From 6814ebd8997bf6cd48782eb688c389189831c730 Mon Sep 17 00:00:00 2001 From: Oier Lauzirika Zarrabeitia Date: Thu, 28 May 2026 10:56:37 +0200 Subject: [PATCH 1/4] Proof of concept with core --- CMakeLists.txt | 68 +- src/CMakeLists.txt | 45 - src/core/alglib/alglibinternal.cpp | 15919 ---------- src/core/alglib/alglibinternal.h | 1074 - src/core/alglib/alglibmisc.cpp | 3611 --- src/core/alglib/alglibmisc.h | 769 - src/core/alglib/ap.cpp | 10661 ------- src/core/alglib/ap.h | 1575 - src/core/alglib/dataanalysis.cpp | 35078 ----------------------- src/core/alglib/dataanalysis.h | 7394 ----- src/core/alglib/diffequations.cpp | 1187 - src/core/alglib/diffequations.h | 267 - src/core/alglib/fasttransforms.cpp | 3554 --- src/core/alglib/fasttransforms.h | 691 - src/core/alglib/integration.cpp | 3961 --- src/core/alglib/integration.h | 837 - src/core/alglib/interpolation.cpp | 30715 -------------------- src/core/alglib/interpolation.h | 5906 ---- src/core/alglib/linalg.cpp | 33805 ---------------------- src/core/alglib/linalg.h | 5187 ---- src/core/alglib/optimization.cpp | 25034 ---------------- src/core/alglib/optimization.h | 4379 --- src/core/alglib/solvers.cpp | 8709 ------ src/core/alglib/solvers.h | 2016 -- src/core/alglib/specialfunctions.cpp | 9637 ------- src/core/alglib/specialfunctions.h | 1976 -- src/core/alglib/statistics.cpp | 19718 ------------- src/core/alglib/statistics.h | 1305 - src/core/alglib/stdafx.h | 2 - src/core/args.cpp | 469 - src/core/args.h | 421 - src/core/argsparser.cpp | 1060 - src/core/argsparser.h | 275 - src/core/argsprinter.cpp | 596 - src/core/argsprinter.h | 120 - src/core/axis_view.h | 43 - src/core/bilib/changebasis.cc | 637 - src/core/bilib/changebasis.h | 62 - src/core/bilib/configs.h | 94 - src/core/bilib/convert.cc | 375 - src/core/bilib/convert.h | 60 - src/core/bilib/debug.h | 353 - src/core/bilib/dft.cc | 2905 -- src/core/bilib/dft.h | 1030 - src/core/bilib/dht.cc | 862 - src/core/bilib/dht.h | 34 - src/core/bilib/error.h | 73 - src/core/bilib/findroot.cc | 640 - src/core/bilib/findroot.h | 210 - src/core/bilib/firconvolve.cc | 2423 -- src/core/bilib/firconvolve.h | 173 - src/core/bilib/flip.cc | 169 - src/core/bilib/flip.h | 30 - src/core/bilib/fold.cc | 288 - src/core/bilib/fold.h | 32 - src/core/bilib/fourierconvolve.cc | 395 - src/core/bilib/fourierconvolve.h | 115 - src/core/bilib/geometry.cc | 1740 -- src/core/bilib/geometry.h | 425 - src/core/bilib/getpoles.cc | 319 - src/core/bilib/getpoles.h | 33 - src/core/bilib/getput.cc | 1309 - src/core/bilib/getput.h | 302 - src/core/bilib/getputd.cc | 742 - src/core/bilib/getputd.h | 166 - src/core/bilib/gradient.cc | 701 - src/core/bilib/gradient.h | 67 - src/core/bilib/histogram.cc | 761 - src/core/bilib/histogram.h | 139 - src/core/bilib/iirconvolve.cc | 853 - src/core/bilib/iirconvolve.h | 81 - src/core/bilib/interpolate.cc | 1974 -- src/core/bilib/interpolate.h | 59 - src/core/bilib/kernel.cc | 2185 -- src/core/bilib/kernel.h | 442 - src/core/bilib/kerneldiff.cc | 695 - src/core/bilib/kerneldiff.h | 82 - src/core/bilib/kerneldiff1.cc | 1094 - src/core/bilib/kerneldiff1.h | 186 - src/core/bilib/kerneldiff2.cc | 1145 - src/core/bilib/kerneldiff2.h | 168 - src/core/bilib/kernelintegrate.cc | 1015 - src/core/bilib/kernelintegrate.h | 210 - src/core/bilib/linearalgebra.cc | 2380 -- src/core/bilib/linearalgebra.h | 405 - src/core/bilib/messagedisplay.cc | 7 - src/core/bilib/messagedisplay.h | 7 - src/core/bilib/minmax.cc | 207 - src/core/bilib/minmax.h | 70 - src/core/bilib/morphology.cc | 3435 --- src/core/bilib/morphology.h | 793 - src/core/bilib/movingaverage.cc | 603 - src/core/bilib/movingaverage.h | 72 - src/core/bilib/polynomial.cc | 611 - src/core/bilib/polynomial.h | 104 - src/core/bilib/positivepower.cc | 137 - src/core/bilib/positivepower.h | 10 - src/core/bilib/pyramidfilters.cc | 867 - src/core/bilib/pyramidfilters.h | 103 - src/core/bilib/pyramidtools.cc | 1170 - src/core/bilib/pyramidtools.h | 184 - src/core/bilib/round.cc | 99 - src/core/bilib/round.h | 18 - src/core/bilib/swap.cc | 195 - src/core/bilib/swap.h | 48 - src/core/bilib/tboundaryconvention.h | 17 - src/core/bilib/timestamp.cc | 191 - src/core/bilib/timestamp.h | 19 - src/core/bilib/traceline.cc | 1072 - src/core/bilib/traceline.h | 14 - src/core/bilib/tsplinebasis.h | 14 - src/core/bilib/ttimestamp.h | 11 - src/core/bilib/ttraceline.h | 12 - src/core/bilib/wavelet.cc | 229 - src/core/bilib/wavelet.h | 71 - src/core/bilib/waveletfilters.cc | 1081 - src/core/bilib/waveletfilters.h | 11 - src/core/bilib/waveletfiltersfract.cc | 486 - src/core/bilib/waveletfiltersfract.h | 13 - src/core/bilib/wavelettools.cc | 1232 - src/core/bilib/wavelettools.h | 22 - src/core/bilib/window.cc | 297 - src/core/bilib/window.h | 59 - src/core/choose.h | 23 - src/core/comment_list.cpp | 51 - src/core/comment_list.h | 45 - src/core/gcc_version.h | 48 - src/core/geometry.cpp | 1328 - src/core/geometry.h | 845 - src/core/histogram.cpp | 588 - src/core/histogram.h | 1002 - src/core/linear_system_helper.cpp | 364 - src/core/linear_system_helper.h | 102 - src/core/matrix1d.cpp | 916 - src/core/matrix1d.h | 1251 - src/core/matrix2d.cpp | 1348 - src/core/matrix2d.h | 1329 - src/core/metadata_base.cpp | 657 - src/core/metadata_base.h | 811 - src/core/metadata_base_it.h | 57 - src/core/metadata_db.cpp | 1730 -- src/core/metadata_db.h | 856 - src/core/metadata_extension.cpp | 568 - src/core/metadata_extension.h | 106 - src/core/metadata_generator.cpp | 115 - src/core/metadata_generator.h | 96 - src/core/metadata_label.h | 1010 - src/core/metadata_object.cpp | 654 - src/core/metadata_object.h | 174 - src/core/metadata_query.cpp | 34 - src/core/metadata_query.h | 366 - src/core/metadata_row_base.h | 205 - src/core/metadata_row_sql.cpp | 162 - src/core/metadata_row_sql.h | 103 - src/core/metadata_row_vec.cpp | 231 - src/core/metadata_row_vec.h | 120 - src/core/metadata_sql.cpp | 1603 -- src/core/metadata_sql.h | 345 - src/core/metadata_sql_operations.h | 47 - src/core/metadata_static.cpp | 325 - src/core/metadata_static.h | 1195 - src/core/metadata_vec.cpp | 983 - src/core/metadata_vec.h | 576 - src/core/metadata_writemode.h | 38 - src/core/multidim_array.cpp | 1182 - src/core/multidim_array.h | 4076 --- src/core/multidim_array_base.cpp | 304 - src/core/multidim_array_base.h | 1078 - src/core/multidim_array_generic.cpp | 170 - src/core/multidim_array_generic.h | 525 - src/core/numerical_recipes.cpp | 9426 ------ src/core/numerical_recipes.h | 343 - src/core/optional.h | 99 - src/core/rerunable_program.h | 86 - src/core/rwDM3.cpp | 636 - src/core/rwDM3.h | 42 - src/core/rwDM4.cpp | 679 - src/core/rwDM4.h | 42 - src/core/rwEER.cpp | 670 - src/core/rwEER.h | 51 - src/core/rwEM.cpp | 152 - src/core/rwEM.h | 133 - src/core/rwHDF5.cpp | 324 - src/core/rwHDF5.h | 52 - src/core/rwIMAGIC.cpp | 506 - src/core/rwIMAGIC.h | 65 - src/core/rwINF.cpp | 282 - src/core/rwINF.h | 43 - src/core/rwJPEG.cpp | 220 - src/core/rwJPEG.h | 32 - src/core/rwMRC.cpp | 694 - src/core/rwMRC.h | 27 - src/core/rwPIF.cpp | 165 - src/core/rwPIF.h | 172 - src/core/rwRAW.cpp | 142 - src/core/rwRAW.h | 49 - src/core/rwSPE.cpp | 87 - src/core/rwSPE.h | 42 - src/core/rwSPIDER.cpp | 600 - src/core/rwSPIDER.h | 142 - src/core/rwTIA.cpp | 257 - src/core/rwTIA.h | 44 - src/core/rwTIFF.cpp | 539 - src/core/rwTIFF.h | 91 - src/core/sqlite3-extension-functions.c | 1945 -- src/core/symmetries.cpp | 1285 - src/core/symmetries.h | 357 - src/core/transformations.cpp | 1465 - src/core/transformations.h | 1952 -- src/core/transformations_defines.h | 43 - src/core/userSettings.cpp | 64 - src/core/userSettings.h | 178 - src/core/utils/half.hpp | 3261 --- src/core/utils/memory_utils.h | 136 - src/core/utils/sql_utils.cpp | 343 - src/core/utils/sql_utils.h | 190 - src/core/utils/time_utils.cpp | 30 - src/core/utils/time_utils.h | 187 - src/core/xmipp_array_coord.h | 47 - src/core/xmipp_array_dim.h | 74 - src/core/xmipp_color.cpp | 36 - src/core/xmipp_color.h | 57 - src/core/xmipp_datatype.cpp | 214 - src/core/xmipp_datatype.h | 76 - src/core/xmipp_error.cpp | 200 - src/core/xmipp_error.h | 242 - src/core/xmipp_fft.cpp | 518 - src/core/xmipp_fft.h | 596 - src/core/xmipp_fftw.cpp | 1006 - src/core/xmipp_fftw.h | 719 - src/core/xmipp_filename.cpp | 941 - src/core/xmipp_filename.h | 795 - src/core/xmipp_funcs.cpp | 1194 - src/core/xmipp_funcs.h | 1240 - src/core/xmipp_hdf5.cpp | 236 - src/core/xmipp_hdf5.h | 111 - src/core/xmipp_image.cpp | 420 - src/core/xmipp_image.h | 1571 - src/core/xmipp_image_base.cpp | 1208 - src/core/xmipp_image_base.h | 882 - src/core/xmipp_image_extension.cpp | 195 - src/core/xmipp_image_extension.h | 66 - src/core/xmipp_image_generic.cpp | 637 - src/core/xmipp_image_generic.h | 477 - src/core/xmipp_image_macros.h | 44 - src/core/xmipp_log.cpp | 75 - src/core/xmipp_log.h | 94 - src/core/xmipp_macros.h | 472 - src/core/xmipp_marsaglia.h | 237 - src/core/xmipp_memory.cpp | 63 - src/core/xmipp_memory.h | 151 - src/core/xmipp_metadata_program.cpp | 445 - src/core/xmipp_metadata_program.h | 192 - src/core/xmipp_program.cpp | 435 - src/core/xmipp_program.h | 266 - src/core/xmipp_program_sql.cpp | 227 - src/core/xmipp_program_sql.h | 93 - src/core/xmipp_random_mode.h | 38 - src/core/xmipp_strings.cpp | 689 - src/core/xmipp_strings.h | 419 - src/core/xmipp_threads.cpp | 402 - src/core/xmipp_threads.h | 493 - src/core/xmipp_types.h | 37 - src/core/xmipp_write_mode.h | 44 - src/core/xvsmooth.cpp | 422 - src/core/xvsmooth.h | 30 - 266 files changed, 66 insertions(+), 359465 deletions(-) delete mode 100644 src/CMakeLists.txt delete mode 100644 src/core/alglib/alglibinternal.cpp delete mode 100644 src/core/alglib/alglibinternal.h delete mode 100644 src/core/alglib/alglibmisc.cpp delete mode 100644 src/core/alglib/alglibmisc.h delete mode 100644 src/core/alglib/ap.cpp delete mode 100644 src/core/alglib/ap.h delete mode 100644 src/core/alglib/dataanalysis.cpp delete mode 100644 src/core/alglib/dataanalysis.h delete mode 100644 src/core/alglib/diffequations.cpp delete mode 100644 src/core/alglib/diffequations.h delete mode 100644 src/core/alglib/fasttransforms.cpp delete mode 100644 src/core/alglib/fasttransforms.h delete mode 100644 src/core/alglib/integration.cpp delete mode 100644 src/core/alglib/integration.h delete mode 100644 src/core/alglib/interpolation.cpp delete mode 100644 src/core/alglib/interpolation.h delete mode 100644 src/core/alglib/linalg.cpp delete mode 100644 src/core/alglib/linalg.h delete mode 100644 src/core/alglib/optimization.cpp delete mode 100644 src/core/alglib/optimization.h delete mode 100644 src/core/alglib/solvers.cpp delete mode 100644 src/core/alglib/solvers.h delete mode 100644 src/core/alglib/specialfunctions.cpp delete mode 100644 src/core/alglib/specialfunctions.h delete mode 100644 src/core/alglib/statistics.cpp delete mode 100644 src/core/alglib/statistics.h delete mode 100644 src/core/alglib/stdafx.h delete mode 100644 src/core/args.cpp delete mode 100644 src/core/args.h delete mode 100644 src/core/argsparser.cpp delete mode 100644 src/core/argsparser.h delete mode 100644 src/core/argsprinter.cpp delete mode 100644 src/core/argsprinter.h delete mode 100644 src/core/axis_view.h delete mode 100644 src/core/bilib/changebasis.cc delete mode 100644 src/core/bilib/changebasis.h delete mode 100644 src/core/bilib/configs.h delete mode 100644 src/core/bilib/convert.cc delete mode 100644 src/core/bilib/convert.h delete mode 100644 src/core/bilib/debug.h delete mode 100644 src/core/bilib/dft.cc delete mode 100644 src/core/bilib/dft.h delete mode 100644 src/core/bilib/dht.cc delete mode 100644 src/core/bilib/dht.h delete mode 100644 src/core/bilib/error.h delete mode 100644 src/core/bilib/findroot.cc delete mode 100644 src/core/bilib/findroot.h delete mode 100644 src/core/bilib/firconvolve.cc delete mode 100644 src/core/bilib/firconvolve.h delete mode 100644 src/core/bilib/flip.cc delete mode 100644 src/core/bilib/flip.h delete mode 100644 src/core/bilib/fold.cc delete mode 100644 src/core/bilib/fold.h delete mode 100644 src/core/bilib/fourierconvolve.cc delete mode 100644 src/core/bilib/fourierconvolve.h delete mode 100644 src/core/bilib/geometry.cc delete mode 100644 src/core/bilib/geometry.h delete mode 100644 src/core/bilib/getpoles.cc delete mode 100644 src/core/bilib/getpoles.h delete mode 100644 src/core/bilib/getput.cc delete mode 100644 src/core/bilib/getput.h delete mode 100644 src/core/bilib/getputd.cc delete mode 100644 src/core/bilib/getputd.h delete mode 100644 src/core/bilib/gradient.cc delete mode 100644 src/core/bilib/gradient.h delete mode 100644 src/core/bilib/histogram.cc delete mode 100644 src/core/bilib/histogram.h delete mode 100644 src/core/bilib/iirconvolve.cc delete mode 100644 src/core/bilib/iirconvolve.h delete mode 100644 src/core/bilib/interpolate.cc delete mode 100644 src/core/bilib/interpolate.h delete mode 100644 src/core/bilib/kernel.cc delete mode 100644 src/core/bilib/kernel.h delete mode 100644 src/core/bilib/kerneldiff.cc delete mode 100644 src/core/bilib/kerneldiff.h delete mode 100644 src/core/bilib/kerneldiff1.cc delete mode 100644 src/core/bilib/kerneldiff1.h delete mode 100644 src/core/bilib/kerneldiff2.cc delete mode 100644 src/core/bilib/kerneldiff2.h delete mode 100644 src/core/bilib/kernelintegrate.cc delete mode 100644 src/core/bilib/kernelintegrate.h delete mode 100644 src/core/bilib/linearalgebra.cc delete mode 100644 src/core/bilib/linearalgebra.h delete mode 100644 src/core/bilib/messagedisplay.cc delete mode 100644 src/core/bilib/messagedisplay.h delete mode 100644 src/core/bilib/minmax.cc delete mode 100644 src/core/bilib/minmax.h delete mode 100644 src/core/bilib/morphology.cc delete mode 100644 src/core/bilib/morphology.h delete mode 100644 src/core/bilib/movingaverage.cc delete mode 100644 src/core/bilib/movingaverage.h delete mode 100644 src/core/bilib/polynomial.cc delete mode 100644 src/core/bilib/polynomial.h delete mode 100644 src/core/bilib/positivepower.cc delete mode 100644 src/core/bilib/positivepower.h delete mode 100644 src/core/bilib/pyramidfilters.cc delete mode 100644 src/core/bilib/pyramidfilters.h delete mode 100644 src/core/bilib/pyramidtools.cc delete mode 100644 src/core/bilib/pyramidtools.h delete mode 100644 src/core/bilib/round.cc delete mode 100644 src/core/bilib/round.h delete mode 100644 src/core/bilib/swap.cc delete mode 100644 src/core/bilib/swap.h delete mode 100644 src/core/bilib/tboundaryconvention.h delete mode 100644 src/core/bilib/timestamp.cc delete mode 100644 src/core/bilib/timestamp.h delete mode 100644 src/core/bilib/traceline.cc delete mode 100644 src/core/bilib/traceline.h delete mode 100644 src/core/bilib/tsplinebasis.h delete mode 100644 src/core/bilib/ttimestamp.h delete mode 100644 src/core/bilib/ttraceline.h delete mode 100644 src/core/bilib/wavelet.cc delete mode 100644 src/core/bilib/wavelet.h delete mode 100644 src/core/bilib/waveletfilters.cc delete mode 100644 src/core/bilib/waveletfilters.h delete mode 100644 src/core/bilib/waveletfiltersfract.cc delete mode 100644 src/core/bilib/waveletfiltersfract.h delete mode 100644 src/core/bilib/wavelettools.cc delete mode 100644 src/core/bilib/wavelettools.h delete mode 100644 src/core/bilib/window.cc delete mode 100644 src/core/bilib/window.h delete mode 100644 src/core/choose.h delete mode 100644 src/core/comment_list.cpp delete mode 100644 src/core/comment_list.h delete mode 100644 src/core/gcc_version.h delete mode 100644 src/core/geometry.cpp delete mode 100644 src/core/geometry.h delete mode 100644 src/core/histogram.cpp delete mode 100644 src/core/histogram.h delete mode 100644 src/core/linear_system_helper.cpp delete mode 100644 src/core/linear_system_helper.h delete mode 100644 src/core/matrix1d.cpp delete mode 100644 src/core/matrix1d.h delete mode 100644 src/core/matrix2d.cpp delete mode 100644 src/core/matrix2d.h delete mode 100644 src/core/metadata_base.cpp delete mode 100644 src/core/metadata_base.h delete mode 100644 src/core/metadata_base_it.h delete mode 100644 src/core/metadata_db.cpp delete mode 100644 src/core/metadata_db.h delete mode 100644 src/core/metadata_extension.cpp delete mode 100644 src/core/metadata_extension.h delete mode 100644 src/core/metadata_generator.cpp delete mode 100644 src/core/metadata_generator.h delete mode 100644 src/core/metadata_label.h delete mode 100644 src/core/metadata_object.cpp delete mode 100644 src/core/metadata_object.h delete mode 100644 src/core/metadata_query.cpp delete mode 100644 src/core/metadata_query.h delete mode 100644 src/core/metadata_row_base.h delete mode 100644 src/core/metadata_row_sql.cpp delete mode 100644 src/core/metadata_row_sql.h delete mode 100644 src/core/metadata_row_vec.cpp delete mode 100644 src/core/metadata_row_vec.h delete mode 100644 src/core/metadata_sql.cpp delete mode 100644 src/core/metadata_sql.h delete mode 100644 src/core/metadata_sql_operations.h delete mode 100644 src/core/metadata_static.cpp delete mode 100644 src/core/metadata_static.h delete mode 100644 src/core/metadata_vec.cpp delete mode 100644 src/core/metadata_vec.h delete mode 100644 src/core/metadata_writemode.h delete mode 100644 src/core/multidim_array.cpp delete mode 100644 src/core/multidim_array.h delete mode 100644 src/core/multidim_array_base.cpp delete mode 100644 src/core/multidim_array_base.h delete mode 100644 src/core/multidim_array_generic.cpp delete mode 100644 src/core/multidim_array_generic.h delete mode 100644 src/core/numerical_recipes.cpp delete mode 100644 src/core/numerical_recipes.h delete mode 100644 src/core/optional.h delete mode 100644 src/core/rerunable_program.h delete mode 100644 src/core/rwDM3.cpp delete mode 100644 src/core/rwDM3.h delete mode 100644 src/core/rwDM4.cpp delete mode 100644 src/core/rwDM4.h delete mode 100644 src/core/rwEER.cpp delete mode 100644 src/core/rwEER.h delete mode 100644 src/core/rwEM.cpp delete mode 100644 src/core/rwEM.h delete mode 100644 src/core/rwHDF5.cpp delete mode 100644 src/core/rwHDF5.h delete mode 100644 src/core/rwIMAGIC.cpp delete mode 100644 src/core/rwIMAGIC.h delete mode 100644 src/core/rwINF.cpp delete mode 100644 src/core/rwINF.h delete mode 100644 src/core/rwJPEG.cpp delete mode 100644 src/core/rwJPEG.h delete mode 100644 src/core/rwMRC.cpp delete mode 100644 src/core/rwMRC.h delete mode 100644 src/core/rwPIF.cpp delete mode 100644 src/core/rwPIF.h delete mode 100644 src/core/rwRAW.cpp delete mode 100644 src/core/rwRAW.h delete mode 100644 src/core/rwSPE.cpp delete mode 100644 src/core/rwSPE.h delete mode 100644 src/core/rwSPIDER.cpp delete mode 100644 src/core/rwSPIDER.h delete mode 100644 src/core/rwTIA.cpp delete mode 100644 src/core/rwTIA.h delete mode 100644 src/core/rwTIFF.cpp delete mode 100644 src/core/rwTIFF.h delete mode 100644 src/core/sqlite3-extension-functions.c delete mode 100644 src/core/symmetries.cpp delete mode 100644 src/core/symmetries.h delete mode 100644 src/core/transformations.cpp delete mode 100644 src/core/transformations.h delete mode 100644 src/core/transformations_defines.h delete mode 100644 src/core/userSettings.cpp delete mode 100644 src/core/userSettings.h delete mode 100644 src/core/utils/half.hpp delete mode 100644 src/core/utils/memory_utils.h delete mode 100644 src/core/utils/sql_utils.cpp delete mode 100644 src/core/utils/sql_utils.h delete mode 100644 src/core/utils/time_utils.cpp delete mode 100644 src/core/utils/time_utils.h delete mode 100644 src/core/xmipp_array_coord.h delete mode 100644 src/core/xmipp_array_dim.h delete mode 100644 src/core/xmipp_color.cpp delete mode 100644 src/core/xmipp_color.h delete mode 100644 src/core/xmipp_datatype.cpp delete mode 100644 src/core/xmipp_datatype.h delete mode 100644 src/core/xmipp_error.cpp delete mode 100644 src/core/xmipp_error.h delete mode 100644 src/core/xmipp_fft.cpp delete mode 100644 src/core/xmipp_fft.h delete mode 100644 src/core/xmipp_fftw.cpp delete mode 100644 src/core/xmipp_fftw.h delete mode 100644 src/core/xmipp_filename.cpp delete mode 100644 src/core/xmipp_filename.h delete mode 100644 src/core/xmipp_funcs.cpp delete mode 100644 src/core/xmipp_funcs.h delete mode 100644 src/core/xmipp_hdf5.cpp delete mode 100644 src/core/xmipp_hdf5.h delete mode 100644 src/core/xmipp_image.cpp delete mode 100644 src/core/xmipp_image.h delete mode 100644 src/core/xmipp_image_base.cpp delete mode 100644 src/core/xmipp_image_base.h delete mode 100644 src/core/xmipp_image_extension.cpp delete mode 100644 src/core/xmipp_image_extension.h delete mode 100644 src/core/xmipp_image_generic.cpp delete mode 100644 src/core/xmipp_image_generic.h delete mode 100644 src/core/xmipp_image_macros.h delete mode 100644 src/core/xmipp_log.cpp delete mode 100644 src/core/xmipp_log.h delete mode 100644 src/core/xmipp_macros.h delete mode 100644 src/core/xmipp_marsaglia.h delete mode 100644 src/core/xmipp_memory.cpp delete mode 100644 src/core/xmipp_memory.h delete mode 100644 src/core/xmipp_metadata_program.cpp delete mode 100644 src/core/xmipp_metadata_program.h delete mode 100644 src/core/xmipp_program.cpp delete mode 100644 src/core/xmipp_program.h delete mode 100644 src/core/xmipp_program_sql.cpp delete mode 100644 src/core/xmipp_program_sql.h delete mode 100644 src/core/xmipp_random_mode.h delete mode 100644 src/core/xmipp_strings.cpp delete mode 100644 src/core/xmipp_strings.h delete mode 100644 src/core/xmipp_threads.cpp delete mode 100644 src/core/xmipp_threads.h delete mode 100644 src/core/xmipp_types.h delete mode 100644 src/core/xmipp_write_mode.h delete mode 100644 src/core/xvsmooth.cpp delete mode 100644 src/core/xvsmooth.h diff --git a/CMakeLists.txt b/CMakeLists.txt index ab05351..4a95133 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -16,9 +16,11 @@ include(GNUInstallDirs) # Set the module path list(APPEND CMAKE_MODULE_PATH ${CMAKE_CURRENT_SOURCE_DIR}/cmake/modules) +# Find system dependencies find_package(Threads REQUIRED) find_package(Python REQUIRED COMPONENTS Interpreter Development.Module NumPy) +# Fetch dependencies include(fetch_hdf5) include(fetch_sqlite3) include(fetch_fftw3) @@ -37,12 +39,74 @@ else() set(PYTHON_INSTALL_DIR "${Python_SITEARCH}") endif() +# Fetch main Xmipp repository +cmake_policy(SET CMP0135 NEW) # To avoid warnings +FetchContent_Declare( + xmipp_core_sources + URL https://github.com/I2PC/xmippCore/archive/refs/tags/v4.0.0.tar.gz +) +FetchContent_Declare( + xmipp3_sources + URL https://github.com/I2PC/xmipp3/archive/refs/tags/v5.0.0-Beta-gal.tar.gz +) +FetchContent_Populate(xmipp_core_sources) +FetchContent_Populate(xmipp3_sources) + # Set project-wide compilation options set(CMAKE_CXX_STANDARD 17) set(CMAKE_CXX_STANDARD_REQUIRED ON) -# Add sources -add_subdirectory(src) +# Get FFTW include dir +FetchContent_GetProperties(fftw3_double SOURCE_DIR FFTW_SOURCE_DIR) +set(FFTW_INCLUDE_DIR ${FFTW_SOURCE_DIR}/api) + +# Register all source and header files +file( + GLOB_RECURSE + SOURCES + ${xmipp_core_sources_SOURCE_DIR}/core/*.cpp + ${xmipp_core_sources_SOURCE_DIR}/core/*.cc + ${xmipp_core_sources_SOURCE_DIR}/core/*.c + ${CMAKE_CURRENT_SOURCE_DIR}/src/*.cpp +) + +# Create the shared library +add_library(xmippLib MODULE ${SOURCES}) +target_link_libraries( + xmippLib + PRIVATE + Threads::Threads + Python::Module + Python::NumPy + sqlite3 + HDF5::CXX + HDF5::HDF5 + FFTW3::Double + FFTW3::Float + FFTW3::DoubleThreads + FFTW3::FloatThreads + JPEG::JPEG + TIFF::tiff +) +target_include_directories( + xmippLib + PRIVATE + ${xmipp_core_sources_SOURCE_DIR} + ${CMAKE_CURRENT_SOURCE_DIR}/src + ${FFTW_INCLUDE_DIR} +) +set_target_properties(xmippLib + PROPERTIES + PREFIX "" + OUTPUT_NAME "xmippLib" +) + +# Install library's binary files and headers +install( + TARGETS xmippLib + LIBRARY + DESTINATION "${PYTHON_INSTALL_DIR}" +) # Install Python scripts install(DIRECTORY diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt deleted file mode 100644 index 781d836..0000000 --- a/src/CMakeLists.txt +++ /dev/null @@ -1,45 +0,0 @@ -cmake_minimum_required(VERSION 3.16) - -# Register all source and header files -file(GLOB_RECURSE SOURCES ${CMAKE_CURRENT_SOURCE_DIR}/*.cpp ${CMAKE_CURRENT_SOURCE_DIR}/*.c ${CMAKE_CURRENT_SOURCE_DIR}/*.cc) - - -FetchContent_GetProperties(fftw3_double SOURCE_DIR FFTW_SOURCE_DIR) -set(FFTW_INCLUDE_DIR ${FFTW_SOURCE_DIR}/api) - -# Create the shared library -add_library(xmippLib MODULE ${SOURCES}) -target_link_libraries( - xmippLib - PRIVATE - Threads::Threads - Python::Module - Python::NumPy - sqlite3 - HDF5::CXX - HDF5::HDF5 - FFTW3::Double - FFTW3::Float - FFTW3::DoubleThreads - FFTW3::FloatThreads - JPEG::JPEG - TIFF::tiff -) -target_include_directories( - xmippLib - PRIVATE - ${CMAKE_CURRENT_SOURCE_DIR} - ${FFTW_INCLUDE_DIR} -) -set_target_properties(xmippLib - PROPERTIES - PREFIX "" - OUTPUT_NAME "xmippLib" -) - -# Install library's binary files and headers -install( - TARGETS xmippLib - LIBRARY - DESTINATION "${PYTHON_INSTALL_DIR}" -) diff --git a/src/core/alglib/alglibinternal.cpp b/src/core/alglib/alglibinternal.cpp deleted file mode 100644 index b3bcd5c..0000000 --- a/src/core/alglib/alglibinternal.cpp +++ /dev/null @@ -1,15919 +0,0 @@ -/************************************************************************* -Copyright (c) Sergey Bochkanov (ALGLIB project). - ->>> SOURCE LICENSE >>> -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation (www.fsf.org); either version 2 of the -License, or (at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -A copy of the GNU General Public License is available at -http://www.fsf.org/licensing/licenses ->>> END OF LICENSE >>> -*************************************************************************/ -#include "stdafx.h" -#include "alglibinternal.h" - -// disable some irrelevant warnings -#if (AE_COMPILER==AE_MSVC) -#pragma warning(disable:4100) -#pragma warning(disable:4127) -#pragma warning(disable:4702) -#pragma warning(disable:4996) -#endif -using namespace std; - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS IMPLEMENTATION OF C++ INTERFACE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib -{ - - -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS IMPLEMENTATION OF COMPUTATIONAL CORE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ - - - - -static void tsort_tagsortfastirec(/* Real */ ae_vector* a, - /* Integer */ ae_vector* b, - /* Real */ ae_vector* bufa, - /* Integer */ ae_vector* bufb, - ae_int_t i1, - ae_int_t i2, - ae_state *_state); -static void tsort_tagsortfastrrec(/* Real */ ae_vector* a, - /* Real */ ae_vector* b, - /* Real */ ae_vector* bufa, - /* Real */ ae_vector* bufb, - ae_int_t i1, - ae_int_t i2, - ae_state *_state); -static void tsort_tagsortfastrec(/* Real */ ae_vector* a, - /* Real */ ae_vector* bufa, - ae_int_t i1, - ae_int_t i2, - ae_state *_state); - - - - - - - - - - - - - - - - - - - - -static void hsschur_internalauxschur(ae_bool wantt, - ae_bool wantz, - ae_int_t n, - ae_int_t ilo, - ae_int_t ihi, - /* Real */ ae_matrix* h, - /* Real */ ae_vector* wr, - /* Real */ ae_vector* wi, - ae_int_t iloz, - ae_int_t ihiz, - /* Real */ ae_matrix* z, - /* Real */ ae_vector* work, - /* Real */ ae_vector* workv3, - /* Real */ ae_vector* workc1, - /* Real */ ae_vector* works1, - ae_int_t* info, - ae_state *_state); -static void hsschur_aux2x2schur(double* a, - double* b, - double* c, - double* d, - double* rt1r, - double* rt1i, - double* rt2r, - double* rt2i, - double* cs, - double* sn, - ae_state *_state); -static double hsschur_extschursign(double a, double b, ae_state *_state); -static ae_int_t hsschur_extschursigntoone(double b, ae_state *_state); - - - - -static ae_bool safesolve_cbasicsolveandupdate(ae_complex alpha, - ae_complex beta, - double lnmax, - double bnorm, - double maxgrowth, - double* xnorm, - ae_complex* x, - ae_state *_state); - - -static ae_bool hpccores_hpcpreparechunkedgradientx(/* Real */ ae_vector* weights, - ae_int_t wcount, - /* Real */ ae_vector* hpcbuf, - ae_state *_state); -static ae_bool hpccores_hpcfinalizechunkedgradientx(/* Real */ ae_vector* buf, - ae_int_t wcount, - /* Real */ ae_vector* grad, - ae_state *_state); - - -static void xblas_xsum(/* Real */ ae_vector* w, - double mx, - ae_int_t n, - double* r, - double* rerr, - ae_state *_state); -static double xblas_xfastpow(double r, ae_int_t n, ae_state *_state); - - -static double linmin_ftol = 0.001; -static double linmin_xtol = 100*ae_machineepsilon; -static ae_int_t linmin_maxfev = 20; -static double linmin_stpmin = 1.0E-50; -static double linmin_defstpmax = 1.0E+50; -static double linmin_armijofactor = 1.3; -static void linmin_mcstep(double* stx, - double* fx, - double* dx, - double* sty, - double* fy, - double* dy, - double* stp, - double fp, - double dp, - ae_bool* brackt, - double stmin, - double stmax, - ae_int_t* info, - ae_state *_state); - - -static ae_bool ntheory_isprime(ae_int_t n, ae_state *_state); -static ae_int_t ntheory_modmul(ae_int_t a, - ae_int_t b, - ae_int_t n, - ae_state *_state); -static ae_int_t ntheory_modexp(ae_int_t a, - ae_int_t b, - ae_int_t n, - ae_state *_state); - - -static ae_int_t ftbase_coltype = 0; -static ae_int_t ftbase_coloperandscnt = 1; -static ae_int_t ftbase_coloperandsize = 2; -static ae_int_t ftbase_colmicrovectorsize = 3; -static ae_int_t ftbase_colparam0 = 4; -static ae_int_t ftbase_colparam1 = 5; -static ae_int_t ftbase_colparam2 = 6; -static ae_int_t ftbase_colparam3 = 7; -static ae_int_t ftbase_colscnt = 8; -static ae_int_t ftbase_opend = 0; -static ae_int_t ftbase_opcomplexreffft = 1; -static ae_int_t ftbase_opbluesteinsfft = 2; -static ae_int_t ftbase_opcomplexcodeletfft = 3; -static ae_int_t ftbase_opcomplexcodelettwfft = 4; -static ae_int_t ftbase_opradersfft = 5; -static ae_int_t ftbase_opcomplextranspose = -1; -static ae_int_t ftbase_opcomplexfftfactors = -2; -static ae_int_t ftbase_opstart = -3; -static ae_int_t ftbase_opjmp = -4; -static ae_int_t ftbase_opparallelcall = -5; -static ae_int_t ftbase_maxradix = 6; -static ae_int_t ftbase_updatetw = 16; -static ae_int_t ftbase_recursivethreshold = 1024; -static ae_int_t ftbase_raderthreshold = 19; -static ae_int_t ftbase_ftbasecodeletrecommended = 5; -static double ftbase_ftbaseinefficiencyfactor = 1.3; -static ae_int_t ftbase_ftbasemaxsmoothfactor = 5; -static void ftbase_ftdeterminespacerequirements(ae_int_t n, - ae_int_t* precrsize, - ae_int_t* precisize, - ae_state *_state); -static void ftbase_ftcomplexfftplanrec(ae_int_t n, - ae_int_t k, - ae_bool childplan, - ae_bool topmostplan, - ae_int_t* rowptr, - ae_int_t* bluesteinsize, - ae_int_t* precrptr, - ae_int_t* preciptr, - fasttransformplan* plan, - ae_state *_state); -static void ftbase_ftpushentry(fasttransformplan* plan, - ae_int_t* rowptr, - ae_int_t etype, - ae_int_t eopcnt, - ae_int_t eopsize, - ae_int_t emcvsize, - ae_int_t eparam0, - ae_state *_state); -static void ftbase_ftpushentry2(fasttransformplan* plan, - ae_int_t* rowptr, - ae_int_t etype, - ae_int_t eopcnt, - ae_int_t eopsize, - ae_int_t emcvsize, - ae_int_t eparam0, - ae_int_t eparam1, - ae_state *_state); -static void ftbase_ftpushentry4(fasttransformplan* plan, - ae_int_t* rowptr, - ae_int_t etype, - ae_int_t eopcnt, - ae_int_t eopsize, - ae_int_t emcvsize, - ae_int_t eparam0, - ae_int_t eparam1, - ae_int_t eparam2, - ae_int_t eparam3, - ae_state *_state); -static void ftbase_ftapplysubplan(fasttransformplan* plan, - ae_int_t subplan, - /* Real */ ae_vector* a, - ae_int_t abase, - ae_int_t aoffset, - /* Real */ ae_vector* buf, - ae_int_t repcnt, - ae_state *_state); -static void ftbase_ftapplycomplexreffft(/* Real */ ae_vector* a, - ae_int_t offs, - ae_int_t operandscnt, - ae_int_t operandsize, - ae_int_t microvectorsize, - /* Real */ ae_vector* buf, - ae_state *_state); -static void ftbase_ftapplycomplexcodeletfft(/* Real */ ae_vector* a, - ae_int_t offs, - ae_int_t operandscnt, - ae_int_t operandsize, - ae_int_t microvectorsize, - ae_state *_state); -static void ftbase_ftapplycomplexcodelettwfft(/* Real */ ae_vector* a, - ae_int_t offs, - ae_int_t operandscnt, - ae_int_t operandsize, - ae_int_t microvectorsize, - ae_state *_state); -static void ftbase_ftprecomputebluesteinsfft(ae_int_t n, - ae_int_t m, - /* Real */ ae_vector* precr, - ae_int_t offs, - ae_state *_state); -static void ftbase_ftbluesteinsfft(fasttransformplan* plan, - /* Real */ ae_vector* a, - ae_int_t abase, - ae_int_t aoffset, - ae_int_t operandscnt, - ae_int_t n, - ae_int_t m, - ae_int_t precoffs, - ae_int_t subplan, - /* Real */ ae_vector* bufa, - /* Real */ ae_vector* bufb, - /* Real */ ae_vector* bufc, - /* Real */ ae_vector* bufd, - ae_state *_state); -static void ftbase_ftprecomputeradersfft(ae_int_t n, - ae_int_t rq, - ae_int_t riq, - /* Real */ ae_vector* precr, - ae_int_t offs, - ae_state *_state); -static void ftbase_ftradersfft(fasttransformplan* plan, - /* Real */ ae_vector* a, - ae_int_t abase, - ae_int_t aoffset, - ae_int_t operandscnt, - ae_int_t n, - ae_int_t subplan, - ae_int_t rq, - ae_int_t riq, - ae_int_t precoffs, - /* Real */ ae_vector* buf, - ae_state *_state); -static void ftbase_ftfactorize(ae_int_t n, - ae_bool isroot, - ae_int_t* n1, - ae_int_t* n2, - ae_state *_state); -static ae_int_t ftbase_ftoptimisticestimate(ae_int_t n, ae_state *_state); -static void ftbase_ffttwcalc(/* Real */ ae_vector* a, - ae_int_t aoffset, - ae_int_t n1, - ae_int_t n2, - ae_state *_state); -static void ftbase_internalcomplexlintranspose(/* Real */ ae_vector* a, - ae_int_t m, - ae_int_t n, - ae_int_t astart, - /* Real */ ae_vector* buf, - ae_state *_state); -static void ftbase_ffticltrec(/* Real */ ae_vector* a, - ae_int_t astart, - ae_int_t astride, - /* Real */ ae_vector* b, - ae_int_t bstart, - ae_int_t bstride, - ae_int_t m, - ae_int_t n, - ae_state *_state); -static void ftbase_fftirltrec(/* Real */ ae_vector* a, - ae_int_t astart, - ae_int_t astride, - /* Real */ ae_vector* b, - ae_int_t bstart, - ae_int_t bstride, - ae_int_t m, - ae_int_t n, - ae_state *_state); -static void ftbase_ftbasefindsmoothrec(ae_int_t n, - ae_int_t seed, - ae_int_t leastfactor, - ae_int_t* best, - ae_state *_state); - - - - - - - - - -/************************************************************************* -This function is used to set error flags during unit tests. When COND -parameter is True, FLAG variable is set to True. When COND is False, -FLAG is unchanged. - -The purpose of this function is to have single point where failures of -unit tests can be detected. - -This function returns value of COND. -*************************************************************************/ -ae_bool seterrorflag(ae_bool* flag, ae_bool cond, ae_state *_state) -{ - ae_bool result; - - - if( cond ) - { - *flag = ae_true; - } - result = cond; - return result; -} - - -/************************************************************************* -Internally calls SetErrorFlag() with condition: - - Abs(Val-RefVal)>Tol*Max(Abs(RefVal),S) - -This function is used to test relative error in Val against RefVal, with -relative error being replaced by absolute when scale of RefVal is less -than S. - -This function returns value of COND. -*************************************************************************/ -ae_bool seterrorflagdiff(ae_bool* flag, - double val, - double refval, - double tol, - double s, - ae_state *_state) -{ - ae_bool result; - - - result = seterrorflag(flag, ae_fp_greater(ae_fabs(val-refval, _state),tol*ae_maxreal(ae_fabs(refval, _state), s, _state)), _state); - return result; -} - - -/************************************************************************* -The function "touches" integer - it is used to avoid compiler messages -about unused variables (in rare cases when we do NOT want to remove these -variables). - - -- ALGLIB -- - Copyright 17.09.2012 by Bochkanov Sergey -*************************************************************************/ -void touchint(ae_int_t* a, ae_state *_state) -{ - - -} - - -/************************************************************************* -The function "touches" real - it is used to avoid compiler messages -about unused variables (in rare cases when we do NOT want to remove these -variables). - - -- ALGLIB -- - Copyright 17.09.2012 by Bochkanov Sergey -*************************************************************************/ -void touchreal(double* a, ae_state *_state) -{ - - -} - - -/************************************************************************* -The function convert integer value to real value. - - -- ALGLIB -- - Copyright 17.09.2012 by Bochkanov Sergey -*************************************************************************/ -double inttoreal(ae_int_t a, ae_state *_state) -{ - double result; - - - result = a; - return result; -} - - -/************************************************************************* -The function calculates binary logarithm. - -NOTE: it costs twice as much as Ln(x) - - -- ALGLIB -- - Copyright 17.09.2012 by Bochkanov Sergey -*************************************************************************/ -double log2(double x, ae_state *_state) -{ - double result; - - - result = ae_log(x, _state)/ae_log(2, _state); - return result; -} - - -/************************************************************************* -This function compares two numbers for approximate equality, with tolerance -to errors as large as max(|a|,|b|)*tol. - - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -ae_bool approxequalrel(double a, double b, double tol, ae_state *_state) -{ - ae_bool result; - - - result = ae_fp_less_eq(ae_fabs(a-b, _state),ae_maxreal(ae_fabs(a, _state), ae_fabs(b, _state), _state)*tol); - return result; -} - - -/************************************************************************* -This function generates 1-dimensional general interpolation task with -moderate Lipshitz constant (close to 1.0) - -If N=1 then suborutine generates only one point at the middle of [A,B] - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -void taskgenint1d(double a, - double b, - ae_int_t n, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state) -{ - ae_int_t i; - double h; - - ae_vector_clear(x); - ae_vector_clear(y); - - ae_assert(n>=1, "TaskGenInterpolationEqdist1D: N<1!", _state); - ae_vector_set_length(x, n, _state); - ae_vector_set_length(y, n, _state); - if( n>1 ) - { - x->ptr.p_double[0] = a; - y->ptr.p_double[0] = 2*ae_randomreal(_state)-1; - h = (b-a)/(n-1); - for(i=1; i<=n-1; i++) - { - if( i!=n-1 ) - { - x->ptr.p_double[i] = a+(i+0.2*(2*ae_randomreal(_state)-1))*h; - } - else - { - x->ptr.p_double[i] = b; - } - y->ptr.p_double[i] = y->ptr.p_double[i-1]+(2*ae_randomreal(_state)-1)*(x->ptr.p_double[i]-x->ptr.p_double[i-1]); - } - } - else - { - x->ptr.p_double[0] = 0.5*(a+b); - y->ptr.p_double[0] = 2*ae_randomreal(_state)-1; - } -} - - -/************************************************************************* -This function generates 1-dimensional equidistant interpolation task with -moderate Lipshitz constant (close to 1.0) - -If N=1 then suborutine generates only one point at the middle of [A,B] - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -void taskgenint1dequidist(double a, - double b, - ae_int_t n, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state) -{ - ae_int_t i; - double h; - - ae_vector_clear(x); - ae_vector_clear(y); - - ae_assert(n>=1, "TaskGenInterpolationEqdist1D: N<1!", _state); - ae_vector_set_length(x, n, _state); - ae_vector_set_length(y, n, _state); - if( n>1 ) - { - x->ptr.p_double[0] = a; - y->ptr.p_double[0] = 2*ae_randomreal(_state)-1; - h = (b-a)/(n-1); - for(i=1; i<=n-1; i++) - { - x->ptr.p_double[i] = a+i*h; - y->ptr.p_double[i] = y->ptr.p_double[i-1]+(2*ae_randomreal(_state)-1)*h; - } - } - else - { - x->ptr.p_double[0] = 0.5*(a+b); - y->ptr.p_double[0] = 2*ae_randomreal(_state)-1; - } -} - - -/************************************************************************* -This function generates 1-dimensional Chebyshev-1 interpolation task with -moderate Lipshitz constant (close to 1.0) - -If N=1 then suborutine generates only one point at the middle of [A,B] - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -void taskgenint1dcheb1(double a, - double b, - ae_int_t n, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state) -{ - ae_int_t i; - - ae_vector_clear(x); - ae_vector_clear(y); - - ae_assert(n>=1, "TaskGenInterpolation1DCheb1: N<1!", _state); - ae_vector_set_length(x, n, _state); - ae_vector_set_length(y, n, _state); - if( n>1 ) - { - for(i=0; i<=n-1; i++) - { - x->ptr.p_double[i] = 0.5*(b+a)+0.5*(b-a)*ae_cos(ae_pi*(2*i+1)/(2*n), _state); - if( i==0 ) - { - y->ptr.p_double[i] = 2*ae_randomreal(_state)-1; - } - else - { - y->ptr.p_double[i] = y->ptr.p_double[i-1]+(2*ae_randomreal(_state)-1)*(x->ptr.p_double[i]-x->ptr.p_double[i-1]); - } - } - } - else - { - x->ptr.p_double[0] = 0.5*(a+b); - y->ptr.p_double[0] = 2*ae_randomreal(_state)-1; - } -} - - -/************************************************************************* -This function generates 1-dimensional Chebyshev-2 interpolation task with -moderate Lipshitz constant (close to 1.0) - -If N=1 then suborutine generates only one point at the middle of [A,B] - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -void taskgenint1dcheb2(double a, - double b, - ae_int_t n, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state) -{ - ae_int_t i; - - ae_vector_clear(x); - ae_vector_clear(y); - - ae_assert(n>=1, "TaskGenInterpolation1DCheb2: N<1!", _state); - ae_vector_set_length(x, n, _state); - ae_vector_set_length(y, n, _state); - if( n>1 ) - { - for(i=0; i<=n-1; i++) - { - x->ptr.p_double[i] = 0.5*(b+a)+0.5*(b-a)*ae_cos(ae_pi*i/(n-1), _state); - if( i==0 ) - { - y->ptr.p_double[i] = 2*ae_randomreal(_state)-1; - } - else - { - y->ptr.p_double[i] = y->ptr.p_double[i-1]+(2*ae_randomreal(_state)-1)*(x->ptr.p_double[i]-x->ptr.p_double[i-1]); - } - } - } - else - { - x->ptr.p_double[0] = 0.5*(a+b); - y->ptr.p_double[0] = 2*ae_randomreal(_state)-1; - } -} - - -/************************************************************************* -This function checks that all values from X[] are distinct. It does more -than just usual floating point comparison: -* first, it calculates max(X) and min(X) -* second, it maps X[] from [min,max] to [1,2] -* only at this stage actual comparison is done - -The meaning of such check is to ensure that all values are "distinct enough" -and will not cause interpolation subroutine to fail. - -NOTE: - X[] must be sorted by ascending (subroutine ASSERT's it) - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -ae_bool aredistinct(/* Real */ ae_vector* x, - ae_int_t n, - ae_state *_state) -{ - double a; - double b; - ae_int_t i; - ae_bool nonsorted; - ae_bool result; - - - ae_assert(n>=1, "APSERVAreDistinct: internal error (N<1)", _state); - if( n==1 ) - { - - /* - * everything is alright, it is up to caller to decide whether it - * can interpolate something with just one point - */ - result = ae_true; - return result; - } - a = x->ptr.p_double[0]; - b = x->ptr.p_double[0]; - nonsorted = ae_false; - for(i=1; i<=n-1; i++) - { - a = ae_minreal(a, x->ptr.p_double[i], _state); - b = ae_maxreal(b, x->ptr.p_double[i], _state); - nonsorted = nonsorted||ae_fp_greater_eq(x->ptr.p_double[i-1],x->ptr.p_double[i]); - } - ae_assert(!nonsorted, "APSERVAreDistinct: internal error (not sorted)", _state); - for(i=1; i<=n-1; i++) - { - if( ae_fp_eq((x->ptr.p_double[i]-a)/(b-a)+1,(x->ptr.p_double[i-1]-a)/(b-a)+1) ) - { - result = ae_false; - return result; - } - } - result = ae_true; - return result; -} - - -/************************************************************************* -This function checks that two boolean values are the same (both are True -or both are False). - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -ae_bool aresameboolean(ae_bool v1, ae_bool v2, ae_state *_state) -{ - ae_bool result; - - - result = (v1&&v2)||(!v1&&!v2); - return result; -} - - -/************************************************************************* -If Length(X)cntcntcnt0&&n>0 ) - { - if( x->rowscolsrows; - n2 = x->cols; - ae_swap_matrices(x, &oldx); - ae_matrix_set_length(x, m, n, _state); - for(i=0; i<=m-1; i++) - { - for(j=0; j<=n-1; j++) - { - if( iptr.pp_double[i][j] = oldx.ptr.pp_double[i][j]; - } - else - { - x->ptr.pp_double[i][j] = 0.0; - } - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Resizes X and: -* preserves old contents of X -* fills new elements by zeros - - -- ALGLIB -- - Copyright 20.03.2009 by Bochkanov Sergey -*************************************************************************/ -void imatrixresize(/* Integer */ ae_matrix* x, - ae_int_t m, - ae_int_t n, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix oldx; - ae_int_t i; - ae_int_t j; - ae_int_t m2; - ae_int_t n2; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init(&oldx, 0, 0, DT_INT, _state, ae_true); - - m2 = x->rows; - n2 = x->cols; - ae_swap_matrices(x, &oldx); - ae_matrix_set_length(x, m, n, _state); - for(i=0; i<=m-1; i++) - { - for(j=0; j<=n-1; j++) - { - if( iptr.pp_int[i][j] = oldx.ptr.pp_int[i][j]; - } - else - { - x->ptr.pp_int[i][j] = 0; - } - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -This function checks that length(X) is at least N and first N values from -X[] are finite - - -- ALGLIB -- - Copyright 18.06.2010 by Bochkanov Sergey -*************************************************************************/ -ae_bool isfinitevector(/* Real */ ae_vector* x, - ae_int_t n, - ae_state *_state) -{ - ae_int_t i; - ae_bool result; - - - ae_assert(n>=0, "APSERVIsFiniteVector: internal error (N<0)", _state); - if( n==0 ) - { - result = ae_true; - return result; - } - if( x->cntptr.p_double[i], _state) ) - { - result = ae_false; - return result; - } - } - result = ae_true; - return result; -} - - -/************************************************************************* -This function checks that first N values from X[] are finite - - -- ALGLIB -- - Copyright 18.06.2010 by Bochkanov Sergey -*************************************************************************/ -ae_bool isfinitecvector(/* Complex */ ae_vector* z, - ae_int_t n, - ae_state *_state) -{ - ae_int_t i; - ae_bool result; - - - ae_assert(n>=0, "APSERVIsFiniteCVector: internal error (N<0)", _state); - for(i=0; i<=n-1; i++) - { - if( !ae_isfinite(z->ptr.p_complex[i].x, _state)||!ae_isfinite(z->ptr.p_complex[i].y, _state) ) - { - result = ae_false; - return result; - } - } - result = ae_true; - return result; -} - - -/************************************************************************* -This function checks that size of X is at least MxN and values from -X[0..M-1,0..N-1] are finite. - - -- ALGLIB -- - Copyright 18.06.2010 by Bochkanov Sergey -*************************************************************************/ -ae_bool apservisfinitematrix(/* Real */ ae_matrix* x, - ae_int_t m, - ae_int_t n, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_bool result; - - - ae_assert(n>=0, "APSERVIsFiniteMatrix: internal error (N<0)", _state); - ae_assert(m>=0, "APSERVIsFiniteMatrix: internal error (M<0)", _state); - if( m==0||n==0 ) - { - result = ae_true; - return result; - } - if( x->rowscolsptr.pp_double[i][j], _state) ) - { - result = ae_false; - return result; - } - } - } - result = ae_true; - return result; -} - - -/************************************************************************* -This function checks that all values from X[0..M-1,0..N-1] are finite - - -- ALGLIB -- - Copyright 18.06.2010 by Bochkanov Sergey -*************************************************************************/ -ae_bool apservisfinitecmatrix(/* Complex */ ae_matrix* x, - ae_int_t m, - ae_int_t n, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_bool result; - - - ae_assert(n>=0, "APSERVIsFiniteCMatrix: internal error (N<0)", _state); - ae_assert(m>=0, "APSERVIsFiniteCMatrix: internal error (M<0)", _state); - for(i=0; i<=m-1; i++) - { - for(j=0; j<=n-1; j++) - { - if( !ae_isfinite(x->ptr.pp_complex[i][j].x, _state)||!ae_isfinite(x->ptr.pp_complex[i][j].y, _state) ) - { - result = ae_false; - return result; - } - } - } - result = ae_true; - return result; -} - - -/************************************************************************* -This function checks that size of X is at least NxN and all values from -upper/lower triangle of X[0..N-1,0..N-1] are finite - - -- ALGLIB -- - Copyright 18.06.2010 by Bochkanov Sergey -*************************************************************************/ -ae_bool isfinitertrmatrix(/* Real */ ae_matrix* x, - ae_int_t n, - ae_bool isupper, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j1; - ae_int_t j2; - ae_int_t j; - ae_bool result; - - - ae_assert(n>=0, "APSERVIsFiniteRTRMatrix: internal error (N<0)", _state); - if( n==0 ) - { - result = ae_true; - return result; - } - if( x->rowscolsptr.pp_double[i][j], _state) ) - { - result = ae_false; - return result; - } - } - } - result = ae_true; - return result; -} - - -/************************************************************************* -This function checks that all values from upper/lower triangle of -X[0..N-1,0..N-1] are finite - - -- ALGLIB -- - Copyright 18.06.2010 by Bochkanov Sergey -*************************************************************************/ -ae_bool apservisfinitectrmatrix(/* Complex */ ae_matrix* x, - ae_int_t n, - ae_bool isupper, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j1; - ae_int_t j2; - ae_int_t j; - ae_bool result; - - - ae_assert(n>=0, "APSERVIsFiniteCTRMatrix: internal error (N<0)", _state); - for(i=0; i<=n-1; i++) - { - if( isupper ) - { - j1 = i; - j2 = n-1; - } - else - { - j1 = 0; - j2 = i; - } - for(j=j1; j<=j2; j++) - { - if( !ae_isfinite(x->ptr.pp_complex[i][j].x, _state)||!ae_isfinite(x->ptr.pp_complex[i][j].y, _state) ) - { - result = ae_false; - return result; - } - } - } - result = ae_true; - return result; -} - - -/************************************************************************* -This function checks that all values from X[0..M-1,0..N-1] are finite or -NaN's. - - -- ALGLIB -- - Copyright 18.06.2010 by Bochkanov Sergey -*************************************************************************/ -ae_bool apservisfiniteornanmatrix(/* Real */ ae_matrix* x, - ae_int_t m, - ae_int_t n, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_bool result; - - - ae_assert(n>=0, "APSERVIsFiniteOrNaNMatrix: internal error (N<0)", _state); - ae_assert(m>=0, "APSERVIsFiniteOrNaNMatrix: internal error (M<0)", _state); - for(i=0; i<=m-1; i++) - { - for(j=0; j<=n-1; j++) - { - if( !(ae_isfinite(x->ptr.pp_double[i][j], _state)||ae_isnan(x->ptr.pp_double[i][j], _state)) ) - { - result = ae_false; - return result; - } - } - } - result = ae_true; - return result; -} - - -/************************************************************************* -Safe sqrt(x^2+y^2) - - -- ALGLIB -- - Copyright by Bochkanov Sergey -*************************************************************************/ -double safepythag2(double x, double y, ae_state *_state) -{ - double w; - double xabs; - double yabs; - double z; - double result; - - - xabs = ae_fabs(x, _state); - yabs = ae_fabs(y, _state); - w = ae_maxreal(xabs, yabs, _state); - z = ae_minreal(xabs, yabs, _state); - if( ae_fp_eq(z,0) ) - { - result = w; - } - else - { - result = w*ae_sqrt(1+ae_sqr(z/w, _state), _state); - } - return result; -} - - -/************************************************************************* -Safe sqrt(x^2+y^2) - - -- ALGLIB -- - Copyright by Bochkanov Sergey -*************************************************************************/ -double safepythag3(double x, double y, double z, ae_state *_state) -{ - double w; - double result; - - - w = ae_maxreal(ae_fabs(x, _state), ae_maxreal(ae_fabs(y, _state), ae_fabs(z, _state), _state), _state); - if( ae_fp_eq(w,0) ) - { - result = 0; - return result; - } - x = x/w; - y = y/w; - z = z/w; - result = w*ae_sqrt(ae_sqr(x, _state)+ae_sqr(y, _state)+ae_sqr(z, _state), _state); - return result; -} - - -/************************************************************************* -Safe division. - -This function attempts to calculate R=X/Y without overflow. - -It returns: -* +1, if abs(X/Y)>=MaxRealNumber or undefined - overflow-like situation - (no overlfow is generated, R is either NAN, PosINF, NegINF) -* 0, if MinRealNumber0 - (R contains result, may be zero) -* -1, if 00 - */ - if( ae_fp_eq(y,0) ) - { - result = 1; - if( ae_fp_eq(x,0) ) - { - *r = _state->v_nan; - } - if( ae_fp_greater(x,0) ) - { - *r = _state->v_posinf; - } - if( ae_fp_less(x,0) ) - { - *r = _state->v_neginf; - } - return result; - } - if( ae_fp_eq(x,0) ) - { - *r = 0; - result = 0; - return result; - } - - /* - * make Y>0 - */ - if( ae_fp_less(y,0) ) - { - x = -x; - y = -y; - } - - /* - * - */ - if( ae_fp_greater_eq(y,1) ) - { - *r = x/y; - if( ae_fp_less_eq(ae_fabs(*r, _state),ae_minrealnumber) ) - { - result = -1; - *r = 0; - } - else - { - result = 0; - } - } - else - { - if( ae_fp_greater_eq(ae_fabs(x, _state),ae_maxrealnumber*y) ) - { - if( ae_fp_greater(x,0) ) - { - *r = _state->v_posinf; - } - else - { - *r = _state->v_neginf; - } - result = 1; - } - else - { - *r = x/y; - result = 0; - } - } - return result; -} - - -/************************************************************************* -This function calculates "safe" min(X/Y,V) for positive finite X, Y, V. -No overflow is generated in any case. - - -- ALGLIB -- - Copyright by Bochkanov Sergey -*************************************************************************/ -double safeminposrv(double x, double y, double v, ae_state *_state) -{ - double r; - double result; - - - if( ae_fp_greater_eq(y,1) ) - { - - /* - * Y>=1, we can safely divide by Y - */ - r = x/y; - result = v; - if( ae_fp_greater(v,r) ) - { - result = r; - } - else - { - result = v; - } - } - else - { - - /* - * Y<1, we can safely multiply by Y - */ - if( ae_fp_less(x,v*y) ) - { - result = x/y; - } - else - { - result = v; - } - } - return result; -} - - -/************************************************************************* -This function makes periodic mapping of X to [A,B]. - -It accepts X, A, B (A>B). It returns T which lies in [A,B] and integer K, -such that X = T + K*(B-A). - -NOTES: -* K is represented as real value, although actually it is integer -* T is guaranteed to be in [A,B] -* T replaces X - - -- ALGLIB -- - Copyright by Bochkanov Sergey -*************************************************************************/ -void apperiodicmap(double* x, - double a, - double b, - double* k, - ae_state *_state) -{ - - *k = 0; - - ae_assert(ae_fp_less(a,b), "APPeriodicMap: internal error!", _state); - *k = ae_ifloor((*x-a)/(b-a), _state); - *x = *x-*k*(b-a); - while(ae_fp_less(*x,a)) - { - *x = *x+(b-a); - *k = *k-1; - } - while(ae_fp_greater(*x,b)) - { - *x = *x-(b-a); - *k = *k+1; - } - *x = ae_maxreal(*x, a, _state); - *x = ae_minreal(*x, b, _state); -} - - -/************************************************************************* -Returns random normal number using low-quality system-provided generator - - -- ALGLIB -- - Copyright 20.03.2009 by Bochkanov Sergey -*************************************************************************/ -double randomnormal(ae_state *_state) -{ - double u; - double v; - double s; - double result; - - - for(;;) - { - u = 2*ae_randomreal(_state)-1; - v = 2*ae_randomreal(_state)-1; - s = ae_sqr(u, _state)+ae_sqr(v, _state); - if( ae_fp_greater(s,0)&&ae_fp_less(s,1) ) - { - - /* - * two Sqrt's instead of one to - * avoid overflow when S is too small - */ - s = ae_sqrt(-2*ae_log(s, _state), _state)/ae_sqrt(s, _state); - result = u*s; - return result; - } - } - return result; -} - - -/************************************************************************* -Generates random unit vector using low-quality system-provided generator. -Reallocates array if its size is too short. - - -- ALGLIB -- - Copyright 20.03.2009 by Bochkanov Sergey -*************************************************************************/ -void randomunit(ae_int_t n, /* Real */ ae_vector* x, ae_state *_state) -{ - ae_int_t i; - double v; - double vv; - - - ae_assert(n>0, "RandomUnit: N<=0", _state); - if( x->cntptr.p_double[i] = vv; - v = v+vv*vv; - } - } - while(ae_fp_less_eq(v,0)); - v = 1/ae_sqrt(v, _state); - for(i=0; i<=n-1; i++) - { - x->ptr.p_double[i] = x->ptr.p_double[i]*v; - } -} - - -/************************************************************************* -This function is used to increment value of integer variable -*************************************************************************/ -void inc(ae_int_t* v, ae_state *_state) -{ - - - *v = *v+1; -} - - -/************************************************************************* -This function is used to decrement value of integer variable -*************************************************************************/ -void dec(ae_int_t* v, ae_state *_state) -{ - - - *v = *v-1; -} - - -/************************************************************************* -This function performs two operations: -1. decrements value of integer variable, if it is positive -2. explicitly sets variable to zero if it is non-positive -It is used by some algorithms to decrease value of internal counters. -*************************************************************************/ -void countdown(ae_int_t* v, ae_state *_state) -{ - - - if( *v>0 ) - { - *v = *v-1; - } - else - { - *v = 0; - } -} - - -/************************************************************************* -'bounds' value: maps X to [B1,B2] - - -- ALGLIB -- - Copyright 20.03.2009 by Bochkanov Sergey -*************************************************************************/ -double boundval(double x, double b1, double b2, ae_state *_state) -{ - double result; - - - if( ae_fp_less_eq(x,b1) ) - { - result = b1; - return result; - } - if( ae_fp_greater_eq(x,b2) ) - { - result = b2; - return result; - } - result = x; - return result; -} - - -/************************************************************************* -Allocation of serializer: complex value -*************************************************************************/ -void alloccomplex(ae_serializer* s, ae_complex v, ae_state *_state) -{ - - - ae_serializer_alloc_entry(s); - ae_serializer_alloc_entry(s); -} - - -/************************************************************************* -Serialization: complex value -*************************************************************************/ -void serializecomplex(ae_serializer* s, ae_complex v, ae_state *_state) -{ - - - ae_serializer_serialize_double(s, v.x, _state); - ae_serializer_serialize_double(s, v.y, _state); -} - - -/************************************************************************* -Unserialization: complex value -*************************************************************************/ -ae_complex unserializecomplex(ae_serializer* s, ae_state *_state) -{ - ae_complex result; - - - ae_serializer_unserialize_double(s, &result.x, _state); - ae_serializer_unserialize_double(s, &result.y, _state); - return result; -} - - -/************************************************************************* -Allocation of serializer: real array -*************************************************************************/ -void allocrealarray(ae_serializer* s, - /* Real */ ae_vector* v, - ae_int_t n, - ae_state *_state) -{ - ae_int_t i; - - - if( n<0 ) - { - n = v->cnt; - } - ae_serializer_alloc_entry(s); - for(i=0; i<=n-1; i++) - { - ae_serializer_alloc_entry(s); - } -} - - -/************************************************************************* -Serialization: complex value -*************************************************************************/ -void serializerealarray(ae_serializer* s, - /* Real */ ae_vector* v, - ae_int_t n, - ae_state *_state) -{ - ae_int_t i; - - - if( n<0 ) - { - n = v->cnt; - } - ae_serializer_serialize_int(s, n, _state); - for(i=0; i<=n-1; i++) - { - ae_serializer_serialize_double(s, v->ptr.p_double[i], _state); - } -} - - -/************************************************************************* -Unserialization: complex value -*************************************************************************/ -void unserializerealarray(ae_serializer* s, - /* Real */ ae_vector* v, - ae_state *_state) -{ - ae_int_t n; - ae_int_t i; - double t; - - ae_vector_clear(v); - - ae_serializer_unserialize_int(s, &n, _state); - if( n==0 ) - { - return; - } - ae_vector_set_length(v, n, _state); - for(i=0; i<=n-1; i++) - { - ae_serializer_unserialize_double(s, &t, _state); - v->ptr.p_double[i] = t; - } -} - - -/************************************************************************* -Allocation of serializer: Integer array -*************************************************************************/ -void allocintegerarray(ae_serializer* s, - /* Integer */ ae_vector* v, - ae_int_t n, - ae_state *_state) -{ - ae_int_t i; - - - if( n<0 ) - { - n = v->cnt; - } - ae_serializer_alloc_entry(s); - for(i=0; i<=n-1; i++) - { - ae_serializer_alloc_entry(s); - } -} - - -/************************************************************************* -Serialization: Integer array -*************************************************************************/ -void serializeintegerarray(ae_serializer* s, - /* Integer */ ae_vector* v, - ae_int_t n, - ae_state *_state) -{ - ae_int_t i; - - - if( n<0 ) - { - n = v->cnt; - } - ae_serializer_serialize_int(s, n, _state); - for(i=0; i<=n-1; i++) - { - ae_serializer_serialize_int(s, v->ptr.p_int[i], _state); - } -} - - -/************************************************************************* -Unserialization: complex value -*************************************************************************/ -void unserializeintegerarray(ae_serializer* s, - /* Integer */ ae_vector* v, - ae_state *_state) -{ - ae_int_t n; - ae_int_t i; - ae_int_t t; - - ae_vector_clear(v); - - ae_serializer_unserialize_int(s, &n, _state); - if( n==0 ) - { - return; - } - ae_vector_set_length(v, n, _state); - for(i=0; i<=n-1; i++) - { - ae_serializer_unserialize_int(s, &t, _state); - v->ptr.p_int[i] = t; - } -} - - -/************************************************************************* -Allocation of serializer: real matrix -*************************************************************************/ -void allocrealmatrix(ae_serializer* s, - /* Real */ ae_matrix* v, - ae_int_t n0, - ae_int_t n1, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - - - if( n0<0 ) - { - n0 = v->rows; - } - if( n1<0 ) - { - n1 = v->cols; - } - ae_serializer_alloc_entry(s); - ae_serializer_alloc_entry(s); - for(i=0; i<=n0-1; i++) - { - for(j=0; j<=n1-1; j++) - { - ae_serializer_alloc_entry(s); - } - } -} - - -/************************************************************************* -Serialization: complex value -*************************************************************************/ -void serializerealmatrix(ae_serializer* s, - /* Real */ ae_matrix* v, - ae_int_t n0, - ae_int_t n1, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - - - if( n0<0 ) - { - n0 = v->rows; - } - if( n1<0 ) - { - n1 = v->cols; - } - ae_serializer_serialize_int(s, n0, _state); - ae_serializer_serialize_int(s, n1, _state); - for(i=0; i<=n0-1; i++) - { - for(j=0; j<=n1-1; j++) - { - ae_serializer_serialize_double(s, v->ptr.pp_double[i][j], _state); - } - } -} - - -/************************************************************************* -Unserialization: complex value -*************************************************************************/ -void unserializerealmatrix(ae_serializer* s, - /* Real */ ae_matrix* v, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t n0; - ae_int_t n1; - double t; - - ae_matrix_clear(v); - - ae_serializer_unserialize_int(s, &n0, _state); - ae_serializer_unserialize_int(s, &n1, _state); - if( n0==0||n1==0 ) - { - return; - } - ae_matrix_set_length(v, n0, n1, _state); - for(i=0; i<=n0-1; i++) - { - for(j=0; j<=n1-1; j++) - { - ae_serializer_unserialize_double(s, &t, _state); - v->ptr.pp_double[i][j] = t; - } - } -} - - -/************************************************************************* -Copy integer array -*************************************************************************/ -void copyintegerarray(/* Integer */ ae_vector* src, - /* Integer */ ae_vector* dst, - ae_state *_state) -{ - ae_int_t i; - - ae_vector_clear(dst); - - if( src->cnt>0 ) - { - ae_vector_set_length(dst, src->cnt, _state); - for(i=0; i<=src->cnt-1; i++) - { - dst->ptr.p_int[i] = src->ptr.p_int[i]; - } - } -} - - -/************************************************************************* -Copy real array -*************************************************************************/ -void copyrealarray(/* Real */ ae_vector* src, - /* Real */ ae_vector* dst, - ae_state *_state) -{ - ae_int_t i; - - ae_vector_clear(dst); - - if( src->cnt>0 ) - { - ae_vector_set_length(dst, src->cnt, _state); - for(i=0; i<=src->cnt-1; i++) - { - dst->ptr.p_double[i] = src->ptr.p_double[i]; - } - } -} - - -/************************************************************************* -Copy real matrix -*************************************************************************/ -void copyrealmatrix(/* Real */ ae_matrix* src, - /* Real */ ae_matrix* dst, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - - ae_matrix_clear(dst); - - if( src->rows>0&&src->cols>0 ) - { - ae_matrix_set_length(dst, src->rows, src->cols, _state); - for(i=0; i<=src->rows-1; i++) - { - for(j=0; j<=src->cols-1; j++) - { - dst->ptr.pp_double[i][j] = src->ptr.pp_double[i][j]; - } - } - } -} - - -/************************************************************************* -This function searches integer array. Elements in this array are actually -records, each NRec elements wide. Each record has unique header - NHeader -integer values, which identify it. Records are lexicographically sorted by -header. - -Records are identified by their index, not offset (offset = NRec*index). - -This function searches A (records with indices [I0,I1)) for a record with -header B. It returns index of this record (not offset!), or -1 on failure. - - -- ALGLIB -- - Copyright 28.03.2011 by Bochkanov Sergey -*************************************************************************/ -ae_int_t recsearch(/* Integer */ ae_vector* a, - ae_int_t nrec, - ae_int_t nheader, - ae_int_t i0, - ae_int_t i1, - /* Integer */ ae_vector* b, - ae_state *_state) -{ - ae_int_t mididx; - ae_int_t cflag; - ae_int_t k; - ae_int_t offs; - ae_int_t result; - - - result = -1; - for(;;) - { - if( i0>=i1 ) - { - break; - } - mididx = (i0+i1)/2; - offs = nrec*mididx; - cflag = 0; - for(k=0; k<=nheader-1; k++) - { - if( a->ptr.p_int[offs+k]ptr.p_int[k] ) - { - cflag = -1; - break; - } - if( a->ptr.p_int[offs+k]>b->ptr.p_int[k] ) - { - cflag = 1; - break; - } - } - if( cflag==0 ) - { - result = mididx; - return result; - } - if( cflag<0 ) - { - i0 = mididx+1; - } - else - { - i1 = mididx; - } - } - return result; -} - - -/************************************************************************* -This function is used in parallel functions for recurrent division of large -task into two smaller tasks. - -It has following properties: -* it works only for TaskSize>=2 (assertion is thrown otherwise) -* for TaskSize=2, it returns Task0=1, Task1=1 -* in case TaskSize is odd, Task0=TaskSize-1, Task1=1 -* in case TaskSize is even, Task0 and Task1 are approximately TaskSize/2 - and both Task0 and Task1 are even, Task0>=Task1 - - -- ALGLIB -- - Copyright 07.04.2013 by Bochkanov Sergey -*************************************************************************/ -void splitlengtheven(ae_int_t tasksize, - ae_int_t* task0, - ae_int_t* task1, - ae_state *_state) -{ - - *task0 = 0; - *task1 = 0; - - ae_assert(tasksize>=2, "SplitLengthEven: TaskSize<2", _state); - if( tasksize==2 ) - { - *task0 = 1; - *task1 = 1; - return; - } - if( tasksize%2==0 ) - { - - /* - * Even division - */ - *task0 = tasksize/2; - *task1 = tasksize/2; - if( *task0%2!=0 ) - { - *task0 = *task0+1; - *task1 = *task1-1; - } - } - else - { - - /* - * Odd task size, split trailing odd part from it. - */ - *task0 = tasksize-1; - *task1 = 1; - } - ae_assert(*task0>=1, "SplitLengthEven: internal error", _state); - ae_assert(*task1>=1, "SplitLengthEven: internal error", _state); -} - - -/************************************************************************* -This function is used in parallel functions for recurrent division of large -task into two smaller tasks. - -It has following properties: -* it works only for TaskSize>=2 and ChunkSize>=2 - (assertion is thrown otherwise) -* Task0+Task1=TaskSize, Task0>0, Task1>0 -* Task0 and Task1 are close to each other -* in case TaskSize>ChunkSize, Task0 is always divisible by ChunkSize - - -- ALGLIB -- - Copyright 07.04.2013 by Bochkanov Sergey -*************************************************************************/ -void splitlength(ae_int_t tasksize, - ae_int_t chunksize, - ae_int_t* task0, - ae_int_t* task1, - ae_state *_state) -{ - - *task0 = 0; - *task1 = 0; - - ae_assert(chunksize>=2, "SplitLength: ChunkSize<2", _state); - ae_assert(tasksize>=2, "SplitLength: TaskSize<2", _state); - *task0 = tasksize/2; - if( *task0>chunksize&&*task0%chunksize!=0 ) - { - *task0 = *task0-*task0%chunksize; - } - *task1 = tasksize-(*task0); - ae_assert(*task0>=1, "SplitLength: internal error", _state); - ae_assert(*task1>=1, "SplitLength: internal error", _state); -} - - -ae_bool _apbuffers_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - apbuffers *p = (apbuffers*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->ia0, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->ia1, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->ia2, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->ia3, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->ra0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->ra1, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->ra2, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->ra3, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _apbuffers_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - apbuffers *dst = (apbuffers*)_dst; - apbuffers *src = (apbuffers*)_src; - if( !ae_vector_init_copy(&dst->ia0, &src->ia0, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->ia1, &src->ia1, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->ia2, &src->ia2, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->ia3, &src->ia3, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->ra0, &src->ra0, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->ra1, &src->ra1, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->ra2, &src->ra2, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->ra3, &src->ra3, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _apbuffers_clear(void* _p) -{ - apbuffers *p = (apbuffers*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->ia0); - ae_vector_clear(&p->ia1); - ae_vector_clear(&p->ia2); - ae_vector_clear(&p->ia3); - ae_vector_clear(&p->ra0); - ae_vector_clear(&p->ra1); - ae_vector_clear(&p->ra2); - ae_vector_clear(&p->ra3); -} - - -void _apbuffers_destroy(void* _p) -{ - apbuffers *p = (apbuffers*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->ia0); - ae_vector_destroy(&p->ia1); - ae_vector_destroy(&p->ia2); - ae_vector_destroy(&p->ia3); - ae_vector_destroy(&p->ra0); - ae_vector_destroy(&p->ra1); - ae_vector_destroy(&p->ra2); - ae_vector_destroy(&p->ra3); -} - - -ae_bool _sboolean_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - sboolean *p = (sboolean*)_p; - ae_touch_ptr((void*)p); - return ae_true; -} - - -ae_bool _sboolean_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - sboolean *dst = (sboolean*)_dst; - sboolean *src = (sboolean*)_src; - dst->val = src->val; - return ae_true; -} - - -void _sboolean_clear(void* _p) -{ - sboolean *p = (sboolean*)_p; - ae_touch_ptr((void*)p); -} - - -void _sboolean_destroy(void* _p) -{ - sboolean *p = (sboolean*)_p; - ae_touch_ptr((void*)p); -} - - -ae_bool _sbooleanarray_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - sbooleanarray *p = (sbooleanarray*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->val, 0, DT_BOOL, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _sbooleanarray_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - sbooleanarray *dst = (sbooleanarray*)_dst; - sbooleanarray *src = (sbooleanarray*)_src; - if( !ae_vector_init_copy(&dst->val, &src->val, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _sbooleanarray_clear(void* _p) -{ - sbooleanarray *p = (sbooleanarray*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->val); -} - - -void _sbooleanarray_destroy(void* _p) -{ - sbooleanarray *p = (sbooleanarray*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->val); -} - - -ae_bool _sinteger_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - sinteger *p = (sinteger*)_p; - ae_touch_ptr((void*)p); - return ae_true; -} - - -ae_bool _sinteger_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - sinteger *dst = (sinteger*)_dst; - sinteger *src = (sinteger*)_src; - dst->val = src->val; - return ae_true; -} - - -void _sinteger_clear(void* _p) -{ - sinteger *p = (sinteger*)_p; - ae_touch_ptr((void*)p); -} - - -void _sinteger_destroy(void* _p) -{ - sinteger *p = (sinteger*)_p; - ae_touch_ptr((void*)p); -} - - -ae_bool _sintegerarray_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - sintegerarray *p = (sintegerarray*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->val, 0, DT_INT, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _sintegerarray_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - sintegerarray *dst = (sintegerarray*)_dst; - sintegerarray *src = (sintegerarray*)_src; - if( !ae_vector_init_copy(&dst->val, &src->val, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _sintegerarray_clear(void* _p) -{ - sintegerarray *p = (sintegerarray*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->val); -} - - -void _sintegerarray_destroy(void* _p) -{ - sintegerarray *p = (sintegerarray*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->val); -} - - -ae_bool _sreal_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - sreal *p = (sreal*)_p; - ae_touch_ptr((void*)p); - return ae_true; -} - - -ae_bool _sreal_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - sreal *dst = (sreal*)_dst; - sreal *src = (sreal*)_src; - dst->val = src->val; - return ae_true; -} - - -void _sreal_clear(void* _p) -{ - sreal *p = (sreal*)_p; - ae_touch_ptr((void*)p); -} - - -void _sreal_destroy(void* _p) -{ - sreal *p = (sreal*)_p; - ae_touch_ptr((void*)p); -} - - -ae_bool _srealarray_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - srealarray *p = (srealarray*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->val, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _srealarray_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - srealarray *dst = (srealarray*)_dst; - srealarray *src = (srealarray*)_src; - if( !ae_vector_init_copy(&dst->val, &src->val, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _srealarray_clear(void* _p) -{ - srealarray *p = (srealarray*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->val); -} - - -void _srealarray_destroy(void* _p) -{ - srealarray *p = (srealarray*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->val); -} - - -ae_bool _scomplex_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - scomplex *p = (scomplex*)_p; - ae_touch_ptr((void*)p); - return ae_true; -} - - -ae_bool _scomplex_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - scomplex *dst = (scomplex*)_dst; - scomplex *src = (scomplex*)_src; - dst->val = src->val; - return ae_true; -} - - -void _scomplex_clear(void* _p) -{ - scomplex *p = (scomplex*)_p; - ae_touch_ptr((void*)p); -} - - -void _scomplex_destroy(void* _p) -{ - scomplex *p = (scomplex*)_p; - ae_touch_ptr((void*)p); -} - - -ae_bool _scomplexarray_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - scomplexarray *p = (scomplexarray*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->val, 0, DT_COMPLEX, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _scomplexarray_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - scomplexarray *dst = (scomplexarray*)_dst; - scomplexarray *src = (scomplexarray*)_src; - if( !ae_vector_init_copy(&dst->val, &src->val, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _scomplexarray_clear(void* _p) -{ - scomplexarray *p = (scomplexarray*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->val); -} - - -void _scomplexarray_destroy(void* _p) -{ - scomplexarray *p = (scomplexarray*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->val); -} - - - - -ae_int_t getrdfserializationcode(ae_state *_state) -{ - ae_int_t result; - - - result = 1; - return result; -} - - -ae_int_t getkdtreeserializationcode(ae_state *_state) -{ - ae_int_t result; - - - result = 2; - return result; -} - - -ae_int_t getmlpserializationcode(ae_state *_state) -{ - ae_int_t result; - - - result = 3; - return result; -} - - -ae_int_t getmlpeserializationcode(ae_state *_state) -{ - ae_int_t result; - - - result = 4; - return result; -} - - -ae_int_t getrbfserializationcode(ae_state *_state) -{ - ae_int_t result; - - - result = 5; - return result; -} - - - - -/************************************************************************* -This function sorts array of real keys by ascending. - -Its results are: -* sorted array A -* permutation tables P1, P2 - -Algorithm outputs permutation tables using two formats: -* as usual permutation of [0..N-1]. If P1[i]=j, then sorted A[i] contains - value which was moved there from J-th position. -* as a sequence of pairwise permutations. Sorted A[] may be obtained by - swaping A[i] and A[P2[i]] for all i from 0 to N-1. - -INPUT PARAMETERS: - A - unsorted array - N - array size - -OUPUT PARAMETERS: - A - sorted array - P1, P2 - permutation tables, array[N] - -NOTES: - this function assumes that A[] is finite; it doesn't checks that - condition. All other conditions (size of input arrays, etc.) are not - checked too. - - -- ALGLIB -- - Copyright 14.05.2008 by Bochkanov Sergey -*************************************************************************/ -void tagsort(/* Real */ ae_vector* a, - ae_int_t n, - /* Integer */ ae_vector* p1, - /* Integer */ ae_vector* p2, - ae_state *_state) -{ - ae_frame _frame_block; - apbuffers buf; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(p1); - ae_vector_clear(p2); - _apbuffers_init(&buf, _state, ae_true); - - tagsortbuf(a, n, p1, p2, &buf, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Buffered variant of TagSort, which accepts preallocated output arrays as -well as special structure for buffered allocations. If arrays are too -short, they are reallocated. If they are large enough, no memory -allocation is done. - -It is intended to be used in the performance-critical parts of code, where -additional allocations can lead to severe performance degradation - - -- ALGLIB -- - Copyright 14.05.2008 by Bochkanov Sergey -*************************************************************************/ -void tagsortbuf(/* Real */ ae_vector* a, - ae_int_t n, - /* Integer */ ae_vector* p1, - /* Integer */ ae_vector* p2, - apbuffers* buf, - ae_state *_state) -{ - ae_int_t i; - ae_int_t lv; - ae_int_t lp; - ae_int_t rv; - ae_int_t rp; - - - - /* - * Special cases - */ - if( n<=0 ) - { - return; - } - if( n==1 ) - { - ivectorsetlengthatleast(p1, 1, _state); - ivectorsetlengthatleast(p2, 1, _state); - p1->ptr.p_int[0] = 0; - p2->ptr.p_int[0] = 0; - return; - } - - /* - * General case, N>1: prepare permutations table P1 - */ - ivectorsetlengthatleast(p1, n, _state); - for(i=0; i<=n-1; i++) - { - p1->ptr.p_int[i] = i; - } - - /* - * General case, N>1: sort, update P1 - */ - rvectorsetlengthatleast(&buf->ra0, n, _state); - ivectorsetlengthatleast(&buf->ia0, n, _state); - tagsortfasti(a, p1, &buf->ra0, &buf->ia0, n, _state); - - /* - * General case, N>1: fill permutations table P2 - * - * To fill P2 we maintain two arrays: - * * PV (Buf.IA0), Position(Value). PV[i] contains position of I-th key at the moment - * * VP (Buf.IA1), Value(Position). VP[i] contains key which has position I at the moment - * - * At each step we making permutation of two items: - * Left, which is given by position/value pair LP/LV - * and Right, which is given by RP/RV - * and updating PV[] and VP[] correspondingly. - */ - ivectorsetlengthatleast(&buf->ia0, n, _state); - ivectorsetlengthatleast(&buf->ia1, n, _state); - ivectorsetlengthatleast(p2, n, _state); - for(i=0; i<=n-1; i++) - { - buf->ia0.ptr.p_int[i] = i; - buf->ia1.ptr.p_int[i] = i; - } - for(i=0; i<=n-1; i++) - { - - /* - * calculate LP, LV, RP, RV - */ - lp = i; - lv = buf->ia1.ptr.p_int[lp]; - rv = p1->ptr.p_int[i]; - rp = buf->ia0.ptr.p_int[rv]; - - /* - * Fill P2 - */ - p2->ptr.p_int[i] = rp; - - /* - * update PV and VP - */ - buf->ia1.ptr.p_int[lp] = rv; - buf->ia1.ptr.p_int[rp] = lv; - buf->ia0.ptr.p_int[lv] = rp; - buf->ia0.ptr.p_int[rv] = lp; - } -} - - -/************************************************************************* -Same as TagSort, but optimized for real keys and integer labels. - -A is sorted, and same permutations are applied to B. - -NOTES: -1. this function assumes that A[] is finite; it doesn't checks that - condition. All other conditions (size of input arrays, etc.) are not - checked too. -2. this function uses two buffers, BufA and BufB, each is N elements large. - They may be preallocated (which will save some time) or not, in which - case function will automatically allocate memory. - - -- ALGLIB -- - Copyright 11.12.2008 by Bochkanov Sergey -*************************************************************************/ -void tagsortfasti(/* Real */ ae_vector* a, - /* Integer */ ae_vector* b, - /* Real */ ae_vector* bufa, - /* Integer */ ae_vector* bufb, - ae_int_t n, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_bool isascending; - ae_bool isdescending; - double tmpr; - ae_int_t tmpi; - - - - /* - * Special case - */ - if( n<=1 ) - { - return; - } - - /* - * Test for already sorted set - */ - isascending = ae_true; - isdescending = ae_true; - for(i=1; i<=n-1; i++) - { - isascending = isascending&&a->ptr.p_double[i]>=a->ptr.p_double[i-1]; - isdescending = isdescending&&a->ptr.p_double[i]<=a->ptr.p_double[i-1]; - } - if( isascending ) - { - return; - } - if( isdescending ) - { - for(i=0; i<=n-1; i++) - { - j = n-1-i; - if( j<=i ) - { - break; - } - tmpr = a->ptr.p_double[i]; - a->ptr.p_double[i] = a->ptr.p_double[j]; - a->ptr.p_double[j] = tmpr; - tmpi = b->ptr.p_int[i]; - b->ptr.p_int[i] = b->ptr.p_int[j]; - b->ptr.p_int[j] = tmpi; - } - return; - } - - /* - * General case - */ - if( bufa->cntcntptr.p_double[i]>=a->ptr.p_double[i-1]; - isdescending = isdescending&&a->ptr.p_double[i]<=a->ptr.p_double[i-1]; - } - if( isascending ) - { - return; - } - if( isdescending ) - { - for(i=0; i<=n-1; i++) - { - j = n-1-i; - if( j<=i ) - { - break; - } - tmpr = a->ptr.p_double[i]; - a->ptr.p_double[i] = a->ptr.p_double[j]; - a->ptr.p_double[j] = tmpr; - tmpr = b->ptr.p_double[i]; - b->ptr.p_double[i] = b->ptr.p_double[j]; - b->ptr.p_double[j] = tmpr; - } - return; - } - - /* - * General case - */ - if( bufa->cntcntptr.p_double[i]>=a->ptr.p_double[i-1]; - isdescending = isdescending&&a->ptr.p_double[i]<=a->ptr.p_double[i-1]; - } - if( isascending ) - { - return; - } - if( isdescending ) - { - for(i=0; i<=n-1; i++) - { - j = n-1-i; - if( j<=i ) - { - break; - } - tmpr = a->ptr.p_double[i]; - a->ptr.p_double[i] = a->ptr.p_double[j]; - a->ptr.p_double[j] = tmpr; - } - return; - } - - /* - * General case - */ - if( bufa->cnt1: sort, update B - */ - i = 2; - do - { - t = i; - while(t!=1) - { - k = t/2; - if( a->ptr.p_int[offset+k-1]>=a->ptr.p_int[offset+t-1] ) - { - t = 1; - } - else - { - tmp = a->ptr.p_int[offset+k-1]; - a->ptr.p_int[offset+k-1] = a->ptr.p_int[offset+t-1]; - a->ptr.p_int[offset+t-1] = tmp; - tmpr = b->ptr.p_double[offset+k-1]; - b->ptr.p_double[offset+k-1] = b->ptr.p_double[offset+t-1]; - b->ptr.p_double[offset+t-1] = tmpr; - t = k; - } - } - i = i+1; - } - while(i<=n); - i = n-1; - do - { - tmp = a->ptr.p_int[offset+i]; - a->ptr.p_int[offset+i] = a->ptr.p_int[offset+0]; - a->ptr.p_int[offset+0] = tmp; - tmpr = b->ptr.p_double[offset+i]; - b->ptr.p_double[offset+i] = b->ptr.p_double[offset+0]; - b->ptr.p_double[offset+0] = tmpr; - t = 1; - while(t!=0) - { - k = 2*t; - if( k>i ) - { - t = 0; - } - else - { - if( kptr.p_int[offset+k]>a->ptr.p_int[offset+k-1] ) - { - k = k+1; - } - } - if( a->ptr.p_int[offset+t-1]>=a->ptr.p_int[offset+k-1] ) - { - t = 0; - } - else - { - tmp = a->ptr.p_int[offset+k-1]; - a->ptr.p_int[offset+k-1] = a->ptr.p_int[offset+t-1]; - a->ptr.p_int[offset+t-1] = tmp; - tmpr = b->ptr.p_double[offset+k-1]; - b->ptr.p_double[offset+k-1] = b->ptr.p_double[offset+t-1]; - b->ptr.p_double[offset+t-1] = tmpr; - t = k; - } - } - } - i = i-1; - } - while(i>=1); -} - - -/************************************************************************* -Heap operations: adds element to the heap - -PARAMETERS: - A - heap itself, must be at least array[0..N] - B - array of integer tags, which are updated according to - permutations in the heap - N - size of the heap (without new element). - updated on output - VA - value of the element being added - VB - value of the tag - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void tagheappushi(/* Real */ ae_vector* a, - /* Integer */ ae_vector* b, - ae_int_t* n, - double va, - ae_int_t vb, - ae_state *_state) -{ - ae_int_t j; - ae_int_t k; - double v; - - - if( *n<0 ) - { - return; - } - - /* - * N=0 is a special case - */ - if( *n==0 ) - { - a->ptr.p_double[0] = va; - b->ptr.p_int[0] = vb; - *n = *n+1; - return; - } - - /* - * add current point to the heap - * (add to the bottom, then move up) - * - * we don't write point to the heap - * until its final position is determined - * (it allow us to reduce number of array access operations) - */ - j = *n; - *n = *n+1; - while(j>0) - { - k = (j-1)/2; - v = a->ptr.p_double[k]; - if( ae_fp_less(v,va) ) - { - - /* - * swap with higher element - */ - a->ptr.p_double[j] = v; - b->ptr.p_int[j] = b->ptr.p_int[k]; - j = k; - } - else - { - - /* - * element in its place. terminate. - */ - break; - } - } - a->ptr.p_double[j] = va; - b->ptr.p_int[j] = vb; -} - - -/************************************************************************* -Heap operations: replaces top element with new element -(which is moved down) - -PARAMETERS: - A - heap itself, must be at least array[0..N-1] - B - array of integer tags, which are updated according to - permutations in the heap - N - size of the heap - VA - value of the element which replaces top element - VB - value of the tag - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void tagheapreplacetopi(/* Real */ ae_vector* a, - /* Integer */ ae_vector* b, - ae_int_t n, - double va, - ae_int_t vb, - ae_state *_state) -{ - ae_int_t j; - ae_int_t k1; - ae_int_t k2; - double v; - double v1; - double v2; - - - if( n<1 ) - { - return; - } - - /* - * N=1 is a special case - */ - if( n==1 ) - { - a->ptr.p_double[0] = va; - b->ptr.p_int[0] = vb; - return; - } - - /* - * move down through heap: - * * J - current element - * * K1 - first child (always exists) - * * K2 - second child (may not exists) - * - * we don't write point to the heap - * until its final position is determined - * (it allow us to reduce number of array access operations) - */ - j = 0; - k1 = 1; - k2 = 2; - while(k1=n ) - { - - /* - * only one child. - * - * swap and terminate (because this child - * have no siblings due to heap structure) - */ - v = a->ptr.p_double[k1]; - if( ae_fp_greater(v,va) ) - { - a->ptr.p_double[j] = v; - b->ptr.p_int[j] = b->ptr.p_int[k1]; - j = k1; - } - break; - } - else - { - - /* - * two childs - */ - v1 = a->ptr.p_double[k1]; - v2 = a->ptr.p_double[k2]; - if( ae_fp_greater(v1,v2) ) - { - if( ae_fp_less(va,v1) ) - { - a->ptr.p_double[j] = v1; - b->ptr.p_int[j] = b->ptr.p_int[k1]; - j = k1; - } - else - { - break; - } - } - else - { - if( ae_fp_less(va,v2) ) - { - a->ptr.p_double[j] = v2; - b->ptr.p_int[j] = b->ptr.p_int[k2]; - j = k2; - } - else - { - break; - } - } - k1 = 2*j+1; - k2 = 2*j+2; - } - } - a->ptr.p_double[j] = va; - b->ptr.p_int[j] = vb; -} - - -/************************************************************************* -Heap operations: pops top element from the heap - -PARAMETERS: - A - heap itself, must be at least array[0..N-1] - B - array of integer tags, which are updated according to - permutations in the heap - N - size of the heap, N>=1 - -On output top element is moved to A[N-1], B[N-1], heap is reordered, N is -decreased by 1. - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void tagheappopi(/* Real */ ae_vector* a, - /* Integer */ ae_vector* b, - ae_int_t* n, - ae_state *_state) -{ - double va; - ae_int_t vb; - - - if( *n<1 ) - { - return; - } - - /* - * N=1 is a special case - */ - if( *n==1 ) - { - *n = 0; - return; - } - - /* - * swap top element and last element, - * then reorder heap - */ - va = a->ptr.p_double[*n-1]; - vb = b->ptr.p_int[*n-1]; - a->ptr.p_double[*n-1] = a->ptr.p_double[0]; - b->ptr.p_int[*n-1] = b->ptr.p_int[0]; - *n = *n-1; - tagheapreplacetopi(a, b, *n, va, vb, _state); -} - - -/************************************************************************* -Search first element less than T in sorted array. - -PARAMETERS: - A - sorted array by ascending from 0 to N-1 - N - number of elements in array - T - the desired element - -RESULT: - The very first element's index, which isn't less than T. -In the case when there aren't such elements, returns N. -*************************************************************************/ -ae_int_t lowerbound(/* Real */ ae_vector* a, - ae_int_t n, - double t, - ae_state *_state) -{ - ae_int_t l; - ae_int_t half; - ae_int_t first; - ae_int_t middle; - ae_int_t result; - - - l = n; - first = 0; - while(l>0) - { - half = l/2; - middle = first+half; - if( ae_fp_less(a->ptr.p_double[middle],t) ) - { - first = middle+1; - l = l-half-1; - } - else - { - l = half; - } - } - result = first; - return result; -} - - -/************************************************************************* -Search first element more than T in sorted array. - -PARAMETERS: - A - sorted array by ascending from 0 to N-1 - N - number of elements in array - T - the desired element - - RESULT: - The very first element's index, which more than T. -In the case when there aren't such elements, returns N. -*************************************************************************/ -ae_int_t upperbound(/* Real */ ae_vector* a, - ae_int_t n, - double t, - ae_state *_state) -{ - ae_int_t l; - ae_int_t half; - ae_int_t first; - ae_int_t middle; - ae_int_t result; - - - l = n; - first = 0; - while(l>0) - { - half = l/2; - middle = first+half; - if( ae_fp_less(t,a->ptr.p_double[middle]) ) - { - l = half; - } - else - { - first = middle+1; - l = l-half-1; - } - } - result = first; - return result; -} - - -/************************************************************************* -Internal TagSortFastI: sorts A[I1...I2] (both bounds are included), -applies same permutations to B. - - -- ALGLIB -- - Copyright 06.09.2010 by Bochkanov Sergey -*************************************************************************/ -static void tsort_tagsortfastirec(/* Real */ ae_vector* a, - /* Integer */ ae_vector* b, - /* Real */ ae_vector* bufa, - /* Integer */ ae_vector* bufb, - ae_int_t i1, - ae_int_t i2, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t cntless; - ae_int_t cnteq; - ae_int_t cntgreater; - double tmpr; - ae_int_t tmpi; - double v0; - double v1; - double v2; - double vp; - - - - /* - * Fast exit - */ - if( i2<=i1 ) - { - return; - } - - /* - * Non-recursive sort for small arrays - */ - if( i2-i1<=16 ) - { - for(j=i1+1; j<=i2; j++) - { - - /* - * Search elements [I1..J-1] for place to insert Jth element. - * - * This code stops immediately if we can leave A[J] at J-th position - * (all elements have same value of A[J] larger than any of them) - */ - tmpr = a->ptr.p_double[j]; - tmpi = j; - for(k=j-1; k>=i1; k--) - { - if( a->ptr.p_double[k]<=tmpr ) - { - break; - } - tmpi = k; - } - k = tmpi; - - /* - * Insert Jth element into Kth position - */ - if( k!=j ) - { - tmpr = a->ptr.p_double[j]; - tmpi = b->ptr.p_int[j]; - for(i=j-1; i>=k; i--) - { - a->ptr.p_double[i+1] = a->ptr.p_double[i]; - b->ptr.p_int[i+1] = b->ptr.p_int[i]; - } - a->ptr.p_double[k] = tmpr; - b->ptr.p_int[k] = tmpi; - } - } - return; - } - - /* - * Quicksort: choose pivot - * Here we assume that I2-I1>=2 - */ - v0 = a->ptr.p_double[i1]; - v1 = a->ptr.p_double[i1+(i2-i1)/2]; - v2 = a->ptr.p_double[i2]; - if( v0>v1 ) - { - tmpr = v1; - v1 = v0; - v0 = tmpr; - } - if( v1>v2 ) - { - tmpr = v2; - v2 = v1; - v1 = tmpr; - } - if( v0>v1 ) - { - tmpr = v1; - v1 = v0; - v0 = tmpr; - } - vp = v1; - - /* - * now pass through A/B and: - * * move elements that are LESS than VP to the left of A/B - * * move elements that are EQUAL to VP to the right of BufA/BufB (in the reverse order) - * * move elements that are GREATER than VP to the left of BufA/BufB (in the normal order - * * move elements from the tail of BufA/BufB to the middle of A/B (restoring normal order) - * * move elements from the left of BufA/BufB to the end of A/B - */ - cntless = 0; - cnteq = 0; - cntgreater = 0; - for(i=i1; i<=i2; i++) - { - v0 = a->ptr.p_double[i]; - if( v0ptr.p_double[k] = v0; - b->ptr.p_int[k] = b->ptr.p_int[i]; - } - cntless = cntless+1; - continue; - } - if( v0==vp ) - { - - /* - * EQUAL - */ - k = i2-cnteq; - bufa->ptr.p_double[k] = v0; - bufb->ptr.p_int[k] = b->ptr.p_int[i]; - cnteq = cnteq+1; - continue; - } - - /* - * GREATER - */ - k = i1+cntgreater; - bufa->ptr.p_double[k] = v0; - bufb->ptr.p_int[k] = b->ptr.p_int[i]; - cntgreater = cntgreater+1; - } - for(i=0; i<=cnteq-1; i++) - { - j = i1+cntless+cnteq-1-i; - k = i2+i-(cnteq-1); - a->ptr.p_double[j] = bufa->ptr.p_double[k]; - b->ptr.p_int[j] = bufb->ptr.p_int[k]; - } - for(i=0; i<=cntgreater-1; i++) - { - j = i1+cntless+cnteq+i; - k = i1+i; - a->ptr.p_double[j] = bufa->ptr.p_double[k]; - b->ptr.p_int[j] = bufb->ptr.p_int[k]; - } - - /* - * Sort left and right parts of the array (ignoring middle part) - */ - tsort_tagsortfastirec(a, b, bufa, bufb, i1, i1+cntless-1, _state); - tsort_tagsortfastirec(a, b, bufa, bufb, i1+cntless+cnteq, i2, _state); -} - - -/************************************************************************* -Internal TagSortFastR: sorts A[I1...I2] (both bounds are included), -applies same permutations to B. - - -- ALGLIB -- - Copyright 06.09.2010 by Bochkanov Sergey -*************************************************************************/ -static void tsort_tagsortfastrrec(/* Real */ ae_vector* a, - /* Real */ ae_vector* b, - /* Real */ ae_vector* bufa, - /* Real */ ae_vector* bufb, - ae_int_t i1, - ae_int_t i2, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t k; - double tmpr; - double tmpr2; - ae_int_t tmpi; - ae_int_t cntless; - ae_int_t cnteq; - ae_int_t cntgreater; - double v0; - double v1; - double v2; - double vp; - - - - /* - * Fast exit - */ - if( i2<=i1 ) - { - return; - } - - /* - * Non-recursive sort for small arrays - */ - if( i2-i1<=16 ) - { - for(j=i1+1; j<=i2; j++) - { - - /* - * Search elements [I1..J-1] for place to insert Jth element. - * - * This code stops immediately if we can leave A[J] at J-th position - * (all elements have same value of A[J] larger than any of them) - */ - tmpr = a->ptr.p_double[j]; - tmpi = j; - for(k=j-1; k>=i1; k--) - { - if( a->ptr.p_double[k]<=tmpr ) - { - break; - } - tmpi = k; - } - k = tmpi; - - /* - * Insert Jth element into Kth position - */ - if( k!=j ) - { - tmpr = a->ptr.p_double[j]; - tmpr2 = b->ptr.p_double[j]; - for(i=j-1; i>=k; i--) - { - a->ptr.p_double[i+1] = a->ptr.p_double[i]; - b->ptr.p_double[i+1] = b->ptr.p_double[i]; - } - a->ptr.p_double[k] = tmpr; - b->ptr.p_double[k] = tmpr2; - } - } - return; - } - - /* - * Quicksort: choose pivot - * Here we assume that I2-I1>=16 - */ - v0 = a->ptr.p_double[i1]; - v1 = a->ptr.p_double[i1+(i2-i1)/2]; - v2 = a->ptr.p_double[i2]; - if( v0>v1 ) - { - tmpr = v1; - v1 = v0; - v0 = tmpr; - } - if( v1>v2 ) - { - tmpr = v2; - v2 = v1; - v1 = tmpr; - } - if( v0>v1 ) - { - tmpr = v1; - v1 = v0; - v0 = tmpr; - } - vp = v1; - - /* - * now pass through A/B and: - * * move elements that are LESS than VP to the left of A/B - * * move elements that are EQUAL to VP to the right of BufA/BufB (in the reverse order) - * * move elements that are GREATER than VP to the left of BufA/BufB (in the normal order - * * move elements from the tail of BufA/BufB to the middle of A/B (restoring normal order) - * * move elements from the left of BufA/BufB to the end of A/B - */ - cntless = 0; - cnteq = 0; - cntgreater = 0; - for(i=i1; i<=i2; i++) - { - v0 = a->ptr.p_double[i]; - if( v0ptr.p_double[k] = v0; - b->ptr.p_double[k] = b->ptr.p_double[i]; - } - cntless = cntless+1; - continue; - } - if( v0==vp ) - { - - /* - * EQUAL - */ - k = i2-cnteq; - bufa->ptr.p_double[k] = v0; - bufb->ptr.p_double[k] = b->ptr.p_double[i]; - cnteq = cnteq+1; - continue; - } - - /* - * GREATER - */ - k = i1+cntgreater; - bufa->ptr.p_double[k] = v0; - bufb->ptr.p_double[k] = b->ptr.p_double[i]; - cntgreater = cntgreater+1; - } - for(i=0; i<=cnteq-1; i++) - { - j = i1+cntless+cnteq-1-i; - k = i2+i-(cnteq-1); - a->ptr.p_double[j] = bufa->ptr.p_double[k]; - b->ptr.p_double[j] = bufb->ptr.p_double[k]; - } - for(i=0; i<=cntgreater-1; i++) - { - j = i1+cntless+cnteq+i; - k = i1+i; - a->ptr.p_double[j] = bufa->ptr.p_double[k]; - b->ptr.p_double[j] = bufb->ptr.p_double[k]; - } - - /* - * Sort left and right parts of the array (ignoring middle part) - */ - tsort_tagsortfastrrec(a, b, bufa, bufb, i1, i1+cntless-1, _state); - tsort_tagsortfastrrec(a, b, bufa, bufb, i1+cntless+cnteq, i2, _state); -} - - -/************************************************************************* -Internal TagSortFastI: sorts A[I1...I2] (both bounds are included), -applies same permutations to B. - - -- ALGLIB -- - Copyright 06.09.2010 by Bochkanov Sergey -*************************************************************************/ -static void tsort_tagsortfastrec(/* Real */ ae_vector* a, - /* Real */ ae_vector* bufa, - ae_int_t i1, - ae_int_t i2, - ae_state *_state) -{ - ae_int_t cntless; - ae_int_t cnteq; - ae_int_t cntgreater; - ae_int_t i; - ae_int_t j; - ae_int_t k; - double tmpr; - ae_int_t tmpi; - double v0; - double v1; - double v2; - double vp; - - - - /* - * Fast exit - */ - if( i2<=i1 ) - { - return; - } - - /* - * Non-recursive sort for small arrays - */ - if( i2-i1<=16 ) - { - for(j=i1+1; j<=i2; j++) - { - - /* - * Search elements [I1..J-1] for place to insert Jth element. - * - * This code stops immediately if we can leave A[J] at J-th position - * (all elements have same value of A[J] larger than any of them) - */ - tmpr = a->ptr.p_double[j]; - tmpi = j; - for(k=j-1; k>=i1; k--) - { - if( a->ptr.p_double[k]<=tmpr ) - { - break; - } - tmpi = k; - } - k = tmpi; - - /* - * Insert Jth element into Kth position - */ - if( k!=j ) - { - tmpr = a->ptr.p_double[j]; - for(i=j-1; i>=k; i--) - { - a->ptr.p_double[i+1] = a->ptr.p_double[i]; - } - a->ptr.p_double[k] = tmpr; - } - } - return; - } - - /* - * Quicksort: choose pivot - * Here we assume that I2-I1>=16 - */ - v0 = a->ptr.p_double[i1]; - v1 = a->ptr.p_double[i1+(i2-i1)/2]; - v2 = a->ptr.p_double[i2]; - if( v0>v1 ) - { - tmpr = v1; - v1 = v0; - v0 = tmpr; - } - if( v1>v2 ) - { - tmpr = v2; - v2 = v1; - v1 = tmpr; - } - if( v0>v1 ) - { - tmpr = v1; - v1 = v0; - v0 = tmpr; - } - vp = v1; - - /* - * now pass through A/B and: - * * move elements that are LESS than VP to the left of A/B - * * move elements that are EQUAL to VP to the right of BufA/BufB (in the reverse order) - * * move elements that are GREATER than VP to the left of BufA/BufB (in the normal order - * * move elements from the tail of BufA/BufB to the middle of A/B (restoring normal order) - * * move elements from the left of BufA/BufB to the end of A/B - */ - cntless = 0; - cnteq = 0; - cntgreater = 0; - for(i=i1; i<=i2; i++) - { - v0 = a->ptr.p_double[i]; - if( v0ptr.p_double[k] = v0; - } - cntless = cntless+1; - continue; - } - if( v0==vp ) - { - - /* - * EQUAL - */ - k = i2-cnteq; - bufa->ptr.p_double[k] = v0; - cnteq = cnteq+1; - continue; - } - - /* - * GREATER - */ - k = i1+cntgreater; - bufa->ptr.p_double[k] = v0; - cntgreater = cntgreater+1; - } - for(i=0; i<=cnteq-1; i++) - { - j = i1+cntless+cnteq-1-i; - k = i2+i-(cnteq-1); - a->ptr.p_double[j] = bufa->ptr.p_double[k]; - } - for(i=0; i<=cntgreater-1; i++) - { - j = i1+cntless+cnteq+i; - k = i1+i; - a->ptr.p_double[j] = bufa->ptr.p_double[k]; - } - - /* - * Sort left and right parts of the array (ignoring middle part) - */ - tsort_tagsortfastrec(a, bufa, i1, i1+cntless-1, _state); - tsort_tagsortfastrec(a, bufa, i1+cntless+cnteq, i2, _state); -} - - - - -/************************************************************************* -Internal ranking subroutine. - -INPUT PARAMETERS: - X - array to rank - N - array size - IsCentered- whether ranks are centered or not: - * True - ranks are centered in such way that their - sum is zero - * False - ranks are not centered - Buf - temporary buffers - -NOTE: when IsCentered is True and all X[] are equal, this function fills - X by zeros (exact zeros are used, not sum which is only approximately - equal to zero). -*************************************************************************/ -void rankx(/* Real */ ae_vector* x, - ae_int_t n, - ae_bool iscentered, - apbuffers* buf, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t k; - double tmp; - double voffs; - - - - /* - * Prepare - */ - if( n<1 ) - { - return; - } - if( n==1 ) - { - x->ptr.p_double[0] = 0; - return; - } - if( buf->ra1.cntra1, n, _state); - } - if( buf->ia1.cntia1, n, _state); - } - for(i=0; i<=n-1; i++) - { - buf->ra1.ptr.p_double[i] = x->ptr.p_double[i]; - buf->ia1.ptr.p_int[i] = i; - } - tagsortfasti(&buf->ra1, &buf->ia1, &buf->ra2, &buf->ia2, n, _state); - - /* - * Special test for all values being equal - */ - if( ae_fp_eq(buf->ra1.ptr.p_double[0],buf->ra1.ptr.p_double[n-1]) ) - { - if( iscentered ) - { - tmp = 0.0; - } - else - { - tmp = (double)(n-1)/(double)2; - } - for(i=0; i<=n-1; i++) - { - x->ptr.p_double[i] = tmp; - } - return; - } - - /* - * compute tied ranks - */ - i = 0; - while(i<=n-1) - { - j = i+1; - while(j<=n-1) - { - if( ae_fp_neq(buf->ra1.ptr.p_double[j],buf->ra1.ptr.p_double[i]) ) - { - break; - } - j = j+1; - } - for(k=i; k<=j-1; k++) - { - buf->ra1.ptr.p_double[k] = (double)(i+j-1)/(double)2; - } - i = j; - } - - /* - * back to x - */ - if( iscentered ) - { - voffs = (double)(n-1)/(double)2; - } - else - { - voffs = 0.0; - } - for(i=0; i<=n-1; i++) - { - x->ptr.p_double[buf->ia1.ptr.p_int[i]] = buf->ra1.ptr.p_double[i]-voffs; - } -} - - - - -/************************************************************************* -Fast kernel - - -- ALGLIB routine -- - 19.01.2010 - Bochkanov Sergey -*************************************************************************/ -ae_bool cmatrixrank1f(ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - /* Complex */ ae_vector* u, - ae_int_t iu, - /* Complex */ ae_vector* v, - ae_int_t iv, - ae_state *_state) -{ -#ifndef ALGLIB_INTERCEPTS_ABLAS - ae_bool result; - - - result = ae_false; - return result; -#else - return _ialglib_i_cmatrixrank1f(m, n, a, ia, ja, u, iu, v, iv); -#endif -} - - -/************************************************************************* -Fast kernel - - -- ALGLIB routine -- - 19.01.2010 - Bochkanov Sergey -*************************************************************************/ -ae_bool rmatrixrank1f(ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - /* Real */ ae_vector* u, - ae_int_t iu, - /* Real */ ae_vector* v, - ae_int_t iv, - ae_state *_state) -{ -#ifndef ALGLIB_INTERCEPTS_ABLAS - ae_bool result; - - - result = ae_false; - return result; -#else - return _ialglib_i_rmatrixrank1f(m, n, a, ia, ja, u, iu, v, iv); -#endif -} - - -/************************************************************************* -Fast kernel - - -- ALGLIB routine -- - 19.01.2010 - Bochkanov Sergey -*************************************************************************/ -ae_bool cmatrixmvf(ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t opa, - /* Complex */ ae_vector* x, - ae_int_t ix, - /* Complex */ ae_vector* y, - ae_int_t iy, - ae_state *_state) -{ - ae_bool result; - - - result = ae_false; - return result; -} - - -/************************************************************************* -Fast kernel - - -- ALGLIB routine -- - 19.01.2010 - Bochkanov Sergey -*************************************************************************/ -ae_bool rmatrixmvf(ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t opa, - /* Real */ ae_vector* x, - ae_int_t ix, - /* Real */ ae_vector* y, - ae_int_t iy, - ae_state *_state) -{ - ae_bool result; - - - result = ae_false; - return result; -} - - -/************************************************************************* -Fast kernel - - -- ALGLIB routine -- - 19.01.2010 - Bochkanov Sergey -*************************************************************************/ -ae_bool cmatrixrighttrsmf(ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Complex */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, - ae_state *_state) -{ -#ifndef ALGLIB_INTERCEPTS_ABLAS - ae_bool result; - - - result = ae_false; - return result; -#else - return _ialglib_i_cmatrixrighttrsmf(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2); -#endif -} - - -/************************************************************************* -Fast kernel - - -- ALGLIB routine -- - 19.01.2010 - Bochkanov Sergey -*************************************************************************/ -ae_bool cmatrixlefttrsmf(ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Complex */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, - ae_state *_state) -{ -#ifndef ALGLIB_INTERCEPTS_ABLAS - ae_bool result; - - - result = ae_false; - return result; -#else - return _ialglib_i_cmatrixlefttrsmf(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2); -#endif -} - - -/************************************************************************* -Fast kernel - - -- ALGLIB routine -- - 19.01.2010 - Bochkanov Sergey -*************************************************************************/ -ae_bool rmatrixrighttrsmf(ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Real */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, - ae_state *_state) -{ -#ifndef ALGLIB_INTERCEPTS_ABLAS - ae_bool result; - - - result = ae_false; - return result; -#else - return _ialglib_i_rmatrixrighttrsmf(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2); -#endif -} - - -/************************************************************************* -Fast kernel - - -- ALGLIB routine -- - 19.01.2010 - Bochkanov Sergey -*************************************************************************/ -ae_bool rmatrixlefttrsmf(ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Real */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, - ae_state *_state) -{ -#ifndef ALGLIB_INTERCEPTS_ABLAS - ae_bool result; - - - result = ae_false; - return result; -#else - return _ialglib_i_rmatrixlefttrsmf(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2); -#endif -} - - -/************************************************************************* -Fast kernel - - -- ALGLIB routine -- - 19.01.2010 - Bochkanov Sergey -*************************************************************************/ -ae_bool cmatrixsyrkf(ae_int_t n, - ae_int_t k, - double alpha, - /* Complex */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - double beta, - /* Complex */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_bool isupper, - ae_state *_state) -{ -#ifndef ALGLIB_INTERCEPTS_ABLAS - ae_bool result; - - - result = ae_false; - return result; -#else - return _ialglib_i_cmatrixsyrkf(n, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper); -#endif -} - - -/************************************************************************* -Fast kernel - - -- ALGLIB routine -- - 19.01.2010 - Bochkanov Sergey -*************************************************************************/ -ae_bool rmatrixsyrkf(ae_int_t n, - ae_int_t k, - double alpha, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - double beta, - /* Real */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_bool isupper, - ae_state *_state) -{ -#ifndef ALGLIB_INTERCEPTS_ABLAS - ae_bool result; - - - result = ae_false; - return result; -#else - return _ialglib_i_rmatrixsyrkf(n, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper); -#endif -} - - -/************************************************************************* -Fast kernel - - -- ALGLIB routine -- - 19.01.2010 - Bochkanov Sergey -*************************************************************************/ -ae_bool rmatrixgemmf(ae_int_t m, - ae_int_t n, - ae_int_t k, - double alpha, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - /* Real */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - ae_int_t optypeb, - double beta, - /* Real */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_state *_state) -{ -#ifndef ALGLIB_INTERCEPTS_ABLAS - ae_bool result; - - - result = ae_false; - return result; -#else - return _ialglib_i_rmatrixgemmf(m, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc); -#endif -} - - -/************************************************************************* -Fast kernel - - -- ALGLIB routine -- - 19.01.2010 - Bochkanov Sergey -*************************************************************************/ -ae_bool cmatrixgemmf(ae_int_t m, - ae_int_t n, - ae_int_t k, - ae_complex alpha, - /* Complex */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - /* Complex */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - ae_int_t optypeb, - ae_complex beta, - /* Complex */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_state *_state) -{ -#ifndef ALGLIB_INTERCEPTS_ABLAS - ae_bool result; - - - result = ae_false; - return result; -#else - return _ialglib_i_cmatrixgemmf(m, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc); -#endif -} - - -/************************************************************************* -CMatrixGEMM kernel, basecase code for CMatrixGEMM. - -This subroutine calculates C = alpha*op1(A)*op2(B) +beta*C where: -* C is MxN general matrix -* op1(A) is MxK matrix -* op2(B) is KxN matrix -* "op" may be identity transformation, transposition, conjugate transposition - -Additional info: -* multiplication result replaces C. If Beta=0, C elements are not used in - calculations (not multiplied by zero - just not referenced) -* if Alpha=0, A is not used (not multiplied by zero - just not referenced) -* if both Beta and Alpha are zero, C is filled by zeros. - -IMPORTANT: - -This function does NOT preallocate output matrix C, it MUST be preallocated -by caller prior to calling this function. In case C does not have enough -space to store result, exception will be generated. - -INPUT PARAMETERS - M - matrix size, M>0 - N - matrix size, N>0 - K - matrix size, K>0 - Alpha - coefficient - A - matrix - IA - submatrix offset - JA - submatrix offset - OpTypeA - transformation type: - * 0 - no transformation - * 1 - transposition - * 2 - conjugate transposition - B - matrix - IB - submatrix offset - JB - submatrix offset - OpTypeB - transformation type: - * 0 - no transformation - * 1 - transposition - * 2 - conjugate transposition - Beta - coefficient - C - PREALLOCATED output matrix - IC - submatrix offset - JC - submatrix offset - - -- ALGLIB routine -- - 27.03.2013 - Bochkanov Sergey -*************************************************************************/ -void cmatrixgemmk(ae_int_t m, - ae_int_t n, - ae_int_t k, - ae_complex alpha, - /* Complex */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - /* Complex */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - ae_int_t optypeb, - ae_complex beta, - /* Complex */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_complex v; - ae_complex v00; - ae_complex v01; - ae_complex v10; - ae_complex v11; - double v00x; - double v00y; - double v01x; - double v01y; - double v10x; - double v10y; - double v11x; - double v11y; - double a0x; - double a0y; - double a1x; - double a1y; - double b0x; - double b0y; - double b1x; - double b1y; - ae_int_t idxa0; - ae_int_t idxa1; - ae_int_t idxb0; - ae_int_t idxb1; - ae_int_t i0; - ae_int_t i1; - ae_int_t ik; - ae_int_t j0; - ae_int_t j1; - ae_int_t jk; - ae_int_t t; - ae_int_t offsa; - ae_int_t offsb; - - - - /* - * if matrix size is zero - */ - if( m==0||n==0 ) - { - return; - } - - /* - * Try optimized code - */ - if( cmatrixgemmf(m, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state) ) - { - return; - } - - /* - * if K=0, then C=Beta*C - */ - if( k==0 ) - { - if( ae_c_neq_d(beta,1) ) - { - if( ae_c_neq_d(beta,0) ) - { - for(i=0; i<=m-1; i++) - { - for(j=0; j<=n-1; j++) - { - c->ptr.pp_complex[ic+i][jc+j] = ae_c_mul(beta,c->ptr.pp_complex[ic+i][jc+j]); - } - } - } - else - { - for(i=0; i<=m-1; i++) - { - for(j=0; j<=n-1; j++) - { - c->ptr.pp_complex[ic+i][jc+j] = ae_complex_from_d(0); - } - } - } - } - return; - } - - /* - * This phase is not really necessary, but compiler complains - * about "possibly uninitialized variables" - */ - a0x = 0; - a0y = 0; - a1x = 0; - a1y = 0; - b0x = 0; - b0y = 0; - b1x = 0; - b1y = 0; - - /* - * General case - */ - i = 0; - while(iptr.pp_complex[idxa0][offsa].x; - a0y = a->ptr.pp_complex[idxa0][offsa].y; - a1x = a->ptr.pp_complex[idxa1][offsa].x; - a1y = a->ptr.pp_complex[idxa1][offsa].y; - } - if( optypea==1 ) - { - a0x = a->ptr.pp_complex[offsa][idxa0].x; - a0y = a->ptr.pp_complex[offsa][idxa0].y; - a1x = a->ptr.pp_complex[offsa][idxa1].x; - a1y = a->ptr.pp_complex[offsa][idxa1].y; - } - if( optypea==2 ) - { - a0x = a->ptr.pp_complex[offsa][idxa0].x; - a0y = -a->ptr.pp_complex[offsa][idxa0].y; - a1x = a->ptr.pp_complex[offsa][idxa1].x; - a1y = -a->ptr.pp_complex[offsa][idxa1].y; - } - if( optypeb==0 ) - { - b0x = b->ptr.pp_complex[offsb][idxb0].x; - b0y = b->ptr.pp_complex[offsb][idxb0].y; - b1x = b->ptr.pp_complex[offsb][idxb1].x; - b1y = b->ptr.pp_complex[offsb][idxb1].y; - } - if( optypeb==1 ) - { - b0x = b->ptr.pp_complex[idxb0][offsb].x; - b0y = b->ptr.pp_complex[idxb0][offsb].y; - b1x = b->ptr.pp_complex[idxb1][offsb].x; - b1y = b->ptr.pp_complex[idxb1][offsb].y; - } - if( optypeb==2 ) - { - b0x = b->ptr.pp_complex[idxb0][offsb].x; - b0y = -b->ptr.pp_complex[idxb0][offsb].y; - b1x = b->ptr.pp_complex[idxb1][offsb].x; - b1y = -b->ptr.pp_complex[idxb1][offsb].y; - } - v00x = v00x+a0x*b0x-a0y*b0y; - v00y = v00y+a0x*b0y+a0y*b0x; - v01x = v01x+a0x*b1x-a0y*b1y; - v01y = v01y+a0x*b1y+a0y*b1x; - v10x = v10x+a1x*b0x-a1y*b0y; - v10y = v10y+a1x*b0y+a1y*b0x; - v11x = v11x+a1x*b1x-a1y*b1y; - v11y = v11y+a1x*b1y+a1y*b1x; - offsa = offsa+1; - offsb = offsb+1; - } - v00.x = v00x; - v00.y = v00y; - v10.x = v10x; - v10.y = v10y; - v01.x = v01x; - v01.y = v01y; - v11.x = v11x; - v11.y = v11y; - if( ae_c_eq_d(beta,0) ) - { - c->ptr.pp_complex[ic+i+0][jc+j+0] = ae_c_mul(alpha,v00); - c->ptr.pp_complex[ic+i+0][jc+j+1] = ae_c_mul(alpha,v01); - c->ptr.pp_complex[ic+i+1][jc+j+0] = ae_c_mul(alpha,v10); - c->ptr.pp_complex[ic+i+1][jc+j+1] = ae_c_mul(alpha,v11); - } - else - { - c->ptr.pp_complex[ic+i+0][jc+j+0] = ae_c_add(ae_c_mul(beta,c->ptr.pp_complex[ic+i+0][jc+j+0]),ae_c_mul(alpha,v00)); - c->ptr.pp_complex[ic+i+0][jc+j+1] = ae_c_add(ae_c_mul(beta,c->ptr.pp_complex[ic+i+0][jc+j+1]),ae_c_mul(alpha,v01)); - c->ptr.pp_complex[ic+i+1][jc+j+0] = ae_c_add(ae_c_mul(beta,c->ptr.pp_complex[ic+i+1][jc+j+0]),ae_c_mul(alpha,v10)); - c->ptr.pp_complex[ic+i+1][jc+j+1] = ae_c_add(ae_c_mul(beta,c->ptr.pp_complex[ic+i+1][jc+j+1]),ae_c_mul(alpha,v11)); - } - } - else - { - - /* - * Determine submatrix [I0..I1]x[J0..J1] to process - */ - i0 = i; - i1 = ae_minint(i+1, m-1, _state); - j0 = j; - j1 = ae_minint(j+1, n-1, _state); - - /* - * Process submatrix - */ - for(ik=i0; ik<=i1; ik++) - { - for(jk=j0; jk<=j1; jk++) - { - if( k==0||ae_c_eq_d(alpha,0) ) - { - v = ae_complex_from_d(0); - } - else - { - v = ae_complex_from_d(0.0); - if( optypea==0&&optypeb==0 ) - { - v = ae_v_cdotproduct(&a->ptr.pp_complex[ia+ik][ja], 1, "N", &b->ptr.pp_complex[ib][jb+jk], b->stride, "N", ae_v_len(ja,ja+k-1)); - } - if( optypea==0&&optypeb==1 ) - { - v = ae_v_cdotproduct(&a->ptr.pp_complex[ia+ik][ja], 1, "N", &b->ptr.pp_complex[ib+jk][jb], 1, "N", ae_v_len(ja,ja+k-1)); - } - if( optypea==0&&optypeb==2 ) - { - v = ae_v_cdotproduct(&a->ptr.pp_complex[ia+ik][ja], 1, "N", &b->ptr.pp_complex[ib+jk][jb], 1, "Conj", ae_v_len(ja,ja+k-1)); - } - if( optypea==1&&optypeb==0 ) - { - v = ae_v_cdotproduct(&a->ptr.pp_complex[ia][ja+ik], a->stride, "N", &b->ptr.pp_complex[ib][jb+jk], b->stride, "N", ae_v_len(ia,ia+k-1)); - } - if( optypea==1&&optypeb==1 ) - { - v = ae_v_cdotproduct(&a->ptr.pp_complex[ia][ja+ik], a->stride, "N", &b->ptr.pp_complex[ib+jk][jb], 1, "N", ae_v_len(ia,ia+k-1)); - } - if( optypea==1&&optypeb==2 ) - { - v = ae_v_cdotproduct(&a->ptr.pp_complex[ia][ja+ik], a->stride, "N", &b->ptr.pp_complex[ib+jk][jb], 1, "Conj", ae_v_len(ia,ia+k-1)); - } - if( optypea==2&&optypeb==0 ) - { - v = ae_v_cdotproduct(&a->ptr.pp_complex[ia][ja+ik], a->stride, "Conj", &b->ptr.pp_complex[ib][jb+jk], b->stride, "N", ae_v_len(ia,ia+k-1)); - } - if( optypea==2&&optypeb==1 ) - { - v = ae_v_cdotproduct(&a->ptr.pp_complex[ia][ja+ik], a->stride, "Conj", &b->ptr.pp_complex[ib+jk][jb], 1, "N", ae_v_len(ia,ia+k-1)); - } - if( optypea==2&&optypeb==2 ) - { - v = ae_v_cdotproduct(&a->ptr.pp_complex[ia][ja+ik], a->stride, "Conj", &b->ptr.pp_complex[ib+jk][jb], 1, "Conj", ae_v_len(ia,ia+k-1)); - } - } - if( ae_c_eq_d(beta,0) ) - { - c->ptr.pp_complex[ic+ik][jc+jk] = ae_c_mul(alpha,v); - } - else - { - c->ptr.pp_complex[ic+ik][jc+jk] = ae_c_add(ae_c_mul(beta,c->ptr.pp_complex[ic+ik][jc+jk]),ae_c_mul(alpha,v)); - } - } - } - } - j = j+2; - } - i = i+2; - } -} - - -/************************************************************************* -RMatrixGEMM kernel, basecase code for RMatrixGEMM. - -This subroutine calculates C = alpha*op1(A)*op2(B) +beta*C where: -* C is MxN general matrix -* op1(A) is MxK matrix -* op2(B) is KxN matrix -* "op" may be identity transformation, transposition - -Additional info: -* multiplication result replaces C. If Beta=0, C elements are not used in - calculations (not multiplied by zero - just not referenced) -* if Alpha=0, A is not used (not multiplied by zero - just not referenced) -* if both Beta and Alpha are zero, C is filled by zeros. - -IMPORTANT: - -This function does NOT preallocate output matrix C, it MUST be preallocated -by caller prior to calling this function. In case C does not have enough -space to store result, exception will be generated. - -INPUT PARAMETERS - M - matrix size, M>0 - N - matrix size, N>0 - K - matrix size, K>0 - Alpha - coefficient - A - matrix - IA - submatrix offset - JA - submatrix offset - OpTypeA - transformation type: - * 0 - no transformation - * 1 - transposition - B - matrix - IB - submatrix offset - JB - submatrix offset - OpTypeB - transformation type: - * 0 - no transformation - * 1 - transposition - Beta - coefficient - C - PREALLOCATED output matrix - IC - submatrix offset - JC - submatrix offset - - -- ALGLIB routine -- - 27.03.2013 - Bochkanov Sergey -*************************************************************************/ -void rmatrixgemmk(ae_int_t m, - ae_int_t n, - ae_int_t k, - double alpha, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - /* Real */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - ae_int_t optypeb, - double beta, - /* Real */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - - - - /* - * if matrix size is zero - */ - if( m==0||n==0 ) - { - return; - } - - /* - * Try optimized code - */ - if( rmatrixgemmf(m, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state) ) - { - return; - } - - /* - * if K=0, then C=Beta*C - */ - if( k==0||ae_fp_eq(alpha,0) ) - { - if( ae_fp_neq(beta,1) ) - { - if( ae_fp_neq(beta,0) ) - { - for(i=0; i<=m-1; i++) - { - for(j=0; j<=n-1; j++) - { - c->ptr.pp_double[ic+i][jc+j] = beta*c->ptr.pp_double[ic+i][jc+j]; - } - } - } - else - { - for(i=0; i<=m-1; i++) - { - for(j=0; j<=n-1; j++) - { - c->ptr.pp_double[ic+i][jc+j] = 0; - } - } - } - } - return; - } - - /* - * Call specialized code. - * - * NOTE: specialized code was moved to separate function because of strange - * issues with instructions cache on some systems; Having too long - * functions significantly slows down internal loop of the algorithm. - */ - if( optypea==0&&optypeb==0 ) - { - rmatrixgemmk44v00(m, n, k, alpha, a, ia, ja, b, ib, jb, beta, c, ic, jc, _state); - } - if( optypea==0&&optypeb!=0 ) - { - rmatrixgemmk44v01(m, n, k, alpha, a, ia, ja, b, ib, jb, beta, c, ic, jc, _state); - } - if( optypea!=0&&optypeb==0 ) - { - rmatrixgemmk44v10(m, n, k, alpha, a, ia, ja, b, ib, jb, beta, c, ic, jc, _state); - } - if( optypea!=0&&optypeb!=0 ) - { - rmatrixgemmk44v11(m, n, k, alpha, a, ia, ja, b, ib, jb, beta, c, ic, jc, _state); - } -} - - -/************************************************************************* -RMatrixGEMM kernel, basecase code for RMatrixGEMM, specialized for sitation -with OpTypeA=0 and OpTypeB=0. - -Additional info: -* this function requires that Alpha<>0 (assertion is thrown otherwise) - -INPUT PARAMETERS - M - matrix size, M>0 - N - matrix size, N>0 - K - matrix size, K>0 - Alpha - coefficient - A - matrix - IA - submatrix offset - JA - submatrix offset - B - matrix - IB - submatrix offset - JB - submatrix offset - Beta - coefficient - C - PREALLOCATED output matrix - IC - submatrix offset - JC - submatrix offset - - -- ALGLIB routine -- - 27.03.2013 - Bochkanov Sergey -*************************************************************************/ -void rmatrixgemmk44v00(ae_int_t m, - ae_int_t n, - ae_int_t k, - double alpha, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - /* Real */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - double beta, - /* Real */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - double v; - double v00; - double v01; - double v02; - double v03; - double v10; - double v11; - double v12; - double v13; - double v20; - double v21; - double v22; - double v23; - double v30; - double v31; - double v32; - double v33; - double a0; - double a1; - double a2; - double a3; - double b0; - double b1; - double b2; - double b3; - ae_int_t idxa0; - ae_int_t idxa1; - ae_int_t idxa2; - ae_int_t idxa3; - ae_int_t idxb0; - ae_int_t idxb1; - ae_int_t idxb2; - ae_int_t idxb3; - ae_int_t i0; - ae_int_t i1; - ae_int_t ik; - ae_int_t j0; - ae_int_t j1; - ae_int_t jk; - ae_int_t t; - ae_int_t offsa; - ae_int_t offsb; - - - ae_assert(ae_fp_neq(alpha,0), "RMatrixGEMMK44V00: internal error (Alpha=0)", _state); - - /* - * if matrix size is zero - */ - if( m==0||n==0 ) - { - return; - } - - /* - * A*B - */ - i = 0; - while(iptr.pp_double[idxa0][offsa]; - a1 = a->ptr.pp_double[idxa1][offsa]; - b0 = b->ptr.pp_double[offsb][idxb0]; - b1 = b->ptr.pp_double[offsb][idxb1]; - v00 = v00+a0*b0; - v01 = v01+a0*b1; - v10 = v10+a1*b0; - v11 = v11+a1*b1; - a2 = a->ptr.pp_double[idxa2][offsa]; - a3 = a->ptr.pp_double[idxa3][offsa]; - v20 = v20+a2*b0; - v21 = v21+a2*b1; - v30 = v30+a3*b0; - v31 = v31+a3*b1; - b2 = b->ptr.pp_double[offsb][idxb2]; - b3 = b->ptr.pp_double[offsb][idxb3]; - v22 = v22+a2*b2; - v23 = v23+a2*b3; - v32 = v32+a3*b2; - v33 = v33+a3*b3; - v02 = v02+a0*b2; - v03 = v03+a0*b3; - v12 = v12+a1*b2; - v13 = v13+a1*b3; - offsa = offsa+1; - offsb = offsb+1; - } - if( ae_fp_eq(beta,0) ) - { - c->ptr.pp_double[ic+i+0][jc+j+0] = alpha*v00; - c->ptr.pp_double[ic+i+0][jc+j+1] = alpha*v01; - c->ptr.pp_double[ic+i+0][jc+j+2] = alpha*v02; - c->ptr.pp_double[ic+i+0][jc+j+3] = alpha*v03; - c->ptr.pp_double[ic+i+1][jc+j+0] = alpha*v10; - c->ptr.pp_double[ic+i+1][jc+j+1] = alpha*v11; - c->ptr.pp_double[ic+i+1][jc+j+2] = alpha*v12; - c->ptr.pp_double[ic+i+1][jc+j+3] = alpha*v13; - c->ptr.pp_double[ic+i+2][jc+j+0] = alpha*v20; - c->ptr.pp_double[ic+i+2][jc+j+1] = alpha*v21; - c->ptr.pp_double[ic+i+2][jc+j+2] = alpha*v22; - c->ptr.pp_double[ic+i+2][jc+j+3] = alpha*v23; - c->ptr.pp_double[ic+i+3][jc+j+0] = alpha*v30; - c->ptr.pp_double[ic+i+3][jc+j+1] = alpha*v31; - c->ptr.pp_double[ic+i+3][jc+j+2] = alpha*v32; - c->ptr.pp_double[ic+i+3][jc+j+3] = alpha*v33; - } - else - { - c->ptr.pp_double[ic+i+0][jc+j+0] = beta*c->ptr.pp_double[ic+i+0][jc+j+0]+alpha*v00; - c->ptr.pp_double[ic+i+0][jc+j+1] = beta*c->ptr.pp_double[ic+i+0][jc+j+1]+alpha*v01; - c->ptr.pp_double[ic+i+0][jc+j+2] = beta*c->ptr.pp_double[ic+i+0][jc+j+2]+alpha*v02; - c->ptr.pp_double[ic+i+0][jc+j+3] = beta*c->ptr.pp_double[ic+i+0][jc+j+3]+alpha*v03; - c->ptr.pp_double[ic+i+1][jc+j+0] = beta*c->ptr.pp_double[ic+i+1][jc+j+0]+alpha*v10; - c->ptr.pp_double[ic+i+1][jc+j+1] = beta*c->ptr.pp_double[ic+i+1][jc+j+1]+alpha*v11; - c->ptr.pp_double[ic+i+1][jc+j+2] = beta*c->ptr.pp_double[ic+i+1][jc+j+2]+alpha*v12; - c->ptr.pp_double[ic+i+1][jc+j+3] = beta*c->ptr.pp_double[ic+i+1][jc+j+3]+alpha*v13; - c->ptr.pp_double[ic+i+2][jc+j+0] = beta*c->ptr.pp_double[ic+i+2][jc+j+0]+alpha*v20; - c->ptr.pp_double[ic+i+2][jc+j+1] = beta*c->ptr.pp_double[ic+i+2][jc+j+1]+alpha*v21; - c->ptr.pp_double[ic+i+2][jc+j+2] = beta*c->ptr.pp_double[ic+i+2][jc+j+2]+alpha*v22; - c->ptr.pp_double[ic+i+2][jc+j+3] = beta*c->ptr.pp_double[ic+i+2][jc+j+3]+alpha*v23; - c->ptr.pp_double[ic+i+3][jc+j+0] = beta*c->ptr.pp_double[ic+i+3][jc+j+0]+alpha*v30; - c->ptr.pp_double[ic+i+3][jc+j+1] = beta*c->ptr.pp_double[ic+i+3][jc+j+1]+alpha*v31; - c->ptr.pp_double[ic+i+3][jc+j+2] = beta*c->ptr.pp_double[ic+i+3][jc+j+2]+alpha*v32; - c->ptr.pp_double[ic+i+3][jc+j+3] = beta*c->ptr.pp_double[ic+i+3][jc+j+3]+alpha*v33; - } - } - else - { - - /* - * Determine submatrix [I0..I1]x[J0..J1] to process - */ - i0 = i; - i1 = ae_minint(i+3, m-1, _state); - j0 = j; - j1 = ae_minint(j+3, n-1, _state); - - /* - * Process submatrix - */ - for(ik=i0; ik<=i1; ik++) - { - for(jk=j0; jk<=j1; jk++) - { - if( k==0||ae_fp_eq(alpha,0) ) - { - v = 0; - } - else - { - v = ae_v_dotproduct(&a->ptr.pp_double[ia+ik][ja], 1, &b->ptr.pp_double[ib][jb+jk], b->stride, ae_v_len(ja,ja+k-1)); - } - if( ae_fp_eq(beta,0) ) - { - c->ptr.pp_double[ic+ik][jc+jk] = alpha*v; - } - else - { - c->ptr.pp_double[ic+ik][jc+jk] = beta*c->ptr.pp_double[ic+ik][jc+jk]+alpha*v; - } - } - } - } - j = j+4; - } - i = i+4; - } -} - - -/************************************************************************* -RMatrixGEMM kernel, basecase code for RMatrixGEMM, specialized for sitation -with OpTypeA=0 and OpTypeB=1. - -Additional info: -* this function requires that Alpha<>0 (assertion is thrown otherwise) - -INPUT PARAMETERS - M - matrix size, M>0 - N - matrix size, N>0 - K - matrix size, K>0 - Alpha - coefficient - A - matrix - IA - submatrix offset - JA - submatrix offset - B - matrix - IB - submatrix offset - JB - submatrix offset - Beta - coefficient - C - PREALLOCATED output matrix - IC - submatrix offset - JC - submatrix offset - - -- ALGLIB routine -- - 27.03.2013 - Bochkanov Sergey -*************************************************************************/ -void rmatrixgemmk44v01(ae_int_t m, - ae_int_t n, - ae_int_t k, - double alpha, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - /* Real */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - double beta, - /* Real */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - double v; - double v00; - double v01; - double v02; - double v03; - double v10; - double v11; - double v12; - double v13; - double v20; - double v21; - double v22; - double v23; - double v30; - double v31; - double v32; - double v33; - double a0; - double a1; - double a2; - double a3; - double b0; - double b1; - double b2; - double b3; - ae_int_t idxa0; - ae_int_t idxa1; - ae_int_t idxa2; - ae_int_t idxa3; - ae_int_t idxb0; - ae_int_t idxb1; - ae_int_t idxb2; - ae_int_t idxb3; - ae_int_t i0; - ae_int_t i1; - ae_int_t ik; - ae_int_t j0; - ae_int_t j1; - ae_int_t jk; - ae_int_t t; - ae_int_t offsa; - ae_int_t offsb; - - - ae_assert(ae_fp_neq(alpha,0), "RMatrixGEMMK44V00: internal error (Alpha=0)", _state); - - /* - * if matrix size is zero - */ - if( m==0||n==0 ) - { - return; - } - - /* - * A*B' - */ - i = 0; - while(iptr.pp_double[idxa0][offsa]; - a1 = a->ptr.pp_double[idxa1][offsa]; - b0 = b->ptr.pp_double[idxb0][offsb]; - b1 = b->ptr.pp_double[idxb1][offsb]; - v00 = v00+a0*b0; - v01 = v01+a0*b1; - v10 = v10+a1*b0; - v11 = v11+a1*b1; - a2 = a->ptr.pp_double[idxa2][offsa]; - a3 = a->ptr.pp_double[idxa3][offsa]; - v20 = v20+a2*b0; - v21 = v21+a2*b1; - v30 = v30+a3*b0; - v31 = v31+a3*b1; - b2 = b->ptr.pp_double[idxb2][offsb]; - b3 = b->ptr.pp_double[idxb3][offsb]; - v22 = v22+a2*b2; - v23 = v23+a2*b3; - v32 = v32+a3*b2; - v33 = v33+a3*b3; - v02 = v02+a0*b2; - v03 = v03+a0*b3; - v12 = v12+a1*b2; - v13 = v13+a1*b3; - offsa = offsa+1; - offsb = offsb+1; - } - if( ae_fp_eq(beta,0) ) - { - c->ptr.pp_double[ic+i+0][jc+j+0] = alpha*v00; - c->ptr.pp_double[ic+i+0][jc+j+1] = alpha*v01; - c->ptr.pp_double[ic+i+0][jc+j+2] = alpha*v02; - c->ptr.pp_double[ic+i+0][jc+j+3] = alpha*v03; - c->ptr.pp_double[ic+i+1][jc+j+0] = alpha*v10; - c->ptr.pp_double[ic+i+1][jc+j+1] = alpha*v11; - c->ptr.pp_double[ic+i+1][jc+j+2] = alpha*v12; - c->ptr.pp_double[ic+i+1][jc+j+3] = alpha*v13; - c->ptr.pp_double[ic+i+2][jc+j+0] = alpha*v20; - c->ptr.pp_double[ic+i+2][jc+j+1] = alpha*v21; - c->ptr.pp_double[ic+i+2][jc+j+2] = alpha*v22; - c->ptr.pp_double[ic+i+2][jc+j+3] = alpha*v23; - c->ptr.pp_double[ic+i+3][jc+j+0] = alpha*v30; - c->ptr.pp_double[ic+i+3][jc+j+1] = alpha*v31; - c->ptr.pp_double[ic+i+3][jc+j+2] = alpha*v32; - c->ptr.pp_double[ic+i+3][jc+j+3] = alpha*v33; - } - else - { - c->ptr.pp_double[ic+i+0][jc+j+0] = beta*c->ptr.pp_double[ic+i+0][jc+j+0]+alpha*v00; - c->ptr.pp_double[ic+i+0][jc+j+1] = beta*c->ptr.pp_double[ic+i+0][jc+j+1]+alpha*v01; - c->ptr.pp_double[ic+i+0][jc+j+2] = beta*c->ptr.pp_double[ic+i+0][jc+j+2]+alpha*v02; - c->ptr.pp_double[ic+i+0][jc+j+3] = beta*c->ptr.pp_double[ic+i+0][jc+j+3]+alpha*v03; - c->ptr.pp_double[ic+i+1][jc+j+0] = beta*c->ptr.pp_double[ic+i+1][jc+j+0]+alpha*v10; - c->ptr.pp_double[ic+i+1][jc+j+1] = beta*c->ptr.pp_double[ic+i+1][jc+j+1]+alpha*v11; - c->ptr.pp_double[ic+i+1][jc+j+2] = beta*c->ptr.pp_double[ic+i+1][jc+j+2]+alpha*v12; - c->ptr.pp_double[ic+i+1][jc+j+3] = beta*c->ptr.pp_double[ic+i+1][jc+j+3]+alpha*v13; - c->ptr.pp_double[ic+i+2][jc+j+0] = beta*c->ptr.pp_double[ic+i+2][jc+j+0]+alpha*v20; - c->ptr.pp_double[ic+i+2][jc+j+1] = beta*c->ptr.pp_double[ic+i+2][jc+j+1]+alpha*v21; - c->ptr.pp_double[ic+i+2][jc+j+2] = beta*c->ptr.pp_double[ic+i+2][jc+j+2]+alpha*v22; - c->ptr.pp_double[ic+i+2][jc+j+3] = beta*c->ptr.pp_double[ic+i+2][jc+j+3]+alpha*v23; - c->ptr.pp_double[ic+i+3][jc+j+0] = beta*c->ptr.pp_double[ic+i+3][jc+j+0]+alpha*v30; - c->ptr.pp_double[ic+i+3][jc+j+1] = beta*c->ptr.pp_double[ic+i+3][jc+j+1]+alpha*v31; - c->ptr.pp_double[ic+i+3][jc+j+2] = beta*c->ptr.pp_double[ic+i+3][jc+j+2]+alpha*v32; - c->ptr.pp_double[ic+i+3][jc+j+3] = beta*c->ptr.pp_double[ic+i+3][jc+j+3]+alpha*v33; - } - } - else - { - - /* - * Determine submatrix [I0..I1]x[J0..J1] to process - */ - i0 = i; - i1 = ae_minint(i+3, m-1, _state); - j0 = j; - j1 = ae_minint(j+3, n-1, _state); - - /* - * Process submatrix - */ - for(ik=i0; ik<=i1; ik++) - { - for(jk=j0; jk<=j1; jk++) - { - if( k==0||ae_fp_eq(alpha,0) ) - { - v = 0; - } - else - { - v = ae_v_dotproduct(&a->ptr.pp_double[ia+ik][ja], 1, &b->ptr.pp_double[ib+jk][jb], 1, ae_v_len(ja,ja+k-1)); - } - if( ae_fp_eq(beta,0) ) - { - c->ptr.pp_double[ic+ik][jc+jk] = alpha*v; - } - else - { - c->ptr.pp_double[ic+ik][jc+jk] = beta*c->ptr.pp_double[ic+ik][jc+jk]+alpha*v; - } - } - } - } - j = j+4; - } - i = i+4; - } -} - - -/************************************************************************* -RMatrixGEMM kernel, basecase code for RMatrixGEMM, specialized for sitation -with OpTypeA=1 and OpTypeB=0. - -Additional info: -* this function requires that Alpha<>0 (assertion is thrown otherwise) - -INPUT PARAMETERS - M - matrix size, M>0 - N - matrix size, N>0 - K - matrix size, K>0 - Alpha - coefficient - A - matrix - IA - submatrix offset - JA - submatrix offset - B - matrix - IB - submatrix offset - JB - submatrix offset - Beta - coefficient - C - PREALLOCATED output matrix - IC - submatrix offset - JC - submatrix offset - - -- ALGLIB routine -- - 27.03.2013 - Bochkanov Sergey -*************************************************************************/ -void rmatrixgemmk44v10(ae_int_t m, - ae_int_t n, - ae_int_t k, - double alpha, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - /* Real */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - double beta, - /* Real */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - double v; - double v00; - double v01; - double v02; - double v03; - double v10; - double v11; - double v12; - double v13; - double v20; - double v21; - double v22; - double v23; - double v30; - double v31; - double v32; - double v33; - double a0; - double a1; - double a2; - double a3; - double b0; - double b1; - double b2; - double b3; - ae_int_t idxa0; - ae_int_t idxa1; - ae_int_t idxa2; - ae_int_t idxa3; - ae_int_t idxb0; - ae_int_t idxb1; - ae_int_t idxb2; - ae_int_t idxb3; - ae_int_t i0; - ae_int_t i1; - ae_int_t ik; - ae_int_t j0; - ae_int_t j1; - ae_int_t jk; - ae_int_t t; - ae_int_t offsa; - ae_int_t offsb; - - - ae_assert(ae_fp_neq(alpha,0), "RMatrixGEMMK44V00: internal error (Alpha=0)", _state); - - /* - * if matrix size is zero - */ - if( m==0||n==0 ) - { - return; - } - - /* - * A'*B - */ - i = 0; - while(iptr.pp_double[offsa][idxa0]; - a1 = a->ptr.pp_double[offsa][idxa1]; - b0 = b->ptr.pp_double[offsb][idxb0]; - b1 = b->ptr.pp_double[offsb][idxb1]; - v00 = v00+a0*b0; - v01 = v01+a0*b1; - v10 = v10+a1*b0; - v11 = v11+a1*b1; - a2 = a->ptr.pp_double[offsa][idxa2]; - a3 = a->ptr.pp_double[offsa][idxa3]; - v20 = v20+a2*b0; - v21 = v21+a2*b1; - v30 = v30+a3*b0; - v31 = v31+a3*b1; - b2 = b->ptr.pp_double[offsb][idxb2]; - b3 = b->ptr.pp_double[offsb][idxb3]; - v22 = v22+a2*b2; - v23 = v23+a2*b3; - v32 = v32+a3*b2; - v33 = v33+a3*b3; - v02 = v02+a0*b2; - v03 = v03+a0*b3; - v12 = v12+a1*b2; - v13 = v13+a1*b3; - offsa = offsa+1; - offsb = offsb+1; - } - if( ae_fp_eq(beta,0) ) - { - c->ptr.pp_double[ic+i+0][jc+j+0] = alpha*v00; - c->ptr.pp_double[ic+i+0][jc+j+1] = alpha*v01; - c->ptr.pp_double[ic+i+0][jc+j+2] = alpha*v02; - c->ptr.pp_double[ic+i+0][jc+j+3] = alpha*v03; - c->ptr.pp_double[ic+i+1][jc+j+0] = alpha*v10; - c->ptr.pp_double[ic+i+1][jc+j+1] = alpha*v11; - c->ptr.pp_double[ic+i+1][jc+j+2] = alpha*v12; - c->ptr.pp_double[ic+i+1][jc+j+3] = alpha*v13; - c->ptr.pp_double[ic+i+2][jc+j+0] = alpha*v20; - c->ptr.pp_double[ic+i+2][jc+j+1] = alpha*v21; - c->ptr.pp_double[ic+i+2][jc+j+2] = alpha*v22; - c->ptr.pp_double[ic+i+2][jc+j+3] = alpha*v23; - c->ptr.pp_double[ic+i+3][jc+j+0] = alpha*v30; - c->ptr.pp_double[ic+i+3][jc+j+1] = alpha*v31; - c->ptr.pp_double[ic+i+3][jc+j+2] = alpha*v32; - c->ptr.pp_double[ic+i+3][jc+j+3] = alpha*v33; - } - else - { - c->ptr.pp_double[ic+i+0][jc+j+0] = beta*c->ptr.pp_double[ic+i+0][jc+j+0]+alpha*v00; - c->ptr.pp_double[ic+i+0][jc+j+1] = beta*c->ptr.pp_double[ic+i+0][jc+j+1]+alpha*v01; - c->ptr.pp_double[ic+i+0][jc+j+2] = beta*c->ptr.pp_double[ic+i+0][jc+j+2]+alpha*v02; - c->ptr.pp_double[ic+i+0][jc+j+3] = beta*c->ptr.pp_double[ic+i+0][jc+j+3]+alpha*v03; - c->ptr.pp_double[ic+i+1][jc+j+0] = beta*c->ptr.pp_double[ic+i+1][jc+j+0]+alpha*v10; - c->ptr.pp_double[ic+i+1][jc+j+1] = beta*c->ptr.pp_double[ic+i+1][jc+j+1]+alpha*v11; - c->ptr.pp_double[ic+i+1][jc+j+2] = beta*c->ptr.pp_double[ic+i+1][jc+j+2]+alpha*v12; - c->ptr.pp_double[ic+i+1][jc+j+3] = beta*c->ptr.pp_double[ic+i+1][jc+j+3]+alpha*v13; - c->ptr.pp_double[ic+i+2][jc+j+0] = beta*c->ptr.pp_double[ic+i+2][jc+j+0]+alpha*v20; - c->ptr.pp_double[ic+i+2][jc+j+1] = beta*c->ptr.pp_double[ic+i+2][jc+j+1]+alpha*v21; - c->ptr.pp_double[ic+i+2][jc+j+2] = beta*c->ptr.pp_double[ic+i+2][jc+j+2]+alpha*v22; - c->ptr.pp_double[ic+i+2][jc+j+3] = beta*c->ptr.pp_double[ic+i+2][jc+j+3]+alpha*v23; - c->ptr.pp_double[ic+i+3][jc+j+0] = beta*c->ptr.pp_double[ic+i+3][jc+j+0]+alpha*v30; - c->ptr.pp_double[ic+i+3][jc+j+1] = beta*c->ptr.pp_double[ic+i+3][jc+j+1]+alpha*v31; - c->ptr.pp_double[ic+i+3][jc+j+2] = beta*c->ptr.pp_double[ic+i+3][jc+j+2]+alpha*v32; - c->ptr.pp_double[ic+i+3][jc+j+3] = beta*c->ptr.pp_double[ic+i+3][jc+j+3]+alpha*v33; - } - } - else - { - - /* - * Determine submatrix [I0..I1]x[J0..J1] to process - */ - i0 = i; - i1 = ae_minint(i+3, m-1, _state); - j0 = j; - j1 = ae_minint(j+3, n-1, _state); - - /* - * Process submatrix - */ - for(ik=i0; ik<=i1; ik++) - { - for(jk=j0; jk<=j1; jk++) - { - if( k==0||ae_fp_eq(alpha,0) ) - { - v = 0; - } - else - { - v = 0.0; - v = ae_v_dotproduct(&a->ptr.pp_double[ia][ja+ik], a->stride, &b->ptr.pp_double[ib][jb+jk], b->stride, ae_v_len(ia,ia+k-1)); - } - if( ae_fp_eq(beta,0) ) - { - c->ptr.pp_double[ic+ik][jc+jk] = alpha*v; - } - else - { - c->ptr.pp_double[ic+ik][jc+jk] = beta*c->ptr.pp_double[ic+ik][jc+jk]+alpha*v; - } - } - } - } - j = j+4; - } - i = i+4; - } -} - - -/************************************************************************* -RMatrixGEMM kernel, basecase code for RMatrixGEMM, specialized for sitation -with OpTypeA=1 and OpTypeB=1. - -Additional info: -* this function requires that Alpha<>0 (assertion is thrown otherwise) - -INPUT PARAMETERS - M - matrix size, M>0 - N - matrix size, N>0 - K - matrix size, K>0 - Alpha - coefficient - A - matrix - IA - submatrix offset - JA - submatrix offset - B - matrix - IB - submatrix offset - JB - submatrix offset - Beta - coefficient - C - PREALLOCATED output matrix - IC - submatrix offset - JC - submatrix offset - - -- ALGLIB routine -- - 27.03.2013 - Bochkanov Sergey -*************************************************************************/ -void rmatrixgemmk44v11(ae_int_t m, - ae_int_t n, - ae_int_t k, - double alpha, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - /* Real */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - double beta, - /* Real */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - double v; - double v00; - double v01; - double v02; - double v03; - double v10; - double v11; - double v12; - double v13; - double v20; - double v21; - double v22; - double v23; - double v30; - double v31; - double v32; - double v33; - double a0; - double a1; - double a2; - double a3; - double b0; - double b1; - double b2; - double b3; - ae_int_t idxa0; - ae_int_t idxa1; - ae_int_t idxa2; - ae_int_t idxa3; - ae_int_t idxb0; - ae_int_t idxb1; - ae_int_t idxb2; - ae_int_t idxb3; - ae_int_t i0; - ae_int_t i1; - ae_int_t ik; - ae_int_t j0; - ae_int_t j1; - ae_int_t jk; - ae_int_t t; - ae_int_t offsa; - ae_int_t offsb; - - - ae_assert(ae_fp_neq(alpha,0), "RMatrixGEMMK44V00: internal error (Alpha=0)", _state); - - /* - * if matrix size is zero - */ - if( m==0||n==0 ) - { - return; - } - - /* - * A'*B' - */ - i = 0; - while(iptr.pp_double[offsa][idxa0]; - a1 = a->ptr.pp_double[offsa][idxa1]; - b0 = b->ptr.pp_double[idxb0][offsb]; - b1 = b->ptr.pp_double[idxb1][offsb]; - v00 = v00+a0*b0; - v01 = v01+a0*b1; - v10 = v10+a1*b0; - v11 = v11+a1*b1; - a2 = a->ptr.pp_double[offsa][idxa2]; - a3 = a->ptr.pp_double[offsa][idxa3]; - v20 = v20+a2*b0; - v21 = v21+a2*b1; - v30 = v30+a3*b0; - v31 = v31+a3*b1; - b2 = b->ptr.pp_double[idxb2][offsb]; - b3 = b->ptr.pp_double[idxb3][offsb]; - v22 = v22+a2*b2; - v23 = v23+a2*b3; - v32 = v32+a3*b2; - v33 = v33+a3*b3; - v02 = v02+a0*b2; - v03 = v03+a0*b3; - v12 = v12+a1*b2; - v13 = v13+a1*b3; - offsa = offsa+1; - offsb = offsb+1; - } - if( ae_fp_eq(beta,0) ) - { - c->ptr.pp_double[ic+i+0][jc+j+0] = alpha*v00; - c->ptr.pp_double[ic+i+0][jc+j+1] = alpha*v01; - c->ptr.pp_double[ic+i+0][jc+j+2] = alpha*v02; - c->ptr.pp_double[ic+i+0][jc+j+3] = alpha*v03; - c->ptr.pp_double[ic+i+1][jc+j+0] = alpha*v10; - c->ptr.pp_double[ic+i+1][jc+j+1] = alpha*v11; - c->ptr.pp_double[ic+i+1][jc+j+2] = alpha*v12; - c->ptr.pp_double[ic+i+1][jc+j+3] = alpha*v13; - c->ptr.pp_double[ic+i+2][jc+j+0] = alpha*v20; - c->ptr.pp_double[ic+i+2][jc+j+1] = alpha*v21; - c->ptr.pp_double[ic+i+2][jc+j+2] = alpha*v22; - c->ptr.pp_double[ic+i+2][jc+j+3] = alpha*v23; - c->ptr.pp_double[ic+i+3][jc+j+0] = alpha*v30; - c->ptr.pp_double[ic+i+3][jc+j+1] = alpha*v31; - c->ptr.pp_double[ic+i+3][jc+j+2] = alpha*v32; - c->ptr.pp_double[ic+i+3][jc+j+3] = alpha*v33; - } - else - { - c->ptr.pp_double[ic+i+0][jc+j+0] = beta*c->ptr.pp_double[ic+i+0][jc+j+0]+alpha*v00; - c->ptr.pp_double[ic+i+0][jc+j+1] = beta*c->ptr.pp_double[ic+i+0][jc+j+1]+alpha*v01; - c->ptr.pp_double[ic+i+0][jc+j+2] = beta*c->ptr.pp_double[ic+i+0][jc+j+2]+alpha*v02; - c->ptr.pp_double[ic+i+0][jc+j+3] = beta*c->ptr.pp_double[ic+i+0][jc+j+3]+alpha*v03; - c->ptr.pp_double[ic+i+1][jc+j+0] = beta*c->ptr.pp_double[ic+i+1][jc+j+0]+alpha*v10; - c->ptr.pp_double[ic+i+1][jc+j+1] = beta*c->ptr.pp_double[ic+i+1][jc+j+1]+alpha*v11; - c->ptr.pp_double[ic+i+1][jc+j+2] = beta*c->ptr.pp_double[ic+i+1][jc+j+2]+alpha*v12; - c->ptr.pp_double[ic+i+1][jc+j+3] = beta*c->ptr.pp_double[ic+i+1][jc+j+3]+alpha*v13; - c->ptr.pp_double[ic+i+2][jc+j+0] = beta*c->ptr.pp_double[ic+i+2][jc+j+0]+alpha*v20; - c->ptr.pp_double[ic+i+2][jc+j+1] = beta*c->ptr.pp_double[ic+i+2][jc+j+1]+alpha*v21; - c->ptr.pp_double[ic+i+2][jc+j+2] = beta*c->ptr.pp_double[ic+i+2][jc+j+2]+alpha*v22; - c->ptr.pp_double[ic+i+2][jc+j+3] = beta*c->ptr.pp_double[ic+i+2][jc+j+3]+alpha*v23; - c->ptr.pp_double[ic+i+3][jc+j+0] = beta*c->ptr.pp_double[ic+i+3][jc+j+0]+alpha*v30; - c->ptr.pp_double[ic+i+3][jc+j+1] = beta*c->ptr.pp_double[ic+i+3][jc+j+1]+alpha*v31; - c->ptr.pp_double[ic+i+3][jc+j+2] = beta*c->ptr.pp_double[ic+i+3][jc+j+2]+alpha*v32; - c->ptr.pp_double[ic+i+3][jc+j+3] = beta*c->ptr.pp_double[ic+i+3][jc+j+3]+alpha*v33; - } - } - else - { - - /* - * Determine submatrix [I0..I1]x[J0..J1] to process - */ - i0 = i; - i1 = ae_minint(i+3, m-1, _state); - j0 = j; - j1 = ae_minint(j+3, n-1, _state); - - /* - * Process submatrix - */ - for(ik=i0; ik<=i1; ik++) - { - for(jk=j0; jk<=j1; jk++) - { - if( k==0||ae_fp_eq(alpha,0) ) - { - v = 0; - } - else - { - v = 0.0; - v = ae_v_dotproduct(&a->ptr.pp_double[ia][ja+ik], a->stride, &b->ptr.pp_double[ib+jk][jb], 1, ae_v_len(ia,ia+k-1)); - } - if( ae_fp_eq(beta,0) ) - { - c->ptr.pp_double[ic+ik][jc+jk] = alpha*v; - } - else - { - c->ptr.pp_double[ic+ik][jc+jk] = beta*c->ptr.pp_double[ic+ik][jc+jk]+alpha*v; - } - } - } - } - j = j+4; - } - i = i+4; - } -} - - - - -/************************************************************************* -MKL-based kernel - - -- ALGLIB routine -- - 19.01.2010 - Bochkanov Sergey -*************************************************************************/ -ae_bool rmatrixsyrkmkl(ae_int_t n, - ae_int_t k, - double alpha, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - double beta, - /* Real */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_bool isupper, - ae_state *_state) -{ -#ifndef ALGLIB_INTERCEPTS_MKL - ae_bool result; - - - result = ae_false; - return result; -#else - return _ialglib_i_rmatrixsyrkmkl(n, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper); -#endif -} - - -/************************************************************************* -MKL-based kernel - - -- ALGLIB routine -- - 19.01.2010 - Bochkanov Sergey -*************************************************************************/ -ae_bool rmatrixgemmmkl(ae_int_t m, - ae_int_t n, - ae_int_t k, - double alpha, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - /* Real */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - ae_int_t optypeb, - double beta, - /* Real */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_state *_state) -{ -#ifndef ALGLIB_INTERCEPTS_MKL - ae_bool result; - - - result = ae_false; - return result; -#else - return _ialglib_i_rmatrixgemmmkl(m, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc); -#endif -} - - - - -double vectornorm2(/* Real */ ae_vector* x, - ae_int_t i1, - ae_int_t i2, - ae_state *_state) -{ - ae_int_t n; - ae_int_t ix; - double absxi; - double scl; - double ssq; - double result; - - - n = i2-i1+1; - if( n<1 ) - { - result = 0; - return result; - } - if( n==1 ) - { - result = ae_fabs(x->ptr.p_double[i1], _state); - return result; - } - scl = 0; - ssq = 1; - for(ix=i1; ix<=i2; ix++) - { - if( ae_fp_neq(x->ptr.p_double[ix],0) ) - { - absxi = ae_fabs(x->ptr.p_double[ix], _state); - if( ae_fp_less(scl,absxi) ) - { - ssq = 1+ssq*ae_sqr(scl/absxi, _state); - scl = absxi; - } - else - { - ssq = ssq+ae_sqr(absxi/scl, _state); - } - } - } - result = scl*ae_sqrt(ssq, _state); - return result; -} - - -ae_int_t vectoridxabsmax(/* Real */ ae_vector* x, - ae_int_t i1, - ae_int_t i2, - ae_state *_state) -{ - ae_int_t i; - ae_int_t result; - - - result = i1; - for(i=i1+1; i<=i2; i++) - { - if( ae_fp_greater(ae_fabs(x->ptr.p_double[i], _state),ae_fabs(x->ptr.p_double[result], _state)) ) - { - result = i; - } - } - return result; -} - - -ae_int_t columnidxabsmax(/* Real */ ae_matrix* x, - ae_int_t i1, - ae_int_t i2, - ae_int_t j, - ae_state *_state) -{ - ae_int_t i; - ae_int_t result; - - - result = i1; - for(i=i1+1; i<=i2; i++) - { - if( ae_fp_greater(ae_fabs(x->ptr.pp_double[i][j], _state),ae_fabs(x->ptr.pp_double[result][j], _state)) ) - { - result = i; - } - } - return result; -} - - -ae_int_t rowidxabsmax(/* Real */ ae_matrix* x, - ae_int_t j1, - ae_int_t j2, - ae_int_t i, - ae_state *_state) -{ - ae_int_t j; - ae_int_t result; - - - result = j1; - for(j=j1+1; j<=j2; j++) - { - if( ae_fp_greater(ae_fabs(x->ptr.pp_double[i][j], _state),ae_fabs(x->ptr.pp_double[i][result], _state)) ) - { - result = j; - } - } - return result; -} - - -double upperhessenberg1norm(/* Real */ ae_matrix* a, - ae_int_t i1, - ae_int_t i2, - ae_int_t j1, - ae_int_t j2, - /* Real */ ae_vector* work, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - double result; - - - ae_assert(i2-i1==j2-j1, "UpperHessenberg1Norm: I2-I1<>J2-J1!", _state); - for(j=j1; j<=j2; j++) - { - work->ptr.p_double[j] = 0; - } - for(i=i1; i<=i2; i++) - { - for(j=ae_maxint(j1, j1+i-i1-1, _state); j<=j2; j++) - { - work->ptr.p_double[j] = work->ptr.p_double[j]+ae_fabs(a->ptr.pp_double[i][j], _state); - } - } - result = 0; - for(j=j1; j<=j2; j++) - { - result = ae_maxreal(result, work->ptr.p_double[j], _state); - } - return result; -} - - -void copymatrix(/* Real */ ae_matrix* a, - ae_int_t is1, - ae_int_t is2, - ae_int_t js1, - ae_int_t js2, - /* Real */ ae_matrix* b, - ae_int_t id1, - ae_int_t id2, - ae_int_t jd1, - ae_int_t jd2, - ae_state *_state) -{ - ae_int_t isrc; - ae_int_t idst; - - - if( is1>is2||js1>js2 ) - { - return; - } - ae_assert(is2-is1==id2-id1, "CopyMatrix: different sizes!", _state); - ae_assert(js2-js1==jd2-jd1, "CopyMatrix: different sizes!", _state); - for(isrc=is1; isrc<=is2; isrc++) - { - idst = isrc-is1+id1; - ae_v_move(&b->ptr.pp_double[idst][jd1], 1, &a->ptr.pp_double[isrc][js1], 1, ae_v_len(jd1,jd2)); - } -} - - -void inplacetranspose(/* Real */ ae_matrix* a, - ae_int_t i1, - ae_int_t i2, - ae_int_t j1, - ae_int_t j2, - /* Real */ ae_vector* work, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t ips; - ae_int_t jps; - ae_int_t l; - - - if( i1>i2||j1>j2 ) - { - return; - } - ae_assert(i1-i2==j1-j2, "InplaceTranspose error: incorrect array size!", _state); - for(i=i1; i<=i2-1; i++) - { - j = j1+i-i1; - ips = i+1; - jps = j1+ips-i1; - l = i2-i; - ae_v_move(&work->ptr.p_double[1], 1, &a->ptr.pp_double[ips][j], a->stride, ae_v_len(1,l)); - ae_v_move(&a->ptr.pp_double[ips][j], a->stride, &a->ptr.pp_double[i][jps], 1, ae_v_len(ips,i2)); - ae_v_move(&a->ptr.pp_double[i][jps], 1, &work->ptr.p_double[1], 1, ae_v_len(jps,j2)); - } -} - - -void copyandtranspose(/* Real */ ae_matrix* a, - ae_int_t is1, - ae_int_t is2, - ae_int_t js1, - ae_int_t js2, - /* Real */ ae_matrix* b, - ae_int_t id1, - ae_int_t id2, - ae_int_t jd1, - ae_int_t jd2, - ae_state *_state) -{ - ae_int_t isrc; - ae_int_t jdst; - - - if( is1>is2||js1>js2 ) - { - return; - } - ae_assert(is2-is1==jd2-jd1, "CopyAndTranspose: different sizes!", _state); - ae_assert(js2-js1==id2-id1, "CopyAndTranspose: different sizes!", _state); - for(isrc=is1; isrc<=is2; isrc++) - { - jdst = isrc-is1+jd1; - ae_v_move(&b->ptr.pp_double[id1][jdst], b->stride, &a->ptr.pp_double[isrc][js1], 1, ae_v_len(id1,id2)); - } -} - - -void matrixvectormultiply(/* Real */ ae_matrix* a, - ae_int_t i1, - ae_int_t i2, - ae_int_t j1, - ae_int_t j2, - ae_bool trans, - /* Real */ ae_vector* x, - ae_int_t ix1, - ae_int_t ix2, - double alpha, - /* Real */ ae_vector* y, - ae_int_t iy1, - ae_int_t iy2, - double beta, - ae_state *_state) -{ - ae_int_t i; - double v; - - - if( !trans ) - { - - /* - * y := alpha*A*x + beta*y; - */ - if( i1>i2||j1>j2 ) - { - return; - } - ae_assert(j2-j1==ix2-ix1, "MatrixVectorMultiply: A and X dont match!", _state); - ae_assert(i2-i1==iy2-iy1, "MatrixVectorMultiply: A and Y dont match!", _state); - - /* - * beta*y - */ - if( ae_fp_eq(beta,0) ) - { - for(i=iy1; i<=iy2; i++) - { - y->ptr.p_double[i] = 0; - } - } - else - { - ae_v_muld(&y->ptr.p_double[iy1], 1, ae_v_len(iy1,iy2), beta); - } - - /* - * alpha*A*x - */ - for(i=i1; i<=i2; i++) - { - v = ae_v_dotproduct(&a->ptr.pp_double[i][j1], 1, &x->ptr.p_double[ix1], 1, ae_v_len(j1,j2)); - y->ptr.p_double[iy1+i-i1] = y->ptr.p_double[iy1+i-i1]+alpha*v; - } - } - else - { - - /* - * y := alpha*A'*x + beta*y; - */ - if( i1>i2||j1>j2 ) - { - return; - } - ae_assert(i2-i1==ix2-ix1, "MatrixVectorMultiply: A and X do not match!", _state); - ae_assert(j2-j1==iy2-iy1, "MatrixVectorMultiply: A and Y do not match!", _state); - - /* - * beta*y - */ - if( ae_fp_eq(beta,0) ) - { - for(i=iy1; i<=iy2; i++) - { - y->ptr.p_double[i] = 0; - } - } - else - { - ae_v_muld(&y->ptr.p_double[iy1], 1, ae_v_len(iy1,iy2), beta); - } - - /* - * alpha*A'*x - */ - for(i=i1; i<=i2; i++) - { - v = alpha*x->ptr.p_double[ix1+i-i1]; - ae_v_addd(&y->ptr.p_double[iy1], 1, &a->ptr.pp_double[i][j1], 1, ae_v_len(iy1,iy2), v); - } - } -} - - -double pythag2(double x, double y, ae_state *_state) -{ - double w; - double xabs; - double yabs; - double z; - double result; - - - xabs = ae_fabs(x, _state); - yabs = ae_fabs(y, _state); - w = ae_maxreal(xabs, yabs, _state); - z = ae_minreal(xabs, yabs, _state); - if( ae_fp_eq(z,0) ) - { - result = w; - } - else - { - result = w*ae_sqrt(1+ae_sqr(z/w, _state), _state); - } - return result; -} - - -void matrixmatrixmultiply(/* Real */ ae_matrix* a, - ae_int_t ai1, - ae_int_t ai2, - ae_int_t aj1, - ae_int_t aj2, - ae_bool transa, - /* Real */ ae_matrix* b, - ae_int_t bi1, - ae_int_t bi2, - ae_int_t bj1, - ae_int_t bj2, - ae_bool transb, - double alpha, - /* Real */ ae_matrix* c, - ae_int_t ci1, - ae_int_t ci2, - ae_int_t cj1, - ae_int_t cj2, - double beta, - /* Real */ ae_vector* work, - ae_state *_state) -{ - ae_int_t arows; - ae_int_t acols; - ae_int_t brows; - ae_int_t bcols; - ae_int_t crows; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t l; - ae_int_t r; - double v; - - - - /* - * Setup - */ - if( !transa ) - { - arows = ai2-ai1+1; - acols = aj2-aj1+1; - } - else - { - arows = aj2-aj1+1; - acols = ai2-ai1+1; - } - if( !transb ) - { - brows = bi2-bi1+1; - bcols = bj2-bj1+1; - } - else - { - brows = bj2-bj1+1; - bcols = bi2-bi1+1; - } - ae_assert(acols==brows, "MatrixMatrixMultiply: incorrect matrix sizes!", _state); - if( ((arows<=0||acols<=0)||brows<=0)||bcols<=0 ) - { - return; - } - crows = arows; - - /* - * Test WORK - */ - i = ae_maxint(arows, acols, _state); - i = ae_maxint(brows, i, _state); - i = ae_maxint(i, bcols, _state); - work->ptr.p_double[1] = 0; - work->ptr.p_double[i] = 0; - - /* - * Prepare C - */ - if( ae_fp_eq(beta,0) ) - { - for(i=ci1; i<=ci2; i++) - { - for(j=cj1; j<=cj2; j++) - { - c->ptr.pp_double[i][j] = 0; - } - } - } - else - { - for(i=ci1; i<=ci2; i++) - { - ae_v_muld(&c->ptr.pp_double[i][cj1], 1, ae_v_len(cj1,cj2), beta); - } - } - - /* - * A*B - */ - if( !transa&&!transb ) - { - for(l=ai1; l<=ai2; l++) - { - for(r=bi1; r<=bi2; r++) - { - v = alpha*a->ptr.pp_double[l][aj1+r-bi1]; - k = ci1+l-ai1; - ae_v_addd(&c->ptr.pp_double[k][cj1], 1, &b->ptr.pp_double[r][bj1], 1, ae_v_len(cj1,cj2), v); - } - } - return; - } - - /* - * A*B' - */ - if( !transa&&transb ) - { - if( arows*acolsptr.pp_double[l][aj1], 1, &b->ptr.pp_double[r][bj1], 1, ae_v_len(aj1,aj2)); - c->ptr.pp_double[ci1+l-ai1][cj1+r-bi1] = c->ptr.pp_double[ci1+l-ai1][cj1+r-bi1]+alpha*v; - } - } - return; - } - else - { - for(l=ai1; l<=ai2; l++) - { - for(r=bi1; r<=bi2; r++) - { - v = ae_v_dotproduct(&a->ptr.pp_double[l][aj1], 1, &b->ptr.pp_double[r][bj1], 1, ae_v_len(aj1,aj2)); - c->ptr.pp_double[ci1+l-ai1][cj1+r-bi1] = c->ptr.pp_double[ci1+l-ai1][cj1+r-bi1]+alpha*v; - } - } - return; - } - } - - /* - * A'*B - */ - if( transa&&!transb ) - { - for(l=aj1; l<=aj2; l++) - { - for(r=bi1; r<=bi2; r++) - { - v = alpha*a->ptr.pp_double[ai1+r-bi1][l]; - k = ci1+l-aj1; - ae_v_addd(&c->ptr.pp_double[k][cj1], 1, &b->ptr.pp_double[r][bj1], 1, ae_v_len(cj1,cj2), v); - } - } - return; - } - - /* - * A'*B' - */ - if( transa&&transb ) - { - if( arows*acolsptr.p_double[i] = 0.0; - } - for(l=ai1; l<=ai2; l++) - { - v = alpha*b->ptr.pp_double[r][bj1+l-ai1]; - ae_v_addd(&work->ptr.p_double[1], 1, &a->ptr.pp_double[l][aj1], 1, ae_v_len(1,crows), v); - } - ae_v_add(&c->ptr.pp_double[ci1][k], c->stride, &work->ptr.p_double[1], 1, ae_v_len(ci1,ci2)); - } - return; - } - else - { - for(l=aj1; l<=aj2; l++) - { - k = ai2-ai1+1; - ae_v_move(&work->ptr.p_double[1], 1, &a->ptr.pp_double[ai1][l], a->stride, ae_v_len(1,k)); - for(r=bi1; r<=bi2; r++) - { - v = ae_v_dotproduct(&work->ptr.p_double[1], 1, &b->ptr.pp_double[r][bj1], 1, ae_v_len(1,k)); - c->ptr.pp_double[ci1+l-aj1][cj1+r-bi1] = c->ptr.pp_double[ci1+l-aj1][cj1+r-bi1]+alpha*v; - } - } - return; - } - } -} - - - - -void hermitianmatrixvectormultiply(/* Complex */ ae_matrix* a, - ae_bool isupper, - ae_int_t i1, - ae_int_t i2, - /* Complex */ ae_vector* x, - ae_complex alpha, - /* Complex */ ae_vector* y, - ae_state *_state) -{ - ae_int_t i; - ae_int_t ba1; - ae_int_t by1; - ae_int_t by2; - ae_int_t bx1; - ae_int_t bx2; - ae_int_t n; - ae_complex v; - - - n = i2-i1+1; - if( n<=0 ) - { - return; - } - - /* - * Let A = L + D + U, where - * L is strictly lower triangular (main diagonal is zero) - * D is diagonal - * U is strictly upper triangular (main diagonal is zero) - * - * A*x = L*x + D*x + U*x - * - * Calculate D*x first - */ - for(i=i1; i<=i2; i++) - { - y->ptr.p_complex[i-i1+1] = ae_c_mul(a->ptr.pp_complex[i][i],x->ptr.p_complex[i-i1+1]); - } - - /* - * Add L*x + U*x - */ - if( isupper ) - { - for(i=i1; i<=i2-1; i++) - { - - /* - * Add L*x to the result - */ - v = x->ptr.p_complex[i-i1+1]; - by1 = i-i1+2; - by2 = n; - ba1 = i+1; - ae_v_caddc(&y->ptr.p_complex[by1], 1, &a->ptr.pp_complex[i][ba1], 1, "Conj", ae_v_len(by1,by2), v); - - /* - * Add U*x to the result - */ - bx1 = i-i1+2; - bx2 = n; - ba1 = i+1; - v = ae_v_cdotproduct(&x->ptr.p_complex[bx1], 1, "N", &a->ptr.pp_complex[i][ba1], 1, "N", ae_v_len(bx1,bx2)); - y->ptr.p_complex[i-i1+1] = ae_c_add(y->ptr.p_complex[i-i1+1],v); - } - } - else - { - for(i=i1+1; i<=i2; i++) - { - - /* - * Add L*x to the result - */ - bx1 = 1; - bx2 = i-i1; - ba1 = i1; - v = ae_v_cdotproduct(&x->ptr.p_complex[bx1], 1, "N", &a->ptr.pp_complex[i][ba1], 1, "N", ae_v_len(bx1,bx2)); - y->ptr.p_complex[i-i1+1] = ae_c_add(y->ptr.p_complex[i-i1+1],v); - - /* - * Add U*x to the result - */ - v = x->ptr.p_complex[i-i1+1]; - by1 = 1; - by2 = i-i1; - ba1 = i1; - ae_v_caddc(&y->ptr.p_complex[by1], 1, &a->ptr.pp_complex[i][ba1], 1, "Conj", ae_v_len(by1,by2), v); - } - } - ae_v_cmulc(&y->ptr.p_complex[1], 1, ae_v_len(1,n), alpha); -} - - -void hermitianrank2update(/* Complex */ ae_matrix* a, - ae_bool isupper, - ae_int_t i1, - ae_int_t i2, - /* Complex */ ae_vector* x, - /* Complex */ ae_vector* y, - /* Complex */ ae_vector* t, - ae_complex alpha, - ae_state *_state) -{ - ae_int_t i; - ae_int_t tp1; - ae_int_t tp2; - ae_complex v; - - - if( isupper ) - { - for(i=i1; i<=i2; i++) - { - tp1 = i+1-i1; - tp2 = i2-i1+1; - v = ae_c_mul(alpha,x->ptr.p_complex[i+1-i1]); - ae_v_cmovec(&t->ptr.p_complex[tp1], 1, &y->ptr.p_complex[tp1], 1, "Conj", ae_v_len(tp1,tp2), v); - v = ae_c_mul(ae_c_conj(alpha, _state),y->ptr.p_complex[i+1-i1]); - ae_v_caddc(&t->ptr.p_complex[tp1], 1, &x->ptr.p_complex[tp1], 1, "Conj", ae_v_len(tp1,tp2), v); - ae_v_cadd(&a->ptr.pp_complex[i][i], 1, &t->ptr.p_complex[tp1], 1, "N", ae_v_len(i,i2)); - } - } - else - { - for(i=i1; i<=i2; i++) - { - tp1 = 1; - tp2 = i+1-i1; - v = ae_c_mul(alpha,x->ptr.p_complex[i+1-i1]); - ae_v_cmovec(&t->ptr.p_complex[tp1], 1, &y->ptr.p_complex[tp1], 1, "Conj", ae_v_len(tp1,tp2), v); - v = ae_c_mul(ae_c_conj(alpha, _state),y->ptr.p_complex[i+1-i1]); - ae_v_caddc(&t->ptr.p_complex[tp1], 1, &x->ptr.p_complex[tp1], 1, "Conj", ae_v_len(tp1,tp2), v); - ae_v_cadd(&a->ptr.pp_complex[i][i1], 1, &t->ptr.p_complex[tp1], 1, "N", ae_v_len(i1,i)); - } - } -} - - - - -/************************************************************************* -Generation of an elementary reflection transformation - -The subroutine generates elementary reflection H of order N, so that, for -a given X, the following equality holds true: - - ( X(1) ) ( Beta ) -H * ( .. ) = ( 0 ) - ( X(n) ) ( 0 ) - -where - ( V(1) ) -H = 1 - Tau * ( .. ) * ( V(1), ..., V(n) ) - ( V(n) ) - -where the first component of vector V equals 1. - -Input parameters: - X - vector. Array whose index ranges within [1..N]. - N - reflection order. - -Output parameters: - X - components from 2 to N are replaced with vector V. - The first component is replaced with parameter Beta. - Tau - scalar value Tau. If X is a null vector, Tau equals 0, - otherwise 1 <= Tau <= 2. - -This subroutine is the modification of the DLARFG subroutines from -the LAPACK library. - -MODIFICATIONS: - 24.12.2005 sign(Alpha) was replaced with an analogous to the Fortran SIGN code. - - -- LAPACK auxiliary routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - September 30, 1994 -*************************************************************************/ -void generatereflection(/* Real */ ae_vector* x, - ae_int_t n, - double* tau, - ae_state *_state) -{ - ae_int_t j; - double alpha; - double xnorm; - double v; - double beta; - double mx; - double s; - - *tau = 0; - - if( n<=1 ) - { - *tau = 0; - return; - } - - /* - * Scale if needed (to avoid overflow/underflow during intermediate - * calculations). - */ - mx = 0; - for(j=1; j<=n; j++) - { - mx = ae_maxreal(ae_fabs(x->ptr.p_double[j], _state), mx, _state); - } - s = 1; - if( ae_fp_neq(mx,0) ) - { - if( ae_fp_less_eq(mx,ae_minrealnumber/ae_machineepsilon) ) - { - s = ae_minrealnumber/ae_machineepsilon; - v = 1/s; - ae_v_muld(&x->ptr.p_double[1], 1, ae_v_len(1,n), v); - mx = mx*v; - } - else - { - if( ae_fp_greater_eq(mx,ae_maxrealnumber*ae_machineepsilon) ) - { - s = ae_maxrealnumber*ae_machineepsilon; - v = 1/s; - ae_v_muld(&x->ptr.p_double[1], 1, ae_v_len(1,n), v); - mx = mx*v; - } - } - } - - /* - * XNORM = DNRM2( N-1, X, INCX ) - */ - alpha = x->ptr.p_double[1]; - xnorm = 0; - if( ae_fp_neq(mx,0) ) - { - for(j=2; j<=n; j++) - { - xnorm = xnorm+ae_sqr(x->ptr.p_double[j]/mx, _state); - } - xnorm = ae_sqrt(xnorm, _state)*mx; - } - if( ae_fp_eq(xnorm,0) ) - { - - /* - * H = I - */ - *tau = 0; - x->ptr.p_double[1] = x->ptr.p_double[1]*s; - return; - } - - /* - * general case - */ - mx = ae_maxreal(ae_fabs(alpha, _state), ae_fabs(xnorm, _state), _state); - beta = -mx*ae_sqrt(ae_sqr(alpha/mx, _state)+ae_sqr(xnorm/mx, _state), _state); - if( ae_fp_less(alpha,0) ) - { - beta = -beta; - } - *tau = (beta-alpha)/beta; - v = 1/(alpha-beta); - ae_v_muld(&x->ptr.p_double[2], 1, ae_v_len(2,n), v); - x->ptr.p_double[1] = beta; - - /* - * Scale back outputs - */ - x->ptr.p_double[1] = x->ptr.p_double[1]*s; -} - - -/************************************************************************* -Application of an elementary reflection to a rectangular matrix of size MxN - -The algorithm pre-multiplies the matrix by an elementary reflection transformation -which is given by column V and scalar Tau (see the description of the -GenerateReflection procedure). Not the whole matrix but only a part of it -is transformed (rows from M1 to M2, columns from N1 to N2). Only the elements -of this submatrix are changed. - -Input parameters: - C - matrix to be transformed. - Tau - scalar defining the transformation. - V - column defining the transformation. - Array whose index ranges within [1..M2-M1+1]. - M1, M2 - range of rows to be transformed. - N1, N2 - range of columns to be transformed. - WORK - working array whose indexes goes from N1 to N2. - -Output parameters: - C - the result of multiplying the input matrix C by the - transformation matrix which is given by Tau and V. - If N1>N2 or M1>M2, C is not modified. - - -- LAPACK auxiliary routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - September 30, 1994 -*************************************************************************/ -void applyreflectionfromtheleft(/* Real */ ae_matrix* c, - double tau, - /* Real */ ae_vector* v, - ae_int_t m1, - ae_int_t m2, - ae_int_t n1, - ae_int_t n2, - /* Real */ ae_vector* work, - ae_state *_state) -{ - double t; - ae_int_t i; - - - if( (ae_fp_eq(tau,0)||n1>n2)||m1>m2 ) - { - return; - } - - /* - * w := C' * v - */ - for(i=n1; i<=n2; i++) - { - work->ptr.p_double[i] = 0; - } - for(i=m1; i<=m2; i++) - { - t = v->ptr.p_double[i+1-m1]; - ae_v_addd(&work->ptr.p_double[n1], 1, &c->ptr.pp_double[i][n1], 1, ae_v_len(n1,n2), t); - } - - /* - * C := C - tau * v * w' - */ - for(i=m1; i<=m2; i++) - { - t = v->ptr.p_double[i-m1+1]*tau; - ae_v_subd(&c->ptr.pp_double[i][n1], 1, &work->ptr.p_double[n1], 1, ae_v_len(n1,n2), t); - } -} - - -/************************************************************************* -Application of an elementary reflection to a rectangular matrix of size MxN - -The algorithm post-multiplies the matrix by an elementary reflection transformation -which is given by column V and scalar Tau (see the description of the -GenerateReflection procedure). Not the whole matrix but only a part of it -is transformed (rows from M1 to M2, columns from N1 to N2). Only the -elements of this submatrix are changed. - -Input parameters: - C - matrix to be transformed. - Tau - scalar defining the transformation. - V - column defining the transformation. - Array whose index ranges within [1..N2-N1+1]. - M1, M2 - range of rows to be transformed. - N1, N2 - range of columns to be transformed. - WORK - working array whose indexes goes from M1 to M2. - -Output parameters: - C - the result of multiplying the input matrix C by the - transformation matrix which is given by Tau and V. - If N1>N2 or M1>M2, C is not modified. - - -- LAPACK auxiliary routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - September 30, 1994 -*************************************************************************/ -void applyreflectionfromtheright(/* Real */ ae_matrix* c, - double tau, - /* Real */ ae_vector* v, - ae_int_t m1, - ae_int_t m2, - ae_int_t n1, - ae_int_t n2, - /* Real */ ae_vector* work, - ae_state *_state) -{ - double t; - ae_int_t i; - ae_int_t vm; - - - if( (ae_fp_eq(tau,0)||n1>n2)||m1>m2 ) - { - return; - } - vm = n2-n1+1; - for(i=m1; i<=m2; i++) - { - t = ae_v_dotproduct(&c->ptr.pp_double[i][n1], 1, &v->ptr.p_double[1], 1, ae_v_len(n1,n2)); - t = t*tau; - ae_v_subd(&c->ptr.pp_double[i][n1], 1, &v->ptr.p_double[1], 1, ae_v_len(n1,n2), t); - } - - /* - * This line is necessary to avoid spurious compiler warnings - */ - touchint(&vm, _state); -} - - - - -/************************************************************************* -Generation of an elementary complex reflection transformation - -The subroutine generates elementary complex reflection H of order N, so -that, for a given X, the following equality holds true: - - ( X(1) ) ( Beta ) -H' * ( .. ) = ( 0 ), H'*H = I, Beta is a real number - ( X(n) ) ( 0 ) - -where - - ( V(1) ) -H = 1 - Tau * ( .. ) * ( conj(V(1)), ..., conj(V(n)) ) - ( V(n) ) - -where the first component of vector V equals 1. - -Input parameters: - X - vector. Array with elements [1..N]. - N - reflection order. - -Output parameters: - X - components from 2 to N are replaced by vector V. - The first component is replaced with parameter Beta. - Tau - scalar value Tau. - -This subroutine is the modification of CLARFG subroutines from the LAPACK -library. It has similar functionality except for the fact that it doesnÂ’t -handle errors when intermediate results cause an overflow. - - -- LAPACK auxiliary routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - September 30, 1994 -*************************************************************************/ -void complexgeneratereflection(/* Complex */ ae_vector* x, - ae_int_t n, - ae_complex* tau, - ae_state *_state) -{ - ae_int_t j; - ae_complex alpha; - double alphi; - double alphr; - double beta; - double xnorm; - double mx; - ae_complex t; - double s; - ae_complex v; - - tau->x = 0; - tau->y = 0; - - if( n<=0 ) - { - *tau = ae_complex_from_d(0); - return; - } - - /* - * Scale if needed (to avoid overflow/underflow during intermediate - * calculations). - */ - mx = 0; - for(j=1; j<=n; j++) - { - mx = ae_maxreal(ae_c_abs(x->ptr.p_complex[j], _state), mx, _state); - } - s = 1; - if( ae_fp_neq(mx,0) ) - { - if( ae_fp_less(mx,1) ) - { - s = ae_sqrt(ae_minrealnumber, _state); - v = ae_complex_from_d(1/s); - ae_v_cmulc(&x->ptr.p_complex[1], 1, ae_v_len(1,n), v); - } - else - { - s = ae_sqrt(ae_maxrealnumber, _state); - v = ae_complex_from_d(1/s); - ae_v_cmulc(&x->ptr.p_complex[1], 1, ae_v_len(1,n), v); - } - } - - /* - * calculate - */ - alpha = x->ptr.p_complex[1]; - mx = 0; - for(j=2; j<=n; j++) - { - mx = ae_maxreal(ae_c_abs(x->ptr.p_complex[j], _state), mx, _state); - } - xnorm = 0; - if( ae_fp_neq(mx,0) ) - { - for(j=2; j<=n; j++) - { - t = ae_c_div_d(x->ptr.p_complex[j],mx); - xnorm = xnorm+ae_c_mul(t,ae_c_conj(t, _state)).x; - } - xnorm = ae_sqrt(xnorm, _state)*mx; - } - alphr = alpha.x; - alphi = alpha.y; - if( ae_fp_eq(xnorm,0)&&ae_fp_eq(alphi,0) ) - { - *tau = ae_complex_from_d(0); - x->ptr.p_complex[1] = ae_c_mul_d(x->ptr.p_complex[1],s); - return; - } - mx = ae_maxreal(ae_fabs(alphr, _state), ae_fabs(alphi, _state), _state); - mx = ae_maxreal(mx, ae_fabs(xnorm, _state), _state); - beta = -mx*ae_sqrt(ae_sqr(alphr/mx, _state)+ae_sqr(alphi/mx, _state)+ae_sqr(xnorm/mx, _state), _state); - if( ae_fp_less(alphr,0) ) - { - beta = -beta; - } - tau->x = (beta-alphr)/beta; - tau->y = -alphi/beta; - alpha = ae_c_d_div(1,ae_c_sub_d(alpha,beta)); - if( n>1 ) - { - ae_v_cmulc(&x->ptr.p_complex[2], 1, ae_v_len(2,n), alpha); - } - alpha = ae_complex_from_d(beta); - x->ptr.p_complex[1] = alpha; - - /* - * Scale back - */ - x->ptr.p_complex[1] = ae_c_mul_d(x->ptr.p_complex[1],s); -} - - -/************************************************************************* -Application of an elementary reflection to a rectangular matrix of size MxN - -The algorithm pre-multiplies the matrix by an elementary reflection -transformation which is given by column V and scalar Tau (see the -description of the GenerateReflection). Not the whole matrix but only a -part of it is transformed (rows from M1 to M2, columns from N1 to N2). Only -the elements of this submatrix are changed. - -Note: the matrix is multiplied by H, not by H'. If it is required to -multiply the matrix by H', it is necessary to pass Conj(Tau) instead of Tau. - -Input parameters: - C - matrix to be transformed. - Tau - scalar defining transformation. - V - column defining transformation. - Array whose index ranges within [1..M2-M1+1] - M1, M2 - range of rows to be transformed. - N1, N2 - range of columns to be transformed. - WORK - working array whose index goes from N1 to N2. - -Output parameters: - C - the result of multiplying the input matrix C by the - transformation matrix which is given by Tau and V. - If N1>N2 or M1>M2, C is not modified. - - -- LAPACK auxiliary routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - September 30, 1994 -*************************************************************************/ -void complexapplyreflectionfromtheleft(/* Complex */ ae_matrix* c, - ae_complex tau, - /* Complex */ ae_vector* v, - ae_int_t m1, - ae_int_t m2, - ae_int_t n1, - ae_int_t n2, - /* Complex */ ae_vector* work, - ae_state *_state) -{ - ae_complex t; - ae_int_t i; - - - if( (ae_c_eq_d(tau,0)||n1>n2)||m1>m2 ) - { - return; - } - - /* - * w := C^T * conj(v) - */ - for(i=n1; i<=n2; i++) - { - work->ptr.p_complex[i] = ae_complex_from_d(0); - } - for(i=m1; i<=m2; i++) - { - t = ae_c_conj(v->ptr.p_complex[i+1-m1], _state); - ae_v_caddc(&work->ptr.p_complex[n1], 1, &c->ptr.pp_complex[i][n1], 1, "N", ae_v_len(n1,n2), t); - } - - /* - * C := C - tau * v * w^T - */ - for(i=m1; i<=m2; i++) - { - t = ae_c_mul(v->ptr.p_complex[i-m1+1],tau); - ae_v_csubc(&c->ptr.pp_complex[i][n1], 1, &work->ptr.p_complex[n1], 1, "N", ae_v_len(n1,n2), t); - } -} - - -/************************************************************************* -Application of an elementary reflection to a rectangular matrix of size MxN - -The algorithm post-multiplies the matrix by an elementary reflection -transformation which is given by column V and scalar Tau (see the -description of the GenerateReflection). Not the whole matrix but only a -part of it is transformed (rows from M1 to M2, columns from N1 to N2). -Only the elements of this submatrix are changed. - -Input parameters: - C - matrix to be transformed. - Tau - scalar defining transformation. - V - column defining transformation. - Array whose index ranges within [1..N2-N1+1] - M1, M2 - range of rows to be transformed. - N1, N2 - range of columns to be transformed. - WORK - working array whose index goes from M1 to M2. - -Output parameters: - C - the result of multiplying the input matrix C by the - transformation matrix which is given by Tau and V. - If N1>N2 or M1>M2, C is not modified. - - -- LAPACK auxiliary routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - September 30, 1994 -*************************************************************************/ -void complexapplyreflectionfromtheright(/* Complex */ ae_matrix* c, - ae_complex tau, - /* Complex */ ae_vector* v, - ae_int_t m1, - ae_int_t m2, - ae_int_t n1, - ae_int_t n2, - /* Complex */ ae_vector* work, - ae_state *_state) -{ - ae_complex t; - ae_int_t i; - ae_int_t vm; - - - if( (ae_c_eq_d(tau,0)||n1>n2)||m1>m2 ) - { - return; - } - - /* - * w := C * v - */ - vm = n2-n1+1; - for(i=m1; i<=m2; i++) - { - t = ae_v_cdotproduct(&c->ptr.pp_complex[i][n1], 1, "N", &v->ptr.p_complex[1], 1, "N", ae_v_len(n1,n2)); - work->ptr.p_complex[i] = t; - } - - /* - * C := C - w * conj(v^T) - */ - ae_v_cmove(&v->ptr.p_complex[1], 1, &v->ptr.p_complex[1], 1, "Conj", ae_v_len(1,vm)); - for(i=m1; i<=m2; i++) - { - t = ae_c_mul(work->ptr.p_complex[i],tau); - ae_v_csubc(&c->ptr.pp_complex[i][n1], 1, &v->ptr.p_complex[1], 1, "N", ae_v_len(n1,n2), t); - } - ae_v_cmove(&v->ptr.p_complex[1], 1, &v->ptr.p_complex[1], 1, "Conj", ae_v_len(1,vm)); -} - - - - -void symmetricmatrixvectormultiply(/* Real */ ae_matrix* a, - ae_bool isupper, - ae_int_t i1, - ae_int_t i2, - /* Real */ ae_vector* x, - double alpha, - /* Real */ ae_vector* y, - ae_state *_state) -{ - ae_int_t i; - ae_int_t ba1; - ae_int_t ba2; - ae_int_t by1; - ae_int_t by2; - ae_int_t bx1; - ae_int_t bx2; - ae_int_t n; - double v; - - - n = i2-i1+1; - if( n<=0 ) - { - return; - } - - /* - * Let A = L + D + U, where - * L is strictly lower triangular (main diagonal is zero) - * D is diagonal - * U is strictly upper triangular (main diagonal is zero) - * - * A*x = L*x + D*x + U*x - * - * Calculate D*x first - */ - for(i=i1; i<=i2; i++) - { - y->ptr.p_double[i-i1+1] = a->ptr.pp_double[i][i]*x->ptr.p_double[i-i1+1]; - } - - /* - * Add L*x + U*x - */ - if( isupper ) - { - for(i=i1; i<=i2-1; i++) - { - - /* - * Add L*x to the result - */ - v = x->ptr.p_double[i-i1+1]; - by1 = i-i1+2; - by2 = n; - ba1 = i+1; - ba2 = i2; - ae_v_addd(&y->ptr.p_double[by1], 1, &a->ptr.pp_double[i][ba1], 1, ae_v_len(by1,by2), v); - - /* - * Add U*x to the result - */ - bx1 = i-i1+2; - bx2 = n; - ba1 = i+1; - ba2 = i2; - v = ae_v_dotproduct(&x->ptr.p_double[bx1], 1, &a->ptr.pp_double[i][ba1], 1, ae_v_len(bx1,bx2)); - y->ptr.p_double[i-i1+1] = y->ptr.p_double[i-i1+1]+v; - } - } - else - { - for(i=i1+1; i<=i2; i++) - { - - /* - * Add L*x to the result - */ - bx1 = 1; - bx2 = i-i1; - ba1 = i1; - ba2 = i-1; - v = ae_v_dotproduct(&x->ptr.p_double[bx1], 1, &a->ptr.pp_double[i][ba1], 1, ae_v_len(bx1,bx2)); - y->ptr.p_double[i-i1+1] = y->ptr.p_double[i-i1+1]+v; - - /* - * Add U*x to the result - */ - v = x->ptr.p_double[i-i1+1]; - by1 = 1; - by2 = i-i1; - ba1 = i1; - ba2 = i-1; - ae_v_addd(&y->ptr.p_double[by1], 1, &a->ptr.pp_double[i][ba1], 1, ae_v_len(by1,by2), v); - } - } - ae_v_muld(&y->ptr.p_double[1], 1, ae_v_len(1,n), alpha); - touchint(&ba2, _state); -} - - -void symmetricrank2update(/* Real */ ae_matrix* a, - ae_bool isupper, - ae_int_t i1, - ae_int_t i2, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* t, - double alpha, - ae_state *_state) -{ - ae_int_t i; - ae_int_t tp1; - ae_int_t tp2; - double v; - - - if( isupper ) - { - for(i=i1; i<=i2; i++) - { - tp1 = i+1-i1; - tp2 = i2-i1+1; - v = x->ptr.p_double[i+1-i1]; - ae_v_moved(&t->ptr.p_double[tp1], 1, &y->ptr.p_double[tp1], 1, ae_v_len(tp1,tp2), v); - v = y->ptr.p_double[i+1-i1]; - ae_v_addd(&t->ptr.p_double[tp1], 1, &x->ptr.p_double[tp1], 1, ae_v_len(tp1,tp2), v); - ae_v_muld(&t->ptr.p_double[tp1], 1, ae_v_len(tp1,tp2), alpha); - ae_v_add(&a->ptr.pp_double[i][i], 1, &t->ptr.p_double[tp1], 1, ae_v_len(i,i2)); - } - } - else - { - for(i=i1; i<=i2; i++) - { - tp1 = 1; - tp2 = i+1-i1; - v = x->ptr.p_double[i+1-i1]; - ae_v_moved(&t->ptr.p_double[tp1], 1, &y->ptr.p_double[tp1], 1, ae_v_len(tp1,tp2), v); - v = y->ptr.p_double[i+1-i1]; - ae_v_addd(&t->ptr.p_double[tp1], 1, &x->ptr.p_double[tp1], 1, ae_v_len(tp1,tp2), v); - ae_v_muld(&t->ptr.p_double[tp1], 1, ae_v_len(tp1,tp2), alpha); - ae_v_add(&a->ptr.pp_double[i][i1], 1, &t->ptr.p_double[tp1], 1, ae_v_len(i1,i)); - } - } -} - - - - -/************************************************************************* -Application of a sequence of elementary rotations to a matrix - -The algorithm pre-multiplies the matrix by a sequence of rotation -transformations which is given by arrays C and S. Depending on the value -of the IsForward parameter either 1 and 2, 3 and 4 and so on (if IsForward=true) -rows are rotated, or the rows N and N-1, N-2 and N-3 and so on, are rotated. - -Not the whole matrix but only a part of it is transformed (rows from M1 to -M2, columns from N1 to N2). Only the elements of this submatrix are changed. - -Input parameters: - IsForward - the sequence of the rotation application. - M1,M2 - the range of rows to be transformed. - N1, N2 - the range of columns to be transformed. - C,S - transformation coefficients. - Array whose index ranges within [1..M2-M1]. - A - processed matrix. - WORK - working array whose index ranges within [N1..N2]. - -Output parameters: - A - transformed matrix. - -Utility subroutine. -*************************************************************************/ -void applyrotationsfromtheleft(ae_bool isforward, - ae_int_t m1, - ae_int_t m2, - ae_int_t n1, - ae_int_t n2, - /* Real */ ae_vector* c, - /* Real */ ae_vector* s, - /* Real */ ae_matrix* a, - /* Real */ ae_vector* work, - ae_state *_state) -{ - ae_int_t j; - ae_int_t jp1; - double ctemp; - double stemp; - double temp; - - - if( m1>m2||n1>n2 ) - { - return; - } - - /* - * Form P * A - */ - if( isforward ) - { - if( n1!=n2 ) - { - - /* - * Common case: N1<>N2 - */ - for(j=m1; j<=m2-1; j++) - { - ctemp = c->ptr.p_double[j-m1+1]; - stemp = s->ptr.p_double[j-m1+1]; - if( ae_fp_neq(ctemp,1)||ae_fp_neq(stemp,0) ) - { - jp1 = j+1; - ae_v_moved(&work->ptr.p_double[n1], 1, &a->ptr.pp_double[jp1][n1], 1, ae_v_len(n1,n2), ctemp); - ae_v_subd(&work->ptr.p_double[n1], 1, &a->ptr.pp_double[j][n1], 1, ae_v_len(n1,n2), stemp); - ae_v_muld(&a->ptr.pp_double[j][n1], 1, ae_v_len(n1,n2), ctemp); - ae_v_addd(&a->ptr.pp_double[j][n1], 1, &a->ptr.pp_double[jp1][n1], 1, ae_v_len(n1,n2), stemp); - ae_v_move(&a->ptr.pp_double[jp1][n1], 1, &work->ptr.p_double[n1], 1, ae_v_len(n1,n2)); - } - } - } - else - { - - /* - * Special case: N1=N2 - */ - for(j=m1; j<=m2-1; j++) - { - ctemp = c->ptr.p_double[j-m1+1]; - stemp = s->ptr.p_double[j-m1+1]; - if( ae_fp_neq(ctemp,1)||ae_fp_neq(stemp,0) ) - { - temp = a->ptr.pp_double[j+1][n1]; - a->ptr.pp_double[j+1][n1] = ctemp*temp-stemp*a->ptr.pp_double[j][n1]; - a->ptr.pp_double[j][n1] = stemp*temp+ctemp*a->ptr.pp_double[j][n1]; - } - } - } - } - else - { - if( n1!=n2 ) - { - - /* - * Common case: N1<>N2 - */ - for(j=m2-1; j>=m1; j--) - { - ctemp = c->ptr.p_double[j-m1+1]; - stemp = s->ptr.p_double[j-m1+1]; - if( ae_fp_neq(ctemp,1)||ae_fp_neq(stemp,0) ) - { - jp1 = j+1; - ae_v_moved(&work->ptr.p_double[n1], 1, &a->ptr.pp_double[jp1][n1], 1, ae_v_len(n1,n2), ctemp); - ae_v_subd(&work->ptr.p_double[n1], 1, &a->ptr.pp_double[j][n1], 1, ae_v_len(n1,n2), stemp); - ae_v_muld(&a->ptr.pp_double[j][n1], 1, ae_v_len(n1,n2), ctemp); - ae_v_addd(&a->ptr.pp_double[j][n1], 1, &a->ptr.pp_double[jp1][n1], 1, ae_v_len(n1,n2), stemp); - ae_v_move(&a->ptr.pp_double[jp1][n1], 1, &work->ptr.p_double[n1], 1, ae_v_len(n1,n2)); - } - } - } - else - { - - /* - * Special case: N1=N2 - */ - for(j=m2-1; j>=m1; j--) - { - ctemp = c->ptr.p_double[j-m1+1]; - stemp = s->ptr.p_double[j-m1+1]; - if( ae_fp_neq(ctemp,1)||ae_fp_neq(stemp,0) ) - { - temp = a->ptr.pp_double[j+1][n1]; - a->ptr.pp_double[j+1][n1] = ctemp*temp-stemp*a->ptr.pp_double[j][n1]; - a->ptr.pp_double[j][n1] = stemp*temp+ctemp*a->ptr.pp_double[j][n1]; - } - } - } - } -} - - -/************************************************************************* -Application of a sequence of elementary rotations to a matrix - -The algorithm post-multiplies the matrix by a sequence of rotation -transformations which is given by arrays C and S. Depending on the value -of the IsForward parameter either 1 and 2, 3 and 4 and so on (if IsForward=true) -rows are rotated, or the rows N and N-1, N-2 and N-3 and so on are rotated. - -Not the whole matrix but only a part of it is transformed (rows from M1 -to M2, columns from N1 to N2). Only the elements of this submatrix are changed. - -Input parameters: - IsForward - the sequence of the rotation application. - M1,M2 - the range of rows to be transformed. - N1, N2 - the range of columns to be transformed. - C,S - transformation coefficients. - Array whose index ranges within [1..N2-N1]. - A - processed matrix. - WORK - working array whose index ranges within [M1..M2]. - -Output parameters: - A - transformed matrix. - -Utility subroutine. -*************************************************************************/ -void applyrotationsfromtheright(ae_bool isforward, - ae_int_t m1, - ae_int_t m2, - ae_int_t n1, - ae_int_t n2, - /* Real */ ae_vector* c, - /* Real */ ae_vector* s, - /* Real */ ae_matrix* a, - /* Real */ ae_vector* work, - ae_state *_state) -{ - ae_int_t j; - ae_int_t jp1; - double ctemp; - double stemp; - double temp; - - - - /* - * Form A * P' - */ - if( isforward ) - { - if( m1!=m2 ) - { - - /* - * Common case: M1<>M2 - */ - for(j=n1; j<=n2-1; j++) - { - ctemp = c->ptr.p_double[j-n1+1]; - stemp = s->ptr.p_double[j-n1+1]; - if( ae_fp_neq(ctemp,1)||ae_fp_neq(stemp,0) ) - { - jp1 = j+1; - ae_v_moved(&work->ptr.p_double[m1], 1, &a->ptr.pp_double[m1][jp1], a->stride, ae_v_len(m1,m2), ctemp); - ae_v_subd(&work->ptr.p_double[m1], 1, &a->ptr.pp_double[m1][j], a->stride, ae_v_len(m1,m2), stemp); - ae_v_muld(&a->ptr.pp_double[m1][j], a->stride, ae_v_len(m1,m2), ctemp); - ae_v_addd(&a->ptr.pp_double[m1][j], a->stride, &a->ptr.pp_double[m1][jp1], a->stride, ae_v_len(m1,m2), stemp); - ae_v_move(&a->ptr.pp_double[m1][jp1], a->stride, &work->ptr.p_double[m1], 1, ae_v_len(m1,m2)); - } - } - } - else - { - - /* - * Special case: M1=M2 - */ - for(j=n1; j<=n2-1; j++) - { - ctemp = c->ptr.p_double[j-n1+1]; - stemp = s->ptr.p_double[j-n1+1]; - if( ae_fp_neq(ctemp,1)||ae_fp_neq(stemp,0) ) - { - temp = a->ptr.pp_double[m1][j+1]; - a->ptr.pp_double[m1][j+1] = ctemp*temp-stemp*a->ptr.pp_double[m1][j]; - a->ptr.pp_double[m1][j] = stemp*temp+ctemp*a->ptr.pp_double[m1][j]; - } - } - } - } - else - { - if( m1!=m2 ) - { - - /* - * Common case: M1<>M2 - */ - for(j=n2-1; j>=n1; j--) - { - ctemp = c->ptr.p_double[j-n1+1]; - stemp = s->ptr.p_double[j-n1+1]; - if( ae_fp_neq(ctemp,1)||ae_fp_neq(stemp,0) ) - { - jp1 = j+1; - ae_v_moved(&work->ptr.p_double[m1], 1, &a->ptr.pp_double[m1][jp1], a->stride, ae_v_len(m1,m2), ctemp); - ae_v_subd(&work->ptr.p_double[m1], 1, &a->ptr.pp_double[m1][j], a->stride, ae_v_len(m1,m2), stemp); - ae_v_muld(&a->ptr.pp_double[m1][j], a->stride, ae_v_len(m1,m2), ctemp); - ae_v_addd(&a->ptr.pp_double[m1][j], a->stride, &a->ptr.pp_double[m1][jp1], a->stride, ae_v_len(m1,m2), stemp); - ae_v_move(&a->ptr.pp_double[m1][jp1], a->stride, &work->ptr.p_double[m1], 1, ae_v_len(m1,m2)); - } - } - } - else - { - - /* - * Special case: M1=M2 - */ - for(j=n2-1; j>=n1; j--) - { - ctemp = c->ptr.p_double[j-n1+1]; - stemp = s->ptr.p_double[j-n1+1]; - if( ae_fp_neq(ctemp,1)||ae_fp_neq(stemp,0) ) - { - temp = a->ptr.pp_double[m1][j+1]; - a->ptr.pp_double[m1][j+1] = ctemp*temp-stemp*a->ptr.pp_double[m1][j]; - a->ptr.pp_double[m1][j] = stemp*temp+ctemp*a->ptr.pp_double[m1][j]; - } - } - } - } -} - - -/************************************************************************* -The subroutine generates the elementary rotation, so that: - -[ CS SN ] . [ F ] = [ R ] -[ -SN CS ] [ G ] [ 0 ] - -CS**2 + SN**2 = 1 -*************************************************************************/ -void generaterotation(double f, - double g, - double* cs, - double* sn, - double* r, - ae_state *_state) -{ - double f1; - double g1; - - *cs = 0; - *sn = 0; - *r = 0; - - if( ae_fp_eq(g,0) ) - { - *cs = 1; - *sn = 0; - *r = f; - } - else - { - if( ae_fp_eq(f,0) ) - { - *cs = 0; - *sn = 1; - *r = g; - } - else - { - f1 = f; - g1 = g; - if( ae_fp_greater(ae_fabs(f1, _state),ae_fabs(g1, _state)) ) - { - *r = ae_fabs(f1, _state)*ae_sqrt(1+ae_sqr(g1/f1, _state), _state); - } - else - { - *r = ae_fabs(g1, _state)*ae_sqrt(1+ae_sqr(f1/g1, _state), _state); - } - *cs = f1/(*r); - *sn = g1/(*r); - if( ae_fp_greater(ae_fabs(f, _state),ae_fabs(g, _state))&&ae_fp_less(*cs,0) ) - { - *cs = -*cs; - *sn = -*sn; - *r = -*r; - } - } - } -} - - - - -/************************************************************************* -Subroutine performing the Schur decomposition of a matrix in upper -Hessenberg form using the QR algorithm with multiple shifts. - -The source matrix H is represented as S'*H*S = T, where H - matrix in -upper Hessenberg form, S - orthogonal matrix (Schur vectors), T - upper -quasi-triangular matrix (with blocks of sizes 1x1 and 2x2 on the main -diagonal). - -Input parameters: - H - matrix to be decomposed. - Array whose indexes range within [1..N, 1..N]. - N - size of H, N>=0. - - -Output parameters: - H – contains the matrix T. - Array whose indexes range within [1..N, 1..N]. - All elements below the blocks on the main diagonal are equal - to 0. - S - contains Schur vectors. - Array whose indexes range within [1..N, 1..N]. - -Note 1: - The block structure of matrix T could be easily recognized: since all - the elements below the blocks are zeros, the elements a[i+1,i] which - are equal to 0 show the block border. - -Note 2: - the algorithm performance depends on the value of the internal - parameter NS of InternalSchurDecomposition subroutine which defines - the number of shifts in the QR algorithm (analog of the block width - in block matrix algorithms in linear algebra). If you require maximum - performance on your machine, it is recommended to adjust this - parameter manually. - -Result: - True, if the algorithm has converged and the parameters H and S contain - the result. - False, if the algorithm has not converged. - -Algorithm implemented on the basis of subroutine DHSEQR (LAPACK 3.0 library). -*************************************************************************/ -ae_bool upperhessenbergschurdecomposition(/* Real */ ae_matrix* h, - ae_int_t n, - /* Real */ ae_matrix* s, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector wi; - ae_vector wr; - ae_int_t info; - ae_bool result; - - ae_frame_make(_state, &_frame_block); - ae_matrix_clear(s); - ae_vector_init(&wi, 0, DT_REAL, _state, ae_true); - ae_vector_init(&wr, 0, DT_REAL, _state, ae_true); - - internalschurdecomposition(h, n, 1, 2, &wr, &wi, s, &info, _state); - result = info==0; - ae_frame_leave(_state); - return result; -} - - -void internalschurdecomposition(/* Real */ ae_matrix* h, - ae_int_t n, - ae_int_t tneeded, - ae_int_t zneeded, - /* Real */ ae_vector* wr, - /* Real */ ae_vector* wi, - /* Real */ ae_matrix* z, - ae_int_t* info, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector work; - ae_int_t i; - ae_int_t i1; - ae_int_t i2; - ae_int_t ierr; - ae_int_t ii; - ae_int_t itemp; - ae_int_t itn; - ae_int_t its; - ae_int_t j; - ae_int_t k; - ae_int_t l; - ae_int_t maxb; - ae_int_t nr; - ae_int_t ns; - ae_int_t nv; - double absw; - double smlnum; - double tau; - double temp; - double tst1; - double ulp; - double unfl; - ae_matrix s; - ae_vector v; - ae_vector vv; - ae_vector workc1; - ae_vector works1; - ae_vector workv3; - ae_vector tmpwr; - ae_vector tmpwi; - ae_bool initz; - ae_bool wantt; - ae_bool wantz; - double cnst; - ae_bool failflag; - ae_int_t p1; - ae_int_t p2; - double vt; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(wr); - ae_vector_clear(wi); - *info = 0; - ae_vector_init(&work, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&s, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&v, 0, DT_REAL, _state, ae_true); - ae_vector_init(&vv, 0, DT_REAL, _state, ae_true); - ae_vector_init(&workc1, 0, DT_REAL, _state, ae_true); - ae_vector_init(&works1, 0, DT_REAL, _state, ae_true); - ae_vector_init(&workv3, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tmpwr, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tmpwi, 0, DT_REAL, _state, ae_true); - - - /* - * Set the order of the multi-shift QR algorithm to be used. - * If you want to tune algorithm, change this values - */ - ns = 12; - maxb = 50; - - /* - * Now 2 < NS <= MAXB < NH. - */ - maxb = ae_maxint(3, maxb, _state); - ns = ae_minint(maxb, ns, _state); - - /* - * Initialize - */ - cnst = 1.5; - ae_vector_set_length(&work, ae_maxint(n, 1, _state)+1, _state); - ae_matrix_set_length(&s, ns+1, ns+1, _state); - ae_vector_set_length(&v, ns+1+1, _state); - ae_vector_set_length(&vv, ns+1+1, _state); - ae_vector_set_length(wr, ae_maxint(n, 1, _state)+1, _state); - ae_vector_set_length(wi, ae_maxint(n, 1, _state)+1, _state); - ae_vector_set_length(&workc1, 1+1, _state); - ae_vector_set_length(&works1, 1+1, _state); - ae_vector_set_length(&workv3, 3+1, _state); - ae_vector_set_length(&tmpwr, ae_maxint(n, 1, _state)+1, _state); - ae_vector_set_length(&tmpwi, ae_maxint(n, 1, _state)+1, _state); - ae_assert(n>=0, "InternalSchurDecomposition: incorrect N!", _state); - ae_assert(tneeded==0||tneeded==1, "InternalSchurDecomposition: incorrect TNeeded!", _state); - ae_assert((zneeded==0||zneeded==1)||zneeded==2, "InternalSchurDecomposition: incorrect ZNeeded!", _state); - wantt = tneeded==1; - initz = zneeded==2; - wantz = zneeded!=0; - *info = 0; - - /* - * Initialize Z, if necessary - */ - if( initz ) - { - ae_matrix_set_length(z, n+1, n+1, _state); - for(i=1; i<=n; i++) - { - for(j=1; j<=n; j++) - { - if( i==j ) - { - z->ptr.pp_double[i][j] = 1; - } - else - { - z->ptr.pp_double[i][j] = 0; - } - } - } - } - - /* - * Quick return if possible - */ - if( n==0 ) - { - ae_frame_leave(_state); - return; - } - if( n==1 ) - { - wr->ptr.p_double[1] = h->ptr.pp_double[1][1]; - wi->ptr.p_double[1] = 0; - ae_frame_leave(_state); - return; - } - - /* - * Set rows and columns 1 to N to zero below the first - * subdiagonal. - */ - for(j=1; j<=n-2; j++) - { - for(i=j+2; i<=n; i++) - { - h->ptr.pp_double[i][j] = 0; - } - } - - /* - * Test if N is sufficiently small - */ - if( (ns<=2||ns>n)||maxb>=n ) - { - - /* - * Use the standard double-shift algorithm - */ - hsschur_internalauxschur(wantt, wantz, n, 1, n, h, wr, wi, 1, n, z, &work, &workv3, &workc1, &works1, info, _state); - - /* - * fill entries under diagonal blocks of T with zeros - */ - if( wantt ) - { - j = 1; - while(j<=n) - { - if( ae_fp_eq(wi->ptr.p_double[j],0) ) - { - for(i=j+1; i<=n; i++) - { - h->ptr.pp_double[i][j] = 0; - } - j = j+1; - } - else - { - for(i=j+2; i<=n; i++) - { - h->ptr.pp_double[i][j] = 0; - h->ptr.pp_double[i][j+1] = 0; - } - j = j+2; - } - } - } - ae_frame_leave(_state); - return; - } - unfl = ae_minrealnumber; - ulp = 2*ae_machineepsilon; - smlnum = unfl*(n/ulp); - - /* - * I1 and I2 are the indices of the first row and last column of H - * to which transformations must be applied. If eigenvalues only are - * being computed, I1 and I2 are set inside the main loop. - */ - i1 = 1; - i2 = n; - - /* - * ITN is the total number of multiple-shift QR iterations allowed. - */ - itn = 30*n; - - /* - * The main loop begins here. I is the loop index and decreases from - * IHI to ILO in steps of at most MAXB. Each iteration of the loop - * works with the active submatrix in rows and columns L to I. - * Eigenvalues I+1 to IHI have already converged. Either L = ILO or - * H(L,L-1) is negligible so that the matrix splits. - */ - i = n; - for(;;) - { - l = 1; - if( i<1 ) - { - - /* - * fill entries under diagonal blocks of T with zeros - */ - if( wantt ) - { - j = 1; - while(j<=n) - { - if( ae_fp_eq(wi->ptr.p_double[j],0) ) - { - for(i=j+1; i<=n; i++) - { - h->ptr.pp_double[i][j] = 0; - } - j = j+1; - } - else - { - for(i=j+2; i<=n; i++) - { - h->ptr.pp_double[i][j] = 0; - h->ptr.pp_double[i][j+1] = 0; - } - j = j+2; - } - } - } - - /* - * Exit - */ - ae_frame_leave(_state); - return; - } - - /* - * Perform multiple-shift QR iterations on rows and columns ILO to I - * until a submatrix of order at most MAXB splits off at the bottom - * because a subdiagonal element has become negligible. - */ - failflag = ae_true; - for(its=0; its<=itn; its++) - { - - /* - * Look for a single small subdiagonal element. - */ - for(k=i; k>=l+1; k--) - { - tst1 = ae_fabs(h->ptr.pp_double[k-1][k-1], _state)+ae_fabs(h->ptr.pp_double[k][k], _state); - if( ae_fp_eq(tst1,0) ) - { - tst1 = upperhessenberg1norm(h, l, i, l, i, &work, _state); - } - if( ae_fp_less_eq(ae_fabs(h->ptr.pp_double[k][k-1], _state),ae_maxreal(ulp*tst1, smlnum, _state)) ) - { - break; - } - } - l = k; - if( l>1 ) - { - - /* - * H(L,L-1) is negligible. - */ - h->ptr.pp_double[l][l-1] = 0; - } - - /* - * Exit from loop if a submatrix of order <= MAXB has split off. - */ - if( l>=i-maxb+1 ) - { - failflag = ae_false; - break; - } - - /* - * Now the active submatrix is in rows and columns L to I. If - * eigenvalues only are being computed, only the active submatrix - * need be transformed. - */ - if( its==20||its==30 ) - { - - /* - * Exceptional shifts. - */ - for(ii=i-ns+1; ii<=i; ii++) - { - wr->ptr.p_double[ii] = cnst*(ae_fabs(h->ptr.pp_double[ii][ii-1], _state)+ae_fabs(h->ptr.pp_double[ii][ii], _state)); - wi->ptr.p_double[ii] = 0; - } - } - else - { - - /* - * Use eigenvalues of trailing submatrix of order NS as shifts. - */ - copymatrix(h, i-ns+1, i, i-ns+1, i, &s, 1, ns, 1, ns, _state); - hsschur_internalauxschur(ae_false, ae_false, ns, 1, ns, &s, &tmpwr, &tmpwi, 1, ns, z, &work, &workv3, &workc1, &works1, &ierr, _state); - for(p1=1; p1<=ns; p1++) - { - wr->ptr.p_double[i-ns+p1] = tmpwr.ptr.p_double[p1]; - wi->ptr.p_double[i-ns+p1] = tmpwi.ptr.p_double[p1]; - } - if( ierr>0 ) - { - - /* - * If DLAHQR failed to compute all NS eigenvalues, use the - * unconverged diagonal elements as the remaining shifts. - */ - for(ii=1; ii<=ierr; ii++) - { - wr->ptr.p_double[i-ns+ii] = s.ptr.pp_double[ii][ii]; - wi->ptr.p_double[i-ns+ii] = 0; - } - } - } - - /* - * Form the first column of (G-w(1)) (G-w(2)) . . . (G-w(ns)) - * where G is the Hessenberg submatrix H(L:I,L:I) and w is - * the vector of shifts (stored in WR and WI). The result is - * stored in the local array V. - */ - v.ptr.p_double[1] = 1; - for(ii=2; ii<=ns+1; ii++) - { - v.ptr.p_double[ii] = 0; - } - nv = 1; - for(j=i-ns+1; j<=i; j++) - { - if( ae_fp_greater_eq(wi->ptr.p_double[j],0) ) - { - if( ae_fp_eq(wi->ptr.p_double[j],0) ) - { - - /* - * real shift - */ - p1 = nv+1; - ae_v_move(&vv.ptr.p_double[1], 1, &v.ptr.p_double[1], 1, ae_v_len(1,p1)); - matrixvectormultiply(h, l, l+nv, l, l+nv-1, ae_false, &vv, 1, nv, 1.0, &v, 1, nv+1, -wr->ptr.p_double[j], _state); - nv = nv+1; - } - else - { - if( ae_fp_greater(wi->ptr.p_double[j],0) ) - { - - /* - * complex conjugate pair of shifts - */ - p1 = nv+1; - ae_v_move(&vv.ptr.p_double[1], 1, &v.ptr.p_double[1], 1, ae_v_len(1,p1)); - matrixvectormultiply(h, l, l+nv, l, l+nv-1, ae_false, &v, 1, nv, 1.0, &vv, 1, nv+1, -2*wr->ptr.p_double[j], _state); - itemp = vectoridxabsmax(&vv, 1, nv+1, _state); - temp = 1/ae_maxreal(ae_fabs(vv.ptr.p_double[itemp], _state), smlnum, _state); - p1 = nv+1; - ae_v_muld(&vv.ptr.p_double[1], 1, ae_v_len(1,p1), temp); - absw = pythag2(wr->ptr.p_double[j], wi->ptr.p_double[j], _state); - temp = temp*absw*absw; - matrixvectormultiply(h, l, l+nv+1, l, l+nv, ae_false, &vv, 1, nv+1, 1.0, &v, 1, nv+2, temp, _state); - nv = nv+2; - } - } - - /* - * Scale V(1:NV) so that max(abs(V(i))) = 1. If V is zero, - * reset it to the unit vector. - */ - itemp = vectoridxabsmax(&v, 1, nv, _state); - temp = ae_fabs(v.ptr.p_double[itemp], _state); - if( ae_fp_eq(temp,0) ) - { - v.ptr.p_double[1] = 1; - for(ii=2; ii<=nv; ii++) - { - v.ptr.p_double[ii] = 0; - } - } - else - { - temp = ae_maxreal(temp, smlnum, _state); - vt = 1/temp; - ae_v_muld(&v.ptr.p_double[1], 1, ae_v_len(1,nv), vt); - } - } - } - - /* - * Multiple-shift QR step - */ - for(k=l; k<=i-1; k++) - { - - /* - * The first iteration of this loop determines a reflection G - * from the vector V and applies it from left and right to H, - * thus creating a nonzero bulge below the subdiagonal. - * - * Each subsequent iteration determines a reflection G to - * restore the Hessenberg form in the (K-1)th column, and thus - * chases the bulge one step toward the bottom of the active - * submatrix. NR is the order of G. - */ - nr = ae_minint(ns+1, i-k+1, _state); - if( k>l ) - { - p1 = k-1; - p2 = k+nr-1; - ae_v_move(&v.ptr.p_double[1], 1, &h->ptr.pp_double[k][p1], h->stride, ae_v_len(1,nr)); - touchint(&p2, _state); - } - generatereflection(&v, nr, &tau, _state); - if( k>l ) - { - h->ptr.pp_double[k][k-1] = v.ptr.p_double[1]; - for(ii=k+1; ii<=i; ii++) - { - h->ptr.pp_double[ii][k-1] = 0; - } - } - v.ptr.p_double[1] = 1; - - /* - * Apply G from the left to transform the rows of the matrix in - * columns K to I2. - */ - applyreflectionfromtheleft(h, tau, &v, k, k+nr-1, k, i2, &work, _state); - - /* - * Apply G from the right to transform the columns of the - * matrix in rows I1 to min(K+NR,I). - */ - applyreflectionfromtheright(h, tau, &v, i1, ae_minint(k+nr, i, _state), k, k+nr-1, &work, _state); - if( wantz ) - { - - /* - * Accumulate transformations in the matrix Z - */ - applyreflectionfromtheright(z, tau, &v, 1, n, k, k+nr-1, &work, _state); - } - } - } - - /* - * Failure to converge in remaining number of iterations - */ - if( failflag ) - { - *info = i; - ae_frame_leave(_state); - return; - } - - /* - * A submatrix of order <= MAXB in rows and columns L to I has split - * off. Use the double-shift QR algorithm to handle it. - */ - hsschur_internalauxschur(wantt, wantz, n, l, i, h, wr, wi, 1, n, z, &work, &workv3, &workc1, &works1, info, _state); - if( *info>0 ) - { - ae_frame_leave(_state); - return; - } - - /* - * Decrement number of remaining iterations, and return to start of - * the main loop with a new value of I. - */ - itn = itn-its; - i = l-1; - } - ae_frame_leave(_state); -} - - -static void hsschur_internalauxschur(ae_bool wantt, - ae_bool wantz, - ae_int_t n, - ae_int_t ilo, - ae_int_t ihi, - /* Real */ ae_matrix* h, - /* Real */ ae_vector* wr, - /* Real */ ae_vector* wi, - ae_int_t iloz, - ae_int_t ihiz, - /* Real */ ae_matrix* z, - /* Real */ ae_vector* work, - /* Real */ ae_vector* workv3, - /* Real */ ae_vector* workc1, - /* Real */ ae_vector* works1, - ae_int_t* info, - ae_state *_state) -{ - ae_int_t i; - ae_int_t i1; - ae_int_t i2; - ae_int_t itn; - ae_int_t its; - ae_int_t j; - ae_int_t k; - ae_int_t l; - ae_int_t m; - ae_int_t nh; - ae_int_t nr; - ae_int_t nz; - double ave; - double cs; - double disc; - double h00; - double h10; - double h11; - double h12; - double h21; - double h22; - double h33; - double h33s; - double h43h34; - double h44; - double h44s; - double s; - double smlnum; - double sn; - double sum; - double t1; - double t2; - double t3; - double tst1; - double unfl; - double v1; - double v2; - double v3; - ae_bool failflag; - double dat1; - double dat2; - ae_int_t p1; - double him1im1; - double him1i; - double hiim1; - double hii; - double wrim1; - double wri; - double wiim1; - double wii; - double ulp; - - *info = 0; - - *info = 0; - dat1 = 0.75; - dat2 = -0.4375; - ulp = ae_machineepsilon; - - /* - * Quick return if possible - */ - if( n==0 ) - { - return; - } - if( ilo==ihi ) - { - wr->ptr.p_double[ilo] = h->ptr.pp_double[ilo][ilo]; - wi->ptr.p_double[ilo] = 0; - return; - } - nh = ihi-ilo+1; - nz = ihiz-iloz+1; - - /* - * Set machine-dependent constants for the stopping criterion. - * If norm(H) <= sqrt(MaxRealNumber), overflow should not occur. - */ - unfl = ae_minrealnumber; - smlnum = unfl*(nh/ulp); - - /* - * I1 and I2 are the indices of the first row and last column of H - * to which transformations must be applied. If eigenvalues only are - * being computed, I1 and I2 are set inside the main loop. - */ - i1 = 1; - i2 = n; - - /* - * ITN is the total number of QR iterations allowed. - */ - itn = 30*nh; - - /* - * The main loop begins here. I is the loop index and decreases from - * IHI to ILO in steps of 1 or 2. Each iteration of the loop works - * with the active submatrix in rows and columns L to I. - * Eigenvalues I+1 to IHI have already converged. Either L = ILO or - * H(L,L-1) is negligible so that the matrix splits. - */ - i = ihi; - for(;;) - { - l = ilo; - if( i=l+1; k--) - { - tst1 = ae_fabs(h->ptr.pp_double[k-1][k-1], _state)+ae_fabs(h->ptr.pp_double[k][k], _state); - if( ae_fp_eq(tst1,0) ) - { - tst1 = upperhessenberg1norm(h, l, i, l, i, work, _state); - } - if( ae_fp_less_eq(ae_fabs(h->ptr.pp_double[k][k-1], _state),ae_maxreal(ulp*tst1, smlnum, _state)) ) - { - break; - } - } - l = k; - if( l>ilo ) - { - - /* - * H(L,L-1) is negligible - */ - h->ptr.pp_double[l][l-1] = 0; - } - - /* - * Exit from loop if a submatrix of order 1 or 2 has split off. - */ - if( l>=i-1 ) - { - failflag = ae_false; - break; - } - - /* - * Now the active submatrix is in rows and columns L to I. If - * eigenvalues only are being computed, only the active submatrix - * need be transformed. - */ - if( its==10||its==20 ) - { - - /* - * Exceptional shift. - */ - s = ae_fabs(h->ptr.pp_double[i][i-1], _state)+ae_fabs(h->ptr.pp_double[i-1][i-2], _state); - h44 = dat1*s+h->ptr.pp_double[i][i]; - h33 = h44; - h43h34 = dat2*s*s; - } - else - { - - /* - * Prepare to use Francis' double shift - * (i.e. 2nd degree generalized Rayleigh quotient) - */ - h44 = h->ptr.pp_double[i][i]; - h33 = h->ptr.pp_double[i-1][i-1]; - h43h34 = h->ptr.pp_double[i][i-1]*h->ptr.pp_double[i-1][i]; - s = h->ptr.pp_double[i-1][i-2]*h->ptr.pp_double[i-1][i-2]; - disc = (h33-h44)*0.5; - disc = disc*disc+h43h34; - if( ae_fp_greater(disc,0) ) - { - - /* - * Real roots: use Wilkinson's shift twice - */ - disc = ae_sqrt(disc, _state); - ave = 0.5*(h33+h44); - if( ae_fp_greater(ae_fabs(h33, _state)-ae_fabs(h44, _state),0) ) - { - h33 = h33*h44-h43h34; - h44 = h33/(hsschur_extschursign(disc, ave, _state)+ave); - } - else - { - h44 = hsschur_extschursign(disc, ave, _state)+ave; - } - h33 = h44; - h43h34 = 0; - } - } - - /* - * Look for two consecutive small subdiagonal elements. - */ - for(m=i-2; m>=l; m--) - { - - /* - * Determine the effect of starting the double-shift QR - * iteration at row M, and see if this would make H(M,M-1) - * negligible. - */ - h11 = h->ptr.pp_double[m][m]; - h22 = h->ptr.pp_double[m+1][m+1]; - h21 = h->ptr.pp_double[m+1][m]; - h12 = h->ptr.pp_double[m][m+1]; - h44s = h44-h11; - h33s = h33-h11; - v1 = (h33s*h44s-h43h34)/h21+h12; - v2 = h22-h11-h33s-h44s; - v3 = h->ptr.pp_double[m+2][m+1]; - s = ae_fabs(v1, _state)+ae_fabs(v2, _state)+ae_fabs(v3, _state); - v1 = v1/s; - v2 = v2/s; - v3 = v3/s; - workv3->ptr.p_double[1] = v1; - workv3->ptr.p_double[2] = v2; - workv3->ptr.p_double[3] = v3; - if( m==l ) - { - break; - } - h00 = h->ptr.pp_double[m-1][m-1]; - h10 = h->ptr.pp_double[m][m-1]; - tst1 = ae_fabs(v1, _state)*(ae_fabs(h00, _state)+ae_fabs(h11, _state)+ae_fabs(h22, _state)); - if( ae_fp_less_eq(ae_fabs(h10, _state)*(ae_fabs(v2, _state)+ae_fabs(v3, _state)),ulp*tst1) ) - { - break; - } - } - - /* - * Double-shift QR step - */ - for(k=m; k<=i-1; k++) - { - - /* - * The first iteration of this loop determines a reflection G - * from the vector V and applies it from left and right to H, - * thus creating a nonzero bulge below the subdiagonal. - * - * Each subsequent iteration determines a reflection G to - * restore the Hessenberg form in the (K-1)th column, and thus - * chases the bulge one step toward the bottom of the active - * submatrix. NR is the order of G. - */ - nr = ae_minint(3, i-k+1, _state); - if( k>m ) - { - for(p1=1; p1<=nr; p1++) - { - workv3->ptr.p_double[p1] = h->ptr.pp_double[k+p1-1][k-1]; - } - } - generatereflection(workv3, nr, &t1, _state); - if( k>m ) - { - h->ptr.pp_double[k][k-1] = workv3->ptr.p_double[1]; - h->ptr.pp_double[k+1][k-1] = 0; - if( kptr.pp_double[k+2][k-1] = 0; - } - } - else - { - if( m>l ) - { - h->ptr.pp_double[k][k-1] = -h->ptr.pp_double[k][k-1]; - } - } - v2 = workv3->ptr.p_double[2]; - t2 = t1*v2; - if( nr==3 ) - { - v3 = workv3->ptr.p_double[3]; - t3 = t1*v3; - - /* - * Apply G from the left to transform the rows of the matrix - * in columns K to I2. - */ - for(j=k; j<=i2; j++) - { - sum = h->ptr.pp_double[k][j]+v2*h->ptr.pp_double[k+1][j]+v3*h->ptr.pp_double[k+2][j]; - h->ptr.pp_double[k][j] = h->ptr.pp_double[k][j]-sum*t1; - h->ptr.pp_double[k+1][j] = h->ptr.pp_double[k+1][j]-sum*t2; - h->ptr.pp_double[k+2][j] = h->ptr.pp_double[k+2][j]-sum*t3; - } - - /* - * Apply G from the right to transform the columns of the - * matrix in rows I1 to min(K+3,I). - */ - for(j=i1; j<=ae_minint(k+3, i, _state); j++) - { - sum = h->ptr.pp_double[j][k]+v2*h->ptr.pp_double[j][k+1]+v3*h->ptr.pp_double[j][k+2]; - h->ptr.pp_double[j][k] = h->ptr.pp_double[j][k]-sum*t1; - h->ptr.pp_double[j][k+1] = h->ptr.pp_double[j][k+1]-sum*t2; - h->ptr.pp_double[j][k+2] = h->ptr.pp_double[j][k+2]-sum*t3; - } - if( wantz ) - { - - /* - * Accumulate transformations in the matrix Z - */ - for(j=iloz; j<=ihiz; j++) - { - sum = z->ptr.pp_double[j][k]+v2*z->ptr.pp_double[j][k+1]+v3*z->ptr.pp_double[j][k+2]; - z->ptr.pp_double[j][k] = z->ptr.pp_double[j][k]-sum*t1; - z->ptr.pp_double[j][k+1] = z->ptr.pp_double[j][k+1]-sum*t2; - z->ptr.pp_double[j][k+2] = z->ptr.pp_double[j][k+2]-sum*t3; - } - } - } - else - { - if( nr==2 ) - { - - /* - * Apply G from the left to transform the rows of the matrix - * in columns K to I2. - */ - for(j=k; j<=i2; j++) - { - sum = h->ptr.pp_double[k][j]+v2*h->ptr.pp_double[k+1][j]; - h->ptr.pp_double[k][j] = h->ptr.pp_double[k][j]-sum*t1; - h->ptr.pp_double[k+1][j] = h->ptr.pp_double[k+1][j]-sum*t2; - } - - /* - * Apply G from the right to transform the columns of the - * matrix in rows I1 to min(K+3,I). - */ - for(j=i1; j<=i; j++) - { - sum = h->ptr.pp_double[j][k]+v2*h->ptr.pp_double[j][k+1]; - h->ptr.pp_double[j][k] = h->ptr.pp_double[j][k]-sum*t1; - h->ptr.pp_double[j][k+1] = h->ptr.pp_double[j][k+1]-sum*t2; - } - if( wantz ) - { - - /* - * Accumulate transformations in the matrix Z - */ - for(j=iloz; j<=ihiz; j++) - { - sum = z->ptr.pp_double[j][k]+v2*z->ptr.pp_double[j][k+1]; - z->ptr.pp_double[j][k] = z->ptr.pp_double[j][k]-sum*t1; - z->ptr.pp_double[j][k+1] = z->ptr.pp_double[j][k+1]-sum*t2; - } - } - } - } - } - } - if( failflag ) - { - - /* - * Failure to converge in remaining number of iterations - */ - *info = i; - return; - } - if( l==i ) - { - - /* - * H(I,I-1) is negligible: one eigenvalue has converged. - */ - wr->ptr.p_double[i] = h->ptr.pp_double[i][i]; - wi->ptr.p_double[i] = 0; - } - else - { - if( l==i-1 ) - { - - /* - * H(I-1,I-2) is negligible: a pair of eigenvalues have converged. - * - * Transform the 2-by-2 submatrix to standard Schur form, - * and compute and store the eigenvalues. - */ - him1im1 = h->ptr.pp_double[i-1][i-1]; - him1i = h->ptr.pp_double[i-1][i]; - hiim1 = h->ptr.pp_double[i][i-1]; - hii = h->ptr.pp_double[i][i]; - hsschur_aux2x2schur(&him1im1, &him1i, &hiim1, &hii, &wrim1, &wiim1, &wri, &wii, &cs, &sn, _state); - wr->ptr.p_double[i-1] = wrim1; - wi->ptr.p_double[i-1] = wiim1; - wr->ptr.p_double[i] = wri; - wi->ptr.p_double[i] = wii; - h->ptr.pp_double[i-1][i-1] = him1im1; - h->ptr.pp_double[i-1][i] = him1i; - h->ptr.pp_double[i][i-1] = hiim1; - h->ptr.pp_double[i][i] = hii; - if( wantt ) - { - - /* - * Apply the transformation to the rest of H. - */ - if( i2>i ) - { - workc1->ptr.p_double[1] = cs; - works1->ptr.p_double[1] = sn; - applyrotationsfromtheleft(ae_true, i-1, i, i+1, i2, workc1, works1, h, work, _state); - } - workc1->ptr.p_double[1] = cs; - works1->ptr.p_double[1] = sn; - applyrotationsfromtheright(ae_true, i1, i-2, i-1, i, workc1, works1, h, work, _state); - } - if( wantz ) - { - - /* - * Apply the transformation to Z. - */ - workc1->ptr.p_double[1] = cs; - works1->ptr.p_double[1] = sn; - applyrotationsfromtheright(ae_true, iloz, iloz+nz-1, i-1, i, workc1, works1, z, work, _state); - } - } - } - - /* - * Decrement number of remaining iterations, and return to start of - * the main loop with new value of I. - */ - itn = itn-its; - i = l-1; - } -} - - -static void hsschur_aux2x2schur(double* a, - double* b, - double* c, - double* d, - double* rt1r, - double* rt1i, - double* rt2r, - double* rt2i, - double* cs, - double* sn, - ae_state *_state) -{ - double multpl; - double aa; - double bb; - double bcmax; - double bcmis; - double cc; - double cs1; - double dd; - double eps; - double p; - double sab; - double sac; - double scl; - double sigma; - double sn1; - double tau; - double temp; - double z; - - *rt1r = 0; - *rt1i = 0; - *rt2r = 0; - *rt2i = 0; - *cs = 0; - *sn = 0; - - multpl = 4.0; - eps = ae_machineepsilon; - if( ae_fp_eq(*c,0) ) - { - *cs = 1; - *sn = 0; - } - else - { - if( ae_fp_eq(*b,0) ) - { - - /* - * Swap rows and columns - */ - *cs = 0; - *sn = 1; - temp = *d; - *d = *a; - *a = temp; - *b = -*c; - *c = 0; - } - else - { - if( ae_fp_eq(*a-(*d),0)&&hsschur_extschursigntoone(*b, _state)!=hsschur_extschursigntoone(*c, _state) ) - { - *cs = 1; - *sn = 0; - } - else - { - temp = *a-(*d); - p = 0.5*temp; - bcmax = ae_maxreal(ae_fabs(*b, _state), ae_fabs(*c, _state), _state); - bcmis = ae_minreal(ae_fabs(*b, _state), ae_fabs(*c, _state), _state)*hsschur_extschursigntoone(*b, _state)*hsschur_extschursigntoone(*c, _state); - scl = ae_maxreal(ae_fabs(p, _state), bcmax, _state); - z = p/scl*p+bcmax/scl*bcmis; - - /* - * If Z is of the order of the machine accuracy, postpone the - * decision on the nature of eigenvalues - */ - if( ae_fp_greater_eq(z,multpl*eps) ) - { - - /* - * Real eigenvalues. Compute A and D. - */ - z = p+hsschur_extschursign(ae_sqrt(scl, _state)*ae_sqrt(z, _state), p, _state); - *a = *d+z; - *d = *d-bcmax/z*bcmis; - - /* - * Compute B and the rotation matrix - */ - tau = pythag2(*c, z, _state); - *cs = z/tau; - *sn = *c/tau; - *b = *b-(*c); - *c = 0; - } - else - { - - /* - * Complex eigenvalues, or real (almost) equal eigenvalues. - * Make diagonal elements equal. - */ - sigma = *b+(*c); - tau = pythag2(sigma, temp, _state); - *cs = ae_sqrt(0.5*(1+ae_fabs(sigma, _state)/tau), _state); - *sn = -p/(tau*(*cs))*hsschur_extschursign(1, sigma, _state); - - /* - * Compute [ AA BB ] = [ A B ] [ CS -SN ] - * [ CC DD ] [ C D ] [ SN CS ] - */ - aa = *a*(*cs)+*b*(*sn); - bb = -*a*(*sn)+*b*(*cs); - cc = *c*(*cs)+*d*(*sn); - dd = -*c*(*sn)+*d*(*cs); - - /* - * Compute [ A B ] = [ CS SN ] [ AA BB ] - * [ C D ] [-SN CS ] [ CC DD ] - */ - *a = aa*(*cs)+cc*(*sn); - *b = bb*(*cs)+dd*(*sn); - *c = -aa*(*sn)+cc*(*cs); - *d = -bb*(*sn)+dd*(*cs); - temp = 0.5*(*a+(*d)); - *a = temp; - *d = temp; - if( ae_fp_neq(*c,0) ) - { - if( ae_fp_neq(*b,0) ) - { - if( hsschur_extschursigntoone(*b, _state)==hsschur_extschursigntoone(*c, _state) ) - { - - /* - * Real eigenvalues: reduce to upper triangular form - */ - sab = ae_sqrt(ae_fabs(*b, _state), _state); - sac = ae_sqrt(ae_fabs(*c, _state), _state); - p = hsschur_extschursign(sab*sac, *c, _state); - tau = 1/ae_sqrt(ae_fabs(*b+(*c), _state), _state); - *a = temp+p; - *d = temp-p; - *b = *b-(*c); - *c = 0; - cs1 = sab*tau; - sn1 = sac*tau; - temp = *cs*cs1-*sn*sn1; - *sn = *cs*sn1+*sn*cs1; - *cs = temp; - } - } - else - { - *b = -*c; - *c = 0; - temp = *cs; - *cs = -*sn; - *sn = temp; - } - } - } - } - } - } - - /* - * Store eigenvalues in (RT1R,RT1I) and (RT2R,RT2I). - */ - *rt1r = *a; - *rt2r = *d; - if( ae_fp_eq(*c,0) ) - { - *rt1i = 0; - *rt2i = 0; - } - else - { - *rt1i = ae_sqrt(ae_fabs(*b, _state), _state)*ae_sqrt(ae_fabs(*c, _state), _state); - *rt2i = -*rt1i; - } -} - - -static double hsschur_extschursign(double a, double b, ae_state *_state) -{ - double result; - - - if( ae_fp_greater_eq(b,0) ) - { - result = ae_fabs(a, _state); - } - else - { - result = -ae_fabs(a, _state); - } - return result; -} - - -static ae_int_t hsschur_extschursigntoone(double b, ae_state *_state) -{ - ae_int_t result; - - - if( ae_fp_greater_eq(b,0) ) - { - result = 1; - } - else - { - result = -1; - } - return result; -} - - - - -/************************************************************************* -Utility subroutine performing the "safe" solution of system of linear -equations with triangular coefficient matrices. - -The subroutine uses scaling and solves the scaled system A*x=s*b (where s -is a scalar value) instead of A*x=b, choosing s so that x can be -represented by a floating-point number. The closer the system gets to a -singular, the less s is. If the system is singular, s=0 and x contains the -non-trivial solution of equation A*x=0. - -The feature of an algorithm is that it could not cause an overflow or a -division by zero regardless of the matrix used as the input. - -The algorithm can solve systems of equations with upper/lower triangular -matrices, with/without unit diagonal, and systems of type A*x=b or A'*x=b -(where A' is a transposed matrix A). - -Input parameters: - A - system matrix. Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - X - right-hand member of a system. - Array whose index ranges within [0..N-1]. - IsUpper - matrix type. If it is True, the system matrix is the upper - triangular and is located in the corresponding part of - matrix A. - Trans - problem type. If it is True, the problem to be solved is - A'*x=b, otherwise it is A*x=b. - Isunit - matrix type. If it is True, the system matrix has a unit - diagonal (the elements on the main diagonal are not used - in the calculation process), otherwise the matrix is considered - to be a general triangular matrix. - -Output parameters: - X - solution. Array whose index ranges within [0..N-1]. - S - scaling factor. - - -- LAPACK auxiliary routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - June 30, 1992 -*************************************************************************/ -void rmatrixtrsafesolve(/* Real */ ae_matrix* a, - ae_int_t n, - /* Real */ ae_vector* x, - double* s, - ae_bool isupper, - ae_bool istrans, - ae_bool isunit, - ae_state *_state) -{ - ae_frame _frame_block; - ae_bool normin; - ae_vector cnorm; - ae_matrix a1; - ae_vector x1; - ae_int_t i; - - ae_frame_make(_state, &_frame_block); - *s = 0; - ae_vector_init(&cnorm, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&a1, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&x1, 0, DT_REAL, _state, ae_true); - - - /* - * From 0-based to 1-based - */ - normin = ae_false; - ae_matrix_set_length(&a1, n+1, n+1, _state); - ae_vector_set_length(&x1, n+1, _state); - for(i=1; i<=n; i++) - { - ae_v_move(&a1.ptr.pp_double[i][1], 1, &a->ptr.pp_double[i-1][0], 1, ae_v_len(1,n)); - } - ae_v_move(&x1.ptr.p_double[1], 1, &x->ptr.p_double[0], 1, ae_v_len(1,n)); - - /* - * Solve 1-based - */ - safesolvetriangular(&a1, n, &x1, s, isupper, istrans, isunit, normin, &cnorm, _state); - - /* - * From 1-based to 0-based - */ - ae_v_move(&x->ptr.p_double[0], 1, &x1.ptr.p_double[1], 1, ae_v_len(0,n-1)); - ae_frame_leave(_state); -} - - -/************************************************************************* -Obsolete 1-based subroutine. -See RMatrixTRSafeSolve for 0-based replacement. -*************************************************************************/ -void safesolvetriangular(/* Real */ ae_matrix* a, - ae_int_t n, - /* Real */ ae_vector* x, - double* s, - ae_bool isupper, - ae_bool istrans, - ae_bool isunit, - ae_bool normin, - /* Real */ ae_vector* cnorm, - ae_state *_state) -{ - ae_int_t i; - ae_int_t imax; - ae_int_t j; - ae_int_t jfirst; - ae_int_t jinc; - ae_int_t jlast; - ae_int_t jm1; - ae_int_t jp1; - ae_int_t ip1; - ae_int_t im1; - ae_int_t k; - ae_int_t flg; - double v; - double vd; - double bignum; - double grow; - double rec; - double smlnum; - double sumj; - double tjj; - double tjjs; - double tmax; - double tscal; - double uscal; - double xbnd; - double xj; - double xmax; - ae_bool notran; - ae_bool upper; - ae_bool nounit; - - *s = 0; - - upper = isupper; - notran = !istrans; - nounit = !isunit; - - /* - * these initializers are not really necessary, - * but without them compiler complains about uninitialized locals - */ - tjjs = 0; - - /* - * Quick return if possible - */ - if( n==0 ) - { - return; - } - - /* - * Determine machine dependent parameters to control overflow. - */ - smlnum = ae_minrealnumber/(ae_machineepsilon*2); - bignum = 1/smlnum; - *s = 1; - if( !normin ) - { - ae_vector_set_length(cnorm, n+1, _state); - - /* - * Compute the 1-norm of each column, not including the diagonal. - */ - if( upper ) - { - - /* - * A is upper triangular. - */ - for(j=1; j<=n; j++) - { - v = 0; - for(k=1; k<=j-1; k++) - { - v = v+ae_fabs(a->ptr.pp_double[k][j], _state); - } - cnorm->ptr.p_double[j] = v; - } - } - else - { - - /* - * A is lower triangular. - */ - for(j=1; j<=n-1; j++) - { - v = 0; - for(k=j+1; k<=n; k++) - { - v = v+ae_fabs(a->ptr.pp_double[k][j], _state); - } - cnorm->ptr.p_double[j] = v; - } - cnorm->ptr.p_double[n] = 0; - } - } - - /* - * Scale the column norms by TSCAL if the maximum element in CNORM is - * greater than BIGNUM. - */ - imax = 1; - for(k=2; k<=n; k++) - { - if( ae_fp_greater(cnorm->ptr.p_double[k],cnorm->ptr.p_double[imax]) ) - { - imax = k; - } - } - tmax = cnorm->ptr.p_double[imax]; - if( ae_fp_less_eq(tmax,bignum) ) - { - tscal = 1; - } - else - { - tscal = 1/(smlnum*tmax); - ae_v_muld(&cnorm->ptr.p_double[1], 1, ae_v_len(1,n), tscal); - } - - /* - * Compute a bound on the computed solution vector to see if the - * Level 2 BLAS routine DTRSV can be used. - */ - j = 1; - for(k=2; k<=n; k++) - { - if( ae_fp_greater(ae_fabs(x->ptr.p_double[k], _state),ae_fabs(x->ptr.p_double[j], _state)) ) - { - j = k; - } - } - xmax = ae_fabs(x->ptr.p_double[j], _state); - xbnd = xmax; - if( notran ) - { - - /* - * Compute the growth in A * x = b. - */ - if( upper ) - { - jfirst = n; - jlast = 1; - jinc = -1; - } - else - { - jfirst = 1; - jlast = n; - jinc = 1; - } - if( ae_fp_neq(tscal,1) ) - { - grow = 0; - } - else - { - if( nounit ) - { - - /* - * A is non-unit triangular. - * - * Compute GROW = 1/G(j) and XBND = 1/M(j). - * Initially, G(0) = max{x(i), i=1,...,n}. - */ - grow = 1/ae_maxreal(xbnd, smlnum, _state); - xbnd = grow; - j = jfirst; - while((jinc>0&&j<=jlast)||(jinc<0&&j>=jlast)) - { - - /* - * Exit the loop if the growth factor is too small. - */ - if( ae_fp_less_eq(grow,smlnum) ) - { - break; - } - - /* - * M(j) = G(j-1) / abs(A(j,j)) - */ - tjj = ae_fabs(a->ptr.pp_double[j][j], _state); - xbnd = ae_minreal(xbnd, ae_minreal(1, tjj, _state)*grow, _state); - if( ae_fp_greater_eq(tjj+cnorm->ptr.p_double[j],smlnum) ) - { - - /* - * G(j) = G(j-1)*( 1 + CNORM(j) / abs(A(j,j)) ) - */ - grow = grow*(tjj/(tjj+cnorm->ptr.p_double[j])); - } - else - { - - /* - * G(j) could overflow, set GROW to 0. - */ - grow = 0; - } - if( j==jlast ) - { - grow = xbnd; - } - j = j+jinc; - } - } - else - { - - /* - * A is unit triangular. - * - * Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}. - */ - grow = ae_minreal(1, 1/ae_maxreal(xbnd, smlnum, _state), _state); - j = jfirst; - while((jinc>0&&j<=jlast)||(jinc<0&&j>=jlast)) - { - - /* - * Exit the loop if the growth factor is too small. - */ - if( ae_fp_less_eq(grow,smlnum) ) - { - break; - } - - /* - * G(j) = G(j-1)*( 1 + CNORM(j) ) - */ - grow = grow*(1/(1+cnorm->ptr.p_double[j])); - j = j+jinc; - } - } - } - } - else - { - - /* - * Compute the growth in A' * x = b. - */ - if( upper ) - { - jfirst = 1; - jlast = n; - jinc = 1; - } - else - { - jfirst = n; - jlast = 1; - jinc = -1; - } - if( ae_fp_neq(tscal,1) ) - { - grow = 0; - } - else - { - if( nounit ) - { - - /* - * A is non-unit triangular. - * - * Compute GROW = 1/G(j) and XBND = 1/M(j). - * Initially, M(0) = max{x(i), i=1,...,n}. - */ - grow = 1/ae_maxreal(xbnd, smlnum, _state); - xbnd = grow; - j = jfirst; - while((jinc>0&&j<=jlast)||(jinc<0&&j>=jlast)) - { - - /* - * Exit the loop if the growth factor is too small. - */ - if( ae_fp_less_eq(grow,smlnum) ) - { - break; - } - - /* - * G(j) = max( G(j-1), M(j-1)*( 1 + CNORM(j) ) ) - */ - xj = 1+cnorm->ptr.p_double[j]; - grow = ae_minreal(grow, xbnd/xj, _state); - - /* - * M(j) = M(j-1)*( 1 + CNORM(j) ) / abs(A(j,j)) - */ - tjj = ae_fabs(a->ptr.pp_double[j][j], _state); - if( ae_fp_greater(xj,tjj) ) - { - xbnd = xbnd*(tjj/xj); - } - if( j==jlast ) - { - grow = ae_minreal(grow, xbnd, _state); - } - j = j+jinc; - } - } - else - { - - /* - * A is unit triangular. - * - * Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}. - */ - grow = ae_minreal(1, 1/ae_maxreal(xbnd, smlnum, _state), _state); - j = jfirst; - while((jinc>0&&j<=jlast)||(jinc<0&&j>=jlast)) - { - - /* - * Exit the loop if the growth factor is too small. - */ - if( ae_fp_less_eq(grow,smlnum) ) - { - break; - } - - /* - * G(j) = ( 1 + CNORM(j) )*G(j-1) - */ - xj = 1+cnorm->ptr.p_double[j]; - grow = grow/xj; - j = j+jinc; - } - } - } - } - if( ae_fp_greater(grow*tscal,smlnum) ) - { - - /* - * Use the Level 2 BLAS solve if the reciprocal of the bound on - * elements of X is not too small. - */ - if( (upper&¬ran)||(!upper&&!notran) ) - { - if( nounit ) - { - vd = a->ptr.pp_double[n][n]; - } - else - { - vd = 1; - } - x->ptr.p_double[n] = x->ptr.p_double[n]/vd; - for(i=n-1; i>=1; i--) - { - ip1 = i+1; - if( upper ) - { - v = ae_v_dotproduct(&a->ptr.pp_double[i][ip1], 1, &x->ptr.p_double[ip1], 1, ae_v_len(ip1,n)); - } - else - { - v = ae_v_dotproduct(&a->ptr.pp_double[ip1][i], a->stride, &x->ptr.p_double[ip1], 1, ae_v_len(ip1,n)); - } - if( nounit ) - { - vd = a->ptr.pp_double[i][i]; - } - else - { - vd = 1; - } - x->ptr.p_double[i] = (x->ptr.p_double[i]-v)/vd; - } - } - else - { - if( nounit ) - { - vd = a->ptr.pp_double[1][1]; - } - else - { - vd = 1; - } - x->ptr.p_double[1] = x->ptr.p_double[1]/vd; - for(i=2; i<=n; i++) - { - im1 = i-1; - if( upper ) - { - v = ae_v_dotproduct(&a->ptr.pp_double[1][i], a->stride, &x->ptr.p_double[1], 1, ae_v_len(1,im1)); - } - else - { - v = ae_v_dotproduct(&a->ptr.pp_double[i][1], 1, &x->ptr.p_double[1], 1, ae_v_len(1,im1)); - } - if( nounit ) - { - vd = a->ptr.pp_double[i][i]; - } - else - { - vd = 1; - } - x->ptr.p_double[i] = (x->ptr.p_double[i]-v)/vd; - } - } - } - else - { - - /* - * Use a Level 1 BLAS solve, scaling intermediate results. - */ - if( ae_fp_greater(xmax,bignum) ) - { - - /* - * Scale X so that its components are less than or equal to - * BIGNUM in absolute value. - */ - *s = bignum/xmax; - ae_v_muld(&x->ptr.p_double[1], 1, ae_v_len(1,n), *s); - xmax = bignum; - } - if( notran ) - { - - /* - * Solve A * x = b - */ - j = jfirst; - while((jinc>0&&j<=jlast)||(jinc<0&&j>=jlast)) - { - - /* - * Compute x(j) = b(j) / A(j,j), scaling x if necessary. - */ - xj = ae_fabs(x->ptr.p_double[j], _state); - flg = 0; - if( nounit ) - { - tjjs = a->ptr.pp_double[j][j]*tscal; - } - else - { - tjjs = tscal; - if( ae_fp_eq(tscal,1) ) - { - flg = 100; - } - } - if( flg!=100 ) - { - tjj = ae_fabs(tjjs, _state); - if( ae_fp_greater(tjj,smlnum) ) - { - - /* - * abs(A(j,j)) > SMLNUM: - */ - if( ae_fp_less(tjj,1) ) - { - if( ae_fp_greater(xj,tjj*bignum) ) - { - - /* - * Scale x by 1/b(j). - */ - rec = 1/xj; - ae_v_muld(&x->ptr.p_double[1], 1, ae_v_len(1,n), rec); - *s = *s*rec; - xmax = xmax*rec; - } - } - x->ptr.p_double[j] = x->ptr.p_double[j]/tjjs; - xj = ae_fabs(x->ptr.p_double[j], _state); - } - else - { - if( ae_fp_greater(tjj,0) ) - { - - /* - * 0 < abs(A(j,j)) <= SMLNUM: - */ - if( ae_fp_greater(xj,tjj*bignum) ) - { - - /* - * Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM - * to avoid overflow when dividing by A(j,j). - */ - rec = tjj*bignum/xj; - if( ae_fp_greater(cnorm->ptr.p_double[j],1) ) - { - - /* - * Scale by 1/CNORM(j) to avoid overflow when - * multiplying x(j) times column j. - */ - rec = rec/cnorm->ptr.p_double[j]; - } - ae_v_muld(&x->ptr.p_double[1], 1, ae_v_len(1,n), rec); - *s = *s*rec; - xmax = xmax*rec; - } - x->ptr.p_double[j] = x->ptr.p_double[j]/tjjs; - xj = ae_fabs(x->ptr.p_double[j], _state); - } - else - { - - /* - * A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and - * scale = 0, and compute a solution to A*x = 0. - */ - for(i=1; i<=n; i++) - { - x->ptr.p_double[i] = 0; - } - x->ptr.p_double[j] = 1; - xj = 1; - *s = 0; - xmax = 0; - } - } - } - - /* - * Scale x if necessary to avoid overflow when adding a - * multiple of column j of A. - */ - if( ae_fp_greater(xj,1) ) - { - rec = 1/xj; - if( ae_fp_greater(cnorm->ptr.p_double[j],(bignum-xmax)*rec) ) - { - - /* - * Scale x by 1/(2*abs(x(j))). - */ - rec = rec*0.5; - ae_v_muld(&x->ptr.p_double[1], 1, ae_v_len(1,n), rec); - *s = *s*rec; - } - } - else - { - if( ae_fp_greater(xj*cnorm->ptr.p_double[j],bignum-xmax) ) - { - - /* - * Scale x by 1/2. - */ - ae_v_muld(&x->ptr.p_double[1], 1, ae_v_len(1,n), 0.5); - *s = *s*0.5; - } - } - if( upper ) - { - if( j>1 ) - { - - /* - * Compute the update - * x(1:j-1) := x(1:j-1) - x(j) * A(1:j-1,j) - */ - v = x->ptr.p_double[j]*tscal; - jm1 = j-1; - ae_v_subd(&x->ptr.p_double[1], 1, &a->ptr.pp_double[1][j], a->stride, ae_v_len(1,jm1), v); - i = 1; - for(k=2; k<=j-1; k++) - { - if( ae_fp_greater(ae_fabs(x->ptr.p_double[k], _state),ae_fabs(x->ptr.p_double[i], _state)) ) - { - i = k; - } - } - xmax = ae_fabs(x->ptr.p_double[i], _state); - } - } - else - { - if( jptr.p_double[j]*tscal; - ae_v_subd(&x->ptr.p_double[jp1], 1, &a->ptr.pp_double[jp1][j], a->stride, ae_v_len(jp1,n), v); - i = j+1; - for(k=j+2; k<=n; k++) - { - if( ae_fp_greater(ae_fabs(x->ptr.p_double[k], _state),ae_fabs(x->ptr.p_double[i], _state)) ) - { - i = k; - } - } - xmax = ae_fabs(x->ptr.p_double[i], _state); - } - } - j = j+jinc; - } - } - else - { - - /* - * Solve A' * x = b - */ - j = jfirst; - while((jinc>0&&j<=jlast)||(jinc<0&&j>=jlast)) - { - - /* - * Compute x(j) = b(j) - sum A(k,j)*x(k). - * k<>j - */ - xj = ae_fabs(x->ptr.p_double[j], _state); - uscal = tscal; - rec = 1/ae_maxreal(xmax, 1, _state); - if( ae_fp_greater(cnorm->ptr.p_double[j],(bignum-xj)*rec) ) - { - - /* - * If x(j) could overflow, scale x by 1/(2*XMAX). - */ - rec = rec*0.5; - if( nounit ) - { - tjjs = a->ptr.pp_double[j][j]*tscal; - } - else - { - tjjs = tscal; - } - tjj = ae_fabs(tjjs, _state); - if( ae_fp_greater(tjj,1) ) - { - - /* - * Divide by A(j,j) when scaling x if A(j,j) > 1. - */ - rec = ae_minreal(1, rec*tjj, _state); - uscal = uscal/tjjs; - } - if( ae_fp_less(rec,1) ) - { - ae_v_muld(&x->ptr.p_double[1], 1, ae_v_len(1,n), rec); - *s = *s*rec; - xmax = xmax*rec; - } - } - sumj = 0; - if( ae_fp_eq(uscal,1) ) - { - - /* - * If the scaling needed for A in the dot product is 1, - * call DDOT to perform the dot product. - */ - if( upper ) - { - if( j>1 ) - { - jm1 = j-1; - sumj = ae_v_dotproduct(&a->ptr.pp_double[1][j], a->stride, &x->ptr.p_double[1], 1, ae_v_len(1,jm1)); - } - else - { - sumj = 0; - } - } - else - { - if( jptr.pp_double[jp1][j], a->stride, &x->ptr.p_double[jp1], 1, ae_v_len(jp1,n)); - } - } - } - else - { - - /* - * Otherwise, use in-line code for the dot product. - */ - if( upper ) - { - for(i=1; i<=j-1; i++) - { - v = a->ptr.pp_double[i][j]*uscal; - sumj = sumj+v*x->ptr.p_double[i]; - } - } - else - { - if( jptr.pp_double[i][j]*uscal; - sumj = sumj+v*x->ptr.p_double[i]; - } - } - } - } - if( ae_fp_eq(uscal,tscal) ) - { - - /* - * Compute x(j) := ( x(j) - sumj ) / A(j,j) if 1/A(j,j) - * was not used to scale the dotproduct. - */ - x->ptr.p_double[j] = x->ptr.p_double[j]-sumj; - xj = ae_fabs(x->ptr.p_double[j], _state); - flg = 0; - if( nounit ) - { - tjjs = a->ptr.pp_double[j][j]*tscal; - } - else - { - tjjs = tscal; - if( ae_fp_eq(tscal,1) ) - { - flg = 150; - } - } - - /* - * Compute x(j) = x(j) / A(j,j), scaling if necessary. - */ - if( flg!=150 ) - { - tjj = ae_fabs(tjjs, _state); - if( ae_fp_greater(tjj,smlnum) ) - { - - /* - * abs(A(j,j)) > SMLNUM: - */ - if( ae_fp_less(tjj,1) ) - { - if( ae_fp_greater(xj,tjj*bignum) ) - { - - /* - * Scale X by 1/abs(x(j)). - */ - rec = 1/xj; - ae_v_muld(&x->ptr.p_double[1], 1, ae_v_len(1,n), rec); - *s = *s*rec; - xmax = xmax*rec; - } - } - x->ptr.p_double[j] = x->ptr.p_double[j]/tjjs; - } - else - { - if( ae_fp_greater(tjj,0) ) - { - - /* - * 0 < abs(A(j,j)) <= SMLNUM: - */ - if( ae_fp_greater(xj,tjj*bignum) ) - { - - /* - * Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM. - */ - rec = tjj*bignum/xj; - ae_v_muld(&x->ptr.p_double[1], 1, ae_v_len(1,n), rec); - *s = *s*rec; - xmax = xmax*rec; - } - x->ptr.p_double[j] = x->ptr.p_double[j]/tjjs; - } - else - { - - /* - * A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and - * scale = 0, and compute a solution to A'*x = 0. - */ - for(i=1; i<=n; i++) - { - x->ptr.p_double[i] = 0; - } - x->ptr.p_double[j] = 1; - *s = 0; - xmax = 0; - } - } - } - } - else - { - - /* - * Compute x(j) := x(j) / A(j,j) - sumj if the dot - * product has already been divided by 1/A(j,j). - */ - x->ptr.p_double[j] = x->ptr.p_double[j]/tjjs-sumj; - } - xmax = ae_maxreal(xmax, ae_fabs(x->ptr.p_double[j], _state), _state); - j = j+jinc; - } - } - *s = *s/tscal; - } - - /* - * Scale the column norms by 1/TSCAL for return. - */ - if( ae_fp_neq(tscal,1) ) - { - v = 1/tscal; - ae_v_muld(&cnorm->ptr.p_double[1], 1, ae_v_len(1,n), v); - } -} - - - - -/************************************************************************* -Real implementation of CMatrixScaledTRSafeSolve - - -- ALGLIB routine -- - 21.01.2010 - Bochkanov Sergey -*************************************************************************/ -ae_bool rmatrixscaledtrsafesolve(/* Real */ ae_matrix* a, - double sa, - ae_int_t n, - /* Real */ ae_vector* x, - ae_bool isupper, - ae_int_t trans, - ae_bool isunit, - double maxgrowth, - ae_state *_state) -{ - ae_frame _frame_block; - double lnmax; - double nrmb; - double nrmx; - ae_int_t i; - ae_complex alpha; - ae_complex beta; - double vr; - ae_complex cx; - ae_vector tmp; - ae_bool result; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); - - ae_assert(n>0, "RMatrixTRSafeSolve: incorrect N!", _state); - ae_assert(trans==0||trans==1, "RMatrixTRSafeSolve: incorrect Trans!", _state); - result = ae_true; - lnmax = ae_log(ae_maxrealnumber, _state); - - /* - * Quick return if possible - */ - if( n<=0 ) - { - ae_frame_leave(_state); - return result; - } - - /* - * Load norms: right part and X - */ - nrmb = 0; - for(i=0; i<=n-1; i++) - { - nrmb = ae_maxreal(nrmb, ae_fabs(x->ptr.p_double[i], _state), _state); - } - nrmx = 0; - - /* - * Solve - */ - ae_vector_set_length(&tmp, n, _state); - result = ae_true; - if( isupper&&trans==0 ) - { - - /* - * U*x = b - */ - for(i=n-1; i>=0; i--) - { - - /* - * Task is reduced to alpha*x[i] = beta - */ - if( isunit ) - { - alpha = ae_complex_from_d(sa); - } - else - { - alpha = ae_complex_from_d(a->ptr.pp_double[i][i]*sa); - } - if( iptr.pp_double[i][i+1], 1, ae_v_len(i+1,n-1), sa); - vr = ae_v_dotproduct(&tmp.ptr.p_double[i+1], 1, &x->ptr.p_double[i+1], 1, ae_v_len(i+1,n-1)); - beta = ae_complex_from_d(x->ptr.p_double[i]-vr); - } - else - { - beta = ae_complex_from_d(x->ptr.p_double[i]); - } - - /* - * solve alpha*x[i] = beta - */ - result = safesolve_cbasicsolveandupdate(alpha, beta, lnmax, nrmb, maxgrowth, &nrmx, &cx, _state); - if( !result ) - { - ae_frame_leave(_state); - return result; - } - x->ptr.p_double[i] = cx.x; - } - ae_frame_leave(_state); - return result; - } - if( !isupper&&trans==0 ) - { - - /* - * L*x = b - */ - for(i=0; i<=n-1; i++) - { - - /* - * Task is reduced to alpha*x[i] = beta - */ - if( isunit ) - { - alpha = ae_complex_from_d(sa); - } - else - { - alpha = ae_complex_from_d(a->ptr.pp_double[i][i]*sa); - } - if( i>0 ) - { - ae_v_moved(&tmp.ptr.p_double[0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,i-1), sa); - vr = ae_v_dotproduct(&tmp.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,i-1)); - beta = ae_complex_from_d(x->ptr.p_double[i]-vr); - } - else - { - beta = ae_complex_from_d(x->ptr.p_double[i]); - } - - /* - * solve alpha*x[i] = beta - */ - result = safesolve_cbasicsolveandupdate(alpha, beta, lnmax, nrmb, maxgrowth, &nrmx, &cx, _state); - if( !result ) - { - ae_frame_leave(_state); - return result; - } - x->ptr.p_double[i] = cx.x; - } - ae_frame_leave(_state); - return result; - } - if( isupper&&trans==1 ) - { - - /* - * U^T*x = b - */ - for(i=0; i<=n-1; i++) - { - - /* - * Task is reduced to alpha*x[i] = beta - */ - if( isunit ) - { - alpha = ae_complex_from_d(sa); - } - else - { - alpha = ae_complex_from_d(a->ptr.pp_double[i][i]*sa); - } - beta = ae_complex_from_d(x->ptr.p_double[i]); - - /* - * solve alpha*x[i] = beta - */ - result = safesolve_cbasicsolveandupdate(alpha, beta, lnmax, nrmb, maxgrowth, &nrmx, &cx, _state); - if( !result ) - { - ae_frame_leave(_state); - return result; - } - x->ptr.p_double[i] = cx.x; - - /* - * update the rest of right part - */ - if( iptr.pp_double[i][i+1], 1, ae_v_len(i+1,n-1), sa); - ae_v_subd(&x->ptr.p_double[i+1], 1, &tmp.ptr.p_double[i+1], 1, ae_v_len(i+1,n-1), vr); - } - } - ae_frame_leave(_state); - return result; - } - if( !isupper&&trans==1 ) - { - - /* - * L^T*x = b - */ - for(i=n-1; i>=0; i--) - { - - /* - * Task is reduced to alpha*x[i] = beta - */ - if( isunit ) - { - alpha = ae_complex_from_d(sa); - } - else - { - alpha = ae_complex_from_d(a->ptr.pp_double[i][i]*sa); - } - beta = ae_complex_from_d(x->ptr.p_double[i]); - - /* - * solve alpha*x[i] = beta - */ - result = safesolve_cbasicsolveandupdate(alpha, beta, lnmax, nrmb, maxgrowth, &nrmx, &cx, _state); - if( !result ) - { - ae_frame_leave(_state); - return result; - } - x->ptr.p_double[i] = cx.x; - - /* - * update the rest of right part - */ - if( i>0 ) - { - vr = cx.x; - ae_v_moved(&tmp.ptr.p_double[0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,i-1), sa); - ae_v_subd(&x->ptr.p_double[0], 1, &tmp.ptr.p_double[0], 1, ae_v_len(0,i-1), vr); - } - } - ae_frame_leave(_state); - return result; - } - result = ae_false; - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Internal subroutine for safe solution of - - SA*op(A)=b - -where A is NxN upper/lower triangular/unitriangular matrix, op(A) is -either identity transform, transposition or Hermitian transposition, SA is -a scaling factor such that max(|SA*A[i,j]|) is close to 1.0 in magnutude. - -This subroutine limits relative growth of solution (in inf-norm) by -MaxGrowth, returning False if growth exceeds MaxGrowth. Degenerate or -near-degenerate matrices are handled correctly (False is returned) as long -as MaxGrowth is significantly less than MaxRealNumber/norm(b). - - -- ALGLIB routine -- - 21.01.2010 - Bochkanov Sergey -*************************************************************************/ -ae_bool cmatrixscaledtrsafesolve(/* Complex */ ae_matrix* a, - double sa, - ae_int_t n, - /* Complex */ ae_vector* x, - ae_bool isupper, - ae_int_t trans, - ae_bool isunit, - double maxgrowth, - ae_state *_state) -{ - ae_frame _frame_block; - double lnmax; - double nrmb; - double nrmx; - ae_int_t i; - ae_complex alpha; - ae_complex beta; - ae_complex vc; - ae_vector tmp; - ae_bool result; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&tmp, 0, DT_COMPLEX, _state, ae_true); - - ae_assert(n>0, "CMatrixTRSafeSolve: incorrect N!", _state); - ae_assert((trans==0||trans==1)||trans==2, "CMatrixTRSafeSolve: incorrect Trans!", _state); - result = ae_true; - lnmax = ae_log(ae_maxrealnumber, _state); - - /* - * Quick return if possible - */ - if( n<=0 ) - { - ae_frame_leave(_state); - return result; - } - - /* - * Load norms: right part and X - */ - nrmb = 0; - for(i=0; i<=n-1; i++) - { - nrmb = ae_maxreal(nrmb, ae_c_abs(x->ptr.p_complex[i], _state), _state); - } - nrmx = 0; - - /* - * Solve - */ - ae_vector_set_length(&tmp, n, _state); - result = ae_true; - if( isupper&&trans==0 ) - { - - /* - * U*x = b - */ - for(i=n-1; i>=0; i--) - { - - /* - * Task is reduced to alpha*x[i] = beta - */ - if( isunit ) - { - alpha = ae_complex_from_d(sa); - } - else - { - alpha = ae_c_mul_d(a->ptr.pp_complex[i][i],sa); - } - if( iptr.pp_complex[i][i+1], 1, "N", ae_v_len(i+1,n-1), sa); - vc = ae_v_cdotproduct(&tmp.ptr.p_complex[i+1], 1, "N", &x->ptr.p_complex[i+1], 1, "N", ae_v_len(i+1,n-1)); - beta = ae_c_sub(x->ptr.p_complex[i],vc); - } - else - { - beta = x->ptr.p_complex[i]; - } - - /* - * solve alpha*x[i] = beta - */ - result = safesolve_cbasicsolveandupdate(alpha, beta, lnmax, nrmb, maxgrowth, &nrmx, &vc, _state); - if( !result ) - { - ae_frame_leave(_state); - return result; - } - x->ptr.p_complex[i] = vc; - } - ae_frame_leave(_state); - return result; - } - if( !isupper&&trans==0 ) - { - - /* - * L*x = b - */ - for(i=0; i<=n-1; i++) - { - - /* - * Task is reduced to alpha*x[i] = beta - */ - if( isunit ) - { - alpha = ae_complex_from_d(sa); - } - else - { - alpha = ae_c_mul_d(a->ptr.pp_complex[i][i],sa); - } - if( i>0 ) - { - ae_v_cmoved(&tmp.ptr.p_complex[0], 1, &a->ptr.pp_complex[i][0], 1, "N", ae_v_len(0,i-1), sa); - vc = ae_v_cdotproduct(&tmp.ptr.p_complex[0], 1, "N", &x->ptr.p_complex[0], 1, "N", ae_v_len(0,i-1)); - beta = ae_c_sub(x->ptr.p_complex[i],vc); - } - else - { - beta = x->ptr.p_complex[i]; - } - - /* - * solve alpha*x[i] = beta - */ - result = safesolve_cbasicsolveandupdate(alpha, beta, lnmax, nrmb, maxgrowth, &nrmx, &vc, _state); - if( !result ) - { - ae_frame_leave(_state); - return result; - } - x->ptr.p_complex[i] = vc; - } - ae_frame_leave(_state); - return result; - } - if( isupper&&trans==1 ) - { - - /* - * U^T*x = b - */ - for(i=0; i<=n-1; i++) - { - - /* - * Task is reduced to alpha*x[i] = beta - */ - if( isunit ) - { - alpha = ae_complex_from_d(sa); - } - else - { - alpha = ae_c_mul_d(a->ptr.pp_complex[i][i],sa); - } - beta = x->ptr.p_complex[i]; - - /* - * solve alpha*x[i] = beta - */ - result = safesolve_cbasicsolveandupdate(alpha, beta, lnmax, nrmb, maxgrowth, &nrmx, &vc, _state); - if( !result ) - { - ae_frame_leave(_state); - return result; - } - x->ptr.p_complex[i] = vc; - - /* - * update the rest of right part - */ - if( iptr.pp_complex[i][i+1], 1, "N", ae_v_len(i+1,n-1), sa); - ae_v_csubc(&x->ptr.p_complex[i+1], 1, &tmp.ptr.p_complex[i+1], 1, "N", ae_v_len(i+1,n-1), vc); - } - } - ae_frame_leave(_state); - return result; - } - if( !isupper&&trans==1 ) - { - - /* - * L^T*x = b - */ - for(i=n-1; i>=0; i--) - { - - /* - * Task is reduced to alpha*x[i] = beta - */ - if( isunit ) - { - alpha = ae_complex_from_d(sa); - } - else - { - alpha = ae_c_mul_d(a->ptr.pp_complex[i][i],sa); - } - beta = x->ptr.p_complex[i]; - - /* - * solve alpha*x[i] = beta - */ - result = safesolve_cbasicsolveandupdate(alpha, beta, lnmax, nrmb, maxgrowth, &nrmx, &vc, _state); - if( !result ) - { - ae_frame_leave(_state); - return result; - } - x->ptr.p_complex[i] = vc; - - /* - * update the rest of right part - */ - if( i>0 ) - { - ae_v_cmoved(&tmp.ptr.p_complex[0], 1, &a->ptr.pp_complex[i][0], 1, "N", ae_v_len(0,i-1), sa); - ae_v_csubc(&x->ptr.p_complex[0], 1, &tmp.ptr.p_complex[0], 1, "N", ae_v_len(0,i-1), vc); - } - } - ae_frame_leave(_state); - return result; - } - if( isupper&&trans==2 ) - { - - /* - * U^H*x = b - */ - for(i=0; i<=n-1; i++) - { - - /* - * Task is reduced to alpha*x[i] = beta - */ - if( isunit ) - { - alpha = ae_complex_from_d(sa); - } - else - { - alpha = ae_c_mul_d(ae_c_conj(a->ptr.pp_complex[i][i], _state),sa); - } - beta = x->ptr.p_complex[i]; - - /* - * solve alpha*x[i] = beta - */ - result = safesolve_cbasicsolveandupdate(alpha, beta, lnmax, nrmb, maxgrowth, &nrmx, &vc, _state); - if( !result ) - { - ae_frame_leave(_state); - return result; - } - x->ptr.p_complex[i] = vc; - - /* - * update the rest of right part - */ - if( iptr.pp_complex[i][i+1], 1, "Conj", ae_v_len(i+1,n-1), sa); - ae_v_csubc(&x->ptr.p_complex[i+1], 1, &tmp.ptr.p_complex[i+1], 1, "N", ae_v_len(i+1,n-1), vc); - } - } - ae_frame_leave(_state); - return result; - } - if( !isupper&&trans==2 ) - { - - /* - * L^T*x = b - */ - for(i=n-1; i>=0; i--) - { - - /* - * Task is reduced to alpha*x[i] = beta - */ - if( isunit ) - { - alpha = ae_complex_from_d(sa); - } - else - { - alpha = ae_c_mul_d(ae_c_conj(a->ptr.pp_complex[i][i], _state),sa); - } - beta = x->ptr.p_complex[i]; - - /* - * solve alpha*x[i] = beta - */ - result = safesolve_cbasicsolveandupdate(alpha, beta, lnmax, nrmb, maxgrowth, &nrmx, &vc, _state); - if( !result ) - { - ae_frame_leave(_state); - return result; - } - x->ptr.p_complex[i] = vc; - - /* - * update the rest of right part - */ - if( i>0 ) - { - ae_v_cmoved(&tmp.ptr.p_complex[0], 1, &a->ptr.pp_complex[i][0], 1, "Conj", ae_v_len(0,i-1), sa); - ae_v_csubc(&x->ptr.p_complex[0], 1, &tmp.ptr.p_complex[0], 1, "N", ae_v_len(0,i-1), vc); - } - } - ae_frame_leave(_state); - return result; - } - result = ae_false; - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -complex basic solver-updater for reduced linear system - - alpha*x[i] = beta - -solves this equation and updates it in overlfow-safe manner (keeping track -of relative growth of solution). - -Parameters: - Alpha - alpha - Beta - beta - LnMax - precomputed Ln(MaxRealNumber) - BNorm - inf-norm of b (right part of original system) - MaxGrowth- maximum growth of norm(x) relative to norm(b) - XNorm - inf-norm of other components of X (which are already processed) - it is updated by CBasicSolveAndUpdate. - X - solution - - -- ALGLIB routine -- - 26.01.2009 - Bochkanov Sergey -*************************************************************************/ -static ae_bool safesolve_cbasicsolveandupdate(ae_complex alpha, - ae_complex beta, - double lnmax, - double bnorm, - double maxgrowth, - double* xnorm, - ae_complex* x, - ae_state *_state) -{ - double v; - ae_bool result; - - x->x = 0; - x->y = 0; - - result = ae_false; - if( ae_c_eq_d(alpha,0) ) - { - return result; - } - if( ae_c_neq_d(beta,0) ) - { - - /* - * alpha*x[i]=beta - */ - v = ae_log(ae_c_abs(beta, _state), _state)-ae_log(ae_c_abs(alpha, _state), _state); - if( ae_fp_greater(v,lnmax) ) - { - return result; - } - *x = ae_c_div(beta,alpha); - } - else - { - - /* - * alpha*x[i]=0 - */ - *x = ae_complex_from_d(0); - } - - /* - * update NrmX, test growth limit - */ - *xnorm = ae_maxreal(*xnorm, ae_c_abs(*x, _state), _state); - if( ae_fp_greater(*xnorm,maxgrowth*bnorm) ) - { - return result; - } - result = ae_true; - return result; -} - - - - -/************************************************************************* -Prepares HPC compuations of chunked gradient with HPCChunkedGradient(). -You have to call this function before calling HPCChunkedGradient() for -a new set of weights. You have to call it only once, see example below: - -HOW TO PROCESS DATASET WITH THIS FUNCTION: - Grad:=0 - HPCPrepareChunkedGradient(Weights, WCount, NTotal, NOut, Buf) - foreach chunk-of-dataset do - HPCChunkedGradient(...) - HPCFinalizeChunkedGradient(Buf, Grad) - -*************************************************************************/ -void hpcpreparechunkedgradient(/* Real */ ae_vector* weights, - ae_int_t wcount, - ae_int_t ntotal, - ae_int_t nin, - ae_int_t nout, - mlpbuffers* buf, - ae_state *_state) -{ - ae_int_t i; - ae_int_t batch4size; - ae_int_t chunksize; - - - chunksize = 4; - batch4size = 3*chunksize*ntotal+chunksize*(2*nout+1); - if( buf->xy.rowsxy.colsxy, chunksize, nin+nout, _state); - } - if( buf->xy2.rowsxy2.colsxy2, chunksize, nin+nout, _state); - } - if( buf->xyrow.cntxyrow, nin+nout, _state); - } - if( buf->x.cntx, nin, _state); - } - if( buf->y.cnty, nout, _state); - } - if( buf->desiredy.cntdesiredy, nout, _state); - } - if( buf->batch4buf.cntbatch4buf, batch4size, _state); - } - if( buf->hpcbuf.cnthpcbuf, wcount, _state); - } - if( buf->g.cntg, wcount, _state); - } - if( !hpccores_hpcpreparechunkedgradientx(weights, wcount, &buf->hpcbuf, _state) ) - { - for(i=0; i<=wcount-1; i++) - { - buf->hpcbuf.ptr.p_double[i] = 0.0; - } - } - buf->wcount = wcount; - buf->ntotal = ntotal; - buf->nin = nin; - buf->nout = nout; - buf->chunksize = chunksize; -} - - -/************************************************************************* -Finalizes HPC compuations of chunked gradient with HPCChunkedGradient(). -You have to call this function after calling HPCChunkedGradient() for -a new set of weights. You have to call it only once, see example below: - -HOW TO PROCESS DATASET WITH THIS FUNCTION: - Grad:=0 - HPCPrepareChunkedGradient(Weights, WCount, NTotal, NOut, Buf) - foreach chunk-of-dataset do - HPCChunkedGradient(...) - HPCFinalizeChunkedGradient(Buf, Grad) - -*************************************************************************/ -void hpcfinalizechunkedgradient(mlpbuffers* buf, - /* Real */ ae_vector* grad, - ae_state *_state) -{ - ae_int_t i; - - - if( !hpccores_hpcfinalizechunkedgradientx(&buf->hpcbuf, buf->wcount, grad, _state) ) - { - for(i=0; i<=buf->wcount-1; i++) - { - grad->ptr.p_double[i] = grad->ptr.p_double[i]+buf->hpcbuf.ptr.p_double[i]; - } - } -} - - -/************************************************************************* -Fast kernel for chunked gradient. - -*************************************************************************/ -ae_bool hpcchunkedgradient(/* Real */ ae_vector* weights, - /* Integer */ ae_vector* structinfo, - /* Real */ ae_vector* columnmeans, - /* Real */ ae_vector* columnsigmas, - /* Real */ ae_matrix* xy, - ae_int_t cstart, - ae_int_t csize, - /* Real */ ae_vector* batch4buf, - /* Real */ ae_vector* hpcbuf, - double* e, - ae_bool naturalerrorfunc, - ae_state *_state) -{ -#ifndef ALGLIB_INTERCEPTS_SSE2 - ae_bool result; - - - result = ae_false; - return result; -#else - return _ialglib_i_hpcchunkedgradient(weights, structinfo, columnmeans, columnsigmas, xy, cstart, csize, batch4buf, hpcbuf, e, naturalerrorfunc); -#endif -} - - -/************************************************************************* -Fast kernel for chunked processing. - -*************************************************************************/ -ae_bool hpcchunkedprocess(/* Real */ ae_vector* weights, - /* Integer */ ae_vector* structinfo, - /* Real */ ae_vector* columnmeans, - /* Real */ ae_vector* columnsigmas, - /* Real */ ae_matrix* xy, - ae_int_t cstart, - ae_int_t csize, - /* Real */ ae_vector* batch4buf, - /* Real */ ae_vector* hpcbuf, - ae_state *_state) -{ -#ifndef ALGLIB_INTERCEPTS_SSE2 - ae_bool result; - - - result = ae_false; - return result; -#else - return _ialglib_i_hpcchunkedprocess(weights, structinfo, columnmeans, columnsigmas, xy, cstart, csize, batch4buf, hpcbuf); -#endif -} - - -/************************************************************************* -Stub function. - - -- ALGLIB routine -- - 14.06.2013 - Bochkanov Sergey -*************************************************************************/ -static ae_bool hpccores_hpcpreparechunkedgradientx(/* Real */ ae_vector* weights, - ae_int_t wcount, - /* Real */ ae_vector* hpcbuf, - ae_state *_state) -{ -#ifndef ALGLIB_INTERCEPTS_SSE2 - ae_bool result; - - - result = ae_false; - return result; -#else - return _ialglib_i_hpcpreparechunkedgradientx(weights, wcount, hpcbuf); -#endif -} - - -/************************************************************************* -Stub function. - - -- ALGLIB routine -- - 14.06.2013 - Bochkanov Sergey -*************************************************************************/ -static ae_bool hpccores_hpcfinalizechunkedgradientx(/* Real */ ae_vector* buf, - ae_int_t wcount, - /* Real */ ae_vector* grad, - ae_state *_state) -{ -#ifndef ALGLIB_INTERCEPTS_SSE2 - ae_bool result; - - - result = ae_false; - return result; -#else - return _ialglib_i_hpcfinalizechunkedgradientx(buf, wcount, grad); -#endif -} - - -ae_bool _mlpbuffers_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - mlpbuffers *p = (mlpbuffers*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->batch4buf, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->hpcbuf, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->xy, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->xy2, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->xyrow, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->y, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->desiredy, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->g, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->tmp0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _mlpbuffers_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - mlpbuffers *dst = (mlpbuffers*)_dst; - mlpbuffers *src = (mlpbuffers*)_src; - dst->chunksize = src->chunksize; - dst->ntotal = src->ntotal; - dst->nin = src->nin; - dst->nout = src->nout; - dst->wcount = src->wcount; - if( !ae_vector_init_copy(&dst->batch4buf, &src->batch4buf, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->hpcbuf, &src->hpcbuf, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->xy, &src->xy, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->xy2, &src->xy2, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->xyrow, &src->xyrow, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->y, &src->y, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->desiredy, &src->desiredy, _state, make_automatic) ) - return ae_false; - dst->e = src->e; - if( !ae_vector_init_copy(&dst->g, &src->g, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->tmp0, &src->tmp0, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _mlpbuffers_clear(void* _p) -{ - mlpbuffers *p = (mlpbuffers*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->batch4buf); - ae_vector_clear(&p->hpcbuf); - ae_matrix_clear(&p->xy); - ae_matrix_clear(&p->xy2); - ae_vector_clear(&p->xyrow); - ae_vector_clear(&p->x); - ae_vector_clear(&p->y); - ae_vector_clear(&p->desiredy); - ae_vector_clear(&p->g); - ae_vector_clear(&p->tmp0); -} - - -void _mlpbuffers_destroy(void* _p) -{ - mlpbuffers *p = (mlpbuffers*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->batch4buf); - ae_vector_destroy(&p->hpcbuf); - ae_matrix_destroy(&p->xy); - ae_matrix_destroy(&p->xy2); - ae_vector_destroy(&p->xyrow); - ae_vector_destroy(&p->x); - ae_vector_destroy(&p->y); - ae_vector_destroy(&p->desiredy); - ae_vector_destroy(&p->g); - ae_vector_destroy(&p->tmp0); -} - - - - -/************************************************************************* -More precise dot-product. Absolute error of subroutine result is about -1 ulp of max(MX,V), where: - MX = max( |a[i]*b[i]| ) - V = |(a,b)| - -INPUT PARAMETERS - A - array[0..N-1], vector 1 - B - array[0..N-1], vector 2 - N - vectors length, N<2^29. - Temp - array[0..N-1], pre-allocated temporary storage - -OUTPUT PARAMETERS - R - (A,B) - RErr - estimate of error. This estimate accounts for both errors - during calculation of (A,B) and errors introduced by - rounding of A and B to fit in double (about 1 ulp). - - -- ALGLIB -- - Copyright 24.08.2009 by Bochkanov Sergey -*************************************************************************/ -void xdot(/* Real */ ae_vector* a, - /* Real */ ae_vector* b, - ae_int_t n, - /* Real */ ae_vector* temp, - double* r, - double* rerr, - ae_state *_state) -{ - ae_int_t i; - double mx; - double v; - - *r = 0; - *rerr = 0; - - - /* - * special cases: - * * N=0 - */ - if( n==0 ) - { - *r = 0; - *rerr = 0; - return; - } - mx = 0; - for(i=0; i<=n-1; i++) - { - v = a->ptr.p_double[i]*b->ptr.p_double[i]; - temp->ptr.p_double[i] = v; - mx = ae_maxreal(mx, ae_fabs(v, _state), _state); - } - if( ae_fp_eq(mx,0) ) - { - *r = 0; - *rerr = 0; - return; - } - xblas_xsum(temp, mx, n, r, rerr, _state); -} - - -/************************************************************************* -More precise complex dot-product. Absolute error of subroutine result is -about 1 ulp of max(MX,V), where: - MX = max( |a[i]*b[i]| ) - V = |(a,b)| - -INPUT PARAMETERS - A - array[0..N-1], vector 1 - B - array[0..N-1], vector 2 - N - vectors length, N<2^29. - Temp - array[0..2*N-1], pre-allocated temporary storage - -OUTPUT PARAMETERS - R - (A,B) - RErr - estimate of error. This estimate accounts for both errors - during calculation of (A,B) and errors introduced by - rounding of A and B to fit in double (about 1 ulp). - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void xcdot(/* Complex */ ae_vector* a, - /* Complex */ ae_vector* b, - ae_int_t n, - /* Real */ ae_vector* temp, - ae_complex* r, - double* rerr, - ae_state *_state) -{ - ae_int_t i; - double mx; - double v; - double rerrx; - double rerry; - - r->x = 0; - r->y = 0; - *rerr = 0; - - - /* - * special cases: - * * N=0 - */ - if( n==0 ) - { - *r = ae_complex_from_d(0); - *rerr = 0; - return; - } - - /* - * calculate real part - */ - mx = 0; - for(i=0; i<=n-1; i++) - { - v = a->ptr.p_complex[i].x*b->ptr.p_complex[i].x; - temp->ptr.p_double[2*i+0] = v; - mx = ae_maxreal(mx, ae_fabs(v, _state), _state); - v = -a->ptr.p_complex[i].y*b->ptr.p_complex[i].y; - temp->ptr.p_double[2*i+1] = v; - mx = ae_maxreal(mx, ae_fabs(v, _state), _state); - } - if( ae_fp_eq(mx,0) ) - { - r->x = 0; - rerrx = 0; - } - else - { - xblas_xsum(temp, mx, 2*n, &r->x, &rerrx, _state); - } - - /* - * calculate imaginary part - */ - mx = 0; - for(i=0; i<=n-1; i++) - { - v = a->ptr.p_complex[i].x*b->ptr.p_complex[i].y; - temp->ptr.p_double[2*i+0] = v; - mx = ae_maxreal(mx, ae_fabs(v, _state), _state); - v = a->ptr.p_complex[i].y*b->ptr.p_complex[i].x; - temp->ptr.p_double[2*i+1] = v; - mx = ae_maxreal(mx, ae_fabs(v, _state), _state); - } - if( ae_fp_eq(mx,0) ) - { - r->y = 0; - rerry = 0; - } - else - { - xblas_xsum(temp, mx, 2*n, &r->y, &rerry, _state); - } - - /* - * total error - */ - if( ae_fp_eq(rerrx,0)&&ae_fp_eq(rerry,0) ) - { - *rerr = 0; - } - else - { - *rerr = ae_maxreal(rerrx, rerry, _state)*ae_sqrt(1+ae_sqr(ae_minreal(rerrx, rerry, _state)/ae_maxreal(rerrx, rerry, _state), _state), _state); - } -} - - -/************************************************************************* -Internal subroutine for extra-precise calculation of SUM(w[i]). - -INPUT PARAMETERS: - W - array[0..N-1], values to be added - W is modified during calculations. - MX - max(W[i]) - N - array size - -OUTPUT PARAMETERS: - R - SUM(w[i]) - RErr- error estimate for R - - -- ALGLIB -- - Copyright 24.08.2009 by Bochkanov Sergey -*************************************************************************/ -static void xblas_xsum(/* Real */ ae_vector* w, - double mx, - ae_int_t n, - double* r, - double* rerr, - ae_state *_state) -{ - ae_int_t i; - ae_int_t k; - ae_int_t ks; - double v; - double s; - double ln2; - double chunk; - double invchunk; - ae_bool allzeros; - - *r = 0; - *rerr = 0; - - - /* - * special cases: - * * N=0 - * * N is too large to use integer arithmetics - */ - if( n==0 ) - { - *r = 0; - *rerr = 0; - return; - } - if( ae_fp_eq(mx,0) ) - { - *r = 0; - *rerr = 0; - return; - } - ae_assert(n<536870912, "XDot: N is too large!", _state); - - /* - * Prepare - */ - ln2 = ae_log(2, _state); - *rerr = mx*ae_machineepsilon; - - /* - * 1. find S such that 0.5<=S*MX<1 - * 2. multiply W by S, so task is normalized in some sense - * 3. S:=1/S so we can obtain original vector multiplying by S - */ - k = ae_round(ae_log(mx, _state)/ln2, _state); - s = xblas_xfastpow(2, -k, _state); - while(ae_fp_greater_eq(s*mx,1)) - { - s = 0.5*s; - } - while(ae_fp_less(s*mx,0.5)) - { - s = 2*s; - } - ae_v_muld(&w->ptr.p_double[0], 1, ae_v_len(0,n-1), s); - s = 1/s; - - /* - * find Chunk=2^M such that N*Chunk<2^29 - * - * we have chosen upper limit (2^29) with enough space left - * to tolerate possible problems with rounding and N's close - * to the limit, so we don't want to be very strict here. - */ - k = ae_trunc(ae_log((double)536870912/(double)n, _state)/ln2, _state); - chunk = xblas_xfastpow(2, k, _state); - if( ae_fp_less(chunk,2) ) - { - chunk = 2; - } - invchunk = 1/chunk; - - /* - * calculate result - */ - *r = 0; - ae_v_muld(&w->ptr.p_double[0], 1, ae_v_len(0,n-1), chunk); - for(;;) - { - s = s*invchunk; - allzeros = ae_true; - ks = 0; - for(i=0; i<=n-1; i++) - { - v = w->ptr.p_double[i]; - k = ae_trunc(v, _state); - if( ae_fp_neq(v,k) ) - { - allzeros = ae_false; - } - w->ptr.p_double[i] = chunk*(v-k); - ks = ks+k; - } - *r = *r+s*ks; - v = ae_fabs(*r, _state); - if( allzeros||ae_fp_eq(s*n+mx,mx) ) - { - break; - } - } - - /* - * correct error - */ - *rerr = ae_maxreal(*rerr, ae_fabs(*r, _state)*ae_machineepsilon, _state); -} - - -/************************************************************************* -Fast Pow - - -- ALGLIB -- - Copyright 24.08.2009 by Bochkanov Sergey -*************************************************************************/ -static double xblas_xfastpow(double r, ae_int_t n, ae_state *_state) -{ - double result; - - - result = 0; - if( n>0 ) - { - if( n%2==0 ) - { - result = ae_sqr(xblas_xfastpow(r, n/2, _state), _state); - } - else - { - result = r*xblas_xfastpow(r, n-1, _state); - } - return result; - } - if( n==0 ) - { - result = 1; - } - if( n<0 ) - { - result = xblas_xfastpow(1/r, -n, _state); - } - return result; -} - - - - -/************************************************************************* -Normalizes direction/step pair: makes |D|=1, scales Stp. -If |D|=0, it returns, leavind D/Stp unchanged. - - -- ALGLIB -- - Copyright 01.04.2010 by Bochkanov Sergey -*************************************************************************/ -void linminnormalized(/* Real */ ae_vector* d, - double* stp, - ae_int_t n, - ae_state *_state) -{ - double mx; - double s; - ae_int_t i; - - - - /* - * first, scale D to avoid underflow/overflow durng squaring - */ - mx = 0; - for(i=0; i<=n-1; i++) - { - mx = ae_maxreal(mx, ae_fabs(d->ptr.p_double[i], _state), _state); - } - if( ae_fp_eq(mx,0) ) - { - return; - } - s = 1/mx; - ae_v_muld(&d->ptr.p_double[0], 1, ae_v_len(0,n-1), s); - *stp = *stp/s; - - /* - * normalize D - */ - s = ae_v_dotproduct(&d->ptr.p_double[0], 1, &d->ptr.p_double[0], 1, ae_v_len(0,n-1)); - s = 1/ae_sqrt(s, _state); - ae_v_muld(&d->ptr.p_double[0], 1, ae_v_len(0,n-1), s); - *stp = *stp/s; -} - - -/************************************************************************* -THE PURPOSE OF MCSRCH IS TO FIND A STEP WHICH SATISFIES A SUFFICIENT -DECREASE CONDITION AND A CURVATURE CONDITION. - -AT EACH STAGE THE SUBROUTINE UPDATES AN INTERVAL OF UNCERTAINTY WITH -ENDPOINTS STX AND STY. THE INTERVAL OF UNCERTAINTY IS INITIALLY CHOSEN -SO THAT IT CONTAINS A MINIMIZER OF THE MODIFIED FUNCTION - - F(X+STP*S) - F(X) - FTOL*STP*(GRADF(X)'S). - -IF A STEP IS OBTAINED FOR WHICH THE MODIFIED FUNCTION HAS A NONPOSITIVE -FUNCTION VALUE AND NONNEGATIVE DERIVATIVE, THEN THE INTERVAL OF -UNCERTAINTY IS CHOSEN SO THAT IT CONTAINS A MINIMIZER OF F(X+STP*S). - -THE ALGORITHM IS DESIGNED TO FIND A STEP WHICH SATISFIES THE SUFFICIENT -DECREASE CONDITION - - F(X+STP*S) .LE. F(X) + FTOL*STP*(GRADF(X)'S), - -AND THE CURVATURE CONDITION - - ABS(GRADF(X+STP*S)'S)) .LE. GTOL*ABS(GRADF(X)'S). - -IF FTOL IS LESS THAN GTOL AND IF, FOR EXAMPLE, THE FUNCTION IS BOUNDED -BELOW, THEN THERE IS ALWAYS A STEP WHICH SATISFIES BOTH CONDITIONS. -IF NO STEP CAN BE FOUND WHICH SATISFIES BOTH CONDITIONS, THEN THE -ALGORITHM USUALLY STOPS WHEN ROUNDING ERRORS PREVENT FURTHER PROGRESS. -IN THIS CASE STP ONLY SATISFIES THE SUFFICIENT DECREASE CONDITION. - - -:::::::::::::IMPORTANT NOTES::::::::::::: - -NOTE 1: - -This routine guarantees that it will stop at the last point where function -value was calculated. It won't make several additional function evaluations -after finding good point. So if you store function evaluations requested by -this routine, you can be sure that last one is the point where we've stopped. - -NOTE 2: - -when 0xtrapf = 4.0; - zero = 0; - if( ae_fp_eq(stpmax,0) ) - { - stpmax = linmin_defstpmax; - } - if( ae_fp_less(*stp,linmin_stpmin) ) - { - *stp = linmin_stpmin; - } - if( ae_fp_greater(*stp,stpmax) ) - { - *stp = stpmax; - } - - /* - * Main cycle - */ - for(;;) - { - if( *stage==0 ) - { - - /* - * NEXT - */ - *stage = 2; - continue; - } - if( *stage==2 ) - { - state->infoc = 1; - *info = 0; - - /* - * CHECK THE INPUT PARAMETERS FOR ERRORS. - */ - if( ae_fp_less(stpmax,linmin_stpmin)&&ae_fp_greater(stpmax,0) ) - { - *info = 5; - *stp = 0.0; - return; - } - if( ((((((n<=0||ae_fp_less_eq(*stp,0))||ae_fp_less(linmin_ftol,0))||ae_fp_less(gtol,zero))||ae_fp_less(linmin_xtol,zero))||ae_fp_less(linmin_stpmin,zero))||ae_fp_less(stpmax,linmin_stpmin))||linmin_maxfev<=0 ) - { - *stage = 0; - return; - } - - /* - * COMPUTE THE INITIAL GRADIENT IN THE SEARCH DIRECTION - * AND CHECK THAT S IS A DESCENT DIRECTION. - */ - v = ae_v_dotproduct(&g->ptr.p_double[0], 1, &s->ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->dginit = v; - if( ae_fp_greater_eq(state->dginit,0) ) - { - *stage = 0; - return; - } - - /* - * INITIALIZE LOCAL VARIABLES. - */ - state->brackt = ae_false; - state->stage1 = ae_true; - *nfev = 0; - state->finit = *f; - state->dgtest = linmin_ftol*state->dginit; - state->width = stpmax-linmin_stpmin; - state->width1 = state->width/p5; - ae_v_move(&wa->ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,n-1)); - - /* - * THE VARIABLES STX, FX, DGX CONTAIN THE VALUES OF THE STEP, - * FUNCTION, AND DIRECTIONAL DERIVATIVE AT THE BEST STEP. - * THE VARIABLES STY, FY, DGY CONTAIN THE VALUE OF THE STEP, - * FUNCTION, AND DERIVATIVE AT THE OTHER ENDPOINT OF - * THE INTERVAL OF UNCERTAINTY. - * THE VARIABLES STP, F, DG CONTAIN THE VALUES OF THE STEP, - * FUNCTION, AND DERIVATIVE AT THE CURRENT STEP. - */ - state->stx = 0; - state->fx = state->finit; - state->dgx = state->dginit; - state->sty = 0; - state->fy = state->finit; - state->dgy = state->dginit; - - /* - * NEXT - */ - *stage = 3; - continue; - } - if( *stage==3 ) - { - - /* - * START OF ITERATION. - * - * SET THE MINIMUM AND MAXIMUM STEPS TO CORRESPOND - * TO THE PRESENT INTERVAL OF UNCERTAINTY. - */ - if( state->brackt ) - { - if( ae_fp_less(state->stx,state->sty) ) - { - state->stmin = state->stx; - state->stmax = state->sty; - } - else - { - state->stmin = state->sty; - state->stmax = state->stx; - } - } - else - { - state->stmin = state->stx; - state->stmax = *stp+state->xtrapf*(*stp-state->stx); - } - - /* - * FORCE THE STEP TO BE WITHIN THE BOUNDS STPMAX AND STPMIN. - */ - if( ae_fp_greater(*stp,stpmax) ) - { - *stp = stpmax; - } - if( ae_fp_less(*stp,linmin_stpmin) ) - { - *stp = linmin_stpmin; - } - - /* - * IF AN UNUSUAL TERMINATION IS TO OCCUR THEN LET - * STP BE THE LOWEST POINT OBTAINED SO FAR. - */ - if( (((state->brackt&&(ae_fp_less_eq(*stp,state->stmin)||ae_fp_greater_eq(*stp,state->stmax)))||*nfev>=linmin_maxfev-1)||state->infoc==0)||(state->brackt&&ae_fp_less_eq(state->stmax-state->stmin,linmin_xtol*state->stmax)) ) - { - *stp = state->stx; - } - - /* - * EVALUATE THE FUNCTION AND GRADIENT AT STP - * AND COMPUTE THE DIRECTIONAL DERIVATIVE. - */ - ae_v_move(&x->ptr.p_double[0], 1, &wa->ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_addd(&x->ptr.p_double[0], 1, &s->ptr.p_double[0], 1, ae_v_len(0,n-1), *stp); - - /* - * NEXT - */ - *stage = 4; - return; - } - if( *stage==4 ) - { - *info = 0; - *nfev = *nfev+1; - v = ae_v_dotproduct(&g->ptr.p_double[0], 1, &s->ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->dg = v; - state->ftest1 = state->finit+*stp*state->dgtest; - - /* - * TEST FOR CONVERGENCE. - */ - if( (state->brackt&&(ae_fp_less_eq(*stp,state->stmin)||ae_fp_greater_eq(*stp,state->stmax)))||state->infoc==0 ) - { - *info = 6; - } - if( (ae_fp_eq(*stp,stpmax)&&ae_fp_less_eq(*f,state->ftest1))&&ae_fp_less_eq(state->dg,state->dgtest) ) - { - *info = 5; - } - if( ae_fp_eq(*stp,linmin_stpmin)&&(ae_fp_greater(*f,state->ftest1)||ae_fp_greater_eq(state->dg,state->dgtest)) ) - { - *info = 4; - } - if( *nfev>=linmin_maxfev ) - { - *info = 3; - } - if( state->brackt&&ae_fp_less_eq(state->stmax-state->stmin,linmin_xtol*state->stmax) ) - { - *info = 2; - } - if( ae_fp_less_eq(*f,state->ftest1)&&ae_fp_less_eq(ae_fabs(state->dg, _state),-gtol*state->dginit) ) - { - *info = 1; - } - - /* - * CHECK FOR TERMINATION. - */ - if( *info!=0 ) - { - *stage = 0; - return; - } - - /* - * IN THE FIRST STAGE WE SEEK A STEP FOR WHICH THE MODIFIED - * FUNCTION HAS A NONPOSITIVE VALUE AND NONNEGATIVE DERIVATIVE. - */ - if( (state->stage1&&ae_fp_less_eq(*f,state->ftest1))&&ae_fp_greater_eq(state->dg,ae_minreal(linmin_ftol, gtol, _state)*state->dginit) ) - { - state->stage1 = ae_false; - } - - /* - * A MODIFIED FUNCTION IS USED TO PREDICT THE STEP ONLY IF - * WE HAVE NOT OBTAINED A STEP FOR WHICH THE MODIFIED - * FUNCTION HAS A NONPOSITIVE FUNCTION VALUE AND NONNEGATIVE - * DERIVATIVE, AND IF A LOWER FUNCTION VALUE HAS BEEN - * OBTAINED BUT THE DECREASE IS NOT SUFFICIENT. - */ - if( (state->stage1&&ae_fp_less_eq(*f,state->fx))&&ae_fp_greater(*f,state->ftest1) ) - { - - /* - * DEFINE THE MODIFIED FUNCTION AND DERIVATIVE VALUES. - */ - state->fm = *f-*stp*state->dgtest; - state->fxm = state->fx-state->stx*state->dgtest; - state->fym = state->fy-state->sty*state->dgtest; - state->dgm = state->dg-state->dgtest; - state->dgxm = state->dgx-state->dgtest; - state->dgym = state->dgy-state->dgtest; - - /* - * CALL CSTEP TO UPDATE THE INTERVAL OF UNCERTAINTY - * AND TO COMPUTE THE NEW STEP. - */ - linmin_mcstep(&state->stx, &state->fxm, &state->dgxm, &state->sty, &state->fym, &state->dgym, stp, state->fm, state->dgm, &state->brackt, state->stmin, state->stmax, &state->infoc, _state); - - /* - * RESET THE FUNCTION AND GRADIENT VALUES FOR F. - */ - state->fx = state->fxm+state->stx*state->dgtest; - state->fy = state->fym+state->sty*state->dgtest; - state->dgx = state->dgxm+state->dgtest; - state->dgy = state->dgym+state->dgtest; - } - else - { - - /* - * CALL MCSTEP TO UPDATE THE INTERVAL OF UNCERTAINTY - * AND TO COMPUTE THE NEW STEP. - */ - linmin_mcstep(&state->stx, &state->fx, &state->dgx, &state->sty, &state->fy, &state->dgy, stp, *f, state->dg, &state->brackt, state->stmin, state->stmax, &state->infoc, _state); - } - - /* - * FORCE A SUFFICIENT DECREASE IN THE SIZE OF THE - * INTERVAL OF UNCERTAINTY. - */ - if( state->brackt ) - { - if( ae_fp_greater_eq(ae_fabs(state->sty-state->stx, _state),p66*state->width1) ) - { - *stp = state->stx+p5*(state->sty-state->stx); - } - state->width1 = state->width; - state->width = ae_fabs(state->sty-state->stx, _state); - } - - /* - * NEXT. - */ - *stage = 3; - continue; - } - } -} - - -/************************************************************************* -These functions perform Armijo line search using at most FMAX function -evaluations. It doesn't enforce some kind of " sufficient decrease" -criterion - it just tries different Armijo steps and returns optimum found -so far. - -Optimization is done using F-rcomm interface: -* ArmijoCreate initializes State structure - (reusing previously allocated buffers) -* ArmijoIteration is subsequently called -* ArmijoResults returns results - -INPUT PARAMETERS: - N - problem size - X - array[N], starting point - F - F(X+S*STP) - S - step direction, S>0 - STP - step length - STPMAX - maximum value for STP or zero (if no limit is imposed) - FMAX - maximum number of function evaluations - State - optimization state - - -- ALGLIB -- - Copyright 05.10.2010 by Bochkanov Sergey -*************************************************************************/ -void armijocreate(ae_int_t n, - /* Real */ ae_vector* x, - double f, - /* Real */ ae_vector* s, - double stp, - double stpmax, - ae_int_t fmax, - armijostate* state, - ae_state *_state) -{ - - - if( state->x.cntx, n, _state); - } - if( state->xbase.cntxbase, n, _state); - } - if( state->s.cnts, n, _state); - } - state->stpmax = stpmax; - state->fmax = fmax; - state->stplen = stp; - state->fcur = f; - state->n = n; - ae_v_move(&state->xbase.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_move(&state->s.ptr.p_double[0], 1, &s->ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_vector_set_length(&state->rstate.ia, 0+1, _state); - ae_vector_set_length(&state->rstate.ra, 0+1, _state); - state->rstate.stage = -1; -} - - -/************************************************************************* -This is rcomm-based search function - - -- ALGLIB -- - Copyright 05.10.2010 by Bochkanov Sergey -*************************************************************************/ -ae_bool armijoiteration(armijostate* state, ae_state *_state) -{ - double v; - ae_int_t n; - ae_bool result; - - - - /* - * Reverse communication preparations - * I know it looks ugly, but it works the same way - * anywhere from C++ to Python. - * - * This code initializes locals by: - * * random values determined during code - * generation - on first subroutine call - * * values from previous call - on subsequent calls - */ - if( state->rstate.stage>=0 ) - { - n = state->rstate.ia.ptr.p_int[0]; - v = state->rstate.ra.ptr.p_double[0]; - } - else - { - n = -983; - v = -989; - } - if( state->rstate.stage==0 ) - { - goto lbl_0; - } - if( state->rstate.stage==1 ) - { - goto lbl_1; - } - if( state->rstate.stage==2 ) - { - goto lbl_2; - } - if( state->rstate.stage==3 ) - { - goto lbl_3; - } - - /* - * Routine body - */ - if( (ae_fp_less_eq(state->stplen,0)||ae_fp_less(state->stpmax,0))||state->fmax<2 ) - { - state->info = 0; - result = ae_false; - return result; - } - if( ae_fp_less_eq(state->stplen,linmin_stpmin) ) - { - state->info = 4; - result = ae_false; - return result; - } - n = state->n; - state->nfev = 0; - - /* - * We always need F - */ - state->needf = ae_true; - - /* - * Bound StpLen - */ - if( ae_fp_greater(state->stplen,state->stpmax)&&ae_fp_neq(state->stpmax,0) ) - { - state->stplen = state->stpmax; - } - - /* - * Increase length - */ - v = state->stplen*linmin_armijofactor; - if( ae_fp_greater(v,state->stpmax)&&ae_fp_neq(state->stpmax,0) ) - { - v = state->stpmax; - } - ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_addd(&state->x.ptr.p_double[0], 1, &state->s.ptr.p_double[0], 1, ae_v_len(0,n-1), v); - state->rstate.stage = 0; - goto lbl_rcomm; -lbl_0: - state->nfev = state->nfev+1; - if( ae_fp_greater_eq(state->f,state->fcur) ) - { - goto lbl_4; - } - state->stplen = v; - state->fcur = state->f; -lbl_6: - if( ae_false ) - { - goto lbl_7; - } - - /* - * test stopping conditions - */ - if( state->nfev>=state->fmax ) - { - state->info = 3; - result = ae_false; - return result; - } - if( ae_fp_greater_eq(state->stplen,state->stpmax) ) - { - state->info = 5; - result = ae_false; - return result; - } - - /* - * evaluate F - */ - v = state->stplen*linmin_armijofactor; - if( ae_fp_greater(v,state->stpmax)&&ae_fp_neq(state->stpmax,0) ) - { - v = state->stpmax; - } - ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_addd(&state->x.ptr.p_double[0], 1, &state->s.ptr.p_double[0], 1, ae_v_len(0,n-1), v); - state->rstate.stage = 1; - goto lbl_rcomm; -lbl_1: - state->nfev = state->nfev+1; - - /* - * make decision - */ - if( ae_fp_less(state->f,state->fcur) ) - { - state->stplen = v; - state->fcur = state->f; - } - else - { - state->info = 1; - result = ae_false; - return result; - } - goto lbl_6; -lbl_7: -lbl_4: - - /* - * Decrease length - */ - v = state->stplen/linmin_armijofactor; - ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_addd(&state->x.ptr.p_double[0], 1, &state->s.ptr.p_double[0], 1, ae_v_len(0,n-1), v); - state->rstate.stage = 2; - goto lbl_rcomm; -lbl_2: - state->nfev = state->nfev+1; - if( ae_fp_greater_eq(state->f,state->fcur) ) - { - goto lbl_8; - } - state->stplen = state->stplen/linmin_armijofactor; - state->fcur = state->f; -lbl_10: - if( ae_false ) - { - goto lbl_11; - } - - /* - * test stopping conditions - */ - if( state->nfev>=state->fmax ) - { - state->info = 3; - result = ae_false; - return result; - } - if( ae_fp_less_eq(state->stplen,linmin_stpmin) ) - { - state->info = 4; - result = ae_false; - return result; - } - - /* - * evaluate F - */ - v = state->stplen/linmin_armijofactor; - ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_addd(&state->x.ptr.p_double[0], 1, &state->s.ptr.p_double[0], 1, ae_v_len(0,n-1), v); - state->rstate.stage = 3; - goto lbl_rcomm; -lbl_3: - state->nfev = state->nfev+1; - - /* - * make decision - */ - if( ae_fp_less(state->f,state->fcur) ) - { - state->stplen = state->stplen/linmin_armijofactor; - state->fcur = state->f; - } - else - { - state->info = 1; - result = ae_false; - return result; - } - goto lbl_10; -lbl_11: -lbl_8: - - /* - * Nothing to be done - */ - state->info = 1; - result = ae_false; - return result; - - /* - * Saving state - */ -lbl_rcomm: - result = ae_true; - state->rstate.ia.ptr.p_int[0] = n; - state->rstate.ra.ptr.p_double[0] = v; - return result; -} - - -/************************************************************************* -Results of Armijo search - -OUTPUT PARAMETERS: - INFO - on output it is set to one of the return codes: - * 0 improper input params - * 1 optimum step is found with at most FMAX evaluations - * 3 FMAX evaluations were used, - X contains optimum found so far - * 4 step is at lower bound STPMIN - * 5 step is at upper bound - STP - step length (in case of failure it is still returned) - F - function value (in case of failure it is still returned) - - -- ALGLIB -- - Copyright 05.10.2010 by Bochkanov Sergey -*************************************************************************/ -void armijoresults(armijostate* state, - ae_int_t* info, - double* stp, - double* f, - ae_state *_state) -{ - - - *info = state->info; - *stp = state->stplen; - *f = state->fcur; -} - - -static void linmin_mcstep(double* stx, - double* fx, - double* dx, - double* sty, - double* fy, - double* dy, - double* stp, - double fp, - double dp, - ae_bool* brackt, - double stmin, - double stmax, - ae_int_t* info, - ae_state *_state) -{ - ae_bool bound; - double gamma; - double p; - double q; - double r; - double s; - double sgnd; - double stpc; - double stpf; - double stpq; - double theta; - - - *info = 0; - - /* - * CHECK THE INPUT PARAMETERS FOR ERRORS. - */ - if( ((*brackt&&(ae_fp_less_eq(*stp,ae_minreal(*stx, *sty, _state))||ae_fp_greater_eq(*stp,ae_maxreal(*stx, *sty, _state))))||ae_fp_greater_eq(*dx*(*stp-(*stx)),0))||ae_fp_less(stmax,stmin) ) - { - return; - } - - /* - * DETERMINE IF THE DERIVATIVES HAVE OPPOSITE SIGN. - */ - sgnd = dp*(*dx/ae_fabs(*dx, _state)); - - /* - * FIRST CASE. A HIGHER FUNCTION VALUE. - * THE MINIMUM IS BRACKETED. IF THE CUBIC STEP IS CLOSER - * TO STX THAN THE QUADRATIC STEP, THE CUBIC STEP IS TAKEN, - * ELSE THE AVERAGE OF THE CUBIC AND QUADRATIC STEPS IS TAKEN. - */ - if( ae_fp_greater(fp,*fx) ) - { - *info = 1; - bound = ae_true; - theta = 3*(*fx-fp)/(*stp-(*stx))+(*dx)+dp; - s = ae_maxreal(ae_fabs(theta, _state), ae_maxreal(ae_fabs(*dx, _state), ae_fabs(dp, _state), _state), _state); - gamma = s*ae_sqrt(ae_sqr(theta/s, _state)-*dx/s*(dp/s), _state); - if( ae_fp_less(*stp,*stx) ) - { - gamma = -gamma; - } - p = gamma-(*dx)+theta; - q = gamma-(*dx)+gamma+dp; - r = p/q; - stpc = *stx+r*(*stp-(*stx)); - stpq = *stx+*dx/((*fx-fp)/(*stp-(*stx))+(*dx))/2*(*stp-(*stx)); - if( ae_fp_less(ae_fabs(stpc-(*stx), _state),ae_fabs(stpq-(*stx), _state)) ) - { - stpf = stpc; - } - else - { - stpf = stpc+(stpq-stpc)/2; - } - *brackt = ae_true; - } - else - { - if( ae_fp_less(sgnd,0) ) - { - - /* - * SECOND CASE. A LOWER FUNCTION VALUE AND DERIVATIVES OF - * OPPOSITE SIGN. THE MINIMUM IS BRACKETED. IF THE CUBIC - * STEP IS CLOSER TO STX THAN THE QUADRATIC (SECANT) STEP, - * THE CUBIC STEP IS TAKEN, ELSE THE QUADRATIC STEP IS TAKEN. - */ - *info = 2; - bound = ae_false; - theta = 3*(*fx-fp)/(*stp-(*stx))+(*dx)+dp; - s = ae_maxreal(ae_fabs(theta, _state), ae_maxreal(ae_fabs(*dx, _state), ae_fabs(dp, _state), _state), _state); - gamma = s*ae_sqrt(ae_sqr(theta/s, _state)-*dx/s*(dp/s), _state); - if( ae_fp_greater(*stp,*stx) ) - { - gamma = -gamma; - } - p = gamma-dp+theta; - q = gamma-dp+gamma+(*dx); - r = p/q; - stpc = *stp+r*(*stx-(*stp)); - stpq = *stp+dp/(dp-(*dx))*(*stx-(*stp)); - if( ae_fp_greater(ae_fabs(stpc-(*stp), _state),ae_fabs(stpq-(*stp), _state)) ) - { - stpf = stpc; - } - else - { - stpf = stpq; - } - *brackt = ae_true; - } - else - { - if( ae_fp_less(ae_fabs(dp, _state),ae_fabs(*dx, _state)) ) - { - - /* - * THIRD CASE. A LOWER FUNCTION VALUE, DERIVATIVES OF THE - * SAME SIGN, AND THE MAGNITUDE OF THE DERIVATIVE DECREASES. - * THE CUBIC STEP IS ONLY USED IF THE CUBIC TENDS TO INFINITY - * IN THE DIRECTION OF THE STEP OR IF THE MINIMUM OF THE CUBIC - * IS BEYOND STP. OTHERWISE THE CUBIC STEP IS DEFINED TO BE - * EITHER STPMIN OR STPMAX. THE QUADRATIC (SECANT) STEP IS ALSO - * COMPUTED AND IF THE MINIMUM IS BRACKETED THEN THE THE STEP - * CLOSEST TO STX IS TAKEN, ELSE THE STEP FARTHEST AWAY IS TAKEN. - */ - *info = 3; - bound = ae_true; - theta = 3*(*fx-fp)/(*stp-(*stx))+(*dx)+dp; - s = ae_maxreal(ae_fabs(theta, _state), ae_maxreal(ae_fabs(*dx, _state), ae_fabs(dp, _state), _state), _state); - - /* - * THE CASE GAMMA = 0 ONLY ARISES IF THE CUBIC DOES NOT TEND - * TO INFINITY IN THE DIRECTION OF THE STEP. - */ - gamma = s*ae_sqrt(ae_maxreal(0, ae_sqr(theta/s, _state)-*dx/s*(dp/s), _state), _state); - if( ae_fp_greater(*stp,*stx) ) - { - gamma = -gamma; - } - p = gamma-dp+theta; - q = gamma+(*dx-dp)+gamma; - r = p/q; - if( ae_fp_less(r,0)&&ae_fp_neq(gamma,0) ) - { - stpc = *stp+r*(*stx-(*stp)); - } - else - { - if( ae_fp_greater(*stp,*stx) ) - { - stpc = stmax; - } - else - { - stpc = stmin; - } - } - stpq = *stp+dp/(dp-(*dx))*(*stx-(*stp)); - if( *brackt ) - { - if( ae_fp_less(ae_fabs(*stp-stpc, _state),ae_fabs(*stp-stpq, _state)) ) - { - stpf = stpc; - } - else - { - stpf = stpq; - } - } - else - { - if( ae_fp_greater(ae_fabs(*stp-stpc, _state),ae_fabs(*stp-stpq, _state)) ) - { - stpf = stpc; - } - else - { - stpf = stpq; - } - } - } - else - { - - /* - * FOURTH CASE. A LOWER FUNCTION VALUE, DERIVATIVES OF THE - * SAME SIGN, AND THE MAGNITUDE OF THE DERIVATIVE DOES - * NOT DECREASE. IF THE MINIMUM IS NOT BRACKETED, THE STEP - * IS EITHER STPMIN OR STPMAX, ELSE THE CUBIC STEP IS TAKEN. - */ - *info = 4; - bound = ae_false; - if( *brackt ) - { - theta = 3*(fp-(*fy))/(*sty-(*stp))+(*dy)+dp; - s = ae_maxreal(ae_fabs(theta, _state), ae_maxreal(ae_fabs(*dy, _state), ae_fabs(dp, _state), _state), _state); - gamma = s*ae_sqrt(ae_sqr(theta/s, _state)-*dy/s*(dp/s), _state); - if( ae_fp_greater(*stp,*sty) ) - { - gamma = -gamma; - } - p = gamma-dp+theta; - q = gamma-dp+gamma+(*dy); - r = p/q; - stpc = *stp+r*(*sty-(*stp)); - stpf = stpc; - } - else - { - if( ae_fp_greater(*stp,*stx) ) - { - stpf = stmax; - } - else - { - stpf = stmin; - } - } - } - } - } - - /* - * UPDATE THE INTERVAL OF UNCERTAINTY. THIS UPDATE DOES NOT - * DEPEND ON THE NEW STEP OR THE CASE ANALYSIS ABOVE. - */ - if( ae_fp_greater(fp,*fx) ) - { - *sty = *stp; - *fy = fp; - *dy = dp; - } - else - { - if( ae_fp_less(sgnd,0.0) ) - { - *sty = *stx; - *fy = *fx; - *dy = *dx; - } - *stx = *stp; - *fx = fp; - *dx = dp; - } - - /* - * COMPUTE THE NEW STEP AND SAFEGUARD IT. - */ - stpf = ae_minreal(stmax, stpf, _state); - stpf = ae_maxreal(stmin, stpf, _state); - *stp = stpf; - if( *brackt&&bound ) - { - if( ae_fp_greater(*sty,*stx) ) - { - *stp = ae_minreal(*stx+0.66*(*sty-(*stx)), *stp, _state); - } - else - { - *stp = ae_maxreal(*stx+0.66*(*sty-(*stx)), *stp, _state); - } - } -} - - -ae_bool _linminstate_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - linminstate *p = (linminstate*)_p; - ae_touch_ptr((void*)p); - return ae_true; -} - - -ae_bool _linminstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - linminstate *dst = (linminstate*)_dst; - linminstate *src = (linminstate*)_src; - dst->brackt = src->brackt; - dst->stage1 = src->stage1; - dst->infoc = src->infoc; - dst->dg = src->dg; - dst->dgm = src->dgm; - dst->dginit = src->dginit; - dst->dgtest = src->dgtest; - dst->dgx = src->dgx; - dst->dgxm = src->dgxm; - dst->dgy = src->dgy; - dst->dgym = src->dgym; - dst->finit = src->finit; - dst->ftest1 = src->ftest1; - dst->fm = src->fm; - dst->fx = src->fx; - dst->fxm = src->fxm; - dst->fy = src->fy; - dst->fym = src->fym; - dst->stx = src->stx; - dst->sty = src->sty; - dst->stmin = src->stmin; - dst->stmax = src->stmax; - dst->width = src->width; - dst->width1 = src->width1; - dst->xtrapf = src->xtrapf; - return ae_true; -} - - -void _linminstate_clear(void* _p) -{ - linminstate *p = (linminstate*)_p; - ae_touch_ptr((void*)p); -} - - -void _linminstate_destroy(void* _p) -{ - linminstate *p = (linminstate*)_p; - ae_touch_ptr((void*)p); -} - - -ae_bool _armijostate_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - armijostate *p = (armijostate*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->xbase, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->s, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _armijostate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - armijostate *dst = (armijostate*)_dst; - armijostate *src = (armijostate*)_src; - dst->needf = src->needf; - if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) - return ae_false; - dst->f = src->f; - dst->n = src->n; - if( !ae_vector_init_copy(&dst->xbase, &src->xbase, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->s, &src->s, _state, make_automatic) ) - return ae_false; - dst->stplen = src->stplen; - dst->fcur = src->fcur; - dst->stpmax = src->stpmax; - dst->fmax = src->fmax; - dst->nfev = src->nfev; - dst->info = src->info; - if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _armijostate_clear(void* _p) -{ - armijostate *p = (armijostate*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->x); - ae_vector_clear(&p->xbase); - ae_vector_clear(&p->s); - _rcommstate_clear(&p->rstate); -} - - -void _armijostate_destroy(void* _p) -{ - armijostate *p = (armijostate*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->x); - ae_vector_destroy(&p->xbase); - ae_vector_destroy(&p->s); - _rcommstate_destroy(&p->rstate); -} - - - - -void findprimitiverootandinverse(ae_int_t n, - ae_int_t* proot, - ae_int_t* invproot, - ae_state *_state) -{ - ae_int_t candroot; - ae_int_t phin; - ae_int_t q; - ae_int_t f; - ae_bool allnonone; - ae_int_t x; - ae_int_t lastx; - ae_int_t y; - ae_int_t lasty; - ae_int_t a; - ae_int_t b; - ae_int_t t; - ae_int_t n2; - - *proot = 0; - *invproot = 0; - - ae_assert(n>=3, "FindPrimitiveRootAndInverse: N<3", _state); - *proot = 0; - *invproot = 0; - - /* - * check that N is prime - */ - ae_assert(ntheory_isprime(n, _state), "FindPrimitiveRoot: N is not prime", _state); - - /* - * Because N is prime, Euler totient function is equal to N-1 - */ - phin = n-1; - - /* - * Test different values of PRoot - from 2 to N-1. - * One of these values MUST be primitive root. - * - * For testing we use algorithm from Wiki (Primitive root modulo n): - * * compute phi(N) - * * determine the different prime factors of phi(N), say p1, ..., pk - * * for every element m of Zn*, compute m^(phi(N)/pi) mod N for i=1..k - * using a fast algorithm for modular exponentiation. - * * a number m for which these k results are all different from 1 is a - * primitive root. - */ - for(candroot=2; candroot<=n-1; candroot++) - { - - /* - * We have current candidate root in CandRoot. - * - * Scan different prime factors of PhiN. Here: - * * F is a current candidate factor - * * Q is a current quotient - amount which was left after dividing PhiN - * by all previous factors - * - * For each factor, perform test mentioned above. - */ - q = phin; - f = 2; - allnonone = ae_true; - while(q>1) - { - if( q%f==0 ) - { - t = ntheory_modexp(candroot, phin/f, n, _state); - if( t==1 ) - { - allnonone = ae_false; - break; - } - while(q%f==0) - { - q = q/f; - } - } - f = f+1; - } - if( allnonone ) - { - *proot = candroot; - break; - } - } - ae_assert(*proot>=2, "FindPrimitiveRoot: internal error (root not found)", _state); - - /* - * Use extended Euclidean algorithm to find multiplicative inverse of primitive root - */ - x = 0; - lastx = 1; - y = 1; - lasty = 0; - a = *proot; - b = n; - while(b!=0) - { - q = a/b; - t = a%b; - a = b; - b = t; - t = lastx-q*x; - lastx = x; - x = t; - t = lasty-q*y; - lasty = y; - y = t; - } - while(lastx<0) - { - lastx = lastx+n; - } - *invproot = lastx; - - /* - * Check that it is safe to perform multiplication modulo N. - * Check results for consistency. - */ - n2 = (n-1)*(n-1); - ae_assert(n2/(n-1)==n-1, "FindPrimitiveRoot: internal error", _state); - ae_assert(*proot*(*invproot)/(*proot)==(*invproot), "FindPrimitiveRoot: internal error", _state); - ae_assert(*proot*(*invproot)/(*invproot)==(*proot), "FindPrimitiveRoot: internal error", _state); - ae_assert(*proot*(*invproot)%n==1, "FindPrimitiveRoot: internal error", _state); -} - - -static ae_bool ntheory_isprime(ae_int_t n, ae_state *_state) -{ - ae_int_t p; - ae_bool result; - - - result = ae_false; - p = 2; - while(p*p<=n) - { - if( n%p==0 ) - { - return result; - } - p = p+1; - } - result = ae_true; - return result; -} - - -static ae_int_t ntheory_modmul(ae_int_t a, - ae_int_t b, - ae_int_t n, - ae_state *_state) -{ - ae_int_t t; - double ra; - double rb; - ae_int_t result; - - - ae_assert(a>=0&&a=N", _state); - ae_assert(b>=0&&b=N", _state); - - /* - * Base cases - */ - ra = a; - rb = b; - if( b==0||a==0 ) - { - result = 0; - return result; - } - if( b==1||a==1 ) - { - result = a*b; - return result; - } - if( ae_fp_eq(ra*rb,a*b) ) - { - result = a*b%n; - return result; - } - - /* - * Non-base cases - */ - if( b%2==0 ) - { - - /* - * A*B = (A*(B/2)) * 2 - * - * Product T=A*(B/2) is calculated recursively, product T*2 is - * calculated as follows: - * * result:=T-N - * * result:=result+T - * * if result<0 then result:=result+N - * - * In case integer result overflows, we generate exception - */ - t = ntheory_modmul(a, b/2, n, _state); - result = t-n; - result = result+t; - if( result<0 ) - { - result = result+n; - } - } - else - { - - /* - * A*B = (A*(B div 2)) * 2 + A - * - * Product T=A*(B/2) is calculated recursively, product T*2 is - * calculated as follows: - * * result:=T-N - * * result:=result+T - * * if result<0 then result:=result+N - * - * In case integer result overflows, we generate exception - */ - t = ntheory_modmul(a, b/2, n, _state); - result = t-n; - result = result+t; - if( result<0 ) - { - result = result+n; - } - result = result-n; - result = result+a; - if( result<0 ) - { - result = result+n; - } - } - return result; -} - - -static ae_int_t ntheory_modexp(ae_int_t a, - ae_int_t b, - ae_int_t n, - ae_state *_state) -{ - ae_int_t t; - ae_int_t result; - - - ae_assert(a>=0&&a=N", _state); - ae_assert(b>=0, "ModExp: B<0", _state); - - /* - * Base cases - */ - if( b==0 ) - { - result = 1; - return result; - } - if( b==1 ) - { - result = a; - return result; - } - - /* - * Non-base cases - */ - if( b%2==0 ) - { - t = ntheory_modmul(a, a, n, _state); - result = ntheory_modexp(t, b/2, n, _state); - } - else - { - t = ntheory_modmul(a, a, n, _state); - result = ntheory_modexp(t, b/2, n, _state); - result = ntheory_modmul(result, a, n, _state); - } - return result; -} - - - - -/************************************************************************* -This subroutine generates FFT plan for K complex FFT's with length N each. - -INPUT PARAMETERS: - N - FFT length (in complex numbers), N>=1 - K - number of repetitions, K>=1 - -OUTPUT PARAMETERS: - Plan - plan - - -- ALGLIB -- - Copyright 05.04.2013 by Bochkanov Sergey -*************************************************************************/ -void ftcomplexfftplan(ae_int_t n, - ae_int_t k, - fasttransformplan* plan, - ae_state *_state) -{ - ae_frame _frame_block; - srealarray bluesteinbuf; - ae_int_t rowptr; - ae_int_t bluesteinsize; - ae_int_t precrptr; - ae_int_t preciptr; - ae_int_t precrsize; - ae_int_t precisize; - - ae_frame_make(_state, &_frame_block); - _fasttransformplan_clear(plan); - _srealarray_init(&bluesteinbuf, _state, ae_true); - - - /* - * Initial check for parameters - */ - ae_assert(n>0, "FTComplexFFTPlan: N<=0", _state); - ae_assert(k>0, "FTComplexFFTPlan: K<=0", _state); - - /* - * Determine required sizes of precomputed real and integer - * buffers. This stage of code is highly dependent on internals - * of FTComplexFFTPlanRec() and must be kept synchronized with - * possible changes in internals of plan generation function. - * - * Buffer size is determined as follows: - * * N is factorized - * * we factor out anything which is less or equal to MaxRadix - * * prime factor F>RaderThreshold requires 4*FTBaseFindSmooth(2*F-1) - * real entries to store precomputed Quantities for Bluestein's - * transformation - * * prime factor F<=RaderThreshold does NOT require - * precomputed storage - */ - precrsize = 0; - precisize = 0; - ftbase_ftdeterminespacerequirements(n, &precrsize, &precisize, _state); - if( precrsize>0 ) - { - ae_vector_set_length(&plan->precr, precrsize, _state); - } - if( precisize>0 ) - { - ae_vector_set_length(&plan->preci, precisize, _state); - } - - /* - * Generate plan - */ - rowptr = 0; - precrptr = 0; - preciptr = 0; - bluesteinsize = 1; - ae_vector_set_length(&plan->buffer, 2*n*k, _state); - ftbase_ftcomplexfftplanrec(n, k, ae_true, ae_true, &rowptr, &bluesteinsize, &precrptr, &preciptr, plan, _state); - ae_vector_set_length(&bluesteinbuf.val, bluesteinsize, _state); - ae_shared_pool_set_seed(&plan->bluesteinpool, &bluesteinbuf, sizeof(bluesteinbuf), _srealarray_init, _srealarray_init_copy, _srealarray_destroy, _state); - - /* - * Check that actual amount of precomputed space used by transformation - * plan is EXACTLY equal to amount of space allocated by us. - */ - ae_assert(precrptr==precrsize, "FTComplexFFTPlan: internal error (PrecRPtr<>PrecRSize)", _state); - ae_assert(preciptr==precisize, "FTComplexFFTPlan: internal error (PrecRPtr<>PrecRSize)", _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -This subroutine applies transformation plan to input/output array A. - -INPUT PARAMETERS: - Plan - transformation plan - A - array, must be large enough for plan to work - OffsA - offset of the subarray to process - RepCnt - repetition count (transformation is repeatedly applied - to subsequent subarrays) - -OUTPUT PARAMETERS: - Plan - plan (temporary buffers can be modified, plan itself - is unchanged and can be reused) - A - transformed array - - -- ALGLIB -- - Copyright 05.04.2013 by Bochkanov Sergey -*************************************************************************/ -void ftapplyplan(fasttransformplan* plan, - /* Real */ ae_vector* a, - ae_int_t offsa, - ae_int_t repcnt, - ae_state *_state) -{ - ae_int_t plansize; - ae_int_t i; - - - plansize = plan->entries.ptr.pp_int[0][ftbase_coloperandscnt]*plan->entries.ptr.pp_int[0][ftbase_coloperandsize]*plan->entries.ptr.pp_int[0][ftbase_colmicrovectorsize]; - for(i=0; i<=repcnt-1; i++) - { - ftbase_ftapplysubplan(plan, 0, a, offsa+plansize*i, 0, &plan->buffer, 1, _state); - } -} - - -/************************************************************************* -Returns good factorization N=N1*N2. - -Usually N1<=N2 (but not always - small N's may be exception). -if N1<>1 then N2<>1. - -Factorization is chosen depending on task type and codelets we have. - - -- ALGLIB -- - Copyright 01.05.2009 by Bochkanov Sergey -*************************************************************************/ -void ftbasefactorize(ae_int_t n, - ae_int_t tasktype, - ae_int_t* n1, - ae_int_t* n2, - ae_state *_state) -{ - ae_int_t j; - - *n1 = 0; - *n2 = 0; - - *n1 = 0; - *n2 = 0; - - /* - * try to find good codelet - */ - if( *n1*(*n2)!=n ) - { - for(j=ftbase_ftbasecodeletrecommended; j>=2; j--) - { - if( n%j==0 ) - { - *n1 = j; - *n2 = n/j; - break; - } - } - } - - /* - * try to factorize N - */ - if( *n1*(*n2)!=n ) - { - for(j=ftbase_ftbasecodeletrecommended+1; j<=n-1; j++) - { - if( n%j==0 ) - { - *n1 = j; - *n2 = n/j; - break; - } - } - } - - /* - * looks like N is prime :( - */ - if( *n1*(*n2)!=n ) - { - *n1 = 1; - *n2 = n; - } - - /* - * normalize - */ - if( *n2==1&&*n1!=1 ) - { - *n2 = *n1; - *n1 = 1; - } -} - - -/************************************************************************* -Is number smooth? - - -- ALGLIB -- - Copyright 01.05.2009 by Bochkanov Sergey -*************************************************************************/ -ae_bool ftbaseissmooth(ae_int_t n, ae_state *_state) -{ - ae_int_t i; - ae_bool result; - - - for(i=2; i<=ftbase_ftbasemaxsmoothfactor; i++) - { - while(n%i==0) - { - n = n/i; - } - } - result = n==1; - return result; -} - - -/************************************************************************* -Returns smallest smooth (divisible only by 2, 3, 5) number that is greater -than or equal to max(N,2) - - -- ALGLIB -- - Copyright 01.05.2009 by Bochkanov Sergey -*************************************************************************/ -ae_int_t ftbasefindsmooth(ae_int_t n, ae_state *_state) -{ - ae_int_t best; - ae_int_t result; - - - best = 2; - while(bestRaderThreshold requires 4*FTBaseFindSmooth(2*F-1) - * real entries to store precomputed Quantities for Bluestein's - * transformation - * * prime factor F<=RaderThreshold requires 2*(F-1)+ESTIMATE(F-1) - * precomputed storage - */ - ncur = n; - for(i=2; i<=ftbase_maxradix; i++) - { - while(ncur%i==0) - { - ncur = ncur/i; - } - } - f = 2; - while(f<=ncur) - { - while(ncur%f==0) - { - if( f>ftbase_raderthreshold ) - { - *precrsize = *precrsize+4*ftbasefindsmooth(2*f-1, _state); - } - else - { - *precrsize = *precrsize+2*(f-1); - ftbase_ftdeterminespacerequirements(f-1, precrsize, precisize, _state); - } - ncur = ncur/f; - } - f = f+1; - } -} - - -/************************************************************************* -Recurrent function called by FTComplexFFTPlan() and other functions. It -recursively builds transformation plan - -INPUT PARAMETERS: - N - FFT length (in complex numbers), N>=1 - K - number of repetitions, K>=1 - ChildPlan - if True, plan generator inserts OpStart/opEnd in the - plan header/footer. - TopmostPlan - if True, plan generator assumes that it is topmost plan: - * it may use global buffer for transpositions - and there is no other plan which executes in parallel - RowPtr - index which points to past-the-last entry generated so far - BluesteinSize- amount of storage (in real numbers) required for Bluestein buffer - PrecRPtr - pointer to unused part of precomputed real buffer (Plan.PrecR): - * when this function stores some data to precomputed buffer, - it advances pointer. - * it is responsibility of the function to assert that - Plan.PrecR has enough space to store data before actually - writing to buffer. - * it is responsibility of the caller to allocate enough - space before calling this function - PrecIPtr - pointer to unused part of precomputed integer buffer (Plan.PrecI): - * when this function stores some data to precomputed buffer, - it advances pointer. - * it is responsibility of the function to assert that - Plan.PrecR has enough space to store data before actually - writing to buffer. - * it is responsibility of the caller to allocate enough - space before calling this function - Plan - plan (generated so far) - -OUTPUT PARAMETERS: - RowPtr - updated pointer (advanced by number of entries generated - by function) - BluesteinSize- updated amount - (may be increased, but may never be decreased) - -NOTE: in case TopmostPlan is True, ChildPlan is also must be True. - - -- ALGLIB -- - Copyright 05.04.2013 by Bochkanov Sergey -*************************************************************************/ -static void ftbase_ftcomplexfftplanrec(ae_int_t n, - ae_int_t k, - ae_bool childplan, - ae_bool topmostplan, - ae_int_t* rowptr, - ae_int_t* bluesteinsize, - ae_int_t* precrptr, - ae_int_t* preciptr, - fasttransformplan* plan, - ae_state *_state) -{ - ae_frame _frame_block; - srealarray localbuf; - ae_int_t m; - ae_int_t n1; - ae_int_t n2; - ae_int_t gq; - ae_int_t giq; - ae_int_t row0; - ae_int_t row1; - ae_int_t row2; - ae_int_t row3; - - ae_frame_make(_state, &_frame_block); - _srealarray_init(&localbuf, _state, ae_true); - - ae_assert(n>0, "FTComplexFFTPlan: N<=0", _state); - ae_assert(k>0, "FTComplexFFTPlan: K<=0", _state); - ae_assert(!topmostplan||childplan, "FTComplexFFTPlan: ChildPlan is inconsistent with TopmostPlan", _state); - - /* - * Try to generate "topmost" plan - */ - if( topmostplan&&n>ftbase_recursivethreshold ) - { - ftbase_ftfactorize(n, ae_false, &n1, &n2, _state); - if( n1*n2==0 ) - { - - /* - * Handle prime-factor FFT with Bluestein's FFT. - * Determine size of Bluestein's buffer. - */ - m = ftbasefindsmooth(2*n-1, _state); - *bluesteinsize = ae_maxint(2*m, *bluesteinsize, _state); - - /* - * Generate plan - */ - ftbase_ftpushentry2(plan, rowptr, ftbase_opstart, k, n, 2, -1, ftbase_ftoptimisticestimate(n, _state), _state); - ftbase_ftpushentry4(plan, rowptr, ftbase_opbluesteinsfft, k, n, 2, m, 2, *precrptr, 0, _state); - row0 = *rowptr; - ftbase_ftpushentry(plan, rowptr, ftbase_opjmp, 0, 0, 0, 0, _state); - ftbase_ftcomplexfftplanrec(m, 1, ae_true, ae_true, rowptr, bluesteinsize, precrptr, preciptr, plan, _state); - row1 = *rowptr; - plan->entries.ptr.pp_int[row0][ftbase_colparam0] = row1-row0; - ftbase_ftpushentry(plan, rowptr, ftbase_opend, k, n, 2, 0, _state); - - /* - * Fill precomputed buffer - */ - ftbase_ftprecomputebluesteinsfft(n, m, &plan->precr, *precrptr, _state); - - /* - * Update pointer to the precomputed area - */ - *precrptr = *precrptr+4*m; - } - else - { - - /* - * Handle composite FFT with recursive Cooley-Tukey which - * uses global buffer instead of local one. - */ - ftbase_ftpushentry2(plan, rowptr, ftbase_opstart, k, n, 2, -1, ftbase_ftoptimisticestimate(n, _state), _state); - ftbase_ftpushentry(plan, rowptr, ftbase_opcomplextranspose, k, n, 2, n1, _state); - row0 = *rowptr; - ftbase_ftpushentry2(plan, rowptr, ftbase_opparallelcall, k*n2, n1, 2, 0, ftbase_ftoptimisticestimate(n, _state), _state); - ftbase_ftpushentry(plan, rowptr, ftbase_opcomplexfftfactors, k, n, 2, n1, _state); - ftbase_ftpushentry(plan, rowptr, ftbase_opcomplextranspose, k, n, 2, n2, _state); - row2 = *rowptr; - ftbase_ftpushentry2(plan, rowptr, ftbase_opparallelcall, k*n1, n2, 2, 0, ftbase_ftoptimisticestimate(n, _state), _state); - ftbase_ftpushentry(plan, rowptr, ftbase_opcomplextranspose, k, n, 2, n1, _state); - ftbase_ftpushentry(plan, rowptr, ftbase_opend, k, n, 2, 0, _state); - row1 = *rowptr; - ftbase_ftcomplexfftplanrec(n1, 1, ae_true, ae_false, rowptr, bluesteinsize, precrptr, preciptr, plan, _state); - plan->entries.ptr.pp_int[row0][ftbase_colparam0] = row1-row0; - row3 = *rowptr; - ftbase_ftcomplexfftplanrec(n2, 1, ae_true, ae_false, rowptr, bluesteinsize, precrptr, preciptr, plan, _state); - plan->entries.ptr.pp_int[row2][ftbase_colparam0] = row3-row2; - } - ae_frame_leave(_state); - return; - } - - /* - * Prepare "non-topmost" plan: - * * calculate factorization - * * use local (shared) buffer - * * update buffer size - ANY plan will need at least - * 2*N temporaries, additional requirements can be - * applied later - */ - ftbase_ftfactorize(n, ae_false, &n1, &n2, _state); - - /* - * Handle FFT's with N1*N2=0: either small-N or prime-factor - */ - if( n1*n2==0 ) - { - if( n<=ftbase_maxradix ) - { - - /* - * Small-N FFT - */ - if( childplan ) - { - ftbase_ftpushentry2(plan, rowptr, ftbase_opstart, k, n, 2, -1, ftbase_ftoptimisticestimate(n, _state), _state); - } - ftbase_ftpushentry(plan, rowptr, ftbase_opcomplexcodeletfft, k, n, 2, 0, _state); - if( childplan ) - { - ftbase_ftpushentry(plan, rowptr, ftbase_opend, k, n, 2, 0, _state); - } - ae_frame_leave(_state); - return; - } - if( n<=ftbase_raderthreshold ) - { - - /* - * Handle prime-factor FFT's with Rader's FFT - */ - m = n-1; - if( childplan ) - { - ftbase_ftpushentry2(plan, rowptr, ftbase_opstart, k, n, 2, -1, ftbase_ftoptimisticestimate(n, _state), _state); - } - findprimitiverootandinverse(n, &gq, &giq, _state); - ftbase_ftpushentry4(plan, rowptr, ftbase_opradersfft, k, n, 2, 2, gq, giq, *precrptr, _state); - ftbase_ftprecomputeradersfft(n, gq, giq, &plan->precr, *precrptr, _state); - *precrptr = *precrptr+2*(n-1); - row0 = *rowptr; - ftbase_ftpushentry(plan, rowptr, ftbase_opjmp, 0, 0, 0, 0, _state); - ftbase_ftcomplexfftplanrec(m, 1, ae_true, ae_false, rowptr, bluesteinsize, precrptr, preciptr, plan, _state); - row1 = *rowptr; - plan->entries.ptr.pp_int[row0][ftbase_colparam0] = row1-row0; - if( childplan ) - { - ftbase_ftpushentry(plan, rowptr, ftbase_opend, k, n, 2, 0, _state); - } - } - else - { - - /* - * Handle prime-factor FFT's with Bluestein's FFT - */ - m = ftbasefindsmooth(2*n-1, _state); - *bluesteinsize = ae_maxint(2*m, *bluesteinsize, _state); - if( childplan ) - { - ftbase_ftpushentry2(plan, rowptr, ftbase_opstart, k, n, 2, -1, ftbase_ftoptimisticestimate(n, _state), _state); - } - ftbase_ftpushentry4(plan, rowptr, ftbase_opbluesteinsfft, k, n, 2, m, 2, *precrptr, 0, _state); - ftbase_ftprecomputebluesteinsfft(n, m, &plan->precr, *precrptr, _state); - *precrptr = *precrptr+4*m; - row0 = *rowptr; - ftbase_ftpushentry(plan, rowptr, ftbase_opjmp, 0, 0, 0, 0, _state); - ftbase_ftcomplexfftplanrec(m, 1, ae_true, ae_false, rowptr, bluesteinsize, precrptr, preciptr, plan, _state); - row1 = *rowptr; - plan->entries.ptr.pp_int[row0][ftbase_colparam0] = row1-row0; - if( childplan ) - { - ftbase_ftpushentry(plan, rowptr, ftbase_opend, k, n, 2, 0, _state); - } - } - ae_frame_leave(_state); - return; - } - - /* - * Handle Cooley-Tukey FFT with small N1 - */ - if( n1<=ftbase_maxradix ) - { - - /* - * Specialized transformation for small N1: - * * N2 short inplace FFT's, each N1-point, with integrated twiddle factors - * * N1 long FFT's - * * final transposition - */ - if( childplan ) - { - ftbase_ftpushentry2(plan, rowptr, ftbase_opstart, k, n, 2, -1, ftbase_ftoptimisticestimate(n, _state), _state); - } - ftbase_ftpushentry(plan, rowptr, ftbase_opcomplexcodelettwfft, k, n1, 2*n2, 0, _state); - ftbase_ftcomplexfftplanrec(n2, k*n1, ae_false, ae_false, rowptr, bluesteinsize, precrptr, preciptr, plan, _state); - ftbase_ftpushentry(plan, rowptr, ftbase_opcomplextranspose, k, n, 2, n1, _state); - if( childplan ) - { - ftbase_ftpushentry(plan, rowptr, ftbase_opend, k, n, 2, 0, _state); - } - ae_frame_leave(_state); - return; - } - - /* - * Handle general Cooley-Tukey FFT, either "flat" or "recursive" - */ - if( n<=ftbase_recursivethreshold ) - { - - /* - * General code for large N1/N2, "flat" version without explicit recurrence - * (nested subplans are inserted directly into the body of the plan) - */ - if( childplan ) - { - ftbase_ftpushentry2(plan, rowptr, ftbase_opstart, k, n, 2, -1, ftbase_ftoptimisticestimate(n, _state), _state); - } - ftbase_ftpushentry(plan, rowptr, ftbase_opcomplextranspose, k, n, 2, n1, _state); - ftbase_ftcomplexfftplanrec(n1, k*n2, ae_false, ae_false, rowptr, bluesteinsize, precrptr, preciptr, plan, _state); - ftbase_ftpushentry(plan, rowptr, ftbase_opcomplexfftfactors, k, n, 2, n1, _state); - ftbase_ftpushentry(plan, rowptr, ftbase_opcomplextranspose, k, n, 2, n2, _state); - ftbase_ftcomplexfftplanrec(n2, k*n1, ae_false, ae_false, rowptr, bluesteinsize, precrptr, preciptr, plan, _state); - ftbase_ftpushentry(plan, rowptr, ftbase_opcomplextranspose, k, n, 2, n1, _state); - if( childplan ) - { - ftbase_ftpushentry(plan, rowptr, ftbase_opend, k, n, 2, 0, _state); - } - } - else - { - - /* - * General code for large N1/N2, "recursive" version - nested subplans - * are separated from the plan body. - * - * Generate parent plan. - */ - if( childplan ) - { - ftbase_ftpushentry2(plan, rowptr, ftbase_opstart, k, n, 2, -1, ftbase_ftoptimisticestimate(n, _state), _state); - } - ftbase_ftpushentry(plan, rowptr, ftbase_opcomplextranspose, k, n, 2, n1, _state); - row0 = *rowptr; - ftbase_ftpushentry2(plan, rowptr, ftbase_opparallelcall, k*n2, n1, 2, 0, ftbase_ftoptimisticestimate(n, _state), _state); - ftbase_ftpushentry(plan, rowptr, ftbase_opcomplexfftfactors, k, n, 2, n1, _state); - ftbase_ftpushentry(plan, rowptr, ftbase_opcomplextranspose, k, n, 2, n2, _state); - row2 = *rowptr; - ftbase_ftpushentry2(plan, rowptr, ftbase_opparallelcall, k*n1, n2, 2, 0, ftbase_ftoptimisticestimate(n, _state), _state); - ftbase_ftpushentry(plan, rowptr, ftbase_opcomplextranspose, k, n, 2, n1, _state); - if( childplan ) - { - ftbase_ftpushentry(plan, rowptr, ftbase_opend, k, n, 2, 0, _state); - } - - /* - * Generate child subplans, insert refence to parent plans - */ - row1 = *rowptr; - ftbase_ftcomplexfftplanrec(n1, 1, ae_true, ae_false, rowptr, bluesteinsize, precrptr, preciptr, plan, _state); - plan->entries.ptr.pp_int[row0][ftbase_colparam0] = row1-row0; - row3 = *rowptr; - ftbase_ftcomplexfftplanrec(n2, 1, ae_true, ae_false, rowptr, bluesteinsize, precrptr, preciptr, plan, _state); - plan->entries.ptr.pp_int[row2][ftbase_colparam0] = row3-row2; - } - ae_frame_leave(_state); -} - - -/************************************************************************* -This function pushes one more entry to the plan. It resizes Entries matrix -if needed. - -INPUT PARAMETERS: - Plan - plan (generated so far) - RowPtr - index which points to past-the-last entry generated so far - EType - entry type - EOpCnt - operands count - EOpSize - operand size - EMcvSize - microvector size - EParam0 - parameter 0 - -OUTPUT PARAMETERS: - Plan - updated plan - RowPtr - updated pointer - -NOTE: Param1 is set to -1. - - -- ALGLIB -- - Copyright 05.04.2013 by Bochkanov Sergey -*************************************************************************/ -static void ftbase_ftpushentry(fasttransformplan* plan, - ae_int_t* rowptr, - ae_int_t etype, - ae_int_t eopcnt, - ae_int_t eopsize, - ae_int_t emcvsize, - ae_int_t eparam0, - ae_state *_state) -{ - - - ftbase_ftpushentry2(plan, rowptr, etype, eopcnt, eopsize, emcvsize, eparam0, -1, _state); -} - - -/************************************************************************* -Same as FTPushEntry(), but sets Param0 AND Param1. -This function pushes one more entry to the plan. It resized Entries matrix -if needed. - -INPUT PARAMETERS: - Plan - plan (generated so far) - RowPtr - index which points to past-the-last entry generated so far - EType - entry type - EOpCnt - operands count - EOpSize - operand size - EMcvSize - microvector size - EParam0 - parameter 0 - EParam1 - parameter 1 - -OUTPUT PARAMETERS: - Plan - updated plan - RowPtr - updated pointer - - -- ALGLIB -- - Copyright 05.04.2013 by Bochkanov Sergey -*************************************************************************/ -static void ftbase_ftpushentry2(fasttransformplan* plan, - ae_int_t* rowptr, - ae_int_t etype, - ae_int_t eopcnt, - ae_int_t eopsize, - ae_int_t emcvsize, - ae_int_t eparam0, - ae_int_t eparam1, - ae_state *_state) -{ - - - if( *rowptr>=plan->entries.rows ) - { - imatrixresize(&plan->entries, ae_maxint(2*plan->entries.rows, 1, _state), ftbase_colscnt, _state); - } - plan->entries.ptr.pp_int[*rowptr][ftbase_coltype] = etype; - plan->entries.ptr.pp_int[*rowptr][ftbase_coloperandscnt] = eopcnt; - plan->entries.ptr.pp_int[*rowptr][ftbase_coloperandsize] = eopsize; - plan->entries.ptr.pp_int[*rowptr][ftbase_colmicrovectorsize] = emcvsize; - plan->entries.ptr.pp_int[*rowptr][ftbase_colparam0] = eparam0; - plan->entries.ptr.pp_int[*rowptr][ftbase_colparam1] = eparam1; - plan->entries.ptr.pp_int[*rowptr][ftbase_colparam2] = 0; - plan->entries.ptr.pp_int[*rowptr][ftbase_colparam3] = 0; - *rowptr = *rowptr+1; -} - - -/************************************************************************* -Same as FTPushEntry(), but sets Param0, Param1, Param2 and Param3. -This function pushes one more entry to the plan. It resized Entries matrix -if needed. - -INPUT PARAMETERS: - Plan - plan (generated so far) - RowPtr - index which points to past-the-last entry generated so far - EType - entry type - EOpCnt - operands count - EOpSize - operand size - EMcvSize - microvector size - EParam0 - parameter 0 - EParam1 - parameter 1 - EParam2 - parameter 2 - EParam3 - parameter 3 - -OUTPUT PARAMETERS: - Plan - updated plan - RowPtr - updated pointer - - -- ALGLIB -- - Copyright 05.04.2013 by Bochkanov Sergey -*************************************************************************/ -static void ftbase_ftpushentry4(fasttransformplan* plan, - ae_int_t* rowptr, - ae_int_t etype, - ae_int_t eopcnt, - ae_int_t eopsize, - ae_int_t emcvsize, - ae_int_t eparam0, - ae_int_t eparam1, - ae_int_t eparam2, - ae_int_t eparam3, - ae_state *_state) -{ - - - if( *rowptr>=plan->entries.rows ) - { - imatrixresize(&plan->entries, ae_maxint(2*plan->entries.rows, 1, _state), ftbase_colscnt, _state); - } - plan->entries.ptr.pp_int[*rowptr][ftbase_coltype] = etype; - plan->entries.ptr.pp_int[*rowptr][ftbase_coloperandscnt] = eopcnt; - plan->entries.ptr.pp_int[*rowptr][ftbase_coloperandsize] = eopsize; - plan->entries.ptr.pp_int[*rowptr][ftbase_colmicrovectorsize] = emcvsize; - plan->entries.ptr.pp_int[*rowptr][ftbase_colparam0] = eparam0; - plan->entries.ptr.pp_int[*rowptr][ftbase_colparam1] = eparam1; - plan->entries.ptr.pp_int[*rowptr][ftbase_colparam2] = eparam2; - plan->entries.ptr.pp_int[*rowptr][ftbase_colparam3] = eparam3; - *rowptr = *rowptr+1; -} - - -/************************************************************************* -This subroutine applies subplan to input/output array A. - -INPUT PARAMETERS: - Plan - transformation plan - SubPlan - subplan index - A - array, must be large enough for plan to work - ABase - base offset in array A, this value points to start of - subarray whose length is equal to length of the plan - AOffset - offset with respect to ABase, 0<=AOffsetentries.ptr.pp_int[subplan][ftbase_coltype]==ftbase_opstart, "FTApplySubPlan: incorrect subplan header", _state); - rowidx = subplan+1; - while(plan->entries.ptr.pp_int[rowidx][ftbase_coltype]!=ftbase_opend) - { - operation = plan->entries.ptr.pp_int[rowidx][ftbase_coltype]; - operandscnt = repcnt*plan->entries.ptr.pp_int[rowidx][ftbase_coloperandscnt]; - operandsize = plan->entries.ptr.pp_int[rowidx][ftbase_coloperandsize]; - microvectorsize = plan->entries.ptr.pp_int[rowidx][ftbase_colmicrovectorsize]; - param0 = plan->entries.ptr.pp_int[rowidx][ftbase_colparam0]; - param1 = plan->entries.ptr.pp_int[rowidx][ftbase_colparam1]; - touchint(¶m1, _state); - - /* - * Process "jump" operation - */ - if( operation==ftbase_opjmp ) - { - rowidx = rowidx+plan->entries.ptr.pp_int[rowidx][ftbase_colparam0]; - continue; - } - - /* - * Process "parallel call" operation: - * * we perform initial check for consistency between parent and child plans - * * we call FTSplitAndApplyParallelPlan(), which splits parallel plan into - * several parallel tasks - */ - if( operation==ftbase_opparallelcall ) - { - parentsize = operandsize*microvectorsize; - childsize = plan->entries.ptr.pp_int[rowidx+param0][ftbase_coloperandscnt]*plan->entries.ptr.pp_int[rowidx+param0][ftbase_coloperandsize]*plan->entries.ptr.pp_int[rowidx+param0][ftbase_colmicrovectorsize]; - ae_assert(plan->entries.ptr.pp_int[rowidx+param0][ftbase_coltype]==ftbase_opstart, "FTApplySubPlan: incorrect child subplan header", _state); - ae_assert(parentsize==childsize, "FTApplySubPlan: incorrect child subplan header", _state); - chunksize = ae_maxint(ftbase_recursivethreshold/childsize, 1, _state); - lastchunksize = operandscnt%chunksize; - if( lastchunksize==0 ) - { - lastchunksize = chunksize; - } - i = 0; - while(ibluesteinpool, &_bufa, _state); - ae_shared_pool_retrieve(&plan->bluesteinpool, &_bufb, _state); - ae_shared_pool_retrieve(&plan->bluesteinpool, &_bufc, _state); - ae_shared_pool_retrieve(&plan->bluesteinpool, &_bufd, _state); - ftbase_ftbluesteinsfft(plan, a, abase, aoffset, operandscnt, operandsize, plan->entries.ptr.pp_int[rowidx][ftbase_colparam0], plan->entries.ptr.pp_int[rowidx][ftbase_colparam2], rowidx+plan->entries.ptr.pp_int[rowidx][ftbase_colparam1], &bufa->val, &bufb->val, &bufc->val, &bufd->val, _state); - ae_shared_pool_recycle(&plan->bluesteinpool, &_bufa, _state); - ae_shared_pool_recycle(&plan->bluesteinpool, &_bufb, _state); - ae_shared_pool_recycle(&plan->bluesteinpool, &_bufc, _state); - ae_shared_pool_recycle(&plan->bluesteinpool, &_bufd, _state); - rowidx = rowidx+1; - continue; - } - - /* - * Process Rader's FFT - */ - if( operation==ftbase_opradersfft ) - { - ftbase_ftradersfft(plan, a, abase, aoffset, operandscnt, operandsize, rowidx+plan->entries.ptr.pp_int[rowidx][ftbase_colparam0], plan->entries.ptr.pp_int[rowidx][ftbase_colparam1], plan->entries.ptr.pp_int[rowidx][ftbase_colparam2], plan->entries.ptr.pp_int[rowidx][ftbase_colparam3], buf, _state); - rowidx = rowidx+1; - continue; - } - - /* - * Process "complex twiddle factors" operation - */ - if( operation==ftbase_opcomplexfftfactors ) - { - ae_assert(microvectorsize==2, "FTApplySubPlan: MicrovectorSize<>1", _state); - n1 = plan->entries.ptr.pp_int[rowidx][ftbase_colparam0]; - n2 = operandsize/n1; - for(i=0; i<=operandscnt-1; i++) - { - ftbase_ffttwcalc(a, abase+aoffset+i*operandsize*2, n1, n2, _state); - } - rowidx = rowidx+1; - continue; - } - - /* - * Process "complex transposition" operation - */ - if( operation==ftbase_opcomplextranspose ) - { - ae_assert(microvectorsize==2, "FTApplySubPlan: MicrovectorSize<>1", _state); - n1 = plan->entries.ptr.pp_int[rowidx][ftbase_colparam0]; - n2 = operandsize/n1; - for(i=0; i<=operandscnt-1; i++) - { - ftbase_internalcomplexlintranspose(a, n1, n2, abase+aoffset+i*operandsize*2, buf, _state); - } - rowidx = rowidx+1; - continue; - } - - /* - * Error - */ - ae_assert(ae_false, "FTApplySubPlan: unexpected plan type", _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -This subroutine applies complex reference FFT to input/output array A. - -VERY SLOW OPERATION, do not use it in real life plans :) - -INPUT PARAMETERS: - A - array, must be large enough for plan to work - Offs - offset of the subarray to process - OperandsCnt - operands count (see description of FastTransformPlan) - OperandSize - operand size (see description of FastTransformPlan) - MicrovectorSize-microvector size (see description of FastTransformPlan) - Buf - temporary array, must be at least OperandsCnt*OperandSize*MicrovectorSize - -OUTPUT PARAMETERS: - A - transformed array - - -- ALGLIB -- - Copyright 05.04.2013 by Bochkanov Sergey -*************************************************************************/ -static void ftbase_ftapplycomplexreffft(/* Real */ ae_vector* a, - ae_int_t offs, - ae_int_t operandscnt, - ae_int_t operandsize, - ae_int_t microvectorsize, - /* Real */ ae_vector* buf, - ae_state *_state) -{ - ae_int_t opidx; - ae_int_t i; - ae_int_t k; - double hre; - double him; - double c; - double s; - double re; - double im; - ae_int_t n; - - - ae_assert(operandscnt>=1, "FTApplyComplexRefFFT: OperandsCnt<1", _state); - ae_assert(operandsize>=1, "FTApplyComplexRefFFT: OperandSize<1", _state); - ae_assert(microvectorsize==2, "FTApplyComplexRefFFT: MicrovectorSize<>2", _state); - n = operandsize; - for(opidx=0; opidx<=operandscnt-1; opidx++) - { - for(i=0; i<=n-1; i++) - { - hre = 0; - him = 0; - for(k=0; k<=n-1; k++) - { - re = a->ptr.p_double[offs+opidx*operandsize*2+2*k+0]; - im = a->ptr.p_double[offs+opidx*operandsize*2+2*k+1]; - c = ae_cos(-2*ae_pi*k*i/n, _state); - s = ae_sin(-2*ae_pi*k*i/n, _state); - hre = hre+c*re-s*im; - him = him+c*im+s*re; - } - buf->ptr.p_double[2*i+0] = hre; - buf->ptr.p_double[2*i+1] = him; - } - for(i=0; i<=operandsize*2-1; i++) - { - a->ptr.p_double[offs+opidx*operandsize*2+i] = buf->ptr.p_double[i]; - } - } -} - - -/************************************************************************* -This subroutine applies complex codelet FFT to input/output array A. - -INPUT PARAMETERS: - A - array, must be large enough for plan to work - Offs - offset of the subarray to process - OperandsCnt - operands count (see description of FastTransformPlan) - OperandSize - operand size (see description of FastTransformPlan) - MicrovectorSize-microvector size, must be 2 - -OUTPUT PARAMETERS: - A - transformed array - - -- ALGLIB -- - Copyright 05.04.2013 by Bochkanov Sergey -*************************************************************************/ -static void ftbase_ftapplycomplexcodeletfft(/* Real */ ae_vector* a, - ae_int_t offs, - ae_int_t operandscnt, - ae_int_t operandsize, - ae_int_t microvectorsize, - ae_state *_state) -{ - ae_int_t opidx; - ae_int_t n; - ae_int_t aoffset; - double a0x; - double a0y; - double a1x; - double a1y; - double a2x; - double a2y; - double a3x; - double a3y; - double a4x; - double a4y; - double a5x; - double a5y; - double v0; - double v1; - double v2; - double v3; - double t1x; - double t1y; - double t2x; - double t2y; - double t3x; - double t3y; - double t4x; - double t4y; - double t5x; - double t5y; - double m1x; - double m1y; - double m2x; - double m2y; - double m3x; - double m3y; - double m4x; - double m4y; - double m5x; - double m5y; - double s1x; - double s1y; - double s2x; - double s2y; - double s3x; - double s3y; - double s4x; - double s4y; - double s5x; - double s5y; - double c1; - double c2; - double c3; - double c4; - double c5; - double v; - - - ae_assert(operandscnt>=1, "FTApplyComplexCodeletFFT: OperandsCnt<1", _state); - ae_assert(operandsize>=1, "FTApplyComplexCodeletFFT: OperandSize<1", _state); - ae_assert(microvectorsize==2, "FTApplyComplexCodeletFFT: MicrovectorSize<>2", _state); - n = operandsize; - - /* - * Hard-coded transforms for different N's - */ - ae_assert(n<=ftbase_maxradix, "FTApplyComplexCodeletFFT: N>MaxRadix", _state); - if( n==2 ) - { - for(opidx=0; opidx<=operandscnt-1; opidx++) - { - aoffset = offs+opidx*operandsize*2; - a0x = a->ptr.p_double[aoffset+0]; - a0y = a->ptr.p_double[aoffset+1]; - a1x = a->ptr.p_double[aoffset+2]; - a1y = a->ptr.p_double[aoffset+3]; - v0 = a0x+a1x; - v1 = a0y+a1y; - v2 = a0x-a1x; - v3 = a0y-a1y; - a->ptr.p_double[aoffset+0] = v0; - a->ptr.p_double[aoffset+1] = v1; - a->ptr.p_double[aoffset+2] = v2; - a->ptr.p_double[aoffset+3] = v3; - } - return; - } - if( n==3 ) - { - c1 = ae_cos(2*ae_pi/3, _state)-1; - c2 = ae_sin(2*ae_pi/3, _state); - for(opidx=0; opidx<=operandscnt-1; opidx++) - { - aoffset = offs+opidx*operandsize*2; - a0x = a->ptr.p_double[aoffset+0]; - a0y = a->ptr.p_double[aoffset+1]; - a1x = a->ptr.p_double[aoffset+2]; - a1y = a->ptr.p_double[aoffset+3]; - a2x = a->ptr.p_double[aoffset+4]; - a2y = a->ptr.p_double[aoffset+5]; - t1x = a1x+a2x; - t1y = a1y+a2y; - a0x = a0x+t1x; - a0y = a0y+t1y; - m1x = c1*t1x; - m1y = c1*t1y; - m2x = c2*(a1y-a2y); - m2y = c2*(a2x-a1x); - s1x = a0x+m1x; - s1y = a0y+m1y; - a1x = s1x+m2x; - a1y = s1y+m2y; - a2x = s1x-m2x; - a2y = s1y-m2y; - a->ptr.p_double[aoffset+0] = a0x; - a->ptr.p_double[aoffset+1] = a0y; - a->ptr.p_double[aoffset+2] = a1x; - a->ptr.p_double[aoffset+3] = a1y; - a->ptr.p_double[aoffset+4] = a2x; - a->ptr.p_double[aoffset+5] = a2y; - } - return; - } - if( n==4 ) - { - for(opidx=0; opidx<=operandscnt-1; opidx++) - { - aoffset = offs+opidx*operandsize*2; - a0x = a->ptr.p_double[aoffset+0]; - a0y = a->ptr.p_double[aoffset+1]; - a1x = a->ptr.p_double[aoffset+2]; - a1y = a->ptr.p_double[aoffset+3]; - a2x = a->ptr.p_double[aoffset+4]; - a2y = a->ptr.p_double[aoffset+5]; - a3x = a->ptr.p_double[aoffset+6]; - a3y = a->ptr.p_double[aoffset+7]; - t1x = a0x+a2x; - t1y = a0y+a2y; - t2x = a1x+a3x; - t2y = a1y+a3y; - m2x = a0x-a2x; - m2y = a0y-a2y; - m3x = a1y-a3y; - m3y = a3x-a1x; - a->ptr.p_double[aoffset+0] = t1x+t2x; - a->ptr.p_double[aoffset+1] = t1y+t2y; - a->ptr.p_double[aoffset+4] = t1x-t2x; - a->ptr.p_double[aoffset+5] = t1y-t2y; - a->ptr.p_double[aoffset+2] = m2x+m3x; - a->ptr.p_double[aoffset+3] = m2y+m3y; - a->ptr.p_double[aoffset+6] = m2x-m3x; - a->ptr.p_double[aoffset+7] = m2y-m3y; - } - return; - } - if( n==5 ) - { - v = 2*ae_pi/5; - c1 = (ae_cos(v, _state)+ae_cos(2*v, _state))/2-1; - c2 = (ae_cos(v, _state)-ae_cos(2*v, _state))/2; - c3 = -ae_sin(v, _state); - c4 = -(ae_sin(v, _state)+ae_sin(2*v, _state)); - c5 = ae_sin(v, _state)-ae_sin(2*v, _state); - for(opidx=0; opidx<=operandscnt-1; opidx++) - { - aoffset = offs+opidx*operandsize*2; - t1x = a->ptr.p_double[aoffset+2]+a->ptr.p_double[aoffset+8]; - t1y = a->ptr.p_double[aoffset+3]+a->ptr.p_double[aoffset+9]; - t2x = a->ptr.p_double[aoffset+4]+a->ptr.p_double[aoffset+6]; - t2y = a->ptr.p_double[aoffset+5]+a->ptr.p_double[aoffset+7]; - t3x = a->ptr.p_double[aoffset+2]-a->ptr.p_double[aoffset+8]; - t3y = a->ptr.p_double[aoffset+3]-a->ptr.p_double[aoffset+9]; - t4x = a->ptr.p_double[aoffset+6]-a->ptr.p_double[aoffset+4]; - t4y = a->ptr.p_double[aoffset+7]-a->ptr.p_double[aoffset+5]; - t5x = t1x+t2x; - t5y = t1y+t2y; - a->ptr.p_double[aoffset+0] = a->ptr.p_double[aoffset+0]+t5x; - a->ptr.p_double[aoffset+1] = a->ptr.p_double[aoffset+1]+t5y; - m1x = c1*t5x; - m1y = c1*t5y; - m2x = c2*(t1x-t2x); - m2y = c2*(t1y-t2y); - m3x = -c3*(t3y+t4y); - m3y = c3*(t3x+t4x); - m4x = -c4*t4y; - m4y = c4*t4x; - m5x = -c5*t3y; - m5y = c5*t3x; - s3x = m3x-m4x; - s3y = m3y-m4y; - s5x = m3x+m5x; - s5y = m3y+m5y; - s1x = a->ptr.p_double[aoffset+0]+m1x; - s1y = a->ptr.p_double[aoffset+1]+m1y; - s2x = s1x+m2x; - s2y = s1y+m2y; - s4x = s1x-m2x; - s4y = s1y-m2y; - a->ptr.p_double[aoffset+2] = s2x+s3x; - a->ptr.p_double[aoffset+3] = s2y+s3y; - a->ptr.p_double[aoffset+4] = s4x+s5x; - a->ptr.p_double[aoffset+5] = s4y+s5y; - a->ptr.p_double[aoffset+6] = s4x-s5x; - a->ptr.p_double[aoffset+7] = s4y-s5y; - a->ptr.p_double[aoffset+8] = s2x-s3x; - a->ptr.p_double[aoffset+9] = s2y-s3y; - } - return; - } - if( n==6 ) - { - c1 = ae_cos(2*ae_pi/3, _state)-1; - c2 = ae_sin(2*ae_pi/3, _state); - c3 = ae_cos(-ae_pi/3, _state); - c4 = ae_sin(-ae_pi/3, _state); - for(opidx=0; opidx<=operandscnt-1; opidx++) - { - aoffset = offs+opidx*operandsize*2; - a0x = a->ptr.p_double[aoffset+0]; - a0y = a->ptr.p_double[aoffset+1]; - a1x = a->ptr.p_double[aoffset+2]; - a1y = a->ptr.p_double[aoffset+3]; - a2x = a->ptr.p_double[aoffset+4]; - a2y = a->ptr.p_double[aoffset+5]; - a3x = a->ptr.p_double[aoffset+6]; - a3y = a->ptr.p_double[aoffset+7]; - a4x = a->ptr.p_double[aoffset+8]; - a4y = a->ptr.p_double[aoffset+9]; - a5x = a->ptr.p_double[aoffset+10]; - a5y = a->ptr.p_double[aoffset+11]; - v0 = a0x; - v1 = a0y; - a0x = a0x+a3x; - a0y = a0y+a3y; - a3x = v0-a3x; - a3y = v1-a3y; - v0 = a1x; - v1 = a1y; - a1x = a1x+a4x; - a1y = a1y+a4y; - a4x = v0-a4x; - a4y = v1-a4y; - v0 = a2x; - v1 = a2y; - a2x = a2x+a5x; - a2y = a2y+a5y; - a5x = v0-a5x; - a5y = v1-a5y; - t4x = a4x*c3-a4y*c4; - t4y = a4x*c4+a4y*c3; - a4x = t4x; - a4y = t4y; - t5x = -a5x*c3-a5y*c4; - t5y = a5x*c4-a5y*c3; - a5x = t5x; - a5y = t5y; - t1x = a1x+a2x; - t1y = a1y+a2y; - a0x = a0x+t1x; - a0y = a0y+t1y; - m1x = c1*t1x; - m1y = c1*t1y; - m2x = c2*(a1y-a2y); - m2y = c2*(a2x-a1x); - s1x = a0x+m1x; - s1y = a0y+m1y; - a1x = s1x+m2x; - a1y = s1y+m2y; - a2x = s1x-m2x; - a2y = s1y-m2y; - t1x = a4x+a5x; - t1y = a4y+a5y; - a3x = a3x+t1x; - a3y = a3y+t1y; - m1x = c1*t1x; - m1y = c1*t1y; - m2x = c2*(a4y-a5y); - m2y = c2*(a5x-a4x); - s1x = a3x+m1x; - s1y = a3y+m1y; - a4x = s1x+m2x; - a4y = s1y+m2y; - a5x = s1x-m2x; - a5y = s1y-m2y; - a->ptr.p_double[aoffset+0] = a0x; - a->ptr.p_double[aoffset+1] = a0y; - a->ptr.p_double[aoffset+2] = a3x; - a->ptr.p_double[aoffset+3] = a3y; - a->ptr.p_double[aoffset+4] = a1x; - a->ptr.p_double[aoffset+5] = a1y; - a->ptr.p_double[aoffset+6] = a4x; - a->ptr.p_double[aoffset+7] = a4y; - a->ptr.p_double[aoffset+8] = a2x; - a->ptr.p_double[aoffset+9] = a2y; - a->ptr.p_double[aoffset+10] = a5x; - a->ptr.p_double[aoffset+11] = a5y; - } - return; - } -} - - -/************************************************************************* -This subroutine applies complex "integrated" codelet FFT to input/output -array A. "Integrated" codelet differs from "normal" one in following ways: -* it can work with MicrovectorSize>1 -* hence, it can be used in Cooley-Tukey FFT without transpositions -* it performs inlined multiplication by twiddle factors of Cooley-Tukey - FFT with N2=MicrovectorSize/2. - -INPUT PARAMETERS: - A - array, must be large enough for plan to work - Offs - offset of the subarray to process - OperandsCnt - operands count (see description of FastTransformPlan) - OperandSize - operand size (see description of FastTransformPlan) - MicrovectorSize-microvector size, must be 1 - -OUTPUT PARAMETERS: - A - transformed array - - -- ALGLIB -- - Copyright 05.04.2013 by Bochkanov Sergey -*************************************************************************/ -static void ftbase_ftapplycomplexcodelettwfft(/* Real */ ae_vector* a, - ae_int_t offs, - ae_int_t operandscnt, - ae_int_t operandsize, - ae_int_t microvectorsize, - ae_state *_state) -{ - ae_int_t opidx; - ae_int_t mvidx; - ae_int_t n; - ae_int_t m; - ae_int_t aoffset0; - ae_int_t aoffset2; - ae_int_t aoffset4; - ae_int_t aoffset6; - ae_int_t aoffset8; - ae_int_t aoffset10; - double a0x; - double a0y; - double a1x; - double a1y; - double a2x; - double a2y; - double a3x; - double a3y; - double a4x; - double a4y; - double a5x; - double a5y; - double v0; - double v1; - double v2; - double v3; - double q0x; - double q0y; - double t1x; - double t1y; - double t2x; - double t2y; - double t3x; - double t3y; - double t4x; - double t4y; - double t5x; - double t5y; - double m1x; - double m1y; - double m2x; - double m2y; - double m3x; - double m3y; - double m4x; - double m4y; - double m5x; - double m5y; - double s1x; - double s1y; - double s2x; - double s2y; - double s3x; - double s3y; - double s4x; - double s4y; - double s5x; - double s5y; - double c1; - double c2; - double c3; - double c4; - double c5; - double v; - double tw0; - double tw1; - double twx; - double twxm1; - double twy; - double tw2x; - double tw2y; - double tw3x; - double tw3y; - double tw4x; - double tw4y; - double tw5x; - double tw5y; - - - ae_assert(operandscnt>=1, "FTApplyComplexCodeletFFT: OperandsCnt<1", _state); - ae_assert(operandsize>=1, "FTApplyComplexCodeletFFT: OperandSize<1", _state); - ae_assert(microvectorsize>=1, "FTApplyComplexCodeletFFT: MicrovectorSize<>1", _state); - ae_assert(microvectorsize%2==0, "FTApplyComplexCodeletFFT: MicrovectorSize is not even", _state); - n = operandsize; - m = microvectorsize/2; - - /* - * Hard-coded transforms for different N's - */ - ae_assert(n<=ftbase_maxradix, "FTApplyComplexCodeletTwFFT: N>MaxRadix", _state); - if( n==2 ) - { - v = -2*ae_pi/(n*m); - tw0 = -2*ae_sqr(ae_sin(0.5*v, _state), _state); - tw1 = ae_sin(v, _state); - for(opidx=0; opidx<=operandscnt-1; opidx++) - { - aoffset0 = offs+opidx*operandsize*microvectorsize; - aoffset2 = aoffset0+microvectorsize; - twxm1 = 0.0; - twy = 0.0; - for(mvidx=0; mvidx<=m-1; mvidx++) - { - a0x = a->ptr.p_double[aoffset0]; - a0y = a->ptr.p_double[aoffset0+1]; - a1x = a->ptr.p_double[aoffset2]; - a1y = a->ptr.p_double[aoffset2+1]; - v0 = a0x+a1x; - v1 = a0y+a1y; - v2 = a0x-a1x; - v3 = a0y-a1y; - a->ptr.p_double[aoffset0] = v0; - a->ptr.p_double[aoffset0+1] = v1; - a->ptr.p_double[aoffset2] = v2*(1+twxm1)-v3*twy; - a->ptr.p_double[aoffset2+1] = v3*(1+twxm1)+v2*twy; - aoffset0 = aoffset0+2; - aoffset2 = aoffset2+2; - if( (mvidx+1)%ftbase_updatetw==0 ) - { - v = -2*ae_pi*(mvidx+1)/(n*m); - twxm1 = ae_sin(0.5*v, _state); - twxm1 = -2*twxm1*twxm1; - twy = ae_sin(v, _state); - } - else - { - v = twxm1+tw0+twxm1*tw0-twy*tw1; - twy = twy+tw1+twxm1*tw1+twy*tw0; - twxm1 = v; - } - } - } - return; - } - if( n==3 ) - { - v = -2*ae_pi/(n*m); - tw0 = -2*ae_sqr(ae_sin(0.5*v, _state), _state); - tw1 = ae_sin(v, _state); - c1 = ae_cos(2*ae_pi/3, _state)-1; - c2 = ae_sin(2*ae_pi/3, _state); - for(opidx=0; opidx<=operandscnt-1; opidx++) - { - aoffset0 = offs+opidx*operandsize*microvectorsize; - aoffset2 = aoffset0+microvectorsize; - aoffset4 = aoffset2+microvectorsize; - twx = 1.0; - twxm1 = 0.0; - twy = 0.0; - for(mvidx=0; mvidx<=m-1; mvidx++) - { - a0x = a->ptr.p_double[aoffset0]; - a0y = a->ptr.p_double[aoffset0+1]; - a1x = a->ptr.p_double[aoffset2]; - a1y = a->ptr.p_double[aoffset2+1]; - a2x = a->ptr.p_double[aoffset4]; - a2y = a->ptr.p_double[aoffset4+1]; - t1x = a1x+a2x; - t1y = a1y+a2y; - a0x = a0x+t1x; - a0y = a0y+t1y; - m1x = c1*t1x; - m1y = c1*t1y; - m2x = c2*(a1y-a2y); - m2y = c2*(a2x-a1x); - s1x = a0x+m1x; - s1y = a0y+m1y; - a1x = s1x+m2x; - a1y = s1y+m2y; - a2x = s1x-m2x; - a2y = s1y-m2y; - tw2x = twx*twx-twy*twy; - tw2y = 2*twx*twy; - a->ptr.p_double[aoffset0] = a0x; - a->ptr.p_double[aoffset0+1] = a0y; - a->ptr.p_double[aoffset2] = a1x*twx-a1y*twy; - a->ptr.p_double[aoffset2+1] = a1y*twx+a1x*twy; - a->ptr.p_double[aoffset4] = a2x*tw2x-a2y*tw2y; - a->ptr.p_double[aoffset4+1] = a2y*tw2x+a2x*tw2y; - aoffset0 = aoffset0+2; - aoffset2 = aoffset2+2; - aoffset4 = aoffset4+2; - if( (mvidx+1)%ftbase_updatetw==0 ) - { - v = -2*ae_pi*(mvidx+1)/(n*m); - twxm1 = ae_sin(0.5*v, _state); - twxm1 = -2*twxm1*twxm1; - twy = ae_sin(v, _state); - twx = twxm1+1; - } - else - { - v = twxm1+tw0+twxm1*tw0-twy*tw1; - twy = twy+tw1+twxm1*tw1+twy*tw0; - twxm1 = v; - twx = v+1; - } - } - } - return; - } - if( n==4 ) - { - v = -2*ae_pi/(n*m); - tw0 = -2*ae_sqr(ae_sin(0.5*v, _state), _state); - tw1 = ae_sin(v, _state); - for(opidx=0; opidx<=operandscnt-1; opidx++) - { - aoffset0 = offs+opidx*operandsize*microvectorsize; - aoffset2 = aoffset0+microvectorsize; - aoffset4 = aoffset2+microvectorsize; - aoffset6 = aoffset4+microvectorsize; - twx = 1.0; - twxm1 = 0.0; - twy = 0.0; - for(mvidx=0; mvidx<=m-1; mvidx++) - { - a0x = a->ptr.p_double[aoffset0]; - a0y = a->ptr.p_double[aoffset0+1]; - a1x = a->ptr.p_double[aoffset2]; - a1y = a->ptr.p_double[aoffset2+1]; - a2x = a->ptr.p_double[aoffset4]; - a2y = a->ptr.p_double[aoffset4+1]; - a3x = a->ptr.p_double[aoffset6]; - a3y = a->ptr.p_double[aoffset6+1]; - t1x = a0x+a2x; - t1y = a0y+a2y; - t2x = a1x+a3x; - t2y = a1y+a3y; - m2x = a0x-a2x; - m2y = a0y-a2y; - m3x = a1y-a3y; - m3y = a3x-a1x; - tw2x = twx*twx-twy*twy; - tw2y = 2*twx*twy; - tw3x = twx*tw2x-twy*tw2y; - tw3y = twx*tw2y+twy*tw2x; - a1x = m2x+m3x; - a1y = m2y+m3y; - a2x = t1x-t2x; - a2y = t1y-t2y; - a3x = m2x-m3x; - a3y = m2y-m3y; - a->ptr.p_double[aoffset0] = t1x+t2x; - a->ptr.p_double[aoffset0+1] = t1y+t2y; - a->ptr.p_double[aoffset2] = a1x*twx-a1y*twy; - a->ptr.p_double[aoffset2+1] = a1y*twx+a1x*twy; - a->ptr.p_double[aoffset4] = a2x*tw2x-a2y*tw2y; - a->ptr.p_double[aoffset4+1] = a2y*tw2x+a2x*tw2y; - a->ptr.p_double[aoffset6] = a3x*tw3x-a3y*tw3y; - a->ptr.p_double[aoffset6+1] = a3y*tw3x+a3x*tw3y; - aoffset0 = aoffset0+2; - aoffset2 = aoffset2+2; - aoffset4 = aoffset4+2; - aoffset6 = aoffset6+2; - if( (mvidx+1)%ftbase_updatetw==0 ) - { - v = -2*ae_pi*(mvidx+1)/(n*m); - twxm1 = ae_sin(0.5*v, _state); - twxm1 = -2*twxm1*twxm1; - twy = ae_sin(v, _state); - twx = twxm1+1; - } - else - { - v = twxm1+tw0+twxm1*tw0-twy*tw1; - twy = twy+tw1+twxm1*tw1+twy*tw0; - twxm1 = v; - twx = v+1; - } - } - } - return; - } - if( n==5 ) - { - v = -2*ae_pi/(n*m); - tw0 = -2*ae_sqr(ae_sin(0.5*v, _state), _state); - tw1 = ae_sin(v, _state); - v = 2*ae_pi/5; - c1 = (ae_cos(v, _state)+ae_cos(2*v, _state))/2-1; - c2 = (ae_cos(v, _state)-ae_cos(2*v, _state))/2; - c3 = -ae_sin(v, _state); - c4 = -(ae_sin(v, _state)+ae_sin(2*v, _state)); - c5 = ae_sin(v, _state)-ae_sin(2*v, _state); - for(opidx=0; opidx<=operandscnt-1; opidx++) - { - aoffset0 = offs+opidx*operandsize*microvectorsize; - aoffset2 = aoffset0+microvectorsize; - aoffset4 = aoffset2+microvectorsize; - aoffset6 = aoffset4+microvectorsize; - aoffset8 = aoffset6+microvectorsize; - twx = 1.0; - twxm1 = 0.0; - twy = 0.0; - for(mvidx=0; mvidx<=m-1; mvidx++) - { - a0x = a->ptr.p_double[aoffset0]; - a0y = a->ptr.p_double[aoffset0+1]; - a1x = a->ptr.p_double[aoffset2]; - a1y = a->ptr.p_double[aoffset2+1]; - a2x = a->ptr.p_double[aoffset4]; - a2y = a->ptr.p_double[aoffset4+1]; - a3x = a->ptr.p_double[aoffset6]; - a3y = a->ptr.p_double[aoffset6+1]; - a4x = a->ptr.p_double[aoffset8]; - a4y = a->ptr.p_double[aoffset8+1]; - t1x = a1x+a4x; - t1y = a1y+a4y; - t2x = a2x+a3x; - t2y = a2y+a3y; - t3x = a1x-a4x; - t3y = a1y-a4y; - t4x = a3x-a2x; - t4y = a3y-a2y; - t5x = t1x+t2x; - t5y = t1y+t2y; - q0x = a0x+t5x; - q0y = a0y+t5y; - m1x = c1*t5x; - m1y = c1*t5y; - m2x = c2*(t1x-t2x); - m2y = c2*(t1y-t2y); - m3x = -c3*(t3y+t4y); - m3y = c3*(t3x+t4x); - m4x = -c4*t4y; - m4y = c4*t4x; - m5x = -c5*t3y; - m5y = c5*t3x; - s3x = m3x-m4x; - s3y = m3y-m4y; - s5x = m3x+m5x; - s5y = m3y+m5y; - s1x = q0x+m1x; - s1y = q0y+m1y; - s2x = s1x+m2x; - s2y = s1y+m2y; - s4x = s1x-m2x; - s4y = s1y-m2y; - tw2x = twx*twx-twy*twy; - tw2y = 2*twx*twy; - tw3x = twx*tw2x-twy*tw2y; - tw3y = twx*tw2y+twy*tw2x; - tw4x = tw2x*tw2x-tw2y*tw2y; - tw4y = tw2x*tw2y+tw2y*tw2x; - a1x = s2x+s3x; - a1y = s2y+s3y; - a2x = s4x+s5x; - a2y = s4y+s5y; - a3x = s4x-s5x; - a3y = s4y-s5y; - a4x = s2x-s3x; - a4y = s2y-s3y; - a->ptr.p_double[aoffset0] = q0x; - a->ptr.p_double[aoffset0+1] = q0y; - a->ptr.p_double[aoffset2] = a1x*twx-a1y*twy; - a->ptr.p_double[aoffset2+1] = a1x*twy+a1y*twx; - a->ptr.p_double[aoffset4] = a2x*tw2x-a2y*tw2y; - a->ptr.p_double[aoffset4+1] = a2x*tw2y+a2y*tw2x; - a->ptr.p_double[aoffset6] = a3x*tw3x-a3y*tw3y; - a->ptr.p_double[aoffset6+1] = a3x*tw3y+a3y*tw3x; - a->ptr.p_double[aoffset8] = a4x*tw4x-a4y*tw4y; - a->ptr.p_double[aoffset8+1] = a4x*tw4y+a4y*tw4x; - aoffset0 = aoffset0+2; - aoffset2 = aoffset2+2; - aoffset4 = aoffset4+2; - aoffset6 = aoffset6+2; - aoffset8 = aoffset8+2; - if( (mvidx+1)%ftbase_updatetw==0 ) - { - v = -2*ae_pi*(mvidx+1)/(n*m); - twxm1 = ae_sin(0.5*v, _state); - twxm1 = -2*twxm1*twxm1; - twy = ae_sin(v, _state); - twx = twxm1+1; - } - else - { - v = twxm1+tw0+twxm1*tw0-twy*tw1; - twy = twy+tw1+twxm1*tw1+twy*tw0; - twxm1 = v; - twx = v+1; - } - } - } - return; - } - if( n==6 ) - { - c1 = ae_cos(2*ae_pi/3, _state)-1; - c2 = ae_sin(2*ae_pi/3, _state); - c3 = ae_cos(-ae_pi/3, _state); - c4 = ae_sin(-ae_pi/3, _state); - v = -2*ae_pi/(n*m); - tw0 = -2*ae_sqr(ae_sin(0.5*v, _state), _state); - tw1 = ae_sin(v, _state); - for(opidx=0; opidx<=operandscnt-1; opidx++) - { - aoffset0 = offs+opidx*operandsize*microvectorsize; - aoffset2 = aoffset0+microvectorsize; - aoffset4 = aoffset2+microvectorsize; - aoffset6 = aoffset4+microvectorsize; - aoffset8 = aoffset6+microvectorsize; - aoffset10 = aoffset8+microvectorsize; - twx = 1.0; - twxm1 = 0.0; - twy = 0.0; - for(mvidx=0; mvidx<=m-1; mvidx++) - { - a0x = a->ptr.p_double[aoffset0+0]; - a0y = a->ptr.p_double[aoffset0+1]; - a1x = a->ptr.p_double[aoffset2+0]; - a1y = a->ptr.p_double[aoffset2+1]; - a2x = a->ptr.p_double[aoffset4+0]; - a2y = a->ptr.p_double[aoffset4+1]; - a3x = a->ptr.p_double[aoffset6+0]; - a3y = a->ptr.p_double[aoffset6+1]; - a4x = a->ptr.p_double[aoffset8+0]; - a4y = a->ptr.p_double[aoffset8+1]; - a5x = a->ptr.p_double[aoffset10+0]; - a5y = a->ptr.p_double[aoffset10+1]; - v0 = a0x; - v1 = a0y; - a0x = a0x+a3x; - a0y = a0y+a3y; - a3x = v0-a3x; - a3y = v1-a3y; - v0 = a1x; - v1 = a1y; - a1x = a1x+a4x; - a1y = a1y+a4y; - a4x = v0-a4x; - a4y = v1-a4y; - v0 = a2x; - v1 = a2y; - a2x = a2x+a5x; - a2y = a2y+a5y; - a5x = v0-a5x; - a5y = v1-a5y; - t4x = a4x*c3-a4y*c4; - t4y = a4x*c4+a4y*c3; - a4x = t4x; - a4y = t4y; - t5x = -a5x*c3-a5y*c4; - t5y = a5x*c4-a5y*c3; - a5x = t5x; - a5y = t5y; - t1x = a1x+a2x; - t1y = a1y+a2y; - a0x = a0x+t1x; - a0y = a0y+t1y; - m1x = c1*t1x; - m1y = c1*t1y; - m2x = c2*(a1y-a2y); - m2y = c2*(a2x-a1x); - s1x = a0x+m1x; - s1y = a0y+m1y; - a1x = s1x+m2x; - a1y = s1y+m2y; - a2x = s1x-m2x; - a2y = s1y-m2y; - t1x = a4x+a5x; - t1y = a4y+a5y; - a3x = a3x+t1x; - a3y = a3y+t1y; - m1x = c1*t1x; - m1y = c1*t1y; - m2x = c2*(a4y-a5y); - m2y = c2*(a5x-a4x); - s1x = a3x+m1x; - s1y = a3y+m1y; - a4x = s1x+m2x; - a4y = s1y+m2y; - a5x = s1x-m2x; - a5y = s1y-m2y; - tw2x = twx*twx-twy*twy; - tw2y = 2*twx*twy; - tw3x = twx*tw2x-twy*tw2y; - tw3y = twx*tw2y+twy*tw2x; - tw4x = tw2x*tw2x-tw2y*tw2y; - tw4y = 2*tw2x*tw2y; - tw5x = tw3x*tw2x-tw3y*tw2y; - tw5y = tw3x*tw2y+tw3y*tw2x; - a->ptr.p_double[aoffset0+0] = a0x; - a->ptr.p_double[aoffset0+1] = a0y; - a->ptr.p_double[aoffset2+0] = a3x*twx-a3y*twy; - a->ptr.p_double[aoffset2+1] = a3y*twx+a3x*twy; - a->ptr.p_double[aoffset4+0] = a1x*tw2x-a1y*tw2y; - a->ptr.p_double[aoffset4+1] = a1y*tw2x+a1x*tw2y; - a->ptr.p_double[aoffset6+0] = a4x*tw3x-a4y*tw3y; - a->ptr.p_double[aoffset6+1] = a4y*tw3x+a4x*tw3y; - a->ptr.p_double[aoffset8+0] = a2x*tw4x-a2y*tw4y; - a->ptr.p_double[aoffset8+1] = a2y*tw4x+a2x*tw4y; - a->ptr.p_double[aoffset10+0] = a5x*tw5x-a5y*tw5y; - a->ptr.p_double[aoffset10+1] = a5y*tw5x+a5x*tw5y; - aoffset0 = aoffset0+2; - aoffset2 = aoffset2+2; - aoffset4 = aoffset4+2; - aoffset6 = aoffset6+2; - aoffset8 = aoffset8+2; - aoffset10 = aoffset10+2; - if( (mvidx+1)%ftbase_updatetw==0 ) - { - v = -2*ae_pi*(mvidx+1)/(n*m); - twxm1 = ae_sin(0.5*v, _state); - twxm1 = -2*twxm1*twxm1; - twy = ae_sin(v, _state); - twx = twxm1+1; - } - else - { - v = twxm1+tw0+twxm1*tw0-twy*tw1; - twy = twy+tw1+twxm1*tw1+twy*tw0; - twxm1 = v; - twx = v+1; - } - } - } - return; - } -} - - -/************************************************************************* -This subroutine precomputes data for complex Bluestein's FFT and writes -them to array PrecR[] at specified offset. It is responsibility of the -caller to make sure that PrecR[] is large enough. - -INPUT PARAMETERS: - N - original size of the transform - M - size of the "padded" Bluestein's transform - PrecR - preallocated array - Offs - offset - -OUTPUT PARAMETERS: - PrecR - data at Offs:Offs+4*M-1 are modified: - * PrecR[Offs:Offs+2*M-1] stores Z[k]=exp(i*pi*k^2/N) - * PrecR[Offs+2*M:Offs+4*M-1] stores FFT of the Z - Other parts of PrecR are unchanged. - -NOTE: this function performs internal M-point FFT. It allocates temporary - plan which is destroyed after leaving this function. - - -- ALGLIB -- - Copyright 08.05.2013 by Bochkanov Sergey -*************************************************************************/ -static void ftbase_ftprecomputebluesteinsfft(ae_int_t n, - ae_int_t m, - /* Real */ ae_vector* precr, - ae_int_t offs, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - double bx; - double by; - fasttransformplan plan; - - ae_frame_make(_state, &_frame_block); - _fasttransformplan_init(&plan, _state, ae_true); - - - /* - * Fill first half of PrecR with b[k] = exp(i*pi*k^2/N) - */ - for(i=0; i<=2*m-1; i++) - { - precr->ptr.p_double[offs+i] = 0; - } - for(i=0; i<=n-1; i++) - { - bx = ae_cos(ae_pi/n*i*i, _state); - by = ae_sin(ae_pi/n*i*i, _state); - precr->ptr.p_double[offs+2*i+0] = bx; - precr->ptr.p_double[offs+2*i+1] = by; - precr->ptr.p_double[offs+2*((m-i)%m)+0] = bx; - precr->ptr.p_double[offs+2*((m-i)%m)+1] = by; - } - - /* - * Precomputed FFT - */ - ftcomplexfftplan(m, 1, &plan, _state); - for(i=0; i<=2*m-1; i++) - { - precr->ptr.p_double[offs+2*m+i] = precr->ptr.p_double[offs+i]; - } - ftbase_ftapplysubplan(&plan, 0, precr, offs+2*m, 0, &plan.buffer, 1, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -This subroutine applies complex Bluestein's FFT to input/output array A. - -INPUT PARAMETERS: - Plan - transformation plan - A - array, must be large enough for plan to work - ABase - base offset in array A, this value points to start of - subarray whose length is equal to length of the plan - AOffset - offset with respect to ABase, 0<=AOffsetptr.p_double[p0+0]; - y = a->ptr.p_double[p0+1]; - bx = plan->precr.ptr.p_double[p1+0]; - by = -plan->precr.ptr.p_double[p1+1]; - bufa->ptr.p_double[2*i+0] = x*bx-y*by; - bufa->ptr.p_double[2*i+1] = x*by+y*bx; - p0 = p0+2; - p1 = p1+2; - } - for(i=2*n; i<=2*m-1; i++) - { - bufa->ptr.p_double[i] = 0; - } - - /* - * Perform convolution of A and Z (using precomputed - * FFT of Z stored in Plan structure). - */ - ftbase_ftapplysubplan(plan, subplan, bufa, 0, 0, bufc, 1, _state); - p0 = 0; - p1 = precoffs+2*m; - for(i=0; i<=m-1; i++) - { - ax = bufa->ptr.p_double[p0+0]; - ay = bufa->ptr.p_double[p0+1]; - bx = plan->precr.ptr.p_double[p1+0]; - by = plan->precr.ptr.p_double[p1+1]; - bufa->ptr.p_double[p0+0] = ax*bx-ay*by; - bufa->ptr.p_double[p0+1] = -(ax*by+ay*bx); - p0 = p0+2; - p1 = p1+2; - } - ftbase_ftapplysubplan(plan, subplan, bufa, 0, 0, bufc, 1, _state); - - /* - * Post processing: - * A:=conj(Z)*conj(A)/M - * Here conj(A)/M corresponds to last stage of inverse DFT, - * and conj(Z) comes from Bluestein's FFT algorithm. - */ - p0 = precoffs; - p1 = 0; - p2 = abase+aoffset+op*2*n; - for(i=0; i<=n-1; i++) - { - bx = plan->precr.ptr.p_double[p0+0]; - by = plan->precr.ptr.p_double[p0+1]; - rx = bufa->ptr.p_double[p1+0]/m; - ry = -bufa->ptr.p_double[p1+1]/m; - a->ptr.p_double[p2+0] = rx*bx-ry*(-by); - a->ptr.p_double[p2+1] = rx*(-by)+ry*bx; - p0 = p0+2; - p1 = p1+2; - p2 = p2+2; - } - } -} - - -/************************************************************************* -This subroutine precomputes data for complex Rader's FFT and writes them -to array PrecR[] at specified offset. It is responsibility of the caller -to make sure that PrecR[] is large enough. - -INPUT PARAMETERS: - N - original size of the transform (before reduction to N-1) - RQ - primitive root modulo N - RIQ - inverse of primitive root modulo N - PrecR - preallocated array - Offs - offset - -OUTPUT PARAMETERS: - PrecR - data at Offs:Offs+2*(N-1)-1 store FFT of Rader's factors, - other parts of PrecR are unchanged. - -NOTE: this function performs internal (N-1)-point FFT. It allocates temporary - plan which is destroyed after leaving this function. - - -- ALGLIB -- - Copyright 08.05.2013 by Bochkanov Sergey -*************************************************************************/ -static void ftbase_ftprecomputeradersfft(ae_int_t n, - ae_int_t rq, - ae_int_t riq, - /* Real */ ae_vector* precr, - ae_int_t offs, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t q; - fasttransformplan plan; - ae_int_t kiq; - double v; - - ae_frame_make(_state, &_frame_block); - _fasttransformplan_init(&plan, _state, ae_true); - - - /* - * Fill PrecR with Rader factors, perform FFT - */ - kiq = 1; - for(q=0; q<=n-2; q++) - { - v = -2*ae_pi*kiq/n; - precr->ptr.p_double[offs+2*q+0] = ae_cos(v, _state); - precr->ptr.p_double[offs+2*q+1] = ae_sin(v, _state); - kiq = kiq*riq%n; - } - ftcomplexfftplan(n-1, 1, &plan, _state); - ftbase_ftapplysubplan(&plan, 0, precr, offs, 0, &plan.buffer, 1, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -This subroutine applies complex Rader's FFT to input/output array A. - -INPUT PARAMETERS: - A - array, must be large enough for plan to work - ABase - base offset in array A, this value points to start of - subarray whose length is equal to length of the plan - AOffset - offset with respect to ABase, 0<=AOffset=1, "FTApplyComplexRefFFT: OperandsCnt<1", _state); - - /* - * Process operands - */ - for(opidx=0; opidx<=operandscnt-1; opidx++) - { - - /* - * fill QA - */ - kq = 1; - p0 = abase+aoffset+opidx*n*2; - p1 = aoffset+opidx*n*2; - rx = a->ptr.p_double[p0+0]; - ry = a->ptr.p_double[p0+1]; - x0 = rx; - y0 = ry; - for(q=0; q<=n-2; q++) - { - ax = a->ptr.p_double[p0+2*kq+0]; - ay = a->ptr.p_double[p0+2*kq+1]; - buf->ptr.p_double[p1+0] = ax; - buf->ptr.p_double[p1+1] = ay; - rx = rx+ax; - ry = ry+ay; - kq = kq*rq%n; - p1 = p1+2; - } - p0 = abase+aoffset+opidx*n*2; - p1 = aoffset+opidx*n*2; - for(q=0; q<=n-2; q++) - { - a->ptr.p_double[p0] = buf->ptr.p_double[p1]; - a->ptr.p_double[p0+1] = buf->ptr.p_double[p1+1]; - p0 = p0+2; - p1 = p1+2; - } - - /* - * Convolution - */ - ftbase_ftapplysubplan(plan, subplan, a, abase, aoffset+opidx*n*2, buf, 1, _state); - p0 = abase+aoffset+opidx*n*2; - p1 = precoffs; - for(i=0; i<=n-2; i++) - { - ax = a->ptr.p_double[p0+0]; - ay = a->ptr.p_double[p0+1]; - bx = plan->precr.ptr.p_double[p1+0]; - by = plan->precr.ptr.p_double[p1+1]; - a->ptr.p_double[p0+0] = ax*bx-ay*by; - a->ptr.p_double[p0+1] = -(ax*by+ay*bx); - p0 = p0+2; - p1 = p1+2; - } - ftbase_ftapplysubplan(plan, subplan, a, abase, aoffset+opidx*n*2, buf, 1, _state); - p0 = abase+aoffset+opidx*n*2; - for(i=0; i<=n-2; i++) - { - a->ptr.p_double[p0+0] = a->ptr.p_double[p0+0]/(n-1); - a->ptr.p_double[p0+1] = -a->ptr.p_double[p0+1]/(n-1); - p0 = p0+2; - } - - /* - * Result - */ - buf->ptr.p_double[aoffset+opidx*n*2+0] = rx; - buf->ptr.p_double[aoffset+opidx*n*2+1] = ry; - kiq = 1; - p0 = aoffset+opidx*n*2; - p1 = abase+aoffset+opidx*n*2; - for(q=0; q<=n-2; q++) - { - buf->ptr.p_double[p0+2*kiq+0] = x0+a->ptr.p_double[p1+0]; - buf->ptr.p_double[p0+2*kiq+1] = y0+a->ptr.p_double[p1+1]; - kiq = kiq*riq%n; - p1 = p1+2; - } - p0 = abase+aoffset+opidx*n*2; - p1 = aoffset+opidx*n*2; - for(q=0; q<=n-1; q++) - { - a->ptr.p_double[p0] = buf->ptr.p_double[p1]; - a->ptr.p_double[p0+1] = buf->ptr.p_double[p1+1]; - p0 = p0+2; - p1 = p1+2; - } - } -} - - -/************************************************************************* -Factorizes task size N into product of two smaller sizes N1 and N2 - -INPUT PARAMETERS: - N - task size, N>0 - IsRoot - whether taks is root task (first one in a sequence) - -OUTPUT PARAMETERS: - N1, N2 - such numbers that: - * for prime N: N1=N2=0 - * for composite N<=MaxRadix: N1=N2=0 - * for composite N>MaxRadix: 1<=N1<=N2, N1*N2=N - - -- ALGLIB -- - Copyright 08.04.2013 by Bochkanov Sergey -*************************************************************************/ -static void ftbase_ftfactorize(ae_int_t n, - ae_bool isroot, - ae_int_t* n1, - ae_int_t* n2, - ae_state *_state) -{ - ae_int_t j; - ae_int_t k; - - *n1 = 0; - *n2 = 0; - - ae_assert(n>0, "FTFactorize: N<=0", _state); - *n1 = 0; - *n2 = 0; - - /* - * Small N - */ - if( n<=ftbase_maxradix ) - { - return; - } - - /* - * Large N, recursive split - */ - if( n>ftbase_recursivethreshold ) - { - k = ae_iceil(ae_sqrt(n, _state), _state)+1; - ae_assert(k*k>=n, "FTFactorize: internal error during recursive factorization", _state); - for(j=k; j>=2; j--) - { - if( n%j==0 ) - { - *n1 = ae_minint(n/j, j, _state); - *n2 = ae_maxint(n/j, j, _state); - return; - } - } - } - - /* - * N>MaxRadix, try to find good codelet - */ - for(j=ftbase_maxradix; j>=2; j--) - { - if( n%j==0 ) - { - *n1 = j; - *n2 = n/j; - break; - } - } - - /* - * In case no good codelet was found, - * try to factorize N into product of ANY primes. - */ - if( *n1*(*n2)!=n ) - { - for(j=2; j<=n-1; j++) - { - if( n%j==0 ) - { - *n1 = j; - *n2 = n/j; - break; - } - if( j*j>n ) - { - break; - } - } - } - - /* - * normalize - */ - if( *n1>(*n2) ) - { - j = *n1; - *n1 = *n2; - *n2 = j; - } -} - - -/************************************************************************* -Returns optimistic estimate of the FFT cost, in UNITs (1 UNIT = 100 KFLOPs) - -INPUT PARAMETERS: - N - task size, N>0 - -RESULU: - cost in UNITs, rounded down to nearest integer - -NOTE: If FFT cost is less than 1 UNIT, it will return 0 as result. - - -- ALGLIB -- - Copyright 08.04.2013 by Bochkanov Sergey -*************************************************************************/ -static ae_int_t ftbase_ftoptimisticestimate(ae_int_t n, ae_state *_state) -{ - ae_int_t result; - - - ae_assert(n>0, "FTOptimisticEstimate: N<=0", _state); - result = ae_ifloor(1.0E-5*5*n*ae_log(n, _state)/ae_log(2, _state), _state); - return result; -} - - -/************************************************************************* -Twiddle factors calculation - - -- ALGLIB -- - Copyright 01.05.2009 by Bochkanov Sergey -*************************************************************************/ -static void ftbase_ffttwcalc(/* Real */ ae_vector* a, - ae_int_t aoffset, - ae_int_t n1, - ae_int_t n2, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j2; - ae_int_t n; - ae_int_t halfn1; - ae_int_t offs; - double x; - double y; - double twxm1; - double twy; - double twbasexm1; - double twbasey; - double twrowxm1; - double twrowy; - double tmpx; - double tmpy; - double v; - ae_int_t updatetw2; - - - - /* - * Multiplication by twiddle factors for complex Cooley-Tukey FFT - * with N factorized as N1*N2. - * - * Naive solution to this problem is given below: - * - * > for K:=1 to N2-1 do - * > for J:=1 to N1-1 do - * > begin - * > Idx:=K*N1+J; - * > X:=A[AOffset+2*Idx+0]; - * > Y:=A[AOffset+2*Idx+1]; - * > TwX:=Cos(-2*Pi()*K*J/(N1*N2)); - * > TwY:=Sin(-2*Pi()*K*J/(N1*N2)); - * > A[AOffset+2*Idx+0]:=X*TwX-Y*TwY; - * > A[AOffset+2*Idx+1]:=X*TwY+Y*TwX; - * > end; - * - * However, there are exist more efficient solutions. - * - * Each pass of the inner cycle corresponds to multiplication of one - * entry of A by W[k,j]=exp(-I*2*pi*k*j/N). This factor can be rewritten - * as exp(-I*2*pi*k/N)^j. So we can replace costly exponentiation by - * repeated multiplication: W[k,j+1]=W[k,j]*exp(-I*2*pi*k/N), with - * second factor being computed once in the beginning of the iteration. - * - * Also, exp(-I*2*pi*k/N) can be represented as exp(-I*2*pi/N)^k, i.e. - * we have W[K+1,1]=W[K,1]*W[1,1]. - * - * In our loop we use following variables: - * * [TwBaseXM1,TwBaseY] = [cos(2*pi/N)-1, sin(2*pi/N)] - * * [TwRowXM1, TwRowY] = [cos(2*pi*I/N)-1, sin(2*pi*I/N)] - * * [TwXM1, TwY] = [cos(2*pi*I*J/N)-1, sin(2*pi*I*J/N)] - * - * Meaning of the variables: - * * [TwXM1,TwY] is current twiddle factor W[I,J] - * * [TwRowXM1, TwRowY] is W[I,1] - * * [TwBaseXM1,TwBaseY] is W[1,1] - * - * During inner loop we multiply current twiddle factor by W[I,1], - * during outer loop we update W[I,1]. - * - */ - ae_assert(ftbase_updatetw>=2, "FFTTwCalc: internal error - UpdateTw<2", _state); - updatetw2 = ftbase_updatetw/2; - halfn1 = n1/2; - n = n1*n2; - v = -2*ae_pi/n; - twbasexm1 = -2*ae_sqr(ae_sin(0.5*v, _state), _state); - twbasey = ae_sin(v, _state); - twrowxm1 = 0; - twrowy = 0; - offs = aoffset; - for(i=0; i<=n2-1; i++) - { - - /* - * Initialize twiddle factor for current row - */ - twxm1 = 0; - twy = 0; - - /* - * N1-point block is separated into 2-point chunks and residual 1-point chunk - * (in case N1 is odd). Unrolled loop is several times faster. - */ - for(j2=0; j2<=halfn1-1; j2++) - { - - /* - * Processing: - * * process first element in a chunk. - * * update twiddle factor (unconditional update) - * * process second element - * * conditional update of the twiddle factor - */ - x = a->ptr.p_double[offs+0]; - y = a->ptr.p_double[offs+1]; - tmpx = x*(1+twxm1)-y*twy; - tmpy = x*twy+y*(1+twxm1); - a->ptr.p_double[offs+0] = tmpx; - a->ptr.p_double[offs+1] = tmpy; - tmpx = (1+twxm1)*twrowxm1-twy*twrowy; - twy = twy+(1+twxm1)*twrowy+twy*twrowxm1; - twxm1 = twxm1+tmpx; - x = a->ptr.p_double[offs+2]; - y = a->ptr.p_double[offs+3]; - tmpx = x*(1+twxm1)-y*twy; - tmpy = x*twy+y*(1+twxm1); - a->ptr.p_double[offs+2] = tmpx; - a->ptr.p_double[offs+3] = tmpy; - offs = offs+4; - if( (j2+1)%updatetw2==0&&j2ptr.p_double[offs+0]; - y = a->ptr.p_double[offs+1]; - tmpx = x*(1+twxm1)-y*twy; - tmpy = x*twy+y*(1+twxm1); - a->ptr.p_double[offs+0] = tmpx; - a->ptr.p_double[offs+1] = tmpy; - offs = offs+2; - } - - /* - * update TwRow: TwRow(new) = TwRow(old)*TwBase - */ - if( iptr.p_double[astart], 1, &buf->ptr.p_double[0], 1, ae_v_len(astart,astart+2*m*n-1)); -} - - -/************************************************************************* -Recurrent subroutine for a InternalComplexLinTranspose - -Write A^T to B, where: -* A is m*n complex matrix stored in array A as pairs of real/image values, - beginning from AStart position, with AStride stride -* B is n*m complex matrix stored in array B as pairs of real/image values, - beginning from BStart position, with BStride stride -stride is measured in complex numbers, i.e. in real/image pairs. - - -- ALGLIB -- - Copyright 01.05.2009 by Bochkanov Sergey -*************************************************************************/ -static void ftbase_ffticltrec(/* Real */ ae_vector* a, - ae_int_t astart, - ae_int_t astride, - /* Real */ ae_vector* b, - ae_int_t bstart, - ae_int_t bstride, - ae_int_t m, - ae_int_t n, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t idx1; - ae_int_t idx2; - ae_int_t m2; - ae_int_t m1; - ae_int_t n1; - - - if( m==0||n==0 ) - { - return; - } - if( ae_maxint(m, n, _state)<=8 ) - { - m2 = 2*bstride; - for(i=0; i<=m-1; i++) - { - idx1 = bstart+2*i; - idx2 = astart+2*i*astride; - for(j=0; j<=n-1; j++) - { - b->ptr.p_double[idx1+0] = a->ptr.p_double[idx2+0]; - b->ptr.p_double[idx1+1] = a->ptr.p_double[idx2+1]; - idx1 = idx1+m2; - idx2 = idx2+2; - } - } - return; - } - if( n>m ) - { - - /* - * New partition: - * - * "A^T -> B" becomes "(A1 A2)^T -> ( B1 ) - * ( B2 ) - */ - n1 = n/2; - if( n-n1>=8&&n1%8!=0 ) - { - n1 = n1+(8-n1%8); - } - ae_assert(n-n1>0, "Assertion failed", _state); - ftbase_ffticltrec(a, astart, astride, b, bstart, bstride, m, n1, _state); - ftbase_ffticltrec(a, astart+2*n1, astride, b, bstart+2*n1*bstride, bstride, m, n-n1, _state); - } - else - { - - /* - * New partition: - * - * "A^T -> B" becomes "( A1 )^T -> ( B1 B2 ) - * ( A2 ) - */ - m1 = m/2; - if( m-m1>=8&&m1%8!=0 ) - { - m1 = m1+(8-m1%8); - } - ae_assert(m-m1>0, "Assertion failed", _state); - ftbase_ffticltrec(a, astart, astride, b, bstart, bstride, m1, n, _state); - ftbase_ffticltrec(a, astart+2*m1*astride, astride, b, bstart+2*m1, bstride, m-m1, n, _state); - } -} - - -/************************************************************************* -Recurrent subroutine for a InternalRealLinTranspose - - - -- ALGLIB -- - Copyright 01.05.2009 by Bochkanov Sergey -*************************************************************************/ -static void ftbase_fftirltrec(/* Real */ ae_vector* a, - ae_int_t astart, - ae_int_t astride, - /* Real */ ae_vector* b, - ae_int_t bstart, - ae_int_t bstride, - ae_int_t m, - ae_int_t n, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t idx1; - ae_int_t idx2; - ae_int_t m1; - ae_int_t n1; - - - if( m==0||n==0 ) - { - return; - } - if( ae_maxint(m, n, _state)<=8 ) - { - for(i=0; i<=m-1; i++) - { - idx1 = bstart+i; - idx2 = astart+i*astride; - for(j=0; j<=n-1; j++) - { - b->ptr.p_double[idx1] = a->ptr.p_double[idx2]; - idx1 = idx1+bstride; - idx2 = idx2+1; - } - } - return; - } - if( n>m ) - { - - /* - * New partition: - * - * "A^T -> B" becomes "(A1 A2)^T -> ( B1 ) - * ( B2 ) - */ - n1 = n/2; - if( n-n1>=8&&n1%8!=0 ) - { - n1 = n1+(8-n1%8); - } - ae_assert(n-n1>0, "Assertion failed", _state); - ftbase_fftirltrec(a, astart, astride, b, bstart, bstride, m, n1, _state); - ftbase_fftirltrec(a, astart+n1, astride, b, bstart+n1*bstride, bstride, m, n-n1, _state); - } - else - { - - /* - * New partition: - * - * "A^T -> B" becomes "( A1 )^T -> ( B1 B2 ) - * ( A2 ) - */ - m1 = m/2; - if( m-m1>=8&&m1%8!=0 ) - { - m1 = m1+(8-m1%8); - } - ae_assert(m-m1>0, "Assertion failed", _state); - ftbase_fftirltrec(a, astart, astride, b, bstart, bstride, m1, n, _state); - ftbase_fftirltrec(a, astart+m1*astride, astride, b, bstart+m1, bstride, m-m1, n, _state); - } -} - - -/************************************************************************* -recurrent subroutine for FFTFindSmoothRec - - -- ALGLIB -- - Copyright 01.05.2009 by Bochkanov Sergey -*************************************************************************/ -static void ftbase_ftbasefindsmoothrec(ae_int_t n, - ae_int_t seed, - ae_int_t leastfactor, - ae_int_t* best, - ae_state *_state) -{ - - - ae_assert(ftbase_ftbasemaxsmoothfactor<=5, "FTBaseFindSmoothRec: internal error!", _state); - if( seed>=n ) - { - *best = ae_minint(*best, seed, _state); - return; - } - if( leastfactor<=2 ) - { - ftbase_ftbasefindsmoothrec(n, seed*2, 2, best, _state); - } - if( leastfactor<=3 ) - { - ftbase_ftbasefindsmoothrec(n, seed*3, 3, best, _state); - } - if( leastfactor<=5 ) - { - ftbase_ftbasefindsmoothrec(n, seed*5, 5, best, _state); - } -} - - -ae_bool _fasttransformplan_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - fasttransformplan *p = (fasttransformplan*)_p; - ae_touch_ptr((void*)p); - if( !ae_matrix_init(&p->entries, 0, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->buffer, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->precr, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->preci, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_shared_pool_init(&p->bluesteinpool, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _fasttransformplan_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - fasttransformplan *dst = (fasttransformplan*)_dst; - fasttransformplan *src = (fasttransformplan*)_src; - if( !ae_matrix_init_copy(&dst->entries, &src->entries, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->buffer, &src->buffer, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->precr, &src->precr, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->preci, &src->preci, _state, make_automatic) ) - return ae_false; - if( !ae_shared_pool_init_copy(&dst->bluesteinpool, &src->bluesteinpool, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _fasttransformplan_clear(void* _p) -{ - fasttransformplan *p = (fasttransformplan*)_p; - ae_touch_ptr((void*)p); - ae_matrix_clear(&p->entries); - ae_vector_clear(&p->buffer); - ae_vector_clear(&p->precr); - ae_vector_clear(&p->preci); - ae_shared_pool_clear(&p->bluesteinpool); -} - - -void _fasttransformplan_destroy(void* _p) -{ - fasttransformplan *p = (fasttransformplan*)_p; - ae_touch_ptr((void*)p); - ae_matrix_destroy(&p->entries); - ae_vector_destroy(&p->buffer); - ae_vector_destroy(&p->precr); - ae_vector_destroy(&p->preci); - ae_shared_pool_destroy(&p->bluesteinpool); -} - - - - -double nulog1p(double x, ae_state *_state) -{ - double z; - double lp; - double lq; - double result; - - - z = 1.0+x; - if( ae_fp_less(z,0.70710678118654752440)||ae_fp_greater(z,1.41421356237309504880) ) - { - result = ae_log(z, _state); - return result; - } - z = x*x; - lp = 4.5270000862445199635215E-5; - lp = lp*x+4.9854102823193375972212E-1; - lp = lp*x+6.5787325942061044846969E0; - lp = lp*x+2.9911919328553073277375E1; - lp = lp*x+6.0949667980987787057556E1; - lp = lp*x+5.7112963590585538103336E1; - lp = lp*x+2.0039553499201281259648E1; - lq = 1.0000000000000000000000E0; - lq = lq*x+1.5062909083469192043167E1; - lq = lq*x+8.3047565967967209469434E1; - lq = lq*x+2.2176239823732856465394E2; - lq = lq*x+3.0909872225312059774938E2; - lq = lq*x+2.1642788614495947685003E2; - lq = lq*x+6.0118660497603843919306E1; - z = -0.5*z+x*(z*lp/lq); - result = x+z; - return result; -} - - -double nuexpm1(double x, ae_state *_state) -{ - double r; - double xx; - double ep; - double eq; - double result; - - - if( ae_fp_less(x,-0.5)||ae_fp_greater(x,0.5) ) - { - result = ae_exp(x, _state)-1.0; - return result; - } - xx = x*x; - ep = 1.2617719307481059087798E-4; - ep = ep*xx+3.0299440770744196129956E-2; - ep = ep*xx+9.9999999999999999991025E-1; - eq = 3.0019850513866445504159E-6; - eq = eq*xx+2.5244834034968410419224E-3; - eq = eq*xx+2.2726554820815502876593E-1; - eq = eq*xx+2.0000000000000000000897E0; - r = x*ep; - r = r/(eq-r); - result = r+r; - return result; -} - - -double nucosm1(double x, ae_state *_state) -{ - double xx; - double c; - double result; - - - if( ae_fp_less(x,-0.25*ae_pi)||ae_fp_greater(x,0.25*ae_pi) ) - { - result = ae_cos(x, _state)-1; - return result; - } - xx = x*x; - c = 4.7377507964246204691685E-14; - c = c*xx-1.1470284843425359765671E-11; - c = c*xx+2.0876754287081521758361E-9; - c = c*xx-2.7557319214999787979814E-7; - c = c*xx+2.4801587301570552304991E-5; - c = c*xx-1.3888888888888872993737E-3; - c = c*xx+4.1666666666666666609054E-2; - result = -0.5*xx+xx*xx*c; - return result; -} - - - - - -} - diff --git a/src/core/alglib/alglibinternal.h b/src/core/alglib/alglibinternal.h deleted file mode 100644 index a59bf7e..0000000 --- a/src/core/alglib/alglibinternal.h +++ /dev/null @@ -1,1074 +0,0 @@ -/************************************************************************* -Copyright (c) Sergey Bochkanov (ALGLIB project). - ->>> SOURCE LICENSE >>> -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation (www.fsf.org); either version 2 of the -License, or (at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -A copy of the GNU General Public License is available at -http://www.fsf.org/licensing/licenses ->>> END OF LICENSE >>> -*************************************************************************/ -#ifndef _alglibinternal_pkg_h -#define _alglibinternal_pkg_h -#include "ap.h" - - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (DATATYPES) -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ -typedef struct -{ - ae_vector ia0; - ae_vector ia1; - ae_vector ia2; - ae_vector ia3; - ae_vector ra0; - ae_vector ra1; - ae_vector ra2; - ae_vector ra3; -} apbuffers; -typedef struct -{ - ae_bool val; -} sboolean; -typedef struct -{ - ae_vector val; -} sbooleanarray; -typedef struct -{ - ae_int_t val; -} sinteger; -typedef struct -{ - ae_vector val; -} sintegerarray; -typedef struct -{ - double val; -} sreal; -typedef struct -{ - ae_vector val; -} srealarray; -typedef struct -{ - ae_complex val; -} scomplex; -typedef struct -{ - ae_vector val; -} scomplexarray; -typedef struct -{ - ae_int_t chunksize; - ae_int_t ntotal; - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - ae_vector batch4buf; - ae_vector hpcbuf; - ae_matrix xy; - ae_matrix xy2; - ae_vector xyrow; - ae_vector x; - ae_vector y; - ae_vector desiredy; - double e; - ae_vector g; - ae_vector tmp0; -} mlpbuffers; -typedef struct -{ - ae_bool brackt; - ae_bool stage1; - ae_int_t infoc; - double dg; - double dgm; - double dginit; - double dgtest; - double dgx; - double dgxm; - double dgy; - double dgym; - double finit; - double ftest1; - double fm; - double fx; - double fxm; - double fy; - double fym; - double stx; - double sty; - double stmin; - double stmax; - double width; - double width1; - double xtrapf; -} linminstate; -typedef struct -{ - ae_bool needf; - ae_vector x; - double f; - ae_int_t n; - ae_vector xbase; - ae_vector s; - double stplen; - double fcur; - double stpmax; - ae_int_t fmax; - ae_int_t nfev; - ae_int_t info; - rcommstate rstate; -} armijostate; -typedef struct -{ - ae_matrix entries; - ae_vector buffer; - ae_vector precr; - ae_vector preci; - ae_shared_pool bluesteinpool; -} fasttransformplan; - -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS C++ INTERFACE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib -{ - - -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (FUNCTIONS) -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ -ae_bool seterrorflag(ae_bool* flag, ae_bool cond, ae_state *_state); -ae_bool seterrorflagdiff(ae_bool* flag, - double val, - double refval, - double tol, - double s, - ae_state *_state); -void touchint(ae_int_t* a, ae_state *_state); -void touchreal(double* a, ae_state *_state); -double inttoreal(ae_int_t a, ae_state *_state); -double log2(double x, ae_state *_state); -ae_bool approxequalrel(double a, double b, double tol, ae_state *_state); -void taskgenint1d(double a, - double b, - ae_int_t n, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state); -void taskgenint1dequidist(double a, - double b, - ae_int_t n, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state); -void taskgenint1dcheb1(double a, - double b, - ae_int_t n, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state); -void taskgenint1dcheb2(double a, - double b, - ae_int_t n, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state); -ae_bool aredistinct(/* Real */ ae_vector* x, - ae_int_t n, - ae_state *_state); -ae_bool aresameboolean(ae_bool v1, ae_bool v2, ae_state *_state); -void bvectorsetlengthatleast(/* Boolean */ ae_vector* x, - ae_int_t n, - ae_state *_state); -void ivectorsetlengthatleast(/* Integer */ ae_vector* x, - ae_int_t n, - ae_state *_state); -void rvectorsetlengthatleast(/* Real */ ae_vector* x, - ae_int_t n, - ae_state *_state); -void rmatrixsetlengthatleast(/* Real */ ae_matrix* x, - ae_int_t m, - ae_int_t n, - ae_state *_state); -void rmatrixresize(/* Real */ ae_matrix* x, - ae_int_t m, - ae_int_t n, - ae_state *_state); -void imatrixresize(/* Integer */ ae_matrix* x, - ae_int_t m, - ae_int_t n, - ae_state *_state); -ae_bool isfinitevector(/* Real */ ae_vector* x, - ae_int_t n, - ae_state *_state); -ae_bool isfinitecvector(/* Complex */ ae_vector* z, - ae_int_t n, - ae_state *_state); -ae_bool apservisfinitematrix(/* Real */ ae_matrix* x, - ae_int_t m, - ae_int_t n, - ae_state *_state); -ae_bool apservisfinitecmatrix(/* Complex */ ae_matrix* x, - ae_int_t m, - ae_int_t n, - ae_state *_state); -ae_bool isfinitertrmatrix(/* Real */ ae_matrix* x, - ae_int_t n, - ae_bool isupper, - ae_state *_state); -ae_bool apservisfinitectrmatrix(/* Complex */ ae_matrix* x, - ae_int_t n, - ae_bool isupper, - ae_state *_state); -ae_bool apservisfiniteornanmatrix(/* Real */ ae_matrix* x, - ae_int_t m, - ae_int_t n, - ae_state *_state); -double safepythag2(double x, double y, ae_state *_state); -double safepythag3(double x, double y, double z, ae_state *_state); -ae_int_t saferdiv(double x, double y, double* r, ae_state *_state); -double safeminposrv(double x, double y, double v, ae_state *_state); -void apperiodicmap(double* x, - double a, - double b, - double* k, - ae_state *_state); -double randomnormal(ae_state *_state); -void randomunit(ae_int_t n, /* Real */ ae_vector* x, ae_state *_state); -void inc(ae_int_t* v, ae_state *_state); -void dec(ae_int_t* v, ae_state *_state); -void countdown(ae_int_t* v, ae_state *_state); -double boundval(double x, double b1, double b2, ae_state *_state); -void alloccomplex(ae_serializer* s, ae_complex v, ae_state *_state); -void serializecomplex(ae_serializer* s, ae_complex v, ae_state *_state); -ae_complex unserializecomplex(ae_serializer* s, ae_state *_state); -void allocrealarray(ae_serializer* s, - /* Real */ ae_vector* v, - ae_int_t n, - ae_state *_state); -void serializerealarray(ae_serializer* s, - /* Real */ ae_vector* v, - ae_int_t n, - ae_state *_state); -void unserializerealarray(ae_serializer* s, - /* Real */ ae_vector* v, - ae_state *_state); -void allocintegerarray(ae_serializer* s, - /* Integer */ ae_vector* v, - ae_int_t n, - ae_state *_state); -void serializeintegerarray(ae_serializer* s, - /* Integer */ ae_vector* v, - ae_int_t n, - ae_state *_state); -void unserializeintegerarray(ae_serializer* s, - /* Integer */ ae_vector* v, - ae_state *_state); -void allocrealmatrix(ae_serializer* s, - /* Real */ ae_matrix* v, - ae_int_t n0, - ae_int_t n1, - ae_state *_state); -void serializerealmatrix(ae_serializer* s, - /* Real */ ae_matrix* v, - ae_int_t n0, - ae_int_t n1, - ae_state *_state); -void unserializerealmatrix(ae_serializer* s, - /* Real */ ae_matrix* v, - ae_state *_state); -void copyintegerarray(/* Integer */ ae_vector* src, - /* Integer */ ae_vector* dst, - ae_state *_state); -void copyrealarray(/* Real */ ae_vector* src, - /* Real */ ae_vector* dst, - ae_state *_state); -void copyrealmatrix(/* Real */ ae_matrix* src, - /* Real */ ae_matrix* dst, - ae_state *_state); -ae_int_t recsearch(/* Integer */ ae_vector* a, - ae_int_t nrec, - ae_int_t nheader, - ae_int_t i0, - ae_int_t i1, - /* Integer */ ae_vector* b, - ae_state *_state); -void splitlengtheven(ae_int_t tasksize, - ae_int_t* task0, - ae_int_t* task1, - ae_state *_state); -void splitlength(ae_int_t tasksize, - ae_int_t chunksize, - ae_int_t* task0, - ae_int_t* task1, - ae_state *_state); -ae_bool _apbuffers_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _apbuffers_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _apbuffers_clear(void* _p); -void _apbuffers_destroy(void* _p); -ae_bool _sboolean_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _sboolean_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _sboolean_clear(void* _p); -void _sboolean_destroy(void* _p); -ae_bool _sbooleanarray_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _sbooleanarray_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _sbooleanarray_clear(void* _p); -void _sbooleanarray_destroy(void* _p); -ae_bool _sinteger_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _sinteger_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _sinteger_clear(void* _p); -void _sinteger_destroy(void* _p); -ae_bool _sintegerarray_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _sintegerarray_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _sintegerarray_clear(void* _p); -void _sintegerarray_destroy(void* _p); -ae_bool _sreal_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _sreal_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _sreal_clear(void* _p); -void _sreal_destroy(void* _p); -ae_bool _srealarray_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _srealarray_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _srealarray_clear(void* _p); -void _srealarray_destroy(void* _p); -ae_bool _scomplex_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _scomplex_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _scomplex_clear(void* _p); -void _scomplex_destroy(void* _p); -ae_bool _scomplexarray_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _scomplexarray_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _scomplexarray_clear(void* _p); -void _scomplexarray_destroy(void* _p); -ae_int_t getrdfserializationcode(ae_state *_state); -ae_int_t getkdtreeserializationcode(ae_state *_state); -ae_int_t getmlpserializationcode(ae_state *_state); -ae_int_t getmlpeserializationcode(ae_state *_state); -ae_int_t getrbfserializationcode(ae_state *_state); -void tagsort(/* Real */ ae_vector* a, - ae_int_t n, - /* Integer */ ae_vector* p1, - /* Integer */ ae_vector* p2, - ae_state *_state); -void tagsortbuf(/* Real */ ae_vector* a, - ae_int_t n, - /* Integer */ ae_vector* p1, - /* Integer */ ae_vector* p2, - apbuffers* buf, - ae_state *_state); -void tagsortfasti(/* Real */ ae_vector* a, - /* Integer */ ae_vector* b, - /* Real */ ae_vector* bufa, - /* Integer */ ae_vector* bufb, - ae_int_t n, - ae_state *_state); -void tagsortfastr(/* Real */ ae_vector* a, - /* Real */ ae_vector* b, - /* Real */ ae_vector* bufa, - /* Real */ ae_vector* bufb, - ae_int_t n, - ae_state *_state); -void tagsortfast(/* Real */ ae_vector* a, - /* Real */ ae_vector* bufa, - ae_int_t n, - ae_state *_state); -void tagsortmiddleir(/* Integer */ ae_vector* a, - /* Real */ ae_vector* b, - ae_int_t offset, - ae_int_t n, - ae_state *_state); -void tagheappushi(/* Real */ ae_vector* a, - /* Integer */ ae_vector* b, - ae_int_t* n, - double va, - ae_int_t vb, - ae_state *_state); -void tagheapreplacetopi(/* Real */ ae_vector* a, - /* Integer */ ae_vector* b, - ae_int_t n, - double va, - ae_int_t vb, - ae_state *_state); -void tagheappopi(/* Real */ ae_vector* a, - /* Integer */ ae_vector* b, - ae_int_t* n, - ae_state *_state); -ae_int_t lowerbound(/* Real */ ae_vector* a, - ae_int_t n, - double t, - ae_state *_state); -ae_int_t upperbound(/* Real */ ae_vector* a, - ae_int_t n, - double t, - ae_state *_state); -void rankx(/* Real */ ae_vector* x, - ae_int_t n, - ae_bool iscentered, - apbuffers* buf, - ae_state *_state); -ae_bool cmatrixrank1f(ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - /* Complex */ ae_vector* u, - ae_int_t iu, - /* Complex */ ae_vector* v, - ae_int_t iv, - ae_state *_state); -ae_bool rmatrixrank1f(ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - /* Real */ ae_vector* u, - ae_int_t iu, - /* Real */ ae_vector* v, - ae_int_t iv, - ae_state *_state); -ae_bool cmatrixmvf(ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t opa, - /* Complex */ ae_vector* x, - ae_int_t ix, - /* Complex */ ae_vector* y, - ae_int_t iy, - ae_state *_state); -ae_bool rmatrixmvf(ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t opa, - /* Real */ ae_vector* x, - ae_int_t ix, - /* Real */ ae_vector* y, - ae_int_t iy, - ae_state *_state); -ae_bool cmatrixrighttrsmf(ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Complex */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, - ae_state *_state); -ae_bool cmatrixlefttrsmf(ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Complex */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, - ae_state *_state); -ae_bool rmatrixrighttrsmf(ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Real */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, - ae_state *_state); -ae_bool rmatrixlefttrsmf(ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Real */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, - ae_state *_state); -ae_bool cmatrixsyrkf(ae_int_t n, - ae_int_t k, - double alpha, - /* Complex */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - double beta, - /* Complex */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_bool isupper, - ae_state *_state); -ae_bool rmatrixsyrkf(ae_int_t n, - ae_int_t k, - double alpha, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - double beta, - /* Real */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_bool isupper, - ae_state *_state); -ae_bool rmatrixgemmf(ae_int_t m, - ae_int_t n, - ae_int_t k, - double alpha, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - /* Real */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - ae_int_t optypeb, - double beta, - /* Real */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_state *_state); -ae_bool cmatrixgemmf(ae_int_t m, - ae_int_t n, - ae_int_t k, - ae_complex alpha, - /* Complex */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - /* Complex */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - ae_int_t optypeb, - ae_complex beta, - /* Complex */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_state *_state); -void cmatrixgemmk(ae_int_t m, - ae_int_t n, - ae_int_t k, - ae_complex alpha, - /* Complex */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - /* Complex */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - ae_int_t optypeb, - ae_complex beta, - /* Complex */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_state *_state); -void rmatrixgemmk(ae_int_t m, - ae_int_t n, - ae_int_t k, - double alpha, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - /* Real */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - ae_int_t optypeb, - double beta, - /* Real */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_state *_state); -void rmatrixgemmk44v00(ae_int_t m, - ae_int_t n, - ae_int_t k, - double alpha, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - /* Real */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - double beta, - /* Real */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_state *_state); -void rmatrixgemmk44v01(ae_int_t m, - ae_int_t n, - ae_int_t k, - double alpha, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - /* Real */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - double beta, - /* Real */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_state *_state); -void rmatrixgemmk44v10(ae_int_t m, - ae_int_t n, - ae_int_t k, - double alpha, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - /* Real */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - double beta, - /* Real */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_state *_state); -void rmatrixgemmk44v11(ae_int_t m, - ae_int_t n, - ae_int_t k, - double alpha, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - /* Real */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - double beta, - /* Real */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_state *_state); -ae_bool rmatrixsyrkmkl(ae_int_t n, - ae_int_t k, - double alpha, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - double beta, - /* Real */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_bool isupper, - ae_state *_state); -ae_bool rmatrixgemmmkl(ae_int_t m, - ae_int_t n, - ae_int_t k, - double alpha, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - /* Real */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - ae_int_t optypeb, - double beta, - /* Real */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_state *_state); -double vectornorm2(/* Real */ ae_vector* x, - ae_int_t i1, - ae_int_t i2, - ae_state *_state); -ae_int_t vectoridxabsmax(/* Real */ ae_vector* x, - ae_int_t i1, - ae_int_t i2, - ae_state *_state); -ae_int_t columnidxabsmax(/* Real */ ae_matrix* x, - ae_int_t i1, - ae_int_t i2, - ae_int_t j, - ae_state *_state); -ae_int_t rowidxabsmax(/* Real */ ae_matrix* x, - ae_int_t j1, - ae_int_t j2, - ae_int_t i, - ae_state *_state); -double upperhessenberg1norm(/* Real */ ae_matrix* a, - ae_int_t i1, - ae_int_t i2, - ae_int_t j1, - ae_int_t j2, - /* Real */ ae_vector* work, - ae_state *_state); -void copymatrix(/* Real */ ae_matrix* a, - ae_int_t is1, - ae_int_t is2, - ae_int_t js1, - ae_int_t js2, - /* Real */ ae_matrix* b, - ae_int_t id1, - ae_int_t id2, - ae_int_t jd1, - ae_int_t jd2, - ae_state *_state); -void inplacetranspose(/* Real */ ae_matrix* a, - ae_int_t i1, - ae_int_t i2, - ae_int_t j1, - ae_int_t j2, - /* Real */ ae_vector* work, - ae_state *_state); -void copyandtranspose(/* Real */ ae_matrix* a, - ae_int_t is1, - ae_int_t is2, - ae_int_t js1, - ae_int_t js2, - /* Real */ ae_matrix* b, - ae_int_t id1, - ae_int_t id2, - ae_int_t jd1, - ae_int_t jd2, - ae_state *_state); -void matrixvectormultiply(/* Real */ ae_matrix* a, - ae_int_t i1, - ae_int_t i2, - ae_int_t j1, - ae_int_t j2, - ae_bool trans, - /* Real */ ae_vector* x, - ae_int_t ix1, - ae_int_t ix2, - double alpha, - /* Real */ ae_vector* y, - ae_int_t iy1, - ae_int_t iy2, - double beta, - ae_state *_state); -double pythag2(double x, double y, ae_state *_state); -void matrixmatrixmultiply(/* Real */ ae_matrix* a, - ae_int_t ai1, - ae_int_t ai2, - ae_int_t aj1, - ae_int_t aj2, - ae_bool transa, - /* Real */ ae_matrix* b, - ae_int_t bi1, - ae_int_t bi2, - ae_int_t bj1, - ae_int_t bj2, - ae_bool transb, - double alpha, - /* Real */ ae_matrix* c, - ae_int_t ci1, - ae_int_t ci2, - ae_int_t cj1, - ae_int_t cj2, - double beta, - /* Real */ ae_vector* work, - ae_state *_state); -void hermitianmatrixvectormultiply(/* Complex */ ae_matrix* a, - ae_bool isupper, - ae_int_t i1, - ae_int_t i2, - /* Complex */ ae_vector* x, - ae_complex alpha, - /* Complex */ ae_vector* y, - ae_state *_state); -void hermitianrank2update(/* Complex */ ae_matrix* a, - ae_bool isupper, - ae_int_t i1, - ae_int_t i2, - /* Complex */ ae_vector* x, - /* Complex */ ae_vector* y, - /* Complex */ ae_vector* t, - ae_complex alpha, - ae_state *_state); -void generatereflection(/* Real */ ae_vector* x, - ae_int_t n, - double* tau, - ae_state *_state); -void applyreflectionfromtheleft(/* Real */ ae_matrix* c, - double tau, - /* Real */ ae_vector* v, - ae_int_t m1, - ae_int_t m2, - ae_int_t n1, - ae_int_t n2, - /* Real */ ae_vector* work, - ae_state *_state); -void applyreflectionfromtheright(/* Real */ ae_matrix* c, - double tau, - /* Real */ ae_vector* v, - ae_int_t m1, - ae_int_t m2, - ae_int_t n1, - ae_int_t n2, - /* Real */ ae_vector* work, - ae_state *_state); -void complexgeneratereflection(/* Complex */ ae_vector* x, - ae_int_t n, - ae_complex* tau, - ae_state *_state); -void complexapplyreflectionfromtheleft(/* Complex */ ae_matrix* c, - ae_complex tau, - /* Complex */ ae_vector* v, - ae_int_t m1, - ae_int_t m2, - ae_int_t n1, - ae_int_t n2, - /* Complex */ ae_vector* work, - ae_state *_state); -void complexapplyreflectionfromtheright(/* Complex */ ae_matrix* c, - ae_complex tau, - /* Complex */ ae_vector* v, - ae_int_t m1, - ae_int_t m2, - ae_int_t n1, - ae_int_t n2, - /* Complex */ ae_vector* work, - ae_state *_state); -void symmetricmatrixvectormultiply(/* Real */ ae_matrix* a, - ae_bool isupper, - ae_int_t i1, - ae_int_t i2, - /* Real */ ae_vector* x, - double alpha, - /* Real */ ae_vector* y, - ae_state *_state); -void symmetricrank2update(/* Real */ ae_matrix* a, - ae_bool isupper, - ae_int_t i1, - ae_int_t i2, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* t, - double alpha, - ae_state *_state); -void applyrotationsfromtheleft(ae_bool isforward, - ae_int_t m1, - ae_int_t m2, - ae_int_t n1, - ae_int_t n2, - /* Real */ ae_vector* c, - /* Real */ ae_vector* s, - /* Real */ ae_matrix* a, - /* Real */ ae_vector* work, - ae_state *_state); -void applyrotationsfromtheright(ae_bool isforward, - ae_int_t m1, - ae_int_t m2, - ae_int_t n1, - ae_int_t n2, - /* Real */ ae_vector* c, - /* Real */ ae_vector* s, - /* Real */ ae_matrix* a, - /* Real */ ae_vector* work, - ae_state *_state); -void generaterotation(double f, - double g, - double* cs, - double* sn, - double* r, - ae_state *_state); -ae_bool upperhessenbergschurdecomposition(/* Real */ ae_matrix* h, - ae_int_t n, - /* Real */ ae_matrix* s, - ae_state *_state); -void internalschurdecomposition(/* Real */ ae_matrix* h, - ae_int_t n, - ae_int_t tneeded, - ae_int_t zneeded, - /* Real */ ae_vector* wr, - /* Real */ ae_vector* wi, - /* Real */ ae_matrix* z, - ae_int_t* info, - ae_state *_state); -void rmatrixtrsafesolve(/* Real */ ae_matrix* a, - ae_int_t n, - /* Real */ ae_vector* x, - double* s, - ae_bool isupper, - ae_bool istrans, - ae_bool isunit, - ae_state *_state); -void safesolvetriangular(/* Real */ ae_matrix* a, - ae_int_t n, - /* Real */ ae_vector* x, - double* s, - ae_bool isupper, - ae_bool istrans, - ae_bool isunit, - ae_bool normin, - /* Real */ ae_vector* cnorm, - ae_state *_state); -ae_bool rmatrixscaledtrsafesolve(/* Real */ ae_matrix* a, - double sa, - ae_int_t n, - /* Real */ ae_vector* x, - ae_bool isupper, - ae_int_t trans, - ae_bool isunit, - double maxgrowth, - ae_state *_state); -ae_bool cmatrixscaledtrsafesolve(/* Complex */ ae_matrix* a, - double sa, - ae_int_t n, - /* Complex */ ae_vector* x, - ae_bool isupper, - ae_int_t trans, - ae_bool isunit, - double maxgrowth, - ae_state *_state); -void hpcpreparechunkedgradient(/* Real */ ae_vector* weights, - ae_int_t wcount, - ae_int_t ntotal, - ae_int_t nin, - ae_int_t nout, - mlpbuffers* buf, - ae_state *_state); -void hpcfinalizechunkedgradient(mlpbuffers* buf, - /* Real */ ae_vector* grad, - ae_state *_state); -ae_bool hpcchunkedgradient(/* Real */ ae_vector* weights, - /* Integer */ ae_vector* structinfo, - /* Real */ ae_vector* columnmeans, - /* Real */ ae_vector* columnsigmas, - /* Real */ ae_matrix* xy, - ae_int_t cstart, - ae_int_t csize, - /* Real */ ae_vector* batch4buf, - /* Real */ ae_vector* hpcbuf, - double* e, - ae_bool naturalerrorfunc, - ae_state *_state); -ae_bool hpcchunkedprocess(/* Real */ ae_vector* weights, - /* Integer */ ae_vector* structinfo, - /* Real */ ae_vector* columnmeans, - /* Real */ ae_vector* columnsigmas, - /* Real */ ae_matrix* xy, - ae_int_t cstart, - ae_int_t csize, - /* Real */ ae_vector* batch4buf, - /* Real */ ae_vector* hpcbuf, - ae_state *_state); -ae_bool _mlpbuffers_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _mlpbuffers_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _mlpbuffers_clear(void* _p); -void _mlpbuffers_destroy(void* _p); -void xdot(/* Real */ ae_vector* a, - /* Real */ ae_vector* b, - ae_int_t n, - /* Real */ ae_vector* temp, - double* r, - double* rerr, - ae_state *_state); -void xcdot(/* Complex */ ae_vector* a, - /* Complex */ ae_vector* b, - ae_int_t n, - /* Real */ ae_vector* temp, - ae_complex* r, - double* rerr, - ae_state *_state); -void linminnormalized(/* Real */ ae_vector* d, - double* stp, - ae_int_t n, - ae_state *_state); -void mcsrch(ae_int_t n, - /* Real */ ae_vector* x, - double* f, - /* Real */ ae_vector* g, - /* Real */ ae_vector* s, - double* stp, - double stpmax, - double gtol, - ae_int_t* info, - ae_int_t* nfev, - /* Real */ ae_vector* wa, - linminstate* state, - ae_int_t* stage, - ae_state *_state); -void armijocreate(ae_int_t n, - /* Real */ ae_vector* x, - double f, - /* Real */ ae_vector* s, - double stp, - double stpmax, - ae_int_t fmax, - armijostate* state, - ae_state *_state); -ae_bool armijoiteration(armijostate* state, ae_state *_state); -void armijoresults(armijostate* state, - ae_int_t* info, - double* stp, - double* f, - ae_state *_state); -ae_bool _linminstate_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _linminstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _linminstate_clear(void* _p); -void _linminstate_destroy(void* _p); -ae_bool _armijostate_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _armijostate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _armijostate_clear(void* _p); -void _armijostate_destroy(void* _p); -void findprimitiverootandinverse(ae_int_t n, - ae_int_t* proot, - ae_int_t* invproot, - ae_state *_state); -void ftcomplexfftplan(ae_int_t n, - ae_int_t k, - fasttransformplan* plan, - ae_state *_state); -void ftapplyplan(fasttransformplan* plan, - /* Real */ ae_vector* a, - ae_int_t offsa, - ae_int_t repcnt, - ae_state *_state); -void ftbasefactorize(ae_int_t n, - ae_int_t tasktype, - ae_int_t* n1, - ae_int_t* n2, - ae_state *_state); -ae_bool ftbaseissmooth(ae_int_t n, ae_state *_state); -ae_int_t ftbasefindsmooth(ae_int_t n, ae_state *_state); -ae_int_t ftbasefindsmootheven(ae_int_t n, ae_state *_state); -double ftbasegetflopestimate(ae_int_t n, ae_state *_state); -ae_bool _fasttransformplan_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _fasttransformplan_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _fasttransformplan_clear(void* _p); -void _fasttransformplan_destroy(void* _p); -double nulog1p(double x, ae_state *_state); -double nuexpm1(double x, ae_state *_state); -double nucosm1(double x, ae_state *_state); - -} -#endif - diff --git a/src/core/alglib/alglibmisc.cpp b/src/core/alglib/alglibmisc.cpp deleted file mode 100644 index cc4e095..0000000 --- a/src/core/alglib/alglibmisc.cpp +++ /dev/null @@ -1,3611 +0,0 @@ -/************************************************************************* -Copyright (c) Sergey Bochkanov (ALGLIB project). - ->>> SOURCE LICENSE >>> -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation (www.fsf.org); either version 2 of the -License, or (at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -A copy of the GNU General Public License is available at -http://www.fsf.org/licensing/licenses ->>> END OF LICENSE >>> -*************************************************************************/ -#include "stdafx.h" -#include "alglibmisc.h" - -// disable some irrelevant warnings -#if (AE_COMPILER==AE_MSVC) -#pragma warning(disable:4100) -#pragma warning(disable:4127) -#pragma warning(disable:4702) -#pragma warning(disable:4996) -#endif -using namespace std; - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS IMPLEMENTATION OF C++ INTERFACE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib -{ - - -/************************************************************************* -Portable high quality random number generator state. -Initialized with HQRNDRandomize() or HQRNDSeed(). - -Fields: - S1, S2 - seed values - V - precomputed value - MagicV - 'magic' value used to determine whether State structure - was correctly initialized. -*************************************************************************/ -_hqrndstate_owner::_hqrndstate_owner() -{ - p_struct = (alglib_impl::hqrndstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::hqrndstate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_hqrndstate_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_hqrndstate_owner::_hqrndstate_owner(const _hqrndstate_owner &rhs) -{ - p_struct = (alglib_impl::hqrndstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::hqrndstate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_hqrndstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_hqrndstate_owner& _hqrndstate_owner::operator=(const _hqrndstate_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_hqrndstate_clear(p_struct); - if( !alglib_impl::_hqrndstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_hqrndstate_owner::~_hqrndstate_owner() -{ - alglib_impl::_hqrndstate_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::hqrndstate* _hqrndstate_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::hqrndstate* _hqrndstate_owner::c_ptr() const -{ - return const_cast(p_struct); -} -hqrndstate::hqrndstate() : _hqrndstate_owner() -{ -} - -hqrndstate::hqrndstate(const hqrndstate &rhs):_hqrndstate_owner(rhs) -{ -} - -hqrndstate& hqrndstate::operator=(const hqrndstate &rhs) -{ - if( this==&rhs ) - return *this; - _hqrndstate_owner::operator=(rhs); - return *this; -} - -hqrndstate::~hqrndstate() -{ -} - -/************************************************************************* -HQRNDState initialization with random values which come from standard -RNG. - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -void hqrndrandomize(hqrndstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::hqrndrandomize(const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -HQRNDState initialization with seed values - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -void hqrndseed(const ae_int_t s1, const ae_int_t s2, hqrndstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::hqrndseed(s1, s2, const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function generates random real number in (0,1), -not including interval boundaries - -State structure must be initialized with HQRNDRandomize() or HQRNDSeed(). - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -double hqrnduniformr(const hqrndstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::hqrnduniformr(const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function generates random integer number in [0, N) - -1. State structure must be initialized with HQRNDRandomize() or HQRNDSeed() -2. N can be any positive number except for very large numbers: - * close to 2^31 on 32-bit systems - * close to 2^62 on 64-bit systems - An exception will be generated if N is too large. - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -ae_int_t hqrnduniformi(const hqrndstate &state, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::ae_int_t result = alglib_impl::hqrnduniformi(const_cast(state.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Random number generator: normal numbers - -This function generates one random number from normal distribution. -Its performance is equal to that of HQRNDNormal2() - -State structure must be initialized with HQRNDRandomize() or HQRNDSeed(). - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -double hqrndnormal(const hqrndstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::hqrndnormal(const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Random number generator: random X and Y such that X^2+Y^2=1 - -State structure must be initialized with HQRNDRandomize() or HQRNDSeed(). - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -void hqrndunit2(const hqrndstate &state, double &x, double &y) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::hqrndunit2(const_cast(state.c_ptr()), &x, &y, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Random number generator: normal numbers - -This function generates two independent random numbers from normal -distribution. Its performance is equal to that of HQRNDNormal() - -State structure must be initialized with HQRNDRandomize() or HQRNDSeed(). - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -void hqrndnormal2(const hqrndstate &state, double &x1, double &x2) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::hqrndnormal2(const_cast(state.c_ptr()), &x1, &x2, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Random number generator: exponential distribution - -State structure must be initialized with HQRNDRandomize() or HQRNDSeed(). - - -- ALGLIB -- - Copyright 11.08.2007 by Bochkanov Sergey -*************************************************************************/ -double hqrndexponential(const hqrndstate &state, const double lambdav) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::hqrndexponential(const_cast(state.c_ptr()), lambdav, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function generates random number from discrete distribution given by -finite sample X. - -INPUT PARAMETERS - State - high quality random number generator, must be - initialized with HQRNDRandomize() or HQRNDSeed(). - X - finite sample - N - number of elements to use, N>=1 - -RESULT - this function returns one of the X[i] for random i=0..N-1 - - -- ALGLIB -- - Copyright 08.11.2011 by Bochkanov Sergey -*************************************************************************/ -double hqrnddiscrete(const hqrndstate &state, const real_1d_array &x, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::hqrnddiscrete(const_cast(state.c_ptr()), const_cast(x.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function generates random number from continuous distribution given -by finite sample X. - -INPUT PARAMETERS - State - high quality random number generator, must be - initialized with HQRNDRandomize() or HQRNDSeed(). - X - finite sample, array[N] (can be larger, in this case only - leading N elements are used). THIS ARRAY MUST BE SORTED BY - ASCENDING. - N - number of elements to use, N>=1 - -RESULT - this function returns random number from continuous distribution which - tries to approximate X as mush as possible. min(X)<=Result<=max(X). - - -- ALGLIB -- - Copyright 08.11.2011 by Bochkanov Sergey -*************************************************************************/ -double hqrndcontinuous(const hqrndstate &state, const real_1d_array &x, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::hqrndcontinuous(const_cast(state.c_ptr()), const_cast(x.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* - -*************************************************************************/ -_kdtree_owner::_kdtree_owner() -{ - p_struct = (alglib_impl::kdtree*)alglib_impl::ae_malloc(sizeof(alglib_impl::kdtree), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_kdtree_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_kdtree_owner::_kdtree_owner(const _kdtree_owner &rhs) -{ - p_struct = (alglib_impl::kdtree*)alglib_impl::ae_malloc(sizeof(alglib_impl::kdtree), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_kdtree_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_kdtree_owner& _kdtree_owner::operator=(const _kdtree_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_kdtree_clear(p_struct); - if( !alglib_impl::_kdtree_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_kdtree_owner::~_kdtree_owner() -{ - alglib_impl::_kdtree_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::kdtree* _kdtree_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::kdtree* _kdtree_owner::c_ptr() const -{ - return const_cast(p_struct); -} -kdtree::kdtree() : _kdtree_owner() -{ -} - -kdtree::kdtree(const kdtree &rhs):_kdtree_owner(rhs) -{ -} - -kdtree& kdtree::operator=(const kdtree &rhs) -{ - if( this==&rhs ) - return *this; - _kdtree_owner::operator=(rhs); - return *this; -} - -kdtree::~kdtree() -{ -} - - -/************************************************************************* -This function serializes data structure to string. - -Important properties of s_out: -* it contains alphanumeric characters, dots, underscores, minus signs -* these symbols are grouped into words, which are separated by spaces - and Windows-style (CR+LF) newlines -* although serializer uses spaces and CR+LF as separators, you can - replace any separator character by arbitrary combination of spaces, - tabs, Windows or Unix newlines. It allows flexible reformatting of - the string in case you want to include it into text or XML file. - But you should not insert separators into the middle of the "words" - nor you should change case of letters. -* s_out can be freely moved between 32-bit and 64-bit systems, little - and big endian machines, and so on. You can serialize structure on - 32-bit machine and unserialize it on 64-bit one (or vice versa), or - serialize it on SPARC and unserialize on x86. You can also - serialize it in C++ version of ALGLIB and unserialize in C# one, - and vice versa. -*************************************************************************/ -void kdtreeserialize(kdtree &obj, std::string &s_out) -{ - alglib_impl::ae_state state; - alglib_impl::ae_serializer serializer; - alglib_impl::ae_int_t ssize; - - alglib_impl::ae_state_init(&state); - try - { - alglib_impl::ae_serializer_init(&serializer); - alglib_impl::ae_serializer_alloc_start(&serializer); - alglib_impl::kdtreealloc(&serializer, obj.c_ptr(), &state); - ssize = alglib_impl::ae_serializer_get_alloc_size(&serializer); - s_out.clear(); - s_out.reserve((size_t)(ssize+1)); - alglib_impl::ae_serializer_sstart_str(&serializer, &s_out); - alglib_impl::kdtreeserialize(&serializer, obj.c_ptr(), &state); - alglib_impl::ae_serializer_stop(&serializer); - if( s_out.length()>(size_t)ssize ) - throw ap_error("ALGLIB: serialization integrity error"); - alglib_impl::ae_serializer_clear(&serializer); - alglib_impl::ae_state_clear(&state); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(state.error_msg); - } -} -/************************************************************************* -This function unserializes data structure from string. -*************************************************************************/ -void kdtreeunserialize(std::string &s_in, kdtree &obj) -{ - alglib_impl::ae_state state; - alglib_impl::ae_serializer serializer; - - alglib_impl::ae_state_init(&state); - try - { - alglib_impl::ae_serializer_init(&serializer); - alglib_impl::ae_serializer_ustart_str(&serializer, &s_in); - alglib_impl::kdtreeunserialize(&serializer, obj.c_ptr(), &state); - alglib_impl::ae_serializer_stop(&serializer); - alglib_impl::ae_serializer_clear(&serializer); - alglib_impl::ae_state_clear(&state); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(state.error_msg); - } -} - -/************************************************************************* -KD-tree creation - -This subroutine creates KD-tree from set of X-values and optional Y-values - -INPUT PARAMETERS - XY - dataset, array[0..N-1,0..NX+NY-1]. - one row corresponds to one point. - first NX columns contain X-values, next NY (NY may be zero) - columns may contain associated Y-values - N - number of points, N>=0. - NX - space dimension, NX>=1. - NY - number of optional Y-values, NY>=0. - NormType- norm type: - * 0 denotes infinity-norm - * 1 denotes 1-norm - * 2 denotes 2-norm (Euclidean norm) - -OUTPUT PARAMETERS - KDT - KD-tree - - -NOTES - -1. KD-tree creation have O(N*logN) complexity and O(N*(2*NX+NY)) memory - requirements. -2. Although KD-trees may be used with any combination of N and NX, they - are more efficient than brute-force search only when N >> 4^NX. So they - are most useful in low-dimensional tasks (NX=2, NX=3). NX=1 is another - inefficient case, because simple binary search (without additional - structures) is much more efficient in such tasks than KD-trees. - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreebuild(const real_2d_array &xy, const ae_int_t n, const ae_int_t nx, const ae_int_t ny, const ae_int_t normtype, kdtree &kdt) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::kdtreebuild(const_cast(xy.c_ptr()), n, nx, ny, normtype, const_cast(kdt.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -KD-tree creation - -This subroutine creates KD-tree from set of X-values and optional Y-values - -INPUT PARAMETERS - XY - dataset, array[0..N-1,0..NX+NY-1]. - one row corresponds to one point. - first NX columns contain X-values, next NY (NY may be zero) - columns may contain associated Y-values - N - number of points, N>=0. - NX - space dimension, NX>=1. - NY - number of optional Y-values, NY>=0. - NormType- norm type: - * 0 denotes infinity-norm - * 1 denotes 1-norm - * 2 denotes 2-norm (Euclidean norm) - -OUTPUT PARAMETERS - KDT - KD-tree - - -NOTES - -1. KD-tree creation have O(N*logN) complexity and O(N*(2*NX+NY)) memory - requirements. -2. Although KD-trees may be used with any combination of N and NX, they - are more efficient than brute-force search only when N >> 4^NX. So they - are most useful in low-dimensional tasks (NX=2, NX=3). NX=1 is another - inefficient case, because simple binary search (without additional - structures) is much more efficient in such tasks than KD-trees. - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreebuild(const real_2d_array &xy, const ae_int_t nx, const ae_int_t ny, const ae_int_t normtype, kdtree &kdt) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = xy.rows(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::kdtreebuild(const_cast(xy.c_ptr()), n, nx, ny, normtype, const_cast(kdt.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -KD-tree creation - -This subroutine creates KD-tree from set of X-values, integer tags and -optional Y-values - -INPUT PARAMETERS - XY - dataset, array[0..N-1,0..NX+NY-1]. - one row corresponds to one point. - first NX columns contain X-values, next NY (NY may be zero) - columns may contain associated Y-values - Tags - tags, array[0..N-1], contains integer tags associated - with points. - N - number of points, N>=0 - NX - space dimension, NX>=1. - NY - number of optional Y-values, NY>=0. - NormType- norm type: - * 0 denotes infinity-norm - * 1 denotes 1-norm - * 2 denotes 2-norm (Euclidean norm) - -OUTPUT PARAMETERS - KDT - KD-tree - -NOTES - -1. KD-tree creation have O(N*logN) complexity and O(N*(2*NX+NY)) memory - requirements. -2. Although KD-trees may be used with any combination of N and NX, they - are more efficient than brute-force search only when N >> 4^NX. So they - are most useful in low-dimensional tasks (NX=2, NX=3). NX=1 is another - inefficient case, because simple binary search (without additional - structures) is much more efficient in such tasks than KD-trees. - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreebuildtagged(const real_2d_array &xy, const integer_1d_array &tags, const ae_int_t n, const ae_int_t nx, const ae_int_t ny, const ae_int_t normtype, kdtree &kdt) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::kdtreebuildtagged(const_cast(xy.c_ptr()), const_cast(tags.c_ptr()), n, nx, ny, normtype, const_cast(kdt.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -KD-tree creation - -This subroutine creates KD-tree from set of X-values, integer tags and -optional Y-values - -INPUT PARAMETERS - XY - dataset, array[0..N-1,0..NX+NY-1]. - one row corresponds to one point. - first NX columns contain X-values, next NY (NY may be zero) - columns may contain associated Y-values - Tags - tags, array[0..N-1], contains integer tags associated - with points. - N - number of points, N>=0 - NX - space dimension, NX>=1. - NY - number of optional Y-values, NY>=0. - NormType- norm type: - * 0 denotes infinity-norm - * 1 denotes 1-norm - * 2 denotes 2-norm (Euclidean norm) - -OUTPUT PARAMETERS - KDT - KD-tree - -NOTES - -1. KD-tree creation have O(N*logN) complexity and O(N*(2*NX+NY)) memory - requirements. -2. Although KD-trees may be used with any combination of N and NX, they - are more efficient than brute-force search only when N >> 4^NX. So they - are most useful in low-dimensional tasks (NX=2, NX=3). NX=1 is another - inefficient case, because simple binary search (without additional - structures) is much more efficient in such tasks than KD-trees. - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreebuildtagged(const real_2d_array &xy, const integer_1d_array &tags, const ae_int_t nx, const ae_int_t ny, const ae_int_t normtype, kdtree &kdt) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - if( (xy.rows()!=tags.length())) - throw ap_error("Error while calling 'kdtreebuildtagged': looks like one of arguments has wrong size"); - n = xy.rows(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::kdtreebuildtagged(const_cast(xy.c_ptr()), const_cast(tags.c_ptr()), n, nx, ny, normtype, const_cast(kdt.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -K-NN query: K nearest neighbors - -INPUT PARAMETERS - KDT - KD-tree - X - point, array[0..NX-1]. - K - number of neighbors to return, K>=1 - SelfMatch - whether self-matches are allowed: - * if True, nearest neighbor may be the point itself - (if it exists in original dataset) - * if False, then only points with non-zero distance - are returned - * if not given, considered True - -RESULT - number of actual neighbors found (either K or N, if K>N). - -This subroutine performs query and stores its result in the internal -structures of the KD-tree. You can use following subroutines to obtain -these results: -* KDTreeQueryResultsX() to get X-values -* KDTreeQueryResultsXY() to get X- and Y-values -* KDTreeQueryResultsTags() to get tag values -* KDTreeQueryResultsDistances() to get distances - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -ae_int_t kdtreequeryknn(const kdtree &kdt, const real_1d_array &x, const ae_int_t k, const bool selfmatch) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::ae_int_t result = alglib_impl::kdtreequeryknn(const_cast(kdt.c_ptr()), const_cast(x.c_ptr()), k, selfmatch, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -K-NN query: K nearest neighbors - -INPUT PARAMETERS - KDT - KD-tree - X - point, array[0..NX-1]. - K - number of neighbors to return, K>=1 - SelfMatch - whether self-matches are allowed: - * if True, nearest neighbor may be the point itself - (if it exists in original dataset) - * if False, then only points with non-zero distance - are returned - * if not given, considered True - -RESULT - number of actual neighbors found (either K or N, if K>N). - -This subroutine performs query and stores its result in the internal -structures of the KD-tree. You can use following subroutines to obtain -these results: -* KDTreeQueryResultsX() to get X-values -* KDTreeQueryResultsXY() to get X- and Y-values -* KDTreeQueryResultsTags() to get tag values -* KDTreeQueryResultsDistances() to get distances - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -ae_int_t kdtreequeryknn(const kdtree &kdt, const real_1d_array &x, const ae_int_t k) -{ - alglib_impl::ae_state _alglib_env_state; - bool selfmatch; - - selfmatch = true; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::ae_int_t result = alglib_impl::kdtreequeryknn(const_cast(kdt.c_ptr()), const_cast(x.c_ptr()), k, selfmatch, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -R-NN query: all points within R-sphere centered at X - -INPUT PARAMETERS - KDT - KD-tree - X - point, array[0..NX-1]. - R - radius of sphere (in corresponding norm), R>0 - SelfMatch - whether self-matches are allowed: - * if True, nearest neighbor may be the point itself - (if it exists in original dataset) - * if False, then only points with non-zero distance - are returned - * if not given, considered True - -RESULT - number of neighbors found, >=0 - -This subroutine performs query and stores its result in the internal -structures of the KD-tree. You can use following subroutines to obtain -actual results: -* KDTreeQueryResultsX() to get X-values -* KDTreeQueryResultsXY() to get X- and Y-values -* KDTreeQueryResultsTags() to get tag values -* KDTreeQueryResultsDistances() to get distances - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -ae_int_t kdtreequeryrnn(const kdtree &kdt, const real_1d_array &x, const double r, const bool selfmatch) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::ae_int_t result = alglib_impl::kdtreequeryrnn(const_cast(kdt.c_ptr()), const_cast(x.c_ptr()), r, selfmatch, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -R-NN query: all points within R-sphere centered at X - -INPUT PARAMETERS - KDT - KD-tree - X - point, array[0..NX-1]. - R - radius of sphere (in corresponding norm), R>0 - SelfMatch - whether self-matches are allowed: - * if True, nearest neighbor may be the point itself - (if it exists in original dataset) - * if False, then only points with non-zero distance - are returned - * if not given, considered True - -RESULT - number of neighbors found, >=0 - -This subroutine performs query and stores its result in the internal -structures of the KD-tree. You can use following subroutines to obtain -actual results: -* KDTreeQueryResultsX() to get X-values -* KDTreeQueryResultsXY() to get X- and Y-values -* KDTreeQueryResultsTags() to get tag values -* KDTreeQueryResultsDistances() to get distances - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -ae_int_t kdtreequeryrnn(const kdtree &kdt, const real_1d_array &x, const double r) -{ - alglib_impl::ae_state _alglib_env_state; - bool selfmatch; - - selfmatch = true; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::ae_int_t result = alglib_impl::kdtreequeryrnn(const_cast(kdt.c_ptr()), const_cast(x.c_ptr()), r, selfmatch, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -K-NN query: approximate K nearest neighbors - -INPUT PARAMETERS - KDT - KD-tree - X - point, array[0..NX-1]. - K - number of neighbors to return, K>=1 - SelfMatch - whether self-matches are allowed: - * if True, nearest neighbor may be the point itself - (if it exists in original dataset) - * if False, then only points with non-zero distance - are returned - * if not given, considered True - Eps - approximation factor, Eps>=0. eps-approximate nearest - neighbor is a neighbor whose distance from X is at - most (1+eps) times distance of true nearest neighbor. - -RESULT - number of actual neighbors found (either K or N, if K>N). - -NOTES - significant performance gain may be achieved only when Eps is is on - the order of magnitude of 1 or larger. - -This subroutine performs query and stores its result in the internal -structures of the KD-tree. You can use following subroutines to obtain -these results: -* KDTreeQueryResultsX() to get X-values -* KDTreeQueryResultsXY() to get X- and Y-values -* KDTreeQueryResultsTags() to get tag values -* KDTreeQueryResultsDistances() to get distances - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -ae_int_t kdtreequeryaknn(const kdtree &kdt, const real_1d_array &x, const ae_int_t k, const bool selfmatch, const double eps) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::ae_int_t result = alglib_impl::kdtreequeryaknn(const_cast(kdt.c_ptr()), const_cast(x.c_ptr()), k, selfmatch, eps, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -K-NN query: approximate K nearest neighbors - -INPUT PARAMETERS - KDT - KD-tree - X - point, array[0..NX-1]. - K - number of neighbors to return, K>=1 - SelfMatch - whether self-matches are allowed: - * if True, nearest neighbor may be the point itself - (if it exists in original dataset) - * if False, then only points with non-zero distance - are returned - * if not given, considered True - Eps - approximation factor, Eps>=0. eps-approximate nearest - neighbor is a neighbor whose distance from X is at - most (1+eps) times distance of true nearest neighbor. - -RESULT - number of actual neighbors found (either K or N, if K>N). - -NOTES - significant performance gain may be achieved only when Eps is is on - the order of magnitude of 1 or larger. - -This subroutine performs query and stores its result in the internal -structures of the KD-tree. You can use following subroutines to obtain -these results: -* KDTreeQueryResultsX() to get X-values -* KDTreeQueryResultsXY() to get X- and Y-values -* KDTreeQueryResultsTags() to get tag values -* KDTreeQueryResultsDistances() to get distances - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -ae_int_t kdtreequeryaknn(const kdtree &kdt, const real_1d_array &x, const ae_int_t k, const double eps) -{ - alglib_impl::ae_state _alglib_env_state; - bool selfmatch; - - selfmatch = true; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::ae_int_t result = alglib_impl::kdtreequeryaknn(const_cast(kdt.c_ptr()), const_cast(x.c_ptr()), k, selfmatch, eps, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -X-values from last query - -INPUT PARAMETERS - KDT - KD-tree - X - possibly pre-allocated buffer. If X is too small to store - result, it is resized. If size(X) is enough to store - result, it is left unchanged. - -OUTPUT PARAMETERS - X - rows are filled with X-values - -NOTES -1. points are ordered by distance from the query point (first = closest) -2. if XY is larger than required to store result, only leading part will - be overwritten; trailing part will be left unchanged. So if on input - XY = [[A,B],[C,D]], and result is [1,2], then on exit we will get - XY = [[1,2],[C,D]]. This is done purposely to increase performance; if - you want function to resize array according to result size, use - function with same name and suffix 'I'. - -SEE ALSO -* KDTreeQueryResultsXY() X- and Y-values -* KDTreeQueryResultsTags() tag values -* KDTreeQueryResultsDistances() distances - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreequeryresultsx(const kdtree &kdt, real_2d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::kdtreequeryresultsx(const_cast(kdt.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -X- and Y-values from last query - -INPUT PARAMETERS - KDT - KD-tree - XY - possibly pre-allocated buffer. If XY is too small to store - result, it is resized. If size(XY) is enough to store - result, it is left unchanged. - -OUTPUT PARAMETERS - XY - rows are filled with points: first NX columns with - X-values, next NY columns - with Y-values. - -NOTES -1. points are ordered by distance from the query point (first = closest) -2. if XY is larger than required to store result, only leading part will - be overwritten; trailing part will be left unchanged. So if on input - XY = [[A,B],[C,D]], and result is [1,2], then on exit we will get - XY = [[1,2],[C,D]]. This is done purposely to increase performance; if - you want function to resize array according to result size, use - function with same name and suffix 'I'. - -SEE ALSO -* KDTreeQueryResultsX() X-values -* KDTreeQueryResultsTags() tag values -* KDTreeQueryResultsDistances() distances - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreequeryresultsxy(const kdtree &kdt, real_2d_array &xy) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::kdtreequeryresultsxy(const_cast(kdt.c_ptr()), const_cast(xy.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Tags from last query - -INPUT PARAMETERS - KDT - KD-tree - Tags - possibly pre-allocated buffer. If X is too small to store - result, it is resized. If size(X) is enough to store - result, it is left unchanged. - -OUTPUT PARAMETERS - Tags - filled with tags associated with points, - or, when no tags were supplied, with zeros - -NOTES -1. points are ordered by distance from the query point (first = closest) -2. if XY is larger than required to store result, only leading part will - be overwritten; trailing part will be left unchanged. So if on input - XY = [[A,B],[C,D]], and result is [1,2], then on exit we will get - XY = [[1,2],[C,D]]. This is done purposely to increase performance; if - you want function to resize array according to result size, use - function with same name and suffix 'I'. - -SEE ALSO -* KDTreeQueryResultsX() X-values -* KDTreeQueryResultsXY() X- and Y-values -* KDTreeQueryResultsDistances() distances - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreequeryresultstags(const kdtree &kdt, integer_1d_array &tags) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::kdtreequeryresultstags(const_cast(kdt.c_ptr()), const_cast(tags.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Distances from last query - -INPUT PARAMETERS - KDT - KD-tree - R - possibly pre-allocated buffer. If X is too small to store - result, it is resized. If size(X) is enough to store - result, it is left unchanged. - -OUTPUT PARAMETERS - R - filled with distances (in corresponding norm) - -NOTES -1. points are ordered by distance from the query point (first = closest) -2. if XY is larger than required to store result, only leading part will - be overwritten; trailing part will be left unchanged. So if on input - XY = [[A,B],[C,D]], and result is [1,2], then on exit we will get - XY = [[1,2],[C,D]]. This is done purposely to increase performance; if - you want function to resize array according to result size, use - function with same name and suffix 'I'. - -SEE ALSO -* KDTreeQueryResultsX() X-values -* KDTreeQueryResultsXY() X- and Y-values -* KDTreeQueryResultsTags() tag values - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreequeryresultsdistances(const kdtree &kdt, real_1d_array &r) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::kdtreequeryresultsdistances(const_cast(kdt.c_ptr()), const_cast(r.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -X-values from last query; 'interactive' variant for languages like Python -which support constructs like "X = KDTreeQueryResultsXI(KDT)" and -interactive mode of interpreter. - -This function allocates new array on each call, so it is significantly -slower than its 'non-interactive' counterpart, but it is more convenient -when you call it from command line. - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreequeryresultsxi(const kdtree &kdt, real_2d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::kdtreequeryresultsxi(const_cast(kdt.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -XY-values from last query; 'interactive' variant for languages like Python -which support constructs like "XY = KDTreeQueryResultsXYI(KDT)" and -interactive mode of interpreter. - -This function allocates new array on each call, so it is significantly -slower than its 'non-interactive' counterpart, but it is more convenient -when you call it from command line. - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreequeryresultsxyi(const kdtree &kdt, real_2d_array &xy) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::kdtreequeryresultsxyi(const_cast(kdt.c_ptr()), const_cast(xy.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Tags from last query; 'interactive' variant for languages like Python -which support constructs like "Tags = KDTreeQueryResultsTagsI(KDT)" and -interactive mode of interpreter. - -This function allocates new array on each call, so it is significantly -slower than its 'non-interactive' counterpart, but it is more convenient -when you call it from command line. - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreequeryresultstagsi(const kdtree &kdt, integer_1d_array &tags) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::kdtreequeryresultstagsi(const_cast(kdt.c_ptr()), const_cast(tags.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Distances from last query; 'interactive' variant for languages like Python -which support constructs like "R = KDTreeQueryResultsDistancesI(KDT)" -and interactive mode of interpreter. - -This function allocates new array on each call, so it is significantly -slower than its 'non-interactive' counterpart, but it is more convenient -when you call it from command line. - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreequeryresultsdistancesi(const kdtree &kdt, real_1d_array &r) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::kdtreequeryresultsdistancesi(const_cast(kdt.c_ptr()), const_cast(r.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS IMPLEMENTATION OF COMPUTATIONAL CORE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ -static ae_int_t hqrnd_hqrndmax = 2147483561; -static ae_int_t hqrnd_hqrndm1 = 2147483563; -static ae_int_t hqrnd_hqrndm2 = 2147483399; -static ae_int_t hqrnd_hqrndmagic = 1634357784; -static ae_int_t hqrnd_hqrndintegerbase(hqrndstate* state, - ae_state *_state); - - -static ae_int_t nearestneighbor_splitnodesize = 6; -static ae_int_t nearestneighbor_kdtreefirstversion = 0; -static void nearestneighbor_kdtreesplit(kdtree* kdt, - ae_int_t i1, - ae_int_t i2, - ae_int_t d, - double s, - ae_int_t* i3, - ae_state *_state); -static void nearestneighbor_kdtreegeneratetreerec(kdtree* kdt, - ae_int_t* nodesoffs, - ae_int_t* splitsoffs, - ae_int_t i1, - ae_int_t i2, - ae_int_t maxleafsize, - ae_state *_state); -static void nearestneighbor_kdtreequerynnrec(kdtree* kdt, - ae_int_t offs, - ae_state *_state); -static void nearestneighbor_kdtreeinitbox(kdtree* kdt, - /* Real */ ae_vector* x, - ae_state *_state); -static void nearestneighbor_kdtreeallocdatasetindependent(kdtree* kdt, - ae_int_t nx, - ae_int_t ny, - ae_state *_state); -static void nearestneighbor_kdtreeallocdatasetdependent(kdtree* kdt, - ae_int_t n, - ae_int_t nx, - ae_int_t ny, - ae_state *_state); -static void nearestneighbor_kdtreealloctemporaries(kdtree* kdt, - ae_int_t n, - ae_int_t nx, - ae_int_t ny, - ae_state *_state); - - - - - -/************************************************************************* -HQRNDState initialization with random values which come from standard -RNG. - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -void hqrndrandomize(hqrndstate* state, ae_state *_state) -{ - ae_int_t s0; - ae_int_t s1; - - _hqrndstate_clear(state); - - s0 = ae_randominteger(hqrnd_hqrndm1, _state); - s1 = ae_randominteger(hqrnd_hqrndm2, _state); - hqrndseed(s0, s1, state, _state); -} - - -/************************************************************************* -HQRNDState initialization with seed values - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -void hqrndseed(ae_int_t s1, - ae_int_t s2, - hqrndstate* state, - ae_state *_state) -{ - - _hqrndstate_clear(state); - - - /* - * Protection against negative seeds: - * - * SEED := -(SEED+1) - * - * We can use just "-SEED" because there exists such integer number N - * that N<0, -N=N<0 too. (This number is equal to 0x800...000). Need - * to handle such seed correctly forces us to use a bit complicated - * formula. - */ - if( s1<0 ) - { - s1 = -(s1+1); - } - if( s2<0 ) - { - s2 = -(s2+1); - } - state->s1 = s1%(hqrnd_hqrndm1-1)+1; - state->s2 = s2%(hqrnd_hqrndm2-1)+1; - state->magicv = hqrnd_hqrndmagic; -} - - -/************************************************************************* -This function generates random real number in (0,1), -not including interval boundaries - -State structure must be initialized with HQRNDRandomize() or HQRNDSeed(). - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -double hqrnduniformr(hqrndstate* state, ae_state *_state) -{ - double result; - - - result = (double)(hqrnd_hqrndintegerbase(state, _state)+1)/(double)(hqrnd_hqrndmax+2); - return result; -} - - -/************************************************************************* -This function generates random integer number in [0, N) - -1. State structure must be initialized with HQRNDRandomize() or HQRNDSeed() -2. N can be any positive number except for very large numbers: - * close to 2^31 on 32-bit systems - * close to 2^62 on 64-bit systems - An exception will be generated if N is too large. - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -ae_int_t hqrnduniformi(hqrndstate* state, ae_int_t n, ae_state *_state) -{ - ae_int_t maxcnt; - ae_int_t mx; - ae_int_t a; - ae_int_t b; - ae_int_t result; - - - ae_assert(n>0, "HQRNDUniformI: N<=0!", _state); - maxcnt = hqrnd_hqrndmax+1; - - /* - * Two branches: one for N<=MaxCnt, another for N>MaxCnt. - */ - if( n>maxcnt ) - { - - /* - * N>=MaxCnt. - * - * We have two options here: - * a) N is exactly divisible by MaxCnt - * b) N is not divisible by MaxCnt - * - * In both cases we reduce problem on interval spanning [0,N) - * to several subproblems on intervals spanning [0,MaxCnt). - */ - if( n%maxcnt==0 ) - { - - /* - * N is exactly divisible by MaxCnt. - * - * [0,N) range is dividided into N/MaxCnt bins, - * each of them having length equal to MaxCnt. - * - * We generate: - * * random bin number B - * * random offset within bin A - * Both random numbers are generated by recursively - * calling HQRNDUniformI(). - * - * Result is equal to A+MaxCnt*B. - */ - ae_assert(n/maxcnt<=maxcnt, "HQRNDUniformI: N is too large", _state); - a = hqrnduniformi(state, maxcnt, _state); - b = hqrnduniformi(state, n/maxcnt, _state); - result = a+maxcnt*b; - } - else - { - - /* - * N is NOT exactly divisible by MaxCnt. - * - * [0,N) range is dividided into Ceil(N/MaxCnt) bins, - * each of them having length equal to MaxCnt. - * - * We generate: - * * random bin number B in [0, Ceil(N/MaxCnt)-1] - * * random offset within bin A - * * if both of what is below is true - * 1) bin number B is that of the last bin - * 2) A >= N mod MaxCnt - * then we repeat generation of A/B. - * This stage is essential in order to avoid bias in the result. - * * otherwise, we return A*MaxCnt+N - */ - ae_assert(n/maxcnt+1<=maxcnt, "HQRNDUniformI: N is too large", _state); - result = -1; - do - { - a = hqrnduniformi(state, maxcnt, _state); - b = hqrnduniformi(state, n/maxcnt+1, _state); - if( b==n/maxcnt&&a>=n%maxcnt ) - { - continue; - } - result = a+maxcnt*b; - } - while(result<0); - } - } - else - { - - /* - * N<=MaxCnt - * - * Code below is a bit complicated because we can not simply - * return "HQRNDIntegerBase() mod N" - it will be skewed for - * large N's in [0.1*HQRNDMax...HQRNDMax]. - */ - mx = maxcnt-maxcnt%n; - do - { - result = hqrnd_hqrndintegerbase(state, _state); - } - while(result>=mx); - result = result%n; - } - return result; -} - - -/************************************************************************* -Random number generator: normal numbers - -This function generates one random number from normal distribution. -Its performance is equal to that of HQRNDNormal2() - -State structure must be initialized with HQRNDRandomize() or HQRNDSeed(). - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -double hqrndnormal(hqrndstate* state, ae_state *_state) -{ - double v1; - double v2; - double result; - - - hqrndnormal2(state, &v1, &v2, _state); - result = v1; - return result; -} - - -/************************************************************************* -Random number generator: random X and Y such that X^2+Y^2=1 - -State structure must be initialized with HQRNDRandomize() or HQRNDSeed(). - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -void hqrndunit2(hqrndstate* state, double* x, double* y, ae_state *_state) -{ - double v; - double mx; - double mn; - - *x = 0; - *y = 0; - - do - { - hqrndnormal2(state, x, y, _state); - } - while(!(ae_fp_neq(*x,0)||ae_fp_neq(*y,0))); - mx = ae_maxreal(ae_fabs(*x, _state), ae_fabs(*y, _state), _state); - mn = ae_minreal(ae_fabs(*x, _state), ae_fabs(*y, _state), _state); - v = mx*ae_sqrt(1+ae_sqr(mn/mx, _state), _state); - *x = *x/v; - *y = *y/v; -} - - -/************************************************************************* -Random number generator: normal numbers - -This function generates two independent random numbers from normal -distribution. Its performance is equal to that of HQRNDNormal() - -State structure must be initialized with HQRNDRandomize() or HQRNDSeed(). - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -void hqrndnormal2(hqrndstate* state, - double* x1, - double* x2, - ae_state *_state) -{ - double u; - double v; - double s; - - *x1 = 0; - *x2 = 0; - - for(;;) - { - u = 2*hqrnduniformr(state, _state)-1; - v = 2*hqrnduniformr(state, _state)-1; - s = ae_sqr(u, _state)+ae_sqr(v, _state); - if( ae_fp_greater(s,0)&&ae_fp_less(s,1) ) - { - - /* - * two Sqrt's instead of one to - * avoid overflow when S is too small - */ - s = ae_sqrt(-2*ae_log(s, _state), _state)/ae_sqrt(s, _state); - *x1 = u*s; - *x2 = v*s; - return; - } - } -} - - -/************************************************************************* -Random number generator: exponential distribution - -State structure must be initialized with HQRNDRandomize() or HQRNDSeed(). - - -- ALGLIB -- - Copyright 11.08.2007 by Bochkanov Sergey -*************************************************************************/ -double hqrndexponential(hqrndstate* state, - double lambdav, - ae_state *_state) -{ - double result; - - - ae_assert(ae_fp_greater(lambdav,0), "HQRNDExponential: LambdaV<=0!", _state); - result = -ae_log(hqrnduniformr(state, _state), _state)/lambdav; - return result; -} - - -/************************************************************************* -This function generates random number from discrete distribution given by -finite sample X. - -INPUT PARAMETERS - State - high quality random number generator, must be - initialized with HQRNDRandomize() or HQRNDSeed(). - X - finite sample - N - number of elements to use, N>=1 - -RESULT - this function returns one of the X[i] for random i=0..N-1 - - -- ALGLIB -- - Copyright 08.11.2011 by Bochkanov Sergey -*************************************************************************/ -double hqrnddiscrete(hqrndstate* state, - /* Real */ ae_vector* x, - ae_int_t n, - ae_state *_state) -{ - double result; - - - ae_assert(n>0, "HQRNDDiscrete: N<=0", _state); - ae_assert(n<=x->cnt, "HQRNDDiscrete: Length(X)ptr.p_double[hqrnduniformi(state, n, _state)]; - return result; -} - - -/************************************************************************* -This function generates random number from continuous distribution given -by finite sample X. - -INPUT PARAMETERS - State - high quality random number generator, must be - initialized with HQRNDRandomize() or HQRNDSeed(). - X - finite sample, array[N] (can be larger, in this case only - leading N elements are used). THIS ARRAY MUST BE SORTED BY - ASCENDING. - N - number of elements to use, N>=1 - -RESULT - this function returns random number from continuous distribution which - tries to approximate X as mush as possible. min(X)<=Result<=max(X). - - -- ALGLIB -- - Copyright 08.11.2011 by Bochkanov Sergey -*************************************************************************/ -double hqrndcontinuous(hqrndstate* state, - /* Real */ ae_vector* x, - ae_int_t n, - ae_state *_state) -{ - double mx; - double mn; - ae_int_t i; - double result; - - - ae_assert(n>0, "HQRNDContinuous: N<=0", _state); - ae_assert(n<=x->cnt, "HQRNDContinuous: Length(X)ptr.p_double[0]; - return result; - } - i = hqrnduniformi(state, n-1, _state); - mn = x->ptr.p_double[i]; - mx = x->ptr.p_double[i+1]; - ae_assert(ae_fp_greater_eq(mx,mn), "HQRNDDiscrete: X is not sorted by ascending", _state); - if( ae_fp_neq(mx,mn) ) - { - result = (mx-mn)*hqrnduniformr(state, _state)+mn; - } - else - { - result = mn; - } - return result; -} - - -/************************************************************************* -This function returns random integer in [0,HQRNDMax] - -L'Ecuyer, Efficient and portable combined random number generators -*************************************************************************/ -static ae_int_t hqrnd_hqrndintegerbase(hqrndstate* state, - ae_state *_state) -{ - ae_int_t k; - ae_int_t result; - - - ae_assert(state->magicv==hqrnd_hqrndmagic, "HQRNDIntegerBase: State is not correctly initialized!", _state); - k = state->s1/53668; - state->s1 = 40014*(state->s1-k*53668)-k*12211; - if( state->s1<0 ) - { - state->s1 = state->s1+2147483563; - } - k = state->s2/52774; - state->s2 = 40692*(state->s2-k*52774)-k*3791; - if( state->s2<0 ) - { - state->s2 = state->s2+2147483399; - } - - /* - * Result - */ - result = state->s1-state->s2; - if( result<1 ) - { - result = result+2147483562; - } - result = result-1; - return result; -} - - -ae_bool _hqrndstate_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - hqrndstate *p = (hqrndstate*)_p; - ae_touch_ptr((void*)p); - return ae_true; -} - - -ae_bool _hqrndstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - hqrndstate *dst = (hqrndstate*)_dst; - hqrndstate *src = (hqrndstate*)_src; - dst->s1 = src->s1; - dst->s2 = src->s2; - dst->magicv = src->magicv; - return ae_true; -} - - -void _hqrndstate_clear(void* _p) -{ - hqrndstate *p = (hqrndstate*)_p; - ae_touch_ptr((void*)p); -} - - -void _hqrndstate_destroy(void* _p) -{ - hqrndstate *p = (hqrndstate*)_p; - ae_touch_ptr((void*)p); -} - - - - -/************************************************************************* -KD-tree creation - -This subroutine creates KD-tree from set of X-values and optional Y-values - -INPUT PARAMETERS - XY - dataset, array[0..N-1,0..NX+NY-1]. - one row corresponds to one point. - first NX columns contain X-values, next NY (NY may be zero) - columns may contain associated Y-values - N - number of points, N>=0. - NX - space dimension, NX>=1. - NY - number of optional Y-values, NY>=0. - NormType- norm type: - * 0 denotes infinity-norm - * 1 denotes 1-norm - * 2 denotes 2-norm (Euclidean norm) - -OUTPUT PARAMETERS - KDT - KD-tree - - -NOTES - -1. KD-tree creation have O(N*logN) complexity and O(N*(2*NX+NY)) memory - requirements. -2. Although KD-trees may be used with any combination of N and NX, they - are more efficient than brute-force search only when N >> 4^NX. So they - are most useful in low-dimensional tasks (NX=2, NX=3). NX=1 is another - inefficient case, because simple binary search (without additional - structures) is much more efficient in such tasks than KD-trees. - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreebuild(/* Real */ ae_matrix* xy, - ae_int_t n, - ae_int_t nx, - ae_int_t ny, - ae_int_t normtype, - kdtree* kdt, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector tags; - ae_int_t i; - - ae_frame_make(_state, &_frame_block); - _kdtree_clear(kdt); - ae_vector_init(&tags, 0, DT_INT, _state, ae_true); - - ae_assert(n>=0, "KDTreeBuild: N<0", _state); - ae_assert(nx>=1, "KDTreeBuild: NX<1", _state); - ae_assert(ny>=0, "KDTreeBuild: NY<0", _state); - ae_assert(normtype>=0&&normtype<=2, "KDTreeBuild: incorrect NormType", _state); - ae_assert(xy->rows>=n, "KDTreeBuild: rows(X)cols>=nx+ny||n==0, "KDTreeBuild: cols(X)0 ) - { - ae_vector_set_length(&tags, n, _state); - for(i=0; i<=n-1; i++) - { - tags.ptr.p_int[i] = 0; - } - } - kdtreebuildtagged(xy, &tags, n, nx, ny, normtype, kdt, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -KD-tree creation - -This subroutine creates KD-tree from set of X-values, integer tags and -optional Y-values - -INPUT PARAMETERS - XY - dataset, array[0..N-1,0..NX+NY-1]. - one row corresponds to one point. - first NX columns contain X-values, next NY (NY may be zero) - columns may contain associated Y-values - Tags - tags, array[0..N-1], contains integer tags associated - with points. - N - number of points, N>=0 - NX - space dimension, NX>=1. - NY - number of optional Y-values, NY>=0. - NormType- norm type: - * 0 denotes infinity-norm - * 1 denotes 1-norm - * 2 denotes 2-norm (Euclidean norm) - -OUTPUT PARAMETERS - KDT - KD-tree - -NOTES - -1. KD-tree creation have O(N*logN) complexity and O(N*(2*NX+NY)) memory - requirements. -2. Although KD-trees may be used with any combination of N and NX, they - are more efficient than brute-force search only when N >> 4^NX. So they - are most useful in low-dimensional tasks (NX=2, NX=3). NX=1 is another - inefficient case, because simple binary search (without additional - structures) is much more efficient in such tasks than KD-trees. - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreebuildtagged(/* Real */ ae_matrix* xy, - /* Integer */ ae_vector* tags, - ae_int_t n, - ae_int_t nx, - ae_int_t ny, - ae_int_t normtype, - kdtree* kdt, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t maxnodes; - ae_int_t nodesoffs; - ae_int_t splitsoffs; - - _kdtree_clear(kdt); - - ae_assert(n>=0, "KDTreeBuildTagged: N<0", _state); - ae_assert(nx>=1, "KDTreeBuildTagged: NX<1", _state); - ae_assert(ny>=0, "KDTreeBuildTagged: NY<0", _state); - ae_assert(normtype>=0&&normtype<=2, "KDTreeBuildTagged: incorrect NormType", _state); - ae_assert(xy->rows>=n, "KDTreeBuildTagged: rows(X)cols>=nx+ny||n==0, "KDTreeBuildTagged: cols(X)n = n; - kdt->nx = nx; - kdt->ny = ny; - kdt->normtype = normtype; - kdt->kcur = 0; - - /* - * N=0 => quick exit - */ - if( n==0 ) - { - return; - } - - /* - * Allocate - */ - nearestneighbor_kdtreeallocdatasetindependent(kdt, nx, ny, _state); - nearestneighbor_kdtreeallocdatasetdependent(kdt, n, nx, ny, _state); - - /* - * Initial fill - */ - for(i=0; i<=n-1; i++) - { - ae_v_move(&kdt->xy.ptr.pp_double[i][0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nx-1)); - ae_v_move(&kdt->xy.ptr.pp_double[i][nx], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(nx,2*nx+ny-1)); - kdt->tags.ptr.p_int[i] = tags->ptr.p_int[i]; - } - - /* - * Determine bounding box - */ - ae_v_move(&kdt->boxmin.ptr.p_double[0], 1, &kdt->xy.ptr.pp_double[0][0], 1, ae_v_len(0,nx-1)); - ae_v_move(&kdt->boxmax.ptr.p_double[0], 1, &kdt->xy.ptr.pp_double[0][0], 1, ae_v_len(0,nx-1)); - for(i=1; i<=n-1; i++) - { - for(j=0; j<=nx-1; j++) - { - kdt->boxmin.ptr.p_double[j] = ae_minreal(kdt->boxmin.ptr.p_double[j], kdt->xy.ptr.pp_double[i][j], _state); - kdt->boxmax.ptr.p_double[j] = ae_maxreal(kdt->boxmax.ptr.p_double[j], kdt->xy.ptr.pp_double[i][j], _state); - } - } - - /* - * prepare tree structure - * * MaxNodes=N because we guarantee no trivial splits, i.e. - * every split will generate two non-empty boxes - */ - maxnodes = n; - ae_vector_set_length(&kdt->nodes, nearestneighbor_splitnodesize*2*maxnodes, _state); - ae_vector_set_length(&kdt->splits, 2*maxnodes, _state); - nodesoffs = 0; - splitsoffs = 0; - ae_v_move(&kdt->curboxmin.ptr.p_double[0], 1, &kdt->boxmin.ptr.p_double[0], 1, ae_v_len(0,nx-1)); - ae_v_move(&kdt->curboxmax.ptr.p_double[0], 1, &kdt->boxmax.ptr.p_double[0], 1, ae_v_len(0,nx-1)); - nearestneighbor_kdtreegeneratetreerec(kdt, &nodesoffs, &splitsoffs, 0, n, 8, _state); -} - - -/************************************************************************* -K-NN query: K nearest neighbors - -INPUT PARAMETERS - KDT - KD-tree - X - point, array[0..NX-1]. - K - number of neighbors to return, K>=1 - SelfMatch - whether self-matches are allowed: - * if True, nearest neighbor may be the point itself - (if it exists in original dataset) - * if False, then only points with non-zero distance - are returned - * if not given, considered True - -RESULT - number of actual neighbors found (either K or N, if K>N). - -This subroutine performs query and stores its result in the internal -structures of the KD-tree. You can use following subroutines to obtain -these results: -* KDTreeQueryResultsX() to get X-values -* KDTreeQueryResultsXY() to get X- and Y-values -* KDTreeQueryResultsTags() to get tag values -* KDTreeQueryResultsDistances() to get distances - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -ae_int_t kdtreequeryknn(kdtree* kdt, - /* Real */ ae_vector* x, - ae_int_t k, - ae_bool selfmatch, - ae_state *_state) -{ - ae_int_t result; - - - ae_assert(k>=1, "KDTreeQueryKNN: K<1!", _state); - ae_assert(x->cnt>=kdt->nx, "KDTreeQueryKNN: Length(X)nx, _state), "KDTreeQueryKNN: X contains infinite or NaN values!", _state); - result = kdtreequeryaknn(kdt, x, k, selfmatch, 0.0, _state); - return result; -} - - -/************************************************************************* -R-NN query: all points within R-sphere centered at X - -INPUT PARAMETERS - KDT - KD-tree - X - point, array[0..NX-1]. - R - radius of sphere (in corresponding norm), R>0 - SelfMatch - whether self-matches are allowed: - * if True, nearest neighbor may be the point itself - (if it exists in original dataset) - * if False, then only points with non-zero distance - are returned - * if not given, considered True - -RESULT - number of neighbors found, >=0 - -This subroutine performs query and stores its result in the internal -structures of the KD-tree. You can use following subroutines to obtain -actual results: -* KDTreeQueryResultsX() to get X-values -* KDTreeQueryResultsXY() to get X- and Y-values -* KDTreeQueryResultsTags() to get tag values -* KDTreeQueryResultsDistances() to get distances - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -ae_int_t kdtreequeryrnn(kdtree* kdt, - /* Real */ ae_vector* x, - double r, - ae_bool selfmatch, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t result; - - - ae_assert(ae_fp_greater(r,0), "KDTreeQueryRNN: incorrect R!", _state); - ae_assert(x->cnt>=kdt->nx, "KDTreeQueryRNN: Length(X)nx, _state), "KDTreeQueryRNN: X contains infinite or NaN values!", _state); - - /* - * Handle special case: KDT.N=0 - */ - if( kdt->n==0 ) - { - kdt->kcur = 0; - result = 0; - return result; - } - - /* - * Prepare parameters - */ - kdt->kneeded = 0; - if( kdt->normtype!=2 ) - { - kdt->rneeded = r; - } - else - { - kdt->rneeded = ae_sqr(r, _state); - } - kdt->selfmatch = selfmatch; - kdt->approxf = 1; - kdt->kcur = 0; - - /* - * calculate distance from point to current bounding box - */ - nearestneighbor_kdtreeinitbox(kdt, x, _state); - - /* - * call recursive search - * results are returned as heap - */ - nearestneighbor_kdtreequerynnrec(kdt, 0, _state); - - /* - * pop from heap to generate ordered representation - * - * last element is not pop'ed because it is already in - * its place - */ - result = kdt->kcur; - j = kdt->kcur; - for(i=kdt->kcur; i>=2; i--) - { - tagheappopi(&kdt->r, &kdt->idx, &j, _state); - } - return result; -} - - -/************************************************************************* -K-NN query: approximate K nearest neighbors - -INPUT PARAMETERS - KDT - KD-tree - X - point, array[0..NX-1]. - K - number of neighbors to return, K>=1 - SelfMatch - whether self-matches are allowed: - * if True, nearest neighbor may be the point itself - (if it exists in original dataset) - * if False, then only points with non-zero distance - are returned - * if not given, considered True - Eps - approximation factor, Eps>=0. eps-approximate nearest - neighbor is a neighbor whose distance from X is at - most (1+eps) times distance of true nearest neighbor. - -RESULT - number of actual neighbors found (either K or N, if K>N). - -NOTES - significant performance gain may be achieved only when Eps is is on - the order of magnitude of 1 or larger. - -This subroutine performs query and stores its result in the internal -structures of the KD-tree. You can use following subroutines to obtain -these results: -* KDTreeQueryResultsX() to get X-values -* KDTreeQueryResultsXY() to get X- and Y-values -* KDTreeQueryResultsTags() to get tag values -* KDTreeQueryResultsDistances() to get distances - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -ae_int_t kdtreequeryaknn(kdtree* kdt, - /* Real */ ae_vector* x, - ae_int_t k, - ae_bool selfmatch, - double eps, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t result; - - - ae_assert(k>0, "KDTreeQueryAKNN: incorrect K!", _state); - ae_assert(ae_fp_greater_eq(eps,0), "KDTreeQueryAKNN: incorrect Eps!", _state); - ae_assert(x->cnt>=kdt->nx, "KDTreeQueryAKNN: Length(X)nx, _state), "KDTreeQueryAKNN: X contains infinite or NaN values!", _state); - - /* - * Handle special case: KDT.N=0 - */ - if( kdt->n==0 ) - { - kdt->kcur = 0; - result = 0; - return result; - } - - /* - * Prepare parameters - */ - k = ae_minint(k, kdt->n, _state); - kdt->kneeded = k; - kdt->rneeded = 0; - kdt->selfmatch = selfmatch; - if( kdt->normtype==2 ) - { - kdt->approxf = 1/ae_sqr(1+eps, _state); - } - else - { - kdt->approxf = 1/(1+eps); - } - kdt->kcur = 0; - - /* - * calculate distance from point to current bounding box - */ - nearestneighbor_kdtreeinitbox(kdt, x, _state); - - /* - * call recursive search - * results are returned as heap - */ - nearestneighbor_kdtreequerynnrec(kdt, 0, _state); - - /* - * pop from heap to generate ordered representation - * - * last element is non pop'ed because it is already in - * its place - */ - result = kdt->kcur; - j = kdt->kcur; - for(i=kdt->kcur; i>=2; i--) - { - tagheappopi(&kdt->r, &kdt->idx, &j, _state); - } - return result; -} - - -/************************************************************************* -X-values from last query - -INPUT PARAMETERS - KDT - KD-tree - X - possibly pre-allocated buffer. If X is too small to store - result, it is resized. If size(X) is enough to store - result, it is left unchanged. - -OUTPUT PARAMETERS - X - rows are filled with X-values - -NOTES -1. points are ordered by distance from the query point (first = closest) -2. if XY is larger than required to store result, only leading part will - be overwritten; trailing part will be left unchanged. So if on input - XY = [[A,B],[C,D]], and result is [1,2], then on exit we will get - XY = [[1,2],[C,D]]. This is done purposely to increase performance; if - you want function to resize array according to result size, use - function with same name and suffix 'I'. - -SEE ALSO -* KDTreeQueryResultsXY() X- and Y-values -* KDTreeQueryResultsTags() tag values -* KDTreeQueryResultsDistances() distances - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreequeryresultsx(kdtree* kdt, - /* Real */ ae_matrix* x, - ae_state *_state) -{ - ae_int_t i; - ae_int_t k; - - - if( kdt->kcur==0 ) - { - return; - } - if( x->rowskcur||x->colsnx ) - { - ae_matrix_set_length(x, kdt->kcur, kdt->nx, _state); - } - k = kdt->kcur; - for(i=0; i<=k-1; i++) - { - ae_v_move(&x->ptr.pp_double[i][0], 1, &kdt->xy.ptr.pp_double[kdt->idx.ptr.p_int[i]][kdt->nx], 1, ae_v_len(0,kdt->nx-1)); - } -} - - -/************************************************************************* -X- and Y-values from last query - -INPUT PARAMETERS - KDT - KD-tree - XY - possibly pre-allocated buffer. If XY is too small to store - result, it is resized. If size(XY) is enough to store - result, it is left unchanged. - -OUTPUT PARAMETERS - XY - rows are filled with points: first NX columns with - X-values, next NY columns - with Y-values. - -NOTES -1. points are ordered by distance from the query point (first = closest) -2. if XY is larger than required to store result, only leading part will - be overwritten; trailing part will be left unchanged. So if on input - XY = [[A,B],[C,D]], and result is [1,2], then on exit we will get - XY = [[1,2],[C,D]]. This is done purposely to increase performance; if - you want function to resize array according to result size, use - function with same name and suffix 'I'. - -SEE ALSO -* KDTreeQueryResultsX() X-values -* KDTreeQueryResultsTags() tag values -* KDTreeQueryResultsDistances() distances - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreequeryresultsxy(kdtree* kdt, - /* Real */ ae_matrix* xy, - ae_state *_state) -{ - ae_int_t i; - ae_int_t k; - - - if( kdt->kcur==0 ) - { - return; - } - if( xy->rowskcur||xy->colsnx+kdt->ny ) - { - ae_matrix_set_length(xy, kdt->kcur, kdt->nx+kdt->ny, _state); - } - k = kdt->kcur; - for(i=0; i<=k-1; i++) - { - ae_v_move(&xy->ptr.pp_double[i][0], 1, &kdt->xy.ptr.pp_double[kdt->idx.ptr.p_int[i]][kdt->nx], 1, ae_v_len(0,kdt->nx+kdt->ny-1)); - } -} - - -/************************************************************************* -Tags from last query - -INPUT PARAMETERS - KDT - KD-tree - Tags - possibly pre-allocated buffer. If X is too small to store - result, it is resized. If size(X) is enough to store - result, it is left unchanged. - -OUTPUT PARAMETERS - Tags - filled with tags associated with points, - or, when no tags were supplied, with zeros - -NOTES -1. points are ordered by distance from the query point (first = closest) -2. if XY is larger than required to store result, only leading part will - be overwritten; trailing part will be left unchanged. So if on input - XY = [[A,B],[C,D]], and result is [1,2], then on exit we will get - XY = [[1,2],[C,D]]. This is done purposely to increase performance; if - you want function to resize array according to result size, use - function with same name and suffix 'I'. - -SEE ALSO -* KDTreeQueryResultsX() X-values -* KDTreeQueryResultsXY() X- and Y-values -* KDTreeQueryResultsDistances() distances - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreequeryresultstags(kdtree* kdt, - /* Integer */ ae_vector* tags, - ae_state *_state) -{ - ae_int_t i; - ae_int_t k; - - - if( kdt->kcur==0 ) - { - return; - } - if( tags->cntkcur ) - { - ae_vector_set_length(tags, kdt->kcur, _state); - } - k = kdt->kcur; - for(i=0; i<=k-1; i++) - { - tags->ptr.p_int[i] = kdt->tags.ptr.p_int[kdt->idx.ptr.p_int[i]]; - } -} - - -/************************************************************************* -Distances from last query - -INPUT PARAMETERS - KDT - KD-tree - R - possibly pre-allocated buffer. If X is too small to store - result, it is resized. If size(X) is enough to store - result, it is left unchanged. - -OUTPUT PARAMETERS - R - filled with distances (in corresponding norm) - -NOTES -1. points are ordered by distance from the query point (first = closest) -2. if XY is larger than required to store result, only leading part will - be overwritten; trailing part will be left unchanged. So if on input - XY = [[A,B],[C,D]], and result is [1,2], then on exit we will get - XY = [[1,2],[C,D]]. This is done purposely to increase performance; if - you want function to resize array according to result size, use - function with same name and suffix 'I'. - -SEE ALSO -* KDTreeQueryResultsX() X-values -* KDTreeQueryResultsXY() X- and Y-values -* KDTreeQueryResultsTags() tag values - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreequeryresultsdistances(kdtree* kdt, - /* Real */ ae_vector* r, - ae_state *_state) -{ - ae_int_t i; - ae_int_t k; - - - if( kdt->kcur==0 ) - { - return; - } - if( r->cntkcur ) - { - ae_vector_set_length(r, kdt->kcur, _state); - } - k = kdt->kcur; - - /* - * unload norms - * - * Abs() call is used to handle cases with negative norms - * (generated during KFN requests) - */ - if( kdt->normtype==0 ) - { - for(i=0; i<=k-1; i++) - { - r->ptr.p_double[i] = ae_fabs(kdt->r.ptr.p_double[i], _state); - } - } - if( kdt->normtype==1 ) - { - for(i=0; i<=k-1; i++) - { - r->ptr.p_double[i] = ae_fabs(kdt->r.ptr.p_double[i], _state); - } - } - if( kdt->normtype==2 ) - { - for(i=0; i<=k-1; i++) - { - r->ptr.p_double[i] = ae_sqrt(ae_fabs(kdt->r.ptr.p_double[i], _state), _state); - } - } -} - - -/************************************************************************* -X-values from last query; 'interactive' variant for languages like Python -which support constructs like "X = KDTreeQueryResultsXI(KDT)" and -interactive mode of interpreter. - -This function allocates new array on each call, so it is significantly -slower than its 'non-interactive' counterpart, but it is more convenient -when you call it from command line. - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreequeryresultsxi(kdtree* kdt, - /* Real */ ae_matrix* x, - ae_state *_state) -{ - - ae_matrix_clear(x); - - kdtreequeryresultsx(kdt, x, _state); -} - - -/************************************************************************* -XY-values from last query; 'interactive' variant for languages like Python -which support constructs like "XY = KDTreeQueryResultsXYI(KDT)" and -interactive mode of interpreter. - -This function allocates new array on each call, so it is significantly -slower than its 'non-interactive' counterpart, but it is more convenient -when you call it from command line. - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreequeryresultsxyi(kdtree* kdt, - /* Real */ ae_matrix* xy, - ae_state *_state) -{ - - ae_matrix_clear(xy); - - kdtreequeryresultsxy(kdt, xy, _state); -} - - -/************************************************************************* -Tags from last query; 'interactive' variant for languages like Python -which support constructs like "Tags = KDTreeQueryResultsTagsI(KDT)" and -interactive mode of interpreter. - -This function allocates new array on each call, so it is significantly -slower than its 'non-interactive' counterpart, but it is more convenient -when you call it from command line. - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreequeryresultstagsi(kdtree* kdt, - /* Integer */ ae_vector* tags, - ae_state *_state) -{ - - ae_vector_clear(tags); - - kdtreequeryresultstags(kdt, tags, _state); -} - - -/************************************************************************* -Distances from last query; 'interactive' variant for languages like Python -which support constructs like "R = KDTreeQueryResultsDistancesI(KDT)" -and interactive mode of interpreter. - -This function allocates new array on each call, so it is significantly -slower than its 'non-interactive' counterpart, but it is more convenient -when you call it from command line. - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreequeryresultsdistancesi(kdtree* kdt, - /* Real */ ae_vector* r, - ae_state *_state) -{ - - ae_vector_clear(r); - - kdtreequeryresultsdistances(kdt, r, _state); -} - - -/************************************************************************* -Serializer: allocation - - -- ALGLIB -- - Copyright 14.03.2011 by Bochkanov Sergey -*************************************************************************/ -void kdtreealloc(ae_serializer* s, kdtree* tree, ae_state *_state) -{ - - - - /* - * Header - */ - ae_serializer_alloc_entry(s); - ae_serializer_alloc_entry(s); - - /* - * Data - */ - ae_serializer_alloc_entry(s); - ae_serializer_alloc_entry(s); - ae_serializer_alloc_entry(s); - ae_serializer_alloc_entry(s); - allocrealmatrix(s, &tree->xy, -1, -1, _state); - allocintegerarray(s, &tree->tags, -1, _state); - allocrealarray(s, &tree->boxmin, -1, _state); - allocrealarray(s, &tree->boxmax, -1, _state); - allocintegerarray(s, &tree->nodes, -1, _state); - allocrealarray(s, &tree->splits, -1, _state); -} - - -/************************************************************************* -Serializer: serialization - - -- ALGLIB -- - Copyright 14.03.2011 by Bochkanov Sergey -*************************************************************************/ -void kdtreeserialize(ae_serializer* s, kdtree* tree, ae_state *_state) -{ - - - - /* - * Header - */ - ae_serializer_serialize_int(s, getkdtreeserializationcode(_state), _state); - ae_serializer_serialize_int(s, nearestneighbor_kdtreefirstversion, _state); - - /* - * Data - */ - ae_serializer_serialize_int(s, tree->n, _state); - ae_serializer_serialize_int(s, tree->nx, _state); - ae_serializer_serialize_int(s, tree->ny, _state); - ae_serializer_serialize_int(s, tree->normtype, _state); - serializerealmatrix(s, &tree->xy, -1, -1, _state); - serializeintegerarray(s, &tree->tags, -1, _state); - serializerealarray(s, &tree->boxmin, -1, _state); - serializerealarray(s, &tree->boxmax, -1, _state); - serializeintegerarray(s, &tree->nodes, -1, _state); - serializerealarray(s, &tree->splits, -1, _state); -} - - -/************************************************************************* -Serializer: unserialization - - -- ALGLIB -- - Copyright 14.03.2011 by Bochkanov Sergey -*************************************************************************/ -void kdtreeunserialize(ae_serializer* s, kdtree* tree, ae_state *_state) -{ - ae_int_t i0; - ae_int_t i1; - - _kdtree_clear(tree); - - - /* - * check correctness of header - */ - ae_serializer_unserialize_int(s, &i0, _state); - ae_assert(i0==getkdtreeserializationcode(_state), "KDTreeUnserialize: stream header corrupted", _state); - ae_serializer_unserialize_int(s, &i1, _state); - ae_assert(i1==nearestneighbor_kdtreefirstversion, "KDTreeUnserialize: stream header corrupted", _state); - - /* - * Unserialize data - */ - ae_serializer_unserialize_int(s, &tree->n, _state); - ae_serializer_unserialize_int(s, &tree->nx, _state); - ae_serializer_unserialize_int(s, &tree->ny, _state); - ae_serializer_unserialize_int(s, &tree->normtype, _state); - unserializerealmatrix(s, &tree->xy, _state); - unserializeintegerarray(s, &tree->tags, _state); - unserializerealarray(s, &tree->boxmin, _state); - unserializerealarray(s, &tree->boxmax, _state); - unserializeintegerarray(s, &tree->nodes, _state); - unserializerealarray(s, &tree->splits, _state); - nearestneighbor_kdtreealloctemporaries(tree, tree->n, tree->nx, tree->ny, _state); -} - - -/************************************************************************* -Rearranges nodes [I1,I2) using partition in D-th dimension with S as threshold. -Returns split position I3: [I1,I3) and [I3,I2) are created as result. - -This subroutine doesn't create tree structures, just rearranges nodes. -*************************************************************************/ -static void nearestneighbor_kdtreesplit(kdtree* kdt, - ae_int_t i1, - ae_int_t i2, - ae_int_t d, - double s, - ae_int_t* i3, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t ileft; - ae_int_t iright; - double v; - - *i3 = 0; - - ae_assert(kdt->n>0, "KDTreeSplit: internal error", _state); - - /* - * split XY/Tags in two parts: - * * [ILeft,IRight] is non-processed part of XY/Tags - * - * After cycle is done, we have Ileft=IRight. We deal with - * this element separately. - * - * After this, [I1,ILeft) contains left part, and [ILeft,I2) - * contains right part. - */ - ileft = i1; - iright = i2-1; - while(ileftxy.ptr.pp_double[ileft][d],s) ) - { - - /* - * XY[ILeft] is on its place. - * Advance ILeft. - */ - ileft = ileft+1; - } - else - { - - /* - * XY[ILeft,..] must be at IRight. - * Swap and advance IRight. - */ - for(i=0; i<=2*kdt->nx+kdt->ny-1; i++) - { - v = kdt->xy.ptr.pp_double[ileft][i]; - kdt->xy.ptr.pp_double[ileft][i] = kdt->xy.ptr.pp_double[iright][i]; - kdt->xy.ptr.pp_double[iright][i] = v; - } - j = kdt->tags.ptr.p_int[ileft]; - kdt->tags.ptr.p_int[ileft] = kdt->tags.ptr.p_int[iright]; - kdt->tags.ptr.p_int[iright] = j; - iright = iright-1; - } - } - if( ae_fp_less_eq(kdt->xy.ptr.pp_double[ileft][d],s) ) - { - ileft = ileft+1; - } - else - { - iright = iright-1; - } - *i3 = ileft; -} - - -/************************************************************************* -Recursive kd-tree generation subroutine. - -PARAMETERS - KDT tree - NodesOffs unused part of Nodes[] which must be filled by tree - SplitsOffs unused part of Splits[] - I1, I2 points from [I1,I2) are processed - -NodesOffs[] and SplitsOffs[] must be large enough. - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -static void nearestneighbor_kdtreegeneratetreerec(kdtree* kdt, - ae_int_t* nodesoffs, - ae_int_t* splitsoffs, - ae_int_t i1, - ae_int_t i2, - ae_int_t maxleafsize, - ae_state *_state) -{ - ae_int_t n; - ae_int_t nx; - ae_int_t ny; - ae_int_t i; - ae_int_t j; - ae_int_t oldoffs; - ae_int_t i3; - ae_int_t cntless; - ae_int_t cntgreater; - double minv; - double maxv; - ae_int_t minidx; - ae_int_t maxidx; - ae_int_t d; - double ds; - double s; - double v; - double v0; - double v1; - - - ae_assert(kdt->n>0, "KDTreeGenerateTreeRec: internal error", _state); - ae_assert(i2>i1, "KDTreeGenerateTreeRec: internal error", _state); - - /* - * Generate leaf if needed - */ - if( i2-i1<=maxleafsize ) - { - kdt->nodes.ptr.p_int[*nodesoffs+0] = i2-i1; - kdt->nodes.ptr.p_int[*nodesoffs+1] = i1; - *nodesoffs = *nodesoffs+2; - return; - } - - /* - * Load values for easier access - */ - nx = kdt->nx; - ny = kdt->ny; - - /* - * Select dimension to split: - * * D is a dimension number - * In case bounding box has zero size, we enforce creation of the leaf node. - */ - d = 0; - ds = kdt->curboxmax.ptr.p_double[0]-kdt->curboxmin.ptr.p_double[0]; - for(i=1; i<=nx-1; i++) - { - v = kdt->curboxmax.ptr.p_double[i]-kdt->curboxmin.ptr.p_double[i]; - if( ae_fp_greater(v,ds) ) - { - ds = v; - d = i; - } - } - if( ae_fp_eq(ds,0) ) - { - kdt->nodes.ptr.p_int[*nodesoffs+0] = i2-i1; - kdt->nodes.ptr.p_int[*nodesoffs+1] = i1; - *nodesoffs = *nodesoffs+2; - return; - } - - /* - * Select split position S using sliding midpoint rule, - * rearrange points into [I1,I3) and [I3,I2). - * - * In case all points has same value of D-th component - * (MinV=MaxV) we enforce D-th dimension of bounding - * box to become exactly zero and repeat tree construction. - */ - s = kdt->curboxmin.ptr.p_double[d]+0.5*ds; - ae_v_move(&kdt->buf.ptr.p_double[0], 1, &kdt->xy.ptr.pp_double[i1][d], kdt->xy.stride, ae_v_len(0,i2-i1-1)); - n = i2-i1; - cntless = 0; - cntgreater = 0; - minv = kdt->buf.ptr.p_double[0]; - maxv = kdt->buf.ptr.p_double[0]; - minidx = i1; - maxidx = i1; - for(i=0; i<=n-1; i++) - { - v = kdt->buf.ptr.p_double[i]; - if( ae_fp_less(v,minv) ) - { - minv = v; - minidx = i1+i; - } - if( ae_fp_greater(v,maxv) ) - { - maxv = v; - maxidx = i1+i; - } - if( ae_fp_less(v,s) ) - { - cntless = cntless+1; - } - if( ae_fp_greater(v,s) ) - { - cntgreater = cntgreater+1; - } - } - if( ae_fp_eq(minv,maxv) ) - { - - /* - * In case all points has same value of D-th component - * (MinV=MaxV) we enforce D-th dimension of bounding - * box to become exactly zero and repeat tree construction. - */ - v0 = kdt->curboxmin.ptr.p_double[d]; - v1 = kdt->curboxmax.ptr.p_double[d]; - kdt->curboxmin.ptr.p_double[d] = minv; - kdt->curboxmax.ptr.p_double[d] = maxv; - nearestneighbor_kdtreegeneratetreerec(kdt, nodesoffs, splitsoffs, i1, i2, maxleafsize, _state); - kdt->curboxmin.ptr.p_double[d] = v0; - kdt->curboxmax.ptr.p_double[d] = v1; - return; - } - if( cntless>0&&cntgreater>0 ) - { - - /* - * normal midpoint split - */ - nearestneighbor_kdtreesplit(kdt, i1, i2, d, s, &i3, _state); - } - else - { - - /* - * sliding midpoint - */ - if( cntless==0 ) - { - - /* - * 1. move split to MinV, - * 2. place one point to the left bin (move to I1), - * others - to the right bin - */ - s = minv; - if( minidx!=i1 ) - { - for(i=0; i<=2*nx+ny-1; i++) - { - v = kdt->xy.ptr.pp_double[minidx][i]; - kdt->xy.ptr.pp_double[minidx][i] = kdt->xy.ptr.pp_double[i1][i]; - kdt->xy.ptr.pp_double[i1][i] = v; - } - j = kdt->tags.ptr.p_int[minidx]; - kdt->tags.ptr.p_int[minidx] = kdt->tags.ptr.p_int[i1]; - kdt->tags.ptr.p_int[i1] = j; - } - i3 = i1+1; - } - else - { - - /* - * 1. move split to MaxV, - * 2. place one point to the right bin (move to I2-1), - * others - to the left bin - */ - s = maxv; - if( maxidx!=i2-1 ) - { - for(i=0; i<=2*nx+ny-1; i++) - { - v = kdt->xy.ptr.pp_double[maxidx][i]; - kdt->xy.ptr.pp_double[maxidx][i] = kdt->xy.ptr.pp_double[i2-1][i]; - kdt->xy.ptr.pp_double[i2-1][i] = v; - } - j = kdt->tags.ptr.p_int[maxidx]; - kdt->tags.ptr.p_int[maxidx] = kdt->tags.ptr.p_int[i2-1]; - kdt->tags.ptr.p_int[i2-1] = j; - } - i3 = i2-1; - } - } - - /* - * Generate 'split' node - */ - kdt->nodes.ptr.p_int[*nodesoffs+0] = 0; - kdt->nodes.ptr.p_int[*nodesoffs+1] = d; - kdt->nodes.ptr.p_int[*nodesoffs+2] = *splitsoffs; - kdt->splits.ptr.p_double[*splitsoffs+0] = s; - oldoffs = *nodesoffs; - *nodesoffs = *nodesoffs+nearestneighbor_splitnodesize; - *splitsoffs = *splitsoffs+1; - - /* - * Recirsive generation: - * * update CurBox - * * call subroutine - * * restore CurBox - */ - kdt->nodes.ptr.p_int[oldoffs+3] = *nodesoffs; - v = kdt->curboxmax.ptr.p_double[d]; - kdt->curboxmax.ptr.p_double[d] = s; - nearestneighbor_kdtreegeneratetreerec(kdt, nodesoffs, splitsoffs, i1, i3, maxleafsize, _state); - kdt->curboxmax.ptr.p_double[d] = v; - kdt->nodes.ptr.p_int[oldoffs+4] = *nodesoffs; - v = kdt->curboxmin.ptr.p_double[d]; - kdt->curboxmin.ptr.p_double[d] = s; - nearestneighbor_kdtreegeneratetreerec(kdt, nodesoffs, splitsoffs, i3, i2, maxleafsize, _state); - kdt->curboxmin.ptr.p_double[d] = v; -} - - -/************************************************************************* -Recursive subroutine for NN queries. - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -static void nearestneighbor_kdtreequerynnrec(kdtree* kdt, - ae_int_t offs, - ae_state *_state) -{ - double ptdist; - ae_int_t i; - ae_int_t j; - ae_int_t nx; - ae_int_t i1; - ae_int_t i2; - ae_int_t d; - double s; - double v; - double t1; - ae_int_t childbestoffs; - ae_int_t childworstoffs; - ae_int_t childoffs; - double prevdist; - ae_bool todive; - ae_bool bestisleft; - ae_bool updatemin; - - - ae_assert(kdt->n>0, "KDTreeQueryNNRec: internal error", _state); - - /* - * Leaf node. - * Process points. - */ - if( kdt->nodes.ptr.p_int[offs]>0 ) - { - i1 = kdt->nodes.ptr.p_int[offs+1]; - i2 = i1+kdt->nodes.ptr.p_int[offs]; - for(i=i1; i<=i2-1; i++) - { - - /* - * Calculate distance - */ - ptdist = 0; - nx = kdt->nx; - if( kdt->normtype==0 ) - { - for(j=0; j<=nx-1; j++) - { - ptdist = ae_maxreal(ptdist, ae_fabs(kdt->xy.ptr.pp_double[i][j]-kdt->x.ptr.p_double[j], _state), _state); - } - } - if( kdt->normtype==1 ) - { - for(j=0; j<=nx-1; j++) - { - ptdist = ptdist+ae_fabs(kdt->xy.ptr.pp_double[i][j]-kdt->x.ptr.p_double[j], _state); - } - } - if( kdt->normtype==2 ) - { - for(j=0; j<=nx-1; j++) - { - ptdist = ptdist+ae_sqr(kdt->xy.ptr.pp_double[i][j]-kdt->x.ptr.p_double[j], _state); - } - } - - /* - * Skip points with zero distance if self-matches are turned off - */ - if( ae_fp_eq(ptdist,0)&&!kdt->selfmatch ) - { - continue; - } - - /* - * We CAN'T process point if R-criterion isn't satisfied, - * i.e. (RNeeded<>0) AND (PtDist>R). - */ - if( ae_fp_eq(kdt->rneeded,0)||ae_fp_less_eq(ptdist,kdt->rneeded) ) - { - - /* - * R-criterion is satisfied, we must either: - * * replace worst point, if (KNeeded<>0) AND (KCur=KNeeded) - * (or skip, if worst point is better) - * * add point without replacement otherwise - */ - if( kdt->kcurkneeded||kdt->kneeded==0 ) - { - - /* - * add current point to heap without replacement - */ - tagheappushi(&kdt->r, &kdt->idx, &kdt->kcur, ptdist, i, _state); - } - else - { - - /* - * New points are added or not, depending on their distance. - * If added, they replace element at the top of the heap - */ - if( ae_fp_less(ptdist,kdt->r.ptr.p_double[0]) ) - { - if( kdt->kneeded==1 ) - { - kdt->idx.ptr.p_int[0] = i; - kdt->r.ptr.p_double[0] = ptdist; - } - else - { - tagheapreplacetopi(&kdt->r, &kdt->idx, kdt->kneeded, ptdist, i, _state); - } - } - } - } - } - return; - } - - /* - * Simple split - */ - if( kdt->nodes.ptr.p_int[offs]==0 ) - { - - /* - * Load: - * * D dimension to split - * * S split position - */ - d = kdt->nodes.ptr.p_int[offs+1]; - s = kdt->splits.ptr.p_double[kdt->nodes.ptr.p_int[offs+2]]; - - /* - * Calculate: - * * ChildBestOffs child box with best chances - * * ChildWorstOffs child box with worst chances - */ - if( ae_fp_less_eq(kdt->x.ptr.p_double[d],s) ) - { - childbestoffs = kdt->nodes.ptr.p_int[offs+3]; - childworstoffs = kdt->nodes.ptr.p_int[offs+4]; - bestisleft = ae_true; - } - else - { - childbestoffs = kdt->nodes.ptr.p_int[offs+4]; - childworstoffs = kdt->nodes.ptr.p_int[offs+3]; - bestisleft = ae_false; - } - - /* - * Navigate through childs - */ - for(i=0; i<=1; i++) - { - - /* - * Select child to process: - * * ChildOffs current child offset in Nodes[] - * * UpdateMin whether minimum or maximum value - * of bounding box is changed on update - */ - if( i==0 ) - { - childoffs = childbestoffs; - updatemin = !bestisleft; - } - else - { - updatemin = bestisleft; - childoffs = childworstoffs; - } - - /* - * Update bounding box and current distance - */ - if( updatemin ) - { - prevdist = kdt->curdist; - t1 = kdt->x.ptr.p_double[d]; - v = kdt->curboxmin.ptr.p_double[d]; - if( ae_fp_less_eq(t1,s) ) - { - if( kdt->normtype==0 ) - { - kdt->curdist = ae_maxreal(kdt->curdist, s-t1, _state); - } - if( kdt->normtype==1 ) - { - kdt->curdist = kdt->curdist-ae_maxreal(v-t1, 0, _state)+s-t1; - } - if( kdt->normtype==2 ) - { - kdt->curdist = kdt->curdist-ae_sqr(ae_maxreal(v-t1, 0, _state), _state)+ae_sqr(s-t1, _state); - } - } - kdt->curboxmin.ptr.p_double[d] = s; - } - else - { - prevdist = kdt->curdist; - t1 = kdt->x.ptr.p_double[d]; - v = kdt->curboxmax.ptr.p_double[d]; - if( ae_fp_greater_eq(t1,s) ) - { - if( kdt->normtype==0 ) - { - kdt->curdist = ae_maxreal(kdt->curdist, t1-s, _state); - } - if( kdt->normtype==1 ) - { - kdt->curdist = kdt->curdist-ae_maxreal(t1-v, 0, _state)+t1-s; - } - if( kdt->normtype==2 ) - { - kdt->curdist = kdt->curdist-ae_sqr(ae_maxreal(t1-v, 0, _state), _state)+ae_sqr(t1-s, _state); - } - } - kdt->curboxmax.ptr.p_double[d] = s; - } - - /* - * Decide: to dive into cell or not to dive - */ - if( ae_fp_neq(kdt->rneeded,0)&&ae_fp_greater(kdt->curdist,kdt->rneeded) ) - { - todive = ae_false; - } - else - { - if( kdt->kcurkneeded||kdt->kneeded==0 ) - { - - /* - * KCurcurdist,kdt->r.ptr.p_double[0]*kdt->approxf); - } - } - if( todive ) - { - nearestneighbor_kdtreequerynnrec(kdt, childoffs, _state); - } - - /* - * Restore bounding box and distance - */ - if( updatemin ) - { - kdt->curboxmin.ptr.p_double[d] = v; - } - else - { - kdt->curboxmax.ptr.p_double[d] = v; - } - kdt->curdist = prevdist; - } - return; - } -} - - -/************************************************************************* -Copies X[] to KDT.X[] -Loads distance from X[] to bounding box. -Initializes CurBox[]. - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -static void nearestneighbor_kdtreeinitbox(kdtree* kdt, - /* Real */ ae_vector* x, - ae_state *_state) -{ - ae_int_t i; - double vx; - double vmin; - double vmax; - - - ae_assert(kdt->n>0, "KDTreeInitBox: internal error", _state); - - /* - * calculate distance from point to current bounding box - */ - kdt->curdist = 0; - if( kdt->normtype==0 ) - { - for(i=0; i<=kdt->nx-1; i++) - { - vx = x->ptr.p_double[i]; - vmin = kdt->boxmin.ptr.p_double[i]; - vmax = kdt->boxmax.ptr.p_double[i]; - kdt->x.ptr.p_double[i] = vx; - kdt->curboxmin.ptr.p_double[i] = vmin; - kdt->curboxmax.ptr.p_double[i] = vmax; - if( ae_fp_less(vx,vmin) ) - { - kdt->curdist = ae_maxreal(kdt->curdist, vmin-vx, _state); - } - else - { - if( ae_fp_greater(vx,vmax) ) - { - kdt->curdist = ae_maxreal(kdt->curdist, vx-vmax, _state); - } - } - } - } - if( kdt->normtype==1 ) - { - for(i=0; i<=kdt->nx-1; i++) - { - vx = x->ptr.p_double[i]; - vmin = kdt->boxmin.ptr.p_double[i]; - vmax = kdt->boxmax.ptr.p_double[i]; - kdt->x.ptr.p_double[i] = vx; - kdt->curboxmin.ptr.p_double[i] = vmin; - kdt->curboxmax.ptr.p_double[i] = vmax; - if( ae_fp_less(vx,vmin) ) - { - kdt->curdist = kdt->curdist+vmin-vx; - } - else - { - if( ae_fp_greater(vx,vmax) ) - { - kdt->curdist = kdt->curdist+vx-vmax; - } - } - } - } - if( kdt->normtype==2 ) - { - for(i=0; i<=kdt->nx-1; i++) - { - vx = x->ptr.p_double[i]; - vmin = kdt->boxmin.ptr.p_double[i]; - vmax = kdt->boxmax.ptr.p_double[i]; - kdt->x.ptr.p_double[i] = vx; - kdt->curboxmin.ptr.p_double[i] = vmin; - kdt->curboxmax.ptr.p_double[i] = vmax; - if( ae_fp_less(vx,vmin) ) - { - kdt->curdist = kdt->curdist+ae_sqr(vmin-vx, _state); - } - else - { - if( ae_fp_greater(vx,vmax) ) - { - kdt->curdist = kdt->curdist+ae_sqr(vx-vmax, _state); - } - } - } - } -} - - -/************************************************************************* -This function allocates all dataset-independent array fields of KDTree, -i.e. such array fields that their dimensions do not depend on dataset -size. - -This function do not sets KDT.NX or KDT.NY - it just allocates arrays - - -- ALGLIB -- - Copyright 14.03.2011 by Bochkanov Sergey -*************************************************************************/ -static void nearestneighbor_kdtreeallocdatasetindependent(kdtree* kdt, - ae_int_t nx, - ae_int_t ny, - ae_state *_state) -{ - - - ae_assert(kdt->n>0, "KDTreeAllocDatasetIndependent: internal error", _state); - ae_vector_set_length(&kdt->x, nx, _state); - ae_vector_set_length(&kdt->boxmin, nx, _state); - ae_vector_set_length(&kdt->boxmax, nx, _state); - ae_vector_set_length(&kdt->curboxmin, nx, _state); - ae_vector_set_length(&kdt->curboxmax, nx, _state); -} - - -/************************************************************************* -This function allocates all dataset-dependent array fields of KDTree, i.e. -such array fields that their dimensions depend on dataset size. - -This function do not sets KDT.N, KDT.NX or KDT.NY - -it just allocates arrays. - - -- ALGLIB -- - Copyright 14.03.2011 by Bochkanov Sergey -*************************************************************************/ -static void nearestneighbor_kdtreeallocdatasetdependent(kdtree* kdt, - ae_int_t n, - ae_int_t nx, - ae_int_t ny, - ae_state *_state) -{ - - - ae_assert(n>0, "KDTreeAllocDatasetDependent: internal error", _state); - ae_matrix_set_length(&kdt->xy, n, 2*nx+ny, _state); - ae_vector_set_length(&kdt->tags, n, _state); - ae_vector_set_length(&kdt->idx, n, _state); - ae_vector_set_length(&kdt->r, n, _state); - ae_vector_set_length(&kdt->x, nx, _state); - ae_vector_set_length(&kdt->buf, ae_maxint(n, nx, _state), _state); - ae_vector_set_length(&kdt->nodes, nearestneighbor_splitnodesize*2*n, _state); - ae_vector_set_length(&kdt->splits, 2*n, _state); -} - - -/************************************************************************* -This function allocates temporaries. - -This function do not sets KDT.N, KDT.NX or KDT.NY - -it just allocates arrays. - - -- ALGLIB -- - Copyright 14.03.2011 by Bochkanov Sergey -*************************************************************************/ -static void nearestneighbor_kdtreealloctemporaries(kdtree* kdt, - ae_int_t n, - ae_int_t nx, - ae_int_t ny, - ae_state *_state) -{ - - - ae_assert(n>0, "KDTreeAllocTemporaries: internal error", _state); - ae_vector_set_length(&kdt->x, nx, _state); - ae_vector_set_length(&kdt->idx, n, _state); - ae_vector_set_length(&kdt->r, n, _state); - ae_vector_set_length(&kdt->buf, ae_maxint(n, nx, _state), _state); - ae_vector_set_length(&kdt->curboxmin, nx, _state); - ae_vector_set_length(&kdt->curboxmax, nx, _state); -} - - -ae_bool _kdtree_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - kdtree *p = (kdtree*)_p; - ae_touch_ptr((void*)p); - if( !ae_matrix_init(&p->xy, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->tags, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->boxmin, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->boxmax, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->nodes, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->splits, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->idx, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->r, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->buf, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->curboxmin, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->curboxmax, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _kdtree_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - kdtree *dst = (kdtree*)_dst; - kdtree *src = (kdtree*)_src; - dst->n = src->n; - dst->nx = src->nx; - dst->ny = src->ny; - dst->normtype = src->normtype; - if( !ae_matrix_init_copy(&dst->xy, &src->xy, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->tags, &src->tags, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->boxmin, &src->boxmin, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->boxmax, &src->boxmax, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->nodes, &src->nodes, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->splits, &src->splits, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) - return ae_false; - dst->kneeded = src->kneeded; - dst->rneeded = src->rneeded; - dst->selfmatch = src->selfmatch; - dst->approxf = src->approxf; - dst->kcur = src->kcur; - if( !ae_vector_init_copy(&dst->idx, &src->idx, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->r, &src->r, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->buf, &src->buf, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->curboxmin, &src->curboxmin, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->curboxmax, &src->curboxmax, _state, make_automatic) ) - return ae_false; - dst->curdist = src->curdist; - dst->debugcounter = src->debugcounter; - return ae_true; -} - - -void _kdtree_clear(void* _p) -{ - kdtree *p = (kdtree*)_p; - ae_touch_ptr((void*)p); - ae_matrix_clear(&p->xy); - ae_vector_clear(&p->tags); - ae_vector_clear(&p->boxmin); - ae_vector_clear(&p->boxmax); - ae_vector_clear(&p->nodes); - ae_vector_clear(&p->splits); - ae_vector_clear(&p->x); - ae_vector_clear(&p->idx); - ae_vector_clear(&p->r); - ae_vector_clear(&p->buf); - ae_vector_clear(&p->curboxmin); - ae_vector_clear(&p->curboxmax); -} - - -void _kdtree_destroy(void* _p) -{ - kdtree *p = (kdtree*)_p; - ae_touch_ptr((void*)p); - ae_matrix_destroy(&p->xy); - ae_vector_destroy(&p->tags); - ae_vector_destroy(&p->boxmin); - ae_vector_destroy(&p->boxmax); - ae_vector_destroy(&p->nodes); - ae_vector_destroy(&p->splits); - ae_vector_destroy(&p->x); - ae_vector_destroy(&p->idx); - ae_vector_destroy(&p->r); - ae_vector_destroy(&p->buf); - ae_vector_destroy(&p->curboxmin); - ae_vector_destroy(&p->curboxmax); -} - - - -} - diff --git a/src/core/alglib/alglibmisc.h b/src/core/alglib/alglibmisc.h deleted file mode 100644 index 8209ac6..0000000 --- a/src/core/alglib/alglibmisc.h +++ /dev/null @@ -1,769 +0,0 @@ -/************************************************************************* -Copyright (c) Sergey Bochkanov (ALGLIB project). - ->>> SOURCE LICENSE >>> -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation (www.fsf.org); either version 2 of the -License, or (at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -A copy of the GNU General Public License is available at -http://www.fsf.org/licensing/licenses ->>> END OF LICENSE >>> -*************************************************************************/ -#ifndef _alglibmisc_pkg_h -#define _alglibmisc_pkg_h -#include "ap.h" -#include "alglibinternal.h" - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (DATATYPES) -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ -typedef struct -{ - ae_int_t s1; - ae_int_t s2; - ae_int_t magicv; -} hqrndstate; -typedef struct -{ - ae_int_t n; - ae_int_t nx; - ae_int_t ny; - ae_int_t normtype; - ae_matrix xy; - ae_vector tags; - ae_vector boxmin; - ae_vector boxmax; - ae_vector nodes; - ae_vector splits; - ae_vector x; - ae_int_t kneeded; - double rneeded; - ae_bool selfmatch; - double approxf; - ae_int_t kcur; - ae_vector idx; - ae_vector r; - ae_vector buf; - ae_vector curboxmin; - ae_vector curboxmax; - double curdist; - ae_int_t debugcounter; -} kdtree; - -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS C++ INTERFACE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib -{ - -/************************************************************************* -Portable high quality random number generator state. -Initialized with HQRNDRandomize() or HQRNDSeed(). - -Fields: - S1, S2 - seed values - V - precomputed value - MagicV - 'magic' value used to determine whether State structure - was correctly initialized. -*************************************************************************/ -class _hqrndstate_owner -{ -public: - _hqrndstate_owner(); - _hqrndstate_owner(const _hqrndstate_owner &rhs); - _hqrndstate_owner& operator=(const _hqrndstate_owner &rhs); - virtual ~_hqrndstate_owner(); - alglib_impl::hqrndstate* c_ptr(); - alglib_impl::hqrndstate* c_ptr() const; -protected: - alglib_impl::hqrndstate *p_struct; -}; -class hqrndstate : public _hqrndstate_owner -{ -public: - hqrndstate(); - hqrndstate(const hqrndstate &rhs); - hqrndstate& operator=(const hqrndstate &rhs); - virtual ~hqrndstate(); - -}; - -/************************************************************************* - -*************************************************************************/ -class _kdtree_owner -{ -public: - _kdtree_owner(); - _kdtree_owner(const _kdtree_owner &rhs); - _kdtree_owner& operator=(const _kdtree_owner &rhs); - virtual ~_kdtree_owner(); - alglib_impl::kdtree* c_ptr(); - alglib_impl::kdtree* c_ptr() const; -protected: - alglib_impl::kdtree *p_struct; -}; -class kdtree : public _kdtree_owner -{ -public: - kdtree(); - kdtree(const kdtree &rhs); - kdtree& operator=(const kdtree &rhs); - virtual ~kdtree(); - -}; - -/************************************************************************* -HQRNDState initialization with random values which come from standard -RNG. - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -void hqrndrandomize(hqrndstate &state); - - -/************************************************************************* -HQRNDState initialization with seed values - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -void hqrndseed(const ae_int_t s1, const ae_int_t s2, hqrndstate &state); - - -/************************************************************************* -This function generates random real number in (0,1), -not including interval boundaries - -State structure must be initialized with HQRNDRandomize() or HQRNDSeed(). - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -double hqrnduniformr(const hqrndstate &state); - - -/************************************************************************* -This function generates random integer number in [0, N) - -1. State structure must be initialized with HQRNDRandomize() or HQRNDSeed() -2. N can be any positive number except for very large numbers: - * close to 2^31 on 32-bit systems - * close to 2^62 on 64-bit systems - An exception will be generated if N is too large. - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -ae_int_t hqrnduniformi(const hqrndstate &state, const ae_int_t n); - - -/************************************************************************* -Random number generator: normal numbers - -This function generates one random number from normal distribution. -Its performance is equal to that of HQRNDNormal2() - -State structure must be initialized with HQRNDRandomize() or HQRNDSeed(). - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -double hqrndnormal(const hqrndstate &state); - - -/************************************************************************* -Random number generator: random X and Y such that X^2+Y^2=1 - -State structure must be initialized with HQRNDRandomize() or HQRNDSeed(). - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -void hqrndunit2(const hqrndstate &state, double &x, double &y); - - -/************************************************************************* -Random number generator: normal numbers - -This function generates two independent random numbers from normal -distribution. Its performance is equal to that of HQRNDNormal() - -State structure must be initialized with HQRNDRandomize() or HQRNDSeed(). - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -void hqrndnormal2(const hqrndstate &state, double &x1, double &x2); - - -/************************************************************************* -Random number generator: exponential distribution - -State structure must be initialized with HQRNDRandomize() or HQRNDSeed(). - - -- ALGLIB -- - Copyright 11.08.2007 by Bochkanov Sergey -*************************************************************************/ -double hqrndexponential(const hqrndstate &state, const double lambdav); - - -/************************************************************************* -This function generates random number from discrete distribution given by -finite sample X. - -INPUT PARAMETERS - State - high quality random number generator, must be - initialized with HQRNDRandomize() or HQRNDSeed(). - X - finite sample - N - number of elements to use, N>=1 - -RESULT - this function returns one of the X[i] for random i=0..N-1 - - -- ALGLIB -- - Copyright 08.11.2011 by Bochkanov Sergey -*************************************************************************/ -double hqrnddiscrete(const hqrndstate &state, const real_1d_array &x, const ae_int_t n); - - -/************************************************************************* -This function generates random number from continuous distribution given -by finite sample X. - -INPUT PARAMETERS - State - high quality random number generator, must be - initialized with HQRNDRandomize() or HQRNDSeed(). - X - finite sample, array[N] (can be larger, in this case only - leading N elements are used). THIS ARRAY MUST BE SORTED BY - ASCENDING. - N - number of elements to use, N>=1 - -RESULT - this function returns random number from continuous distribution which - tries to approximate X as mush as possible. min(X)<=Result<=max(X). - - -- ALGLIB -- - Copyright 08.11.2011 by Bochkanov Sergey -*************************************************************************/ -double hqrndcontinuous(const hqrndstate &state, const real_1d_array &x, const ae_int_t n); - -/************************************************************************* -This function serializes data structure to string. - -Important properties of s_out: -* it contains alphanumeric characters, dots, underscores, minus signs -* these symbols are grouped into words, which are separated by spaces - and Windows-style (CR+LF) newlines -* although serializer uses spaces and CR+LF as separators, you can - replace any separator character by arbitrary combination of spaces, - tabs, Windows or Unix newlines. It allows flexible reformatting of - the string in case you want to include it into text or XML file. - But you should not insert separators into the middle of the "words" - nor you should change case of letters. -* s_out can be freely moved between 32-bit and 64-bit systems, little - and big endian machines, and so on. You can serialize structure on - 32-bit machine and unserialize it on 64-bit one (or vice versa), or - serialize it on SPARC and unserialize on x86. You can also - serialize it in C++ version of ALGLIB and unserialize in C# one, - and vice versa. -*************************************************************************/ -void kdtreeserialize(kdtree &obj, std::string &s_out); - - -/************************************************************************* -This function unserializes data structure from string. -*************************************************************************/ -void kdtreeunserialize(std::string &s_in, kdtree &obj); - - -/************************************************************************* -KD-tree creation - -This subroutine creates KD-tree from set of X-values and optional Y-values - -INPUT PARAMETERS - XY - dataset, array[0..N-1,0..NX+NY-1]. - one row corresponds to one point. - first NX columns contain X-values, next NY (NY may be zero) - columns may contain associated Y-values - N - number of points, N>=0. - NX - space dimension, NX>=1. - NY - number of optional Y-values, NY>=0. - NormType- norm type: - * 0 denotes infinity-norm - * 1 denotes 1-norm - * 2 denotes 2-norm (Euclidean norm) - -OUTPUT PARAMETERS - KDT - KD-tree - - -NOTES - -1. KD-tree creation have O(N*logN) complexity and O(N*(2*NX+NY)) memory - requirements. -2. Although KD-trees may be used with any combination of N and NX, they - are more efficient than brute-force search only when N >> 4^NX. So they - are most useful in low-dimensional tasks (NX=2, NX=3). NX=1 is another - inefficient case, because simple binary search (without additional - structures) is much more efficient in such tasks than KD-trees. - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreebuild(const real_2d_array &xy, const ae_int_t n, const ae_int_t nx, const ae_int_t ny, const ae_int_t normtype, kdtree &kdt); -void kdtreebuild(const real_2d_array &xy, const ae_int_t nx, const ae_int_t ny, const ae_int_t normtype, kdtree &kdt); - - -/************************************************************************* -KD-tree creation - -This subroutine creates KD-tree from set of X-values, integer tags and -optional Y-values - -INPUT PARAMETERS - XY - dataset, array[0..N-1,0..NX+NY-1]. - one row corresponds to one point. - first NX columns contain X-values, next NY (NY may be zero) - columns may contain associated Y-values - Tags - tags, array[0..N-1], contains integer tags associated - with points. - N - number of points, N>=0 - NX - space dimension, NX>=1. - NY - number of optional Y-values, NY>=0. - NormType- norm type: - * 0 denotes infinity-norm - * 1 denotes 1-norm - * 2 denotes 2-norm (Euclidean norm) - -OUTPUT PARAMETERS - KDT - KD-tree - -NOTES - -1. KD-tree creation have O(N*logN) complexity and O(N*(2*NX+NY)) memory - requirements. -2. Although KD-trees may be used with any combination of N and NX, they - are more efficient than brute-force search only when N >> 4^NX. So they - are most useful in low-dimensional tasks (NX=2, NX=3). NX=1 is another - inefficient case, because simple binary search (without additional - structures) is much more efficient in such tasks than KD-trees. - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreebuildtagged(const real_2d_array &xy, const integer_1d_array &tags, const ae_int_t n, const ae_int_t nx, const ae_int_t ny, const ae_int_t normtype, kdtree &kdt); -void kdtreebuildtagged(const real_2d_array &xy, const integer_1d_array &tags, const ae_int_t nx, const ae_int_t ny, const ae_int_t normtype, kdtree &kdt); - - -/************************************************************************* -K-NN query: K nearest neighbors - -INPUT PARAMETERS - KDT - KD-tree - X - point, array[0..NX-1]. - K - number of neighbors to return, K>=1 - SelfMatch - whether self-matches are allowed: - * if True, nearest neighbor may be the point itself - (if it exists in original dataset) - * if False, then only points with non-zero distance - are returned - * if not given, considered True - -RESULT - number of actual neighbors found (either K or N, if K>N). - -This subroutine performs query and stores its result in the internal -structures of the KD-tree. You can use following subroutines to obtain -these results: -* KDTreeQueryResultsX() to get X-values -* KDTreeQueryResultsXY() to get X- and Y-values -* KDTreeQueryResultsTags() to get tag values -* KDTreeQueryResultsDistances() to get distances - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -ae_int_t kdtreequeryknn(const kdtree &kdt, const real_1d_array &x, const ae_int_t k, const bool selfmatch); -ae_int_t kdtreequeryknn(const kdtree &kdt, const real_1d_array &x, const ae_int_t k); - - -/************************************************************************* -R-NN query: all points within R-sphere centered at X - -INPUT PARAMETERS - KDT - KD-tree - X - point, array[0..NX-1]. - R - radius of sphere (in corresponding norm), R>0 - SelfMatch - whether self-matches are allowed: - * if True, nearest neighbor may be the point itself - (if it exists in original dataset) - * if False, then only points with non-zero distance - are returned - * if not given, considered True - -RESULT - number of neighbors found, >=0 - -This subroutine performs query and stores its result in the internal -structures of the KD-tree. You can use following subroutines to obtain -actual results: -* KDTreeQueryResultsX() to get X-values -* KDTreeQueryResultsXY() to get X- and Y-values -* KDTreeQueryResultsTags() to get tag values -* KDTreeQueryResultsDistances() to get distances - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -ae_int_t kdtreequeryrnn(const kdtree &kdt, const real_1d_array &x, const double r, const bool selfmatch); -ae_int_t kdtreequeryrnn(const kdtree &kdt, const real_1d_array &x, const double r); - - -/************************************************************************* -K-NN query: approximate K nearest neighbors - -INPUT PARAMETERS - KDT - KD-tree - X - point, array[0..NX-1]. - K - number of neighbors to return, K>=1 - SelfMatch - whether self-matches are allowed: - * if True, nearest neighbor may be the point itself - (if it exists in original dataset) - * if False, then only points with non-zero distance - are returned - * if not given, considered True - Eps - approximation factor, Eps>=0. eps-approximate nearest - neighbor is a neighbor whose distance from X is at - most (1+eps) times distance of true nearest neighbor. - -RESULT - number of actual neighbors found (either K or N, if K>N). - -NOTES - significant performance gain may be achieved only when Eps is is on - the order of magnitude of 1 or larger. - -This subroutine performs query and stores its result in the internal -structures of the KD-tree. You can use following subroutines to obtain -these results: -* KDTreeQueryResultsX() to get X-values -* KDTreeQueryResultsXY() to get X- and Y-values -* KDTreeQueryResultsTags() to get tag values -* KDTreeQueryResultsDistances() to get distances - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -ae_int_t kdtreequeryaknn(const kdtree &kdt, const real_1d_array &x, const ae_int_t k, const bool selfmatch, const double eps); -ae_int_t kdtreequeryaknn(const kdtree &kdt, const real_1d_array &x, const ae_int_t k, const double eps); - - -/************************************************************************* -X-values from last query - -INPUT PARAMETERS - KDT - KD-tree - X - possibly pre-allocated buffer. If X is too small to store - result, it is resized. If size(X) is enough to store - result, it is left unchanged. - -OUTPUT PARAMETERS - X - rows are filled with X-values - -NOTES -1. points are ordered by distance from the query point (first = closest) -2. if XY is larger than required to store result, only leading part will - be overwritten; trailing part will be left unchanged. So if on input - XY = [[A,B],[C,D]], and result is [1,2], then on exit we will get - XY = [[1,2],[C,D]]. This is done purposely to increase performance; if - you want function to resize array according to result size, use - function with same name and suffix 'I'. - -SEE ALSO -* KDTreeQueryResultsXY() X- and Y-values -* KDTreeQueryResultsTags() tag values -* KDTreeQueryResultsDistances() distances - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreequeryresultsx(const kdtree &kdt, real_2d_array &x); - - -/************************************************************************* -X- and Y-values from last query - -INPUT PARAMETERS - KDT - KD-tree - XY - possibly pre-allocated buffer. If XY is too small to store - result, it is resized. If size(XY) is enough to store - result, it is left unchanged. - -OUTPUT PARAMETERS - XY - rows are filled with points: first NX columns with - X-values, next NY columns - with Y-values. - -NOTES -1. points are ordered by distance from the query point (first = closest) -2. if XY is larger than required to store result, only leading part will - be overwritten; trailing part will be left unchanged. So if on input - XY = [[A,B],[C,D]], and result is [1,2], then on exit we will get - XY = [[1,2],[C,D]]. This is done purposely to increase performance; if - you want function to resize array according to result size, use - function with same name and suffix 'I'. - -SEE ALSO -* KDTreeQueryResultsX() X-values -* KDTreeQueryResultsTags() tag values -* KDTreeQueryResultsDistances() distances - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreequeryresultsxy(const kdtree &kdt, real_2d_array &xy); - - -/************************************************************************* -Tags from last query - -INPUT PARAMETERS - KDT - KD-tree - Tags - possibly pre-allocated buffer. If X is too small to store - result, it is resized. If size(X) is enough to store - result, it is left unchanged. - -OUTPUT PARAMETERS - Tags - filled with tags associated with points, - or, when no tags were supplied, with zeros - -NOTES -1. points are ordered by distance from the query point (first = closest) -2. if XY is larger than required to store result, only leading part will - be overwritten; trailing part will be left unchanged. So if on input - XY = [[A,B],[C,D]], and result is [1,2], then on exit we will get - XY = [[1,2],[C,D]]. This is done purposely to increase performance; if - you want function to resize array according to result size, use - function with same name and suffix 'I'. - -SEE ALSO -* KDTreeQueryResultsX() X-values -* KDTreeQueryResultsXY() X- and Y-values -* KDTreeQueryResultsDistances() distances - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreequeryresultstags(const kdtree &kdt, integer_1d_array &tags); - - -/************************************************************************* -Distances from last query - -INPUT PARAMETERS - KDT - KD-tree - R - possibly pre-allocated buffer. If X is too small to store - result, it is resized. If size(X) is enough to store - result, it is left unchanged. - -OUTPUT PARAMETERS - R - filled with distances (in corresponding norm) - -NOTES -1. points are ordered by distance from the query point (first = closest) -2. if XY is larger than required to store result, only leading part will - be overwritten; trailing part will be left unchanged. So if on input - XY = [[A,B],[C,D]], and result is [1,2], then on exit we will get - XY = [[1,2],[C,D]]. This is done purposely to increase performance; if - you want function to resize array according to result size, use - function with same name and suffix 'I'. - -SEE ALSO -* KDTreeQueryResultsX() X-values -* KDTreeQueryResultsXY() X- and Y-values -* KDTreeQueryResultsTags() tag values - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreequeryresultsdistances(const kdtree &kdt, real_1d_array &r); - - -/************************************************************************* -X-values from last query; 'interactive' variant for languages like Python -which support constructs like "X = KDTreeQueryResultsXI(KDT)" and -interactive mode of interpreter. - -This function allocates new array on each call, so it is significantly -slower than its 'non-interactive' counterpart, but it is more convenient -when you call it from command line. - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreequeryresultsxi(const kdtree &kdt, real_2d_array &x); - - -/************************************************************************* -XY-values from last query; 'interactive' variant for languages like Python -which support constructs like "XY = KDTreeQueryResultsXYI(KDT)" and -interactive mode of interpreter. - -This function allocates new array on each call, so it is significantly -slower than its 'non-interactive' counterpart, but it is more convenient -when you call it from command line. - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreequeryresultsxyi(const kdtree &kdt, real_2d_array &xy); - - -/************************************************************************* -Tags from last query; 'interactive' variant for languages like Python -which support constructs like "Tags = KDTreeQueryResultsTagsI(KDT)" and -interactive mode of interpreter. - -This function allocates new array on each call, so it is significantly -slower than its 'non-interactive' counterpart, but it is more convenient -when you call it from command line. - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreequeryresultstagsi(const kdtree &kdt, integer_1d_array &tags); - - -/************************************************************************* -Distances from last query; 'interactive' variant for languages like Python -which support constructs like "R = KDTreeQueryResultsDistancesI(KDT)" -and interactive mode of interpreter. - -This function allocates new array on each call, so it is significantly -slower than its 'non-interactive' counterpart, but it is more convenient -when you call it from command line. - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void kdtreequeryresultsdistancesi(const kdtree &kdt, real_1d_array &r); -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (FUNCTIONS) -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ -void hqrndrandomize(hqrndstate* state, ae_state *_state); -void hqrndseed(ae_int_t s1, - ae_int_t s2, - hqrndstate* state, - ae_state *_state); -double hqrnduniformr(hqrndstate* state, ae_state *_state); -ae_int_t hqrnduniformi(hqrndstate* state, ae_int_t n, ae_state *_state); -double hqrndnormal(hqrndstate* state, ae_state *_state); -void hqrndunit2(hqrndstate* state, double* x, double* y, ae_state *_state); -void hqrndnormal2(hqrndstate* state, - double* x1, - double* x2, - ae_state *_state); -double hqrndexponential(hqrndstate* state, - double lambdav, - ae_state *_state); -double hqrnddiscrete(hqrndstate* state, - /* Real */ ae_vector* x, - ae_int_t n, - ae_state *_state); -double hqrndcontinuous(hqrndstate* state, - /* Real */ ae_vector* x, - ae_int_t n, - ae_state *_state); -ae_bool _hqrndstate_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _hqrndstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _hqrndstate_clear(void* _p); -void _hqrndstate_destroy(void* _p); -void kdtreebuild(/* Real */ ae_matrix* xy, - ae_int_t n, - ae_int_t nx, - ae_int_t ny, - ae_int_t normtype, - kdtree* kdt, - ae_state *_state); -void kdtreebuildtagged(/* Real */ ae_matrix* xy, - /* Integer */ ae_vector* tags, - ae_int_t n, - ae_int_t nx, - ae_int_t ny, - ae_int_t normtype, - kdtree* kdt, - ae_state *_state); -ae_int_t kdtreequeryknn(kdtree* kdt, - /* Real */ ae_vector* x, - ae_int_t k, - ae_bool selfmatch, - ae_state *_state); -ae_int_t kdtreequeryrnn(kdtree* kdt, - /* Real */ ae_vector* x, - double r, - ae_bool selfmatch, - ae_state *_state); -ae_int_t kdtreequeryaknn(kdtree* kdt, - /* Real */ ae_vector* x, - ae_int_t k, - ae_bool selfmatch, - double eps, - ae_state *_state); -void kdtreequeryresultsx(kdtree* kdt, - /* Real */ ae_matrix* x, - ae_state *_state); -void kdtreequeryresultsxy(kdtree* kdt, - /* Real */ ae_matrix* xy, - ae_state *_state); -void kdtreequeryresultstags(kdtree* kdt, - /* Integer */ ae_vector* tags, - ae_state *_state); -void kdtreequeryresultsdistances(kdtree* kdt, - /* Real */ ae_vector* r, - ae_state *_state); -void kdtreequeryresultsxi(kdtree* kdt, - /* Real */ ae_matrix* x, - ae_state *_state); -void kdtreequeryresultsxyi(kdtree* kdt, - /* Real */ ae_matrix* xy, - ae_state *_state); -void kdtreequeryresultstagsi(kdtree* kdt, - /* Integer */ ae_vector* tags, - ae_state *_state); -void kdtreequeryresultsdistancesi(kdtree* kdt, - /* Real */ ae_vector* r, - ae_state *_state); -void kdtreealloc(ae_serializer* s, kdtree* tree, ae_state *_state); -void kdtreeserialize(ae_serializer* s, kdtree* tree, ae_state *_state); -void kdtreeunserialize(ae_serializer* s, kdtree* tree, ae_state *_state); -ae_bool _kdtree_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _kdtree_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _kdtree_clear(void* _p); -void _kdtree_destroy(void* _p); - -} -#endif - diff --git a/src/core/alglib/ap.cpp b/src/core/alglib/ap.cpp deleted file mode 100644 index 54102f4..0000000 --- a/src/core/alglib/ap.cpp +++ /dev/null @@ -1,10661 +0,0 @@ -/************************************************************************* -Copyright (c) Sergey Bochkanov (ALGLIB project). - ->>> SOURCE LICENSE >>> -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation (www.fsf.org); either version 2 of the -License, or (at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -A copy of the GNU General Public License is available at -http://www.fsf.org/licensing/licenses ->>> END OF LICENSE >>> -*************************************************************************/ -#include "stdafx.h" -#include "ap.h" -#include -#include -using namespace std; - -#if defined(AE_CPU) -#if (AE_CPU==AE_INTEL) - -#if AE_COMPILER==AE_MSVC -#include -#endif - -#endif -#endif - -// disable some irrelevant warnings -#if (AE_COMPILER==AE_MSVC) -#pragma warning(disable:4100) -#pragma warning(disable:4127) -#pragma warning(disable:4702) -#pragma warning(disable:4996) -#endif - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION IMPLEMENTS BASIC FUNCTIONALITY LIKE -// MEMORY MANAGEMENT FOR VECTORS/MATRICES WHICH IS -// SHARED BETWEEN C++ AND PURE C LIBRARIES -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ -/* - * local definitions - */ -#define x_nb 16 -#define AE_DATA_ALIGN 16 -#define AE_PTR_ALIGN sizeof(void*) -#define DYN_BOTTOM ((void*)1) -#define DYN_FRAME ((void*)2) -#define AE_LITTLE_ENDIAN 1 -#define AE_BIG_ENDIAN 2 -#define AE_MIXED_ENDIAN 3 -#define AE_SER_ENTRY_LENGTH 11 -#define AE_SER_ENTRIES_PER_ROW 5 - -#define AE_SM_DEFAULT 0 -#define AE_SM_ALLOC 1 -#define AE_SM_READY2S 2 -#define AE_SM_TO_STRING 10 -#define AE_SM_FROM_STRING 20 -#define AE_SM_TO_CPPSTRING 11 - -#define AE_LOCK_CYCLES 512 -#define AE_LOCK_TESTS_BEFORE_YIELD 16 -#define AE_CRITICAL_ASSERT(x) if( !(x) ) abort() - - -/* - * alloc counter (if used) - */ -#ifdef AE_USE_ALLOC_COUNTER -ae_int64_t _alloc_counter = 0; -#endif -#ifdef AE_DEBUGRNG -static ae_int_t _debug_rng_s0 = 11; -static ae_int_t _debug_rng_s1 = 13; -#endif -#ifdef AE_SMP_DEBUGCOUNTERS -__declspec(align(AE_LOCK_ALIGNMENT)) volatile ae_int64_t _ae_dbg_lock_acquisitions = 0; -__declspec(align(AE_LOCK_ALIGNMENT)) volatile ae_int64_t _ae_dbg_lock_spinwaits = 0; -__declspec(align(AE_LOCK_ALIGNMENT)) volatile ae_int64_t _ae_dbg_lock_yields = 0; -#endif - -/* - * These declarations are used to ensure that - * sizeof(ae_int32_t)==4, sizeof(ae_int64_t)==8, sizeof(ae_int_t)==sizeof(void*). - * they will lead to syntax error otherwise (array size will be negative). - * - * you can remove them, if you want - they are not used anywhere. - * - */ -static char _ae_int32_t_must_be_32_bits_wide[1-2*((int)(sizeof(ae_int32_t))-4)*((int)(sizeof(ae_int32_t))-4)]; -static char _ae_int64_t_must_be_64_bits_wide[1-2*((int)(sizeof(ae_int64_t))-8)*((int)(sizeof(ae_int64_t))-8)]; -static char _ae_int_t_must_be_pointer_sized [1-2*((int)(sizeof(ae_int_t))-(int)sizeof(void*))*((int)(sizeof(ae_int_t))-(int)(sizeof(void*)))]; - -/* - * This variable is used to prevent some tricky optimizations which may degrade multithreaded performance. - * It is touched once in the ae_init_pool() function from smp.c in order to prevent optimizations. - * - */ -static volatile ae_int_t ae_never_change_it = 1; - -ae_int_t ae_misalignment(const void *ptr, size_t alignment) -{ - union _u - { - const void *ptr; - ae_int_t iptr; - } u; - u.ptr = ptr; - return (ae_int_t)(u.iptr%alignment); -} - -void* ae_align(void *ptr, size_t alignment) -{ - char *result = (char*)ptr; - if( (result-(char*)0)%alignment!=0 ) - result += alignment - (result-(char*)0)%alignment; - return result; -} - -void ae_break(ae_state *state, ae_error_type error_type, const char *msg) -{ -#ifndef AE_USE_CPP_ERROR_HANDLING - if( state!=NULL ) - { - if( state->thread_exception_handler!=NULL ) - state->thread_exception_handler(state); - ae_state_clear(state); - state->last_error = error_type; - state->error_msg = msg; - if( state->break_jump!=NULL ) - longjmp(*(state->break_jump), 1); - else - abort(); - } - else - abort(); -#else - if( state!=NULL ) - { - if( state->thread_exception_handler!=NULL ) - state->thread_exception_handler(state); - ae_state_clear(state); - state->last_error = error_type; - state->error_msg = msg; - } - throw error_type; -#endif -} - -void* aligned_malloc(size_t size, size_t alignment) -{ - if( size==0 ) - return NULL; - if( alignment<=1 ) - { - /* no alignment, just call malloc */ - void *block; - void **p; ; - block = malloc(sizeof(void*)+size); - if( block==NULL ) - return NULL; - p = (void**)block; - *p = block; -#ifdef AE_USE_ALLOC_COUNTER - _alloc_counter++; -#endif - return (void*)((char*)block+sizeof(void*)); - } - else - { - /* align */ - void *block; - char *result; - block = malloc(alignment-1+sizeof(void*)+size); - if( block==NULL ) - return NULL; - result = (char*)block+sizeof(void*); - /*if( (result-(char*)0)%alignment!=0 ) - result += alignment - (result-(char*)0)%alignment;*/ - result = (char*)ae_align(result, alignment); - *((void**)(result-sizeof(void*))) = block; -#ifdef AE_USE_ALLOC_COUNTER - _alloc_counter++; -#endif - return result; - } -} - -void aligned_free(void *block) -{ - void *p; - if( block==NULL ) - return; - p = *((void**)((char*)block-sizeof(void*))); - free(p); -#ifdef AE_USE_ALLOC_COUNTER - _alloc_counter--; -#endif -} - -/************************************************************************ -Malloc's memory with automatic alignment. - -Returns NULL when zero size is specified. - -Error handling: -* if state is NULL, returns NULL on allocation error -* if state is not NULL, calls ae_break() on allocation error -************************************************************************/ -void* ae_malloc(size_t size, ae_state *state) -{ - void *result; - if( size==0 ) - return NULL; - result = aligned_malloc(size,AE_DATA_ALIGN); - if( result==NULL && state!=NULL) - { - char buf[256]; - sprintf(buf, "ae_malloc(): out of memory (attempted to allocate %llu bytes)", (unsigned long long)size); - ae_break(state, ERR_OUT_OF_MEMORY, buf); - } - return result; -} - -void ae_free(void *p) -{ - if( p!=NULL ) - aligned_free(p); -} - -/************************************************************************ -Sets pointers to the matrix rows. - -* dst must be correctly initialized matrix -* dst->data.ptr points to the beginning of memory block allocated for - row pointers. -* dst->ptr - undefined (initialized during algorithm processing) -* storage parameter points to the beginning of actual storage -************************************************************************/ -void ae_matrix_update_row_pointers(ae_matrix *dst, void *storage) -{ - char *p_base; - void **pp_ptr; - ae_int_t i; - if( dst->rows>0 && dst->cols>0 ) - { - p_base = (char*)storage; - pp_ptr = (void**)dst->data.ptr; - dst->ptr.pp_void = pp_ptr; - for(i=0; irows; i++, p_base+=dst->stride*ae_sizeof(dst->datatype)) - pp_ptr[i] = p_base; - } - else - dst->ptr.pp_void = NULL; -} - -/************************************************************************ -Returns size of datatype. -Zero for dynamic types like strings or multiple precision types. -************************************************************************/ -ae_int_t ae_sizeof(ae_datatype datatype) -{ - switch(datatype) - { - case DT_BOOL: return (ae_int_t)sizeof(ae_bool); - case DT_INT: return (ae_int_t)sizeof(ae_int_t); - case DT_REAL: return (ae_int_t)sizeof(double); - case DT_COMPLEX: return 2*(ae_int_t)sizeof(double); - default: return 0; - } -} - - -/************************************************************************ -This dummy function is used to prevent compiler messages about unused -locals in automatically generated code. - -It makes nothing - just accepts pointer, "touches" it - and that is all. -It performs several tricky operations without side effects which confuse -compiler so it does not compain about unused locals in THIS function. -************************************************************************/ -void ae_touch_ptr(void *p) -{ - void * volatile fake_variable0 = p; - void * volatile fake_variable1 = fake_variable0; - fake_variable0 = fake_variable1; -} - -/************************************************************************ -This function initializes ALGLIB environment state. - -NOTES: -* stacks contain no frames, so ae_make_frame() must be called before - attaching dynamic blocks. Without it ae_leave_frame() will cycle - forever (which is intended behavior). -************************************************************************/ -void ae_state_init(ae_state *state) -{ - ae_int32_t *vp; - - /* - * p_next points to itself because: - * * correct program should be able to detect end of the list - * by looking at the ptr field. - * * NULL p_next may be used to distinguish automatic blocks - * (in the list) from non-automatic (not in the list) - */ - state->last_block.p_next = &(state->last_block); - state->last_block.deallocator = NULL; - state->last_block.ptr = DYN_BOTTOM; - state->p_top_block = &(state->last_block); -#ifndef AE_USE_CPP_ERROR_HANDLING - state->break_jump = NULL; -#endif - state->error_msg = ""; - - /* - * determine endianness and initialize precomputed IEEE special quantities. - */ - state->endianness = ae_get_endianness(); - if( state->endianness==AE_LITTLE_ENDIAN ) - { - vp = (ae_int32_t*)(&state->v_nan); - vp[0] = 0; - vp[1] = (ae_int32_t)0x7FF80000; - vp = (ae_int32_t*)(&state->v_posinf); - vp[0] = 0; - vp[1] = (ae_int32_t)0x7FF00000; - vp = (ae_int32_t*)(&state->v_neginf); - vp[0] = 0; - vp[1] = (ae_int32_t)0xFFF00000; - } - else if( state->endianness==AE_BIG_ENDIAN ) - { - vp = (ae_int32_t*)(&state->v_nan); - vp[1] = 0; - vp[0] = (ae_int32_t)0x7FF80000; - vp = (ae_int32_t*)(&state->v_posinf); - vp[1] = 0; - vp[0] = (ae_int32_t)0x7FF00000; - vp = (ae_int32_t*)(&state->v_neginf); - vp[1] = 0; - vp[0] = (ae_int32_t)0xFFF00000; - } - else - abort(); - - /* - * set threading information - */ - state->worker_thread = NULL; - state->parent_task = NULL; - state->thread_exception_handler = NULL; -} - - -/************************************************************************ -This function clears ALGLIB environment state. -All dynamic data controlled by state are freed. -************************************************************************/ -void ae_state_clear(ae_state *state) -{ - while( state->p_top_block->ptr!=DYN_BOTTOM ) - ae_frame_leave(state); -} - - -#ifndef AE_USE_CPP_ERROR_HANDLING -/************************************************************************ -This function sets jump buffer for error handling. - -buf may be NULL. -************************************************************************/ -void ae_state_set_break_jump(ae_state *state, jmp_buf *buf) -{ - state->break_jump = buf; -} -#endif - - -/************************************************************************ -This function makes new stack frame. - -This function takes two parameters: environment state and pointer to the -dynamic block which will be used as indicator of the frame beginning. -This dynamic block must be initialized by caller and mustn't be changed/ -deallocated/reused till ae_leave_frame called. It may be global or local -variable (local is even better). -************************************************************************/ -void ae_frame_make(ae_state *state, ae_frame *tmp) -{ - tmp->db_marker.p_next = state->p_top_block; - tmp->db_marker.deallocator = NULL; - tmp->db_marker.ptr = DYN_FRAME; - state->p_top_block = &tmp->db_marker; -} - - -/************************************************************************ -This function leaves current stack frame and deallocates all automatic -dynamic blocks which were attached to this frame. -************************************************************************/ -void ae_frame_leave(ae_state *state) -{ - while( state->p_top_block->ptr!=DYN_FRAME && state->p_top_block->ptr!=DYN_BOTTOM) - { - if( state->p_top_block->ptr!=NULL && state->p_top_block->deallocator!=NULL) - ((ae_deallocator)(state->p_top_block->deallocator))(state->p_top_block->ptr); - state->p_top_block = state->p_top_block->p_next; - } - state->p_top_block = state->p_top_block->p_next; -} - - -/************************************************************************ -This function attaches block to the dynamic block list - -block block -state ALGLIB environment state - -NOTES: -* never call it for special blocks which marks frame boundaries! -************************************************************************/ -void ae_db_attach(ae_dyn_block *block, ae_state *state) -{ - block->p_next = state->p_top_block; - state->p_top_block = block; -} - - -/************************************************************************ -This function malloc's dynamic block: - -block destination block, assumed to be uninitialized -size size (in bytes) -state ALGLIB environment state. May be NULL. -make_automatic if true, vector is added to the dynamic block list - -block is assumed to be uninitialized, its fields are ignored. - -Error handling: -* if state is NULL, returns ae_false on allocation error -* if state is not NULL, calls ae_break() on allocation error -* returns ae_true on success - -NOTES: -* never call it for blocks which are already in the list -************************************************************************/ -ae_bool ae_db_malloc(ae_dyn_block *block, ae_int_t size, ae_state *state, ae_bool make_automatic) -{ - /* ensure that size is >=0 - two ways to exit: 1) through ae_assert, if we have non-NULL state, 2) by returning ae_false */ - if( state!=NULL ) - ae_assert(size>=0, "ae_db_malloc(): negative size", state); - if( size<0 ) - return ae_false; - - /* alloc */ - block->ptr = ae_malloc((size_t)size, state); - if( block->ptr==NULL && size!=0 ) - return ae_false; - if( make_automatic && state!=NULL ) - ae_db_attach(block, state); - else - block->p_next = NULL; - block->deallocator = ae_free; - return ae_true; -} - - -/************************************************************************ -This function realloc's dynamic block: - -block destination block (initialized) -size new size (in bytes) -state ALGLIB environment state - -block is assumed to be initialized. - -This function: -* deletes old contents -* preserves automatic state - -Error handling: -* if state is NULL, returns ae_false on allocation error -* if state is not NULL, calls ae_break() on allocation error -* returns ae_true on success - -NOTES: -* never call it for special blocks which mark frame boundaries! -************************************************************************/ -ae_bool ae_db_realloc(ae_dyn_block *block, ae_int_t size, ae_state *state) -{ - /* ensure that size is >=0 - two ways to exit: 1) through ae_assert, if we have non-NULL state, 2) by returning ae_false */ - if( state!=NULL ) - ae_assert(size>=0, "ae_db_realloc(): negative size", state); - if( size<0 ) - return ae_false; - - /* realloc */ - if( block->ptr!=NULL ) - ((ae_deallocator)block->deallocator)(block->ptr); - block->ptr = ae_malloc((size_t)size, state); - if( block->ptr==NULL && size!=0 ) - return ae_false; - block->deallocator = ae_free; - return ae_true; -} - - -/************************************************************************ -This function clears dynamic block (releases all dynamically allocated -memory). Dynamic block may be in automatic management list - in this case -it will NOT be removed from list. - -block destination block (initialized) - -NOTES: -* never call it for special blocks which marks frame boundaries! -************************************************************************/ -void ae_db_free(ae_dyn_block *block) -{ - if( block->ptr!=NULL ) - ((ae_deallocator)block->deallocator)(block->ptr); - block->ptr = NULL; - block->deallocator = ae_free; -} - -/************************************************************************ -This function swaps contents of two dynamic blocks (pointers and -deallocators) leaving other parameters (automatic management settings, -etc.) unchanged. - -NOTES: -* never call it for special blocks which marks frame boundaries! -************************************************************************/ -void ae_db_swap(ae_dyn_block *block1, ae_dyn_block *block2) -{ - void (*deallocator)(void*) = NULL; - void * volatile ptr; - ptr = block1->ptr; - deallocator = block1->deallocator; - block1->ptr = block2->ptr; - block1->deallocator = block2->deallocator; - block2->ptr = ptr; - block2->deallocator = deallocator; -} - -/************************************************************************ -This function creates ae_vector. - -Vector size may be zero. Vector contents is uninitialized. - -dst destination vector -size vector size, may be zero -datatype guess what... -state ALGLIB environment state -make_automatic if true, vector is added to the dynamic block list - -Error handling: -* if state is NULL, returns ae_false on allocation error -* if state is not NULL, calls ae_break() on allocation error -* returns ae_true on success - -dst is assumed to be uninitialized, its fields are ignored. -************************************************************************/ -ae_bool ae_vector_init(ae_vector *dst, ae_int_t size, ae_datatype datatype, ae_state *state, ae_bool make_automatic) -{ - /* ensure that size is >=0 - two ways to exit: 1) through ae_assert, if we have non-NULL state, 2) by returning ae_false */ - if( state!=NULL ) - ae_assert(size>=0, "ae_vector_init(): negative size", state); - if( size<0 ) - return ae_false; - - /* init */ - dst->cnt = size; - dst->datatype = datatype; - if( !ae_db_malloc(&dst->data, size*ae_sizeof(datatype), state, make_automatic) ) - return ae_false; - dst->ptr.p_ptr = dst->data.ptr; - return ae_true; -} - - -/************************************************************************ -This function creates copy of ae_vector. - -dst destination vector -src well, it is source -state ALGLIB environment state -make_automatic if true, vector is added to the dynamic block list - -Error handling: -* if state is NULL, returns ae_false on allocation error -* if state is not NULL, calls ae_break() on allocation error -* returns ae_true on success - -dst is assumed to be uninitialized, its fields are ignored. -************************************************************************/ -ae_bool ae_vector_init_copy(ae_vector *dst, ae_vector *src, ae_state *state, ae_bool make_automatic) -{ - if( !ae_vector_init(dst, src->cnt, src->datatype, state, make_automatic) ) - return ae_false; - if( src->cnt!=0 ) - memcpy(dst->ptr.p_ptr, src->ptr.p_ptr, (size_t)(src->cnt*ae_sizeof(src->datatype))); - return ae_true; -} - -/************************************************************************ -This function creates ae_vector from x_vector: - -dst destination vector -src source, vector in x-format -state ALGLIB environment state -make_automatic if true, vector is added to the dynamic block list - -dst is assumed to be uninitialized, its fields are ignored. -************************************************************************/ -void ae_vector_init_from_x(ae_vector *dst, x_vector *src, ae_state *state, ae_bool make_automatic) -{ - ae_vector_init(dst, (ae_int_t)src->cnt, (ae_datatype)src->datatype, state, make_automatic); - if( src->cnt>0 ) - memcpy(dst->ptr.p_ptr, src->ptr, (size_t)(((ae_int_t)src->cnt)*ae_sizeof((ae_datatype)src->datatype))); -} - - -/************************************************************************ -This function changes length of ae_vector. - -dst destination vector -newsize vector size, may be zero -state ALGLIB environment state - -Error handling: -* if state is NULL, returns ae_false on allocation error -* if state is not NULL, calls ae_break() on allocation error -* returns ae_true on success - -NOTES: -* vector must be initialized -* all contents is destroyed during setlength() call -* new size may be zero. -************************************************************************/ -ae_bool ae_vector_set_length(ae_vector *dst, ae_int_t newsize, ae_state *state) -{ - /* ensure that size is >=0 - two ways to exit: 1) through ae_assert, if we have non-NULL state, 2) by returning ae_false */ - if( state!=NULL ) - ae_assert(newsize>=0, "ae_vector_set_length(): negative size", state); - if( newsize<0 ) - return ae_false; - - /* set length */ - if( dst->cnt==newsize ) - return ae_true; - dst->cnt = newsize; - if( !ae_db_realloc(&dst->data, newsize*ae_sizeof(dst->datatype), state) ) - return ae_false; - dst->ptr.p_ptr = dst->data.ptr; - return ae_true; -} - - -/************************************************************************ -This function provides "CLEAR" functionality for vector (contents is -cleared, but structure still left in valid state). - -The function clears vector contents (releases all dynamically allocated -memory). Vector may be in automatic management list - in this case it -will NOT be removed from list. - -IMPORTANT: this function does NOT invalidates dst; it just releases all -dynamically allocated storage, but dst still may be used after call to -ae_vector_set_length(). - -dst destination vector -************************************************************************/ -void ae_vector_clear(ae_vector *dst) -{ - dst->cnt = 0; - ae_db_free(&dst->data); - dst->ptr.p_ptr = 0; -} - - -/************************************************************************ -This function provides "DESTROY" functionality for vector (contents is -cleared, all internal structures are destroyed). For vectors it is same -as CLEAR. - -dst destination vector -************************************************************************/ -void ae_vector_destroy(ae_vector *dst) -{ - ae_vector_clear(dst); -} - - -/************************************************************************ -This function efficiently swaps contents of two vectors, leaving other -pararemeters (automatic management, etc.) unchanged. -************************************************************************/ -void ae_swap_vectors(ae_vector *vec1, ae_vector *vec2) -{ - ae_int_t cnt; - ae_datatype datatype; - void *p_ptr; - - ae_db_swap(&vec1->data, &vec2->data); - - cnt = vec1->cnt; - datatype = vec1->datatype; - p_ptr = vec1->ptr.p_ptr; - vec1->cnt = vec2->cnt; - vec1->datatype = vec2->datatype; - vec1->ptr.p_ptr = vec2->ptr.p_ptr; - vec2->cnt = cnt; - vec2->datatype = datatype; - vec2->ptr.p_ptr = p_ptr; -} - -/************************************************************************ -This function creates ae_matrix. - -Matrix size may be zero, in such cases both rows and cols are zero. -Matrix contents is uninitialized. - -dst destination natrix -rows rows count -cols cols count -datatype element type -state ALGLIB environment state -make_automatic if true, matrix is added to the dynamic block list - -Error handling: -* if state is NULL, returns ae_false on allocation error -* if state is not NULL, calls ae_break() on allocation error -* returns ae_true on success - -dst is assumed to be uninitialized, its fields are ignored. -************************************************************************/ -ae_bool ae_matrix_init(ae_matrix *dst, ae_int_t rows, ae_int_t cols, ae_datatype datatype, ae_state *state, ae_bool make_automatic) -{ - /* ensure that size is >=0 - two ways to exit: 1) through ae_assert, if we have non-NULL state, 2) by returning ae_false */ - if( state!=NULL ) - ae_assert(rows>=0 && cols>=0, "ae_matrix_init(): negative length", state); - if( rows<0 || cols<0 ) - return ae_false; - - /* if one of rows/cols is zero, another MUST be too */ - if( rows==0 || cols==0 ) - { - rows = 0; - cols = 0; - } - - /* init */ - dst->rows = rows; - dst->cols = cols; - dst->stride = cols; - while( dst->stride*ae_sizeof(datatype)%AE_DATA_ALIGN!=0 ) - dst->stride++; - dst->datatype = datatype; - if( !ae_db_malloc(&dst->data, dst->rows*((ae_int_t)sizeof(void*)+dst->stride*ae_sizeof(datatype))+AE_DATA_ALIGN-1, state, make_automatic) ) - return ae_false; - ae_matrix_update_row_pointers(dst, ae_align((char*)dst->data.ptr+dst->rows*sizeof(void*),AE_DATA_ALIGN)); - return ae_true; -} - - -/************************************************************************ -This function creates copy of ae_matrix. - -dst destination matrix -src well, it is source -state ALGLIB environment state -make_automatic if true, matrix is added to the dynamic block list - -Error handling: -* if state is NULL, returns ae_false on allocation error -* if state is not NULL, calls ae_break() on allocation error -* returns ae_true on success - -dst is assumed to be uninitialized, its fields are ignored. -************************************************************************/ -ae_bool ae_matrix_init_copy(ae_matrix *dst, ae_matrix *src, ae_state *state, ae_bool make_automatic) -{ - ae_int_t i; - if( !ae_matrix_init(dst, src->rows, src->cols, src->datatype, state, make_automatic) ) - return ae_false; - if( src->rows!=0 && src->cols!=0 ) - { - if( dst->stride==src->stride ) - memcpy(dst->ptr.pp_void[0], src->ptr.pp_void[0], (size_t)(src->rows*src->stride*ae_sizeof(src->datatype))); - else - for(i=0; irows; i++) - memcpy(dst->ptr.pp_void[i], src->ptr.pp_void[i], (size_t)(dst->cols*ae_sizeof(dst->datatype))); - } - return ae_true; -} - - -void ae_matrix_init_from_x(ae_matrix *dst, x_matrix *src, ae_state *state, ae_bool make_automatic) -{ - char *p_src_row; - char *p_dst_row; - ae_int_t row_size; - ae_int_t i; - ae_matrix_init(dst, (ae_int_t)src->rows, (ae_int_t)src->cols, (ae_datatype)src->datatype, state, make_automatic); - if( src->rows!=0 && src->cols!=0 ) - { - p_src_row = (char*)src->ptr; - p_dst_row = (char*)(dst->ptr.pp_void[0]); - row_size = ae_sizeof((ae_datatype)src->datatype)*(ae_int_t)src->cols; - for(i=0; irows; i++, p_src_row+=src->stride*ae_sizeof((ae_datatype)src->datatype), p_dst_row+=dst->stride*ae_sizeof((ae_datatype)src->datatype)) - memcpy(p_dst_row, p_src_row, (size_t)(row_size)); - } -} - - -/************************************************************************ -This function changes length of ae_matrix. - -dst destination matrix -rows size, may be zero -cols size, may be zero -state ALGLIB environment state - -Error handling: -* if state is NULL, returns ae_false on allocation error -* if state is not NULL, calls ae_break() on allocation error -* returns ae_true on success - -NOTES: -* matrix must be initialized -* all contents is destroyed during setlength() call -* new size may be zero. -************************************************************************/ -ae_bool ae_matrix_set_length(ae_matrix *dst, ae_int_t rows, ae_int_t cols, ae_state *state) -{ - /* ensure that size is >=0 - two ways to exit: 1) through ae_assert, if we have non-NULL state, 2) by returning ae_false */ - if( state!=NULL ) - ae_assert(rows>=0 && cols>=0, "ae_matrix_set_length(): negative length", state); - if( rows<0 || cols<0 ) - return ae_false; - - if( dst->rows==rows && dst->cols==cols ) - return ae_true; - dst->rows = rows; - dst->cols = cols; - dst->stride = cols; - while( dst->stride*ae_sizeof(dst->datatype)%AE_DATA_ALIGN!=0 ) - dst->stride++; - if( !ae_db_realloc(&dst->data, dst->rows*((ae_int_t)sizeof(void*)+dst->stride*ae_sizeof(dst->datatype))+AE_DATA_ALIGN-1, state) ) - return ae_false; - ae_matrix_update_row_pointers(dst, ae_align((char*)dst->data.ptr+dst->rows*sizeof(void*),AE_DATA_ALIGN)); - return ae_true; -} - - -/************************************************************************ -This function provides "CLEAR" functionality for vector (contents is -cleared, but structure still left in valid state). - -The function clears matrix contents (releases all dynamically allocated -memory). Matrix may be in automatic management list - in this case it -will NOT be removed from list. - -IMPORTANT: this function does NOT invalidates dst; it just releases all -dynamically allocated storage, but dst still may be used after call to -ae_matrix_set_length(). - -dst destination matrix -************************************************************************/ -void ae_matrix_clear(ae_matrix *dst) -{ - dst->rows = 0; - dst->cols = 0; - dst->stride = 0; - ae_db_free(&dst->data); - dst->ptr.p_ptr = 0; -} - - -/************************************************************************ -This function provides "DESTROY" functionality for matrix (contents is -cleared, but structure still left in valid state). - -For matrices it is same as CLEAR. - -dst destination matrix -************************************************************************/ -void ae_matrix_destroy(ae_matrix *dst) -{ - ae_matrix_clear(dst); -} - - -/************************************************************************ -This function efficiently swaps contents of two vectors, leaving other -pararemeters (automatic management, etc.) unchanged. -************************************************************************/ -void ae_swap_matrices(ae_matrix *mat1, ae_matrix *mat2) -{ - ae_int_t rows; - ae_int_t cols; - ae_int_t stride; - ae_datatype datatype; - void *p_ptr; - - ae_db_swap(&mat1->data, &mat2->data); - - rows = mat1->rows; - cols = mat1->cols; - stride = mat1->stride; - datatype = mat1->datatype; - p_ptr = mat1->ptr.p_ptr; - - mat1->rows = mat2->rows; - mat1->cols = mat2->cols; - mat1->stride = mat2->stride; - mat1->datatype = mat2->datatype; - mat1->ptr.p_ptr = mat2->ptr.p_ptr; - - mat2->rows = rows; - mat2->cols = cols; - mat2->stride = stride; - mat2->datatype = datatype; - mat2->ptr.p_ptr = p_ptr; -} - - -/************************************************************************ -This function creates smart pointer structure. - -dst destination smart pointer. - already allocated, but not initialized. -subscriber pointer to pointer which receives updates in the - internal object stored in ae_smart_ptr. Any update to - dst->ptr is translated to subscriber. Can be NULL. -state ALGLIB environment state -make_automatic if true, smart pointer is added to the dynamic block list - -After initialization, smart pointer stores NULL pointer. - -Error handling: -* if state is NULL, returns ae_false on allocation error -* if state is not NULL, calls ae_break() on allocation error -* returns ae_true on success -************************************************************************/ -ae_bool ae_smart_ptr_init(ae_smart_ptr *dst, void **subscriber, ae_state *state, ae_bool make_automatic) -{ - dst->subscriber = subscriber; - dst->ptr = NULL; - if( dst->subscriber!=NULL ) - *(dst->subscriber) = dst->ptr; - dst->is_owner = ae_false; - dst->is_dynamic = ae_false; - dst->frame_entry.deallocator = ae_smart_ptr_destroy; - dst->frame_entry.ptr = dst; - if( make_automatic && state!=NULL ) - ae_db_attach(&dst->frame_entry, state); - return ae_true; -} - - -/************************************************************************ -This function clears smart pointer structure. - -dst destination smart pointer. - -After call to this function smart pointer contains NULL reference, which -is propagated to its subscriber (in cases non-NULL subscruber was -specified during pointer creation). -************************************************************************/ -void ae_smart_ptr_clear(void *_dst) -{ - ae_smart_ptr *dst = (ae_smart_ptr*)_dst; - if( dst->is_owner && dst->ptr!=NULL ) - { - dst->destroy(dst->ptr); - if( dst->is_dynamic ) - ae_free(dst->ptr); - } - dst->is_owner = ae_false; - dst->is_dynamic = ae_false; - dst->ptr = NULL; - dst->destroy = NULL; - if( dst->subscriber!=NULL ) - *(dst->subscriber) = NULL; -} - - -/************************************************************************ -This function dstroys smart pointer structure (same as clearing it). - -dst destination smart pointer. -************************************************************************/ -void ae_smart_ptr_destroy(void *_dst) -{ - ae_smart_ptr_clear(_dst); -} - - -/************************************************************************ -This function assigns pointer to ae_smart_ptr structure. - -dst destination smart pointer. -new_ptr new pointer to assign -is_owner whether smart pointer owns new_ptr -is_dynamic whether object is dynamic - clearing such object - requires BOTH calling destructor function AND calling - ae_free() for memory occupied by object. -destroy destructor function - -In case smart pointer already contains non-NULL value and owns this value, -it is freed before assigning new pointer. - -Changes in pointer are propagated to its subscriber (in case non-NULL -subscriber was specified during pointer creation). - -You can specify NULL new_ptr, in which case is_owner/destroy are ignored. -************************************************************************/ -void ae_smart_ptr_assign(ae_smart_ptr *dst, void *new_ptr, ae_bool is_owner, ae_bool is_dynamic, void (*destroy)(void*)) -{ - if( dst->is_owner && dst->ptr!=NULL ) - dst->destroy(dst->ptr); - if( new_ptr!=NULL ) - { - dst->ptr = new_ptr; - dst->is_owner = is_owner; - dst->is_dynamic = is_dynamic; - dst->destroy = destroy; - } - else - { - dst->ptr = NULL; - dst->is_owner = ae_false; - dst->is_dynamic = ae_false; - dst->destroy = NULL; - } - if( dst->subscriber!=NULL ) - *(dst->subscriber) = dst->ptr; -} - - -/************************************************************************ -This function releases pointer owned by ae_smart_ptr structure: -* all internal fields are set to NULL -* destructor function for internal pointer is NOT called even when we own - this pointer. After this call ae_smart_ptr releases ownership of its - pointer and passes it to caller. -* changes in pointer are propagated to its subscriber (in case non-NULL - subscriber was specified during pointer creation). - -dst destination smart pointer. -************************************************************************/ -void ae_smart_ptr_release(ae_smart_ptr *dst) -{ - dst->is_owner = ae_false; - dst->is_dynamic = ae_false; - dst->ptr = NULL; - dst->destroy = NULL; - if( dst->subscriber!=NULL ) - *(dst->subscriber) = NULL; -} - -/************************************************************************ -This function fills x_vector by ae_vector's contents: - -dst destination vector -src source, vector in x-format -state ALGLIB environment state - -NOTES: -* dst is assumed to be initialized. Its contents is freed before copying - data from src (if size / type are different) or overwritten (if - possible given destination size). -************************************************************************/ -void ae_x_set_vector(x_vector *dst, ae_vector *src, ae_state *state) -{ - if( dst->cnt!=src->cnt || dst->datatype!=src->datatype ) - { - if( dst->owner==OWN_AE ) - ae_free(dst->ptr); - dst->ptr = ae_malloc((size_t)(src->cnt*ae_sizeof(src->datatype)), state); - dst->last_action = ACT_NEW_LOCATION; - dst->cnt = src->cnt; - dst->datatype = src->datatype; - dst->owner = OWN_AE; - } - else - dst->last_action = ACT_SAME_LOCATION; - if( src->cnt ) - memcpy(dst->ptr, src->ptr.p_ptr, (size_t)(src->cnt*ae_sizeof(src->datatype))); -} - -/************************************************************************ -This function fills x_matrix by ae_matrix's contents: - -dst destination vector -src source, matrix in x-format -state ALGLIB environment state - -NOTES: -* dst is assumed to be initialized. Its contents is freed before copying - data from src (if size / type are different) or overwritten (if - possible given destination size). -************************************************************************/ -void ae_x_set_matrix(x_matrix *dst, ae_matrix *src, ae_state *state) -{ - char *p_src_row; - char *p_dst_row; - ae_int_t i; - ae_int_t row_size; - if( dst->rows!=src->rows || dst->cols!=src->cols || dst->datatype!=src->datatype ) - { - if( dst->owner==OWN_AE ) - ae_free(dst->ptr); - dst->rows = src->rows; - dst->cols = src->cols; - dst->stride = src->cols; - dst->datatype = src->datatype; - dst->ptr = ae_malloc((size_t)(dst->rows*((ae_int_t)dst->stride)*ae_sizeof(src->datatype)), state); - dst->last_action = ACT_NEW_LOCATION; - dst->owner = OWN_AE; - } - else - dst->last_action = ACT_SAME_LOCATION; - if( src->rows!=0 && src->cols!=0 ) - { - p_src_row = (char*)(src->ptr.pp_void[0]); - p_dst_row = (char*)dst->ptr; - row_size = ae_sizeof(src->datatype)*src->cols; - for(i=0; irows; i++, p_src_row+=src->stride*ae_sizeof(src->datatype), p_dst_row+=dst->stride*ae_sizeof(src->datatype)) - memcpy(p_dst_row, p_src_row, (size_t)(row_size)); - } -} - -/************************************************************************ -This function attaches x_vector to ae_vector's contents. -Ownership of memory allocated is not changed (it is still managed by -ae_matrix). - -dst destination vector -src source, vector in x-format -state ALGLIB environment state - -NOTES: -* dst is assumed to be initialized. Its contents is freed before - attaching to src. -* this function doesn't need ae_state parameter because it can't fail - (assuming correctly initialized src) -************************************************************************/ -void ae_x_attach_to_vector(x_vector *dst, ae_vector *src) -{ - if( dst->owner==OWN_AE ) - ae_free(dst->ptr); - dst->ptr = src->ptr.p_ptr; - dst->last_action = ACT_NEW_LOCATION; - dst->cnt = src->cnt; - dst->datatype = src->datatype; - dst->owner = OWN_CALLER; -} - -/************************************************************************ -This function attaches x_matrix to ae_matrix's contents. -Ownership of memory allocated is not changed (it is still managed by -ae_matrix). - -dst destination vector -src source, matrix in x-format -state ALGLIB environment state - -NOTES: -* dst is assumed to be initialized. Its contents is freed before - attaching to src. -* this function doesn't need ae_state parameter because it can't fail - (assuming correctly initialized src) -************************************************************************/ -void ae_x_attach_to_matrix(x_matrix *dst, ae_matrix *src) -{ - if( dst->owner==OWN_AE ) - ae_free(dst->ptr); - dst->rows = src->rows; - dst->cols = src->cols; - dst->stride = src->stride; - dst->datatype = src->datatype; - dst->ptr = &(src->ptr.pp_double[0][0]); - dst->last_action = ACT_NEW_LOCATION; - dst->owner = OWN_CALLER; -} - -/************************************************************************ -This function clears x_vector. It does nothing if vector is not owned by -ALGLIB environment. - -dst vector -************************************************************************/ -void x_vector_clear(x_vector *dst) -{ - if( dst->owner==OWN_AE ) - aligned_free(dst->ptr); - dst->ptr = NULL; - dst->cnt = 0; -} - -/************************************************************************ -Assertion -************************************************************************/ -void ae_assert(ae_bool cond, const char *msg, ae_state *state) -{ - if( !cond ) - ae_break(state, ERR_ASSERTION_FAILED, msg); -} - -/************************************************************************ -CPUID - -Returns information about features CPU and compiler support. - -You must tell ALGLIB what CPU family is used by defining AE_CPU symbol -(without this hint zero will be returned). - -Note: results of this function depend on both CPU and compiler; -if compiler doesn't support SSE intrinsics, function won't set -corresponding flag. -************************************************************************/ -static volatile ae_bool _ae_cpuid_initialized = ae_false; -static volatile ae_bool _ae_cpuid_has_sse2 = ae_false; -ae_int_t ae_cpuid() -{ - /* - * to speed up CPU detection we cache results from previous attempts - * there is no synchronization, but it is still thread safe. - * - * thread safety is guaranteed on all modern architectures which - * have following property: simultaneous writes by different cores - * to the same location will be executed in serial manner. - * - */ - ae_int_t result; - - /* - * if not initialized, determine system properties - */ - if( !_ae_cpuid_initialized ) - { - /* - * SSE2 - */ -#if defined(AE_CPU) -#if (AE_CPU==AE_INTEL) && defined(AE_HAS_SSE2_INTRINSICS) -#if AE_COMPILER==AE_MSVC - { - int CPUInfo[4]; - __cpuid(CPUInfo, 1); - if( (CPUInfo[3]&0x04000000)!=0 ) - _ae_cpuid_has_sse2 = ae_true; - } -#elif AE_COMPILER==AE_GNUC - { - ae_int_t a,b,c,d; - __asm__ __volatile__ ("cpuid": "=a" (a), "=b" (b), "=c" (c), "=d" (d) : "a" (1)); - if( (d&0x04000000)!=0 ) - _ae_cpuid_has_sse2 = ae_true; - } -#elif AE_COMPILER==AE_SUNC - { - ae_int_t a,b,c,d; - __asm__ __volatile__ ("cpuid": "=a" (a), "=b" (b), "=c" (c), "=d" (d) : "a" (1)); - if( (d&0x04000000)!=0 ) - _ae_cpuid_has_sse2 = ae_true; - } -#else -#endif -#endif -#endif - /* - * set initialization flag - */ - _ae_cpuid_initialized = ae_true; - } - - /* - * return - */ - result = 0; - if( _ae_cpuid_has_sse2 ) - result = result|CPU_SSE2; - return result; -} - -/************************************************************************ -Real math functions -************************************************************************/ -ae_bool ae_fp_eq(double v1, double v2) -{ - /* IEEE-strict floating point comparison */ - volatile double x = v1; - volatile double y = v2; - return x==y; -} - -ae_bool ae_fp_neq(double v1, double v2) -{ - /* IEEE-strict floating point comparison */ - return !ae_fp_eq(v1,v2); -} - -ae_bool ae_fp_less(double v1, double v2) -{ - /* IEEE-strict floating point comparison */ - volatile double x = v1; - volatile double y = v2; - return xy; -} - -ae_bool ae_fp_greater_eq(double v1, double v2) -{ - /* IEEE-strict floating point comparison */ - volatile double x = v1; - volatile double y = v2; - return x>=y; -} - -ae_bool ae_isfinite_stateless(double x, ae_int_t endianness) -{ - union _u - { - double a; - ae_int32_t p[2]; - } u; - ae_int32_t high; - u.a = x; - if( endianness==AE_LITTLE_ENDIAN ) - high = u.p[1]; - else - high = u.p[0]; - return (high & (ae_int32_t)0x7FF00000)!=(ae_int32_t)0x7FF00000; -} - -ae_bool ae_isnan_stateless(double x, ae_int_t endianness) -{ - union _u - { - double a; - ae_int32_t p[2]; - } u; - ae_int32_t high, low; - u.a = x; - if( endianness==AE_LITTLE_ENDIAN ) - { - high = u.p[1]; - low = u.p[0]; - } - else - { - high = u.p[0]; - low = u.p[1]; - } - return ((high &0x7FF00000)==0x7FF00000) && (((high &0x000FFFFF)!=0) || (low!=0)); -} - -ae_bool ae_isinf_stateless(double x, ae_int_t endianness) -{ - union _u - { - double a; - ae_int32_t p[2]; - } u; - ae_int32_t high, low; - u.a = x; - if( endianness==AE_LITTLE_ENDIAN ) - { - high = u.p[1]; - low = u.p[0]; - } - else - { - high = u.p[0]; - low = u.p[1]; - } - - /* 31 least significant bits of high are compared */ - return ((high&0x7FFFFFFF)==0x7FF00000) && (low==0); -} - -ae_bool ae_isposinf_stateless(double x, ae_int_t endianness) -{ - union _u - { - double a; - ae_int32_t p[2]; - } u; - ae_int32_t high, low; - u.a = x; - if( endianness==AE_LITTLE_ENDIAN ) - { - high = u.p[1]; - low = u.p[0]; - } - else - { - high = u.p[0]; - low = u.p[1]; - } - - /* all 32 bits of high are compared */ - return (high==(ae_int32_t)0x7FF00000) && (low==0); -} - -ae_bool ae_isneginf_stateless(double x, ae_int_t endianness) -{ - union _u - { - double a; - ae_int32_t p[2]; - } u; - ae_int32_t high, low; - u.a = x; - if( endianness==AE_LITTLE_ENDIAN ) - { - high = u.p[1]; - low = u.p[0]; - } - else - { - high = u.p[0]; - low = u.p[1]; - } - - /* this code is a bit tricky to avoid comparison of high with 0xFFF00000, which may be unsafe with some buggy compilers */ - return ((high&0x7FFFFFFF)==0x7FF00000) && (high!=(ae_int32_t)0x7FF00000) && (low==0); -} - -ae_int_t ae_get_endianness() -{ - union - { - double a; - ae_int32_t p[2]; - } u; - - /* - * determine endianness - * two types are supported: big-endian and little-endian. - * mixed-endian hardware is NOT supported. - * - * 1983 is used as magic number because its non-periodic double - * representation allow us to easily distinguish between upper - * and lower halfs and to detect mixed endian hardware. - * - */ - u.a = 1.0/1983.0; - if( u.p[1]==(ae_int32_t)0x3f408642 ) - return AE_LITTLE_ENDIAN; - if( u.p[0]==(ae_int32_t)0x3f408642 ) - return AE_BIG_ENDIAN; - return AE_MIXED_ENDIAN; -} - -ae_bool ae_isfinite(double x,ae_state *state) -{ - return ae_isfinite_stateless(x, state->endianness); -} - -ae_bool ae_isnan(double x, ae_state *state) -{ - return ae_isnan_stateless(x, state->endianness); -} - -ae_bool ae_isinf(double x, ae_state *state) -{ - return ae_isinf_stateless(x, state->endianness); -} - -ae_bool ae_isposinf(double x,ae_state *state) -{ - return ae_isposinf_stateless(x, state->endianness); -} - -ae_bool ae_isneginf(double x,ae_state *state) -{ - return ae_isneginf_stateless(x, state->endianness); -} - -double ae_fabs(double x, ae_state *state) -{ - return fabs(x); -} - -ae_int_t ae_iabs(ae_int_t x, ae_state *state) -{ - return x>=0 ? x : -x; -} - -double ae_sqr(double x, ae_state *state) -{ - return x*x; -} - -double ae_sqrt(double x, ae_state *state) -{ - return sqrt(x); -} - -ae_int_t ae_sign(double x, ae_state *state) -{ - if( x>0 ) return 1; - if( x<0 ) return -1; - return 0; -} - -ae_int_t ae_round(double x, ae_state *state) -{ - return (ae_int_t)(ae_ifloor(x+0.5,state)); -} - -ae_int_t ae_trunc(double x, ae_state *state) -{ - return (ae_int_t)(x>0 ? ae_ifloor(x,state) : ae_iceil(x,state)); -} - -ae_int_t ae_ifloor(double x, ae_state *state) -{ - return (ae_int_t)(floor(x)); -} - -ae_int_t ae_iceil(double x, ae_state *state) -{ - return (ae_int_t)(ceil(x)); -} - -ae_int_t ae_maxint(ae_int_t m1, ae_int_t m2, ae_state *state) -{ - return m1>m2 ? m1 : m2; -} - -ae_int_t ae_minint(ae_int_t m1, ae_int_t m2, ae_state *state) -{ - return m1>m2 ? m2 : m1; -} - -double ae_maxreal(double m1, double m2, ae_state *state) -{ - return m1>m2 ? m1 : m2; -} - -double ae_minreal(double m1, double m2, ae_state *state) -{ - return m1>m2 ? m2 : m1; -} - -#ifdef AE_DEBUGRNG -ae_int_t ae_debugrng() -{ - ae_int_t k; - ae_int_t result; - k = _debug_rng_s0/53668; - _debug_rng_s0 = 40014*(_debug_rng_s0-k*53668)-k*12211; - if( _debug_rng_s0<0 ) - _debug_rng_s0 = _debug_rng_s0+2147483563; - k = _debug_rng_s1/52774; - _debug_rng_s1 = 40692*(_debug_rng_s1-k*52774)-k*3791; - if( _debug_rng_s1<0 ) - _debug_rng_s1 = _debug_rng_s1+2147483399; - result = _debug_rng_s0-_debug_rng_s1; - if( result<1 ) - result = result+2147483562; - return result; -} -#endif - -double ae_randomreal(ae_state *state) -{ -#ifdef AE_DEBUGRNG - return ae_debugrng()/2147483563.0; -#else - int i1 = rand(); - int i2 = rand(); - double mx = (double)(RAND_MAX)+1.0; - volatile double tmp0 = i2/mx; - volatile double tmp1 = i1+tmp0; - return tmp1/mx; -#endif -} - -ae_int_t ae_randominteger(ae_int_t maxv, ae_state *state) -{ -#ifdef AE_DEBUGRNG - return (ae_debugrng()-1)%maxv; -#else - return rand()%maxv; -#endif -} - -double ae_sin(double x, ae_state *state) -{ - return sin(x); -} - -double ae_cos(double x, ae_state *state) -{ - return cos(x); -} - -double ae_tan(double x, ae_state *state) -{ - return tan(x); -} - -double ae_sinh(double x, ae_state *state) -{ - return sinh(x); -} - -double ae_cosh(double x, ae_state *state) -{ - return cosh(x); -} -double ae_tanh(double x, ae_state *state) -{ - return tanh(x); -} - -double ae_asin(double x, ae_state *state) -{ - return asin(x); -} - -double ae_acos(double x, ae_state *state) -{ - return acos(x); -} - -double ae_atan(double x, ae_state *state) -{ - return atan(x); -} - -double ae_atan2(double y, double x, ae_state *state) -{ - return atan2(y,x); -} - -double ae_log(double x, ae_state *state) -{ - return log(x); -} - -double ae_pow(double x, double y, ae_state *state) -{ - return pow(x,y); -} - -double ae_exp(double x, ae_state *state) -{ - return exp(x); -} - -/************************************************************************ -Symmetric/Hermitian properties: check and force -************************************************************************/ -static void x_split_length(ae_int_t n, ae_int_t nb, ae_int_t* n1, ae_int_t* n2) -{ - ae_int_t r; - if( n<=nb ) - { - *n1 = n; - *n2 = 0; - } - else - { - if( n%nb!=0 ) - { - *n2 = n%nb; - *n1 = n-(*n2); - } - else - { - *n2 = n/2; - *n1 = n-(*n2); - if( *n1%nb==0 ) - { - return; - } - r = nb-*n1%nb; - *n1 = *n1+r; - *n2 = *n2-r; - } - } -} -static double x_safepythag2(double x, double y) -{ - double w; - double xabs; - double yabs; - double z; - xabs = fabs(x); - yabs = fabs(y); - w = xabs>yabs ? xabs : yabs; - z = xabsx_nb || len1>x_nb ) - { - ae_int_t n1, n2; - if( len0>len1 ) - { - x_split_length(len0, x_nb, &n1, &n2); - is_symmetric_rec_off_stat(a, offset0, offset1, n1, len1, nonfinite, mx, err, _state); - is_symmetric_rec_off_stat(a, offset0+n1, offset1, n2, len1, nonfinite, mx, err, _state); - } - else - { - x_split_length(len1, x_nb, &n1, &n2); - is_symmetric_rec_off_stat(a, offset0, offset1, len0, n1, nonfinite, mx, err, _state); - is_symmetric_rec_off_stat(a, offset0, offset1+n1, len0, n2, nonfinite, mx, err, _state); - } - return; - } - else - { - /* base case */ - double *p1, *p2, *prow, *pcol; - double v; - ae_int_t i, j; - - p1 = (double*)(a->ptr)+offset0*a->stride+offset1; - p2 = (double*)(a->ptr)+offset1*a->stride+offset0; - for(i=0; istride; - for(j=0; jv ? *mx : v; - v = fabs(*prow); - *mx = *mx>v ? *mx : v; - v = fabs(*pcol-*prow); - *err = *err>v ? *err : v; - } - pcol += a->stride; - prow++; - } - } - } -} -/* - * this function checks that diagonal block A0 is symmetric. - * Block A0 is specified by its offset and size. - * - * [ . ] - * [ A0 ] - * A = [ . ] - * [ . ] - * - * this subroutine updates current values of: - * a) mx maximum value of A[i,j] found so far - * b) err componentwise difference between A0 and A0^T - * - */ -static void is_symmetric_rec_diag_stat(x_matrix *a, ae_int_t offset, ae_int_t len, ae_bool *nonfinite, double *mx, double *err, ae_state *_state) -{ - double *p, *prow, *pcol; - double v; - ae_int_t i, j; - - /* try to split problem into two smaller ones */ - if( len>x_nb ) - { - ae_int_t n1, n2; - x_split_length(len, x_nb, &n1, &n2); - is_symmetric_rec_diag_stat(a, offset, n1, nonfinite, mx, err, _state); - is_symmetric_rec_diag_stat(a, offset+n1, n2, nonfinite, mx, err, _state); - is_symmetric_rec_off_stat(a, offset+n1, offset, n2, n1, nonfinite, mx, err, _state); - return; - } - - /* base case */ - p = (double*)(a->ptr)+offset*a->stride+offset; - for(i=0; istride; - for(j=0; jstride,prow++) - { - if( !ae_isfinite(*pcol,_state) || !ae_isfinite(*prow,_state) ) - { - *nonfinite = ae_true; - } - else - { - v = fabs(*pcol); - *mx = *mx>v ? *mx : v; - v = fabs(*prow); - *mx = *mx>v ? *mx : v; - v = fabs(*pcol-*prow); - *err = *err>v ? *err : v; - } - } - v = fabs(p[i+i*a->stride]); - *mx = *mx>v ? *mx : v; - } -} -/* - * this function checks difference between offdiagonal blocks BL and BU - * (see below). Block BL is specified by offsets (offset0,offset1) and - * sizes (len0,len1). - * - * [ . ] - * [ A0 BU ] - * A = [ BL A1 ] - * [ . ] - * - * this subroutine updates current values of: - * a) mx maximum value of A[i,j] found so far - * b) err componentwise difference between elements of BL and BU^H - * - */ -static void is_hermitian_rec_off_stat(x_matrix *a, ae_int_t offset0, ae_int_t offset1, ae_int_t len0, ae_int_t len1, ae_bool *nonfinite, double *mx, double *err, ae_state *_state) -{ - /* try to split problem into two smaller ones */ - if( len0>x_nb || len1>x_nb ) - { - ae_int_t n1, n2; - if( len0>len1 ) - { - x_split_length(len0, x_nb, &n1, &n2); - is_hermitian_rec_off_stat(a, offset0, offset1, n1, len1, nonfinite, mx, err, _state); - is_hermitian_rec_off_stat(a, offset0+n1, offset1, n2, len1, nonfinite, mx, err, _state); - } - else - { - x_split_length(len1, x_nb, &n1, &n2); - is_hermitian_rec_off_stat(a, offset0, offset1, len0, n1, nonfinite, mx, err, _state); - is_hermitian_rec_off_stat(a, offset0, offset1+n1, len0, n2, nonfinite, mx, err, _state); - } - return; - } - else - { - /* base case */ - ae_complex *p1, *p2, *prow, *pcol; - double v; - ae_int_t i, j; - - p1 = (ae_complex*)(a->ptr)+offset0*a->stride+offset1; - p2 = (ae_complex*)(a->ptr)+offset1*a->stride+offset0; - for(i=0; istride; - for(j=0; jx, _state) || !ae_isfinite(pcol->y, _state) || !ae_isfinite(prow->x, _state) || !ae_isfinite(prow->y, _state) ) - { - *nonfinite = ae_true; - } - else - { - v = x_safepythag2(pcol->x, pcol->y); - *mx = *mx>v ? *mx : v; - v = x_safepythag2(prow->x, prow->y); - *mx = *mx>v ? *mx : v; - v = x_safepythag2(pcol->x-prow->x, pcol->y+prow->y); - *err = *err>v ? *err : v; - } - pcol += a->stride; - prow++; - } - } - } -} -/* - * this function checks that diagonal block A0 is Hermitian. - * Block A0 is specified by its offset and size. - * - * [ . ] - * [ A0 ] - * A = [ . ] - * [ . ] - * - * this subroutine updates current values of: - * a) mx maximum value of A[i,j] found so far - * b) err componentwise difference between A0 and A0^H - * - */ -static void is_hermitian_rec_diag_stat(x_matrix *a, ae_int_t offset, ae_int_t len, ae_bool *nonfinite, double *mx, double *err, ae_state *_state) -{ - ae_complex *p, *prow, *pcol; - double v; - ae_int_t i, j; - - /* try to split problem into two smaller ones */ - if( len>x_nb ) - { - ae_int_t n1, n2; - x_split_length(len, x_nb, &n1, &n2); - is_hermitian_rec_diag_stat(a, offset, n1, nonfinite, mx, err, _state); - is_hermitian_rec_diag_stat(a, offset+n1, n2, nonfinite, mx, err, _state); - is_hermitian_rec_off_stat(a, offset+n1, offset, n2, n1, nonfinite, mx, err, _state); - return; - } - - /* base case */ - p = (ae_complex*)(a->ptr)+offset*a->stride+offset; - for(i=0; istride; - for(j=0; jstride,prow++) - { - if( !ae_isfinite(pcol->x, _state) || !ae_isfinite(pcol->y, _state) || !ae_isfinite(prow->x, _state) || !ae_isfinite(prow->y, _state) ) - { - *nonfinite = ae_true; - } - else - { - v = x_safepythag2(pcol->x, pcol->y); - *mx = *mx>v ? *mx : v; - v = x_safepythag2(prow->x, prow->y); - *mx = *mx>v ? *mx : v; - v = x_safepythag2(pcol->x-prow->x, pcol->y+prow->y); - *err = *err>v ? *err : v; - } - } - if( !ae_isfinite(p[i+i*a->stride].x, _state) || !ae_isfinite(p[i+i*a->stride].y, _state) ) - { - *nonfinite = ae_true; - } - else - { - v = fabs(p[i+i*a->stride].x); - *mx = *mx>v ? *mx : v; - v = fabs(p[i+i*a->stride].y); - *err = *err>v ? *err : v; - } - } -} -/* - * this function copies offdiagonal block BL to its symmetric counterpart - * BU (see below). Block BL is specified by offsets (offset0,offset1) - * and sizes (len0,len1). - * - * [ . ] - * [ A0 BU ] - * A = [ BL A1 ] - * [ . ] - * - */ -static void force_symmetric_rec_off_stat(x_matrix *a, ae_int_t offset0, ae_int_t offset1, ae_int_t len0, ae_int_t len1) -{ - /* try to split problem into two smaller ones */ - if( len0>x_nb || len1>x_nb ) - { - ae_int_t n1, n2; - if( len0>len1 ) - { - x_split_length(len0, x_nb, &n1, &n2); - force_symmetric_rec_off_stat(a, offset0, offset1, n1, len1); - force_symmetric_rec_off_stat(a, offset0+n1, offset1, n2, len1); - } - else - { - x_split_length(len1, x_nb, &n1, &n2); - force_symmetric_rec_off_stat(a, offset0, offset1, len0, n1); - force_symmetric_rec_off_stat(a, offset0, offset1+n1, len0, n2); - } - return; - } - else - { - /* base case */ - double *p1, *p2, *prow, *pcol; - ae_int_t i, j; - - p1 = (double*)(a->ptr)+offset0*a->stride+offset1; - p2 = (double*)(a->ptr)+offset1*a->stride+offset0; - for(i=0; istride; - for(j=0; jstride; - prow++; - } - } - } -} -/* - * this function copies lower part of diagonal block A0 to its upper part - * Block is specified by offset and size. - * - * [ . ] - * [ A0 ] - * A = [ . ] - * [ . ] - * - */ -static void force_symmetric_rec_diag_stat(x_matrix *a, ae_int_t offset, ae_int_t len) -{ - double *p, *prow, *pcol; - ae_int_t i, j; - - /* try to split problem into two smaller ones */ - if( len>x_nb ) - { - ae_int_t n1, n2; - x_split_length(len, x_nb, &n1, &n2); - force_symmetric_rec_diag_stat(a, offset, n1); - force_symmetric_rec_diag_stat(a, offset+n1, n2); - force_symmetric_rec_off_stat(a, offset+n1, offset, n2, n1); - return; - } - - /* base case */ - p = (double*)(a->ptr)+offset*a->stride+offset; - for(i=0; istride; - for(j=0; jstride,prow++) - *pcol = *prow; - } -} -/* - * this function copies Hermitian transpose of offdiagonal block BL to - * its symmetric counterpart BU (see below). Block BL is specified by - * offsets (offset0,offset1) and sizes (len0,len1). - * - * [ . ] - * [ A0 BU ] - * A = [ BL A1 ] - * [ . ] - */ -static void force_hermitian_rec_off_stat(x_matrix *a, ae_int_t offset0, ae_int_t offset1, ae_int_t len0, ae_int_t len1) -{ - /* try to split problem into two smaller ones */ - if( len0>x_nb || len1>x_nb ) - { - ae_int_t n1, n2; - if( len0>len1 ) - { - x_split_length(len0, x_nb, &n1, &n2); - force_hermitian_rec_off_stat(a, offset0, offset1, n1, len1); - force_hermitian_rec_off_stat(a, offset0+n1, offset1, n2, len1); - } - else - { - x_split_length(len1, x_nb, &n1, &n2); - force_hermitian_rec_off_stat(a, offset0, offset1, len0, n1); - force_hermitian_rec_off_stat(a, offset0, offset1+n1, len0, n2); - } - return; - } - else - { - /* base case */ - ae_complex *p1, *p2, *prow, *pcol; - ae_int_t i, j; - - p1 = (ae_complex*)(a->ptr)+offset0*a->stride+offset1; - p2 = (ae_complex*)(a->ptr)+offset1*a->stride+offset0; - for(i=0; istride; - for(j=0; jstride; - prow++; - } - } - } -} -/* - * this function copies Hermitian transpose of lower part of - * diagonal block A0 to its upper part Block is specified by offset and size. - * - * [ . ] - * [ A0 ] - * A = [ . ] - * [ . ] - * - */ -static void force_hermitian_rec_diag_stat(x_matrix *a, ae_int_t offset, ae_int_t len) -{ - ae_complex *p, *prow, *pcol; - ae_int_t i, j; - - /* try to split problem into two smaller ones */ - if( len>x_nb ) - { - ae_int_t n1, n2; - x_split_length(len, x_nb, &n1, &n2); - force_hermitian_rec_diag_stat(a, offset, n1); - force_hermitian_rec_diag_stat(a, offset+n1, n2); - force_hermitian_rec_off_stat(a, offset+n1, offset, n2, n1); - return; - } - - /* base case */ - p = (ae_complex*)(a->ptr)+offset*a->stride+offset; - for(i=0; istride; - for(j=0; jstride,prow++) - *pcol = *prow; - } -} -ae_bool x_is_symmetric(x_matrix *a) -{ - double mx, err; - ae_bool nonfinite; - ae_state _alglib_env_state; - if( a->datatype!=DT_REAL ) - return ae_false; - if( a->cols!=a->rows ) - return ae_false; - if( a->cols==0 || a->rows==0 ) - return ae_true; - ae_state_init(&_alglib_env_state); - mx = 0; - err = 0; - nonfinite = ae_false; - is_symmetric_rec_diag_stat(a, 0, (ae_int_t)a->rows, &nonfinite, &mx, &err, &_alglib_env_state); - if( nonfinite ) - return ae_false; - if( mx==0 ) - return ae_true; - return err/mx<=1.0E-14; -} -ae_bool x_is_hermitian(x_matrix *a) -{ - double mx, err; - ae_bool nonfinite; - ae_state _alglib_env_state; - if( a->datatype!=DT_COMPLEX ) - return ae_false; - if( a->cols!=a->rows ) - return ae_false; - if( a->cols==0 || a->rows==0 ) - return ae_true; - ae_state_init(&_alglib_env_state); - mx = 0; - err = 0; - nonfinite = ae_false; - is_hermitian_rec_diag_stat(a, 0, (ae_int_t)a->rows, &nonfinite, &mx, &err, &_alglib_env_state); - if( nonfinite ) - return ae_false; - if( mx==0 ) - return ae_true; - return err/mx<=1.0E-14; -} -ae_bool x_force_symmetric(x_matrix *a) -{ - if( a->datatype!=DT_REAL ) - return ae_false; - if( a->cols!=a->rows ) - return ae_false; - if( a->cols==0 || a->rows==0 ) - return ae_true; - force_symmetric_rec_diag_stat(a, 0, (ae_int_t)a->rows); - return ae_true; -} -ae_bool x_force_hermitian(x_matrix *a) -{ - if( a->datatype!=DT_COMPLEX ) - return ae_false; - if( a->cols!=a->rows ) - return ae_false; - if( a->cols==0 || a->rows==0 ) - return ae_true; - force_hermitian_rec_diag_stat(a, 0, (ae_int_t)a->rows); - return ae_true; -} - -ae_bool ae_is_symmetric(ae_matrix *a) -{ - x_matrix x; - x.owner = OWN_CALLER; - ae_x_attach_to_matrix(&x, a); - return x_is_symmetric(&x); -} - -ae_bool ae_is_hermitian(ae_matrix *a) -{ - x_matrix x; - x.owner = OWN_CALLER; - ae_x_attach_to_matrix(&x, a); - return x_is_hermitian(&x); -} - -ae_bool ae_force_symmetric(ae_matrix *a) -{ - x_matrix x; - x.owner = OWN_CALLER; - ae_x_attach_to_matrix(&x, a); - return x_force_symmetric(&x); -} - -ae_bool ae_force_hermitian(ae_matrix *a) -{ - x_matrix x; - x.owner = OWN_CALLER; - ae_x_attach_to_matrix(&x, a); - return x_force_hermitian(&x); -} - -/************************************************************************ -This function converts six-bit value (from 0 to 63) to character (only -digits, lowercase and uppercase letters, minus and underscore are used). - -If v is negative or greater than 63, this function returns '?'. -************************************************************************/ -static char _sixbits2char_tbl[64] = { - '0', '1', '2', '3', '4', '5', '6', '7', - '8', '9', 'A', 'B', 'C', 'D', 'E', 'F', - 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', - 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', - 'W', 'X', 'Y', 'Z', 'a', 'b', 'c', 'd', - 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', - 'm', 'n', 'o', 'p', 'q', 'r', 's', 't', - 'u', 'v', 'w', 'x', 'y', 'z', '-', '_' }; - -char ae_sixbits2char(ae_int_t v) -{ - - if( v<0 || v>63 ) - return '?'; - return _sixbits2char_tbl[v]; - - /* v is correct, process it */ - /*if( v<10 ) - return '0'+v; - v -= 10; - if( v<26 ) - return 'A'+v; - v -= 26; - if( v<26 ) - return 'a'+v; - v -= 26; - return v==0 ? '-' : '_';*/ -} - -/************************************************************************ -This function converts character to six-bit value (from 0 to 63). - -This function is inverse of ae_sixbits2char() -If c is not correct character, this function returns -1. -************************************************************************/ -static ae_int_t _ae_char2sixbits_tbl[] = { - -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 62, -1, -1, - 0, 1, 2, 3, 4, 5, 6, 7, - 8, 9, -1, -1, -1, -1, -1, -1, - -1, 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, -1, -1, -1, -1, 63, - -1, 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, -1, -1, -1, -1, -1 }; -ae_int_t ae_char2sixbits(char c) -{ - return (c>=0 && c<127) ? _ae_char2sixbits_tbl[(int)c] : -1; -} - -/************************************************************************ -This function converts three bytes (24 bits) to four six-bit values -(24 bits again). - -src pointer to three bytes -dst pointer to four ints -************************************************************************/ -void ae_threebytes2foursixbits(const unsigned char *src, ae_int_t *dst) -{ - dst[0] = src[0] & 0x3F; - dst[1] = (src[0]>>6) | ((src[1]&0x0F)<<2); - dst[2] = (src[1]>>4) | ((src[2]&0x03)<<4); - dst[3] = src[2]>>2; -} - -/************************************************************************ -This function converts four six-bit values (24 bits) to three bytes -(24 bits again). - -src pointer to four ints -dst pointer to three bytes -************************************************************************/ -void ae_foursixbits2threebytes(const ae_int_t *src, unsigned char *dst) -{ - dst[0] = (unsigned char)( src[0] | ((src[1]&0x03)<<6)); - dst[1] = (unsigned char)((src[1]>>2) | ((src[2]&0x0F)<<4)); - dst[2] = (unsigned char)((src[2]>>4) | (src[3]<<2)); -} - -/************************************************************************ -This function serializes boolean value into buffer - -v boolean value to be serialized -buf buffer, at least 12 characters wide - (11 chars for value, one for trailing zero) -state ALGLIB environment state -************************************************************************/ -void ae_bool2str(ae_bool v, char *buf, ae_state *state) -{ - char c = v ? '1' : '0'; - ae_int_t i; - for(i=0; iendianness==AE_BIG_ENDIAN ) - { - for(i=0; i<(ae_int_t)(sizeof(ae_int_t)/2); i++) - { - unsigned char tc; - tc = u.bytes[i]; - u.bytes[i] = u.bytes[sizeof(ae_int_t)-1-i]; - u.bytes[sizeof(ae_int_t)-1-i] = tc; - } - } - - /* - * convert to six-bit representation, output - * - * NOTE: last 12th element of sixbits is always zero, we do not output it - */ - ae_threebytes2foursixbits(u.bytes+0, sixbits+0); - ae_threebytes2foursixbits(u.bytes+3, sixbits+4); - ae_threebytes2foursixbits(u.bytes+6, sixbits+8); - for(i=0; i=AE_SER_ENTRY_LENGTH ) - ae_break(state, ERR_ASSERTION_FAILED, emsg); - sixbits[sixbitsread] = d; - sixbitsread++; - buf++; - } - *pasttheend = buf; - if( sixbitsread==0 ) - ae_break(state, ERR_ASSERTION_FAILED, emsg); - for(i=sixbitsread; i<12; i++) - sixbits[i] = 0; - ae_foursixbits2threebytes(sixbits+0, u.bytes+0); - ae_foursixbits2threebytes(sixbits+4, u.bytes+3); - ae_foursixbits2threebytes(sixbits+8, u.bytes+6); - if( state->endianness==AE_BIG_ENDIAN ) - { - for(i=0; i<(ae_int_t)(sizeof(ae_int_t)/2); i++) - { - unsigned char tc; - tc = u.bytes[i]; - u.bytes[i] = u.bytes[sizeof(ae_int_t)-1-i]; - u.bytes[sizeof(ae_int_t)-1-i] = tc; - } - } - return u.ival; -} - - -/************************************************************************ -This function serializes double value into buffer - -v double value to be serialized -buf buffer, at least 12 characters wide - (11 chars for value, one for trailing zero) -state ALGLIB environment state -************************************************************************/ -void ae_double2str(double v, char *buf, ae_state *state) -{ - union _u - { - double dval; - unsigned char bytes[9]; - } u; - ae_int_t i; - ae_int_t sixbits[12]; - - /* - * handle special quantities - */ - if( ae_isnan(v, state) ) - { - const char *s = ".nan_______"; - memcpy(buf, s, strlen(s)+1); - return; - } - if( ae_isposinf(v, state) ) - { - const char *s = ".posinf____"; - memcpy(buf, s, strlen(s)+1); - return; - } - if( ae_isneginf(v, state) ) - { - const char *s = ".neginf____"; - memcpy(buf, s, strlen(s)+1); - return; - } - - /* - * process general case: - * 1. copy v to array of chars - * 2. set 9th byte of u.bytes to zero in order to - * simplify conversion to six-bit representation - * 3. convert to little endian (if needed) - * 4. convert to six-bit representation - * (last 12th element of sixbits is always zero, we do not output it) - */ - u.dval = v; - u.bytes[8] = 0; - if( state->endianness==AE_BIG_ENDIAN ) - { - for(i=0; i<(ae_int_t)(sizeof(double)/2); i++) - { - unsigned char tc; - tc = u.bytes[i]; - u.bytes[i] = u.bytes[sizeof(double)-1-i]; - u.bytes[sizeof(double)-1-i] = tc; - } - } - ae_threebytes2foursixbits(u.bytes+0, sixbits+0); - ae_threebytes2foursixbits(u.bytes+3, sixbits+4); - ae_threebytes2foursixbits(u.bytes+6, sixbits+8); - for(i=0; iv_nan; - } - if( strncmp(buf, s_posinf, strlen(s_posinf))==0 ) - { - *pasttheend = buf+strlen(s_posinf); - return state->v_posinf; - } - if( strncmp(buf, s_neginf, strlen(s_neginf))==0 ) - { - *pasttheend = buf+strlen(s_neginf); - return state->v_neginf; - } - ae_break(state, ERR_ASSERTION_FAILED, emsg); - } - - /* - * General case: - * 1. read and decode six-bit digits - * 2. check that all 11 digits were read - * 3. set last 12th digit to zero (needed for simplicity of conversion) - * 4. convert to 8 bytes - * 5. convert to big endian representation, if needed - */ - sixbitsread = 0; - while( *buf!=' ' && *buf!='\t' && *buf!='\n' && *buf!='\r' && *buf!=0 ) - { - ae_int_t d; - d = ae_char2sixbits(*buf); - if( d<0 || sixbitsread>=AE_SER_ENTRY_LENGTH ) - ae_break(state, ERR_ASSERTION_FAILED, emsg); - sixbits[sixbitsread] = d; - sixbitsread++; - buf++; - } - *pasttheend = buf; - if( sixbitsread!=AE_SER_ENTRY_LENGTH ) - ae_break(state, ERR_ASSERTION_FAILED, emsg); - sixbits[AE_SER_ENTRY_LENGTH] = 0; - ae_foursixbits2threebytes(sixbits+0, u.bytes+0); - ae_foursixbits2threebytes(sixbits+4, u.bytes+3); - ae_foursixbits2threebytes(sixbits+8, u.bytes+6); - if( state->endianness==AE_BIG_ENDIAN ) - { - for(i=0; i<(ae_int_t)(sizeof(double)/2); i++) - { - unsigned char tc; - tc = u.bytes[i]; - u.bytes[i] = u.bytes[sizeof(double)-1-i]; - u.bytes[sizeof(double)-1-i] = tc; - } - } - return u.dval; -} - - -/************************************************************************ -This function performs given number of spin-wait iterations -************************************************************************/ -void ae_spin_wait(ae_int_t cnt) -{ - /* - * these strange operations with ae_never_change_it are necessary to - * prevent compiler optimization of the loop. - */ - volatile ae_int_t i; - - /* very unlikely because no one will wait for such amount of cycles */ - if( cnt>0x12345678 ) - ae_never_change_it = cnt%10; - - /* spin wait, test condition which will never be true */ - for(i=0; i0 ) - ae_never_change_it--; -} - - -/************************************************************************ -This function causes the calling thread to relinquish the CPU. The thread -is moved to the end of the queue and some other thread gets to run. - -NOTE: this function should NOT be called when AE_OS is AE_UNKNOWN - the - whole program will be abnormally terminated. -************************************************************************/ -void ae_yield() -{ -#if AE_OS==AE_WINDOWS - if( !SwitchToThread() ) - Sleep(0); -#elif AE_OS==AE_POSIX - sched_yield(); -#else - abort(); -#endif -} - -/************************************************************************ -This function initializes ae_lock structure and sets lock in a free mode. -************************************************************************/ -void ae_init_lock(ae_lock *lock) -{ -#if AE_OS==AE_WINDOWS - lock->p_lock = (ae_int_t*)ae_align((void*)(&lock->buf),AE_LOCK_ALIGNMENT); - lock->p_lock[0] = 0; -#elif AE_OS==AE_POSIX - pthread_mutex_init(&lock->mutex, NULL); -#else - lock->is_locked = ae_false; -#endif -} - - -/************************************************************************ -This function acquires lock. In case lock is busy, we perform several -iterations inside tight loop before trying again. -************************************************************************/ -void ae_acquire_lock(ae_lock *lock) -{ -#if AE_OS==AE_WINDOWS - ae_int_t cnt = 0; -#ifdef AE_SMP_DEBUGCOUNTERS - InterlockedIncrement((LONG volatile *)&_ae_dbg_lock_acquisitions); -#endif - for(;;) - { - if( InterlockedCompareExchange((LONG volatile *)lock->p_lock, 1, 0)==0 ) - return; - ae_spin_wait(AE_LOCK_CYCLES); -#ifdef AE_SMP_DEBUGCOUNTERS - InterlockedIncrement((LONG volatile *)&_ae_dbg_lock_spinwaits); -#endif - cnt++; - if( cnt%AE_LOCK_TESTS_BEFORE_YIELD==0 ) - { -#ifdef AE_SMP_DEBUGCOUNTERS - InterlockedIncrement((LONG volatile *)&_ae_dbg_lock_yields); -#endif - ae_yield(); - } - } -#elif AE_OS==AE_POSIX - ae_int_t cnt = 0; - for(;;) - { - if( pthread_mutex_trylock(&lock->mutex)==0 ) - return; - ae_spin_wait(AE_LOCK_CYCLES); - cnt++; - if( cnt%AE_LOCK_TESTS_BEFORE_YIELD==0 ) - ae_yield(); - } - ; -#else - AE_CRITICAL_ASSERT(!lock->is_locked); - lock->is_locked = ae_true; -#endif -} - - -/************************************************************************ -This function releases lock. -************************************************************************/ -void ae_release_lock(ae_lock *lock) -{ -#if AE_OS==AE_WINDOWS - InterlockedExchange((LONG volatile *)lock->p_lock, 0); -#elif AE_OS==AE_POSIX - pthread_mutex_unlock(&lock->mutex); -#else - lock->is_locked = ae_false; -#endif -} - - -/************************************************************************ -This function frees ae_lock structure. -************************************************************************/ -void ae_free_lock(ae_lock *lock) -{ -#if AE_OS==AE_POSIX - pthread_mutex_destroy(&lock->mutex); -#endif -} - - -/************************************************************************ -This function creates ae_shared_pool structure. - -dst destination shared pool; - already allocated, but not initialized. -state ALGLIB environment state -make_automatic if true, pool is added to the dynamic block list - -Error handling: -* if state is NULL, returns ae_false on allocation error -* if state is not NULL, calls ae_break() on allocation error -* returns ae_true on success - -dst is assumed to be uninitialized, its fields are ignored. -************************************************************************/ -ae_bool ae_shared_pool_init(void *_dst, ae_state *state, ae_bool make_automatic) -{ - ae_shared_pool *dst; - - dst = (ae_shared_pool*)_dst; - - /* init */ - dst->seed_object = NULL; - dst->recycled_objects = NULL; - dst->recycled_entries = NULL; - dst->enumeration_counter = NULL; - dst->size_of_object = 0; - dst->init = NULL; - dst->init_copy = NULL; - dst->destroy = NULL; - dst->frame_entry.deallocator = ae_shared_pool_destroy; - dst->frame_entry.ptr = dst; - if( make_automatic && state!=NULL ) - ae_db_attach(&dst->frame_entry, state); - ae_init_lock(&dst->pool_lock); - return ae_true; -} - - -/************************************************************************ -This function clears all dynamically allocated fields of the pool except -for the lock. It does NOT try to acquire pool_lock. - -NOTE: this function is NOT thread-safe, it is not protected by lock. -************************************************************************/ -static void ae_shared_pool_internalclear(ae_shared_pool *dst) -{ - ae_shared_pool_entry *ptr, *tmp; - - /* destroy seed */ - if( dst->seed_object!=NULL ) - { - dst->destroy((void*)dst->seed_object); - ae_free((void*)dst->seed_object); - dst->seed_object = NULL; - } - - /* destroy recycled objects */ - for(ptr=dst->recycled_objects; ptr!=NULL;) - { - tmp = (ae_shared_pool_entry*)ptr->next_entry; - dst->destroy(ptr->obj); - ae_free(ptr->obj); - ae_free(ptr); - ptr = tmp; - } - dst->recycled_objects = NULL; - - /* destroy recycled entries */ - for(ptr=dst->recycled_entries; ptr!=NULL;) - { - tmp = (ae_shared_pool_entry*)ptr->next_entry; - ae_free(ptr); - ptr = tmp; - } - dst->recycled_entries = NULL; -} - - -/************************************************************************ -This function creates copy of ae_shared_pool. - -dst destination pool, allocated but not initialized -src source pool -state ALGLIB environment state -make_automatic if true, pool is added to the dynamic block list - -Error handling: -* if state is NULL, returns ae_false on allocation error -* if state is not NULL, calls ae_break() on allocation error -* returns ae_true on success - -dst is assumed to be uninitialized, its fields are ignored. - -NOTE: this function is NOT thread-safe. It does not acquire pool lock, so - you should NOT call it when lock can be used by another thread. -************************************************************************/ -ae_bool ae_shared_pool_init_copy(void *_dst, void *_src, ae_state *state, ae_bool make_automatic) -{ - ae_shared_pool *dst, *src; - ae_shared_pool_entry *ptr; - - dst = (ae_shared_pool*)_dst; - src = (ae_shared_pool*)_src; - if( !ae_shared_pool_init(dst, state, make_automatic) ) - return ae_false; - - /* copy non-pointer fields */ - dst->size_of_object = src->size_of_object; - dst->init = src->init; - dst->init_copy = src->init_copy; - dst->destroy = src->destroy; - ae_init_lock(&dst->pool_lock); - - /* copy seed object */ - if( src->seed_object!=NULL ) - { - dst->seed_object = ae_malloc(dst->size_of_object, state); - if( dst->seed_object==NULL ) - return ae_false; - if( !dst->init_copy(dst->seed_object, src->seed_object, state, ae_false) ) - return ae_false; - } - - /* copy recycled objects */ - dst->recycled_objects = NULL; - for(ptr=src->recycled_objects; ptr!=NULL; ptr=(ae_shared_pool_entry*)ptr->next_entry) - { - ae_shared_pool_entry *tmp; - tmp = (ae_shared_pool_entry*)ae_malloc(sizeof(ae_shared_pool_entry), state); - if( tmp==NULL ) - return ae_false; - tmp->obj = ae_malloc(dst->size_of_object, state); - if( tmp->obj==NULL ) - return ae_false; - if( !dst->init_copy(tmp->obj, ptr->obj, state, ae_false) ) - return ae_false; - tmp->next_entry = dst->recycled_objects; - dst->recycled_objects = tmp; - } - - /* recycled entries are not copied because they do not store any information */ - dst->recycled_entries = NULL; - - /* enumeration counter is reset on copying */ - dst->enumeration_counter = NULL; - - /* initialize frame record */ - dst->frame_entry.deallocator = ae_shared_pool_destroy; - dst->frame_entry.ptr = dst; - - /* return */ - return ae_true; -} - - -/************************************************************************ -This function clears contents of the pool, but pool remain usable. - -IMPORTANT: this function invalidates dst, it can not be used after it is - cleared. - -NOTE: this function is NOT thread-safe. It does not acquire pool lock, so - you should NOT call it when lock can be used by another thread. -************************************************************************/ -void ae_shared_pool_clear(void *_dst) -{ - ae_shared_pool *dst = (ae_shared_pool*)_dst; - - /* clear seed and lists */ - ae_shared_pool_internalclear(dst); - - /* clear fields */ - dst->seed_object = NULL; - dst->recycled_objects = NULL; - dst->recycled_entries = NULL; - dst->enumeration_counter = NULL; - dst->size_of_object = 0; - dst->init = NULL; - dst->init_copy = NULL; - dst->destroy = NULL; -} - - -/************************************************************************ -This function destroys pool (object is left in invalid state, all -dynamically allocated memory is freed). - -NOTE: this function is NOT thread-safe. It does not acquire pool lock, so - you should NOT call it when lock can be used by another thread. -************************************************************************/ -void ae_shared_pool_destroy(void *_dst) -{ - ae_shared_pool *dst = (ae_shared_pool*)_dst; - ae_shared_pool_clear(_dst); - ae_free_lock(&dst->pool_lock); -} - - -/************************************************************************ -This function returns True, if internal seed object was set. It returns -False for un-seeded pool. - -dst destination pool (initialized by constructor function) - -NOTE: this function is NOT thread-safe. It does not acquire pool lock, so - you should NOT call it when lock can be used by another thread. -************************************************************************/ -ae_bool ae_shared_pool_is_initialized(void *_dst) -{ - ae_shared_pool *dst = (ae_shared_pool*)_dst; - return dst->seed_object!=NULL; -} - - -/************************************************************************ -This function sets internal seed object. All objects owned by the pool -(current seed object, recycled objects) are automatically freed. - -dst destination pool (initialized by constructor function) -seed_object new seed object -size_of_object sizeof(), used to allocate memory -init constructor function -init_copy copy constructor -clear destructor function -state ALGLIB environment state - -NOTE: this function is NOT thread-safe. It does not acquire pool lock, so - you should NOT call it when lock can be used by another thread. -************************************************************************/ -void ae_shared_pool_set_seed( - ae_shared_pool *dst, - void *seed_object, - ae_int_t size_of_object, - ae_bool (*init)(void* dst, ae_state* state, ae_bool make_automatic), - ae_bool (*init_copy)(void* dst, void* src, ae_state* state, ae_bool make_automatic), - void (*destroy)(void* ptr), - ae_state *state) -{ - /* destroy internal objects */ - ae_shared_pool_internalclear(dst); - - /* set non-pointer fields */ - dst->size_of_object = size_of_object; - dst->init = init; - dst->init_copy = init_copy; - dst->destroy = destroy; - - /* set seed object */ - dst->seed_object = ae_malloc(size_of_object, state); - ae_assert(dst->seed_object!=NULL, "ALGLIB: unable to allocate memory for ae_shared_pool_set_seed()", state); - ae_assert( - init_copy(dst->seed_object, seed_object, state, ae_false), - "ALGLIB: unable to initialize seed in ae_shared_pool_set_seed()", - state); -} - - -/************************************************************************ -This function retrieves a copy of the seed object from the pool and -stores it to target smart pointer ptr. - -In case target pointer owns non-NULL value, it is deallocated before -storing value retrieved from pool. Target pointer becomes owner of the -value which was retrieved from pool. - -pool pool -pptr pointer to ae_smart_ptr structure -state ALGLIB environment state - -NOTE: this function IS thread-safe. It acquires pool lock during its - operation and can be used simultaneously from several threads. -************************************************************************/ -void ae_shared_pool_retrieve( - ae_shared_pool *pool, - ae_smart_ptr *pptr, - ae_state *state) -{ - void *new_obj; - - /* assert that pool was seeded */ - ae_assert( - pool->seed_object!=NULL, - "ALGLIB: shared pool is not seeded, PoolRetrieve() failed", - state); - - /* acquire lock */ - ae_acquire_lock(&pool->pool_lock); - - /* try to reuse recycled objects */ - if( pool->recycled_objects!=NULL ) - { - void *new_obj; - ae_shared_pool_entry *result; - - /* retrieve entry/object from list of recycled objects */ - result = pool->recycled_objects; - pool->recycled_objects = (ae_shared_pool_entry*)pool->recycled_objects->next_entry; - new_obj = result->obj; - result->obj = NULL; - - /* move entry to list of recycled entries */ - result->next_entry = pool->recycled_entries; - pool->recycled_entries = result; - - /* release lock */ - ae_release_lock(&pool->pool_lock); - - /* assign object to smart pointer */ - ae_smart_ptr_assign(pptr, new_obj, ae_true, ae_true, pool->destroy); - return; - } - - /* release lock; we do not need it anymore because copy constructor does not modify source variable */ - ae_release_lock(&pool->pool_lock); - - /* create new object from seed */ - new_obj = ae_malloc(pool->size_of_object, state); - ae_assert(new_obj!=NULL, "ALGLIB: unable to allocate memory for ae_shared_pool_retrieve()", state); - ae_assert( - pool->init_copy(new_obj, pool->seed_object, state, ae_false), - "ALGLIB: unable to initialize object in ae_shared_pool_retrieve()", - state); - - /* assign object to smart pointer and return */ - ae_smart_ptr_assign(pptr, new_obj, ae_true, ae_true, pool->destroy); -} - - -/************************************************************************ -This function recycles object owned by smart pointer by moving it to -internal storage of the shared pool. - -Source pointer must own the object. After function is over, it owns NULL -pointer. - -pool pool -pptr pointer to ae_smart_ptr structure -state ALGLIB environment state - -NOTE: this function IS thread-safe. It acquires pool lock during its - operation and can be used simultaneously from several threads. -************************************************************************/ -void ae_shared_pool_recycle( - ae_shared_pool *pool, - ae_smart_ptr *pptr, - ae_state *state) -{ - ae_shared_pool_entry *new_entry; - - /* assert that pool was seeded */ - ae_assert( - pool->seed_object!=NULL, - "ALGLIB: shared pool is not seeded, PoolRecycle() failed", - state); - - /* assert that pointer non-null and owns the object */ - ae_assert(pptr->is_owner, "ALGLIB: pptr in ae_shared_pool_recycle() does not own its pointer", state); - ae_assert(pptr->ptr!=NULL, "ALGLIB: pptr in ae_shared_pool_recycle() is NULL", state); - - /* acquire lock */ - ae_acquire_lock(&pool->pool_lock); - - /* acquire shared pool entry (reuse one from recycled_entries or malloc new one) */ - if( pool->recycled_entries!=NULL ) - { - /* reuse previously allocated entry */ - new_entry = pool->recycled_entries; - pool->recycled_entries = (ae_shared_pool_entry*)new_entry->next_entry; - } - else - { - /* - * Allocate memory for new entry. - * - * NOTE: we release pool lock during allocation because ae_malloc() may raise - * exception and we do not want our pool to be left in the locked state. - */ - ae_release_lock(&pool->pool_lock); - new_entry = (ae_shared_pool_entry*)ae_malloc(sizeof(ae_shared_pool_entry), state); - ae_assert(new_entry!=NULL, "ALGLIB: unable to allocate memory in ae_shared_pool_recycle()", state); - ae_acquire_lock(&pool->pool_lock); - } - - /* add object to the list of recycled objects */ - new_entry->obj = pptr->ptr; - new_entry->next_entry = pool->recycled_objects; - pool->recycled_objects = new_entry; - - /* release lock object */ - ae_release_lock(&pool->pool_lock); - - /* release source pointer */ - ae_smart_ptr_release(pptr); -} - - -/************************************************************************ -This function clears internal list of recycled objects, but does not -change seed object managed by the pool. - -pool pool -state ALGLIB environment state - -NOTE: this function is NOT thread-safe. It does not acquire pool lock, so - you should NOT call it when lock can be used by another thread. -************************************************************************/ -void ae_shared_pool_clear_recycled( - ae_shared_pool *pool, - ae_state *state) -{ - ae_shared_pool_entry *ptr, *tmp; - - /* clear recycled objects */ - for(ptr=pool->recycled_objects; ptr!=NULL;) - { - tmp = (ae_shared_pool_entry*)ptr->next_entry; - pool->destroy(ptr->obj); - ae_free(ptr->obj); - ae_free(ptr); - ptr = tmp; - } - pool->recycled_objects = NULL; -} - - -/************************************************************************ -This function allows to enumerate recycled elements of the shared pool. -It stores pointer to the first recycled object in the smart pointer. - -IMPORTANT: -* in case target pointer owns non-NULL value, it is deallocated before - storing value retrieved from pool. -* recycled object IS NOT removed from pool -* target pointer DOES NOT become owner of the new value -* this function IS NOT thread-safe -* you SHOULD NOT modify shared pool during enumeration (although you can - modify state of the objects retrieved from pool) -* in case there is no recycled objects in the pool, NULL is stored to pptr -* in case pool is not seeded, NULL is stored to pptr - -pool pool -pptr pointer to ae_smart_ptr structure -state ALGLIB environment state -************************************************************************/ -void ae_shared_pool_first_recycled( - ae_shared_pool *pool, - ae_smart_ptr *pptr, - ae_state *state) -{ - /* modify internal enumeration counter */ - pool->enumeration_counter = pool->recycled_objects; - - /* exit on empty list */ - if( pool->enumeration_counter==NULL ) - { - ae_smart_ptr_assign(pptr, NULL, ae_false, ae_false, NULL); - return; - } - - /* assign object to smart pointer */ - ae_smart_ptr_assign(pptr, pool->enumeration_counter->obj, ae_false, ae_false, pool->destroy); -} - - -/************************************************************************ -This function allows to enumerate recycled elements of the shared pool. -It stores pointer to the next recycled object in the smart pointer. - -IMPORTANT: -* in case target pointer owns non-NULL value, it is deallocated before - storing value retrieved from pool. -* recycled object IS NOT removed from pool -* target pointer DOES NOT become owner of the new value -* this function IS NOT thread-safe -* you SHOULD NOT modify shared pool during enumeration (although you can - modify state of the objects retrieved from pool) -* in case there is no recycled objects left in the pool, NULL is stored. -* in case pool is not seeded, NULL is stored. - -pool pool -pptr pointer to ae_smart_ptr structure -state ALGLIB environment state -************************************************************************/ -void ae_shared_pool_next_recycled( - ae_shared_pool *pool, - ae_smart_ptr *pptr, - ae_state *state) -{ - /* exit on end of list */ - if( pool->enumeration_counter==NULL ) - { - ae_smart_ptr_assign(pptr, NULL, ae_false, ae_false, NULL); - return; - } - - /* modify internal enumeration counter */ - pool->enumeration_counter = (ae_shared_pool_entry*)pool->enumeration_counter->next_entry; - - /* exit on empty list */ - if( pool->enumeration_counter==NULL ) - { - ae_smart_ptr_assign(pptr, NULL, ae_false, ae_false, NULL); - return; - } - - /* assign object to smart pointer */ - ae_smart_ptr_assign(pptr, pool->enumeration_counter->obj, ae_false, ae_false, pool->destroy); -} - - - -/************************************************************************ -This function clears internal list of recycled objects and seed object. -However, pool still can be used (after initialization with another seed). - -pool pool -state ALGLIB environment state - -NOTE: this function is NOT thread-safe. It does not acquire pool lock, so - you should NOT call it when lock can be used by another thread. -************************************************************************/ -void ae_shared_pool_reset( - ae_shared_pool *pool, - ae_state *state) -{ - /* clear seed and lists */ - ae_shared_pool_internalclear(pool); - - /* clear fields */ - pool->seed_object = NULL; - pool->recycled_objects = NULL; - pool->recycled_entries = NULL; - pool->enumeration_counter = NULL; - pool->size_of_object = 0; - pool->init = NULL; - pool->init_copy = NULL; - pool->destroy = NULL; -} - - -/************************************************************************ -This function initializes serializer -************************************************************************/ -void ae_serializer_init(ae_serializer *serializer) -{ - serializer->mode = AE_SM_DEFAULT; - serializer->entries_needed = 0; - serializer->bytes_asked = 0; -} - -void ae_serializer_clear(ae_serializer *serializer) -{ -} - -void ae_serializer_alloc_start(ae_serializer *serializer) -{ - serializer->entries_needed = 0; - serializer->bytes_asked = 0; - serializer->mode = AE_SM_ALLOC; -} - -void ae_serializer_alloc_entry(ae_serializer *serializer) -{ - serializer->entries_needed++; -} - -ae_int_t ae_serializer_get_alloc_size(ae_serializer *serializer) -{ - ae_int_t rows, lastrowsize, result; - - serializer->mode = AE_SM_READY2S; - - /* if no entries needes (degenerate case) */ - if( serializer->entries_needed==0 ) - { - serializer->bytes_asked = 1; - return serializer->bytes_asked; - } - - /* non-degenerate case */ - rows = serializer->entries_needed/AE_SER_ENTRIES_PER_ROW; - lastrowsize = AE_SER_ENTRIES_PER_ROW; - if( serializer->entries_needed%AE_SER_ENTRIES_PER_ROW ) - { - lastrowsize = serializer->entries_needed%AE_SER_ENTRIES_PER_ROW; - rows++; - } - - /* calculate result size */ - result = ((rows-1)*AE_SER_ENTRIES_PER_ROW+lastrowsize)*AE_SER_ENTRY_LENGTH; - result += (rows-1)*(AE_SER_ENTRIES_PER_ROW-1)+(lastrowsize-1); - result += rows*2; - serializer->bytes_asked = result; - return result; -} - -#ifdef AE_USE_CPP_SERIALIZATION -void ae_serializer_sstart_str(ae_serializer *serializer, std::string *buf) -{ - serializer->mode = AE_SM_TO_CPPSTRING; - serializer->out_cppstr = buf; - serializer->entries_saved = 0; - serializer->bytes_written = 0; -} -#endif - -#ifdef AE_USE_CPP_SERIALIZATION -void ae_serializer_ustart_str(ae_serializer *serializer, const std::string *buf) -{ - serializer->mode = AE_SM_FROM_STRING; - serializer->in_str = buf->c_str(); -} -#endif - -void ae_serializer_sstart_str(ae_serializer *serializer, char *buf) -{ - serializer->mode = AE_SM_TO_STRING; - serializer->out_str = buf; - serializer->out_str[0] = 0; - serializer->entries_saved = 0; - serializer->bytes_written = 0; -} - -void ae_serializer_ustart_str(ae_serializer *serializer, const char *buf) -{ - serializer->mode = AE_SM_FROM_STRING; - serializer->in_str = buf; -} - -void ae_serializer_serialize_bool(ae_serializer *serializer, ae_bool v, ae_state *state) -{ - char buf[AE_SER_ENTRY_LENGTH+2+1]; - const char *emsg = "ALGLIB: serialization integrity error"; - ae_int_t bytes_appended; - - /* prepare serialization, check consistency */ - ae_bool2str(v, buf, state); - serializer->entries_saved++; - if( serializer->entries_saved%AE_SER_ENTRIES_PER_ROW ) - strcat(buf, " "); - else - strcat(buf, "\r\n"); - bytes_appended = (ae_int_t)strlen(buf); - if( serializer->bytes_written+bytes_appended > serializer->bytes_asked ) - ae_break(state, ERR_ASSERTION_FAILED, emsg); - serializer->bytes_written += bytes_appended; - - /* append to buffer */ -#ifdef AE_USE_CPP_SERIALIZATION - if( serializer->mode==AE_SM_TO_CPPSTRING ) - { - *(serializer->out_cppstr) += buf; - return; - } -#endif - if( serializer->mode==AE_SM_TO_STRING ) - { - strcat(serializer->out_str, buf); - serializer->out_str += bytes_appended; - return; - } - ae_break(state, ERR_ASSERTION_FAILED, emsg); -} - -void ae_serializer_serialize_int(ae_serializer *serializer, ae_int_t v, ae_state *state) -{ - char buf[AE_SER_ENTRY_LENGTH+2+1]; - const char *emsg = "ALGLIB: serialization integrity error"; - ae_int_t bytes_appended; - - /* prepare serialization, check consistency */ - ae_int2str(v, buf, state); - serializer->entries_saved++; - if( serializer->entries_saved%AE_SER_ENTRIES_PER_ROW ) - strcat(buf, " "); - else - strcat(buf, "\r\n"); - bytes_appended = (ae_int_t)strlen(buf); - if( serializer->bytes_written+bytes_appended > serializer->bytes_asked ) - ae_break(state, ERR_ASSERTION_FAILED, emsg); - serializer->bytes_written += bytes_appended; - - /* append to buffer */ -#ifdef AE_USE_CPP_SERIALIZATION - if( serializer->mode==AE_SM_TO_CPPSTRING ) - { - *(serializer->out_cppstr) += buf; - return; - } -#endif - if( serializer->mode==AE_SM_TO_STRING ) - { - strcat(serializer->out_str, buf); - serializer->out_str += bytes_appended; - return; - } - ae_break(state, ERR_ASSERTION_FAILED, emsg); -} - -void ae_serializer_serialize_double(ae_serializer *serializer, double v, ae_state *state) -{ - char buf[AE_SER_ENTRY_LENGTH+2+1]; - const char *emsg = "ALGLIB: serialization integrity error"; - ae_int_t bytes_appended; - - /* prepare serialization, check consistency */ - ae_double2str(v, buf, state); - serializer->entries_saved++; - if( serializer->entries_saved%AE_SER_ENTRIES_PER_ROW ) - strcat(buf, " "); - else - strcat(buf, "\r\n"); - bytes_appended = (ae_int_t)strlen(buf); - if( serializer->bytes_written+bytes_appended > serializer->bytes_asked ) - ae_break(state, ERR_ASSERTION_FAILED, emsg); - serializer->bytes_written += bytes_appended; - - /* append to buffer */ -#ifdef AE_USE_CPP_SERIALIZATION - if( serializer->mode==AE_SM_TO_CPPSTRING ) - { - *(serializer->out_cppstr) += buf; - return; - } -#endif - if( serializer->mode==AE_SM_TO_STRING ) - { - strcat(serializer->out_str, buf); - serializer->out_str += bytes_appended; - return; - } - ae_break(state, ERR_ASSERTION_FAILED, emsg); -} - -void ae_serializer_unserialize_bool(ae_serializer *serializer, ae_bool *v, ae_state *state) -{ - *v = ae_str2bool(serializer->in_str, state, &serializer->in_str); -} - -void ae_serializer_unserialize_int(ae_serializer *serializer, ae_int_t *v, ae_state *state) -{ - *v = ae_str2int(serializer->in_str, state, &serializer->in_str); -} - -void ae_serializer_unserialize_double(ae_serializer *serializer, double *v, ae_state *state) -{ - *v = ae_str2double(serializer->in_str, state, &serializer->in_str); -} - -void ae_serializer_stop(ae_serializer *serializer) -{ -} - - -/************************************************************************ -Complex math functions -************************************************************************/ -ae_complex ae_complex_from_d(double v) -{ - ae_complex r; - r.x = v; - r.y = 0.0; - return r; -} - -ae_complex ae_c_neg(ae_complex lhs) -{ - ae_complex result; - result.x = -lhs.x; - result.y = -lhs.y; - return result; -} - -ae_complex ae_c_conj(ae_complex lhs, ae_state *state) -{ - ae_complex result; - result.x = +lhs.x; - result.y = -lhs.y; - return result; -} - -ae_complex ae_c_sqr(ae_complex lhs, ae_state *state) -{ - ae_complex result; - result.x = lhs.x*lhs.x-lhs.y*lhs.y; - result.y = 2*lhs.x*lhs.y; - return result; -} - -double ae_c_abs(ae_complex z, ae_state *state) -{ - double w; - double xabs; - double yabs; - double v; - - xabs = fabs(z.x); - yabs = fabs(z.y); - w = xabs>yabs ? xabs : yabs; - v = xabsx; - v0y = -v0->y; - v1x = v1->x; - v1y = -v1->y; - rx += v0x*v1x-v0y*v1y; - ry += v0x*v1y+v0y*v1x; - } - } - if( !bconj0 && bconj1 ) - { - double v0x, v0y, v1x, v1y; - for(i=0; ix; - v0y = v0->y; - v1x = v1->x; - v1y = -v1->y; - rx += v0x*v1x-v0y*v1y; - ry += v0x*v1y+v0y*v1x; - } - } - if( bconj0 && !bconj1 ) - { - double v0x, v0y, v1x, v1y; - for(i=0; ix; - v0y = -v0->y; - v1x = v1->x; - v1y = v1->y; - rx += v0x*v1x-v0y*v1y; - ry += v0x*v1y+v0y*v1x; - } - } - if( !bconj0 && !bconj1 ) - { - double v0x, v0y, v1x, v1y; - for(i=0; ix; - v0y = v0->y; - v1x = v1->x; - v1y = v1->y; - rx += v0x*v1x-v0y*v1y; - ry += v0x*v1y+v0y*v1x; - } - } - result.x = rx; - result.y = ry; - return result; -} - -void ae_v_cmove(ae_complex *vdst, ae_int_t stride_dst, const ae_complex* vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n) -{ - ae_bool bconj = !((conj_src[0]=='N') || (conj_src[0]=='n')); - ae_int_t i; - if( stride_dst!=1 || stride_src!=1 ) - { - /* - * general unoptimized case - */ - if( bconj ) - { - for(i=0; ix = vsrc->x; - vdst->y = -vsrc->y; - } - } - else - { - for(i=0; ix = vsrc->x; - vdst->y = -vsrc->y; - } - } - else - { - for(i=0; ix = -vsrc->x; - vdst->y = vsrc->y; - } - } - else - { - for(i=0; ix = -vsrc->x; - vdst->y = -vsrc->y; - } - } - } - else - { - /* - * optimized case - */ - if( bconj ) - { - for(i=0; ix = -vsrc->x; - vdst->y = vsrc->y; - } - } - else - { - for(i=0; ix = -vsrc->x; - vdst->y = -vsrc->y; - } - } - } -} - -void ae_v_cmoved(ae_complex *vdst, ae_int_t stride_dst, const ae_complex* vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, double alpha) -{ - ae_bool bconj = !((conj_src[0]=='N') || (conj_src[0]=='n')); - ae_int_t i; - if( stride_dst!=1 || stride_src!=1 ) - { - /* - * general unoptimized case - */ - if( bconj ) - { - for(i=0; ix = alpha*vsrc->x; - vdst->y = -alpha*vsrc->y; - } - } - else - { - for(i=0; ix = alpha*vsrc->x; - vdst->y = alpha*vsrc->y; - } - } - } - else - { - /* - * optimized case - */ - if( bconj ) - { - for(i=0; ix = alpha*vsrc->x; - vdst->y = -alpha*vsrc->y; - } - } - else - { - for(i=0; ix = alpha*vsrc->x; - vdst->y = alpha*vsrc->y; - } - } - } -} - -void ae_v_cmovec(ae_complex *vdst, ae_int_t stride_dst, const ae_complex* vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, ae_complex alpha) -{ - ae_bool bconj = !((conj_src[0]=='N') || (conj_src[0]=='n')); - ae_int_t i; - if( stride_dst!=1 || stride_src!=1 ) - { - /* - * general unoptimized case - */ - if( bconj ) - { - double ax = alpha.x, ay = alpha.y; - for(i=0; ix = ax*vsrc->x+ay*vsrc->y; - vdst->y = -ax*vsrc->y+ay*vsrc->x; - } - } - else - { - double ax = alpha.x, ay = alpha.y; - for(i=0; ix = ax*vsrc->x-ay*vsrc->y; - vdst->y = ax*vsrc->y+ay*vsrc->x; - } - } - } - else - { - /* - * highly optimized case - */ - if( bconj ) - { - double ax = alpha.x, ay = alpha.y; - for(i=0; ix = ax*vsrc->x+ay*vsrc->y; - vdst->y = -ax*vsrc->y+ay*vsrc->x; - } - } - else - { - double ax = alpha.x, ay = alpha.y; - for(i=0; ix = ax*vsrc->x-ay*vsrc->y; - vdst->y = ax*vsrc->y+ay*vsrc->x; - } - } - } -} - -void ae_v_cadd(ae_complex *vdst, ae_int_t stride_dst, const ae_complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n) -{ - ae_bool bconj = !((conj_src[0]=='N') || (conj_src[0]=='n')); - ae_int_t i; - if( stride_dst!=1 || stride_src!=1 ) - { - /* - * general unoptimized case - */ - if( bconj ) - { - for(i=0; ix += vsrc->x; - vdst->y -= vsrc->y; - } - } - else - { - for(i=0; ix += vsrc->x; - vdst->y += vsrc->y; - } - } - } - else - { - /* - * optimized case - */ - if( bconj ) - { - for(i=0; ix += vsrc->x; - vdst->y -= vsrc->y; - } - } - else - { - for(i=0; ix += vsrc->x; - vdst->y += vsrc->y; - } - } - } -} - -void ae_v_caddd(ae_complex *vdst, ae_int_t stride_dst, const ae_complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, double alpha) -{ - ae_bool bconj = !((conj_src[0]=='N') || (conj_src[0]=='n')); - ae_int_t i; - if( stride_dst!=1 || stride_src!=1 ) - { - /* - * general unoptimized case - */ - if( bconj ) - { - for(i=0; ix += alpha*vsrc->x; - vdst->y -= alpha*vsrc->y; - } - } - else - { - for(i=0; ix += alpha*vsrc->x; - vdst->y += alpha*vsrc->y; - } - } - } - else - { - /* - * optimized case - */ - if( bconj ) - { - for(i=0; ix += alpha*vsrc->x; - vdst->y -= alpha*vsrc->y; - } - } - else - { - for(i=0; ix += alpha*vsrc->x; - vdst->y += alpha*vsrc->y; - } - } - } -} - -void ae_v_caddc(ae_complex *vdst, ae_int_t stride_dst, const ae_complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, ae_complex alpha) -{ - ae_bool bconj = !((conj_src[0]=='N') || (conj_src[0]=='n')); - ae_int_t i; - if( stride_dst!=1 || stride_src!=1 ) - { - /* - * general unoptimized case - */ - double ax = alpha.x, ay = alpha.y; - if( bconj ) - { - for(i=0; ix += ax*vsrc->x+ay*vsrc->y; - vdst->y -= ax*vsrc->y-ay*vsrc->x; - } - } - else - { - for(i=0; ix += ax*vsrc->x-ay*vsrc->y; - vdst->y += ax*vsrc->y+ay*vsrc->x; - } - } - } - else - { - /* - * highly optimized case - */ - double ax = alpha.x, ay = alpha.y; - if( bconj ) - { - for(i=0; ix += ax*vsrc->x+ay*vsrc->y; - vdst->y -= ax*vsrc->y-ay*vsrc->x; - } - } - else - { - for(i=0; ix += ax*vsrc->x-ay*vsrc->y; - vdst->y += ax*vsrc->y+ay*vsrc->x; - } - } - } -} - -void ae_v_csub(ae_complex *vdst, ae_int_t stride_dst, const ae_complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n) -{ - ae_bool bconj = !((conj_src[0]=='N') || (conj_src[0]=='n')); - ae_int_t i; - if( stride_dst!=1 || stride_src!=1 ) - { - /* - * general unoptimized case - */ - if( bconj ) - { - for(i=0; ix -= vsrc->x; - vdst->y += vsrc->y; - } - } - else - { - for(i=0; ix -= vsrc->x; - vdst->y -= vsrc->y; - } - } - } - else - { - /* - * highly optimized case - */ - if( bconj ) - { - for(i=0; ix -= vsrc->x; - vdst->y += vsrc->y; - } - } - else - { - for(i=0; ix -= vsrc->x; - vdst->y -= vsrc->y; - } - } - } -} - -void ae_v_csubd(ae_complex *vdst, ae_int_t stride_dst, const ae_complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, double alpha) -{ - ae_v_caddd(vdst, stride_dst, vsrc, stride_src, conj_src, n, -alpha); -} - -void ae_v_csubc(ae_complex *vdst, ae_int_t stride_dst, const ae_complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, ae_complex alpha) -{ - alpha.x = -alpha.x; - alpha.y = -alpha.y; - ae_v_caddc(vdst, stride_dst, vsrc, stride_src, conj_src, n, alpha); -} - -void ae_v_cmuld(ae_complex *vdst, ae_int_t stride_dst, ae_int_t n, double alpha) -{ - ae_int_t i; - if( stride_dst!=1 ) - { - /* - * general unoptimized case - */ - for(i=0; ix *= alpha; - vdst->y *= alpha; - } - } - else - { - /* - * optimized case - */ - for(i=0; ix *= alpha; - vdst->y *= alpha; - } - } -} - -void ae_v_cmulc(ae_complex *vdst, ae_int_t stride_dst, ae_int_t n, ae_complex alpha) -{ - ae_int_t i; - if( stride_dst!=1 ) - { - /* - * general unoptimized case - */ - double ax = alpha.x, ay = alpha.y; - for(i=0; ix, dsty = vdst->y; - vdst->x = ax*dstx-ay*dsty; - vdst->y = ax*dsty+ay*dstx; - } - } - else - { - /* - * highly optimized case - */ - double ax = alpha.x, ay = alpha.y; - for(i=0; ix, dsty = vdst->y; - vdst->x = ax*dstx-ay*dsty; - vdst->y = ax*dsty+ay*dstx; - } - } -} - -/************************************************************************ -Real BLAS operations -************************************************************************/ -double ae_v_dotproduct(const double *v0, ae_int_t stride0, const double *v1, ae_int_t stride1, ae_int_t n) -{ - double result = 0; - ae_int_t i; - if( stride0!=1 || stride1!=1 ) - { - /* - * slow general code - */ - for(i=0; iba, 0, DT_BOOL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->ia, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->ra, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->ca, 0, DT_COMPLEX, _state, make_automatic) ) - return ae_false; - return ae_true; -} - -ae_bool _rcommstate_init_copy(rcommstate* dst, rcommstate* src, ae_state *_state, ae_bool make_automatic) -{ - if( !ae_vector_init_copy(&dst->ba, &src->ba, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->ia, &src->ia, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->ra, &src->ra, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->ca, &src->ca, _state, make_automatic) ) - return ae_false; - dst->stage = src->stage; - return ae_true; -} - -void _rcommstate_clear(rcommstate* p) -{ - ae_vector_clear(&p->ba); - ae_vector_clear(&p->ia); - ae_vector_clear(&p->ra); - ae_vector_clear(&p->ca); -} - -void _rcommstate_destroy(rcommstate* p) -{ - _rcommstate_clear(p); -} - -#ifdef AE_DEBUG4WINDOWS -int _tickcount() -{ - return GetTickCount(); -} -#endif - -#ifdef AE_DEBUG4POSIX -#include -int _tickcount() -{ - struct timespec now; - if (clock_gettime(CLOCK_MONOTONIC, &now) ) - return 0; - return now.tv_sec * 1000.0 + now.tv_nsec / 1000000.0; -} -#endif - -#ifdef AE_DEBUGRNG -void ae_set_seed(ae_int_t s0, ae_int_t s1) -{ - ae_int_t hqrnd_hqrndm1 = 2147483563; - ae_int_t hqrnd_hqrndm2 = 2147483399; - - while(s0<1) - s0 += hqrnd_hqrndm1-1; - while(s0>hqrnd_hqrndm1-1) - s0 -= hqrnd_hqrndm1-1; - - while(s1<1) - s1 += hqrnd_hqrndm2-1; - while(s1>hqrnd_hqrndm2-1) - s1 -= hqrnd_hqrndm2-1; - - _debug_rng_s0 = s0; - _debug_rng_s1 = s1; -} - -void ae_get_seed(ae_int_t *s0, ae_int_t *s1) -{ - *s0 = _debug_rng_s0; - *s1 = _debug_rng_s1; -} -#endif - -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS C++ RELATED FUNCTIONALITY -// -///////////////////////////////////////////////////////////////////////// -/******************************************************************** -Internal forwards -********************************************************************/ -namespace alglib -{ - double get_aenv_nan(); - double get_aenv_posinf(); - double get_aenv_neginf(); - ae_int_t my_stricmp(const char *s1, const char *s2); - char* filter_spaces(const char *s); - void str_vector_create(const char *src, bool match_head_only, std::vector *p_vec); - void str_matrix_create(const char *src, std::vector< std::vector > *p_mat); - - ae_bool parse_bool_delim(const char *s, const char *delim); - ae_int_t parse_int_delim(const char *s, const char *delim); - bool _parse_real_delim(const char *s, const char *delim, double *result, const char **new_s); - double parse_real_delim(const char *s, const char *delim); - alglib::complex parse_complex_delim(const char *s, const char *delim); - - std::string arraytostring(const bool *ptr, ae_int_t n); - std::string arraytostring(const ae_int_t *ptr, ae_int_t n); - std::string arraytostring(const double *ptr, ae_int_t n, int dps); - std::string arraytostring(const alglib::complex *ptr, ae_int_t n, int dps); -} - -/******************************************************************** -Global and local constants -********************************************************************/ -const double alglib::machineepsilon = 5E-16; -const double alglib::maxrealnumber = 1E300; -const double alglib::minrealnumber = 1E-300; -const alglib::ae_int_t alglib::endianness = alglib_impl::ae_get_endianness(); -const double alglib::fp_nan = alglib::get_aenv_nan(); -const double alglib::fp_posinf = alglib::get_aenv_posinf(); -const double alglib::fp_neginf = alglib::get_aenv_neginf(); - - -/******************************************************************** -ap_error -********************************************************************/ -alglib::ap_error::ap_error() -{ -} - -alglib::ap_error::ap_error(const char *s) -{ - msg = s; -} - -void alglib::ap_error::make_assertion(bool bClause) -{ - if(!bClause) - throw ap_error(); -} - -void alglib::ap_error::make_assertion(bool bClause, const char *msg) -{ - if(!bClause) - throw ap_error(msg); -} - - -/******************************************************************** -Complex number with double precision. -********************************************************************/ -alglib::complex::complex():x(0.0),y(0.0) -{ -} - -alglib::complex::complex(const double &_x):x(_x),y(0.0) -{ -} - -alglib::complex::complex(const double &_x, const double &_y):x(_x),y(_y) -{ -} - -alglib::complex::complex(const alglib::complex &z):x(z.x),y(z.y) -{ -} - -alglib::complex& alglib::complex::operator= (const double& v) -{ - x = v; - y = 0.0; - return *this; -} - -alglib::complex& alglib::complex::operator+=(const double& v) -{ - x += v; - return *this; -} - -alglib::complex& alglib::complex::operator-=(const double& v) -{ - x -= v; - return *this; -} - -alglib::complex& alglib::complex::operator*=(const double& v) -{ - x *= v; - y *= v; - return *this; -} - -alglib::complex& alglib::complex::operator/=(const double& v) -{ - x /= v; - y /= v; - return *this; -} - -alglib::complex& alglib::complex::operator= (const alglib::complex& z) -{ - x = z.x; - y = z.y; - return *this; -} - -alglib::complex& alglib::complex::operator+=(const alglib::complex& z) -{ - x += z.x; - y += z.y; - return *this; -} - -alglib::complex& alglib::complex::operator-=(const alglib::complex& z) -{ - x -= z.x; - y -= z.y; - return *this; -} - -alglib::complex& alglib::complex::operator*=(const alglib::complex& z) -{ - double t = x*z.x-y*z.y; - y = x*z.y+y*z.x; - x = t; - return *this; -} - -alglib::complex& alglib::complex::operator/=(const alglib::complex& z) -{ - alglib::complex result; - double e; - double f; - if( fabs(z.y)=0 ? _dps : -_dps; - if( dps<=0 || dps>=20 ) - throw ap_error("complex::tostring(): incorrect dps"); - - // handle IEEE special quantities - if( fp_isnan(x) || fp_isnan(y) ) - return "NAN"; - if( fp_isinf(x) || fp_isinf(y) ) - return "INF"; - - // generate mask - if( sprintf(mask, "%%.%d%s", dps, _dps>=0 ? "f" : "e")>=(int)sizeof(mask) ) - throw ap_error("complex::tostring(): buffer overflow"); - - // print |x|, |y| and zero with same mask and compare - if( sprintf(buf_x, mask, (double)(fabs(x)))>=(int)sizeof(buf_x) ) - throw ap_error("complex::tostring(): buffer overflow"); - if( sprintf(buf_y, mask, (double)(fabs(y)))>=(int)sizeof(buf_y) ) - throw ap_error("complex::tostring(): buffer overflow"); - if( sprintf(buf_zero, mask, (double)0)>=(int)sizeof(buf_zero) ) - throw ap_error("complex::tostring(): buffer overflow"); - - // different zero/nonzero patterns - if( strcmp(buf_x,buf_zero)!=0 && strcmp(buf_y,buf_zero)!=0 ) - return std::string(x>0 ? "" : "-")+buf_x+(y>0 ? "+" : "-")+buf_y+"i"; - if( strcmp(buf_x,buf_zero)!=0 && strcmp(buf_y,buf_zero)==0 ) - return std::string(x>0 ? "" : "-")+buf_x; - if( strcmp(buf_x,buf_zero)==0 && strcmp(buf_y,buf_zero)!=0 ) - return std::string(y>0 ? "" : "-")+buf_y+"i"; - return std::string("0"); -} - -const bool alglib::operator==(const alglib::complex& lhs, const alglib::complex& rhs) -{ - volatile double x1 = lhs.x; - volatile double x2 = rhs.x; - volatile double y1 = lhs.y; - volatile double y2 = rhs.y; - return x1==x2 && y1==y2; -} - -const bool alglib::operator!=(const alglib::complex& lhs, const alglib::complex& rhs) -{ return !(lhs==rhs); } - -const alglib::complex alglib::operator+(const alglib::complex& lhs) -{ return lhs; } - -const alglib::complex alglib::operator-(const alglib::complex& lhs) -{ return alglib::complex(-lhs.x, -lhs.y); } - -const alglib::complex alglib::operator+(const alglib::complex& lhs, const alglib::complex& rhs) -{ alglib::complex r = lhs; r += rhs; return r; } - -const alglib::complex alglib::operator+(const alglib::complex& lhs, const double& rhs) -{ alglib::complex r = lhs; r += rhs; return r; } - -const alglib::complex alglib::operator+(const double& lhs, const alglib::complex& rhs) -{ alglib::complex r = rhs; r += lhs; return r; } - -const alglib::complex alglib::operator-(const alglib::complex& lhs, const alglib::complex& rhs) -{ alglib::complex r = lhs; r -= rhs; return r; } - -const alglib::complex alglib::operator-(const alglib::complex& lhs, const double& rhs) -{ alglib::complex r = lhs; r -= rhs; return r; } - -const alglib::complex alglib::operator-(const double& lhs, const alglib::complex& rhs) -{ alglib::complex r = lhs; r -= rhs; return r; } - -const alglib::complex alglib::operator*(const alglib::complex& lhs, const alglib::complex& rhs) -{ return alglib::complex(lhs.x*rhs.x - lhs.y*rhs.y, lhs.x*rhs.y + lhs.y*rhs.x); } - -const alglib::complex alglib::operator*(const alglib::complex& lhs, const double& rhs) -{ return alglib::complex(lhs.x*rhs, lhs.y*rhs); } - -const alglib::complex alglib::operator*(const double& lhs, const alglib::complex& rhs) -{ return alglib::complex(lhs*rhs.x, lhs*rhs.y); } - -const alglib::complex alglib::operator/(const alglib::complex& lhs, const alglib::complex& rhs) -{ - alglib::complex result; - double e; - double f; - if( fabs(rhs.y)yabs ? xabs : yabs; - v = xabsx; - v0y = -v0->y; - v1x = v1->x; - v1y = -v1->y; - rx += v0x*v1x-v0y*v1y; - ry += v0x*v1y+v0y*v1x; - } - } - if( !bconj0 && bconj1 ) - { - double v0x, v0y, v1x, v1y; - for(i=0; ix; - v0y = v0->y; - v1x = v1->x; - v1y = -v1->y; - rx += v0x*v1x-v0y*v1y; - ry += v0x*v1y+v0y*v1x; - } - } - if( bconj0 && !bconj1 ) - { - double v0x, v0y, v1x, v1y; - for(i=0; ix; - v0y = -v0->y; - v1x = v1->x; - v1y = v1->y; - rx += v0x*v1x-v0y*v1y; - ry += v0x*v1y+v0y*v1x; - } - } - if( !bconj0 && !bconj1 ) - { - double v0x, v0y, v1x, v1y; - for(i=0; ix; - v0y = v0->y; - v1x = v1->x; - v1y = v1->y; - rx += v0x*v1x-v0y*v1y; - ry += v0x*v1y+v0y*v1x; - } - } - return alglib::complex(rx,ry); -} - -alglib::complex alglib::vdotproduct(const alglib::complex *v1, const alglib::complex *v2, ae_int_t N) -{ - return vdotproduct(v1, 1, "N", v2, 1, "N", N); -} - -void alglib::vmove(double *vdst, ae_int_t stride_dst, const double* vsrc, ae_int_t stride_src, ae_int_t n) -{ - ae_int_t i; - if( stride_dst!=1 || stride_src!=1 ) - { - // - // general unoptimized case - // - for(i=0; ix = vsrc->x; - vdst->y = -vsrc->y; - } - } - else - { - for(i=0; ix = vsrc->x; - vdst->y = -vsrc->y; - } - } - else - { - for(i=0; ix = -vsrc->x; - vdst->y = vsrc->y; - } - } - else - { - for(i=0; ix = -vsrc->x; - vdst->y = -vsrc->y; - } - } - } - else - { - // - // optimized case - // - if( bconj ) - { - for(i=0; ix = -vsrc->x; - vdst->y = vsrc->y; - } - } - else - { - for(i=0; ix = -vsrc->x; - vdst->y = -vsrc->y; - } - } - } -} - -void alglib::vmoveneg(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N) -{ - vmoveneg(vdst, 1, vsrc, 1, "N", N); -} - -void alglib::vmove(double *vdst, ae_int_t stride_dst, const double* vsrc, ae_int_t stride_src, ae_int_t n, double alpha) -{ - ae_int_t i; - if( stride_dst!=1 || stride_src!=1 ) - { - // - // general unoptimized case - // - for(i=0; ix = alpha*vsrc->x; - vdst->y = -alpha*vsrc->y; - } - } - else - { - for(i=0; ix = alpha*vsrc->x; - vdst->y = alpha*vsrc->y; - } - } - } - else - { - // - // optimized case - // - if( bconj ) - { - for(i=0; ix = alpha*vsrc->x; - vdst->y = -alpha*vsrc->y; - } - } - else - { - for(i=0; ix = alpha*vsrc->x; - vdst->y = alpha*vsrc->y; - } - } - } -} - -void alglib::vmove(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N, double alpha) -{ - vmove(vdst, 1, vsrc, 1, "N", N, alpha); -} - -void alglib::vmove(alglib::complex *vdst, ae_int_t stride_dst, const alglib::complex* vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, alglib::complex alpha) -{ - bool bconj = !((conj_src[0]=='N') || (conj_src[0]=='n')); - ae_int_t i; - if( stride_dst!=1 || stride_src!=1 ) - { - // - // general unoptimized case - // - if( bconj ) - { - double ax = alpha.x, ay = alpha.y; - for(i=0; ix = ax*vsrc->x+ay*vsrc->y; - vdst->y = -ax*vsrc->y+ay*vsrc->x; - } - } - else - { - double ax = alpha.x, ay = alpha.y; - for(i=0; ix = ax*vsrc->x-ay*vsrc->y; - vdst->y = ax*vsrc->y+ay*vsrc->x; - } - } - } - else - { - // - // optimized case - // - if( bconj ) - { - double ax = alpha.x, ay = alpha.y; - for(i=0; ix = ax*vsrc->x+ay*vsrc->y; - vdst->y = -ax*vsrc->y+ay*vsrc->x; - } - } - else - { - double ax = alpha.x, ay = alpha.y; - for(i=0; ix = ax*vsrc->x-ay*vsrc->y; - vdst->y = ax*vsrc->y+ay*vsrc->x; - } - } - } -} - -void alglib::vmove(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N, alglib::complex alpha) -{ - vmove(vdst, 1, vsrc, 1, "N", N, alpha); -} - -void alglib::vadd(double *vdst, ae_int_t stride_dst, const double *vsrc, ae_int_t stride_src, ae_int_t n) -{ - ae_int_t i; - if( stride_dst!=1 || stride_src!=1 ) - { - // - // general unoptimized case - // - for(i=0; ix += vsrc->x; - vdst->y -= vsrc->y; - } - } - else - { - for(i=0; ix += vsrc->x; - vdst->y += vsrc->y; - } - } - } - else - { - // - // optimized case - // - if( bconj ) - { - for(i=0; ix += vsrc->x; - vdst->y -= vsrc->y; - } - } - else - { - for(i=0; ix += vsrc->x; - vdst->y += vsrc->y; - } - } - } -} - -void alglib::vadd(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N) -{ - vadd(vdst, 1, vsrc, 1, "N", N); -} - -void alglib::vadd(double *vdst, ae_int_t stride_dst, const double *vsrc, ae_int_t stride_src, ae_int_t n, double alpha) -{ - ae_int_t i; - if( stride_dst!=1 || stride_src!=1 ) - { - // - // general unoptimized case - // - for(i=0; ix += alpha*vsrc->x; - vdst->y -= alpha*vsrc->y; - } - } - else - { - for(i=0; ix += alpha*vsrc->x; - vdst->y += alpha*vsrc->y; - } - } - } - else - { - // - // optimized case - // - if( bconj ) - { - for(i=0; ix += alpha*vsrc->x; - vdst->y -= alpha*vsrc->y; - } - } - else - { - for(i=0; ix += alpha*vsrc->x; - vdst->y += alpha*vsrc->y; - } - } - } -} - -void alglib::vadd(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N, double alpha) -{ - vadd(vdst, 1, vsrc, 1, "N", N, alpha); -} - -void alglib::vadd(alglib::complex *vdst, ae_int_t stride_dst, const alglib::complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, alglib::complex alpha) -{ - bool bconj = !((conj_src[0]=='N') || (conj_src[0]=='n')); - ae_int_t i; - if( stride_dst!=1 || stride_src!=1 ) - { - // - // general unoptimized case - // - double ax = alpha.x, ay = alpha.y; - if( bconj ) - { - for(i=0; ix += ax*vsrc->x+ay*vsrc->y; - vdst->y -= ax*vsrc->y-ay*vsrc->x; - } - } - else - { - for(i=0; ix += ax*vsrc->x-ay*vsrc->y; - vdst->y += ax*vsrc->y+ay*vsrc->x; - } - } - } - else - { - // - // optimized case - // - double ax = alpha.x, ay = alpha.y; - if( bconj ) - { - for(i=0; ix += ax*vsrc->x+ay*vsrc->y; - vdst->y -= ax*vsrc->y-ay*vsrc->x; - } - } - else - { - for(i=0; ix += ax*vsrc->x-ay*vsrc->y; - vdst->y += ax*vsrc->y+ay*vsrc->x; - } - } - } -} - -void alglib::vadd(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N, alglib::complex alpha) -{ - vadd(vdst, 1, vsrc, 1, "N", N, alpha); -} - -void alglib::vsub(double *vdst, ae_int_t stride_dst, const double *vsrc, ae_int_t stride_src, ae_int_t n) -{ - ae_int_t i; - if( stride_dst!=1 || stride_src!=1 ) - { - // - // general unoptimized case - // - for(i=0; ix -= vsrc->x; - vdst->y += vsrc->y; - } - } - else - { - for(i=0; ix -= vsrc->x; - vdst->y -= vsrc->y; - } - } - } - else - { - // - // optimized case - // - if( bconj ) - { - for(i=0; ix -= vsrc->x; - vdst->y += vsrc->y; - } - } - else - { - for(i=0; ix -= vsrc->x; - vdst->y -= vsrc->y; - } - } - } -} - -void alglib::vsub(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N) -{ - vsub(vdst, 1, vsrc, 1, "N", N); -} - -void alglib::vsub(double *vdst, ae_int_t stride_dst, const double *vsrc, ae_int_t stride_src, ae_int_t n, double alpha) -{ - vadd(vdst, stride_dst, vsrc, stride_src, n, -alpha); -} - -void alglib::vsub(double *vdst, const double *vsrc, ae_int_t N, double alpha) -{ - vadd(vdst, 1, vsrc, 1, N, -alpha); -} - -void alglib::vsub(alglib::complex *vdst, ae_int_t stride_dst, const alglib::complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, double alpha) -{ - vadd(vdst, stride_dst, vsrc, stride_src, conj_src, n, -alpha); -} - -void alglib::vsub(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t n, double alpha) -{ - vadd(vdst, 1, vsrc, 1, "N", n, -alpha); -} - -void alglib::vsub(alglib::complex *vdst, ae_int_t stride_dst, const alglib::complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, alglib::complex alpha) -{ - vadd(vdst, stride_dst, vsrc, stride_src, conj_src, n, -alpha); -} - -void alglib::vsub(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t n, alglib::complex alpha) -{ - vadd(vdst, 1, vsrc, 1, "N", n, -alpha); -} -void alglib::vmul(double *vdst, ae_int_t stride_dst, ae_int_t n, double alpha) -{ - ae_int_t i; - if( stride_dst!=1 ) - { - // - // general unoptimized case - // - for(i=0; ix *= alpha; - vdst->y *= alpha; - } - } - else - { - // - // optimized case - // - for(i=0; ix *= alpha; - vdst->y *= alpha; - } - } -} - -void alglib::vmul(alglib::complex *vdst, ae_int_t N, double alpha) -{ - vmul(vdst, 1, N, alpha); -} - -void alglib::vmul(alglib::complex *vdst, ae_int_t stride_dst, ae_int_t n, alglib::complex alpha) -{ - ae_int_t i; - if( stride_dst!=1 ) - { - // - // general unoptimized case - // - double ax = alpha.x, ay = alpha.y; - for(i=0; ix, dsty = vdst->y; - vdst->x = ax*dstx-ay*dsty; - vdst->y = ax*dsty+ay*dstx; - } - } - else - { - // - // optimized case - // - double ax = alpha.x, ay = alpha.y; - for(i=0; ix, dsty = vdst->y; - vdst->x = ax*dstx-ay*dsty; - vdst->y = ax*dsty+ay*dstx; - } - } -} - -void alglib::vmul(alglib::complex *vdst, ae_int_t N, alglib::complex alpha) -{ - vmul(vdst, 1, N, alpha); -} - - -/******************************************************************** -Matrices and vectors -********************************************************************/ -alglib::ae_vector_wrapper::ae_vector_wrapper() -{ - p_vec = NULL; -} - -alglib::ae_vector_wrapper::~ae_vector_wrapper() -{ - if( p_vec==&vec ) - ae_vector_clear(p_vec); -} - -void alglib::ae_vector_wrapper::setlength(ae_int_t iLen) -{ - if( p_vec==NULL ) - throw alglib::ap_error("ALGLIB: setlength() error, p_vec==NULL (array was not correctly initialized)"); - if( p_vec!=&vec ) - throw alglib::ap_error("ALGLIB: setlength() error, p_vec!=&vec (attempt to resize frozen array)"); - if( !ae_vector_set_length(p_vec, iLen, NULL) ) - throw alglib::ap_error("ALGLIB: malloc error"); -} - -alglib::ae_int_t alglib::ae_vector_wrapper::length() const -{ - if( p_vec==NULL ) - return 0; - return p_vec->cnt; -} - -void alglib::ae_vector_wrapper::attach_to(alglib_impl::ae_vector *ptr) -{ - if( ptr==&vec ) - throw alglib::ap_error("ALGLIB: attempt to attach vector to itself"); - if( p_vec==&vec ) - ae_vector_clear(p_vec); - p_vec = ptr; -} - -void alglib::ae_vector_wrapper::allocate_own(ae_int_t size, alglib_impl::ae_datatype datatype) -{ - if( p_vec==&vec ) - ae_vector_clear(p_vec); - p_vec = &vec; - if( !ae_vector_init(p_vec, size, datatype, NULL, false) ) - throw alglib::ap_error("ALGLIB: malloc error"); -} - -const alglib_impl::ae_vector* alglib::ae_vector_wrapper::c_ptr() const -{ - return p_vec; -} - -alglib_impl::ae_vector* alglib::ae_vector_wrapper::c_ptr() -{ - return p_vec; -} - -void alglib::ae_vector_wrapper::create(const alglib::ae_vector_wrapper &rhs) -{ - if( rhs.p_vec!=NULL ) - { - p_vec = &vec; - if( !ae_vector_init_copy(p_vec, rhs.p_vec, NULL, ae_false) ) - throw alglib::ap_error("ALGLIB: malloc error!"); - } - else - p_vec = NULL; -} - -void alglib::ae_vector_wrapper::create(const char *s, alglib_impl::ae_datatype datatype) -{ - std::vector svec; - size_t i; - char *p = filter_spaces(s); - try - { - str_vector_create(p, true, &svec); - allocate_own((ae_int_t)(svec.size()), datatype); - for(i=0; iptr.p_bool[i] = parse_bool_delim(svec[i],",]"); - if( datatype==alglib_impl::DT_INT ) - p_vec->ptr.p_int[i] = parse_int_delim(svec[i],",]"); - if( datatype==alglib_impl::DT_REAL ) - p_vec->ptr.p_double[i] = parse_real_delim(svec[i],",]"); - if( datatype==alglib_impl::DT_COMPLEX ) - { - alglib::complex t = parse_complex_delim(svec[i],",]"); - p_vec->ptr.p_complex[i].x = t.x; - p_vec->ptr.p_complex[i].y = t.y; - } - } - alglib_impl::ae_free(p); - } - catch(...) - { - alglib_impl::ae_free(p); - throw; - } -} - -void alglib::ae_vector_wrapper::assign(const alglib::ae_vector_wrapper &rhs) -{ - if( this==&rhs ) - return; - if( p_vec==&vec || p_vec==NULL ) - { - // - // Assignment to non-proxy object - // - ae_vector_clear(p_vec); - if( rhs.p_vec!=NULL ) - { - p_vec = &vec; - if( !ae_vector_init_copy(p_vec, rhs.p_vec, NULL, ae_false) ) - throw alglib::ap_error("ALGLIB: malloc error!"); - } - else - p_vec = NULL; - } - else - { - // - // Assignment to proxy object - // - if( rhs.p_vec==NULL ) - throw alglib::ap_error("ALGLIB: incorrect assignment to array (sizes do not match)"); - if( rhs.p_vec->datatype!=p_vec->datatype ) - throw alglib::ap_error("ALGLIB: incorrect assignment to array (types do not match)"); - if( rhs.p_vec->cnt!=p_vec->cnt ) - throw alglib::ap_error("ALGLIB: incorrect assignment to array (sizes do not match)"); - memcpy(p_vec->ptr.p_ptr, rhs.p_vec->ptr.p_ptr, p_vec->cnt*alglib_impl::ae_sizeof(p_vec->datatype)); - } -} - -alglib::boolean_1d_array::boolean_1d_array() -{ - allocate_own(0, alglib_impl::DT_BOOL); -} - -alglib::boolean_1d_array::boolean_1d_array(const char *s) -{ - create(s, alglib_impl::DT_BOOL); -} - -alglib::boolean_1d_array::boolean_1d_array(const alglib::boolean_1d_array &rhs) -{ - create(rhs); -} - -alglib::boolean_1d_array::boolean_1d_array(alglib_impl::ae_vector *p) -{ - p_vec = NULL; - attach_to(p); -} - -const alglib::boolean_1d_array& alglib::boolean_1d_array::operator=(const alglib::boolean_1d_array &rhs) -{ - assign(rhs); - return *this; -} - -alglib::boolean_1d_array::~boolean_1d_array() -{ -} - -const ae_bool& alglib::boolean_1d_array::operator()(ae_int_t i) const -{ - return p_vec->ptr.p_bool[i]; -} - -ae_bool& alglib::boolean_1d_array::operator()(ae_int_t i) -{ - return p_vec->ptr.p_bool[i]; -} - -const ae_bool& alglib::boolean_1d_array::operator[](ae_int_t i) const -{ - return p_vec->ptr.p_bool[i]; -} - -ae_bool& alglib::boolean_1d_array::operator[](ae_int_t i) -{ - return p_vec->ptr.p_bool[i]; -} - -void alglib::boolean_1d_array::setcontent(ae_int_t iLen, const bool *pContent ) -{ - ae_int_t i; - setlength(iLen); - for(i=0; iptr.p_bool[i] = pContent[i]; -} - -ae_bool* alglib::boolean_1d_array::getcontent() -{ - return p_vec->ptr.p_bool; -} - -const ae_bool* alglib::boolean_1d_array::getcontent() const -{ - return p_vec->ptr.p_bool; -} - -std::string alglib::boolean_1d_array::tostring() const -{ - if( length()==0 ) - return "[]"; - return arraytostring(&(operator()(0)), length()); -} - -alglib::integer_1d_array::integer_1d_array() -{ - allocate_own(0, alglib_impl::DT_INT); -} - -alglib::integer_1d_array::integer_1d_array(alglib_impl::ae_vector *p) -{ - p_vec = NULL; - attach_to(p); -} - -alglib::integer_1d_array::integer_1d_array(const char *s) -{ - create(s, alglib_impl::DT_INT); -} - -alglib::integer_1d_array::integer_1d_array(const alglib::integer_1d_array &rhs) -{ - create(rhs); -} - -const alglib::integer_1d_array& alglib::integer_1d_array::operator=(const alglib::integer_1d_array &rhs) -{ - assign(rhs); - return *this; -} - -alglib::integer_1d_array::~integer_1d_array() -{ -} - -const alglib::ae_int_t& alglib::integer_1d_array::operator()(ae_int_t i) const -{ - return p_vec->ptr.p_int[i]; -} - -alglib::ae_int_t& alglib::integer_1d_array::operator()(ae_int_t i) -{ - return p_vec->ptr.p_int[i]; -} - -const alglib::ae_int_t& alglib::integer_1d_array::operator[](ae_int_t i) const -{ - return p_vec->ptr.p_int[i]; -} - -alglib::ae_int_t& alglib::integer_1d_array::operator[](ae_int_t i) -{ - return p_vec->ptr.p_int[i]; -} - -void alglib::integer_1d_array::setcontent(ae_int_t iLen, const ae_int_t *pContent ) -{ - ae_int_t i; - setlength(iLen); - for(i=0; iptr.p_int[i] = pContent[i]; -} - -alglib::ae_int_t* alglib::integer_1d_array::getcontent() -{ - return p_vec->ptr.p_int; -} - -const alglib::ae_int_t* alglib::integer_1d_array::getcontent() const -{ - return p_vec->ptr.p_int; -} - -std::string alglib::integer_1d_array::tostring() const -{ - if( length()==0 ) - return "[]"; - return arraytostring(&operator()(0), length()); -} - -alglib::real_1d_array::real_1d_array() -{ - allocate_own(0, alglib_impl::DT_REAL); -} - -alglib::real_1d_array::real_1d_array(alglib_impl::ae_vector *p) -{ - p_vec = NULL; - attach_to(p); -} - -alglib::real_1d_array::real_1d_array(const char *s) -{ - create(s, alglib_impl::DT_REAL); -} - -alglib::real_1d_array::real_1d_array(const alglib::real_1d_array &rhs) -{ - create(rhs); -} - -const alglib::real_1d_array& alglib::real_1d_array::operator=(const alglib::real_1d_array &rhs) -{ - assign(rhs); - return *this; -} - -alglib::real_1d_array::~real_1d_array() -{ -} - -const double& alglib::real_1d_array::operator()(ae_int_t i) const -{ - return p_vec->ptr.p_double[i]; -} - -double& alglib::real_1d_array::operator()(ae_int_t i) -{ - return p_vec->ptr.p_double[i]; -} - -const double& alglib::real_1d_array::operator[](ae_int_t i) const -{ - return p_vec->ptr.p_double[i]; -} - -double& alglib::real_1d_array::operator[](ae_int_t i) -{ - return p_vec->ptr.p_double[i]; -} - -void alglib::real_1d_array::setcontent(ae_int_t iLen, const double *pContent ) -{ - ae_int_t i; - setlength(iLen); - for(i=0; iptr.p_double[i] = pContent[i]; -} - -double* alglib::real_1d_array::getcontent() -{ - return p_vec->ptr.p_double; -} - -const double* alglib::real_1d_array::getcontent() const -{ - return p_vec->ptr.p_double; -} - -std::string alglib::real_1d_array::tostring(int dps) const -{ - if( length()==0 ) - return "[]"; - return arraytostring(&operator()(0), length(), dps); -} - -alglib::complex_1d_array::complex_1d_array() -{ - allocate_own(0, alglib_impl::DT_COMPLEX); -} - -alglib::complex_1d_array::complex_1d_array(alglib_impl::ae_vector *p) -{ - p_vec = NULL; - attach_to(p); -} - -alglib::complex_1d_array::complex_1d_array(const char *s) -{ - create(s, alglib_impl::DT_COMPLEX); -} - -alglib::complex_1d_array::complex_1d_array(const alglib::complex_1d_array &rhs) -{ - create(rhs); -} - -const alglib::complex_1d_array& alglib::complex_1d_array::operator=(const alglib::complex_1d_array &rhs) -{ - assign(rhs); - return *this; -} - -alglib::complex_1d_array::~complex_1d_array() -{ -} - -const alglib::complex& alglib::complex_1d_array::operator()(ae_int_t i) const -{ - return *((const alglib::complex*)(p_vec->ptr.p_complex+i)); -} - -alglib::complex& alglib::complex_1d_array::operator()(ae_int_t i) -{ - return *((alglib::complex*)(p_vec->ptr.p_complex+i)); -} - -const alglib::complex& alglib::complex_1d_array::operator[](ae_int_t i) const -{ - return *((const alglib::complex*)(p_vec->ptr.p_complex+i)); -} - -alglib::complex& alglib::complex_1d_array::operator[](ae_int_t i) -{ - return *((alglib::complex*)(p_vec->ptr.p_complex+i)); -} - -void alglib::complex_1d_array::setcontent(ae_int_t iLen, const alglib::complex *pContent ) -{ - ae_int_t i; - setlength(iLen); - for(i=0; iptr.p_complex[i].x = pContent[i].x; - p_vec->ptr.p_complex[i].y = pContent[i].y; - } -} - - alglib::complex* alglib::complex_1d_array::getcontent() -{ - return (alglib::complex*)p_vec->ptr.p_complex; -} - -const alglib::complex* alglib::complex_1d_array::getcontent() const -{ - return (const alglib::complex*)p_vec->ptr.p_complex; -} - -std::string alglib::complex_1d_array::tostring(int dps) const -{ - if( length()==0 ) - return "[]"; - return arraytostring(&operator()(0), length(), dps); -} - -alglib::ae_matrix_wrapper::ae_matrix_wrapper() -{ - p_mat = NULL; -} - -alglib::ae_matrix_wrapper::~ae_matrix_wrapper() -{ - if( p_mat==&mat ) - ae_matrix_clear(p_mat); -} - -const alglib::ae_matrix_wrapper& alglib::ae_matrix_wrapper::operator=(const alglib::ae_matrix_wrapper &rhs) -{ - assign(rhs); - return *this; -} - -void alglib::ae_matrix_wrapper::create(const ae_matrix_wrapper &rhs) -{ - if( rhs.p_mat!=NULL ) - { - p_mat = &mat; - if( !ae_matrix_init_copy(p_mat, rhs.p_mat, NULL, ae_false) ) - throw alglib::ap_error("ALGLIB: malloc error!"); - } - else - p_mat = NULL; -} - -void alglib::ae_matrix_wrapper::create(const char *s, alglib_impl::ae_datatype datatype) -{ - std::vector< std::vector > smat; - size_t i, j; - char *p = filter_spaces(s); - try - { - str_matrix_create(p, &smat); - if( smat.size()!=0 ) - { - allocate_own((ae_int_t)(smat.size()), (ae_int_t)(smat[0].size()), datatype); - for(i=0; iptr.pp_bool[i][j] = parse_bool_delim(smat[i][j],",]"); - if( datatype==alglib_impl::DT_INT ) - p_mat->ptr.pp_int[i][j] = parse_int_delim(smat[i][j],",]"); - if( datatype==alglib_impl::DT_REAL ) - p_mat->ptr.pp_double[i][j] = parse_real_delim(smat[i][j],",]"); - if( datatype==alglib_impl::DT_COMPLEX ) - { - alglib::complex t = parse_complex_delim(smat[i][j],",]"); - p_mat->ptr.pp_complex[i][j].x = t.x; - p_mat->ptr.pp_complex[i][j].y = t.y; - } - } - } - else - allocate_own(0, 0, datatype); - alglib_impl::ae_free(p); - } - catch(...) - { - alglib_impl::ae_free(p); - throw; - } -} - -void alglib::ae_matrix_wrapper::assign(const alglib::ae_matrix_wrapper &rhs) -{ - if( this==&rhs ) - return; - if( p_mat==&mat || p_mat==NULL ) - { - // - // Assignment to non-proxy object - // - ae_matrix_clear(p_mat); - if( rhs.p_mat!=NULL ) - { - p_mat = &mat; - if( !ae_matrix_init_copy(p_mat, rhs.p_mat, NULL, ae_false) ) - throw alglib::ap_error("ALGLIB: malloc error!"); - } - else - p_mat = NULL; - } - else - { - // - // Assignment to proxy object - // - ae_int_t i; - if( rhs.p_mat==NULL ) - throw alglib::ap_error("ALGLIB: incorrect assignment to array (sizes do not match)"); - if( rhs.p_mat->datatype!=p_mat->datatype ) - throw alglib::ap_error("ALGLIB: incorrect assignment to array (types do not match)"); - if( rhs.p_mat->rows!=p_mat->rows ) - throw alglib::ap_error("ALGLIB: incorrect assignment to array (sizes do not match)"); - if( rhs.p_mat->cols!=p_mat->cols ) - throw alglib::ap_error("ALGLIB: incorrect assignment to array (sizes do not match)"); - for(i=0; irows; i++) - memcpy(p_mat->ptr.pp_void[i], rhs.p_mat->ptr.pp_void[i], p_mat->cols*alglib_impl::ae_sizeof(p_mat->datatype)); - } -} - -void alglib::ae_matrix_wrapper::setlength(ae_int_t rows, ae_int_t cols) -{ - if( p_mat==NULL ) - throw alglib::ap_error("ALGLIB: setlength() error, p_mat==NULL (array was not correctly initialized)"); - if( p_mat!=&mat ) - throw alglib::ap_error("ALGLIB: setlength() error, p_mat!=&mat (attempt to resize frozen array)"); - if( !ae_matrix_set_length(p_mat, rows, cols, NULL) ) - throw alglib::ap_error("ALGLIB: malloc error"); -} - -alglib::ae_int_t alglib::ae_matrix_wrapper::rows() const -{ - if( p_mat==NULL ) - return 0; - return p_mat->rows; -} - -alglib::ae_int_t alglib::ae_matrix_wrapper::cols() const -{ - if( p_mat==NULL ) - return 0; - return p_mat->cols; -} - -bool alglib::ae_matrix_wrapper::isempty() const -{ - return rows()==0 || cols()==0; -} - -alglib::ae_int_t alglib::ae_matrix_wrapper::getstride() const -{ - if( p_mat==NULL ) - return 0; - return p_mat->stride; -} - -void alglib::ae_matrix_wrapper::attach_to(alglib_impl::ae_matrix *ptr) -{ - if( ptr==&mat ) - throw alglib::ap_error("ALGLIB: attempt to attach matrix to itself"); - if( p_mat==&mat ) - ae_matrix_clear(p_mat); - p_mat = ptr; -} - -void alglib::ae_matrix_wrapper::allocate_own(ae_int_t rows, ae_int_t cols, alglib_impl::ae_datatype datatype) -{ - if( p_mat==&mat ) - ae_matrix_clear(p_mat); - p_mat = &mat; - if( !ae_matrix_init(p_mat, rows, cols, datatype, NULL, false) ) - throw alglib::ap_error("ALGLIB: malloc error"); -} - -const alglib_impl::ae_matrix* alglib::ae_matrix_wrapper::c_ptr() const -{ - return p_mat; -} - -alglib_impl::ae_matrix* alglib::ae_matrix_wrapper::c_ptr() -{ - return p_mat; -} - -alglib::boolean_2d_array::boolean_2d_array() -{ - allocate_own(0, 0, alglib_impl::DT_BOOL); -} - -alglib::boolean_2d_array::boolean_2d_array(const alglib::boolean_2d_array &rhs) -{ - create(rhs); -} - -alglib::boolean_2d_array::boolean_2d_array(alglib_impl::ae_matrix *p) -{ - p_mat = NULL; - attach_to(p); -} - -alglib::boolean_2d_array::boolean_2d_array(const char *s) -{ - create(s, alglib_impl::DT_BOOL); -} - -alglib::boolean_2d_array::~boolean_2d_array() -{ -} - -const ae_bool& alglib::boolean_2d_array::operator()(ae_int_t i, ae_int_t j) const -{ - return p_mat->ptr.pp_bool[i][j]; -} - -ae_bool& alglib::boolean_2d_array::operator()(ae_int_t i, ae_int_t j) -{ - return p_mat->ptr.pp_bool[i][j]; -} - -const ae_bool* alglib::boolean_2d_array::operator[](ae_int_t i) const -{ - return p_mat->ptr.pp_bool[i]; -} - -ae_bool* alglib::boolean_2d_array::operator[](ae_int_t i) -{ - return p_mat->ptr.pp_bool[i]; -} - -void alglib::boolean_2d_array::setcontent(ae_int_t irows, ae_int_t icols, const bool *pContent ) -{ - ae_int_t i, j; - setlength(irows, icols); - for(i=0; iptr.pp_bool[i][j] = pContent[i*icols+j]; -} - -std::string alglib::boolean_2d_array::tostring() const -{ - std::string result; - ae_int_t i; - if( isempty() ) - return "[[]]"; - result = "["; - for(i=0; iptr.pp_int[i][j]; -} - -alglib::ae_int_t& alglib::integer_2d_array::operator()(ae_int_t i, ae_int_t j) -{ - return p_mat->ptr.pp_int[i][j]; -} - -const alglib::ae_int_t* alglib::integer_2d_array::operator[](ae_int_t i) const -{ - return p_mat->ptr.pp_int[i]; -} - -alglib::ae_int_t* alglib::integer_2d_array::operator[](ae_int_t i) -{ - return p_mat->ptr.pp_int[i]; -} - -void alglib::integer_2d_array::setcontent(ae_int_t irows, ae_int_t icols, const ae_int_t *pContent ) -{ - ae_int_t i, j; - setlength(irows, icols); - for(i=0; iptr.pp_int[i][j] = pContent[i*icols+j]; -} - -std::string alglib::integer_2d_array::tostring() const -{ - std::string result; - ae_int_t i; - if( isempty() ) - return "[[]]"; - result = "["; - for(i=0; iptr.pp_double[i][j]; -} - -double& alglib::real_2d_array::operator()(ae_int_t i, ae_int_t j) -{ - return p_mat->ptr.pp_double[i][j]; -} - -const double* alglib::real_2d_array::operator[](ae_int_t i) const -{ - return p_mat->ptr.pp_double[i]; -} - -double* alglib::real_2d_array::operator[](ae_int_t i) -{ - return p_mat->ptr.pp_double[i]; -} - -void alglib::real_2d_array::setcontent(ae_int_t irows, ae_int_t icols, const double *pContent ) -{ - ae_int_t i, j; - setlength(irows, icols); - for(i=0; iptr.pp_double[i][j] = pContent[i*icols+j]; -} - -std::string alglib::real_2d_array::tostring(int dps) const -{ - std::string result; - ae_int_t i; - if( isempty() ) - return "[[]]"; - result = "["; - for(i=0; iptr.pp_complex[i]+j)); -} - -alglib::complex& alglib::complex_2d_array::operator()(ae_int_t i, ae_int_t j) -{ - return *((alglib::complex*)(p_mat->ptr.pp_complex[i]+j)); -} - -const alglib::complex* alglib::complex_2d_array::operator[](ae_int_t i) const -{ - return (const alglib::complex*)(p_mat->ptr.pp_complex[i]); -} - -alglib::complex* alglib::complex_2d_array::operator[](ae_int_t i) -{ - return (alglib::complex*)(p_mat->ptr.pp_complex[i]); -} - -void alglib::complex_2d_array::setcontent(ae_int_t irows, ae_int_t icols, const alglib::complex *pContent ) -{ - ae_int_t i, j; - setlength(irows, icols); - for(i=0; iptr.pp_complex[i][j].x = pContent[i*icols+j].x; - p_mat->ptr.pp_complex[i][j].y = pContent[i*icols+j].y; - } -} - -std::string alglib::complex_2d_array::tostring(int dps) const -{ - std::string result; - ae_int_t i; - if( isempty() ) - return "[[]]"; - result = "["; - for(i=0; ic2 ) - return +1; - } -} - -char* alglib::filter_spaces(const char *s) -{ - size_t i, n; - char *r; - char *r0; - n = strlen(s); - r = (char*)alglib_impl::ae_malloc(n+1, NULL); - if( r==NULL ) - throw ap_error("malloc error"); - for(i=0,r0=r; i<=n; i++,s++) - if( !isspace(*s) ) - { - *r0 = *s; - r0++; - } - return r; -} - -void alglib::str_vector_create(const char *src, bool match_head_only, std::vector *p_vec) -{ - // - // parse beginning of the string. - // try to handle "[]" string - // - p_vec->clear(); - if( *src!='[' ) - throw alglib::ap_error("Incorrect initializer for vector"); - src++; - if( *src==']' ) - return; - p_vec->push_back(src); - for(;;) - { - if( *src==0 ) - throw alglib::ap_error("Incorrect initializer for vector"); - if( *src==']' ) - { - if( src[1]==0 || !match_head_only) - return; - throw alglib::ap_error("Incorrect initializer for vector"); - } - if( *src==',' ) - { - p_vec->push_back(src+1); - src++; - continue; - } - src++; - } -} - -void alglib::str_matrix_create(const char *src, std::vector< std::vector > *p_mat) -{ - p_mat->clear(); - - // - // Try to handle "[[]]" string - // - if( strcmp(src, "[[]]")==0 ) - return; - - // - // Parse non-empty string - // - if( *src!='[' ) - throw alglib::ap_error("Incorrect initializer for matrix"); - src++; - for(;;) - { - p_mat->push_back(std::vector()); - str_vector_create(src, false, &p_mat->back()); - if( p_mat->back().size()==0 || p_mat->back().size()!=(*p_mat)[0].size() ) - throw alglib::ap_error("Incorrect initializer for matrix"); - src = strchr(src, ']'); - if( src==NULL ) - throw alglib::ap_error("Incorrect initializer for matrix"); - src++; - if( *src==',' ) - { - src++; - continue; - } - if( *src==']' ) - break; - throw alglib::ap_error("Incorrect initializer for matrix"); - } - src++; - if( *src!=0 ) - throw alglib::ap_error("Incorrect initializer for matrix"); -} - -ae_bool alglib::parse_bool_delim(const char *s, const char *delim) -{ - const char *p; - char buf[8]; - - // try to parse false - p = "false"; - memset(buf, 0, sizeof(buf)); - strncpy(buf, s, strlen(p)); - if( my_stricmp(buf, p)==0 ) - { - if( s[strlen(p)]==0 || strchr(delim,s[strlen(p)])==NULL ) - throw alglib::ap_error("Cannot parse value"); - return ae_false; - } - - // try to parse true - p = "true"; - memset(buf, 0, sizeof(buf)); - strncpy(buf, s, strlen(p)); - if( my_stricmp(buf, p)==0 ) - { - if( s[strlen(p)]==0 || strchr(delim,s[strlen(p)])==NULL ) - throw alglib::ap_error("Cannot parse value"); - return ae_true; - } - - // error - throw alglib::ap_error("Cannot parse value"); -} - -alglib::ae_int_t alglib::parse_int_delim(const char *s, const char *delim) -{ - const char *p; - long long_val; - volatile ae_int_t ae_val; - - p = s; - - // - // check string structure: - // * leading sign - // * at least one digit - // * delimiter - // - if( *s=='-' || *s=='+' ) - s++; - if( *s==0 || strchr("1234567890",*s)==NULL) - throw alglib::ap_error("Cannot parse value"); - while( *s!=0 && strchr("1234567890",*s)!=NULL ) - s++; - if( *s==0 || strchr(delim,*s)==NULL ) - throw alglib::ap_error("Cannot parse value"); - - // convert and ensure that value fits into ae_int_t - s = p; - long_val = atol(s); - ae_val = long_val; - if( ae_val!=long_val ) - throw alglib::ap_error("Cannot parse value"); - return ae_val; -} - -bool alglib::_parse_real_delim(const char *s, const char *delim, double *result, const char **new_s) -{ - const char *p; - char *t; - bool has_digits; - char buf[64]; - int isign; - lconv *loc; - - p = s; - - // - // check string structure and decide what to do - // - isign = 1; - if( *s=='-' || *s=='+' ) - { - isign = *s=='-' ? -1 : +1; - s++; - } - memset(buf, 0, sizeof(buf)); - strncpy(buf, s, 3); - if( my_stricmp(buf,"nan")!=0 && my_stricmp(buf,"inf")!=0 ) - { - // - // [sign] [ddd] [.] [ddd] [e|E[sign]ddd] - // - has_digits = false; - if( *s!=0 && strchr("1234567890",*s)!=NULL ) - { - has_digits = true; - while( *s!=0 && strchr("1234567890",*s)!=NULL ) - s++; - } - if( *s=='.' ) - s++; - if( *s!=0 && strchr("1234567890",*s)!=NULL ) - { - has_digits = true; - while( *s!=0 && strchr("1234567890",*s)!=NULL ) - s++; - } - if (!has_digits ) - return false; - if( *s=='e' || *s=='E' ) - { - s++; - if( *s=='-' || *s=='+' ) - s++; - if( *s==0 || strchr("1234567890",*s)==NULL ) - return false; - while( *s!=0 && strchr("1234567890",*s)!=NULL ) - s++; - } - if( *s==0 || strchr(delim,*s)==NULL ) - return false; - *new_s = s; - - // - // finite value conversion - // - if( *new_s-p>=(int)sizeof(buf) ) - return false; - strncpy(buf, p, (size_t)(*new_s-p)); - buf[*new_s-p] = 0; - loc = localeconv(); - t = strchr(buf,'.'); - if( t!=NULL ) - *t = *loc->decimal_point; - *result = atof(buf); - return true; - } - else - { - // - // check delimiter and update *new_s - // - s += 3; - if( *s==0 || strchr(delim,*s)==NULL ) - return false; - *new_s = s; - - // - // NAN, INF conversion - // - if( my_stricmp(buf,"nan")==0 ) - *result = fp_nan; - if( my_stricmp(buf,"inf")==0 ) - *result = isign>0 ? fp_posinf : fp_neginf; - return true; - } -} - -double alglib::parse_real_delim(const char *s, const char *delim) -{ - double result; - const char *new_s; - if( !_parse_real_delim(s, delim, &result, &new_s) ) - throw alglib::ap_error("Cannot parse value"); - return result; -} - -alglib::complex alglib::parse_complex_delim(const char *s, const char *delim) -{ - double d_result; - const char *new_s; - alglib::complex c_result; - - // parse as real value - if( _parse_real_delim(s, delim, &d_result, &new_s) ) - return d_result; - - // parse as "a+bi" or "a-bi" - if( _parse_real_delim(s, "+-", &c_result.x, &new_s) ) - { - s = new_s; - if( !_parse_real_delim(s, "i", &c_result.y, &new_s) ) - throw alglib::ap_error("Cannot parse value"); - s = new_s+1; - if( *s==0 || strchr(delim,*s)==NULL ) - throw alglib::ap_error("Cannot parse value"); - return c_result; - } - - // parse as complex value "bi+a" or "bi-a" - if( _parse_real_delim(s, "i", &c_result.y, &new_s) ) - { - s = new_s+1; - if( *s==0 ) - throw alglib::ap_error("Cannot parse value"); - if( strchr(delim,*s)!=NULL ) - { - c_result.x = 0; - return c_result; - } - if( strchr("+-",*s)!=NULL ) - { - if( !_parse_real_delim(s, delim, &c_result.x, &new_s) ) - throw alglib::ap_error("Cannot parse value"); - return c_result; - } - throw alglib::ap_error("Cannot parse value"); - } - - // error - throw alglib::ap_error("Cannot parse value"); -} - -std::string alglib::arraytostring(const bool *ptr, ae_int_t n) -{ - std::string result; - ae_int_t i; - result = "["; - for(i=0; i=(int)sizeof(buf) ) - throw ap_error("arraytostring(): buffer overflow"); - result += buf; - } - result += "]"; - return result; -} - -std::string alglib::arraytostring(const double *ptr, ae_int_t n, int _dps) -{ - std::string result; - ae_int_t i; - char buf[67]; - char mask1[64]; - char mask2[66]; - int dps = _dps>=0 ? _dps : -_dps; - result = "["; - if( sprintf(mask1, "%%.%d%s", dps, _dps>=0 ? "f" : "e")>=(int)sizeof(mask1) ) - throw ap_error("arraytostring(): buffer overflow"); - if( sprintf(mask2, ",%s", mask1)>=(int)sizeof(mask2) ) - throw ap_error("arraytostring(): buffer overflow"); - for(i=0; i=(int)sizeof(buf) ) - throw ap_error("arraytostring(): buffer overflow"); - } - else if( fp_isnan(ptr[i]) ) - strcpy(buf, i==0 ? "NAN" : ",NAN"); - else if( fp_isposinf(ptr[i]) ) - strcpy(buf, i==0 ? "+INF" : ",+INF"); - else if( fp_isneginf(ptr[i]) ) - strcpy(buf, i==0 ? "-INF" : ",-INF"); - result += buf; - } - result += "]"; - return result; -} - -std::string alglib::arraytostring(const alglib::complex *ptr, ae_int_t n, int dps) -{ - std::string result; - ae_int_t i; - result = "["; - for(i=0; i0 ) return 1; - if( x<0 ) return -1; - return 0; -} - -double alglib::randomreal() -{ -#ifdef AE_DEBUGRNG - return alglib_impl::ae_debugrng()/2147483563.0; -#else - int i1 = rand(); - int i2 = rand(); - double mx = (double)(RAND_MAX)+1.0; - volatile double tmp0 = i2/mx; - volatile double tmp1 = i1+tmp0; - return tmp1/mx; -#endif -} - -alglib::ae_int_t alglib::randominteger(alglib::ae_int_t maxv) -{ -#ifdef AE_DEBUGRNG - return ((alglib::ae_int_t)(alglib_impl::ae_debugrng()-1))%maxv; -#else - return ((alglib::ae_int_t)rand())%maxv; -#endif -} - -int alglib::round(double x) -{ return int(floor(x+0.5)); } - -int alglib::trunc(double x) -{ return int(x>0 ? floor(x) : ceil(x)); } - -int alglib::ifloor(double x) -{ return int(floor(x)); } - -int alglib::iceil(double x) -{ return int(ceil(x)); } - -double alglib::pi() -{ return 3.14159265358979323846; } - -double alglib::sqr(double x) -{ return x*x; } - -int alglib::maxint(int m1, int m2) -{ - return m1>m2 ? m1 : m2; -} - -int alglib::minint(int m1, int m2) -{ - return m1>m2 ? m2 : m1; -} - -double alglib::maxreal(double m1, double m2) -{ - return m1>m2 ? m1 : m2; -} - -double alglib::minreal(double m1, double m2) -{ - return m1>m2 ? m2 : m1; -} - -bool alglib::fp_eq(double v1, double v2) -{ - // IEEE-strict floating point comparison - volatile double x = v1; - volatile double y = v2; - return x==y; -} - -bool alglib::fp_neq(double v1, double v2) -{ - // IEEE-strict floating point comparison - return !fp_eq(v1,v2); -} - -bool alglib::fp_less(double v1, double v2) -{ - // IEEE-strict floating point comparison - volatile double x = v1; - volatile double y = v2; - return xy; -} - -bool alglib::fp_greater_eq(double v1, double v2) -{ - // IEEE-strict floating point comparison - volatile double x = v1; - volatile double y = v2; - return x>=y; -} - -bool alglib::fp_isnan(double x) -{ - return alglib_impl::ae_isnan_stateless(x,endianness); -} - -bool alglib::fp_isposinf(double x) -{ - return alglib_impl::ae_isposinf_stateless(x,endianness); -} - -bool alglib::fp_isneginf(double x) -{ - return alglib_impl::ae_isneginf_stateless(x,endianness); -} - -bool alglib::fp_isinf(double x) -{ - return alglib_impl::ae_isinf_stateless(x,endianness); -} - -bool alglib::fp_isfinite(double x) -{ - return alglib_impl::ae_isfinite_stateless(x,endianness); -} - -/******************************************************************** -Dataset functions -********************************************************************/ -/*bool alglib::readstrings(std::string file, std::list *pOutput) -{ - return readstrings(file, pOutput, ""); -} - -bool alglib::readstrings(std::string file, std::list *pOutput, std::string comment) -{ - std::string cmd, s; - FILE *f; - char buf[32768]; - char *str; - - f = fopen(file.c_str(), "rb"); - if( !f ) - return false; - s = ""; - pOutput->clear(); - while(str=fgets(buf, sizeof(buf), f)) - { - // TODO: read file by small chunks, combine in one large string - if( strlen(str)==0 ) - continue; - - // - // trim trailing newline chars - // - char *eos = str+strlen(str)-1; - if( *eos=='\n' ) - { - *eos = 0; - eos--; - } - if( *eos=='\r' ) - { - *eos = 0; - eos--; - } - s = str; - - // - // skip comments - // - if( comment.length()>0 ) - if( strncmp(s.c_str(), comment.c_str(), comment.length())==0 ) - { - s = ""; - continue; - } - - // - // read data - // - if( s.length()<1 ) - { - fclose(f); - throw alglib::ap_error("internal error in read_strings"); - } - pOutput->push_back(s); - } - fclose(f); - return true; -} - -void alglib::explodestring(std::string s, char sep, std::vector *pOutput) -{ - std::string tmp; - int i; - tmp = ""; - pOutput->clear(); - for(i=0; ipush_back(tmp); - tmp = ""; - } - if( tmp.length()!=0 ) - pOutput->push_back(tmp); -} - -std::string alglib::strtolower(const std::string &s) -{ - std::string r = s; - for(int i=0; i Lines; - std::vector Values, RowsArr, ColsArr, VarsArr, HeadArr; - std::list::iterator i; - std::string s; - int TrnFirst, TrnLast, ValFirst, ValLast, TstFirst, TstLast, LinesRead, j; - - // - // Read data - // - if( pdataset==NULL ) - return false; - if( !readstrings(file, &Lines, "//") ) - return false; - i = Lines.begin(); - *pdataset = dataset(); - - // - // Read header - // - if( i==Lines.end() ) - return false; - s = alglib::xtrim(*i); - alglib::explodestring(s, '#', &HeadArr); - if( HeadArr.size()!=2 ) - return false; - - // - // Rows info - // - alglib::explodestring(alglib::xtrim(HeadArr[0]), ' ', &RowsArr); - if( RowsArr.size()==0 || RowsArr.size()>3 ) - return false; - if( RowsArr.size()==1 ) - { - pdataset->totalsize = atol(RowsArr[0].c_str()); - pdataset->trnsize = pdataset->totalsize; - } - if( RowsArr.size()==2 ) - { - pdataset->trnsize = atol(RowsArr[0].c_str()); - pdataset->tstsize = atol(RowsArr[1].c_str()); - pdataset->totalsize = pdataset->trnsize + pdataset->tstsize; - } - if( RowsArr.size()==3 ) - { - pdataset->trnsize = atol(RowsArr[0].c_str()); - pdataset->valsize = atol(RowsArr[1].c_str()); - pdataset->tstsize = atol(RowsArr[2].c_str()); - pdataset->totalsize = pdataset->trnsize + pdataset->valsize + pdataset->tstsize; - } - if( pdataset->totalsize<=0 || pdataset->trnsize<0 || pdataset->valsize<0 || pdataset->tstsize<0 ) - return false; - TrnFirst = 0; - TrnLast = TrnFirst + pdataset->trnsize; - ValFirst = TrnLast; - ValLast = ValFirst + pdataset->valsize; - TstFirst = ValLast; - TstLast = TstFirst + pdataset->tstsize; - - // - // columns - // - alglib::explodestring(alglib::xtrim(HeadArr[1]), ' ', &ColsArr); - if( ColsArr.size()!=1 && ColsArr.size()!=4 ) - return false; - if( ColsArr.size()==1 ) - { - pdataset->nin = atoi(ColsArr[0].c_str()); - if( pdataset->nin<=0 ) - return false; - } - if( ColsArr.size()==4 ) - { - if( alglib::strtolower(ColsArr[0])!="reg" && alglib::strtolower(ColsArr[0])!="cls" ) - return false; - if( ColsArr[2]!="=>" ) - return false; - pdataset->nin = atol(ColsArr[1].c_str()); - if( pdataset->nin<1 ) - return false; - if( alglib::strtolower(ColsArr[0])=="reg" ) - { - pdataset->nclasses = 0; - pdataset->nout = atol(ColsArr[3].c_str()); - if( pdataset->nout<1 ) - return false; - } - else - { - pdataset->nclasses = atol(ColsArr[3].c_str()); - pdataset->nout = 1; - if( pdataset->nclasses<2 ) - return false; - } - } - - // - // initialize arrays - // - pdataset->all.setlength(pdataset->totalsize, pdataset->nin+pdataset->nout); - if( pdataset->trnsize>0 ) pdataset->trn.setlength(pdataset->trnsize, pdataset->nin+pdataset->nout); - if( pdataset->valsize>0 ) pdataset->val.setlength(pdataset->valsize, pdataset->nin+pdataset->nout); - if( pdataset->tstsize>0 ) pdataset->tst.setlength(pdataset->tstsize, pdataset->nin+pdataset->nout); - - // - // read data - // - for(LinesRead=0, i++; i!=Lines.end() && LinesReadtotalsize; i++, LinesRead++) - { - std::string sss = *i; - alglib::explodestring(alglib::xtrim(*i), ' ', &VarsArr); - if( VarsArr.size()!=pdataset->nin+pdataset->nout ) - return false; - int tmpc = alglib::round(atof(VarsArr[pdataset->nin+pdataset->nout-1].c_str())); - if( pdataset->nclasses>0 && (tmpc<0 || tmpc>=pdataset->nclasses) ) - return false; - for(j=0; jnin+pdataset->nout; j++) - { - pdataset->all(LinesRead,j) = atof(VarsArr[j].c_str()); - if( LinesRead>=TrnFirst && LinesReadtrn(LinesRead-TrnFirst,j) = atof(VarsArr[j].c_str()); - if( LinesRead>=ValFirst && LinesReadval(LinesRead-ValFirst,j) = atof(VarsArr[j].c_str()); - if( LinesRead>=TstFirst && LinesReadtst(LinesRead-TstFirst,j) = atof(VarsArr[j].c_str()); - } - } - if( LinesRead!=pdataset->totalsize ) - return false; - return true; -}*/ - -/* -previous variant -bool alglib::opendataset(std::string file, dataset *pdataset) -{ - std::list Lines; - std::vector Values; - std::list::iterator i; - int nCol, nRow, nSplitted; - int nColumns, nRows; - - // - // Read data - // - if( pdataset==NULL ) - return false; - if( !readstrings(file, &Lines, "//") ) - return false; - i = Lines.begin(); - *pdataset = dataset(); - - // - // Read columns info - // - if( i==Lines.end() ) - return false; - if( sscanf(i->c_str(), " columns = %d %d ", &pdataset->nin, &pdataset->nout)!=2 ) - return false; - if( pdataset->nin<=0 || pdataset->nout==0 || pdataset->nout==-1) - return false; - if( pdataset->nout<0 ) - { - pdataset->nclasses = -pdataset->nout; - pdataset->nout = 1; - pdataset->iscls = true; - } - else - { - pdataset->isreg = true; - } - nColumns = pdataset->nin+pdataset->nout; - i++; - - // - // Read rows info - // - if( i==Lines.end() ) - return false; - if( sscanf(i->c_str(), " rows = %d %d %d ", &pdataset->trnsize, &pdataset->valsize, &pdataset->tstsize)!=3 ) - return false; - if( (pdataset->trnsize<0) || (pdataset->valsize<0) || (pdataset->tstsize<0) ) - return false; - if( (pdataset->trnsize==0) && (pdataset->valsize==0) && (pdataset->tstsize==0) ) - return false; - nRows = pdataset->trnsize+pdataset->valsize+pdataset->tstsize; - pdataset->size = nRows; - if( Lines.size()!=nRows+2 ) - return false; - i++; - - // - // Read all cases - // - alglib::real_2d_array &arr = pdataset->all; - arr.setbounds(0, nRows-1, 0, nColumns-1); - for(nRow=0; nRowiscls && ((round(v)<0) || (round(v)>=pdataset->nclasses)) ) - return false; - if( (nCol==nColumns-1) && pdataset->iscls ) - arr(nRow, nCol) = round(v); - else - arr(nRow, nCol) = v; - } - i++; - } - - // - // Split to training, validation and test sets - // - if( pdataset->trnsize>0 ) - pdataset->trn.setbounds(0, pdataset->trnsize-1, 0, nColumns-1); - if( pdataset->valsize>0 ) - pdataset->val.setbounds(0, pdataset->valsize-1, 0, nColumns-1); - if( pdataset->tstsize>0 ) - pdataset->tst.setbounds(0, pdataset->tstsize-1, 0, nColumns-1); - nSplitted=0; - for(nRow=0; nRow<=pdataset->trnsize-1; nRow++, nSplitted++) - for(nCol=0; nCol<=nColumns-1; nCol++) - pdataset->trn(nRow,nCol) = arr(nSplitted,nCol); - for(nRow=0; nRow<=pdataset->valsize-1; nRow++, nSplitted++) - for(nCol=0; nCol<=nColumns-1; nCol++) - pdataset->val(nRow,nCol) = arr(nSplitted,nCol); - for(nRow=0; nRow<=pdataset->tstsize-1; nRow++, nSplitted++) - for(nCol=0; nCol<=nColumns-1; nCol++) - pdataset->tst(nRow,nCol) = arr(nSplitted,nCol); - return true; -}*/ - -alglib::ae_int_t alglib::vlen(ae_int_t n1, ae_int_t n2) -{ - return n2-n1+1; -} - - - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTIONS CONTAINS OPTIMIZED LINEAR ALGEBRA CODE -// IT IS SHARED BETWEEN C++ AND PURE C LIBRARIES -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ -#define alglib_simd_alignment 16 - -#define alglib_r_block 32 -#define alglib_half_r_block 16 -#define alglib_twice_r_block 64 - -#define alglib_c_block 24 -#define alglib_half_c_block 12 -#define alglib_twice_c_block 48 - - -/******************************************************************** -This subroutine calculates fast 32x32 real matrix-vector product: - - y := beta*y + alpha*A*x - -using either generic C code or native optimizations (if available) - -IMPORTANT: -* A must be stored in row-major order, - stride is alglib_r_block, - aligned on alglib_simd_alignment boundary -* X must be aligned on alglib_simd_alignment boundary -* Y may be non-aligned -********************************************************************/ -void _ialglib_mv_32(const double *a, const double *x, double *y, ae_int_t stride, double alpha, double beta) -{ - ae_int_t i, k; - const double *pa0, *pa1, *pb; - - pa0 = a; - pa1 = a+alglib_r_block; - pb = x; - for(i=0; i<16; i++) - { - double v0 = 0, v1 = 0; - for(k=0; k<4; k++) - { - v0 += pa0[0]*pb[0]; - v1 += pa1[0]*pb[0]; - v0 += pa0[1]*pb[1]; - v1 += pa1[1]*pb[1]; - v0 += pa0[2]*pb[2]; - v1 += pa1[2]*pb[2]; - v0 += pa0[3]*pb[3]; - v1 += pa1[3]*pb[3]; - v0 += pa0[4]*pb[4]; - v1 += pa1[4]*pb[4]; - v0 += pa0[5]*pb[5]; - v1 += pa1[5]*pb[5]; - v0 += pa0[6]*pb[6]; - v1 += pa1[6]*pb[6]; - v0 += pa0[7]*pb[7]; - v1 += pa1[7]*pb[7]; - pa0 += 8; - pa1 += 8; - pb += 8; - } - y[0] = beta*y[0]+alpha*v0; - y[stride] = beta*y[stride]+alpha*v1; - - /* - * now we've processed rows I and I+1, - * pa0 and pa1 are pointing to rows I+1 and I+2. - * move to I+2 and I+3. - */ - pa0 += alglib_r_block; - pa1 += alglib_r_block; - pb = x; - y+=2*stride; - } -} - - -/************************************************************************* -This function calculates MxN real matrix-vector product: - - y := beta*y + alpha*A*x - -using generic C code. It calls _ialglib_mv_32 if both M=32 and N=32. - -If beta is zero, we do not use previous values of y (they are overwritten -by alpha*A*x without ever being read). If alpha is zero, no matrix-vector -product is calculated (only beta is updated); however, this update is not -efficient and this function should NOT be used for multiplication of -vector and scalar. - -IMPORTANT: -* 0<=M<=alglib_r_block, 0<=N<=alglib_r_block -* A must be stored in row-major order with stride equal to alglib_r_block -*************************************************************************/ -void _ialglib_rmv(ae_int_t m, ae_int_t n, const double *a, const double *x, double *y, ae_int_t stride, double alpha, double beta) -{ - /* - * Handle special cases: - * - alpha is zero or n is zero - * - m is zero - */ - if( m==0 ) - return; - if( alpha==0.0 || n==0 ) - { - ae_int_t i; - if( beta==0.0 ) - { - for(i=0; ix-beta.y*cy->y)+(alpha.x*v0-alpha.y*v1); - double ty = (beta.x*cy->y+beta.y*cy->x)+(alpha.x*v1+alpha.y*v0); - cy->x = tx; - cy->y = ty; - cy+=stride; - } - else - { - double tx = (beta.x*dy[0]-beta.y*dy[1])+(alpha.x*v0-alpha.y*v1); - double ty = (beta.x*dy[1]+beta.y*dy[0])+(alpha.x*v1+alpha.y*v0); - dy[0] = tx; - dy[1] = ty; - dy += 2*stride; - } - parow += 2*alglib_c_block; - } -} - - -/************************************************************************* -This subroutine calculates fast MxN complex matrix-vector product: - - y := beta*y + alpha*A*x - -using generic C code, where A, x, y, alpha and beta are complex. - -If beta is zero, we do not use previous values of y (they are overwritten -by alpha*A*x without ever being read). However, when alpha is zero, we -still calculate A*x and multiply it by alpha (this distinction can be -important when A or x contain infinities/NANs). - -IMPORTANT: -* 0<=M<=alglib_c_block, 0<=N<=alglib_c_block -* A must be stored in row-major order, as sequence of double precision - pairs. Stride is alglib_c_block (it is measured in pairs of doubles, not - in doubles). -* Y may be referenced by cy (pointer to ae_complex) or - dy (pointer to array of double precision pair) depending on what type of - output you wish. Pass pointer to Y as one of these parameters, - AND SET OTHER PARAMETER TO NULL. -* both A and x must be aligned; y may be non-aligned. - -This function supports SSE2; it can be used when: -1. AE_HAS_SSE2_INTRINSICS was defined (checked at compile-time) -2. ae_cpuid() result contains CPU_SSE2 (checked at run-time) - -If (1) is failed, this function will be undefined. If (2) is failed, call -to this function will probably crash your system. - -If you want to know whether it is safe to call it, you should check -results of ae_cpuid(). If CPU_SSE2 bit is set, this function is callable -and will do its work. -*************************************************************************/ -#if defined(AE_HAS_SSE2_INTRINSICS) -void _ialglib_cmv_sse2(ae_int_t m, ae_int_t n, const double *a, const double *x, ae_complex *cy, double *dy, ae_int_t stride, ae_complex alpha, ae_complex beta) -{ - ae_int_t i, j, m2; - const double *pa0, *pa1, *parow, *pb; - __m128d vbeta, vbetax, vbetay; - __m128d valpha, valphax, valphay; - - m2 = m/2; - parow = a; - if( cy!=NULL ) - { - dy = (double*)cy; - cy = NULL; - } - vbeta = _mm_loadh_pd(_mm_load_sd(&beta.x),&beta.y); - vbetax = _mm_unpacklo_pd(vbeta,vbeta); - vbetay = _mm_unpackhi_pd(vbeta,vbeta); - valpha = _mm_loadh_pd(_mm_load_sd(&alpha.x),&alpha.y); - valphax = _mm_unpacklo_pd(valpha,valpha); - valphay = _mm_unpackhi_pd(valpha,valpha); - for(i=0; ix = 0.0; - p->y = 0.0; - } - } - else - { - for(i=0; ix = 0.0; - p->y = 0.0; - } - } -} - - -/******************************************************************** -This subroutine copies unaligned real vector -********************************************************************/ -void _ialglib_vcopy(ae_int_t n, const double *a, ae_int_t stridea, double *b, ae_int_t strideb) -{ - ae_int_t i, n2; - if( stridea==1 && strideb==1 ) - { - n2 = n/2; - for(i=n2; i!=0; i--, a+=2, b+=2) - { - b[0] = a[0]; - b[1] = a[1]; - } - if( n%2!=0 ) - b[0] = a[0]; - } - else - { - for(i=0; ix; - b[1] = a->y; - } - } - else - { - for(i=0; ix; - b[1] = -a->y; - } - } -} - - -/******************************************************************** -This subroutine copies unaligned complex vector (passed as double*) - -1. strideb is stride measured in complex numbers, not doubles -2. conj may be "N" (no conj.) or "C" (conj.) -********************************************************************/ -void _ialglib_vcopy_dcomplex(ae_int_t n, const double *a, ae_int_t stridea, double *b, ae_int_t strideb, const char *conj) -{ - ae_int_t i; - - /* - * more general case - */ - if( conj[0]=='N' || conj[0]=='n' ) - { - for(i=0; ix; - pdst[1] = psrc->y; - } - } - if( op==1 ) - { - for(i=0,psrc=a; ix; - pdst[1] = psrc->y; - } - } - if( op==2 ) - { - for(i=0,psrc=a; ix; - pdst[1] = -psrc->y; - } - } - if( op==3 ) - { - for(i=0,psrc=a; ix; - pdst[1] = -psrc->y; - } - } -} - - -/******************************************************************** -This subroutine copies matrix from aligned contigous storage to -non-aligned non-contigous storage - -A: -* 2*alglib_c_block*alglib_c_block doubles (only MxN submatrix is used) -* aligned -* stride is alglib_c_block -* pointer to double is passed -* may be transformed during copying (as prescribed by op) - -B: -* MxN -* non-aligned -* non-contigous -* pointer to ae_complex is passed - -Transformation types: -* 0 - no transform -* 1 - transposition -* 2 - conjugate transposition -* 3 - conjugate, but no transposition -********************************************************************/ -void _ialglib_mcopyunblock_complex(ae_int_t m, ae_int_t n, const double *a, ae_int_t op, ae_complex* b, ae_int_t stride) -{ - ae_int_t i, j; - const double *psrc; - ae_complex *pdst; - if( op==0 ) - { - for(i=0,psrc=a; ix = psrc[0]; - pdst->y = psrc[1]; - } - } - if( op==1 ) - { - for(i=0,psrc=a; ix = psrc[0]; - pdst->y = psrc[1]; - } - } - if( op==2 ) - { - for(i=0,psrc=a; ix = psrc[0]; - pdst->y = -psrc[1]; - } - } - if( op==3 ) - { - for(i=0,psrc=a; ix = psrc[0]; - pdst->y = -psrc[1]; - } - } -} - - -/******************************************************************** -Real GEMM kernel -********************************************************************/ -ae_bool _ialglib_rmatrixgemm(ae_int_t m, - ae_int_t n, - ae_int_t k, - double alpha, - double *_a, - ae_int_t _a_stride, - ae_int_t optypea, - double *_b, - ae_int_t _b_stride, - ae_int_t optypeb, - double beta, - double *_c, - ae_int_t _c_stride) -{ - int i; - double *crow; - double _abuf[alglib_r_block+alglib_simd_alignment]; - double _bbuf[alglib_r_block*alglib_r_block+alglib_simd_alignment]; - double * const abuf = (double * const) ae_align(_abuf,alglib_simd_alignment); - double * const b = (double * const) ae_align(_bbuf,alglib_simd_alignment); - void (*rmv)(ae_int_t, ae_int_t, const double *, const double *, double *, ae_int_t, double, double) = &_ialglib_rmv; - void (*mcopyblock)(ae_int_t, ae_int_t, const double *, ae_int_t, ae_int_t, double *) = &_ialglib_mcopyblock; - - if( m>alglib_r_block || n>alglib_r_block || k>alglib_r_block || m<=0 || n<=0 || k<=0 || alpha==0.0 ) - return ae_false; - - /* - * Check for SSE2 support - */ -#ifdef AE_HAS_SSE2_INTRINSICS - if( ae_cpuid() & CPU_SSE2 ) - { - rmv = &_ialglib_rmv_sse2; - mcopyblock = &_ialglib_mcopyblock_sse2; - } -#endif - - /* - * copy b - */ - if( optypeb==0 ) - mcopyblock(k, n, _b, 1, _b_stride, b); - else - mcopyblock(n, k, _b, 0, _b_stride, b); - - /* - * multiply B by A (from the right, by rows) - * and store result in C - */ - crow = _c; - if( optypea==0 ) - { - const double *arow = _a; - for(i=0; ialglib_c_block || n>alglib_c_block || k>alglib_c_block ) - return ae_false; - - /* - * Check for SSE2 support - */ -#ifdef AE_HAS_SSE2_INTRINSICS - if( ae_cpuid() & CPU_SSE2 ) - { - cmv = &_ialglib_cmv_sse2; - } -#endif - - /* - * copy b - */ - brows = optypeb==0 ? k : n; - bcols = optypeb==0 ? n : k; - if( optypeb==0 ) - _ialglib_mcopyblock_complex(brows, bcols, _b, 1, _b_stride, b); - if( optypeb==1 ) - _ialglib_mcopyblock_complex(brows, bcols, _b, 0, _b_stride, b); - if( optypeb==2 ) - _ialglib_mcopyblock_complex(brows, bcols, _b, 3, _b_stride, b); - - /* - * multiply B by A (from the right, by rows) - * and store result in C - */ - arow = _a; - crow = _c; - for(i=0; ialglib_c_block || n>alglib_c_block ) - return ae_false; - - /* - * Check for SSE2 support - */ -#ifdef AE_HAS_SSE2_INTRINSICS - if( ae_cpuid() & CPU_SSE2 ) - { - cmv = &_ialglib_cmv_sse2; - } -#endif - - /* - * Prepare - */ - _ialglib_mcopyblock_complex(n, n, _a, optype, _a_stride, abuf); - _ialglib_mcopyblock_complex(m, n, _x, 0, _x_stride, xbuf); - if( isunit ) - for(i=0,pdiag=abuf; i=0; i--,pdiag-=2*(alglib_c_block+1)) - { - ae_complex tmp_c; - ae_complex beta; - ae_complex alpha; - tmp_c.x = pdiag[0]; - tmp_c.y = pdiag[1]; - beta = ae_c_d_div(1.0, tmp_c); - alpha.x = -beta.x; - alpha.y = -beta.y; - _ialglib_vcopy_dcomplex(n-1-i, pdiag+2*alglib_c_block, alglib_c_block, tmpbuf, 1, "No conj"); - cmv(m, n-1-i, xbuf+2*(i+1), tmpbuf, NULL, xbuf+2*i, alglib_c_block, alpha, beta); - } - _ialglib_mcopyunblock_complex(m, n, xbuf, 0, _x, _x_stride); - } - return ae_true; -} - - -/******************************************************************** -real TRSM kernel -********************************************************************/ -ae_bool _ialglib_rmatrixrighttrsm(ae_int_t m, - ae_int_t n, - double *_a, - ae_int_t _a_stride, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - double *_x, - ae_int_t _x_stride) -{ - /* - * local buffers - */ - double *pdiag; - ae_int_t i; - double _loc_abuf[alglib_r_block*alglib_r_block+alglib_simd_alignment]; - double _loc_xbuf[alglib_r_block*alglib_r_block+alglib_simd_alignment]; - double _loc_tmpbuf[alglib_r_block+alglib_simd_alignment]; - double * const abuf = (double * const) ae_align(_loc_abuf, alglib_simd_alignment); - double * const xbuf = (double * const) ae_align(_loc_xbuf, alglib_simd_alignment); - double * const tmpbuf = (double * const) ae_align(_loc_tmpbuf,alglib_simd_alignment); - ae_bool uppera; - void (*rmv)(ae_int_t, ae_int_t, const double *, const double *, double *, ae_int_t, double, double) = &_ialglib_rmv; - void (*mcopyblock)(ae_int_t, ae_int_t, const double *, ae_int_t, ae_int_t, double *) = &_ialglib_mcopyblock; - - if( m>alglib_r_block || n>alglib_r_block ) - return ae_false; - - /* - * Check for SSE2 support - */ -#ifdef AE_HAS_SSE2_INTRINSICS - if( ae_cpuid() & CPU_SSE2 ) - { - rmv = &_ialglib_rmv_sse2; - mcopyblock = &_ialglib_mcopyblock_sse2; - } -#endif - - /* - * Prepare - */ - mcopyblock(n, n, _a, optype, _a_stride, abuf); - mcopyblock(m, n, _x, 0, _x_stride, xbuf); - if( isunit ) - for(i=0,pdiag=abuf; i=0; i--,pdiag-=alglib_r_block+1) - { - double beta = 1.0/(*pdiag); - double alpha = -beta; - _ialglib_vcopy(n-1-i, pdiag+alglib_r_block, alglib_r_block, tmpbuf+i+1, 1); - rmv(m, n-1-i, xbuf+i+1, tmpbuf+i+1, xbuf+i, alglib_r_block, alpha, beta); - } - _ialglib_mcopyunblock(m, n, xbuf, 0, _x, _x_stride); - } - return ae_true; -} - - -/******************************************************************** -complex TRSM kernel -********************************************************************/ -ae_bool _ialglib_cmatrixlefttrsm(ae_int_t m, - ae_int_t n, - ae_complex *_a, - ae_int_t _a_stride, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - ae_complex *_x, - ae_int_t _x_stride) -{ - /* - * local buffers - */ - double *pdiag, *arow; - ae_int_t i; - double _loc_abuf[2*alglib_c_block*alglib_c_block+alglib_simd_alignment]; - double _loc_xbuf[2*alglib_c_block*alglib_c_block+alglib_simd_alignment]; - double _loc_tmpbuf[2*alglib_c_block+alglib_simd_alignment]; - double * const abuf = (double * const) ae_align(_loc_abuf, alglib_simd_alignment); - double * const xbuf = (double * const) ae_align(_loc_xbuf, alglib_simd_alignment); - double * const tmpbuf = (double * const) ae_align(_loc_tmpbuf,alglib_simd_alignment); - ae_bool uppera; - void (*cmv)(ae_int_t, ae_int_t, const double *, const double *, ae_complex *, double *, ae_int_t, ae_complex, ae_complex) = &_ialglib_cmv; - - if( m>alglib_c_block || n>alglib_c_block ) - return ae_false; - - /* - * Check for SSE2 support - */ -#ifdef AE_HAS_SSE2_INTRINSICS - if( ae_cpuid() & CPU_SSE2 ) - { - cmv = &_ialglib_cmv_sse2; - } -#endif - - /* - * Prepare - * Transpose X (so we may use mv, which calculates A*x, but not x*A) - */ - _ialglib_mcopyblock_complex(m, m, _a, optype, _a_stride, abuf); - _ialglib_mcopyblock_complex(m, n, _x, 1, _x_stride, xbuf); - if( isunit ) - for(i=0,pdiag=abuf; i=0; i--,pdiag-=2*(alglib_c_block+1)) - { - ae_complex tmp_c; - ae_complex beta; - ae_complex alpha; - tmp_c.x = pdiag[0]; - tmp_c.y = pdiag[1]; - beta = ae_c_d_div(1.0, tmp_c); - alpha.x = -beta.x; - alpha.y = -beta.y; - _ialglib_vcopy_dcomplex(m-1-i, pdiag+2, 1, tmpbuf, 1, "No conj"); - cmv(n, m-1-i, xbuf+2*(i+1), tmpbuf, NULL, xbuf+2*i, alglib_c_block, alpha, beta); - } - _ialglib_mcopyunblock_complex(m, n, xbuf, 1, _x, _x_stride); - } - else - { for(i=0,pdiag=abuf,arow=abuf; ialglib_r_block || n>alglib_r_block ) - return ae_false; - - /* - * Check for SSE2 support - */ -#ifdef AE_HAS_SSE2_INTRINSICS - if( ae_cpuid() & CPU_SSE2 ) - { - rmv = &_ialglib_rmv_sse2; - mcopyblock = &_ialglib_mcopyblock_sse2; - } -#endif - - /* - * Prepare - * Transpose X (so we may use mv, which calculates A*x, but not x*A) - */ - mcopyblock(m, m, _a, optype, _a_stride, abuf); - mcopyblock(m, n, _x, 1, _x_stride, xbuf); - if( isunit ) - for(i=0,pdiag=abuf; i=0; i--,pdiag-=alglib_r_block+1) - { - double beta = 1.0/(*pdiag); - double alpha = -beta; - _ialglib_vcopy(m-1-i, pdiag+1, 1, tmpbuf+i+1, 1); - rmv(n, m-1-i, xbuf+i+1, tmpbuf+i+1, xbuf+i, alglib_r_block, alpha, beta); - } - _ialglib_mcopyunblock(m, n, xbuf, 1, _x, _x_stride); - } - else - { for(i=0,pdiag=abuf,arow=abuf; ialglib_c_block || k>alglib_c_block ) - return ae_false; - if( n==0 ) - return ae_true; - - /* - * copy A and C, task is transformed to "A*A^H"-form. - * if beta==0, then C is filled by zeros (and not referenced) - * - * alpha==0 or k==0 are correctly processed (A is not referenced) - */ - c_alpha.x = alpha; - c_alpha.y = 0; - c_beta.x = beta; - c_beta.y = 0; - if( alpha==0 ) - k = 0; - if( k>0 ) - { - if( optypea==0 ) - _ialglib_mcopyblock_complex(n, k, _a, 3, _a_stride, abuf); - else - _ialglib_mcopyblock_complex(k, n, _a, 1, _a_stride, abuf); - } - _ialglib_mcopyblock_complex(n, n, _c, 0, _c_stride, cbuf); - if( beta==0 ) - { - for(i=0,crow=cbuf; ialglib_r_block || k>alglib_r_block ) - return ae_false; - if( n==0 ) - return ae_true; - - /* - * copy A and C, task is transformed to "A*A^T"-form. - * if beta==0, then C is filled by zeros (and not referenced) - * - * alpha==0 or k==0 are correctly processed (A is not referenced) - */ - if( alpha==0 ) - k = 0; - if( k>0 ) - { - if( optypea==0 ) - _ialglib_mcopyblock(n, k, _a, 0, _a_stride, abuf); - else - _ialglib_mcopyblock(k, n, _a, 1, _a_stride, abuf); - } - _ialglib_mcopyblock(n, n, _c, 0, _c_stride, cbuf); - if( beta==0 ) - { - for(i=0,crow=cbuf; iptr.pp_double[ia]+ja, _a->stride, optypea, _b->ptr.pp_double[ib]+jb, _b->stride, optypeb, beta, _c->ptr.pp_double[ic]+jc, _c->stride); -} - -ae_bool _ialglib_i_cmatrixgemmf(ae_int_t m, - ae_int_t n, - ae_int_t k, - ae_complex alpha, - ae_matrix *_a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - ae_matrix *_b, - ae_int_t ib, - ae_int_t jb, - ae_int_t optypeb, - ae_complex beta, - ae_matrix *_c, - ae_int_t ic, - ae_int_t jc) -{ - return _ialglib_cmatrixgemm(m, n, k, alpha, _a->ptr.pp_complex[ia]+ja, _a->stride, optypea, _b->ptr.pp_complex[ib]+jb, _b->stride, optypeb, beta, _c->ptr.pp_complex[ic]+jc, _c->stride); -} - -ae_bool _ialglib_i_cmatrixrighttrsmf(ae_int_t m, - ae_int_t n, - ae_matrix *a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - ae_matrix *x, - ae_int_t i2, - ae_int_t j2) -{ - return _ialglib_cmatrixrighttrsm(m, n, &a->ptr.pp_complex[i1][j1], a->stride, isupper, isunit, optype, &x->ptr.pp_complex[i2][j2], x->stride); -} - -ae_bool _ialglib_i_rmatrixrighttrsmf(ae_int_t m, - ae_int_t n, - ae_matrix *a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - ae_matrix *x, - ae_int_t i2, - ae_int_t j2) -{ - return _ialglib_rmatrixrighttrsm(m, n, &a->ptr.pp_double[i1][j1], a->stride, isupper, isunit, optype, &x->ptr.pp_double[i2][j2], x->stride); -} - -ae_bool _ialglib_i_cmatrixlefttrsmf(ae_int_t m, - ae_int_t n, - ae_matrix *a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - ae_matrix *x, - ae_int_t i2, - ae_int_t j2) -{ - return _ialglib_cmatrixlefttrsm(m, n, &a->ptr.pp_complex[i1][j1], a->stride, isupper, isunit, optype, &x->ptr.pp_complex[i2][j2], x->stride); -} - -ae_bool _ialglib_i_rmatrixlefttrsmf(ae_int_t m, - ae_int_t n, - ae_matrix *a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - ae_matrix *x, - ae_int_t i2, - ae_int_t j2) -{ - return _ialglib_rmatrixlefttrsm(m, n, &a->ptr.pp_double[i1][j1], a->stride, isupper, isunit, optype, &x->ptr.pp_double[i2][j2], x->stride); -} - -ae_bool _ialglib_i_cmatrixsyrkf(ae_int_t n, - ae_int_t k, - double alpha, - ae_matrix *a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - double beta, - ae_matrix *c, - ae_int_t ic, - ae_int_t jc, - ae_bool isupper) -{ - return _ialglib_cmatrixsyrk(n, k, alpha, &a->ptr.pp_complex[ia][ja], a->stride, optypea, beta, &c->ptr.pp_complex[ic][jc], c->stride, isupper); -} - -ae_bool _ialglib_i_rmatrixsyrkf(ae_int_t n, - ae_int_t k, - double alpha, - ae_matrix *a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - double beta, - ae_matrix *c, - ae_int_t ic, - ae_int_t jc, - ae_bool isupper) -{ - return _ialglib_rmatrixsyrk(n, k, alpha, &a->ptr.pp_double[ia][ja], a->stride, optypea, beta, &c->ptr.pp_double[ic][jc], c->stride, isupper); -} - -ae_bool _ialglib_i_cmatrixrank1f(ae_int_t m, - ae_int_t n, - ae_matrix *a, - ae_int_t ia, - ae_int_t ja, - ae_vector *u, - ae_int_t uoffs, - ae_vector *v, - ae_int_t voffs) -{ - return _ialglib_cmatrixrank1(m, n, &a->ptr.pp_complex[ia][ja], a->stride, &u->ptr.p_complex[uoffs], &v->ptr.p_complex[voffs]); -} - -ae_bool _ialglib_i_rmatrixrank1f(ae_int_t m, - ae_int_t n, - ae_matrix *a, - ae_int_t ia, - ae_int_t ja, - ae_vector *u, - ae_int_t uoffs, - ae_vector *v, - ae_int_t voffs) -{ - return _ialglib_rmatrixrank1(m, n, &a->ptr.pp_double[ia][ja], a->stride, &u->ptr.p_double[uoffs], &v->ptr.p_double[voffs]); -} - - - - -/******************************************************************** -This function reads rectangular matrix A given by two column pointers -col0 and col1 and stride src_stride and moves it into contiguous row- -by-row storage given by dst. - -It can handle following special cases: -* col1==NULL in this case second column of A is filled by zeros -********************************************************************/ -void _ialglib_pack_n2( - double *col0, - double *col1, - ae_int_t n, - ae_int_t src_stride, - double *dst) -{ - ae_int_t n2, j, stride2; - - /* - * handle special case - */ - if( col1==NULL ) - { - for(j=0; j>> SOURCE LICENSE >>> -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation (www.fsf.org); either version 2 of the -License, or (at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -A copy of the GNU General Public License is available at -http://www.fsf.org/licensing/licenses ->>> END OF LICENSE >>> -*************************************************************************/ -#ifndef _ap_h -#define _ap_h - -#include -#include -#include -#include -#include -#include - -#ifdef __BORLANDC__ -#include -#include -#else -#include -#include -#endif - -#define AE_USE_CPP -/* Definitions */ -#define AE_UNKNOWN 0 -#define AE_MSVC 1 -#define AE_GNUC 2 -#define AE_SUNC 3 -#define AE_INTEL 1 -#define AE_SPARC 2 -#define AE_WINDOWS 1 -#define AE_POSIX 2 -#define AE_LOCK_ALIGNMENT 16 - -/* in case no OS is defined, use AE_UNKNOWN */ -#ifndef AE_OS -#define AE_OS AE_UNKNOWN -#endif - -/* automatically determine compiler */ -#define AE_COMPILER AE_UNKNOWN -#ifdef __GNUC__ -#undef AE_COMPILER -#define AE_COMPILER AE_GNUC -#endif -#if defined(__SUNPRO_C)||defined(__SUNPRO_CC) -#undef AE_COMPILER -#define AE_COMPILER AE_SUNC -#endif -#ifdef _MSC_VER -#undef AE_COMPILER -#define AE_COMPILER AE_MSVC -#endif - -/* now we are ready to include headers */ -#include -#include -#include -#include -#include -#include - -#if AE_OS==AE_WINDOWS -#include -#include -#elif AE_OS==AE_POSIX -#include -#include -#include -#include -#endif - -#if defined(AE_HAVE_STDINT) -#include -#endif - -/* - * SSE2 intrinsics - * - * Preprocessor directives below: - * - include headers for SSE2 intrinsics - * - define AE_HAS_SSE2_INTRINSICS definition - * - * These actions are performed when we have: - * - x86 architecture definition (AE_CPU==AE_INTEL) - * - compiler which supports intrinsics - * - * Presence of AE_HAS_SSE2_INTRINSICS does NOT mean that our CPU - * actually supports SSE2 - such things should be determined at runtime - * with ae_cpuid() call. It means that we are working under Intel and - * out compiler can issue SSE2-capable code. - * - */ -#if defined(AE_CPU) -#if AE_CPU==AE_INTEL -#if AE_COMPILER==AE_MSVC -#include -#define AE_HAS_SSE2_INTRINSICS -#endif -#if AE_COMPILER==AE_GNUC -#include -#define AE_HAS_SSE2_INTRINSICS -#endif -#if AE_COMPILER==AE_SUNC -#include -#include -#define AE_HAS_SSE2_INTRINSICS -#endif -#endif -#endif - -/* Debugging helpers for Windows */ -#ifdef AE_DEBUG4WINDOWS -#include -#include -#endif - - - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS DECLARATIONS FOR BASIC FUNCTIONALITY -// LIKE MEMORY MANAGEMENT FOR VECTORS/MATRICES WHICH IS SHARED -// BETWEEN C++ AND PURE C LIBRARIES -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ - -/* if we work under C++ environment, define several conditions */ -#ifdef AE_USE_CPP -#define AE_USE_CPP_BOOL -#define AE_USE_CPP_ERROR_HANDLING -#define AE_USE_CPP_SERIALIZATION -#endif - -/* - * define ae_int32_t, ae_int64_t, ae_int_t, ae_bool, ae_complex, ae_error_type and ae_datatype - */ - -#if defined(AE_INT32_T) -typedef AE_INT32_T ae_int32_t; -#endif -#if defined(AE_HAVE_STDINT) && !defined(AE_INT32_T) -typedef int32_t ae_int32_t; -#endif -#if !defined(AE_HAVE_STDINT) && !defined(AE_INT32_T) -#if AE_COMPILER==AE_MSVC -typedef _int32 ae_int32_t; -#endif -#if (AE_COMPILER==AE_GNUC) || (AE_COMPILER==AE_SUNC) || (AE_COMPILER==AE_UNKNOWN) -typedef int ae_int32_t; -#endif -#endif - -#if defined(AE_INT64_T) -typedef AE_INT64_T ae_int64_t; -#endif -#if defined(AE_HAVE_STDINT) && !defined(AE_INT64_T) -typedef int64_t ae_int64_t; -#endif -#if !defined(AE_HAVE_STDINT) && !defined(AE_INT64_T) -#if AE_COMPILER==AE_MSVC -typedef _int64 ae_int64_t; -#endif -#if (AE_COMPILER==AE_GNUC) || (AE_COMPILER==AE_SUNC) || (AE_COMPILER==AE_UNKNOWN) -typedef signed long long ae_int64_t; -#endif -#endif - -#if !defined(AE_INT_T) -typedef ptrdiff_t ae_int_t; -#endif - -#if !defined(AE_USE_CPP_BOOL) -#define ae_bool char -#define ae_true 1 -#define ae_false 0 -#else -#define ae_bool bool -#define ae_true true -#define ae_false false -#endif - -typedef struct { double x, y; } ae_complex; - -typedef enum -{ - ERR_OK = 0, - ERR_OUT_OF_MEMORY = 1, - ERR_XARRAY_TOO_LARGE = 2, - ERR_ASSERTION_FAILED = 3 -} ae_error_type; - -typedef ae_int_t ae_datatype; - -/* - * other definitions - */ -enum { OWN_CALLER=1, OWN_AE=2 }; -enum { ACT_UNCHANGED=1, ACT_SAME_LOCATION=2, ACT_NEW_LOCATION=3 }; -enum { DT_BOOL=1, DT_INT=2, DT_REAL=3, DT_COMPLEX=4 }; -enum { CPU_SSE2=1 }; - -/************************************************************************ -x-string (zero-terminated): - owner OWN_CALLER or OWN_AE. Determines what to do on realloc(). - If vector is owned by caller, X-interface will just set - ptr to NULL before realloc(). If it is owned by X, it - will call ae_free/x_free/aligned_free family functions. - - last_action ACT_UNCHANGED, ACT_SAME_LOCATION, ACT_NEW_LOCATION - contents is either: unchanged, stored at the same location, - stored at the new location. - this field is set on return from X. - - ptr pointer to the actual data - -Members of this structure are ae_int64_t to avoid alignment problems. -************************************************************************/ -typedef struct -{ - ae_int64_t owner; - ae_int64_t last_action; - char *ptr; -} x_string; - -/************************************************************************ -x-vector: - cnt number of elements - - datatype one of the DT_XXXX values - - owner OWN_CALLER or OWN_AE. Determines what to do on realloc(). - If vector is owned by caller, X-interface will just set - ptr to NULL before realloc(). If it is owned by X, it - will call ae_free/x_free/aligned_free family functions. - - last_action ACT_UNCHANGED, ACT_SAME_LOCATION, ACT_NEW_LOCATION - contents is either: unchanged, stored at the same location, - stored at the new location. - this field is set on return from X interface and may be - used by caller as hint when deciding what to do with data - (if it was ACT_UNCHANGED or ACT_SAME_LOCATION, no array - reallocation or copying is required). - - ptr pointer to the actual data - -Members of this structure are ae_int64_t to avoid alignment problems. -************************************************************************/ -typedef struct -{ - ae_int64_t cnt; - ae_int64_t datatype; - ae_int64_t owner; - ae_int64_t last_action; - void *ptr; -} x_vector; - - -/************************************************************************ -x-matrix: - rows number of rows. may be zero only when cols is zero too. - - cols number of columns. may be zero only when rows is zero too. - - stride stride, i.e. distance between first elements of rows (in bytes) - - datatype one of the DT_XXXX values - - owner OWN_CALLER or OWN_AE. Determines what to do on realloc(). - If vector is owned by caller, X-interface will just set - ptr to NULL before realloc(). If it is owned by X, it - will call ae_free/x_free/aligned_free family functions. - - last_action ACT_UNCHANGED, ACT_SAME_LOCATION, ACT_NEW_LOCATION - contents is either: unchanged, stored at the same location, - stored at the new location. - this field is set on return from X interface and may be - used by caller as hint when deciding what to do with data - (if it was ACT_UNCHANGED or ACT_SAME_LOCATION, no array - reallocation or copying is required). - - ptr pointer to the actual data, stored rowwise - -Members of this structure are ae_int64_t to avoid alignment problems. -************************************************************************/ -typedef struct -{ - ae_int64_t rows; - ae_int64_t cols; - ae_int64_t stride; - ae_int64_t datatype; - ae_int64_t owner; - ae_int64_t last_action; - void *ptr; -} x_matrix; - - -/************************************************************************ -dynamic block which may be automatically deallocated during stack unwinding - -p_next next block in the stack unwinding list. - NULL means that this block is not in the list -deallocator deallocator function which should be used to deallocate block. - NULL for "special" blocks (frame/stack boundaries) -ptr pointer which should be passed to the deallocator. - may be null (for zero-size block), DYN_BOTTOM or DYN_FRAME - for "special" blocks (frame/stack boundaries). - -************************************************************************/ -typedef struct ae_dyn_block -{ - struct ae_dyn_block * volatile p_next; - /* void *deallocator; */ - void (*deallocator)(void*); - void * volatile ptr; -} ae_dyn_block; - -/************************************************************************ -frame marker -************************************************************************/ -typedef struct ae_frame -{ - ae_dyn_block db_marker; -} ae_frame; - -/************************************************************************ -ALGLIB environment state -************************************************************************/ -typedef struct ae_state -{ - /* - * endianness type: AE_LITTLE_ENDIAN or AE_BIG_ENDIAN - */ - ae_int_t endianness; - - /* - * double value for NAN - */ - double v_nan; - - /* - * double value for +INF - */ - double v_posinf; - - /* - * double value for -INF - */ - double v_neginf; - - /* - * pointer to the top block in a stack of frames - * which hold dynamically allocated objects - */ - ae_dyn_block * volatile p_top_block; - ae_dyn_block last_block; - - /* - * jmp_buf for cases when C-style exception handling is used - */ -#ifndef AE_USE_CPP_ERROR_HANDLING - jmp_buf * volatile break_jump; -#endif - - /* - * ae_error_type of the last error (filled when exception is thrown) - */ - ae_error_type volatile last_error; - - /* - * human-readable message (filled when exception is thrown) - */ - const char* volatile error_msg; - - /* - * threading information: - * a) current thread pool - * b) current worker thread - * c) parent task (one we are solving right now) - * d) thread exception handler (function which must be called - * by ae_assert before raising exception). - * - * NOTE: we use void* to store pointers in order to avoid explicit dependency on smp.h - */ - void *worker_thread; - void *parent_task; - void (*thread_exception_handler)(void*); - -} ae_state; - -/************************************************************************ -Serializer -************************************************************************/ -typedef struct -{ - ae_int_t mode; - ae_int_t entries_needed; - ae_int_t entries_saved; - ae_int_t bytes_asked; - ae_int_t bytes_written; - -#ifdef AE_USE_CPP_SERIALIZATION - std::string *out_cppstr; -#endif - char *out_str; - const char *in_str; -} ae_serializer; - -typedef void(*ae_deallocator)(void*); - -typedef struct ae_vector -{ - ae_int_t cnt; - ae_datatype datatype; - ae_dyn_block data; - union - { - void *p_ptr; - ae_bool *p_bool; - ae_int_t *p_int; - double *p_double; - ae_complex *p_complex; - } ptr; -} ae_vector; - -typedef struct ae_matrix -{ - ae_int_t rows; - ae_int_t cols; - ae_int_t stride; - ae_datatype datatype; - ae_dyn_block data; - union - { - void *p_ptr; - void **pp_void; - ae_bool **pp_bool; - ae_int_t **pp_int; - double **pp_double; - ae_complex **pp_complex; - } ptr; -} ae_matrix; - -typedef struct ae_smart_ptr -{ - /* pointer to subscriber; all changes in ptr are translated to subscriber */ - void **subscriber; - - /* pointer to object */ - void *ptr; - - /* whether smart pointer owns ptr */ - ae_bool is_owner; - - /* whether object pointed by ptr is dynamic - clearing such object requires BOTH - calling destructor function AND calling ae_free for memory occupied by object. */ - ae_bool is_dynamic; - - /* destructor function for pointer; clears all dynamically allocated memory */ - void (*destroy)(void*); - - /* frame entry; used to ensure automatic deallocation of smart pointer in case of exception/exit */ - ae_dyn_block frame_entry; -} ae_smart_ptr; - - -/************************************************************************* -Lock. - -This structure provides OS-independent non-reentrant lock: -* under Windows/Posix systems it uses system-provided locks -* under Boost it uses OS-independent lock provided by Boost package -* when no OS is defined, it uses "fake lock" (just stub which is not thread-safe): - a) "fake lock" can be in locked or free mode - b) "fake lock" can be used only from one thread - one which created lock - c) when thread acquires free lock, it immediately returns - d) when thread acquires busy lock, program is terminated - (because lock is already acquired and no one else can free it) -*************************************************************************/ -typedef struct -{ -#if AE_OS==AE_WINDOWS - volatile ae_int_t * volatile p_lock; - char buf[sizeof(ae_int_t)+AE_LOCK_ALIGNMENT]; -#elif AE_OS==AE_POSIX - pthread_mutex_t mutex; -#else - ae_bool is_locked; -#endif -} ae_lock; - - -/************************************************************************* -Shared pool: data structure used to provide thread-safe access to pool of -temporary variables. -*************************************************************************/ -typedef struct ae_shared_pool_entry -{ - void * volatile obj; - void * volatile next_entry; -} ae_shared_pool_entry; - -typedef struct ae_shared_pool -{ - /* lock object which protects pool */ - ae_lock pool_lock; - - /* seed object (used to create new instances of temporaries) */ - void * volatile seed_object; - - /* - * list of recycled OBJECTS: - * 1. entries in this list store pointers to recycled objects - * 2. every time we retrieve object, we retrieve first entry from this list, - * move it to recycled_entries and return its obj field to caller/ - */ - ae_shared_pool_entry * volatile recycled_objects; - - /* - * list of recycled ENTRIES: - * 1. this list holds entries which are not used to store recycled objects; - * every time recycled object is retrieved, its entry is moved to this list. - * 2. every time object is recycled, we try to fetch entry for him from this list - * before allocating it with malloc() - */ - ae_shared_pool_entry * volatile recycled_entries; - - /* enumeration pointer, points to current recycled object*/ - ae_shared_pool_entry * volatile enumeration_counter; - - /* size of object; this field is used when we call malloc() for new objects */ - ae_int_t size_of_object; - - /* initializer function; accepts pointer to malloc'ed object, initializes its fields */ - ae_bool (*init)(void* dst, ae_state* state, ae_bool make_automatic); - - /* copy constructor; accepts pointer to malloc'ed, but not initialized object */ - ae_bool (*init_copy)(void* dst, void* src, ae_state* state, ae_bool make_automatic); - - /* destructor function; */ - void (*destroy)(void* ptr); - - /* frame entry; contains pointer to the pool object itself */ - ae_dyn_block frame_entry; -} ae_shared_pool; - -ae_int_t ae_misalignment(const void *ptr, size_t alignment); -void* ae_align(void *ptr, size_t alignment); -void* aligned_malloc(size_t size, size_t alignment); -void aligned_free(void *block); - -void* ae_malloc(size_t size, ae_state *state); -void ae_free(void *p); -ae_int_t ae_sizeof(ae_datatype datatype); -void ae_touch_ptr(void *p); - -void ae_state_init(ae_state *state); -void ae_state_clear(ae_state *state); -#ifndef AE_USE_CPP_ERROR_HANDLING -void ae_state_set_break_jump(ae_state *state, jmp_buf *buf); -#endif -void ae_break(ae_state *state, ae_error_type error_type, const char *msg); - -void ae_frame_make(ae_state *state, ae_frame *tmp); -void ae_frame_leave(ae_state *state); - -void ae_db_attach(ae_dyn_block *block, ae_state *state); -ae_bool ae_db_malloc(ae_dyn_block *block, ae_int_t size, ae_state *state, ae_bool make_automatic); -ae_bool ae_db_realloc(ae_dyn_block *block, ae_int_t size, ae_state *state); -void ae_db_free(ae_dyn_block *block); -void ae_db_swap(ae_dyn_block *block1, ae_dyn_block *block2); - -ae_bool ae_vector_init(ae_vector *dst, ae_int_t size, ae_datatype datatype, ae_state *state, ae_bool make_automatic); -ae_bool ae_vector_init_copy(ae_vector *dst, ae_vector *src, ae_state *state, ae_bool make_automatic); -void ae_vector_init_from_x(ae_vector *dst, x_vector *src, ae_state *state, ae_bool make_automatic); -ae_bool ae_vector_set_length(ae_vector *dst, ae_int_t newsize, ae_state *state); -void ae_vector_clear(ae_vector *dst); -void ae_vector_destroy(ae_vector *dst); -void ae_swap_vectors(ae_vector *vec1, ae_vector *vec2); - -ae_bool ae_matrix_init(ae_matrix *dst, ae_int_t rows, ae_int_t cols, ae_datatype datatype, ae_state *state, ae_bool make_automatic); -ae_bool ae_matrix_init_copy(ae_matrix *dst, ae_matrix *src, ae_state *state, ae_bool make_automatic); -void ae_matrix_init_from_x(ae_matrix *dst, x_matrix *src, ae_state *state, ae_bool make_automatic); -ae_bool ae_matrix_set_length(ae_matrix *dst, ae_int_t rows, ae_int_t cols, ae_state *state); -void ae_matrix_clear(ae_matrix *dst); -void ae_matrix_destroy(ae_matrix *dst); -void ae_swap_matrices(ae_matrix *mat1, ae_matrix *mat2); - -ae_bool ae_smart_ptr_init(ae_smart_ptr *dst, void **subscriber, ae_state *state, ae_bool make_automatic); -void ae_smart_ptr_clear(void *_dst); /* accepts ae_smart_ptr* */ -void ae_smart_ptr_destroy(void *_dst); -void ae_smart_ptr_assign(ae_smart_ptr *dst, void *new_ptr, ae_bool is_owner, ae_bool is_dynamic, void (*destroy)(void*)); -void ae_smart_ptr_release(ae_smart_ptr *dst); - -void ae_yield(); -void ae_init_lock(ae_lock *lock); -void ae_acquire_lock(ae_lock *lock); -void ae_release_lock(ae_lock *lock); -void ae_free_lock(ae_lock *lock); - -ae_bool ae_shared_pool_init(void *_dst, ae_state *state, ae_bool make_automatic); -ae_bool ae_shared_pool_init_copy(void *_dst, void *_src, ae_state *state, ae_bool make_automatic); -void ae_shared_pool_clear(void *dst); -void ae_shared_pool_destroy(void *dst); -ae_bool ae_shared_pool_is_initialized(void *_dst); -void ae_shared_pool_set_seed( - ae_shared_pool *dst, - void *seed_object, - ae_int_t size_of_object, - ae_bool (*init)(void* dst, ae_state* state, ae_bool make_automatic), - ae_bool (*init_copy)(void* dst, void* src, ae_state* state, ae_bool make_automatic), - void (*destroy)(void* ptr), - ae_state *state); -void ae_shared_pool_retrieve( - ae_shared_pool *pool, - ae_smart_ptr *pptr, - ae_state *state); -void ae_shared_pool_recycle( - ae_shared_pool *pool, - ae_smart_ptr *pptr, - ae_state *state); -void ae_shared_pool_clear_recycled( - ae_shared_pool *pool, - ae_state *state); -void ae_shared_pool_first_recycled( - ae_shared_pool *pool, - ae_smart_ptr *pptr, - ae_state *state); -void ae_shared_pool_next_recycled( - ae_shared_pool *pool, - ae_smart_ptr *pptr, - ae_state *state); -void ae_shared_pool_reset( - ae_shared_pool *pool, - ae_state *state); - -void ae_x_set_vector(x_vector *dst, ae_vector *src, ae_state *state); -void ae_x_set_matrix(x_matrix *dst, ae_matrix *src, ae_state *state); -void ae_x_attach_to_vector(x_vector *dst, ae_vector *src); -void ae_x_attach_to_matrix(x_matrix *dst, ae_matrix *src); - -void x_vector_clear(x_vector *dst); - -ae_bool x_is_symmetric(x_matrix *a); -ae_bool x_is_hermitian(x_matrix *a); -ae_bool x_force_symmetric(x_matrix *a); -ae_bool x_force_hermitian(x_matrix *a); -ae_bool ae_is_symmetric(ae_matrix *a); -ae_bool ae_is_hermitian(ae_matrix *a); -ae_bool ae_force_symmetric(ae_matrix *a); -ae_bool ae_force_hermitian(ae_matrix *a); - -void ae_serializer_init(ae_serializer *serializer); -void ae_serializer_clear(ae_serializer *serializer); - -void ae_serializer_alloc_start(ae_serializer *serializer); -void ae_serializer_alloc_entry(ae_serializer *serializer); -ae_int_t ae_serializer_get_alloc_size(ae_serializer *serializer); - -#ifdef AE_USE_CPP_SERIALIZATION -void ae_serializer_sstart_str(ae_serializer *serializer, std::string *buf); -void ae_serializer_ustart_str(ae_serializer *serializer, const std::string *buf); -#endif -void ae_serializer_sstart_str(ae_serializer *serializer, char *buf); -void ae_serializer_ustart_str(ae_serializer *serializer, const char *buf); - -void ae_serializer_serialize_bool(ae_serializer *serializer, ae_bool v, ae_state *state); -void ae_serializer_serialize_int(ae_serializer *serializer, ae_int_t v, ae_state *state); -void ae_serializer_serialize_double(ae_serializer *serializer, double v, ae_state *state); -void ae_serializer_unserialize_bool(ae_serializer *serializer, ae_bool *v, ae_state *state); -void ae_serializer_unserialize_int(ae_serializer *serializer, ae_int_t *v, ae_state *state); -void ae_serializer_unserialize_double(ae_serializer *serializer, double *v, ae_state *state); - -void ae_serializer_stop(ae_serializer *serializer); - -/************************************************************************ -Service functions -************************************************************************/ -void ae_assert(ae_bool cond, const char *msg, ae_state *state); -ae_int_t ae_cpuid(); - -/************************************************************************ -Real math functions: -* IEEE-compliant floating point comparisons -* standard functions -************************************************************************/ -ae_bool ae_fp_eq(double v1, double v2); -ae_bool ae_fp_neq(double v1, double v2); -ae_bool ae_fp_less(double v1, double v2); -ae_bool ae_fp_less_eq(double v1, double v2); -ae_bool ae_fp_greater(double v1, double v2); -ae_bool ae_fp_greater_eq(double v1, double v2); - -ae_bool ae_isfinite_stateless(double x, ae_int_t endianness); -ae_bool ae_isnan_stateless(double x, ae_int_t endianness); -ae_bool ae_isinf_stateless(double x, ae_int_t endianness); -ae_bool ae_isposinf_stateless(double x, ae_int_t endianness); -ae_bool ae_isneginf_stateless(double x, ae_int_t endianness); - -ae_int_t ae_get_endianness(); - -ae_bool ae_isfinite(double x,ae_state *state); -ae_bool ae_isnan(double x, ae_state *state); -ae_bool ae_isinf(double x, ae_state *state); -ae_bool ae_isposinf(double x,ae_state *state); -ae_bool ae_isneginf(double x,ae_state *state); - -double ae_fabs(double x, ae_state *state); -ae_int_t ae_iabs(ae_int_t x, ae_state *state); -double ae_sqr(double x, ae_state *state); -double ae_sqrt(double x, ae_state *state); - -ae_int_t ae_sign(double x, ae_state *state); -ae_int_t ae_round(double x, ae_state *state); -ae_int_t ae_trunc(double x, ae_state *state); -ae_int_t ae_ifloor(double x, ae_state *state); -ae_int_t ae_iceil(double x, ae_state *state); - -ae_int_t ae_maxint(ae_int_t m1, ae_int_t m2, ae_state *state); -ae_int_t ae_minint(ae_int_t m1, ae_int_t m2, ae_state *state); -double ae_maxreal(double m1, double m2, ae_state *state); -double ae_minreal(double m1, double m2, ae_state *state); -double ae_randomreal(ae_state *state); -ae_int_t ae_randominteger(ae_int_t maxv, ae_state *state); - -double ae_sin(double x, ae_state *state); -double ae_cos(double x, ae_state *state); -double ae_tan(double x, ae_state *state); -double ae_sinh(double x, ae_state *state); -double ae_cosh(double x, ae_state *state); -double ae_tanh(double x, ae_state *state); -double ae_asin(double x, ae_state *state); -double ae_acos(double x, ae_state *state); -double ae_atan(double x, ae_state *state); -double ae_atan2(double y, double x, ae_state *state); - -double ae_log(double x, ae_state *state); -double ae_pow(double x, double y, ae_state *state); -double ae_exp(double x, ae_state *state); - -/************************************************************************ -Complex math functions: -* basic arithmetic operations -* standard functions -************************************************************************/ -ae_complex ae_complex_from_d(double v); - -ae_complex ae_c_neg(ae_complex lhs); -ae_bool ae_c_eq(ae_complex lhs, ae_complex rhs); -ae_bool ae_c_neq(ae_complex lhs, ae_complex rhs); -ae_complex ae_c_add(ae_complex lhs, ae_complex rhs); -ae_complex ae_c_mul(ae_complex lhs, ae_complex rhs); -ae_complex ae_c_sub(ae_complex lhs, ae_complex rhs); -ae_complex ae_c_div(ae_complex lhs, ae_complex rhs); -ae_bool ae_c_eq_d(ae_complex lhs, double rhs); -ae_bool ae_c_neq_d(ae_complex lhs, double rhs); -ae_complex ae_c_add_d(ae_complex lhs, double rhs); -ae_complex ae_c_mul_d(ae_complex lhs, double rhs); -ae_complex ae_c_sub_d(ae_complex lhs, double rhs); -ae_complex ae_c_d_sub(double lhs, ae_complex rhs); -ae_complex ae_c_div_d(ae_complex lhs, double rhs); -ae_complex ae_c_d_div(double lhs, ae_complex rhs); - -ae_complex ae_c_conj(ae_complex lhs, ae_state *state); -ae_complex ae_c_sqr(ae_complex lhs, ae_state *state); -double ae_c_abs(ae_complex z, ae_state *state); - -/************************************************************************ -Complex BLAS operations -************************************************************************/ -ae_complex ae_v_cdotproduct(const ae_complex *v0, ae_int_t stride0, const char *conj0, const ae_complex *v1, ae_int_t stride1, const char *conj1, ae_int_t n); -void ae_v_cmove(ae_complex *vdst, ae_int_t stride_dst, const ae_complex* vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n); -void ae_v_cmoveneg(ae_complex *vdst, ae_int_t stride_dst, const ae_complex* vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n); -void ae_v_cmoved(ae_complex *vdst, ae_int_t stride_dst, const ae_complex* vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, double alpha); -void ae_v_cmovec(ae_complex *vdst, ae_int_t stride_dst, const ae_complex* vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, ae_complex alpha); -void ae_v_cadd(ae_complex *vdst, ae_int_t stride_dst, const ae_complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n); -void ae_v_caddd(ae_complex *vdst, ae_int_t stride_dst, const ae_complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, double alpha); -void ae_v_caddc(ae_complex *vdst, ae_int_t stride_dst, const ae_complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, ae_complex alpha); -void ae_v_csub(ae_complex *vdst, ae_int_t stride_dst, const ae_complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n); -void ae_v_csubd(ae_complex *vdst, ae_int_t stride_dst, const ae_complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, double alpha); -void ae_v_csubc(ae_complex *vdst, ae_int_t stride_dst, const ae_complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, ae_complex alpha); -void ae_v_cmuld(ae_complex *vdst, ae_int_t stride_dst, ae_int_t n, double alpha); -void ae_v_cmulc(ae_complex *vdst, ae_int_t stride_dst, ae_int_t n, ae_complex alpha); - -/************************************************************************ -Real BLAS operations -************************************************************************/ -double ae_v_dotproduct(const double *v0, ae_int_t stride0, const double *v1, ae_int_t stride1, ae_int_t n); -void ae_v_move(double *vdst, ae_int_t stride_dst, const double* vsrc, ae_int_t stride_src, ae_int_t n); -void ae_v_moveneg(double *vdst, ae_int_t stride_dst, const double* vsrc, ae_int_t stride_src, ae_int_t n); -void ae_v_moved(double *vdst, ae_int_t stride_dst, const double* vsrc, ae_int_t stride_src, ae_int_t n, double alpha); -void ae_v_add(double *vdst, ae_int_t stride_dst, const double *vsrc, ae_int_t stride_src, ae_int_t n); -void ae_v_addd(double *vdst, ae_int_t stride_dst, const double *vsrc, ae_int_t stride_src, ae_int_t n, double alpha); -void ae_v_sub(double *vdst, ae_int_t stride_dst, const double *vsrc, ae_int_t stride_src, ae_int_t n); -void ae_v_subd(double *vdst, ae_int_t stride_dst, const double *vsrc, ae_int_t stride_src, ae_int_t n, double alpha); -void ae_v_muld(double *vdst, ae_int_t stride_dst, ae_int_t n, double alpha); - -/************************************************************************ -Other functions -************************************************************************/ -ae_int_t ae_v_len(ae_int_t a, ae_int_t b); - -/* -extern const double ae_machineepsilon; -extern const double ae_maxrealnumber; -extern const double ae_minrealnumber; -extern const double ae_pi; -*/ -#define ae_machineepsilon 5E-16 -#define ae_maxrealnumber 1E300 -#define ae_minrealnumber 1E-300 -#define ae_pi 3.1415926535897932384626433832795 - - -/************************************************************************ -RComm functions -************************************************************************/ -typedef struct rcommstate -{ - int stage; - ae_vector ia; - ae_vector ba; - ae_vector ra; - ae_vector ca; -} rcommstate; -ae_bool _rcommstate_init(rcommstate* p, ae_state *_state, ae_bool make_automatic); -ae_bool _rcommstate_init_copy(rcommstate* dst, rcommstate* src, ae_state *_state, ae_bool make_automatic); -void _rcommstate_clear(rcommstate* p); -void _rcommstate_destroy(rcommstate* p); - -#ifdef AE_USE_ALLOC_COUNTER -extern ae_int64_t _alloc_counter; -#endif - - -/************************************************************************ -debug functions (must be turned on by preprocessor definitions): -* tickcount(), which is wrapper around GetTickCount() -* flushconsole(), fluches console -* ae_debugrng(), returns random number generated with high-quality random numbers generator -* ae_set_seed(), sets seed of the debug RNG (NON-THREAD-SAFE!!!) -* ae_get_seed(), returns two seed values of the debug RNG (NON-THREAD-SAFE!!!) -************************************************************************/ -#ifdef AE_DEBUG4WINDOWS -#define flushconsole(s) fflush(stdout) -#define tickcount(s) _tickcount() -int _tickcount(); -#endif -#ifdef AE_DEBUG4POSIX -#define flushconsole(s) fflush(stdout) -#define tickcount(s) _tickcount() -int _tickcount(); -#endif -#ifdef AE_DEBUGRNG -ae_int_t ae_debugrng(); -void ae_set_seed(ae_int_t s0, ae_int_t s1); -void ae_get_seed(ae_int_t *s0, ae_int_t *s1); -#endif - - -} - - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS DECLARATIONS FOR C++ RELATED FUNCTIONALITY -// -///////////////////////////////////////////////////////////////////////// - -namespace alglib -{ - -typedef alglib_impl::ae_int_t ae_int_t; - -/******************************************************************** -Class forwards -********************************************************************/ -class complex; - -ae_int_t vlen(ae_int_t n1, ae_int_t n2); - -/******************************************************************** -Exception class. -********************************************************************/ -class ap_error -{ -public: - std::string msg; - - ap_error(); - ap_error(const char *s); - static void make_assertion(bool bClause); - static void make_assertion(bool bClause, const char *msg); -private: -}; - -/******************************************************************** -Complex number with double precision. -********************************************************************/ -class complex -{ -public: - complex(); - complex(const double &_x); - complex(const double &_x, const double &_y); - complex(const complex &z); - - complex& operator= (const double& v); - complex& operator+=(const double& v); - complex& operator-=(const double& v); - complex& operator*=(const double& v); - complex& operator/=(const double& v); - - complex& operator= (const complex& z); - complex& operator+=(const complex& z); - complex& operator-=(const complex& z); - complex& operator*=(const complex& z); - complex& operator/=(const complex& z); - - alglib_impl::ae_complex* c_ptr(); - const alglib_impl::ae_complex* c_ptr() const; - - std::string tostring(int dps) const; - - double x, y; -}; - -const alglib::complex operator/(const alglib::complex& lhs, const alglib::complex& rhs); -const bool operator==(const alglib::complex& lhs, const alglib::complex& rhs); -const bool operator!=(const alglib::complex& lhs, const alglib::complex& rhs); -const alglib::complex operator+(const alglib::complex& lhs); -const alglib::complex operator-(const alglib::complex& lhs); -const alglib::complex operator+(const alglib::complex& lhs, const alglib::complex& rhs); -const alglib::complex operator+(const alglib::complex& lhs, const double& rhs); -const alglib::complex operator+(const double& lhs, const alglib::complex& rhs); -const alglib::complex operator-(const alglib::complex& lhs, const alglib::complex& rhs); -const alglib::complex operator-(const alglib::complex& lhs, const double& rhs); -const alglib::complex operator-(const double& lhs, const alglib::complex& rhs); -const alglib::complex operator*(const alglib::complex& lhs, const alglib::complex& rhs); -const alglib::complex operator*(const alglib::complex& lhs, const double& rhs); -const alglib::complex operator*(const double& lhs, const alglib::complex& rhs); -const alglib::complex operator/(const alglib::complex& lhs, const alglib::complex& rhs); -const alglib::complex operator/(const double& lhs, const alglib::complex& rhs); -const alglib::complex operator/(const alglib::complex& lhs, const double& rhs); -double abscomplex(const alglib::complex &z); -alglib::complex conj(const alglib::complex &z); -alglib::complex csqr(const alglib::complex &z); -void setnworkers(alglib::ae_int_t nworkers); - -/******************************************************************** -Level 1 BLAS functions - -NOTES: -* destination and source should NOT overlap -* stride is assumed to be positive, but it is not - assert'ed within function -* conj_src parameter specifies whether complex source is conjugated - before processing or not. Pass string which starts with 'N' or 'n' - ("No conj", for example) to use unmodified parameter. All other - values will result in conjugation of input, but it is recommended - to use "Conj" in such cases. -********************************************************************/ -double vdotproduct(const double *v0, ae_int_t stride0, const double *v1, ae_int_t stride1, ae_int_t n); -double vdotproduct(const double *v1, const double *v2, ae_int_t N); - -alglib::complex vdotproduct(const alglib::complex *v0, ae_int_t stride0, const char *conj0, const alglib::complex *v1, ae_int_t stride1, const char *conj1, ae_int_t n); -alglib::complex vdotproduct(const alglib::complex *v1, const alglib::complex *v2, ae_int_t N); - -void vmove(double *vdst, ae_int_t stride_dst, const double* vsrc, ae_int_t stride_src, ae_int_t n); -void vmove(double *vdst, const double* vsrc, ae_int_t N); - -void vmove(alglib::complex *vdst, ae_int_t stride_dst, const alglib::complex* vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n); -void vmove(alglib::complex *vdst, const alglib::complex* vsrc, ae_int_t N); - -void vmoveneg(double *vdst, ae_int_t stride_dst, const double* vsrc, ae_int_t stride_src, ae_int_t n); -void vmoveneg(double *vdst, const double *vsrc, ae_int_t N); - -void vmoveneg(alglib::complex *vdst, ae_int_t stride_dst, const alglib::complex* vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n); -void vmoveneg(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N); - -void vmove(double *vdst, ae_int_t stride_dst, const double* vsrc, ae_int_t stride_src, ae_int_t n, double alpha); -void vmove(double *vdst, const double *vsrc, ae_int_t N, double alpha); - -void vmove(alglib::complex *vdst, ae_int_t stride_dst, const alglib::complex* vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, double alpha); -void vmove(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N, double alpha); - -void vmove(alglib::complex *vdst, ae_int_t stride_dst, const alglib::complex* vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, alglib::complex alpha); -void vmove(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N, alglib::complex alpha); - -void vadd(double *vdst, ae_int_t stride_dst, const double *vsrc, ae_int_t stride_src, ae_int_t n); -void vadd(double *vdst, const double *vsrc, ae_int_t N); - -void vadd(alglib::complex *vdst, ae_int_t stride_dst, const alglib::complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n); -void vadd(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N); - -void vadd(double *vdst, ae_int_t stride_dst, const double *vsrc, ae_int_t stride_src, ae_int_t n, double alpha); -void vadd(double *vdst, const double *vsrc, ae_int_t N, double alpha); - -void vadd(alglib::complex *vdst, ae_int_t stride_dst, const alglib::complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, double alpha); -void vadd(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N, double alpha); - -void vadd(alglib::complex *vdst, ae_int_t stride_dst, const alglib::complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, alglib::complex alpha); -void vadd(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N, alglib::complex alpha); - -void vsub(double *vdst, ae_int_t stride_dst, const double *vsrc, ae_int_t stride_src, ae_int_t n); -void vsub(double *vdst, const double *vsrc, ae_int_t N); - -void vsub(alglib::complex *vdst, ae_int_t stride_dst, const alglib::complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n); -void vsub(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N); - -void vsub(double *vdst, ae_int_t stride_dst, const double *vsrc, ae_int_t stride_src, ae_int_t n, double alpha); -void vsub(double *vdst, const double *vsrc, ae_int_t N, double alpha); - -void vsub(alglib::complex *vdst, ae_int_t stride_dst, const alglib::complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, double alpha); -void vsub(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N, double alpha); - -void vsub(alglib::complex *vdst, ae_int_t stride_dst, const alglib::complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, alglib::complex alpha); -void vsub(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N, alglib::complex alpha); - -void vmul(double *vdst, ae_int_t stride_dst, ae_int_t n, double alpha); -void vmul(double *vdst, ae_int_t N, double alpha); - -void vmul(alglib::complex *vdst, ae_int_t stride_dst, ae_int_t n, double alpha); -void vmul(alglib::complex *vdst, ae_int_t N, double alpha); - -void vmul(alglib::complex *vdst, ae_int_t stride_dst, ae_int_t n, alglib::complex alpha); -void vmul(alglib::complex *vdst, ae_int_t N, alglib::complex alpha); - - - -/******************************************************************** -string conversion functions !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -********************************************************************/ - -/******************************************************************** -1- and 2-dimensional arrays -********************************************************************/ -class ae_vector_wrapper -{ -public: - ae_vector_wrapper(); - virtual ~ae_vector_wrapper(); - - void setlength(ae_int_t iLen); - ae_int_t length() const; - - void attach_to(alglib_impl::ae_vector *ptr); - void allocate_own(ae_int_t size, alglib_impl::ae_datatype datatype); - const alglib_impl::ae_vector* c_ptr() const; - alglib_impl::ae_vector* c_ptr(); -private: - ae_vector_wrapper(const ae_vector_wrapper &rhs); - const ae_vector_wrapper& operator=(const ae_vector_wrapper &rhs); -protected: - // - // Copies source vector RHS into current object. - // - // Current object is considered empty (this function should be - // called from copy constructor). - // - void create(const ae_vector_wrapper &rhs); - - // - // Copies array given by string into current object. Additional - // parameter DATATYPE contains information about type of the data - // in S and type of the array to create. - // - // Current object is considered empty (this function should be - // called from copy constructor). - // - void create(const char *s, alglib_impl::ae_datatype datatype); - - // - // Assigns RHS to current object. - // - // It has several branches depending on target object status: - // * in case it is proxy object, data are copied into memory pointed by - // proxy. Function checks that source has exactly same size as target - // (exception is thrown on failure). - // * in case it is non-proxy object, data allocated by object are cleared - // and a copy of RHS is created in target. - // - // NOTE: this function correctly handles assignments of the object to itself. - // - void assign(const ae_vector_wrapper &rhs); - - alglib_impl::ae_vector *p_vec; - alglib_impl::ae_vector vec; -}; - -class boolean_1d_array : public ae_vector_wrapper -{ -public: - boolean_1d_array(); - boolean_1d_array(const char *s); - boolean_1d_array(const boolean_1d_array &rhs); - boolean_1d_array(alglib_impl::ae_vector *p); - const boolean_1d_array& operator=(const boolean_1d_array &rhs); - virtual ~boolean_1d_array() ; - - const ae_bool& operator()(ae_int_t i) const; - ae_bool& operator()(ae_int_t i); - - const ae_bool& operator[](ae_int_t i) const; - ae_bool& operator[](ae_int_t i); - - void setcontent(ae_int_t iLen, const bool *pContent ); - ae_bool* getcontent(); - const ae_bool* getcontent() const; - - std::string tostring() const; -}; - -class integer_1d_array : public ae_vector_wrapper -{ -public: - integer_1d_array(); - integer_1d_array(const char *s); - integer_1d_array(const integer_1d_array &rhs); - integer_1d_array(alglib_impl::ae_vector *p); - const integer_1d_array& operator=(const integer_1d_array &rhs); - virtual ~integer_1d_array(); - - const ae_int_t& operator()(ae_int_t i) const; - ae_int_t& operator()(ae_int_t i); - - const ae_int_t& operator[](ae_int_t i) const; - ae_int_t& operator[](ae_int_t i); - - void setcontent(ae_int_t iLen, const ae_int_t *pContent ); - - ae_int_t* getcontent(); - const ae_int_t* getcontent() const; - - std::string tostring() const; -}; - -class real_1d_array : public ae_vector_wrapper -{ -public: - real_1d_array(); - real_1d_array(const char *s); - real_1d_array(const real_1d_array &rhs); - real_1d_array(alglib_impl::ae_vector *p); - const real_1d_array& operator=(const real_1d_array &rhs); - virtual ~real_1d_array(); - - const double& operator()(ae_int_t i) const; - double& operator()(ae_int_t i); - - const double& operator[](ae_int_t i) const; - double& operator[](ae_int_t i); - - void setcontent(ae_int_t iLen, const double *pContent ); - double* getcontent(); - const double* getcontent() const; - - std::string tostring(int dps) const; -}; - -class complex_1d_array : public ae_vector_wrapper -{ -public: - complex_1d_array(); - complex_1d_array(const char *s); - complex_1d_array(const complex_1d_array &rhs); - complex_1d_array(alglib_impl::ae_vector *p); - const complex_1d_array& operator=(const complex_1d_array &rhs); - virtual ~complex_1d_array(); - - const alglib::complex& operator()(ae_int_t i) const; - alglib::complex& operator()(ae_int_t i); - - const alglib::complex& operator[](ae_int_t i) const; - alglib::complex& operator[](ae_int_t i); - - void setcontent(ae_int_t iLen, const alglib::complex *pContent ); - alglib::complex* getcontent(); - const alglib::complex* getcontent() const; - - std::string tostring(int dps) const; -}; - -class ae_matrix_wrapper -{ -public: - ae_matrix_wrapper(); - virtual ~ae_matrix_wrapper(); - const ae_matrix_wrapper& operator=(const ae_matrix_wrapper &rhs); - - void setlength(ae_int_t rows, ae_int_t cols); - ae_int_t rows() const; - ae_int_t cols() const; - bool isempty() const; - ae_int_t getstride() const; - - void attach_to(alglib_impl::ae_matrix *ptr); - void allocate_own(ae_int_t rows, ae_int_t cols, alglib_impl::ae_datatype datatype); - const alglib_impl::ae_matrix* c_ptr() const; - alglib_impl::ae_matrix* c_ptr(); -private: - ae_matrix_wrapper(const ae_matrix_wrapper &rhs); -protected: - // - // Copies source matrix RHS into current object. - // - // Current object is considered empty (this function should be - // called from copy constructor). - // - void create(const ae_matrix_wrapper &rhs); - - // - // Copies array given by string into current object. Additional - // parameter DATATYPE contains information about type of the data - // in S and type of the array to create. - // - // Current object is considered empty (this function should be - // called from copy constructor). - // - void create(const char *s, alglib_impl::ae_datatype datatype); - - // - // Assigns RHS to current object. - // - // It has several branches depending on target object status: - // * in case it is proxy object, data are copied into memory pointed by - // proxy. Function checks that source has exactly same size as target - // (exception is thrown on failure). - // * in case it is non-proxy object, data allocated by object are cleared - // and a copy of RHS is created in target. - // - // NOTE: this function correctly handles assignments of the object to itself. - // - void assign(const ae_matrix_wrapper &rhs); - - alglib_impl::ae_matrix *p_mat; - alglib_impl::ae_matrix mat; -}; - -class boolean_2d_array : public ae_matrix_wrapper -{ -public: - boolean_2d_array(); - boolean_2d_array(const boolean_2d_array &rhs); - boolean_2d_array(alglib_impl::ae_matrix *p); - boolean_2d_array(const char *s); - virtual ~boolean_2d_array(); - - const ae_bool& operator()(ae_int_t i, ae_int_t j) const; - ae_bool& operator()(ae_int_t i, ae_int_t j); - - const ae_bool* operator[](ae_int_t i) const; - ae_bool* operator[](ae_int_t i); - - void setcontent(ae_int_t irows, ae_int_t icols, const bool *pContent ); - - std::string tostring() const ; -}; - -class integer_2d_array : public ae_matrix_wrapper -{ -public: - integer_2d_array(); - integer_2d_array(const integer_2d_array &rhs); - integer_2d_array(alglib_impl::ae_matrix *p); - integer_2d_array(const char *s); - virtual ~integer_2d_array(); - - const ae_int_t& operator()(ae_int_t i, ae_int_t j) const; - ae_int_t& operator()(ae_int_t i, ae_int_t j); - - const ae_int_t* operator[](ae_int_t i) const; - ae_int_t* operator[](ae_int_t i); - - void setcontent(ae_int_t irows, ae_int_t icols, const ae_int_t *pContent ); - - std::string tostring() const; -}; - -class real_2d_array : public ae_matrix_wrapper -{ -public: - real_2d_array(); - real_2d_array(const real_2d_array &rhs); - real_2d_array(alglib_impl::ae_matrix *p); - real_2d_array(const char *s); - virtual ~real_2d_array(); - - const double& operator()(ae_int_t i, ae_int_t j) const; - double& operator()(ae_int_t i, ae_int_t j); - - const double* operator[](ae_int_t i) const; - double* operator[](ae_int_t i); - - void setcontent(ae_int_t irows, ae_int_t icols, const double *pContent ); - - std::string tostring(int dps) const; -}; - -class complex_2d_array : public ae_matrix_wrapper -{ -public: - complex_2d_array(); - complex_2d_array(const complex_2d_array &rhs); - complex_2d_array(alglib_impl::ae_matrix *p); - complex_2d_array(const char *s); - virtual ~complex_2d_array(); - - const alglib::complex& operator()(ae_int_t i, ae_int_t j) const; - alglib::complex& operator()(ae_int_t i, ae_int_t j); - - const alglib::complex* operator[](ae_int_t i) const; - alglib::complex* operator[](ae_int_t i); - - void setcontent(ae_int_t irows, ae_int_t icols, const alglib::complex *pContent ); - - std::string tostring(int dps) const; -}; - - - -/******************************************************************** -dataset information. - -can store regression dataset, classification dataset, or non-labeled -task: -* nout==0 means non-labeled task (clustering, for example) -* nout>0 && nclasses==0 means regression task -* nout>0 && nclasses>0 means classification task -********************************************************************/ -/*class dataset -{ -public: - dataset():nin(0), nout(0), nclasses(0), trnsize(0), valsize(0), tstsize(0), totalsize(0){}; - - int nin, nout, nclasses; - - int trnsize; - int valsize; - int tstsize; - int totalsize; - - alglib::real_2d_array trn; - alglib::real_2d_array val; - alglib::real_2d_array tst; - alglib::real_2d_array all; -}; - -bool opendataset(std::string file, dataset *pdataset); - -// -// internal functions -// -std::string strtolower(const std::string &s); -bool readstrings(std::string file, std::list *pOutput); -bool readstrings(std::string file, std::list *pOutput, std::string comment); -void explodestring(std::string s, char sep, std::vector *pOutput); -std::string xtrim(std::string s);*/ - -/******************************************************************** -Constants and functions introduced for compatibility with AlgoPascal -********************************************************************/ -extern const double machineepsilon; -extern const double maxrealnumber; -extern const double minrealnumber; -extern const double fp_nan; -extern const double fp_posinf; -extern const double fp_neginf; -extern const ae_int_t endianness; - -int sign(double x); -double randomreal(); -ae_int_t randominteger(ae_int_t maxv); -int round(double x); -int trunc(double x); -int ifloor(double x); -int iceil(double x); -double pi(); -double sqr(double x); -int maxint(int m1, int m2); -int minint(int m1, int m2); -double maxreal(double m1, double m2); -double minreal(double m1, double m2); - -bool fp_eq(double v1, double v2); -bool fp_neq(double v1, double v2); -bool fp_less(double v1, double v2); -bool fp_less_eq(double v1, double v2); -bool fp_greater(double v1, double v2); -bool fp_greater_eq(double v1, double v2); - -bool fp_isnan(double x); -bool fp_isposinf(double x); -bool fp_isneginf(double x); -bool fp_isinf(double x); -bool fp_isfinite(double x); - - -}//namespace alglib - - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTIONS CONTAINS DECLARATIONS FOR OPTIMIZED LINEAR ALGEBRA CODES -// IT IS SHARED BETWEEN C++ AND PURE C LIBRARIES -// -///////////////////////////////////////////////////////////////////////// - -namespace alglib_impl -{ -#define ALGLIB_INTERCEPTS_ABLAS -void _ialglib_vzero(ae_int_t n, double *p, ae_int_t stride); -void _ialglib_vzero_complex(ae_int_t n, ae_complex *p, ae_int_t stride); -void _ialglib_vcopy(ae_int_t n, const double *a, ae_int_t stridea, double *b, ae_int_t strideb); -void _ialglib_vcopy_complex(ae_int_t n, const ae_complex *a, ae_int_t stridea, double *b, ae_int_t strideb, const char *conj); -void _ialglib_vcopy_dcomplex(ae_int_t n, const double *a, ae_int_t stridea, double *b, ae_int_t strideb, const char *conj); -void _ialglib_mcopyblock(ae_int_t m, ae_int_t n, const double *a, ae_int_t op, ae_int_t stride, double *b); -void _ialglib_mcopyunblock(ae_int_t m, ae_int_t n, const double *a, ae_int_t op, double *b, ae_int_t stride); -void _ialglib_mcopyblock_complex(ae_int_t m, ae_int_t n, const ae_complex *a, ae_int_t op, ae_int_t stride, double *b); -void _ialglib_mcopyunblock_complex(ae_int_t m, ae_int_t n, const double *a, ae_int_t op, ae_complex* b, ae_int_t stride); - -ae_bool _ialglib_i_rmatrixgemmf(ae_int_t m, - ae_int_t n, - ae_int_t k, - double alpha, - ae_matrix *a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - ae_matrix *b, - ae_int_t ib, - ae_int_t jb, - ae_int_t optypeb, - double beta, - ae_matrix *c, - ae_int_t ic, - ae_int_t jc); -ae_bool _ialglib_i_cmatrixgemmf(ae_int_t m, - ae_int_t n, - ae_int_t k, - ae_complex alpha, - ae_matrix *a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - ae_matrix *b, - ae_int_t ib, - ae_int_t jb, - ae_int_t optypeb, - ae_complex beta, - ae_matrix *c, - ae_int_t ic, - ae_int_t jc); -ae_bool _ialglib_i_cmatrixrighttrsmf(ae_int_t m, - ae_int_t n, - ae_matrix *a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - ae_matrix *x, - ae_int_t i2, - ae_int_t j2); -ae_bool _ialglib_i_rmatrixrighttrsmf(ae_int_t m, - ae_int_t n, - ae_matrix *a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - ae_matrix *x, - ae_int_t i2, - ae_int_t j2); -ae_bool _ialglib_i_cmatrixlefttrsmf(ae_int_t m, - ae_int_t n, - ae_matrix *a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - ae_matrix *x, - ae_int_t i2, - ae_int_t j2); -ae_bool _ialglib_i_rmatrixlefttrsmf(ae_int_t m, - ae_int_t n, - ae_matrix *a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - ae_matrix *x, - ae_int_t i2, - ae_int_t j2); -ae_bool _ialglib_i_cmatrixsyrkf(ae_int_t n, - ae_int_t k, - double alpha, - ae_matrix *a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - double beta, - ae_matrix *c, - ae_int_t ic, - ae_int_t jc, - ae_bool isupper); -ae_bool _ialglib_i_rmatrixsyrkf(ae_int_t n, - ae_int_t k, - double alpha, - ae_matrix *a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - double beta, - ae_matrix *c, - ae_int_t ic, - ae_int_t jc, - ae_bool isupper); -ae_bool _ialglib_i_cmatrixrank1f(ae_int_t m, - ae_int_t n, - ae_matrix *a, - ae_int_t ia, - ae_int_t ja, - ae_vector *u, - ae_int_t uoffs, - ae_vector *v, - ae_int_t voffs); -ae_bool _ialglib_i_rmatrixrank1f(ae_int_t m, - ae_int_t n, - ae_matrix *a, - ae_int_t ia, - ae_int_t ja, - ae_vector *u, - ae_int_t uoffs, - ae_vector *v, - ae_int_t voffs); - - - -} - - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS PARALLEL SUBROUTINES -// -///////////////////////////////////////////////////////////////////////// - -namespace alglib_impl -{ - -} - - -#endif - diff --git a/src/core/alglib/dataanalysis.cpp b/src/core/alglib/dataanalysis.cpp deleted file mode 100644 index 79c433d..0000000 --- a/src/core/alglib/dataanalysis.cpp +++ /dev/null @@ -1,35078 +0,0 @@ -/************************************************************************* -Copyright (c) Sergey Bochkanov (ALGLIB project). - ->>> SOURCE LICENSE >>> -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation (www.fsf.org); either version 2 of the -License, or (at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -A copy of the GNU General Public License is available at -http://www.fsf.org/licensing/licenses ->>> END OF LICENSE >>> -*************************************************************************/ -#include "stdafx.h" -#include "dataanalysis.h" - -// disable some irrelevant warnings -#if (AE_COMPILER==AE_MSVC) -#pragma warning(disable:4100) -#pragma warning(disable:4127) -#pragma warning(disable:4702) -#pragma warning(disable:4996) -#endif -using namespace std; - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS IMPLEMENTATION OF C++ INTERFACE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib -{ - - -/************************************************************************* -Optimal binary classification - -Algorithms finds optimal (=with minimal cross-entropy) binary partition. -Internal subroutine. - -INPUT PARAMETERS: - A - array[0..N-1], variable - C - array[0..N-1], class numbers (0 or 1). - N - array size - -OUTPUT PARAMETERS: - Info - completion code: - * -3, all values of A[] are same (partition is impossible) - * -2, one of C[] is incorrect (<0, >1) - * -1, incorrect pararemets were passed (N<=0). - * 1, OK - Threshold- partiton boundary. Left part contains values which are - strictly less than Threshold. Right part contains values - which are greater than or equal to Threshold. - PAL, PBL- probabilities P(0|v=Threshold) and P(1|v>=Threshold) - CVE - cross-validation estimate of cross-entropy - - -- ALGLIB -- - Copyright 22.05.2008 by Bochkanov Sergey -*************************************************************************/ -void dsoptimalsplit2(const real_1d_array &a, const integer_1d_array &c, const ae_int_t n, ae_int_t &info, double &threshold, double &pal, double &pbl, double &par, double &pbr, double &cve) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::dsoptimalsplit2(const_cast(a.c_ptr()), const_cast(c.c_ptr()), n, &info, &threshold, &pal, &pbl, &par, &pbr, &cve, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Optimal partition, internal subroutine. Fast version. - -Accepts: - A array[0..N-1] array of attributes array[0..N-1] - C array[0..N-1] array of class labels - TiesBuf array[0..N] temporaries (ties) - CntBuf array[0..2*NC-1] temporaries (counts) - Alpha centering factor (0<=alpha<=1, recommended value - 0.05) - BufR array[0..N-1] temporaries - BufI array[0..N-1] temporaries - -Output: - Info error code (">0"=OK, "<0"=bad) - RMS training set RMS error - CVRMS leave-one-out RMS error - -Note: - content of all arrays is changed by subroutine; - it doesn't allocate temporaries. - - -- ALGLIB -- - Copyright 11.12.2008 by Bochkanov Sergey -*************************************************************************/ -void dsoptimalsplit2fast(real_1d_array &a, integer_1d_array &c, integer_1d_array &tiesbuf, integer_1d_array &cntbuf, real_1d_array &bufr, integer_1d_array &bufi, const ae_int_t n, const ae_int_t nc, const double alpha, ae_int_t &info, double &threshold, double &rms, double &cvrms) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::dsoptimalsplit2fast(const_cast(a.c_ptr()), const_cast(c.c_ptr()), const_cast(tiesbuf.c_ptr()), const_cast(cntbuf.c_ptr()), const_cast(bufr.c_ptr()), const_cast(bufi.c_ptr()), n, nc, alpha, &info, &threshold, &rms, &cvrms, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This structure is a clusterization engine. - -You should not try to access its fields directly. -Use ALGLIB functions in order to work with this object. - - -- ALGLIB -- - Copyright 10.07.2012 by Bochkanov Sergey -*************************************************************************/ -_clusterizerstate_owner::_clusterizerstate_owner() -{ - p_struct = (alglib_impl::clusterizerstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::clusterizerstate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_clusterizerstate_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_clusterizerstate_owner::_clusterizerstate_owner(const _clusterizerstate_owner &rhs) -{ - p_struct = (alglib_impl::clusterizerstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::clusterizerstate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_clusterizerstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_clusterizerstate_owner& _clusterizerstate_owner::operator=(const _clusterizerstate_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_clusterizerstate_clear(p_struct); - if( !alglib_impl::_clusterizerstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_clusterizerstate_owner::~_clusterizerstate_owner() -{ - alglib_impl::_clusterizerstate_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::clusterizerstate* _clusterizerstate_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::clusterizerstate* _clusterizerstate_owner::c_ptr() const -{ - return const_cast(p_struct); -} -clusterizerstate::clusterizerstate() : _clusterizerstate_owner() -{ -} - -clusterizerstate::clusterizerstate(const clusterizerstate &rhs):_clusterizerstate_owner(rhs) -{ -} - -clusterizerstate& clusterizerstate::operator=(const clusterizerstate &rhs) -{ - if( this==&rhs ) - return *this; - _clusterizerstate_owner::operator=(rhs); - return *this; -} - -clusterizerstate::~clusterizerstate() -{ -} - - -/************************************************************************* -This structure is used to store results of the agglomerative hierarchical -clustering (AHC). - -Following information is returned: - -* NPoints contains number of points in the original dataset - -* Z contains information about merges performed (see below). Z contains - indexes from the original (unsorted) dataset and it can be used when you - need to know what points were merged. However, it is not convenient when - you want to build a dendrograd (see below). - -* if you want to build dendrogram, you can use Z, but it is not good - option, because Z contains indexes from unsorted dataset. Dendrogram - built from such dataset is likely to have intersections. So, you have to - reorder you points before building dendrogram. - Permutation which reorders point is returned in P. Another representation - of merges, which is more convenient for dendorgram construction, is - returned in PM. - -* more information on format of Z, P and PM can be found below and in the - examples from ALGLIB Reference Manual. - -FORMAL DESCRIPTION OF FIELDS: - NPoints number of points - Z array[NPoints-1,2], contains indexes of clusters - linked in pairs to form clustering tree. I-th row - corresponds to I-th merge: - * Z[I,0] - index of the first cluster to merge - * Z[I,1] - index of the second cluster to merge - * Z[I,0](rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_ahcreport_owner& _ahcreport_owner::operator=(const _ahcreport_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_ahcreport_clear(p_struct); - if( !alglib_impl::_ahcreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_ahcreport_owner::~_ahcreport_owner() -{ - alglib_impl::_ahcreport_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::ahcreport* _ahcreport_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::ahcreport* _ahcreport_owner::c_ptr() const -{ - return const_cast(p_struct); -} -ahcreport::ahcreport() : _ahcreport_owner() ,npoints(p_struct->npoints),p(&p_struct->p),z(&p_struct->z),pz(&p_struct->pz),pm(&p_struct->pm),mergedist(&p_struct->mergedist) -{ -} - -ahcreport::ahcreport(const ahcreport &rhs):_ahcreport_owner(rhs) ,npoints(p_struct->npoints),p(&p_struct->p),z(&p_struct->z),pz(&p_struct->pz),pm(&p_struct->pm),mergedist(&p_struct->mergedist) -{ -} - -ahcreport& ahcreport::operator=(const ahcreport &rhs) -{ - if( this==&rhs ) - return *this; - _ahcreport_owner::operator=(rhs); - return *this; -} - -ahcreport::~ahcreport() -{ -} - - -/************************************************************************* -This structure is used to store results of the k-means++ clustering -algorithm. - -Following information is always returned: -* NPoints contains number of points in the original dataset -* TerminationType contains completion code, negative on failure, positive - on success -* K contains number of clusters - -For positive TerminationType we return: -* NFeatures contains number of variables in the original dataset -* C, which contains centers found by algorithm -* CIdx, which maps points of the original dataset to clusters - -FORMAL DESCRIPTION OF FIELDS: - NPoints number of points, >=0 - NFeatures number of variables, >=1 - TerminationType completion code: - * -5 if distance type is anything different from - Euclidean metric - * -3 for degenerate dataset: a) less than K distinct - points, b) K=0 for non-empty dataset. - * +1 for successful completion - K number of clusters - C array[K,NFeatures], rows of the array store centers - CIdx array[NPoints], which contains cluster indexes - - -- ALGLIB -- - Copyright 27.11.2012 by Bochkanov Sergey -*************************************************************************/ -_kmeansreport_owner::_kmeansreport_owner() -{ - p_struct = (alglib_impl::kmeansreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::kmeansreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_kmeansreport_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_kmeansreport_owner::_kmeansreport_owner(const _kmeansreport_owner &rhs) -{ - p_struct = (alglib_impl::kmeansreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::kmeansreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_kmeansreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_kmeansreport_owner& _kmeansreport_owner::operator=(const _kmeansreport_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_kmeansreport_clear(p_struct); - if( !alglib_impl::_kmeansreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_kmeansreport_owner::~_kmeansreport_owner() -{ - alglib_impl::_kmeansreport_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::kmeansreport* _kmeansreport_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::kmeansreport* _kmeansreport_owner::c_ptr() const -{ - return const_cast(p_struct); -} -kmeansreport::kmeansreport() : _kmeansreport_owner() ,npoints(p_struct->npoints),nfeatures(p_struct->nfeatures),terminationtype(p_struct->terminationtype),k(p_struct->k),c(&p_struct->c),cidx(&p_struct->cidx) -{ -} - -kmeansreport::kmeansreport(const kmeansreport &rhs):_kmeansreport_owner(rhs) ,npoints(p_struct->npoints),nfeatures(p_struct->nfeatures),terminationtype(p_struct->terminationtype),k(p_struct->k),c(&p_struct->c),cidx(&p_struct->cidx) -{ -} - -kmeansreport& kmeansreport::operator=(const kmeansreport &rhs) -{ - if( this==&rhs ) - return *this; - _kmeansreport_owner::operator=(rhs); - return *this; -} - -kmeansreport::~kmeansreport() -{ -} - -/************************************************************************* -This function initializes clusterizer object. Newly initialized object is -empty, i.e. it does not contain dataset. You should use it as follows: -1. creation -2. dataset is added with ClusterizerSetPoints() -3. additional parameters are set -3. clusterization is performed with one of the clustering functions - - -- ALGLIB -- - Copyright 10.07.2012 by Bochkanov Sergey -*************************************************************************/ -void clusterizercreate(clusterizerstate &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::clusterizercreate(const_cast(s.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function adds dataset to the clusterizer structure. - -This function overrides all previous calls of ClusterizerSetPoints() or -ClusterizerSetDistances(). - -INPUT PARAMETERS: - S - clusterizer state, initialized by ClusterizerCreate() - XY - array[NPoints,NFeatures], dataset - NPoints - number of points, >=0 - NFeatures- number of features, >=1 - DistType- distance function: - * 0 Chebyshev distance (L-inf norm) - * 1 city block distance (L1 norm) - * 2 Euclidean distance (L2 norm) - * 10 Pearson correlation: - dist(a,b) = 1-corr(a,b) - * 11 Absolute Pearson correlation: - dist(a,b) = 1-|corr(a,b)| - * 12 Uncentered Pearson correlation (cosine of the angle): - dist(a,b) = a'*b/(|a|*|b|) - * 13 Absolute uncentered Pearson correlation - dist(a,b) = |a'*b|/(|a|*|b|) - * 20 Spearman rank correlation: - dist(a,b) = 1-rankcorr(a,b) - * 21 Absolute Spearman rank correlation - dist(a,b) = 1-|rankcorr(a,b)| - -NOTE 1: different distance functions have different performance penalty: - * Euclidean or Pearson correlation distances are the fastest ones - * Spearman correlation distance function is a bit slower - * city block and Chebyshev distances are order of magnitude slower - - The reason behing difference in performance is that correlation-based - distance functions are computed using optimized linear algebra kernels, - while Chebyshev and city block distance functions are computed using - simple nested loops with two branches at each iteration. - -NOTE 2: different clustering algorithms have different limitations: - * agglomerative hierarchical clustering algorithms may be used with - any kind of distance metric - * k-means++ clustering algorithm may be used only with Euclidean - distance function - Thus, list of specific clustering algorithms you may use depends - on distance function you specify when you set your dataset. - - -- ALGLIB -- - Copyright 10.07.2012 by Bochkanov Sergey -*************************************************************************/ -void clusterizersetpoints(const clusterizerstate &s, const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nfeatures, const ae_int_t disttype) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::clusterizersetpoints(const_cast(s.c_ptr()), const_cast(xy.c_ptr()), npoints, nfeatures, disttype, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function adds dataset to the clusterizer structure. - -This function overrides all previous calls of ClusterizerSetPoints() or -ClusterizerSetDistances(). - -INPUT PARAMETERS: - S - clusterizer state, initialized by ClusterizerCreate() - XY - array[NPoints,NFeatures], dataset - NPoints - number of points, >=0 - NFeatures- number of features, >=1 - DistType- distance function: - * 0 Chebyshev distance (L-inf norm) - * 1 city block distance (L1 norm) - * 2 Euclidean distance (L2 norm) - * 10 Pearson correlation: - dist(a,b) = 1-corr(a,b) - * 11 Absolute Pearson correlation: - dist(a,b) = 1-|corr(a,b)| - * 12 Uncentered Pearson correlation (cosine of the angle): - dist(a,b) = a'*b/(|a|*|b|) - * 13 Absolute uncentered Pearson correlation - dist(a,b) = |a'*b|/(|a|*|b|) - * 20 Spearman rank correlation: - dist(a,b) = 1-rankcorr(a,b) - * 21 Absolute Spearman rank correlation - dist(a,b) = 1-|rankcorr(a,b)| - -NOTE 1: different distance functions have different performance penalty: - * Euclidean or Pearson correlation distances are the fastest ones - * Spearman correlation distance function is a bit slower - * city block and Chebyshev distances are order of magnitude slower - - The reason behing difference in performance is that correlation-based - distance functions are computed using optimized linear algebra kernels, - while Chebyshev and city block distance functions are computed using - simple nested loops with two branches at each iteration. - -NOTE 2: different clustering algorithms have different limitations: - * agglomerative hierarchical clustering algorithms may be used with - any kind of distance metric - * k-means++ clustering algorithm may be used only with Euclidean - distance function - Thus, list of specific clustering algorithms you may use depends - on distance function you specify when you set your dataset. - - -- ALGLIB -- - Copyright 10.07.2012 by Bochkanov Sergey -*************************************************************************/ -void clusterizersetpoints(const clusterizerstate &s, const real_2d_array &xy, const ae_int_t disttype) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t npoints; - ae_int_t nfeatures; - - npoints = xy.rows(); - nfeatures = xy.cols(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::clusterizersetpoints(const_cast(s.c_ptr()), const_cast(xy.c_ptr()), npoints, nfeatures, disttype, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function adds dataset given by distance matrix to the clusterizer -structure. It is important that dataset is not given explicitly - only -distance matrix is given. - -This function overrides all previous calls of ClusterizerSetPoints() or -ClusterizerSetDistances(). - -INPUT PARAMETERS: - S - clusterizer state, initialized by ClusterizerCreate() - D - array[NPoints,NPoints], distance matrix given by its upper - or lower triangle (main diagonal is ignored because its - entries are expected to be zero). - NPoints - number of points - IsUpper - whether upper or lower triangle of D is given. - -NOTE 1: different clustering algorithms have different limitations: - * agglomerative hierarchical clustering algorithms may be used with - any kind of distance metric, including one which is given by - distance matrix - * k-means++ clustering algorithm may be used only with Euclidean - distance function and explicitly given points - it can not be - used with dataset given by distance matrix - Thus, if you call this function, you will be unable to use k-means - clustering algorithm to process your problem. - - -- ALGLIB -- - Copyright 10.07.2012 by Bochkanov Sergey -*************************************************************************/ -void clusterizersetdistances(const clusterizerstate &s, const real_2d_array &d, const ae_int_t npoints, const bool isupper) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::clusterizersetdistances(const_cast(s.c_ptr()), const_cast(d.c_ptr()), npoints, isupper, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function adds dataset given by distance matrix to the clusterizer -structure. It is important that dataset is not given explicitly - only -distance matrix is given. - -This function overrides all previous calls of ClusterizerSetPoints() or -ClusterizerSetDistances(). - -INPUT PARAMETERS: - S - clusterizer state, initialized by ClusterizerCreate() - D - array[NPoints,NPoints], distance matrix given by its upper - or lower triangle (main diagonal is ignored because its - entries are expected to be zero). - NPoints - number of points - IsUpper - whether upper or lower triangle of D is given. - -NOTE 1: different clustering algorithms have different limitations: - * agglomerative hierarchical clustering algorithms may be used with - any kind of distance metric, including one which is given by - distance matrix - * k-means++ clustering algorithm may be used only with Euclidean - distance function and explicitly given points - it can not be - used with dataset given by distance matrix - Thus, if you call this function, you will be unable to use k-means - clustering algorithm to process your problem. - - -- ALGLIB -- - Copyright 10.07.2012 by Bochkanov Sergey -*************************************************************************/ -void clusterizersetdistances(const clusterizerstate &s, const real_2d_array &d, const bool isupper) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t npoints; - if( (d.rows()!=d.cols())) - throw ap_error("Error while calling 'clusterizersetdistances': looks like one of arguments has wrong size"); - npoints = d.rows(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::clusterizersetdistances(const_cast(s.c_ptr()), const_cast(d.c_ptr()), npoints, isupper, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets agglomerative hierarchical clustering algorithm - -INPUT PARAMETERS: - S - clusterizer state, initialized by ClusterizerCreate() - Algo - algorithm type: - * 0 complete linkage (default algorithm) - * 1 single linkage - * 2 unweighted average linkage - * 3 weighted average linkage - - -- ALGLIB -- - Copyright 10.07.2012 by Bochkanov Sergey -*************************************************************************/ -void clusterizersetahcalgo(const clusterizerstate &s, const ae_int_t algo) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::clusterizersetahcalgo(const_cast(s.c_ptr()), algo, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets k-means++ properties : number of restarts and maximum -number of iterations per one run. - -INPUT PARAMETERS: - S - clusterizer state, initialized by ClusterizerCreate() - Restarts- restarts count, >=1. - k-means++ algorithm performs several restarts and chooses - best set of centers (one with minimum squared distance). - MaxIts - maximum number of k-means iterations performed during one - run. >=0, zero value means that algorithm performs unlimited - number of iterations. - - -- ALGLIB -- - Copyright 10.07.2012 by Bochkanov Sergey -*************************************************************************/ -void clusterizersetkmeanslimits(const clusterizerstate &s, const ae_int_t restarts, const ae_int_t maxits) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::clusterizersetkmeanslimits(const_cast(s.c_ptr()), restarts, maxits, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function performs agglomerative hierarchical clustering - -FOR USERS OF SMP EDITION: - - ! This function can utilize multicore capabilities of your system. In - ! order to do this you have to call version with "smp_" prefix, which - ! indicates that multicore code will be used. - ! - ! This note is given for users of SMP edition; if you use GPL edition, - ! or commercial edition of ALGLIB without SMP support, you still will - ! be able to call smp-version of this function, but all computations - ! will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - ! - ! You should remember that starting/stopping worker thread always have - ! non-zero cost. Multicore version is pretty efficient on large - ! problems which need more than 1.000.000 operations to be solved, - ! gives moderate speed-up in mid-range (from 100.000 to 1.000.000 CPU - ! cycles), but gives no speed-up for small problems (less than 100.000 - ! operations). - -INPUT PARAMETERS: - S - clusterizer state, initialized by ClusterizerCreate() - -OUTPUT PARAMETERS: - Rep - clustering results; see description of AHCReport - structure for more information. - -NOTE 1: hierarchical clustering algorithms require large amounts of memory. - In particular, this implementation needs sizeof(double)*NPoints^2 - bytes, which are used to store distance matrix. In case we work - with user-supplied matrix, this amount is multiplied by 2 (we have - to store original matrix and to work with its copy). - - For example, problem with 10000 points would require 800M of RAM, - even when working in a 1-dimensional space. - - -- ALGLIB -- - Copyright 10.07.2012 by Bochkanov Sergey -*************************************************************************/ -void clusterizerrunahc(const clusterizerstate &s, ahcreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::clusterizerrunahc(const_cast(s.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_clusterizerrunahc(const clusterizerstate &s, ahcreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_clusterizerrunahc(const_cast(s.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function performs clustering by k-means++ algorithm. - -You may change algorithm properties like number of restarts or iterations -limit by calling ClusterizerSetKMeansLimits() functions. - -INPUT PARAMETERS: - S - clusterizer state, initialized by ClusterizerCreate() - K - number of clusters, K>=0. - K can be zero only when algorithm is called for empty - dataset, in this case completion code is set to - success (+1). - If K=0 and dataset size is non-zero, we can not - meaningfully assign points to some center (there are no - centers because K=0) and return -3 as completion code - (failure). - -OUTPUT PARAMETERS: - Rep - clustering results; see description of KMeansReport - structure for more information. - -NOTE 1: k-means clustering can be performed only for datasets with - Euclidean distance function. Algorithm will return negative - completion code in Rep.TerminationType in case dataset was added - to clusterizer with DistType other than Euclidean (or dataset was - specified by distance matrix instead of explicitly given points). - - -- ALGLIB -- - Copyright 10.07.2012 by Bochkanov Sergey -*************************************************************************/ -void clusterizerrunkmeans(const clusterizerstate &s, const ae_int_t k, kmeansreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::clusterizerrunkmeans(const_cast(s.c_ptr()), k, const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function returns distance matrix for dataset - -FOR USERS OF SMP EDITION: - - ! This function can utilize multicore capabilities of your system. In - ! order to do this you have to call version with "smp_" prefix, which - ! indicates that multicore code will be used. - ! - ! This note is given for users of SMP edition; if you use GPL edition, - ! or commercial edition of ALGLIB without SMP support, you still will - ! be able to call smp-version of this function, but all computations - ! will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - ! - ! You should remember that starting/stopping worker thread always have - ! non-zero cost. Multicore version is pretty efficient on large - ! problems which need more than 1.000.000 operations to be solved, - ! gives moderate speed-up in mid-range (from 100.000 to 1.000.000 CPU - ! cycles), but gives no speed-up for small problems (less than 100.000 - ! operations). - -INPUT PARAMETERS: - XY - array[NPoints,NFeatures], dataset - NPoints - number of points, >=0 - NFeatures- number of features, >=1 - DistType- distance function: - * 0 Chebyshev distance (L-inf norm) - * 1 city block distance (L1 norm) - * 2 Euclidean distance (L2 norm) - * 10 Pearson correlation: - dist(a,b) = 1-corr(a,b) - * 11 Absolute Pearson correlation: - dist(a,b) = 1-|corr(a,b)| - * 12 Uncentered Pearson correlation (cosine of the angle): - dist(a,b) = a'*b/(|a|*|b|) - * 13 Absolute uncentered Pearson correlation - dist(a,b) = |a'*b|/(|a|*|b|) - * 20 Spearman rank correlation: - dist(a,b) = 1-rankcorr(a,b) - * 21 Absolute Spearman rank correlation - dist(a,b) = 1-|rankcorr(a,b)| - -OUTPUT PARAMETERS: - D - array[NPoints,NPoints], distance matrix - (full matrix is returned, with lower and upper triangles) - -NOTES: different distance functions have different performance penalty: - * Euclidean or Pearson correlation distances are the fastest ones - * Spearman correlation distance function is a bit slower - * city block and Chebyshev distances are order of magnitude slower - - The reason behing difference in performance is that correlation-based - distance functions are computed using optimized linear algebra kernels, - while Chebyshev and city block distance functions are computed using - simple nested loops with two branches at each iteration. - - -- ALGLIB -- - Copyright 10.07.2012 by Bochkanov Sergey -*************************************************************************/ -void clusterizergetdistances(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nfeatures, const ae_int_t disttype, real_2d_array &d) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::clusterizergetdistances(const_cast(xy.c_ptr()), npoints, nfeatures, disttype, const_cast(d.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_clusterizergetdistances(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nfeatures, const ae_int_t disttype, real_2d_array &d) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_clusterizergetdistances(const_cast(xy.c_ptr()), npoints, nfeatures, disttype, const_cast(d.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function takes as input clusterization report Rep, desired clusters -count K, and builds top K clusters from hierarchical clusterization tree. -It returns assignment of points to clusters (array of cluster indexes). - -INPUT PARAMETERS: - Rep - report from ClusterizerRunAHC() performed on XY - K - desired number of clusters, 1<=K<=NPoints. - K can be zero only when NPoints=0. - -OUTPUT PARAMETERS: - CIdx - array[NPoints], I-th element contains cluster index (from - 0 to K-1) for I-th point of the dataset. - CZ - array[K]. This array allows to convert cluster indexes - returned by this function to indexes used by Rep.Z. J-th - cluster returned by this function corresponds to CZ[J]-th - cluster stored in Rep.Z/PZ/PM. - It is guaranteed that CZ[I](rep.c_ptr()), k, const_cast(cidx.c_ptr()), const_cast(cz.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function accepts AHC report Rep, desired minimum intercluster -distance and returns top clusters from hierarchical clusterization tree -which are separated by distance R or HIGHER. - -It returns assignment of points to clusters (array of cluster indexes). - -There is one more function with similar name - ClusterizerSeparatedByCorr, -which returns clusters with intercluster correlation equal to R or LOWER -(note: higher for distance, lower for correlation). - -INPUT PARAMETERS: - Rep - report from ClusterizerRunAHC() performed on XY - R - desired minimum intercluster distance, R>=0 - -OUTPUT PARAMETERS: - K - number of clusters, 1<=K<=NPoints - CIdx - array[NPoints], I-th element contains cluster index (from - 0 to K-1) for I-th point of the dataset. - CZ - array[K]. This array allows to convert cluster indexes - returned by this function to indexes used by Rep.Z. J-th - cluster returned by this function corresponds to CZ[J]-th - cluster stored in Rep.Z/PZ/PM. - It is guaranteed that CZ[I](rep.c_ptr()), r, &k, const_cast(cidx.c_ptr()), const_cast(cz.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function accepts AHC report Rep, desired maximum intercluster -correlation and returns top clusters from hierarchical clusterization tree -which are separated by correlation R or LOWER. - -It returns assignment of points to clusters (array of cluster indexes). - -There is one more function with similar name - ClusterizerSeparatedByDist, -which returns clusters with intercluster distance equal to R or HIGHER -(note: higher for distance, lower for correlation). - -INPUT PARAMETERS: - Rep - report from ClusterizerRunAHC() performed on XY - R - desired maximum intercluster correlation, -1<=R<=+1 - -OUTPUT PARAMETERS: - K - number of clusters, 1<=K<=NPoints - CIdx - array[NPoints], I-th element contains cluster index (from - 0 to K-1) for I-th point of the dataset. - CZ - array[K]. This array allows to convert cluster indexes - returned by this function to indexes used by Rep.Z. J-th - cluster returned by this function corresponds to CZ[J]-th - cluster stored in Rep.Z/PZ/PM. - It is guaranteed that CZ[I](rep.c_ptr()), r, &k, const_cast(cidx.c_ptr()), const_cast(cz.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -k-means++ clusterization. -Backward compatibility function, we recommend to use CLUSTERING subpackage -as better replacement. - - -- ALGLIB -- - Copyright 21.03.2009 by Bochkanov Sergey -*************************************************************************/ -void kmeansgenerate(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nvars, const ae_int_t k, const ae_int_t restarts, ae_int_t &info, real_2d_array &c, integer_1d_array &xyc) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::kmeansgenerate(const_cast(xy.c_ptr()), npoints, nvars, k, restarts, &info, const_cast(c.c_ptr()), const_cast(xyc.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* - -*************************************************************************/ -_decisionforest_owner::_decisionforest_owner() -{ - p_struct = (alglib_impl::decisionforest*)alglib_impl::ae_malloc(sizeof(alglib_impl::decisionforest), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_decisionforest_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_decisionforest_owner::_decisionforest_owner(const _decisionforest_owner &rhs) -{ - p_struct = (alglib_impl::decisionforest*)alglib_impl::ae_malloc(sizeof(alglib_impl::decisionforest), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_decisionforest_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_decisionforest_owner& _decisionforest_owner::operator=(const _decisionforest_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_decisionforest_clear(p_struct); - if( !alglib_impl::_decisionforest_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_decisionforest_owner::~_decisionforest_owner() -{ - alglib_impl::_decisionforest_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::decisionforest* _decisionforest_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::decisionforest* _decisionforest_owner::c_ptr() const -{ - return const_cast(p_struct); -} -decisionforest::decisionforest() : _decisionforest_owner() -{ -} - -decisionforest::decisionforest(const decisionforest &rhs):_decisionforest_owner(rhs) -{ -} - -decisionforest& decisionforest::operator=(const decisionforest &rhs) -{ - if( this==&rhs ) - return *this; - _decisionforest_owner::operator=(rhs); - return *this; -} - -decisionforest::~decisionforest() -{ -} - - -/************************************************************************* - -*************************************************************************/ -_dfreport_owner::_dfreport_owner() -{ - p_struct = (alglib_impl::dfreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::dfreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_dfreport_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_dfreport_owner::_dfreport_owner(const _dfreport_owner &rhs) -{ - p_struct = (alglib_impl::dfreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::dfreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_dfreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_dfreport_owner& _dfreport_owner::operator=(const _dfreport_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_dfreport_clear(p_struct); - if( !alglib_impl::_dfreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_dfreport_owner::~_dfreport_owner() -{ - alglib_impl::_dfreport_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::dfreport* _dfreport_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::dfreport* _dfreport_owner::c_ptr() const -{ - return const_cast(p_struct); -} -dfreport::dfreport() : _dfreport_owner() ,relclserror(p_struct->relclserror),avgce(p_struct->avgce),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror),oobrelclserror(p_struct->oobrelclserror),oobavgce(p_struct->oobavgce),oobrmserror(p_struct->oobrmserror),oobavgerror(p_struct->oobavgerror),oobavgrelerror(p_struct->oobavgrelerror) -{ -} - -dfreport::dfreport(const dfreport &rhs):_dfreport_owner(rhs) ,relclserror(p_struct->relclserror),avgce(p_struct->avgce),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror),oobrelclserror(p_struct->oobrelclserror),oobavgce(p_struct->oobavgce),oobrmserror(p_struct->oobrmserror),oobavgerror(p_struct->oobavgerror),oobavgrelerror(p_struct->oobavgrelerror) -{ -} - -dfreport& dfreport::operator=(const dfreport &rhs) -{ - if( this==&rhs ) - return *this; - _dfreport_owner::operator=(rhs); - return *this; -} - -dfreport::~dfreport() -{ -} - - -/************************************************************************* -This function serializes data structure to string. - -Important properties of s_out: -* it contains alphanumeric characters, dots, underscores, minus signs -* these symbols are grouped into words, which are separated by spaces - and Windows-style (CR+LF) newlines -* although serializer uses spaces and CR+LF as separators, you can - replace any separator character by arbitrary combination of spaces, - tabs, Windows or Unix newlines. It allows flexible reformatting of - the string in case you want to include it into text or XML file. - But you should not insert separators into the middle of the "words" - nor you should change case of letters. -* s_out can be freely moved between 32-bit and 64-bit systems, little - and big endian machines, and so on. You can serialize structure on - 32-bit machine and unserialize it on 64-bit one (or vice versa), or - serialize it on SPARC and unserialize on x86. You can also - serialize it in C++ version of ALGLIB and unserialize in C# one, - and vice versa. -*************************************************************************/ -void dfserialize(decisionforest &obj, std::string &s_out) -{ - alglib_impl::ae_state state; - alglib_impl::ae_serializer serializer; - alglib_impl::ae_int_t ssize; - - alglib_impl::ae_state_init(&state); - try - { - alglib_impl::ae_serializer_init(&serializer); - alglib_impl::ae_serializer_alloc_start(&serializer); - alglib_impl::dfalloc(&serializer, obj.c_ptr(), &state); - ssize = alglib_impl::ae_serializer_get_alloc_size(&serializer); - s_out.clear(); - s_out.reserve((size_t)(ssize+1)); - alglib_impl::ae_serializer_sstart_str(&serializer, &s_out); - alglib_impl::dfserialize(&serializer, obj.c_ptr(), &state); - alglib_impl::ae_serializer_stop(&serializer); - if( s_out.length()>(size_t)ssize ) - throw ap_error("ALGLIB: serialization integrity error"); - alglib_impl::ae_serializer_clear(&serializer); - alglib_impl::ae_state_clear(&state); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(state.error_msg); - } -} -/************************************************************************* -This function unserializes data structure from string. -*************************************************************************/ -void dfunserialize(std::string &s_in, decisionforest &obj) -{ - alglib_impl::ae_state state; - alglib_impl::ae_serializer serializer; - - alglib_impl::ae_state_init(&state); - try - { - alglib_impl::ae_serializer_init(&serializer); - alglib_impl::ae_serializer_ustart_str(&serializer, &s_in); - alglib_impl::dfunserialize(&serializer, obj.c_ptr(), &state); - alglib_impl::ae_serializer_stop(&serializer); - alglib_impl::ae_serializer_clear(&serializer); - alglib_impl::ae_state_clear(&state); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(state.error_msg); - } -} - -/************************************************************************* -This subroutine builds random decision forest. - -INPUT PARAMETERS: - XY - training set - NPoints - training set size, NPoints>=1 - NVars - number of independent variables, NVars>=1 - NClasses - task type: - * NClasses=1 - regression task with one - dependent variable - * NClasses>1 - classification task with - NClasses classes. - NTrees - number of trees in a forest, NTrees>=1. - recommended values: 50-100. - R - percent of a training set used to build - individual trees. 01). - * 1, if task has been solved - DF - model built - Rep - training report, contains error on a training set - and out-of-bag estimates of generalization error. - - -- ALGLIB -- - Copyright 19.02.2009 by Bochkanov Sergey -*************************************************************************/ -void dfbuildrandomdecisionforest(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nvars, const ae_int_t nclasses, const ae_int_t ntrees, const double r, ae_int_t &info, decisionforest &df, dfreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::dfbuildrandomdecisionforest(const_cast(xy.c_ptr()), npoints, nvars, nclasses, ntrees, r, &info, const_cast(df.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine builds random decision forest. -This function gives ability to tune number of variables used when choosing -best split. - -INPUT PARAMETERS: - XY - training set - NPoints - training set size, NPoints>=1 - NVars - number of independent variables, NVars>=1 - NClasses - task type: - * NClasses=1 - regression task with one - dependent variable - * NClasses>1 - classification task with - NClasses classes. - NTrees - number of trees in a forest, NTrees>=1. - recommended values: 50-100. - NRndVars - number of variables used when choosing best split - R - percent of a training set used to build - individual trees. 01). - * 1, if task has been solved - DF - model built - Rep - training report, contains error on a training set - and out-of-bag estimates of generalization error. - - -- ALGLIB -- - Copyright 19.02.2009 by Bochkanov Sergey -*************************************************************************/ -void dfbuildrandomdecisionforestx1(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nvars, const ae_int_t nclasses, const ae_int_t ntrees, const ae_int_t nrndvars, const double r, ae_int_t &info, decisionforest &df, dfreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::dfbuildrandomdecisionforestx1(const_cast(xy.c_ptr()), npoints, nvars, nclasses, ntrees, nrndvars, r, &info, const_cast(df.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Procesing - -INPUT PARAMETERS: - DF - decision forest model - X - input vector, array[0..NVars-1]. - -OUTPUT PARAMETERS: - Y - result. Regression estimate when solving regression task, - vector of posterior probabilities for classification task. - -See also DFProcessI. - - -- ALGLIB -- - Copyright 16.02.2009 by Bochkanov Sergey -*************************************************************************/ -void dfprocess(const decisionforest &df, const real_1d_array &x, real_1d_array &y) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::dfprocess(const_cast(df.c_ptr()), const_cast(x.c_ptr()), const_cast(y.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -'interactive' variant of DFProcess for languages like Python which support -constructs like "Y = DFProcessI(DF,X)" and interactive mode of interpreter - -This function allocates new array on each call, so it is significantly -slower than its 'non-interactive' counterpart, but it is more convenient -when you call it from command line. - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void dfprocessi(const decisionforest &df, const real_1d_array &x, real_1d_array &y) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::dfprocessi(const_cast(df.c_ptr()), const_cast(x.c_ptr()), const_cast(y.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Relative classification error on the test set - -INPUT PARAMETERS: - DF - decision forest model - XY - test set - NPoints - test set size - -RESULT: - percent of incorrectly classified cases. - Zero if model solves regression task. - - -- ALGLIB -- - Copyright 16.02.2009 by Bochkanov Sergey -*************************************************************************/ -double dfrelclserror(const decisionforest &df, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::dfrelclserror(const_cast(df.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Average cross-entropy (in bits per element) on the test set - -INPUT PARAMETERS: - DF - decision forest model - XY - test set - NPoints - test set size - -RESULT: - CrossEntropy/(NPoints*LN(2)). - Zero if model solves regression task. - - -- ALGLIB -- - Copyright 16.02.2009 by Bochkanov Sergey -*************************************************************************/ -double dfavgce(const decisionforest &df, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::dfavgce(const_cast(df.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -RMS error on the test set - -INPUT PARAMETERS: - DF - decision forest model - XY - test set - NPoints - test set size - -RESULT: - root mean square error. - Its meaning for regression task is obvious. As for - classification task, RMS error means error when estimating posterior - probabilities. - - -- ALGLIB -- - Copyright 16.02.2009 by Bochkanov Sergey -*************************************************************************/ -double dfrmserror(const decisionforest &df, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::dfrmserror(const_cast(df.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Average error on the test set - -INPUT PARAMETERS: - DF - decision forest model - XY - test set - NPoints - test set size - -RESULT: - Its meaning for regression task is obvious. As for - classification task, it means average error when estimating posterior - probabilities. - - -- ALGLIB -- - Copyright 16.02.2009 by Bochkanov Sergey -*************************************************************************/ -double dfavgerror(const decisionforest &df, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::dfavgerror(const_cast(df.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Average relative error on the test set - -INPUT PARAMETERS: - DF - decision forest model - XY - test set - NPoints - test set size - -RESULT: - Its meaning for regression task is obvious. As for - classification task, it means average relative error when estimating - posterior probability of belonging to the correct class. - - -- ALGLIB -- - Copyright 16.02.2009 by Bochkanov Sergey -*************************************************************************/ -double dfavgrelerror(const decisionforest &df, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::dfavgrelerror(const_cast(df.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* - -*************************************************************************/ -_linearmodel_owner::_linearmodel_owner() -{ - p_struct = (alglib_impl::linearmodel*)alglib_impl::ae_malloc(sizeof(alglib_impl::linearmodel), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_linearmodel_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_linearmodel_owner::_linearmodel_owner(const _linearmodel_owner &rhs) -{ - p_struct = (alglib_impl::linearmodel*)alglib_impl::ae_malloc(sizeof(alglib_impl::linearmodel), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_linearmodel_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_linearmodel_owner& _linearmodel_owner::operator=(const _linearmodel_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_linearmodel_clear(p_struct); - if( !alglib_impl::_linearmodel_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_linearmodel_owner::~_linearmodel_owner() -{ - alglib_impl::_linearmodel_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::linearmodel* _linearmodel_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::linearmodel* _linearmodel_owner::c_ptr() const -{ - return const_cast(p_struct); -} -linearmodel::linearmodel() : _linearmodel_owner() -{ -} - -linearmodel::linearmodel(const linearmodel &rhs):_linearmodel_owner(rhs) -{ -} - -linearmodel& linearmodel::operator=(const linearmodel &rhs) -{ - if( this==&rhs ) - return *this; - _linearmodel_owner::operator=(rhs); - return *this; -} - -linearmodel::~linearmodel() -{ -} - - -/************************************************************************* -LRReport structure contains additional information about linear model: -* C - covariation matrix, array[0..NVars,0..NVars]. - C[i,j] = Cov(A[i],A[j]) -* RMSError - root mean square error on a training set -* AvgError - average error on a training set -* AvgRelError - average relative error on a training set (excluding - observations with zero function value). -* CVRMSError - leave-one-out cross-validation estimate of - generalization error. Calculated using fast algorithm - with O(NVars*NPoints) complexity. -* CVAvgError - cross-validation estimate of average error -* CVAvgRelError - cross-validation estimate of average relative error - -All other fields of the structure are intended for internal use and should -not be used outside ALGLIB. -*************************************************************************/ -_lrreport_owner::_lrreport_owner() -{ - p_struct = (alglib_impl::lrreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::lrreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_lrreport_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_lrreport_owner::_lrreport_owner(const _lrreport_owner &rhs) -{ - p_struct = (alglib_impl::lrreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::lrreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_lrreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_lrreport_owner& _lrreport_owner::operator=(const _lrreport_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_lrreport_clear(p_struct); - if( !alglib_impl::_lrreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_lrreport_owner::~_lrreport_owner() -{ - alglib_impl::_lrreport_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::lrreport* _lrreport_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::lrreport* _lrreport_owner::c_ptr() const -{ - return const_cast(p_struct); -} -lrreport::lrreport() : _lrreport_owner() ,c(&p_struct->c),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror),cvrmserror(p_struct->cvrmserror),cvavgerror(p_struct->cvavgerror),cvavgrelerror(p_struct->cvavgrelerror),ncvdefects(p_struct->ncvdefects),cvdefects(&p_struct->cvdefects) -{ -} - -lrreport::lrreport(const lrreport &rhs):_lrreport_owner(rhs) ,c(&p_struct->c),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror),cvrmserror(p_struct->cvrmserror),cvavgerror(p_struct->cvavgerror),cvavgrelerror(p_struct->cvavgrelerror),ncvdefects(p_struct->ncvdefects),cvdefects(&p_struct->cvdefects) -{ -} - -lrreport& lrreport::operator=(const lrreport &rhs) -{ - if( this==&rhs ) - return *this; - _lrreport_owner::operator=(rhs); - return *this; -} - -lrreport::~lrreport() -{ -} - -/************************************************************************* -Linear regression - -Subroutine builds model: - - Y = A(0)*X[0] + ... + A(N-1)*X[N-1] + A(N) - -and model found in ALGLIB format, covariation matrix, training set errors -(rms, average, average relative) and leave-one-out cross-validation -estimate of the generalization error. CV estimate calculated using fast -algorithm with O(NPoints*NVars) complexity. - -When covariation matrix is calculated standard deviations of function -values are assumed to be equal to RMS error on the training set. - -INPUT PARAMETERS: - XY - training set, array [0..NPoints-1,0..NVars]: - * NVars columns - independent variables - * last column - dependent variable - NPoints - training set size, NPoints>NVars+1 - NVars - number of independent variables - -OUTPUT PARAMETERS: - Info - return code: - * -255, in case of unknown internal error - * -4, if internal SVD subroutine haven't converged - * -1, if incorrect parameters was passed (NPoints(xy.c_ptr()), npoints, nvars, &info, const_cast(lm.c_ptr()), const_cast(ar.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Linear regression - -Variant of LRBuild which uses vector of standatd deviations (errors in -function values). - -INPUT PARAMETERS: - XY - training set, array [0..NPoints-1,0..NVars]: - * NVars columns - independent variables - * last column - dependent variable - S - standard deviations (errors in function values) - array[0..NPoints-1], S[i]>0. - NPoints - training set size, NPoints>NVars+1 - NVars - number of independent variables - -OUTPUT PARAMETERS: - Info - return code: - * -255, in case of unknown internal error - * -4, if internal SVD subroutine haven't converged - * -1, if incorrect parameters was passed (NPoints(xy.c_ptr()), const_cast(s.c_ptr()), npoints, nvars, &info, const_cast(lm.c_ptr()), const_cast(ar.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Like LRBuildS, but builds model - - Y = A(0)*X[0] + ... + A(N-1)*X[N-1] - -i.e. with zero constant term. - - -- ALGLIB -- - Copyright 30.10.2008 by Bochkanov Sergey -*************************************************************************/ -void lrbuildzs(const real_2d_array &xy, const real_1d_array &s, const ae_int_t npoints, const ae_int_t nvars, ae_int_t &info, linearmodel &lm, lrreport &ar) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lrbuildzs(const_cast(xy.c_ptr()), const_cast(s.c_ptr()), npoints, nvars, &info, const_cast(lm.c_ptr()), const_cast(ar.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Like LRBuild but builds model - - Y = A(0)*X[0] + ... + A(N-1)*X[N-1] - -i.e. with zero constant term. - - -- ALGLIB -- - Copyright 30.10.2008 by Bochkanov Sergey -*************************************************************************/ -void lrbuildz(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nvars, ae_int_t &info, linearmodel &lm, lrreport &ar) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lrbuildz(const_cast(xy.c_ptr()), npoints, nvars, &info, const_cast(lm.c_ptr()), const_cast(ar.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Unpacks coefficients of linear model. - -INPUT PARAMETERS: - LM - linear model in ALGLIB format - -OUTPUT PARAMETERS: - V - coefficients, array[0..NVars] - constant term (intercept) is stored in the V[NVars]. - NVars - number of independent variables (one less than number - of coefficients) - - -- ALGLIB -- - Copyright 30.08.2008 by Bochkanov Sergey -*************************************************************************/ -void lrunpack(const linearmodel &lm, real_1d_array &v, ae_int_t &nvars) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lrunpack(const_cast(lm.c_ptr()), const_cast(v.c_ptr()), &nvars, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -"Packs" coefficients and creates linear model in ALGLIB format (LRUnpack -reversed). - -INPUT PARAMETERS: - V - coefficients, array[0..NVars] - NVars - number of independent variables - -OUTPUT PAREMETERS: - LM - linear model. - - -- ALGLIB -- - Copyright 30.08.2008 by Bochkanov Sergey -*************************************************************************/ -void lrpack(const real_1d_array &v, const ae_int_t nvars, linearmodel &lm) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lrpack(const_cast(v.c_ptr()), nvars, const_cast(lm.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Procesing - -INPUT PARAMETERS: - LM - linear model - X - input vector, array[0..NVars-1]. - -Result: - value of linear model regression estimate - - -- ALGLIB -- - Copyright 03.09.2008 by Bochkanov Sergey -*************************************************************************/ -double lrprocess(const linearmodel &lm, const real_1d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::lrprocess(const_cast(lm.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -RMS error on the test set - -INPUT PARAMETERS: - LM - linear model - XY - test set - NPoints - test set size - -RESULT: - root mean square error. - - -- ALGLIB -- - Copyright 30.08.2008 by Bochkanov Sergey -*************************************************************************/ -double lrrmserror(const linearmodel &lm, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::lrrmserror(const_cast(lm.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Average error on the test set - -INPUT PARAMETERS: - LM - linear model - XY - test set - NPoints - test set size - -RESULT: - average error. - - -- ALGLIB -- - Copyright 30.08.2008 by Bochkanov Sergey -*************************************************************************/ -double lravgerror(const linearmodel &lm, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::lravgerror(const_cast(lm.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -RMS error on the test set - -INPUT PARAMETERS: - LM - linear model - XY - test set - NPoints - test set size - -RESULT: - average relative error. - - -- ALGLIB -- - Copyright 30.08.2008 by Bochkanov Sergey -*************************************************************************/ -double lravgrelerror(const linearmodel &lm, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::lravgrelerror(const_cast(lm.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Filters: simple moving averages (unsymmetric). - -This filter replaces array by results of SMA(K) filter. SMA(K) is defined -as filter which averages at most K previous points (previous - not points -AROUND central point) - or less, in case of the first K-1 points. - -INPUT PARAMETERS: - X - array[N], array to process. It can be larger than N, - in this case only first N points are processed. - N - points count, N>=0 - K - K>=1 (K can be larger than N , such cases will be - correctly handled). Window width. K=1 corresponds to - identity transformation (nothing changes). - -OUTPUT PARAMETERS: - X - array, whose first N elements were processed with SMA(K) - -NOTE 1: this function uses efficient in-place algorithm which does not - allocate temporary arrays. - -NOTE 2: this algorithm makes only one pass through array and uses running - sum to speed-up calculation of the averages. Additional measures - are taken to ensure that running sum on a long sequence of zero - elements will be correctly reset to zero even in the presence of - round-off error. - -NOTE 3: this is unsymmetric version of the algorithm, which does NOT - averages points after the current one. Only X[i], X[i-1], ... are - used when calculating new value of X[i]. We should also note that - this algorithm uses BOTH previous points and current one, i.e. - new value of X[i] depends on BOTH previous point and X[i] itself. - - -- ALGLIB -- - Copyright 25.10.2011 by Bochkanov Sergey -*************************************************************************/ -void filtersma(real_1d_array &x, const ae_int_t n, const ae_int_t k) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::filtersma(const_cast(x.c_ptr()), n, k, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Filters: simple moving averages (unsymmetric). - -This filter replaces array by results of SMA(K) filter. SMA(K) is defined -as filter which averages at most K previous points (previous - not points -AROUND central point) - or less, in case of the first K-1 points. - -INPUT PARAMETERS: - X - array[N], array to process. It can be larger than N, - in this case only first N points are processed. - N - points count, N>=0 - K - K>=1 (K can be larger than N , such cases will be - correctly handled). Window width. K=1 corresponds to - identity transformation (nothing changes). - -OUTPUT PARAMETERS: - X - array, whose first N elements were processed with SMA(K) - -NOTE 1: this function uses efficient in-place algorithm which does not - allocate temporary arrays. - -NOTE 2: this algorithm makes only one pass through array and uses running - sum to speed-up calculation of the averages. Additional measures - are taken to ensure that running sum on a long sequence of zero - elements will be correctly reset to zero even in the presence of - round-off error. - -NOTE 3: this is unsymmetric version of the algorithm, which does NOT - averages points after the current one. Only X[i], X[i-1], ... are - used when calculating new value of X[i]. We should also note that - this algorithm uses BOTH previous points and current one, i.e. - new value of X[i] depends on BOTH previous point and X[i] itself. - - -- ALGLIB -- - Copyright 25.10.2011 by Bochkanov Sergey -*************************************************************************/ -void filtersma(real_1d_array &x, const ae_int_t k) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::filtersma(const_cast(x.c_ptr()), n, k, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Filters: exponential moving averages. - -This filter replaces array by results of EMA(alpha) filter. EMA(alpha) is -defined as filter which replaces X[] by S[]: - S[0] = X[0] - S[t] = alpha*X[t] + (1-alpha)*S[t-1] - -INPUT PARAMETERS: - X - array[N], array to process. It can be larger than N, - in this case only first N points are processed. - N - points count, N>=0 - alpha - 0(x.c_ptr()), n, alpha, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Filters: exponential moving averages. - -This filter replaces array by results of EMA(alpha) filter. EMA(alpha) is -defined as filter which replaces X[] by S[]: - S[0] = X[0] - S[t] = alpha*X[t] + (1-alpha)*S[t-1] - -INPUT PARAMETERS: - X - array[N], array to process. It can be larger than N, - in this case only first N points are processed. - N - points count, N>=0 - alpha - 0(x.c_ptr()), n, alpha, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Filters: linear regression moving averages. - -This filter replaces array by results of LRMA(K) filter. - -LRMA(K) is defined as filter which, for each data point, builds linear -regression model using K prevous points (point itself is included in -these K points) and calculates value of this linear model at the point in -question. - -INPUT PARAMETERS: - X - array[N], array to process. It can be larger than N, - in this case only first N points are processed. - N - points count, N>=0 - K - K>=1 (K can be larger than N , such cases will be - correctly handled). Window width. K=1 corresponds to - identity transformation (nothing changes). - -OUTPUT PARAMETERS: - X - array, whose first N elements were processed with SMA(K) - -NOTE 1: this function uses efficient in-place algorithm which does not - allocate temporary arrays. - -NOTE 2: this algorithm makes only one pass through array and uses running - sum to speed-up calculation of the averages. Additional measures - are taken to ensure that running sum on a long sequence of zero - elements will be correctly reset to zero even in the presence of - round-off error. - -NOTE 3: this is unsymmetric version of the algorithm, which does NOT - averages points after the current one. Only X[i], X[i-1], ... are - used when calculating new value of X[i]. We should also note that - this algorithm uses BOTH previous points and current one, i.e. - new value of X[i] depends on BOTH previous point and X[i] itself. - - -- ALGLIB -- - Copyright 25.10.2011 by Bochkanov Sergey -*************************************************************************/ -void filterlrma(real_1d_array &x, const ae_int_t n, const ae_int_t k) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::filterlrma(const_cast(x.c_ptr()), n, k, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Filters: linear regression moving averages. - -This filter replaces array by results of LRMA(K) filter. - -LRMA(K) is defined as filter which, for each data point, builds linear -regression model using K prevous points (point itself is included in -these K points) and calculates value of this linear model at the point in -question. - -INPUT PARAMETERS: - X - array[N], array to process. It can be larger than N, - in this case only first N points are processed. - N - points count, N>=0 - K - K>=1 (K can be larger than N , such cases will be - correctly handled). Window width. K=1 corresponds to - identity transformation (nothing changes). - -OUTPUT PARAMETERS: - X - array, whose first N elements were processed with SMA(K) - -NOTE 1: this function uses efficient in-place algorithm which does not - allocate temporary arrays. - -NOTE 2: this algorithm makes only one pass through array and uses running - sum to speed-up calculation of the averages. Additional measures - are taken to ensure that running sum on a long sequence of zero - elements will be correctly reset to zero even in the presence of - round-off error. - -NOTE 3: this is unsymmetric version of the algorithm, which does NOT - averages points after the current one. Only X[i], X[i-1], ... are - used when calculating new value of X[i]. We should also note that - this algorithm uses BOTH previous points and current one, i.e. - new value of X[i] depends on BOTH previous point and X[i] itself. - - -- ALGLIB -- - Copyright 25.10.2011 by Bochkanov Sergey -*************************************************************************/ -void filterlrma(real_1d_array &x, const ae_int_t k) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::filterlrma(const_cast(x.c_ptr()), n, k, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Multiclass Fisher LDA - -Subroutine finds coefficients of linear combination which optimally separates -training set on classes. - -INPUT PARAMETERS: - XY - training set, array[0..NPoints-1,0..NVars]. - First NVars columns store values of independent - variables, next column stores number of class (from 0 - to NClasses-1) which dataset element belongs to. Fractional - values are rounded to nearest integer. - NPoints - training set size, NPoints>=0 - NVars - number of independent variables, NVars>=1 - NClasses - number of classes, NClasses>=2 - - -OUTPUT PARAMETERS: - Info - return code: - * -4, if internal EVD subroutine hasn't converged - * -2, if there is a point with class number - outside of [0..NClasses-1]. - * -1, if incorrect parameters was passed (NPoints<0, - NVars<1, NClasses<2) - * 1, if task has been solved - * 2, if there was a multicollinearity in training set, - but task has been solved. - W - linear combination coefficients, array[0..NVars-1] - - -- ALGLIB -- - Copyright 31.05.2008 by Bochkanov Sergey -*************************************************************************/ -void fisherlda(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nvars, const ae_int_t nclasses, ae_int_t &info, real_1d_array &w) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::fisherlda(const_cast(xy.c_ptr()), npoints, nvars, nclasses, &info, const_cast(w.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -N-dimensional multiclass Fisher LDA - -Subroutine finds coefficients of linear combinations which optimally separates -training set on classes. It returns N-dimensional basis whose vector are sorted -by quality of training set separation (in descending order). - -INPUT PARAMETERS: - XY - training set, array[0..NPoints-1,0..NVars]. - First NVars columns store values of independent - variables, next column stores number of class (from 0 - to NClasses-1) which dataset element belongs to. Fractional - values are rounded to nearest integer. - NPoints - training set size, NPoints>=0 - NVars - number of independent variables, NVars>=1 - NClasses - number of classes, NClasses>=2 - - -OUTPUT PARAMETERS: - Info - return code: - * -4, if internal EVD subroutine hasn't converged - * -2, if there is a point with class number - outside of [0..NClasses-1]. - * -1, if incorrect parameters was passed (NPoints<0, - NVars<1, NClasses<2) - * 1, if task has been solved - * 2, if there was a multicollinearity in training set, - but task has been solved. - W - basis, array[0..NVars-1,0..NVars-1] - columns of matrix stores basis vectors, sorted by - quality of training set separation (in descending order) - - -- ALGLIB -- - Copyright 31.05.2008 by Bochkanov Sergey -*************************************************************************/ -void fisherldan(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nvars, const ae_int_t nclasses, ae_int_t &info, real_2d_array &w) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::fisherldan(const_cast(xy.c_ptr()), npoints, nvars, nclasses, &info, const_cast(w.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Model's errors: - * RelCLSError - fraction of misclassified cases. - * AvgCE - acerage cross-entropy - * RMSError - root-mean-square error - * AvgError - average error - * AvgRelError - average relative error - -NOTE 1: RelCLSError/AvgCE are zero on regression problems. - -NOTE 2: on classification problems RMSError/AvgError/AvgRelError contain - errors in prediction of posterior probabilities -*************************************************************************/ -_modelerrors_owner::_modelerrors_owner() -{ - p_struct = (alglib_impl::modelerrors*)alglib_impl::ae_malloc(sizeof(alglib_impl::modelerrors), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_modelerrors_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_modelerrors_owner::_modelerrors_owner(const _modelerrors_owner &rhs) -{ - p_struct = (alglib_impl::modelerrors*)alglib_impl::ae_malloc(sizeof(alglib_impl::modelerrors), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_modelerrors_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_modelerrors_owner& _modelerrors_owner::operator=(const _modelerrors_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_modelerrors_clear(p_struct); - if( !alglib_impl::_modelerrors_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_modelerrors_owner::~_modelerrors_owner() -{ - alglib_impl::_modelerrors_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::modelerrors* _modelerrors_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::modelerrors* _modelerrors_owner::c_ptr() const -{ - return const_cast(p_struct); -} -modelerrors::modelerrors() : _modelerrors_owner() ,relclserror(p_struct->relclserror),avgce(p_struct->avgce),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror) -{ -} - -modelerrors::modelerrors(const modelerrors &rhs):_modelerrors_owner(rhs) ,relclserror(p_struct->relclserror),avgce(p_struct->avgce),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror) -{ -} - -modelerrors& modelerrors::operator=(const modelerrors &rhs) -{ - if( this==&rhs ) - return *this; - _modelerrors_owner::operator=(rhs); - return *this; -} - -modelerrors::~modelerrors() -{ -} - - -/************************************************************************* - -*************************************************************************/ -_multilayerperceptron_owner::_multilayerperceptron_owner() -{ - p_struct = (alglib_impl::multilayerperceptron*)alglib_impl::ae_malloc(sizeof(alglib_impl::multilayerperceptron), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_multilayerperceptron_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_multilayerperceptron_owner::_multilayerperceptron_owner(const _multilayerperceptron_owner &rhs) -{ - p_struct = (alglib_impl::multilayerperceptron*)alglib_impl::ae_malloc(sizeof(alglib_impl::multilayerperceptron), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_multilayerperceptron_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_multilayerperceptron_owner& _multilayerperceptron_owner::operator=(const _multilayerperceptron_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_multilayerperceptron_clear(p_struct); - if( !alglib_impl::_multilayerperceptron_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_multilayerperceptron_owner::~_multilayerperceptron_owner() -{ - alglib_impl::_multilayerperceptron_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::multilayerperceptron* _multilayerperceptron_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::multilayerperceptron* _multilayerperceptron_owner::c_ptr() const -{ - return const_cast(p_struct); -} -multilayerperceptron::multilayerperceptron() : _multilayerperceptron_owner() -{ -} - -multilayerperceptron::multilayerperceptron(const multilayerperceptron &rhs):_multilayerperceptron_owner(rhs) -{ -} - -multilayerperceptron& multilayerperceptron::operator=(const multilayerperceptron &rhs) -{ - if( this==&rhs ) - return *this; - _multilayerperceptron_owner::operator=(rhs); - return *this; -} - -multilayerperceptron::~multilayerperceptron() -{ -} - - -/************************************************************************* -This function serializes data structure to string. - -Important properties of s_out: -* it contains alphanumeric characters, dots, underscores, minus signs -* these symbols are grouped into words, which are separated by spaces - and Windows-style (CR+LF) newlines -* although serializer uses spaces and CR+LF as separators, you can - replace any separator character by arbitrary combination of spaces, - tabs, Windows or Unix newlines. It allows flexible reformatting of - the string in case you want to include it into text or XML file. - But you should not insert separators into the middle of the "words" - nor you should change case of letters. -* s_out can be freely moved between 32-bit and 64-bit systems, little - and big endian machines, and so on. You can serialize structure on - 32-bit machine and unserialize it on 64-bit one (or vice versa), or - serialize it on SPARC and unserialize on x86. You can also - serialize it in C++ version of ALGLIB and unserialize in C# one, - and vice versa. -*************************************************************************/ -void mlpserialize(multilayerperceptron &obj, std::string &s_out) -{ - alglib_impl::ae_state state; - alglib_impl::ae_serializer serializer; - alglib_impl::ae_int_t ssize; - - alglib_impl::ae_state_init(&state); - try - { - alglib_impl::ae_serializer_init(&serializer); - alglib_impl::ae_serializer_alloc_start(&serializer); - alglib_impl::mlpalloc(&serializer, obj.c_ptr(), &state); - ssize = alglib_impl::ae_serializer_get_alloc_size(&serializer); - s_out.clear(); - s_out.reserve((size_t)(ssize+1)); - alglib_impl::ae_serializer_sstart_str(&serializer, &s_out); - alglib_impl::mlpserialize(&serializer, obj.c_ptr(), &state); - alglib_impl::ae_serializer_stop(&serializer); - if( s_out.length()>(size_t)ssize ) - throw ap_error("ALGLIB: serialization integrity error"); - alglib_impl::ae_serializer_clear(&serializer); - alglib_impl::ae_state_clear(&state); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(state.error_msg); - } -} -/************************************************************************* -This function unserializes data structure from string. -*************************************************************************/ -void mlpunserialize(std::string &s_in, multilayerperceptron &obj) -{ - alglib_impl::ae_state state; - alglib_impl::ae_serializer serializer; - - alglib_impl::ae_state_init(&state); - try - { - alglib_impl::ae_serializer_init(&serializer); - alglib_impl::ae_serializer_ustart_str(&serializer, &s_in); - alglib_impl::mlpunserialize(&serializer, obj.c_ptr(), &state); - alglib_impl::ae_serializer_stop(&serializer); - alglib_impl::ae_serializer_clear(&serializer); - alglib_impl::ae_state_clear(&state); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(state.error_msg); - } -} - -/************************************************************************* -Creates neural network with NIn inputs, NOut outputs, without hidden -layers, with linear output layer. Network weights are filled with small -random values. - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpcreate0(const ae_int_t nin, const ae_int_t nout, multilayerperceptron &network) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpcreate0(nin, nout, const_cast(network.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Same as MLPCreate0, but with one hidden layer (NHid neurons) with -non-linear activation function. Output layer is linear. - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpcreate1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, multilayerperceptron &network) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpcreate1(nin, nhid, nout, const_cast(network.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Same as MLPCreate0, but with two hidden layers (NHid1 and NHid2 neurons) -with non-linear activation function. Output layer is linear. - $ALL - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpcreate2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, multilayerperceptron &network) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpcreate2(nin, nhid1, nhid2, nout, const_cast(network.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Creates neural network with NIn inputs, NOut outputs, without hidden -layers with non-linear output layer. Network weights are filled with small -random values. - -Activation function of the output layer takes values: - - (B, +INF), if D>=0 - -or - - (-INF, B), if D<0. - - - -- ALGLIB -- - Copyright 30.03.2008 by Bochkanov Sergey -*************************************************************************/ -void mlpcreateb0(const ae_int_t nin, const ae_int_t nout, const double b, const double d, multilayerperceptron &network) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpcreateb0(nin, nout, b, d, const_cast(network.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Same as MLPCreateB0 but with non-linear hidden layer. - - -- ALGLIB -- - Copyright 30.03.2008 by Bochkanov Sergey -*************************************************************************/ -void mlpcreateb1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, const double b, const double d, multilayerperceptron &network) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpcreateb1(nin, nhid, nout, b, d, const_cast(network.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Same as MLPCreateB0 but with two non-linear hidden layers. - - -- ALGLIB -- - Copyright 30.03.2008 by Bochkanov Sergey -*************************************************************************/ -void mlpcreateb2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, const double b, const double d, multilayerperceptron &network) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpcreateb2(nin, nhid1, nhid2, nout, b, d, const_cast(network.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Creates neural network with NIn inputs, NOut outputs, without hidden -layers with non-linear output layer. Network weights are filled with small -random values. Activation function of the output layer takes values [A,B]. - - -- ALGLIB -- - Copyright 30.03.2008 by Bochkanov Sergey -*************************************************************************/ -void mlpcreater0(const ae_int_t nin, const ae_int_t nout, const double a, const double b, multilayerperceptron &network) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpcreater0(nin, nout, a, b, const_cast(network.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Same as MLPCreateR0, but with non-linear hidden layer. - - -- ALGLIB -- - Copyright 30.03.2008 by Bochkanov Sergey -*************************************************************************/ -void mlpcreater1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, const double a, const double b, multilayerperceptron &network) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpcreater1(nin, nhid, nout, a, b, const_cast(network.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Same as MLPCreateR0, but with two non-linear hidden layers. - - -- ALGLIB -- - Copyright 30.03.2008 by Bochkanov Sergey -*************************************************************************/ -void mlpcreater2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, const double a, const double b, multilayerperceptron &network) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpcreater2(nin, nhid1, nhid2, nout, a, b, const_cast(network.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Creates classifier network with NIn inputs and NOut possible classes. -Network contains no hidden layers and linear output layer with SOFTMAX- -normalization (so outputs sums up to 1.0 and converge to posterior -probabilities). - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpcreatec0(const ae_int_t nin, const ae_int_t nout, multilayerperceptron &network) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpcreatec0(nin, nout, const_cast(network.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Same as MLPCreateC0, but with one non-linear hidden layer. - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpcreatec1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, multilayerperceptron &network) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpcreatec1(nin, nhid, nout, const_cast(network.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Same as MLPCreateC0, but with two non-linear hidden layers. - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpcreatec2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, multilayerperceptron &network) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpcreatec2(nin, nhid1, nhid2, nout, const_cast(network.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Randomization of neural network weights - - -- ALGLIB -- - Copyright 06.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlprandomize(const multilayerperceptron &network) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlprandomize(const_cast(network.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Randomization of neural network weights and standartisator - - -- ALGLIB -- - Copyright 10.03.2008 by Bochkanov Sergey -*************************************************************************/ -void mlprandomizefull(const multilayerperceptron &network) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlprandomizefull(const_cast(network.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Returns information about initialized network: number of inputs, outputs, -weights. - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpproperties(const multilayerperceptron &network, ae_int_t &nin, ae_int_t &nout, ae_int_t &wcount) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpproperties(const_cast(network.c_ptr()), &nin, &nout, &wcount, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Returns number of inputs. - - -- ALGLIB -- - Copyright 19.10.2011 by Bochkanov Sergey -*************************************************************************/ -ae_int_t mlpgetinputscount(const multilayerperceptron &network) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::ae_int_t result = alglib_impl::mlpgetinputscount(const_cast(network.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Returns number of outputs. - - -- ALGLIB -- - Copyright 19.10.2011 by Bochkanov Sergey -*************************************************************************/ -ae_int_t mlpgetoutputscount(const multilayerperceptron &network) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::ae_int_t result = alglib_impl::mlpgetoutputscount(const_cast(network.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Returns number of weights. - - -- ALGLIB -- - Copyright 19.10.2011 by Bochkanov Sergey -*************************************************************************/ -ae_int_t mlpgetweightscount(const multilayerperceptron &network) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::ae_int_t result = alglib_impl::mlpgetweightscount(const_cast(network.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Tells whether network is SOFTMAX-normalized (i.e. classifier) or not. - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -bool mlpissoftmax(const multilayerperceptron &network) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::mlpissoftmax(const_cast(network.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function returns total number of layers (including input, hidden and -output layers). - - -- ALGLIB -- - Copyright 25.03.2011 by Bochkanov Sergey -*************************************************************************/ -ae_int_t mlpgetlayerscount(const multilayerperceptron &network) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::ae_int_t result = alglib_impl::mlpgetlayerscount(const_cast(network.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function returns size of K-th layer. - -K=0 corresponds to input layer, K=CNT-1 corresponds to output layer. - -Size of the output layer is always equal to the number of outputs, although -when we have softmax-normalized network, last neuron doesn't have any -connections - it is just zero. - - -- ALGLIB -- - Copyright 25.03.2011 by Bochkanov Sergey -*************************************************************************/ -ae_int_t mlpgetlayersize(const multilayerperceptron &network, const ae_int_t k) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::ae_int_t result = alglib_impl::mlpgetlayersize(const_cast(network.c_ptr()), k, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function returns offset/scaling coefficients for I-th input of the -network. - -INPUT PARAMETERS: - Network - network - I - input index - -OUTPUT PARAMETERS: - Mean - mean term - Sigma - sigma term, guaranteed to be nonzero. - -I-th input is passed through linear transformation - IN[i] = (IN[i]-Mean)/Sigma -before feeding to the network - - -- ALGLIB -- - Copyright 25.03.2011 by Bochkanov Sergey -*************************************************************************/ -void mlpgetinputscaling(const multilayerperceptron &network, const ae_int_t i, double &mean, double &sigma) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpgetinputscaling(const_cast(network.c_ptr()), i, &mean, &sigma, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function returns offset/scaling coefficients for I-th output of the -network. - -INPUT PARAMETERS: - Network - network - I - input index - -OUTPUT PARAMETERS: - Mean - mean term - Sigma - sigma term, guaranteed to be nonzero. - -I-th output is passed through linear transformation - OUT[i] = OUT[i]*Sigma+Mean -before returning it to user. In case we have SOFTMAX-normalized network, -we return (Mean,Sigma)=(0.0,1.0). - - -- ALGLIB -- - Copyright 25.03.2011 by Bochkanov Sergey -*************************************************************************/ -void mlpgetoutputscaling(const multilayerperceptron &network, const ae_int_t i, double &mean, double &sigma) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpgetoutputscaling(const_cast(network.c_ptr()), i, &mean, &sigma, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function returns information about Ith neuron of Kth layer - -INPUT PARAMETERS: - Network - network - K - layer index - I - neuron index (within layer) - -OUTPUT PARAMETERS: - FKind - activation function type (used by MLPActivationFunction()) - this value is zero for input or linear neurons - Threshold - also called offset, bias - zero for input neurons - -NOTE: this function throws exception if layer or neuron with given index -do not exists. - - -- ALGLIB -- - Copyright 25.03.2011 by Bochkanov Sergey -*************************************************************************/ -void mlpgetneuroninfo(const multilayerperceptron &network, const ae_int_t k, const ae_int_t i, ae_int_t &fkind, double &threshold) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpgetneuroninfo(const_cast(network.c_ptr()), k, i, &fkind, &threshold, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function returns information about connection from I0-th neuron of -K0-th layer to I1-th neuron of K1-th layer. - -INPUT PARAMETERS: - Network - network - K0 - layer index - I0 - neuron index (within layer) - K1 - layer index - I1 - neuron index (within layer) - -RESULT: - connection weight (zero for non-existent connections) - -This function: -1. throws exception if layer or neuron with given index do not exists. -2. returns zero if neurons exist, but there is no connection between them - - -- ALGLIB -- - Copyright 25.03.2011 by Bochkanov Sergey -*************************************************************************/ -double mlpgetweight(const multilayerperceptron &network, const ae_int_t k0, const ae_int_t i0, const ae_int_t k1, const ae_int_t i1) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::mlpgetweight(const_cast(network.c_ptr()), k0, i0, k1, i1, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets offset/scaling coefficients for I-th input of the -network. - -INPUT PARAMETERS: - Network - network - I - input index - Mean - mean term - Sigma - sigma term (if zero, will be replaced by 1.0) - -NTE: I-th input is passed through linear transformation - IN[i] = (IN[i]-Mean)/Sigma -before feeding to the network. This function sets Mean and Sigma. - - -- ALGLIB -- - Copyright 25.03.2011 by Bochkanov Sergey -*************************************************************************/ -void mlpsetinputscaling(const multilayerperceptron &network, const ae_int_t i, const double mean, const double sigma) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpsetinputscaling(const_cast(network.c_ptr()), i, mean, sigma, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets offset/scaling coefficients for I-th output of the -network. - -INPUT PARAMETERS: - Network - network - I - input index - Mean - mean term - Sigma - sigma term (if zero, will be replaced by 1.0) - -OUTPUT PARAMETERS: - -NOTE: I-th output is passed through linear transformation - OUT[i] = OUT[i]*Sigma+Mean -before returning it to user. This function sets Sigma/Mean. In case we -have SOFTMAX-normalized network, you can not set (Sigma,Mean) to anything -other than(0.0,1.0) - this function will throw exception. - - -- ALGLIB -- - Copyright 25.03.2011 by Bochkanov Sergey -*************************************************************************/ -void mlpsetoutputscaling(const multilayerperceptron &network, const ae_int_t i, const double mean, const double sigma) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpsetoutputscaling(const_cast(network.c_ptr()), i, mean, sigma, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function modifies information about Ith neuron of Kth layer - -INPUT PARAMETERS: - Network - network - K - layer index - I - neuron index (within layer) - FKind - activation function type (used by MLPActivationFunction()) - this value must be zero for input neurons - (you can not set activation function for input neurons) - Threshold - also called offset, bias - this value must be zero for input neurons - (you can not set threshold for input neurons) - -NOTES: -1. this function throws exception if layer or neuron with given index do - not exists. -2. this function also throws exception when you try to set non-linear - activation function for input neurons (any kind of network) or for output - neurons of classifier network. -3. this function throws exception when you try to set non-zero threshold for - input neurons (any kind of network). - - -- ALGLIB -- - Copyright 25.03.2011 by Bochkanov Sergey -*************************************************************************/ -void mlpsetneuroninfo(const multilayerperceptron &network, const ae_int_t k, const ae_int_t i, const ae_int_t fkind, const double threshold) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpsetneuroninfo(const_cast(network.c_ptr()), k, i, fkind, threshold, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function modifies information about connection from I0-th neuron of -K0-th layer to I1-th neuron of K1-th layer. - -INPUT PARAMETERS: - Network - network - K0 - layer index - I0 - neuron index (within layer) - K1 - layer index - I1 - neuron index (within layer) - W - connection weight (must be zero for non-existent - connections) - -This function: -1. throws exception if layer or neuron with given index do not exists. -2. throws exception if you try to set non-zero weight for non-existent - connection - - -- ALGLIB -- - Copyright 25.03.2011 by Bochkanov Sergey -*************************************************************************/ -void mlpsetweight(const multilayerperceptron &network, const ae_int_t k0, const ae_int_t i0, const ae_int_t k1, const ae_int_t i1, const double w) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpsetweight(const_cast(network.c_ptr()), k0, i0, k1, i1, w, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Neural network activation function - -INPUT PARAMETERS: - NET - neuron input - K - function index (zero for linear function) - -OUTPUT PARAMETERS: - F - function - DF - its derivative - D2F - its second derivative - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpactivationfunction(const double net, const ae_int_t k, double &f, double &df, double &d2f) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpactivationfunction(net, k, &f, &df, &d2f, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Procesing - -INPUT PARAMETERS: - Network - neural network - X - input vector, array[0..NIn-1]. - -OUTPUT PARAMETERS: - Y - result. Regression estimate when solving regression task, - vector of posterior probabilities for classification task. - -See also MLPProcessI - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpprocess(const multilayerperceptron &network, const real_1d_array &x, real_1d_array &y) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpprocess(const_cast(network.c_ptr()), const_cast(x.c_ptr()), const_cast(y.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -'interactive' variant of MLPProcess for languages like Python which -support constructs like "Y = MLPProcess(NN,X)" and interactive mode of the -interpreter - -This function allocates new array on each call, so it is significantly -slower than its 'non-interactive' counterpart, but it is more convenient -when you call it from command line. - - -- ALGLIB -- - Copyright 21.09.2010 by Bochkanov Sergey -*************************************************************************/ -void mlpprocessi(const multilayerperceptron &network, const real_1d_array &x, real_1d_array &y) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpprocessi(const_cast(network.c_ptr()), const_cast(x.c_ptr()), const_cast(y.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Error of the neural network on dataset. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x, depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format; - NPoints - points count. - -RESULT: - sum-of-squares error, SUM(sqr(y[i]-desired_y[i])/2) - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -double mlperror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::mlperror(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -double smp_mlperror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::_pexec_mlperror(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Error of the neural network on dataset given by sparse matrix. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x, depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network - XY - training set, see below for information on the - training set format. This function checks correctness - of the dataset (no NANs/INFs, class numbers are - correct) and throws exception when incorrect dataset - is passed. Sparse matrix must use CRS format for - storage. - NPoints - points count, >=0 - -RESULT: - sum-of-squares error, SUM(sqr(y[i]-desired_y[i])/2) - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -double mlperrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::mlperrorsparse(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -double smp_mlperrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::_pexec_mlperrorsparse(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Natural error function for neural network, internal subroutine. - -NOTE: this function is single-threaded. Unlike other error function, it -receives no speed-up from being executed in SMP mode. - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -double mlperrorn(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t ssize) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::mlperrorn(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), ssize, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Classification error of the neural network on dataset. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format; - NPoints - points count. - -RESULT: - classification error (number of misclassified cases) - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -ae_int_t mlpclserror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::ae_int_t result = alglib_impl::mlpclserror(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -ae_int_t smp_mlpclserror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::ae_int_t result = alglib_impl::_pexec_mlpclserror(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Relative classification error on the test set. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format; - NPoints - points count. - -RESULT: -Percent of incorrectly classified cases. Works both for classifier -networks and general purpose networks used as classifiers. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 25.12.2008 by Bochkanov Sergey -*************************************************************************/ -double mlprelclserror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::mlprelclserror(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -double smp_mlprelclserror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::_pexec_mlprelclserror(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Relative classification error on the test set given by sparse matrix. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format. Sparse matrix must use CRS format - for storage. - NPoints - points count, >=0. - -RESULT: -Percent of incorrectly classified cases. Works both for classifier -networks and general purpose networks used as classifiers. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 09.08.2012 by Bochkanov Sergey -*************************************************************************/ -double mlprelclserrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::mlprelclserrorsparse(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -double smp_mlprelclserrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::_pexec_mlprelclserrorsparse(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Average cross-entropy (in bits per element) on the test set. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format; - NPoints - points count. - -RESULT: -CrossEntropy/(NPoints*LN(2)). -Zero if network solves regression task. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 08.01.2009 by Bochkanov Sergey -*************************************************************************/ -double mlpavgce(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::mlpavgce(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -double smp_mlpavgce(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::_pexec_mlpavgce(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Average cross-entropy (in bits per element) on the test set given by -sparse matrix. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format. This function checks correctness - of the dataset (no NANs/INFs, class numbers are - correct) and throws exception when incorrect dataset - is passed. Sparse matrix must use CRS format for - storage. - NPoints - points count, >=0. - -RESULT: -CrossEntropy/(NPoints*LN(2)). -Zero if network solves regression task. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 9.08.2012 by Bochkanov Sergey -*************************************************************************/ -double mlpavgcesparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::mlpavgcesparse(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -double smp_mlpavgcesparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::_pexec_mlpavgcesparse(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -RMS error on the test set given. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format; - NPoints - points count. - -RESULT: -Root mean square error. Its meaning for regression task is obvious. As for -classification task, RMS error means error when estimating posterior -probabilities. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -double mlprmserror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::mlprmserror(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -double smp_mlprmserror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::_pexec_mlprmserror(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -RMS error on the test set given by sparse matrix. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format. This function checks correctness - of the dataset (no NANs/INFs, class numbers are - correct) and throws exception when incorrect dataset - is passed. Sparse matrix must use CRS format for - storage. - NPoints - points count, >=0. - -RESULT: -Root mean square error. Its meaning for regression task is obvious. As for -classification task, RMS error means error when estimating posterior -probabilities. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 09.08.2012 by Bochkanov Sergey -*************************************************************************/ -double mlprmserrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::mlprmserrorsparse(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -double smp_mlprmserrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::_pexec_mlprmserrorsparse(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Average absolute error on the test set. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format; - NPoints - points count. - -RESULT: -Its meaning for regression task is obvious. As for classification task, it -means average error when estimating posterior probabilities. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 11.03.2008 by Bochkanov Sergey -*************************************************************************/ -double mlpavgerror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::mlpavgerror(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -double smp_mlpavgerror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::_pexec_mlpavgerror(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Average absolute error on the test set given by sparse matrix. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format. This function checks correctness - of the dataset (no NANs/INFs, class numbers are - correct) and throws exception when incorrect dataset - is passed. Sparse matrix must use CRS format for - storage. - NPoints - points count, >=0. - -RESULT: -Its meaning for regression task is obvious. As for classification task, it -means average error when estimating posterior probabilities. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 09.08.2012 by Bochkanov Sergey -*************************************************************************/ -double mlpavgerrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::mlpavgerrorsparse(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -double smp_mlpavgerrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::_pexec_mlpavgerrorsparse(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Average relative error on the test set. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format; - NPoints - points count. - -RESULT: -Its meaning for regression task is obvious. As for classification task, it -means average relative error when estimating posterior probability of -belonging to the correct class. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 11.03.2008 by Bochkanov Sergey -*************************************************************************/ -double mlpavgrelerror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::mlpavgrelerror(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -double smp_mlpavgrelerror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::_pexec_mlpavgrelerror(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Average relative error on the test set given by sparse matrix. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format. This function checks correctness - of the dataset (no NANs/INFs, class numbers are - correct) and throws exception when incorrect dataset - is passed. Sparse matrix must use CRS format for - storage. - NPoints - points count, >=0. - -RESULT: -Its meaning for regression task is obvious. As for classification task, it -means average relative error when estimating posterior probability of -belonging to the correct class. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 09.08.2012 by Bochkanov Sergey -*************************************************************************/ -double mlpavgrelerrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::mlpavgrelerrorsparse(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -double smp_mlpavgrelerrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::_pexec_mlpavgrelerrorsparse(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Gradient calculation - -INPUT PARAMETERS: - Network - network initialized with one of the network creation funcs - X - input vector, length of array must be at least NIn - DesiredY- desired outputs, length of array must be at least NOut - Grad - possibly preallocated array. If size of array is smaller - than WCount, it will be reallocated. It is recommended to - reuse previously allocated array to reduce allocation - overhead. - -OUTPUT PARAMETERS: - E - error function, SUM(sqr(y[i]-desiredy[i])/2,i) - Grad - gradient of E with respect to weights of network, array[WCount] - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpgrad(const multilayerperceptron &network, const real_1d_array &x, const real_1d_array &desiredy, double &e, real_1d_array &grad) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpgrad(const_cast(network.c_ptr()), const_cast(x.c_ptr()), const_cast(desiredy.c_ptr()), &e, const_cast(grad.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Gradient calculation (natural error function is used) - -INPUT PARAMETERS: - Network - network initialized with one of the network creation funcs - X - input vector, length of array must be at least NIn - DesiredY- desired outputs, length of array must be at least NOut - Grad - possibly preallocated array. If size of array is smaller - than WCount, it will be reallocated. It is recommended to - reuse previously allocated array to reduce allocation - overhead. - -OUTPUT PARAMETERS: - E - error function, sum-of-squares for regression networks, - cross-entropy for classification networks. - Grad - gradient of E with respect to weights of network, array[WCount] - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpgradn(const multilayerperceptron &network, const real_1d_array &x, const real_1d_array &desiredy, double &e, real_1d_array &grad) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpgradn(const_cast(network.c_ptr()), const_cast(x.c_ptr()), const_cast(desiredy.c_ptr()), &e, const_cast(grad.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Batch gradient calculation for a set of inputs/outputs - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - network initialized with one of the network creation funcs - XY - original dataset in dense format; one sample = one row: - * first NIn columns contain inputs, - * for regression problem, next NOut columns store - desired outputs. - * for classification problem, next column (just one!) - stores class number. - SSize - number of elements in XY - Grad - possibly preallocated array. If size of array is smaller - than WCount, it will be reallocated. It is recommended to - reuse previously allocated array to reduce allocation - overhead. - -OUTPUT PARAMETERS: - E - error function, SUM(sqr(y[i]-desiredy[i])/2,i) - Grad - gradient of E with respect to weights of network, array[WCount] - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpgradbatch(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t ssize, double &e, real_1d_array &grad) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpgradbatch(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), ssize, &e, const_cast(grad.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_mlpgradbatch(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t ssize, double &e, real_1d_array &grad) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_mlpgradbatch(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), ssize, &e, const_cast(grad.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Batch gradient calculation for a set of inputs/outputs given by sparse -matrices - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - network initialized with one of the network creation funcs - XY - original dataset in sparse format; one sample = one row: - * MATRIX MUST BE STORED IN CRS FORMAT - * first NIn columns contain inputs. - * for regression problem, next NOut columns store - desired outputs. - * for classification problem, next column (just one!) - stores class number. - SSize - number of elements in XY - Grad - possibly preallocated array. If size of array is smaller - than WCount, it will be reallocated. It is recommended to - reuse previously allocated array to reduce allocation - overhead. - -OUTPUT PARAMETERS: - E - error function, SUM(sqr(y[i]-desiredy[i])/2,i) - Grad - gradient of E with respect to weights of network, array[WCount] - - -- ALGLIB -- - Copyright 26.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpgradbatchsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t ssize, double &e, real_1d_array &grad) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpgradbatchsparse(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), ssize, &e, const_cast(grad.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_mlpgradbatchsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t ssize, double &e, real_1d_array &grad) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_mlpgradbatchsparse(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), ssize, &e, const_cast(grad.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Batch gradient calculation for a subset of dataset - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - network initialized with one of the network creation funcs - XY - original dataset in dense format; one sample = one row: - * first NIn columns contain inputs, - * for regression problem, next NOut columns store - desired outputs. - * for classification problem, next column (just one!) - stores class number. - SetSize - real size of XY, SetSize>=0; - Idx - subset of SubsetSize elements, array[SubsetSize]: - * Idx[I] stores row index in the original dataset which is - given by XY. Gradient is calculated with respect to rows - whose indexes are stored in Idx[]. - * Idx[] must store correct indexes; this function throws - an exception in case incorrect index (less than 0 or - larger than rows(XY)) is given - * Idx[] may store indexes in any order and even with - repetitions. - SubsetSize- number of elements in Idx[] array: - * positive value means that subset given by Idx[] is processed - * zero value results in zero gradient - * negative value means that full dataset is processed - Grad - possibly preallocated array. If size of array is smaller - than WCount, it will be reallocated. It is recommended to - reuse previously allocated array to reduce allocation - overhead. - -OUTPUT PARAMETERS: - E - error function, SUM(sqr(y[i]-desiredy[i])/2,i) - Grad - gradient of E with respect to weights of network, - array[WCount] - - -- ALGLIB -- - Copyright 26.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpgradbatchsubset(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t setsize, const integer_1d_array &idx, const ae_int_t subsetsize, double &e, real_1d_array &grad) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpgradbatchsubset(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), setsize, const_cast(idx.c_ptr()), subsetsize, &e, const_cast(grad.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_mlpgradbatchsubset(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t setsize, const integer_1d_array &idx, const ae_int_t subsetsize, double &e, real_1d_array &grad) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_mlpgradbatchsubset(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), setsize, const_cast(idx.c_ptr()), subsetsize, &e, const_cast(grad.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Batch gradient calculation for a set of inputs/outputs for a subset of -dataset given by set of indexes. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - network initialized with one of the network creation funcs - XY - original dataset in sparse format; one sample = one row: - * MATRIX MUST BE STORED IN CRS FORMAT - * first NIn columns contain inputs, - * for regression problem, next NOut columns store - desired outputs. - * for classification problem, next column (just one!) - stores class number. - SetSize - real size of XY, SetSize>=0; - Idx - subset of SubsetSize elements, array[SubsetSize]: - * Idx[I] stores row index in the original dataset which is - given by XY. Gradient is calculated with respect to rows - whose indexes are stored in Idx[]. - * Idx[] must store correct indexes; this function throws - an exception in case incorrect index (less than 0 or - larger than rows(XY)) is given - * Idx[] may store indexes in any order and even with - repetitions. - SubsetSize- number of elements in Idx[] array: - * positive value means that subset given by Idx[] is processed - * zero value results in zero gradient - * negative value means that full dataset is processed - Grad - possibly preallocated array. If size of array is smaller - than WCount, it will be reallocated. It is recommended to - reuse previously allocated array to reduce allocation - overhead. - -OUTPUT PARAMETERS: - E - error function, SUM(sqr(y[i]-desiredy[i])/2,i) - Grad - gradient of E with respect to weights of network, - array[WCount] - -NOTE: when SubsetSize<0 is used full dataset by call MLPGradBatchSparse - function. - - -- ALGLIB -- - Copyright 26.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpgradbatchsparsesubset(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t setsize, const integer_1d_array &idx, const ae_int_t subsetsize, double &e, real_1d_array &grad) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpgradbatchsparsesubset(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), setsize, const_cast(idx.c_ptr()), subsetsize, &e, const_cast(grad.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_mlpgradbatchsparsesubset(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t setsize, const integer_1d_array &idx, const ae_int_t subsetsize, double &e, real_1d_array &grad) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_mlpgradbatchsparsesubset(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), setsize, const_cast(idx.c_ptr()), subsetsize, &e, const_cast(grad.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Batch gradient calculation for a set of inputs/outputs -(natural error function is used) - -INPUT PARAMETERS: - Network - network initialized with one of the network creation funcs - XY - set of inputs/outputs; one sample = one row; - first NIn columns contain inputs, - next NOut columns - desired outputs. - SSize - number of elements in XY - Grad - possibly preallocated array. If size of array is smaller - than WCount, it will be reallocated. It is recommended to - reuse previously allocated array to reduce allocation - overhead. - -OUTPUT PARAMETERS: - E - error function, sum-of-squares for regression networks, - cross-entropy for classification networks. - Grad - gradient of E with respect to weights of network, array[WCount] - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpgradnbatch(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t ssize, double &e, real_1d_array &grad) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpgradnbatch(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), ssize, &e, const_cast(grad.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Batch Hessian calculation (natural error function) using R-algorithm. -Internal subroutine. - - -- ALGLIB -- - Copyright 26.01.2008 by Bochkanov Sergey. - - Hessian calculation based on R-algorithm described in - "Fast Exact Multiplication by the Hessian", - B. A. Pearlmutter, - Neural Computation, 1994. -*************************************************************************/ -void mlphessiannbatch(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t ssize, double &e, real_1d_array &grad, real_2d_array &h) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlphessiannbatch(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), ssize, &e, const_cast(grad.c_ptr()), const_cast(h.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Batch Hessian calculation using R-algorithm. -Internal subroutine. - - -- ALGLIB -- - Copyright 26.01.2008 by Bochkanov Sergey. - - Hessian calculation based on R-algorithm described in - "Fast Exact Multiplication by the Hessian", - B. A. Pearlmutter, - Neural Computation, 1994. -*************************************************************************/ -void mlphessianbatch(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t ssize, double &e, real_1d_array &grad, real_2d_array &h) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlphessianbatch(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), ssize, &e, const_cast(grad.c_ptr()), const_cast(h.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Calculation of all types of errors. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - network initialized with one of the network creation funcs - XY - original dataset; one sample = one row; - first NIn columns contain inputs, - next NOut columns - desired outputs. - SetSize - real size of XY, SetSize>=0; - Subset - subset of SubsetSize elements, array[SubsetSize]; - SubsetSize- number of elements in Subset[] array. - -OUTPUT PARAMETERS: - Rep - it contains all type of errors. - -NOTE: when SubsetSize<0 is used full dataset by call MLPGradBatch function. - - -- ALGLIB -- - Copyright 04.09.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpallerrorssubset(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize, modelerrors &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpallerrorssubset(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), setsize, const_cast(subset.c_ptr()), subsetsize, const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_mlpallerrorssubset(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize, modelerrors &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_mlpallerrorssubset(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), setsize, const_cast(subset.c_ptr()), subsetsize, const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Calculation of all types of errors on sparse dataset. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - network initialized with one of the network creation funcs - XY - original dataset given by sparse matrix; - one sample = one row; - first NIn columns contain inputs, - next NOut columns - desired outputs. - SetSize - real size of XY, SetSize>=0; - Subset - subset of SubsetSize elements, array[SubsetSize]; - SubsetSize- number of elements in Subset[] array. - -OUTPUT PARAMETERS: - Rep - it contains all type of errors. - -NOTE: when SubsetSize<0 is used full dataset by call MLPGradBatch function. - - -- ALGLIB -- - Copyright 04.09.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpallerrorssparsesubset(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize, modelerrors &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpallerrorssparsesubset(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), setsize, const_cast(subset.c_ptr()), subsetsize, const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_mlpallerrorssparsesubset(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize, modelerrors &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_mlpallerrorssparsesubset(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), setsize, const_cast(subset.c_ptr()), subsetsize, const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Error of the neural network on dataset. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format; - SetSize - real size of XY, SetSize>=0; - Subset - subset of SubsetSize elements, array[SubsetSize]; - SubsetSize- number of elements in Subset[] array. - -RESULT: - sum-of-squares error, SUM(sqr(y[i]-desired_y[i])/2) - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 04.09.2012 by Bochkanov Sergey -*************************************************************************/ -double mlperrorsubset(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::mlperrorsubset(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), setsize, const_cast(subset.c_ptr()), subsetsize, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -double smp_mlperrorsubset(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::_pexec_mlperrorsubset(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), setsize, const_cast(subset.c_ptr()), subsetsize, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Error of the neural network on sparse dataset. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format. This function checks correctness - of the dataset (no NANs/INFs, class numbers are - correct) and throws exception when incorrect dataset - is passed. Sparse matrix must use CRS format for - storage. - SetSize - real size of XY, SetSize>=0; - it is used when SubsetSize<0; - Subset - subset of SubsetSize elements, array[SubsetSize]; - SubsetSize- number of elements in Subset[] array. - -RESULT: - sum-of-squares error, SUM(sqr(y[i]-desired_y[i])/2) - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 04.09.2012 by Bochkanov Sergey -*************************************************************************/ -double mlperrorsparsesubset(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::mlperrorsparsesubset(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), setsize, const_cast(subset.c_ptr()), subsetsize, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -double smp_mlperrorsparsesubset(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::_pexec_mlperrorsparsesubset(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), setsize, const_cast(subset.c_ptr()), subsetsize, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* - -*************************************************************************/ -_logitmodel_owner::_logitmodel_owner() -{ - p_struct = (alglib_impl::logitmodel*)alglib_impl::ae_malloc(sizeof(alglib_impl::logitmodel), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_logitmodel_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_logitmodel_owner::_logitmodel_owner(const _logitmodel_owner &rhs) -{ - p_struct = (alglib_impl::logitmodel*)alglib_impl::ae_malloc(sizeof(alglib_impl::logitmodel), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_logitmodel_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_logitmodel_owner& _logitmodel_owner::operator=(const _logitmodel_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_logitmodel_clear(p_struct); - if( !alglib_impl::_logitmodel_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_logitmodel_owner::~_logitmodel_owner() -{ - alglib_impl::_logitmodel_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::logitmodel* _logitmodel_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::logitmodel* _logitmodel_owner::c_ptr() const -{ - return const_cast(p_struct); -} -logitmodel::logitmodel() : _logitmodel_owner() -{ -} - -logitmodel::logitmodel(const logitmodel &rhs):_logitmodel_owner(rhs) -{ -} - -logitmodel& logitmodel::operator=(const logitmodel &rhs) -{ - if( this==&rhs ) - return *this; - _logitmodel_owner::operator=(rhs); - return *this; -} - -logitmodel::~logitmodel() -{ -} - - -/************************************************************************* -MNLReport structure contains information about training process: -* NGrad - number of gradient calculations -* NHess - number of Hessian calculations -*************************************************************************/ -_mnlreport_owner::_mnlreport_owner() -{ - p_struct = (alglib_impl::mnlreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::mnlreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_mnlreport_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_mnlreport_owner::_mnlreport_owner(const _mnlreport_owner &rhs) -{ - p_struct = (alglib_impl::mnlreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::mnlreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_mnlreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_mnlreport_owner& _mnlreport_owner::operator=(const _mnlreport_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_mnlreport_clear(p_struct); - if( !alglib_impl::_mnlreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_mnlreport_owner::~_mnlreport_owner() -{ - alglib_impl::_mnlreport_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::mnlreport* _mnlreport_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::mnlreport* _mnlreport_owner::c_ptr() const -{ - return const_cast(p_struct); -} -mnlreport::mnlreport() : _mnlreport_owner() ,ngrad(p_struct->ngrad),nhess(p_struct->nhess) -{ -} - -mnlreport::mnlreport(const mnlreport &rhs):_mnlreport_owner(rhs) ,ngrad(p_struct->ngrad),nhess(p_struct->nhess) -{ -} - -mnlreport& mnlreport::operator=(const mnlreport &rhs) -{ - if( this==&rhs ) - return *this; - _mnlreport_owner::operator=(rhs); - return *this; -} - -mnlreport::~mnlreport() -{ -} - -/************************************************************************* -This subroutine trains logit model. - -INPUT PARAMETERS: - XY - training set, array[0..NPoints-1,0..NVars] - First NVars columns store values of independent - variables, next column stores number of class (from 0 - to NClasses-1) which dataset element belongs to. Fractional - values are rounded to nearest integer. - NPoints - training set size, NPoints>=1 - NVars - number of independent variables, NVars>=1 - NClasses - number of classes, NClasses>=2 - -OUTPUT PARAMETERS: - Info - return code: - * -2, if there is a point with class number - outside of [0..NClasses-1]. - * -1, if incorrect parameters was passed - (NPoints(xy.c_ptr()), npoints, nvars, nclasses, &info, const_cast(lm.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Procesing - -INPUT PARAMETERS: - LM - logit model, passed by non-constant reference - (some fields of structure are used as temporaries - when calculating model output). - X - input vector, array[0..NVars-1]. - Y - (possibly) preallocated buffer; if size of Y is less than - NClasses, it will be reallocated.If it is large enough, it - is NOT reallocated, so we can save some time on reallocation. - -OUTPUT PARAMETERS: - Y - result, array[0..NClasses-1] - Vector of posterior probabilities for classification task. - - -- ALGLIB -- - Copyright 10.09.2008 by Bochkanov Sergey -*************************************************************************/ -void mnlprocess(const logitmodel &lm, const real_1d_array &x, real_1d_array &y) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mnlprocess(const_cast(lm.c_ptr()), const_cast(x.c_ptr()), const_cast(y.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -'interactive' variant of MNLProcess for languages like Python which -support constructs like "Y = MNLProcess(LM,X)" and interactive mode of the -interpreter - -This function allocates new array on each call, so it is significantly -slower than its 'non-interactive' counterpart, but it is more convenient -when you call it from command line. - - -- ALGLIB -- - Copyright 10.09.2008 by Bochkanov Sergey -*************************************************************************/ -void mnlprocessi(const logitmodel &lm, const real_1d_array &x, real_1d_array &y) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mnlprocessi(const_cast(lm.c_ptr()), const_cast(x.c_ptr()), const_cast(y.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Unpacks coefficients of logit model. Logit model have form: - - P(class=i) = S(i) / (S(0) + S(1) + ... +S(M-1)) - S(i) = Exp(A[i,0]*X[0] + ... + A[i,N-1]*X[N-1] + A[i,N]), when i(lm.c_ptr()), const_cast(a.c_ptr()), &nvars, &nclasses, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -"Packs" coefficients and creates logit model in ALGLIB format (MNLUnpack -reversed). - -INPUT PARAMETERS: - A - model (see MNLUnpack) - NVars - number of independent variables - NClasses - number of classes - -OUTPUT PARAMETERS: - LM - logit model. - - -- ALGLIB -- - Copyright 10.09.2008 by Bochkanov Sergey -*************************************************************************/ -void mnlpack(const real_2d_array &a, const ae_int_t nvars, const ae_int_t nclasses, logitmodel &lm) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mnlpack(const_cast(a.c_ptr()), nvars, nclasses, const_cast(lm.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Average cross-entropy (in bits per element) on the test set - -INPUT PARAMETERS: - LM - logit model - XY - test set - NPoints - test set size - -RESULT: - CrossEntropy/(NPoints*ln(2)). - - -- ALGLIB -- - Copyright 10.09.2008 by Bochkanov Sergey -*************************************************************************/ -double mnlavgce(const logitmodel &lm, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::mnlavgce(const_cast(lm.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Relative classification error on the test set - -INPUT PARAMETERS: - LM - logit model - XY - test set - NPoints - test set size - -RESULT: - percent of incorrectly classified cases. - - -- ALGLIB -- - Copyright 10.09.2008 by Bochkanov Sergey -*************************************************************************/ -double mnlrelclserror(const logitmodel &lm, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::mnlrelclserror(const_cast(lm.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -RMS error on the test set - -INPUT PARAMETERS: - LM - logit model - XY - test set - NPoints - test set size - -RESULT: - root mean square error (error when estimating posterior probabilities). - - -- ALGLIB -- - Copyright 30.08.2008 by Bochkanov Sergey -*************************************************************************/ -double mnlrmserror(const logitmodel &lm, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::mnlrmserror(const_cast(lm.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Average error on the test set - -INPUT PARAMETERS: - LM - logit model - XY - test set - NPoints - test set size - -RESULT: - average error (error when estimating posterior probabilities). - - -- ALGLIB -- - Copyright 30.08.2008 by Bochkanov Sergey -*************************************************************************/ -double mnlavgerror(const logitmodel &lm, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::mnlavgerror(const_cast(lm.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Average relative error on the test set - -INPUT PARAMETERS: - LM - logit model - XY - test set - NPoints - test set size - -RESULT: - average relative error (error when estimating posterior probabilities). - - -- ALGLIB -- - Copyright 30.08.2008 by Bochkanov Sergey -*************************************************************************/ -double mnlavgrelerror(const logitmodel &lm, const real_2d_array &xy, const ae_int_t ssize) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::mnlavgrelerror(const_cast(lm.c_ptr()), const_cast(xy.c_ptr()), ssize, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Classification error on test set = MNLRelClsError*NPoints - - -- ALGLIB -- - Copyright 10.09.2008 by Bochkanov Sergey -*************************************************************************/ -ae_int_t mnlclserror(const logitmodel &lm, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::ae_int_t result = alglib_impl::mnlclserror(const_cast(lm.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This structure is a MCPD (Markov Chains for Population Data) solver. - -You should use ALGLIB functions in order to work with this object. - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -_mcpdstate_owner::_mcpdstate_owner() -{ - p_struct = (alglib_impl::mcpdstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::mcpdstate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_mcpdstate_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_mcpdstate_owner::_mcpdstate_owner(const _mcpdstate_owner &rhs) -{ - p_struct = (alglib_impl::mcpdstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::mcpdstate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_mcpdstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_mcpdstate_owner& _mcpdstate_owner::operator=(const _mcpdstate_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_mcpdstate_clear(p_struct); - if( !alglib_impl::_mcpdstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_mcpdstate_owner::~_mcpdstate_owner() -{ - alglib_impl::_mcpdstate_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::mcpdstate* _mcpdstate_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::mcpdstate* _mcpdstate_owner::c_ptr() const -{ - return const_cast(p_struct); -} -mcpdstate::mcpdstate() : _mcpdstate_owner() -{ -} - -mcpdstate::mcpdstate(const mcpdstate &rhs):_mcpdstate_owner(rhs) -{ -} - -mcpdstate& mcpdstate::operator=(const mcpdstate &rhs) -{ - if( this==&rhs ) - return *this; - _mcpdstate_owner::operator=(rhs); - return *this; -} - -mcpdstate::~mcpdstate() -{ -} - - -/************************************************************************* -This structure is a MCPD training report: - InnerIterationsCount - number of inner iterations of the - underlying optimization algorithm - OuterIterationsCount - number of outer iterations of the - underlying optimization algorithm - NFEV - number of merit function evaluations - TerminationType - termination type - (same as for MinBLEIC optimizer, positive - values denote success, negative ones - - failure) - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -_mcpdreport_owner::_mcpdreport_owner() -{ - p_struct = (alglib_impl::mcpdreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::mcpdreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_mcpdreport_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_mcpdreport_owner::_mcpdreport_owner(const _mcpdreport_owner &rhs) -{ - p_struct = (alglib_impl::mcpdreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::mcpdreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_mcpdreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_mcpdreport_owner& _mcpdreport_owner::operator=(const _mcpdreport_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_mcpdreport_clear(p_struct); - if( !alglib_impl::_mcpdreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_mcpdreport_owner::~_mcpdreport_owner() -{ - alglib_impl::_mcpdreport_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::mcpdreport* _mcpdreport_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::mcpdreport* _mcpdreport_owner::c_ptr() const -{ - return const_cast(p_struct); -} -mcpdreport::mcpdreport() : _mcpdreport_owner() ,inneriterationscount(p_struct->inneriterationscount),outeriterationscount(p_struct->outeriterationscount),nfev(p_struct->nfev),terminationtype(p_struct->terminationtype) -{ -} - -mcpdreport::mcpdreport(const mcpdreport &rhs):_mcpdreport_owner(rhs) ,inneriterationscount(p_struct->inneriterationscount),outeriterationscount(p_struct->outeriterationscount),nfev(p_struct->nfev),terminationtype(p_struct->terminationtype) -{ -} - -mcpdreport& mcpdreport::operator=(const mcpdreport &rhs) -{ - if( this==&rhs ) - return *this; - _mcpdreport_owner::operator=(rhs); - return *this; -} - -mcpdreport::~mcpdreport() -{ -} - -/************************************************************************* -DESCRIPTION: - -This function creates MCPD (Markov Chains for Population Data) solver. - -This solver can be used to find transition matrix P for N-dimensional -prediction problem where transition from X[i] to X[i+1] is modelled as - X[i+1] = P*X[i] -where X[i] and X[i+1] are N-dimensional population vectors (components of -each X are non-negative), and P is a N*N transition matrix (elements of P -are non-negative, each column sums to 1.0). - -Such models arise when when: -* there is some population of individuals -* individuals can have different states -* individuals can transit from one state to another -* population size is constant, i.e. there is no new individuals and no one - leaves population -* you want to model transitions of individuals from one state into another - -USAGE: - -Here we give very brief outline of the MCPD. We strongly recommend you to -read examples in the ALGLIB Reference Manual and to read ALGLIB User Guide -on data analysis which is available at http://www.alglib.net/dataanalysis/ - -1. User initializes algorithm state with MCPDCreate() call - -2. User adds one or more tracks - sequences of states which describe - evolution of a system being modelled from different starting conditions - -3. User may add optional boundary, equality and/or linear constraints on - the coefficients of P by calling one of the following functions: - * MCPDSetEC() to set equality constraints - * MCPDSetBC() to set bound constraints - * MCPDSetLC() to set linear constraints - -4. Optionally, user may set custom weights for prediction errors (by - default, algorithm assigns non-equal, automatically chosen weights for - errors in the prediction of different components of X). It can be done - with a call of MCPDSetPredictionWeights() function. - -5. User calls MCPDSolve() function which takes algorithm state and - pointer (delegate, etc.) to callback function which calculates F/G. - -6. User calls MCPDResults() to get solution - -INPUT PARAMETERS: - N - problem dimension, N>=1 - -OUTPUT PARAMETERS: - State - structure stores algorithm state - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdcreate(const ae_int_t n, mcpdstate &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mcpdcreate(n, const_cast(s.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -DESCRIPTION: - -This function is a specialized version of MCPDCreate() function, and we -recommend you to read comments for this function for general information -about MCPD solver. - -This function creates MCPD (Markov Chains for Population Data) solver -for "Entry-state" model, i.e. model where transition from X[i] to X[i+1] -is modelled as - X[i+1] = P*X[i] -where - X[i] and X[i+1] are N-dimensional state vectors - P is a N*N transition matrix -and one selected component of X[] is called "entry" state and is treated -in a special way: - system state always transits from "entry" state to some another state - system state can not transit from any state into "entry" state -Such conditions basically mean that row of P which corresponds to "entry" -state is zero. - -Such models arise when: -* there is some population of individuals -* individuals can have different states -* individuals can transit from one state to another -* population size is NOT constant - at every moment of time there is some - (unpredictable) amount of "new" individuals, which can transit into one - of the states at the next turn, but still no one leaves population -* you want to model transitions of individuals from one state into another -* but you do NOT want to predict amount of "new" individuals because it - does not depends on individuals already present (hence system can not - transit INTO entry state - it can only transit FROM it). - -This model is discussed in more details in the ALGLIB User Guide (see -http://www.alglib.net/dataanalysis/ for more data). - -INPUT PARAMETERS: - N - problem dimension, N>=2 - EntryState- index of entry state, in 0..N-1 - -OUTPUT PARAMETERS: - State - structure stores algorithm state - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdcreateentry(const ae_int_t n, const ae_int_t entrystate, mcpdstate &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mcpdcreateentry(n, entrystate, const_cast(s.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -DESCRIPTION: - -This function is a specialized version of MCPDCreate() function, and we -recommend you to read comments for this function for general information -about MCPD solver. - -This function creates MCPD (Markov Chains for Population Data) solver -for "Exit-state" model, i.e. model where transition from X[i] to X[i+1] -is modelled as - X[i+1] = P*X[i] -where - X[i] and X[i+1] are N-dimensional state vectors - P is a N*N transition matrix -and one selected component of X[] is called "exit" state and is treated -in a special way: - system state can transit from any state into "exit" state - system state can not transit from "exit" state into any other state - transition operator discards "exit" state (makes it zero at each turn) -Such conditions basically mean that column of P which corresponds to -"exit" state is zero. Multiplication by such P may decrease sum of vector -components. - -Such models arise when: -* there is some population of individuals -* individuals can have different states -* individuals can transit from one state to another -* population size is NOT constant - individuals can move into "exit" state - and leave population at the next turn, but there are no new individuals -* amount of individuals which leave population can be predicted -* you want to model transitions of individuals from one state into another - (including transitions into the "exit" state) - -This model is discussed in more details in the ALGLIB User Guide (see -http://www.alglib.net/dataanalysis/ for more data). - -INPUT PARAMETERS: - N - problem dimension, N>=2 - ExitState- index of exit state, in 0..N-1 - -OUTPUT PARAMETERS: - State - structure stores algorithm state - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdcreateexit(const ae_int_t n, const ae_int_t exitstate, mcpdstate &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mcpdcreateexit(n, exitstate, const_cast(s.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -DESCRIPTION: - -This function is a specialized version of MCPDCreate() function, and we -recommend you to read comments for this function for general information -about MCPD solver. - -This function creates MCPD (Markov Chains for Population Data) solver -for "Entry-Exit-states" model, i.e. model where transition from X[i] to -X[i+1] is modelled as - X[i+1] = P*X[i] -where - X[i] and X[i+1] are N-dimensional state vectors - P is a N*N transition matrix -one selected component of X[] is called "entry" state and is treated in a -special way: - system state always transits from "entry" state to some another state - system state can not transit from any state into "entry" state -and another one component of X[] is called "exit" state and is treated in -a special way too: - system state can transit from any state into "exit" state - system state can not transit from "exit" state into any other state - transition operator discards "exit" state (makes it zero at each turn) -Such conditions basically mean that: - row of P which corresponds to "entry" state is zero - column of P which corresponds to "exit" state is zero -Multiplication by such P may decrease sum of vector components. - -Such models arise when: -* there is some population of individuals -* individuals can have different states -* individuals can transit from one state to another -* population size is NOT constant -* at every moment of time there is some (unpredictable) amount of "new" - individuals, which can transit into one of the states at the next turn -* some individuals can move (predictably) into "exit" state and leave - population at the next turn -* you want to model transitions of individuals from one state into another, - including transitions from the "entry" state and into the "exit" state. -* but you do NOT want to predict amount of "new" individuals because it - does not depends on individuals already present (hence system can not - transit INTO entry state - it can only transit FROM it). - -This model is discussed in more details in the ALGLIB User Guide (see -http://www.alglib.net/dataanalysis/ for more data). - -INPUT PARAMETERS: - N - problem dimension, N>=2 - EntryState- index of entry state, in 0..N-1 - ExitState- index of exit state, in 0..N-1 - -OUTPUT PARAMETERS: - State - structure stores algorithm state - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdcreateentryexit(const ae_int_t n, const ae_int_t entrystate, const ae_int_t exitstate, mcpdstate &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mcpdcreateentryexit(n, entrystate, exitstate, const_cast(s.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function is used to add a track - sequence of system states at the -different moments of its evolution. - -You may add one or several tracks to the MCPD solver. In case you have -several tracks, they won't overwrite each other. For example, if you pass -two tracks, A1-A2-A3 (system at t=A+1, t=A+2 and t=A+3) and B1-B2-B3, then -solver will try to model transitions from t=A+1 to t=A+2, t=A+2 to t=A+3, -t=B+1 to t=B+2, t=B+2 to t=B+3. But it WON'T mix these two tracks - i.e. it -won't try to model transition from t=A+3 to t=B+1. - -INPUT PARAMETERS: - S - solver - XY - track, array[K,N]: - * I-th row is a state at t=I - * elements of XY must be non-negative (exception will be - thrown on negative elements) - K - number of points in a track - * if given, only leading K rows of XY are used - * if not given, automatically determined from size of XY - -NOTES: - -1. Track may contain either proportional or population data: - * with proportional data all rows of XY must sum to 1.0, i.e. we have - proportions instead of absolute population values - * with population data rows of XY contain population counts and generally - do not sum to 1.0 (although they still must be non-negative) - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdaddtrack(const mcpdstate &s, const real_2d_array &xy, const ae_int_t k) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mcpdaddtrack(const_cast(s.c_ptr()), const_cast(xy.c_ptr()), k, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function is used to add a track - sequence of system states at the -different moments of its evolution. - -You may add one or several tracks to the MCPD solver. In case you have -several tracks, they won't overwrite each other. For example, if you pass -two tracks, A1-A2-A3 (system at t=A+1, t=A+2 and t=A+3) and B1-B2-B3, then -solver will try to model transitions from t=A+1 to t=A+2, t=A+2 to t=A+3, -t=B+1 to t=B+2, t=B+2 to t=B+3. But it WON'T mix these two tracks - i.e. it -won't try to model transition from t=A+3 to t=B+1. - -INPUT PARAMETERS: - S - solver - XY - track, array[K,N]: - * I-th row is a state at t=I - * elements of XY must be non-negative (exception will be - thrown on negative elements) - K - number of points in a track - * if given, only leading K rows of XY are used - * if not given, automatically determined from size of XY - -NOTES: - -1. Track may contain either proportional or population data: - * with proportional data all rows of XY must sum to 1.0, i.e. we have - proportions instead of absolute population values - * with population data rows of XY contain population counts and generally - do not sum to 1.0 (although they still must be non-negative) - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdaddtrack(const mcpdstate &s, const real_2d_array &xy) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t k; - - k = xy.rows(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mcpdaddtrack(const_cast(s.c_ptr()), const_cast(xy.c_ptr()), k, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function is used to add equality constraints on the elements of the -transition matrix P. - -MCPD solver has four types of constraints which can be placed on P: -* user-specified equality constraints (optional) -* user-specified bound constraints (optional) -* user-specified general linear constraints (optional) -* basic constraints (always present): - * non-negativity: P[i,j]>=0 - * consistency: every column of P sums to 1.0 - -Final constraints which are passed to the underlying optimizer are -calculated as intersection of all present constraints. For example, you -may specify boundary constraint on P[0,0] and equality one: - 0.1<=P[0,0]<=0.9 - P[0,0]=0.5 -Such combination of constraints will be silently reduced to their -intersection, which is P[0,0]=0.5. - -This function can be used to place equality constraints on arbitrary -subset of elements of P. Set of constraints is specified by EC, which may -contain either NAN's or finite numbers from [0,1]. NAN denotes absence of -constraint, finite number denotes equality constraint on specific element -of P. - -You can also use MCPDAddEC() function which allows to ADD equality -constraint for one element of P without changing constraints for other -elements. - -These functions (MCPDSetEC and MCPDAddEC) interact as follows: -* there is internal matrix of equality constraints which is stored in the - MCPD solver -* MCPDSetEC() replaces this matrix by another one (SET) -* MCPDAddEC() modifies one element of this matrix and leaves other ones - unchanged (ADD) -* thus MCPDAddEC() call preserves all modifications done by previous - calls, while MCPDSetEC() completely discards all changes done to the - equality constraints. - -INPUT PARAMETERS: - S - solver - EC - equality constraints, array[N,N]. Elements of EC can be - either NAN's or finite numbers from [0,1]. NAN denotes - absence of constraints, while finite value denotes - equality constraint on the corresponding element of P. - -NOTES: - -1. infinite values of EC will lead to exception being thrown. Values less -than 0.0 or greater than 1.0 will lead to error code being returned after -call to MCPDSolve(). - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdsetec(const mcpdstate &s, const real_2d_array &ec) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mcpdsetec(const_cast(s.c_ptr()), const_cast(ec.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function is used to add equality constraints on the elements of the -transition matrix P. - -MCPD solver has four types of constraints which can be placed on P: -* user-specified equality constraints (optional) -* user-specified bound constraints (optional) -* user-specified general linear constraints (optional) -* basic constraints (always present): - * non-negativity: P[i,j]>=0 - * consistency: every column of P sums to 1.0 - -Final constraints which are passed to the underlying optimizer are -calculated as intersection of all present constraints. For example, you -may specify boundary constraint on P[0,0] and equality one: - 0.1<=P[0,0]<=0.9 - P[0,0]=0.5 -Such combination of constraints will be silently reduced to their -intersection, which is P[0,0]=0.5. - -This function can be used to ADD equality constraint for one element of P -without changing constraints for other elements. - -You can also use MCPDSetEC() function which allows you to specify -arbitrary set of equality constraints in one call. - -These functions (MCPDSetEC and MCPDAddEC) interact as follows: -* there is internal matrix of equality constraints which is stored in the - MCPD solver -* MCPDSetEC() replaces this matrix by another one (SET) -* MCPDAddEC() modifies one element of this matrix and leaves other ones - unchanged (ADD) -* thus MCPDAddEC() call preserves all modifications done by previous - calls, while MCPDSetEC() completely discards all changes done to the - equality constraints. - -INPUT PARAMETERS: - S - solver - I - row index of element being constrained - J - column index of element being constrained - C - value (constraint for P[I,J]). Can be either NAN (no - constraint) or finite value from [0,1]. - -NOTES: - -1. infinite values of C will lead to exception being thrown. Values less -than 0.0 or greater than 1.0 will lead to error code being returned after -call to MCPDSolve(). - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdaddec(const mcpdstate &s, const ae_int_t i, const ae_int_t j, const double c) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mcpdaddec(const_cast(s.c_ptr()), i, j, c, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function is used to add bound constraints on the elements of the -transition matrix P. - -MCPD solver has four types of constraints which can be placed on P: -* user-specified equality constraints (optional) -* user-specified bound constraints (optional) -* user-specified general linear constraints (optional) -* basic constraints (always present): - * non-negativity: P[i,j]>=0 - * consistency: every column of P sums to 1.0 - -Final constraints which are passed to the underlying optimizer are -calculated as intersection of all present constraints. For example, you -may specify boundary constraint on P[0,0] and equality one: - 0.1<=P[0,0]<=0.9 - P[0,0]=0.5 -Such combination of constraints will be silently reduced to their -intersection, which is P[0,0]=0.5. - -This function can be used to place bound constraints on arbitrary -subset of elements of P. Set of constraints is specified by BndL/BndU -matrices, which may contain arbitrary combination of finite numbers or -infinities (like -INF(s.c_ptr()), const_cast(bndl.c_ptr()), const_cast(bndu.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function is used to add bound constraints on the elements of the -transition matrix P. - -MCPD solver has four types of constraints which can be placed on P: -* user-specified equality constraints (optional) -* user-specified bound constraints (optional) -* user-specified general linear constraints (optional) -* basic constraints (always present): - * non-negativity: P[i,j]>=0 - * consistency: every column of P sums to 1.0 - -Final constraints which are passed to the underlying optimizer are -calculated as intersection of all present constraints. For example, you -may specify boundary constraint on P[0,0] and equality one: - 0.1<=P[0,0]<=0.9 - P[0,0]=0.5 -Such combination of constraints will be silently reduced to their -intersection, which is P[0,0]=0.5. - -This function can be used to ADD bound constraint for one element of P -without changing constraints for other elements. - -You can also use MCPDSetBC() function which allows to place bound -constraints on arbitrary subset of elements of P. Set of constraints is -specified by BndL/BndU matrices, which may contain arbitrary combination -of finite numbers or infinities (like -INF(s.c_ptr()), i, j, bndl, bndu, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function is used to set linear equality/inequality constraints on the -elements of the transition matrix P. - -This function can be used to set one or several general linear constraints -on the elements of P. Two types of constraints are supported: -* equality constraints -* inequality constraints (both less-or-equal and greater-or-equal) - -Coefficients of constraints are specified by matrix C (one of the -parameters). One row of C corresponds to one constraint. Because -transition matrix P has N*N elements, we need N*N columns to store all -coefficients (they are stored row by row), and one more column to store -right part - hence C has N*N+1 columns. Constraint kind is stored in the -CT array. - -Thus, I-th linear constraint is - P[0,0]*C[I,0] + P[0,1]*C[I,1] + .. + P[0,N-1]*C[I,N-1] + - + P[1,0]*C[I,N] + P[1,1]*C[I,N+1] + ... + - + P[N-1,N-1]*C[I,N*N-1] ?=? C[I,N*N] -where ?=? can be either "=" (CT[i]=0), "<=" (CT[i]<0) or ">=" (CT[i]>0). - -Your constraint may involve only some subset of P (less than N*N elements). -For example it can be something like - P[0,0] + P[0,1] = 0.5 -In this case you still should pass matrix with N*N+1 columns, but all its -elements (except for C[0,0], C[0,1] and C[0,N*N-1]) will be zero. - -INPUT PARAMETERS: - S - solver - C - array[K,N*N+1] - coefficients of constraints - (see above for complete description) - CT - array[K] - constraint types - (see above for complete description) - K - number of equality/inequality constraints, K>=0: - * if given, only leading K elements of C/CT are used - * if not given, automatically determined from sizes of C/CT - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdsetlc(const mcpdstate &s, const real_2d_array &c, const integer_1d_array &ct, const ae_int_t k) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mcpdsetlc(const_cast(s.c_ptr()), const_cast(c.c_ptr()), const_cast(ct.c_ptr()), k, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function is used to set linear equality/inequality constraints on the -elements of the transition matrix P. - -This function can be used to set one or several general linear constraints -on the elements of P. Two types of constraints are supported: -* equality constraints -* inequality constraints (both less-or-equal and greater-or-equal) - -Coefficients of constraints are specified by matrix C (one of the -parameters). One row of C corresponds to one constraint. Because -transition matrix P has N*N elements, we need N*N columns to store all -coefficients (they are stored row by row), and one more column to store -right part - hence C has N*N+1 columns. Constraint kind is stored in the -CT array. - -Thus, I-th linear constraint is - P[0,0]*C[I,0] + P[0,1]*C[I,1] + .. + P[0,N-1]*C[I,N-1] + - + P[1,0]*C[I,N] + P[1,1]*C[I,N+1] + ... + - + P[N-1,N-1]*C[I,N*N-1] ?=? C[I,N*N] -where ?=? can be either "=" (CT[i]=0), "<=" (CT[i]<0) or ">=" (CT[i]>0). - -Your constraint may involve only some subset of P (less than N*N elements). -For example it can be something like - P[0,0] + P[0,1] = 0.5 -In this case you still should pass matrix with N*N+1 columns, but all its -elements (except for C[0,0], C[0,1] and C[0,N*N-1]) will be zero. - -INPUT PARAMETERS: - S - solver - C - array[K,N*N+1] - coefficients of constraints - (see above for complete description) - CT - array[K] - constraint types - (see above for complete description) - K - number of equality/inequality constraints, K>=0: - * if given, only leading K elements of C/CT are used - * if not given, automatically determined from sizes of C/CT - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdsetlc(const mcpdstate &s, const real_2d_array &c, const integer_1d_array &ct) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t k; - if( (c.rows()!=ct.length())) - throw ap_error("Error while calling 'mcpdsetlc': looks like one of arguments has wrong size"); - k = c.rows(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mcpdsetlc(const_cast(s.c_ptr()), const_cast(c.c_ptr()), const_cast(ct.c_ptr()), k, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function allows to tune amount of Tikhonov regularization being -applied to your problem. - -By default, regularizing term is equal to r*||P-prior_P||^2, where r is a -small non-zero value, P is transition matrix, prior_P is identity matrix, -||X||^2 is a sum of squared elements of X. - -This function allows you to change coefficient r. You can also change -prior values with MCPDSetPrior() function. - -INPUT PARAMETERS: - S - solver - V - regularization coefficient, finite non-negative value. It - is not recommended to specify zero value unless you are - pretty sure that you want it. - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdsettikhonovregularizer(const mcpdstate &s, const double v) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mcpdsettikhonovregularizer(const_cast(s.c_ptr()), v, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function allows to set prior values used for regularization of your -problem. - -By default, regularizing term is equal to r*||P-prior_P||^2, where r is a -small non-zero value, P is transition matrix, prior_P is identity matrix, -||X||^2 is a sum of squared elements of X. - -This function allows you to change prior values prior_P. You can also -change r with MCPDSetTikhonovRegularizer() function. - -INPUT PARAMETERS: - S - solver - PP - array[N,N], matrix of prior values: - 1. elements must be real numbers from [0,1] - 2. columns must sum to 1.0. - First property is checked (exception is thrown otherwise), - while second one is not checked/enforced. - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdsetprior(const mcpdstate &s, const real_2d_array &pp) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mcpdsetprior(const_cast(s.c_ptr()), const_cast(pp.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function is used to change prediction weights - -MCPD solver scales prediction errors as follows - Error(P) = ||W*(y-P*x)||^2 -where - x is a system state at time t - y is a system state at time t+1 - P is a transition matrix - W is a diagonal scaling matrix - -By default, weights are chosen in order to minimize relative prediction -error instead of absolute one. For example, if one component of state is -about 0.5 in magnitude and another one is about 0.05, then algorithm will -make corresponding weights equal to 2.0 and 20.0. - -INPUT PARAMETERS: - S - solver - PW - array[N], weights: - * must be non-negative values (exception will be thrown otherwise) - * zero values will be replaced by automatically chosen values - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdsetpredictionweights(const mcpdstate &s, const real_1d_array &pw) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mcpdsetpredictionweights(const_cast(s.c_ptr()), const_cast(pw.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function is used to start solution of the MCPD problem. - -After return from this function, you can use MCPDResults() to get solution -and completion code. - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdsolve(const mcpdstate &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mcpdsolve(const_cast(s.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -MCPD results - -INPUT PARAMETERS: - State - algorithm state - -OUTPUT PARAMETERS: - P - array[N,N], transition matrix - Rep - optimization report. You should check Rep.TerminationType - in order to distinguish successful termination from - unsuccessful one. Speaking short, positive values denote - success, negative ones are failures. - More information about fields of this structure can be - found in the comments on MCPDReport datatype. - - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdresults(const mcpdstate &s, real_2d_array &p, mcpdreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mcpdresults(const_cast(s.c_ptr()), const_cast(p.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Neural networks ensemble -*************************************************************************/ -_mlpensemble_owner::_mlpensemble_owner() -{ - p_struct = (alglib_impl::mlpensemble*)alglib_impl::ae_malloc(sizeof(alglib_impl::mlpensemble), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_mlpensemble_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_mlpensemble_owner::_mlpensemble_owner(const _mlpensemble_owner &rhs) -{ - p_struct = (alglib_impl::mlpensemble*)alglib_impl::ae_malloc(sizeof(alglib_impl::mlpensemble), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_mlpensemble_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_mlpensemble_owner& _mlpensemble_owner::operator=(const _mlpensemble_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_mlpensemble_clear(p_struct); - if( !alglib_impl::_mlpensemble_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_mlpensemble_owner::~_mlpensemble_owner() -{ - alglib_impl::_mlpensemble_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::mlpensemble* _mlpensemble_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::mlpensemble* _mlpensemble_owner::c_ptr() const -{ - return const_cast(p_struct); -} -mlpensemble::mlpensemble() : _mlpensemble_owner() -{ -} - -mlpensemble::mlpensemble(const mlpensemble &rhs):_mlpensemble_owner(rhs) -{ -} - -mlpensemble& mlpensemble::operator=(const mlpensemble &rhs) -{ - if( this==&rhs ) - return *this; - _mlpensemble_owner::operator=(rhs); - return *this; -} - -mlpensemble::~mlpensemble() -{ -} - - -/************************************************************************* -This function serializes data structure to string. - -Important properties of s_out: -* it contains alphanumeric characters, dots, underscores, minus signs -* these symbols are grouped into words, which are separated by spaces - and Windows-style (CR+LF) newlines -* although serializer uses spaces and CR+LF as separators, you can - replace any separator character by arbitrary combination of spaces, - tabs, Windows or Unix newlines. It allows flexible reformatting of - the string in case you want to include it into text or XML file. - But you should not insert separators into the middle of the "words" - nor you should change case of letters. -* s_out can be freely moved between 32-bit and 64-bit systems, little - and big endian machines, and so on. You can serialize structure on - 32-bit machine and unserialize it on 64-bit one (or vice versa), or - serialize it on SPARC and unserialize on x86. You can also - serialize it in C++ version of ALGLIB and unserialize in C# one, - and vice versa. -*************************************************************************/ -void mlpeserialize(mlpensemble &obj, std::string &s_out) -{ - alglib_impl::ae_state state; - alglib_impl::ae_serializer serializer; - alglib_impl::ae_int_t ssize; - - alglib_impl::ae_state_init(&state); - try - { - alglib_impl::ae_serializer_init(&serializer); - alglib_impl::ae_serializer_alloc_start(&serializer); - alglib_impl::mlpealloc(&serializer, obj.c_ptr(), &state); - ssize = alglib_impl::ae_serializer_get_alloc_size(&serializer); - s_out.clear(); - s_out.reserve((size_t)(ssize+1)); - alglib_impl::ae_serializer_sstart_str(&serializer, &s_out); - alglib_impl::mlpeserialize(&serializer, obj.c_ptr(), &state); - alglib_impl::ae_serializer_stop(&serializer); - if( s_out.length()>(size_t)ssize ) - throw ap_error("ALGLIB: serialization integrity error"); - alglib_impl::ae_serializer_clear(&serializer); - alglib_impl::ae_state_clear(&state); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(state.error_msg); - } -} -/************************************************************************* -This function unserializes data structure from string. -*************************************************************************/ -void mlpeunserialize(std::string &s_in, mlpensemble &obj) -{ - alglib_impl::ae_state state; - alglib_impl::ae_serializer serializer; - - alglib_impl::ae_state_init(&state); - try - { - alglib_impl::ae_serializer_init(&serializer); - alglib_impl::ae_serializer_ustart_str(&serializer, &s_in); - alglib_impl::mlpeunserialize(&serializer, obj.c_ptr(), &state); - alglib_impl::ae_serializer_stop(&serializer); - alglib_impl::ae_serializer_clear(&serializer); - alglib_impl::ae_state_clear(&state); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(state.error_msg); - } -} - -/************************************************************************* -Like MLPCreate0, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreate0(const ae_int_t nin, const ae_int_t nout, const ae_int_t ensemblesize, mlpensemble &ensemble) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpecreate0(nin, nout, ensemblesize, const_cast(ensemble.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Like MLPCreate1, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreate1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, const ae_int_t ensemblesize, mlpensemble &ensemble) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpecreate1(nin, nhid, nout, ensemblesize, const_cast(ensemble.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Like MLPCreate2, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreate2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, const ae_int_t ensemblesize, mlpensemble &ensemble) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpecreate2(nin, nhid1, nhid2, nout, ensemblesize, const_cast(ensemble.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Like MLPCreateB0, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreateb0(const ae_int_t nin, const ae_int_t nout, const double b, const double d, const ae_int_t ensemblesize, mlpensemble &ensemble) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpecreateb0(nin, nout, b, d, ensemblesize, const_cast(ensemble.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Like MLPCreateB1, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreateb1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, const double b, const double d, const ae_int_t ensemblesize, mlpensemble &ensemble) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpecreateb1(nin, nhid, nout, b, d, ensemblesize, const_cast(ensemble.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Like MLPCreateB2, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreateb2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, const double b, const double d, const ae_int_t ensemblesize, mlpensemble &ensemble) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpecreateb2(nin, nhid1, nhid2, nout, b, d, ensemblesize, const_cast(ensemble.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Like MLPCreateR0, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreater0(const ae_int_t nin, const ae_int_t nout, const double a, const double b, const ae_int_t ensemblesize, mlpensemble &ensemble) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpecreater0(nin, nout, a, b, ensemblesize, const_cast(ensemble.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Like MLPCreateR1, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreater1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, const double a, const double b, const ae_int_t ensemblesize, mlpensemble &ensemble) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpecreater1(nin, nhid, nout, a, b, ensemblesize, const_cast(ensemble.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Like MLPCreateR2, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreater2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, const double a, const double b, const ae_int_t ensemblesize, mlpensemble &ensemble) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpecreater2(nin, nhid1, nhid2, nout, a, b, ensemblesize, const_cast(ensemble.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Like MLPCreateC0, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreatec0(const ae_int_t nin, const ae_int_t nout, const ae_int_t ensemblesize, mlpensemble &ensemble) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpecreatec0(nin, nout, ensemblesize, const_cast(ensemble.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Like MLPCreateC1, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreatec1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, const ae_int_t ensemblesize, mlpensemble &ensemble) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpecreatec1(nin, nhid, nout, ensemblesize, const_cast(ensemble.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Like MLPCreateC2, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreatec2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, const ae_int_t ensemblesize, mlpensemble &ensemble) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpecreatec2(nin, nhid1, nhid2, nout, ensemblesize, const_cast(ensemble.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Creates ensemble from network. Only network geometry is copied. - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreatefromnetwork(const multilayerperceptron &network, const ae_int_t ensemblesize, mlpensemble &ensemble) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpecreatefromnetwork(const_cast(network.c_ptr()), ensemblesize, const_cast(ensemble.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Randomization of MLP ensemble - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlperandomize(const mlpensemble &ensemble) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlperandomize(const_cast(ensemble.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Return ensemble properties (number of inputs and outputs). - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpeproperties(const mlpensemble &ensemble, ae_int_t &nin, ae_int_t &nout) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpeproperties(const_cast(ensemble.c_ptr()), &nin, &nout, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Return normalization type (whether ensemble is SOFTMAX-normalized or not). - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -bool mlpeissoftmax(const mlpensemble &ensemble) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::mlpeissoftmax(const_cast(ensemble.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Procesing - -INPUT PARAMETERS: - Ensemble- neural networks ensemble - X - input vector, array[0..NIn-1]. - Y - (possibly) preallocated buffer; if size of Y is less than - NOut, it will be reallocated. If it is large enough, it - is NOT reallocated, so we can save some time on reallocation. - - -OUTPUT PARAMETERS: - Y - result. Regression estimate when solving regression task, - vector of posterior probabilities for classification task. - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpeprocess(const mlpensemble &ensemble, const real_1d_array &x, real_1d_array &y) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpeprocess(const_cast(ensemble.c_ptr()), const_cast(x.c_ptr()), const_cast(y.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -'interactive' variant of MLPEProcess for languages like Python which -support constructs like "Y = MLPEProcess(LM,X)" and interactive mode of the -interpreter - -This function allocates new array on each call, so it is significantly -slower than its 'non-interactive' counterpart, but it is more convenient -when you call it from command line. - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpeprocessi(const mlpensemble &ensemble, const real_1d_array &x, real_1d_array &y) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpeprocessi(const_cast(ensemble.c_ptr()), const_cast(x.c_ptr()), const_cast(y.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Relative classification error on the test set - -INPUT PARAMETERS: - Ensemble- ensemble - XY - test set - NPoints - test set size - -RESULT: - percent of incorrectly classified cases. - Works both for classifier betwork and for regression networks which -are used as classifiers. - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -double mlperelclserror(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::mlperelclserror(const_cast(ensemble.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Average cross-entropy (in bits per element) on the test set - -INPUT PARAMETERS: - Ensemble- ensemble - XY - test set - NPoints - test set size - -RESULT: - CrossEntropy/(NPoints*LN(2)). - Zero if ensemble solves regression task. - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -double mlpeavgce(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::mlpeavgce(const_cast(ensemble.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -RMS error on the test set - -INPUT PARAMETERS: - Ensemble- ensemble - XY - test set - NPoints - test set size - -RESULT: - root mean square error. - Its meaning for regression task is obvious. As for classification task -RMS error means error when estimating posterior probabilities. - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -double mlpermserror(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::mlpermserror(const_cast(ensemble.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Average error on the test set - -INPUT PARAMETERS: - Ensemble- ensemble - XY - test set - NPoints - test set size - -RESULT: - Its meaning for regression task is obvious. As for classification task -it means average error when estimating posterior probabilities. - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -double mlpeavgerror(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::mlpeavgerror(const_cast(ensemble.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Average relative error on the test set - -INPUT PARAMETERS: - Ensemble- ensemble - XY - test set - NPoints - test set size - -RESULT: - Its meaning for regression task is obvious. As for classification task -it means average relative error when estimating posterior probabilities. - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -double mlpeavgrelerror(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::mlpeavgrelerror(const_cast(ensemble.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Training report: - * RelCLSError - fraction of misclassified cases. - * AvgCE - acerage cross-entropy - * RMSError - root-mean-square error - * AvgError - average error - * AvgRelError - average relative error - * NGrad - number of gradient calculations - * NHess - number of Hessian calculations - * NCholesky - number of Cholesky decompositions - -NOTE 1: RelCLSError/AvgCE are zero on regression problems. - -NOTE 2: on classification problems RMSError/AvgError/AvgRelError contain - errors in prediction of posterior probabilities -*************************************************************************/ -_mlpreport_owner::_mlpreport_owner() -{ - p_struct = (alglib_impl::mlpreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::mlpreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_mlpreport_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_mlpreport_owner::_mlpreport_owner(const _mlpreport_owner &rhs) -{ - p_struct = (alglib_impl::mlpreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::mlpreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_mlpreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_mlpreport_owner& _mlpreport_owner::operator=(const _mlpreport_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_mlpreport_clear(p_struct); - if( !alglib_impl::_mlpreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_mlpreport_owner::~_mlpreport_owner() -{ - alglib_impl::_mlpreport_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::mlpreport* _mlpreport_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::mlpreport* _mlpreport_owner::c_ptr() const -{ - return const_cast(p_struct); -} -mlpreport::mlpreport() : _mlpreport_owner() ,relclserror(p_struct->relclserror),avgce(p_struct->avgce),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror),ngrad(p_struct->ngrad),nhess(p_struct->nhess),ncholesky(p_struct->ncholesky) -{ -} - -mlpreport::mlpreport(const mlpreport &rhs):_mlpreport_owner(rhs) ,relclserror(p_struct->relclserror),avgce(p_struct->avgce),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror),ngrad(p_struct->ngrad),nhess(p_struct->nhess),ncholesky(p_struct->ncholesky) -{ -} - -mlpreport& mlpreport::operator=(const mlpreport &rhs) -{ - if( this==&rhs ) - return *this; - _mlpreport_owner::operator=(rhs); - return *this; -} - -mlpreport::~mlpreport() -{ -} - - -/************************************************************************* -Cross-validation estimates of generalization error -*************************************************************************/ -_mlpcvreport_owner::_mlpcvreport_owner() -{ - p_struct = (alglib_impl::mlpcvreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::mlpcvreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_mlpcvreport_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_mlpcvreport_owner::_mlpcvreport_owner(const _mlpcvreport_owner &rhs) -{ - p_struct = (alglib_impl::mlpcvreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::mlpcvreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_mlpcvreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_mlpcvreport_owner& _mlpcvreport_owner::operator=(const _mlpcvreport_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_mlpcvreport_clear(p_struct); - if( !alglib_impl::_mlpcvreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_mlpcvreport_owner::~_mlpcvreport_owner() -{ - alglib_impl::_mlpcvreport_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::mlpcvreport* _mlpcvreport_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::mlpcvreport* _mlpcvreport_owner::c_ptr() const -{ - return const_cast(p_struct); -} -mlpcvreport::mlpcvreport() : _mlpcvreport_owner() ,relclserror(p_struct->relclserror),avgce(p_struct->avgce),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror) -{ -} - -mlpcvreport::mlpcvreport(const mlpcvreport &rhs):_mlpcvreport_owner(rhs) ,relclserror(p_struct->relclserror),avgce(p_struct->avgce),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror) -{ -} - -mlpcvreport& mlpcvreport::operator=(const mlpcvreport &rhs) -{ - if( this==&rhs ) - return *this; - _mlpcvreport_owner::operator=(rhs); - return *this; -} - -mlpcvreport::~mlpcvreport() -{ -} - - -/************************************************************************* -Trainer object for neural network. - -You should not try to access fields of this object directly - use ALGLIB -functions to work with this object. -*************************************************************************/ -_mlptrainer_owner::_mlptrainer_owner() -{ - p_struct = (alglib_impl::mlptrainer*)alglib_impl::ae_malloc(sizeof(alglib_impl::mlptrainer), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_mlptrainer_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_mlptrainer_owner::_mlptrainer_owner(const _mlptrainer_owner &rhs) -{ - p_struct = (alglib_impl::mlptrainer*)alglib_impl::ae_malloc(sizeof(alglib_impl::mlptrainer), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_mlptrainer_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_mlptrainer_owner& _mlptrainer_owner::operator=(const _mlptrainer_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_mlptrainer_clear(p_struct); - if( !alglib_impl::_mlptrainer_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_mlptrainer_owner::~_mlptrainer_owner() -{ - alglib_impl::_mlptrainer_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::mlptrainer* _mlptrainer_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::mlptrainer* _mlptrainer_owner::c_ptr() const -{ - return const_cast(p_struct); -} -mlptrainer::mlptrainer() : _mlptrainer_owner() -{ -} - -mlptrainer::mlptrainer(const mlptrainer &rhs):_mlptrainer_owner(rhs) -{ -} - -mlptrainer& mlptrainer::operator=(const mlptrainer &rhs) -{ - if( this==&rhs ) - return *this; - _mlptrainer_owner::operator=(rhs); - return *this; -} - -mlptrainer::~mlptrainer() -{ -} - -/************************************************************************* -Neural network training using modified Levenberg-Marquardt with exact -Hessian calculation and regularization. Subroutine trains neural network -with restarts from random positions. Algorithm is well suited for small -and medium scale problems (hundreds of weights). - -INPUT PARAMETERS: - Network - neural network with initialized geometry - XY - training set - NPoints - training set size - Decay - weight decay constant, >=0.001 - Decay term 'Decay*||Weights||^2' is added to error - function. - If you don't know what Decay to choose, use 0.001. - Restarts - number of restarts from random position, >0. - If you don't know what Restarts to choose, use 2. - -OUTPUT PARAMETERS: - Network - trained neural network. - Info - return code: - * -9, if internal matrix inverse subroutine failed - * -2, if there is a point with class number - outside of [0..NOut-1]. - * -1, if wrong parameters specified - (NPoints<0, Restarts<1). - * 2, if task has been solved. - Rep - training report - - -- ALGLIB -- - Copyright 10.03.2009 by Bochkanov Sergey -*************************************************************************/ -void mlptrainlm(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints, const double decay, const ae_int_t restarts, ae_int_t &info, mlpreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlptrainlm(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, decay, restarts, &info, const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Neural network training using L-BFGS algorithm with regularization. -Subroutine trains neural network with restarts from random positions. -Algorithm is well suited for problems of any dimensionality (memory -requirements and step complexity are linear by weights number). - -INPUT PARAMETERS: - Network - neural network with initialized geometry - XY - training set - NPoints - training set size - Decay - weight decay constant, >=0.001 - Decay term 'Decay*||Weights||^2' is added to error - function. - If you don't know what Decay to choose, use 0.001. - Restarts - number of restarts from random position, >0. - If you don't know what Restarts to choose, use 2. - WStep - stopping criterion. Algorithm stops if step size is - less than WStep. Recommended value - 0.01. Zero step - size means stopping after MaxIts iterations. - MaxIts - stopping criterion. Algorithm stops after MaxIts - iterations (NOT gradient calculations). Zero MaxIts - means stopping when step is sufficiently small. - -OUTPUT PARAMETERS: - Network - trained neural network. - Info - return code: - * -8, if both WStep=0 and MaxIts=0 - * -2, if there is a point with class number - outside of [0..NOut-1]. - * -1, if wrong parameters specified - (NPoints<0, Restarts<1). - * 2, if task has been solved. - Rep - training report - - -- ALGLIB -- - Copyright 09.12.2007 by Bochkanov Sergey -*************************************************************************/ -void mlptrainlbfgs(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints, const double decay, const ae_int_t restarts, const double wstep, const ae_int_t maxits, ae_int_t &info, mlpreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlptrainlbfgs(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, decay, restarts, wstep, maxits, &info, const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Neural network training using early stopping (base algorithm - L-BFGS with -regularization). - -INPUT PARAMETERS: - Network - neural network with initialized geometry - TrnXY - training set - TrnSize - training set size, TrnSize>0 - ValXY - validation set - ValSize - validation set size, ValSize>0 - Decay - weight decay constant, >=0.001 - Decay term 'Decay*||Weights||^2' is added to error - function. - If you don't know what Decay to choose, use 0.001. - Restarts - number of restarts, either: - * strictly positive number - algorithm make specified - number of restarts from random position. - * -1, in which case algorithm makes exactly one run - from the initial state of the network (no randomization). - If you don't know what Restarts to choose, choose one - one the following: - * -1 (deterministic start) - * +1 (one random restart) - * +5 (moderate amount of random restarts) - -OUTPUT PARAMETERS: - Network - trained neural network. - Info - return code: - * -2, if there is a point with class number - outside of [0..NOut-1]. - * -1, if wrong parameters specified - (NPoints<0, Restarts<1, ...). - * 2, task has been solved, stopping criterion met - - sufficiently small step size. Not expected (we - use EARLY stopping) but possible and not an - error. - * 6, task has been solved, stopping criterion met - - increasing of validation set error. - Rep - training report - -NOTE: - -Algorithm stops if validation set error increases for a long enough or -step size is small enought (there are task where validation set may -decrease for eternity). In any case solution returned corresponds to the -minimum of validation set error. - - -- ALGLIB -- - Copyright 10.03.2009 by Bochkanov Sergey -*************************************************************************/ -void mlptraines(const multilayerperceptron &network, const real_2d_array &trnxy, const ae_int_t trnsize, const real_2d_array &valxy, const ae_int_t valsize, const double decay, const ae_int_t restarts, ae_int_t &info, mlpreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlptraines(const_cast(network.c_ptr()), const_cast(trnxy.c_ptr()), trnsize, const_cast(valxy.c_ptr()), valsize, decay, restarts, &info, const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Cross-validation estimate of generalization error. - -Base algorithm - L-BFGS. - -INPUT PARAMETERS: - Network - neural network with initialized geometry. Network is - not changed during cross-validation - it is used only - as a representative of its architecture. - XY - training set. - SSize - training set size - Decay - weight decay, same as in MLPTrainLBFGS - Restarts - number of restarts, >0. - restarts are counted for each partition separately, so - total number of restarts will be Restarts*FoldsCount. - WStep - stopping criterion, same as in MLPTrainLBFGS - MaxIts - stopping criterion, same as in MLPTrainLBFGS - FoldsCount - number of folds in k-fold cross-validation, - 2<=FoldsCount<=SSize. - recommended value: 10. - -OUTPUT PARAMETERS: - Info - return code, same as in MLPTrainLBFGS - Rep - report, same as in MLPTrainLM/MLPTrainLBFGS - CVRep - generalization error estimates - - -- ALGLIB -- - Copyright 09.12.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpkfoldcvlbfgs(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints, const double decay, const ae_int_t restarts, const double wstep, const ae_int_t maxits, const ae_int_t foldscount, ae_int_t &info, mlpreport &rep, mlpcvreport &cvrep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpkfoldcvlbfgs(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, decay, restarts, wstep, maxits, foldscount, &info, const_cast(rep.c_ptr()), const_cast(cvrep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Cross-validation estimate of generalization error. - -Base algorithm - Levenberg-Marquardt. - -INPUT PARAMETERS: - Network - neural network with initialized geometry. Network is - not changed during cross-validation - it is used only - as a representative of its architecture. - XY - training set. - SSize - training set size - Decay - weight decay, same as in MLPTrainLBFGS - Restarts - number of restarts, >0. - restarts are counted for each partition separately, so - total number of restarts will be Restarts*FoldsCount. - FoldsCount - number of folds in k-fold cross-validation, - 2<=FoldsCount<=SSize. - recommended value: 10. - -OUTPUT PARAMETERS: - Info - return code, same as in MLPTrainLBFGS - Rep - report, same as in MLPTrainLM/MLPTrainLBFGS - CVRep - generalization error estimates - - -- ALGLIB -- - Copyright 09.12.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpkfoldcvlm(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints, const double decay, const ae_int_t restarts, const ae_int_t foldscount, ae_int_t &info, mlpreport &rep, mlpcvreport &cvrep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpkfoldcvlm(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, decay, restarts, foldscount, &info, const_cast(rep.c_ptr()), const_cast(cvrep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function estimates generalization error using cross-validation on the -current dataset with current training settings. - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support (C++ computational core) - ! - ! Second improvement gives constant speedup (2-3X). First improvement - ! gives close-to-linear speedup on multicore systems. Following - ! operations can be executed in parallel: - ! * FoldsCount cross-validation rounds (always) - ! * NRestarts training sessions performed within each of - ! cross-validation rounds (if NRestarts>1) - ! * gradient calculation over large dataset (if dataset is large enough) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - -INPUT PARAMETERS: - S - trainer object - Network - neural network. It must have same number of inputs and - output/classes as was specified during creation of the - trainer object. Network is not changed during cross- - validation and is not trained - it is used only as - representative of its architecture. I.e., we estimate - generalization properties of ARCHITECTURE, not some - specific network. - NRestarts - number of restarts, >=0: - * NRestarts>0 means that for each cross-validation - round specified number of random restarts is - performed, with best network being chosen after - training. - * NRestarts=0 is same as NRestarts=1 - FoldsCount - number of folds in k-fold cross-validation: - * 2<=FoldsCount<=size of dataset - * recommended value: 10. - * values larger than dataset size will be silently - truncated down to dataset size - -OUTPUT PARAMETERS: - Rep - structure which contains cross-validation estimates: - * Rep.RelCLSError - fraction of misclassified cases. - * Rep.AvgCE - acerage cross-entropy - * Rep.RMSError - root-mean-square error - * Rep.AvgError - average error - * Rep.AvgRelError - average relative error - -NOTE: when no dataset was specified with MLPSetDataset/SetSparseDataset(), - or subset with only one point was given, zeros are returned as - estimates. - -NOTE: this method performs FoldsCount cross-validation rounds, each one - with NRestarts random starts. Thus, FoldsCount*NRestarts networks - are trained in total. - -NOTE: Rep.RelCLSError/Rep.AvgCE are zero on regression problems. - -NOTE: on classification problems Rep.RMSError/Rep.AvgError/Rep.AvgRelError - contain errors in prediction of posterior probabilities. - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpkfoldcv(const mlptrainer &s, const multilayerperceptron &network, const ae_int_t nrestarts, const ae_int_t foldscount, mlpreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpkfoldcv(const_cast(s.c_ptr()), const_cast(network.c_ptr()), nrestarts, foldscount, const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_mlpkfoldcv(const mlptrainer &s, const multilayerperceptron &network, const ae_int_t nrestarts, const ae_int_t foldscount, mlpreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_mlpkfoldcv(const_cast(s.c_ptr()), const_cast(network.c_ptr()), nrestarts, foldscount, const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Creation of the network trainer object for regression networks - -INPUT PARAMETERS: - NIn - number of inputs, NIn>=1 - NOut - number of outputs, NOut>=1 - -OUTPUT PARAMETERS: - S - neural network trainer object. - This structure can be used to train any regression - network with NIn inputs and NOut outputs. - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpcreatetrainer(const ae_int_t nin, const ae_int_t nout, mlptrainer &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpcreatetrainer(nin, nout, const_cast(s.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Creation of the network trainer object for classification networks - -INPUT PARAMETERS: - NIn - number of inputs, NIn>=1 - NClasses - number of classes, NClasses>=2 - -OUTPUT PARAMETERS: - S - neural network trainer object. - This structure can be used to train any classification - network with NIn inputs and NOut outputs. - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpcreatetrainercls(const ae_int_t nin, const ae_int_t nclasses, mlptrainer &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpcreatetrainercls(nin, nclasses, const_cast(s.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets "current dataset" of the trainer object to one passed -by user. - -INPUT PARAMETERS: - S - trainer object - XY - training set, see below for information on the - training set format. This function checks correctness - of the dataset (no NANs/INFs, class numbers are - correct) and throws exception when incorrect dataset - is passed. - NPoints - points count, >=0. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -datasetformat is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpsetdataset(const mlptrainer &s, const real_2d_array &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpsetdataset(const_cast(s.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets "current dataset" of the trainer object to one passed -by user (sparse matrix is used to store dataset). - -INPUT PARAMETERS: - S - trainer object - XY - training set, see below for information on the - training set format. This function checks correctness - of the dataset (no NANs/INFs, class numbers are - correct) and throws exception when incorrect dataset - is passed. Any sparse storage format can be used: - Hash-table, CRS... - NPoints - points count, >=0 - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -datasetformat is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpsetsparsedataset(const mlptrainer &s, const sparsematrix &xy, const ae_int_t npoints) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpsetsparsedataset(const_cast(s.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets weight decay coefficient which is used for training. - -INPUT PARAMETERS: - S - trainer object - Decay - weight decay coefficient, >=0. Weight decay term - 'Decay*||Weights||^2' is added to error function. If - you don't know what Decay to choose, use 1.0E-3. - Weight decay can be set to zero, in this case network - is trained without weight decay. - -NOTE: by default network uses some small nonzero value for weight decay. - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpsetdecay(const mlptrainer &s, const double decay) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpsetdecay(const_cast(s.c_ptr()), decay, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets stopping criteria for the optimizer. - -INPUT PARAMETERS: - S - trainer object - WStep - stopping criterion. Algorithm stops if step size is - less than WStep. Recommended value - 0.01. Zero step - size means stopping after MaxIts iterations. - WStep>=0. - MaxIts - stopping criterion. Algorithm stops after MaxIts - epochs (full passes over entire dataset). Zero MaxIts - means stopping when step is sufficiently small. - MaxIts>=0. - -NOTE: by default, WStep=0.005 and MaxIts=0 are used. These values are also - used when MLPSetCond() is called with WStep=0 and MaxIts=0. - -NOTE: these stopping criteria are used for all kinds of neural training - - from "conventional" networks to early stopping ensembles. When used - for "conventional" networks, they are used as the only stopping - criteria. When combined with early stopping, they used as ADDITIONAL - stopping criteria which can terminate early stopping algorithm. - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpsetcond(const mlptrainer &s, const double wstep, const ae_int_t maxits) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpsetcond(const_cast(s.c_ptr()), wstep, maxits, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets training algorithm: batch training using L-BFGS will be -used. - -This algorithm: -* the most robust for small-scale problems, but may be too slow for large - scale ones. -* perfoms full pass through the dataset before performing step -* uses conditions specified by MLPSetCond() for stopping -* is default one used by trainer object - -INPUT PARAMETERS: - S - trainer object - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpsetalgobatch(const mlptrainer &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpsetalgobatch(const_cast(s.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function trains neural network passed to this function, using current -dataset (one which was passed to MLPSetDataset() or MLPSetSparseDataset()) -and current training settings. Training from NRestarts random starting -positions is performed, best network is chosen. - -Training is performed using current training algorithm. - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support (C++ computational core) - ! - ! Second improvement gives constant speedup (2-3X). First improvement - ! gives close-to-linear speedup on multicore systems. Following - ! operations can be executed in parallel: - ! * NRestarts training sessions performed within each of - ! cross-validation rounds (if NRestarts>1) - ! * gradient calculation over large dataset (if dataset is large enough) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - -INPUT PARAMETERS: - S - trainer object - Network - neural network. It must have same number of inputs and - output/classes as was specified during creation of the - trainer object. - NRestarts - number of restarts, >=0: - * NRestarts>0 means that specified number of random - restarts are performed, best network is chosen after - training - * NRestarts=0 means that current state of the network - is used for training. - -OUTPUT PARAMETERS: - Network - trained network - -NOTE: when no dataset was specified with MLPSetDataset/SetSparseDataset(), - network is filled by zero values. Same behavior for functions - MLPStartTraining and MLPContinueTraining. - -NOTE: this method uses sum-of-squares error function for training. - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlptrainnetwork(const mlptrainer &s, const multilayerperceptron &network, const ae_int_t nrestarts, mlpreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlptrainnetwork(const_cast(s.c_ptr()), const_cast(network.c_ptr()), nrestarts, const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_mlptrainnetwork(const mlptrainer &s, const multilayerperceptron &network, const ae_int_t nrestarts, mlpreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_mlptrainnetwork(const_cast(s.c_ptr()), const_cast(network.c_ptr()), nrestarts, const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -IMPORTANT: this is an "expert" version of the MLPTrain() function. We do - not recommend you to use it unless you are pretty sure that you - need ability to monitor training progress. - -This function performs step-by-step training of the neural network. Here -"step-by-step" means that training starts with MLPStartTraining() call, -and then user subsequently calls MLPContinueTraining() to perform one more -iteration of the training. - -After call to this function trainer object remembers network and is ready -to train it. However, no training is performed until first call to -MLPContinueTraining() function. Subsequent calls to MLPContinueTraining() -will advance training progress one iteration further. - -EXAMPLE: - > - > ...initialize network and trainer object.... - > - > MLPStartTraining(Trainer, Network, True) - > while MLPContinueTraining(Trainer, Network) do - > ...visualize training progress... - > - -INPUT PARAMETERS: - S - trainer object - Network - neural network. It must have same number of inputs and - output/classes as was specified during creation of the - trainer object. - RandomStart - randomize network before training or not: - * True means that network is randomized and its - initial state (one which was passed to the trainer - object) is lost. - * False means that training is started from the - current state of the network - -OUTPUT PARAMETERS: - Network - neural network which is ready to training (weights are - initialized, preprocessor is initialized using current - training set) - -NOTE: this method uses sum-of-squares error function for training. - -NOTE: it is expected that trainer object settings are NOT changed during - step-by-step training, i.e. no one changes stopping criteria or - training set during training. It is possible and there is no defense - against such actions, but algorithm behavior in such cases is - undefined and can be unpredictable. - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpstarttraining(const mlptrainer &s, const multilayerperceptron &network, const bool randomstart) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpstarttraining(const_cast(s.c_ptr()), const_cast(network.c_ptr()), randomstart, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -IMPORTANT: this is an "expert" version of the MLPTrain() function. We do - not recommend you to use it unless you are pretty sure that you - need ability to monitor training progress. - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support (C++ computational core) - ! - ! Second improvement gives constant speedup (2-3X). First improvement - ! gives close-to-linear speedup on multicore systems. Following - ! operations can be executed in parallel: - ! * gradient calculation over large dataset (if dataset is large enough) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - -This function performs step-by-step training of the neural network. Here -"step-by-step" means that training starts with MLPStartTraining() call, -and then user subsequently calls MLPContinueTraining() to perform one more -iteration of the training. - -This function performs one more iteration of the training and returns -either True (training continues) or False (training stopped). In case True -was returned, Network weights are updated according to the current state -of the optimization progress. In case False was returned, no additional -updates is performed (previous update of the network weights moved us to -the final point, and no additional updates is needed). - -EXAMPLE: - > - > [initialize network and trainer object] - > - > MLPStartTraining(Trainer, Network, True) - > while MLPContinueTraining(Trainer, Network) do - > [visualize training progress] - > - -INPUT PARAMETERS: - S - trainer object - Network - neural network structure, which is used to store - current state of the training process. - -OUTPUT PARAMETERS: - Network - weights of the neural network are rewritten by the - current approximation. - -NOTE: this method uses sum-of-squares error function for training. - -NOTE: it is expected that trainer object settings are NOT changed during - step-by-step training, i.e. no one changes stopping criteria or - training set during training. It is possible and there is no defense - against such actions, but algorithm behavior in such cases is - undefined and can be unpredictable. - -NOTE: It is expected that Network is the same one which was passed to - MLPStartTraining() function. However, THIS function checks only - following: - * that number of network inputs is consistent with trainer object - settings - * that number of network outputs/classes is consistent with trainer - object settings - * that number of network weights is the same as number of weights in - the network passed to MLPStartTraining() function - Exception is thrown when these conditions are violated. - - It is also expected that you do not change state of the network on - your own - the only party who has right to change network during its - training is a trainer object. Any attempt to interfere with trainer - may lead to unpredictable results. - - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -bool mlpcontinuetraining(const mlptrainer &s, const multilayerperceptron &network) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::mlpcontinuetraining(const_cast(s.c_ptr()), const_cast(network.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -bool smp_mlpcontinuetraining(const mlptrainer &s, const multilayerperceptron &network) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::_pexec_mlpcontinuetraining(const_cast(s.c_ptr()), const_cast(network.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Training neural networks ensemble using bootstrap aggregating (bagging). -Modified Levenberg-Marquardt algorithm is used as base training method. - -INPUT PARAMETERS: - Ensemble - model with initialized geometry - XY - training set - NPoints - training set size - Decay - weight decay coefficient, >=0.001 - Restarts - restarts, >0. - -OUTPUT PARAMETERS: - Ensemble - trained model - Info - return code: - * -2, if there is a point with class number - outside of [0..NClasses-1]. - * -1, if incorrect parameters was passed - (NPoints<0, Restarts<1). - * 2, if task has been solved. - Rep - training report. - OOBErrors - out-of-bag generalization error estimate - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpebagginglm(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints, const double decay, const ae_int_t restarts, ae_int_t &info, mlpreport &rep, mlpcvreport &ooberrors) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpebagginglm(const_cast(ensemble.c_ptr()), const_cast(xy.c_ptr()), npoints, decay, restarts, &info, const_cast(rep.c_ptr()), const_cast(ooberrors.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Training neural networks ensemble using bootstrap aggregating (bagging). -L-BFGS algorithm is used as base training method. - -INPUT PARAMETERS: - Ensemble - model with initialized geometry - XY - training set - NPoints - training set size - Decay - weight decay coefficient, >=0.001 - Restarts - restarts, >0. - WStep - stopping criterion, same as in MLPTrainLBFGS - MaxIts - stopping criterion, same as in MLPTrainLBFGS - -OUTPUT PARAMETERS: - Ensemble - trained model - Info - return code: - * -8, if both WStep=0 and MaxIts=0 - * -2, if there is a point with class number - outside of [0..NClasses-1]. - * -1, if incorrect parameters was passed - (NPoints<0, Restarts<1). - * 2, if task has been solved. - Rep - training report. - OOBErrors - out-of-bag generalization error estimate - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpebagginglbfgs(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints, const double decay, const ae_int_t restarts, const double wstep, const ae_int_t maxits, ae_int_t &info, mlpreport &rep, mlpcvreport &ooberrors) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpebagginglbfgs(const_cast(ensemble.c_ptr()), const_cast(xy.c_ptr()), npoints, decay, restarts, wstep, maxits, &info, const_cast(rep.c_ptr()), const_cast(ooberrors.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Training neural networks ensemble using early stopping. - -INPUT PARAMETERS: - Ensemble - model with initialized geometry - XY - training set - NPoints - training set size - Decay - weight decay coefficient, >=0.001 - Restarts - restarts, >0. - -OUTPUT PARAMETERS: - Ensemble - trained model - Info - return code: - * -2, if there is a point with class number - outside of [0..NClasses-1]. - * -1, if incorrect parameters was passed - (NPoints<0, Restarts<1). - * 6, if task has been solved. - Rep - training report. - OOBErrors - out-of-bag generalization error estimate - - -- ALGLIB -- - Copyright 10.03.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpetraines(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints, const double decay, const ae_int_t restarts, ae_int_t &info, mlpreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlpetraines(const_cast(ensemble.c_ptr()), const_cast(xy.c_ptr()), npoints, decay, restarts, &info, const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function trains neural network ensemble passed to this function using -current dataset and early stopping training algorithm. Each early stopping -round performs NRestarts random restarts (thus, EnsembleSize*NRestarts -training rounds is performed in total). - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support (C++ computational core) - ! - ! Second improvement gives constant speedup (2-3X). First improvement - ! gives close-to-linear speedup on multicore systems. Following - ! operations can be executed in parallel: - ! * EnsembleSize training sessions performed for each of ensemble - ! members (always parallelized) - ! * NRestarts training sessions performed within each of training - ! sessions (if NRestarts>1) - ! * gradient calculation over large dataset (if dataset is large enough) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - -INPUT PARAMETERS: - S - trainer object; - Ensemble - neural network ensemble. It must have same number of - inputs and outputs/classes as was specified during - creation of the trainer object. - NRestarts - number of restarts, >=0: - * NRestarts>0 means that specified number of random - restarts are performed during each ES round; - * NRestarts=0 is silently replaced by 1. - -OUTPUT PARAMETERS: - Ensemble - trained ensemble; - Rep - it contains all type of errors. - -NOTE: this training method uses BOTH early stopping and weight decay! So, - you should select weight decay before starting training just as you - select it before training "conventional" networks. - -NOTE: when no dataset was specified with MLPSetDataset/SetSparseDataset(), - or single-point dataset was passed, ensemble is filled by zero - values. - -NOTE: this method uses sum-of-squares error function for training. - - -- ALGLIB -- - Copyright 22.08.2012 by Bochkanov Sergey -*************************************************************************/ -void mlptrainensemblees(const mlptrainer &s, const mlpensemble &ensemble, const ae_int_t nrestarts, mlpreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mlptrainensemblees(const_cast(s.c_ptr()), const_cast(ensemble.c_ptr()), nrestarts, const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_mlptrainensemblees(const mlptrainer &s, const mlpensemble &ensemble, const ae_int_t nrestarts, mlpreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_mlptrainensemblees(const_cast(s.c_ptr()), const_cast(ensemble.c_ptr()), nrestarts, const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Principal components analysis - -Subroutine builds orthogonal basis where first axis corresponds to -direction with maximum variance, second axis maximizes variance in subspace -orthogonal to first axis and so on. - -It should be noted that, unlike LDA, PCA does not use class labels. - -INPUT PARAMETERS: - X - dataset, array[0..NPoints-1,0..NVars-1]. - matrix contains ONLY INDEPENDENT VARIABLES. - NPoints - dataset size, NPoints>=0 - NVars - number of independent variables, NVars>=1 - -ÂÛÕÎÄÍÛÅ ÏÀÐÀÌÅÒÐÛ: - Info - return code: - * -4, if SVD subroutine haven't converged - * -1, if wrong parameters has been passed (NPoints<0, - NVars<1) - * 1, if task is solved - S2 - array[0..NVars-1]. variance values corresponding - to basis vectors. - V - array[0..NVars-1,0..NVars-1] - matrix, whose columns store basis vectors. - - -- ALGLIB -- - Copyright 25.08.2008 by Bochkanov Sergey -*************************************************************************/ -void pcabuildbasis(const real_2d_array &x, const ae_int_t npoints, const ae_int_t nvars, ae_int_t &info, real_1d_array &s2, real_2d_array &v) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::pcabuildbasis(const_cast(x.c_ptr()), npoints, nvars, &info, const_cast(s2.c_ptr()), const_cast(v.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS IMPLEMENTATION OF COMPUTATIONAL CORE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ -static double bdss_xlny(double x, double y, ae_state *_state); -static double bdss_getcv(/* Integer */ ae_vector* cnt, - ae_int_t nc, - ae_state *_state); -static void bdss_tieaddc(/* Integer */ ae_vector* c, - /* Integer */ ae_vector* ties, - ae_int_t ntie, - ae_int_t nc, - /* Integer */ ae_vector* cnt, - ae_state *_state); -static void bdss_tiesubc(/* Integer */ ae_vector* c, - /* Integer */ ae_vector* ties, - ae_int_t ntie, - ae_int_t nc, - /* Integer */ ae_vector* cnt, - ae_state *_state); - - -static ae_int_t clustering_parallelcomplexity = 200000; -static ae_bool clustering_selectcenterpp(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nvars, - /* Real */ ae_matrix* centers, - /* Boolean */ ae_vector* busycenters, - ae_int_t ccnt, - /* Real */ ae_vector* d2, - /* Real */ ae_vector* p, - /* Real */ ae_vector* tmp, - ae_state *_state); -static void clustering_clusterizerrunahcinternal(clusterizerstate* s, - /* Real */ ae_matrix* d, - ahcreport* rep, - ae_state *_state); -static void clustering_evaluatedistancematrixrec(/* Real */ ae_matrix* xy, - ae_int_t nfeatures, - ae_int_t disttype, - /* Real */ ae_matrix* d, - ae_int_t i0, - ae_int_t i1, - ae_int_t j0, - ae_int_t j1, - ae_state *_state); - - - - -static ae_int_t dforest_innernodewidth = 3; -static ae_int_t dforest_leafnodewidth = 2; -static ae_int_t dforest_dfusestrongsplits = 1; -static ae_int_t dforest_dfuseevs = 2; -static ae_int_t dforest_dffirstversion = 0; -static ae_int_t dforest_dfclserror(decisionforest* df, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state); -static void dforest_dfprocessinternal(decisionforest* df, - ae_int_t offs, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state); -static void dforest_dfbuildtree(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t nclasses, - ae_int_t nfeatures, - ae_int_t nvarsinpool, - ae_int_t flags, - dfinternalbuffers* bufs, - hqrndstate* rs, - ae_state *_state); -static void dforest_dfbuildtreerec(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t nclasses, - ae_int_t nfeatures, - ae_int_t nvarsinpool, - ae_int_t flags, - ae_int_t* numprocessed, - ae_int_t idx1, - ae_int_t idx2, - dfinternalbuffers* bufs, - hqrndstate* rs, - ae_state *_state); -static void dforest_dfsplitc(/* Real */ ae_vector* x, - /* Integer */ ae_vector* c, - /* Integer */ ae_vector* cntbuf, - ae_int_t n, - ae_int_t nc, - ae_int_t flags, - ae_int_t* info, - double* threshold, - double* e, - /* Real */ ae_vector* sortrbuf, - /* Integer */ ae_vector* sortibuf, - ae_state *_state); -static void dforest_dfsplitr(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_int_t flags, - ae_int_t* info, - double* threshold, - double* e, - /* Real */ ae_vector* sortrbuf, - /* Real */ ae_vector* sortrbuf2, - ae_state *_state); - - -static ae_int_t linreg_lrvnum = 5; -static void linreg_lrinternal(/* Real */ ae_matrix* xy, - /* Real */ ae_vector* s, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t* info, - linearmodel* lm, - lrreport* ar, - ae_state *_state); - - - - - - -static ae_int_t mlpbase_mlpvnum = 7; -static ae_int_t mlpbase_mlpfirstversion = 0; -static ae_int_t mlpbase_nfieldwidth = 4; -static ae_int_t mlpbase_hlconnfieldwidth = 5; -static ae_int_t mlpbase_hlnfieldwidth = 4; -static ae_int_t mlpbase_gradbasecasecost = 50000; -static ae_int_t mlpbase_microbatchsize = 64; -static void mlpbase_addinputlayer(ae_int_t ncount, - /* Integer */ ae_vector* lsizes, - /* Integer */ ae_vector* ltypes, - /* Integer */ ae_vector* lconnfirst, - /* Integer */ ae_vector* lconnlast, - ae_int_t* lastproc, - ae_state *_state); -static void mlpbase_addbiasedsummatorlayer(ae_int_t ncount, - /* Integer */ ae_vector* lsizes, - /* Integer */ ae_vector* ltypes, - /* Integer */ ae_vector* lconnfirst, - /* Integer */ ae_vector* lconnlast, - ae_int_t* lastproc, - ae_state *_state); -static void mlpbase_addactivationlayer(ae_int_t functype, - /* Integer */ ae_vector* lsizes, - /* Integer */ ae_vector* ltypes, - /* Integer */ ae_vector* lconnfirst, - /* Integer */ ae_vector* lconnlast, - ae_int_t* lastproc, - ae_state *_state); -static void mlpbase_addzerolayer(/* Integer */ ae_vector* lsizes, - /* Integer */ ae_vector* ltypes, - /* Integer */ ae_vector* lconnfirst, - /* Integer */ ae_vector* lconnlast, - ae_int_t* lastproc, - ae_state *_state); -static void mlpbase_hladdinputlayer(multilayerperceptron* network, - ae_int_t* connidx, - ae_int_t* neuroidx, - ae_int_t* structinfoidx, - ae_int_t nin, - ae_state *_state); -static void mlpbase_hladdoutputlayer(multilayerperceptron* network, - ae_int_t* connidx, - ae_int_t* neuroidx, - ae_int_t* structinfoidx, - ae_int_t* weightsidx, - ae_int_t k, - ae_int_t nprev, - ae_int_t nout, - ae_bool iscls, - ae_bool islinearout, - ae_state *_state); -static void mlpbase_hladdhiddenlayer(multilayerperceptron* network, - ae_int_t* connidx, - ae_int_t* neuroidx, - ae_int_t* structinfoidx, - ae_int_t* weightsidx, - ae_int_t k, - ae_int_t nprev, - ae_int_t ncur, - ae_state *_state); -static void mlpbase_fillhighlevelinformation(multilayerperceptron* network, - ae_int_t nin, - ae_int_t nhid1, - ae_int_t nhid2, - ae_int_t nout, - ae_bool iscls, - ae_bool islinearout, - ae_state *_state); -static void mlpbase_mlpcreate(ae_int_t nin, - ae_int_t nout, - /* Integer */ ae_vector* lsizes, - /* Integer */ ae_vector* ltypes, - /* Integer */ ae_vector* lconnfirst, - /* Integer */ ae_vector* lconnlast, - ae_int_t layerscount, - ae_bool isclsnet, - multilayerperceptron* network, - ae_state *_state); -static void mlpbase_mlphessianbatchinternal(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t ssize, - ae_bool naturalerr, - double* e, - /* Real */ ae_vector* grad, - /* Real */ ae_matrix* h, - ae_state *_state); -static void mlpbase_mlpinternalcalculategradient(multilayerperceptron* network, - /* Real */ ae_vector* neurons, - /* Real */ ae_vector* weights, - /* Real */ ae_vector* derror, - /* Real */ ae_vector* grad, - ae_bool naturalerrorfunc, - ae_state *_state); -static void mlpbase_mlpchunkedgradient(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t cstart, - ae_int_t csize, - /* Real */ ae_vector* batch4buf, - /* Real */ ae_vector* hpcbuf, - double* e, - ae_bool naturalerrorfunc, - ae_state *_state); -static void mlpbase_mlpchunkedprocess(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t cstart, - ae_int_t csize, - /* Real */ ae_vector* batch4buf, - /* Real */ ae_vector* hpcbuf, - ae_state *_state); -static double mlpbase_safecrossentropy(double t, - double z, - ae_state *_state); -static void mlpbase_randomizebackwardpass(multilayerperceptron* network, - ae_int_t neuronidx, - double v, - ae_state *_state); - - -static double logit_xtol = 100*ae_machineepsilon; -static double logit_ftol = 0.0001; -static double logit_gtol = 0.3; -static ae_int_t logit_maxfev = 20; -static double logit_stpmin = 1.0E-2; -static double logit_stpmax = 1.0E5; -static ae_int_t logit_logitvnum = 6; -static void logit_mnliexp(/* Real */ ae_vector* w, - /* Real */ ae_vector* x, - ae_state *_state); -static void logit_mnlallerrors(logitmodel* lm, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - double* relcls, - double* avgce, - double* rms, - double* avg, - double* avgrel, - ae_state *_state); -static void logit_mnlmcsrch(ae_int_t n, - /* Real */ ae_vector* x, - double* f, - /* Real */ ae_vector* g, - /* Real */ ae_vector* s, - double* stp, - ae_int_t* info, - ae_int_t* nfev, - /* Real */ ae_vector* wa, - logitmcstate* state, - ae_int_t* stage, - ae_state *_state); -static void logit_mnlmcstep(double* stx, - double* fx, - double* dx, - double* sty, - double* fy, - double* dy, - double* stp, - double fp, - double dp, - ae_bool* brackt, - double stmin, - double stmax, - ae_int_t* info, - ae_state *_state); - - -static double mcpd_xtol = 1.0E-8; -static void mcpd_mcpdinit(ae_int_t n, - ae_int_t entrystate, - ae_int_t exitstate, - mcpdstate* s, - ae_state *_state); - - -static ae_int_t mlpe_mlpefirstversion = 1; - - -static double mlptrain_mindecay = 0.001; -static ae_int_t mlptrain_defaultlbfgsfactor = 6; -static void mlptrain_mlpkfoldcvgeneral(multilayerperceptron* n, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - double decay, - ae_int_t restarts, - ae_int_t foldscount, - ae_bool lmalgorithm, - double wstep, - ae_int_t maxits, - ae_int_t* info, - mlpreport* rep, - mlpcvreport* cvrep, - ae_state *_state); -static void mlptrain_mlpkfoldsplit(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nclasses, - ae_int_t foldscount, - ae_bool stratifiedsplits, - /* Integer */ ae_vector* folds, - ae_state *_state); -static void mlptrain_mthreadcv(mlptrainer* s, - ae_int_t rowsize, - ae_int_t nrestarts, - /* Integer */ ae_vector* folds, - ae_int_t fold, - ae_int_t dfold, - /* Real */ ae_matrix* cvy, - ae_shared_pool* pooldatacv, - ae_state *_state); -static void mlptrain_mlptrainnetworkx(mlptrainer* s, - ae_int_t nrestarts, - ae_int_t algokind, - /* Integer */ ae_vector* trnsubset, - ae_int_t trnsubsetsize, - /* Integer */ ae_vector* valsubset, - ae_int_t valsubsetsize, - multilayerperceptron* network, - mlpreport* rep, - ae_bool isrootcall, - ae_shared_pool* sessions, - ae_state *_state); -static void mlptrain_mlptrainensemblex(mlptrainer* s, - mlpensemble* ensemble, - ae_int_t idx0, - ae_int_t idx1, - ae_int_t nrestarts, - ae_int_t trainingmethod, - sinteger* ngrad, - ae_bool isrootcall, - ae_shared_pool* esessions, - ae_state *_state); -static void mlptrain_mlpstarttrainingx(mlptrainer* s, - ae_bool randomstart, - ae_int_t algokind, - /* Integer */ ae_vector* subset, - ae_int_t subsetsize, - smlptrnsession* session, - ae_state *_state); -static ae_bool mlptrain_mlpcontinuetrainingx(mlptrainer* s, - /* Integer */ ae_vector* subset, - ae_int_t subsetsize, - ae_int_t* ngradbatch, - smlptrnsession* session, - ae_state *_state); -static void mlptrain_mlpebagginginternal(mlpensemble* ensemble, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - double decay, - ae_int_t restarts, - double wstep, - ae_int_t maxits, - ae_bool lmalgorithm, - ae_int_t* info, - mlpreport* rep, - mlpcvreport* ooberrors, - ae_state *_state); -static void mlptrain_initmlptrnsession(multilayerperceptron* networktrained, - ae_bool randomizenetwork, - mlptrainer* trainer, - smlptrnsession* session, - ae_state *_state); -static void mlptrain_initmlptrnsessions(multilayerperceptron* networktrained, - ae_bool randomizenetwork, - mlptrainer* trainer, - ae_shared_pool* sessions, - ae_state *_state); -static void mlptrain_initmlpetrnsession(multilayerperceptron* individualnetwork, - mlptrainer* trainer, - mlpetrnsession* session, - ae_state *_state); -static void mlptrain_initmlpetrnsessions(multilayerperceptron* individualnetwork, - mlptrainer* trainer, - ae_shared_pool* sessions, - ae_state *_state); - - - - - - - -/************************************************************************* -This set of routines (DSErrAllocate, DSErrAccumulate, DSErrFinish) -calculates different error functions (classification error, cross-entropy, -rms, avg, avg.rel errors). - -1. DSErrAllocate prepares buffer. -2. DSErrAccumulate accumulates individual errors: - * Y contains predicted output (posterior probabilities for classification) - * DesiredY contains desired output (class number for classification) -3. DSErrFinish outputs results: - * Buf[0] contains relative classification error (zero for regression tasks) - * Buf[1] contains avg. cross-entropy (zero for regression tasks) - * Buf[2] contains rms error (regression, classification) - * Buf[3] contains average error (regression, classification) - * Buf[4] contains average relative error (regression, classification) - -NOTES(1): - "NClasses>0" means that we have classification task. - "NClasses<0" means regression task with -NClasses real outputs. - -NOTES(2): - rms. avg, avg.rel errors for classification tasks are interpreted as - errors in posterior probabilities with respect to probabilities given - by training/test set. - - -- ALGLIB -- - Copyright 11.01.2009 by Bochkanov Sergey -*************************************************************************/ -void dserrallocate(ae_int_t nclasses, - /* Real */ ae_vector* buf, - ae_state *_state) -{ - - ae_vector_clear(buf); - - ae_vector_set_length(buf, 7+1, _state); - buf->ptr.p_double[0] = 0; - buf->ptr.p_double[1] = 0; - buf->ptr.p_double[2] = 0; - buf->ptr.p_double[3] = 0; - buf->ptr.p_double[4] = 0; - buf->ptr.p_double[5] = nclasses; - buf->ptr.p_double[6] = 0; - buf->ptr.p_double[7] = 0; -} - - -/************************************************************************* -See DSErrAllocate for comments on this routine. - - -- ALGLIB -- - Copyright 11.01.2009 by Bochkanov Sergey -*************************************************************************/ -void dserraccumulate(/* Real */ ae_vector* buf, - /* Real */ ae_vector* y, - /* Real */ ae_vector* desiredy, - ae_state *_state) -{ - ae_int_t nclasses; - ae_int_t nout; - ae_int_t offs; - ae_int_t mmax; - ae_int_t rmax; - ae_int_t j; - double v; - double ev; - - - offs = 5; - nclasses = ae_round(buf->ptr.p_double[offs], _state); - if( nclasses>0 ) - { - - /* - * Classification - */ - rmax = ae_round(desiredy->ptr.p_double[0], _state); - mmax = 0; - for(j=1; j<=nclasses-1; j++) - { - if( ae_fp_greater(y->ptr.p_double[j],y->ptr.p_double[mmax]) ) - { - mmax = j; - } - } - if( mmax!=rmax ) - { - buf->ptr.p_double[0] = buf->ptr.p_double[0]+1; - } - if( ae_fp_greater(y->ptr.p_double[rmax],0) ) - { - buf->ptr.p_double[1] = buf->ptr.p_double[1]-ae_log(y->ptr.p_double[rmax], _state); - } - else - { - buf->ptr.p_double[1] = buf->ptr.p_double[1]+ae_log(ae_maxrealnumber, _state); - } - for(j=0; j<=nclasses-1; j++) - { - v = y->ptr.p_double[j]; - if( j==rmax ) - { - ev = 1; - } - else - { - ev = 0; - } - buf->ptr.p_double[2] = buf->ptr.p_double[2]+ae_sqr(v-ev, _state); - buf->ptr.p_double[3] = buf->ptr.p_double[3]+ae_fabs(v-ev, _state); - if( ae_fp_neq(ev,0) ) - { - buf->ptr.p_double[4] = buf->ptr.p_double[4]+ae_fabs((v-ev)/ev, _state); - buf->ptr.p_double[offs+2] = buf->ptr.p_double[offs+2]+1; - } - } - buf->ptr.p_double[offs+1] = buf->ptr.p_double[offs+1]+1; - } - else - { - - /* - * Regression - */ - nout = -nclasses; - rmax = 0; - for(j=1; j<=nout-1; j++) - { - if( ae_fp_greater(desiredy->ptr.p_double[j],desiredy->ptr.p_double[rmax]) ) - { - rmax = j; - } - } - mmax = 0; - for(j=1; j<=nout-1; j++) - { - if( ae_fp_greater(y->ptr.p_double[j],y->ptr.p_double[mmax]) ) - { - mmax = j; - } - } - if( mmax!=rmax ) - { - buf->ptr.p_double[0] = buf->ptr.p_double[0]+1; - } - for(j=0; j<=nout-1; j++) - { - v = y->ptr.p_double[j]; - ev = desiredy->ptr.p_double[j]; - buf->ptr.p_double[2] = buf->ptr.p_double[2]+ae_sqr(v-ev, _state); - buf->ptr.p_double[3] = buf->ptr.p_double[3]+ae_fabs(v-ev, _state); - if( ae_fp_neq(ev,0) ) - { - buf->ptr.p_double[4] = buf->ptr.p_double[4]+ae_fabs((v-ev)/ev, _state); - buf->ptr.p_double[offs+2] = buf->ptr.p_double[offs+2]+1; - } - } - buf->ptr.p_double[offs+1] = buf->ptr.p_double[offs+1]+1; - } -} - - -/************************************************************************* -See DSErrAllocate for comments on this routine. - - -- ALGLIB -- - Copyright 11.01.2009 by Bochkanov Sergey -*************************************************************************/ -void dserrfinish(/* Real */ ae_vector* buf, ae_state *_state) -{ - ae_int_t nout; - ae_int_t offs; - - - offs = 5; - nout = ae_iabs(ae_round(buf->ptr.p_double[offs], _state), _state); - if( ae_fp_neq(buf->ptr.p_double[offs+1],0) ) - { - buf->ptr.p_double[0] = buf->ptr.p_double[0]/buf->ptr.p_double[offs+1]; - buf->ptr.p_double[1] = buf->ptr.p_double[1]/buf->ptr.p_double[offs+1]; - buf->ptr.p_double[2] = ae_sqrt(buf->ptr.p_double[2]/(nout*buf->ptr.p_double[offs+1]), _state); - buf->ptr.p_double[3] = buf->ptr.p_double[3]/(nout*buf->ptr.p_double[offs+1]); - } - if( ae_fp_neq(buf->ptr.p_double[offs+2],0) ) - { - buf->ptr.p_double[4] = buf->ptr.p_double[4]/buf->ptr.p_double[offs+2]; - } -} - - -/************************************************************************* - - -- ALGLIB -- - Copyright 19.05.2008 by Bochkanov Sergey -*************************************************************************/ -void dsnormalize(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t* info, - /* Real */ ae_vector* means, - /* Real */ ae_vector* sigmas, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - ae_vector tmp; - double mean; - double variance; - double skewness; - double kurtosis; - - ae_frame_make(_state, &_frame_block); - *info = 0; - ae_vector_clear(means); - ae_vector_clear(sigmas); - ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); - - - /* - * Test parameters - */ - if( npoints<=0||nvars<1 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - *info = 1; - - /* - * Standartization - */ - ae_vector_set_length(means, nvars-1+1, _state); - ae_vector_set_length(sigmas, nvars-1+1, _state); - ae_vector_set_length(&tmp, npoints-1+1, _state); - for(j=0; j<=nvars-1; j++) - { - ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][j], xy->stride, ae_v_len(0,npoints-1)); - samplemoments(&tmp, npoints, &mean, &variance, &skewness, &kurtosis, _state); - means->ptr.p_double[j] = mean; - sigmas->ptr.p_double[j] = ae_sqrt(variance, _state); - if( ae_fp_eq(sigmas->ptr.p_double[j],0) ) - { - sigmas->ptr.p_double[j] = 1; - } - for(i=0; i<=npoints-1; i++) - { - xy->ptr.pp_double[i][j] = (xy->ptr.pp_double[i][j]-means->ptr.p_double[j])/sigmas->ptr.p_double[j]; - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* - - -- ALGLIB -- - Copyright 19.05.2008 by Bochkanov Sergey -*************************************************************************/ -void dsnormalizec(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t* info, - /* Real */ ae_vector* means, - /* Real */ ae_vector* sigmas, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t j; - ae_vector tmp; - double mean; - double variance; - double skewness; - double kurtosis; - - ae_frame_make(_state, &_frame_block); - *info = 0; - ae_vector_clear(means); - ae_vector_clear(sigmas); - ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); - - - /* - * Test parameters - */ - if( npoints<=0||nvars<1 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - *info = 1; - - /* - * Standartization - */ - ae_vector_set_length(means, nvars-1+1, _state); - ae_vector_set_length(sigmas, nvars-1+1, _state); - ae_vector_set_length(&tmp, npoints-1+1, _state); - for(j=0; j<=nvars-1; j++) - { - ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][j], xy->stride, ae_v_len(0,npoints-1)); - samplemoments(&tmp, npoints, &mean, &variance, &skewness, &kurtosis, _state); - means->ptr.p_double[j] = mean; - sigmas->ptr.p_double[j] = ae_sqrt(variance, _state); - if( ae_fp_eq(sigmas->ptr.p_double[j],0) ) - { - sigmas->ptr.p_double[j] = 1; - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* - - -- ALGLIB -- - Copyright 19.05.2008 by Bochkanov Sergey -*************************************************************************/ -double dsgetmeanmindistance(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nvars, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - ae_vector tmp; - ae_vector tmp2; - double v; - double result; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tmp2, 0, DT_REAL, _state, ae_true); - - - /* - * Test parameters - */ - if( npoints<=0||nvars<1 ) - { - result = 0; - ae_frame_leave(_state); - return result; - } - - /* - * Process - */ - ae_vector_set_length(&tmp, npoints-1+1, _state); - for(i=0; i<=npoints-1; i++) - { - tmp.ptr.p_double[i] = ae_maxrealnumber; - } - ae_vector_set_length(&tmp2, nvars-1+1, _state); - for(i=0; i<=npoints-1; i++) - { - for(j=i+1; j<=npoints-1; j++) - { - ae_v_move(&tmp2.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); - ae_v_sub(&tmp2.ptr.p_double[0], 1, &xy->ptr.pp_double[j][0], 1, ae_v_len(0,nvars-1)); - v = ae_v_dotproduct(&tmp2.ptr.p_double[0], 1, &tmp2.ptr.p_double[0], 1, ae_v_len(0,nvars-1)); - v = ae_sqrt(v, _state); - tmp.ptr.p_double[i] = ae_minreal(tmp.ptr.p_double[i], v, _state); - tmp.ptr.p_double[j] = ae_minreal(tmp.ptr.p_double[j], v, _state); - } - } - result = 0; - for(i=0; i<=npoints-1; i++) - { - result = result+tmp.ptr.p_double[i]/npoints; - } - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* - - -- ALGLIB -- - Copyright 19.05.2008 by Bochkanov Sergey -*************************************************************************/ -void dstie(/* Real */ ae_vector* a, - ae_int_t n, - /* Integer */ ae_vector* ties, - ae_int_t* tiecount, - /* Integer */ ae_vector* p1, - /* Integer */ ae_vector* p2, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t k; - ae_vector tmp; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(ties); - *tiecount = 0; - ae_vector_clear(p1); - ae_vector_clear(p2); - ae_vector_init(&tmp, 0, DT_INT, _state, ae_true); - - - /* - * Special case - */ - if( n<=0 ) - { - *tiecount = 0; - ae_frame_leave(_state); - return; - } - - /* - * Sort A - */ - tagsort(a, n, p1, p2, _state); - - /* - * Process ties - */ - *tiecount = 1; - for(i=1; i<=n-1; i++) - { - if( ae_fp_neq(a->ptr.p_double[i],a->ptr.p_double[i-1]) ) - { - *tiecount = *tiecount+1; - } - } - ae_vector_set_length(ties, *tiecount+1, _state); - ties->ptr.p_int[0] = 0; - k = 1; - for(i=1; i<=n-1; i++) - { - if( ae_fp_neq(a->ptr.p_double[i],a->ptr.p_double[i-1]) ) - { - ties->ptr.p_int[k] = i; - k = k+1; - } - } - ties->ptr.p_int[*tiecount] = n; - ae_frame_leave(_state); -} - - -/************************************************************************* - - -- ALGLIB -- - Copyright 11.12.2008 by Bochkanov Sergey -*************************************************************************/ -void dstiefasti(/* Real */ ae_vector* a, - /* Integer */ ae_vector* b, - ae_int_t n, - /* Integer */ ae_vector* ties, - ae_int_t* tiecount, - /* Real */ ae_vector* bufr, - /* Integer */ ae_vector* bufi, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t k; - ae_vector tmp; - - ae_frame_make(_state, &_frame_block); - *tiecount = 0; - ae_vector_init(&tmp, 0, DT_INT, _state, ae_true); - - - /* - * Special case - */ - if( n<=0 ) - { - *tiecount = 0; - ae_frame_leave(_state); - return; - } - - /* - * Sort A - */ - tagsortfasti(a, b, bufr, bufi, n, _state); - - /* - * Process ties - */ - ties->ptr.p_int[0] = 0; - k = 1; - for(i=1; i<=n-1; i++) - { - if( ae_fp_neq(a->ptr.p_double[i],a->ptr.p_double[i-1]) ) - { - ties->ptr.p_int[k] = i; - k = k+1; - } - } - ties->ptr.p_int[k] = n; - *tiecount = k; - ae_frame_leave(_state); -} - - -/************************************************************************* -Optimal binary classification - -Algorithms finds optimal (=with minimal cross-entropy) binary partition. -Internal subroutine. - -INPUT PARAMETERS: - A - array[0..N-1], variable - C - array[0..N-1], class numbers (0 or 1). - N - array size - -OUTPUT PARAMETERS: - Info - completion code: - * -3, all values of A[] are same (partition is impossible) - * -2, one of C[] is incorrect (<0, >1) - * -1, incorrect pararemets were passed (N<=0). - * 1, OK - Threshold- partiton boundary. Left part contains values which are - strictly less than Threshold. Right part contains values - which are greater than or equal to Threshold. - PAL, PBL- probabilities P(0|v=Threshold) and P(1|v>=Threshold) - CVE - cross-validation estimate of cross-entropy - - -- ALGLIB -- - Copyright 22.05.2008 by Bochkanov Sergey -*************************************************************************/ -void dsoptimalsplit2(/* Real */ ae_vector* a, - /* Integer */ ae_vector* c, - ae_int_t n, - ae_int_t* info, - double* threshold, - double* pal, - double* pbl, - double* par, - double* pbr, - double* cve, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _a; - ae_vector _c; - ae_int_t i; - ae_int_t t; - double s; - ae_vector ties; - ae_int_t tiecount; - ae_vector p1; - ae_vector p2; - ae_int_t k; - ae_int_t koptimal; - double pak; - double pbk; - double cvoptimal; - double cv; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_a, a, _state, ae_true); - a = &_a; - ae_vector_init_copy(&_c, c, _state, ae_true); - c = &_c; - *info = 0; - *threshold = 0; - *pal = 0; - *pbl = 0; - *par = 0; - *pbr = 0; - *cve = 0; - ae_vector_init(&ties, 0, DT_INT, _state, ae_true); - ae_vector_init(&p1, 0, DT_INT, _state, ae_true); - ae_vector_init(&p2, 0, DT_INT, _state, ae_true); - - - /* - * Test for errors in inputs - */ - if( n<=0 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - for(i=0; i<=n-1; i++) - { - if( c->ptr.p_int[i]!=0&&c->ptr.p_int[i]!=1 ) - { - *info = -2; - ae_frame_leave(_state); - return; - } - } - *info = 1; - - /* - * Tie - */ - dstie(a, n, &ties, &tiecount, &p1, &p2, _state); - for(i=0; i<=n-1; i++) - { - if( p2.ptr.p_int[i]!=i ) - { - t = c->ptr.p_int[i]; - c->ptr.p_int[i] = c->ptr.p_int[p2.ptr.p_int[i]]; - c->ptr.p_int[p2.ptr.p_int[i]] = t; - } - } - - /* - * Special case: number of ties is 1. - * - * NOTE: we assume that P[i,j] equals to 0 or 1, - * intermediate values are not allowed. - */ - if( tiecount==1 ) - { - *info = -3; - ae_frame_leave(_state); - return; - } - - /* - * General case, number of ties > 1 - * - * NOTE: we assume that P[i,j] equals to 0 or 1, - * intermediate values are not allowed. - */ - *pal = 0; - *pbl = 0; - *par = 0; - *pbr = 0; - for(i=0; i<=n-1; i++) - { - if( c->ptr.p_int[i]==0 ) - { - *par = *par+1; - } - if( c->ptr.p_int[i]==1 ) - { - *pbr = *pbr+1; - } - } - koptimal = -1; - cvoptimal = ae_maxrealnumber; - for(k=0; k<=tiecount-2; k++) - { - - /* - * first, obtain information about K-th tie which is - * moved from R-part to L-part - */ - pak = 0; - pbk = 0; - for(i=ties.ptr.p_int[k]; i<=ties.ptr.p_int[k+1]-1; i++) - { - if( c->ptr.p_int[i]==0 ) - { - pak = pak+1; - } - if( c->ptr.p_int[i]==1 ) - { - pbk = pbk+1; - } - } - - /* - * Calculate cross-validation CE - */ - cv = 0; - cv = cv-bdss_xlny(*pal+pak, (*pal+pak)/(*pal+pak+(*pbl)+pbk+1), _state); - cv = cv-bdss_xlny(*pbl+pbk, (*pbl+pbk)/(*pal+pak+1+(*pbl)+pbk), _state); - cv = cv-bdss_xlny(*par-pak, (*par-pak)/(*par-pak+(*pbr)-pbk+1), _state); - cv = cv-bdss_xlny(*pbr-pbk, (*pbr-pbk)/(*par-pak+1+(*pbr)-pbk), _state); - - /* - * Compare with best - */ - if( ae_fp_less(cv,cvoptimal) ) - { - cvoptimal = cv; - koptimal = k; - } - - /* - * update - */ - *pal = *pal+pak; - *pbl = *pbl+pbk; - *par = *par-pak; - *pbr = *pbr-pbk; - } - *cve = cvoptimal; - *threshold = 0.5*(a->ptr.p_double[ties.ptr.p_int[koptimal]]+a->ptr.p_double[ties.ptr.p_int[koptimal+1]]); - *pal = 0; - *pbl = 0; - *par = 0; - *pbr = 0; - for(i=0; i<=n-1; i++) - { - if( ae_fp_less(a->ptr.p_double[i],*threshold) ) - { - if( c->ptr.p_int[i]==0 ) - { - *pal = *pal+1; - } - else - { - *pbl = *pbl+1; - } - } - else - { - if( c->ptr.p_int[i]==0 ) - { - *par = *par+1; - } - else - { - *pbr = *pbr+1; - } - } - } - s = *pal+(*pbl); - *pal = *pal/s; - *pbl = *pbl/s; - s = *par+(*pbr); - *par = *par/s; - *pbr = *pbr/s; - ae_frame_leave(_state); -} - - -/************************************************************************* -Optimal partition, internal subroutine. Fast version. - -Accepts: - A array[0..N-1] array of attributes array[0..N-1] - C array[0..N-1] array of class labels - TiesBuf array[0..N] temporaries (ties) - CntBuf array[0..2*NC-1] temporaries (counts) - Alpha centering factor (0<=alpha<=1, recommended value - 0.05) - BufR array[0..N-1] temporaries - BufI array[0..N-1] temporaries - -Output: - Info error code (">0"=OK, "<0"=bad) - RMS training set RMS error - CVRMS leave-one-out RMS error - -Note: - content of all arrays is changed by subroutine; - it doesn't allocate temporaries. - - -- ALGLIB -- - Copyright 11.12.2008 by Bochkanov Sergey -*************************************************************************/ -void dsoptimalsplit2fast(/* Real */ ae_vector* a, - /* Integer */ ae_vector* c, - /* Integer */ ae_vector* tiesbuf, - /* Integer */ ae_vector* cntbuf, - /* Real */ ae_vector* bufr, - /* Integer */ ae_vector* bufi, - ae_int_t n, - ae_int_t nc, - double alpha, - ae_int_t* info, - double* threshold, - double* rms, - double* cvrms, - ae_state *_state) -{ - ae_int_t i; - ae_int_t k; - ae_int_t cl; - ae_int_t tiecount; - double cbest; - double cc; - ae_int_t koptimal; - ae_int_t sl; - ae_int_t sr; - double v; - double w; - double x; - - *info = 0; - *threshold = 0; - *rms = 0; - *cvrms = 0; - - - /* - * Test for errors in inputs - */ - if( n<=0||nc<2 ) - { - *info = -1; - return; - } - for(i=0; i<=n-1; i++) - { - if( c->ptr.p_int[i]<0||c->ptr.p_int[i]>=nc ) - { - *info = -2; - return; - } - } - *info = 1; - - /* - * Tie - */ - dstiefasti(a, c, n, tiesbuf, &tiecount, bufr, bufi, _state); - - /* - * Special case: number of ties is 1. - */ - if( tiecount==1 ) - { - *info = -3; - return; - } - - /* - * General case, number of ties > 1 - */ - for(i=0; i<=2*nc-1; i++) - { - cntbuf->ptr.p_int[i] = 0; - } - for(i=0; i<=n-1; i++) - { - cntbuf->ptr.p_int[nc+c->ptr.p_int[i]] = cntbuf->ptr.p_int[nc+c->ptr.p_int[i]]+1; - } - koptimal = -1; - *threshold = a->ptr.p_double[n-1]; - cbest = ae_maxrealnumber; - sl = 0; - sr = n; - for(k=0; k<=tiecount-2; k++) - { - - /* - * first, move Kth tie from right to left - */ - for(i=tiesbuf->ptr.p_int[k]; i<=tiesbuf->ptr.p_int[k+1]-1; i++) - { - cl = c->ptr.p_int[i]; - cntbuf->ptr.p_int[cl] = cntbuf->ptr.p_int[cl]+1; - cntbuf->ptr.p_int[nc+cl] = cntbuf->ptr.p_int[nc+cl]-1; - } - sl = sl+(tiesbuf->ptr.p_int[k+1]-tiesbuf->ptr.p_int[k]); - sr = sr-(tiesbuf->ptr.p_int[k+1]-tiesbuf->ptr.p_int[k]); - - /* - * Calculate RMS error - */ - v = 0; - for(i=0; i<=nc-1; i++) - { - w = cntbuf->ptr.p_int[i]; - v = v+w*ae_sqr(w/sl-1, _state); - v = v+(sl-w)*ae_sqr(w/sl, _state); - w = cntbuf->ptr.p_int[nc+i]; - v = v+w*ae_sqr(w/sr-1, _state); - v = v+(sr-w)*ae_sqr(w/sr, _state); - } - v = ae_sqrt(v/(nc*n), _state); - - /* - * Compare with best - */ - x = (double)(2*sl)/(double)(sl+sr)-1; - cc = v*(1-alpha+alpha*ae_sqr(x, _state)); - if( ae_fp_less(cc,cbest) ) - { - - /* - * store split - */ - *rms = v; - koptimal = k; - cbest = cc; - - /* - * calculate CVRMS error - */ - *cvrms = 0; - for(i=0; i<=nc-1; i++) - { - if( sl>1 ) - { - w = cntbuf->ptr.p_int[i]; - *cvrms = *cvrms+w*ae_sqr((w-1)/(sl-1)-1, _state); - *cvrms = *cvrms+(sl-w)*ae_sqr(w/(sl-1), _state); - } - else - { - w = cntbuf->ptr.p_int[i]; - *cvrms = *cvrms+w*ae_sqr((double)1/(double)nc-1, _state); - *cvrms = *cvrms+(sl-w)*ae_sqr((double)1/(double)nc, _state); - } - if( sr>1 ) - { - w = cntbuf->ptr.p_int[nc+i]; - *cvrms = *cvrms+w*ae_sqr((w-1)/(sr-1)-1, _state); - *cvrms = *cvrms+(sr-w)*ae_sqr(w/(sr-1), _state); - } - else - { - w = cntbuf->ptr.p_int[nc+i]; - *cvrms = *cvrms+w*ae_sqr((double)1/(double)nc-1, _state); - *cvrms = *cvrms+(sr-w)*ae_sqr((double)1/(double)nc, _state); - } - } - *cvrms = ae_sqrt(*cvrms/(nc*n), _state); - } - } - - /* - * Calculate threshold. - * Code is a bit complicated because there can be such - * numbers that 0.5(A+B) equals to A or B (if A-B=epsilon) - */ - *threshold = 0.5*(a->ptr.p_double[tiesbuf->ptr.p_int[koptimal]]+a->ptr.p_double[tiesbuf->ptr.p_int[koptimal+1]]); - if( ae_fp_less_eq(*threshold,a->ptr.p_double[tiesbuf->ptr.p_int[koptimal]]) ) - { - *threshold = a->ptr.p_double[tiesbuf->ptr.p_int[koptimal+1]]; - } -} - - -/************************************************************************* -Automatic non-optimal discretization, internal subroutine. - - -- ALGLIB -- - Copyright 22.05.2008 by Bochkanov Sergey -*************************************************************************/ -void dssplitk(/* Real */ ae_vector* a, - /* Integer */ ae_vector* c, - ae_int_t n, - ae_int_t nc, - ae_int_t kmax, - ae_int_t* info, - /* Real */ ae_vector* thresholds, - ae_int_t* ni, - double* cve, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _a; - ae_vector _c; - ae_int_t i; - ae_int_t j; - ae_int_t j1; - ae_int_t k; - ae_vector ties; - ae_int_t tiecount; - ae_vector p1; - ae_vector p2; - ae_vector cnt; - double v2; - ae_int_t bestk; - double bestcve; - ae_vector bestsizes; - double curcve; - ae_vector cursizes; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_a, a, _state, ae_true); - a = &_a; - ae_vector_init_copy(&_c, c, _state, ae_true); - c = &_c; - *info = 0; - ae_vector_clear(thresholds); - *ni = 0; - *cve = 0; - ae_vector_init(&ties, 0, DT_INT, _state, ae_true); - ae_vector_init(&p1, 0, DT_INT, _state, ae_true); - ae_vector_init(&p2, 0, DT_INT, _state, ae_true); - ae_vector_init(&cnt, 0, DT_INT, _state, ae_true); - ae_vector_init(&bestsizes, 0, DT_INT, _state, ae_true); - ae_vector_init(&cursizes, 0, DT_INT, _state, ae_true); - - - /* - * Test for errors in inputs - */ - if( (n<=0||nc<2)||kmax<2 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - for(i=0; i<=n-1; i++) - { - if( c->ptr.p_int[i]<0||c->ptr.p_int[i]>=nc ) - { - *info = -2; - ae_frame_leave(_state); - return; - } - } - *info = 1; - - /* - * Tie - */ - dstie(a, n, &ties, &tiecount, &p1, &p2, _state); - for(i=0; i<=n-1; i++) - { - if( p2.ptr.p_int[i]!=i ) - { - k = c->ptr.p_int[i]; - c->ptr.p_int[i] = c->ptr.p_int[p2.ptr.p_int[i]]; - c->ptr.p_int[p2.ptr.p_int[i]] = k; - } - } - - /* - * Special cases - */ - if( tiecount==1 ) - { - *info = -3; - ae_frame_leave(_state); - return; - } - - /* - * General case: - * 0. allocate arrays - */ - kmax = ae_minint(kmax, tiecount, _state); - ae_vector_set_length(&bestsizes, kmax-1+1, _state); - ae_vector_set_length(&cursizes, kmax-1+1, _state); - ae_vector_set_length(&cnt, nc-1+1, _state); - - /* - * General case: - * 1. prepare "weak" solution (two subintervals, divided at median) - */ - v2 = ae_maxrealnumber; - j = -1; - for(i=1; i<=tiecount-1; i++) - { - if( ae_fp_less(ae_fabs(ties.ptr.p_int[i]-0.5*(n-1), _state),v2) ) - { - v2 = ae_fabs(ties.ptr.p_int[i]-0.5*n, _state); - j = i; - } - } - ae_assert(j>0, "DSSplitK: internal error #1!", _state); - bestk = 2; - bestsizes.ptr.p_int[0] = ties.ptr.p_int[j]; - bestsizes.ptr.p_int[1] = n-j; - bestcve = 0; - for(i=0; i<=nc-1; i++) - { - cnt.ptr.p_int[i] = 0; - } - for(i=0; i<=j-1; i++) - { - bdss_tieaddc(c, &ties, i, nc, &cnt, _state); - } - bestcve = bestcve+bdss_getcv(&cnt, nc, _state); - for(i=0; i<=nc-1; i++) - { - cnt.ptr.p_int[i] = 0; - } - for(i=j; i<=tiecount-1; i++) - { - bdss_tieaddc(c, &ties, i, nc, &cnt, _state); - } - bestcve = bestcve+bdss_getcv(&cnt, nc, _state); - - /* - * General case: - * 2. Use greedy algorithm to find sub-optimal split in O(KMax*N) time - */ - for(k=2; k<=kmax; k++) - { - - /* - * Prepare greedy K-interval split - */ - for(i=0; i<=k-1; i++) - { - cursizes.ptr.p_int[i] = 0; - } - i = 0; - j = 0; - while(j<=tiecount-1&&i<=k-1) - { - - /* - * Rule: I-th bin is empty, fill it - */ - if( cursizes.ptr.p_int[i]==0 ) - { - cursizes.ptr.p_int[i] = ties.ptr.p_int[j+1]-ties.ptr.p_int[j]; - j = j+1; - continue; - } - - /* - * Rule: (K-1-I) bins left, (K-1-I) ties left (1 tie per bin); next bin - */ - if( tiecount-j==k-1-i ) - { - i = i+1; - continue; - } - - /* - * Rule: last bin, always place in current - */ - if( i==k-1 ) - { - cursizes.ptr.p_int[i] = cursizes.ptr.p_int[i]+ties.ptr.p_int[j+1]-ties.ptr.p_int[j]; - j = j+1; - continue; - } - - /* - * Place J-th tie in I-th bin, or leave for I+1-th bin. - */ - if( ae_fp_less(ae_fabs(cursizes.ptr.p_int[i]+ties.ptr.p_int[j+1]-ties.ptr.p_int[j]-(double)n/(double)k, _state),ae_fabs(cursizes.ptr.p_int[i]-(double)n/(double)k, _state)) ) - { - cursizes.ptr.p_int[i] = cursizes.ptr.p_int[i]+ties.ptr.p_int[j+1]-ties.ptr.p_int[j]; - j = j+1; - } - else - { - i = i+1; - } - } - ae_assert(cursizes.ptr.p_int[k-1]!=0&&j==tiecount, "DSSplitK: internal error #1", _state); - - /* - * Calculate CVE - */ - curcve = 0; - j = 0; - for(i=0; i<=k-1; i++) - { - for(j1=0; j1<=nc-1; j1++) - { - cnt.ptr.p_int[j1] = 0; - } - for(j1=j; j1<=j+cursizes.ptr.p_int[i]-1; j1++) - { - cnt.ptr.p_int[c->ptr.p_int[j1]] = cnt.ptr.p_int[c->ptr.p_int[j1]]+1; - } - curcve = curcve+bdss_getcv(&cnt, nc, _state); - j = j+cursizes.ptr.p_int[i]; - } - - /* - * Choose best variant - */ - if( ae_fp_less(curcve,bestcve) ) - { - for(i=0; i<=k-1; i++) - { - bestsizes.ptr.p_int[i] = cursizes.ptr.p_int[i]; - } - bestcve = curcve; - bestk = k; - } - } - - /* - * Transform from sizes to thresholds - */ - *cve = bestcve; - *ni = bestk; - ae_vector_set_length(thresholds, *ni-2+1, _state); - j = bestsizes.ptr.p_int[0]; - for(i=1; i<=bestk-1; i++) - { - thresholds->ptr.p_double[i-1] = 0.5*(a->ptr.p_double[j-1]+a->ptr.p_double[j]); - j = j+bestsizes.ptr.p_int[i]; - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Automatic optimal discretization, internal subroutine. - - -- ALGLIB -- - Copyright 22.05.2008 by Bochkanov Sergey -*************************************************************************/ -void dsoptimalsplitk(/* Real */ ae_vector* a, - /* Integer */ ae_vector* c, - ae_int_t n, - ae_int_t nc, - ae_int_t kmax, - ae_int_t* info, - /* Real */ ae_vector* thresholds, - ae_int_t* ni, - double* cve, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _a; - ae_vector _c; - ae_int_t i; - ae_int_t j; - ae_int_t s; - ae_int_t jl; - ae_int_t jr; - double v2; - ae_vector ties; - ae_int_t tiecount; - ae_vector p1; - ae_vector p2; - double cvtemp; - ae_vector cnt; - ae_vector cnt2; - ae_matrix cv; - ae_matrix splits; - ae_int_t k; - ae_int_t koptimal; - double cvoptimal; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_a, a, _state, ae_true); - a = &_a; - ae_vector_init_copy(&_c, c, _state, ae_true); - c = &_c; - *info = 0; - ae_vector_clear(thresholds); - *ni = 0; - *cve = 0; - ae_vector_init(&ties, 0, DT_INT, _state, ae_true); - ae_vector_init(&p1, 0, DT_INT, _state, ae_true); - ae_vector_init(&p2, 0, DT_INT, _state, ae_true); - ae_vector_init(&cnt, 0, DT_INT, _state, ae_true); - ae_vector_init(&cnt2, 0, DT_INT, _state, ae_true); - ae_matrix_init(&cv, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&splits, 0, 0, DT_INT, _state, ae_true); - - - /* - * Test for errors in inputs - */ - if( (n<=0||nc<2)||kmax<2 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - for(i=0; i<=n-1; i++) - { - if( c->ptr.p_int[i]<0||c->ptr.p_int[i]>=nc ) - { - *info = -2; - ae_frame_leave(_state); - return; - } - } - *info = 1; - - /* - * Tie - */ - dstie(a, n, &ties, &tiecount, &p1, &p2, _state); - for(i=0; i<=n-1; i++) - { - if( p2.ptr.p_int[i]!=i ) - { - k = c->ptr.p_int[i]; - c->ptr.p_int[i] = c->ptr.p_int[p2.ptr.p_int[i]]; - c->ptr.p_int[p2.ptr.p_int[i]] = k; - } - } - - /* - * Special cases - */ - if( tiecount==1 ) - { - *info = -3; - ae_frame_leave(_state); - return; - } - - /* - * General case - * Use dynamic programming to find best split in O(KMax*NC*TieCount^2) time - */ - kmax = ae_minint(kmax, tiecount, _state); - ae_matrix_set_length(&cv, kmax-1+1, tiecount-1+1, _state); - ae_matrix_set_length(&splits, kmax-1+1, tiecount-1+1, _state); - ae_vector_set_length(&cnt, nc-1+1, _state); - ae_vector_set_length(&cnt2, nc-1+1, _state); - for(j=0; j<=nc-1; j++) - { - cnt.ptr.p_int[j] = 0; - } - for(j=0; j<=tiecount-1; j++) - { - bdss_tieaddc(c, &ties, j, nc, &cnt, _state); - splits.ptr.pp_int[0][j] = 0; - cv.ptr.pp_double[0][j] = bdss_getcv(&cnt, nc, _state); - } - for(k=1; k<=kmax-1; k++) - { - for(j=0; j<=nc-1; j++) - { - cnt.ptr.p_int[j] = 0; - } - - /* - * Subtask size J in [K..TieCount-1]: - * optimal K-splitting on ties from 0-th to J-th. - */ - for(j=k; j<=tiecount-1; j++) - { - - /* - * Update Cnt - let it contain classes of ties from K-th to J-th - */ - bdss_tieaddc(c, &ties, j, nc, &cnt, _state); - - /* - * Search for optimal split point S in [K..J] - */ - for(i=0; i<=nc-1; i++) - { - cnt2.ptr.p_int[i] = cnt.ptr.p_int[i]; - } - cv.ptr.pp_double[k][j] = cv.ptr.pp_double[k-1][j-1]+bdss_getcv(&cnt2, nc, _state); - splits.ptr.pp_int[k][j] = j; - for(s=k+1; s<=j; s++) - { - - /* - * Update Cnt2 - let it contain classes of ties from S-th to J-th - */ - bdss_tiesubc(c, &ties, s-1, nc, &cnt2, _state); - - /* - * Calculate CVE - */ - cvtemp = cv.ptr.pp_double[k-1][s-1]+bdss_getcv(&cnt2, nc, _state); - if( ae_fp_less(cvtemp,cv.ptr.pp_double[k][j]) ) - { - cv.ptr.pp_double[k][j] = cvtemp; - splits.ptr.pp_int[k][j] = s; - } - } - } - } - - /* - * Choose best partition, output result - */ - koptimal = -1; - cvoptimal = ae_maxrealnumber; - for(k=0; k<=kmax-1; k++) - { - if( ae_fp_less(cv.ptr.pp_double[k][tiecount-1],cvoptimal) ) - { - cvoptimal = cv.ptr.pp_double[k][tiecount-1]; - koptimal = k; - } - } - ae_assert(koptimal>=0, "DSOptimalSplitK: internal error #1!", _state); - if( koptimal==0 ) - { - - /* - * Special case: best partition is one big interval. - * Even 2-partition is not better. - * This is possible when dealing with "weak" predictor variables. - * - * Make binary split as close to the median as possible. - */ - v2 = ae_maxrealnumber; - j = -1; - for(i=1; i<=tiecount-1; i++) - { - if( ae_fp_less(ae_fabs(ties.ptr.p_int[i]-0.5*(n-1), _state),v2) ) - { - v2 = ae_fabs(ties.ptr.p_int[i]-0.5*(n-1), _state); - j = i; - } - } - ae_assert(j>0, "DSOptimalSplitK: internal error #2!", _state); - ae_vector_set_length(thresholds, 0+1, _state); - thresholds->ptr.p_double[0] = 0.5*(a->ptr.p_double[ties.ptr.p_int[j-1]]+a->ptr.p_double[ties.ptr.p_int[j]]); - *ni = 2; - *cve = 0; - for(i=0; i<=nc-1; i++) - { - cnt.ptr.p_int[i] = 0; - } - for(i=0; i<=j-1; i++) - { - bdss_tieaddc(c, &ties, i, nc, &cnt, _state); - } - *cve = *cve+bdss_getcv(&cnt, nc, _state); - for(i=0; i<=nc-1; i++) - { - cnt.ptr.p_int[i] = 0; - } - for(i=j; i<=tiecount-1; i++) - { - bdss_tieaddc(c, &ties, i, nc, &cnt, _state); - } - *cve = *cve+bdss_getcv(&cnt, nc, _state); - } - else - { - - /* - * General case: 2 or more intervals - * - * NOTE: we initialize both JL and JR (left and right bounds), - * although algorithm needs only JL. - */ - ae_vector_set_length(thresholds, koptimal-1+1, _state); - *ni = koptimal+1; - *cve = cv.ptr.pp_double[koptimal][tiecount-1]; - jl = splits.ptr.pp_int[koptimal][tiecount-1]; - jr = tiecount-1; - for(k=koptimal; k>=1; k--) - { - thresholds->ptr.p_double[k-1] = 0.5*(a->ptr.p_double[ties.ptr.p_int[jl-1]]+a->ptr.p_double[ties.ptr.p_int[jl]]); - jr = jl-1; - jl = splits.ptr.pp_int[k-1][jl-1]; - } - touchint(&jr, _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Internal function -*************************************************************************/ -static double bdss_xlny(double x, double y, ae_state *_state) -{ - double result; - - - if( ae_fp_eq(x,0) ) - { - result = 0; - } - else - { - result = x*ae_log(y, _state); - } - return result; -} - - -/************************************************************************* -Internal function, -returns number of samples of class I in Cnt[I] -*************************************************************************/ -static double bdss_getcv(/* Integer */ ae_vector* cnt, - ae_int_t nc, - ae_state *_state) -{ - ae_int_t i; - double s; - double result; - - - s = 0; - for(i=0; i<=nc-1; i++) - { - s = s+cnt->ptr.p_int[i]; - } - result = 0; - for(i=0; i<=nc-1; i++) - { - result = result-bdss_xlny(cnt->ptr.p_int[i], cnt->ptr.p_int[i]/(s+nc-1), _state); - } - return result; -} - - -/************************************************************************* -Internal function, adds number of samples of class I in tie NTie to Cnt[I] -*************************************************************************/ -static void bdss_tieaddc(/* Integer */ ae_vector* c, - /* Integer */ ae_vector* ties, - ae_int_t ntie, - ae_int_t nc, - /* Integer */ ae_vector* cnt, - ae_state *_state) -{ - ae_int_t i; - - - for(i=ties->ptr.p_int[ntie]; i<=ties->ptr.p_int[ntie+1]-1; i++) - { - cnt->ptr.p_int[c->ptr.p_int[i]] = cnt->ptr.p_int[c->ptr.p_int[i]]+1; - } -} - - -/************************************************************************* -Internal function, subtracts number of samples of class I in tie NTie to Cnt[I] -*************************************************************************/ -static void bdss_tiesubc(/* Integer */ ae_vector* c, - /* Integer */ ae_vector* ties, - ae_int_t ntie, - ae_int_t nc, - /* Integer */ ae_vector* cnt, - ae_state *_state) -{ - ae_int_t i; - - - for(i=ties->ptr.p_int[ntie]; i<=ties->ptr.p_int[ntie+1]-1; i++) - { - cnt->ptr.p_int[c->ptr.p_int[i]] = cnt->ptr.p_int[c->ptr.p_int[i]]-1; - } -} - - -ae_bool _cvreport_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - cvreport *p = (cvreport*)_p; - ae_touch_ptr((void*)p); - return ae_true; -} - - -ae_bool _cvreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - cvreport *dst = (cvreport*)_dst; - cvreport *src = (cvreport*)_src; - dst->relclserror = src->relclserror; - dst->avgce = src->avgce; - dst->rmserror = src->rmserror; - dst->avgerror = src->avgerror; - dst->avgrelerror = src->avgrelerror; - return ae_true; -} - - -void _cvreport_clear(void* _p) -{ - cvreport *p = (cvreport*)_p; - ae_touch_ptr((void*)p); -} - - -void _cvreport_destroy(void* _p) -{ - cvreport *p = (cvreport*)_p; - ae_touch_ptr((void*)p); -} - - - - -/************************************************************************* -This function initializes clusterizer object. Newly initialized object is -empty, i.e. it does not contain dataset. You should use it as follows: -1. creation -2. dataset is added with ClusterizerSetPoints() -3. additional parameters are set -3. clusterization is performed with one of the clustering functions - - -- ALGLIB -- - Copyright 10.07.2012 by Bochkanov Sergey -*************************************************************************/ -void clusterizercreate(clusterizerstate* s, ae_state *_state) -{ - - _clusterizerstate_clear(s); - - s->npoints = 0; - s->nfeatures = 0; - s->disttype = 2; - s->ahcalgo = 0; - s->kmeansrestarts = 1; - s->kmeansmaxits = 0; -} - - -/************************************************************************* -This function adds dataset to the clusterizer structure. - -This function overrides all previous calls of ClusterizerSetPoints() or -ClusterizerSetDistances(). - -INPUT PARAMETERS: - S - clusterizer state, initialized by ClusterizerCreate() - XY - array[NPoints,NFeatures], dataset - NPoints - number of points, >=0 - NFeatures- number of features, >=1 - DistType- distance function: - * 0 Chebyshev distance (L-inf norm) - * 1 city block distance (L1 norm) - * 2 Euclidean distance (L2 norm) - * 10 Pearson correlation: - dist(a,b) = 1-corr(a,b) - * 11 Absolute Pearson correlation: - dist(a,b) = 1-|corr(a,b)| - * 12 Uncentered Pearson correlation (cosine of the angle): - dist(a,b) = a'*b/(|a|*|b|) - * 13 Absolute uncentered Pearson correlation - dist(a,b) = |a'*b|/(|a|*|b|) - * 20 Spearman rank correlation: - dist(a,b) = 1-rankcorr(a,b) - * 21 Absolute Spearman rank correlation - dist(a,b) = 1-|rankcorr(a,b)| - -NOTE 1: different distance functions have different performance penalty: - * Euclidean or Pearson correlation distances are the fastest ones - * Spearman correlation distance function is a bit slower - * city block and Chebyshev distances are order of magnitude slower - - The reason behing difference in performance is that correlation-based - distance functions are computed using optimized linear algebra kernels, - while Chebyshev and city block distance functions are computed using - simple nested loops with two branches at each iteration. - -NOTE 2: different clustering algorithms have different limitations: - * agglomerative hierarchical clustering algorithms may be used with - any kind of distance metric - * k-means++ clustering algorithm may be used only with Euclidean - distance function - Thus, list of specific clustering algorithms you may use depends - on distance function you specify when you set your dataset. - - -- ALGLIB -- - Copyright 10.07.2012 by Bochkanov Sergey -*************************************************************************/ -void clusterizersetpoints(clusterizerstate* s, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nfeatures, - ae_int_t disttype, - ae_state *_state) -{ - ae_int_t i; - - - ae_assert((((((((disttype==0||disttype==1)||disttype==2)||disttype==10)||disttype==11)||disttype==12)||disttype==13)||disttype==20)||disttype==21, "ClusterizerSetPoints: incorrect DistType", _state); - ae_assert(npoints>=0, "ClusterizerSetPoints: NPoints<0", _state); - ae_assert(nfeatures>=1, "ClusterizerSetPoints: NFeatures<1", _state); - ae_assert(xy->rows>=npoints, "ClusterizerSetPoints: Rows(XY)cols>=nfeatures, "ClusterizerSetPoints: Cols(XY)npoints = npoints; - s->nfeatures = nfeatures; - s->disttype = disttype; - rmatrixsetlengthatleast(&s->xy, npoints, nfeatures, _state); - for(i=0; i<=npoints-1; i++) - { - ae_v_move(&s->xy.ptr.pp_double[i][0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nfeatures-1)); - } -} - - -/************************************************************************* -This function adds dataset given by distance matrix to the clusterizer -structure. It is important that dataset is not given explicitly - only -distance matrix is given. - -This function overrides all previous calls of ClusterizerSetPoints() or -ClusterizerSetDistances(). - -INPUT PARAMETERS: - S - clusterizer state, initialized by ClusterizerCreate() - D - array[NPoints,NPoints], distance matrix given by its upper - or lower triangle (main diagonal is ignored because its - entries are expected to be zero). - NPoints - number of points - IsUpper - whether upper or lower triangle of D is given. - -NOTE 1: different clustering algorithms have different limitations: - * agglomerative hierarchical clustering algorithms may be used with - any kind of distance metric, including one which is given by - distance matrix - * k-means++ clustering algorithm may be used only with Euclidean - distance function and explicitly given points - it can not be - used with dataset given by distance matrix - Thus, if you call this function, you will be unable to use k-means - clustering algorithm to process your problem. - - -- ALGLIB -- - Copyright 10.07.2012 by Bochkanov Sergey -*************************************************************************/ -void clusterizersetdistances(clusterizerstate* s, - /* Real */ ae_matrix* d, - ae_int_t npoints, - ae_bool isupper, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t j0; - ae_int_t j1; - - - ae_assert(npoints>=0, "ClusterizerSetDistances: NPoints<0", _state); - ae_assert(d->rows>=npoints, "ClusterizerSetDistances: Rows(D)cols>=npoints, "ClusterizerSetDistances: Cols(D)npoints = npoints; - s->nfeatures = 0; - s->disttype = -1; - rmatrixsetlengthatleast(&s->d, npoints, npoints, _state); - for(i=0; i<=npoints-1; i++) - { - if( isupper ) - { - j0 = i+1; - j1 = npoints-1; - } - else - { - j0 = 0; - j1 = i-1; - } - for(j=j0; j<=j1; j++) - { - ae_assert(ae_isfinite(d->ptr.pp_double[i][j], _state)&&ae_fp_greater_eq(d->ptr.pp_double[i][j],0), "ClusterizerSetDistances: D contains infinite, NAN or negative elements", _state); - s->d.ptr.pp_double[i][j] = d->ptr.pp_double[i][j]; - s->d.ptr.pp_double[j][i] = d->ptr.pp_double[i][j]; - } - s->d.ptr.pp_double[i][i] = 0; - } -} - - -/************************************************************************* -This function sets agglomerative hierarchical clustering algorithm - -INPUT PARAMETERS: - S - clusterizer state, initialized by ClusterizerCreate() - Algo - algorithm type: - * 0 complete linkage (default algorithm) - * 1 single linkage - * 2 unweighted average linkage - * 3 weighted average linkage - - -- ALGLIB -- - Copyright 10.07.2012 by Bochkanov Sergey -*************************************************************************/ -void clusterizersetahcalgo(clusterizerstate* s, - ae_int_t algo, - ae_state *_state) -{ - - - ae_assert(((algo==0||algo==1)||algo==2)||algo==3, "ClusterizerSetHCAlgo: incorrect algorithm type", _state); - s->ahcalgo = algo; -} - - -/************************************************************************* -This function sets k-means++ properties : number of restarts and maximum -number of iterations per one run. - -INPUT PARAMETERS: - S - clusterizer state, initialized by ClusterizerCreate() - Restarts- restarts count, >=1. - k-means++ algorithm performs several restarts and chooses - best set of centers (one with minimum squared distance). - MaxIts - maximum number of k-means iterations performed during one - run. >=0, zero value means that algorithm performs unlimited - number of iterations. - - -- ALGLIB -- - Copyright 10.07.2012 by Bochkanov Sergey -*************************************************************************/ -void clusterizersetkmeanslimits(clusterizerstate* s, - ae_int_t restarts, - ae_int_t maxits, - ae_state *_state) -{ - - - ae_assert(restarts>=1, "ClusterizerSetKMeansLimits: Restarts<=0", _state); - ae_assert(maxits>=0, "ClusterizerSetKMeansLimits: MaxIts<0", _state); - s->kmeansrestarts = restarts; - s->kmeansmaxits = maxits; -} - - -/************************************************************************* -This function performs agglomerative hierarchical clustering - -FOR USERS OF SMP EDITION: - - ! This function can utilize multicore capabilities of your system. In - ! order to do this you have to call version with "smp_" prefix, which - ! indicates that multicore code will be used. - ! - ! This note is given for users of SMP edition; if you use GPL edition, - ! or commercial edition of ALGLIB without SMP support, you still will - ! be able to call smp-version of this function, but all computations - ! will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - ! - ! You should remember that starting/stopping worker thread always have - ! non-zero cost. Multicore version is pretty efficient on large - ! problems which need more than 1.000.000 operations to be solved, - ! gives moderate speed-up in mid-range (from 100.000 to 1.000.000 CPU - ! cycles), but gives no speed-up for small problems (less than 100.000 - ! operations). - -INPUT PARAMETERS: - S - clusterizer state, initialized by ClusterizerCreate() - -OUTPUT PARAMETERS: - Rep - clustering results; see description of AHCReport - structure for more information. - -NOTE 1: hierarchical clustering algorithms require large amounts of memory. - In particular, this implementation needs sizeof(double)*NPoints^2 - bytes, which are used to store distance matrix. In case we work - with user-supplied matrix, this amount is multiplied by 2 (we have - to store original matrix and to work with its copy). - - For example, problem with 10000 points would require 800M of RAM, - even when working in a 1-dimensional space. - - -- ALGLIB -- - Copyright 10.07.2012 by Bochkanov Sergey -*************************************************************************/ -void clusterizerrunahc(clusterizerstate* s, - ahcreport* rep, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t npoints; - ae_int_t nfeatures; - ae_matrix d; - - ae_frame_make(_state, &_frame_block); - _ahcreport_clear(rep); - ae_matrix_init(&d, 0, 0, DT_REAL, _state, ae_true); - - npoints = s->npoints; - nfeatures = s->nfeatures; - - /* - * Fill Rep.NPoints, quick exit when NPoints<=1 - */ - rep->npoints = npoints; - if( npoints==0 ) - { - ae_vector_set_length(&rep->p, 0, _state); - ae_matrix_set_length(&rep->z, 0, 0, _state); - ae_matrix_set_length(&rep->pz, 0, 0, _state); - ae_matrix_set_length(&rep->pm, 0, 0, _state); - ae_vector_set_length(&rep->mergedist, 0, _state); - ae_frame_leave(_state); - return; - } - if( npoints==1 ) - { - ae_vector_set_length(&rep->p, 1, _state); - ae_matrix_set_length(&rep->z, 0, 0, _state); - ae_matrix_set_length(&rep->pz, 0, 0, _state); - ae_matrix_set_length(&rep->pm, 0, 0, _state); - ae_vector_set_length(&rep->mergedist, 0, _state); - rep->p.ptr.p_int[0] = 0; - ae_frame_leave(_state); - return; - } - - /* - * More than one point - */ - if( s->disttype==-1 ) - { - - /* - * Run clusterizer with user-supplied distance matrix - */ - clustering_clusterizerrunahcinternal(s, &s->d, rep, _state); - ae_frame_leave(_state); - return; - } - else - { - - /* - * Build distance matrix D. - */ - clusterizergetdistances(&s->xy, npoints, nfeatures, s->disttype, &d, _state); - - /* - * Run clusterizer - */ - clustering_clusterizerrunahcinternal(s, &d, rep, _state); - ae_frame_leave(_state); - return; - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -void _pexec_clusterizerrunahc(clusterizerstate* s, - ahcreport* rep, ae_state *_state) -{ - clusterizerrunahc(s,rep, _state); -} - - -/************************************************************************* -This function performs clustering by k-means++ algorithm. - -You may change algorithm properties like number of restarts or iterations -limit by calling ClusterizerSetKMeansLimits() functions. - -INPUT PARAMETERS: - S - clusterizer state, initialized by ClusterizerCreate() - K - number of clusters, K>=0. - K can be zero only when algorithm is called for empty - dataset, in this case completion code is set to - success (+1). - If K=0 and dataset size is non-zero, we can not - meaningfully assign points to some center (there are no - centers because K=0) and return -3 as completion code - (failure). - -OUTPUT PARAMETERS: - Rep - clustering results; see description of KMeansReport - structure for more information. - -NOTE 1: k-means clustering can be performed only for datasets with - Euclidean distance function. Algorithm will return negative - completion code in Rep.TerminationType in case dataset was added - to clusterizer with DistType other than Euclidean (or dataset was - specified by distance matrix instead of explicitly given points). - - -- ALGLIB -- - Copyright 10.07.2012 by Bochkanov Sergey -*************************************************************************/ -void clusterizerrunkmeans(clusterizerstate* s, - ae_int_t k, - kmeansreport* rep, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix dummy; - - ae_frame_make(_state, &_frame_block); - _kmeansreport_clear(rep); - ae_matrix_init(&dummy, 0, 0, DT_REAL, _state, ae_true); - - ae_assert(k>=0, "ClusterizerRunKMeans: K<0", _state); - - /* - * Incorrect distance type - */ - if( s->disttype!=2 ) - { - rep->npoints = s->npoints; - rep->terminationtype = -5; - rep->k = k; - ae_frame_leave(_state); - return; - } - - /* - * K>NPoints or (K=0 and NPoints>0) - */ - if( k>s->npoints||(k==0&&s->npoints>0) ) - { - rep->npoints = s->npoints; - rep->terminationtype = -3; - rep->k = k; - ae_frame_leave(_state); - return; - } - - /* - * No points - */ - if( s->npoints==0 ) - { - rep->npoints = 0; - rep->terminationtype = 1; - rep->k = k; - ae_frame_leave(_state); - return; - } - - /* - * Normal case: - * 1<=K<=NPoints, Euclidean distance - */ - rep->npoints = s->npoints; - rep->nfeatures = s->nfeatures; - rep->k = k; - rep->npoints = s->npoints; - rep->nfeatures = s->nfeatures; - kmeansgenerateinternal(&s->xy, s->npoints, s->nfeatures, k, s->kmeansmaxits, s->kmeansrestarts, &rep->terminationtype, &dummy, ae_false, &rep->c, ae_true, &rep->cidx, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -This function returns distance matrix for dataset - -FOR USERS OF SMP EDITION: - - ! This function can utilize multicore capabilities of your system. In - ! order to do this you have to call version with "smp_" prefix, which - ! indicates that multicore code will be used. - ! - ! This note is given for users of SMP edition; if you use GPL edition, - ! or commercial edition of ALGLIB without SMP support, you still will - ! be able to call smp-version of this function, but all computations - ! will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - ! - ! You should remember that starting/stopping worker thread always have - ! non-zero cost. Multicore version is pretty efficient on large - ! problems which need more than 1.000.000 operations to be solved, - ! gives moderate speed-up in mid-range (from 100.000 to 1.000.000 CPU - ! cycles), but gives no speed-up for small problems (less than 100.000 - ! operations). - -INPUT PARAMETERS: - XY - array[NPoints,NFeatures], dataset - NPoints - number of points, >=0 - NFeatures- number of features, >=1 - DistType- distance function: - * 0 Chebyshev distance (L-inf norm) - * 1 city block distance (L1 norm) - * 2 Euclidean distance (L2 norm) - * 10 Pearson correlation: - dist(a,b) = 1-corr(a,b) - * 11 Absolute Pearson correlation: - dist(a,b) = 1-|corr(a,b)| - * 12 Uncentered Pearson correlation (cosine of the angle): - dist(a,b) = a'*b/(|a|*|b|) - * 13 Absolute uncentered Pearson correlation - dist(a,b) = |a'*b|/(|a|*|b|) - * 20 Spearman rank correlation: - dist(a,b) = 1-rankcorr(a,b) - * 21 Absolute Spearman rank correlation - dist(a,b) = 1-|rankcorr(a,b)| - -OUTPUT PARAMETERS: - D - array[NPoints,NPoints], distance matrix - (full matrix is returned, with lower and upper triangles) - -NOTES: different distance functions have different performance penalty: - * Euclidean or Pearson correlation distances are the fastest ones - * Spearman correlation distance function is a bit slower - * city block and Chebyshev distances are order of magnitude slower - - The reason behing difference in performance is that correlation-based - distance functions are computed using optimized linear algebra kernels, - while Chebyshev and city block distance functions are computed using - simple nested loops with two branches at each iteration. - - -- ALGLIB -- - Copyright 10.07.2012 by Bochkanov Sergey -*************************************************************************/ -void clusterizergetdistances(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nfeatures, - ae_int_t disttype, - /* Real */ ae_matrix* d, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - double v; - double vv; - double vr; - ae_matrix tmpxy; - ae_vector tmpx; - ae_vector tmpy; - ae_vector diagbuf; - apbuffers buf; - - ae_frame_make(_state, &_frame_block); - ae_matrix_clear(d); - ae_matrix_init(&tmpxy, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tmpx, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tmpy, 0, DT_REAL, _state, ae_true); - ae_vector_init(&diagbuf, 0, DT_REAL, _state, ae_true); - _apbuffers_init(&buf, _state, ae_true); - - ae_assert(nfeatures>=1, "ClusterizerGetDistances: NFeatures<1", _state); - ae_assert(npoints>=0, "ClusterizerGetDistances: NPoints<1", _state); - ae_assert((((((((disttype==0||disttype==1)||disttype==2)||disttype==10)||disttype==11)||disttype==12)||disttype==13)||disttype==20)||disttype==21, "ClusterizerGetDistances: incorrect DistType", _state); - ae_assert(xy->rows>=npoints, "ClusterizerGetDistances: Rows(XY)cols>=nfeatures, "ClusterizerGetDistances: Cols(XY)ptr.pp_double[0][0] = 0; - ae_frame_leave(_state); - return; - } - - /* - * Build distance matrix D. - */ - if( disttype==0||disttype==1 ) - { - - /* - * Chebyshev or city-block distances: - * * recursively calculate upper triangle (with main diagonal) - * * copy it to the bottom part of the matrix - */ - ae_matrix_set_length(d, npoints, npoints, _state); - clustering_evaluatedistancematrixrec(xy, nfeatures, disttype, d, 0, npoints, 0, npoints, _state); - rmatrixenforcesymmetricity(d, npoints, ae_true, _state); - ae_frame_leave(_state); - return; - } - if( disttype==2 ) - { - - /* - * Euclidean distance - * - * NOTE: parallelization is done within RMatrixSYRK - */ - ae_matrix_set_length(d, npoints, npoints, _state); - ae_matrix_set_length(&tmpxy, npoints, nfeatures, _state); - ae_vector_set_length(&tmpx, nfeatures, _state); - ae_vector_set_length(&diagbuf, npoints, _state); - for(j=0; j<=nfeatures-1; j++) - { - tmpx.ptr.p_double[j] = 0.0; - } - v = (double)1/(double)npoints; - for(i=0; i<=npoints-1; i++) - { - ae_v_addd(&tmpx.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nfeatures-1), v); - } - for(i=0; i<=npoints-1; i++) - { - ae_v_move(&tmpxy.ptr.pp_double[i][0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nfeatures-1)); - ae_v_sub(&tmpxy.ptr.pp_double[i][0], 1, &tmpx.ptr.p_double[0], 1, ae_v_len(0,nfeatures-1)); - } - rmatrixsyrk(npoints, nfeatures, 1.0, &tmpxy, 0, 0, 0, 0.0, d, 0, 0, ae_true, _state); - for(i=0; i<=npoints-1; i++) - { - diagbuf.ptr.p_double[i] = d->ptr.pp_double[i][i]; - } - for(i=0; i<=npoints-1; i++) - { - d->ptr.pp_double[i][i] = 0.0; - for(j=i+1; j<=npoints-1; j++) - { - v = ae_sqrt(ae_maxreal(diagbuf.ptr.p_double[i]+diagbuf.ptr.p_double[j]-2*d->ptr.pp_double[i][j], 0.0, _state), _state); - d->ptr.pp_double[i][j] = v; - } - } - rmatrixenforcesymmetricity(d, npoints, ae_true, _state); - ae_frame_leave(_state); - return; - } - if( disttype==10||disttype==11 ) - { - - /* - * Absolute/nonabsolute Pearson correlation distance - * - * NOTE: parallelization is done within PearsonCorrM, which calls RMatrixSYRK internally - */ - ae_matrix_set_length(d, npoints, npoints, _state); - ae_vector_set_length(&diagbuf, npoints, _state); - ae_matrix_set_length(&tmpxy, npoints, nfeatures, _state); - for(i=0; i<=npoints-1; i++) - { - v = 0.0; - for(j=0; j<=nfeatures-1; j++) - { - v = v+xy->ptr.pp_double[i][j]; - } - v = v/nfeatures; - for(j=0; j<=nfeatures-1; j++) - { - tmpxy.ptr.pp_double[i][j] = xy->ptr.pp_double[i][j]-v; - } - } - rmatrixsyrk(npoints, nfeatures, 1.0, &tmpxy, 0, 0, 0, 0.0, d, 0, 0, ae_true, _state); - for(i=0; i<=npoints-1; i++) - { - diagbuf.ptr.p_double[i] = d->ptr.pp_double[i][i]; - } - for(i=0; i<=npoints-1; i++) - { - d->ptr.pp_double[i][i] = 0.0; - for(j=i+1; j<=npoints-1; j++) - { - v = d->ptr.pp_double[i][j]/ae_sqrt(diagbuf.ptr.p_double[i]*diagbuf.ptr.p_double[j], _state); - if( disttype==10 ) - { - v = 1-v; - } - else - { - v = 1-ae_fabs(v, _state); - } - v = ae_maxreal(v, 0.0, _state); - d->ptr.pp_double[i][j] = v; - } - } - rmatrixenforcesymmetricity(d, npoints, ae_true, _state); - ae_frame_leave(_state); - return; - } - if( disttype==12||disttype==13 ) - { - - /* - * Absolute/nonabsolute uncentered Pearson correlation distance - * - * NOTE: parallelization is done within RMatrixSYRK - */ - ae_matrix_set_length(d, npoints, npoints, _state); - ae_vector_set_length(&diagbuf, npoints, _state); - rmatrixsyrk(npoints, nfeatures, 1.0, xy, 0, 0, 0, 0.0, d, 0, 0, ae_true, _state); - for(i=0; i<=npoints-1; i++) - { - diagbuf.ptr.p_double[i] = d->ptr.pp_double[i][i]; - } - for(i=0; i<=npoints-1; i++) - { - d->ptr.pp_double[i][i] = 0.0; - for(j=i+1; j<=npoints-1; j++) - { - v = d->ptr.pp_double[i][j]/ae_sqrt(diagbuf.ptr.p_double[i]*diagbuf.ptr.p_double[j], _state); - if( disttype==13 ) - { - v = ae_fabs(v, _state); - } - v = ae_minreal(v, 1.0, _state); - d->ptr.pp_double[i][j] = 1-v; - } - } - rmatrixenforcesymmetricity(d, npoints, ae_true, _state); - ae_frame_leave(_state); - return; - } - if( disttype==20||disttype==21 ) - { - - /* - * Spearman rank correlation - * - * NOTE: parallelization of correlation matrix is done within - * PearsonCorrM, which calls RMatrixSYRK internally - */ - ae_matrix_set_length(d, npoints, npoints, _state); - ae_vector_set_length(&diagbuf, npoints, _state); - ae_matrix_set_length(&tmpxy, npoints, nfeatures, _state); - rmatrixcopy(npoints, nfeatures, xy, 0, 0, &tmpxy, 0, 0, _state); - rankdatacentered(&tmpxy, npoints, nfeatures, _state); - rmatrixsyrk(npoints, nfeatures, 1.0, &tmpxy, 0, 0, 0, 0.0, d, 0, 0, ae_true, _state); - for(i=0; i<=npoints-1; i++) - { - if( ae_fp_greater(d->ptr.pp_double[i][i],0) ) - { - diagbuf.ptr.p_double[i] = 1/ae_sqrt(d->ptr.pp_double[i][i], _state); - } - else - { - diagbuf.ptr.p_double[i] = 0.0; - } - } - for(i=0; i<=npoints-1; i++) - { - v = diagbuf.ptr.p_double[i]; - d->ptr.pp_double[i][i] = 0.0; - for(j=i+1; j<=npoints-1; j++) - { - vv = d->ptr.pp_double[i][j]*v*diagbuf.ptr.p_double[j]; - if( disttype==20 ) - { - vr = 1-vv; - } - else - { - vr = 1-ae_fabs(vv, _state); - } - if( ae_fp_less(vr,0) ) - { - vr = 0.0; - } - d->ptr.pp_double[i][j] = vr; - } - } - rmatrixenforcesymmetricity(d, npoints, ae_true, _state); - ae_frame_leave(_state); - return; - } - ae_assert(ae_false, "Assertion failed", _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -void _pexec_clusterizergetdistances(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nfeatures, - ae_int_t disttype, - /* Real */ ae_matrix* d, ae_state *_state) -{ - clusterizergetdistances(xy,npoints,nfeatures,disttype,d, _state); -} - - -/************************************************************************* -This function takes as input clusterization report Rep, desired clusters -count K, and builds top K clusters from hierarchical clusterization tree. -It returns assignment of points to clusters (array of cluster indexes). - -INPUT PARAMETERS: - Rep - report from ClusterizerRunAHC() performed on XY - K - desired number of clusters, 1<=K<=NPoints. - K can be zero only when NPoints=0. - -OUTPUT PARAMETERS: - CIdx - array[NPoints], I-th element contains cluster index (from - 0 to K-1) for I-th point of the dataset. - CZ - array[K]. This array allows to convert cluster indexes - returned by this function to indexes used by Rep.Z. J-th - cluster returned by this function corresponds to CZ[J]-th - cluster stored in Rep.Z/PZ/PM. - It is guaranteed that CZ[I]npoints; - ae_assert(npoints>=0, "ClusterizerGetKClusters: internal error in Rep integrity", _state); - ae_assert(k>=0, "ClusterizerGetKClusters: K<=0", _state); - ae_assert(k<=npoints, "ClusterizerGetKClusters: K>NPoints", _state); - ae_assert(k>0||npoints==0, "ClusterizerGetKClusters: K<=0", _state); - ae_assert(npoints==rep->npoints, "ClusterizerGetKClusters: NPoints<>Rep.NPoints", _state); - - /* - * Quick exit - */ - if( npoints==0 ) - { - ae_frame_leave(_state); - return; - } - if( npoints==1 ) - { - ae_vector_set_length(cz, 1, _state); - ae_vector_set_length(cidx, 1, _state); - cz->ptr.p_int[0] = 0; - cidx->ptr.p_int[0] = 0; - ae_frame_leave(_state); - return; - } - - /* - * Replay merges, from top to bottom, - * keep track of clusters being present at the moment - */ - ae_vector_set_length(&presentclusters, 2*npoints-1, _state); - ae_vector_set_length(&tmpidx, npoints, _state); - for(i=0; i<=2*npoints-3; i++) - { - presentclusters.ptr.p_bool[i] = ae_false; - } - presentclusters.ptr.p_bool[2*npoints-2] = ae_true; - for(i=0; i<=npoints-1; i++) - { - tmpidx.ptr.p_int[i] = 2*npoints-2; - } - for(mergeidx=npoints-2; mergeidx>=npoints-k; mergeidx--) - { - - /* - * Update information about clusters being present at the moment - */ - presentclusters.ptr.p_bool[npoints+mergeidx] = ae_false; - presentclusters.ptr.p_bool[rep->z.ptr.pp_int[mergeidx][0]] = ae_true; - presentclusters.ptr.p_bool[rep->z.ptr.pp_int[mergeidx][1]] = ae_true; - - /* - * Update TmpIdx according to the current state of the dataset - * - * NOTE: TmpIdx contains cluster indexes from [0..2*NPoints-2]; - * we will convert them to [0..K-1] later. - */ - i0 = rep->pm.ptr.pp_int[mergeidx][0]; - i1 = rep->pm.ptr.pp_int[mergeidx][1]; - t = rep->z.ptr.pp_int[mergeidx][0]; - for(i=i0; i<=i1; i++) - { - tmpidx.ptr.p_int[i] = t; - } - i0 = rep->pm.ptr.pp_int[mergeidx][2]; - i1 = rep->pm.ptr.pp_int[mergeidx][3]; - t = rep->z.ptr.pp_int[mergeidx][1]; - for(i=i0; i<=i1; i++) - { - tmpidx.ptr.p_int[i] = t; - } - } - - /* - * Fill CZ - array which allows us to convert cluster indexes - * from one system to another. - */ - ae_vector_set_length(cz, k, _state); - ae_vector_set_length(&clusterindexes, 2*npoints-1, _state); - t = 0; - for(i=0; i<=2*npoints-2; i++) - { - if( presentclusters.ptr.p_bool[i] ) - { - cz->ptr.p_int[t] = i; - clusterindexes.ptr.p_int[i] = t; - t = t+1; - } - } - ae_assert(t==k, "ClusterizerGetKClusters: internal error", _state); - - /* - * Convert indexes stored in CIdx - */ - ae_vector_set_length(cidx, npoints, _state); - for(i=0; i<=npoints-1; i++) - { - cidx->ptr.p_int[i] = clusterindexes.ptr.p_int[tmpidx.ptr.p_int[rep->p.ptr.p_int[i]]]; - } - ae_frame_leave(_state); -} - - -/************************************************************************* -This function accepts AHC report Rep, desired minimum intercluster -distance and returns top clusters from hierarchical clusterization tree -which are separated by distance R or HIGHER. - -It returns assignment of points to clusters (array of cluster indexes). - -There is one more function with similar name - ClusterizerSeparatedByCorr, -which returns clusters with intercluster correlation equal to R or LOWER -(note: higher for distance, lower for correlation). - -INPUT PARAMETERS: - Rep - report from ClusterizerRunAHC() performed on XY - R - desired minimum intercluster distance, R>=0 - -OUTPUT PARAMETERS: - K - number of clusters, 1<=K<=NPoints - CIdx - array[NPoints], I-th element contains cluster index (from - 0 to K-1) for I-th point of the dataset. - CZ - array[K]. This array allows to convert cluster indexes - returned by this function to indexes used by Rep.Z. J-th - cluster returned by this function corresponds to CZ[J]-th - cluster stored in Rep.Z/PZ/PM. - It is guaranteed that CZ[I]npoints&&ae_fp_greater_eq(rep->mergedist.ptr.p_double[rep->npoints-1-(*k)],r)) - { - *k = *k+1; - } - clusterizergetkclusters(rep, *k, cidx, cz, _state); -} - - -/************************************************************************* -This function accepts AHC report Rep, desired maximum intercluster -correlation and returns top clusters from hierarchical clusterization tree -which are separated by correlation R or LOWER. - -It returns assignment of points to clusters (array of cluster indexes). - -There is one more function with similar name - ClusterizerSeparatedByDist, -which returns clusters with intercluster distance equal to R or HIGHER -(note: higher for distance, lower for correlation). - -INPUT PARAMETERS: - Rep - report from ClusterizerRunAHC() performed on XY - R - desired maximum intercluster correlation, -1<=R<=+1 - -OUTPUT PARAMETERS: - K - number of clusters, 1<=K<=NPoints - CIdx - array[NPoints], I-th element contains cluster index (from - 0 to K-1) for I-th point of the dataset. - CZ - array[K]. This array allows to convert cluster indexes - returned by this function to indexes used by Rep.Z. J-th - cluster returned by this function corresponds to CZ[J]-th - cluster stored in Rep.Z/PZ/PM. - It is guaranteed that CZ[I]npoints&&ae_fp_greater_eq(rep->mergedist.ptr.p_double[rep->npoints-1-(*k)],1-r)) - { - *k = *k+1; - } - clusterizergetkclusters(rep, *k, cidx, cz, _state); -} - - -/************************************************************************* -K-means++ clusterization - -INPUT PARAMETERS: - XY - dataset, array [0..NPoints-1,0..NVars-1]. - NPoints - dataset size, NPoints>=K - NVars - number of variables, NVars>=1 - K - desired number of clusters, K>=1 - Restarts - number of restarts, Restarts>=1 - -OUTPUT PARAMETERS: - Info - return code: - * -3, if task is degenerate (number of distinct points is - less than K) - * -1, if incorrect NPoints/NFeatures/K/Restarts was passed - * 1, if subroutine finished successfully - CCol - array[0..NVars-1,0..K-1].matrix whose columns store - cluster's centers - NeedCCol - True in case caller requires to store result in CCol - CRow - array[0..K-1,0..NVars-1], same as CCol, but centers are - stored in rows - NeedCRow - True in case caller requires to store result in CCol - XYC - array[NPoints], which contains cluster indexes - - -- ALGLIB -- - Copyright 21.03.2009 by Bochkanov Sergey -*************************************************************************/ -void kmeansgenerateinternal(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t k, - ae_int_t maxits, - ae_int_t restarts, - ae_int_t* info, - /* Real */ ae_matrix* ccol, - ae_bool needccol, - /* Real */ ae_matrix* crow, - ae_bool needcrow, - /* Integer */ ae_vector* xyc, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - ae_matrix ct; - ae_matrix ctbest; - ae_vector xycbest; - double e; - double eprev; - double ebest; - ae_vector x; - ae_vector tmp; - ae_vector d2; - ae_vector p; - ae_vector csizes; - ae_vector cbusy; - double v; - ae_int_t cclosest; - double dclosest; - ae_vector work; - ae_bool waschanges; - ae_bool zerosizeclusters; - ae_int_t pass; - ae_int_t itcnt; - hqrndstate rs; - - ae_frame_make(_state, &_frame_block); - *info = 0; - ae_matrix_clear(ccol); - ae_matrix_clear(crow); - ae_vector_clear(xyc); - ae_matrix_init(&ct, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&ctbest, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&xycbest, 0, DT_INT, _state, ae_true); - ae_vector_init(&x, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); - ae_vector_init(&d2, 0, DT_REAL, _state, ae_true); - ae_vector_init(&p, 0, DT_REAL, _state, ae_true); - ae_vector_init(&csizes, 0, DT_INT, _state, ae_true); - ae_vector_init(&cbusy, 0, DT_BOOL, _state, ae_true); - ae_vector_init(&work, 0, DT_REAL, _state, ae_true); - _hqrndstate_init(&rs, _state, ae_true); - - - /* - * Test parameters - */ - if( ((npointsptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); - cbusy.ptr.p_bool[0] = ae_true; - for(i=1; i<=k-1; i++) - { - cbusy.ptr.p_bool[i] = ae_false; - } - if( !clustering_selectcenterpp(xy, npoints, nvars, &ct, &cbusy, k, &d2, &p, &tmp, _state) ) - { - *info = -3; - ae_frame_leave(_state); - return; - } - - /* - * Update centers: - * 2. update center positions - */ - for(i=0; i<=npoints-1; i++) - { - xyc->ptr.p_int[i] = -1; - } - eprev = ae_maxrealnumber; - itcnt = 0; - e = 0; - while(maxits==0||itcntptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); - ae_v_sub(&tmp.ptr.p_double[0], 1, &ct.ptr.pp_double[j][0], 1, ae_v_len(0,nvars-1)); - v = ae_v_dotproduct(&tmp.ptr.p_double[0], 1, &tmp.ptr.p_double[0], 1, ae_v_len(0,nvars-1)); - if( ae_fp_less(v,dclosest) ) - { - cclosest = j; - dclosest = v; - } - } - if( xyc->ptr.p_int[i]!=cclosest ) - { - waschanges = ae_true; - } - xyc->ptr.p_int[i] = cclosest; - } - - /* - * Update centers - */ - for(j=0; j<=k-1; j++) - { - csizes.ptr.p_int[j] = 0; - } - for(i=0; i<=k-1; i++) - { - for(j=0; j<=nvars-1; j++) - { - ct.ptr.pp_double[i][j] = 0; - } - } - for(i=0; i<=npoints-1; i++) - { - csizes.ptr.p_int[xyc->ptr.p_int[i]] = csizes.ptr.p_int[xyc->ptr.p_int[i]]+1; - ae_v_add(&ct.ptr.pp_double[xyc->ptr.p_int[i]][0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); - } - zerosizeclusters = ae_false; - for(j=0; j<=k-1; j++) - { - if( csizes.ptr.p_int[j]!=0 ) - { - v = (double)1/(double)csizes.ptr.p_int[j]; - ae_v_muld(&ct.ptr.pp_double[j][0], 1, ae_v_len(0,nvars-1), v); - } - cbusy.ptr.p_bool[j] = csizes.ptr.p_int[j]!=0; - zerosizeclusters = zerosizeclusters||csizes.ptr.p_int[j]==0; - } - if( zerosizeclusters ) - { - - /* - * Some clusters have zero size - rare, but possible. - * We'll choose new centers for such clusters using k-means++ rule - * and restart algorithm - */ - if( !clustering_selectcenterpp(xy, npoints, nvars, &ct, &cbusy, k, &d2, &p, &tmp, _state) ) - { - *info = -3; - ae_frame_leave(_state); - return; - } - continue; - } - - /* - * Stop if one of two conditions is met: - * 1. nothing has changed during iteration - * 2. energy function increased - */ - e = 0; - for(i=0; i<=npoints-1; i++) - { - ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); - ae_v_sub(&tmp.ptr.p_double[0], 1, &ct.ptr.pp_double[xyc->ptr.p_int[i]][0], 1, ae_v_len(0,nvars-1)); - v = ae_v_dotproduct(&tmp.ptr.p_double[0], 1, &tmp.ptr.p_double[0], 1, ae_v_len(0,nvars-1)); - e = e+v; - } - if( !waschanges||ae_fp_greater_eq(e,eprev) ) - { - break; - } - - /* - * Update EPrev - */ - eprev = e; - } - - /* - * 3. Calculate E, compare with best centers found so far - */ - if( ae_fp_less(e,ebest) ) - { - - /* - * store partition. - */ - ebest = e; - copymatrix(&ct, 0, k-1, 0, nvars-1, &ctbest, 0, k-1, 0, nvars-1, _state); - for(i=0; i<=npoints-1; i++) - { - xycbest.ptr.p_int[i] = xyc->ptr.p_int[i]; - } - } - } - - /* - * Copy and transpose - */ - if( needccol ) - { - ae_matrix_set_length(ccol, nvars, k, _state); - copyandtranspose(&ctbest, 0, k-1, 0, nvars-1, ccol, 0, nvars-1, 0, k-1, _state); - } - if( needcrow ) - { - ae_matrix_set_length(crow, k, nvars, _state); - rmatrixcopy(k, nvars, &ctbest, 0, 0, crow, 0, 0, _state); - } - for(i=0; i<=npoints-1; i++) - { - xyc->ptr.p_int[i] = xycbest.ptr.p_int[i]; - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Select center for a new cluster using k-means++ rule -*************************************************************************/ -static ae_bool clustering_selectcenterpp(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nvars, - /* Real */ ae_matrix* centers, - /* Boolean */ ae_vector* busycenters, - ae_int_t ccnt, - /* Real */ ae_vector* d2, - /* Real */ ae_vector* p, - /* Real */ ae_vector* tmp, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t cc; - double v; - double s; - ae_bool result; - - - result = ae_true; - for(cc=0; cc<=ccnt-1; cc++) - { - if( !busycenters->ptr.p_bool[cc] ) - { - - /* - * fill D2 - */ - for(i=0; i<=npoints-1; i++) - { - d2->ptr.p_double[i] = ae_maxrealnumber; - for(j=0; j<=ccnt-1; j++) - { - if( busycenters->ptr.p_bool[j] ) - { - ae_v_move(&tmp->ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); - ae_v_sub(&tmp->ptr.p_double[0], 1, ¢ers->ptr.pp_double[j][0], 1, ae_v_len(0,nvars-1)); - v = ae_v_dotproduct(&tmp->ptr.p_double[0], 1, &tmp->ptr.p_double[0], 1, ae_v_len(0,nvars-1)); - if( ae_fp_less(v,d2->ptr.p_double[i]) ) - { - d2->ptr.p_double[i] = v; - } - } - } - } - - /* - * calculate P (non-cumulative) - */ - s = 0; - for(i=0; i<=npoints-1; i++) - { - s = s+d2->ptr.p_double[i]; - } - if( ae_fp_eq(s,0) ) - { - result = ae_false; - return result; - } - s = 1/s; - ae_v_moved(&p->ptr.p_double[0], 1, &d2->ptr.p_double[0], 1, ae_v_len(0,npoints-1), s); - - /* - * choose one of points with probability P - * random number within (0,1) is generated and - * inverse empirical CDF is used to randomly choose a point. - */ - s = 0; - v = ae_randomreal(_state); - for(i=0; i<=npoints-1; i++) - { - s = s+p->ptr.p_double[i]; - if( ae_fp_less_eq(v,s)||i==npoints-1 ) - { - ae_v_move(¢ers->ptr.pp_double[cc][0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); - busycenters->ptr.p_bool[cc] = ae_true; - break; - } - } - } - } - return result; -} - - -/************************************************************************* -This function performs agglomerative hierarchical clustering using -precomputed distance matrix. Internal function, should not be called -directly. - -INPUT PARAMETERS: - S - clusterizer state, initialized by ClusterizerCreate() - D - distance matrix, array[S.NFeatures,S.NFeatures] - Contents of the matrix is destroyed during - algorithm operation. - -OUTPUT PARAMETERS: - Rep - clustering results; see description of AHCReport - structure for more information. - - -- ALGLIB -- - Copyright 10.07.2012 by Bochkanov Sergey -*************************************************************************/ -static void clustering_clusterizerrunahcinternal(clusterizerstate* s, - /* Real */ ae_matrix* d, - ahcreport* rep, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - ae_int_t k; - double v; - ae_int_t mergeidx; - ae_int_t c0; - ae_int_t c1; - ae_int_t s0; - ae_int_t s1; - ae_int_t ar; - ae_int_t br; - ae_int_t npoints; - ae_vector cidx; - ae_vector csizes; - ae_vector nnidx; - ae_matrix cinfo; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&cidx, 0, DT_INT, _state, ae_true); - ae_vector_init(&csizes, 0, DT_INT, _state, ae_true); - ae_vector_init(&nnidx, 0, DT_INT, _state, ae_true); - ae_matrix_init(&cinfo, 0, 0, DT_INT, _state, ae_true); - - npoints = s->npoints; - - /* - * Fill Rep.NPoints, quick exit when NPoints<=1 - */ - rep->npoints = npoints; - if( npoints==0 ) - { - ae_vector_set_length(&rep->p, 0, _state); - ae_matrix_set_length(&rep->z, 0, 0, _state); - ae_matrix_set_length(&rep->pz, 0, 0, _state); - ae_matrix_set_length(&rep->pm, 0, 0, _state); - ae_vector_set_length(&rep->mergedist, 0, _state); - ae_frame_leave(_state); - return; - } - if( npoints==1 ) - { - ae_vector_set_length(&rep->p, 1, _state); - ae_matrix_set_length(&rep->z, 0, 0, _state); - ae_matrix_set_length(&rep->pz, 0, 0, _state); - ae_matrix_set_length(&rep->pm, 0, 0, _state); - ae_vector_set_length(&rep->mergedist, 0, _state); - rep->p.ptr.p_int[0] = 0; - ae_frame_leave(_state); - return; - } - ae_matrix_set_length(&rep->z, npoints-1, 2, _state); - ae_vector_set_length(&rep->mergedist, npoints-1, _state); - - /* - * Build list of nearest neighbors - */ - ae_vector_set_length(&nnidx, npoints, _state); - for(i=0; i<=npoints-1; i++) - { - - /* - * Calculate index of the nearest neighbor - */ - k = -1; - v = ae_maxrealnumber; - for(j=0; j<=npoints-1; j++) - { - if( j!=i&&ae_fp_less(d->ptr.pp_double[i][j],v) ) - { - k = j; - v = d->ptr.pp_double[i][j]; - } - } - ae_assert(ae_fp_less(v,ae_maxrealnumber), "ClusterizerRunAHC: internal error", _state); - nnidx.ptr.p_int[i] = k; - } - - /* - * Distance matrix is built, perform merges. - * - * NOTE 1: CIdx is array[NPoints] which maps rows/columns of the - * distance matrix D to indexes of clusters. Values of CIdx - * from [0,NPoints) denote single-point clusters, and values - * from [NPoints,2*NPoints-1) denote ones obtained by merging - * smaller clusters. Negative calues correspond to absent clusters. - * - * Initially it contains [0...NPoints-1], after each merge - * one element of CIdx (one with index C0) is replaced by - * NPoints+MergeIdx, and another one with index C1 is - * rewritten by -1. - * - * NOTE 2: CSizes is array[NPoints] which stores sizes of clusters. - * - */ - ae_vector_set_length(&cidx, npoints, _state); - ae_vector_set_length(&csizes, npoints, _state); - for(i=0; i<=npoints-1; i++) - { - cidx.ptr.p_int[i] = i; - csizes.ptr.p_int[i] = 1; - } - for(mergeidx=0; mergeidx<=npoints-2; mergeidx++) - { - - /* - * Select pair of clusters (C0,C1) with CIdx[C0]=0 ) - { - if( ae_fp_less(d->ptr.pp_double[i][nnidx.ptr.p_int[i]],v) ) - { - c0 = i; - c1 = nnidx.ptr.p_int[i]; - v = d->ptr.pp_double[i][nnidx.ptr.p_int[i]]; - } - } - } - ae_assert(ae_fp_less(v,ae_maxrealnumber), "ClusterizerRunAHC: internal error", _state); - if( cidx.ptr.p_int[c0]>cidx.ptr.p_int[c1] ) - { - i = c1; - c1 = c0; - c0 = i; - } - - /* - * Fill one row of Rep.Z and one element of Rep.MergeDist - */ - rep->z.ptr.pp_int[mergeidx][0] = cidx.ptr.p_int[c0]; - rep->z.ptr.pp_int[mergeidx][1] = cidx.ptr.p_int[c1]; - rep->mergedist.ptr.p_double[mergeidx] = v; - - /* - * Update distance matrix: - * * row/column C0 are updated by distances to the new cluster - * * row/column C1 are considered empty (we can fill them by zeros, - * but do not want to spend time - we just ignore them) - * - * NOTE: it is important to update distance matrix BEFORE CIdx/CSizes - * are updated. - */ - ae_assert(((s->ahcalgo==0||s->ahcalgo==1)||s->ahcalgo==2)||s->ahcalgo==3, "ClusterizerRunAHC: internal error", _state); - for(i=0; i<=npoints-1; i++) - { - if( i!=c0&&i!=c1 ) - { - if( s->ahcalgo==0 ) - { - d->ptr.pp_double[i][c0] = ae_maxreal(d->ptr.pp_double[i][c0], d->ptr.pp_double[i][c1], _state); - } - if( s->ahcalgo==1 ) - { - d->ptr.pp_double[i][c0] = ae_minreal(d->ptr.pp_double[i][c0], d->ptr.pp_double[i][c1], _state); - } - if( s->ahcalgo==2 ) - { - d->ptr.pp_double[i][c0] = (csizes.ptr.p_int[c0]*d->ptr.pp_double[i][c0]+csizes.ptr.p_int[c1]*d->ptr.pp_double[i][c1])/(csizes.ptr.p_int[c0]+csizes.ptr.p_int[c1]); - } - if( s->ahcalgo==3 ) - { - d->ptr.pp_double[i][c0] = (d->ptr.pp_double[i][c0]+d->ptr.pp_double[i][c1])/2; - } - d->ptr.pp_double[c0][i] = d->ptr.pp_double[i][c0]; - } - } - - /* - * Update CIdx and CSizes - */ - cidx.ptr.p_int[c0] = npoints+mergeidx; - cidx.ptr.p_int[c1] = -1; - csizes.ptr.p_int[c0] = csizes.ptr.p_int[c0]+csizes.ptr.p_int[c1]; - csizes.ptr.p_int[c1] = 0; - - /* - * Update nearest neighbors array: - * * update nearest neighbors of everything except for C0/C1 - * * update neighbors of C0/C1 - */ - for(i=0; i<=npoints-1; i++) - { - if( (cidx.ptr.p_int[i]>=0&&i!=c0)&&(nnidx.ptr.p_int[i]==c0||nnidx.ptr.p_int[i]==c1) ) - { - - /* - * I-th cluster which is distinct from C0/C1 has former C0/C1 cluster as its nearest - * neighbor. We handle this issue depending on specific AHC algorithm being used. - */ - if( s->ahcalgo==1 ) - { - - /* - * Single linkage. Merging of two clusters together - * does NOT change distances between new cluster and - * other clusters. - * - * The only thing we have to do is to update nearest neighbor index - */ - nnidx.ptr.p_int[i] = c0; - } - else - { - - /* - * Something other than single linkage. We have to re-examine - * all the row to find nearest neighbor. - */ - k = -1; - v = ae_maxrealnumber; - for(j=0; j<=npoints-1; j++) - { - if( (cidx.ptr.p_int[j]>=0&&j!=i)&&ae_fp_less(d->ptr.pp_double[i][j],v) ) - { - k = j; - v = d->ptr.pp_double[i][j]; - } - } - ae_assert(ae_fp_less(v,ae_maxrealnumber)||mergeidx==npoints-2, "ClusterizerRunAHC: internal error", _state); - nnidx.ptr.p_int[i] = k; - } - } - } - k = -1; - v = ae_maxrealnumber; - for(j=0; j<=npoints-1; j++) - { - if( (cidx.ptr.p_int[j]>=0&&j!=c0)&&ae_fp_less(d->ptr.pp_double[c0][j],v) ) - { - k = j; - v = d->ptr.pp_double[c0][j]; - } - } - ae_assert(ae_fp_less(v,ae_maxrealnumber)||mergeidx==npoints-2, "ClusterizerRunAHC: internal error", _state); - nnidx.ptr.p_int[c0] = k; - } - - /* - * Calculate Rep.P and Rep.PM. - * - * In order to do that, we fill CInfo matrix - (2*NPoints-1)*3 matrix, - * with I-th row containing: - * * CInfo[I,0] - size of I-th cluster - * * CInfo[I,1] - beginning of I-th cluster - * * CInfo[I,2] - end of I-th cluster - * * CInfo[I,3] - height of I-th cluster - * - * We perform it as follows: - * * first NPoints clusters have unit size (CInfo[I,0]=1) and zero - * height (CInfo[I,3]=0) - * * we replay NPoints-1 merges from first to last and fill sizes of - * corresponding clusters (new size is a sum of sizes of clusters - * being merged) and height (new height is max(heights)+1). - * * now we ready to determine locations of clusters. Last cluster - * spans entire dataset, we know it. We replay merges from last to - * first, during each merge we already know location of the merge - * result, and we can position first cluster to the left part of - * the result, and second cluster to the right part. - */ - ae_vector_set_length(&rep->p, npoints, _state); - ae_matrix_set_length(&rep->pm, npoints-1, 6, _state); - ae_matrix_set_length(&cinfo, 2*npoints-1, 4, _state); - for(i=0; i<=npoints-1; i++) - { - cinfo.ptr.pp_int[i][0] = 1; - cinfo.ptr.pp_int[i][3] = 0; - } - for(i=0; i<=npoints-2; i++) - { - cinfo.ptr.pp_int[npoints+i][0] = cinfo.ptr.pp_int[rep->z.ptr.pp_int[i][0]][0]+cinfo.ptr.pp_int[rep->z.ptr.pp_int[i][1]][0]; - cinfo.ptr.pp_int[npoints+i][3] = ae_maxint(cinfo.ptr.pp_int[rep->z.ptr.pp_int[i][0]][3], cinfo.ptr.pp_int[rep->z.ptr.pp_int[i][1]][3], _state)+1; - } - cinfo.ptr.pp_int[2*npoints-2][1] = 0; - cinfo.ptr.pp_int[2*npoints-2][2] = npoints-1; - for(i=npoints-2; i>=0; i--) - { - - /* - * We merge C0 which spans [A0,B0] and C1 (spans [A1,B1]), - * with unknown A0, B0, A1, B1. However, we know that result - * is CR, which spans [AR,BR] with known AR/BR, and we know - * sizes of C0, C1, CR (denotes as S0, S1, SR). - */ - c0 = rep->z.ptr.pp_int[i][0]; - c1 = rep->z.ptr.pp_int[i][1]; - s0 = cinfo.ptr.pp_int[c0][0]; - s1 = cinfo.ptr.pp_int[c1][0]; - ar = cinfo.ptr.pp_int[npoints+i][1]; - br = cinfo.ptr.pp_int[npoints+i][2]; - cinfo.ptr.pp_int[c0][1] = ar; - cinfo.ptr.pp_int[c0][2] = ar+s0-1; - cinfo.ptr.pp_int[c1][1] = br-(s1-1); - cinfo.ptr.pp_int[c1][2] = br; - rep->pm.ptr.pp_int[i][0] = cinfo.ptr.pp_int[c0][1]; - rep->pm.ptr.pp_int[i][1] = cinfo.ptr.pp_int[c0][2]; - rep->pm.ptr.pp_int[i][2] = cinfo.ptr.pp_int[c1][1]; - rep->pm.ptr.pp_int[i][3] = cinfo.ptr.pp_int[c1][2]; - rep->pm.ptr.pp_int[i][4] = cinfo.ptr.pp_int[c0][3]; - rep->pm.ptr.pp_int[i][5] = cinfo.ptr.pp_int[c1][3]; - } - for(i=0; i<=npoints-1; i++) - { - ae_assert(cinfo.ptr.pp_int[i][1]==cinfo.ptr.pp_int[i][2], "Assertion failed", _state); - rep->p.ptr.p_int[i] = cinfo.ptr.pp_int[i][1]; - } - - /* - * Calculate Rep.PZ - */ - ae_matrix_set_length(&rep->pz, npoints-1, 2, _state); - for(i=0; i<=npoints-2; i++) - { - rep->pz.ptr.pp_int[i][0] = rep->z.ptr.pp_int[i][0]; - rep->pz.ptr.pp_int[i][1] = rep->z.ptr.pp_int[i][1]; - if( rep->pz.ptr.pp_int[i][0]pz.ptr.pp_int[i][0] = rep->p.ptr.p_int[rep->pz.ptr.pp_int[i][0]]; - } - if( rep->pz.ptr.pp_int[i][1]pz.ptr.pp_int[i][1] = rep->p.ptr.p_int[rep->pz.ptr.pp_int[i][1]]; - } - } - ae_frame_leave(_state); -} - - -static void clustering_evaluatedistancematrixrec(/* Real */ ae_matrix* xy, - ae_int_t nfeatures, - ae_int_t disttype, - /* Real */ ae_matrix* d, - ae_int_t i0, - ae_int_t i1, - ae_int_t j0, - ae_int_t j1, - ae_state *_state) -{ - double rcomplexity; - ae_int_t len0; - ae_int_t len1; - ae_int_t i; - ae_int_t j; - ae_int_t k; - double v; - double vv; - - - ae_assert(disttype==0||disttype==1, "EvaluateDistanceMatrixRec: incorrect DistType", _state); - - /* - * Normalize J0/J1: - * * J0:=max(J0,I0) - we ignore lower triangle - * * J1:=max(J1,J0) - normalize J1 - */ - j0 = ae_maxint(j0, i0, _state); - j1 = ae_maxint(j1, j0, _state); - if( j1<=j0||i1<=i0 ) - { - return; - } - - /* - * Try to process in parallel. Two condtions must hold in order to - * activate parallel processing: - * 1. I1-I0>2 or J1-J0>2 - * 2. (I1-I0)*(J1-J0)*NFeatures>=ParallelComplexity - * - * NOTE: all quantities are converted to reals in order to avoid - * integer overflow during multiplication - * - * NOTE: strict inequality in (1) is necessary to reduce task to 2x2 - * basecases. In future versions we will be able to handle such - * basecases more efficiently than 1x1 cases. - */ - rcomplexity = i1-i0; - rcomplexity = rcomplexity*(j1-j0); - rcomplexity = rcomplexity*nfeatures; - if( ae_fp_greater_eq(rcomplexity,clustering_parallelcomplexity)&&(i1-i0>2||j1-j0>2) ) - { - - /* - * Recursive division along largest of dimensions - */ - if( i1-i0>j1-j0 ) - { - splitlengtheven(i1-i0, &len0, &len1, _state); - clustering_evaluatedistancematrixrec(xy, nfeatures, disttype, d, i0, i0+len0, j0, j1, _state); - clustering_evaluatedistancematrixrec(xy, nfeatures, disttype, d, i0+len0, i1, j0, j1, _state); - } - else - { - splitlengtheven(j1-j0, &len0, &len1, _state); - clustering_evaluatedistancematrixrec(xy, nfeatures, disttype, d, i0, i1, j0, j0+len0, _state); - clustering_evaluatedistancematrixrec(xy, nfeatures, disttype, d, i0, i1, j0+len0, j1, _state); - } - return; - } - - /* - * Sequential processing - */ - for(i=i0; i<=i1-1; i++) - { - for(j=j0; j<=j1-1; j++) - { - if( j>=i ) - { - v = 0.0; - if( disttype==0 ) - { - for(k=0; k<=nfeatures-1; k++) - { - vv = xy->ptr.pp_double[i][k]-xy->ptr.pp_double[j][k]; - if( ae_fp_less(vv,0) ) - { - vv = -vv; - } - if( ae_fp_greater(vv,v) ) - { - v = vv; - } - } - } - if( disttype==1 ) - { - for(k=0; k<=nfeatures-1; k++) - { - vv = xy->ptr.pp_double[i][k]-xy->ptr.pp_double[j][k]; - if( ae_fp_less(vv,0) ) - { - vv = -vv; - } - v = v+vv; - } - } - d->ptr.pp_double[i][j] = v; - } - } - } -} - - -ae_bool _clusterizerstate_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - clusterizerstate *p = (clusterizerstate*)_p; - ae_touch_ptr((void*)p); - if( !ae_matrix_init(&p->xy, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->d, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _clusterizerstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - clusterizerstate *dst = (clusterizerstate*)_dst; - clusterizerstate *src = (clusterizerstate*)_src; - dst->npoints = src->npoints; - dst->nfeatures = src->nfeatures; - dst->disttype = src->disttype; - if( !ae_matrix_init_copy(&dst->xy, &src->xy, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->d, &src->d, _state, make_automatic) ) - return ae_false; - dst->ahcalgo = src->ahcalgo; - dst->kmeansrestarts = src->kmeansrestarts; - dst->kmeansmaxits = src->kmeansmaxits; - return ae_true; -} - - -void _clusterizerstate_clear(void* _p) -{ - clusterizerstate *p = (clusterizerstate*)_p; - ae_touch_ptr((void*)p); - ae_matrix_clear(&p->xy); - ae_matrix_clear(&p->d); -} - - -void _clusterizerstate_destroy(void* _p) -{ - clusterizerstate *p = (clusterizerstate*)_p; - ae_touch_ptr((void*)p); - ae_matrix_destroy(&p->xy); - ae_matrix_destroy(&p->d); -} - - -ae_bool _ahcreport_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - ahcreport *p = (ahcreport*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->p, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->z, 0, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->pz, 0, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->pm, 0, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->mergedist, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _ahcreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - ahcreport *dst = (ahcreport*)_dst; - ahcreport *src = (ahcreport*)_src; - dst->npoints = src->npoints; - if( !ae_vector_init_copy(&dst->p, &src->p, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->z, &src->z, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->pz, &src->pz, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->pm, &src->pm, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->mergedist, &src->mergedist, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _ahcreport_clear(void* _p) -{ - ahcreport *p = (ahcreport*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->p); - ae_matrix_clear(&p->z); - ae_matrix_clear(&p->pz); - ae_matrix_clear(&p->pm); - ae_vector_clear(&p->mergedist); -} - - -void _ahcreport_destroy(void* _p) -{ - ahcreport *p = (ahcreport*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->p); - ae_matrix_destroy(&p->z); - ae_matrix_destroy(&p->pz); - ae_matrix_destroy(&p->pm); - ae_vector_destroy(&p->mergedist); -} - - -ae_bool _kmeansreport_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - kmeansreport *p = (kmeansreport*)_p; - ae_touch_ptr((void*)p); - if( !ae_matrix_init(&p->c, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->cidx, 0, DT_INT, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _kmeansreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - kmeansreport *dst = (kmeansreport*)_dst; - kmeansreport *src = (kmeansreport*)_src; - dst->npoints = src->npoints; - dst->nfeatures = src->nfeatures; - dst->terminationtype = src->terminationtype; - dst->k = src->k; - if( !ae_matrix_init_copy(&dst->c, &src->c, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->cidx, &src->cidx, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _kmeansreport_clear(void* _p) -{ - kmeansreport *p = (kmeansreport*)_p; - ae_touch_ptr((void*)p); - ae_matrix_clear(&p->c); - ae_vector_clear(&p->cidx); -} - - -void _kmeansreport_destroy(void* _p) -{ - kmeansreport *p = (kmeansreport*)_p; - ae_touch_ptr((void*)p); - ae_matrix_destroy(&p->c); - ae_vector_destroy(&p->cidx); -} - - - - -/************************************************************************* -k-means++ clusterization. -Backward compatibility function, we recommend to use CLUSTERING subpackage -as better replacement. - - -- ALGLIB -- - Copyright 21.03.2009 by Bochkanov Sergey -*************************************************************************/ -void kmeansgenerate(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t k, - ae_int_t restarts, - ae_int_t* info, - /* Real */ ae_matrix* c, - /* Integer */ ae_vector* xyc, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix dummy; - - ae_frame_make(_state, &_frame_block); - *info = 0; - ae_matrix_clear(c); - ae_vector_clear(xyc); - ae_matrix_init(&dummy, 0, 0, DT_REAL, _state, ae_true); - - kmeansgenerateinternal(xy, npoints, nvars, k, 0, restarts, info, c, ae_true, &dummy, ae_false, xyc, _state); - ae_frame_leave(_state); -} - - - - -/************************************************************************* -This subroutine builds random decision forest. - -INPUT PARAMETERS: - XY - training set - NPoints - training set size, NPoints>=1 - NVars - number of independent variables, NVars>=1 - NClasses - task type: - * NClasses=1 - regression task with one - dependent variable - * NClasses>1 - classification task with - NClasses classes. - NTrees - number of trees in a forest, NTrees>=1. - recommended values: 50-100. - R - percent of a training set used to build - individual trees. 01). - * 1, if task has been solved - DF - model built - Rep - training report, contains error on a training set - and out-of-bag estimates of generalization error. - - -- ALGLIB -- - Copyright 19.02.2009 by Bochkanov Sergey -*************************************************************************/ -void dfbuildrandomdecisionforest(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t nclasses, - ae_int_t ntrees, - double r, - ae_int_t* info, - decisionforest* df, - dfreport* rep, - ae_state *_state) -{ - ae_int_t samplesize; - - *info = 0; - _decisionforest_clear(df); - _dfreport_clear(rep); - - if( ae_fp_less_eq(r,0)||ae_fp_greater(r,1) ) - { - *info = -1; - return; - } - samplesize = ae_maxint(ae_round(r*npoints, _state), 1, _state); - dfbuildinternal(xy, npoints, nvars, nclasses, ntrees, samplesize, ae_maxint(nvars/2, 1, _state), dforest_dfusestrongsplits+dforest_dfuseevs, info, df, rep, _state); -} - - -/************************************************************************* -This subroutine builds random decision forest. -This function gives ability to tune number of variables used when choosing -best split. - -INPUT PARAMETERS: - XY - training set - NPoints - training set size, NPoints>=1 - NVars - number of independent variables, NVars>=1 - NClasses - task type: - * NClasses=1 - regression task with one - dependent variable - * NClasses>1 - classification task with - NClasses classes. - NTrees - number of trees in a forest, NTrees>=1. - recommended values: 50-100. - NRndVars - number of variables used when choosing best split - R - percent of a training set used to build - individual trees. 01). - * 1, if task has been solved - DF - model built - Rep - training report, contains error on a training set - and out-of-bag estimates of generalization error. - - -- ALGLIB -- - Copyright 19.02.2009 by Bochkanov Sergey -*************************************************************************/ -void dfbuildrandomdecisionforestx1(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t nclasses, - ae_int_t ntrees, - ae_int_t nrndvars, - double r, - ae_int_t* info, - decisionforest* df, - dfreport* rep, - ae_state *_state) -{ - ae_int_t samplesize; - - *info = 0; - _decisionforest_clear(df); - _dfreport_clear(rep); - - if( ae_fp_less_eq(r,0)||ae_fp_greater(r,1) ) - { - *info = -1; - return; - } - if( nrndvars<=0||nrndvars>nvars ) - { - *info = -1; - return; - } - samplesize = ae_maxint(ae_round(r*npoints, _state), 1, _state); - dfbuildinternal(xy, npoints, nvars, nclasses, ntrees, samplesize, nrndvars, dforest_dfusestrongsplits+dforest_dfuseevs, info, df, rep, _state); -} - - -void dfbuildinternal(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t nclasses, - ae_int_t ntrees, - ae_int_t samplesize, - ae_int_t nfeatures, - ae_int_t flags, - ae_int_t* info, - decisionforest* df, - dfreport* rep, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t tmpi; - ae_int_t lasttreeoffs; - ae_int_t offs; - ae_int_t ooboffs; - ae_int_t treesize; - ae_int_t nvarsinpool; - ae_bool useevs; - dfinternalbuffers bufs; - ae_vector permbuf; - ae_vector oobbuf; - ae_vector oobcntbuf; - ae_matrix xys; - ae_vector x; - ae_vector y; - ae_int_t oobcnt; - ae_int_t oobrelcnt; - double v; - double vmin; - double vmax; - ae_bool bflag; - hqrndstate rs; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _decisionforest_clear(df); - _dfreport_clear(rep); - _dfinternalbuffers_init(&bufs, _state, ae_true); - ae_vector_init(&permbuf, 0, DT_INT, _state, ae_true); - ae_vector_init(&oobbuf, 0, DT_REAL, _state, ae_true); - ae_vector_init(&oobcntbuf, 0, DT_INT, _state, ae_true); - ae_matrix_init(&xys, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&x, 0, DT_REAL, _state, ae_true); - ae_vector_init(&y, 0, DT_REAL, _state, ae_true); - _hqrndstate_init(&rs, _state, ae_true); - - - /* - * Test for inputs - */ - if( (((((npoints<1||samplesize<1)||samplesize>npoints)||nvars<1)||nclasses<1)||ntrees<1)||nfeatures<1 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - if( nclasses>1 ) - { - for(i=0; i<=npoints-1; i++) - { - if( ae_round(xy->ptr.pp_double[i][nvars], _state)<0||ae_round(xy->ptr.pp_double[i][nvars], _state)>=nclasses ) - { - *info = -2; - ae_frame_leave(_state); - return; - } - } - } - *info = 1; - - /* - * Flags - */ - useevs = flags/dforest_dfuseevs%2!=0; - - /* - * Allocate data, prepare header - */ - treesize = 1+dforest_innernodewidth*(samplesize-1)+dforest_leafnodewidth*samplesize; - ae_vector_set_length(&permbuf, npoints-1+1, _state); - ae_vector_set_length(&bufs.treebuf, treesize-1+1, _state); - ae_vector_set_length(&bufs.idxbuf, npoints-1+1, _state); - ae_vector_set_length(&bufs.tmpbufr, npoints-1+1, _state); - ae_vector_set_length(&bufs.tmpbufr2, npoints-1+1, _state); - ae_vector_set_length(&bufs.tmpbufi, npoints-1+1, _state); - ae_vector_set_length(&bufs.sortrbuf, npoints, _state); - ae_vector_set_length(&bufs.sortrbuf2, npoints, _state); - ae_vector_set_length(&bufs.sortibuf, npoints, _state); - ae_vector_set_length(&bufs.varpool, nvars-1+1, _state); - ae_vector_set_length(&bufs.evsbin, nvars-1+1, _state); - ae_vector_set_length(&bufs.evssplits, nvars-1+1, _state); - ae_vector_set_length(&bufs.classibuf, 2*nclasses-1+1, _state); - ae_vector_set_length(&oobbuf, nclasses*npoints-1+1, _state); - ae_vector_set_length(&oobcntbuf, npoints-1+1, _state); - ae_vector_set_length(&df->trees, ntrees*treesize-1+1, _state); - ae_matrix_set_length(&xys, samplesize-1+1, nvars+1, _state); - ae_vector_set_length(&x, nvars-1+1, _state); - ae_vector_set_length(&y, nclasses-1+1, _state); - for(i=0; i<=npoints-1; i++) - { - permbuf.ptr.p_int[i] = i; - } - for(i=0; i<=npoints*nclasses-1; i++) - { - oobbuf.ptr.p_double[i] = 0; - } - for(i=0; i<=npoints-1; i++) - { - oobcntbuf.ptr.p_int[i] = 0; - } - - /* - * Prepare variable pool and EVS (extended variable selection/splitting) buffers - * (whether EVS is turned on or not): - * 1. detect binary variables and pre-calculate splits for them - * 2. detect variables with non-distinct values and exclude them from pool - */ - for(i=0; i<=nvars-1; i++) - { - bufs.varpool.ptr.p_int[i] = i; - } - nvarsinpool = nvars; - if( useevs ) - { - for(j=0; j<=nvars-1; j++) - { - vmin = xy->ptr.pp_double[0][j]; - vmax = vmin; - for(i=0; i<=npoints-1; i++) - { - v = xy->ptr.pp_double[i][j]; - vmin = ae_minreal(vmin, v, _state); - vmax = ae_maxreal(vmax, v, _state); - } - if( ae_fp_eq(vmin,vmax) ) - { - - /* - * exclude variable from pool - */ - bufs.varpool.ptr.p_int[j] = bufs.varpool.ptr.p_int[nvarsinpool-1]; - bufs.varpool.ptr.p_int[nvarsinpool-1] = -1; - nvarsinpool = nvarsinpool-1; - continue; - } - bflag = ae_false; - for(i=0; i<=npoints-1; i++) - { - v = xy->ptr.pp_double[i][j]; - if( ae_fp_neq(v,vmin)&&ae_fp_neq(v,vmax) ) - { - bflag = ae_true; - break; - } - } - if( bflag ) - { - - /* - * non-binary variable - */ - bufs.evsbin.ptr.p_bool[j] = ae_false; - } - else - { - - /* - * Prepare - */ - bufs.evsbin.ptr.p_bool[j] = ae_true; - bufs.evssplits.ptr.p_double[j] = 0.5*(vmin+vmax); - if( ae_fp_less_eq(bufs.evssplits.ptr.p_double[j],vmin) ) - { - bufs.evssplits.ptr.p_double[j] = vmax; - } - } - } - } - - /* - * RANDOM FOREST FORMAT - * W[0] - size of array - * W[1] - version number - * W[2] - NVars - * W[3] - NClasses (1 for regression) - * W[4] - NTrees - * W[5] - trees offset - * - * - * TREE FORMAT - * W[Offs] - size of sub-array - * node info: - * W[K+0] - variable number (-1 for leaf mode) - * W[K+1] - threshold (class/value for leaf node) - * W[K+2] - ">=" branch index (absent for leaf node) - * - */ - df->nvars = nvars; - df->nclasses = nclasses; - df->ntrees = ntrees; - - /* - * Build forest - */ - hqrndrandomize(&rs, _state); - offs = 0; - for(i=0; i<=ntrees-1; i++) - { - - /* - * Prepare sample - */ - for(k=0; k<=samplesize-1; k++) - { - j = k+hqrnduniformi(&rs, npoints-k, _state); - tmpi = permbuf.ptr.p_int[k]; - permbuf.ptr.p_int[k] = permbuf.ptr.p_int[j]; - permbuf.ptr.p_int[j] = tmpi; - j = permbuf.ptr.p_int[k]; - ae_v_move(&xys.ptr.pp_double[k][0], 1, &xy->ptr.pp_double[j][0], 1, ae_v_len(0,nvars)); - } - - /* - * build tree, copy - */ - dforest_dfbuildtree(&xys, samplesize, nvars, nclasses, nfeatures, nvarsinpool, flags, &bufs, &rs, _state); - j = ae_round(bufs.treebuf.ptr.p_double[0], _state); - ae_v_move(&df->trees.ptr.p_double[offs], 1, &bufs.treebuf.ptr.p_double[0], 1, ae_v_len(offs,offs+j-1)); - lasttreeoffs = offs; - offs = offs+j; - - /* - * OOB estimates - */ - for(k=samplesize; k<=npoints-1; k++) - { - for(j=0; j<=nclasses-1; j++) - { - y.ptr.p_double[j] = 0; - } - j = permbuf.ptr.p_int[k]; - ae_v_move(&x.ptr.p_double[0], 1, &xy->ptr.pp_double[j][0], 1, ae_v_len(0,nvars-1)); - dforest_dfprocessinternal(df, lasttreeoffs, &x, &y, _state); - ae_v_add(&oobbuf.ptr.p_double[j*nclasses], 1, &y.ptr.p_double[0], 1, ae_v_len(j*nclasses,(j+1)*nclasses-1)); - oobcntbuf.ptr.p_int[j] = oobcntbuf.ptr.p_int[j]+1; - } - } - df->bufsize = offs; - - /* - * Normalize OOB results - */ - for(i=0; i<=npoints-1; i++) - { - if( oobcntbuf.ptr.p_int[i]!=0 ) - { - v = (double)1/(double)oobcntbuf.ptr.p_int[i]; - ae_v_muld(&oobbuf.ptr.p_double[i*nclasses], 1, ae_v_len(i*nclasses,i*nclasses+nclasses-1), v); - } - } - - /* - * Calculate training set estimates - */ - rep->relclserror = dfrelclserror(df, xy, npoints, _state); - rep->avgce = dfavgce(df, xy, npoints, _state); - rep->rmserror = dfrmserror(df, xy, npoints, _state); - rep->avgerror = dfavgerror(df, xy, npoints, _state); - rep->avgrelerror = dfavgrelerror(df, xy, npoints, _state); - - /* - * Calculate OOB estimates. - */ - rep->oobrelclserror = 0; - rep->oobavgce = 0; - rep->oobrmserror = 0; - rep->oobavgerror = 0; - rep->oobavgrelerror = 0; - oobcnt = 0; - oobrelcnt = 0; - for(i=0; i<=npoints-1; i++) - { - if( oobcntbuf.ptr.p_int[i]!=0 ) - { - ooboffs = i*nclasses; - if( nclasses>1 ) - { - - /* - * classification-specific code - */ - k = ae_round(xy->ptr.pp_double[i][nvars], _state); - tmpi = 0; - for(j=1; j<=nclasses-1; j++) - { - if( ae_fp_greater(oobbuf.ptr.p_double[ooboffs+j],oobbuf.ptr.p_double[ooboffs+tmpi]) ) - { - tmpi = j; - } - } - if( tmpi!=k ) - { - rep->oobrelclserror = rep->oobrelclserror+1; - } - if( ae_fp_neq(oobbuf.ptr.p_double[ooboffs+k],0) ) - { - rep->oobavgce = rep->oobavgce-ae_log(oobbuf.ptr.p_double[ooboffs+k], _state); - } - else - { - rep->oobavgce = rep->oobavgce-ae_log(ae_minrealnumber, _state); - } - for(j=0; j<=nclasses-1; j++) - { - if( j==k ) - { - rep->oobrmserror = rep->oobrmserror+ae_sqr(oobbuf.ptr.p_double[ooboffs+j]-1, _state); - rep->oobavgerror = rep->oobavgerror+ae_fabs(oobbuf.ptr.p_double[ooboffs+j]-1, _state); - rep->oobavgrelerror = rep->oobavgrelerror+ae_fabs(oobbuf.ptr.p_double[ooboffs+j]-1, _state); - oobrelcnt = oobrelcnt+1; - } - else - { - rep->oobrmserror = rep->oobrmserror+ae_sqr(oobbuf.ptr.p_double[ooboffs+j], _state); - rep->oobavgerror = rep->oobavgerror+ae_fabs(oobbuf.ptr.p_double[ooboffs+j], _state); - } - } - } - else - { - - /* - * regression-specific code - */ - rep->oobrmserror = rep->oobrmserror+ae_sqr(oobbuf.ptr.p_double[ooboffs]-xy->ptr.pp_double[i][nvars], _state); - rep->oobavgerror = rep->oobavgerror+ae_fabs(oobbuf.ptr.p_double[ooboffs]-xy->ptr.pp_double[i][nvars], _state); - if( ae_fp_neq(xy->ptr.pp_double[i][nvars],0) ) - { - rep->oobavgrelerror = rep->oobavgrelerror+ae_fabs((oobbuf.ptr.p_double[ooboffs]-xy->ptr.pp_double[i][nvars])/xy->ptr.pp_double[i][nvars], _state); - oobrelcnt = oobrelcnt+1; - } - } - - /* - * update OOB estimates count. - */ - oobcnt = oobcnt+1; - } - } - if( oobcnt>0 ) - { - rep->oobrelclserror = rep->oobrelclserror/oobcnt; - rep->oobavgce = rep->oobavgce/oobcnt; - rep->oobrmserror = ae_sqrt(rep->oobrmserror/(oobcnt*nclasses), _state); - rep->oobavgerror = rep->oobavgerror/(oobcnt*nclasses); - if( oobrelcnt>0 ) - { - rep->oobavgrelerror = rep->oobavgrelerror/oobrelcnt; - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Procesing - -INPUT PARAMETERS: - DF - decision forest model - X - input vector, array[0..NVars-1]. - -OUTPUT PARAMETERS: - Y - result. Regression estimate when solving regression task, - vector of posterior probabilities for classification task. - -See also DFProcessI. - - -- ALGLIB -- - Copyright 16.02.2009 by Bochkanov Sergey -*************************************************************************/ -void dfprocess(decisionforest* df, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state) -{ - ae_int_t offs; - ae_int_t i; - double v; - - - - /* - * Proceed - */ - if( y->cntnclasses ) - { - ae_vector_set_length(y, df->nclasses, _state); - } - offs = 0; - for(i=0; i<=df->nclasses-1; i++) - { - y->ptr.p_double[i] = 0; - } - for(i=0; i<=df->ntrees-1; i++) - { - - /* - * Process basic tree - */ - dforest_dfprocessinternal(df, offs, x, y, _state); - - /* - * Next tree - */ - offs = offs+ae_round(df->trees.ptr.p_double[offs], _state); - } - v = (double)1/(double)df->ntrees; - ae_v_muld(&y->ptr.p_double[0], 1, ae_v_len(0,df->nclasses-1), v); -} - - -/************************************************************************* -'interactive' variant of DFProcess for languages like Python which support -constructs like "Y = DFProcessI(DF,X)" and interactive mode of interpreter - -This function allocates new array on each call, so it is significantly -slower than its 'non-interactive' counterpart, but it is more convenient -when you call it from command line. - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void dfprocessi(decisionforest* df, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state) -{ - - ae_vector_clear(y); - - dfprocess(df, x, y, _state); -} - - -/************************************************************************* -Relative classification error on the test set - -INPUT PARAMETERS: - DF - decision forest model - XY - test set - NPoints - test set size - -RESULT: - percent of incorrectly classified cases. - Zero if model solves regression task. - - -- ALGLIB -- - Copyright 16.02.2009 by Bochkanov Sergey -*************************************************************************/ -double dfrelclserror(decisionforest* df, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - double result; - - - result = (double)dforest_dfclserror(df, xy, npoints, _state)/(double)npoints; - return result; -} - - -/************************************************************************* -Average cross-entropy (in bits per element) on the test set - -INPUT PARAMETERS: - DF - decision forest model - XY - test set - NPoints - test set size - -RESULT: - CrossEntropy/(NPoints*LN(2)). - Zero if model solves regression task. - - -- ALGLIB -- - Copyright 16.02.2009 by Bochkanov Sergey -*************************************************************************/ -double dfavgce(decisionforest* df, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector x; - ae_vector y; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t tmpi; - double result; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&x, 0, DT_REAL, _state, ae_true); - ae_vector_init(&y, 0, DT_REAL, _state, ae_true); - - ae_vector_set_length(&x, df->nvars-1+1, _state); - ae_vector_set_length(&y, df->nclasses-1+1, _state); - result = 0; - for(i=0; i<=npoints-1; i++) - { - ae_v_move(&x.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,df->nvars-1)); - dfprocess(df, &x, &y, _state); - if( df->nclasses>1 ) - { - - /* - * classification-specific code - */ - k = ae_round(xy->ptr.pp_double[i][df->nvars], _state); - tmpi = 0; - for(j=1; j<=df->nclasses-1; j++) - { - if( ae_fp_greater(y.ptr.p_double[j],y.ptr.p_double[tmpi]) ) - { - tmpi = j; - } - } - if( ae_fp_neq(y.ptr.p_double[k],0) ) - { - result = result-ae_log(y.ptr.p_double[k], _state); - } - else - { - result = result-ae_log(ae_minrealnumber, _state); - } - } - } - result = result/npoints; - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -RMS error on the test set - -INPUT PARAMETERS: - DF - decision forest model - XY - test set - NPoints - test set size - -RESULT: - root mean square error. - Its meaning for regression task is obvious. As for - classification task, RMS error means error when estimating posterior - probabilities. - - -- ALGLIB -- - Copyright 16.02.2009 by Bochkanov Sergey -*************************************************************************/ -double dfrmserror(decisionforest* df, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector x; - ae_vector y; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t tmpi; - double result; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&x, 0, DT_REAL, _state, ae_true); - ae_vector_init(&y, 0, DT_REAL, _state, ae_true); - - ae_vector_set_length(&x, df->nvars-1+1, _state); - ae_vector_set_length(&y, df->nclasses-1+1, _state); - result = 0; - for(i=0; i<=npoints-1; i++) - { - ae_v_move(&x.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,df->nvars-1)); - dfprocess(df, &x, &y, _state); - if( df->nclasses>1 ) - { - - /* - * classification-specific code - */ - k = ae_round(xy->ptr.pp_double[i][df->nvars], _state); - tmpi = 0; - for(j=1; j<=df->nclasses-1; j++) - { - if( ae_fp_greater(y.ptr.p_double[j],y.ptr.p_double[tmpi]) ) - { - tmpi = j; - } - } - for(j=0; j<=df->nclasses-1; j++) - { - if( j==k ) - { - result = result+ae_sqr(y.ptr.p_double[j]-1, _state); - } - else - { - result = result+ae_sqr(y.ptr.p_double[j], _state); - } - } - } - else - { - - /* - * regression-specific code - */ - result = result+ae_sqr(y.ptr.p_double[0]-xy->ptr.pp_double[i][df->nvars], _state); - } - } - result = ae_sqrt(result/(npoints*df->nclasses), _state); - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Average error on the test set - -INPUT PARAMETERS: - DF - decision forest model - XY - test set - NPoints - test set size - -RESULT: - Its meaning for regression task is obvious. As for - classification task, it means average error when estimating posterior - probabilities. - - -- ALGLIB -- - Copyright 16.02.2009 by Bochkanov Sergey -*************************************************************************/ -double dfavgerror(decisionforest* df, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector x; - ae_vector y; - ae_int_t i; - ae_int_t j; - ae_int_t k; - double result; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&x, 0, DT_REAL, _state, ae_true); - ae_vector_init(&y, 0, DT_REAL, _state, ae_true); - - ae_vector_set_length(&x, df->nvars-1+1, _state); - ae_vector_set_length(&y, df->nclasses-1+1, _state); - result = 0; - for(i=0; i<=npoints-1; i++) - { - ae_v_move(&x.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,df->nvars-1)); - dfprocess(df, &x, &y, _state); - if( df->nclasses>1 ) - { - - /* - * classification-specific code - */ - k = ae_round(xy->ptr.pp_double[i][df->nvars], _state); - for(j=0; j<=df->nclasses-1; j++) - { - if( j==k ) - { - result = result+ae_fabs(y.ptr.p_double[j]-1, _state); - } - else - { - result = result+ae_fabs(y.ptr.p_double[j], _state); - } - } - } - else - { - - /* - * regression-specific code - */ - result = result+ae_fabs(y.ptr.p_double[0]-xy->ptr.pp_double[i][df->nvars], _state); - } - } - result = result/(npoints*df->nclasses); - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Average relative error on the test set - -INPUT PARAMETERS: - DF - decision forest model - XY - test set - NPoints - test set size - -RESULT: - Its meaning for regression task is obvious. As for - classification task, it means average relative error when estimating - posterior probability of belonging to the correct class. - - -- ALGLIB -- - Copyright 16.02.2009 by Bochkanov Sergey -*************************************************************************/ -double dfavgrelerror(decisionforest* df, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector x; - ae_vector y; - ae_int_t relcnt; - ae_int_t i; - ae_int_t j; - ae_int_t k; - double result; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&x, 0, DT_REAL, _state, ae_true); - ae_vector_init(&y, 0, DT_REAL, _state, ae_true); - - ae_vector_set_length(&x, df->nvars-1+1, _state); - ae_vector_set_length(&y, df->nclasses-1+1, _state); - result = 0; - relcnt = 0; - for(i=0; i<=npoints-1; i++) - { - ae_v_move(&x.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,df->nvars-1)); - dfprocess(df, &x, &y, _state); - if( df->nclasses>1 ) - { - - /* - * classification-specific code - */ - k = ae_round(xy->ptr.pp_double[i][df->nvars], _state); - for(j=0; j<=df->nclasses-1; j++) - { - if( j==k ) - { - result = result+ae_fabs(y.ptr.p_double[j]-1, _state); - relcnt = relcnt+1; - } - } - } - else - { - - /* - * regression-specific code - */ - if( ae_fp_neq(xy->ptr.pp_double[i][df->nvars],0) ) - { - result = result+ae_fabs((y.ptr.p_double[0]-xy->ptr.pp_double[i][df->nvars])/xy->ptr.pp_double[i][df->nvars], _state); - relcnt = relcnt+1; - } - } - } - if( relcnt>0 ) - { - result = result/relcnt; - } - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Copying of DecisionForest strucure - -INPUT PARAMETERS: - DF1 - original - -OUTPUT PARAMETERS: - DF2 - copy - - -- ALGLIB -- - Copyright 13.02.2009 by Bochkanov Sergey -*************************************************************************/ -void dfcopy(decisionforest* df1, decisionforest* df2, ae_state *_state) -{ - - _decisionforest_clear(df2); - - df2->nvars = df1->nvars; - df2->nclasses = df1->nclasses; - df2->ntrees = df1->ntrees; - df2->bufsize = df1->bufsize; - ae_vector_set_length(&df2->trees, df1->bufsize-1+1, _state); - ae_v_move(&df2->trees.ptr.p_double[0], 1, &df1->trees.ptr.p_double[0], 1, ae_v_len(0,df1->bufsize-1)); -} - - -/************************************************************************* -Serializer: allocation - - -- ALGLIB -- - Copyright 14.03.2011 by Bochkanov Sergey -*************************************************************************/ -void dfalloc(ae_serializer* s, decisionforest* forest, ae_state *_state) -{ - - - ae_serializer_alloc_entry(s); - ae_serializer_alloc_entry(s); - ae_serializer_alloc_entry(s); - ae_serializer_alloc_entry(s); - ae_serializer_alloc_entry(s); - ae_serializer_alloc_entry(s); - allocrealarray(s, &forest->trees, forest->bufsize, _state); -} - - -/************************************************************************* -Serializer: serialization - - -- ALGLIB -- - Copyright 14.03.2011 by Bochkanov Sergey -*************************************************************************/ -void dfserialize(ae_serializer* s, - decisionforest* forest, - ae_state *_state) -{ - - - ae_serializer_serialize_int(s, getrdfserializationcode(_state), _state); - ae_serializer_serialize_int(s, dforest_dffirstversion, _state); - ae_serializer_serialize_int(s, forest->nvars, _state); - ae_serializer_serialize_int(s, forest->nclasses, _state); - ae_serializer_serialize_int(s, forest->ntrees, _state); - ae_serializer_serialize_int(s, forest->bufsize, _state); - serializerealarray(s, &forest->trees, forest->bufsize, _state); -} - - -/************************************************************************* -Serializer: unserialization - - -- ALGLIB -- - Copyright 14.03.2011 by Bochkanov Sergey -*************************************************************************/ -void dfunserialize(ae_serializer* s, - decisionforest* forest, - ae_state *_state) -{ - ae_int_t i0; - ae_int_t i1; - - _decisionforest_clear(forest); - - - /* - * check correctness of header - */ - ae_serializer_unserialize_int(s, &i0, _state); - ae_assert(i0==getrdfserializationcode(_state), "DFUnserialize: stream header corrupted", _state); - ae_serializer_unserialize_int(s, &i1, _state); - ae_assert(i1==dforest_dffirstversion, "DFUnserialize: stream header corrupted", _state); - - /* - * Unserialize data - */ - ae_serializer_unserialize_int(s, &forest->nvars, _state); - ae_serializer_unserialize_int(s, &forest->nclasses, _state); - ae_serializer_unserialize_int(s, &forest->ntrees, _state); - ae_serializer_unserialize_int(s, &forest->bufsize, _state); - unserializerealarray(s, &forest->trees, _state); -} - - -/************************************************************************* -Classification error -*************************************************************************/ -static ae_int_t dforest_dfclserror(decisionforest* df, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector x; - ae_vector y; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t tmpi; - ae_int_t result; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&x, 0, DT_REAL, _state, ae_true); - ae_vector_init(&y, 0, DT_REAL, _state, ae_true); - - if( df->nclasses<=1 ) - { - result = 0; - ae_frame_leave(_state); - return result; - } - ae_vector_set_length(&x, df->nvars-1+1, _state); - ae_vector_set_length(&y, df->nclasses-1+1, _state); - result = 0; - for(i=0; i<=npoints-1; i++) - { - ae_v_move(&x.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,df->nvars-1)); - dfprocess(df, &x, &y, _state); - k = ae_round(xy->ptr.pp_double[i][df->nvars], _state); - tmpi = 0; - for(j=1; j<=df->nclasses-1; j++) - { - if( ae_fp_greater(y.ptr.p_double[j],y.ptr.p_double[tmpi]) ) - { - tmpi = j; - } - } - if( tmpi!=k ) - { - result = result+1; - } - } - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Internal subroutine for processing one decision tree starting at Offs -*************************************************************************/ -static void dforest_dfprocessinternal(decisionforest* df, - ae_int_t offs, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state) -{ - ae_int_t k; - ae_int_t idx; - - - - /* - * Set pointer to the root - */ - k = offs+1; - - /* - * Navigate through the tree - */ - for(;;) - { - if( ae_fp_eq(df->trees.ptr.p_double[k],-1) ) - { - if( df->nclasses==1 ) - { - y->ptr.p_double[0] = y->ptr.p_double[0]+df->trees.ptr.p_double[k+1]; - } - else - { - idx = ae_round(df->trees.ptr.p_double[k+1], _state); - y->ptr.p_double[idx] = y->ptr.p_double[idx]+1; - } - break; - } - if( ae_fp_less(x->ptr.p_double[ae_round(df->trees.ptr.p_double[k], _state)],df->trees.ptr.p_double[k+1]) ) - { - k = k+dforest_innernodewidth; - } - else - { - k = offs+ae_round(df->trees.ptr.p_double[k+2], _state); - } - } -} - - -/************************************************************************* -Builds one decision tree. Just a wrapper for the DFBuildTreeRec. -*************************************************************************/ -static void dforest_dfbuildtree(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t nclasses, - ae_int_t nfeatures, - ae_int_t nvarsinpool, - ae_int_t flags, - dfinternalbuffers* bufs, - hqrndstate* rs, - ae_state *_state) -{ - ae_int_t numprocessed; - ae_int_t i; - - - ae_assert(npoints>0, "Assertion failed", _state); - - /* - * Prepare IdxBuf. It stores indices of the training set elements. - * When training set is being split, contents of IdxBuf is - * correspondingly reordered so we can know which elements belong - * to which branch of decision tree. - */ - for(i=0; i<=npoints-1; i++) - { - bufs->idxbuf.ptr.p_int[i] = i; - } - - /* - * Recursive procedure - */ - numprocessed = 1; - dforest_dfbuildtreerec(xy, npoints, nvars, nclasses, nfeatures, nvarsinpool, flags, &numprocessed, 0, npoints-1, bufs, rs, _state); - bufs->treebuf.ptr.p_double[0] = numprocessed; -} - - -/************************************************************************* -Builds one decision tree (internal recursive subroutine) - -Parameters: - TreeBuf - large enough array, at least TreeSize - IdxBuf - at least NPoints elements - TmpBufR - at least NPoints - TmpBufR2 - at least NPoints - TmpBufI - at least NPoints - TmpBufI2 - at least NPoints+1 -*************************************************************************/ -static void dforest_dfbuildtreerec(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t nclasses, - ae_int_t nfeatures, - ae_int_t nvarsinpool, - ae_int_t flags, - ae_int_t* numprocessed, - ae_int_t idx1, - ae_int_t idx2, - dfinternalbuffers* bufs, - hqrndstate* rs, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_bool bflag; - ae_int_t i1; - ae_int_t i2; - ae_int_t info; - double sl; - double sr; - double w; - ae_int_t idxbest; - double ebest; - double tbest; - ae_int_t varcur; - double s; - double v; - double v1; - double v2; - double threshold; - ae_int_t oldnp; - double currms; - ae_bool useevs; - - - - /* - * these initializers are not really necessary, - * but without them compiler complains about uninitialized locals - */ - tbest = 0; - - /* - * Prepare - */ - ae_assert(npoints>0, "Assertion failed", _state); - ae_assert(idx2>=idx1, "Assertion failed", _state); - useevs = flags/dforest_dfuseevs%2!=0; - - /* - * Leaf node - */ - if( idx2==idx1 ) - { - bufs->treebuf.ptr.p_double[*numprocessed] = -1; - bufs->treebuf.ptr.p_double[*numprocessed+1] = xy->ptr.pp_double[bufs->idxbuf.ptr.p_int[idx1]][nvars]; - *numprocessed = *numprocessed+dforest_leafnodewidth; - return; - } - - /* - * Non-leaf node. - * Select random variable, prepare split: - * 1. prepare default solution - no splitting, class at random - * 2. investigate possible splits, compare with default/best - */ - idxbest = -1; - if( nclasses>1 ) - { - - /* - * default solution for classification - */ - for(i=0; i<=nclasses-1; i++) - { - bufs->classibuf.ptr.p_int[i] = 0; - } - s = idx2-idx1+1; - for(i=idx1; i<=idx2; i++) - { - j = ae_round(xy->ptr.pp_double[bufs->idxbuf.ptr.p_int[i]][nvars], _state); - bufs->classibuf.ptr.p_int[j] = bufs->classibuf.ptr.p_int[j]+1; - } - ebest = 0; - for(i=0; i<=nclasses-1; i++) - { - ebest = ebest+bufs->classibuf.ptr.p_int[i]*ae_sqr(1-bufs->classibuf.ptr.p_int[i]/s, _state)+(s-bufs->classibuf.ptr.p_int[i])*ae_sqr(bufs->classibuf.ptr.p_int[i]/s, _state); - } - ebest = ae_sqrt(ebest/(nclasses*(idx2-idx1+1)), _state); - } - else - { - - /* - * default solution for regression - */ - v = 0; - for(i=idx1; i<=idx2; i++) - { - v = v+xy->ptr.pp_double[bufs->idxbuf.ptr.p_int[i]][nvars]; - } - v = v/(idx2-idx1+1); - ebest = 0; - for(i=idx1; i<=idx2; i++) - { - ebest = ebest+ae_sqr(xy->ptr.pp_double[bufs->idxbuf.ptr.p_int[i]][nvars]-v, _state); - } - ebest = ae_sqrt(ebest/(idx2-idx1+1), _state); - } - i = 0; - while(i<=ae_minint(nfeatures, nvarsinpool, _state)-1) - { - - /* - * select variables from pool - */ - j = i+hqrnduniformi(rs, nvarsinpool-i, _state); - k = bufs->varpool.ptr.p_int[i]; - bufs->varpool.ptr.p_int[i] = bufs->varpool.ptr.p_int[j]; - bufs->varpool.ptr.p_int[j] = k; - varcur = bufs->varpool.ptr.p_int[i]; - - /* - * load variable values to working array - * - * apply EVS preprocessing: if all variable values are same, - * variable is excluded from pool. - * - * This is necessary for binary pre-splits (see later) to work. - */ - for(j=idx1; j<=idx2; j++) - { - bufs->tmpbufr.ptr.p_double[j-idx1] = xy->ptr.pp_double[bufs->idxbuf.ptr.p_int[j]][varcur]; - } - if( useevs ) - { - bflag = ae_false; - v = bufs->tmpbufr.ptr.p_double[0]; - for(j=0; j<=idx2-idx1; j++) - { - if( ae_fp_neq(bufs->tmpbufr.ptr.p_double[j],v) ) - { - bflag = ae_true; - break; - } - } - if( !bflag ) - { - - /* - * exclude variable from pool, - * go to the next iteration. - * I is not increased. - */ - k = bufs->varpool.ptr.p_int[i]; - bufs->varpool.ptr.p_int[i] = bufs->varpool.ptr.p_int[nvarsinpool-1]; - bufs->varpool.ptr.p_int[nvarsinpool-1] = k; - nvarsinpool = nvarsinpool-1; - continue; - } - } - - /* - * load labels to working array - */ - if( nclasses>1 ) - { - for(j=idx1; j<=idx2; j++) - { - bufs->tmpbufi.ptr.p_int[j-idx1] = ae_round(xy->ptr.pp_double[bufs->idxbuf.ptr.p_int[j]][nvars], _state); - } - } - else - { - for(j=idx1; j<=idx2; j++) - { - bufs->tmpbufr2.ptr.p_double[j-idx1] = xy->ptr.pp_double[bufs->idxbuf.ptr.p_int[j]][nvars]; - } - } - - /* - * calculate split - */ - if( useevs&&bufs->evsbin.ptr.p_bool[varcur] ) - { - - /* - * Pre-calculated splits for binary variables. - * Threshold is already known, just calculate RMS error - */ - threshold = bufs->evssplits.ptr.p_double[varcur]; - if( nclasses>1 ) - { - - /* - * classification-specific code - */ - for(j=0; j<=2*nclasses-1; j++) - { - bufs->classibuf.ptr.p_int[j] = 0; - } - sl = 0; - sr = 0; - for(j=0; j<=idx2-idx1; j++) - { - k = bufs->tmpbufi.ptr.p_int[j]; - if( ae_fp_less(bufs->tmpbufr.ptr.p_double[j],threshold) ) - { - bufs->classibuf.ptr.p_int[k] = bufs->classibuf.ptr.p_int[k]+1; - sl = sl+1; - } - else - { - bufs->classibuf.ptr.p_int[k+nclasses] = bufs->classibuf.ptr.p_int[k+nclasses]+1; - sr = sr+1; - } - } - ae_assert(ae_fp_neq(sl,0)&&ae_fp_neq(sr,0), "DFBuildTreeRec: something strange!", _state); - currms = 0; - for(j=0; j<=nclasses-1; j++) - { - w = bufs->classibuf.ptr.p_int[j]; - currms = currms+w*ae_sqr(w/sl-1, _state); - currms = currms+(sl-w)*ae_sqr(w/sl, _state); - w = bufs->classibuf.ptr.p_int[nclasses+j]; - currms = currms+w*ae_sqr(w/sr-1, _state); - currms = currms+(sr-w)*ae_sqr(w/sr, _state); - } - currms = ae_sqrt(currms/(nclasses*(idx2-idx1+1)), _state); - } - else - { - - /* - * regression-specific code - */ - sl = 0; - sr = 0; - v1 = 0; - v2 = 0; - for(j=0; j<=idx2-idx1; j++) - { - if( ae_fp_less(bufs->tmpbufr.ptr.p_double[j],threshold) ) - { - v1 = v1+bufs->tmpbufr2.ptr.p_double[j]; - sl = sl+1; - } - else - { - v2 = v2+bufs->tmpbufr2.ptr.p_double[j]; - sr = sr+1; - } - } - ae_assert(ae_fp_neq(sl,0)&&ae_fp_neq(sr,0), "DFBuildTreeRec: something strange!", _state); - v1 = v1/sl; - v2 = v2/sr; - currms = 0; - for(j=0; j<=idx2-idx1; j++) - { - if( ae_fp_less(bufs->tmpbufr.ptr.p_double[j],threshold) ) - { - currms = currms+ae_sqr(v1-bufs->tmpbufr2.ptr.p_double[j], _state); - } - else - { - currms = currms+ae_sqr(v2-bufs->tmpbufr2.ptr.p_double[j], _state); - } - } - currms = ae_sqrt(currms/(idx2-idx1+1), _state); - } - info = 1; - } - else - { - - /* - * Generic splits - */ - if( nclasses>1 ) - { - dforest_dfsplitc(&bufs->tmpbufr, &bufs->tmpbufi, &bufs->classibuf, idx2-idx1+1, nclasses, dforest_dfusestrongsplits, &info, &threshold, &currms, &bufs->sortrbuf, &bufs->sortibuf, _state); - } - else - { - dforest_dfsplitr(&bufs->tmpbufr, &bufs->tmpbufr2, idx2-idx1+1, dforest_dfusestrongsplits, &info, &threshold, &currms, &bufs->sortrbuf, &bufs->sortrbuf2, _state); - } - } - if( info>0 ) - { - if( ae_fp_less_eq(currms,ebest) ) - { - ebest = currms; - idxbest = varcur; - tbest = threshold; - } - } - - /* - * Next iteration - */ - i = i+1; - } - - /* - * to split or not to split - */ - if( idxbest<0 ) - { - - /* - * All values are same, cannot split. - */ - bufs->treebuf.ptr.p_double[*numprocessed] = -1; - if( nclasses>1 ) - { - - /* - * Select random class label (randomness allows us to - * approximate distribution of the classes) - */ - bufs->treebuf.ptr.p_double[*numprocessed+1] = ae_round(xy->ptr.pp_double[bufs->idxbuf.ptr.p_int[idx1+hqrnduniformi(rs, idx2-idx1+1, _state)]][nvars], _state); - } - else - { - - /* - * Select average (for regression task). - */ - v = 0; - for(i=idx1; i<=idx2; i++) - { - v = v+xy->ptr.pp_double[bufs->idxbuf.ptr.p_int[i]][nvars]/(idx2-idx1+1); - } - bufs->treebuf.ptr.p_double[*numprocessed+1] = v; - } - *numprocessed = *numprocessed+dforest_leafnodewidth; - } - else - { - - /* - * we can split - */ - bufs->treebuf.ptr.p_double[*numprocessed] = idxbest; - bufs->treebuf.ptr.p_double[*numprocessed+1] = tbest; - i1 = idx1; - i2 = idx2; - while(i1<=i2) - { - - /* - * Reorder indices so that left partition is in [Idx1..I1-1], - * and right partition is in [I2+1..Idx2] - */ - if( ae_fp_less(xy->ptr.pp_double[bufs->idxbuf.ptr.p_int[i1]][idxbest],tbest) ) - { - i1 = i1+1; - continue; - } - if( ae_fp_greater_eq(xy->ptr.pp_double[bufs->idxbuf.ptr.p_int[i2]][idxbest],tbest) ) - { - i2 = i2-1; - continue; - } - j = bufs->idxbuf.ptr.p_int[i1]; - bufs->idxbuf.ptr.p_int[i1] = bufs->idxbuf.ptr.p_int[i2]; - bufs->idxbuf.ptr.p_int[i2] = j; - i1 = i1+1; - i2 = i2-1; - } - oldnp = *numprocessed; - *numprocessed = *numprocessed+dforest_innernodewidth; - dforest_dfbuildtreerec(xy, npoints, nvars, nclasses, nfeatures, nvarsinpool, flags, numprocessed, idx1, i1-1, bufs, rs, _state); - bufs->treebuf.ptr.p_double[oldnp+2] = *numprocessed; - dforest_dfbuildtreerec(xy, npoints, nvars, nclasses, nfeatures, nvarsinpool, flags, numprocessed, i2+1, idx2, bufs, rs, _state); - } -} - - -/************************************************************************* -Makes split on attribute -*************************************************************************/ -static void dforest_dfsplitc(/* Real */ ae_vector* x, - /* Integer */ ae_vector* c, - /* Integer */ ae_vector* cntbuf, - ae_int_t n, - ae_int_t nc, - ae_int_t flags, - ae_int_t* info, - double* threshold, - double* e, - /* Real */ ae_vector* sortrbuf, - /* Integer */ ae_vector* sortibuf, - ae_state *_state) -{ - ae_int_t i; - ae_int_t neq; - ae_int_t nless; - ae_int_t ngreater; - ae_int_t q; - ae_int_t qmin; - ae_int_t qmax; - ae_int_t qcnt; - double cursplit; - ae_int_t nleft; - double v; - double cure; - double w; - double sl; - double sr; - - *info = 0; - *threshold = 0; - *e = 0; - - tagsortfasti(x, c, sortrbuf, sortibuf, n, _state); - *e = ae_maxrealnumber; - *threshold = 0.5*(x->ptr.p_double[0]+x->ptr.p_double[n-1]); - *info = -3; - if( flags/dforest_dfusestrongsplits%2==0 ) - { - - /* - * weak splits, split at half - */ - qcnt = 2; - qmin = 1; - qmax = 1; - } - else - { - - /* - * strong splits: choose best quartile - */ - qcnt = 4; - qmin = 1; - qmax = 3; - } - for(q=qmin; q<=qmax; q++) - { - cursplit = x->ptr.p_double[n*q/qcnt]; - neq = 0; - nless = 0; - ngreater = 0; - for(i=0; i<=n-1; i++) - { - if( ae_fp_less(x->ptr.p_double[i],cursplit) ) - { - nless = nless+1; - } - if( ae_fp_eq(x->ptr.p_double[i],cursplit) ) - { - neq = neq+1; - } - if( ae_fp_greater(x->ptr.p_double[i],cursplit) ) - { - ngreater = ngreater+1; - } - } - ae_assert(neq!=0, "DFSplitR: NEq=0, something strange!!!", _state); - if( nless!=0||ngreater!=0 ) - { - - /* - * set threshold between two partitions, with - * some tweaking to avoid problems with floating point - * arithmetics. - * - * The problem is that when you calculates C = 0.5*(A+B) there - * can be no C which lies strictly between A and B (for example, - * there is no floating point number which is - * greater than 1 and less than 1+eps). In such situations - * we choose right side as threshold (remember that - * points which lie on threshold falls to the right side). - */ - if( nlessptr.p_double[nless+neq-1]+x->ptr.p_double[nless+neq]); - nleft = nless+neq; - if( ae_fp_less_eq(cursplit,x->ptr.p_double[nless+neq-1]) ) - { - cursplit = x->ptr.p_double[nless+neq]; - } - } - else - { - cursplit = 0.5*(x->ptr.p_double[nless-1]+x->ptr.p_double[nless]); - nleft = nless; - if( ae_fp_less_eq(cursplit,x->ptr.p_double[nless-1]) ) - { - cursplit = x->ptr.p_double[nless]; - } - } - *info = 1; - cure = 0; - for(i=0; i<=2*nc-1; i++) - { - cntbuf->ptr.p_int[i] = 0; - } - for(i=0; i<=nleft-1; i++) - { - cntbuf->ptr.p_int[c->ptr.p_int[i]] = cntbuf->ptr.p_int[c->ptr.p_int[i]]+1; - } - for(i=nleft; i<=n-1; i++) - { - cntbuf->ptr.p_int[nc+c->ptr.p_int[i]] = cntbuf->ptr.p_int[nc+c->ptr.p_int[i]]+1; - } - sl = nleft; - sr = n-nleft; - v = 0; - for(i=0; i<=nc-1; i++) - { - w = cntbuf->ptr.p_int[i]; - v = v+w*ae_sqr(w/sl-1, _state); - v = v+(sl-w)*ae_sqr(w/sl, _state); - w = cntbuf->ptr.p_int[nc+i]; - v = v+w*ae_sqr(w/sr-1, _state); - v = v+(sr-w)*ae_sqr(w/sr, _state); - } - cure = ae_sqrt(v/(nc*n), _state); - if( ae_fp_less(cure,*e) ) - { - *threshold = cursplit; - *e = cure; - } - } - } -} - - -/************************************************************************* -Makes split on attribute -*************************************************************************/ -static void dforest_dfsplitr(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_int_t flags, - ae_int_t* info, - double* threshold, - double* e, - /* Real */ ae_vector* sortrbuf, - /* Real */ ae_vector* sortrbuf2, - ae_state *_state) -{ - ae_int_t i; - ae_int_t neq; - ae_int_t nless; - ae_int_t ngreater; - ae_int_t q; - ae_int_t qmin; - ae_int_t qmax; - ae_int_t qcnt; - double cursplit; - ae_int_t nleft; - double v; - double cure; - - *info = 0; - *threshold = 0; - *e = 0; - - tagsortfastr(x, y, sortrbuf, sortrbuf2, n, _state); - *e = ae_maxrealnumber; - *threshold = 0.5*(x->ptr.p_double[0]+x->ptr.p_double[n-1]); - *info = -3; - if( flags/dforest_dfusestrongsplits%2==0 ) - { - - /* - * weak splits, split at half - */ - qcnt = 2; - qmin = 1; - qmax = 1; - } - else - { - - /* - * strong splits: choose best quartile - */ - qcnt = 4; - qmin = 1; - qmax = 3; - } - for(q=qmin; q<=qmax; q++) - { - cursplit = x->ptr.p_double[n*q/qcnt]; - neq = 0; - nless = 0; - ngreater = 0; - for(i=0; i<=n-1; i++) - { - if( ae_fp_less(x->ptr.p_double[i],cursplit) ) - { - nless = nless+1; - } - if( ae_fp_eq(x->ptr.p_double[i],cursplit) ) - { - neq = neq+1; - } - if( ae_fp_greater(x->ptr.p_double[i],cursplit) ) - { - ngreater = ngreater+1; - } - } - ae_assert(neq!=0, "DFSplitR: NEq=0, something strange!!!", _state); - if( nless!=0||ngreater!=0 ) - { - - /* - * set threshold between two partitions, with - * some tweaking to avoid problems with floating point - * arithmetics. - * - * The problem is that when you calculates C = 0.5*(A+B) there - * can be no C which lies strictly between A and B (for example, - * there is no floating point number which is - * greater than 1 and less than 1+eps). In such situations - * we choose right side as threshold (remember that - * points which lie on threshold falls to the right side). - */ - if( nlessptr.p_double[nless+neq-1]+x->ptr.p_double[nless+neq]); - nleft = nless+neq; - if( ae_fp_less_eq(cursplit,x->ptr.p_double[nless+neq-1]) ) - { - cursplit = x->ptr.p_double[nless+neq]; - } - } - else - { - cursplit = 0.5*(x->ptr.p_double[nless-1]+x->ptr.p_double[nless]); - nleft = nless; - if( ae_fp_less_eq(cursplit,x->ptr.p_double[nless-1]) ) - { - cursplit = x->ptr.p_double[nless]; - } - } - *info = 1; - cure = 0; - v = 0; - for(i=0; i<=nleft-1; i++) - { - v = v+y->ptr.p_double[i]; - } - v = v/nleft; - for(i=0; i<=nleft-1; i++) - { - cure = cure+ae_sqr(y->ptr.p_double[i]-v, _state); - } - v = 0; - for(i=nleft; i<=n-1; i++) - { - v = v+y->ptr.p_double[i]; - } - v = v/(n-nleft); - for(i=nleft; i<=n-1; i++) - { - cure = cure+ae_sqr(y->ptr.p_double[i]-v, _state); - } - cure = ae_sqrt(cure/n, _state); - if( ae_fp_less(cure,*e) ) - { - *threshold = cursplit; - *e = cure; - } - } - } -} - - -ae_bool _decisionforest_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - decisionforest *p = (decisionforest*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->trees, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _decisionforest_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - decisionforest *dst = (decisionforest*)_dst; - decisionforest *src = (decisionforest*)_src; - dst->nvars = src->nvars; - dst->nclasses = src->nclasses; - dst->ntrees = src->ntrees; - dst->bufsize = src->bufsize; - if( !ae_vector_init_copy(&dst->trees, &src->trees, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _decisionforest_clear(void* _p) -{ - decisionforest *p = (decisionforest*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->trees); -} - - -void _decisionforest_destroy(void* _p) -{ - decisionforest *p = (decisionforest*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->trees); -} - - -ae_bool _dfreport_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - dfreport *p = (dfreport*)_p; - ae_touch_ptr((void*)p); - return ae_true; -} - - -ae_bool _dfreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - dfreport *dst = (dfreport*)_dst; - dfreport *src = (dfreport*)_src; - dst->relclserror = src->relclserror; - dst->avgce = src->avgce; - dst->rmserror = src->rmserror; - dst->avgerror = src->avgerror; - dst->avgrelerror = src->avgrelerror; - dst->oobrelclserror = src->oobrelclserror; - dst->oobavgce = src->oobavgce; - dst->oobrmserror = src->oobrmserror; - dst->oobavgerror = src->oobavgerror; - dst->oobavgrelerror = src->oobavgrelerror; - return ae_true; -} - - -void _dfreport_clear(void* _p) -{ - dfreport *p = (dfreport*)_p; - ae_touch_ptr((void*)p); -} - - -void _dfreport_destroy(void* _p) -{ - dfreport *p = (dfreport*)_p; - ae_touch_ptr((void*)p); -} - - -ae_bool _dfinternalbuffers_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - dfinternalbuffers *p = (dfinternalbuffers*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->treebuf, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->idxbuf, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->tmpbufr, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->tmpbufr2, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->tmpbufi, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->classibuf, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->sortrbuf, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->sortrbuf2, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->sortibuf, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->varpool, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->evsbin, 0, DT_BOOL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->evssplits, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _dfinternalbuffers_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - dfinternalbuffers *dst = (dfinternalbuffers*)_dst; - dfinternalbuffers *src = (dfinternalbuffers*)_src; - if( !ae_vector_init_copy(&dst->treebuf, &src->treebuf, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->idxbuf, &src->idxbuf, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->tmpbufr, &src->tmpbufr, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->tmpbufr2, &src->tmpbufr2, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->tmpbufi, &src->tmpbufi, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->classibuf, &src->classibuf, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->sortrbuf, &src->sortrbuf, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->sortrbuf2, &src->sortrbuf2, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->sortibuf, &src->sortibuf, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->varpool, &src->varpool, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->evsbin, &src->evsbin, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->evssplits, &src->evssplits, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _dfinternalbuffers_clear(void* _p) -{ - dfinternalbuffers *p = (dfinternalbuffers*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->treebuf); - ae_vector_clear(&p->idxbuf); - ae_vector_clear(&p->tmpbufr); - ae_vector_clear(&p->tmpbufr2); - ae_vector_clear(&p->tmpbufi); - ae_vector_clear(&p->classibuf); - ae_vector_clear(&p->sortrbuf); - ae_vector_clear(&p->sortrbuf2); - ae_vector_clear(&p->sortibuf); - ae_vector_clear(&p->varpool); - ae_vector_clear(&p->evsbin); - ae_vector_clear(&p->evssplits); -} - - -void _dfinternalbuffers_destroy(void* _p) -{ - dfinternalbuffers *p = (dfinternalbuffers*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->treebuf); - ae_vector_destroy(&p->idxbuf); - ae_vector_destroy(&p->tmpbufr); - ae_vector_destroy(&p->tmpbufr2); - ae_vector_destroy(&p->tmpbufi); - ae_vector_destroy(&p->classibuf); - ae_vector_destroy(&p->sortrbuf); - ae_vector_destroy(&p->sortrbuf2); - ae_vector_destroy(&p->sortibuf); - ae_vector_destroy(&p->varpool); - ae_vector_destroy(&p->evsbin); - ae_vector_destroy(&p->evssplits); -} - - - - -/************************************************************************* -Linear regression - -Subroutine builds model: - - Y = A(0)*X[0] + ... + A(N-1)*X[N-1] + A(N) - -and model found in ALGLIB format, covariation matrix, training set errors -(rms, average, average relative) and leave-one-out cross-validation -estimate of the generalization error. CV estimate calculated using fast -algorithm with O(NPoints*NVars) complexity. - -When covariation matrix is calculated standard deviations of function -values are assumed to be equal to RMS error on the training set. - -INPUT PARAMETERS: - XY - training set, array [0..NPoints-1,0..NVars]: - * NVars columns - independent variables - * last column - dependent variable - NPoints - training set size, NPoints>NVars+1 - NVars - number of independent variables - -OUTPUT PARAMETERS: - Info - return code: - * -255, in case of unknown internal error - * -4, if internal SVD subroutine haven't converged - * -1, if incorrect parameters was passed (NPointsrmserror, _state)*npoints/(npoints-nvars-1); - for(i=0; i<=nvars; i++) - { - ae_v_muld(&ar->c.ptr.pp_double[i][0], 1, ae_v_len(0,nvars), sigma2); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Linear regression - -Variant of LRBuild which uses vector of standatd deviations (errors in -function values). - -INPUT PARAMETERS: - XY - training set, array [0..NPoints-1,0..NVars]: - * NVars columns - independent variables - * last column - dependent variable - S - standard deviations (errors in function values) - array[0..NPoints-1], S[i]>0. - NPoints - training set size, NPoints>NVars+1 - NVars - number of independent variables - -OUTPUT PARAMETERS: - Info - return code: - * -255, in case of unknown internal error - * -4, if internal SVD subroutine haven't converged - * -1, if incorrect parameters was passed (NPointsptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); - xyi.ptr.pp_double[i][nvars] = 1; - xyi.ptr.pp_double[i][nvars+1] = xy->ptr.pp_double[i][nvars]; - } - - /* - * Standartization - */ - ae_vector_set_length(&x, npoints-1+1, _state); - ae_vector_set_length(&means, nvars-1+1, _state); - ae_vector_set_length(&sigmas, nvars-1+1, _state); - for(j=0; j<=nvars-1; j++) - { - ae_v_move(&x.ptr.p_double[0], 1, &xy->ptr.pp_double[0][j], xy->stride, ae_v_len(0,npoints-1)); - samplemoments(&x, npoints, &mean, &variance, &skewness, &kurtosis, _state); - means.ptr.p_double[j] = mean; - sigmas.ptr.p_double[j] = ae_sqrt(variance, _state); - if( ae_fp_eq(sigmas.ptr.p_double[j],0) ) - { - sigmas.ptr.p_double[j] = 1; - } - for(i=0; i<=npoints-1; i++) - { - xyi.ptr.pp_double[i][j] = (xyi.ptr.pp_double[i][j]-means.ptr.p_double[j])/sigmas.ptr.p_double[j]; - } - } - - /* - * Internal processing - */ - linreg_lrinternal(&xyi, s, npoints, nvars+1, info, lm, ar, _state); - if( *info<0 ) - { - ae_frame_leave(_state); - return; - } - - /* - * Un-standartization - */ - offs = ae_round(lm->w.ptr.p_double[3], _state); - for(j=0; j<=nvars-1; j++) - { - - /* - * Constant term is updated (and its covariance too, - * since it gets some variance from J-th component) - */ - lm->w.ptr.p_double[offs+nvars] = lm->w.ptr.p_double[offs+nvars]-lm->w.ptr.p_double[offs+j]*means.ptr.p_double[j]/sigmas.ptr.p_double[j]; - v = means.ptr.p_double[j]/sigmas.ptr.p_double[j]; - ae_v_subd(&ar->c.ptr.pp_double[nvars][0], 1, &ar->c.ptr.pp_double[j][0], 1, ae_v_len(0,nvars), v); - ae_v_subd(&ar->c.ptr.pp_double[0][nvars], ar->c.stride, &ar->c.ptr.pp_double[0][j], ar->c.stride, ae_v_len(0,nvars), v); - - /* - * J-th term is updated - */ - lm->w.ptr.p_double[offs+j] = lm->w.ptr.p_double[offs+j]/sigmas.ptr.p_double[j]; - v = 1/sigmas.ptr.p_double[j]; - ae_v_muld(&ar->c.ptr.pp_double[j][0], 1, ae_v_len(0,nvars), v); - ae_v_muld(&ar->c.ptr.pp_double[0][j], ar->c.stride, ae_v_len(0,nvars), v); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Like LRBuildS, but builds model - - Y = A(0)*X[0] + ... + A(N-1)*X[N-1] - -i.e. with zero constant term. - - -- ALGLIB -- - Copyright 30.10.2008 by Bochkanov Sergey -*************************************************************************/ -void lrbuildzs(/* Real */ ae_matrix* xy, - /* Real */ ae_vector* s, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t* info, - linearmodel* lm, - lrreport* ar, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix xyi; - ae_vector x; - ae_vector c; - ae_int_t i; - ae_int_t j; - double v; - ae_int_t offs; - double mean; - double variance; - double skewness; - double kurtosis; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _linearmodel_clear(lm); - _lrreport_clear(ar); - ae_matrix_init(&xyi, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&x, 0, DT_REAL, _state, ae_true); - ae_vector_init(&c, 0, DT_REAL, _state, ae_true); - - - /* - * Test parameters - */ - if( npoints<=nvars+1||nvars<1 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - - /* - * Copy data, add one more column (constant term) - */ - ae_matrix_set_length(&xyi, npoints-1+1, nvars+1+1, _state); - for(i=0; i<=npoints-1; i++) - { - ae_v_move(&xyi.ptr.pp_double[i][0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); - xyi.ptr.pp_double[i][nvars] = 0; - xyi.ptr.pp_double[i][nvars+1] = xy->ptr.pp_double[i][nvars]; - } - - /* - * Standartization: unusual scaling - */ - ae_vector_set_length(&x, npoints-1+1, _state); - ae_vector_set_length(&c, nvars-1+1, _state); - for(j=0; j<=nvars-1; j++) - { - ae_v_move(&x.ptr.p_double[0], 1, &xy->ptr.pp_double[0][j], xy->stride, ae_v_len(0,npoints-1)); - samplemoments(&x, npoints, &mean, &variance, &skewness, &kurtosis, _state); - if( ae_fp_greater(ae_fabs(mean, _state),ae_sqrt(variance, _state)) ) - { - - /* - * variation is relatively small, it is better to - * bring mean value to 1 - */ - c.ptr.p_double[j] = mean; - } - else - { - - /* - * variation is large, it is better to bring variance to 1 - */ - if( ae_fp_eq(variance,0) ) - { - variance = 1; - } - c.ptr.p_double[j] = ae_sqrt(variance, _state); - } - for(i=0; i<=npoints-1; i++) - { - xyi.ptr.pp_double[i][j] = xyi.ptr.pp_double[i][j]/c.ptr.p_double[j]; - } - } - - /* - * Internal processing - */ - linreg_lrinternal(&xyi, s, npoints, nvars+1, info, lm, ar, _state); - if( *info<0 ) - { - ae_frame_leave(_state); - return; - } - - /* - * Un-standartization - */ - offs = ae_round(lm->w.ptr.p_double[3], _state); - for(j=0; j<=nvars-1; j++) - { - - /* - * J-th term is updated - */ - lm->w.ptr.p_double[offs+j] = lm->w.ptr.p_double[offs+j]/c.ptr.p_double[j]; - v = 1/c.ptr.p_double[j]; - ae_v_muld(&ar->c.ptr.pp_double[j][0], 1, ae_v_len(0,nvars), v); - ae_v_muld(&ar->c.ptr.pp_double[0][j], ar->c.stride, ae_v_len(0,nvars), v); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Like LRBuild but builds model - - Y = A(0)*X[0] + ... + A(N-1)*X[N-1] - -i.e. with zero constant term. - - -- ALGLIB -- - Copyright 30.10.2008 by Bochkanov Sergey -*************************************************************************/ -void lrbuildz(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t* info, - linearmodel* lm, - lrreport* ar, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector s; - ae_int_t i; - double sigma2; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _linearmodel_clear(lm); - _lrreport_clear(ar); - ae_vector_init(&s, 0, DT_REAL, _state, ae_true); - - if( npoints<=nvars+1||nvars<1 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - ae_vector_set_length(&s, npoints-1+1, _state); - for(i=0; i<=npoints-1; i++) - { - s.ptr.p_double[i] = 1; - } - lrbuildzs(xy, &s, npoints, nvars, info, lm, ar, _state); - if( *info<0 ) - { - ae_frame_leave(_state); - return; - } - sigma2 = ae_sqr(ar->rmserror, _state)*npoints/(npoints-nvars-1); - for(i=0; i<=nvars; i++) - { - ae_v_muld(&ar->c.ptr.pp_double[i][0], 1, ae_v_len(0,nvars), sigma2); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Unpacks coefficients of linear model. - -INPUT PARAMETERS: - LM - linear model in ALGLIB format - -OUTPUT PARAMETERS: - V - coefficients, array[0..NVars] - constant term (intercept) is stored in the V[NVars]. - NVars - number of independent variables (one less than number - of coefficients) - - -- ALGLIB -- - Copyright 30.08.2008 by Bochkanov Sergey -*************************************************************************/ -void lrunpack(linearmodel* lm, - /* Real */ ae_vector* v, - ae_int_t* nvars, - ae_state *_state) -{ - ae_int_t offs; - - ae_vector_clear(v); - *nvars = 0; - - ae_assert(ae_round(lm->w.ptr.p_double[1], _state)==linreg_lrvnum, "LINREG: Incorrect LINREG version!", _state); - *nvars = ae_round(lm->w.ptr.p_double[2], _state); - offs = ae_round(lm->w.ptr.p_double[3], _state); - ae_vector_set_length(v, *nvars+1, _state); - ae_v_move(&v->ptr.p_double[0], 1, &lm->w.ptr.p_double[offs], 1, ae_v_len(0,*nvars)); -} - - -/************************************************************************* -"Packs" coefficients and creates linear model in ALGLIB format (LRUnpack -reversed). - -INPUT PARAMETERS: - V - coefficients, array[0..NVars] - NVars - number of independent variables - -OUTPUT PAREMETERS: - LM - linear model. - - -- ALGLIB -- - Copyright 30.08.2008 by Bochkanov Sergey -*************************************************************************/ -void lrpack(/* Real */ ae_vector* v, - ae_int_t nvars, - linearmodel* lm, - ae_state *_state) -{ - ae_int_t offs; - - _linearmodel_clear(lm); - - ae_vector_set_length(&lm->w, 4+nvars+1, _state); - offs = 4; - lm->w.ptr.p_double[0] = 4+nvars+1; - lm->w.ptr.p_double[1] = linreg_lrvnum; - lm->w.ptr.p_double[2] = nvars; - lm->w.ptr.p_double[3] = offs; - ae_v_move(&lm->w.ptr.p_double[offs], 1, &v->ptr.p_double[0], 1, ae_v_len(offs,offs+nvars)); -} - - -/************************************************************************* -Procesing - -INPUT PARAMETERS: - LM - linear model - X - input vector, array[0..NVars-1]. - -Result: - value of linear model regression estimate - - -- ALGLIB -- - Copyright 03.09.2008 by Bochkanov Sergey -*************************************************************************/ -double lrprocess(linearmodel* lm, - /* Real */ ae_vector* x, - ae_state *_state) -{ - double v; - ae_int_t offs; - ae_int_t nvars; - double result; - - - ae_assert(ae_round(lm->w.ptr.p_double[1], _state)==linreg_lrvnum, "LINREG: Incorrect LINREG version!", _state); - nvars = ae_round(lm->w.ptr.p_double[2], _state); - offs = ae_round(lm->w.ptr.p_double[3], _state); - v = ae_v_dotproduct(&x->ptr.p_double[0], 1, &lm->w.ptr.p_double[offs], 1, ae_v_len(0,nvars-1)); - result = v+lm->w.ptr.p_double[offs+nvars]; - return result; -} - - -/************************************************************************* -RMS error on the test set - -INPUT PARAMETERS: - LM - linear model - XY - test set - NPoints - test set size - -RESULT: - root mean square error. - - -- ALGLIB -- - Copyright 30.08.2008 by Bochkanov Sergey -*************************************************************************/ -double lrrmserror(linearmodel* lm, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - ae_int_t i; - double v; - ae_int_t offs; - ae_int_t nvars; - double result; - - - ae_assert(ae_round(lm->w.ptr.p_double[1], _state)==linreg_lrvnum, "LINREG: Incorrect LINREG version!", _state); - nvars = ae_round(lm->w.ptr.p_double[2], _state); - offs = ae_round(lm->w.ptr.p_double[3], _state); - result = 0; - for(i=0; i<=npoints-1; i++) - { - v = ae_v_dotproduct(&xy->ptr.pp_double[i][0], 1, &lm->w.ptr.p_double[offs], 1, ae_v_len(0,nvars-1)); - v = v+lm->w.ptr.p_double[offs+nvars]; - result = result+ae_sqr(v-xy->ptr.pp_double[i][nvars], _state); - } - result = ae_sqrt(result/npoints, _state); - return result; -} - - -/************************************************************************* -Average error on the test set - -INPUT PARAMETERS: - LM - linear model - XY - test set - NPoints - test set size - -RESULT: - average error. - - -- ALGLIB -- - Copyright 30.08.2008 by Bochkanov Sergey -*************************************************************************/ -double lravgerror(linearmodel* lm, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - ae_int_t i; - double v; - ae_int_t offs; - ae_int_t nvars; - double result; - - - ae_assert(ae_round(lm->w.ptr.p_double[1], _state)==linreg_lrvnum, "LINREG: Incorrect LINREG version!", _state); - nvars = ae_round(lm->w.ptr.p_double[2], _state); - offs = ae_round(lm->w.ptr.p_double[3], _state); - result = 0; - for(i=0; i<=npoints-1; i++) - { - v = ae_v_dotproduct(&xy->ptr.pp_double[i][0], 1, &lm->w.ptr.p_double[offs], 1, ae_v_len(0,nvars-1)); - v = v+lm->w.ptr.p_double[offs+nvars]; - result = result+ae_fabs(v-xy->ptr.pp_double[i][nvars], _state); - } - result = result/npoints; - return result; -} - - -/************************************************************************* -RMS error on the test set - -INPUT PARAMETERS: - LM - linear model - XY - test set - NPoints - test set size - -RESULT: - average relative error. - - -- ALGLIB -- - Copyright 30.08.2008 by Bochkanov Sergey -*************************************************************************/ -double lravgrelerror(linearmodel* lm, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - ae_int_t i; - ae_int_t k; - double v; - ae_int_t offs; - ae_int_t nvars; - double result; - - - ae_assert(ae_round(lm->w.ptr.p_double[1], _state)==linreg_lrvnum, "LINREG: Incorrect LINREG version!", _state); - nvars = ae_round(lm->w.ptr.p_double[2], _state); - offs = ae_round(lm->w.ptr.p_double[3], _state); - result = 0; - k = 0; - for(i=0; i<=npoints-1; i++) - { - if( ae_fp_neq(xy->ptr.pp_double[i][nvars],0) ) - { - v = ae_v_dotproduct(&xy->ptr.pp_double[i][0], 1, &lm->w.ptr.p_double[offs], 1, ae_v_len(0,nvars-1)); - v = v+lm->w.ptr.p_double[offs+nvars]; - result = result+ae_fabs((v-xy->ptr.pp_double[i][nvars])/xy->ptr.pp_double[i][nvars], _state); - k = k+1; - } - } - if( k!=0 ) - { - result = result/k; - } - return result; -} - - -/************************************************************************* -Copying of LinearModel strucure - -INPUT PARAMETERS: - LM1 - original - -OUTPUT PARAMETERS: - LM2 - copy - - -- ALGLIB -- - Copyright 15.03.2009 by Bochkanov Sergey -*************************************************************************/ -void lrcopy(linearmodel* lm1, linearmodel* lm2, ae_state *_state) -{ - ae_int_t k; - - _linearmodel_clear(lm2); - - k = ae_round(lm1->w.ptr.p_double[0], _state); - ae_vector_set_length(&lm2->w, k-1+1, _state); - ae_v_move(&lm2->w.ptr.p_double[0], 1, &lm1->w.ptr.p_double[0], 1, ae_v_len(0,k-1)); -} - - -void lrlines(/* Real */ ae_matrix* xy, - /* Real */ ae_vector* s, - ae_int_t n, - ae_int_t* info, - double* a, - double* b, - double* vara, - double* varb, - double* covab, - double* corrab, - double* p, - ae_state *_state) -{ - ae_int_t i; - double ss; - double sx; - double sxx; - double sy; - double stt; - double e1; - double e2; - double t; - double chi2; - - *info = 0; - *a = 0; - *b = 0; - *vara = 0; - *varb = 0; - *covab = 0; - *corrab = 0; - *p = 0; - - if( n<2 ) - { - *info = -1; - return; - } - for(i=0; i<=n-1; i++) - { - if( ae_fp_less_eq(s->ptr.p_double[i],0) ) - { - *info = -2; - return; - } - } - *info = 1; - - /* - * Calculate S, SX, SY, SXX - */ - ss = 0; - sx = 0; - sy = 0; - sxx = 0; - for(i=0; i<=n-1; i++) - { - t = ae_sqr(s->ptr.p_double[i], _state); - ss = ss+1/t; - sx = sx+xy->ptr.pp_double[i][0]/t; - sy = sy+xy->ptr.pp_double[i][1]/t; - sxx = sxx+ae_sqr(xy->ptr.pp_double[i][0], _state)/t; - } - - /* - * Test for condition number - */ - t = ae_sqrt(4*ae_sqr(sx, _state)+ae_sqr(ss-sxx, _state), _state); - e1 = 0.5*(ss+sxx+t); - e2 = 0.5*(ss+sxx-t); - if( ae_fp_less_eq(ae_minreal(e1, e2, _state),1000*ae_machineepsilon*ae_maxreal(e1, e2, _state)) ) - { - *info = -3; - return; - } - - /* - * Calculate A, B - */ - *a = 0; - *b = 0; - stt = 0; - for(i=0; i<=n-1; i++) - { - t = (xy->ptr.pp_double[i][0]-sx/ss)/s->ptr.p_double[i]; - *b = *b+t*xy->ptr.pp_double[i][1]/s->ptr.p_double[i]; - stt = stt+ae_sqr(t, _state); - } - *b = *b/stt; - *a = (sy-sx*(*b))/ss; - - /* - * Calculate goodness-of-fit - */ - if( n>2 ) - { - chi2 = 0; - for(i=0; i<=n-1; i++) - { - chi2 = chi2+ae_sqr((xy->ptr.pp_double[i][1]-(*a)-*b*xy->ptr.pp_double[i][0])/s->ptr.p_double[i], _state); - } - *p = incompletegammac((double)(n-2)/(double)2, chi2/2, _state); - } - else - { - *p = 1; - } - - /* - * Calculate other parameters - */ - *vara = (1+ae_sqr(sx, _state)/(ss*stt))/ss; - *varb = 1/stt; - *covab = -sx/(ss*stt); - *corrab = *covab/ae_sqrt(*vara*(*varb), _state); -} - - -void lrline(/* Real */ ae_matrix* xy, - ae_int_t n, - ae_int_t* info, - double* a, - double* b, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector s; - ae_int_t i; - double vara; - double varb; - double covab; - double corrab; - double p; - - ae_frame_make(_state, &_frame_block); - *info = 0; - *a = 0; - *b = 0; - ae_vector_init(&s, 0, DT_REAL, _state, ae_true); - - if( n<2 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - ae_vector_set_length(&s, n-1+1, _state); - for(i=0; i<=n-1; i++) - { - s.ptr.p_double[i] = 1; - } - lrlines(xy, &s, n, info, a, b, &vara, &varb, &covab, &corrab, &p, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Internal linear regression subroutine -*************************************************************************/ -static void linreg_lrinternal(/* Real */ ae_matrix* xy, - /* Real */ ae_vector* s, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t* info, - linearmodel* lm, - lrreport* ar, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix a; - ae_matrix u; - ae_matrix vt; - ae_matrix vm; - ae_matrix xym; - ae_vector b; - ae_vector sv; - ae_vector t; - ae_vector svi; - ae_vector work; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t ncv; - ae_int_t na; - ae_int_t nacv; - double r; - double p; - double epstol; - lrreport ar2; - ae_int_t offs; - linearmodel tlm; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _linearmodel_clear(lm); - _lrreport_clear(ar); - ae_matrix_init(&a, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&u, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&vt, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&vm, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&xym, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&b, 0, DT_REAL, _state, ae_true); - ae_vector_init(&sv, 0, DT_REAL, _state, ae_true); - ae_vector_init(&t, 0, DT_REAL, _state, ae_true); - ae_vector_init(&svi, 0, DT_REAL, _state, ae_true); - ae_vector_init(&work, 0, DT_REAL, _state, ae_true); - _lrreport_init(&ar2, _state, ae_true); - _linearmodel_init(&tlm, _state, ae_true); - - epstol = 1000; - - /* - * Check for errors in data - */ - if( npointsptr.p_double[i],0) ) - { - *info = -2; - ae_frame_leave(_state); - return; - } - } - *info = 1; - - /* - * Create design matrix - */ - ae_matrix_set_length(&a, npoints-1+1, nvars-1+1, _state); - ae_vector_set_length(&b, npoints-1+1, _state); - for(i=0; i<=npoints-1; i++) - { - r = 1/s->ptr.p_double[i]; - ae_v_moved(&a.ptr.pp_double[i][0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1), r); - b.ptr.p_double[i] = xy->ptr.pp_double[i][nvars]/s->ptr.p_double[i]; - } - - /* - * Allocate W: - * W[0] array size - * W[1] version number, 0 - * W[2] NVars (minus 1, to be compatible with external representation) - * W[3] coefficients offset - */ - ae_vector_set_length(&lm->w, 4+nvars-1+1, _state); - offs = 4; - lm->w.ptr.p_double[0] = 4+nvars; - lm->w.ptr.p_double[1] = linreg_lrvnum; - lm->w.ptr.p_double[2] = nvars-1; - lm->w.ptr.p_double[3] = offs; - - /* - * Solve problem using SVD: - * - * 0. check for degeneracy (different types) - * 1. A = U*diag(sv)*V' - * 2. T = b'*U - * 3. w = SUM((T[i]/sv[i])*V[..,i]) - * 4. cov(wi,wj) = SUM(Vji*Vjk/sv[i]^2,K=1..M) - * - * see $15.4 of "Numerical Recipes in C" for more information - */ - ae_vector_set_length(&t, nvars-1+1, _state); - ae_vector_set_length(&svi, nvars-1+1, _state); - ae_matrix_set_length(&ar->c, nvars-1+1, nvars-1+1, _state); - ae_matrix_set_length(&vm, nvars-1+1, nvars-1+1, _state); - if( !rmatrixsvd(&a, npoints, nvars, 1, 1, 2, &sv, &u, &vt, _state) ) - { - *info = -4; - ae_frame_leave(_state); - return; - } - if( ae_fp_less_eq(sv.ptr.p_double[0],0) ) - { - - /* - * Degenerate case: zero design matrix. - */ - for(i=offs; i<=offs+nvars-1; i++) - { - lm->w.ptr.p_double[i] = 0; - } - ar->rmserror = lrrmserror(lm, xy, npoints, _state); - ar->avgerror = lravgerror(lm, xy, npoints, _state); - ar->avgrelerror = lravgrelerror(lm, xy, npoints, _state); - ar->cvrmserror = ar->rmserror; - ar->cvavgerror = ar->avgerror; - ar->cvavgrelerror = ar->avgrelerror; - ar->ncvdefects = 0; - ae_vector_set_length(&ar->cvdefects, nvars-1+1, _state); - ae_matrix_set_length(&ar->c, nvars-1+1, nvars-1+1, _state); - for(i=0; i<=nvars-1; i++) - { - for(j=0; j<=nvars-1; j++) - { - ar->c.ptr.pp_double[i][j] = 0; - } - } - ae_frame_leave(_state); - return; - } - if( ae_fp_less_eq(sv.ptr.p_double[nvars-1],epstol*ae_machineepsilon*sv.ptr.p_double[0]) ) - { - - /* - * Degenerate case, non-zero design matrix. - * - * We can leave it and solve task in SVD least squares fashion. - * Solution and covariance matrix will be obtained correctly, - * but CV error estimates - will not. It is better to reduce - * it to non-degenerate task and to obtain correct CV estimates. - */ - for(k=nvars; k>=1; k--) - { - if( ae_fp_greater(sv.ptr.p_double[k-1],epstol*ae_machineepsilon*sv.ptr.p_double[0]) ) - { - - /* - * Reduce - */ - ae_matrix_set_length(&xym, npoints-1+1, k+1, _state); - for(i=0; i<=npoints-1; i++) - { - for(j=0; j<=k-1; j++) - { - r = ae_v_dotproduct(&xy->ptr.pp_double[i][0], 1, &vt.ptr.pp_double[j][0], 1, ae_v_len(0,nvars-1)); - xym.ptr.pp_double[i][j] = r; - } - xym.ptr.pp_double[i][k] = xy->ptr.pp_double[i][nvars]; - } - - /* - * Solve - */ - linreg_lrinternal(&xym, s, npoints, k, info, &tlm, &ar2, _state); - if( *info!=1 ) - { - ae_frame_leave(_state); - return; - } - - /* - * Convert back to un-reduced format - */ - for(j=0; j<=nvars-1; j++) - { - lm->w.ptr.p_double[offs+j] = 0; - } - for(j=0; j<=k-1; j++) - { - r = tlm.w.ptr.p_double[offs+j]; - ae_v_addd(&lm->w.ptr.p_double[offs], 1, &vt.ptr.pp_double[j][0], 1, ae_v_len(offs,offs+nvars-1), r); - } - ar->rmserror = ar2.rmserror; - ar->avgerror = ar2.avgerror; - ar->avgrelerror = ar2.avgrelerror; - ar->cvrmserror = ar2.cvrmserror; - ar->cvavgerror = ar2.cvavgerror; - ar->cvavgrelerror = ar2.cvavgrelerror; - ar->ncvdefects = ar2.ncvdefects; - ae_vector_set_length(&ar->cvdefects, nvars-1+1, _state); - for(j=0; j<=ar->ncvdefects-1; j++) - { - ar->cvdefects.ptr.p_int[j] = ar2.cvdefects.ptr.p_int[j]; - } - ae_matrix_set_length(&ar->c, nvars-1+1, nvars-1+1, _state); - ae_vector_set_length(&work, nvars+1, _state); - matrixmatrixmultiply(&ar2.c, 0, k-1, 0, k-1, ae_false, &vt, 0, k-1, 0, nvars-1, ae_false, 1.0, &vm, 0, k-1, 0, nvars-1, 0.0, &work, _state); - matrixmatrixmultiply(&vt, 0, k-1, 0, nvars-1, ae_true, &vm, 0, k-1, 0, nvars-1, ae_false, 1.0, &ar->c, 0, nvars-1, 0, nvars-1, 0.0, &work, _state); - ae_frame_leave(_state); - return; - } - } - *info = -255; - ae_frame_leave(_state); - return; - } - for(i=0; i<=nvars-1; i++) - { - if( ae_fp_greater(sv.ptr.p_double[i],epstol*ae_machineepsilon*sv.ptr.p_double[0]) ) - { - svi.ptr.p_double[i] = 1/sv.ptr.p_double[i]; - } - else - { - svi.ptr.p_double[i] = 0; - } - } - for(i=0; i<=nvars-1; i++) - { - t.ptr.p_double[i] = 0; - } - for(i=0; i<=npoints-1; i++) - { - r = b.ptr.p_double[i]; - ae_v_addd(&t.ptr.p_double[0], 1, &u.ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1), r); - } - for(i=0; i<=nvars-1; i++) - { - lm->w.ptr.p_double[offs+i] = 0; - } - for(i=0; i<=nvars-1; i++) - { - r = t.ptr.p_double[i]*svi.ptr.p_double[i]; - ae_v_addd(&lm->w.ptr.p_double[offs], 1, &vt.ptr.pp_double[i][0], 1, ae_v_len(offs,offs+nvars-1), r); - } - for(j=0; j<=nvars-1; j++) - { - r = svi.ptr.p_double[j]; - ae_v_moved(&vm.ptr.pp_double[0][j], vm.stride, &vt.ptr.pp_double[j][0], 1, ae_v_len(0,nvars-1), r); - } - for(i=0; i<=nvars-1; i++) - { - for(j=i; j<=nvars-1; j++) - { - r = ae_v_dotproduct(&vm.ptr.pp_double[i][0], 1, &vm.ptr.pp_double[j][0], 1, ae_v_len(0,nvars-1)); - ar->c.ptr.pp_double[i][j] = r; - ar->c.ptr.pp_double[j][i] = r; - } - } - - /* - * Leave-1-out cross-validation error. - * - * NOTATIONS: - * A design matrix - * A*x = b original linear least squares task - * U*S*V' SVD of A - * ai i-th row of the A - * bi i-th element of the b - * xf solution of the original LLS task - * - * Cross-validation error of i-th element from a sample is - * calculated using following formula: - * - * ERRi = ai*xf - (ai*xf-bi*(ui*ui'))/(1-ui*ui') (1) - * - * This formula can be derived from normal equations of the - * original task - * - * (A'*A)x = A'*b (2) - * - * by applying modification (zeroing out i-th row of A) to (2): - * - * (A-ai)'*(A-ai) = (A-ai)'*b - * - * and using Sherman-Morrison formula for updating matrix inverse - * - * NOTE 1: b is not zeroed out since it is much simpler and - * does not influence final result. - * - * NOTE 2: some design matrices A have such ui that 1-ui*ui'=0. - * Formula (1) can't be applied for such cases and they are skipped - * from CV calculation (which distorts resulting CV estimate). - * But from the properties of U we can conclude that there can - * be no more than NVars such vectors. Usually - * NVars << NPoints, so in a normal case it only slightly - * influences result. - */ - ncv = 0; - na = 0; - nacv = 0; - ar->rmserror = 0; - ar->avgerror = 0; - ar->avgrelerror = 0; - ar->cvrmserror = 0; - ar->cvavgerror = 0; - ar->cvavgrelerror = 0; - ar->ncvdefects = 0; - ae_vector_set_length(&ar->cvdefects, nvars-1+1, _state); - for(i=0; i<=npoints-1; i++) - { - - /* - * Error on a training set - */ - r = ae_v_dotproduct(&xy->ptr.pp_double[i][0], 1, &lm->w.ptr.p_double[offs], 1, ae_v_len(0,nvars-1)); - ar->rmserror = ar->rmserror+ae_sqr(r-xy->ptr.pp_double[i][nvars], _state); - ar->avgerror = ar->avgerror+ae_fabs(r-xy->ptr.pp_double[i][nvars], _state); - if( ae_fp_neq(xy->ptr.pp_double[i][nvars],0) ) - { - ar->avgrelerror = ar->avgrelerror+ae_fabs((r-xy->ptr.pp_double[i][nvars])/xy->ptr.pp_double[i][nvars], _state); - na = na+1; - } - - /* - * Error using fast leave-one-out cross-validation - */ - p = ae_v_dotproduct(&u.ptr.pp_double[i][0], 1, &u.ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); - if( ae_fp_greater(p,1-epstol*ae_machineepsilon) ) - { - ar->cvdefects.ptr.p_int[ar->ncvdefects] = i; - ar->ncvdefects = ar->ncvdefects+1; - continue; - } - r = s->ptr.p_double[i]*(r/s->ptr.p_double[i]-b.ptr.p_double[i]*p)/(1-p); - ar->cvrmserror = ar->cvrmserror+ae_sqr(r-xy->ptr.pp_double[i][nvars], _state); - ar->cvavgerror = ar->cvavgerror+ae_fabs(r-xy->ptr.pp_double[i][nvars], _state); - if( ae_fp_neq(xy->ptr.pp_double[i][nvars],0) ) - { - ar->cvavgrelerror = ar->cvavgrelerror+ae_fabs((r-xy->ptr.pp_double[i][nvars])/xy->ptr.pp_double[i][nvars], _state); - nacv = nacv+1; - } - ncv = ncv+1; - } - if( ncv==0 ) - { - - /* - * Something strange: ALL ui are degenerate. - * Unexpected... - */ - *info = -255; - ae_frame_leave(_state); - return; - } - ar->rmserror = ae_sqrt(ar->rmserror/npoints, _state); - ar->avgerror = ar->avgerror/npoints; - if( na!=0 ) - { - ar->avgrelerror = ar->avgrelerror/na; - } - ar->cvrmserror = ae_sqrt(ar->cvrmserror/ncv, _state); - ar->cvavgerror = ar->cvavgerror/ncv; - if( nacv!=0 ) - { - ar->cvavgrelerror = ar->cvavgrelerror/nacv; - } - ae_frame_leave(_state); -} - - -ae_bool _linearmodel_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - linearmodel *p = (linearmodel*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->w, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _linearmodel_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - linearmodel *dst = (linearmodel*)_dst; - linearmodel *src = (linearmodel*)_src; - if( !ae_vector_init_copy(&dst->w, &src->w, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _linearmodel_clear(void* _p) -{ - linearmodel *p = (linearmodel*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->w); -} - - -void _linearmodel_destroy(void* _p) -{ - linearmodel *p = (linearmodel*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->w); -} - - -ae_bool _lrreport_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - lrreport *p = (lrreport*)_p; - ae_touch_ptr((void*)p); - if( !ae_matrix_init(&p->c, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->cvdefects, 0, DT_INT, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _lrreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - lrreport *dst = (lrreport*)_dst; - lrreport *src = (lrreport*)_src; - if( !ae_matrix_init_copy(&dst->c, &src->c, _state, make_automatic) ) - return ae_false; - dst->rmserror = src->rmserror; - dst->avgerror = src->avgerror; - dst->avgrelerror = src->avgrelerror; - dst->cvrmserror = src->cvrmserror; - dst->cvavgerror = src->cvavgerror; - dst->cvavgrelerror = src->cvavgrelerror; - dst->ncvdefects = src->ncvdefects; - if( !ae_vector_init_copy(&dst->cvdefects, &src->cvdefects, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _lrreport_clear(void* _p) -{ - lrreport *p = (lrreport*)_p; - ae_touch_ptr((void*)p); - ae_matrix_clear(&p->c); - ae_vector_clear(&p->cvdefects); -} - - -void _lrreport_destroy(void* _p) -{ - lrreport *p = (lrreport*)_p; - ae_touch_ptr((void*)p); - ae_matrix_destroy(&p->c); - ae_vector_destroy(&p->cvdefects); -} - - - - -/************************************************************************* -Filters: simple moving averages (unsymmetric). - -This filter replaces array by results of SMA(K) filter. SMA(K) is defined -as filter which averages at most K previous points (previous - not points -AROUND central point) - or less, in case of the first K-1 points. - -INPUT PARAMETERS: - X - array[N], array to process. It can be larger than N, - in this case only first N points are processed. - N - points count, N>=0 - K - K>=1 (K can be larger than N , such cases will be - correctly handled). Window width. K=1 corresponds to - identity transformation (nothing changes). - -OUTPUT PARAMETERS: - X - array, whose first N elements were processed with SMA(K) - -NOTE 1: this function uses efficient in-place algorithm which does not - allocate temporary arrays. - -NOTE 2: this algorithm makes only one pass through array and uses running - sum to speed-up calculation of the averages. Additional measures - are taken to ensure that running sum on a long sequence of zero - elements will be correctly reset to zero even in the presence of - round-off error. - -NOTE 3: this is unsymmetric version of the algorithm, which does NOT - averages points after the current one. Only X[i], X[i-1], ... are - used when calculating new value of X[i]. We should also note that - this algorithm uses BOTH previous points and current one, i.e. - new value of X[i] depends on BOTH previous point and X[i] itself. - - -- ALGLIB -- - Copyright 25.10.2011 by Bochkanov Sergey -*************************************************************************/ -void filtersma(/* Real */ ae_vector* x, - ae_int_t n, - ae_int_t k, - ae_state *_state) -{ - ae_int_t i; - double runningsum; - double termsinsum; - ae_int_t zeroprefix; - double v; - - - ae_assert(n>=0, "FilterSMA: N<0", _state); - ae_assert(x->cnt>=n, "FilterSMA: Length(X)=1, "FilterSMA: K<1", _state); - - /* - * Quick exit, if necessary - */ - if( n<=1||k==1 ) - { - return; - } - - /* - * Prepare variables (see below for explanation) - */ - runningsum = 0.0; - termsinsum = 0; - for(i=ae_maxint(n-k, 0, _state); i<=n-1; i++) - { - runningsum = runningsum+x->ptr.p_double[i]; - termsinsum = termsinsum+1; - } - i = ae_maxint(n-k, 0, _state); - zeroprefix = 0; - while(i<=n-1&&ae_fp_eq(x->ptr.p_double[i],0)) - { - zeroprefix = zeroprefix+1; - i = i+1; - } - - /* - * General case: we assume that N>1 and K>1 - * - * Make one pass through all elements. At the beginning of - * the iteration we have: - * * I element being processed - * * RunningSum current value of the running sum - * (including I-th element) - * * TermsInSum number of terms in sum, 0<=TermsInSum<=K - * * ZeroPrefix length of the sequence of zero elements - * which starts at X[I-K+1] and continues towards X[I]. - * Equal to zero in case X[I-K+1] is non-zero. - * This value is used to make RunningSum exactly zero - * when it follows from the problem properties. - */ - for(i=n-1; i>=0; i--) - { - - /* - * Store new value of X[i], save old value in V - */ - v = x->ptr.p_double[i]; - x->ptr.p_double[i] = runningsum/termsinsum; - - /* - * Update RunningSum and TermsInSum - */ - if( i-k>=0 ) - { - runningsum = runningsum-v+x->ptr.p_double[i-k]; - } - else - { - runningsum = runningsum-v; - termsinsum = termsinsum-1; - } - - /* - * Update ZeroPrefix. - * In case we have ZeroPrefix=TermsInSum, - * RunningSum is reset to zero. - */ - if( i-k>=0 ) - { - if( ae_fp_neq(x->ptr.p_double[i-k],0) ) - { - zeroprefix = 0; - } - else - { - zeroprefix = ae_minint(zeroprefix+1, k, _state); - } - } - else - { - zeroprefix = ae_minint(zeroprefix, i+1, _state); - } - if( ae_fp_eq(zeroprefix,termsinsum) ) - { - runningsum = 0; - } - } -} - - -/************************************************************************* -Filters: exponential moving averages. - -This filter replaces array by results of EMA(alpha) filter. EMA(alpha) is -defined as filter which replaces X[] by S[]: - S[0] = X[0] - S[t] = alpha*X[t] + (1-alpha)*S[t-1] - -INPUT PARAMETERS: - X - array[N], array to process. It can be larger than N, - in this case only first N points are processed. - N - points count, N>=0 - alpha - 0=0, "FilterEMA: N<0", _state); - ae_assert(x->cnt>=n, "FilterEMA: Length(X)1", _state); - - /* - * Quick exit, if necessary - */ - if( n<=1||ae_fp_eq(alpha,1) ) - { - return; - } - - /* - * Process - */ - for(i=1; i<=n-1; i++) - { - x->ptr.p_double[i] = alpha*x->ptr.p_double[i]+(1-alpha)*x->ptr.p_double[i-1]; - } -} - - -/************************************************************************* -Filters: linear regression moving averages. - -This filter replaces array by results of LRMA(K) filter. - -LRMA(K) is defined as filter which, for each data point, builds linear -regression model using K prevous points (point itself is included in -these K points) and calculates value of this linear model at the point in -question. - -INPUT PARAMETERS: - X - array[N], array to process. It can be larger than N, - in this case only first N points are processed. - N - points count, N>=0 - K - K>=1 (K can be larger than N , such cases will be - correctly handled). Window width. K=1 corresponds to - identity transformation (nothing changes). - -OUTPUT PARAMETERS: - X - array, whose first N elements were processed with SMA(K) - -NOTE 1: this function uses efficient in-place algorithm which does not - allocate temporary arrays. - -NOTE 2: this algorithm makes only one pass through array and uses running - sum to speed-up calculation of the averages. Additional measures - are taken to ensure that running sum on a long sequence of zero - elements will be correctly reset to zero even in the presence of - round-off error. - -NOTE 3: this is unsymmetric version of the algorithm, which does NOT - averages points after the current one. Only X[i], X[i-1], ... are - used when calculating new value of X[i]. We should also note that - this algorithm uses BOTH previous points and current one, i.e. - new value of X[i] depends on BOTH previous point and X[i] itself. - - -- ALGLIB -- - Copyright 25.10.2011 by Bochkanov Sergey -*************************************************************************/ -void filterlrma(/* Real */ ae_vector* x, - ae_int_t n, - ae_int_t k, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t m; - ae_matrix xy; - ae_vector s; - ae_int_t info; - double a; - double b; - double vara; - double varb; - double covab; - double corrab; - double p; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init(&xy, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&s, 0, DT_REAL, _state, ae_true); - - ae_assert(n>=0, "FilterLRMA: N<0", _state); - ae_assert(x->cnt>=n, "FilterLRMA: Length(X)=1, "FilterLRMA: K<1", _state); - - /* - * Quick exit, if necessary: - * * either N is equal to 1 (nothing to average) - * * or K is 1 (only point itself is used) or 2 (model is too simple, - * we will always get identity transformation) - */ - if( n<=1||k<=2 ) - { - ae_frame_leave(_state); - return; - } - - /* - * General case: K>2, N>1. - * We do not process points with I<2 because first two points (I=0 and I=1) will be - * left unmodified by LRMA filter in any case. - */ - ae_matrix_set_length(&xy, k, 2, _state); - ae_vector_set_length(&s, k, _state); - for(i=0; i<=k-1; i++) - { - xy.ptr.pp_double[i][0] = i; - s.ptr.p_double[i] = 1.0; - } - for(i=n-1; i>=2; i--) - { - m = ae_minint(i+1, k, _state); - ae_v_move(&xy.ptr.pp_double[0][1], xy.stride, &x->ptr.p_double[i-m+1], 1, ae_v_len(0,m-1)); - lrlines(&xy, &s, m, &info, &a, &b, &vara, &varb, &covab, &corrab, &p, _state); - ae_assert(info==1, "FilterLRMA: internal error", _state); - x->ptr.p_double[i] = a+b*(m-1); - } - ae_frame_leave(_state); -} - - - - -/************************************************************************* -Multiclass Fisher LDA - -Subroutine finds coefficients of linear combination which optimally separates -training set on classes. - -INPUT PARAMETERS: - XY - training set, array[0..NPoints-1,0..NVars]. - First NVars columns store values of independent - variables, next column stores number of class (from 0 - to NClasses-1) which dataset element belongs to. Fractional - values are rounded to nearest integer. - NPoints - training set size, NPoints>=0 - NVars - number of independent variables, NVars>=1 - NClasses - number of classes, NClasses>=2 - - -OUTPUT PARAMETERS: - Info - return code: - * -4, if internal EVD subroutine hasn't converged - * -2, if there is a point with class number - outside of [0..NClasses-1]. - * -1, if incorrect parameters was passed (NPoints<0, - NVars<1, NClasses<2) - * 1, if task has been solved - * 2, if there was a multicollinearity in training set, - but task has been solved. - W - linear combination coefficients, array[0..NVars-1] - - -- ALGLIB -- - Copyright 31.05.2008 by Bochkanov Sergey -*************************************************************************/ -void fisherlda(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t nclasses, - ae_int_t* info, - /* Real */ ae_vector* w, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix w2; - - ae_frame_make(_state, &_frame_block); - *info = 0; - ae_vector_clear(w); - ae_matrix_init(&w2, 0, 0, DT_REAL, _state, ae_true); - - fisherldan(xy, npoints, nvars, nclasses, info, &w2, _state); - if( *info>0 ) - { - ae_vector_set_length(w, nvars-1+1, _state); - ae_v_move(&w->ptr.p_double[0], 1, &w2.ptr.pp_double[0][0], w2.stride, ae_v_len(0,nvars-1)); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -N-dimensional multiclass Fisher LDA - -Subroutine finds coefficients of linear combinations which optimally separates -training set on classes. It returns N-dimensional basis whose vector are sorted -by quality of training set separation (in descending order). - -INPUT PARAMETERS: - XY - training set, array[0..NPoints-1,0..NVars]. - First NVars columns store values of independent - variables, next column stores number of class (from 0 - to NClasses-1) which dataset element belongs to. Fractional - values are rounded to nearest integer. - NPoints - training set size, NPoints>=0 - NVars - number of independent variables, NVars>=1 - NClasses - number of classes, NClasses>=2 - - -OUTPUT PARAMETERS: - Info - return code: - * -4, if internal EVD subroutine hasn't converged - * -2, if there is a point with class number - outside of [0..NClasses-1]. - * -1, if incorrect parameters was passed (NPoints<0, - NVars<1, NClasses<2) - * 1, if task has been solved - * 2, if there was a multicollinearity in training set, - but task has been solved. - W - basis, array[0..NVars-1,0..NVars-1] - columns of matrix stores basis vectors, sorted by - quality of training set separation (in descending order) - - -- ALGLIB -- - Copyright 31.05.2008 by Bochkanov Sergey -*************************************************************************/ -void fisherldan(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t nclasses, - ae_int_t* info, - /* Real */ ae_matrix* w, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t m; - double v; - ae_vector c; - ae_vector mu; - ae_matrix muc; - ae_vector nc; - ae_matrix sw; - ae_matrix st; - ae_matrix z; - ae_matrix z2; - ae_matrix tm; - ae_matrix sbroot; - ae_matrix a; - ae_matrix xyproj; - ae_matrix wproj; - ae_vector tf; - ae_vector d; - ae_vector d2; - ae_vector work; - - ae_frame_make(_state, &_frame_block); - *info = 0; - ae_matrix_clear(w); - ae_vector_init(&c, 0, DT_INT, _state, ae_true); - ae_vector_init(&mu, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&muc, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&nc, 0, DT_INT, _state, ae_true); - ae_matrix_init(&sw, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&st, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&z, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&z2, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&tm, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&sbroot, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&a, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&xyproj, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&wproj, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tf, 0, DT_REAL, _state, ae_true); - ae_vector_init(&d, 0, DT_REAL, _state, ae_true); - ae_vector_init(&d2, 0, DT_REAL, _state, ae_true); - ae_vector_init(&work, 0, DT_REAL, _state, ae_true); - - - /* - * Test data - */ - if( (npoints<0||nvars<1)||nclasses<2 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - for(i=0; i<=npoints-1; i++) - { - if( ae_round(xy->ptr.pp_double[i][nvars], _state)<0||ae_round(xy->ptr.pp_double[i][nvars], _state)>=nclasses ) - { - *info = -2; - ae_frame_leave(_state); - return; - } - } - *info = 1; - - /* - * Special case: NPoints<=1 - * Degenerate task. - */ - if( npoints<=1 ) - { - *info = 2; - ae_matrix_set_length(w, nvars-1+1, nvars-1+1, _state); - for(i=0; i<=nvars-1; i++) - { - for(j=0; j<=nvars-1; j++) - { - if( i==j ) - { - w->ptr.pp_double[i][j] = 1; - } - else - { - w->ptr.pp_double[i][j] = 0; - } - } - } - ae_frame_leave(_state); - return; - } - - /* - * Prepare temporaries - */ - ae_vector_set_length(&tf, nvars-1+1, _state); - ae_vector_set_length(&work, ae_maxint(nvars, npoints, _state)+1, _state); - - /* - * Convert class labels from reals to integers (just for convenience) - */ - ae_vector_set_length(&c, npoints-1+1, _state); - for(i=0; i<=npoints-1; i++) - { - c.ptr.p_int[i] = ae_round(xy->ptr.pp_double[i][nvars], _state); - } - - /* - * Calculate class sizes and means - */ - ae_vector_set_length(&mu, nvars-1+1, _state); - ae_matrix_set_length(&muc, nclasses-1+1, nvars-1+1, _state); - ae_vector_set_length(&nc, nclasses-1+1, _state); - for(j=0; j<=nvars-1; j++) - { - mu.ptr.p_double[j] = 0; - } - for(i=0; i<=nclasses-1; i++) - { - nc.ptr.p_int[i] = 0; - for(j=0; j<=nvars-1; j++) - { - muc.ptr.pp_double[i][j] = 0; - } - } - for(i=0; i<=npoints-1; i++) - { - ae_v_add(&mu.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); - ae_v_add(&muc.ptr.pp_double[c.ptr.p_int[i]][0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); - nc.ptr.p_int[c.ptr.p_int[i]] = nc.ptr.p_int[c.ptr.p_int[i]]+1; - } - for(i=0; i<=nclasses-1; i++) - { - v = (double)1/(double)nc.ptr.p_int[i]; - ae_v_muld(&muc.ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1), v); - } - v = (double)1/(double)npoints; - ae_v_muld(&mu.ptr.p_double[0], 1, ae_v_len(0,nvars-1), v); - - /* - * Create ST matrix - */ - ae_matrix_set_length(&st, nvars-1+1, nvars-1+1, _state); - for(i=0; i<=nvars-1; i++) - { - for(j=0; j<=nvars-1; j++) - { - st.ptr.pp_double[i][j] = 0; - } - } - for(k=0; k<=npoints-1; k++) - { - ae_v_move(&tf.ptr.p_double[0], 1, &xy->ptr.pp_double[k][0], 1, ae_v_len(0,nvars-1)); - ae_v_sub(&tf.ptr.p_double[0], 1, &mu.ptr.p_double[0], 1, ae_v_len(0,nvars-1)); - for(i=0; i<=nvars-1; i++) - { - v = tf.ptr.p_double[i]; - ae_v_addd(&st.ptr.pp_double[i][0], 1, &tf.ptr.p_double[0], 1, ae_v_len(0,nvars-1), v); - } - } - - /* - * Create SW matrix - */ - ae_matrix_set_length(&sw, nvars-1+1, nvars-1+1, _state); - for(i=0; i<=nvars-1; i++) - { - for(j=0; j<=nvars-1; j++) - { - sw.ptr.pp_double[i][j] = 0; - } - } - for(k=0; k<=npoints-1; k++) - { - ae_v_move(&tf.ptr.p_double[0], 1, &xy->ptr.pp_double[k][0], 1, ae_v_len(0,nvars-1)); - ae_v_sub(&tf.ptr.p_double[0], 1, &muc.ptr.pp_double[c.ptr.p_int[k]][0], 1, ae_v_len(0,nvars-1)); - for(i=0; i<=nvars-1; i++) - { - v = tf.ptr.p_double[i]; - ae_v_addd(&sw.ptr.pp_double[i][0], 1, &tf.ptr.p_double[0], 1, ae_v_len(0,nvars-1), v); - } - } - - /* - * Maximize ratio J=(w'*ST*w)/(w'*SW*w). - * - * First, make transition from w to v such that w'*ST*w becomes v'*v: - * v = root(ST)*w = R*w - * R = root(D)*Z' - * w = (root(ST)^-1)*v = RI*v - * RI = Z*inv(root(D)) - * J = (v'*v)/(v'*(RI'*SW*RI)*v) - * ST = Z*D*Z' - * - * so we have - * - * J = (v'*v) / (v'*(inv(root(D))*Z'*SW*Z*inv(root(D)))*v) = - * = (v'*v) / (v'*A*v) - */ - if( !smatrixevd(&st, nvars, 1, ae_true, &d, &z, _state) ) - { - *info = -4; - ae_frame_leave(_state); - return; - } - ae_matrix_set_length(w, nvars-1+1, nvars-1+1, _state); - if( ae_fp_less_eq(d.ptr.p_double[nvars-1],0)||ae_fp_less_eq(d.ptr.p_double[0],1000*ae_machineepsilon*d.ptr.p_double[nvars-1]) ) - { - - /* - * Special case: D[NVars-1]<=0 - * Degenerate task (all variables takes the same value). - */ - if( ae_fp_less_eq(d.ptr.p_double[nvars-1],0) ) - { - *info = 2; - for(i=0; i<=nvars-1; i++) - { - for(j=0; j<=nvars-1; j++) - { - if( i==j ) - { - w->ptr.pp_double[i][j] = 1; - } - else - { - w->ptr.pp_double[i][j] = 0; - } - } - } - ae_frame_leave(_state); - return; - } - - /* - * Special case: degenerate ST matrix, multicollinearity found. - * Since we know ST eigenvalues/vectors we can translate task to - * non-degenerate form. - * - * Let WG is orthogonal basis of the non zero variance subspace - * of the ST and let WZ is orthogonal basis of the zero variance - * subspace. - * - * Projection on WG allows us to use LDA on reduced M-dimensional - * subspace, N-M vectors of WZ allows us to update reduced LDA - * factors to full N-dimensional subspace. - */ - m = 0; - for(k=0; k<=nvars-1; k++) - { - if( ae_fp_less_eq(d.ptr.p_double[k],1000*ae_machineepsilon*d.ptr.p_double[nvars-1]) ) - { - m = k+1; - } - } - ae_assert(m!=0, "FisherLDAN: internal error #1", _state); - ae_matrix_set_length(&xyproj, npoints-1+1, nvars-m+1, _state); - matrixmatrixmultiply(xy, 0, npoints-1, 0, nvars-1, ae_false, &z, 0, nvars-1, m, nvars-1, ae_false, 1.0, &xyproj, 0, npoints-1, 0, nvars-m-1, 0.0, &work, _state); - for(i=0; i<=npoints-1; i++) - { - xyproj.ptr.pp_double[i][nvars-m] = xy->ptr.pp_double[i][nvars]; - } - fisherldan(&xyproj, npoints, nvars-m, nclasses, info, &wproj, _state); - if( *info<0 ) - { - ae_frame_leave(_state); - return; - } - matrixmatrixmultiply(&z, 0, nvars-1, m, nvars-1, ae_false, &wproj, 0, nvars-m-1, 0, nvars-m-1, ae_false, 1.0, w, 0, nvars-1, 0, nvars-m-1, 0.0, &work, _state); - for(k=nvars-m; k<=nvars-1; k++) - { - ae_v_move(&w->ptr.pp_double[0][k], w->stride, &z.ptr.pp_double[0][k-(nvars-m)], z.stride, ae_v_len(0,nvars-1)); - } - *info = 2; - } - else - { - - /* - * General case: no multicollinearity - */ - ae_matrix_set_length(&tm, nvars-1+1, nvars-1+1, _state); - ae_matrix_set_length(&a, nvars-1+1, nvars-1+1, _state); - matrixmatrixmultiply(&sw, 0, nvars-1, 0, nvars-1, ae_false, &z, 0, nvars-1, 0, nvars-1, ae_false, 1.0, &tm, 0, nvars-1, 0, nvars-1, 0.0, &work, _state); - matrixmatrixmultiply(&z, 0, nvars-1, 0, nvars-1, ae_true, &tm, 0, nvars-1, 0, nvars-1, ae_false, 1.0, &a, 0, nvars-1, 0, nvars-1, 0.0, &work, _state); - for(i=0; i<=nvars-1; i++) - { - for(j=0; j<=nvars-1; j++) - { - a.ptr.pp_double[i][j] = a.ptr.pp_double[i][j]/ae_sqrt(d.ptr.p_double[i]*d.ptr.p_double[j], _state); - } - } - if( !smatrixevd(&a, nvars, 1, ae_true, &d2, &z2, _state) ) - { - *info = -4; - ae_frame_leave(_state); - return; - } - for(k=0; k<=nvars-1; k++) - { - for(i=0; i<=nvars-1; i++) - { - tf.ptr.p_double[i] = z2.ptr.pp_double[i][k]/ae_sqrt(d.ptr.p_double[i], _state); - } - for(i=0; i<=nvars-1; i++) - { - v = ae_v_dotproduct(&z.ptr.pp_double[i][0], 1, &tf.ptr.p_double[0], 1, ae_v_len(0,nvars-1)); - w->ptr.pp_double[i][k] = v; - } - } - } - - /* - * Post-processing: - * * normalization - * * converting to non-negative form, if possible - */ - for(k=0; k<=nvars-1; k++) - { - v = ae_v_dotproduct(&w->ptr.pp_double[0][k], w->stride, &w->ptr.pp_double[0][k], w->stride, ae_v_len(0,nvars-1)); - v = 1/ae_sqrt(v, _state); - ae_v_muld(&w->ptr.pp_double[0][k], w->stride, ae_v_len(0,nvars-1), v); - v = 0; - for(i=0; i<=nvars-1; i++) - { - v = v+w->ptr.pp_double[i][k]; - } - if( ae_fp_less(v,0) ) - { - ae_v_muld(&w->ptr.pp_double[0][k], w->stride, ae_v_len(0,nvars-1), -1); - } - } - ae_frame_leave(_state); -} - - - - -/************************************************************************* -This function returns number of weights updates which is required for -gradient calculation problem to be splitted. -*************************************************************************/ -ae_int_t mlpgradsplitcost(ae_state *_state) -{ - ae_int_t result; - - - result = mlpbase_gradbasecasecost; - return result; -} - - -/************************************************************************* -This function returns number of elements in subset of dataset which is -required for gradient calculation problem to be splitted. -*************************************************************************/ -ae_int_t mlpgradsplitsize(ae_state *_state) -{ - ae_int_t result; - - - result = mlpbase_microbatchsize; - return result; -} - - -/************************************************************************* -Creates neural network with NIn inputs, NOut outputs, without hidden -layers, with linear output layer. Network weights are filled with small -random values. - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpcreate0(ae_int_t nin, - ae_int_t nout, - multilayerperceptron* network, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector lsizes; - ae_vector ltypes; - ae_vector lconnfirst; - ae_vector lconnlast; - ae_int_t layerscount; - ae_int_t lastproc; - - ae_frame_make(_state, &_frame_block); - _multilayerperceptron_clear(network); - ae_vector_init(&lsizes, 0, DT_INT, _state, ae_true); - ae_vector_init(<ypes, 0, DT_INT, _state, ae_true); - ae_vector_init(&lconnfirst, 0, DT_INT, _state, ae_true); - ae_vector_init(&lconnlast, 0, DT_INT, _state, ae_true); - - layerscount = 1+3; - - /* - * Allocate arrays - */ - ae_vector_set_length(&lsizes, layerscount-1+1, _state); - ae_vector_set_length(<ypes, layerscount-1+1, _state); - ae_vector_set_length(&lconnfirst, layerscount-1+1, _state); - ae_vector_set_length(&lconnlast, layerscount-1+1, _state); - - /* - * Layers - */ - mlpbase_addinputlayer(nin, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addbiasedsummatorlayer(nout, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addactivationlayer(-5, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - - /* - * Create - */ - mlpbase_mlpcreate(nin, nout, &lsizes, <ypes, &lconnfirst, &lconnlast, layerscount, ae_false, network, _state); - mlpbase_fillhighlevelinformation(network, nin, 0, 0, nout, ae_false, ae_true, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Same as MLPCreate0, but with one hidden layer (NHid neurons) with -non-linear activation function. Output layer is linear. - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpcreate1(ae_int_t nin, - ae_int_t nhid, - ae_int_t nout, - multilayerperceptron* network, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector lsizes; - ae_vector ltypes; - ae_vector lconnfirst; - ae_vector lconnlast; - ae_int_t layerscount; - ae_int_t lastproc; - - ae_frame_make(_state, &_frame_block); - _multilayerperceptron_clear(network); - ae_vector_init(&lsizes, 0, DT_INT, _state, ae_true); - ae_vector_init(<ypes, 0, DT_INT, _state, ae_true); - ae_vector_init(&lconnfirst, 0, DT_INT, _state, ae_true); - ae_vector_init(&lconnlast, 0, DT_INT, _state, ae_true); - - layerscount = 1+3+3; - - /* - * Allocate arrays - */ - ae_vector_set_length(&lsizes, layerscount-1+1, _state); - ae_vector_set_length(<ypes, layerscount-1+1, _state); - ae_vector_set_length(&lconnfirst, layerscount-1+1, _state); - ae_vector_set_length(&lconnlast, layerscount-1+1, _state); - - /* - * Layers - */ - mlpbase_addinputlayer(nin, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addbiasedsummatorlayer(nhid, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addactivationlayer(1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addbiasedsummatorlayer(nout, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addactivationlayer(-5, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - - /* - * Create - */ - mlpbase_mlpcreate(nin, nout, &lsizes, <ypes, &lconnfirst, &lconnlast, layerscount, ae_false, network, _state); - mlpbase_fillhighlevelinformation(network, nin, nhid, 0, nout, ae_false, ae_true, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Same as MLPCreate0, but with two hidden layers (NHid1 and NHid2 neurons) -with non-linear activation function. Output layer is linear. - $ALL - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpcreate2(ae_int_t nin, - ae_int_t nhid1, - ae_int_t nhid2, - ae_int_t nout, - multilayerperceptron* network, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector lsizes; - ae_vector ltypes; - ae_vector lconnfirst; - ae_vector lconnlast; - ae_int_t layerscount; - ae_int_t lastproc; - - ae_frame_make(_state, &_frame_block); - _multilayerperceptron_clear(network); - ae_vector_init(&lsizes, 0, DT_INT, _state, ae_true); - ae_vector_init(<ypes, 0, DT_INT, _state, ae_true); - ae_vector_init(&lconnfirst, 0, DT_INT, _state, ae_true); - ae_vector_init(&lconnlast, 0, DT_INT, _state, ae_true); - - layerscount = 1+3+3+3; - - /* - * Allocate arrays - */ - ae_vector_set_length(&lsizes, layerscount-1+1, _state); - ae_vector_set_length(<ypes, layerscount-1+1, _state); - ae_vector_set_length(&lconnfirst, layerscount-1+1, _state); - ae_vector_set_length(&lconnlast, layerscount-1+1, _state); - - /* - * Layers - */ - mlpbase_addinputlayer(nin, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addbiasedsummatorlayer(nhid1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addactivationlayer(1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addbiasedsummatorlayer(nhid2, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addactivationlayer(1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addbiasedsummatorlayer(nout, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addactivationlayer(-5, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - - /* - * Create - */ - mlpbase_mlpcreate(nin, nout, &lsizes, <ypes, &lconnfirst, &lconnlast, layerscount, ae_false, network, _state); - mlpbase_fillhighlevelinformation(network, nin, nhid1, nhid2, nout, ae_false, ae_true, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Creates neural network with NIn inputs, NOut outputs, without hidden -layers with non-linear output layer. Network weights are filled with small -random values. - -Activation function of the output layer takes values: - - (B, +INF), if D>=0 - -or - - (-INF, B), if D<0. - - - -- ALGLIB -- - Copyright 30.03.2008 by Bochkanov Sergey -*************************************************************************/ -void mlpcreateb0(ae_int_t nin, - ae_int_t nout, - double b, - double d, - multilayerperceptron* network, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector lsizes; - ae_vector ltypes; - ae_vector lconnfirst; - ae_vector lconnlast; - ae_int_t layerscount; - ae_int_t lastproc; - ae_int_t i; - - ae_frame_make(_state, &_frame_block); - _multilayerperceptron_clear(network); - ae_vector_init(&lsizes, 0, DT_INT, _state, ae_true); - ae_vector_init(<ypes, 0, DT_INT, _state, ae_true); - ae_vector_init(&lconnfirst, 0, DT_INT, _state, ae_true); - ae_vector_init(&lconnlast, 0, DT_INT, _state, ae_true); - - layerscount = 1+3; - if( ae_fp_greater_eq(d,0) ) - { - d = 1; - } - else - { - d = -1; - } - - /* - * Allocate arrays - */ - ae_vector_set_length(&lsizes, layerscount-1+1, _state); - ae_vector_set_length(<ypes, layerscount-1+1, _state); - ae_vector_set_length(&lconnfirst, layerscount-1+1, _state); - ae_vector_set_length(&lconnlast, layerscount-1+1, _state); - - /* - * Layers - */ - mlpbase_addinputlayer(nin, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addbiasedsummatorlayer(nout, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addactivationlayer(3, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - - /* - * Create - */ - mlpbase_mlpcreate(nin, nout, &lsizes, <ypes, &lconnfirst, &lconnlast, layerscount, ae_false, network, _state); - mlpbase_fillhighlevelinformation(network, nin, 0, 0, nout, ae_false, ae_false, _state); - - /* - * Turn on ouputs shift/scaling. - */ - for(i=nin; i<=nin+nout-1; i++) - { - network->columnmeans.ptr.p_double[i] = b; - network->columnsigmas.ptr.p_double[i] = d; - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Same as MLPCreateB0 but with non-linear hidden layer. - - -- ALGLIB -- - Copyright 30.03.2008 by Bochkanov Sergey -*************************************************************************/ -void mlpcreateb1(ae_int_t nin, - ae_int_t nhid, - ae_int_t nout, - double b, - double d, - multilayerperceptron* network, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector lsizes; - ae_vector ltypes; - ae_vector lconnfirst; - ae_vector lconnlast; - ae_int_t layerscount; - ae_int_t lastproc; - ae_int_t i; - - ae_frame_make(_state, &_frame_block); - _multilayerperceptron_clear(network); - ae_vector_init(&lsizes, 0, DT_INT, _state, ae_true); - ae_vector_init(<ypes, 0, DT_INT, _state, ae_true); - ae_vector_init(&lconnfirst, 0, DT_INT, _state, ae_true); - ae_vector_init(&lconnlast, 0, DT_INT, _state, ae_true); - - layerscount = 1+3+3; - if( ae_fp_greater_eq(d,0) ) - { - d = 1; - } - else - { - d = -1; - } - - /* - * Allocate arrays - */ - ae_vector_set_length(&lsizes, layerscount-1+1, _state); - ae_vector_set_length(<ypes, layerscount-1+1, _state); - ae_vector_set_length(&lconnfirst, layerscount-1+1, _state); - ae_vector_set_length(&lconnlast, layerscount-1+1, _state); - - /* - * Layers - */ - mlpbase_addinputlayer(nin, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addbiasedsummatorlayer(nhid, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addactivationlayer(1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addbiasedsummatorlayer(nout, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addactivationlayer(3, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - - /* - * Create - */ - mlpbase_mlpcreate(nin, nout, &lsizes, <ypes, &lconnfirst, &lconnlast, layerscount, ae_false, network, _state); - mlpbase_fillhighlevelinformation(network, nin, nhid, 0, nout, ae_false, ae_false, _state); - - /* - * Turn on ouputs shift/scaling. - */ - for(i=nin; i<=nin+nout-1; i++) - { - network->columnmeans.ptr.p_double[i] = b; - network->columnsigmas.ptr.p_double[i] = d; - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Same as MLPCreateB0 but with two non-linear hidden layers. - - -- ALGLIB -- - Copyright 30.03.2008 by Bochkanov Sergey -*************************************************************************/ -void mlpcreateb2(ae_int_t nin, - ae_int_t nhid1, - ae_int_t nhid2, - ae_int_t nout, - double b, - double d, - multilayerperceptron* network, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector lsizes; - ae_vector ltypes; - ae_vector lconnfirst; - ae_vector lconnlast; - ae_int_t layerscount; - ae_int_t lastproc; - ae_int_t i; - - ae_frame_make(_state, &_frame_block); - _multilayerperceptron_clear(network); - ae_vector_init(&lsizes, 0, DT_INT, _state, ae_true); - ae_vector_init(<ypes, 0, DT_INT, _state, ae_true); - ae_vector_init(&lconnfirst, 0, DT_INT, _state, ae_true); - ae_vector_init(&lconnlast, 0, DT_INT, _state, ae_true); - - layerscount = 1+3+3+3; - if( ae_fp_greater_eq(d,0) ) - { - d = 1; - } - else - { - d = -1; - } - - /* - * Allocate arrays - */ - ae_vector_set_length(&lsizes, layerscount-1+1, _state); - ae_vector_set_length(<ypes, layerscount-1+1, _state); - ae_vector_set_length(&lconnfirst, layerscount-1+1, _state); - ae_vector_set_length(&lconnlast, layerscount-1+1, _state); - - /* - * Layers - */ - mlpbase_addinputlayer(nin, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addbiasedsummatorlayer(nhid1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addactivationlayer(1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addbiasedsummatorlayer(nhid2, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addactivationlayer(1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addbiasedsummatorlayer(nout, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addactivationlayer(3, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - - /* - * Create - */ - mlpbase_mlpcreate(nin, nout, &lsizes, <ypes, &lconnfirst, &lconnlast, layerscount, ae_false, network, _state); - mlpbase_fillhighlevelinformation(network, nin, nhid1, nhid2, nout, ae_false, ae_false, _state); - - /* - * Turn on ouputs shift/scaling. - */ - for(i=nin; i<=nin+nout-1; i++) - { - network->columnmeans.ptr.p_double[i] = b; - network->columnsigmas.ptr.p_double[i] = d; - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Creates neural network with NIn inputs, NOut outputs, without hidden -layers with non-linear output layer. Network weights are filled with small -random values. Activation function of the output layer takes values [A,B]. - - -- ALGLIB -- - Copyright 30.03.2008 by Bochkanov Sergey -*************************************************************************/ -void mlpcreater0(ae_int_t nin, - ae_int_t nout, - double a, - double b, - multilayerperceptron* network, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector lsizes; - ae_vector ltypes; - ae_vector lconnfirst; - ae_vector lconnlast; - ae_int_t layerscount; - ae_int_t lastproc; - ae_int_t i; - - ae_frame_make(_state, &_frame_block); - _multilayerperceptron_clear(network); - ae_vector_init(&lsizes, 0, DT_INT, _state, ae_true); - ae_vector_init(<ypes, 0, DT_INT, _state, ae_true); - ae_vector_init(&lconnfirst, 0, DT_INT, _state, ae_true); - ae_vector_init(&lconnlast, 0, DT_INT, _state, ae_true); - - layerscount = 1+3; - - /* - * Allocate arrays - */ - ae_vector_set_length(&lsizes, layerscount-1+1, _state); - ae_vector_set_length(<ypes, layerscount-1+1, _state); - ae_vector_set_length(&lconnfirst, layerscount-1+1, _state); - ae_vector_set_length(&lconnlast, layerscount-1+1, _state); - - /* - * Layers - */ - mlpbase_addinputlayer(nin, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addbiasedsummatorlayer(nout, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addactivationlayer(1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - - /* - * Create - */ - mlpbase_mlpcreate(nin, nout, &lsizes, <ypes, &lconnfirst, &lconnlast, layerscount, ae_false, network, _state); - mlpbase_fillhighlevelinformation(network, nin, 0, 0, nout, ae_false, ae_false, _state); - - /* - * Turn on outputs shift/scaling. - */ - for(i=nin; i<=nin+nout-1; i++) - { - network->columnmeans.ptr.p_double[i] = 0.5*(a+b); - network->columnsigmas.ptr.p_double[i] = 0.5*(a-b); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Same as MLPCreateR0, but with non-linear hidden layer. - - -- ALGLIB -- - Copyright 30.03.2008 by Bochkanov Sergey -*************************************************************************/ -void mlpcreater1(ae_int_t nin, - ae_int_t nhid, - ae_int_t nout, - double a, - double b, - multilayerperceptron* network, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector lsizes; - ae_vector ltypes; - ae_vector lconnfirst; - ae_vector lconnlast; - ae_int_t layerscount; - ae_int_t lastproc; - ae_int_t i; - - ae_frame_make(_state, &_frame_block); - _multilayerperceptron_clear(network); - ae_vector_init(&lsizes, 0, DT_INT, _state, ae_true); - ae_vector_init(<ypes, 0, DT_INT, _state, ae_true); - ae_vector_init(&lconnfirst, 0, DT_INT, _state, ae_true); - ae_vector_init(&lconnlast, 0, DT_INT, _state, ae_true); - - layerscount = 1+3+3; - - /* - * Allocate arrays - */ - ae_vector_set_length(&lsizes, layerscount-1+1, _state); - ae_vector_set_length(<ypes, layerscount-1+1, _state); - ae_vector_set_length(&lconnfirst, layerscount-1+1, _state); - ae_vector_set_length(&lconnlast, layerscount-1+1, _state); - - /* - * Layers - */ - mlpbase_addinputlayer(nin, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addbiasedsummatorlayer(nhid, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addactivationlayer(1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addbiasedsummatorlayer(nout, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addactivationlayer(1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - - /* - * Create - */ - mlpbase_mlpcreate(nin, nout, &lsizes, <ypes, &lconnfirst, &lconnlast, layerscount, ae_false, network, _state); - mlpbase_fillhighlevelinformation(network, nin, nhid, 0, nout, ae_false, ae_false, _state); - - /* - * Turn on outputs shift/scaling. - */ - for(i=nin; i<=nin+nout-1; i++) - { - network->columnmeans.ptr.p_double[i] = 0.5*(a+b); - network->columnsigmas.ptr.p_double[i] = 0.5*(a-b); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Same as MLPCreateR0, but with two non-linear hidden layers. - - -- ALGLIB -- - Copyright 30.03.2008 by Bochkanov Sergey -*************************************************************************/ -void mlpcreater2(ae_int_t nin, - ae_int_t nhid1, - ae_int_t nhid2, - ae_int_t nout, - double a, - double b, - multilayerperceptron* network, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector lsizes; - ae_vector ltypes; - ae_vector lconnfirst; - ae_vector lconnlast; - ae_int_t layerscount; - ae_int_t lastproc; - ae_int_t i; - - ae_frame_make(_state, &_frame_block); - _multilayerperceptron_clear(network); - ae_vector_init(&lsizes, 0, DT_INT, _state, ae_true); - ae_vector_init(<ypes, 0, DT_INT, _state, ae_true); - ae_vector_init(&lconnfirst, 0, DT_INT, _state, ae_true); - ae_vector_init(&lconnlast, 0, DT_INT, _state, ae_true); - - layerscount = 1+3+3+3; - - /* - * Allocate arrays - */ - ae_vector_set_length(&lsizes, layerscount-1+1, _state); - ae_vector_set_length(<ypes, layerscount-1+1, _state); - ae_vector_set_length(&lconnfirst, layerscount-1+1, _state); - ae_vector_set_length(&lconnlast, layerscount-1+1, _state); - - /* - * Layers - */ - mlpbase_addinputlayer(nin, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addbiasedsummatorlayer(nhid1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addactivationlayer(1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addbiasedsummatorlayer(nhid2, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addactivationlayer(1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addbiasedsummatorlayer(nout, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addactivationlayer(1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - - /* - * Create - */ - mlpbase_mlpcreate(nin, nout, &lsizes, <ypes, &lconnfirst, &lconnlast, layerscount, ae_false, network, _state); - mlpbase_fillhighlevelinformation(network, nin, nhid1, nhid2, nout, ae_false, ae_false, _state); - - /* - * Turn on outputs shift/scaling. - */ - for(i=nin; i<=nin+nout-1; i++) - { - network->columnmeans.ptr.p_double[i] = 0.5*(a+b); - network->columnsigmas.ptr.p_double[i] = 0.5*(a-b); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Creates classifier network with NIn inputs and NOut possible classes. -Network contains no hidden layers and linear output layer with SOFTMAX- -normalization (so outputs sums up to 1.0 and converge to posterior -probabilities). - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpcreatec0(ae_int_t nin, - ae_int_t nout, - multilayerperceptron* network, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector lsizes; - ae_vector ltypes; - ae_vector lconnfirst; - ae_vector lconnlast; - ae_int_t layerscount; - ae_int_t lastproc; - - ae_frame_make(_state, &_frame_block); - _multilayerperceptron_clear(network); - ae_vector_init(&lsizes, 0, DT_INT, _state, ae_true); - ae_vector_init(<ypes, 0, DT_INT, _state, ae_true); - ae_vector_init(&lconnfirst, 0, DT_INT, _state, ae_true); - ae_vector_init(&lconnlast, 0, DT_INT, _state, ae_true); - - ae_assert(nout>=2, "MLPCreateC0: NOut<2!", _state); - layerscount = 1+2+1; - - /* - * Allocate arrays - */ - ae_vector_set_length(&lsizes, layerscount-1+1, _state); - ae_vector_set_length(<ypes, layerscount-1+1, _state); - ae_vector_set_length(&lconnfirst, layerscount-1+1, _state); - ae_vector_set_length(&lconnlast, layerscount-1+1, _state); - - /* - * Layers - */ - mlpbase_addinputlayer(nin, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addbiasedsummatorlayer(nout-1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addzerolayer(&lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - - /* - * Create - */ - mlpbase_mlpcreate(nin, nout, &lsizes, <ypes, &lconnfirst, &lconnlast, layerscount, ae_true, network, _state); - mlpbase_fillhighlevelinformation(network, nin, 0, 0, nout, ae_true, ae_true, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Same as MLPCreateC0, but with one non-linear hidden layer. - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpcreatec1(ae_int_t nin, - ae_int_t nhid, - ae_int_t nout, - multilayerperceptron* network, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector lsizes; - ae_vector ltypes; - ae_vector lconnfirst; - ae_vector lconnlast; - ae_int_t layerscount; - ae_int_t lastproc; - - ae_frame_make(_state, &_frame_block); - _multilayerperceptron_clear(network); - ae_vector_init(&lsizes, 0, DT_INT, _state, ae_true); - ae_vector_init(<ypes, 0, DT_INT, _state, ae_true); - ae_vector_init(&lconnfirst, 0, DT_INT, _state, ae_true); - ae_vector_init(&lconnlast, 0, DT_INT, _state, ae_true); - - ae_assert(nout>=2, "MLPCreateC1: NOut<2!", _state); - layerscount = 1+3+2+1; - - /* - * Allocate arrays - */ - ae_vector_set_length(&lsizes, layerscount-1+1, _state); - ae_vector_set_length(<ypes, layerscount-1+1, _state); - ae_vector_set_length(&lconnfirst, layerscount-1+1, _state); - ae_vector_set_length(&lconnlast, layerscount-1+1, _state); - - /* - * Layers - */ - mlpbase_addinputlayer(nin, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addbiasedsummatorlayer(nhid, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addactivationlayer(1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addbiasedsummatorlayer(nout-1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addzerolayer(&lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - - /* - * Create - */ - mlpbase_mlpcreate(nin, nout, &lsizes, <ypes, &lconnfirst, &lconnlast, layerscount, ae_true, network, _state); - mlpbase_fillhighlevelinformation(network, nin, nhid, 0, nout, ae_true, ae_true, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Same as MLPCreateC0, but with two non-linear hidden layers. - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpcreatec2(ae_int_t nin, - ae_int_t nhid1, - ae_int_t nhid2, - ae_int_t nout, - multilayerperceptron* network, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector lsizes; - ae_vector ltypes; - ae_vector lconnfirst; - ae_vector lconnlast; - ae_int_t layerscount; - ae_int_t lastproc; - - ae_frame_make(_state, &_frame_block); - _multilayerperceptron_clear(network); - ae_vector_init(&lsizes, 0, DT_INT, _state, ae_true); - ae_vector_init(<ypes, 0, DT_INT, _state, ae_true); - ae_vector_init(&lconnfirst, 0, DT_INT, _state, ae_true); - ae_vector_init(&lconnlast, 0, DT_INT, _state, ae_true); - - ae_assert(nout>=2, "MLPCreateC2: NOut<2!", _state); - layerscount = 1+3+3+2+1; - - /* - * Allocate arrays - */ - ae_vector_set_length(&lsizes, layerscount-1+1, _state); - ae_vector_set_length(<ypes, layerscount-1+1, _state); - ae_vector_set_length(&lconnfirst, layerscount-1+1, _state); - ae_vector_set_length(&lconnlast, layerscount-1+1, _state); - - /* - * Layers - */ - mlpbase_addinputlayer(nin, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addbiasedsummatorlayer(nhid1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addactivationlayer(1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addbiasedsummatorlayer(nhid2, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addactivationlayer(1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addbiasedsummatorlayer(nout-1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - mlpbase_addzerolayer(&lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); - - /* - * Create - */ - mlpbase_mlpcreate(nin, nout, &lsizes, <ypes, &lconnfirst, &lconnlast, layerscount, ae_true, network, _state); - mlpbase_fillhighlevelinformation(network, nin, nhid1, nhid2, nout, ae_true, ae_true, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Copying of neural network - -INPUT PARAMETERS: - Network1 - original - -OUTPUT PARAMETERS: - Network2 - copy - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpcopy(multilayerperceptron* network1, - multilayerperceptron* network2, - ae_state *_state) -{ - - _multilayerperceptron_clear(network2); - - mlpcopyshared(network1, network2, _state); -} - - -/************************************************************************* -Copying of neural network (second parameter is passed as shared object). - -INPUT PARAMETERS: - Network1 - original - -OUTPUT PARAMETERS: - Network2 - copy - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpcopyshared(multilayerperceptron* network1, - multilayerperceptron* network2, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t wcount; - ae_int_t i; - mlpbuffers buf; - smlpgrad sgrad; - - ae_frame_make(_state, &_frame_block); - _mlpbuffers_init(&buf, _state, ae_true); - _smlpgrad_init(&sgrad, _state, ae_true); - - - /* - * Copy scalar and array fields - */ - network2->hlnetworktype = network1->hlnetworktype; - network2->hlnormtype = network1->hlnormtype; - copyintegerarray(&network1->hllayersizes, &network2->hllayersizes, _state); - copyintegerarray(&network1->hlconnections, &network2->hlconnections, _state); - copyintegerarray(&network1->hlneurons, &network2->hlneurons, _state); - copyintegerarray(&network1->structinfo, &network2->structinfo, _state); - copyrealarray(&network1->weights, &network2->weights, _state); - copyrealarray(&network1->columnmeans, &network2->columnmeans, _state); - copyrealarray(&network1->columnsigmas, &network2->columnsigmas, _state); - copyrealarray(&network1->neurons, &network2->neurons, _state); - copyrealarray(&network1->dfdnet, &network2->dfdnet, _state); - copyrealarray(&network1->derror, &network2->derror, _state); - copyrealarray(&network1->x, &network2->x, _state); - copyrealarray(&network1->y, &network2->y, _state); - copyrealarray(&network1->nwbuf, &network2->nwbuf, _state); - copyintegerarray(&network1->integerbuf, &network2->integerbuf, _state); - - /* - * copy buffers - */ - wcount = mlpgetweightscount(network1, _state); - ae_shared_pool_set_seed(&network2->buf, &buf, sizeof(buf), _mlpbuffers_init, _mlpbuffers_init_copy, _mlpbuffers_destroy, _state); - ae_vector_set_length(&sgrad.g, wcount, _state); - sgrad.f = 0.0; - for(i=0; i<=wcount-1; i++) - { - sgrad.g.ptr.p_double[i] = 0.0; - } - ae_shared_pool_set_seed(&network2->gradbuf, &sgrad, sizeof(sgrad), _smlpgrad_init, _smlpgrad_init_copy, _smlpgrad_destroy, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -This function compares architectures of neural networks. Only geometries -are compared, weights and other parameters are not tested. - - -- ALGLIB -- - Copyright 20.06.2013 by Bochkanov Sergey -*************************************************************************/ -ae_bool mlpsamearchitecture(multilayerperceptron* network1, - multilayerperceptron* network2, - ae_state *_state) -{ - ae_int_t i; - ae_int_t ninfo; - ae_bool result; - - - ae_assert(network1->structinfo.cnt>0&&network1->structinfo.cnt>=network1->structinfo.ptr.p_int[0], "MLPSameArchitecture: Network1 is uninitialized", _state); - ae_assert(network2->structinfo.cnt>0&&network2->structinfo.cnt>=network2->structinfo.ptr.p_int[0], "MLPSameArchitecture: Network2 is uninitialized", _state); - result = ae_false; - if( network1->structinfo.ptr.p_int[0]!=network2->structinfo.ptr.p_int[0] ) - { - return result; - } - ninfo = network1->structinfo.ptr.p_int[0]; - for(i=0; i<=ninfo-1; i++) - { - if( network1->structinfo.ptr.p_int[i]!=network2->structinfo.ptr.p_int[i] ) - { - return result; - } - } - result = ae_true; - return result; -} - - -/************************************************************************* -This function copies tunable parameters (weights/means/sigmas) from one -network to another with same architecture. It performs some rudimentary -checks that architectures are same, and throws exception if check fails. - -It is intended for fast copying of states between two network which are -known to have same geometry. - -INPUT PARAMETERS: - Network1 - source, must be correctly initialized - Network2 - target, must have same architecture - -OUTPUT PARAMETERS: - Network2 - network state is copied from source to target - - -- ALGLIB -- - Copyright 20.06.2013 by Bochkanov Sergey -*************************************************************************/ -void mlpcopytunableparameters(multilayerperceptron* network1, - multilayerperceptron* network2, - ae_state *_state) -{ - ae_int_t i; - ae_int_t ninfo; - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - - - ae_assert(network1->structinfo.cnt>0&&network1->structinfo.cnt>=network1->structinfo.ptr.p_int[0], "MLPCopyTunableParameters: Network1 is uninitialized", _state); - ae_assert(network2->structinfo.cnt>0&&network2->structinfo.cnt>=network2->structinfo.ptr.p_int[0], "MLPCopyTunableParameters: Network2 is uninitialized", _state); - ae_assert(network1->structinfo.ptr.p_int[0]==network2->structinfo.ptr.p_int[0], "MLPCopyTunableParameters: Network1 geometry differs from that of Network2", _state); - ninfo = network1->structinfo.ptr.p_int[0]; - for(i=0; i<=ninfo-1; i++) - { - ae_assert(network1->structinfo.ptr.p_int[i]==network2->structinfo.ptr.p_int[i], "MLPCopyTunableParameters: Network1 geometry differs from that of Network2", _state); - } - mlpproperties(network1, &nin, &nout, &wcount, _state); - for(i=0; i<=wcount-1; i++) - { - network2->weights.ptr.p_double[i] = network1->weights.ptr.p_double[i]; - } - if( mlpissoftmax(network1, _state) ) - { - for(i=0; i<=nin-1; i++) - { - network2->columnmeans.ptr.p_double[i] = network1->columnmeans.ptr.p_double[i]; - network2->columnsigmas.ptr.p_double[i] = network1->columnsigmas.ptr.p_double[i]; - } - } - else - { - for(i=0; i<=nin+nout-1; i++) - { - network2->columnmeans.ptr.p_double[i] = network1->columnmeans.ptr.p_double[i]; - network2->columnsigmas.ptr.p_double[i] = network1->columnsigmas.ptr.p_double[i]; - } - } -} - - -/************************************************************************* -This function exports tunable parameters (weights/means/sigmas) from -network to contiguous array. Nothing is guaranteed about array format, the -only thing you can count for is that MLPImportTunableParameters() will be -able to parse it. - -It is intended for fast copying of states between network and backup array - -INPUT PARAMETERS: - Network - source, must be correctly initialized - P - array to use. If its size is enough to store data, it - is reused. - -OUTPUT PARAMETERS: - P - array which stores network parameters, resized if needed - PCount - number of parameters stored in array. - - -- ALGLIB -- - Copyright 20.06.2013 by Bochkanov Sergey -*************************************************************************/ -void mlpexporttunableparameters(multilayerperceptron* network, - /* Real */ ae_vector* p, - ae_int_t* pcount, - ae_state *_state) -{ - ae_int_t i; - ae_int_t k; - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - - *pcount = 0; - - ae_assert(network->structinfo.cnt>0&&network->structinfo.cnt>=network->structinfo.ptr.p_int[0], "MLPExportTunableParameters: Network is uninitialized", _state); - mlpproperties(network, &nin, &nout, &wcount, _state); - if( mlpissoftmax(network, _state) ) - { - *pcount = wcount+2*nin; - rvectorsetlengthatleast(p, *pcount, _state); - k = 0; - for(i=0; i<=wcount-1; i++) - { - p->ptr.p_double[k] = network->weights.ptr.p_double[i]; - k = k+1; - } - for(i=0; i<=nin-1; i++) - { - p->ptr.p_double[k] = network->columnmeans.ptr.p_double[i]; - k = k+1; - p->ptr.p_double[k] = network->columnsigmas.ptr.p_double[i]; - k = k+1; - } - } - else - { - *pcount = wcount+2*(nin+nout); - rvectorsetlengthatleast(p, *pcount, _state); - k = 0; - for(i=0; i<=wcount-1; i++) - { - p->ptr.p_double[k] = network->weights.ptr.p_double[i]; - k = k+1; - } - for(i=0; i<=nin+nout-1; i++) - { - p->ptr.p_double[k] = network->columnmeans.ptr.p_double[i]; - k = k+1; - p->ptr.p_double[k] = network->columnsigmas.ptr.p_double[i]; - k = k+1; - } - } -} - - -/************************************************************************* -This function imports tunable parameters (weights/means/sigmas) which -were exported by MLPExportTunableParameters(). - -It is intended for fast copying of states between network and backup array - -INPUT PARAMETERS: - Network - target: - * must be correctly initialized - * must have same geometry as network used to export params - P - array with parameters - - -- ALGLIB -- - Copyright 20.06.2013 by Bochkanov Sergey -*************************************************************************/ -void mlpimporttunableparameters(multilayerperceptron* network, - /* Real */ ae_vector* p, - ae_state *_state) -{ - ae_int_t i; - ae_int_t k; - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - - - ae_assert(network->structinfo.cnt>0&&network->structinfo.cnt>=network->structinfo.ptr.p_int[0], "MLPImportTunableParameters: Network is uninitialized", _state); - mlpproperties(network, &nin, &nout, &wcount, _state); - if( mlpissoftmax(network, _state) ) - { - k = 0; - for(i=0; i<=wcount-1; i++) - { - network->weights.ptr.p_double[i] = p->ptr.p_double[k]; - k = k+1; - } - for(i=0; i<=nin-1; i++) - { - network->columnmeans.ptr.p_double[i] = p->ptr.p_double[k]; - k = k+1; - network->columnsigmas.ptr.p_double[i] = p->ptr.p_double[k]; - k = k+1; - } - } - else - { - k = 0; - for(i=0; i<=wcount-1; i++) - { - network->weights.ptr.p_double[i] = p->ptr.p_double[k]; - k = k+1; - } - for(i=0; i<=nin+nout-1; i++) - { - network->columnmeans.ptr.p_double[i] = p->ptr.p_double[k]; - k = k+1; - network->columnsigmas.ptr.p_double[i] = p->ptr.p_double[k]; - k = k+1; - } - } -} - - -/************************************************************************* -Serialization of MultiLayerPerceptron strucure - -INPUT PARAMETERS: - Network - original - -OUTPUT PARAMETERS: - RA - array of real numbers which stores network, - array[0..RLen-1] - RLen - RA length - - -- ALGLIB -- - Copyright 29.03.2008 by Bochkanov Sergey -*************************************************************************/ -void mlpserializeold(multilayerperceptron* network, - /* Real */ ae_vector* ra, - ae_int_t* rlen, - ae_state *_state) -{ - ae_int_t i; - ae_int_t ssize; - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - ae_int_t sigmalen; - ae_int_t offs; - - ae_vector_clear(ra); - *rlen = 0; - - - /* - * Unload info - */ - ssize = network->structinfo.ptr.p_int[0]; - nin = network->structinfo.ptr.p_int[1]; - nout = network->structinfo.ptr.p_int[2]; - wcount = network->structinfo.ptr.p_int[4]; - if( mlpissoftmax(network, _state) ) - { - sigmalen = nin; - } - else - { - sigmalen = nin+nout; - } - - /* - * RA format: - * LEN DESRC. - * 1 RLen - * 1 version (MLPVNum) - * 1 StructInfo size - * SSize StructInfo - * WCount Weights - * SigmaLen ColumnMeans - * SigmaLen ColumnSigmas - */ - *rlen = 3+ssize+wcount+2*sigmalen; - ae_vector_set_length(ra, *rlen-1+1, _state); - ra->ptr.p_double[0] = *rlen; - ra->ptr.p_double[1] = mlpbase_mlpvnum; - ra->ptr.p_double[2] = ssize; - offs = 3; - for(i=0; i<=ssize-1; i++) - { - ra->ptr.p_double[offs+i] = network->structinfo.ptr.p_int[i]; - } - offs = offs+ssize; - ae_v_move(&ra->ptr.p_double[offs], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(offs,offs+wcount-1)); - offs = offs+wcount; - ae_v_move(&ra->ptr.p_double[offs], 1, &network->columnmeans.ptr.p_double[0], 1, ae_v_len(offs,offs+sigmalen-1)); - offs = offs+sigmalen; - ae_v_move(&ra->ptr.p_double[offs], 1, &network->columnsigmas.ptr.p_double[0], 1, ae_v_len(offs,offs+sigmalen-1)); - offs = offs+sigmalen; -} - - -/************************************************************************* -Unserialization of MultiLayerPerceptron strucure - -INPUT PARAMETERS: - RA - real array which stores network - -OUTPUT PARAMETERS: - Network - restored network - - -- ALGLIB -- - Copyright 29.03.2008 by Bochkanov Sergey -*************************************************************************/ -void mlpunserializeold(/* Real */ ae_vector* ra, - multilayerperceptron* network, - ae_state *_state) -{ - ae_int_t i; - ae_int_t ssize; - ae_int_t ntotal; - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - ae_int_t sigmalen; - ae_int_t offs; - - _multilayerperceptron_clear(network); - - ae_assert(ae_round(ra->ptr.p_double[1], _state)==mlpbase_mlpvnum, "MLPUnserialize: incorrect array!", _state); - - /* - * Unload StructInfo from IA - */ - offs = 3; - ssize = ae_round(ra->ptr.p_double[2], _state); - ae_vector_set_length(&network->structinfo, ssize-1+1, _state); - for(i=0; i<=ssize-1; i++) - { - network->structinfo.ptr.p_int[i] = ae_round(ra->ptr.p_double[offs+i], _state); - } - offs = offs+ssize; - - /* - * Unload info from StructInfo - */ - ssize = network->structinfo.ptr.p_int[0]; - nin = network->structinfo.ptr.p_int[1]; - nout = network->structinfo.ptr.p_int[2]; - ntotal = network->structinfo.ptr.p_int[3]; - wcount = network->structinfo.ptr.p_int[4]; - if( network->structinfo.ptr.p_int[6]==0 ) - { - sigmalen = nin+nout; - } - else - { - sigmalen = nin; - } - - /* - * Allocate space for other fields - */ - ae_vector_set_length(&network->weights, wcount-1+1, _state); - ae_vector_set_length(&network->columnmeans, sigmalen-1+1, _state); - ae_vector_set_length(&network->columnsigmas, sigmalen-1+1, _state); - ae_vector_set_length(&network->neurons, ntotal-1+1, _state); - ae_vector_set_length(&network->nwbuf, ae_maxint(wcount, 2*nout, _state)-1+1, _state); - ae_vector_set_length(&network->dfdnet, ntotal-1+1, _state); - ae_vector_set_length(&network->x, nin-1+1, _state); - ae_vector_set_length(&network->y, nout-1+1, _state); - ae_vector_set_length(&network->derror, ntotal-1+1, _state); - - /* - * Copy parameters from RA - */ - ae_v_move(&network->weights.ptr.p_double[0], 1, &ra->ptr.p_double[offs], 1, ae_v_len(0,wcount-1)); - offs = offs+wcount; - ae_v_move(&network->columnmeans.ptr.p_double[0], 1, &ra->ptr.p_double[offs], 1, ae_v_len(0,sigmalen-1)); - offs = offs+sigmalen; - ae_v_move(&network->columnsigmas.ptr.p_double[0], 1, &ra->ptr.p_double[offs], 1, ae_v_len(0,sigmalen-1)); - offs = offs+sigmalen; -} - - -/************************************************************************* -Randomization of neural network weights - - -- ALGLIB -- - Copyright 06.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlprandomize(multilayerperceptron* network, ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - ae_int_t ntotal; - ae_int_t istart; - hqrndstate r; - ae_int_t entrysize; - ae_int_t entryoffs; - ae_int_t neuronidx; - ae_int_t neurontype; - double vmean; - double vvar; - ae_int_t i; - ae_int_t n1; - ae_int_t n2; - double desiredsigma; - ae_int_t montecarlocnt; - double ef; - double ef2; - double v; - double wscale; - - ae_frame_make(_state, &_frame_block); - _hqrndstate_init(&r, _state, ae_true); - - hqrndrandomize(&r, _state); - mlpproperties(network, &nin, &nout, &wcount, _state); - ntotal = network->structinfo.ptr.p_int[3]; - istart = network->structinfo.ptr.p_int[5]; - desiredsigma = 0.5; - montecarlocnt = 20; - - /* - * Stage 1: - * * Network.Weights is filled by standard deviation of weights - * * default values: sigma=1 - */ - for(i=0; i<=wcount-1; i++) - { - network->weights.ptr.p_double[i] = 1.0; - } - - /* - * Stage 2: - * * assume that input neurons have zero mean and unit standard deviation - * * assume that constant neurons have zero standard deviation - * * perform forward pass along neurons - * * for each non-input non-constant neuron: - * * calculate mean and standard deviation of neuron's output - * assuming that we know means/deviations of neurons which feed it - * and assuming that weights has unit variance and zero mean. - * * for each nonlinear neuron additionally we perform backward pass: - * * scale variances of weights which feed it in such way that neuron's - * input has unit standard deviation - * - * NOTE: this algorithm assumes that each connection feeds at most one - * non-linear neuron. This assumption can be incorrect in upcoming - * architectures with strong neurons. However, algorithm should - * work smoothly even in this case. - * - * During this stage we use Network.RndBuf, which is grouped into NTotal - * entries, each of them having following format: - * - * Buf[Offset+0] mean value of neuron's output - * Buf[Offset+1] standard deviation of neuron's output - * - * - */ - entrysize = 2; - rvectorsetlengthatleast(&network->rndbuf, entrysize*ntotal, _state); - for(neuronidx=0; neuronidx<=ntotal-1; neuronidx++) - { - neurontype = network->structinfo.ptr.p_int[istart+neuronidx*mlpbase_nfieldwidth+0]; - entryoffs = entrysize*neuronidx; - if( neurontype==-2 ) - { - - /* - * Input neuron: zero mean, unit variance. - */ - network->rndbuf.ptr.p_double[entryoffs+0] = 0.0; - network->rndbuf.ptr.p_double[entryoffs+1] = 1.0; - continue; - } - if( neurontype==-3 ) - { - - /* - * "-1" neuron: mean=-1, zero variance. - */ - network->rndbuf.ptr.p_double[entryoffs+0] = -1.0; - network->rndbuf.ptr.p_double[entryoffs+1] = 0.0; - continue; - } - if( neurontype==-4 ) - { - - /* - * "0" neuron: mean=0, zero variance. - */ - network->rndbuf.ptr.p_double[entryoffs+0] = 0.0; - network->rndbuf.ptr.p_double[entryoffs+1] = 0.0; - continue; - } - if( neurontype==0 ) - { - - /* - * Adaptive summator neuron: - * * calculate its mean and variance. - * * we assume that weights of this neuron have unit variance and zero mean. - * * thus, neuron's output is always have zero mean - * * as for variance, it is a bit more interesting: - * * let n[i] is i-th input neuron - * * let w[i] is i-th weight - * * we assume that n[i] and w[i] are independently distributed - * * Var(n0*w0+n1*w1+...) = Var(n0*w0)+Var(n1*w1)+... - * * Var(X*Y) = mean(X)^2*Var(Y) + mean(Y)^2*Var(X) + Var(X)*Var(Y) - * * mean(w[i])=0, var(w[i])=1 - * * Var(n[i]*w[i]) = mean(n[i])^2 + Var(n[i]) - */ - n1 = network->structinfo.ptr.p_int[istart+neuronidx*mlpbase_nfieldwidth+2]; - n2 = n1+network->structinfo.ptr.p_int[istart+neuronidx*mlpbase_nfieldwidth+1]-1; - vmean = 0.0; - vvar = 0.0; - for(i=n1; i<=n2; i++) - { - vvar = vvar+ae_sqr(network->rndbuf.ptr.p_double[entrysize*i+0], _state)+ae_sqr(network->rndbuf.ptr.p_double[entrysize*i+1], _state); - } - network->rndbuf.ptr.p_double[entryoffs+0] = vmean; - network->rndbuf.ptr.p_double[entryoffs+1] = ae_sqrt(vvar, _state); - continue; - } - if( neurontype==-5 ) - { - - /* - * Linear activation function - */ - i = network->structinfo.ptr.p_int[istart+neuronidx*mlpbase_nfieldwidth+2]; - vmean = network->rndbuf.ptr.p_double[entrysize*i+0]; - vvar = ae_sqr(network->rndbuf.ptr.p_double[entrysize*i+1], _state); - if( ae_fp_greater(vvar,0) ) - { - wscale = desiredsigma/ae_sqrt(vvar, _state); - } - else - { - wscale = 1.0; - } - mlpbase_randomizebackwardpass(network, i, wscale, _state); - network->rndbuf.ptr.p_double[entryoffs+0] = vmean*wscale; - network->rndbuf.ptr.p_double[entryoffs+1] = desiredsigma; - continue; - } - if( neurontype>0 ) - { - - /* - * Nonlinear activation function: - * * scale its inputs - * * estimate mean/sigma of its output using Monte-Carlo method - * (we simulate different inputs with unit deviation and - * sample activation function output on such inputs) - */ - i = network->structinfo.ptr.p_int[istart+neuronidx*mlpbase_nfieldwidth+2]; - vmean = network->rndbuf.ptr.p_double[entrysize*i+0]; - vvar = ae_sqr(network->rndbuf.ptr.p_double[entrysize*i+1], _state); - if( ae_fp_greater(vvar,0) ) - { - wscale = desiredsigma/ae_sqrt(vvar, _state); - } - else - { - wscale = 1.0; - } - mlpbase_randomizebackwardpass(network, i, wscale, _state); - ef = 0.0; - ef2 = 0.0; - vmean = vmean*wscale; - for(i=0; i<=montecarlocnt-1; i++) - { - v = vmean+desiredsigma*hqrndnormal(&r, _state); - ef = ef+v; - ef2 = ef2+v*v; - } - ef = ef/montecarlocnt; - ef2 = ef2/montecarlocnt; - network->rndbuf.ptr.p_double[entryoffs+0] = ef; - network->rndbuf.ptr.p_double[entryoffs+1] = ae_maxreal(ef2-ef*ef, 0.0, _state); - continue; - } - ae_assert(ae_false, "MLPRandomize: unexpected neuron type", _state); - } - - /* - * Stage 3: generate weights. - */ - for(i=0; i<=wcount-1; i++) - { - network->weights.ptr.p_double[i] = network->weights.ptr.p_double[i]*hqrndnormal(&r, _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Randomization of neural network weights and standartisator - - -- ALGLIB -- - Copyright 10.03.2008 by Bochkanov Sergey -*************************************************************************/ -void mlprandomizefull(multilayerperceptron* network, ae_state *_state) -{ - ae_int_t i; - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - ae_int_t ntotal; - ae_int_t istart; - ae_int_t offs; - ae_int_t ntype; - - - mlpproperties(network, &nin, &nout, &wcount, _state); - ntotal = network->structinfo.ptr.p_int[3]; - istart = network->structinfo.ptr.p_int[5]; - - /* - * Process network - */ - mlprandomize(network, _state); - for(i=0; i<=nin-1; i++) - { - network->columnmeans.ptr.p_double[i] = ae_randomreal(_state)-0.5; - network->columnsigmas.ptr.p_double[i] = ae_randomreal(_state)+0.5; - } - if( !mlpissoftmax(network, _state) ) - { - for(i=0; i<=nout-1; i++) - { - offs = istart+(ntotal-nout+i)*mlpbase_nfieldwidth; - ntype = network->structinfo.ptr.p_int[offs+0]; - if( ntype==0 ) - { - - /* - * Shifts are changed only for linear outputs neurons - */ - network->columnmeans.ptr.p_double[nin+i] = 2*ae_randomreal(_state)-1; - } - if( ntype==0||ntype==3 ) - { - - /* - * Scales are changed only for linear or bounded outputs neurons. - * Note that scale randomization preserves sign. - */ - network->columnsigmas.ptr.p_double[nin+i] = ae_sign(network->columnsigmas.ptr.p_double[nin+i], _state)*(1.5*ae_randomreal(_state)+0.5); - } - } - } -} - - -/************************************************************************* -Internal subroutine. - - -- ALGLIB -- - Copyright 30.03.2008 by Bochkanov Sergey -*************************************************************************/ -void mlpinitpreprocessor(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t ssize, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - ae_int_t jmax; - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - ae_int_t ntotal; - ae_int_t istart; - ae_int_t offs; - ae_int_t ntype; - ae_vector means; - ae_vector sigmas; - double s; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&means, 0, DT_REAL, _state, ae_true); - ae_vector_init(&sigmas, 0, DT_REAL, _state, ae_true); - - mlpproperties(network, &nin, &nout, &wcount, _state); - ntotal = network->structinfo.ptr.p_int[3]; - istart = network->structinfo.ptr.p_int[5]; - - /* - * Means/Sigmas - */ - if( mlpissoftmax(network, _state) ) - { - jmax = nin-1; - } - else - { - jmax = nin+nout-1; - } - ae_vector_set_length(&means, jmax+1, _state); - ae_vector_set_length(&sigmas, jmax+1, _state); - for(i=0; i<=jmax; i++) - { - means.ptr.p_double[i] = 0; - sigmas.ptr.p_double[i] = 0; - } - for(i=0; i<=ssize-1; i++) - { - for(j=0; j<=jmax; j++) - { - means.ptr.p_double[j] = means.ptr.p_double[j]+xy->ptr.pp_double[i][j]; - } - } - for(i=0; i<=jmax; i++) - { - means.ptr.p_double[i] = means.ptr.p_double[i]/ssize; - } - for(i=0; i<=ssize-1; i++) - { - for(j=0; j<=jmax; j++) - { - sigmas.ptr.p_double[j] = sigmas.ptr.p_double[j]+ae_sqr(xy->ptr.pp_double[i][j]-means.ptr.p_double[j], _state); - } - } - for(i=0; i<=jmax; i++) - { - sigmas.ptr.p_double[i] = ae_sqrt(sigmas.ptr.p_double[i]/ssize, _state); - } - - /* - * Inputs - */ - for(i=0; i<=nin-1; i++) - { - network->columnmeans.ptr.p_double[i] = means.ptr.p_double[i]; - network->columnsigmas.ptr.p_double[i] = sigmas.ptr.p_double[i]; - if( ae_fp_eq(network->columnsigmas.ptr.p_double[i],0) ) - { - network->columnsigmas.ptr.p_double[i] = 1; - } - } - - /* - * Outputs - */ - if( !mlpissoftmax(network, _state) ) - { - for(i=0; i<=nout-1; i++) - { - offs = istart+(ntotal-nout+i)*mlpbase_nfieldwidth; - ntype = network->structinfo.ptr.p_int[offs+0]; - - /* - * Linear outputs - */ - if( ntype==0 ) - { - network->columnmeans.ptr.p_double[nin+i] = means.ptr.p_double[nin+i]; - network->columnsigmas.ptr.p_double[nin+i] = sigmas.ptr.p_double[nin+i]; - if( ae_fp_eq(network->columnsigmas.ptr.p_double[nin+i],0) ) - { - network->columnsigmas.ptr.p_double[nin+i] = 1; - } - } - - /* - * Bounded outputs (half-interval) - */ - if( ntype==3 ) - { - s = means.ptr.p_double[nin+i]-network->columnmeans.ptr.p_double[nin+i]; - if( ae_fp_eq(s,0) ) - { - s = ae_sign(network->columnsigmas.ptr.p_double[nin+i], _state); - } - if( ae_fp_eq(s,0) ) - { - s = 1.0; - } - network->columnsigmas.ptr.p_double[nin+i] = ae_sign(network->columnsigmas.ptr.p_double[nin+i], _state)*ae_fabs(s, _state); - if( ae_fp_eq(network->columnsigmas.ptr.p_double[nin+i],0) ) - { - network->columnsigmas.ptr.p_double[nin+i] = 1; - } - } - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Internal subroutine. -Initialization for preprocessor based on a sample. - -INPUT - Network - initialized neural network; - XY - sample, given by sparse matrix; - SSize - sample size. - -OUTPUT - Network - neural network with initialised preprocessor. - - -- ALGLIB -- - Copyright 26.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpinitpreprocessorsparse(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t ssize, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t jmax; - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - ae_int_t ntotal; - ae_int_t istart; - ae_int_t offs; - ae_int_t ntype; - ae_vector means; - ae_vector sigmas; - double s; - ae_int_t i; - ae_int_t j; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&means, 0, DT_REAL, _state, ae_true); - ae_vector_init(&sigmas, 0, DT_REAL, _state, ae_true); - - mlpproperties(network, &nin, &nout, &wcount, _state); - ntotal = network->structinfo.ptr.p_int[3]; - istart = network->structinfo.ptr.p_int[5]; - - /* - * Means/Sigmas - */ - if( mlpissoftmax(network, _state) ) - { - jmax = nin-1; - } - else - { - jmax = nin+nout-1; - } - ae_vector_set_length(&means, jmax+1, _state); - ae_vector_set_length(&sigmas, jmax+1, _state); - for(i=0; i<=jmax; i++) - { - means.ptr.p_double[i] = 0; - sigmas.ptr.p_double[i] = 0; - } - for(i=0; i<=ssize-1; i++) - { - sparsegetrow(xy, i, &network->xyrow, _state); - for(j=0; j<=jmax; j++) - { - means.ptr.p_double[j] = means.ptr.p_double[j]+network->xyrow.ptr.p_double[j]; - } - } - for(i=0; i<=jmax; i++) - { - means.ptr.p_double[i] = means.ptr.p_double[i]/ssize; - } - for(i=0; i<=ssize-1; i++) - { - sparsegetrow(xy, i, &network->xyrow, _state); - for(j=0; j<=jmax; j++) - { - sigmas.ptr.p_double[j] = sigmas.ptr.p_double[j]+ae_sqr(network->xyrow.ptr.p_double[j]-means.ptr.p_double[j], _state); - } - } - for(i=0; i<=jmax; i++) - { - sigmas.ptr.p_double[i] = ae_sqrt(sigmas.ptr.p_double[i]/ssize, _state); - } - - /* - * Inputs - */ - for(i=0; i<=nin-1; i++) - { - network->columnmeans.ptr.p_double[i] = means.ptr.p_double[i]; - network->columnsigmas.ptr.p_double[i] = sigmas.ptr.p_double[i]; - if( ae_fp_eq(network->columnsigmas.ptr.p_double[i],0) ) - { - network->columnsigmas.ptr.p_double[i] = 1; - } - } - - /* - * Outputs - */ - if( !mlpissoftmax(network, _state) ) - { - for(i=0; i<=nout-1; i++) - { - offs = istart+(ntotal-nout+i)*mlpbase_nfieldwidth; - ntype = network->structinfo.ptr.p_int[offs+0]; - - /* - * Linear outputs - */ - if( ntype==0 ) - { - network->columnmeans.ptr.p_double[nin+i] = means.ptr.p_double[nin+i]; - network->columnsigmas.ptr.p_double[nin+i] = sigmas.ptr.p_double[nin+i]; - if( ae_fp_eq(network->columnsigmas.ptr.p_double[nin+i],0) ) - { - network->columnsigmas.ptr.p_double[nin+i] = 1; - } - } - - /* - * Bounded outputs (half-interval) - */ - if( ntype==3 ) - { - s = means.ptr.p_double[nin+i]-network->columnmeans.ptr.p_double[nin+i]; - if( ae_fp_eq(s,0) ) - { - s = ae_sign(network->columnsigmas.ptr.p_double[nin+i], _state); - } - if( ae_fp_eq(s,0) ) - { - s = 1.0; - } - network->columnsigmas.ptr.p_double[nin+i] = ae_sign(network->columnsigmas.ptr.p_double[nin+i], _state)*ae_fabs(s, _state); - if( ae_fp_eq(network->columnsigmas.ptr.p_double[nin+i],0) ) - { - network->columnsigmas.ptr.p_double[nin+i] = 1; - } - } - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Internal subroutine. -Initialization for preprocessor based on a subsample. - -INPUT PARAMETERS: - Network - network initialized with one of the network creation funcs - XY - original dataset; one sample = one row; - first NIn columns contain inputs, - next NOut columns - desired outputs. - SetSize - real size of XY, SetSize>=0; - Idx - subset of SubsetSize elements, array[SubsetSize]: - * Idx[I] stores row index in the original dataset which is - given by XY. Gradient is calculated with respect to rows - whose indexes are stored in Idx[]. - * Idx[] must store correct indexes; this function throws - an exception in case incorrect index (less than 0 or - larger than rows(XY)) is given - * Idx[] may store indexes in any order and even with - repetitions. - SubsetSize- number of elements in Idx[] array. - -OUTPUT: - Network - neural network with initialised preprocessor. - -NOTE: when SubsetSize<0 is used full dataset by call MLPInitPreprocessor - function. - - -- ALGLIB -- - Copyright 23.08.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpinitpreprocessorsubset(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t setsize, - /* Integer */ ae_vector* idx, - ae_int_t subsetsize, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t jmax; - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - ae_int_t ntotal; - ae_int_t istart; - ae_int_t offs; - ae_int_t ntype; - ae_vector means; - ae_vector sigmas; - double s; - ae_int_t npoints; - ae_int_t i; - ae_int_t j; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&means, 0, DT_REAL, _state, ae_true); - ae_vector_init(&sigmas, 0, DT_REAL, _state, ae_true); - - ae_assert(setsize>=0, "MLPInitPreprocessorSubset: SetSize<0", _state); - if( subsetsize<0 ) - { - mlpinitpreprocessor(network, xy, setsize, _state); - ae_frame_leave(_state); - return; - } - ae_assert(subsetsize<=idx->cnt, "MLPInitPreprocessorSubset: SubsetSize>Length(Idx)", _state); - npoints = setsize; - for(i=0; i<=subsetsize-1; i++) - { - ae_assert(idx->ptr.p_int[i]>=0, "MLPInitPreprocessorSubset: incorrect index of XY row(Idx[I]<0)", _state); - ae_assert(idx->ptr.p_int[i]<=npoints-1, "MLPInitPreprocessorSubset: incorrect index of XY row(Idx[I]>Rows(XY)-1)", _state); - } - mlpproperties(network, &nin, &nout, &wcount, _state); - ntotal = network->structinfo.ptr.p_int[3]; - istart = network->structinfo.ptr.p_int[5]; - - /* - * Means/Sigmas - */ - if( mlpissoftmax(network, _state) ) - { - jmax = nin-1; - } - else - { - jmax = nin+nout-1; - } - ae_vector_set_length(&means, jmax+1, _state); - ae_vector_set_length(&sigmas, jmax+1, _state); - for(i=0; i<=jmax; i++) - { - means.ptr.p_double[i] = 0; - sigmas.ptr.p_double[i] = 0; - } - for(i=0; i<=subsetsize-1; i++) - { - for(j=0; j<=jmax; j++) - { - means.ptr.p_double[j] = means.ptr.p_double[j]+xy->ptr.pp_double[idx->ptr.p_int[i]][j]; - } - } - for(i=0; i<=jmax; i++) - { - means.ptr.p_double[i] = means.ptr.p_double[i]/subsetsize; - } - for(i=0; i<=subsetsize-1; i++) - { - for(j=0; j<=jmax; j++) - { - sigmas.ptr.p_double[j] = sigmas.ptr.p_double[j]+ae_sqr(xy->ptr.pp_double[idx->ptr.p_int[i]][j]-means.ptr.p_double[j], _state); - } - } - for(i=0; i<=jmax; i++) - { - sigmas.ptr.p_double[i] = ae_sqrt(sigmas.ptr.p_double[i]/subsetsize, _state); - } - - /* - * Inputs - */ - for(i=0; i<=nin-1; i++) - { - network->columnmeans.ptr.p_double[i] = means.ptr.p_double[i]; - network->columnsigmas.ptr.p_double[i] = sigmas.ptr.p_double[i]; - if( ae_fp_eq(network->columnsigmas.ptr.p_double[i],0) ) - { - network->columnsigmas.ptr.p_double[i] = 1; - } - } - - /* - * Outputs - */ - if( !mlpissoftmax(network, _state) ) - { - for(i=0; i<=nout-1; i++) - { - offs = istart+(ntotal-nout+i)*mlpbase_nfieldwidth; - ntype = network->structinfo.ptr.p_int[offs+0]; - - /* - * Linear outputs - */ - if( ntype==0 ) - { - network->columnmeans.ptr.p_double[nin+i] = means.ptr.p_double[nin+i]; - network->columnsigmas.ptr.p_double[nin+i] = sigmas.ptr.p_double[nin+i]; - if( ae_fp_eq(network->columnsigmas.ptr.p_double[nin+i],0) ) - { - network->columnsigmas.ptr.p_double[nin+i] = 1; - } - } - - /* - * Bounded outputs (half-interval) - */ - if( ntype==3 ) - { - s = means.ptr.p_double[nin+i]-network->columnmeans.ptr.p_double[nin+i]; - if( ae_fp_eq(s,0) ) - { - s = ae_sign(network->columnsigmas.ptr.p_double[nin+i], _state); - } - if( ae_fp_eq(s,0) ) - { - s = 1.0; - } - network->columnsigmas.ptr.p_double[nin+i] = ae_sign(network->columnsigmas.ptr.p_double[nin+i], _state)*ae_fabs(s, _state); - if( ae_fp_eq(network->columnsigmas.ptr.p_double[nin+i],0) ) - { - network->columnsigmas.ptr.p_double[nin+i] = 1; - } - } - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Internal subroutine. -Initialization for preprocessor based on a subsample. - -INPUT PARAMETERS: - Network - network initialized with one of the network creation funcs - XY - original dataset, given by sparse matrix; - one sample = one row; - first NIn columns contain inputs, - next NOut columns - desired outputs. - SetSize - real size of XY, SetSize>=0; - Idx - subset of SubsetSize elements, array[SubsetSize]: - * Idx[I] stores row index in the original dataset which is - given by XY. Gradient is calculated with respect to rows - whose indexes are stored in Idx[]. - * Idx[] must store correct indexes; this function throws - an exception in case incorrect index (less than 0 or - larger than rows(XY)) is given - * Idx[] may store indexes in any order and even with - repetitions. - SubsetSize- number of elements in Idx[] array. - -OUTPUT: - Network - neural network with initialised preprocessor. - -NOTE: when SubsetSize<0 is used full dataset by call - MLPInitPreprocessorSparse function. - - -- ALGLIB -- - Copyright 26.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpinitpreprocessorsparsesubset(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t setsize, - /* Integer */ ae_vector* idx, - ae_int_t subsetsize, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t jmax; - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - ae_int_t ntotal; - ae_int_t istart; - ae_int_t offs; - ae_int_t ntype; - ae_vector means; - ae_vector sigmas; - double s; - ae_int_t npoints; - ae_int_t i; - ae_int_t j; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&means, 0, DT_REAL, _state, ae_true); - ae_vector_init(&sigmas, 0, DT_REAL, _state, ae_true); - - ae_assert(setsize>=0, "MLPInitPreprocessorSparseSubset: SetSize<0", _state); - if( subsetsize<0 ) - { - mlpinitpreprocessorsparse(network, xy, setsize, _state); - ae_frame_leave(_state); - return; - } - ae_assert(subsetsize<=idx->cnt, "MLPInitPreprocessorSparseSubset: SubsetSize>Length(Idx)", _state); - npoints = setsize; - for(i=0; i<=subsetsize-1; i++) - { - ae_assert(idx->ptr.p_int[i]>=0, "MLPInitPreprocessorSparseSubset: incorrect index of XY row(Idx[I]<0)", _state); - ae_assert(idx->ptr.p_int[i]<=npoints-1, "MLPInitPreprocessorSparseSubset: incorrect index of XY row(Idx[I]>Rows(XY)-1)", _state); - } - mlpproperties(network, &nin, &nout, &wcount, _state); - ntotal = network->structinfo.ptr.p_int[3]; - istart = network->structinfo.ptr.p_int[5]; - - /* - * Means/Sigmas - */ - if( mlpissoftmax(network, _state) ) - { - jmax = nin-1; - } - else - { - jmax = nin+nout-1; - } - ae_vector_set_length(&means, jmax+1, _state); - ae_vector_set_length(&sigmas, jmax+1, _state); - for(i=0; i<=jmax; i++) - { - means.ptr.p_double[i] = 0; - sigmas.ptr.p_double[i] = 0; - } - for(i=0; i<=subsetsize-1; i++) - { - sparsegetrow(xy, idx->ptr.p_int[i], &network->xyrow, _state); - for(j=0; j<=jmax; j++) - { - means.ptr.p_double[j] = means.ptr.p_double[j]+network->xyrow.ptr.p_double[j]; - } - } - for(i=0; i<=jmax; i++) - { - means.ptr.p_double[i] = means.ptr.p_double[i]/subsetsize; - } - for(i=0; i<=subsetsize-1; i++) - { - sparsegetrow(xy, idx->ptr.p_int[i], &network->xyrow, _state); - for(j=0; j<=jmax; j++) - { - sigmas.ptr.p_double[j] = sigmas.ptr.p_double[j]+ae_sqr(network->xyrow.ptr.p_double[j]-means.ptr.p_double[j], _state); - } - } - for(i=0; i<=jmax; i++) - { - sigmas.ptr.p_double[i] = ae_sqrt(sigmas.ptr.p_double[i]/subsetsize, _state); - } - - /* - * Inputs - */ - for(i=0; i<=nin-1; i++) - { - network->columnmeans.ptr.p_double[i] = means.ptr.p_double[i]; - network->columnsigmas.ptr.p_double[i] = sigmas.ptr.p_double[i]; - if( ae_fp_eq(network->columnsigmas.ptr.p_double[i],0) ) - { - network->columnsigmas.ptr.p_double[i] = 1; - } - } - - /* - * Outputs - */ - if( !mlpissoftmax(network, _state) ) - { - for(i=0; i<=nout-1; i++) - { - offs = istart+(ntotal-nout+i)*mlpbase_nfieldwidth; - ntype = network->structinfo.ptr.p_int[offs+0]; - - /* - * Linear outputs - */ - if( ntype==0 ) - { - network->columnmeans.ptr.p_double[nin+i] = means.ptr.p_double[nin+i]; - network->columnsigmas.ptr.p_double[nin+i] = sigmas.ptr.p_double[nin+i]; - if( ae_fp_eq(network->columnsigmas.ptr.p_double[nin+i],0) ) - { - network->columnsigmas.ptr.p_double[nin+i] = 1; - } - } - - /* - * Bounded outputs (half-interval) - */ - if( ntype==3 ) - { - s = means.ptr.p_double[nin+i]-network->columnmeans.ptr.p_double[nin+i]; - if( ae_fp_eq(s,0) ) - { - s = ae_sign(network->columnsigmas.ptr.p_double[nin+i], _state); - } - if( ae_fp_eq(s,0) ) - { - s = 1.0; - } - network->columnsigmas.ptr.p_double[nin+i] = ae_sign(network->columnsigmas.ptr.p_double[nin+i], _state)*ae_fabs(s, _state); - if( ae_fp_eq(network->columnsigmas.ptr.p_double[nin+i],0) ) - { - network->columnsigmas.ptr.p_double[nin+i] = 1; - } - } - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Returns information about initialized network: number of inputs, outputs, -weights. - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpproperties(multilayerperceptron* network, - ae_int_t* nin, - ae_int_t* nout, - ae_int_t* wcount, - ae_state *_state) -{ - - *nin = 0; - *nout = 0; - *wcount = 0; - - *nin = network->structinfo.ptr.p_int[1]; - *nout = network->structinfo.ptr.p_int[2]; - *wcount = network->structinfo.ptr.p_int[4]; -} - - -/************************************************************************* -Returns number of "internal", low-level neurons in the network (one which -is stored in StructInfo). - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -ae_int_t mlpntotal(multilayerperceptron* network, ae_state *_state) -{ - ae_int_t result; - - - result = network->structinfo.ptr.p_int[3]; - return result; -} - - -/************************************************************************* -Returns number of inputs. - - -- ALGLIB -- - Copyright 19.10.2011 by Bochkanov Sergey -*************************************************************************/ -ae_int_t mlpgetinputscount(multilayerperceptron* network, - ae_state *_state) -{ - ae_int_t result; - - - result = network->structinfo.ptr.p_int[1]; - return result; -} - - -/************************************************************************* -Returns number of outputs. - - -- ALGLIB -- - Copyright 19.10.2011 by Bochkanov Sergey -*************************************************************************/ -ae_int_t mlpgetoutputscount(multilayerperceptron* network, - ae_state *_state) -{ - ae_int_t result; - - - result = network->structinfo.ptr.p_int[2]; - return result; -} - - -/************************************************************************* -Returns number of weights. - - -- ALGLIB -- - Copyright 19.10.2011 by Bochkanov Sergey -*************************************************************************/ -ae_int_t mlpgetweightscount(multilayerperceptron* network, - ae_state *_state) -{ - ae_int_t result; - - - result = network->structinfo.ptr.p_int[4]; - return result; -} - - -/************************************************************************* -Tells whether network is SOFTMAX-normalized (i.e. classifier) or not. - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -ae_bool mlpissoftmax(multilayerperceptron* network, ae_state *_state) -{ - ae_bool result; - - - result = network->structinfo.ptr.p_int[6]==1; - return result; -} - - -/************************************************************************* -This function returns total number of layers (including input, hidden and -output layers). - - -- ALGLIB -- - Copyright 25.03.2011 by Bochkanov Sergey -*************************************************************************/ -ae_int_t mlpgetlayerscount(multilayerperceptron* network, - ae_state *_state) -{ - ae_int_t result; - - - result = network->hllayersizes.cnt; - return result; -} - - -/************************************************************************* -This function returns size of K-th layer. - -K=0 corresponds to input layer, K=CNT-1 corresponds to output layer. - -Size of the output layer is always equal to the number of outputs, although -when we have softmax-normalized network, last neuron doesn't have any -connections - it is just zero. - - -- ALGLIB -- - Copyright 25.03.2011 by Bochkanov Sergey -*************************************************************************/ -ae_int_t mlpgetlayersize(multilayerperceptron* network, - ae_int_t k, - ae_state *_state) -{ - ae_int_t result; - - - ae_assert(k>=0&&khllayersizes.cnt, "MLPGetLayerSize: incorrect layer index", _state); - result = network->hllayersizes.ptr.p_int[k]; - return result; -} - - -/************************************************************************* -This function returns offset/scaling coefficients for I-th input of the -network. - -INPUT PARAMETERS: - Network - network - I - input index - -OUTPUT PARAMETERS: - Mean - mean term - Sigma - sigma term, guaranteed to be nonzero. - -I-th input is passed through linear transformation - IN[i] = (IN[i]-Mean)/Sigma -before feeding to the network - - -- ALGLIB -- - Copyright 25.03.2011 by Bochkanov Sergey -*************************************************************************/ -void mlpgetinputscaling(multilayerperceptron* network, - ae_int_t i, - double* mean, - double* sigma, - ae_state *_state) -{ - - *mean = 0; - *sigma = 0; - - ae_assert(i>=0&&ihllayersizes.ptr.p_int[0], "MLPGetInputScaling: incorrect (nonexistent) I", _state); - *mean = network->columnmeans.ptr.p_double[i]; - *sigma = network->columnsigmas.ptr.p_double[i]; - if( ae_fp_eq(*sigma,0) ) - { - *sigma = 1; - } -} - - -/************************************************************************* -This function returns offset/scaling coefficients for I-th output of the -network. - -INPUT PARAMETERS: - Network - network - I - input index - -OUTPUT PARAMETERS: - Mean - mean term - Sigma - sigma term, guaranteed to be nonzero. - -I-th output is passed through linear transformation - OUT[i] = OUT[i]*Sigma+Mean -before returning it to user. In case we have SOFTMAX-normalized network, -we return (Mean,Sigma)=(0.0,1.0). - - -- ALGLIB -- - Copyright 25.03.2011 by Bochkanov Sergey -*************************************************************************/ -void mlpgetoutputscaling(multilayerperceptron* network, - ae_int_t i, - double* mean, - double* sigma, - ae_state *_state) -{ - - *mean = 0; - *sigma = 0; - - ae_assert(i>=0&&ihllayersizes.ptr.p_int[network->hllayersizes.cnt-1], "MLPGetOutputScaling: incorrect (nonexistent) I", _state); - if( network->structinfo.ptr.p_int[6]==1 ) - { - *mean = 0; - *sigma = 1; - } - else - { - *mean = network->columnmeans.ptr.p_double[network->hllayersizes.ptr.p_int[0]+i]; - *sigma = network->columnsigmas.ptr.p_double[network->hllayersizes.ptr.p_int[0]+i]; - } -} - - -/************************************************************************* -This function returns information about Ith neuron of Kth layer - -INPUT PARAMETERS: - Network - network - K - layer index - I - neuron index (within layer) - -OUTPUT PARAMETERS: - FKind - activation function type (used by MLPActivationFunction()) - this value is zero for input or linear neurons - Threshold - also called offset, bias - zero for input neurons - -NOTE: this function throws exception if layer or neuron with given index -do not exists. - - -- ALGLIB -- - Copyright 25.03.2011 by Bochkanov Sergey -*************************************************************************/ -void mlpgetneuroninfo(multilayerperceptron* network, - ae_int_t k, - ae_int_t i, - ae_int_t* fkind, - double* threshold, - ae_state *_state) -{ - ae_int_t ncnt; - ae_int_t istart; - ae_int_t highlevelidx; - ae_int_t activationoffset; - - *fkind = 0; - *threshold = 0; - - ncnt = network->hlneurons.cnt/mlpbase_hlnfieldwidth; - istart = network->structinfo.ptr.p_int[5]; - - /* - * search - */ - network->integerbuf.ptr.p_int[0] = k; - network->integerbuf.ptr.p_int[1] = i; - highlevelidx = recsearch(&network->hlneurons, mlpbase_hlnfieldwidth, 2, 0, ncnt, &network->integerbuf, _state); - ae_assert(highlevelidx>=0, "MLPGetNeuronInfo: incorrect (nonexistent) layer or neuron index", _state); - - /* - * 1. find offset of the activation function record in the - */ - if( network->hlneurons.ptr.p_int[highlevelidx*mlpbase_hlnfieldwidth+2]>=0 ) - { - activationoffset = istart+network->hlneurons.ptr.p_int[highlevelidx*mlpbase_hlnfieldwidth+2]*mlpbase_nfieldwidth; - *fkind = network->structinfo.ptr.p_int[activationoffset+0]; - } - else - { - *fkind = 0; - } - if( network->hlneurons.ptr.p_int[highlevelidx*mlpbase_hlnfieldwidth+3]>=0 ) - { - *threshold = network->weights.ptr.p_double[network->hlneurons.ptr.p_int[highlevelidx*mlpbase_hlnfieldwidth+3]]; - } - else - { - *threshold = 0; - } -} - - -/************************************************************************* -This function returns information about connection from I0-th neuron of -K0-th layer to I1-th neuron of K1-th layer. - -INPUT PARAMETERS: - Network - network - K0 - layer index - I0 - neuron index (within layer) - K1 - layer index - I1 - neuron index (within layer) - -RESULT: - connection weight (zero for non-existent connections) - -This function: -1. throws exception if layer or neuron with given index do not exists. -2. returns zero if neurons exist, but there is no connection between them - - -- ALGLIB -- - Copyright 25.03.2011 by Bochkanov Sergey -*************************************************************************/ -double mlpgetweight(multilayerperceptron* network, - ae_int_t k0, - ae_int_t i0, - ae_int_t k1, - ae_int_t i1, - ae_state *_state) -{ - ae_int_t ccnt; - ae_int_t highlevelidx; - double result; - - - ccnt = network->hlconnections.cnt/mlpbase_hlconnfieldwidth; - - /* - * check params - */ - ae_assert(k0>=0&&k0hllayersizes.cnt, "MLPGetWeight: incorrect (nonexistent) K0", _state); - ae_assert(i0>=0&&i0hllayersizes.ptr.p_int[k0], "MLPGetWeight: incorrect (nonexistent) I0", _state); - ae_assert(k1>=0&&k1hllayersizes.cnt, "MLPGetWeight: incorrect (nonexistent) K1", _state); - ae_assert(i1>=0&&i1hllayersizes.ptr.p_int[k1], "MLPGetWeight: incorrect (nonexistent) I1", _state); - - /* - * search - */ - network->integerbuf.ptr.p_int[0] = k0; - network->integerbuf.ptr.p_int[1] = i0; - network->integerbuf.ptr.p_int[2] = k1; - network->integerbuf.ptr.p_int[3] = i1; - highlevelidx = recsearch(&network->hlconnections, mlpbase_hlconnfieldwidth, 4, 0, ccnt, &network->integerbuf, _state); - if( highlevelidx>=0 ) - { - result = network->weights.ptr.p_double[network->hlconnections.ptr.p_int[highlevelidx*mlpbase_hlconnfieldwidth+4]]; - } - else - { - result = 0; - } - return result; -} - - -/************************************************************************* -This function sets offset/scaling coefficients for I-th input of the -network. - -INPUT PARAMETERS: - Network - network - I - input index - Mean - mean term - Sigma - sigma term (if zero, will be replaced by 1.0) - -NTE: I-th input is passed through linear transformation - IN[i] = (IN[i]-Mean)/Sigma -before feeding to the network. This function sets Mean and Sigma. - - -- ALGLIB -- - Copyright 25.03.2011 by Bochkanov Sergey -*************************************************************************/ -void mlpsetinputscaling(multilayerperceptron* network, - ae_int_t i, - double mean, - double sigma, - ae_state *_state) -{ - - - ae_assert(i>=0&&ihllayersizes.ptr.p_int[0], "MLPSetInputScaling: incorrect (nonexistent) I", _state); - ae_assert(ae_isfinite(mean, _state), "MLPSetInputScaling: infinite or NAN Mean", _state); - ae_assert(ae_isfinite(sigma, _state), "MLPSetInputScaling: infinite or NAN Sigma", _state); - if( ae_fp_eq(sigma,0) ) - { - sigma = 1; - } - network->columnmeans.ptr.p_double[i] = mean; - network->columnsigmas.ptr.p_double[i] = sigma; -} - - -/************************************************************************* -This function sets offset/scaling coefficients for I-th output of the -network. - -INPUT PARAMETERS: - Network - network - I - input index - Mean - mean term - Sigma - sigma term (if zero, will be replaced by 1.0) - -OUTPUT PARAMETERS: - -NOTE: I-th output is passed through linear transformation - OUT[i] = OUT[i]*Sigma+Mean -before returning it to user. This function sets Sigma/Mean. In case we -have SOFTMAX-normalized network, you can not set (Sigma,Mean) to anything -other than(0.0,1.0) - this function will throw exception. - - -- ALGLIB -- - Copyright 25.03.2011 by Bochkanov Sergey -*************************************************************************/ -void mlpsetoutputscaling(multilayerperceptron* network, - ae_int_t i, - double mean, - double sigma, - ae_state *_state) -{ - - - ae_assert(i>=0&&ihllayersizes.ptr.p_int[network->hllayersizes.cnt-1], "MLPSetOutputScaling: incorrect (nonexistent) I", _state); - ae_assert(ae_isfinite(mean, _state), "MLPSetOutputScaling: infinite or NAN Mean", _state); - ae_assert(ae_isfinite(sigma, _state), "MLPSetOutputScaling: infinite or NAN Sigma", _state); - if( network->structinfo.ptr.p_int[6]==1 ) - { - ae_assert(ae_fp_eq(mean,0), "MLPSetOutputScaling: you can not set non-zero Mean term for classifier network", _state); - ae_assert(ae_fp_eq(sigma,1), "MLPSetOutputScaling: you can not set non-unit Sigma term for classifier network", _state); - } - else - { - if( ae_fp_eq(sigma,0) ) - { - sigma = 1; - } - network->columnmeans.ptr.p_double[network->hllayersizes.ptr.p_int[0]+i] = mean; - network->columnsigmas.ptr.p_double[network->hllayersizes.ptr.p_int[0]+i] = sigma; - } -} - - -/************************************************************************* -This function modifies information about Ith neuron of Kth layer - -INPUT PARAMETERS: - Network - network - K - layer index - I - neuron index (within layer) - FKind - activation function type (used by MLPActivationFunction()) - this value must be zero for input neurons - (you can not set activation function for input neurons) - Threshold - also called offset, bias - this value must be zero for input neurons - (you can not set threshold for input neurons) - -NOTES: -1. this function throws exception if layer or neuron with given index do - not exists. -2. this function also throws exception when you try to set non-linear - activation function for input neurons (any kind of network) or for output - neurons of classifier network. -3. this function throws exception when you try to set non-zero threshold for - input neurons (any kind of network). - - -- ALGLIB -- - Copyright 25.03.2011 by Bochkanov Sergey -*************************************************************************/ -void mlpsetneuroninfo(multilayerperceptron* network, - ae_int_t k, - ae_int_t i, - ae_int_t fkind, - double threshold, - ae_state *_state) -{ - ae_int_t ncnt; - ae_int_t istart; - ae_int_t highlevelidx; - ae_int_t activationoffset; - - - ae_assert(ae_isfinite(threshold, _state), "MLPSetNeuronInfo: infinite or NAN Threshold", _state); - - /* - * convenience vars - */ - ncnt = network->hlneurons.cnt/mlpbase_hlnfieldwidth; - istart = network->structinfo.ptr.p_int[5]; - - /* - * search - */ - network->integerbuf.ptr.p_int[0] = k; - network->integerbuf.ptr.p_int[1] = i; - highlevelidx = recsearch(&network->hlneurons, mlpbase_hlnfieldwidth, 2, 0, ncnt, &network->integerbuf, _state); - ae_assert(highlevelidx>=0, "MLPSetNeuronInfo: incorrect (nonexistent) layer or neuron index", _state); - - /* - * activation function - */ - if( network->hlneurons.ptr.p_int[highlevelidx*mlpbase_hlnfieldwidth+2]>=0 ) - { - activationoffset = istart+network->hlneurons.ptr.p_int[highlevelidx*mlpbase_hlnfieldwidth+2]*mlpbase_nfieldwidth; - network->structinfo.ptr.p_int[activationoffset+0] = fkind; - } - else - { - ae_assert(fkind==0, "MLPSetNeuronInfo: you try to set activation function for neuron which can not have one", _state); - } - - /* - * Threshold - */ - if( network->hlneurons.ptr.p_int[highlevelidx*mlpbase_hlnfieldwidth+3]>=0 ) - { - network->weights.ptr.p_double[network->hlneurons.ptr.p_int[highlevelidx*mlpbase_hlnfieldwidth+3]] = threshold; - } - else - { - ae_assert(ae_fp_eq(threshold,0), "MLPSetNeuronInfo: you try to set non-zero threshold for neuron which can not have one", _state); - } -} - - -/************************************************************************* -This function modifies information about connection from I0-th neuron of -K0-th layer to I1-th neuron of K1-th layer. - -INPUT PARAMETERS: - Network - network - K0 - layer index - I0 - neuron index (within layer) - K1 - layer index - I1 - neuron index (within layer) - W - connection weight (must be zero for non-existent - connections) - -This function: -1. throws exception if layer or neuron with given index do not exists. -2. throws exception if you try to set non-zero weight for non-existent - connection - - -- ALGLIB -- - Copyright 25.03.2011 by Bochkanov Sergey -*************************************************************************/ -void mlpsetweight(multilayerperceptron* network, - ae_int_t k0, - ae_int_t i0, - ae_int_t k1, - ae_int_t i1, - double w, - ae_state *_state) -{ - ae_int_t ccnt; - ae_int_t highlevelidx; - - - ccnt = network->hlconnections.cnt/mlpbase_hlconnfieldwidth; - - /* - * check params - */ - ae_assert(k0>=0&&k0hllayersizes.cnt, "MLPSetWeight: incorrect (nonexistent) K0", _state); - ae_assert(i0>=0&&i0hllayersizes.ptr.p_int[k0], "MLPSetWeight: incorrect (nonexistent) I0", _state); - ae_assert(k1>=0&&k1hllayersizes.cnt, "MLPSetWeight: incorrect (nonexistent) K1", _state); - ae_assert(i1>=0&&i1hllayersizes.ptr.p_int[k1], "MLPSetWeight: incorrect (nonexistent) I1", _state); - ae_assert(ae_isfinite(w, _state), "MLPSetWeight: infinite or NAN weight", _state); - - /* - * search - */ - network->integerbuf.ptr.p_int[0] = k0; - network->integerbuf.ptr.p_int[1] = i0; - network->integerbuf.ptr.p_int[2] = k1; - network->integerbuf.ptr.p_int[3] = i1; - highlevelidx = recsearch(&network->hlconnections, mlpbase_hlconnfieldwidth, 4, 0, ccnt, &network->integerbuf, _state); - if( highlevelidx>=0 ) - { - network->weights.ptr.p_double[network->hlconnections.ptr.p_int[highlevelidx*mlpbase_hlconnfieldwidth+4]] = w; - } - else - { - ae_assert(ae_fp_eq(w,0), "MLPSetWeight: you try to set non-zero weight for non-existent connection", _state); - } -} - - -/************************************************************************* -Neural network activation function - -INPUT PARAMETERS: - NET - neuron input - K - function index (zero for linear function) - -OUTPUT PARAMETERS: - F - function - DF - its derivative - D2F - its second derivative - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpactivationfunction(double net, - ae_int_t k, - double* f, - double* df, - double* d2f, - ae_state *_state) -{ - double net2; - double arg; - double root; - double r; - - *f = 0; - *df = 0; - *d2f = 0; - - if( k==0||k==-5 ) - { - *f = net; - *df = 1; - *d2f = 0; - return; - } - if( k==1 ) - { - - /* - * TanH activation function - */ - if( ae_fp_less(ae_fabs(net, _state),100) ) - { - *f = ae_tanh(net, _state); - } - else - { - *f = ae_sign(net, _state); - } - *df = 1-*f*(*f); - *d2f = -2*(*f)*(*df); - return; - } - if( k==3 ) - { - - /* - * EX activation function - */ - if( ae_fp_greater_eq(net,0) ) - { - net2 = net*net; - arg = net2+1; - root = ae_sqrt(arg, _state); - *f = net+root; - r = net/root; - *df = 1+r; - *d2f = (root-net*r)/arg; - } - else - { - *f = ae_exp(net, _state); - *df = *f; - *d2f = *f; - } - return; - } - if( k==2 ) - { - *f = ae_exp(-ae_sqr(net, _state), _state); - *df = -2*net*(*f); - *d2f = -2*(*f+*df*net); - return; - } - *f = 0; - *df = 0; - *d2f = 0; -} - - -/************************************************************************* -Procesing - -INPUT PARAMETERS: - Network - neural network - X - input vector, array[0..NIn-1]. - -OUTPUT PARAMETERS: - Y - result. Regression estimate when solving regression task, - vector of posterior probabilities for classification task. - -See also MLPProcessI - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpprocess(multilayerperceptron* network, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state) -{ - - - if( y->cntstructinfo.ptr.p_int[2] ) - { - ae_vector_set_length(y, network->structinfo.ptr.p_int[2], _state); - } - mlpinternalprocessvector(&network->structinfo, &network->weights, &network->columnmeans, &network->columnsigmas, &network->neurons, &network->dfdnet, x, y, _state); -} - - -/************************************************************************* -'interactive' variant of MLPProcess for languages like Python which -support constructs like "Y = MLPProcess(NN,X)" and interactive mode of the -interpreter - -This function allocates new array on each call, so it is significantly -slower than its 'non-interactive' counterpart, but it is more convenient -when you call it from command line. - - -- ALGLIB -- - Copyright 21.09.2010 by Bochkanov Sergey -*************************************************************************/ -void mlpprocessi(multilayerperceptron* network, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state) -{ - - ae_vector_clear(y); - - mlpprocess(network, x, y, _state); -} - - -/************************************************************************* -Error of the neural network on dataset. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x, depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format; - NPoints - points count. - -RESULT: - sum-of-squares error, SUM(sqr(y[i]-desired_y[i])/2) - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -double mlperror(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - double result; - - - ae_assert(xy->rows>=npoints, "MLPError: XY has less than NPoints rows", _state); - if( npoints>0 ) - { - if( mlpissoftmax(network, _state) ) - { - ae_assert(xy->cols>=mlpgetinputscount(network, _state)+1, "MLPError: XY has less than NIn+1 columns", _state); - } - else - { - ae_assert(xy->cols>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPError: XY has less than NIn+NOut columns", _state); - } - } - mlpallerrorsx(network, xy, &network->dummysxy, npoints, 0, &network->dummyidx, 0, npoints, 0, &network->buf, &network->err, _state); - result = ae_sqr(network->err.rmserror, _state)*npoints*mlpgetoutputscount(network, _state)/2; - return result; -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -double _pexec_mlperror(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, ae_state *_state) -{ - return mlperror(network,xy,npoints, _state); -} - - -/************************************************************************* -Error of the neural network on dataset given by sparse matrix. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x, depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network - XY - training set, see below for information on the - training set format. This function checks correctness - of the dataset (no NANs/INFs, class numbers are - correct) and throws exception when incorrect dataset - is passed. Sparse matrix must use CRS format for - storage. - NPoints - points count, >=0 - -RESULT: - sum-of-squares error, SUM(sqr(y[i]-desired_y[i])/2) - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -double mlperrorsparse(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - double result; - - - ae_assert(sparseiscrs(xy, _state), "MLPErrorSparse: XY is not in CRS format.", _state); - ae_assert(sparsegetnrows(xy, _state)>=npoints, "MLPErrorSparse: XY has less than NPoints rows", _state); - if( npoints>0 ) - { - if( mlpissoftmax(network, _state) ) - { - ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+1, "MLPErrorSparse: XY has less than NIn+1 columns", _state); - } - else - { - ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPErrorSparse: XY has less than NIn+NOut columns", _state); - } - } - mlpallerrorsx(network, &network->dummydxy, xy, npoints, 1, &network->dummyidx, 0, npoints, 0, &network->buf, &network->err, _state); - result = ae_sqr(network->err.rmserror, _state)*npoints*mlpgetoutputscount(network, _state)/2; - return result; -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -double _pexec_mlperrorsparse(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t npoints, ae_state *_state) -{ - return mlperrorsparse(network,xy,npoints, _state); -} - - -/************************************************************************* -Natural error function for neural network, internal subroutine. - -NOTE: this function is single-threaded. Unlike other error function, it -receives no speed-up from being executed in SMP mode. - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -double mlperrorn(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t ssize, - ae_state *_state) -{ - ae_int_t i; - ae_int_t k; - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - double e; - double result; - - - mlpproperties(network, &nin, &nout, &wcount, _state); - result = 0; - for(i=0; i<=ssize-1; i++) - { - - /* - * Process vector - */ - ae_v_move(&network->x.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nin-1)); - mlpprocess(network, &network->x, &network->y, _state); - - /* - * Update error function - */ - if( network->structinfo.ptr.p_int[6]==0 ) - { - - /* - * Least squares error function - */ - ae_v_sub(&network->y.ptr.p_double[0], 1, &xy->ptr.pp_double[i][nin], 1, ae_v_len(0,nout-1)); - e = ae_v_dotproduct(&network->y.ptr.p_double[0], 1, &network->y.ptr.p_double[0], 1, ae_v_len(0,nout-1)); - result = result+e/2; - } - else - { - - /* - * Cross-entropy error function - */ - k = ae_round(xy->ptr.pp_double[i][nin], _state); - if( k>=0&&ky.ptr.p_double[k], _state); - } - } - } - return result; -} - - -/************************************************************************* -Classification error of the neural network on dataset. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format; - NPoints - points count. - -RESULT: - classification error (number of misclassified cases) - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -ae_int_t mlpclserror(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - ae_int_t result; - - - ae_assert(xy->rows>=npoints, "MLPClsError: XY has less than NPoints rows", _state); - if( npoints>0 ) - { - if( mlpissoftmax(network, _state) ) - { - ae_assert(xy->cols>=mlpgetinputscount(network, _state)+1, "MLPClsError: XY has less than NIn+1 columns", _state); - } - else - { - ae_assert(xy->cols>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPClsError: XY has less than NIn+NOut columns", _state); - } - } - mlpallerrorsx(network, xy, &network->dummysxy, npoints, 0, &network->dummyidx, 0, npoints, 0, &network->buf, &network->err, _state); - result = ae_round(npoints*network->err.relclserror, _state); - return result; -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -ae_int_t _pexec_mlpclserror(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, ae_state *_state) -{ - return mlpclserror(network,xy,npoints, _state); -} - - -/************************************************************************* -Relative classification error on the test set. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format; - NPoints - points count. - -RESULT: -Percent of incorrectly classified cases. Works both for classifier -networks and general purpose networks used as classifiers. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 25.12.2008 by Bochkanov Sergey -*************************************************************************/ -double mlprelclserror(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - double result; - - - ae_assert(xy->rows>=npoints, "MLPRelClsError: XY has less than NPoints rows", _state); - if( npoints>0 ) - { - if( mlpissoftmax(network, _state) ) - { - ae_assert(xy->cols>=mlpgetinputscount(network, _state)+1, "MLPRelClsError: XY has less than NIn+1 columns", _state); - } - else - { - ae_assert(xy->cols>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPRelClsError: XY has less than NIn+NOut columns", _state); - } - } - if( npoints>0 ) - { - result = (double)mlpclserror(network, xy, npoints, _state)/(double)npoints; - } - else - { - result = 0.0; - } - return result; -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -double _pexec_mlprelclserror(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, ae_state *_state) -{ - return mlprelclserror(network,xy,npoints, _state); -} - - -/************************************************************************* -Relative classification error on the test set given by sparse matrix. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format. Sparse matrix must use CRS format - for storage. - NPoints - points count, >=0. - -RESULT: -Percent of incorrectly classified cases. Works both for classifier -networks and general purpose networks used as classifiers. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 09.08.2012 by Bochkanov Sergey -*************************************************************************/ -double mlprelclserrorsparse(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - double result; - - - ae_assert(sparseiscrs(xy, _state), "MLPRelClsErrorSparse: sparse matrix XY is not in CRS format.", _state); - ae_assert(sparsegetnrows(xy, _state)>=npoints, "MLPRelClsErrorSparse: sparse matrix XY has less than NPoints rows", _state); - if( npoints>0 ) - { - if( mlpissoftmax(network, _state) ) - { - ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+1, "MLPRelClsErrorSparse: sparse matrix XY has less than NIn+1 columns", _state); - } - else - { - ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPRelClsErrorSparse: sparse matrix XY has less than NIn+NOut columns", _state); - } - } - mlpallerrorsx(network, &network->dummydxy, xy, npoints, 1, &network->dummyidx, 0, npoints, 0, &network->buf, &network->err, _state); - result = network->err.relclserror; - return result; -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -double _pexec_mlprelclserrorsparse(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t npoints, ae_state *_state) -{ - return mlprelclserrorsparse(network,xy,npoints, _state); -} - - -/************************************************************************* -Average cross-entropy (in bits per element) on the test set. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format; - NPoints - points count. - -RESULT: -CrossEntropy/(NPoints*LN(2)). -Zero if network solves regression task. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 08.01.2009 by Bochkanov Sergey -*************************************************************************/ -double mlpavgce(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - double result; - - - ae_assert(xy->rows>=npoints, "MLPAvgCE: XY has less than NPoints rows", _state); - if( npoints>0 ) - { - if( mlpissoftmax(network, _state) ) - { - ae_assert(xy->cols>=mlpgetinputscount(network, _state)+1, "MLPAvgCE: XY has less than NIn+1 columns", _state); - } - else - { - ae_assert(xy->cols>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPAvgCE: XY has less than NIn+NOut columns", _state); - } - } - mlpallerrorsx(network, xy, &network->dummysxy, npoints, 0, &network->dummyidx, 0, npoints, 0, &network->buf, &network->err, _state); - result = network->err.avgce; - return result; -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -double _pexec_mlpavgce(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, ae_state *_state) -{ - return mlpavgce(network,xy,npoints, _state); -} - - -/************************************************************************* -Average cross-entropy (in bits per element) on the test set given by -sparse matrix. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format. This function checks correctness - of the dataset (no NANs/INFs, class numbers are - correct) and throws exception when incorrect dataset - is passed. Sparse matrix must use CRS format for - storage. - NPoints - points count, >=0. - -RESULT: -CrossEntropy/(NPoints*LN(2)). -Zero if network solves regression task. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 9.08.2012 by Bochkanov Sergey -*************************************************************************/ -double mlpavgcesparse(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - double result; - - - ae_assert(sparseiscrs(xy, _state), "MLPAvgCESparse: sparse matrix XY is not in CRS format.", _state); - ae_assert(sparsegetnrows(xy, _state)>=npoints, "MLPAvgCESparse: sparse matrix XY has less than NPoints rows", _state); - if( npoints>0 ) - { - if( mlpissoftmax(network, _state) ) - { - ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+1, "MLPAvgCESparse: sparse matrix XY has less than NIn+1 columns", _state); - } - else - { - ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPAvgCESparse: sparse matrix XY has less than NIn+NOut columns", _state); - } - } - mlpallerrorsx(network, &network->dummydxy, xy, npoints, 1, &network->dummyidx, 0, npoints, 0, &network->buf, &network->err, _state); - result = network->err.avgce; - return result; -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -double _pexec_mlpavgcesparse(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t npoints, ae_state *_state) -{ - return mlpavgcesparse(network,xy,npoints, _state); -} - - -/************************************************************************* -RMS error on the test set given. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format; - NPoints - points count. - -RESULT: -Root mean square error. Its meaning for regression task is obvious. As for -classification task, RMS error means error when estimating posterior -probabilities. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -double mlprmserror(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - double result; - - - ae_assert(xy->rows>=npoints, "MLPRMSError: XY has less than NPoints rows", _state); - if( npoints>0 ) - { - if( mlpissoftmax(network, _state) ) - { - ae_assert(xy->cols>=mlpgetinputscount(network, _state)+1, "MLPRMSError: XY has less than NIn+1 columns", _state); - } - else - { - ae_assert(xy->cols>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPRMSError: XY has less than NIn+NOut columns", _state); - } - } - mlpallerrorsx(network, xy, &network->dummysxy, npoints, 0, &network->dummyidx, 0, npoints, 0, &network->buf, &network->err, _state); - result = network->err.rmserror; - return result; -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -double _pexec_mlprmserror(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, ae_state *_state) -{ - return mlprmserror(network,xy,npoints, _state); -} - - -/************************************************************************* -RMS error on the test set given by sparse matrix. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format. This function checks correctness - of the dataset (no NANs/INFs, class numbers are - correct) and throws exception when incorrect dataset - is passed. Sparse matrix must use CRS format for - storage. - NPoints - points count, >=0. - -RESULT: -Root mean square error. Its meaning for regression task is obvious. As for -classification task, RMS error means error when estimating posterior -probabilities. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 09.08.2012 by Bochkanov Sergey -*************************************************************************/ -double mlprmserrorsparse(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - double result; - - - ae_assert(sparseiscrs(xy, _state), "MLPRMSErrorSparse: sparse matrix XY is not in CRS format.", _state); - ae_assert(sparsegetnrows(xy, _state)>=npoints, "MLPRMSErrorSparse: sparse matrix XY has less than NPoints rows", _state); - if( npoints>0 ) - { - if( mlpissoftmax(network, _state) ) - { - ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+1, "MLPRMSErrorSparse: sparse matrix XY has less than NIn+1 columns", _state); - } - else - { - ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPRMSErrorSparse: sparse matrix XY has less than NIn+NOut columns", _state); - } - } - mlpallerrorsx(network, &network->dummydxy, xy, npoints, 1, &network->dummyidx, 0, npoints, 0, &network->buf, &network->err, _state); - result = network->err.rmserror; - return result; -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -double _pexec_mlprmserrorsparse(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t npoints, ae_state *_state) -{ - return mlprmserrorsparse(network,xy,npoints, _state); -} - - -/************************************************************************* -Average absolute error on the test set. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format; - NPoints - points count. - -RESULT: -Its meaning for regression task is obvious. As for classification task, it -means average error when estimating posterior probabilities. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 11.03.2008 by Bochkanov Sergey -*************************************************************************/ -double mlpavgerror(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - double result; - - - ae_assert(xy->rows>=npoints, "MLPAvgError: XY has less than NPoints rows", _state); - if( npoints>0 ) - { - if( mlpissoftmax(network, _state) ) - { - ae_assert(xy->cols>=mlpgetinputscount(network, _state)+1, "MLPAvgError: XY has less than NIn+1 columns", _state); - } - else - { - ae_assert(xy->cols>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPAvgError: XY has less than NIn+NOut columns", _state); - } - } - mlpallerrorsx(network, xy, &network->dummysxy, npoints, 0, &network->dummyidx, 0, npoints, 0, &network->buf, &network->err, _state); - result = network->err.avgerror; - return result; -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -double _pexec_mlpavgerror(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, ae_state *_state) -{ - return mlpavgerror(network,xy,npoints, _state); -} - - -/************************************************************************* -Average absolute error on the test set given by sparse matrix. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format. This function checks correctness - of the dataset (no NANs/INFs, class numbers are - correct) and throws exception when incorrect dataset - is passed. Sparse matrix must use CRS format for - storage. - NPoints - points count, >=0. - -RESULT: -Its meaning for regression task is obvious. As for classification task, it -means average error when estimating posterior probabilities. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 09.08.2012 by Bochkanov Sergey -*************************************************************************/ -double mlpavgerrorsparse(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - double result; - - - ae_assert(sparseiscrs(xy, _state), "MLPAvgErrorSparse: XY is not in CRS format.", _state); - ae_assert(sparsegetnrows(xy, _state)>=npoints, "MLPAvgErrorSparse: XY has less than NPoints rows", _state); - if( npoints>0 ) - { - if( mlpissoftmax(network, _state) ) - { - ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+1, "MLPAvgErrorSparse: XY has less than NIn+1 columns", _state); - } - else - { - ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPAvgErrorSparse: XY has less than NIn+NOut columns", _state); - } - } - mlpallerrorsx(network, &network->dummydxy, xy, npoints, 1, &network->dummyidx, 0, npoints, 0, &network->buf, &network->err, _state); - result = network->err.avgerror; - return result; -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -double _pexec_mlpavgerrorsparse(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t npoints, ae_state *_state) -{ - return mlpavgerrorsparse(network,xy,npoints, _state); -} - - -/************************************************************************* -Average relative error on the test set. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format; - NPoints - points count. - -RESULT: -Its meaning for regression task is obvious. As for classification task, it -means average relative error when estimating posterior probability of -belonging to the correct class. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 11.03.2008 by Bochkanov Sergey -*************************************************************************/ -double mlpavgrelerror(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - double result; - - - ae_assert(xy->rows>=npoints, "MLPAvgRelError: XY has less than NPoints rows", _state); - if( npoints>0 ) - { - if( mlpissoftmax(network, _state) ) - { - ae_assert(xy->cols>=mlpgetinputscount(network, _state)+1, "MLPAvgRelError: XY has less than NIn+1 columns", _state); - } - else - { - ae_assert(xy->cols>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPAvgRelError: XY has less than NIn+NOut columns", _state); - } - } - mlpallerrorsx(network, xy, &network->dummysxy, npoints, 0, &network->dummyidx, 0, npoints, 0, &network->buf, &network->err, _state); - result = network->err.avgrelerror; - return result; -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -double _pexec_mlpavgrelerror(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, ae_state *_state) -{ - return mlpavgrelerror(network,xy,npoints, _state); -} - - -/************************************************************************* -Average relative error on the test set given by sparse matrix. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format. This function checks correctness - of the dataset (no NANs/INFs, class numbers are - correct) and throws exception when incorrect dataset - is passed. Sparse matrix must use CRS format for - storage. - NPoints - points count, >=0. - -RESULT: -Its meaning for regression task is obvious. As for classification task, it -means average relative error when estimating posterior probability of -belonging to the correct class. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 09.08.2012 by Bochkanov Sergey -*************************************************************************/ -double mlpavgrelerrorsparse(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - double result; - - - ae_assert(sparseiscrs(xy, _state), "MLPAvgRelErrorSparse: XY is not in CRS format.", _state); - ae_assert(sparsegetnrows(xy, _state)>=npoints, "MLPAvgRelErrorSparse: XY has less than NPoints rows", _state); - if( npoints>0 ) - { - if( mlpissoftmax(network, _state) ) - { - ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+1, "MLPAvgRelErrorSparse: XY has less than NIn+1 columns", _state); - } - else - { - ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPAvgRelErrorSparse: XY has less than NIn+NOut columns", _state); - } - } - mlpallerrorsx(network, &network->dummydxy, xy, npoints, 1, &network->dummyidx, 0, npoints, 0, &network->buf, &network->err, _state); - result = network->err.avgrelerror; - return result; -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -double _pexec_mlpavgrelerrorsparse(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t npoints, ae_state *_state) -{ - return mlpavgrelerrorsparse(network,xy,npoints, _state); -} - - -/************************************************************************* -Gradient calculation - -INPUT PARAMETERS: - Network - network initialized with one of the network creation funcs - X - input vector, length of array must be at least NIn - DesiredY- desired outputs, length of array must be at least NOut - Grad - possibly preallocated array. If size of array is smaller - than WCount, it will be reallocated. It is recommended to - reuse previously allocated array to reduce allocation - overhead. - -OUTPUT PARAMETERS: - E - error function, SUM(sqr(y[i]-desiredy[i])/2,i) - Grad - gradient of E with respect to weights of network, array[WCount] - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpgrad(multilayerperceptron* network, - /* Real */ ae_vector* x, - /* Real */ ae_vector* desiredy, - double* e, - /* Real */ ae_vector* grad, - ae_state *_state) -{ - ae_int_t i; - ae_int_t nout; - ae_int_t ntotal; - - *e = 0; - - - /* - * Alloc - */ - rvectorsetlengthatleast(grad, network->structinfo.ptr.p_int[4], _state); - - /* - * Prepare dError/dOut, internal structures - */ - mlpprocess(network, x, &network->y, _state); - nout = network->structinfo.ptr.p_int[2]; - ntotal = network->structinfo.ptr.p_int[3]; - *e = 0; - for(i=0; i<=ntotal-1; i++) - { - network->derror.ptr.p_double[i] = 0; - } - for(i=0; i<=nout-1; i++) - { - network->derror.ptr.p_double[ntotal-nout+i] = network->y.ptr.p_double[i]-desiredy->ptr.p_double[i]; - *e = *e+ae_sqr(network->y.ptr.p_double[i]-desiredy->ptr.p_double[i], _state)/2; - } - - /* - * gradient - */ - mlpbase_mlpinternalcalculategradient(network, &network->neurons, &network->weights, &network->derror, grad, ae_false, _state); -} - - -/************************************************************************* -Gradient calculation (natural error function is used) - -INPUT PARAMETERS: - Network - network initialized with one of the network creation funcs - X - input vector, length of array must be at least NIn - DesiredY- desired outputs, length of array must be at least NOut - Grad - possibly preallocated array. If size of array is smaller - than WCount, it will be reallocated. It is recommended to - reuse previously allocated array to reduce allocation - overhead. - -OUTPUT PARAMETERS: - E - error function, sum-of-squares for regression networks, - cross-entropy for classification networks. - Grad - gradient of E with respect to weights of network, array[WCount] - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpgradn(multilayerperceptron* network, - /* Real */ ae_vector* x, - /* Real */ ae_vector* desiredy, - double* e, - /* Real */ ae_vector* grad, - ae_state *_state) -{ - double s; - ae_int_t i; - ae_int_t nout; - ae_int_t ntotal; - - *e = 0; - - - /* - * Alloc - */ - rvectorsetlengthatleast(grad, network->structinfo.ptr.p_int[4], _state); - - /* - * Prepare dError/dOut, internal structures - */ - mlpprocess(network, x, &network->y, _state); - nout = network->structinfo.ptr.p_int[2]; - ntotal = network->structinfo.ptr.p_int[3]; - for(i=0; i<=ntotal-1; i++) - { - network->derror.ptr.p_double[i] = 0; - } - *e = 0; - if( network->structinfo.ptr.p_int[6]==0 ) - { - - /* - * Regression network, least squares - */ - for(i=0; i<=nout-1; i++) - { - network->derror.ptr.p_double[ntotal-nout+i] = network->y.ptr.p_double[i]-desiredy->ptr.p_double[i]; - *e = *e+ae_sqr(network->y.ptr.p_double[i]-desiredy->ptr.p_double[i], _state)/2; - } - } - else - { - - /* - * Classification network, cross-entropy - */ - s = 0; - for(i=0; i<=nout-1; i++) - { - s = s+desiredy->ptr.p_double[i]; - } - for(i=0; i<=nout-1; i++) - { - network->derror.ptr.p_double[ntotal-nout+i] = s*network->y.ptr.p_double[i]-desiredy->ptr.p_double[i]; - *e = *e+mlpbase_safecrossentropy(desiredy->ptr.p_double[i], network->y.ptr.p_double[i], _state); - } - } - - /* - * gradient - */ - mlpbase_mlpinternalcalculategradient(network, &network->neurons, &network->weights, &network->derror, grad, ae_true, _state); -} - - -/************************************************************************* -Batch gradient calculation for a set of inputs/outputs - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - network initialized with one of the network creation funcs - XY - original dataset in dense format; one sample = one row: - * first NIn columns contain inputs, - * for regression problem, next NOut columns store - desired outputs. - * for classification problem, next column (just one!) - stores class number. - SSize - number of elements in XY - Grad - possibly preallocated array. If size of array is smaller - than WCount, it will be reallocated. It is recommended to - reuse previously allocated array to reduce allocation - overhead. - -OUTPUT PARAMETERS: - E - error function, SUM(sqr(y[i]-desiredy[i])/2,i) - Grad - gradient of E with respect to weights of network, array[WCount] - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpgradbatch(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t ssize, - double* e, - /* Real */ ae_vector* grad, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - ae_int_t subset0; - ae_int_t subset1; - ae_int_t subsettype; - smlpgrad *sgrad; - ae_smart_ptr _sgrad; - - ae_frame_make(_state, &_frame_block); - *e = 0; - ae_smart_ptr_init(&_sgrad, (void**)&sgrad, _state, ae_true); - - ae_assert(ssize>=0, "MLPGradBatchSparse: SSize<0", _state); - subset0 = 0; - subset1 = ssize; - subsettype = 0; - mlpproperties(network, &nin, &nout, &wcount, _state); - rvectorsetlengthatleast(grad, wcount, _state); - ae_shared_pool_first_recycled(&network->gradbuf, &_sgrad, _state); - while(sgrad!=NULL) - { - sgrad->f = 0.0; - for(i=0; i<=wcount-1; i++) - { - sgrad->g.ptr.p_double[i] = 0.0; - } - ae_shared_pool_next_recycled(&network->gradbuf, &_sgrad, _state); - } - mlpgradbatchx(network, xy, &network->dummysxy, ssize, 0, &network->dummyidx, subset0, subset1, subsettype, &network->buf, &network->gradbuf, _state); - *e = 0.0; - for(i=0; i<=wcount-1; i++) - { - grad->ptr.p_double[i] = 0.0; - } - ae_shared_pool_first_recycled(&network->gradbuf, &_sgrad, _state); - while(sgrad!=NULL) - { - *e = *e+sgrad->f; - for(i=0; i<=wcount-1; i++) - { - grad->ptr.p_double[i] = grad->ptr.p_double[i]+sgrad->g.ptr.p_double[i]; - } - ae_shared_pool_next_recycled(&network->gradbuf, &_sgrad, _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -void _pexec_mlpgradbatch(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t ssize, - double* e, - /* Real */ ae_vector* grad, ae_state *_state) -{ - mlpgradbatch(network,xy,ssize,e,grad, _state); -} - - -/************************************************************************* -Batch gradient calculation for a set of inputs/outputs given by sparse -matrices - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - network initialized with one of the network creation funcs - XY - original dataset in sparse format; one sample = one row: - * MATRIX MUST BE STORED IN CRS FORMAT - * first NIn columns contain inputs. - * for regression problem, next NOut columns store - desired outputs. - * for classification problem, next column (just one!) - stores class number. - SSize - number of elements in XY - Grad - possibly preallocated array. If size of array is smaller - than WCount, it will be reallocated. It is recommended to - reuse previously allocated array to reduce allocation - overhead. - -OUTPUT PARAMETERS: - E - error function, SUM(sqr(y[i]-desiredy[i])/2,i) - Grad - gradient of E with respect to weights of network, array[WCount] - - -- ALGLIB -- - Copyright 26.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpgradbatchsparse(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t ssize, - double* e, - /* Real */ ae_vector* grad, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - ae_int_t subset0; - ae_int_t subset1; - ae_int_t subsettype; - smlpgrad *sgrad; - ae_smart_ptr _sgrad; - - ae_frame_make(_state, &_frame_block); - *e = 0; - ae_smart_ptr_init(&_sgrad, (void**)&sgrad, _state, ae_true); - - ae_assert(ssize>=0, "MLPGradBatchSparse: SSize<0", _state); - ae_assert(sparseiscrs(xy, _state), "MLPGradBatchSparse: sparse matrix XY must be in CRS format.", _state); - subset0 = 0; - subset1 = ssize; - subsettype = 0; - mlpproperties(network, &nin, &nout, &wcount, _state); - rvectorsetlengthatleast(grad, wcount, _state); - ae_shared_pool_first_recycled(&network->gradbuf, &_sgrad, _state); - while(sgrad!=NULL) - { - sgrad->f = 0.0; - for(i=0; i<=wcount-1; i++) - { - sgrad->g.ptr.p_double[i] = 0.0; - } - ae_shared_pool_next_recycled(&network->gradbuf, &_sgrad, _state); - } - mlpgradbatchx(network, &network->dummydxy, xy, ssize, 1, &network->dummyidx, subset0, subset1, subsettype, &network->buf, &network->gradbuf, _state); - *e = 0.0; - for(i=0; i<=wcount-1; i++) - { - grad->ptr.p_double[i] = 0.0; - } - ae_shared_pool_first_recycled(&network->gradbuf, &_sgrad, _state); - while(sgrad!=NULL) - { - *e = *e+sgrad->f; - for(i=0; i<=wcount-1; i++) - { - grad->ptr.p_double[i] = grad->ptr.p_double[i]+sgrad->g.ptr.p_double[i]; - } - ae_shared_pool_next_recycled(&network->gradbuf, &_sgrad, _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -void _pexec_mlpgradbatchsparse(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t ssize, - double* e, - /* Real */ ae_vector* grad, ae_state *_state) -{ - mlpgradbatchsparse(network,xy,ssize,e,grad, _state); -} - - -/************************************************************************* -Batch gradient calculation for a subset of dataset - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - network initialized with one of the network creation funcs - XY - original dataset in dense format; one sample = one row: - * first NIn columns contain inputs, - * for regression problem, next NOut columns store - desired outputs. - * for classification problem, next column (just one!) - stores class number. - SetSize - real size of XY, SetSize>=0; - Idx - subset of SubsetSize elements, array[SubsetSize]: - * Idx[I] stores row index in the original dataset which is - given by XY. Gradient is calculated with respect to rows - whose indexes are stored in Idx[]. - * Idx[] must store correct indexes; this function throws - an exception in case incorrect index (less than 0 or - larger than rows(XY)) is given - * Idx[] may store indexes in any order and even with - repetitions. - SubsetSize- number of elements in Idx[] array: - * positive value means that subset given by Idx[] is processed - * zero value results in zero gradient - * negative value means that full dataset is processed - Grad - possibly preallocated array. If size of array is smaller - than WCount, it will be reallocated. It is recommended to - reuse previously allocated array to reduce allocation - overhead. - -OUTPUT PARAMETERS: - E - error function, SUM(sqr(y[i]-desiredy[i])/2,i) - Grad - gradient of E with respect to weights of network, - array[WCount] - - -- ALGLIB -- - Copyright 26.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpgradbatchsubset(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t setsize, - /* Integer */ ae_vector* idx, - ae_int_t subsetsize, - double* e, - /* Real */ ae_vector* grad, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - ae_int_t npoints; - ae_int_t subset0; - ae_int_t subset1; - ae_int_t subsettype; - smlpgrad *sgrad; - ae_smart_ptr _sgrad; - - ae_frame_make(_state, &_frame_block); - *e = 0; - ae_smart_ptr_init(&_sgrad, (void**)&sgrad, _state, ae_true); - - ae_assert(setsize>=0, "MLPGradBatchSubset: SetSize<0", _state); - ae_assert(subsetsize<=idx->cnt, "MLPGradBatchSubset: SubsetSize>Length(Idx)", _state); - npoints = setsize; - if( subsetsize<0 ) - { - subset0 = 0; - subset1 = setsize; - subsettype = 0; - } - else - { - subset0 = 0; - subset1 = subsetsize; - subsettype = 1; - for(i=0; i<=subsetsize-1; i++) - { - ae_assert(idx->ptr.p_int[i]>=0, "MLPGradBatchSubset: incorrect index of XY row(Idx[I]<0)", _state); - ae_assert(idx->ptr.p_int[i]<=npoints-1, "MLPGradBatchSubset: incorrect index of XY row(Idx[I]>Rows(XY)-1)", _state); - } - } - mlpproperties(network, &nin, &nout, &wcount, _state); - rvectorsetlengthatleast(grad, wcount, _state); - ae_shared_pool_first_recycled(&network->gradbuf, &_sgrad, _state); - while(sgrad!=NULL) - { - sgrad->f = 0.0; - for(i=0; i<=wcount-1; i++) - { - sgrad->g.ptr.p_double[i] = 0.0; - } - ae_shared_pool_next_recycled(&network->gradbuf, &_sgrad, _state); - } - mlpgradbatchx(network, xy, &network->dummysxy, setsize, 0, idx, subset0, subset1, subsettype, &network->buf, &network->gradbuf, _state); - *e = 0.0; - for(i=0; i<=wcount-1; i++) - { - grad->ptr.p_double[i] = 0.0; - } - ae_shared_pool_first_recycled(&network->gradbuf, &_sgrad, _state); - while(sgrad!=NULL) - { - *e = *e+sgrad->f; - for(i=0; i<=wcount-1; i++) - { - grad->ptr.p_double[i] = grad->ptr.p_double[i]+sgrad->g.ptr.p_double[i]; - } - ae_shared_pool_next_recycled(&network->gradbuf, &_sgrad, _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -void _pexec_mlpgradbatchsubset(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t setsize, - /* Integer */ ae_vector* idx, - ae_int_t subsetsize, - double* e, - /* Real */ ae_vector* grad, ae_state *_state) -{ - mlpgradbatchsubset(network,xy,setsize,idx,subsetsize,e,grad, _state); -} - - -/************************************************************************* -Batch gradient calculation for a set of inputs/outputs for a subset of -dataset given by set of indexes. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - network initialized with one of the network creation funcs - XY - original dataset in sparse format; one sample = one row: - * MATRIX MUST BE STORED IN CRS FORMAT - * first NIn columns contain inputs, - * for regression problem, next NOut columns store - desired outputs. - * for classification problem, next column (just one!) - stores class number. - SetSize - real size of XY, SetSize>=0; - Idx - subset of SubsetSize elements, array[SubsetSize]: - * Idx[I] stores row index in the original dataset which is - given by XY. Gradient is calculated with respect to rows - whose indexes are stored in Idx[]. - * Idx[] must store correct indexes; this function throws - an exception in case incorrect index (less than 0 or - larger than rows(XY)) is given - * Idx[] may store indexes in any order and even with - repetitions. - SubsetSize- number of elements in Idx[] array: - * positive value means that subset given by Idx[] is processed - * zero value results in zero gradient - * negative value means that full dataset is processed - Grad - possibly preallocated array. If size of array is smaller - than WCount, it will be reallocated. It is recommended to - reuse previously allocated array to reduce allocation - overhead. - -OUTPUT PARAMETERS: - E - error function, SUM(sqr(y[i]-desiredy[i])/2,i) - Grad - gradient of E with respect to weights of network, - array[WCount] - -NOTE: when SubsetSize<0 is used full dataset by call MLPGradBatchSparse - function. - - -- ALGLIB -- - Copyright 26.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpgradbatchsparsesubset(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t setsize, - /* Integer */ ae_vector* idx, - ae_int_t subsetsize, - double* e, - /* Real */ ae_vector* grad, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - ae_int_t npoints; - ae_int_t subset0; - ae_int_t subset1; - ae_int_t subsettype; - smlpgrad *sgrad; - ae_smart_ptr _sgrad; - - ae_frame_make(_state, &_frame_block); - *e = 0; - ae_smart_ptr_init(&_sgrad, (void**)&sgrad, _state, ae_true); - - ae_assert(setsize>=0, "MLPGradBatchSparseSubset: SetSize<0", _state); - ae_assert(subsetsize<=idx->cnt, "MLPGradBatchSparseSubset: SubsetSize>Length(Idx)", _state); - ae_assert(sparseiscrs(xy, _state), "MLPGradBatchSparseSubset: sparse matrix XY must be in CRS format.", _state); - npoints = setsize; - if( subsetsize<0 ) - { - subset0 = 0; - subset1 = setsize; - subsettype = 0; - } - else - { - subset0 = 0; - subset1 = subsetsize; - subsettype = 1; - for(i=0; i<=subsetsize-1; i++) - { - ae_assert(idx->ptr.p_int[i]>=0, "MLPGradBatchSparseSubset: incorrect index of XY row(Idx[I]<0)", _state); - ae_assert(idx->ptr.p_int[i]<=npoints-1, "MLPGradBatchSparseSubset: incorrect index of XY row(Idx[I]>Rows(XY)-1)", _state); - } - } - mlpproperties(network, &nin, &nout, &wcount, _state); - rvectorsetlengthatleast(grad, wcount, _state); - ae_shared_pool_first_recycled(&network->gradbuf, &_sgrad, _state); - while(sgrad!=NULL) - { - sgrad->f = 0.0; - for(i=0; i<=wcount-1; i++) - { - sgrad->g.ptr.p_double[i] = 0.0; - } - ae_shared_pool_next_recycled(&network->gradbuf, &_sgrad, _state); - } - mlpgradbatchx(network, &network->dummydxy, xy, setsize, 1, idx, subset0, subset1, subsettype, &network->buf, &network->gradbuf, _state); - *e = 0.0; - for(i=0; i<=wcount-1; i++) - { - grad->ptr.p_double[i] = 0.0; - } - ae_shared_pool_first_recycled(&network->gradbuf, &_sgrad, _state); - while(sgrad!=NULL) - { - *e = *e+sgrad->f; - for(i=0; i<=wcount-1; i++) - { - grad->ptr.p_double[i] = grad->ptr.p_double[i]+sgrad->g.ptr.p_double[i]; - } - ae_shared_pool_next_recycled(&network->gradbuf, &_sgrad, _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -void _pexec_mlpgradbatchsparsesubset(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t setsize, - /* Integer */ ae_vector* idx, - ae_int_t subsetsize, - double* e, - /* Real */ ae_vector* grad, ae_state *_state) -{ - mlpgradbatchsparsesubset(network,xy,setsize,idx,subsetsize,e,grad, _state); -} - - -void mlpgradbatchx(multilayerperceptron* network, - /* Real */ ae_matrix* densexy, - sparsematrix* sparsexy, - ae_int_t datasetsize, - ae_int_t datasettype, - /* Integer */ ae_vector* idx, - ae_int_t subset0, - ae_int_t subset1, - ae_int_t subsettype, - ae_shared_pool* buf, - ae_shared_pool* gradbuf, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - ae_int_t rowsize; - ae_int_t srcidx; - ae_int_t cstart; - ae_int_t csize; - ae_int_t j; - double problemcost; - mlpbuffers *buf2; - ae_smart_ptr _buf2; - ae_int_t len0; - ae_int_t len1; - mlpbuffers *pbuf; - ae_smart_ptr _pbuf; - smlpgrad *sgrad; - ae_smart_ptr _sgrad; - - ae_frame_make(_state, &_frame_block); - ae_smart_ptr_init(&_buf2, (void**)&buf2, _state, ae_true); - ae_smart_ptr_init(&_pbuf, (void**)&pbuf, _state, ae_true); - ae_smart_ptr_init(&_sgrad, (void**)&sgrad, _state, ae_true); - - ae_assert(datasetsize>=0, "MLPGradBatchX: SetSize<0", _state); - ae_assert(datasettype==0||datasettype==1, "MLPGradBatchX: DatasetType is incorrect", _state); - ae_assert(subsettype==0||subsettype==1, "MLPGradBatchX: SubsetType is incorrect", _state); - - /* - * Determine network and dataset properties - */ - mlpproperties(network, &nin, &nout, &wcount, _state); - if( mlpissoftmax(network, _state) ) - { - rowsize = nin+1; - } - else - { - rowsize = nin+nout; - } - - /* - * Split problem. - * - * Splitting problem allows us to reduce effect of single-precision - * arithmetics (SSE-optimized version of MLPChunkedGradient uses single - * precision internally, but converts them to double precision after - * results are exported from HPC buffer to network). Small batches are - * calculated in single precision, results are aggregated in double - * precision, and it allows us to avoid accumulation of errors when - * we process very large batches (tens of thousands of items). - * - * NOTE: it is important to use real arithmetics for ProblemCost - * because ProblemCost may be larger than MAXINT. - */ - problemcost = subset1-subset0; - problemcost = problemcost*wcount; - if( subset1-subset0>=2*mlpbase_microbatchsize&&ae_fp_greater(problemcost,mlpbase_gradbasecasecost) ) - { - splitlength(subset1-subset0, mlpbase_microbatchsize, &len0, &len1, _state); - mlpgradbatchx(network, densexy, sparsexy, datasetsize, datasettype, idx, subset0, subset0+len0, subsettype, buf, gradbuf, _state); - mlpgradbatchx(network, densexy, sparsexy, datasetsize, datasettype, idx, subset0+len0, subset1, subsettype, buf, gradbuf, _state); - ae_frame_leave(_state); - return; - } - - /* - * Chunked processing - */ - ae_shared_pool_retrieve(gradbuf, &_sgrad, _state); - ae_shared_pool_retrieve(buf, &_pbuf, _state); - hpcpreparechunkedgradient(&network->weights, wcount, mlpntotal(network, _state), nin, nout, pbuf, _state); - cstart = subset0; - while(cstartchunksize, _state)-cstart; - for(j=0; j<=csize-1; j++) - { - srcidx = -1; - if( subsettype==0 ) - { - srcidx = cstart+j; - } - if( subsettype==1 ) - { - srcidx = idx->ptr.p_int[cstart+j]; - } - ae_assert(srcidx>=0, "MLPGradBatchX: internal error", _state); - if( datasettype==0 ) - { - ae_v_move(&pbuf->xy.ptr.pp_double[j][0], 1, &densexy->ptr.pp_double[srcidx][0], 1, ae_v_len(0,rowsize-1)); - } - if( datasettype==1 ) - { - sparsegetrow(sparsexy, srcidx, &pbuf->xyrow, _state); - ae_v_move(&pbuf->xy.ptr.pp_double[j][0], 1, &pbuf->xyrow.ptr.p_double[0], 1, ae_v_len(0,rowsize-1)); - } - } - - /* - * Process chunk and advance line pointer - */ - mlpbase_mlpchunkedgradient(network, &pbuf->xy, 0, csize, &pbuf->batch4buf, &pbuf->hpcbuf, &sgrad->f, ae_false, _state); - cstart = cstart+pbuf->chunksize; - } - hpcfinalizechunkedgradient(pbuf, &sgrad->g, _state); - ae_shared_pool_recycle(buf, &_pbuf, _state); - ae_shared_pool_recycle(gradbuf, &_sgrad, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Batch gradient calculation for a set of inputs/outputs -(natural error function is used) - -INPUT PARAMETERS: - Network - network initialized with one of the network creation funcs - XY - set of inputs/outputs; one sample = one row; - first NIn columns contain inputs, - next NOut columns - desired outputs. - SSize - number of elements in XY - Grad - possibly preallocated array. If size of array is smaller - than WCount, it will be reallocated. It is recommended to - reuse previously allocated array to reduce allocation - overhead. - -OUTPUT PARAMETERS: - E - error function, sum-of-squares for regression networks, - cross-entropy for classification networks. - Grad - gradient of E with respect to weights of network, array[WCount] - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpgradnbatch(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t ssize, - double* e, - /* Real */ ae_vector* grad, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - mlpbuffers *pbuf; - ae_smart_ptr _pbuf; - - ae_frame_make(_state, &_frame_block); - *e = 0; - ae_smart_ptr_init(&_pbuf, (void**)&pbuf, _state, ae_true); - - - /* - * Alloc - */ - mlpproperties(network, &nin, &nout, &wcount, _state); - ae_shared_pool_retrieve(&network->buf, &_pbuf, _state); - hpcpreparechunkedgradient(&network->weights, wcount, mlpntotal(network, _state), nin, nout, pbuf, _state); - rvectorsetlengthatleast(grad, wcount, _state); - for(i=0; i<=wcount-1; i++) - { - grad->ptr.p_double[i] = 0; - } - *e = 0; - i = 0; - while(i<=ssize-1) - { - mlpbase_mlpchunkedgradient(network, xy, i, ae_minint(ssize, i+pbuf->chunksize, _state)-i, &pbuf->batch4buf, &pbuf->hpcbuf, e, ae_true, _state); - i = i+pbuf->chunksize; - } - hpcfinalizechunkedgradient(pbuf, grad, _state); - ae_shared_pool_recycle(&network->buf, &_pbuf, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Batch Hessian calculation (natural error function) using R-algorithm. -Internal subroutine. - - -- ALGLIB -- - Copyright 26.01.2008 by Bochkanov Sergey. - - Hessian calculation based on R-algorithm described in - "Fast Exact Multiplication by the Hessian", - B. A. Pearlmutter, - Neural Computation, 1994. -*************************************************************************/ -void mlphessiannbatch(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t ssize, - double* e, - /* Real */ ae_vector* grad, - /* Real */ ae_matrix* h, - ae_state *_state) -{ - - *e = 0; - - mlpbase_mlphessianbatchinternal(network, xy, ssize, ae_true, e, grad, h, _state); -} - - -/************************************************************************* -Batch Hessian calculation using R-algorithm. -Internal subroutine. - - -- ALGLIB -- - Copyright 26.01.2008 by Bochkanov Sergey. - - Hessian calculation based on R-algorithm described in - "Fast Exact Multiplication by the Hessian", - B. A. Pearlmutter, - Neural Computation, 1994. -*************************************************************************/ -void mlphessianbatch(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t ssize, - double* e, - /* Real */ ae_vector* grad, - /* Real */ ae_matrix* h, - ae_state *_state) -{ - - *e = 0; - - mlpbase_mlphessianbatchinternal(network, xy, ssize, ae_false, e, grad, h, _state); -} - - -/************************************************************************* -Internal subroutine, shouldn't be called by user. -*************************************************************************/ -void mlpinternalprocessvector(/* Integer */ ae_vector* structinfo, - /* Real */ ae_vector* weights, - /* Real */ ae_vector* columnmeans, - /* Real */ ae_vector* columnsigmas, - /* Real */ ae_vector* neurons, - /* Real */ ae_vector* dfdnet, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state) -{ - ae_int_t i; - ae_int_t n1; - ae_int_t n2; - ae_int_t w1; - ae_int_t w2; - ae_int_t ntotal; - ae_int_t nin; - ae_int_t nout; - ae_int_t istart; - ae_int_t offs; - double net; - double f; - double df; - double d2f; - double mx; - ae_bool perr; - - - - /* - * Read network geometry - */ - nin = structinfo->ptr.p_int[1]; - nout = structinfo->ptr.p_int[2]; - ntotal = structinfo->ptr.p_int[3]; - istart = structinfo->ptr.p_int[5]; - - /* - * Inputs standartisation and putting in the network - */ - for(i=0; i<=nin-1; i++) - { - if( ae_fp_neq(columnsigmas->ptr.p_double[i],0) ) - { - neurons->ptr.p_double[i] = (x->ptr.p_double[i]-columnmeans->ptr.p_double[i])/columnsigmas->ptr.p_double[i]; - } - else - { - neurons->ptr.p_double[i] = x->ptr.p_double[i]-columnmeans->ptr.p_double[i]; - } - } - - /* - * Process network - */ - for(i=0; i<=ntotal-1; i++) - { - offs = istart+i*mlpbase_nfieldwidth; - if( structinfo->ptr.p_int[offs+0]>0||structinfo->ptr.p_int[offs+0]==-5 ) - { - - /* - * Activation function - */ - mlpactivationfunction(neurons->ptr.p_double[structinfo->ptr.p_int[offs+2]], structinfo->ptr.p_int[offs+0], &f, &df, &d2f, _state); - neurons->ptr.p_double[i] = f; - dfdnet->ptr.p_double[i] = df; - continue; - } - if( structinfo->ptr.p_int[offs+0]==0 ) - { - - /* - * Adaptive summator - */ - n1 = structinfo->ptr.p_int[offs+2]; - n2 = n1+structinfo->ptr.p_int[offs+1]-1; - w1 = structinfo->ptr.p_int[offs+3]; - w2 = w1+structinfo->ptr.p_int[offs+1]-1; - net = ae_v_dotproduct(&weights->ptr.p_double[w1], 1, &neurons->ptr.p_double[n1], 1, ae_v_len(w1,w2)); - neurons->ptr.p_double[i] = net; - dfdnet->ptr.p_double[i] = 1.0; - touchint(&n2, _state); - continue; - } - if( structinfo->ptr.p_int[offs+0]<0 ) - { - perr = ae_true; - if( structinfo->ptr.p_int[offs+0]==-2 ) - { - - /* - * input neuron, left unchanged - */ - perr = ae_false; - } - if( structinfo->ptr.p_int[offs+0]==-3 ) - { - - /* - * "-1" neuron - */ - neurons->ptr.p_double[i] = -1; - perr = ae_false; - } - if( structinfo->ptr.p_int[offs+0]==-4 ) - { - - /* - * "0" neuron - */ - neurons->ptr.p_double[i] = 0; - perr = ae_false; - } - ae_assert(!perr, "MLPInternalProcessVector: internal error - unknown neuron type!", _state); - continue; - } - } - - /* - * Extract result - */ - ae_v_move(&y->ptr.p_double[0], 1, &neurons->ptr.p_double[ntotal-nout], 1, ae_v_len(0,nout-1)); - - /* - * Softmax post-processing or standardisation if needed - */ - ae_assert(structinfo->ptr.p_int[6]==0||structinfo->ptr.p_int[6]==1, "MLPInternalProcessVector: unknown normalization type!", _state); - if( structinfo->ptr.p_int[6]==1 ) - { - - /* - * Softmax - */ - mx = y->ptr.p_double[0]; - for(i=1; i<=nout-1; i++) - { - mx = ae_maxreal(mx, y->ptr.p_double[i], _state); - } - net = 0; - for(i=0; i<=nout-1; i++) - { - y->ptr.p_double[i] = ae_exp(y->ptr.p_double[i]-mx, _state); - net = net+y->ptr.p_double[i]; - } - for(i=0; i<=nout-1; i++) - { - y->ptr.p_double[i] = y->ptr.p_double[i]/net; - } - } - else - { - - /* - * Standardisation - */ - for(i=0; i<=nout-1; i++) - { - y->ptr.p_double[i] = y->ptr.p_double[i]*columnsigmas->ptr.p_double[nin+i]+columnmeans->ptr.p_double[nin+i]; - } - } -} - - -/************************************************************************* -Serializer: allocation - - -- ALGLIB -- - Copyright 14.03.2011 by Bochkanov Sergey -*************************************************************************/ -void mlpalloc(ae_serializer* s, - multilayerperceptron* network, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t fkind; - double threshold; - double v0; - double v1; - ae_int_t nin; - ae_int_t nout; - - - nin = network->hllayersizes.ptr.p_int[0]; - nout = network->hllayersizes.ptr.p_int[network->hllayersizes.cnt-1]; - ae_serializer_alloc_entry(s); - ae_serializer_alloc_entry(s); - ae_serializer_alloc_entry(s); - allocintegerarray(s, &network->hllayersizes, -1, _state); - for(i=1; i<=network->hllayersizes.cnt-1; i++) - { - for(j=0; j<=network->hllayersizes.ptr.p_int[i]-1; j++) - { - mlpgetneuroninfo(network, i, j, &fkind, &threshold, _state); - ae_serializer_alloc_entry(s); - ae_serializer_alloc_entry(s); - for(k=0; k<=network->hllayersizes.ptr.p_int[i-1]-1; k++) - { - ae_serializer_alloc_entry(s); - } - } - } - for(j=0; j<=nin-1; j++) - { - mlpgetinputscaling(network, j, &v0, &v1, _state); - ae_serializer_alloc_entry(s); - ae_serializer_alloc_entry(s); - } - for(j=0; j<=nout-1; j++) - { - mlpgetoutputscaling(network, j, &v0, &v1, _state); - ae_serializer_alloc_entry(s); - ae_serializer_alloc_entry(s); - } -} - - -/************************************************************************* -Serializer: serialization - - -- ALGLIB -- - Copyright 14.03.2011 by Bochkanov Sergey -*************************************************************************/ -void mlpserialize(ae_serializer* s, - multilayerperceptron* network, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t fkind; - double threshold; - double v0; - double v1; - ae_int_t nin; - ae_int_t nout; - - - nin = network->hllayersizes.ptr.p_int[0]; - nout = network->hllayersizes.ptr.p_int[network->hllayersizes.cnt-1]; - ae_serializer_serialize_int(s, getmlpserializationcode(_state), _state); - ae_serializer_serialize_int(s, mlpbase_mlpfirstversion, _state); - ae_serializer_serialize_bool(s, mlpissoftmax(network, _state), _state); - serializeintegerarray(s, &network->hllayersizes, -1, _state); - for(i=1; i<=network->hllayersizes.cnt-1; i++) - { - for(j=0; j<=network->hllayersizes.ptr.p_int[i]-1; j++) - { - mlpgetneuroninfo(network, i, j, &fkind, &threshold, _state); - ae_serializer_serialize_int(s, fkind, _state); - ae_serializer_serialize_double(s, threshold, _state); - for(k=0; k<=network->hllayersizes.ptr.p_int[i-1]-1; k++) - { - ae_serializer_serialize_double(s, mlpgetweight(network, i-1, k, i, j, _state), _state); - } - } - } - for(j=0; j<=nin-1; j++) - { - mlpgetinputscaling(network, j, &v0, &v1, _state); - ae_serializer_serialize_double(s, v0, _state); - ae_serializer_serialize_double(s, v1, _state); - } - for(j=0; j<=nout-1; j++) - { - mlpgetoutputscaling(network, j, &v0, &v1, _state); - ae_serializer_serialize_double(s, v0, _state); - ae_serializer_serialize_double(s, v1, _state); - } -} - - -/************************************************************************* -Serializer: unserialization - - -- ALGLIB -- - Copyright 14.03.2011 by Bochkanov Sergey -*************************************************************************/ -void mlpunserialize(ae_serializer* s, - multilayerperceptron* network, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i0; - ae_int_t i1; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t fkind; - double threshold; - double v0; - double v1; - ae_int_t nin; - ae_int_t nout; - ae_bool issoftmax; - ae_vector layersizes; - - ae_frame_make(_state, &_frame_block); - _multilayerperceptron_clear(network); - ae_vector_init(&layersizes, 0, DT_INT, _state, ae_true); - - - /* - * check correctness of header - */ - ae_serializer_unserialize_int(s, &i0, _state); - ae_assert(i0==getmlpserializationcode(_state), "MLPUnserialize: stream header corrupted", _state); - ae_serializer_unserialize_int(s, &i1, _state); - ae_assert(i1==mlpbase_mlpfirstversion, "MLPUnserialize: stream header corrupted", _state); - - /* - * Create network - */ - ae_serializer_unserialize_bool(s, &issoftmax, _state); - unserializeintegerarray(s, &layersizes, _state); - ae_assert((layersizes.cnt==2||layersizes.cnt==3)||layersizes.cnt==4, "MLPUnserialize: too many hidden layers!", _state); - nin = layersizes.ptr.p_int[0]; - nout = layersizes.ptr.p_int[layersizes.cnt-1]; - if( layersizes.cnt==2 ) - { - if( issoftmax ) - { - mlpcreatec0(layersizes.ptr.p_int[0], layersizes.ptr.p_int[1], network, _state); - } - else - { - mlpcreate0(layersizes.ptr.p_int[0], layersizes.ptr.p_int[1], network, _state); - } - } - if( layersizes.cnt==3 ) - { - if( issoftmax ) - { - mlpcreatec1(layersizes.ptr.p_int[0], layersizes.ptr.p_int[1], layersizes.ptr.p_int[2], network, _state); - } - else - { - mlpcreate1(layersizes.ptr.p_int[0], layersizes.ptr.p_int[1], layersizes.ptr.p_int[2], network, _state); - } - } - if( layersizes.cnt==4 ) - { - if( issoftmax ) - { - mlpcreatec2(layersizes.ptr.p_int[0], layersizes.ptr.p_int[1], layersizes.ptr.p_int[2], layersizes.ptr.p_int[3], network, _state); - } - else - { - mlpcreate2(layersizes.ptr.p_int[0], layersizes.ptr.p_int[1], layersizes.ptr.p_int[2], layersizes.ptr.p_int[3], network, _state); - } - } - - /* - * Load neurons and weights - */ - for(i=1; i<=layersizes.cnt-1; i++) - { - for(j=0; j<=layersizes.ptr.p_int[i]-1; j++) - { - ae_serializer_unserialize_int(s, &fkind, _state); - ae_serializer_unserialize_double(s, &threshold, _state); - mlpsetneuroninfo(network, i, j, fkind, threshold, _state); - for(k=0; k<=layersizes.ptr.p_int[i-1]-1; k++) - { - ae_serializer_unserialize_double(s, &v0, _state); - mlpsetweight(network, i-1, k, i, j, v0, _state); - } - } - } - - /* - * Load standartizator - */ - for(j=0; j<=nin-1; j++) - { - ae_serializer_unserialize_double(s, &v0, _state); - ae_serializer_unserialize_double(s, &v1, _state); - mlpsetinputscaling(network, j, v0, v1, _state); - } - for(j=0; j<=nout-1; j++) - { - ae_serializer_unserialize_double(s, &v0, _state); - ae_serializer_unserialize_double(s, &v1, _state); - mlpsetoutputscaling(network, j, v0, v1, _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Calculation of all types of errors. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - network initialized with one of the network creation funcs - XY - original dataset; one sample = one row; - first NIn columns contain inputs, - next NOut columns - desired outputs. - SetSize - real size of XY, SetSize>=0; - Subset - subset of SubsetSize elements, array[SubsetSize]; - SubsetSize- number of elements in Subset[] array. - -OUTPUT PARAMETERS: - Rep - it contains all type of errors. - -NOTE: when SubsetSize<0 is used full dataset by call MLPGradBatch function. - - -- ALGLIB -- - Copyright 04.09.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpallerrorssubset(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t setsize, - /* Integer */ ae_vector* subset, - ae_int_t subsetsize, - modelerrors* rep, - ae_state *_state) -{ - ae_int_t idx0; - ae_int_t idx1; - ae_int_t idxtype; - - _modelerrors_clear(rep); - - ae_assert(xy->rows>=setsize, "MLPAllErrorsSubset: XY has less than SetSize rows", _state); - if( setsize>0 ) - { - if( mlpissoftmax(network, _state) ) - { - ae_assert(xy->cols>=mlpgetinputscount(network, _state)+1, "MLPAllErrorsSubset: XY has less than NIn+1 columns", _state); - } - else - { - ae_assert(xy->cols>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPAllErrorsSubset: XY has less than NIn+NOut columns", _state); - } - } - if( subsetsize>=0 ) - { - idx0 = 0; - idx1 = subsetsize; - idxtype = 1; - } - else - { - idx0 = 0; - idx1 = setsize; - idxtype = 0; - } - mlpallerrorsx(network, xy, &network->dummysxy, setsize, 0, subset, idx0, idx1, idxtype, &network->buf, rep, _state); -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -void _pexec_mlpallerrorssubset(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t setsize, - /* Integer */ ae_vector* subset, - ae_int_t subsetsize, - modelerrors* rep, ae_state *_state) -{ - mlpallerrorssubset(network,xy,setsize,subset,subsetsize,rep, _state); -} - - -/************************************************************************* -Calculation of all types of errors on sparse dataset. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - network initialized with one of the network creation funcs - XY - original dataset given by sparse matrix; - one sample = one row; - first NIn columns contain inputs, - next NOut columns - desired outputs. - SetSize - real size of XY, SetSize>=0; - Subset - subset of SubsetSize elements, array[SubsetSize]; - SubsetSize- number of elements in Subset[] array. - -OUTPUT PARAMETERS: - Rep - it contains all type of errors. - -NOTE: when SubsetSize<0 is used full dataset by call MLPGradBatch function. - - -- ALGLIB -- - Copyright 04.09.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpallerrorssparsesubset(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t setsize, - /* Integer */ ae_vector* subset, - ae_int_t subsetsize, - modelerrors* rep, - ae_state *_state) -{ - ae_int_t idx0; - ae_int_t idx1; - ae_int_t idxtype; - - _modelerrors_clear(rep); - - ae_assert(sparseiscrs(xy, _state), "MLPAllErrorsSparseSubset: XY is not in CRS format.", _state); - ae_assert(sparsegetnrows(xy, _state)>=setsize, "MLPAllErrorsSparseSubset: XY has less than SetSize rows", _state); - if( setsize>0 ) - { - if( mlpissoftmax(network, _state) ) - { - ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+1, "MLPAllErrorsSparseSubset: XY has less than NIn+1 columns", _state); - } - else - { - ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPAllErrorsSparseSubset: XY has less than NIn+NOut columns", _state); - } - } - if( subsetsize>=0 ) - { - idx0 = 0; - idx1 = subsetsize; - idxtype = 1; - } - else - { - idx0 = 0; - idx1 = setsize; - idxtype = 0; - } - mlpallerrorsx(network, &network->dummydxy, xy, setsize, 1, subset, idx0, idx1, idxtype, &network->buf, rep, _state); -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -void _pexec_mlpallerrorssparsesubset(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t setsize, - /* Integer */ ae_vector* subset, - ae_int_t subsetsize, - modelerrors* rep, ae_state *_state) -{ - mlpallerrorssparsesubset(network,xy,setsize,subset,subsetsize,rep, _state); -} - - -/************************************************************************* -Error of the neural network on dataset. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format; - SetSize - real size of XY, SetSize>=0; - Subset - subset of SubsetSize elements, array[SubsetSize]; - SubsetSize- number of elements in Subset[] array. - -RESULT: - sum-of-squares error, SUM(sqr(y[i]-desired_y[i])/2) - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 04.09.2012 by Bochkanov Sergey -*************************************************************************/ -double mlperrorsubset(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t setsize, - /* Integer */ ae_vector* subset, - ae_int_t subsetsize, - ae_state *_state) -{ - ae_int_t idx0; - ae_int_t idx1; - ae_int_t idxtype; - double result; - - - ae_assert(xy->rows>=setsize, "MLPErrorSubset: XY has less than SetSize rows", _state); - if( setsize>0 ) - { - if( mlpissoftmax(network, _state) ) - { - ae_assert(xy->cols>=mlpgetinputscount(network, _state)+1, "MLPErrorSubset: XY has less than NIn+1 columns", _state); - } - else - { - ae_assert(xy->cols>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPErrorSubset: XY has less than NIn+NOut columns", _state); - } - } - if( subsetsize>=0 ) - { - idx0 = 0; - idx1 = subsetsize; - idxtype = 1; - } - else - { - idx0 = 0; - idx1 = setsize; - idxtype = 0; - } - mlpallerrorsx(network, xy, &network->dummysxy, setsize, 0, subset, idx0, idx1, idxtype, &network->buf, &network->err, _state); - result = ae_sqr(network->err.rmserror, _state)*(idx1-idx0)*mlpgetoutputscount(network, _state)/2; - return result; -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -double _pexec_mlperrorsubset(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t setsize, - /* Integer */ ae_vector* subset, - ae_int_t subsetsize, ae_state *_state) -{ - return mlperrorsubset(network,xy,setsize,subset,subsetsize, _state); -} - - -/************************************************************************* -Error of the neural network on sparse dataset. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format. This function checks correctness - of the dataset (no NANs/INFs, class numbers are - correct) and throws exception when incorrect dataset - is passed. Sparse matrix must use CRS format for - storage. - SetSize - real size of XY, SetSize>=0; - it is used when SubsetSize<0; - Subset - subset of SubsetSize elements, array[SubsetSize]; - SubsetSize- number of elements in Subset[] array. - -RESULT: - sum-of-squares error, SUM(sqr(y[i]-desired_y[i])/2) - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 04.09.2012 by Bochkanov Sergey -*************************************************************************/ -double mlperrorsparsesubset(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t setsize, - /* Integer */ ae_vector* subset, - ae_int_t subsetsize, - ae_state *_state) -{ - ae_int_t idx0; - ae_int_t idx1; - ae_int_t idxtype; - double result; - - - ae_assert(sparseiscrs(xy, _state), "MLPErrorSparseSubset: XY is not in CRS format.", _state); - ae_assert(sparsegetnrows(xy, _state)>=setsize, "MLPErrorSparseSubset: XY has less than SetSize rows", _state); - if( setsize>0 ) - { - if( mlpissoftmax(network, _state) ) - { - ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+1, "MLPErrorSparseSubset: XY has less than NIn+1 columns", _state); - } - else - { - ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPErrorSparseSubset: XY has less than NIn+NOut columns", _state); - } - } - if( subsetsize>=0 ) - { - idx0 = 0; - idx1 = subsetsize; - idxtype = 1; - } - else - { - idx0 = 0; - idx1 = setsize; - idxtype = 0; - } - mlpallerrorsx(network, &network->dummydxy, xy, setsize, 1, subset, idx0, idx1, idxtype, &network->buf, &network->err, _state); - result = ae_sqr(network->err.rmserror, _state)*(idx1-idx0)*mlpgetoutputscount(network, _state)/2; - return result; -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -double _pexec_mlperrorsparsesubset(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t setsize, - /* Integer */ ae_vector* subset, - ae_int_t subsetsize, ae_state *_state) -{ - return mlperrorsparsesubset(network,xy,setsize,subset,subsetsize, _state); -} - - -void mlpallerrorsx(multilayerperceptron* network, - /* Real */ ae_matrix* densexy, - sparsematrix* sparsexy, - ae_int_t datasetsize, - ae_int_t datasettype, - /* Integer */ ae_vector* idx, - ae_int_t subset0, - ae_int_t subset1, - ae_int_t subsettype, - ae_shared_pool* buf, - modelerrors* rep, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - ae_int_t rowsize; - ae_bool iscls; - ae_int_t srcidx; - ae_int_t cstart; - ae_int_t csize; - ae_int_t j; - mlpbuffers *pbuf; - ae_smart_ptr _pbuf; - ae_int_t len0; - ae_int_t len1; - modelerrors rep0; - modelerrors rep1; - - ae_frame_make(_state, &_frame_block); - ae_smart_ptr_init(&_pbuf, (void**)&pbuf, _state, ae_true); - _modelerrors_init(&rep0, _state, ae_true); - _modelerrors_init(&rep1, _state, ae_true); - - ae_assert(datasetsize>=0, "MLPAllErrorsX: SetSize<0", _state); - ae_assert(datasettype==0||datasettype==1, "MLPAllErrorsX: DatasetType is incorrect", _state); - ae_assert(subsettype==0||subsettype==1, "MLPAllErrorsX: SubsetType is incorrect", _state); - - /* - * Determine network properties - */ - mlpproperties(network, &nin, &nout, &wcount, _state); - iscls = mlpissoftmax(network, _state); - - /* - * Split problem. - * - * Splitting problem allows us to reduce effect of single-precision - * arithmetics (SSE-optimized version of MLPChunkedProcess uses single - * precision internally, but converts them to double precision after - * results are exported from HPC buffer to network). Small batches are - * calculated in single precision, results are aggregated in double - * precision, and it allows us to avoid accumulation of errors when - * we process very large batches (tens of thousands of items). - * - * NOTE: it is important to use real arithmetics for ProblemCost - * because ProblemCost may be larger than MAXINT. - */ - if( subset1-subset0>=2*mlpbase_microbatchsize&&ae_fp_greater(inttoreal(subset1-subset0, _state)*inttoreal(wcount, _state),mlpbase_gradbasecasecost) ) - { - splitlength(subset1-subset0, mlpbase_microbatchsize, &len0, &len1, _state); - mlpallerrorsx(network, densexy, sparsexy, datasetsize, datasettype, idx, subset0, subset0+len0, subsettype, buf, &rep0, _state); - mlpallerrorsx(network, densexy, sparsexy, datasetsize, datasettype, idx, subset0+len0, subset1, subsettype, buf, &rep1, _state); - rep->relclserror = (len0*rep0.relclserror+len1*rep1.relclserror)/(len0+len1); - rep->avgce = (len0*rep0.avgce+len1*rep1.avgce)/(len0+len1); - rep->rmserror = ae_sqrt((len0*ae_sqr(rep0.rmserror, _state)+len1*ae_sqr(rep1.rmserror, _state))/(len0+len1), _state); - rep->avgerror = (len0*rep0.avgerror+len1*rep1.avgerror)/(len0+len1); - rep->avgrelerror = (len0*rep0.avgrelerror+len1*rep1.avgrelerror)/(len0+len1); - ae_frame_leave(_state); - return; - } - - /* - * Retrieve and prepare - */ - ae_shared_pool_retrieve(buf, &_pbuf, _state); - if( iscls ) - { - rowsize = nin+1; - dserrallocate(nout, &pbuf->tmp0, _state); - } - else - { - rowsize = nin+nout; - dserrallocate(-nout, &pbuf->tmp0, _state); - } - - /* - * Processing - */ - hpcpreparechunkedgradient(&network->weights, wcount, mlpntotal(network, _state), nin, nout, pbuf, _state); - cstart = subset0; - while(cstartchunksize, _state)-cstart; - for(j=0; j<=csize-1; j++) - { - srcidx = -1; - if( subsettype==0 ) - { - srcidx = cstart+j; - } - if( subsettype==1 ) - { - srcidx = idx->ptr.p_int[cstart+j]; - } - ae_assert(srcidx>=0, "MLPAllErrorsX: internal error", _state); - if( datasettype==0 ) - { - ae_v_move(&pbuf->xy.ptr.pp_double[j][0], 1, &densexy->ptr.pp_double[srcidx][0], 1, ae_v_len(0,rowsize-1)); - } - if( datasettype==1 ) - { - sparsegetrow(sparsexy, srcidx, &pbuf->xyrow, _state); - ae_v_move(&pbuf->xy.ptr.pp_double[j][0], 1, &pbuf->xyrow.ptr.p_double[0], 1, ae_v_len(0,rowsize-1)); - } - } - - /* - * Unpack XY and process (temporary code, to be replaced by chunked processing) - */ - for(j=0; j<=csize-1; j++) - { - ae_v_move(&pbuf->xy2.ptr.pp_double[j][0], 1, &pbuf->xy.ptr.pp_double[j][0], 1, ae_v_len(0,rowsize-1)); - } - mlpbase_mlpchunkedprocess(network, &pbuf->xy2, 0, csize, &pbuf->batch4buf, &pbuf->hpcbuf, _state); - for(j=0; j<=csize-1; j++) - { - ae_v_move(&pbuf->x.ptr.p_double[0], 1, &pbuf->xy2.ptr.pp_double[j][0], 1, ae_v_len(0,nin-1)); - ae_v_move(&pbuf->y.ptr.p_double[0], 1, &pbuf->xy2.ptr.pp_double[j][nin], 1, ae_v_len(0,nout-1)); - if( iscls ) - { - pbuf->desiredy.ptr.p_double[0] = pbuf->xy.ptr.pp_double[j][nin]; - } - else - { - ae_v_move(&pbuf->desiredy.ptr.p_double[0], 1, &pbuf->xy.ptr.pp_double[j][nin], 1, ae_v_len(0,nout-1)); - } - dserraccumulate(&pbuf->tmp0, &pbuf->y, &pbuf->desiredy, _state); - } - - /* - * Process chunk and advance line pointer - */ - cstart = cstart+pbuf->chunksize; - } - dserrfinish(&pbuf->tmp0, _state); - rep->relclserror = pbuf->tmp0.ptr.p_double[0]; - rep->avgce = pbuf->tmp0.ptr.p_double[1]/ae_log(2, _state); - rep->rmserror = pbuf->tmp0.ptr.p_double[2]; - rep->avgerror = pbuf->tmp0.ptr.p_double[3]; - rep->avgrelerror = pbuf->tmp0.ptr.p_double[4]; - - /* - * Recycle - */ - ae_shared_pool_recycle(buf, &_pbuf, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Internal subroutine: adding new input layer to network -*************************************************************************/ -static void mlpbase_addinputlayer(ae_int_t ncount, - /* Integer */ ae_vector* lsizes, - /* Integer */ ae_vector* ltypes, - /* Integer */ ae_vector* lconnfirst, - /* Integer */ ae_vector* lconnlast, - ae_int_t* lastproc, - ae_state *_state) -{ - - - lsizes->ptr.p_int[0] = ncount; - ltypes->ptr.p_int[0] = -2; - lconnfirst->ptr.p_int[0] = 0; - lconnlast->ptr.p_int[0] = 0; - *lastproc = 0; -} - - -/************************************************************************* -Internal subroutine: adding new summator layer to network -*************************************************************************/ -static void mlpbase_addbiasedsummatorlayer(ae_int_t ncount, - /* Integer */ ae_vector* lsizes, - /* Integer */ ae_vector* ltypes, - /* Integer */ ae_vector* lconnfirst, - /* Integer */ ae_vector* lconnlast, - ae_int_t* lastproc, - ae_state *_state) -{ - - - lsizes->ptr.p_int[*lastproc+1] = 1; - ltypes->ptr.p_int[*lastproc+1] = -3; - lconnfirst->ptr.p_int[*lastproc+1] = 0; - lconnlast->ptr.p_int[*lastproc+1] = 0; - lsizes->ptr.p_int[*lastproc+2] = ncount; - ltypes->ptr.p_int[*lastproc+2] = 0; - lconnfirst->ptr.p_int[*lastproc+2] = *lastproc; - lconnlast->ptr.p_int[*lastproc+2] = *lastproc+1; - *lastproc = *lastproc+2; -} - - -/************************************************************************* -Internal subroutine: adding new summator layer to network -*************************************************************************/ -static void mlpbase_addactivationlayer(ae_int_t functype, - /* Integer */ ae_vector* lsizes, - /* Integer */ ae_vector* ltypes, - /* Integer */ ae_vector* lconnfirst, - /* Integer */ ae_vector* lconnlast, - ae_int_t* lastproc, - ae_state *_state) -{ - - - ae_assert(functype>0||functype==-5, "AddActivationLayer: incorrect function type", _state); - lsizes->ptr.p_int[*lastproc+1] = lsizes->ptr.p_int[*lastproc]; - ltypes->ptr.p_int[*lastproc+1] = functype; - lconnfirst->ptr.p_int[*lastproc+1] = *lastproc; - lconnlast->ptr.p_int[*lastproc+1] = *lastproc; - *lastproc = *lastproc+1; -} - - -/************************************************************************* -Internal subroutine: adding new zero layer to network -*************************************************************************/ -static void mlpbase_addzerolayer(/* Integer */ ae_vector* lsizes, - /* Integer */ ae_vector* ltypes, - /* Integer */ ae_vector* lconnfirst, - /* Integer */ ae_vector* lconnlast, - ae_int_t* lastproc, - ae_state *_state) -{ - - - lsizes->ptr.p_int[*lastproc+1] = 1; - ltypes->ptr.p_int[*lastproc+1] = -4; - lconnfirst->ptr.p_int[*lastproc+1] = 0; - lconnlast->ptr.p_int[*lastproc+1] = 0; - *lastproc = *lastproc+1; -} - - -/************************************************************************* -This routine adds input layer to the high-level description of the network. - -It modifies Network.HLConnections and Network.HLNeurons and assumes that -these arrays have enough place to store data. It accepts following -parameters: - Network - network - ConnIdx - index of the first free entry in the HLConnections - NeuroIdx - index of the first free entry in the HLNeurons - StructInfoIdx- index of the first entry in the low level description - of the current layer (in the StructInfo array) - NIn - number of inputs - -It modified Network and indices. -*************************************************************************/ -static void mlpbase_hladdinputlayer(multilayerperceptron* network, - ae_int_t* connidx, - ae_int_t* neuroidx, - ae_int_t* structinfoidx, - ae_int_t nin, - ae_state *_state) -{ - ae_int_t i; - ae_int_t offs; - - - offs = mlpbase_hlnfieldwidth*(*neuroidx); - for(i=0; i<=nin-1; i++) - { - network->hlneurons.ptr.p_int[offs+0] = 0; - network->hlneurons.ptr.p_int[offs+1] = i; - network->hlneurons.ptr.p_int[offs+2] = -1; - network->hlneurons.ptr.p_int[offs+3] = -1; - offs = offs+mlpbase_hlnfieldwidth; - } - *neuroidx = *neuroidx+nin; - *structinfoidx = *structinfoidx+nin; -} - - -/************************************************************************* -This routine adds output layer to the high-level description of -the network. - -It modifies Network.HLConnections and Network.HLNeurons and assumes that -these arrays have enough place to store data. It accepts following -parameters: - Network - network - ConnIdx - index of the first free entry in the HLConnections - NeuroIdx - index of the first free entry in the HLNeurons - StructInfoIdx- index of the first entry in the low level description - of the current layer (in the StructInfo array) - WeightsIdx - index of the first entry in the Weights array which - corresponds to the current layer - K - current layer index - NPrev - number of neurons in the previous layer - NOut - number of outputs - IsCls - is it classifier network? - IsLinear - is it network with linear output? - -It modified Network and ConnIdx/NeuroIdx/StructInfoIdx/WeightsIdx. -*************************************************************************/ -static void mlpbase_hladdoutputlayer(multilayerperceptron* network, - ae_int_t* connidx, - ae_int_t* neuroidx, - ae_int_t* structinfoidx, - ae_int_t* weightsidx, - ae_int_t k, - ae_int_t nprev, - ae_int_t nout, - ae_bool iscls, - ae_bool islinearout, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t neurooffs; - ae_int_t connoffs; - - - ae_assert((iscls&&islinearout)||!iscls, "HLAddOutputLayer: internal error", _state); - neurooffs = mlpbase_hlnfieldwidth*(*neuroidx); - connoffs = mlpbase_hlconnfieldwidth*(*connidx); - if( !iscls ) - { - - /* - * Regression network - */ - for(i=0; i<=nout-1; i++) - { - network->hlneurons.ptr.p_int[neurooffs+0] = k; - network->hlneurons.ptr.p_int[neurooffs+1] = i; - network->hlneurons.ptr.p_int[neurooffs+2] = *structinfoidx+1+nout+i; - network->hlneurons.ptr.p_int[neurooffs+3] = *weightsidx+nprev+(nprev+1)*i; - neurooffs = neurooffs+mlpbase_hlnfieldwidth; - } - for(i=0; i<=nprev-1; i++) - { - for(j=0; j<=nout-1; j++) - { - network->hlconnections.ptr.p_int[connoffs+0] = k-1; - network->hlconnections.ptr.p_int[connoffs+1] = i; - network->hlconnections.ptr.p_int[connoffs+2] = k; - network->hlconnections.ptr.p_int[connoffs+3] = j; - network->hlconnections.ptr.p_int[connoffs+4] = *weightsidx+i+j*(nprev+1); - connoffs = connoffs+mlpbase_hlconnfieldwidth; - } - } - *connidx = *connidx+nprev*nout; - *neuroidx = *neuroidx+nout; - *structinfoidx = *structinfoidx+2*nout+1; - *weightsidx = *weightsidx+nout*(nprev+1); - } - else - { - - /* - * Classification network - */ - for(i=0; i<=nout-2; i++) - { - network->hlneurons.ptr.p_int[neurooffs+0] = k; - network->hlneurons.ptr.p_int[neurooffs+1] = i; - network->hlneurons.ptr.p_int[neurooffs+2] = -1; - network->hlneurons.ptr.p_int[neurooffs+3] = *weightsidx+nprev+(nprev+1)*i; - neurooffs = neurooffs+mlpbase_hlnfieldwidth; - } - network->hlneurons.ptr.p_int[neurooffs+0] = k; - network->hlneurons.ptr.p_int[neurooffs+1] = i; - network->hlneurons.ptr.p_int[neurooffs+2] = -1; - network->hlneurons.ptr.p_int[neurooffs+3] = -1; - for(i=0; i<=nprev-1; i++) - { - for(j=0; j<=nout-2; j++) - { - network->hlconnections.ptr.p_int[connoffs+0] = k-1; - network->hlconnections.ptr.p_int[connoffs+1] = i; - network->hlconnections.ptr.p_int[connoffs+2] = k; - network->hlconnections.ptr.p_int[connoffs+3] = j; - network->hlconnections.ptr.p_int[connoffs+4] = *weightsidx+i+j*(nprev+1); - connoffs = connoffs+mlpbase_hlconnfieldwidth; - } - } - *connidx = *connidx+nprev*(nout-1); - *neuroidx = *neuroidx+nout; - *structinfoidx = *structinfoidx+nout+2; - *weightsidx = *weightsidx+(nout-1)*(nprev+1); - } -} - - -/************************************************************************* -This routine adds hidden layer to the high-level description of -the network. - -It modifies Network.HLConnections and Network.HLNeurons and assumes that -these arrays have enough place to store data. It accepts following -parameters: - Network - network - ConnIdx - index of the first free entry in the HLConnections - NeuroIdx - index of the first free entry in the HLNeurons - StructInfoIdx- index of the first entry in the low level description - of the current layer (in the StructInfo array) - WeightsIdx - index of the first entry in the Weights array which - corresponds to the current layer - K - current layer index - NPrev - number of neurons in the previous layer - NCur - number of neurons in the current layer - -It modified Network and ConnIdx/NeuroIdx/StructInfoIdx/WeightsIdx. -*************************************************************************/ -static void mlpbase_hladdhiddenlayer(multilayerperceptron* network, - ae_int_t* connidx, - ae_int_t* neuroidx, - ae_int_t* structinfoidx, - ae_int_t* weightsidx, - ae_int_t k, - ae_int_t nprev, - ae_int_t ncur, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t neurooffs; - ae_int_t connoffs; - - - neurooffs = mlpbase_hlnfieldwidth*(*neuroidx); - connoffs = mlpbase_hlconnfieldwidth*(*connidx); - for(i=0; i<=ncur-1; i++) - { - network->hlneurons.ptr.p_int[neurooffs+0] = k; - network->hlneurons.ptr.p_int[neurooffs+1] = i; - network->hlneurons.ptr.p_int[neurooffs+2] = *structinfoidx+1+ncur+i; - network->hlneurons.ptr.p_int[neurooffs+3] = *weightsidx+nprev+(nprev+1)*i; - neurooffs = neurooffs+mlpbase_hlnfieldwidth; - } - for(i=0; i<=nprev-1; i++) - { - for(j=0; j<=ncur-1; j++) - { - network->hlconnections.ptr.p_int[connoffs+0] = k-1; - network->hlconnections.ptr.p_int[connoffs+1] = i; - network->hlconnections.ptr.p_int[connoffs+2] = k; - network->hlconnections.ptr.p_int[connoffs+3] = j; - network->hlconnections.ptr.p_int[connoffs+4] = *weightsidx+i+j*(nprev+1); - connoffs = connoffs+mlpbase_hlconnfieldwidth; - } - } - *connidx = *connidx+nprev*ncur; - *neuroidx = *neuroidx+ncur; - *structinfoidx = *structinfoidx+2*ncur+1; - *weightsidx = *weightsidx+ncur*(nprev+1); -} - - -/************************************************************************* -This function fills high level information about network created using -internal MLPCreate() function. - -This function does NOT examine StructInfo for low level information, it -just expects that network has following structure: - - input neuron \ - ... | input layer - input neuron / - - "-1" neuron \ - biased summator | - ... | - biased summator | hidden layer(s), if there are exists any - activation function | - ... | - activation function / - - "-1" neuron \ - biased summator | output layer: - ... | - biased summator | * we have NOut summators/activators for regression networks - activation function | * we have only NOut-1 summators and no activators for classifiers - ... | * we have "0" neuron only when we have classifier - activation function | - "0" neuron / - - - -- ALGLIB -- - Copyright 30.03.2008 by Bochkanov Sergey -*************************************************************************/ -static void mlpbase_fillhighlevelinformation(multilayerperceptron* network, - ae_int_t nin, - ae_int_t nhid1, - ae_int_t nhid2, - ae_int_t nout, - ae_bool iscls, - ae_bool islinearout, - ae_state *_state) -{ - ae_int_t idxweights; - ae_int_t idxstruct; - ae_int_t idxneuro; - ae_int_t idxconn; - - - ae_assert((iscls&&islinearout)||!iscls, "FillHighLevelInformation: internal error", _state); - - /* - * Preparations common to all types of networks - */ - idxweights = 0; - idxneuro = 0; - idxstruct = 0; - idxconn = 0; - network->hlnetworktype = 0; - - /* - * network without hidden layers - */ - if( nhid1==0 ) - { - ae_vector_set_length(&network->hllayersizes, 2, _state); - network->hllayersizes.ptr.p_int[0] = nin; - network->hllayersizes.ptr.p_int[1] = nout; - if( !iscls ) - { - ae_vector_set_length(&network->hlconnections, mlpbase_hlconnfieldwidth*nin*nout, _state); - ae_vector_set_length(&network->hlneurons, mlpbase_hlnfieldwidth*(nin+nout), _state); - network->hlnormtype = 0; - } - else - { - ae_vector_set_length(&network->hlconnections, mlpbase_hlconnfieldwidth*nin*(nout-1), _state); - ae_vector_set_length(&network->hlneurons, mlpbase_hlnfieldwidth*(nin+nout), _state); - network->hlnormtype = 1; - } - mlpbase_hladdinputlayer(network, &idxconn, &idxneuro, &idxstruct, nin, _state); - mlpbase_hladdoutputlayer(network, &idxconn, &idxneuro, &idxstruct, &idxweights, 1, nin, nout, iscls, islinearout, _state); - return; - } - - /* - * network with one hidden layers - */ - if( nhid2==0 ) - { - ae_vector_set_length(&network->hllayersizes, 3, _state); - network->hllayersizes.ptr.p_int[0] = nin; - network->hllayersizes.ptr.p_int[1] = nhid1; - network->hllayersizes.ptr.p_int[2] = nout; - if( !iscls ) - { - ae_vector_set_length(&network->hlconnections, mlpbase_hlconnfieldwidth*(nin*nhid1+nhid1*nout), _state); - ae_vector_set_length(&network->hlneurons, mlpbase_hlnfieldwidth*(nin+nhid1+nout), _state); - network->hlnormtype = 0; - } - else - { - ae_vector_set_length(&network->hlconnections, mlpbase_hlconnfieldwidth*(nin*nhid1+nhid1*(nout-1)), _state); - ae_vector_set_length(&network->hlneurons, mlpbase_hlnfieldwidth*(nin+nhid1+nout), _state); - network->hlnormtype = 1; - } - mlpbase_hladdinputlayer(network, &idxconn, &idxneuro, &idxstruct, nin, _state); - mlpbase_hladdhiddenlayer(network, &idxconn, &idxneuro, &idxstruct, &idxweights, 1, nin, nhid1, _state); - mlpbase_hladdoutputlayer(network, &idxconn, &idxneuro, &idxstruct, &idxweights, 2, nhid1, nout, iscls, islinearout, _state); - return; - } - - /* - * Two hidden layers - */ - ae_vector_set_length(&network->hllayersizes, 4, _state); - network->hllayersizes.ptr.p_int[0] = nin; - network->hllayersizes.ptr.p_int[1] = nhid1; - network->hllayersizes.ptr.p_int[2] = nhid2; - network->hllayersizes.ptr.p_int[3] = nout; - if( !iscls ) - { - ae_vector_set_length(&network->hlconnections, mlpbase_hlconnfieldwidth*(nin*nhid1+nhid1*nhid2+nhid2*nout), _state); - ae_vector_set_length(&network->hlneurons, mlpbase_hlnfieldwidth*(nin+nhid1+nhid2+nout), _state); - network->hlnormtype = 0; - } - else - { - ae_vector_set_length(&network->hlconnections, mlpbase_hlconnfieldwidth*(nin*nhid1+nhid1*nhid2+nhid2*(nout-1)), _state); - ae_vector_set_length(&network->hlneurons, mlpbase_hlnfieldwidth*(nin+nhid1+nhid2+nout), _state); - network->hlnormtype = 1; - } - mlpbase_hladdinputlayer(network, &idxconn, &idxneuro, &idxstruct, nin, _state); - mlpbase_hladdhiddenlayer(network, &idxconn, &idxneuro, &idxstruct, &idxweights, 1, nin, nhid1, _state); - mlpbase_hladdhiddenlayer(network, &idxconn, &idxneuro, &idxstruct, &idxweights, 2, nhid1, nhid2, _state); - mlpbase_hladdoutputlayer(network, &idxconn, &idxneuro, &idxstruct, &idxweights, 3, nhid2, nout, iscls, islinearout, _state); -} - - -/************************************************************************* -Internal subroutine. - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -static void mlpbase_mlpcreate(ae_int_t nin, - ae_int_t nout, - /* Integer */ ae_vector* lsizes, - /* Integer */ ae_vector* ltypes, - /* Integer */ ae_vector* lconnfirst, - /* Integer */ ae_vector* lconnlast, - ae_int_t layerscount, - ae_bool isclsnet, - multilayerperceptron* network, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - ae_int_t ssize; - ae_int_t ntotal; - ae_int_t wcount; - ae_int_t offs; - ae_int_t nprocessed; - ae_int_t wallocated; - ae_vector localtemp; - ae_vector lnfirst; - ae_vector lnsyn; - mlpbuffers buf; - smlpgrad sgrad; - - ae_frame_make(_state, &_frame_block); - _multilayerperceptron_clear(network); - ae_vector_init(&localtemp, 0, DT_INT, _state, ae_true); - ae_vector_init(&lnfirst, 0, DT_INT, _state, ae_true); - ae_vector_init(&lnsyn, 0, DT_INT, _state, ae_true); - _mlpbuffers_init(&buf, _state, ae_true); - _smlpgrad_init(&sgrad, _state, ae_true); - - - /* - * Check - */ - ae_assert(layerscount>0, "MLPCreate: wrong parameters!", _state); - ae_assert(ltypes->ptr.p_int[0]==-2, "MLPCreate: wrong LTypes[0] (must be -2)!", _state); - for(i=0; i<=layerscount-1; i++) - { - ae_assert(lsizes->ptr.p_int[i]>0, "MLPCreate: wrong LSizes!", _state); - ae_assert(lconnfirst->ptr.p_int[i]>=0&&(lconnfirst->ptr.p_int[i]ptr.p_int[i]>=lconnfirst->ptr.p_int[i]&&(lconnlast->ptr.p_int[i]ptr.p_int[i]>=0||ltypes->ptr.p_int[i]==-5 ) - { - lnsyn.ptr.p_int[i] = 0; - for(j=lconnfirst->ptr.p_int[i]; j<=lconnlast->ptr.p_int[i]; j++) - { - lnsyn.ptr.p_int[i] = lnsyn.ptr.p_int[i]+lsizes->ptr.p_int[j]; - } - } - else - { - if( (ltypes->ptr.p_int[i]==-2||ltypes->ptr.p_int[i]==-3)||ltypes->ptr.p_int[i]==-4 ) - { - lnsyn.ptr.p_int[i] = 0; - } - } - ae_assert(lnsyn.ptr.p_int[i]>=0, "MLPCreate: internal error #0!", _state); - - /* - * Other info - */ - lnfirst.ptr.p_int[i] = ntotal; - ntotal = ntotal+lsizes->ptr.p_int[i]; - if( ltypes->ptr.p_int[i]==0 ) - { - wcount = wcount+lnsyn.ptr.p_int[i]*lsizes->ptr.p_int[i]; - } - } - ssize = 7+ntotal*mlpbase_nfieldwidth; - - /* - * Allocate - */ - ae_vector_set_length(&network->structinfo, ssize-1+1, _state); - ae_vector_set_length(&network->weights, wcount-1+1, _state); - if( isclsnet ) - { - ae_vector_set_length(&network->columnmeans, nin-1+1, _state); - ae_vector_set_length(&network->columnsigmas, nin-1+1, _state); - } - else - { - ae_vector_set_length(&network->columnmeans, nin+nout-1+1, _state); - ae_vector_set_length(&network->columnsigmas, nin+nout-1+1, _state); - } - ae_vector_set_length(&network->neurons, ntotal-1+1, _state); - ae_vector_set_length(&network->nwbuf, ae_maxint(wcount, 2*nout, _state)-1+1, _state); - ae_vector_set_length(&network->integerbuf, 3+1, _state); - ae_vector_set_length(&network->dfdnet, ntotal-1+1, _state); - ae_vector_set_length(&network->x, nin-1+1, _state); - ae_vector_set_length(&network->y, nout-1+1, _state); - ae_vector_set_length(&network->derror, ntotal-1+1, _state); - - /* - * Fill structure: global info - */ - network->structinfo.ptr.p_int[0] = ssize; - network->structinfo.ptr.p_int[1] = nin; - network->structinfo.ptr.p_int[2] = nout; - network->structinfo.ptr.p_int[3] = ntotal; - network->structinfo.ptr.p_int[4] = wcount; - network->structinfo.ptr.p_int[5] = 7; - if( isclsnet ) - { - network->structinfo.ptr.p_int[6] = 1; - } - else - { - network->structinfo.ptr.p_int[6] = 0; - } - - /* - * Fill structure: neuron connections - */ - nprocessed = 0; - wallocated = 0; - for(i=0; i<=layerscount-1; i++) - { - for(j=0; j<=lsizes->ptr.p_int[i]-1; j++) - { - offs = network->structinfo.ptr.p_int[5]+nprocessed*mlpbase_nfieldwidth; - network->structinfo.ptr.p_int[offs+0] = ltypes->ptr.p_int[i]; - if( ltypes->ptr.p_int[i]==0 ) - { - - /* - * Adaptive summator: - * * connections with weights to previous neurons - */ - network->structinfo.ptr.p_int[offs+1] = lnsyn.ptr.p_int[i]; - network->structinfo.ptr.p_int[offs+2] = lnfirst.ptr.p_int[lconnfirst->ptr.p_int[i]]; - network->structinfo.ptr.p_int[offs+3] = wallocated; - wallocated = wallocated+lnsyn.ptr.p_int[i]; - nprocessed = nprocessed+1; - } - if( ltypes->ptr.p_int[i]>0||ltypes->ptr.p_int[i]==-5 ) - { - - /* - * Activation layer: - * * each neuron connected to one (only one) of previous neurons. - * * no weights - */ - network->structinfo.ptr.p_int[offs+1] = 1; - network->structinfo.ptr.p_int[offs+2] = lnfirst.ptr.p_int[lconnfirst->ptr.p_int[i]]+j; - network->structinfo.ptr.p_int[offs+3] = -1; - nprocessed = nprocessed+1; - } - if( (ltypes->ptr.p_int[i]==-2||ltypes->ptr.p_int[i]==-3)||ltypes->ptr.p_int[i]==-4 ) - { - nprocessed = nprocessed+1; - } - } - } - ae_assert(wallocated==wcount, "MLPCreate: internal error #1!", _state); - ae_assert(nprocessed==ntotal, "MLPCreate: internal error #2!", _state); - - /* - * Fill weights by small random values - * Initialize means and sigmas - */ - for(i=0; i<=nin-1; i++) - { - network->columnmeans.ptr.p_double[i] = 0; - network->columnsigmas.ptr.p_double[i] = 1; - } - if( !isclsnet ) - { - for(i=0; i<=nout-1; i++) - { - network->columnmeans.ptr.p_double[nin+i] = 0; - network->columnsigmas.ptr.p_double[nin+i] = 1; - } - } - mlprandomize(network, _state); - - /* - * Seed buffers - */ - ae_shared_pool_set_seed(&network->buf, &buf, sizeof(buf), _mlpbuffers_init, _mlpbuffers_init_copy, _mlpbuffers_destroy, _state); - ae_vector_set_length(&sgrad.g, wcount, _state); - sgrad.f = 0.0; - for(i=0; i<=wcount-1; i++) - { - sgrad.g.ptr.p_double[i] = 0.0; - } - ae_shared_pool_set_seed(&network->gradbuf, &sgrad, sizeof(sgrad), _smlpgrad_init, _smlpgrad_init_copy, _smlpgrad_destroy, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Internal subroutine for Hessian calculation. - -WARNING! Unspeakable math far beyong human capabilities :) -*************************************************************************/ -static void mlpbase_mlphessianbatchinternal(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t ssize, - ae_bool naturalerr, - double* e, - /* Real */ ae_vector* grad, - /* Real */ ae_matrix* h, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - ae_int_t ntotal; - ae_int_t istart; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t kl; - ae_int_t offs; - ae_int_t n1; - ae_int_t n2; - ae_int_t w1; - ae_int_t w2; - double s; - double t; - double v; - double et; - ae_bool bflag; - double f; - double df; - double d2f; - double deidyj; - double mx; - double q; - double z; - double s2; - double expi; - double expj; - ae_vector x; - ae_vector desiredy; - ae_vector gt; - ae_vector zeros; - ae_matrix rx; - ae_matrix ry; - ae_matrix rdx; - ae_matrix rdy; - - ae_frame_make(_state, &_frame_block); - *e = 0; - ae_vector_init(&x, 0, DT_REAL, _state, ae_true); - ae_vector_init(&desiredy, 0, DT_REAL, _state, ae_true); - ae_vector_init(>, 0, DT_REAL, _state, ae_true); - ae_vector_init(&zeros, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&rx, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&ry, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&rdx, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&rdy, 0, 0, DT_REAL, _state, ae_true); - - mlpproperties(network, &nin, &nout, &wcount, _state); - ntotal = network->structinfo.ptr.p_int[3]; - istart = network->structinfo.ptr.p_int[5]; - - /* - * Prepare - */ - ae_vector_set_length(&x, nin-1+1, _state); - ae_vector_set_length(&desiredy, nout-1+1, _state); - ae_vector_set_length(&zeros, wcount-1+1, _state); - ae_vector_set_length(>, wcount-1+1, _state); - ae_matrix_set_length(&rx, ntotal+nout-1+1, wcount-1+1, _state); - ae_matrix_set_length(&ry, ntotal+nout-1+1, wcount-1+1, _state); - ae_matrix_set_length(&rdx, ntotal+nout-1+1, wcount-1+1, _state); - ae_matrix_set_length(&rdy, ntotal+nout-1+1, wcount-1+1, _state); - *e = 0; - for(i=0; i<=wcount-1; i++) - { - zeros.ptr.p_double[i] = 0; - } - ae_v_move(&grad->ptr.p_double[0], 1, &zeros.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - for(i=0; i<=wcount-1; i++) - { - ae_v_move(&h->ptr.pp_double[i][0], 1, &zeros.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - } - - /* - * Process - */ - for(k=0; k<=ssize-1; k++) - { - - /* - * Process vector with MLPGradN. - * Now Neurons, DFDNET and DError contains results of the last run. - */ - ae_v_move(&x.ptr.p_double[0], 1, &xy->ptr.pp_double[k][0], 1, ae_v_len(0,nin-1)); - if( mlpissoftmax(network, _state) ) - { - - /* - * class labels outputs - */ - kl = ae_round(xy->ptr.pp_double[k][nin], _state); - for(i=0; i<=nout-1; i++) - { - if( i==kl ) - { - desiredy.ptr.p_double[i] = 1; - } - else - { - desiredy.ptr.p_double[i] = 0; - } - } - } - else - { - - /* - * real outputs - */ - ae_v_move(&desiredy.ptr.p_double[0], 1, &xy->ptr.pp_double[k][nin], 1, ae_v_len(0,nout-1)); - } - if( naturalerr ) - { - mlpgradn(network, &x, &desiredy, &et, >, _state); - } - else - { - mlpgrad(network, &x, &desiredy, &et, >, _state); - } - - /* - * grad, error - */ - *e = *e+et; - ae_v_add(&grad->ptr.p_double[0], 1, >.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - - /* - * Hessian. - * Forward pass of the R-algorithm - */ - for(i=0; i<=ntotal-1; i++) - { - offs = istart+i*mlpbase_nfieldwidth; - ae_v_move(&rx.ptr.pp_double[i][0], 1, &zeros.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - ae_v_move(&ry.ptr.pp_double[i][0], 1, &zeros.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - if( network->structinfo.ptr.p_int[offs+0]>0||network->structinfo.ptr.p_int[offs+0]==-5 ) - { - - /* - * Activation function - */ - n1 = network->structinfo.ptr.p_int[offs+2]; - ae_v_move(&rx.ptr.pp_double[i][0], 1, &ry.ptr.pp_double[n1][0], 1, ae_v_len(0,wcount-1)); - v = network->dfdnet.ptr.p_double[i]; - ae_v_moved(&ry.ptr.pp_double[i][0], 1, &rx.ptr.pp_double[i][0], 1, ae_v_len(0,wcount-1), v); - continue; - } - if( network->structinfo.ptr.p_int[offs+0]==0 ) - { - - /* - * Adaptive summator - */ - n1 = network->structinfo.ptr.p_int[offs+2]; - n2 = n1+network->structinfo.ptr.p_int[offs+1]-1; - w1 = network->structinfo.ptr.p_int[offs+3]; - w2 = w1+network->structinfo.ptr.p_int[offs+1]-1; - for(j=n1; j<=n2; j++) - { - v = network->weights.ptr.p_double[w1+j-n1]; - ae_v_addd(&rx.ptr.pp_double[i][0], 1, &ry.ptr.pp_double[j][0], 1, ae_v_len(0,wcount-1), v); - rx.ptr.pp_double[i][w1+j-n1] = rx.ptr.pp_double[i][w1+j-n1]+network->neurons.ptr.p_double[j]; - } - ae_v_move(&ry.ptr.pp_double[i][0], 1, &rx.ptr.pp_double[i][0], 1, ae_v_len(0,wcount-1)); - continue; - } - if( network->structinfo.ptr.p_int[offs+0]<0 ) - { - bflag = ae_true; - if( network->structinfo.ptr.p_int[offs+0]==-2 ) - { - - /* - * input neuron, left unchanged - */ - bflag = ae_false; - } - if( network->structinfo.ptr.p_int[offs+0]==-3 ) - { - - /* - * "-1" neuron, left unchanged - */ - bflag = ae_false; - } - if( network->structinfo.ptr.p_int[offs+0]==-4 ) - { - - /* - * "0" neuron, left unchanged - */ - bflag = ae_false; - } - ae_assert(!bflag, "MLPHessianNBatch: internal error - unknown neuron type!", _state); - continue; - } - } - - /* - * Hessian. Backward pass of the R-algorithm. - * - * Stage 1. Initialize RDY - */ - for(i=0; i<=ntotal+nout-1; i++) - { - ae_v_move(&rdy.ptr.pp_double[i][0], 1, &zeros.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - } - if( network->structinfo.ptr.p_int[6]==0 ) - { - - /* - * Standardisation. - * - * In context of the Hessian calculation standardisation - * is considered as additional layer with weightless - * activation function: - * - * F(NET) := Sigma*NET - * - * So we add one more layer to forward pass, and - * make forward/backward pass through this layer. - */ - for(i=0; i<=nout-1; i++) - { - n1 = ntotal-nout+i; - n2 = ntotal+i; - - /* - * Forward pass from N1 to N2 - */ - ae_v_move(&rx.ptr.pp_double[n2][0], 1, &ry.ptr.pp_double[n1][0], 1, ae_v_len(0,wcount-1)); - v = network->columnsigmas.ptr.p_double[nin+i]; - ae_v_moved(&ry.ptr.pp_double[n2][0], 1, &rx.ptr.pp_double[n2][0], 1, ae_v_len(0,wcount-1), v); - - /* - * Initialization of RDY - */ - ae_v_move(&rdy.ptr.pp_double[n2][0], 1, &ry.ptr.pp_double[n2][0], 1, ae_v_len(0,wcount-1)); - - /* - * Backward pass from N2 to N1: - * 1. Calculate R(dE/dX). - * 2. No R(dE/dWij) is needed since weight of activation neuron - * is fixed to 1. So we can update R(dE/dY) for - * the connected neuron (note that Vij=0, Wij=1) - */ - df = network->columnsigmas.ptr.p_double[nin+i]; - ae_v_moved(&rdx.ptr.pp_double[n2][0], 1, &rdy.ptr.pp_double[n2][0], 1, ae_v_len(0,wcount-1), df); - ae_v_add(&rdy.ptr.pp_double[n1][0], 1, &rdx.ptr.pp_double[n2][0], 1, ae_v_len(0,wcount-1)); - } - } - else - { - - /* - * Softmax. - * - * Initialize RDY using generalized expression for ei'(yi) - * (see expression (9) from p. 5 of "Fast Exact Multiplication by the Hessian"). - * - * When we are working with softmax network, generalized - * expression for ei'(yi) is used because softmax - * normalization leads to ei, which depends on all y's - */ - if( naturalerr ) - { - - /* - * softmax + cross-entropy. - * We have: - * - * S = sum(exp(yk)), - * ei = sum(trn)*exp(yi)/S-trn_i - * - * j=i: d(ei)/d(yj) = T*exp(yi)*(S-exp(yi))/S^2 - * j<>i: d(ei)/d(yj) = -T*exp(yi)*exp(yj)/S^2 - */ - t = 0; - for(i=0; i<=nout-1; i++) - { - t = t+desiredy.ptr.p_double[i]; - } - mx = network->neurons.ptr.p_double[ntotal-nout]; - for(i=0; i<=nout-1; i++) - { - mx = ae_maxreal(mx, network->neurons.ptr.p_double[ntotal-nout+i], _state); - } - s = 0; - for(i=0; i<=nout-1; i++) - { - network->nwbuf.ptr.p_double[i] = ae_exp(network->neurons.ptr.p_double[ntotal-nout+i]-mx, _state); - s = s+network->nwbuf.ptr.p_double[i]; - } - for(i=0; i<=nout-1; i++) - { - for(j=0; j<=nout-1; j++) - { - if( j==i ) - { - deidyj = t*network->nwbuf.ptr.p_double[i]*(s-network->nwbuf.ptr.p_double[i])/ae_sqr(s, _state); - ae_v_addd(&rdy.ptr.pp_double[ntotal-nout+i][0], 1, &ry.ptr.pp_double[ntotal-nout+i][0], 1, ae_v_len(0,wcount-1), deidyj); - } - else - { - deidyj = -t*network->nwbuf.ptr.p_double[i]*network->nwbuf.ptr.p_double[j]/ae_sqr(s, _state); - ae_v_addd(&rdy.ptr.pp_double[ntotal-nout+i][0], 1, &ry.ptr.pp_double[ntotal-nout+j][0], 1, ae_v_len(0,wcount-1), deidyj); - } - } - } - } - else - { - - /* - * For a softmax + squared error we have expression - * far beyond human imagination so we don't even try - * to comment on it. Just enjoy the code... - * - * P.S. That's why "natural error" is called "natural" - - * compact beautiful expressions, fast code.... - */ - mx = network->neurons.ptr.p_double[ntotal-nout]; - for(i=0; i<=nout-1; i++) - { - mx = ae_maxreal(mx, network->neurons.ptr.p_double[ntotal-nout+i], _state); - } - s = 0; - s2 = 0; - for(i=0; i<=nout-1; i++) - { - network->nwbuf.ptr.p_double[i] = ae_exp(network->neurons.ptr.p_double[ntotal-nout+i]-mx, _state); - s = s+network->nwbuf.ptr.p_double[i]; - s2 = s2+ae_sqr(network->nwbuf.ptr.p_double[i], _state); - } - q = 0; - for(i=0; i<=nout-1; i++) - { - q = q+(network->y.ptr.p_double[i]-desiredy.ptr.p_double[i])*network->nwbuf.ptr.p_double[i]; - } - for(i=0; i<=nout-1; i++) - { - z = -q+(network->y.ptr.p_double[i]-desiredy.ptr.p_double[i])*s; - expi = network->nwbuf.ptr.p_double[i]; - for(j=0; j<=nout-1; j++) - { - expj = network->nwbuf.ptr.p_double[j]; - if( j==i ) - { - deidyj = expi/ae_sqr(s, _state)*((z+expi)*(s-2*expi)/s+expi*s2/ae_sqr(s, _state)); - } - else - { - deidyj = expi*expj/ae_sqr(s, _state)*(s2/ae_sqr(s, _state)-2*z/s-(expi+expj)/s+(network->y.ptr.p_double[i]-desiredy.ptr.p_double[i])-(network->y.ptr.p_double[j]-desiredy.ptr.p_double[j])); - } - ae_v_addd(&rdy.ptr.pp_double[ntotal-nout+i][0], 1, &ry.ptr.pp_double[ntotal-nout+j][0], 1, ae_v_len(0,wcount-1), deidyj); - } - } - } - } - - /* - * Hessian. Backward pass of the R-algorithm - * - * Stage 2. Process. - */ - for(i=ntotal-1; i>=0; i--) - { - - /* - * Possible variants: - * 1. Activation function - * 2. Adaptive summator - * 3. Special neuron - */ - offs = istart+i*mlpbase_nfieldwidth; - if( network->structinfo.ptr.p_int[offs+0]>0||network->structinfo.ptr.p_int[offs+0]==-5 ) - { - n1 = network->structinfo.ptr.p_int[offs+2]; - - /* - * First, calculate R(dE/dX). - */ - mlpactivationfunction(network->neurons.ptr.p_double[n1], network->structinfo.ptr.p_int[offs+0], &f, &df, &d2f, _state); - v = d2f*network->derror.ptr.p_double[i]; - ae_v_moved(&rdx.ptr.pp_double[i][0], 1, &rdy.ptr.pp_double[i][0], 1, ae_v_len(0,wcount-1), df); - ae_v_addd(&rdx.ptr.pp_double[i][0], 1, &rx.ptr.pp_double[i][0], 1, ae_v_len(0,wcount-1), v); - - /* - * No R(dE/dWij) is needed since weight of activation neuron - * is fixed to 1. - * - * So we can update R(dE/dY) for the connected neuron. - * (note that Vij=0, Wij=1) - */ - ae_v_add(&rdy.ptr.pp_double[n1][0], 1, &rdx.ptr.pp_double[i][0], 1, ae_v_len(0,wcount-1)); - continue; - } - if( network->structinfo.ptr.p_int[offs+0]==0 ) - { - - /* - * Adaptive summator - */ - n1 = network->structinfo.ptr.p_int[offs+2]; - n2 = n1+network->structinfo.ptr.p_int[offs+1]-1; - w1 = network->structinfo.ptr.p_int[offs+3]; - w2 = w1+network->structinfo.ptr.p_int[offs+1]-1; - - /* - * First, calculate R(dE/dX). - */ - ae_v_move(&rdx.ptr.pp_double[i][0], 1, &rdy.ptr.pp_double[i][0], 1, ae_v_len(0,wcount-1)); - - /* - * Then, calculate R(dE/dWij) - */ - for(j=w1; j<=w2; j++) - { - v = network->neurons.ptr.p_double[n1+j-w1]; - ae_v_addd(&h->ptr.pp_double[j][0], 1, &rdx.ptr.pp_double[i][0], 1, ae_v_len(0,wcount-1), v); - v = network->derror.ptr.p_double[i]; - ae_v_addd(&h->ptr.pp_double[j][0], 1, &ry.ptr.pp_double[n1+j-w1][0], 1, ae_v_len(0,wcount-1), v); - } - - /* - * And finally, update R(dE/dY) for connected neurons. - */ - for(j=w1; j<=w2; j++) - { - v = network->weights.ptr.p_double[j]; - ae_v_addd(&rdy.ptr.pp_double[n1+j-w1][0], 1, &rdx.ptr.pp_double[i][0], 1, ae_v_len(0,wcount-1), v); - rdy.ptr.pp_double[n1+j-w1][j] = rdy.ptr.pp_double[n1+j-w1][j]+network->derror.ptr.p_double[i]; - } - continue; - } - if( network->structinfo.ptr.p_int[offs+0]<0 ) - { - bflag = ae_false; - if( (network->structinfo.ptr.p_int[offs+0]==-2||network->structinfo.ptr.p_int[offs+0]==-3)||network->structinfo.ptr.p_int[offs+0]==-4 ) - { - - /* - * Special neuron type, no back-propagation required - */ - bflag = ae_true; - } - ae_assert(bflag, "MLPHessianNBatch: unknown neuron type!", _state); - continue; - } - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Internal subroutine - -Network must be processed by MLPProcess on X -*************************************************************************/ -static void mlpbase_mlpinternalcalculategradient(multilayerperceptron* network, - /* Real */ ae_vector* neurons, - /* Real */ ae_vector* weights, - /* Real */ ae_vector* derror, - /* Real */ ae_vector* grad, - ae_bool naturalerrorfunc, - ae_state *_state) -{ - ae_int_t i; - ae_int_t n1; - ae_int_t n2; - ae_int_t w1; - ae_int_t w2; - ae_int_t ntotal; - ae_int_t istart; - ae_int_t nin; - ae_int_t nout; - ae_int_t offs; - double dedf; - double dfdnet; - double v; - double fown; - double deown; - double net; - double mx; - ae_bool bflag; - - - - /* - * Read network geometry - */ - nin = network->structinfo.ptr.p_int[1]; - nout = network->structinfo.ptr.p_int[2]; - ntotal = network->structinfo.ptr.p_int[3]; - istart = network->structinfo.ptr.p_int[5]; - - /* - * Pre-processing of dError/dOut: - * from dError/dOut(normalized) to dError/dOut(non-normalized) - */ - ae_assert(network->structinfo.ptr.p_int[6]==0||network->structinfo.ptr.p_int[6]==1, "MLPInternalCalculateGradient: unknown normalization type!", _state); - if( network->structinfo.ptr.p_int[6]==1 ) - { - - /* - * Softmax - */ - if( !naturalerrorfunc ) - { - mx = network->neurons.ptr.p_double[ntotal-nout]; - for(i=0; i<=nout-1; i++) - { - mx = ae_maxreal(mx, network->neurons.ptr.p_double[ntotal-nout+i], _state); - } - net = 0; - for(i=0; i<=nout-1; i++) - { - network->nwbuf.ptr.p_double[i] = ae_exp(network->neurons.ptr.p_double[ntotal-nout+i]-mx, _state); - net = net+network->nwbuf.ptr.p_double[i]; - } - v = ae_v_dotproduct(&network->derror.ptr.p_double[ntotal-nout], 1, &network->nwbuf.ptr.p_double[0], 1, ae_v_len(ntotal-nout,ntotal-1)); - for(i=0; i<=nout-1; i++) - { - fown = network->nwbuf.ptr.p_double[i]; - deown = network->derror.ptr.p_double[ntotal-nout+i]; - network->nwbuf.ptr.p_double[nout+i] = (-v+deown*fown+deown*(net-fown))*fown/ae_sqr(net, _state); - } - for(i=0; i<=nout-1; i++) - { - network->derror.ptr.p_double[ntotal-nout+i] = network->nwbuf.ptr.p_double[nout+i]; - } - } - } - else - { - - /* - * Un-standardisation - */ - for(i=0; i<=nout-1; i++) - { - network->derror.ptr.p_double[ntotal-nout+i] = network->derror.ptr.p_double[ntotal-nout+i]*network->columnsigmas.ptr.p_double[nin+i]; - } - } - - /* - * Backpropagation - */ - for(i=ntotal-1; i>=0; i--) - { - - /* - * Extract info - */ - offs = istart+i*mlpbase_nfieldwidth; - if( network->structinfo.ptr.p_int[offs+0]>0||network->structinfo.ptr.p_int[offs+0]==-5 ) - { - - /* - * Activation function - */ - dedf = network->derror.ptr.p_double[i]; - dfdnet = network->dfdnet.ptr.p_double[i]; - derror->ptr.p_double[network->structinfo.ptr.p_int[offs+2]] = derror->ptr.p_double[network->structinfo.ptr.p_int[offs+2]]+dedf*dfdnet; - continue; - } - if( network->structinfo.ptr.p_int[offs+0]==0 ) - { - - /* - * Adaptive summator - */ - n1 = network->structinfo.ptr.p_int[offs+2]; - n2 = n1+network->structinfo.ptr.p_int[offs+1]-1; - w1 = network->structinfo.ptr.p_int[offs+3]; - w2 = w1+network->structinfo.ptr.p_int[offs+1]-1; - dedf = network->derror.ptr.p_double[i]; - dfdnet = 1.0; - v = dedf*dfdnet; - ae_v_moved(&grad->ptr.p_double[w1], 1, &neurons->ptr.p_double[n1], 1, ae_v_len(w1,w2), v); - ae_v_addd(&derror->ptr.p_double[n1], 1, &weights->ptr.p_double[w1], 1, ae_v_len(n1,n2), v); - continue; - } - if( network->structinfo.ptr.p_int[offs+0]<0 ) - { - bflag = ae_false; - if( (network->structinfo.ptr.p_int[offs+0]==-2||network->structinfo.ptr.p_int[offs+0]==-3)||network->structinfo.ptr.p_int[offs+0]==-4 ) - { - - /* - * Special neuron type, no back-propagation required - */ - bflag = ae_true; - } - ae_assert(bflag, "MLPInternalCalculateGradient: unknown neuron type!", _state); - continue; - } - } -} - - -static void mlpbase_mlpchunkedgradient(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t cstart, - ae_int_t csize, - /* Real */ ae_vector* batch4buf, - /* Real */ ae_vector* hpcbuf, - double* e, - ae_bool naturalerrorfunc, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t kl; - ae_int_t ntotal; - ae_int_t nin; - ae_int_t nout; - ae_int_t offs; - double f; - double df; - double d2f; - double v; - double vv; - double s; - double fown; - double deown; - ae_bool bflag; - ae_int_t istart; - ae_int_t entrysize; - ae_int_t dfoffs; - ae_int_t derroroffs; - ae_int_t entryoffs; - ae_int_t neuronidx; - ae_int_t srcentryoffs; - ae_int_t srcneuronidx; - ae_int_t srcweightidx; - ae_int_t neurontype; - ae_int_t nweights; - ae_int_t offs0; - ae_int_t offs1; - ae_int_t offs2; - double v0; - double v1; - double v2; - double v3; - double s0; - double s1; - double s2; - double s3; - ae_int_t chunksize; - - - chunksize = 4; - ae_assert(csize<=chunksize, "MLPChunkedGradient: internal error (CSize>ChunkSize)", _state); - - /* - * Try to use HPC core, if possible - */ - if( hpcchunkedgradient(&network->weights, &network->structinfo, &network->columnmeans, &network->columnsigmas, xy, cstart, csize, batch4buf, hpcbuf, e, naturalerrorfunc, _state) ) - { - return; - } - - /* - * Read network geometry, prepare data - */ - nin = network->structinfo.ptr.p_int[1]; - nout = network->structinfo.ptr.p_int[2]; - ntotal = network->structinfo.ptr.p_int[3]; - istart = network->structinfo.ptr.p_int[5]; - entrysize = 12; - dfoffs = 4; - derroroffs = 8; - - /* - * Fill Batch4Buf by zeros. - * - * THIS STAGE IS VERY IMPORTANT! - * - * We fill all components of entry - neuron values, dF/dNET, dError/dF. - * It allows us to easily handle situations when CSizeptr.p_double[i] = 0; - } - - /* - * Forward pass: - * 1. Load data into Batch4Buf. If CSizecolumnsigmas.ptr.p_double[i],0) ) - { - batch4buf->ptr.p_double[entryoffs+j] = (xy->ptr.pp_double[cstart+j][i]-network->columnmeans.ptr.p_double[i])/network->columnsigmas.ptr.p_double[i]; - } - else - { - batch4buf->ptr.p_double[entryoffs+j] = xy->ptr.pp_double[cstart+j][i]-network->columnmeans.ptr.p_double[i]; - } - } - } - for(neuronidx=0; neuronidx<=ntotal-1; neuronidx++) - { - entryoffs = entrysize*neuronidx; - offs = istart+neuronidx*mlpbase_nfieldwidth; - neurontype = network->structinfo.ptr.p_int[offs+0]; - if( neurontype>0||neurontype==-5 ) - { - - /* - * "activation function" neuron, which takes value of neuron SrcNeuronIdx - * and applies activation function to it. - * - * This neuron has no weights and no tunable parameters. - */ - srcneuronidx = network->structinfo.ptr.p_int[offs+2]; - srcentryoffs = entrysize*srcneuronidx; - mlpactivationfunction(batch4buf->ptr.p_double[srcentryoffs+0], neurontype, &f, &df, &d2f, _state); - batch4buf->ptr.p_double[entryoffs+0] = f; - batch4buf->ptr.p_double[entryoffs+0+dfoffs] = df; - mlpactivationfunction(batch4buf->ptr.p_double[srcentryoffs+1], neurontype, &f, &df, &d2f, _state); - batch4buf->ptr.p_double[entryoffs+1] = f; - batch4buf->ptr.p_double[entryoffs+1+dfoffs] = df; - mlpactivationfunction(batch4buf->ptr.p_double[srcentryoffs+2], neurontype, &f, &df, &d2f, _state); - batch4buf->ptr.p_double[entryoffs+2] = f; - batch4buf->ptr.p_double[entryoffs+2+dfoffs] = df; - mlpactivationfunction(batch4buf->ptr.p_double[srcentryoffs+3], neurontype, &f, &df, &d2f, _state); - batch4buf->ptr.p_double[entryoffs+3] = f; - batch4buf->ptr.p_double[entryoffs+3+dfoffs] = df; - continue; - } - if( neurontype==0 ) - { - - /* - * "adaptive summator" neuron, whose output is a weighted sum of inputs. - * It has weights, but has no activation function. - */ - nweights = network->structinfo.ptr.p_int[offs+1]; - srcneuronidx = network->structinfo.ptr.p_int[offs+2]; - srcentryoffs = entrysize*srcneuronidx; - srcweightidx = network->structinfo.ptr.p_int[offs+3]; - v0 = 0; - v1 = 0; - v2 = 0; - v3 = 0; - for(j=0; j<=nweights-1; j++) - { - v = network->weights.ptr.p_double[srcweightidx]; - srcweightidx = srcweightidx+1; - v0 = v0+v*batch4buf->ptr.p_double[srcentryoffs+0]; - v1 = v1+v*batch4buf->ptr.p_double[srcentryoffs+1]; - v2 = v2+v*batch4buf->ptr.p_double[srcentryoffs+2]; - v3 = v3+v*batch4buf->ptr.p_double[srcentryoffs+3]; - srcentryoffs = srcentryoffs+entrysize; - } - batch4buf->ptr.p_double[entryoffs+0] = v0; - batch4buf->ptr.p_double[entryoffs+1] = v1; - batch4buf->ptr.p_double[entryoffs+2] = v2; - batch4buf->ptr.p_double[entryoffs+3] = v3; - batch4buf->ptr.p_double[entryoffs+0+dfoffs] = 1; - batch4buf->ptr.p_double[entryoffs+1+dfoffs] = 1; - batch4buf->ptr.p_double[entryoffs+2+dfoffs] = 1; - batch4buf->ptr.p_double[entryoffs+3+dfoffs] = 1; - continue; - } - if( neurontype<0 ) - { - bflag = ae_false; - if( neurontype==-2 ) - { - - /* - * Input neuron, left unchanged - */ - bflag = ae_true; - } - if( neurontype==-3 ) - { - - /* - * "-1" neuron - */ - batch4buf->ptr.p_double[entryoffs+0] = -1; - batch4buf->ptr.p_double[entryoffs+1] = -1; - batch4buf->ptr.p_double[entryoffs+2] = -1; - batch4buf->ptr.p_double[entryoffs+3] = -1; - batch4buf->ptr.p_double[entryoffs+0+dfoffs] = 0; - batch4buf->ptr.p_double[entryoffs+1+dfoffs] = 0; - batch4buf->ptr.p_double[entryoffs+2+dfoffs] = 0; - batch4buf->ptr.p_double[entryoffs+3+dfoffs] = 0; - bflag = ae_true; - } - if( neurontype==-4 ) - { - - /* - * "0" neuron - */ - batch4buf->ptr.p_double[entryoffs+0] = 0; - batch4buf->ptr.p_double[entryoffs+1] = 0; - batch4buf->ptr.p_double[entryoffs+2] = 0; - batch4buf->ptr.p_double[entryoffs+3] = 0; - batch4buf->ptr.p_double[entryoffs+0+dfoffs] = 0; - batch4buf->ptr.p_double[entryoffs+1+dfoffs] = 0; - batch4buf->ptr.p_double[entryoffs+2+dfoffs] = 0; - batch4buf->ptr.p_double[entryoffs+3+dfoffs] = 0; - bflag = ae_true; - } - ae_assert(bflag, "MLPChunkedGradient: internal error - unknown neuron type!", _state); - continue; - } - } - - /* - * Intermediate phase between forward and backward passes. - * - * For regression networks: - * * forward pass is completely done (no additional post-processing is - * needed). - * * before starting backward pass, we have to calculate dError/dOut - * for output neurons. We also update error at this phase. - * - * For classification networks: - * * in addition to forward pass we apply SOFTMAX normalization to - * output neurons. - * * after applying normalization, we have to calculate dError/dOut, - * which is calculated in two steps: - * * first, we calculate derivative of error with respect to SOFTMAX - * normalized outputs (normalized dError) - * * then, we calculate derivative of error with respect to values - * of outputs BEFORE normalization was applied to them - */ - ae_assert(network->structinfo.ptr.p_int[6]==0||network->structinfo.ptr.p_int[6]==1, "MLPChunkedGradient: unknown normalization type!", _state); - if( network->structinfo.ptr.p_int[6]==1 ) - { - - /* - * SOFTMAX-normalized network. - * - * First, calculate (V0,V1,V2,V3) - component-wise maximum - * of output neurons. This vector of maximum values will be - * used for normalization of outputs prior to calculating - * exponentials. - * - * NOTE: the only purpose of this stage is to prevent overflow - * during calculation of exponentials. With this stage - * we make sure that all exponentials are calculated - * with non-positive argument. If you load (0,0,0,0) to - * (V0,V1,V2,V3), your program will continue working - - * although with less robustness. - */ - entryoffs = entrysize*(ntotal-nout); - v0 = batch4buf->ptr.p_double[entryoffs+0]; - v1 = batch4buf->ptr.p_double[entryoffs+1]; - v2 = batch4buf->ptr.p_double[entryoffs+2]; - v3 = batch4buf->ptr.p_double[entryoffs+3]; - entryoffs = entryoffs+entrysize; - for(i=1; i<=nout-1; i++) - { - v = batch4buf->ptr.p_double[entryoffs+0]; - if( v>v0 ) - { - v0 = v; - } - v = batch4buf->ptr.p_double[entryoffs+1]; - if( v>v1 ) - { - v1 = v; - } - v = batch4buf->ptr.p_double[entryoffs+2]; - if( v>v2 ) - { - v2 = v; - } - v = batch4buf->ptr.p_double[entryoffs+3]; - if( v>v3 ) - { - v3 = v; - } - entryoffs = entryoffs+entrysize; - } - - /* - * Then, calculate exponentials and place them to part of the - * array which is located past the last entry. We also - * calculate sum of exponentials which will be stored past the - * exponentials. - */ - entryoffs = entrysize*(ntotal-nout); - offs0 = entrysize*ntotal; - s0 = 0; - s1 = 0; - s2 = 0; - s3 = 0; - for(i=0; i<=nout-1; i++) - { - v = ae_exp(batch4buf->ptr.p_double[entryoffs+0]-v0, _state); - s0 = s0+v; - batch4buf->ptr.p_double[offs0+0] = v; - v = ae_exp(batch4buf->ptr.p_double[entryoffs+1]-v1, _state); - s1 = s1+v; - batch4buf->ptr.p_double[offs0+1] = v; - v = ae_exp(batch4buf->ptr.p_double[entryoffs+2]-v2, _state); - s2 = s2+v; - batch4buf->ptr.p_double[offs0+2] = v; - v = ae_exp(batch4buf->ptr.p_double[entryoffs+3]-v3, _state); - s3 = s3+v; - batch4buf->ptr.p_double[offs0+3] = v; - entryoffs = entryoffs+entrysize; - offs0 = offs0+chunksize; - } - offs0 = entrysize*ntotal+2*nout*chunksize; - batch4buf->ptr.p_double[offs0+0] = s0; - batch4buf->ptr.p_double[offs0+1] = s1; - batch4buf->ptr.p_double[offs0+2] = s2; - batch4buf->ptr.p_double[offs0+3] = s3; - - /* - * Now we have: - * * Batch4Buf[0...EntrySize*NTotal-1] stores: - * * NTotal*ChunkSize neuron output values (SOFTMAX normalization - * was not applied to these values), - * * NTotal*ChunkSize values of dF/dNET (derivative of neuron - * output with respect to its input) - * * NTotal*ChunkSize zeros in the elements which correspond to - * dError/dOut (derivative of error with respect to neuron output). - * * Batch4Buf[EntrySize*NTotal...EntrySize*NTotal+ChunkSize*NOut-1] - - * stores exponentials of last NOut neurons. - * * Batch4Buf[EntrySize*NTotal+ChunkSize*NOut-1...EntrySize*NTotal+ChunkSize*2*NOut-1] - * - can be used for temporary calculations - * * Batch4Buf[EntrySize*NTotal+ChunkSize*2*NOut...EntrySize*NTotal+ChunkSize*2*NOut+ChunkSize-1] - * - stores sum-of-exponentials - * - * Block below calculates derivatives of error function with respect - * to non-SOFTMAX-normalized output values of last NOut neurons. - * - * It is quite complicated; we do not describe algebra behind it, - * but if you want you may check it yourself :) - */ - if( naturalerrorfunc ) - { - - /* - * Calculate derivative of error with respect to values of - * output neurons PRIOR TO SOFTMAX NORMALIZATION. Because we - * use natural error function (cross-entropy), we can do so - * very easy. - */ - offs0 = entrysize*ntotal+2*nout*chunksize; - for(k=0; k<=csize-1; k++) - { - s = batch4buf->ptr.p_double[offs0+k]; - kl = ae_round(xy->ptr.pp_double[cstart+k][nin], _state); - offs1 = (ntotal-nout)*entrysize+derroroffs+k; - offs2 = entrysize*ntotal+k; - for(i=0; i<=nout-1; i++) - { - if( i==kl ) - { - v = 1; - } - else - { - v = 0; - } - vv = batch4buf->ptr.p_double[offs2]; - batch4buf->ptr.p_double[offs1] = vv/s-v; - *e = *e+mlpbase_safecrossentropy(v, vv/s, _state); - offs1 = offs1+entrysize; - offs2 = offs2+chunksize; - } - } - } - else - { - - /* - * SOFTMAX normalization makes things very difficult. - * Sorry, we do not dare to describe this esoteric math - * in details. - */ - offs0 = entrysize*ntotal+chunksize*2*nout; - for(k=0; k<=csize-1; k++) - { - s = batch4buf->ptr.p_double[offs0+k]; - kl = ae_round(xy->ptr.pp_double[cstart+k][nin], _state); - vv = 0; - offs1 = entrysize*ntotal+k; - offs2 = entrysize*ntotal+nout*chunksize+k; - for(i=0; i<=nout-1; i++) - { - fown = batch4buf->ptr.p_double[offs1]; - if( i==kl ) - { - deown = fown/s-1; - } - else - { - deown = fown/s; - } - batch4buf->ptr.p_double[offs2] = deown; - vv = vv+deown*fown; - *e = *e+deown*deown/2; - offs1 = offs1+chunksize; - offs2 = offs2+chunksize; - } - offs1 = entrysize*ntotal+k; - offs2 = entrysize*ntotal+nout*chunksize+k; - for(i=0; i<=nout-1; i++) - { - fown = batch4buf->ptr.p_double[offs1]; - deown = batch4buf->ptr.p_double[offs2]; - batch4buf->ptr.p_double[(ntotal-nout+i)*entrysize+derroroffs+k] = (-vv+deown*fown+deown*(s-fown))*fown/ae_sqr(s, _state); - offs1 = offs1+chunksize; - offs2 = offs2+chunksize; - } - } - } - } - else - { - - /* - * Regression network with sum-of-squares function. - * - * For each NOut of last neurons: - * * calculate difference between actual and desired output - * * calculate dError/dOut for this neuron (proportional to difference) - * * store in in last 4 components of entry (these values are used - * to start backpropagation) - * * update error - */ - for(i=0; i<=nout-1; i++) - { - v0 = network->columnsigmas.ptr.p_double[nin+i]; - v1 = network->columnmeans.ptr.p_double[nin+i]; - entryoffs = entrysize*(ntotal-nout+i); - offs0 = entryoffs; - offs1 = entryoffs+derroroffs; - for(j=0; j<=csize-1; j++) - { - v = batch4buf->ptr.p_double[offs0+j]*v0+v1-xy->ptr.pp_double[cstart+j][nin+i]; - batch4buf->ptr.p_double[offs1+j] = v*v0; - *e = *e+v*v/2; - } - } - } - - /* - * Backpropagation - */ - for(neuronidx=ntotal-1; neuronidx>=0; neuronidx--) - { - entryoffs = entrysize*neuronidx; - offs = istart+neuronidx*mlpbase_nfieldwidth; - neurontype = network->structinfo.ptr.p_int[offs+0]; - if( neurontype>0||neurontype==-5 ) - { - - /* - * Activation function - */ - srcneuronidx = network->structinfo.ptr.p_int[offs+2]; - srcentryoffs = entrysize*srcneuronidx; - offs0 = srcentryoffs+derroroffs; - offs1 = entryoffs+derroroffs; - offs2 = entryoffs+dfoffs; - batch4buf->ptr.p_double[offs0+0] = batch4buf->ptr.p_double[offs0+0]+batch4buf->ptr.p_double[offs1+0]*batch4buf->ptr.p_double[offs2+0]; - batch4buf->ptr.p_double[offs0+1] = batch4buf->ptr.p_double[offs0+1]+batch4buf->ptr.p_double[offs1+1]*batch4buf->ptr.p_double[offs2+1]; - batch4buf->ptr.p_double[offs0+2] = batch4buf->ptr.p_double[offs0+2]+batch4buf->ptr.p_double[offs1+2]*batch4buf->ptr.p_double[offs2+2]; - batch4buf->ptr.p_double[offs0+3] = batch4buf->ptr.p_double[offs0+3]+batch4buf->ptr.p_double[offs1+3]*batch4buf->ptr.p_double[offs2+3]; - continue; - } - if( neurontype==0 ) - { - - /* - * Adaptive summator - */ - nweights = network->structinfo.ptr.p_int[offs+1]; - srcneuronidx = network->structinfo.ptr.p_int[offs+2]; - srcentryoffs = entrysize*srcneuronidx; - srcweightidx = network->structinfo.ptr.p_int[offs+3]; - v0 = batch4buf->ptr.p_double[entryoffs+derroroffs+0]; - v1 = batch4buf->ptr.p_double[entryoffs+derroroffs+1]; - v2 = batch4buf->ptr.p_double[entryoffs+derroroffs+2]; - v3 = batch4buf->ptr.p_double[entryoffs+derroroffs+3]; - for(j=0; j<=nweights-1; j++) - { - offs0 = srcentryoffs; - offs1 = srcentryoffs+derroroffs; - v = network->weights.ptr.p_double[srcweightidx]; - hpcbuf->ptr.p_double[srcweightidx] = hpcbuf->ptr.p_double[srcweightidx]+batch4buf->ptr.p_double[offs0+0]*v0+batch4buf->ptr.p_double[offs0+1]*v1+batch4buf->ptr.p_double[offs0+2]*v2+batch4buf->ptr.p_double[offs0+3]*v3; - batch4buf->ptr.p_double[offs1+0] = batch4buf->ptr.p_double[offs1+0]+v*v0; - batch4buf->ptr.p_double[offs1+1] = batch4buf->ptr.p_double[offs1+1]+v*v1; - batch4buf->ptr.p_double[offs1+2] = batch4buf->ptr.p_double[offs1+2]+v*v2; - batch4buf->ptr.p_double[offs1+3] = batch4buf->ptr.p_double[offs1+3]+v*v3; - srcentryoffs = srcentryoffs+entrysize; - srcweightidx = srcweightidx+1; - } - continue; - } - if( neurontype<0 ) - { - bflag = ae_false; - if( (neurontype==-2||neurontype==-3)||neurontype==-4 ) - { - - /* - * Special neuron type, no back-propagation required - */ - bflag = ae_true; - } - ae_assert(bflag, "MLPInternalCalculateGradient: unknown neuron type!", _state); - continue; - } - } -} - - -static void mlpbase_mlpchunkedprocess(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t cstart, - ae_int_t csize, - /* Real */ ae_vector* batch4buf, - /* Real */ ae_vector* hpcbuf, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t ntotal; - ae_int_t nin; - ae_int_t nout; - ae_int_t offs; - double f; - double df; - double d2f; - double v; - ae_bool bflag; - ae_int_t istart; - ae_int_t entrysize; - ae_int_t entryoffs; - ae_int_t neuronidx; - ae_int_t srcentryoffs; - ae_int_t srcneuronidx; - ae_int_t srcweightidx; - ae_int_t neurontype; - ae_int_t nweights; - ae_int_t offs0; - double v0; - double v1; - double v2; - double v3; - double s0; - double s1; - double s2; - double s3; - ae_int_t chunksize; - - - chunksize = 4; - ae_assert(csize<=chunksize, "MLPChunkedProcess: internal error (CSize>ChunkSize)", _state); - - /* - * Try to use HPC core, if possible - */ - if( hpcchunkedprocess(&network->weights, &network->structinfo, &network->columnmeans, &network->columnsigmas, xy, cstart, csize, batch4buf, hpcbuf, _state) ) - { - return; - } - - /* - * Read network geometry, prepare data - */ - nin = network->structinfo.ptr.p_int[1]; - nout = network->structinfo.ptr.p_int[2]; - ntotal = network->structinfo.ptr.p_int[3]; - istart = network->structinfo.ptr.p_int[5]; - entrysize = 4; - - /* - * Fill Batch4Buf by zeros. - * - * THIS STAGE IS VERY IMPORTANT! - * - * We fill all components of entry - neuron values, dF/dNET, dError/dF. - * It allows us to easily handle situations when CSizeptr.p_double[i] = 0; - } - - /* - * Forward pass: - * 1. Load data into Batch4Buf. If CSizecolumnsigmas.ptr.p_double[i],0) ) - { - batch4buf->ptr.p_double[entryoffs+j] = (xy->ptr.pp_double[cstart+j][i]-network->columnmeans.ptr.p_double[i])/network->columnsigmas.ptr.p_double[i]; - } - else - { - batch4buf->ptr.p_double[entryoffs+j] = xy->ptr.pp_double[cstart+j][i]-network->columnmeans.ptr.p_double[i]; - } - } - } - for(neuronidx=0; neuronidx<=ntotal-1; neuronidx++) - { - entryoffs = entrysize*neuronidx; - offs = istart+neuronidx*mlpbase_nfieldwidth; - neurontype = network->structinfo.ptr.p_int[offs+0]; - if( neurontype>0||neurontype==-5 ) - { - - /* - * "activation function" neuron, which takes value of neuron SrcNeuronIdx - * and applies activation function to it. - * - * This neuron has no weights and no tunable parameters. - */ - srcneuronidx = network->structinfo.ptr.p_int[offs+2]; - srcentryoffs = entrysize*srcneuronidx; - mlpactivationfunction(batch4buf->ptr.p_double[srcentryoffs+0], neurontype, &f, &df, &d2f, _state); - batch4buf->ptr.p_double[entryoffs+0] = f; - mlpactivationfunction(batch4buf->ptr.p_double[srcentryoffs+1], neurontype, &f, &df, &d2f, _state); - batch4buf->ptr.p_double[entryoffs+1] = f; - mlpactivationfunction(batch4buf->ptr.p_double[srcentryoffs+2], neurontype, &f, &df, &d2f, _state); - batch4buf->ptr.p_double[entryoffs+2] = f; - mlpactivationfunction(batch4buf->ptr.p_double[srcentryoffs+3], neurontype, &f, &df, &d2f, _state); - batch4buf->ptr.p_double[entryoffs+3] = f; - continue; - } - if( neurontype==0 ) - { - - /* - * "adaptive summator" neuron, whose output is a weighted sum of inputs. - * It has weights, but has no activation function. - */ - nweights = network->structinfo.ptr.p_int[offs+1]; - srcneuronidx = network->structinfo.ptr.p_int[offs+2]; - srcentryoffs = entrysize*srcneuronidx; - srcweightidx = network->structinfo.ptr.p_int[offs+3]; - v0 = 0; - v1 = 0; - v2 = 0; - v3 = 0; - for(j=0; j<=nweights-1; j++) - { - v = network->weights.ptr.p_double[srcweightidx]; - srcweightidx = srcweightidx+1; - v0 = v0+v*batch4buf->ptr.p_double[srcentryoffs+0]; - v1 = v1+v*batch4buf->ptr.p_double[srcentryoffs+1]; - v2 = v2+v*batch4buf->ptr.p_double[srcentryoffs+2]; - v3 = v3+v*batch4buf->ptr.p_double[srcentryoffs+3]; - srcentryoffs = srcentryoffs+entrysize; - } - batch4buf->ptr.p_double[entryoffs+0] = v0; - batch4buf->ptr.p_double[entryoffs+1] = v1; - batch4buf->ptr.p_double[entryoffs+2] = v2; - batch4buf->ptr.p_double[entryoffs+3] = v3; - continue; - } - if( neurontype<0 ) - { - bflag = ae_false; - if( neurontype==-2 ) - { - - /* - * Input neuron, left unchanged - */ - bflag = ae_true; - } - if( neurontype==-3 ) - { - - /* - * "-1" neuron - */ - batch4buf->ptr.p_double[entryoffs+0] = -1; - batch4buf->ptr.p_double[entryoffs+1] = -1; - batch4buf->ptr.p_double[entryoffs+2] = -1; - batch4buf->ptr.p_double[entryoffs+3] = -1; - bflag = ae_true; - } - if( neurontype==-4 ) - { - - /* - * "0" neuron - */ - batch4buf->ptr.p_double[entryoffs+0] = 0; - batch4buf->ptr.p_double[entryoffs+1] = 0; - batch4buf->ptr.p_double[entryoffs+2] = 0; - batch4buf->ptr.p_double[entryoffs+3] = 0; - bflag = ae_true; - } - ae_assert(bflag, "MLPChunkedProcess: internal error - unknown neuron type!", _state); - continue; - } - } - - /* - * SOFTMAX normalization or scaling. - */ - ae_assert(network->structinfo.ptr.p_int[6]==0||network->structinfo.ptr.p_int[6]==1, "MLPChunkedProcess: unknown normalization type!", _state); - if( network->structinfo.ptr.p_int[6]==1 ) - { - - /* - * SOFTMAX-normalized network. - * - * First, calculate (V0,V1,V2,V3) - component-wise maximum - * of output neurons. This vector of maximum values will be - * used for normalization of outputs prior to calculating - * exponentials. - * - * NOTE: the only purpose of this stage is to prevent overflow - * during calculation of exponentials. With this stage - * we make sure that all exponentials are calculated - * with non-positive argument. If you load (0,0,0,0) to - * (V0,V1,V2,V3), your program will continue working - - * although with less robustness. - */ - entryoffs = entrysize*(ntotal-nout); - v0 = batch4buf->ptr.p_double[entryoffs+0]; - v1 = batch4buf->ptr.p_double[entryoffs+1]; - v2 = batch4buf->ptr.p_double[entryoffs+2]; - v3 = batch4buf->ptr.p_double[entryoffs+3]; - entryoffs = entryoffs+entrysize; - for(i=1; i<=nout-1; i++) - { - v = batch4buf->ptr.p_double[entryoffs+0]; - if( v>v0 ) - { - v0 = v; - } - v = batch4buf->ptr.p_double[entryoffs+1]; - if( v>v1 ) - { - v1 = v; - } - v = batch4buf->ptr.p_double[entryoffs+2]; - if( v>v2 ) - { - v2 = v; - } - v = batch4buf->ptr.p_double[entryoffs+3]; - if( v>v3 ) - { - v3 = v; - } - entryoffs = entryoffs+entrysize; - } - - /* - * Then, calculate exponentials and place them to part of the - * array which is located past the last entry. We also - * calculate sum of exponentials. - */ - entryoffs = entrysize*(ntotal-nout); - offs0 = entrysize*ntotal; - s0 = 0; - s1 = 0; - s2 = 0; - s3 = 0; - for(i=0; i<=nout-1; i++) - { - v = ae_exp(batch4buf->ptr.p_double[entryoffs+0]-v0, _state); - s0 = s0+v; - batch4buf->ptr.p_double[offs0+0] = v; - v = ae_exp(batch4buf->ptr.p_double[entryoffs+1]-v1, _state); - s1 = s1+v; - batch4buf->ptr.p_double[offs0+1] = v; - v = ae_exp(batch4buf->ptr.p_double[entryoffs+2]-v2, _state); - s2 = s2+v; - batch4buf->ptr.p_double[offs0+2] = v; - v = ae_exp(batch4buf->ptr.p_double[entryoffs+3]-v3, _state); - s3 = s3+v; - batch4buf->ptr.p_double[offs0+3] = v; - entryoffs = entryoffs+entrysize; - offs0 = offs0+chunksize; - } - - /* - * Write SOFTMAX-normalized values to the output array. - */ - offs0 = entrysize*ntotal; - for(i=0; i<=nout-1; i++) - { - if( csize>0 ) - { - xy->ptr.pp_double[cstart+0][nin+i] = batch4buf->ptr.p_double[offs0+0]/s0; - } - if( csize>1 ) - { - xy->ptr.pp_double[cstart+1][nin+i] = batch4buf->ptr.p_double[offs0+1]/s1; - } - if( csize>2 ) - { - xy->ptr.pp_double[cstart+2][nin+i] = batch4buf->ptr.p_double[offs0+2]/s2; - } - if( csize>3 ) - { - xy->ptr.pp_double[cstart+3][nin+i] = batch4buf->ptr.p_double[offs0+3]/s3; - } - offs0 = offs0+chunksize; - } - } - else - { - - /* - * Regression network with sum-of-squares function. - * - * For each NOut of last neurons: - * * calculate difference between actual and desired output - * * calculate dError/dOut for this neuron (proportional to difference) - * * store in in last 4 components of entry (these values are used - * to start backpropagation) - * * update error - */ - for(i=0; i<=nout-1; i++) - { - v0 = network->columnsigmas.ptr.p_double[nin+i]; - v1 = network->columnmeans.ptr.p_double[nin+i]; - entryoffs = entrysize*(ntotal-nout+i); - for(j=0; j<=csize-1; j++) - { - xy->ptr.pp_double[cstart+j][nin+i] = batch4buf->ptr.p_double[entryoffs+j]*v0+v1; - } - } - } -} - - -/************************************************************************* -Returns T*Ln(T/Z), guarded against overflow/underflow. -Internal subroutine. -*************************************************************************/ -static double mlpbase_safecrossentropy(double t, - double z, - ae_state *_state) -{ - double r; - double result; - - - if( ae_fp_eq(t,0) ) - { - result = 0; - } - else - { - if( ae_fp_greater(ae_fabs(z, _state),1) ) - { - - /* - * Shouldn't be the case with softmax, - * but we just want to be sure. - */ - if( ae_fp_eq(t/z,0) ) - { - r = ae_minrealnumber; - } - else - { - r = t/z; - } - } - else - { - - /* - * Normal case - */ - if( ae_fp_eq(z,0)||ae_fp_greater_eq(ae_fabs(t, _state),ae_maxrealnumber*ae_fabs(z, _state)) ) - { - r = ae_maxrealnumber; - } - else - { - r = t/z; - } - } - result = t*ae_log(r, _state); - } - return result; -} - - -/************************************************************************* -This function performs backward pass of neural network randimization: -* it assumes that Network.Weights stores standard deviation of weights - (weights are not generated yet, only their deviations are present) -* it sets deviations of weights which feed NeuronIdx-th neuron to specified value -* it recursively passes to deeper neuron and modifies their weights -* it stops after encountering nonlinear neurons, linear activation function, - input neurons, "0" and "-1" neurons - - -- ALGLIB -- - Copyright 27.06.2013 by Bochkanov Sergey -*************************************************************************/ -static void mlpbase_randomizebackwardpass(multilayerperceptron* network, - ae_int_t neuronidx, - double v, - ae_state *_state) -{ - ae_int_t istart; - ae_int_t neurontype; - ae_int_t n1; - ae_int_t n2; - ae_int_t w1; - ae_int_t w2; - ae_int_t offs; - ae_int_t i; - - - istart = network->structinfo.ptr.p_int[5]; - neurontype = network->structinfo.ptr.p_int[istart+neuronidx*mlpbase_nfieldwidth+0]; - if( neurontype==-2 ) - { - - /* - * Input neuron - stop - */ - return; - } - if( neurontype==-3 ) - { - - /* - * "-1" neuron: stop - */ - return; - } - if( neurontype==-4 ) - { - - /* - * "0" neuron: stop - */ - return; - } - if( neurontype==0 ) - { - - /* - * Adaptive summator neuron: - * * modify deviations of its weights - * * recursively call this function for its inputs - */ - offs = istart+neuronidx*mlpbase_nfieldwidth; - n1 = network->structinfo.ptr.p_int[offs+2]; - n2 = n1+network->structinfo.ptr.p_int[offs+1]-1; - w1 = network->structinfo.ptr.p_int[offs+3]; - w2 = w1+network->structinfo.ptr.p_int[offs+1]-1; - for(i=w1; i<=w2; i++) - { - network->weights.ptr.p_double[i] = v; - } - for(i=n1; i<=n2; i++) - { - mlpbase_randomizebackwardpass(network, i, v, _state); - } - return; - } - if( neurontype==-5 ) - { - - /* - * Linear activation function: stop - */ - return; - } - if( neurontype>0 ) - { - - /* - * Nonlinear activation function: stop - */ - return; - } - ae_assert(ae_false, "RandomizeBackwardPass: unexpected neuron type", _state); -} - - -ae_bool _modelerrors_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - modelerrors *p = (modelerrors*)_p; - ae_touch_ptr((void*)p); - return ae_true; -} - - -ae_bool _modelerrors_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - modelerrors *dst = (modelerrors*)_dst; - modelerrors *src = (modelerrors*)_src; - dst->relclserror = src->relclserror; - dst->avgce = src->avgce; - dst->rmserror = src->rmserror; - dst->avgerror = src->avgerror; - dst->avgrelerror = src->avgrelerror; - return ae_true; -} - - -void _modelerrors_clear(void* _p) -{ - modelerrors *p = (modelerrors*)_p; - ae_touch_ptr((void*)p); -} - - -void _modelerrors_destroy(void* _p) -{ - modelerrors *p = (modelerrors*)_p; - ae_touch_ptr((void*)p); -} - - -ae_bool _smlpgrad_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - smlpgrad *p = (smlpgrad*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->g, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _smlpgrad_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - smlpgrad *dst = (smlpgrad*)_dst; - smlpgrad *src = (smlpgrad*)_src; - dst->f = src->f; - if( !ae_vector_init_copy(&dst->g, &src->g, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _smlpgrad_clear(void* _p) -{ - smlpgrad *p = (smlpgrad*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->g); -} - - -void _smlpgrad_destroy(void* _p) -{ - smlpgrad *p = (smlpgrad*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->g); -} - - -ae_bool _multilayerperceptron_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - multilayerperceptron *p = (multilayerperceptron*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->hllayersizes, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->hlconnections, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->hlneurons, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->structinfo, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->weights, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->columnmeans, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->columnsigmas, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->neurons, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->dfdnet, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->derror, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->y, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->xy, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->xyrow, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->nwbuf, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->integerbuf, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !_modelerrors_init(&p->err, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->rndbuf, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_shared_pool_init(&p->buf, _state, make_automatic) ) - return ae_false; - if( !ae_shared_pool_init(&p->gradbuf, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->dummydxy, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !_sparsematrix_init(&p->dummysxy, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->dummyidx, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_shared_pool_init(&p->dummypool, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _multilayerperceptron_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - multilayerperceptron *dst = (multilayerperceptron*)_dst; - multilayerperceptron *src = (multilayerperceptron*)_src; - dst->hlnetworktype = src->hlnetworktype; - dst->hlnormtype = src->hlnormtype; - if( !ae_vector_init_copy(&dst->hllayersizes, &src->hllayersizes, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->hlconnections, &src->hlconnections, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->hlneurons, &src->hlneurons, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->structinfo, &src->structinfo, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->weights, &src->weights, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->columnmeans, &src->columnmeans, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->columnsigmas, &src->columnsigmas, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->neurons, &src->neurons, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->dfdnet, &src->dfdnet, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->derror, &src->derror, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->y, &src->y, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->xy, &src->xy, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->xyrow, &src->xyrow, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->nwbuf, &src->nwbuf, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->integerbuf, &src->integerbuf, _state, make_automatic) ) - return ae_false; - if( !_modelerrors_init_copy(&dst->err, &src->err, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->rndbuf, &src->rndbuf, _state, make_automatic) ) - return ae_false; - if( !ae_shared_pool_init_copy(&dst->buf, &src->buf, _state, make_automatic) ) - return ae_false; - if( !ae_shared_pool_init_copy(&dst->gradbuf, &src->gradbuf, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->dummydxy, &src->dummydxy, _state, make_automatic) ) - return ae_false; - if( !_sparsematrix_init_copy(&dst->dummysxy, &src->dummysxy, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->dummyidx, &src->dummyidx, _state, make_automatic) ) - return ae_false; - if( !ae_shared_pool_init_copy(&dst->dummypool, &src->dummypool, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _multilayerperceptron_clear(void* _p) -{ - multilayerperceptron *p = (multilayerperceptron*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->hllayersizes); - ae_vector_clear(&p->hlconnections); - ae_vector_clear(&p->hlneurons); - ae_vector_clear(&p->structinfo); - ae_vector_clear(&p->weights); - ae_vector_clear(&p->columnmeans); - ae_vector_clear(&p->columnsigmas); - ae_vector_clear(&p->neurons); - ae_vector_clear(&p->dfdnet); - ae_vector_clear(&p->derror); - ae_vector_clear(&p->x); - ae_vector_clear(&p->y); - ae_matrix_clear(&p->xy); - ae_vector_clear(&p->xyrow); - ae_vector_clear(&p->nwbuf); - ae_vector_clear(&p->integerbuf); - _modelerrors_clear(&p->err); - ae_vector_clear(&p->rndbuf); - ae_shared_pool_clear(&p->buf); - ae_shared_pool_clear(&p->gradbuf); - ae_matrix_clear(&p->dummydxy); - _sparsematrix_clear(&p->dummysxy); - ae_vector_clear(&p->dummyidx); - ae_shared_pool_clear(&p->dummypool); -} - - -void _multilayerperceptron_destroy(void* _p) -{ - multilayerperceptron *p = (multilayerperceptron*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->hllayersizes); - ae_vector_destroy(&p->hlconnections); - ae_vector_destroy(&p->hlneurons); - ae_vector_destroy(&p->structinfo); - ae_vector_destroy(&p->weights); - ae_vector_destroy(&p->columnmeans); - ae_vector_destroy(&p->columnsigmas); - ae_vector_destroy(&p->neurons); - ae_vector_destroy(&p->dfdnet); - ae_vector_destroy(&p->derror); - ae_vector_destroy(&p->x); - ae_vector_destroy(&p->y); - ae_matrix_destroy(&p->xy); - ae_vector_destroy(&p->xyrow); - ae_vector_destroy(&p->nwbuf); - ae_vector_destroy(&p->integerbuf); - _modelerrors_destroy(&p->err); - ae_vector_destroy(&p->rndbuf); - ae_shared_pool_destroy(&p->buf); - ae_shared_pool_destroy(&p->gradbuf); - ae_matrix_destroy(&p->dummydxy); - _sparsematrix_destroy(&p->dummysxy); - ae_vector_destroy(&p->dummyidx); - ae_shared_pool_destroy(&p->dummypool); -} - - - - -/************************************************************************* -This subroutine trains logit model. - -INPUT PARAMETERS: - XY - training set, array[0..NPoints-1,0..NVars] - First NVars columns store values of independent - variables, next column stores number of class (from 0 - to NClasses-1) which dataset element belongs to. Fractional - values are rounded to nearest integer. - NPoints - training set size, NPoints>=1 - NVars - number of independent variables, NVars>=1 - NClasses - number of classes, NClasses>=2 - -OUTPUT PARAMETERS: - Info - return code: - * -2, if there is a point with class number - outside of [0..NClasses-1]. - * -1, if incorrect parameters was passed - (NPointsptr.pp_double[i][nvars], _state)<0||ae_round(xy->ptr.pp_double[i][nvars], _state)>=nclasses ) - { - *info = -2; - ae_frame_leave(_state); - return; - } - } - *info = 1; - - /* - * Initialize data - */ - rep->ngrad = 0; - rep->nhess = 0; - - /* - * Allocate array - */ - offs = 5; - ssize = 5+(nvars+1)*(nclasses-1)+nclasses; - ae_vector_set_length(&lm->w, ssize-1+1, _state); - lm->w.ptr.p_double[0] = ssize; - lm->w.ptr.p_double[1] = logit_logitvnum; - lm->w.ptr.p_double[2] = nvars; - lm->w.ptr.p_double[3] = nclasses; - lm->w.ptr.p_double[4] = offs; - - /* - * Degenerate case: all outputs are equal - */ - allsame = ae_true; - for(i=1; i<=npoints-1; i++) - { - if( ae_round(xy->ptr.pp_double[i][nvars], _state)!=ae_round(xy->ptr.pp_double[i-1][nvars], _state) ) - { - allsame = ae_false; - } - } - if( allsame ) - { - for(i=0; i<=(nvars+1)*(nclasses-1)-1; i++) - { - lm->w.ptr.p_double[offs+i] = 0; - } - v = -2*ae_log(ae_minrealnumber, _state); - k = ae_round(xy->ptr.pp_double[0][nvars], _state); - if( k==nclasses-1 ) - { - for(i=0; i<=nclasses-2; i++) - { - lm->w.ptr.p_double[offs+i*(nvars+1)+nvars] = -v; - } - } - else - { - for(i=0; i<=nclasses-2; i++) - { - if( i==k ) - { - lm->w.ptr.p_double[offs+i*(nvars+1)+nvars] = v; - } - else - { - lm->w.ptr.p_double[offs+i*(nvars+1)+nvars] = 0; - } - } - } - ae_frame_leave(_state); - return; - } - - /* - * General case. - * Prepare task and network. Allocate space. - */ - mlpcreatec0(nvars, nclasses, &network, _state); - mlpinitpreprocessor(&network, xy, npoints, _state); - mlpproperties(&network, &nin, &nout, &wcount, _state); - for(i=0; i<=wcount-1; i++) - { - network.weights.ptr.p_double[i] = (2*ae_randomreal(_state)-1)/nvars; - } - ae_vector_set_length(&g, wcount-1+1, _state); - ae_matrix_set_length(&h, wcount-1+1, wcount-1+1, _state); - ae_vector_set_length(&wbase, wcount-1+1, _state); - ae_vector_set_length(&wdir, wcount-1+1, _state); - ae_vector_set_length(&work, wcount-1+1, _state); - - /* - * First stage: optimize in gradient direction. - */ - for(k=0; k<=wcount/3+10; k++) - { - - /* - * Calculate gradient in starting point - */ - mlpgradnbatch(&network, xy, npoints, &e, &g, _state); - v = ae_v_dotproduct(&network.weights.ptr.p_double[0], 1, &network.weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - e = e+0.5*decay*v; - ae_v_addd(&g.ptr.p_double[0], 1, &network.weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1), decay); - rep->ngrad = rep->ngrad+1; - - /* - * Setup optimization scheme - */ - ae_v_moveneg(&wdir.ptr.p_double[0], 1, &g.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - v = ae_v_dotproduct(&wdir.ptr.p_double[0], 1, &wdir.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - wstep = ae_sqrt(v, _state); - v = 1/ae_sqrt(v, _state); - ae_v_muld(&wdir.ptr.p_double[0], 1, ae_v_len(0,wcount-1), v); - mcstage = 0; - logit_mnlmcsrch(wcount, &network.weights, &e, &g, &wdir, &wstep, &mcinfo, &mcnfev, &work, &mcstate, &mcstage, _state); - while(mcstage!=0) - { - mlpgradnbatch(&network, xy, npoints, &e, &g, _state); - v = ae_v_dotproduct(&network.weights.ptr.p_double[0], 1, &network.weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - e = e+0.5*decay*v; - ae_v_addd(&g.ptr.p_double[0], 1, &network.weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1), decay); - rep->ngrad = rep->ngrad+1; - logit_mnlmcsrch(wcount, &network.weights, &e, &g, &wdir, &wstep, &mcinfo, &mcnfev, &work, &mcstate, &mcstage, _state); - } - } - - /* - * Second stage: use Hessian when we are close to the minimum - */ - for(;;) - { - - /* - * Calculate and update E/G/H - */ - mlphessiannbatch(&network, xy, npoints, &e, &g, &h, _state); - v = ae_v_dotproduct(&network.weights.ptr.p_double[0], 1, &network.weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - e = e+0.5*decay*v; - ae_v_addd(&g.ptr.p_double[0], 1, &network.weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1), decay); - for(k=0; k<=wcount-1; k++) - { - h.ptr.pp_double[k][k] = h.ptr.pp_double[k][k]+decay; - } - rep->nhess = rep->nhess+1; - - /* - * Select step direction - * NOTE: it is important to use lower-triangle Cholesky - * factorization since it is much faster than higher-triangle version. - */ - spd = spdmatrixcholesky(&h, wcount, ae_false, _state); - spdmatrixcholeskysolve(&h, wcount, ae_false, &g, &solverinfo, &solverrep, &wdir, _state); - spd = solverinfo>0; - if( spd ) - { - - /* - * H is positive definite. - * Step in Newton direction. - */ - ae_v_muld(&wdir.ptr.p_double[0], 1, ae_v_len(0,wcount-1), -1); - spd = ae_true; - } - else - { - - /* - * H is indefinite. - * Step in gradient direction. - */ - ae_v_moveneg(&wdir.ptr.p_double[0], 1, &g.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - spd = ae_false; - } - - /* - * Optimize in WDir direction - */ - v = ae_v_dotproduct(&wdir.ptr.p_double[0], 1, &wdir.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - wstep = ae_sqrt(v, _state); - v = 1/ae_sqrt(v, _state); - ae_v_muld(&wdir.ptr.p_double[0], 1, ae_v_len(0,wcount-1), v); - mcstage = 0; - logit_mnlmcsrch(wcount, &network.weights, &e, &g, &wdir, &wstep, &mcinfo, &mcnfev, &work, &mcstate, &mcstage, _state); - while(mcstage!=0) - { - mlpgradnbatch(&network, xy, npoints, &e, &g, _state); - v = ae_v_dotproduct(&network.weights.ptr.p_double[0], 1, &network.weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - e = e+0.5*decay*v; - ae_v_addd(&g.ptr.p_double[0], 1, &network.weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1), decay); - rep->ngrad = rep->ngrad+1; - logit_mnlmcsrch(wcount, &network.weights, &e, &g, &wdir, &wstep, &mcinfo, &mcnfev, &work, &mcstate, &mcstage, _state); - } - if( spd&&((mcinfo==2||mcinfo==4)||mcinfo==6) ) - { - break; - } - } - - /* - * Convert from NN format to MNL format - */ - ae_v_move(&lm->w.ptr.p_double[offs], 1, &network.weights.ptr.p_double[0], 1, ae_v_len(offs,offs+wcount-1)); - for(k=0; k<=nvars-1; k++) - { - for(i=0; i<=nclasses-2; i++) - { - s = network.columnsigmas.ptr.p_double[k]; - if( ae_fp_eq(s,0) ) - { - s = 1; - } - j = offs+(nvars+1)*i; - v = lm->w.ptr.p_double[j+k]; - lm->w.ptr.p_double[j+k] = v/s; - lm->w.ptr.p_double[j+nvars] = lm->w.ptr.p_double[j+nvars]+v*network.columnmeans.ptr.p_double[k]/s; - } - } - for(k=0; k<=nclasses-2; k++) - { - lm->w.ptr.p_double[offs+(nvars+1)*k+nvars] = -lm->w.ptr.p_double[offs+(nvars+1)*k+nvars]; - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Procesing - -INPUT PARAMETERS: - LM - logit model, passed by non-constant reference - (some fields of structure are used as temporaries - when calculating model output). - X - input vector, array[0..NVars-1]. - Y - (possibly) preallocated buffer; if size of Y is less than - NClasses, it will be reallocated.If it is large enough, it - is NOT reallocated, so we can save some time on reallocation. - -OUTPUT PARAMETERS: - Y - result, array[0..NClasses-1] - Vector of posterior probabilities for classification task. - - -- ALGLIB -- - Copyright 10.09.2008 by Bochkanov Sergey -*************************************************************************/ -void mnlprocess(logitmodel* lm, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state) -{ - ae_int_t nvars; - ae_int_t nclasses; - ae_int_t offs; - ae_int_t i; - ae_int_t i1; - double s; - - - ae_assert(ae_fp_eq(lm->w.ptr.p_double[1],logit_logitvnum), "MNLProcess: unexpected model version", _state); - nvars = ae_round(lm->w.ptr.p_double[2], _state); - nclasses = ae_round(lm->w.ptr.p_double[3], _state); - offs = ae_round(lm->w.ptr.p_double[4], _state); - logit_mnliexp(&lm->w, x, _state); - s = 0; - i1 = offs+(nvars+1)*(nclasses-1); - for(i=i1; i<=i1+nclasses-1; i++) - { - s = s+lm->w.ptr.p_double[i]; - } - if( y->cntptr.p_double[i] = lm->w.ptr.p_double[i1+i]/s; - } -} - - -/************************************************************************* -'interactive' variant of MNLProcess for languages like Python which -support constructs like "Y = MNLProcess(LM,X)" and interactive mode of the -interpreter - -This function allocates new array on each call, so it is significantly -slower than its 'non-interactive' counterpart, but it is more convenient -when you call it from command line. - - -- ALGLIB -- - Copyright 10.09.2008 by Bochkanov Sergey -*************************************************************************/ -void mnlprocessi(logitmodel* lm, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state) -{ - - ae_vector_clear(y); - - mnlprocess(lm, x, y, _state); -} - - -/************************************************************************* -Unpacks coefficients of logit model. Logit model have form: - - P(class=i) = S(i) / (S(0) + S(1) + ... +S(M-1)) - S(i) = Exp(A[i,0]*X[0] + ... + A[i,N-1]*X[N-1] + A[i,N]), when iw.ptr.p_double[1],logit_logitvnum), "MNLUnpack: unexpected model version", _state); - *nvars = ae_round(lm->w.ptr.p_double[2], _state); - *nclasses = ae_round(lm->w.ptr.p_double[3], _state); - offs = ae_round(lm->w.ptr.p_double[4], _state); - ae_matrix_set_length(a, *nclasses-2+1, *nvars+1, _state); - for(i=0; i<=*nclasses-2; i++) - { - ae_v_move(&a->ptr.pp_double[i][0], 1, &lm->w.ptr.p_double[offs+i*(*nvars+1)], 1, ae_v_len(0,*nvars)); - } -} - - -/************************************************************************* -"Packs" coefficients and creates logit model in ALGLIB format (MNLUnpack -reversed). - -INPUT PARAMETERS: - A - model (see MNLUnpack) - NVars - number of independent variables - NClasses - number of classes - -OUTPUT PARAMETERS: - LM - logit model. - - -- ALGLIB -- - Copyright 10.09.2008 by Bochkanov Sergey -*************************************************************************/ -void mnlpack(/* Real */ ae_matrix* a, - ae_int_t nvars, - ae_int_t nclasses, - logitmodel* lm, - ae_state *_state) -{ - ae_int_t offs; - ae_int_t i; - ae_int_t ssize; - - _logitmodel_clear(lm); - - offs = 5; - ssize = 5+(nvars+1)*(nclasses-1)+nclasses; - ae_vector_set_length(&lm->w, ssize-1+1, _state); - lm->w.ptr.p_double[0] = ssize; - lm->w.ptr.p_double[1] = logit_logitvnum; - lm->w.ptr.p_double[2] = nvars; - lm->w.ptr.p_double[3] = nclasses; - lm->w.ptr.p_double[4] = offs; - for(i=0; i<=nclasses-2; i++) - { - ae_v_move(&lm->w.ptr.p_double[offs+i*(nvars+1)], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(offs+i*(nvars+1),offs+i*(nvars+1)+nvars)); - } -} - - -/************************************************************************* -Copying of LogitModel strucure - -INPUT PARAMETERS: - LM1 - original - -OUTPUT PARAMETERS: - LM2 - copy - - -- ALGLIB -- - Copyright 15.03.2009 by Bochkanov Sergey -*************************************************************************/ -void mnlcopy(logitmodel* lm1, logitmodel* lm2, ae_state *_state) -{ - ae_int_t k; - - _logitmodel_clear(lm2); - - k = ae_round(lm1->w.ptr.p_double[0], _state); - ae_vector_set_length(&lm2->w, k-1+1, _state); - ae_v_move(&lm2->w.ptr.p_double[0], 1, &lm1->w.ptr.p_double[0], 1, ae_v_len(0,k-1)); -} - - -/************************************************************************* -Average cross-entropy (in bits per element) on the test set - -INPUT PARAMETERS: - LM - logit model - XY - test set - NPoints - test set size - -RESULT: - CrossEntropy/(NPoints*ln(2)). - - -- ALGLIB -- - Copyright 10.09.2008 by Bochkanov Sergey -*************************************************************************/ -double mnlavgce(logitmodel* lm, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t nvars; - ae_int_t nclasses; - ae_int_t i; - ae_vector workx; - ae_vector worky; - double result; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&workx, 0, DT_REAL, _state, ae_true); - ae_vector_init(&worky, 0, DT_REAL, _state, ae_true); - - ae_assert(ae_fp_eq(lm->w.ptr.p_double[1],logit_logitvnum), "MNLClsError: unexpected model version", _state); - nvars = ae_round(lm->w.ptr.p_double[2], _state); - nclasses = ae_round(lm->w.ptr.p_double[3], _state); - ae_vector_set_length(&workx, nvars-1+1, _state); - ae_vector_set_length(&worky, nclasses-1+1, _state); - result = 0; - for(i=0; i<=npoints-1; i++) - { - ae_assert(ae_round(xy->ptr.pp_double[i][nvars], _state)>=0&&ae_round(xy->ptr.pp_double[i][nvars], _state)ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); - mnlprocess(lm, &workx, &worky, _state); - if( ae_fp_greater(worky.ptr.p_double[ae_round(xy->ptr.pp_double[i][nvars], _state)],0) ) - { - result = result-ae_log(worky.ptr.p_double[ae_round(xy->ptr.pp_double[i][nvars], _state)], _state); - } - else - { - result = result-ae_log(ae_minrealnumber, _state); - } - } - result = result/(npoints*ae_log(2, _state)); - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Relative classification error on the test set - -INPUT PARAMETERS: - LM - logit model - XY - test set - NPoints - test set size - -RESULT: - percent of incorrectly classified cases. - - -- ALGLIB -- - Copyright 10.09.2008 by Bochkanov Sergey -*************************************************************************/ -double mnlrelclserror(logitmodel* lm, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - double result; - - - result = (double)mnlclserror(lm, xy, npoints, _state)/(double)npoints; - return result; -} - - -/************************************************************************* -RMS error on the test set - -INPUT PARAMETERS: - LM - logit model - XY - test set - NPoints - test set size - -RESULT: - root mean square error (error when estimating posterior probabilities). - - -- ALGLIB -- - Copyright 30.08.2008 by Bochkanov Sergey -*************************************************************************/ -double mnlrmserror(logitmodel* lm, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - double relcls; - double avgce; - double rms; - double avg; - double avgrel; - double result; - - - ae_assert(ae_round(lm->w.ptr.p_double[1], _state)==logit_logitvnum, "MNLRMSError: Incorrect MNL version!", _state); - logit_mnlallerrors(lm, xy, npoints, &relcls, &avgce, &rms, &avg, &avgrel, _state); - result = rms; - return result; -} - - -/************************************************************************* -Average error on the test set - -INPUT PARAMETERS: - LM - logit model - XY - test set - NPoints - test set size - -RESULT: - average error (error when estimating posterior probabilities). - - -- ALGLIB -- - Copyright 30.08.2008 by Bochkanov Sergey -*************************************************************************/ -double mnlavgerror(logitmodel* lm, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - double relcls; - double avgce; - double rms; - double avg; - double avgrel; - double result; - - - ae_assert(ae_round(lm->w.ptr.p_double[1], _state)==logit_logitvnum, "MNLRMSError: Incorrect MNL version!", _state); - logit_mnlallerrors(lm, xy, npoints, &relcls, &avgce, &rms, &avg, &avgrel, _state); - result = avg; - return result; -} - - -/************************************************************************* -Average relative error on the test set - -INPUT PARAMETERS: - LM - logit model - XY - test set - NPoints - test set size - -RESULT: - average relative error (error when estimating posterior probabilities). - - -- ALGLIB -- - Copyright 30.08.2008 by Bochkanov Sergey -*************************************************************************/ -double mnlavgrelerror(logitmodel* lm, - /* Real */ ae_matrix* xy, - ae_int_t ssize, - ae_state *_state) -{ - double relcls; - double avgce; - double rms; - double avg; - double avgrel; - double result; - - - ae_assert(ae_round(lm->w.ptr.p_double[1], _state)==logit_logitvnum, "MNLRMSError: Incorrect MNL version!", _state); - logit_mnlallerrors(lm, xy, ssize, &relcls, &avgce, &rms, &avg, &avgrel, _state); - result = avgrel; - return result; -} - - -/************************************************************************* -Classification error on test set = MNLRelClsError*NPoints - - -- ALGLIB -- - Copyright 10.09.2008 by Bochkanov Sergey -*************************************************************************/ -ae_int_t mnlclserror(logitmodel* lm, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t nvars; - ae_int_t nclasses; - ae_int_t i; - ae_int_t j; - ae_vector workx; - ae_vector worky; - ae_int_t nmax; - ae_int_t result; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&workx, 0, DT_REAL, _state, ae_true); - ae_vector_init(&worky, 0, DT_REAL, _state, ae_true); - - ae_assert(ae_fp_eq(lm->w.ptr.p_double[1],logit_logitvnum), "MNLClsError: unexpected model version", _state); - nvars = ae_round(lm->w.ptr.p_double[2], _state); - nclasses = ae_round(lm->w.ptr.p_double[3], _state); - ae_vector_set_length(&workx, nvars-1+1, _state); - ae_vector_set_length(&worky, nclasses-1+1, _state); - result = 0; - for(i=0; i<=npoints-1; i++) - { - - /* - * Process - */ - ae_v_move(&workx.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); - mnlprocess(lm, &workx, &worky, _state); - - /* - * Logit version of the answer - */ - nmax = 0; - for(j=0; j<=nclasses-1; j++) - { - if( ae_fp_greater(worky.ptr.p_double[j],worky.ptr.p_double[nmax]) ) - { - nmax = j; - } - } - - /* - * compare - */ - if( nmax!=ae_round(xy->ptr.pp_double[i][nvars], _state) ) - { - result = result+1; - } - } - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Internal subroutine. Places exponents of the anti-overflow shifted -internal linear outputs into the service part of the W array. -*************************************************************************/ -static void logit_mnliexp(/* Real */ ae_vector* w, - /* Real */ ae_vector* x, - ae_state *_state) -{ - ae_int_t nvars; - ae_int_t nclasses; - ae_int_t offs; - ae_int_t i; - ae_int_t i1; - double v; - double mx; - - - ae_assert(ae_fp_eq(w->ptr.p_double[1],logit_logitvnum), "LOGIT: unexpected model version", _state); - nvars = ae_round(w->ptr.p_double[2], _state); - nclasses = ae_round(w->ptr.p_double[3], _state); - offs = ae_round(w->ptr.p_double[4], _state); - i1 = offs+(nvars+1)*(nclasses-1); - for(i=0; i<=nclasses-2; i++) - { - v = ae_v_dotproduct(&w->ptr.p_double[offs+i*(nvars+1)], 1, &x->ptr.p_double[0], 1, ae_v_len(offs+i*(nvars+1),offs+i*(nvars+1)+nvars-1)); - w->ptr.p_double[i1+i] = v+w->ptr.p_double[offs+i*(nvars+1)+nvars]; - } - w->ptr.p_double[i1+nclasses-1] = 0; - mx = 0; - for(i=i1; i<=i1+nclasses-1; i++) - { - mx = ae_maxreal(mx, w->ptr.p_double[i], _state); - } - for(i=i1; i<=i1+nclasses-1; i++) - { - w->ptr.p_double[i] = ae_exp(w->ptr.p_double[i]-mx, _state); - } -} - - -/************************************************************************* -Calculation of all types of errors - - -- ALGLIB -- - Copyright 30.08.2008 by Bochkanov Sergey -*************************************************************************/ -static void logit_mnlallerrors(logitmodel* lm, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - double* relcls, - double* avgce, - double* rms, - double* avg, - double* avgrel, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t nvars; - ae_int_t nclasses; - ae_int_t i; - ae_vector buf; - ae_vector workx; - ae_vector y; - ae_vector dy; - - ae_frame_make(_state, &_frame_block); - *relcls = 0; - *avgce = 0; - *rms = 0; - *avg = 0; - *avgrel = 0; - ae_vector_init(&buf, 0, DT_REAL, _state, ae_true); - ae_vector_init(&workx, 0, DT_REAL, _state, ae_true); - ae_vector_init(&y, 0, DT_REAL, _state, ae_true); - ae_vector_init(&dy, 0, DT_REAL, _state, ae_true); - - ae_assert(ae_round(lm->w.ptr.p_double[1], _state)==logit_logitvnum, "MNL unit: Incorrect MNL version!", _state); - nvars = ae_round(lm->w.ptr.p_double[2], _state); - nclasses = ae_round(lm->w.ptr.p_double[3], _state); - ae_vector_set_length(&workx, nvars-1+1, _state); - ae_vector_set_length(&y, nclasses-1+1, _state); - ae_vector_set_length(&dy, 0+1, _state); - dserrallocate(nclasses, &buf, _state); - for(i=0; i<=npoints-1; i++) - { - ae_v_move(&workx.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); - mnlprocess(lm, &workx, &y, _state); - dy.ptr.p_double[0] = xy->ptr.pp_double[i][nvars]; - dserraccumulate(&buf, &y, &dy, _state); - } - dserrfinish(&buf, _state); - *relcls = buf.ptr.p_double[0]; - *avgce = buf.ptr.p_double[1]; - *rms = buf.ptr.p_double[2]; - *avg = buf.ptr.p_double[3]; - *avgrel = buf.ptr.p_double[4]; - ae_frame_leave(_state); -} - - -/************************************************************************* -THE PURPOSE OF MCSRCH IS TO FIND A STEP WHICH SATISFIES A SUFFICIENT -DECREASE CONDITION AND A CURVATURE CONDITION. - -AT EACH STAGE THE SUBROUTINE UPDATES AN INTERVAL OF UNCERTAINTY WITH -ENDPOINTS STX AND STY. THE INTERVAL OF UNCERTAINTY IS INITIALLY CHOSEN -SO THAT IT CONTAINS A MINIMIZER OF THE MODIFIED FUNCTION - - F(X+STP*S) - F(X) - FTOL*STP*(GRADF(X)'S). - -IF A STEP IS OBTAINED FOR WHICH THE MODIFIED FUNCTION HAS A NONPOSITIVE -FUNCTION VALUE AND NONNEGATIVE DERIVATIVE, THEN THE INTERVAL OF -UNCERTAINTY IS CHOSEN SO THAT IT CONTAINS A MINIMIZER OF F(X+STP*S). - -THE ALGORITHM IS DESIGNED TO FIND A STEP WHICH SATISFIES THE SUFFICIENT -DECREASE CONDITION - - F(X+STP*S) .LE. F(X) + FTOL*STP*(GRADF(X)'S), - -AND THE CURVATURE CONDITION - - ABS(GRADF(X+STP*S)'S)) .LE. GTOL*ABS(GRADF(X)'S). - -IF FTOL IS LESS THAN GTOL AND IF, FOR EXAMPLE, THE FUNCTION IS BOUNDED -BELOW, THEN THERE IS ALWAYS A STEP WHICH SATISFIES BOTH CONDITIONS. -IF NO STEP CAN BE FOUND WHICH SATISFIES BOTH CONDITIONS, THEN THE -ALGORITHM USUALLY STOPS WHEN ROUNDING ERRORS PREVENT FURTHER PROGRESS. -IN THIS CASE STP ONLY SATISFIES THE SUFFICIENT DECREASE CONDITION. - -PARAMETERS DESCRIPRION - -N IS A POSITIVE INTEGER INPUT VARIABLE SET TO THE NUMBER OF VARIABLES. - -X IS AN ARRAY OF LENGTH N. ON INPUT IT MUST CONTAIN THE BASE POINT FOR -THE LINE SEARCH. ON OUTPUT IT CONTAINS X+STP*S. - -F IS A VARIABLE. ON INPUT IT MUST CONTAIN THE VALUE OF F AT X. ON OUTPUT -IT CONTAINS THE VALUE OF F AT X + STP*S. - -G IS AN ARRAY OF LENGTH N. ON INPUT IT MUST CONTAIN THE GRADIENT OF F AT X. -ON OUTPUT IT CONTAINS THE GRADIENT OF F AT X + STP*S. - -S IS AN INPUT ARRAY OF LENGTH N WHICH SPECIFIES THE SEARCH DIRECTION. - -STP IS A NONNEGATIVE VARIABLE. ON INPUT STP CONTAINS AN INITIAL ESTIMATE -OF A SATISFACTORY STEP. ON OUTPUT STP CONTAINS THE FINAL ESTIMATE. - -FTOL AND GTOL ARE NONNEGATIVE INPUT VARIABLES. TERMINATION OCCURS WHEN THE -SUFFICIENT DECREASE CONDITION AND THE DIRECTIONAL DERIVATIVE CONDITION ARE -SATISFIED. - -XTOL IS A NONNEGATIVE INPUT VARIABLE. TERMINATION OCCURS WHEN THE RELATIVE -WIDTH OF THE INTERVAL OF UNCERTAINTY IS AT MOST XTOL. - -STPMIN AND STPMAX ARE NONNEGATIVE INPUT VARIABLES WHICH SPECIFY LOWER AND -UPPER BOUNDS FOR THE STEP. - -MAXFEV IS A POSITIVE INTEGER INPUT VARIABLE. TERMINATION OCCURS WHEN THE -NUMBER OF CALLS TO FCN IS AT LEAST MAXFEV BY THE END OF AN ITERATION. - -INFO IS AN INTEGER OUTPUT VARIABLE SET AS FOLLOWS: - INFO = 0 IMPROPER INPUT PARAMETERS. - - INFO = 1 THE SUFFICIENT DECREASE CONDITION AND THE - DIRECTIONAL DERIVATIVE CONDITION HOLD. - - INFO = 2 RELATIVE WIDTH OF THE INTERVAL OF UNCERTAINTY - IS AT MOST XTOL. - - INFO = 3 NUMBER OF CALLS TO FCN HAS REACHED MAXFEV. - - INFO = 4 THE STEP IS AT THE LOWER BOUND STPMIN. - - INFO = 5 THE STEP IS AT THE UPPER BOUND STPMAX. - - INFO = 6 ROUNDING ERRORS PREVENT FURTHER PROGRESS. - THERE MAY NOT BE A STEP WHICH SATISFIES THE - SUFFICIENT DECREASE AND CURVATURE CONDITIONS. - TOLERANCES MAY BE TOO SMALL. - -NFEV IS AN INTEGER OUTPUT VARIABLE SET TO THE NUMBER OF CALLS TO FCN. - -WA IS A WORK ARRAY OF LENGTH N. - -ARGONNE NATIONAL LABORATORY. MINPACK PROJECT. JUNE 1983 -JORGE J. MORE', DAVID J. THUENTE -*************************************************************************/ -static void logit_mnlmcsrch(ae_int_t n, - /* Real */ ae_vector* x, - double* f, - /* Real */ ae_vector* g, - /* Real */ ae_vector* s, - double* stp, - ae_int_t* info, - ae_int_t* nfev, - /* Real */ ae_vector* wa, - logitmcstate* state, - ae_int_t* stage, - ae_state *_state) -{ - double v; - double p5; - double p66; - double zero; - - - - /* - * init - */ - p5 = 0.5; - p66 = 0.66; - state->xtrapf = 4.0; - zero = 0; - - /* - * Main cycle - */ - for(;;) - { - if( *stage==0 ) - { - - /* - * NEXT - */ - *stage = 2; - continue; - } - if( *stage==2 ) - { - state->infoc = 1; - *info = 0; - - /* - * CHECK THE INPUT PARAMETERS FOR ERRORS. - */ - if( ((((((n<=0||ae_fp_less_eq(*stp,0))||ae_fp_less(logit_ftol,0))||ae_fp_less(logit_gtol,zero))||ae_fp_less(logit_xtol,zero))||ae_fp_less(logit_stpmin,zero))||ae_fp_less(logit_stpmax,logit_stpmin))||logit_maxfev<=0 ) - { - *stage = 0; - return; - } - - /* - * COMPUTE THE INITIAL GRADIENT IN THE SEARCH DIRECTION - * AND CHECK THAT S IS A DESCENT DIRECTION. - */ - v = ae_v_dotproduct(&g->ptr.p_double[0], 1, &s->ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->dginit = v; - if( ae_fp_greater_eq(state->dginit,0) ) - { - *stage = 0; - return; - } - - /* - * INITIALIZE LOCAL VARIABLES. - */ - state->brackt = ae_false; - state->stage1 = ae_true; - *nfev = 0; - state->finit = *f; - state->dgtest = logit_ftol*state->dginit; - state->width = logit_stpmax-logit_stpmin; - state->width1 = state->width/p5; - ae_v_move(&wa->ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,n-1)); - - /* - * THE VARIABLES STX, FX, DGX CONTAIN THE VALUES OF THE STEP, - * FUNCTION, AND DIRECTIONAL DERIVATIVE AT THE BEST STEP. - * THE VARIABLES STY, FY, DGY CONTAIN THE VALUE OF THE STEP, - * FUNCTION, AND DERIVATIVE AT THE OTHER ENDPOINT OF - * THE INTERVAL OF UNCERTAINTY. - * THE VARIABLES STP, F, DG CONTAIN THE VALUES OF THE STEP, - * FUNCTION, AND DERIVATIVE AT THE CURRENT STEP. - */ - state->stx = 0; - state->fx = state->finit; - state->dgx = state->dginit; - state->sty = 0; - state->fy = state->finit; - state->dgy = state->dginit; - - /* - * NEXT - */ - *stage = 3; - continue; - } - if( *stage==3 ) - { - - /* - * START OF ITERATION. - * - * SET THE MINIMUM AND MAXIMUM STEPS TO CORRESPOND - * TO THE PRESENT INTERVAL OF UNCERTAINTY. - */ - if( state->brackt ) - { - if( ae_fp_less(state->stx,state->sty) ) - { - state->stmin = state->stx; - state->stmax = state->sty; - } - else - { - state->stmin = state->sty; - state->stmax = state->stx; - } - } - else - { - state->stmin = state->stx; - state->stmax = *stp+state->xtrapf*(*stp-state->stx); - } - - /* - * FORCE THE STEP TO BE WITHIN THE BOUNDS STPMAX AND STPMIN. - */ - if( ae_fp_greater(*stp,logit_stpmax) ) - { - *stp = logit_stpmax; - } - if( ae_fp_less(*stp,logit_stpmin) ) - { - *stp = logit_stpmin; - } - - /* - * IF AN UNUSUAL TERMINATION IS TO OCCUR THEN LET - * STP BE THE LOWEST POINT OBTAINED SO FAR. - */ - if( (((state->brackt&&(ae_fp_less_eq(*stp,state->stmin)||ae_fp_greater_eq(*stp,state->stmax)))||*nfev>=logit_maxfev-1)||state->infoc==0)||(state->brackt&&ae_fp_less_eq(state->stmax-state->stmin,logit_xtol*state->stmax)) ) - { - *stp = state->stx; - } - - /* - * EVALUATE THE FUNCTION AND GRADIENT AT STP - * AND COMPUTE THE DIRECTIONAL DERIVATIVE. - */ - ae_v_move(&x->ptr.p_double[0], 1, &wa->ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_addd(&x->ptr.p_double[0], 1, &s->ptr.p_double[0], 1, ae_v_len(0,n-1), *stp); - - /* - * NEXT - */ - *stage = 4; - return; - } - if( *stage==4 ) - { - *info = 0; - *nfev = *nfev+1; - v = ae_v_dotproduct(&g->ptr.p_double[0], 1, &s->ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->dg = v; - state->ftest1 = state->finit+*stp*state->dgtest; - - /* - * TEST FOR CONVERGENCE. - */ - if( (state->brackt&&(ae_fp_less_eq(*stp,state->stmin)||ae_fp_greater_eq(*stp,state->stmax)))||state->infoc==0 ) - { - *info = 6; - } - if( (ae_fp_eq(*stp,logit_stpmax)&&ae_fp_less_eq(*f,state->ftest1))&&ae_fp_less_eq(state->dg,state->dgtest) ) - { - *info = 5; - } - if( ae_fp_eq(*stp,logit_stpmin)&&(ae_fp_greater(*f,state->ftest1)||ae_fp_greater_eq(state->dg,state->dgtest)) ) - { - *info = 4; - } - if( *nfev>=logit_maxfev ) - { - *info = 3; - } - if( state->brackt&&ae_fp_less_eq(state->stmax-state->stmin,logit_xtol*state->stmax) ) - { - *info = 2; - } - if( ae_fp_less_eq(*f,state->ftest1)&&ae_fp_less_eq(ae_fabs(state->dg, _state),-logit_gtol*state->dginit) ) - { - *info = 1; - } - - /* - * CHECK FOR TERMINATION. - */ - if( *info!=0 ) - { - *stage = 0; - return; - } - - /* - * IN THE FIRST STAGE WE SEEK A STEP FOR WHICH THE MODIFIED - * FUNCTION HAS A NONPOSITIVE VALUE AND NONNEGATIVE DERIVATIVE. - */ - if( (state->stage1&&ae_fp_less_eq(*f,state->ftest1))&&ae_fp_greater_eq(state->dg,ae_minreal(logit_ftol, logit_gtol, _state)*state->dginit) ) - { - state->stage1 = ae_false; - } - - /* - * A MODIFIED FUNCTION IS USED TO PREDICT THE STEP ONLY IF - * WE HAVE NOT OBTAINED A STEP FOR WHICH THE MODIFIED - * FUNCTION HAS A NONPOSITIVE FUNCTION VALUE AND NONNEGATIVE - * DERIVATIVE, AND IF A LOWER FUNCTION VALUE HAS BEEN - * OBTAINED BUT THE DECREASE IS NOT SUFFICIENT. - */ - if( (state->stage1&&ae_fp_less_eq(*f,state->fx))&&ae_fp_greater(*f,state->ftest1) ) - { - - /* - * DEFINE THE MODIFIED FUNCTION AND DERIVATIVE VALUES. - */ - state->fm = *f-*stp*state->dgtest; - state->fxm = state->fx-state->stx*state->dgtest; - state->fym = state->fy-state->sty*state->dgtest; - state->dgm = state->dg-state->dgtest; - state->dgxm = state->dgx-state->dgtest; - state->dgym = state->dgy-state->dgtest; - - /* - * CALL CSTEP TO UPDATE THE INTERVAL OF UNCERTAINTY - * AND TO COMPUTE THE NEW STEP. - */ - logit_mnlmcstep(&state->stx, &state->fxm, &state->dgxm, &state->sty, &state->fym, &state->dgym, stp, state->fm, state->dgm, &state->brackt, state->stmin, state->stmax, &state->infoc, _state); - - /* - * RESET THE FUNCTION AND GRADIENT VALUES FOR F. - */ - state->fx = state->fxm+state->stx*state->dgtest; - state->fy = state->fym+state->sty*state->dgtest; - state->dgx = state->dgxm+state->dgtest; - state->dgy = state->dgym+state->dgtest; - } - else - { - - /* - * CALL MCSTEP TO UPDATE THE INTERVAL OF UNCERTAINTY - * AND TO COMPUTE THE NEW STEP. - */ - logit_mnlmcstep(&state->stx, &state->fx, &state->dgx, &state->sty, &state->fy, &state->dgy, stp, *f, state->dg, &state->brackt, state->stmin, state->stmax, &state->infoc, _state); - } - - /* - * FORCE A SUFFICIENT DECREASE IN THE SIZE OF THE - * INTERVAL OF UNCERTAINTY. - */ - if( state->brackt ) - { - if( ae_fp_greater_eq(ae_fabs(state->sty-state->stx, _state),p66*state->width1) ) - { - *stp = state->stx+p5*(state->sty-state->stx); - } - state->width1 = state->width; - state->width = ae_fabs(state->sty-state->stx, _state); - } - - /* - * NEXT. - */ - *stage = 3; - continue; - } - } -} - - -static void logit_mnlmcstep(double* stx, - double* fx, - double* dx, - double* sty, - double* fy, - double* dy, - double* stp, - double fp, - double dp, - ae_bool* brackt, - double stmin, - double stmax, - ae_int_t* info, - ae_state *_state) -{ - ae_bool bound; - double gamma; - double p; - double q; - double r; - double s; - double sgnd; - double stpc; - double stpf; - double stpq; - double theta; - - - *info = 0; - - /* - * CHECK THE INPUT PARAMETERS FOR ERRORS. - */ - if( ((*brackt&&(ae_fp_less_eq(*stp,ae_minreal(*stx, *sty, _state))||ae_fp_greater_eq(*stp,ae_maxreal(*stx, *sty, _state))))||ae_fp_greater_eq(*dx*(*stp-(*stx)),0))||ae_fp_less(stmax,stmin) ) - { - return; - } - - /* - * DETERMINE IF THE DERIVATIVES HAVE OPPOSITE SIGN. - */ - sgnd = dp*(*dx/ae_fabs(*dx, _state)); - - /* - * FIRST CASE. A HIGHER FUNCTION VALUE. - * THE MINIMUM IS BRACKETED. IF THE CUBIC STEP IS CLOSER - * TO STX THAN THE QUADRATIC STEP, THE CUBIC STEP IS TAKEN, - * ELSE THE AVERAGE OF THE CUBIC AND QUADRATIC STEPS IS TAKEN. - */ - if( ae_fp_greater(fp,*fx) ) - { - *info = 1; - bound = ae_true; - theta = 3*(*fx-fp)/(*stp-(*stx))+(*dx)+dp; - s = ae_maxreal(ae_fabs(theta, _state), ae_maxreal(ae_fabs(*dx, _state), ae_fabs(dp, _state), _state), _state); - gamma = s*ae_sqrt(ae_sqr(theta/s, _state)-*dx/s*(dp/s), _state); - if( ae_fp_less(*stp,*stx) ) - { - gamma = -gamma; - } - p = gamma-(*dx)+theta; - q = gamma-(*dx)+gamma+dp; - r = p/q; - stpc = *stx+r*(*stp-(*stx)); - stpq = *stx+*dx/((*fx-fp)/(*stp-(*stx))+(*dx))/2*(*stp-(*stx)); - if( ae_fp_less(ae_fabs(stpc-(*stx), _state),ae_fabs(stpq-(*stx), _state)) ) - { - stpf = stpc; - } - else - { - stpf = stpc+(stpq-stpc)/2; - } - *brackt = ae_true; - } - else - { - if( ae_fp_less(sgnd,0) ) - { - - /* - * SECOND CASE. A LOWER FUNCTION VALUE AND DERIVATIVES OF - * OPPOSITE SIGN. THE MINIMUM IS BRACKETED. IF THE CUBIC - * STEP IS CLOSER TO STX THAN THE QUADRATIC (SECANT) STEP, - * THE CUBIC STEP IS TAKEN, ELSE THE QUADRATIC STEP IS TAKEN. - */ - *info = 2; - bound = ae_false; - theta = 3*(*fx-fp)/(*stp-(*stx))+(*dx)+dp; - s = ae_maxreal(ae_fabs(theta, _state), ae_maxreal(ae_fabs(*dx, _state), ae_fabs(dp, _state), _state), _state); - gamma = s*ae_sqrt(ae_sqr(theta/s, _state)-*dx/s*(dp/s), _state); - if( ae_fp_greater(*stp,*stx) ) - { - gamma = -gamma; - } - p = gamma-dp+theta; - q = gamma-dp+gamma+(*dx); - r = p/q; - stpc = *stp+r*(*stx-(*stp)); - stpq = *stp+dp/(dp-(*dx))*(*stx-(*stp)); - if( ae_fp_greater(ae_fabs(stpc-(*stp), _state),ae_fabs(stpq-(*stp), _state)) ) - { - stpf = stpc; - } - else - { - stpf = stpq; - } - *brackt = ae_true; - } - else - { - if( ae_fp_less(ae_fabs(dp, _state),ae_fabs(*dx, _state)) ) - { - - /* - * THIRD CASE. A LOWER FUNCTION VALUE, DERIVATIVES OF THE - * SAME SIGN, AND THE MAGNITUDE OF THE DERIVATIVE DECREASES. - * THE CUBIC STEP IS ONLY USED IF THE CUBIC TENDS TO INFINITY - * IN THE DIRECTION OF THE STEP OR IF THE MINIMUM OF THE CUBIC - * IS BEYOND STP. OTHERWISE THE CUBIC STEP IS DEFINED TO BE - * EITHER STPMIN OR STPMAX. THE QUADRATIC (SECANT) STEP IS ALSO - * COMPUTED AND IF THE MINIMUM IS BRACKETED THEN THE THE STEP - * CLOSEST TO STX IS TAKEN, ELSE THE STEP FARTHEST AWAY IS TAKEN. - */ - *info = 3; - bound = ae_true; - theta = 3*(*fx-fp)/(*stp-(*stx))+(*dx)+dp; - s = ae_maxreal(ae_fabs(theta, _state), ae_maxreal(ae_fabs(*dx, _state), ae_fabs(dp, _state), _state), _state); - - /* - * THE CASE GAMMA = 0 ONLY ARISES IF THE CUBIC DOES NOT TEND - * TO INFINITY IN THE DIRECTION OF THE STEP. - */ - gamma = s*ae_sqrt(ae_maxreal(0, ae_sqr(theta/s, _state)-*dx/s*(dp/s), _state), _state); - if( ae_fp_greater(*stp,*stx) ) - { - gamma = -gamma; - } - p = gamma-dp+theta; - q = gamma+(*dx-dp)+gamma; - r = p/q; - if( ae_fp_less(r,0)&&ae_fp_neq(gamma,0) ) - { - stpc = *stp+r*(*stx-(*stp)); - } - else - { - if( ae_fp_greater(*stp,*stx) ) - { - stpc = stmax; - } - else - { - stpc = stmin; - } - } - stpq = *stp+dp/(dp-(*dx))*(*stx-(*stp)); - if( *brackt ) - { - if( ae_fp_less(ae_fabs(*stp-stpc, _state),ae_fabs(*stp-stpq, _state)) ) - { - stpf = stpc; - } - else - { - stpf = stpq; - } - } - else - { - if( ae_fp_greater(ae_fabs(*stp-stpc, _state),ae_fabs(*stp-stpq, _state)) ) - { - stpf = stpc; - } - else - { - stpf = stpq; - } - } - } - else - { - - /* - * FOURTH CASE. A LOWER FUNCTION VALUE, DERIVATIVES OF THE - * SAME SIGN, AND THE MAGNITUDE OF THE DERIVATIVE DOES - * NOT DECREASE. IF THE MINIMUM IS NOT BRACKETED, THE STEP - * IS EITHER STPMIN OR STPMAX, ELSE THE CUBIC STEP IS TAKEN. - */ - *info = 4; - bound = ae_false; - if( *brackt ) - { - theta = 3*(fp-(*fy))/(*sty-(*stp))+(*dy)+dp; - s = ae_maxreal(ae_fabs(theta, _state), ae_maxreal(ae_fabs(*dy, _state), ae_fabs(dp, _state), _state), _state); - gamma = s*ae_sqrt(ae_sqr(theta/s, _state)-*dy/s*(dp/s), _state); - if( ae_fp_greater(*stp,*sty) ) - { - gamma = -gamma; - } - p = gamma-dp+theta; - q = gamma-dp+gamma+(*dy); - r = p/q; - stpc = *stp+r*(*sty-(*stp)); - stpf = stpc; - } - else - { - if( ae_fp_greater(*stp,*stx) ) - { - stpf = stmax; - } - else - { - stpf = stmin; - } - } - } - } - } - - /* - * UPDATE THE INTERVAL OF UNCERTAINTY. THIS UPDATE DOES NOT - * DEPEND ON THE NEW STEP OR THE CASE ANALYSIS ABOVE. - */ - if( ae_fp_greater(fp,*fx) ) - { - *sty = *stp; - *fy = fp; - *dy = dp; - } - else - { - if( ae_fp_less(sgnd,0.0) ) - { - *sty = *stx; - *fy = *fx; - *dy = *dx; - } - *stx = *stp; - *fx = fp; - *dx = dp; - } - - /* - * COMPUTE THE NEW STEP AND SAFEGUARD IT. - */ - stpf = ae_minreal(stmax, stpf, _state); - stpf = ae_maxreal(stmin, stpf, _state); - *stp = stpf; - if( *brackt&&bound ) - { - if( ae_fp_greater(*sty,*stx) ) - { - *stp = ae_minreal(*stx+0.66*(*sty-(*stx)), *stp, _state); - } - else - { - *stp = ae_maxreal(*stx+0.66*(*sty-(*stx)), *stp, _state); - } - } -} - - -ae_bool _logitmodel_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - logitmodel *p = (logitmodel*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->w, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _logitmodel_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - logitmodel *dst = (logitmodel*)_dst; - logitmodel *src = (logitmodel*)_src; - if( !ae_vector_init_copy(&dst->w, &src->w, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _logitmodel_clear(void* _p) -{ - logitmodel *p = (logitmodel*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->w); -} - - -void _logitmodel_destroy(void* _p) -{ - logitmodel *p = (logitmodel*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->w); -} - - -ae_bool _logitmcstate_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - logitmcstate *p = (logitmcstate*)_p; - ae_touch_ptr((void*)p); - return ae_true; -} - - -ae_bool _logitmcstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - logitmcstate *dst = (logitmcstate*)_dst; - logitmcstate *src = (logitmcstate*)_src; - dst->brackt = src->brackt; - dst->stage1 = src->stage1; - dst->infoc = src->infoc; - dst->dg = src->dg; - dst->dgm = src->dgm; - dst->dginit = src->dginit; - dst->dgtest = src->dgtest; - dst->dgx = src->dgx; - dst->dgxm = src->dgxm; - dst->dgy = src->dgy; - dst->dgym = src->dgym; - dst->finit = src->finit; - dst->ftest1 = src->ftest1; - dst->fm = src->fm; - dst->fx = src->fx; - dst->fxm = src->fxm; - dst->fy = src->fy; - dst->fym = src->fym; - dst->stx = src->stx; - dst->sty = src->sty; - dst->stmin = src->stmin; - dst->stmax = src->stmax; - dst->width = src->width; - dst->width1 = src->width1; - dst->xtrapf = src->xtrapf; - return ae_true; -} - - -void _logitmcstate_clear(void* _p) -{ - logitmcstate *p = (logitmcstate*)_p; - ae_touch_ptr((void*)p); -} - - -void _logitmcstate_destroy(void* _p) -{ - logitmcstate *p = (logitmcstate*)_p; - ae_touch_ptr((void*)p); -} - - -ae_bool _mnlreport_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - mnlreport *p = (mnlreport*)_p; - ae_touch_ptr((void*)p); - return ae_true; -} - - -ae_bool _mnlreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - mnlreport *dst = (mnlreport*)_dst; - mnlreport *src = (mnlreport*)_src; - dst->ngrad = src->ngrad; - dst->nhess = src->nhess; - return ae_true; -} - - -void _mnlreport_clear(void* _p) -{ - mnlreport *p = (mnlreport*)_p; - ae_touch_ptr((void*)p); -} - - -void _mnlreport_destroy(void* _p) -{ - mnlreport *p = (mnlreport*)_p; - ae_touch_ptr((void*)p); -} - - - - -/************************************************************************* -DESCRIPTION: - -This function creates MCPD (Markov Chains for Population Data) solver. - -This solver can be used to find transition matrix P for N-dimensional -prediction problem where transition from X[i] to X[i+1] is modelled as - X[i+1] = P*X[i] -where X[i] and X[i+1] are N-dimensional population vectors (components of -each X are non-negative), and P is a N*N transition matrix (elements of P -are non-negative, each column sums to 1.0). - -Such models arise when when: -* there is some population of individuals -* individuals can have different states -* individuals can transit from one state to another -* population size is constant, i.e. there is no new individuals and no one - leaves population -* you want to model transitions of individuals from one state into another - -USAGE: - -Here we give very brief outline of the MCPD. We strongly recommend you to -read examples in the ALGLIB Reference Manual and to read ALGLIB User Guide -on data analysis which is available at http://www.alglib.net/dataanalysis/ - -1. User initializes algorithm state with MCPDCreate() call - -2. User adds one or more tracks - sequences of states which describe - evolution of a system being modelled from different starting conditions - -3. User may add optional boundary, equality and/or linear constraints on - the coefficients of P by calling one of the following functions: - * MCPDSetEC() to set equality constraints - * MCPDSetBC() to set bound constraints - * MCPDSetLC() to set linear constraints - -4. Optionally, user may set custom weights for prediction errors (by - default, algorithm assigns non-equal, automatically chosen weights for - errors in the prediction of different components of X). It can be done - with a call of MCPDSetPredictionWeights() function. - -5. User calls MCPDSolve() function which takes algorithm state and - pointer (delegate, etc.) to callback function which calculates F/G. - -6. User calls MCPDResults() to get solution - -INPUT PARAMETERS: - N - problem dimension, N>=1 - -OUTPUT PARAMETERS: - State - structure stores algorithm state - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdcreate(ae_int_t n, mcpdstate* s, ae_state *_state) -{ - - _mcpdstate_clear(s); - - ae_assert(n>=1, "MCPDCreate: N<1", _state); - mcpd_mcpdinit(n, -1, -1, s, _state); -} - - -/************************************************************************* -DESCRIPTION: - -This function is a specialized version of MCPDCreate() function, and we -recommend you to read comments for this function for general information -about MCPD solver. - -This function creates MCPD (Markov Chains for Population Data) solver -for "Entry-state" model, i.e. model where transition from X[i] to X[i+1] -is modelled as - X[i+1] = P*X[i] -where - X[i] and X[i+1] are N-dimensional state vectors - P is a N*N transition matrix -and one selected component of X[] is called "entry" state and is treated -in a special way: - system state always transits from "entry" state to some another state - system state can not transit from any state into "entry" state -Such conditions basically mean that row of P which corresponds to "entry" -state is zero. - -Such models arise when: -* there is some population of individuals -* individuals can have different states -* individuals can transit from one state to another -* population size is NOT constant - at every moment of time there is some - (unpredictable) amount of "new" individuals, which can transit into one - of the states at the next turn, but still no one leaves population -* you want to model transitions of individuals from one state into another -* but you do NOT want to predict amount of "new" individuals because it - does not depends on individuals already present (hence system can not - transit INTO entry state - it can only transit FROM it). - -This model is discussed in more details in the ALGLIB User Guide (see -http://www.alglib.net/dataanalysis/ for more data). - -INPUT PARAMETERS: - N - problem dimension, N>=2 - EntryState- index of entry state, in 0..N-1 - -OUTPUT PARAMETERS: - State - structure stores algorithm state - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdcreateentry(ae_int_t n, - ae_int_t entrystate, - mcpdstate* s, - ae_state *_state) -{ - - _mcpdstate_clear(s); - - ae_assert(n>=2, "MCPDCreateEntry: N<2", _state); - ae_assert(entrystate>=0, "MCPDCreateEntry: EntryState<0", _state); - ae_assert(entrystate=N", _state); - mcpd_mcpdinit(n, entrystate, -1, s, _state); -} - - -/************************************************************************* -DESCRIPTION: - -This function is a specialized version of MCPDCreate() function, and we -recommend you to read comments for this function for general information -about MCPD solver. - -This function creates MCPD (Markov Chains for Population Data) solver -for "Exit-state" model, i.e. model where transition from X[i] to X[i+1] -is modelled as - X[i+1] = P*X[i] -where - X[i] and X[i+1] are N-dimensional state vectors - P is a N*N transition matrix -and one selected component of X[] is called "exit" state and is treated -in a special way: - system state can transit from any state into "exit" state - system state can not transit from "exit" state into any other state - transition operator discards "exit" state (makes it zero at each turn) -Such conditions basically mean that column of P which corresponds to -"exit" state is zero. Multiplication by such P may decrease sum of vector -components. - -Such models arise when: -* there is some population of individuals -* individuals can have different states -* individuals can transit from one state to another -* population size is NOT constant - individuals can move into "exit" state - and leave population at the next turn, but there are no new individuals -* amount of individuals which leave population can be predicted -* you want to model transitions of individuals from one state into another - (including transitions into the "exit" state) - -This model is discussed in more details in the ALGLIB User Guide (see -http://www.alglib.net/dataanalysis/ for more data). - -INPUT PARAMETERS: - N - problem dimension, N>=2 - ExitState- index of exit state, in 0..N-1 - -OUTPUT PARAMETERS: - State - structure stores algorithm state - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdcreateexit(ae_int_t n, - ae_int_t exitstate, - mcpdstate* s, - ae_state *_state) -{ - - _mcpdstate_clear(s); - - ae_assert(n>=2, "MCPDCreateExit: N<2", _state); - ae_assert(exitstate>=0, "MCPDCreateExit: ExitState<0", _state); - ae_assert(exitstate=N", _state); - mcpd_mcpdinit(n, -1, exitstate, s, _state); -} - - -/************************************************************************* -DESCRIPTION: - -This function is a specialized version of MCPDCreate() function, and we -recommend you to read comments for this function for general information -about MCPD solver. - -This function creates MCPD (Markov Chains for Population Data) solver -for "Entry-Exit-states" model, i.e. model where transition from X[i] to -X[i+1] is modelled as - X[i+1] = P*X[i] -where - X[i] and X[i+1] are N-dimensional state vectors - P is a N*N transition matrix -one selected component of X[] is called "entry" state and is treated in a -special way: - system state always transits from "entry" state to some another state - system state can not transit from any state into "entry" state -and another one component of X[] is called "exit" state and is treated in -a special way too: - system state can transit from any state into "exit" state - system state can not transit from "exit" state into any other state - transition operator discards "exit" state (makes it zero at each turn) -Such conditions basically mean that: - row of P which corresponds to "entry" state is zero - column of P which corresponds to "exit" state is zero -Multiplication by such P may decrease sum of vector components. - -Such models arise when: -* there is some population of individuals -* individuals can have different states -* individuals can transit from one state to another -* population size is NOT constant -* at every moment of time there is some (unpredictable) amount of "new" - individuals, which can transit into one of the states at the next turn -* some individuals can move (predictably) into "exit" state and leave - population at the next turn -* you want to model transitions of individuals from one state into another, - including transitions from the "entry" state and into the "exit" state. -* but you do NOT want to predict amount of "new" individuals because it - does not depends on individuals already present (hence system can not - transit INTO entry state - it can only transit FROM it). - -This model is discussed in more details in the ALGLIB User Guide (see -http://www.alglib.net/dataanalysis/ for more data). - -INPUT PARAMETERS: - N - problem dimension, N>=2 - EntryState- index of entry state, in 0..N-1 - ExitState- index of exit state, in 0..N-1 - -OUTPUT PARAMETERS: - State - structure stores algorithm state - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdcreateentryexit(ae_int_t n, - ae_int_t entrystate, - ae_int_t exitstate, - mcpdstate* s, - ae_state *_state) -{ - - _mcpdstate_clear(s); - - ae_assert(n>=2, "MCPDCreateEntryExit: N<2", _state); - ae_assert(entrystate>=0, "MCPDCreateEntryExit: EntryState<0", _state); - ae_assert(entrystate=N", _state); - ae_assert(exitstate>=0, "MCPDCreateEntryExit: ExitState<0", _state); - ae_assert(exitstate=N", _state); - ae_assert(entrystate!=exitstate, "MCPDCreateEntryExit: EntryState=ExitState", _state); - mcpd_mcpdinit(n, entrystate, exitstate, s, _state); -} - - -/************************************************************************* -This function is used to add a track - sequence of system states at the -different moments of its evolution. - -You may add one or several tracks to the MCPD solver. In case you have -several tracks, they won't overwrite each other. For example, if you pass -two tracks, A1-A2-A3 (system at t=A+1, t=A+2 and t=A+3) and B1-B2-B3, then -solver will try to model transitions from t=A+1 to t=A+2, t=A+2 to t=A+3, -t=B+1 to t=B+2, t=B+2 to t=B+3. But it WON'T mix these two tracks - i.e. it -won't try to model transition from t=A+3 to t=B+1. - -INPUT PARAMETERS: - S - solver - XY - track, array[K,N]: - * I-th row is a state at t=I - * elements of XY must be non-negative (exception will be - thrown on negative elements) - K - number of points in a track - * if given, only leading K rows of XY are used - * if not given, automatically determined from size of XY - -NOTES: - -1. Track may contain either proportional or population data: - * with proportional data all rows of XY must sum to 1.0, i.e. we have - proportions instead of absolute population values - * with population data rows of XY contain population counts and generally - do not sum to 1.0 (although they still must be non-negative) - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdaddtrack(mcpdstate* s, - /* Real */ ae_matrix* xy, - ae_int_t k, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t n; - double s0; - double s1; - - - n = s->n; - ae_assert(k>=0, "MCPDAddTrack: K<0", _state); - ae_assert(xy->cols>=n, "MCPDAddTrack: Cols(XY)rows>=k, "MCPDAddTrack: Rows(XY)ptr.pp_double[i][j],0), "MCPDAddTrack: XY contains negative elements", _state); - } - } - if( k<2 ) - { - return; - } - if( s->data.rowsnpairs+k-1 ) - { - rmatrixresize(&s->data, ae_maxint(2*s->data.rows, s->npairs+k-1, _state), 2*n, _state); - } - for(i=0; i<=k-2; i++) - { - s0 = 0; - s1 = 0; - for(j=0; j<=n-1; j++) - { - if( s->states.ptr.p_int[j]>=0 ) - { - s0 = s0+xy->ptr.pp_double[i][j]; - } - if( s->states.ptr.p_int[j]<=0 ) - { - s1 = s1+xy->ptr.pp_double[i+1][j]; - } - } - if( ae_fp_greater(s0,0)&&ae_fp_greater(s1,0) ) - { - for(j=0; j<=n-1; j++) - { - if( s->states.ptr.p_int[j]>=0 ) - { - s->data.ptr.pp_double[s->npairs][j] = xy->ptr.pp_double[i][j]/s0; - } - else - { - s->data.ptr.pp_double[s->npairs][j] = 0.0; - } - if( s->states.ptr.p_int[j]<=0 ) - { - s->data.ptr.pp_double[s->npairs][n+j] = xy->ptr.pp_double[i+1][j]/s1; - } - else - { - s->data.ptr.pp_double[s->npairs][n+j] = 0.0; - } - } - s->npairs = s->npairs+1; - } - } -} - - -/************************************************************************* -This function is used to add equality constraints on the elements of the -transition matrix P. - -MCPD solver has four types of constraints which can be placed on P: -* user-specified equality constraints (optional) -* user-specified bound constraints (optional) -* user-specified general linear constraints (optional) -* basic constraints (always present): - * non-negativity: P[i,j]>=0 - * consistency: every column of P sums to 1.0 - -Final constraints which are passed to the underlying optimizer are -calculated as intersection of all present constraints. For example, you -may specify boundary constraint on P[0,0] and equality one: - 0.1<=P[0,0]<=0.9 - P[0,0]=0.5 -Such combination of constraints will be silently reduced to their -intersection, which is P[0,0]=0.5. - -This function can be used to place equality constraints on arbitrary -subset of elements of P. Set of constraints is specified by EC, which may -contain either NAN's or finite numbers from [0,1]. NAN denotes absence of -constraint, finite number denotes equality constraint on specific element -of P. - -You can also use MCPDAddEC() function which allows to ADD equality -constraint for one element of P without changing constraints for other -elements. - -These functions (MCPDSetEC and MCPDAddEC) interact as follows: -* there is internal matrix of equality constraints which is stored in the - MCPD solver -* MCPDSetEC() replaces this matrix by another one (SET) -* MCPDAddEC() modifies one element of this matrix and leaves other ones - unchanged (ADD) -* thus MCPDAddEC() call preserves all modifications done by previous - calls, while MCPDSetEC() completely discards all changes done to the - equality constraints. - -INPUT PARAMETERS: - S - solver - EC - equality constraints, array[N,N]. Elements of EC can be - either NAN's or finite numbers from [0,1]. NAN denotes - absence of constraints, while finite value denotes - equality constraint on the corresponding element of P. - -NOTES: - -1. infinite values of EC will lead to exception being thrown. Values less -than 0.0 or greater than 1.0 will lead to error code being returned after -call to MCPDSolve(). - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdsetec(mcpdstate* s, - /* Real */ ae_matrix* ec, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t n; - - - n = s->n; - ae_assert(ec->cols>=n, "MCPDSetEC: Cols(EC)rows>=n, "MCPDSetEC: Rows(EC)ptr.pp_double[i][j], _state)||ae_isnan(ec->ptr.pp_double[i][j], _state), "MCPDSetEC: EC containts infinite elements", _state); - s->ec.ptr.pp_double[i][j] = ec->ptr.pp_double[i][j]; - } - } -} - - -/************************************************************************* -This function is used to add equality constraints on the elements of the -transition matrix P. - -MCPD solver has four types of constraints which can be placed on P: -* user-specified equality constraints (optional) -* user-specified bound constraints (optional) -* user-specified general linear constraints (optional) -* basic constraints (always present): - * non-negativity: P[i,j]>=0 - * consistency: every column of P sums to 1.0 - -Final constraints which are passed to the underlying optimizer are -calculated as intersection of all present constraints. For example, you -may specify boundary constraint on P[0,0] and equality one: - 0.1<=P[0,0]<=0.9 - P[0,0]=0.5 -Such combination of constraints will be silently reduced to their -intersection, which is P[0,0]=0.5. - -This function can be used to ADD equality constraint for one element of P -without changing constraints for other elements. - -You can also use MCPDSetEC() function which allows you to specify -arbitrary set of equality constraints in one call. - -These functions (MCPDSetEC and MCPDAddEC) interact as follows: -* there is internal matrix of equality constraints which is stored in the - MCPD solver -* MCPDSetEC() replaces this matrix by another one (SET) -* MCPDAddEC() modifies one element of this matrix and leaves other ones - unchanged (ADD) -* thus MCPDAddEC() call preserves all modifications done by previous - calls, while MCPDSetEC() completely discards all changes done to the - equality constraints. - -INPUT PARAMETERS: - S - solver - I - row index of element being constrained - J - column index of element being constrained - C - value (constraint for P[I,J]). Can be either NAN (no - constraint) or finite value from [0,1]. - -NOTES: - -1. infinite values of C will lead to exception being thrown. Values less -than 0.0 or greater than 1.0 will lead to error code being returned after -call to MCPDSolve(). - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdaddec(mcpdstate* s, - ae_int_t i, - ae_int_t j, - double c, - ae_state *_state) -{ - - - ae_assert(i>=0, "MCPDAddEC: I<0", _state); - ae_assert(in, "MCPDAddEC: I>=N", _state); - ae_assert(j>=0, "MCPDAddEC: J<0", _state); - ae_assert(jn, "MCPDAddEC: J>=N", _state); - ae_assert(ae_isnan(c, _state)||ae_isfinite(c, _state), "MCPDAddEC: C is not finite number or NAN", _state); - s->ec.ptr.pp_double[i][j] = c; -} - - -/************************************************************************* -This function is used to add bound constraints on the elements of the -transition matrix P. - -MCPD solver has four types of constraints which can be placed on P: -* user-specified equality constraints (optional) -* user-specified bound constraints (optional) -* user-specified general linear constraints (optional) -* basic constraints (always present): - * non-negativity: P[i,j]>=0 - * consistency: every column of P sums to 1.0 - -Final constraints which are passed to the underlying optimizer are -calculated as intersection of all present constraints. For example, you -may specify boundary constraint on P[0,0] and equality one: - 0.1<=P[0,0]<=0.9 - P[0,0]=0.5 -Such combination of constraints will be silently reduced to their -intersection, which is P[0,0]=0.5. - -This function can be used to place bound constraints on arbitrary -subset of elements of P. Set of constraints is specified by BndL/BndU -matrices, which may contain arbitrary combination of finite numbers or -infinities (like -INFn; - ae_assert(bndl->cols>=n, "MCPDSetBC: Cols(BndL)rows>=n, "MCPDSetBC: Rows(BndL)cols>=n, "MCPDSetBC: Cols(BndU)rows>=n, "MCPDSetBC: Rows(BndU)ptr.pp_double[i][j], _state)||ae_isneginf(bndl->ptr.pp_double[i][j], _state), "MCPDSetBC: BndL containts NAN or +INF", _state); - ae_assert(ae_isfinite(bndu->ptr.pp_double[i][j], _state)||ae_isposinf(bndu->ptr.pp_double[i][j], _state), "MCPDSetBC: BndU containts NAN or -INF", _state); - s->bndl.ptr.pp_double[i][j] = bndl->ptr.pp_double[i][j]; - s->bndu.ptr.pp_double[i][j] = bndu->ptr.pp_double[i][j]; - } - } -} - - -/************************************************************************* -This function is used to add bound constraints on the elements of the -transition matrix P. - -MCPD solver has four types of constraints which can be placed on P: -* user-specified equality constraints (optional) -* user-specified bound constraints (optional) -* user-specified general linear constraints (optional) -* basic constraints (always present): - * non-negativity: P[i,j]>=0 - * consistency: every column of P sums to 1.0 - -Final constraints which are passed to the underlying optimizer are -calculated as intersection of all present constraints. For example, you -may specify boundary constraint on P[0,0] and equality one: - 0.1<=P[0,0]<=0.9 - P[0,0]=0.5 -Such combination of constraints will be silently reduced to their -intersection, which is P[0,0]=0.5. - -This function can be used to ADD bound constraint for one element of P -without changing constraints for other elements. - -You can also use MCPDSetBC() function which allows to place bound -constraints on arbitrary subset of elements of P. Set of constraints is -specified by BndL/BndU matrices, which may contain arbitrary combination -of finite numbers or infinities (like -INF=0, "MCPDAddBC: I<0", _state); - ae_assert(in, "MCPDAddBC: I>=N", _state); - ae_assert(j>=0, "MCPDAddBC: J<0", _state); - ae_assert(jn, "MCPDAddBC: J>=N", _state); - ae_assert(ae_isfinite(bndl, _state)||ae_isneginf(bndl, _state), "MCPDAddBC: BndL is NAN or +INF", _state); - ae_assert(ae_isfinite(bndu, _state)||ae_isposinf(bndu, _state), "MCPDAddBC: BndU is NAN or -INF", _state); - s->bndl.ptr.pp_double[i][j] = bndl; - s->bndu.ptr.pp_double[i][j] = bndu; -} - - -/************************************************************************* -This function is used to set linear equality/inequality constraints on the -elements of the transition matrix P. - -This function can be used to set one or several general linear constraints -on the elements of P. Two types of constraints are supported: -* equality constraints -* inequality constraints (both less-or-equal and greater-or-equal) - -Coefficients of constraints are specified by matrix C (one of the -parameters). One row of C corresponds to one constraint. Because -transition matrix P has N*N elements, we need N*N columns to store all -coefficients (they are stored row by row), and one more column to store -right part - hence C has N*N+1 columns. Constraint kind is stored in the -CT array. - -Thus, I-th linear constraint is - P[0,0]*C[I,0] + P[0,1]*C[I,1] + .. + P[0,N-1]*C[I,N-1] + - + P[1,0]*C[I,N] + P[1,1]*C[I,N+1] + ... + - + P[N-1,N-1]*C[I,N*N-1] ?=? C[I,N*N] -where ?=? can be either "=" (CT[i]=0), "<=" (CT[i]<0) or ">=" (CT[i]>0). - -Your constraint may involve only some subset of P (less than N*N elements). -For example it can be something like - P[0,0] + P[0,1] = 0.5 -In this case you still should pass matrix with N*N+1 columns, but all its -elements (except for C[0,0], C[0,1] and C[0,N*N-1]) will be zero. - -INPUT PARAMETERS: - S - solver - C - array[K,N*N+1] - coefficients of constraints - (see above for complete description) - CT - array[K] - constraint types - (see above for complete description) - K - number of equality/inequality constraints, K>=0: - * if given, only leading K elements of C/CT are used - * if not given, automatically determined from sizes of C/CT - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdsetlc(mcpdstate* s, - /* Real */ ae_matrix* c, - /* Integer */ ae_vector* ct, - ae_int_t k, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t n; - - - n = s->n; - ae_assert(c->cols>=n*n+1, "MCPDSetLC: Cols(C)rows>=k, "MCPDSetLC: Rows(C)cnt>=k, "MCPDSetLC: Len(CT)c, k, n*n+1, _state); - ivectorsetlengthatleast(&s->ct, k, _state); - for(i=0; i<=k-1; i++) - { - for(j=0; j<=n*n; j++) - { - s->c.ptr.pp_double[i][j] = c->ptr.pp_double[i][j]; - } - s->ct.ptr.p_int[i] = ct->ptr.p_int[i]; - } - s->ccnt = k; -} - - -/************************************************************************* -This function allows to tune amount of Tikhonov regularization being -applied to your problem. - -By default, regularizing term is equal to r*||P-prior_P||^2, where r is a -small non-zero value, P is transition matrix, prior_P is identity matrix, -||X||^2 is a sum of squared elements of X. - -This function allows you to change coefficient r. You can also change -prior values with MCPDSetPrior() function. - -INPUT PARAMETERS: - S - solver - V - regularization coefficient, finite non-negative value. It - is not recommended to specify zero value unless you are - pretty sure that you want it. - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdsettikhonovregularizer(mcpdstate* s, double v, ae_state *_state) -{ - - - ae_assert(ae_isfinite(v, _state), "MCPDSetTikhonovRegularizer: V is infinite or NAN", _state); - ae_assert(ae_fp_greater_eq(v,0.0), "MCPDSetTikhonovRegularizer: V is less than zero", _state); - s->regterm = v; -} - - -/************************************************************************* -This function allows to set prior values used for regularization of your -problem. - -By default, regularizing term is equal to r*||P-prior_P||^2, where r is a -small non-zero value, P is transition matrix, prior_P is identity matrix, -||X||^2 is a sum of squared elements of X. - -This function allows you to change prior values prior_P. You can also -change r with MCPDSetTikhonovRegularizer() function. - -INPUT PARAMETERS: - S - solver - PP - array[N,N], matrix of prior values: - 1. elements must be real numbers from [0,1] - 2. columns must sum to 1.0. - First property is checked (exception is thrown otherwise), - while second one is not checked/enforced. - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdsetprior(mcpdstate* s, - /* Real */ ae_matrix* pp, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix _pp; - ae_int_t i; - ae_int_t j; - ae_int_t n; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init_copy(&_pp, pp, _state, ae_true); - pp = &_pp; - - n = s->n; - ae_assert(pp->cols>=n, "MCPDSetPrior: Cols(PP)rows>=n, "MCPDSetPrior: Rows(PP)ptr.pp_double[i][j], _state), "MCPDSetPrior: PP containts infinite elements", _state); - ae_assert(ae_fp_greater_eq(pp->ptr.pp_double[i][j],0.0)&&ae_fp_less_eq(pp->ptr.pp_double[i][j],1.0), "MCPDSetPrior: PP[i,j] is less than 0.0 or greater than 1.0", _state); - s->priorp.ptr.pp_double[i][j] = pp->ptr.pp_double[i][j]; - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -This function is used to change prediction weights - -MCPD solver scales prediction errors as follows - Error(P) = ||W*(y-P*x)||^2 -where - x is a system state at time t - y is a system state at time t+1 - P is a transition matrix - W is a diagonal scaling matrix - -By default, weights are chosen in order to minimize relative prediction -error instead of absolute one. For example, if one component of state is -about 0.5 in magnitude and another one is about 0.05, then algorithm will -make corresponding weights equal to 2.0 and 20.0. - -INPUT PARAMETERS: - S - solver - PW - array[N], weights: - * must be non-negative values (exception will be thrown otherwise) - * zero values will be replaced by automatically chosen values - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdsetpredictionweights(mcpdstate* s, - /* Real */ ae_vector* pw, - ae_state *_state) -{ - ae_int_t i; - ae_int_t n; - - - n = s->n; - ae_assert(pw->cnt>=n, "MCPDSetPredictionWeights: Length(PW)ptr.p_double[i], _state), "MCPDSetPredictionWeights: PW containts infinite or NAN elements", _state); - ae_assert(ae_fp_greater_eq(pw->ptr.p_double[i],0), "MCPDSetPredictionWeights: PW containts negative elements", _state); - s->pw.ptr.p_double[i] = pw->ptr.p_double[i]; - } -} - - -/************************************************************************* -This function is used to start solution of the MCPD problem. - -After return from this function, you can use MCPDResults() to get solution -and completion code. - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdsolve(mcpdstate* s, ae_state *_state) -{ - ae_int_t n; - ae_int_t npairs; - ae_int_t ccnt; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t k2; - double v; - double vv; - - - n = s->n; - npairs = s->npairs; - - /* - * init fields of S - */ - s->repterminationtype = 0; - s->repinneriterationscount = 0; - s->repouteriterationscount = 0; - s->repnfev = 0; - for(k=0; k<=n-1; k++) - { - for(k2=0; k2<=n-1; k2++) - { - s->p.ptr.pp_double[k][k2] = _state->v_nan; - } - } - - /* - * Generate "effective" weights for prediction and calculate preconditioner - */ - for(i=0; i<=n-1; i++) - { - if( ae_fp_eq(s->pw.ptr.p_double[i],0) ) - { - v = 0; - k = 0; - for(j=0; j<=npairs-1; j++) - { - if( ae_fp_neq(s->data.ptr.pp_double[j][n+i],0) ) - { - v = v+s->data.ptr.pp_double[j][n+i]; - k = k+1; - } - } - if( k!=0 ) - { - s->effectivew.ptr.p_double[i] = k/v; - } - else - { - s->effectivew.ptr.p_double[i] = 1.0; - } - } - else - { - s->effectivew.ptr.p_double[i] = s->pw.ptr.p_double[i]; - } - } - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - s->h.ptr.p_double[i*n+j] = 2*s->regterm; - } - } - for(k=0; k<=npairs-1; k++) - { - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - s->h.ptr.p_double[i*n+j] = s->h.ptr.p_double[i*n+j]+2*ae_sqr(s->effectivew.ptr.p_double[i], _state)*ae_sqr(s->data.ptr.pp_double[k][j], _state); - } - } - } - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - if( ae_fp_eq(s->h.ptr.p_double[i*n+j],0) ) - { - s->h.ptr.p_double[i*n+j] = 1; - } - } - } - - /* - * Generate "effective" BndL/BndU - */ - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - - /* - * Set default boundary constraints. - * Lower bound is always zero, upper bound is calculated - * with respect to entry/exit states. - */ - s->effectivebndl.ptr.p_double[i*n+j] = 0.0; - if( s->states.ptr.p_int[i]>0||s->states.ptr.p_int[j]<0 ) - { - s->effectivebndu.ptr.p_double[i*n+j] = 0.0; - } - else - { - s->effectivebndu.ptr.p_double[i*n+j] = 1.0; - } - - /* - * Calculate intersection of the default and user-specified bound constraints. - * This code checks consistency of such combination. - */ - if( ae_isfinite(s->bndl.ptr.pp_double[i][j], _state)&&ae_fp_greater(s->bndl.ptr.pp_double[i][j],s->effectivebndl.ptr.p_double[i*n+j]) ) - { - s->effectivebndl.ptr.p_double[i*n+j] = s->bndl.ptr.pp_double[i][j]; - } - if( ae_isfinite(s->bndu.ptr.pp_double[i][j], _state)&&ae_fp_less(s->bndu.ptr.pp_double[i][j],s->effectivebndu.ptr.p_double[i*n+j]) ) - { - s->effectivebndu.ptr.p_double[i*n+j] = s->bndu.ptr.pp_double[i][j]; - } - if( ae_fp_greater(s->effectivebndl.ptr.p_double[i*n+j],s->effectivebndu.ptr.p_double[i*n+j]) ) - { - s->repterminationtype = -3; - return; - } - - /* - * Calculate intersection of the effective bound constraints - * and user-specified equality constraints. - * This code checks consistency of such combination. - */ - if( ae_isfinite(s->ec.ptr.pp_double[i][j], _state) ) - { - if( ae_fp_less(s->ec.ptr.pp_double[i][j],s->effectivebndl.ptr.p_double[i*n+j])||ae_fp_greater(s->ec.ptr.pp_double[i][j],s->effectivebndu.ptr.p_double[i*n+j]) ) - { - s->repterminationtype = -3; - return; - } - s->effectivebndl.ptr.p_double[i*n+j] = s->ec.ptr.pp_double[i][j]; - s->effectivebndu.ptr.p_double[i*n+j] = s->ec.ptr.pp_double[i][j]; - } - } - } - - /* - * Generate linear constraints: - * * "default" sums-to-one constraints (not generated for "exit" states) - */ - rmatrixsetlengthatleast(&s->effectivec, s->ccnt+n, n*n+1, _state); - ivectorsetlengthatleast(&s->effectivect, s->ccnt+n, _state); - ccnt = s->ccnt; - for(i=0; i<=s->ccnt-1; i++) - { - for(j=0; j<=n*n; j++) - { - s->effectivec.ptr.pp_double[i][j] = s->c.ptr.pp_double[i][j]; - } - s->effectivect.ptr.p_int[i] = s->ct.ptr.p_int[i]; - } - for(i=0; i<=n-1; i++) - { - if( s->states.ptr.p_int[i]>=0 ) - { - for(k=0; k<=n*n-1; k++) - { - s->effectivec.ptr.pp_double[ccnt][k] = 0; - } - for(k=0; k<=n-1; k++) - { - s->effectivec.ptr.pp_double[ccnt][k*n+i] = 1; - } - s->effectivec.ptr.pp_double[ccnt][n*n] = 1.0; - s->effectivect.ptr.p_int[ccnt] = 0; - ccnt = ccnt+1; - } - } - - /* - * create optimizer - */ - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - s->tmpp.ptr.p_double[i*n+j] = (double)1/(double)n; - } - } - minbleicrestartfrom(&s->bs, &s->tmpp, _state); - minbleicsetbc(&s->bs, &s->effectivebndl, &s->effectivebndu, _state); - minbleicsetlc(&s->bs, &s->effectivec, &s->effectivect, ccnt, _state); - minbleicsetcond(&s->bs, 0.0, 0.0, mcpd_xtol, 0, _state); - minbleicsetprecdiag(&s->bs, &s->h, _state); - - /* - * solve problem - */ - while(minbleiciteration(&s->bs, _state)) - { - ae_assert(s->bs.needfg, "MCPDSolve: internal error", _state); - if( s->bs.needfg ) - { - - /* - * Calculate regularization term - */ - s->bs.f = 0.0; - vv = s->regterm; - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - s->bs.f = s->bs.f+vv*ae_sqr(s->bs.x.ptr.p_double[i*n+j]-s->priorp.ptr.pp_double[i][j], _state); - s->bs.g.ptr.p_double[i*n+j] = 2*vv*(s->bs.x.ptr.p_double[i*n+j]-s->priorp.ptr.pp_double[i][j]); - } - } - - /* - * calculate prediction error/gradient for K-th pair - */ - for(k=0; k<=npairs-1; k++) - { - for(i=0; i<=n-1; i++) - { - v = ae_v_dotproduct(&s->bs.x.ptr.p_double[i*n], 1, &s->data.ptr.pp_double[k][0], 1, ae_v_len(i*n,i*n+n-1)); - vv = s->effectivew.ptr.p_double[i]; - s->bs.f = s->bs.f+ae_sqr(vv*(v-s->data.ptr.pp_double[k][n+i]), _state); - for(j=0; j<=n-1; j++) - { - s->bs.g.ptr.p_double[i*n+j] = s->bs.g.ptr.p_double[i*n+j]+2*vv*vv*(v-s->data.ptr.pp_double[k][n+i])*s->data.ptr.pp_double[k][j]; - } - } - } - - /* - * continue - */ - continue; - } - } - minbleicresultsbuf(&s->bs, &s->tmpp, &s->br, _state); - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - s->p.ptr.pp_double[i][j] = s->tmpp.ptr.p_double[i*n+j]; - } - } - s->repterminationtype = s->br.terminationtype; - s->repinneriterationscount = s->br.inneriterationscount; - s->repouteriterationscount = s->br.outeriterationscount; - s->repnfev = s->br.nfev; -} - - -/************************************************************************* -MCPD results - -INPUT PARAMETERS: - State - algorithm state - -OUTPUT PARAMETERS: - P - array[N,N], transition matrix - Rep - optimization report. You should check Rep.TerminationType - in order to distinguish successful termination from - unsuccessful one. Speaking short, positive values denote - success, negative ones are failures. - More information about fields of this structure can be - found in the comments on MCPDReport datatype. - - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdresults(mcpdstate* s, - /* Real */ ae_matrix* p, - mcpdreport* rep, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - - ae_matrix_clear(p); - _mcpdreport_clear(rep); - - ae_matrix_set_length(p, s->n, s->n, _state); - for(i=0; i<=s->n-1; i++) - { - for(j=0; j<=s->n-1; j++) - { - p->ptr.pp_double[i][j] = s->p.ptr.pp_double[i][j]; - } - } - rep->terminationtype = s->repterminationtype; - rep->inneriterationscount = s->repinneriterationscount; - rep->outeriterationscount = s->repouteriterationscount; - rep->nfev = s->repnfev; -} - - -/************************************************************************* -Internal initialization function - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -static void mcpd_mcpdinit(ae_int_t n, - ae_int_t entrystate, - ae_int_t exitstate, - mcpdstate* s, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - - - ae_assert(n>=1, "MCPDCreate: N<1", _state); - s->n = n; - ae_vector_set_length(&s->states, n, _state); - for(i=0; i<=n-1; i++) - { - s->states.ptr.p_int[i] = 0; - } - if( entrystate>=0 ) - { - s->states.ptr.p_int[entrystate] = 1; - } - if( exitstate>=0 ) - { - s->states.ptr.p_int[exitstate] = -1; - } - s->npairs = 0; - s->regterm = 1.0E-8; - s->ccnt = 0; - ae_matrix_set_length(&s->p, n, n, _state); - ae_matrix_set_length(&s->ec, n, n, _state); - ae_matrix_set_length(&s->bndl, n, n, _state); - ae_matrix_set_length(&s->bndu, n, n, _state); - ae_vector_set_length(&s->pw, n, _state); - ae_matrix_set_length(&s->priorp, n, n, _state); - ae_vector_set_length(&s->tmpp, n*n, _state); - ae_vector_set_length(&s->effectivew, n, _state); - ae_vector_set_length(&s->effectivebndl, n*n, _state); - ae_vector_set_length(&s->effectivebndu, n*n, _state); - ae_vector_set_length(&s->h, n*n, _state); - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - s->p.ptr.pp_double[i][j] = 0.0; - s->priorp.ptr.pp_double[i][j] = 0.0; - s->bndl.ptr.pp_double[i][j] = _state->v_neginf; - s->bndu.ptr.pp_double[i][j] = _state->v_posinf; - s->ec.ptr.pp_double[i][j] = _state->v_nan; - } - s->pw.ptr.p_double[i] = 0.0; - s->priorp.ptr.pp_double[i][i] = 1.0; - } - ae_matrix_set_length(&s->data, 1, 2*n, _state); - for(i=0; i<=2*n-1; i++) - { - s->data.ptr.pp_double[0][i] = 0.0; - } - for(i=0; i<=n*n-1; i++) - { - s->tmpp.ptr.p_double[i] = 0.0; - } - minbleiccreate(n*n, &s->tmpp, &s->bs, _state); -} - - -ae_bool _mcpdstate_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - mcpdstate *p = (mcpdstate*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->states, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->data, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->ec, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->bndl, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->bndu, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->c, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->ct, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->pw, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->priorp, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !_minbleicstate_init(&p->bs, _state, make_automatic) ) - return ae_false; - if( !_minbleicreport_init(&p->br, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->tmpp, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->effectivew, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->effectivebndl, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->effectivebndu, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->effectivec, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->effectivect, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->h, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->p, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _mcpdstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - mcpdstate *dst = (mcpdstate*)_dst; - mcpdstate *src = (mcpdstate*)_src; - dst->n = src->n; - if( !ae_vector_init_copy(&dst->states, &src->states, _state, make_automatic) ) - return ae_false; - dst->npairs = src->npairs; - if( !ae_matrix_init_copy(&dst->data, &src->data, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->ec, &src->ec, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->bndl, &src->bndl, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->bndu, &src->bndu, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->c, &src->c, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->ct, &src->ct, _state, make_automatic) ) - return ae_false; - dst->ccnt = src->ccnt; - if( !ae_vector_init_copy(&dst->pw, &src->pw, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->priorp, &src->priorp, _state, make_automatic) ) - return ae_false; - dst->regterm = src->regterm; - if( !_minbleicstate_init_copy(&dst->bs, &src->bs, _state, make_automatic) ) - return ae_false; - dst->repinneriterationscount = src->repinneriterationscount; - dst->repouteriterationscount = src->repouteriterationscount; - dst->repnfev = src->repnfev; - dst->repterminationtype = src->repterminationtype; - if( !_minbleicreport_init_copy(&dst->br, &src->br, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->tmpp, &src->tmpp, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->effectivew, &src->effectivew, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->effectivebndl, &src->effectivebndl, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->effectivebndu, &src->effectivebndu, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->effectivec, &src->effectivec, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->effectivect, &src->effectivect, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->h, &src->h, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->p, &src->p, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _mcpdstate_clear(void* _p) -{ - mcpdstate *p = (mcpdstate*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->states); - ae_matrix_clear(&p->data); - ae_matrix_clear(&p->ec); - ae_matrix_clear(&p->bndl); - ae_matrix_clear(&p->bndu); - ae_matrix_clear(&p->c); - ae_vector_clear(&p->ct); - ae_vector_clear(&p->pw); - ae_matrix_clear(&p->priorp); - _minbleicstate_clear(&p->bs); - _minbleicreport_clear(&p->br); - ae_vector_clear(&p->tmpp); - ae_vector_clear(&p->effectivew); - ae_vector_clear(&p->effectivebndl); - ae_vector_clear(&p->effectivebndu); - ae_matrix_clear(&p->effectivec); - ae_vector_clear(&p->effectivect); - ae_vector_clear(&p->h); - ae_matrix_clear(&p->p); -} - - -void _mcpdstate_destroy(void* _p) -{ - mcpdstate *p = (mcpdstate*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->states); - ae_matrix_destroy(&p->data); - ae_matrix_destroy(&p->ec); - ae_matrix_destroy(&p->bndl); - ae_matrix_destroy(&p->bndu); - ae_matrix_destroy(&p->c); - ae_vector_destroy(&p->ct); - ae_vector_destroy(&p->pw); - ae_matrix_destroy(&p->priorp); - _minbleicstate_destroy(&p->bs); - _minbleicreport_destroy(&p->br); - ae_vector_destroy(&p->tmpp); - ae_vector_destroy(&p->effectivew); - ae_vector_destroy(&p->effectivebndl); - ae_vector_destroy(&p->effectivebndu); - ae_matrix_destroy(&p->effectivec); - ae_vector_destroy(&p->effectivect); - ae_vector_destroy(&p->h); - ae_matrix_destroy(&p->p); -} - - -ae_bool _mcpdreport_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - mcpdreport *p = (mcpdreport*)_p; - ae_touch_ptr((void*)p); - return ae_true; -} - - -ae_bool _mcpdreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - mcpdreport *dst = (mcpdreport*)_dst; - mcpdreport *src = (mcpdreport*)_src; - dst->inneriterationscount = src->inneriterationscount; - dst->outeriterationscount = src->outeriterationscount; - dst->nfev = src->nfev; - dst->terminationtype = src->terminationtype; - return ae_true; -} - - -void _mcpdreport_clear(void* _p) -{ - mcpdreport *p = (mcpdreport*)_p; - ae_touch_ptr((void*)p); -} - - -void _mcpdreport_destroy(void* _p) -{ - mcpdreport *p = (mcpdreport*)_p; - ae_touch_ptr((void*)p); -} - - - - -/************************************************************************* -Like MLPCreate0, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreate0(ae_int_t nin, - ae_int_t nout, - ae_int_t ensemblesize, - mlpensemble* ensemble, - ae_state *_state) -{ - ae_frame _frame_block; - multilayerperceptron net; - - ae_frame_make(_state, &_frame_block); - _mlpensemble_clear(ensemble); - _multilayerperceptron_init(&net, _state, ae_true); - - mlpcreate0(nin, nout, &net, _state); - mlpecreatefromnetwork(&net, ensemblesize, ensemble, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Like MLPCreate1, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreate1(ae_int_t nin, - ae_int_t nhid, - ae_int_t nout, - ae_int_t ensemblesize, - mlpensemble* ensemble, - ae_state *_state) -{ - ae_frame _frame_block; - multilayerperceptron net; - - ae_frame_make(_state, &_frame_block); - _mlpensemble_clear(ensemble); - _multilayerperceptron_init(&net, _state, ae_true); - - mlpcreate1(nin, nhid, nout, &net, _state); - mlpecreatefromnetwork(&net, ensemblesize, ensemble, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Like MLPCreate2, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreate2(ae_int_t nin, - ae_int_t nhid1, - ae_int_t nhid2, - ae_int_t nout, - ae_int_t ensemblesize, - mlpensemble* ensemble, - ae_state *_state) -{ - ae_frame _frame_block; - multilayerperceptron net; - - ae_frame_make(_state, &_frame_block); - _mlpensemble_clear(ensemble); - _multilayerperceptron_init(&net, _state, ae_true); - - mlpcreate2(nin, nhid1, nhid2, nout, &net, _state); - mlpecreatefromnetwork(&net, ensemblesize, ensemble, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Like MLPCreateB0, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreateb0(ae_int_t nin, - ae_int_t nout, - double b, - double d, - ae_int_t ensemblesize, - mlpensemble* ensemble, - ae_state *_state) -{ - ae_frame _frame_block; - multilayerperceptron net; - - ae_frame_make(_state, &_frame_block); - _mlpensemble_clear(ensemble); - _multilayerperceptron_init(&net, _state, ae_true); - - mlpcreateb0(nin, nout, b, d, &net, _state); - mlpecreatefromnetwork(&net, ensemblesize, ensemble, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Like MLPCreateB1, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreateb1(ae_int_t nin, - ae_int_t nhid, - ae_int_t nout, - double b, - double d, - ae_int_t ensemblesize, - mlpensemble* ensemble, - ae_state *_state) -{ - ae_frame _frame_block; - multilayerperceptron net; - - ae_frame_make(_state, &_frame_block); - _mlpensemble_clear(ensemble); - _multilayerperceptron_init(&net, _state, ae_true); - - mlpcreateb1(nin, nhid, nout, b, d, &net, _state); - mlpecreatefromnetwork(&net, ensemblesize, ensemble, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Like MLPCreateB2, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreateb2(ae_int_t nin, - ae_int_t nhid1, - ae_int_t nhid2, - ae_int_t nout, - double b, - double d, - ae_int_t ensemblesize, - mlpensemble* ensemble, - ae_state *_state) -{ - ae_frame _frame_block; - multilayerperceptron net; - - ae_frame_make(_state, &_frame_block); - _mlpensemble_clear(ensemble); - _multilayerperceptron_init(&net, _state, ae_true); - - mlpcreateb2(nin, nhid1, nhid2, nout, b, d, &net, _state); - mlpecreatefromnetwork(&net, ensemblesize, ensemble, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Like MLPCreateR0, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreater0(ae_int_t nin, - ae_int_t nout, - double a, - double b, - ae_int_t ensemblesize, - mlpensemble* ensemble, - ae_state *_state) -{ - ae_frame _frame_block; - multilayerperceptron net; - - ae_frame_make(_state, &_frame_block); - _mlpensemble_clear(ensemble); - _multilayerperceptron_init(&net, _state, ae_true); - - mlpcreater0(nin, nout, a, b, &net, _state); - mlpecreatefromnetwork(&net, ensemblesize, ensemble, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Like MLPCreateR1, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreater1(ae_int_t nin, - ae_int_t nhid, - ae_int_t nout, - double a, - double b, - ae_int_t ensemblesize, - mlpensemble* ensemble, - ae_state *_state) -{ - ae_frame _frame_block; - multilayerperceptron net; - - ae_frame_make(_state, &_frame_block); - _mlpensemble_clear(ensemble); - _multilayerperceptron_init(&net, _state, ae_true); - - mlpcreater1(nin, nhid, nout, a, b, &net, _state); - mlpecreatefromnetwork(&net, ensemblesize, ensemble, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Like MLPCreateR2, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreater2(ae_int_t nin, - ae_int_t nhid1, - ae_int_t nhid2, - ae_int_t nout, - double a, - double b, - ae_int_t ensemblesize, - mlpensemble* ensemble, - ae_state *_state) -{ - ae_frame _frame_block; - multilayerperceptron net; - - ae_frame_make(_state, &_frame_block); - _mlpensemble_clear(ensemble); - _multilayerperceptron_init(&net, _state, ae_true); - - mlpcreater2(nin, nhid1, nhid2, nout, a, b, &net, _state); - mlpecreatefromnetwork(&net, ensemblesize, ensemble, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Like MLPCreateC0, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreatec0(ae_int_t nin, - ae_int_t nout, - ae_int_t ensemblesize, - mlpensemble* ensemble, - ae_state *_state) -{ - ae_frame _frame_block; - multilayerperceptron net; - - ae_frame_make(_state, &_frame_block); - _mlpensemble_clear(ensemble); - _multilayerperceptron_init(&net, _state, ae_true); - - mlpcreatec0(nin, nout, &net, _state); - mlpecreatefromnetwork(&net, ensemblesize, ensemble, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Like MLPCreateC1, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreatec1(ae_int_t nin, - ae_int_t nhid, - ae_int_t nout, - ae_int_t ensemblesize, - mlpensemble* ensemble, - ae_state *_state) -{ - ae_frame _frame_block; - multilayerperceptron net; - - ae_frame_make(_state, &_frame_block); - _mlpensemble_clear(ensemble); - _multilayerperceptron_init(&net, _state, ae_true); - - mlpcreatec1(nin, nhid, nout, &net, _state); - mlpecreatefromnetwork(&net, ensemblesize, ensemble, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Like MLPCreateC2, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreatec2(ae_int_t nin, - ae_int_t nhid1, - ae_int_t nhid2, - ae_int_t nout, - ae_int_t ensemblesize, - mlpensemble* ensemble, - ae_state *_state) -{ - ae_frame _frame_block; - multilayerperceptron net; - - ae_frame_make(_state, &_frame_block); - _mlpensemble_clear(ensemble); - _multilayerperceptron_init(&net, _state, ae_true); - - mlpcreatec2(nin, nhid1, nhid2, nout, &net, _state); - mlpecreatefromnetwork(&net, ensemblesize, ensemble, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Creates ensemble from network. Only network geometry is copied. - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreatefromnetwork(multilayerperceptron* network, - ae_int_t ensemblesize, - mlpensemble* ensemble, - ae_state *_state) -{ - ae_int_t i; - ae_int_t ccount; - ae_int_t wcount; - - _mlpensemble_clear(ensemble); - - ae_assert(ensemblesize>0, "MLPECreate: incorrect ensemble size!", _state); - - /* - * Copy network - */ - mlpcopy(network, &ensemble->network, _state); - - /* - * network properties - */ - if( mlpissoftmax(network, _state) ) - { - ccount = mlpgetinputscount(&ensemble->network, _state); - } - else - { - ccount = mlpgetinputscount(&ensemble->network, _state)+mlpgetoutputscount(&ensemble->network, _state); - } - wcount = mlpgetweightscount(&ensemble->network, _state); - ensemble->ensemblesize = ensemblesize; - - /* - * weights, means, sigmas - */ - ae_vector_set_length(&ensemble->weights, ensemblesize*wcount, _state); - ae_vector_set_length(&ensemble->columnmeans, ensemblesize*ccount, _state); - ae_vector_set_length(&ensemble->columnsigmas, ensemblesize*ccount, _state); - for(i=0; i<=ensemblesize*wcount-1; i++) - { - ensemble->weights.ptr.p_double[i] = ae_randomreal(_state)-0.5; - } - for(i=0; i<=ensemblesize-1; i++) - { - ae_v_move(&ensemble->columnmeans.ptr.p_double[i*ccount], 1, &network->columnmeans.ptr.p_double[0], 1, ae_v_len(i*ccount,(i+1)*ccount-1)); - ae_v_move(&ensemble->columnsigmas.ptr.p_double[i*ccount], 1, &network->columnsigmas.ptr.p_double[0], 1, ae_v_len(i*ccount,(i+1)*ccount-1)); - } - - /* - * temporaries, internal buffers - */ - ae_vector_set_length(&ensemble->y, mlpgetoutputscount(&ensemble->network, _state), _state); -} - - -/************************************************************************* -Copying of MLPEnsemble strucure - -INPUT PARAMETERS: - Ensemble1 - original - -OUTPUT PARAMETERS: - Ensemble2 - copy - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecopy(mlpensemble* ensemble1, - mlpensemble* ensemble2, - ae_state *_state) -{ - ae_int_t ccount; - ae_int_t wcount; - - _mlpensemble_clear(ensemble2); - - - /* - * Unload info - */ - if( mlpissoftmax(&ensemble1->network, _state) ) - { - ccount = mlpgetinputscount(&ensemble1->network, _state); - } - else - { - ccount = mlpgetinputscount(&ensemble1->network, _state)+mlpgetoutputscount(&ensemble1->network, _state); - } - wcount = mlpgetweightscount(&ensemble1->network, _state); - - /* - * Allocate space - */ - ae_vector_set_length(&ensemble2->weights, ensemble1->ensemblesize*wcount, _state); - ae_vector_set_length(&ensemble2->columnmeans, ensemble1->ensemblesize*ccount, _state); - ae_vector_set_length(&ensemble2->columnsigmas, ensemble1->ensemblesize*ccount, _state); - ae_vector_set_length(&ensemble2->y, mlpgetoutputscount(&ensemble1->network, _state), _state); - - /* - * Copy - */ - ensemble2->ensemblesize = ensemble1->ensemblesize; - ae_v_move(&ensemble2->weights.ptr.p_double[0], 1, &ensemble1->weights.ptr.p_double[0], 1, ae_v_len(0,ensemble1->ensemblesize*wcount-1)); - ae_v_move(&ensemble2->columnmeans.ptr.p_double[0], 1, &ensemble1->columnmeans.ptr.p_double[0], 1, ae_v_len(0,ensemble1->ensemblesize*ccount-1)); - ae_v_move(&ensemble2->columnsigmas.ptr.p_double[0], 1, &ensemble1->columnsigmas.ptr.p_double[0], 1, ae_v_len(0,ensemble1->ensemblesize*ccount-1)); - mlpcopy(&ensemble1->network, &ensemble2->network, _state); -} - - -/************************************************************************* -Randomization of MLP ensemble - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlperandomize(mlpensemble* ensemble, ae_state *_state) -{ - ae_int_t i; - ae_int_t wcount; - - - wcount = mlpgetweightscount(&ensemble->network, _state); - for(i=0; i<=ensemble->ensemblesize*wcount-1; i++) - { - ensemble->weights.ptr.p_double[i] = ae_randomreal(_state)-0.5; - } -} - - -/************************************************************************* -Return ensemble properties (number of inputs and outputs). - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpeproperties(mlpensemble* ensemble, - ae_int_t* nin, - ae_int_t* nout, - ae_state *_state) -{ - - *nin = 0; - *nout = 0; - - *nin = mlpgetinputscount(&ensemble->network, _state); - *nout = mlpgetoutputscount(&ensemble->network, _state); -} - - -/************************************************************************* -Return normalization type (whether ensemble is SOFTMAX-normalized or not). - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -ae_bool mlpeissoftmax(mlpensemble* ensemble, ae_state *_state) -{ - ae_bool result; - - - result = mlpissoftmax(&ensemble->network, _state); - return result; -} - - -/************************************************************************* -Procesing - -INPUT PARAMETERS: - Ensemble- neural networks ensemble - X - input vector, array[0..NIn-1]. - Y - (possibly) preallocated buffer; if size of Y is less than - NOut, it will be reallocated. If it is large enough, it - is NOT reallocated, so we can save some time on reallocation. - - -OUTPUT PARAMETERS: - Y - result. Regression estimate when solving regression task, - vector of posterior probabilities for classification task. - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpeprocess(mlpensemble* ensemble, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state) -{ - ae_int_t i; - ae_int_t es; - ae_int_t wc; - ae_int_t cc; - double v; - ae_int_t nout; - - - if( y->cntnetwork, _state) ) - { - ae_vector_set_length(y, mlpgetoutputscount(&ensemble->network, _state), _state); - } - es = ensemble->ensemblesize; - wc = mlpgetweightscount(&ensemble->network, _state); - if( mlpissoftmax(&ensemble->network, _state) ) - { - cc = mlpgetinputscount(&ensemble->network, _state); - } - else - { - cc = mlpgetinputscount(&ensemble->network, _state)+mlpgetoutputscount(&ensemble->network, _state); - } - v = (double)1/(double)es; - nout = mlpgetoutputscount(&ensemble->network, _state); - for(i=0; i<=nout-1; i++) - { - y->ptr.p_double[i] = 0; - } - for(i=0; i<=es-1; i++) - { - ae_v_move(&ensemble->network.weights.ptr.p_double[0], 1, &ensemble->weights.ptr.p_double[i*wc], 1, ae_v_len(0,wc-1)); - ae_v_move(&ensemble->network.columnmeans.ptr.p_double[0], 1, &ensemble->columnmeans.ptr.p_double[i*cc], 1, ae_v_len(0,cc-1)); - ae_v_move(&ensemble->network.columnsigmas.ptr.p_double[0], 1, &ensemble->columnsigmas.ptr.p_double[i*cc], 1, ae_v_len(0,cc-1)); - mlpprocess(&ensemble->network, x, &ensemble->y, _state); - ae_v_addd(&y->ptr.p_double[0], 1, &ensemble->y.ptr.p_double[0], 1, ae_v_len(0,nout-1), v); - } -} - - -/************************************************************************* -'interactive' variant of MLPEProcess for languages like Python which -support constructs like "Y = MLPEProcess(LM,X)" and interactive mode of the -interpreter - -This function allocates new array on each call, so it is significantly -slower than its 'non-interactive' counterpart, but it is more convenient -when you call it from command line. - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpeprocessi(mlpensemble* ensemble, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state) -{ - - ae_vector_clear(y); - - mlpeprocess(ensemble, x, y, _state); -} - - -/************************************************************************* -Calculation of all types of errors - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpeallerrorsx(mlpensemble* ensemble, - /* Real */ ae_matrix* densexy, - sparsematrix* sparsexy, - ae_int_t datasetsize, - ae_int_t datasettype, - /* Integer */ ae_vector* idx, - ae_int_t subset0, - ae_int_t subset1, - ae_int_t subsettype, - ae_shared_pool* buf, - modelerrors* rep, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - ae_int_t nin; - ae_int_t nout; - ae_bool iscls; - ae_int_t srcidx; - mlpbuffers *pbuf; - ae_smart_ptr _pbuf; - modelerrors rep0; - modelerrors rep1; - - ae_frame_make(_state, &_frame_block); - ae_smart_ptr_init(&_pbuf, (void**)&pbuf, _state, ae_true); - _modelerrors_init(&rep0, _state, ae_true); - _modelerrors_init(&rep1, _state, ae_true); - - - /* - * Get network information - */ - nin = mlpgetinputscount(&ensemble->network, _state); - nout = mlpgetoutputscount(&ensemble->network, _state); - iscls = mlpissoftmax(&ensemble->network, _state); - - /* - * Retrieve buffer, prepare, process data, recycle buffer - */ - ae_shared_pool_retrieve(buf, &_pbuf, _state); - if( iscls ) - { - dserrallocate(nout, &pbuf->tmp0, _state); - } - else - { - dserrallocate(-nout, &pbuf->tmp0, _state); - } - rvectorsetlengthatleast(&pbuf->x, nin, _state); - rvectorsetlengthatleast(&pbuf->y, nout, _state); - rvectorsetlengthatleast(&pbuf->desiredy, nout, _state); - for(i=subset0; i<=subset1-1; i++) - { - srcidx = -1; - if( subsettype==0 ) - { - srcidx = i; - } - if( subsettype==1 ) - { - srcidx = idx->ptr.p_int[i]; - } - ae_assert(srcidx>=0, "MLPEAllErrorsX: internal error", _state); - if( datasettype==0 ) - { - ae_v_move(&pbuf->x.ptr.p_double[0], 1, &densexy->ptr.pp_double[srcidx][0], 1, ae_v_len(0,nin-1)); - } - if( datasettype==1 ) - { - sparsegetrow(sparsexy, srcidx, &pbuf->x, _state); - } - mlpeprocess(ensemble, &pbuf->x, &pbuf->y, _state); - if( mlpissoftmax(&ensemble->network, _state) ) - { - if( datasettype==0 ) - { - pbuf->desiredy.ptr.p_double[0] = densexy->ptr.pp_double[srcidx][nin]; - } - if( datasettype==1 ) - { - pbuf->desiredy.ptr.p_double[0] = sparseget(sparsexy, srcidx, nin, _state); - } - } - else - { - if( datasettype==0 ) - { - ae_v_move(&pbuf->desiredy.ptr.p_double[0], 1, &densexy->ptr.pp_double[srcidx][nin], 1, ae_v_len(0,nout-1)); - } - if( datasettype==1 ) - { - for(j=0; j<=nout-1; j++) - { - pbuf->desiredy.ptr.p_double[j] = sparseget(sparsexy, srcidx, nin+j, _state); - } - } - } - dserraccumulate(&pbuf->tmp0, &pbuf->y, &pbuf->desiredy, _state); - } - dserrfinish(&pbuf->tmp0, _state); - rep->relclserror = pbuf->tmp0.ptr.p_double[0]; - rep->avgce = pbuf->tmp0.ptr.p_double[1]/ae_log(2, _state); - rep->rmserror = pbuf->tmp0.ptr.p_double[2]; - rep->avgerror = pbuf->tmp0.ptr.p_double[3]; - rep->avgrelerror = pbuf->tmp0.ptr.p_double[4]; - ae_shared_pool_recycle(buf, &_pbuf, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Calculation of all types of errors on dataset given by sparse matrix - - -- ALGLIB -- - Copyright 10.09.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpeallerrorssparse(mlpensemble* ensemble, - sparsematrix* xy, - ae_int_t npoints, - double* relcls, - double* avgce, - double* rms, - double* avg, - double* avgrel, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_vector buf; - ae_vector workx; - ae_vector y; - ae_vector dy; - ae_int_t nin; - ae_int_t nout; - - ae_frame_make(_state, &_frame_block); - *relcls = 0; - *avgce = 0; - *rms = 0; - *avg = 0; - *avgrel = 0; - ae_vector_init(&buf, 0, DT_REAL, _state, ae_true); - ae_vector_init(&workx, 0, DT_REAL, _state, ae_true); - ae_vector_init(&y, 0, DT_REAL, _state, ae_true); - ae_vector_init(&dy, 0, DT_REAL, _state, ae_true); - - nin = mlpgetinputscount(&ensemble->network, _state); - nout = mlpgetoutputscount(&ensemble->network, _state); - if( mlpissoftmax(&ensemble->network, _state) ) - { - ae_vector_set_length(&dy, 1, _state); - dserrallocate(nout, &buf, _state); - } - else - { - ae_vector_set_length(&dy, nout, _state); - dserrallocate(-nout, &buf, _state); - } - for(i=0; i<=npoints-1; i++) - { - sparsegetrow(xy, i, &workx, _state); - mlpeprocess(ensemble, &workx, &y, _state); - if( mlpissoftmax(&ensemble->network, _state) ) - { - dy.ptr.p_double[0] = workx.ptr.p_double[nin]; - } - else - { - ae_v_move(&dy.ptr.p_double[0], 1, &workx.ptr.p_double[nin], 1, ae_v_len(0,nout-1)); - } - dserraccumulate(&buf, &y, &dy, _state); - } - dserrfinish(&buf, _state); - *relcls = buf.ptr.p_double[0]; - *avgce = buf.ptr.p_double[1]; - *rms = buf.ptr.p_double[2]; - *avg = buf.ptr.p_double[3]; - *avgrel = buf.ptr.p_double[4]; - ae_frame_leave(_state); -} - - -/************************************************************************* -Relative classification error on the test set - -INPUT PARAMETERS: - Ensemble- ensemble - XY - test set - NPoints - test set size - -RESULT: - percent of incorrectly classified cases. - Works both for classifier betwork and for regression networks which -are used as classifiers. - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -double mlperelclserror(mlpensemble* ensemble, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - ae_frame _frame_block; - modelerrors rep; - double result; - - ae_frame_make(_state, &_frame_block); - _modelerrors_init(&rep, _state, ae_true); - - mlpeallerrorsx(ensemble, xy, &ensemble->network.dummysxy, npoints, 0, &ensemble->network.dummyidx, 0, npoints, 0, &ensemble->network.buf, &rep, _state); - result = rep.relclserror; - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Average cross-entropy (in bits per element) on the test set - -INPUT PARAMETERS: - Ensemble- ensemble - XY - test set - NPoints - test set size - -RESULT: - CrossEntropy/(NPoints*LN(2)). - Zero if ensemble solves regression task. - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -double mlpeavgce(mlpensemble* ensemble, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - ae_frame _frame_block; - modelerrors rep; - double result; - - ae_frame_make(_state, &_frame_block); - _modelerrors_init(&rep, _state, ae_true); - - mlpeallerrorsx(ensemble, xy, &ensemble->network.dummysxy, npoints, 0, &ensemble->network.dummyidx, 0, npoints, 0, &ensemble->network.buf, &rep, _state); - result = rep.avgce; - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -RMS error on the test set - -INPUT PARAMETERS: - Ensemble- ensemble - XY - test set - NPoints - test set size - -RESULT: - root mean square error. - Its meaning for regression task is obvious. As for classification task -RMS error means error when estimating posterior probabilities. - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -double mlpermserror(mlpensemble* ensemble, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - ae_frame _frame_block; - modelerrors rep; - double result; - - ae_frame_make(_state, &_frame_block); - _modelerrors_init(&rep, _state, ae_true); - - mlpeallerrorsx(ensemble, xy, &ensemble->network.dummysxy, npoints, 0, &ensemble->network.dummyidx, 0, npoints, 0, &ensemble->network.buf, &rep, _state); - result = rep.rmserror; - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Average error on the test set - -INPUT PARAMETERS: - Ensemble- ensemble - XY - test set - NPoints - test set size - -RESULT: - Its meaning for regression task is obvious. As for classification task -it means average error when estimating posterior probabilities. - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -double mlpeavgerror(mlpensemble* ensemble, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - ae_frame _frame_block; - modelerrors rep; - double result; - - ae_frame_make(_state, &_frame_block); - _modelerrors_init(&rep, _state, ae_true); - - mlpeallerrorsx(ensemble, xy, &ensemble->network.dummysxy, npoints, 0, &ensemble->network.dummyidx, 0, npoints, 0, &ensemble->network.buf, &rep, _state); - result = rep.avgerror; - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Average relative error on the test set - -INPUT PARAMETERS: - Ensemble- ensemble - XY - test set - NPoints - test set size - -RESULT: - Its meaning for regression task is obvious. As for classification task -it means average relative error when estimating posterior probabilities. - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -double mlpeavgrelerror(mlpensemble* ensemble, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - ae_frame _frame_block; - modelerrors rep; - double result; - - ae_frame_make(_state, &_frame_block); - _modelerrors_init(&rep, _state, ae_true); - - mlpeallerrorsx(ensemble, xy, &ensemble->network.dummysxy, npoints, 0, &ensemble->network.dummyidx, 0, npoints, 0, &ensemble->network.buf, &rep, _state); - result = rep.avgrelerror; - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Serializer: allocation - - -- ALGLIB -- - Copyright 19.10.2011 by Bochkanov Sergey -*************************************************************************/ -void mlpealloc(ae_serializer* s, mlpensemble* ensemble, ae_state *_state) -{ - - - ae_serializer_alloc_entry(s); - ae_serializer_alloc_entry(s); - ae_serializer_alloc_entry(s); - allocrealarray(s, &ensemble->weights, -1, _state); - allocrealarray(s, &ensemble->columnmeans, -1, _state); - allocrealarray(s, &ensemble->columnsigmas, -1, _state); - mlpalloc(s, &ensemble->network, _state); -} - - -/************************************************************************* -Serializer: serialization - - -- ALGLIB -- - Copyright 14.03.2011 by Bochkanov Sergey -*************************************************************************/ -void mlpeserialize(ae_serializer* s, - mlpensemble* ensemble, - ae_state *_state) -{ - - - ae_serializer_serialize_int(s, getmlpeserializationcode(_state), _state); - ae_serializer_serialize_int(s, mlpe_mlpefirstversion, _state); - ae_serializer_serialize_int(s, ensemble->ensemblesize, _state); - serializerealarray(s, &ensemble->weights, -1, _state); - serializerealarray(s, &ensemble->columnmeans, -1, _state); - serializerealarray(s, &ensemble->columnsigmas, -1, _state); - mlpserialize(s, &ensemble->network, _state); -} - - -/************************************************************************* -Serializer: unserialization - - -- ALGLIB -- - Copyright 14.03.2011 by Bochkanov Sergey -*************************************************************************/ -void mlpeunserialize(ae_serializer* s, - mlpensemble* ensemble, - ae_state *_state) -{ - ae_int_t i0; - ae_int_t i1; - - _mlpensemble_clear(ensemble); - - - /* - * check correctness of header - */ - ae_serializer_unserialize_int(s, &i0, _state); - ae_assert(i0==getmlpeserializationcode(_state), "MLPEUnserialize: stream header corrupted", _state); - ae_serializer_unserialize_int(s, &i1, _state); - ae_assert(i1==mlpe_mlpefirstversion, "MLPEUnserialize: stream header corrupted", _state); - - /* - * Create network - */ - ae_serializer_unserialize_int(s, &ensemble->ensemblesize, _state); - unserializerealarray(s, &ensemble->weights, _state); - unserializerealarray(s, &ensemble->columnmeans, _state); - unserializerealarray(s, &ensemble->columnsigmas, _state); - mlpunserialize(s, &ensemble->network, _state); - - /* - * Allocate termoraries - */ - ae_vector_set_length(&ensemble->y, mlpgetoutputscount(&ensemble->network, _state), _state); -} - - -ae_bool _mlpensemble_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - mlpensemble *p = (mlpensemble*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->weights, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->columnmeans, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->columnsigmas, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !_multilayerperceptron_init(&p->network, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->y, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _mlpensemble_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - mlpensemble *dst = (mlpensemble*)_dst; - mlpensemble *src = (mlpensemble*)_src; - dst->ensemblesize = src->ensemblesize; - if( !ae_vector_init_copy(&dst->weights, &src->weights, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->columnmeans, &src->columnmeans, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->columnsigmas, &src->columnsigmas, _state, make_automatic) ) - return ae_false; - if( !_multilayerperceptron_init_copy(&dst->network, &src->network, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->y, &src->y, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _mlpensemble_clear(void* _p) -{ - mlpensemble *p = (mlpensemble*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->weights); - ae_vector_clear(&p->columnmeans); - ae_vector_clear(&p->columnsigmas); - _multilayerperceptron_clear(&p->network); - ae_vector_clear(&p->y); -} - - -void _mlpensemble_destroy(void* _p) -{ - mlpensemble *p = (mlpensemble*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->weights); - ae_vector_destroy(&p->columnmeans); - ae_vector_destroy(&p->columnsigmas); - _multilayerperceptron_destroy(&p->network); - ae_vector_destroy(&p->y); -} - - - - -/************************************************************************* -Neural network training using modified Levenberg-Marquardt with exact -Hessian calculation and regularization. Subroutine trains neural network -with restarts from random positions. Algorithm is well suited for small -and medium scale problems (hundreds of weights). - -INPUT PARAMETERS: - Network - neural network with initialized geometry - XY - training set - NPoints - training set size - Decay - weight decay constant, >=0.001 - Decay term 'Decay*||Weights||^2' is added to error - function. - If you don't know what Decay to choose, use 0.001. - Restarts - number of restarts from random position, >0. - If you don't know what Restarts to choose, use 2. - -OUTPUT PARAMETERS: - Network - trained neural network. - Info - return code: - * -9, if internal matrix inverse subroutine failed - * -2, if there is a point with class number - outside of [0..NOut-1]. - * -1, if wrong parameters specified - (NPoints<0, Restarts<1). - * 2, if task has been solved. - Rep - training report - - -- ALGLIB -- - Copyright 10.03.2009 by Bochkanov Sergey -*************************************************************************/ -void mlptrainlm(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - double decay, - ae_int_t restarts, - ae_int_t* info, - mlpreport* rep, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - double lmsteptol; - ae_int_t i; - ae_int_t k; - double v; - double e; - double enew; - double xnorm2; - double stepnorm; - ae_vector g; - ae_vector d; - ae_matrix h; - ae_matrix hmod; - ae_matrix z; - ae_bool spd; - double nu; - double lambdav; - double lambdaup; - double lambdadown; - minlbfgsreport internalrep; - minlbfgsstate state; - ae_vector x; - ae_vector y; - ae_vector wbase; - ae_vector wdir; - ae_vector wt; - ae_vector wx; - ae_int_t pass; - ae_vector wbest; - double ebest; - ae_int_t invinfo; - matinvreport invrep; - ae_int_t solverinfo; - densesolverreport solverrep; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _mlpreport_clear(rep); - ae_vector_init(&g, 0, DT_REAL, _state, ae_true); - ae_vector_init(&d, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&h, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&hmod, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&z, 0, 0, DT_REAL, _state, ae_true); - _minlbfgsreport_init(&internalrep, _state, ae_true); - _minlbfgsstate_init(&state, _state, ae_true); - ae_vector_init(&x, 0, DT_REAL, _state, ae_true); - ae_vector_init(&y, 0, DT_REAL, _state, ae_true); - ae_vector_init(&wbase, 0, DT_REAL, _state, ae_true); - ae_vector_init(&wdir, 0, DT_REAL, _state, ae_true); - ae_vector_init(&wt, 0, DT_REAL, _state, ae_true); - ae_vector_init(&wx, 0, DT_REAL, _state, ae_true); - ae_vector_init(&wbest, 0, DT_REAL, _state, ae_true); - _matinvreport_init(&invrep, _state, ae_true); - _densesolverreport_init(&solverrep, _state, ae_true); - - mlpproperties(network, &nin, &nout, &wcount, _state); - lambdaup = 10; - lambdadown = 0.3; - lmsteptol = 0.001; - - /* - * Test for inputs - */ - if( npoints<=0||restarts<1 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - if( mlpissoftmax(network, _state) ) - { - for(i=0; i<=npoints-1; i++) - { - if( ae_round(xy->ptr.pp_double[i][nin], _state)<0||ae_round(xy->ptr.pp_double[i][nin], _state)>=nout ) - { - *info = -2; - ae_frame_leave(_state); - return; - } - } - } - decay = ae_maxreal(decay, mlptrain_mindecay, _state); - *info = 2; - - /* - * Initialize data - */ - rep->ngrad = 0; - rep->nhess = 0; - rep->ncholesky = 0; - - /* - * General case. - * Prepare task and network. Allocate space. - */ - mlpinitpreprocessor(network, xy, npoints, _state); - ae_vector_set_length(&g, wcount-1+1, _state); - ae_matrix_set_length(&h, wcount-1+1, wcount-1+1, _state); - ae_matrix_set_length(&hmod, wcount-1+1, wcount-1+1, _state); - ae_vector_set_length(&wbase, wcount-1+1, _state); - ae_vector_set_length(&wdir, wcount-1+1, _state); - ae_vector_set_length(&wbest, wcount-1+1, _state); - ae_vector_set_length(&wt, wcount-1+1, _state); - ae_vector_set_length(&wx, wcount-1+1, _state); - ebest = ae_maxrealnumber; - - /* - * Multiple passes - */ - for(pass=1; pass<=restarts; pass++) - { - - /* - * Initialize weights - */ - mlprandomize(network, _state); - - /* - * First stage of the hybrid algorithm: LBFGS - */ - ae_v_move(&wbase.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - minlbfgscreate(wcount, ae_minint(wcount, 5, _state), &wbase, &state, _state); - minlbfgssetcond(&state, 0, 0, 0, ae_maxint(25, wcount, _state), _state); - while(minlbfgsiteration(&state, _state)) - { - - /* - * gradient - */ - ae_v_move(&network->weights.ptr.p_double[0], 1, &state.x.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - mlpgradbatch(network, xy, npoints, &state.f, &state.g, _state); - - /* - * weight decay - */ - v = ae_v_dotproduct(&network->weights.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - state.f = state.f+0.5*decay*v; - ae_v_addd(&state.g.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1), decay); - - /* - * next iteration - */ - rep->ngrad = rep->ngrad+1; - } - minlbfgsresults(&state, &wbase, &internalrep, _state); - ae_v_move(&network->weights.ptr.p_double[0], 1, &wbase.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - - /* - * Second stage of the hybrid algorithm: LM - * - * Initialize H with identity matrix, - * G with gradient, - * E with regularized error. - */ - mlphessianbatch(network, xy, npoints, &e, &g, &h, _state); - v = ae_v_dotproduct(&network->weights.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - e = e+0.5*decay*v; - ae_v_addd(&g.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1), decay); - for(k=0; k<=wcount-1; k++) - { - h.ptr.pp_double[k][k] = h.ptr.pp_double[k][k]+decay; - } - rep->nhess = rep->nhess+1; - lambdav = 0.001; - nu = 2; - for(;;) - { - - /* - * 1. HMod = H+lambda*I - * 2. Try to solve (H+Lambda*I)*dx = -g. - * Increase lambda if left part is not positive definite. - */ - for(i=0; i<=wcount-1; i++) - { - ae_v_move(&hmod.ptr.pp_double[i][0], 1, &h.ptr.pp_double[i][0], 1, ae_v_len(0,wcount-1)); - hmod.ptr.pp_double[i][i] = hmod.ptr.pp_double[i][i]+lambdav; - } - spd = spdmatrixcholesky(&hmod, wcount, ae_true, _state); - rep->ncholesky = rep->ncholesky+1; - if( !spd ) - { - lambdav = lambdav*lambdaup*nu; - nu = nu*2; - continue; - } - spdmatrixcholeskysolve(&hmod, wcount, ae_true, &g, &solverinfo, &solverrep, &wdir, _state); - if( solverinfo<0 ) - { - lambdav = lambdav*lambdaup*nu; - nu = nu*2; - continue; - } - ae_v_muld(&wdir.ptr.p_double[0], 1, ae_v_len(0,wcount-1), -1); - - /* - * Lambda found. - * 1. Save old w in WBase - * 1. Test some stopping criterions - * 2. If error(w+wdir)>error(w), increase lambda - */ - ae_v_add(&network->weights.ptr.p_double[0], 1, &wdir.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - xnorm2 = ae_v_dotproduct(&network->weights.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - stepnorm = ae_v_dotproduct(&wdir.ptr.p_double[0], 1, &wdir.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - stepnorm = ae_sqrt(stepnorm, _state); - enew = mlperror(network, xy, npoints, _state)+0.5*decay*xnorm2; - if( ae_fp_less(stepnorm,lmsteptol*(1+ae_sqrt(xnorm2, _state))) ) - { - break; - } - if( ae_fp_greater(enew,e) ) - { - lambdav = lambdav*lambdaup*nu; - nu = nu*2; - continue; - } - - /* - * Optimize using inv(cholesky(H)) as preconditioner - */ - rmatrixtrinverse(&hmod, wcount, ae_true, ae_false, &invinfo, &invrep, _state); - if( invinfo<=0 ) - { - - /* - * if matrix can't be inverted then exit with errors - * TODO: make WCount steps in direction suggested by HMod - */ - *info = -9; - ae_frame_leave(_state); - return; - } - ae_v_move(&wbase.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - for(i=0; i<=wcount-1; i++) - { - wt.ptr.p_double[i] = 0; - } - minlbfgscreatex(wcount, wcount, &wt, 1, 0.0, &state, _state); - minlbfgssetcond(&state, 0, 0, 0, 5, _state); - while(minlbfgsiteration(&state, _state)) - { - - /* - * gradient - */ - for(i=0; i<=wcount-1; i++) - { - v = ae_v_dotproduct(&state.x.ptr.p_double[i], 1, &hmod.ptr.pp_double[i][i], 1, ae_v_len(i,wcount-1)); - network->weights.ptr.p_double[i] = wbase.ptr.p_double[i]+v; - } - mlpgradbatch(network, xy, npoints, &state.f, &g, _state); - for(i=0; i<=wcount-1; i++) - { - state.g.ptr.p_double[i] = 0; - } - for(i=0; i<=wcount-1; i++) - { - v = g.ptr.p_double[i]; - ae_v_addd(&state.g.ptr.p_double[i], 1, &hmod.ptr.pp_double[i][i], 1, ae_v_len(i,wcount-1), v); - } - - /* - * weight decay - * grad(x'*x) = A'*(x0+A*t) - */ - v = ae_v_dotproduct(&network->weights.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - state.f = state.f+0.5*decay*v; - for(i=0; i<=wcount-1; i++) - { - v = decay*network->weights.ptr.p_double[i]; - ae_v_addd(&state.g.ptr.p_double[i], 1, &hmod.ptr.pp_double[i][i], 1, ae_v_len(i,wcount-1), v); - } - - /* - * next iteration - */ - rep->ngrad = rep->ngrad+1; - } - minlbfgsresults(&state, &wt, &internalrep, _state); - - /* - * Accept new position. - * Calculate Hessian - */ - for(i=0; i<=wcount-1; i++) - { - v = ae_v_dotproduct(&wt.ptr.p_double[i], 1, &hmod.ptr.pp_double[i][i], 1, ae_v_len(i,wcount-1)); - network->weights.ptr.p_double[i] = wbase.ptr.p_double[i]+v; - } - mlphessianbatch(network, xy, npoints, &e, &g, &h, _state); - v = ae_v_dotproduct(&network->weights.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - e = e+0.5*decay*v; - ae_v_addd(&g.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1), decay); - for(k=0; k<=wcount-1; k++) - { - h.ptr.pp_double[k][k] = h.ptr.pp_double[k][k]+decay; - } - rep->nhess = rep->nhess+1; - - /* - * Update lambda - */ - lambdav = lambdav*lambdadown; - nu = 2; - } - - /* - * update WBest - */ - v = ae_v_dotproduct(&network->weights.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - e = 0.5*decay*v+mlperror(network, xy, npoints, _state); - if( ae_fp_less(e,ebest) ) - { - ebest = e; - ae_v_move(&wbest.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - } - } - - /* - * copy WBest to output - */ - ae_v_move(&network->weights.ptr.p_double[0], 1, &wbest.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - ae_frame_leave(_state); -} - - -/************************************************************************* -Neural network training using L-BFGS algorithm with regularization. -Subroutine trains neural network with restarts from random positions. -Algorithm is well suited for problems of any dimensionality (memory -requirements and step complexity are linear by weights number). - -INPUT PARAMETERS: - Network - neural network with initialized geometry - XY - training set - NPoints - training set size - Decay - weight decay constant, >=0.001 - Decay term 'Decay*||Weights||^2' is added to error - function. - If you don't know what Decay to choose, use 0.001. - Restarts - number of restarts from random position, >0. - If you don't know what Restarts to choose, use 2. - WStep - stopping criterion. Algorithm stops if step size is - less than WStep. Recommended value - 0.01. Zero step - size means stopping after MaxIts iterations. - MaxIts - stopping criterion. Algorithm stops after MaxIts - iterations (NOT gradient calculations). Zero MaxIts - means stopping when step is sufficiently small. - -OUTPUT PARAMETERS: - Network - trained neural network. - Info - return code: - * -8, if both WStep=0 and MaxIts=0 - * -2, if there is a point with class number - outside of [0..NOut-1]. - * -1, if wrong parameters specified - (NPoints<0, Restarts<1). - * 2, if task has been solved. - Rep - training report - - -- ALGLIB -- - Copyright 09.12.2007 by Bochkanov Sergey -*************************************************************************/ -void mlptrainlbfgs(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - double decay, - ae_int_t restarts, - double wstep, - ae_int_t maxits, - ae_int_t* info, - mlpreport* rep, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t pass; - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - ae_vector w; - ae_vector wbest; - double e; - double v; - double ebest; - minlbfgsreport internalrep; - minlbfgsstate state; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _mlpreport_clear(rep); - ae_vector_init(&w, 0, DT_REAL, _state, ae_true); - ae_vector_init(&wbest, 0, DT_REAL, _state, ae_true); - _minlbfgsreport_init(&internalrep, _state, ae_true); - _minlbfgsstate_init(&state, _state, ae_true); - - - /* - * Test inputs, parse flags, read network geometry - */ - if( ae_fp_eq(wstep,0)&&maxits==0 ) - { - *info = -8; - ae_frame_leave(_state); - return; - } - if( ((npoints<=0||restarts<1)||ae_fp_less(wstep,0))||maxits<0 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - mlpproperties(network, &nin, &nout, &wcount, _state); - if( mlpissoftmax(network, _state) ) - { - for(i=0; i<=npoints-1; i++) - { - if( ae_round(xy->ptr.pp_double[i][nin], _state)<0||ae_round(xy->ptr.pp_double[i][nin], _state)>=nout ) - { - *info = -2; - ae_frame_leave(_state); - return; - } - } - } - decay = ae_maxreal(decay, mlptrain_mindecay, _state); - *info = 2; - - /* - * Prepare - */ - mlpinitpreprocessor(network, xy, npoints, _state); - ae_vector_set_length(&w, wcount-1+1, _state); - ae_vector_set_length(&wbest, wcount-1+1, _state); - ebest = ae_maxrealnumber; - - /* - * Multiple starts - */ - rep->ncholesky = 0; - rep->nhess = 0; - rep->ngrad = 0; - for(pass=1; pass<=restarts; pass++) - { - - /* - * Process - */ - mlprandomize(network, _state); - ae_v_move(&w.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - minlbfgscreate(wcount, ae_minint(wcount, 10, _state), &w, &state, _state); - minlbfgssetcond(&state, 0.0, 0.0, wstep, maxits, _state); - while(minlbfgsiteration(&state, _state)) - { - ae_v_move(&network->weights.ptr.p_double[0], 1, &state.x.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - mlpgradnbatch(network, xy, npoints, &state.f, &state.g, _state); - v = ae_v_dotproduct(&network->weights.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - state.f = state.f+0.5*decay*v; - ae_v_addd(&state.g.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1), decay); - rep->ngrad = rep->ngrad+1; - } - minlbfgsresults(&state, &w, &internalrep, _state); - ae_v_move(&network->weights.ptr.p_double[0], 1, &w.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - - /* - * Compare with best - */ - v = ae_v_dotproduct(&network->weights.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - e = mlperrorn(network, xy, npoints, _state)+0.5*decay*v; - if( ae_fp_less(e,ebest) ) - { - ae_v_move(&wbest.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - ebest = e; - } - } - - /* - * The best network - */ - ae_v_move(&network->weights.ptr.p_double[0], 1, &wbest.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - ae_frame_leave(_state); -} - - -/************************************************************************* -Neural network training using early stopping (base algorithm - L-BFGS with -regularization). - -INPUT PARAMETERS: - Network - neural network with initialized geometry - TrnXY - training set - TrnSize - training set size, TrnSize>0 - ValXY - validation set - ValSize - validation set size, ValSize>0 - Decay - weight decay constant, >=0.001 - Decay term 'Decay*||Weights||^2' is added to error - function. - If you don't know what Decay to choose, use 0.001. - Restarts - number of restarts, either: - * strictly positive number - algorithm make specified - number of restarts from random position. - * -1, in which case algorithm makes exactly one run - from the initial state of the network (no randomization). - If you don't know what Restarts to choose, choose one - one the following: - * -1 (deterministic start) - * +1 (one random restart) - * +5 (moderate amount of random restarts) - -OUTPUT PARAMETERS: - Network - trained neural network. - Info - return code: - * -2, if there is a point with class number - outside of [0..NOut-1]. - * -1, if wrong parameters specified - (NPoints<0, Restarts<1, ...). - * 2, task has been solved, stopping criterion met - - sufficiently small step size. Not expected (we - use EARLY stopping) but possible and not an - error. - * 6, task has been solved, stopping criterion met - - increasing of validation set error. - Rep - training report - -NOTE: - -Algorithm stops if validation set error increases for a long enough or -step size is small enought (there are task where validation set may -decrease for eternity). In any case solution returned corresponds to the -minimum of validation set error. - - -- ALGLIB -- - Copyright 10.03.2009 by Bochkanov Sergey -*************************************************************************/ -void mlptraines(multilayerperceptron* network, - /* Real */ ae_matrix* trnxy, - ae_int_t trnsize, - /* Real */ ae_matrix* valxy, - ae_int_t valsize, - double decay, - ae_int_t restarts, - ae_int_t* info, - mlpreport* rep, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t pass; - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - ae_vector w; - ae_vector wbest; - double e; - double v; - double ebest; - ae_vector wfinal; - double efinal; - ae_int_t itcnt; - ae_int_t itbest; - minlbfgsreport internalrep; - minlbfgsstate state; - double wstep; - ae_bool needrandomization; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _mlpreport_clear(rep); - ae_vector_init(&w, 0, DT_REAL, _state, ae_true); - ae_vector_init(&wbest, 0, DT_REAL, _state, ae_true); - ae_vector_init(&wfinal, 0, DT_REAL, _state, ae_true); - _minlbfgsreport_init(&internalrep, _state, ae_true); - _minlbfgsstate_init(&state, _state, ae_true); - - wstep = 0.001; - - /* - * Test inputs, parse flags, read network geometry - */ - if( ((trnsize<=0||valsize<=0)||(restarts<1&&restarts!=-1))||ae_fp_less(decay,0) ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - if( restarts==-1 ) - { - needrandomization = ae_false; - restarts = 1; - } - else - { - needrandomization = ae_true; - } - mlpproperties(network, &nin, &nout, &wcount, _state); - if( mlpissoftmax(network, _state) ) - { - for(i=0; i<=trnsize-1; i++) - { - if( ae_round(trnxy->ptr.pp_double[i][nin], _state)<0||ae_round(trnxy->ptr.pp_double[i][nin], _state)>=nout ) - { - *info = -2; - ae_frame_leave(_state); - return; - } - } - for(i=0; i<=valsize-1; i++) - { - if( ae_round(valxy->ptr.pp_double[i][nin], _state)<0||ae_round(valxy->ptr.pp_double[i][nin], _state)>=nout ) - { - *info = -2; - ae_frame_leave(_state); - return; - } - } - } - *info = 2; - - /* - * Prepare - */ - mlpinitpreprocessor(network, trnxy, trnsize, _state); - ae_vector_set_length(&w, wcount-1+1, _state); - ae_vector_set_length(&wbest, wcount-1+1, _state); - ae_vector_set_length(&wfinal, wcount-1+1, _state); - efinal = ae_maxrealnumber; - for(i=0; i<=wcount-1; i++) - { - wfinal.ptr.p_double[i] = 0; - } - - /* - * Multiple starts - */ - rep->ncholesky = 0; - rep->nhess = 0; - rep->ngrad = 0; - for(pass=1; pass<=restarts; pass++) - { - - /* - * Process - */ - if( needrandomization ) - { - mlprandomize(network, _state); - } - ebest = mlperror(network, valxy, valsize, _state); - ae_v_move(&wbest.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - itbest = 0; - itcnt = 0; - ae_v_move(&w.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - minlbfgscreate(wcount, ae_minint(wcount, 10, _state), &w, &state, _state); - minlbfgssetcond(&state, 0.0, 0.0, wstep, 0, _state); - minlbfgssetxrep(&state, ae_true, _state); - while(minlbfgsiteration(&state, _state)) - { - - /* - * Calculate gradient - */ - if( state.needfg ) - { - ae_v_move(&network->weights.ptr.p_double[0], 1, &state.x.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - mlpgradnbatch(network, trnxy, trnsize, &state.f, &state.g, _state); - v = ae_v_dotproduct(&network->weights.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - state.f = state.f+0.5*decay*v; - ae_v_addd(&state.g.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1), decay); - rep->ngrad = rep->ngrad+1; - } - - /* - * Validation set - */ - if( state.xupdated ) - { - ae_v_move(&network->weights.ptr.p_double[0], 1, &state.x.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - e = mlperror(network, valxy, valsize, _state); - if( ae_fp_less(e,ebest) ) - { - ebest = e; - ae_v_move(&wbest.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - itbest = itcnt; - } - if( itcnt>30&&ae_fp_greater(itcnt,1.5*itbest) ) - { - *info = 6; - break; - } - itcnt = itcnt+1; - } - } - minlbfgsresults(&state, &w, &internalrep, _state); - - /* - * Compare with final answer - */ - if( ae_fp_less(ebest,efinal) ) - { - ae_v_move(&wfinal.ptr.p_double[0], 1, &wbest.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - efinal = ebest; - } - } - - /* - * The best network - */ - ae_v_move(&network->weights.ptr.p_double[0], 1, &wfinal.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - ae_frame_leave(_state); -} - - -/************************************************************************* -Cross-validation estimate of generalization error. - -Base algorithm - L-BFGS. - -INPUT PARAMETERS: - Network - neural network with initialized geometry. Network is - not changed during cross-validation - it is used only - as a representative of its architecture. - XY - training set. - SSize - training set size - Decay - weight decay, same as in MLPTrainLBFGS - Restarts - number of restarts, >0. - restarts are counted for each partition separately, so - total number of restarts will be Restarts*FoldsCount. - WStep - stopping criterion, same as in MLPTrainLBFGS - MaxIts - stopping criterion, same as in MLPTrainLBFGS - FoldsCount - number of folds in k-fold cross-validation, - 2<=FoldsCount<=SSize. - recommended value: 10. - -OUTPUT PARAMETERS: - Info - return code, same as in MLPTrainLBFGS - Rep - report, same as in MLPTrainLM/MLPTrainLBFGS - CVRep - generalization error estimates - - -- ALGLIB -- - Copyright 09.12.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpkfoldcvlbfgs(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - double decay, - ae_int_t restarts, - double wstep, - ae_int_t maxits, - ae_int_t foldscount, - ae_int_t* info, - mlpreport* rep, - mlpcvreport* cvrep, - ae_state *_state) -{ - - *info = 0; - _mlpreport_clear(rep); - _mlpcvreport_clear(cvrep); - - mlptrain_mlpkfoldcvgeneral(network, xy, npoints, decay, restarts, foldscount, ae_false, wstep, maxits, info, rep, cvrep, _state); -} - - -/************************************************************************* -Cross-validation estimate of generalization error. - -Base algorithm - Levenberg-Marquardt. - -INPUT PARAMETERS: - Network - neural network with initialized geometry. Network is - not changed during cross-validation - it is used only - as a representative of its architecture. - XY - training set. - SSize - training set size - Decay - weight decay, same as in MLPTrainLBFGS - Restarts - number of restarts, >0. - restarts are counted for each partition separately, so - total number of restarts will be Restarts*FoldsCount. - FoldsCount - number of folds in k-fold cross-validation, - 2<=FoldsCount<=SSize. - recommended value: 10. - -OUTPUT PARAMETERS: - Info - return code, same as in MLPTrainLBFGS - Rep - report, same as in MLPTrainLM/MLPTrainLBFGS - CVRep - generalization error estimates - - -- ALGLIB -- - Copyright 09.12.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpkfoldcvlm(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - double decay, - ae_int_t restarts, - ae_int_t foldscount, - ae_int_t* info, - mlpreport* rep, - mlpcvreport* cvrep, - ae_state *_state) -{ - - *info = 0; - _mlpreport_clear(rep); - _mlpcvreport_clear(cvrep); - - mlptrain_mlpkfoldcvgeneral(network, xy, npoints, decay, restarts, foldscount, ae_true, 0.0, 0, info, rep, cvrep, _state); -} - - -/************************************************************************* -This function estimates generalization error using cross-validation on the -current dataset with current training settings. - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support (C++ computational core) - ! - ! Second improvement gives constant speedup (2-3X). First improvement - ! gives close-to-linear speedup on multicore systems. Following - ! operations can be executed in parallel: - ! * FoldsCount cross-validation rounds (always) - ! * NRestarts training sessions performed within each of - ! cross-validation rounds (if NRestarts>1) - ! * gradient calculation over large dataset (if dataset is large enough) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - -INPUT PARAMETERS: - S - trainer object - Network - neural network. It must have same number of inputs and - output/classes as was specified during creation of the - trainer object. Network is not changed during cross- - validation and is not trained - it is used only as - representative of its architecture. I.e., we estimate - generalization properties of ARCHITECTURE, not some - specific network. - NRestarts - number of restarts, >=0: - * NRestarts>0 means that for each cross-validation - round specified number of random restarts is - performed, with best network being chosen after - training. - * NRestarts=0 is same as NRestarts=1 - FoldsCount - number of folds in k-fold cross-validation: - * 2<=FoldsCount<=size of dataset - * recommended value: 10. - * values larger than dataset size will be silently - truncated down to dataset size - -OUTPUT PARAMETERS: - Rep - structure which contains cross-validation estimates: - * Rep.RelCLSError - fraction of misclassified cases. - * Rep.AvgCE - acerage cross-entropy - * Rep.RMSError - root-mean-square error - * Rep.AvgError - average error - * Rep.AvgRelError - average relative error - -NOTE: when no dataset was specified with MLPSetDataset/SetSparseDataset(), - or subset with only one point was given, zeros are returned as - estimates. - -NOTE: this method performs FoldsCount cross-validation rounds, each one - with NRestarts random starts. Thus, FoldsCount*NRestarts networks - are trained in total. - -NOTE: Rep.RelCLSError/Rep.AvgCE are zero on regression problems. - -NOTE: on classification problems Rep.RMSError/Rep.AvgError/Rep.AvgRelError - contain errors in prediction of posterior probabilities. - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpkfoldcv(mlptrainer* s, - multilayerperceptron* network, - ae_int_t nrestarts, - ae_int_t foldscount, - mlpreport* rep, - ae_state *_state) -{ - ae_frame _frame_block; - ae_shared_pool pooldatacv; - mlpparallelizationcv datacv; - mlpparallelizationcv *sdatacv; - ae_smart_ptr _sdatacv; - ae_matrix cvy; - ae_vector folds; - ae_vector buf; - ae_vector dy; - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - ae_int_t rowsize; - ae_int_t ntype; - ae_int_t ttype; - ae_int_t i; - ae_int_t j; - ae_int_t k; - hqrndstate rs; - - ae_frame_make(_state, &_frame_block); - _mlpreport_clear(rep); - ae_shared_pool_init(&pooldatacv, _state, ae_true); - _mlpparallelizationcv_init(&datacv, _state, ae_true); - ae_smart_ptr_init(&_sdatacv, (void**)&sdatacv, _state, ae_true); - ae_matrix_init(&cvy, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&folds, 0, DT_INT, _state, ae_true); - ae_vector_init(&buf, 0, DT_REAL, _state, ae_true); - ae_vector_init(&dy, 0, DT_REAL, _state, ae_true); - _hqrndstate_init(&rs, _state, ae_true); - - if( !mlpissoftmax(network, _state) ) - { - ntype = 0; - } - else - { - ntype = 1; - } - if( s->rcpar ) - { - ttype = 0; - } - else - { - ttype = 1; - } - ae_assert(ntype==ttype, "MLPKFoldCV: type of input network is not similar to network type in trainer object", _state); - ae_assert(s->npoints>=0, "MLPKFoldCV: possible trainer S is not initialized(S.NPoints<0)", _state); - mlpproperties(network, &nin, &nout, &wcount, _state); - ae_assert(s->nin==nin, "MLPKFoldCV: number of inputs in trainer is not equal to number of inputs in network", _state); - ae_assert(s->nout==nout, "MLPKFoldCV: number of outputs in trainer is not equal to number of outputs in network", _state); - ae_assert(nrestarts>=0, "MLPKFoldCV: NRestarts<0", _state); - ae_assert(foldscount>=2, "MLPKFoldCV: FoldsCount<2", _state); - if( foldscount>s->npoints ) - { - foldscount = s->npoints; - } - rep->relclserror = 0; - rep->avgce = 0; - rep->rmserror = 0; - rep->avgerror = 0; - rep->avgrelerror = 0; - hqrndrandomize(&rs, _state); - rep->ngrad = 0; - rep->nhess = 0; - rep->ncholesky = 0; - if( s->npoints==0||s->npoints==1 ) - { - ae_frame_leave(_state); - return; - } - - /* - * Read network geometry, test parameters - */ - if( s->rcpar ) - { - rowsize = nin+nout; - ae_vector_set_length(&dy, nout, _state); - dserrallocate(-nout, &buf, _state); - } - else - { - rowsize = nin+1; - ae_vector_set_length(&dy, 1, _state); - dserrallocate(nout, &buf, _state); - } - - /* - * Folds - */ - ae_vector_set_length(&folds, s->npoints, _state); - for(i=0; i<=s->npoints-1; i++) - { - folds.ptr.p_int[i] = i*foldscount/s->npoints; - } - for(i=0; i<=s->npoints-2; i++) - { - j = i+hqrnduniformi(&rs, s->npoints-i, _state); - if( j!=i ) - { - k = folds.ptr.p_int[i]; - folds.ptr.p_int[i] = folds.ptr.p_int[j]; - folds.ptr.p_int[j] = k; - } - } - ae_matrix_set_length(&cvy, s->npoints, nout, _state); - - /* - * Initialize SEED-value for shared pool - */ - datacv.ngrad = 0; - mlpcopy(network, &datacv.network, _state); - ae_vector_set_length(&datacv.subset, s->npoints, _state); - ae_vector_set_length(&datacv.xyrow, rowsize, _state); - ae_vector_set_length(&datacv.y, nout, _state); - - /* - * Create shared pool - */ - ae_shared_pool_set_seed(&pooldatacv, &datacv, sizeof(datacv), _mlpparallelizationcv_init, _mlpparallelizationcv_init_copy, _mlpparallelizationcv_destroy, _state); - - /* - * Parallelization - */ - mlptrain_mthreadcv(s, rowsize, nrestarts, &folds, 0, foldscount, &cvy, &pooldatacv, _state); - - /* - * Calculate value for NGrad - */ - ae_shared_pool_first_recycled(&pooldatacv, &_sdatacv, _state); - while(sdatacv!=NULL) - { - rep->ngrad = rep->ngrad+sdatacv->ngrad; - ae_shared_pool_next_recycled(&pooldatacv, &_sdatacv, _state); - } - - /* - * Connect of results and calculate cross-validation error - */ - for(i=0; i<=s->npoints-1; i++) - { - if( s->datatype==0 ) - { - ae_v_move(&datacv.xyrow.ptr.p_double[0], 1, &s->densexy.ptr.pp_double[i][0], 1, ae_v_len(0,rowsize-1)); - } - if( s->datatype==1 ) - { - sparsegetrow(&s->sparsexy, i, &datacv.xyrow, _state); - } - ae_v_move(&datacv.y.ptr.p_double[0], 1, &cvy.ptr.pp_double[i][0], 1, ae_v_len(0,nout-1)); - if( s->rcpar ) - { - ae_v_move(&dy.ptr.p_double[0], 1, &datacv.xyrow.ptr.p_double[nin], 1, ae_v_len(0,nout-1)); - } - else - { - dy.ptr.p_double[0] = datacv.xyrow.ptr.p_double[nin]; - } - dserraccumulate(&buf, &datacv.y, &dy, _state); - } - dserrfinish(&buf, _state); - rep->relclserror = buf.ptr.p_double[0]; - rep->avgce = buf.ptr.p_double[1]; - rep->rmserror = buf.ptr.p_double[2]; - rep->avgerror = buf.ptr.p_double[3]; - rep->avgrelerror = buf.ptr.p_double[4]; - ae_frame_leave(_state); -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -void _pexec_mlpkfoldcv(mlptrainer* s, - multilayerperceptron* network, - ae_int_t nrestarts, - ae_int_t foldscount, - mlpreport* rep, ae_state *_state) -{ - mlpkfoldcv(s,network,nrestarts,foldscount,rep, _state); -} - - -/************************************************************************* -Creation of the network trainer object for regression networks - -INPUT PARAMETERS: - NIn - number of inputs, NIn>=1 - NOut - number of outputs, NOut>=1 - -OUTPUT PARAMETERS: - S - neural network trainer object. - This structure can be used to train any regression - network with NIn inputs and NOut outputs. - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpcreatetrainer(ae_int_t nin, - ae_int_t nout, - mlptrainer* s, - ae_state *_state) -{ - - _mlptrainer_clear(s); - - ae_assert(nin>=1, "MLPCreateTrainer: NIn<1.", _state); - ae_assert(nout>=1, "MLPCreateTrainer: NOut<1.", _state); - s->nin = nin; - s->nout = nout; - s->rcpar = ae_true; - s->lbfgsfactor = mlptrain_defaultlbfgsfactor; - s->decay = 1.0E-6; - mlpsetcond(s, 0, 0, _state); - s->datatype = 0; - s->npoints = 0; - mlpsetalgobatch(s, _state); -} - - -/************************************************************************* -Creation of the network trainer object for classification networks - -INPUT PARAMETERS: - NIn - number of inputs, NIn>=1 - NClasses - number of classes, NClasses>=2 - -OUTPUT PARAMETERS: - S - neural network trainer object. - This structure can be used to train any classification - network with NIn inputs and NOut outputs. - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpcreatetrainercls(ae_int_t nin, - ae_int_t nclasses, - mlptrainer* s, - ae_state *_state) -{ - - _mlptrainer_clear(s); - - ae_assert(nin>=1, "MLPCreateTrainerCls: NIn<1.", _state); - ae_assert(nclasses>=2, "MLPCreateTrainerCls: NClasses<2.", _state); - s->nin = nin; - s->nout = nclasses; - s->rcpar = ae_false; - s->lbfgsfactor = mlptrain_defaultlbfgsfactor; - s->decay = 1.0E-6; - mlpsetcond(s, 0, 0, _state); - s->datatype = 0; - s->npoints = 0; - mlpsetalgobatch(s, _state); -} - - -/************************************************************************* -This function sets "current dataset" of the trainer object to one passed -by user. - -INPUT PARAMETERS: - S - trainer object - XY - training set, see below for information on the - training set format. This function checks correctness - of the dataset (no NANs/INFs, class numbers are - correct) and throws exception when incorrect dataset - is passed. - NPoints - points count, >=0. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -datasetformat is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpsetdataset(mlptrainer* s, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - ae_int_t ndim; - ae_int_t i; - ae_int_t j; - - - ae_assert(s->nin>=1, "MLPSetDataset: possible parameter S is not initialized or spoiled(S.NIn<=0).", _state); - ae_assert(npoints>=0, "MLPSetDataset: NPoint<0", _state); - ae_assert(npoints<=xy->rows, "MLPSetDataset: invalid size of matrix XY(NPoint more then rows of matrix XY)", _state); - s->datatype = 0; - s->npoints = npoints; - if( npoints==0 ) - { - return; - } - if( s->rcpar ) - { - ae_assert(s->nout>=1, "MLPSetDataset: possible parameter S is not initialized or is spoiled(NOut<1 for regression).", _state); - ndim = s->nin+s->nout; - ae_assert(ndim<=xy->cols, "MLPSetDataset: invalid size of matrix XY(too few columns in matrix XY).", _state); - ae_assert(apservisfinitematrix(xy, npoints, ndim, _state), "MLPSetDataset: parameter XY contains Infinite or NaN.", _state); - } - else - { - ae_assert(s->nout>=2, "MLPSetDataset: possible parameter S is not initialized or is spoiled(NClasses<2 for classifier).", _state); - ndim = s->nin+1; - ae_assert(ndim<=xy->cols, "MLPSetDataset: invalid size of matrix XY(too few columns in matrix XY).", _state); - ae_assert(apservisfinitematrix(xy, npoints, ndim, _state), "MLPSetDataset: parameter XY contains Infinite or NaN.", _state); - for(i=0; i<=npoints-1; i++) - { - ae_assert(ae_round(xy->ptr.pp_double[i][s->nin], _state)>=0&&ae_round(xy->ptr.pp_double[i][s->nin], _state)nout, "MLPSetDataset: invalid parameter XY(in classifier used nonexistent class number: either XY[.,NIn]<0 or XY[.,NIn]>=NClasses).", _state); - } - } - rmatrixsetlengthatleast(&s->densexy, npoints, ndim, _state); - for(i=0; i<=npoints-1; i++) - { - for(j=0; j<=ndim-1; j++) - { - s->densexy.ptr.pp_double[i][j] = xy->ptr.pp_double[i][j]; - } - } -} - - -/************************************************************************* -This function sets "current dataset" of the trainer object to one passed -by user (sparse matrix is used to store dataset). - -INPUT PARAMETERS: - S - trainer object - XY - training set, see below for information on the - training set format. This function checks correctness - of the dataset (no NANs/INFs, class numbers are - correct) and throws exception when incorrect dataset - is passed. Any sparse storage format can be used: - Hash-table, CRS... - NPoints - points count, >=0 - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -datasetformat is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpsetsparsedataset(mlptrainer* s, - sparsematrix* xy, - ae_int_t npoints, - ae_state *_state) -{ - double v; - ae_int_t t0; - ae_int_t t1; - ae_int_t i; - ae_int_t j; - - - - /* - * Check correctness of the data - */ - ae_assert(s->nin>0, "MLPSetSparseDataset: possible parameter S is not initialized or spoiled(S.NIn<=0).", _state); - ae_assert(npoints>=0, "MLPSetSparseDataset: NPoint<0", _state); - ae_assert(npoints<=sparsegetnrows(xy, _state), "MLPSetSparseDataset: invalid size of sparse matrix XY(NPoint more then rows of matrix XY)", _state); - if( npoints>0 ) - { - t0 = 0; - t1 = 0; - if( s->rcpar ) - { - ae_assert(s->nout>=1, "MLPSetSparseDataset: possible parameter S is not initialized or is spoiled(NOut<1 for regression).", _state); - ae_assert(s->nin+s->nout<=sparsegetncols(xy, _state), "MLPSetSparseDataset: invalid size of sparse matrix XY(too few columns in sparse matrix XY).", _state); - while(sparseenumerate(xy, &t0, &t1, &i, &j, &v, _state)) - { - if( inin+s->nout ) - { - ae_assert(ae_isfinite(v, _state), "MLPSetSparseDataset: sparse matrix XY contains Infinite or NaN.", _state); - } - } - } - else - { - ae_assert(s->nout>=2, "MLPSetSparseDataset: possible parameter S is not initialized or is spoiled(NClasses<2 for classifier).", _state); - ae_assert(s->nin+1<=sparsegetncols(xy, _state), "MLPSetSparseDataset: invalid size of sparse matrix XY(too few columns in sparse matrix XY).", _state); - while(sparseenumerate(xy, &t0, &t1, &i, &j, &v, _state)) - { - if( inin ) - { - if( j!=s->nin ) - { - ae_assert(ae_isfinite(v, _state), "MLPSetSparseDataset: sparse matrix XY contains Infinite or NaN.", _state); - } - else - { - ae_assert((ae_isfinite(v, _state)&&ae_round(v, _state)>=0)&&ae_round(v, _state)nout, "MLPSetSparseDataset: invalid sparse matrix XY(in classifier used nonexistent class number: either XY[.,NIn]<0 or XY[.,NIn]>=NClasses).", _state); - } - } - } - } - } - - /* - * Set dataset - */ - s->datatype = 1; - s->npoints = npoints; - sparsecopytocrs(xy, &s->sparsexy, _state); -} - - -/************************************************************************* -This function sets weight decay coefficient which is used for training. - -INPUT PARAMETERS: - S - trainer object - Decay - weight decay coefficient, >=0. Weight decay term - 'Decay*||Weights||^2' is added to error function. If - you don't know what Decay to choose, use 1.0E-3. - Weight decay can be set to zero, in this case network - is trained without weight decay. - -NOTE: by default network uses some small nonzero value for weight decay. - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpsetdecay(mlptrainer* s, double decay, ae_state *_state) -{ - - - ae_assert(ae_isfinite(decay, _state), "MLPSetDecay: parameter Decay contains Infinite or NaN.", _state); - ae_assert(ae_fp_greater_eq(decay,0), "MLPSetDecay: Decay<0.", _state); - s->decay = decay; -} - - -/************************************************************************* -This function sets stopping criteria for the optimizer. - -INPUT PARAMETERS: - S - trainer object - WStep - stopping criterion. Algorithm stops if step size is - less than WStep. Recommended value - 0.01. Zero step - size means stopping after MaxIts iterations. - WStep>=0. - MaxIts - stopping criterion. Algorithm stops after MaxIts - epochs (full passes over entire dataset). Zero MaxIts - means stopping when step is sufficiently small. - MaxIts>=0. - -NOTE: by default, WStep=0.005 and MaxIts=0 are used. These values are also - used when MLPSetCond() is called with WStep=0 and MaxIts=0. - -NOTE: these stopping criteria are used for all kinds of neural training - - from "conventional" networks to early stopping ensembles. When used - for "conventional" networks, they are used as the only stopping - criteria. When combined with early stopping, they used as ADDITIONAL - stopping criteria which can terminate early stopping algorithm. - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpsetcond(mlptrainer* s, - double wstep, - ae_int_t maxits, - ae_state *_state) -{ - - - ae_assert(ae_isfinite(wstep, _state), "MLPSetCond: parameter WStep contains Infinite or NaN.", _state); - ae_assert(ae_fp_greater_eq(wstep,0), "MLPSetCond: WStep<0.", _state); - ae_assert(maxits>=0, "MLPSetCond: MaxIts<0.", _state); - if( ae_fp_neq(wstep,0)||maxits!=0 ) - { - s->wstep = wstep; - s->maxits = maxits; - } - else - { - s->wstep = 0.005; - s->maxits = 0; - } -} - - -/************************************************************************* -This function sets training algorithm: batch training using L-BFGS will be -used. - -This algorithm: -* the most robust for small-scale problems, but may be too slow for large - scale ones. -* perfoms full pass through the dataset before performing step -* uses conditions specified by MLPSetCond() for stopping -* is default one used by trainer object - -INPUT PARAMETERS: - S - trainer object - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpsetalgobatch(mlptrainer* s, ae_state *_state) -{ - - - s->algokind = 0; -} - - -/************************************************************************* -This function trains neural network passed to this function, using current -dataset (one which was passed to MLPSetDataset() or MLPSetSparseDataset()) -and current training settings. Training from NRestarts random starting -positions is performed, best network is chosen. - -Training is performed using current training algorithm. - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support (C++ computational core) - ! - ! Second improvement gives constant speedup (2-3X). First improvement - ! gives close-to-linear speedup on multicore systems. Following - ! operations can be executed in parallel: - ! * NRestarts training sessions performed within each of - ! cross-validation rounds (if NRestarts>1) - ! * gradient calculation over large dataset (if dataset is large enough) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - -INPUT PARAMETERS: - S - trainer object - Network - neural network. It must have same number of inputs and - output/classes as was specified during creation of the - trainer object. - NRestarts - number of restarts, >=0: - * NRestarts>0 means that specified number of random - restarts are performed, best network is chosen after - training - * NRestarts=0 means that current state of the network - is used for training. - -OUTPUT PARAMETERS: - Network - trained network - -NOTE: when no dataset was specified with MLPSetDataset/SetSparseDataset(), - network is filled by zero values. Same behavior for functions - MLPStartTraining and MLPContinueTraining. - -NOTE: this method uses sum-of-squares error function for training. - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlptrainnetwork(mlptrainer* s, - multilayerperceptron* network, - ae_int_t nrestarts, - mlpreport* rep, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - ae_int_t ntype; - ae_int_t ttype; - ae_shared_pool trnpool; - - ae_frame_make(_state, &_frame_block); - _mlpreport_clear(rep); - ae_shared_pool_init(&trnpool, _state, ae_true); - - ae_assert(s->npoints>=0, "MLPTrainNetwork: parameter S is not initialized or is spoiled(S.NPoints<0)", _state); - if( !mlpissoftmax(network, _state) ) - { - ntype = 0; - } - else - { - ntype = 1; - } - if( s->rcpar ) - { - ttype = 0; - } - else - { - ttype = 1; - } - ae_assert(ntype==ttype, "MLPTrainNetwork: type of input network is not similar to network type in trainer object", _state); - mlpproperties(network, &nin, &nout, &wcount, _state); - ae_assert(s->nin==nin, "MLPTrainNetwork: number of inputs in trainer is not equal to number of inputs in network", _state); - ae_assert(s->nout==nout, "MLPTrainNetwork: number of outputs in trainer is not equal to number of outputs in network", _state); - ae_assert(nrestarts>=0, "MLPTrainNetwork: NRestarts<0.", _state); - - /* - * Train - */ - mlptrain_mlptrainnetworkx(s, nrestarts, -1, &s->subset, -1, &s->subset, 0, network, rep, ae_true, &trnpool, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -void _pexec_mlptrainnetwork(mlptrainer* s, - multilayerperceptron* network, - ae_int_t nrestarts, - mlpreport* rep, ae_state *_state) -{ - mlptrainnetwork(s,network,nrestarts,rep, _state); -} - - -/************************************************************************* -IMPORTANT: this is an "expert" version of the MLPTrain() function. We do - not recommend you to use it unless you are pretty sure that you - need ability to monitor training progress. - -This function performs step-by-step training of the neural network. Here -"step-by-step" means that training starts with MLPStartTraining() call, -and then user subsequently calls MLPContinueTraining() to perform one more -iteration of the training. - -After call to this function trainer object remembers network and is ready -to train it. However, no training is performed until first call to -MLPContinueTraining() function. Subsequent calls to MLPContinueTraining() -will advance training progress one iteration further. - -EXAMPLE: - > - > ...initialize network and trainer object.... - > - > MLPStartTraining(Trainer, Network, True) - > while MLPContinueTraining(Trainer, Network) do - > ...visualize training progress... - > - -INPUT PARAMETERS: - S - trainer object - Network - neural network. It must have same number of inputs and - output/classes as was specified during creation of the - trainer object. - RandomStart - randomize network before training or not: - * True means that network is randomized and its - initial state (one which was passed to the trainer - object) is lost. - * False means that training is started from the - current state of the network - -OUTPUT PARAMETERS: - Network - neural network which is ready to training (weights are - initialized, preprocessor is initialized using current - training set) - -NOTE: this method uses sum-of-squares error function for training. - -NOTE: it is expected that trainer object settings are NOT changed during - step-by-step training, i.e. no one changes stopping criteria or - training set during training. It is possible and there is no defense - against such actions, but algorithm behavior in such cases is - undefined and can be unpredictable. - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpstarttraining(mlptrainer* s, - multilayerperceptron* network, - ae_bool randomstart, - ae_state *_state) -{ - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - ae_int_t ntype; - ae_int_t ttype; - - - ae_assert(s->npoints>=0, "MLPStartTraining: parameter S is not initialized or is spoiled(S.NPoints<0)", _state); - if( !mlpissoftmax(network, _state) ) - { - ntype = 0; - } - else - { - ntype = 1; - } - if( s->rcpar ) - { - ttype = 0; - } - else - { - ttype = 1; - } - ae_assert(ntype==ttype, "MLPStartTraining: type of input network is not similar to network type in trainer object", _state); - mlpproperties(network, &nin, &nout, &wcount, _state); - ae_assert(s->nin==nin, "MLPStartTraining: number of inputs in trainer is not equal to number of inputs in the network.", _state); - ae_assert(s->nout==nout, "MLPStartTraining: number of outputs in trainer is not equal to number of outputs in the network.", _state); - - /* - * Initialize temporaries - */ - mlptrain_initmlptrnsession(network, randomstart, s, &s->session, _state); - - /* - * Train network - */ - mlptrain_mlpstarttrainingx(s, randomstart, -1, &s->subset, -1, &s->session, _state); - - /* - * Update network - */ - mlpcopytunableparameters(&s->session.network, network, _state); -} - - -/************************************************************************* -IMPORTANT: this is an "expert" version of the MLPTrain() function. We do - not recommend you to use it unless you are pretty sure that you - need ability to monitor training progress. - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support (C++ computational core) - ! - ! Second improvement gives constant speedup (2-3X). First improvement - ! gives close-to-linear speedup on multicore systems. Following - ! operations can be executed in parallel: - ! * gradient calculation over large dataset (if dataset is large enough) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - -This function performs step-by-step training of the neural network. Here -"step-by-step" means that training starts with MLPStartTraining() call, -and then user subsequently calls MLPContinueTraining() to perform one more -iteration of the training. - -This function performs one more iteration of the training and returns -either True (training continues) or False (training stopped). In case True -was returned, Network weights are updated according to the current state -of the optimization progress. In case False was returned, no additional -updates is performed (previous update of the network weights moved us to -the final point, and no additional updates is needed). - -EXAMPLE: - > - > [initialize network and trainer object] - > - > MLPStartTraining(Trainer, Network, True) - > while MLPContinueTraining(Trainer, Network) do - > [visualize training progress] - > - -INPUT PARAMETERS: - S - trainer object - Network - neural network structure, which is used to store - current state of the training process. - -OUTPUT PARAMETERS: - Network - weights of the neural network are rewritten by the - current approximation. - -NOTE: this method uses sum-of-squares error function for training. - -NOTE: it is expected that trainer object settings are NOT changed during - step-by-step training, i.e. no one changes stopping criteria or - training set during training. It is possible and there is no defense - against such actions, but algorithm behavior in such cases is - undefined and can be unpredictable. - -NOTE: It is expected that Network is the same one which was passed to - MLPStartTraining() function. However, THIS function checks only - following: - * that number of network inputs is consistent with trainer object - settings - * that number of network outputs/classes is consistent with trainer - object settings - * that number of network weights is the same as number of weights in - the network passed to MLPStartTraining() function - Exception is thrown when these conditions are violated. - - It is also expected that you do not change state of the network on - your own - the only party who has right to change network during its - training is a trainer object. Any attempt to interfere with trainer - may lead to unpredictable results. - - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -ae_bool mlpcontinuetraining(mlptrainer* s, - multilayerperceptron* network, - ae_state *_state) -{ - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - ae_int_t ntype; - ae_int_t ttype; - ae_bool result; - - - ae_assert(s->npoints>=0, "MLPContinueTraining: parameter S is not initialized or is spoiled(S.NPoints<0)", _state); - if( s->rcpar ) - { - ttype = 0; - } - else - { - ttype = 1; - } - if( !mlpissoftmax(network, _state) ) - { - ntype = 0; - } - else - { - ntype = 1; - } - ae_assert(ntype==ttype, "MLPContinueTraining: type of input network is not similar to network type in trainer object.", _state); - mlpproperties(network, &nin, &nout, &wcount, _state); - ae_assert(s->nin==nin, "MLPContinueTraining: number of inputs in trainer is not equal to number of inputs in the network.", _state); - ae_assert(s->nout==nout, "MLPContinueTraining: number of outputs in trainer is not equal to number of outputs in the network.", _state); - result = mlptrain_mlpcontinuetrainingx(s, &s->subset, -1, &s->ngradbatch, &s->session, _state); - if( result ) - { - ae_v_move(&network->weights.ptr.p_double[0], 1, &s->session.network.weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - } - return result; -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -ae_bool _pexec_mlpcontinuetraining(mlptrainer* s, - multilayerperceptron* network, ae_state *_state) -{ - return mlpcontinuetraining(s,network, _state); -} - - -/************************************************************************* -Training neural networks ensemble using bootstrap aggregating (bagging). -Modified Levenberg-Marquardt algorithm is used as base training method. - -INPUT PARAMETERS: - Ensemble - model with initialized geometry - XY - training set - NPoints - training set size - Decay - weight decay coefficient, >=0.001 - Restarts - restarts, >0. - -OUTPUT PARAMETERS: - Ensemble - trained model - Info - return code: - * -2, if there is a point with class number - outside of [0..NClasses-1]. - * -1, if incorrect parameters was passed - (NPoints<0, Restarts<1). - * 2, if task has been solved. - Rep - training report. - OOBErrors - out-of-bag generalization error estimate - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpebagginglm(mlpensemble* ensemble, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - double decay, - ae_int_t restarts, - ae_int_t* info, - mlpreport* rep, - mlpcvreport* ooberrors, - ae_state *_state) -{ - - *info = 0; - _mlpreport_clear(rep); - _mlpcvreport_clear(ooberrors); - - mlptrain_mlpebagginginternal(ensemble, xy, npoints, decay, restarts, 0.0, 0, ae_true, info, rep, ooberrors, _state); -} - - -/************************************************************************* -Training neural networks ensemble using bootstrap aggregating (bagging). -L-BFGS algorithm is used as base training method. - -INPUT PARAMETERS: - Ensemble - model with initialized geometry - XY - training set - NPoints - training set size - Decay - weight decay coefficient, >=0.001 - Restarts - restarts, >0. - WStep - stopping criterion, same as in MLPTrainLBFGS - MaxIts - stopping criterion, same as in MLPTrainLBFGS - -OUTPUT PARAMETERS: - Ensemble - trained model - Info - return code: - * -8, if both WStep=0 and MaxIts=0 - * -2, if there is a point with class number - outside of [0..NClasses-1]. - * -1, if incorrect parameters was passed - (NPoints<0, Restarts<1). - * 2, if task has been solved. - Rep - training report. - OOBErrors - out-of-bag generalization error estimate - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpebagginglbfgs(mlpensemble* ensemble, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - double decay, - ae_int_t restarts, - double wstep, - ae_int_t maxits, - ae_int_t* info, - mlpreport* rep, - mlpcvreport* ooberrors, - ae_state *_state) -{ - - *info = 0; - _mlpreport_clear(rep); - _mlpcvreport_clear(ooberrors); - - mlptrain_mlpebagginginternal(ensemble, xy, npoints, decay, restarts, wstep, maxits, ae_false, info, rep, ooberrors, _state); -} - - -/************************************************************************* -Training neural networks ensemble using early stopping. - -INPUT PARAMETERS: - Ensemble - model with initialized geometry - XY - training set - NPoints - training set size - Decay - weight decay coefficient, >=0.001 - Restarts - restarts, >0. - -OUTPUT PARAMETERS: - Ensemble - trained model - Info - return code: - * -2, if there is a point with class number - outside of [0..NClasses-1]. - * -1, if incorrect parameters was passed - (NPoints<0, Restarts<1). - * 6, if task has been solved. - Rep - training report. - OOBErrors - out-of-bag generalization error estimate - - -- ALGLIB -- - Copyright 10.03.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpetraines(mlpensemble* ensemble, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - double decay, - ae_int_t restarts, - ae_int_t* info, - mlpreport* rep, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t k; - ae_int_t ccount; - ae_int_t pcount; - ae_matrix trnxy; - ae_matrix valxy; - ae_int_t trnsize; - ae_int_t valsize; - ae_int_t tmpinfo; - mlpreport tmprep; - modelerrors moderr; - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _mlpreport_clear(rep); - ae_matrix_init(&trnxy, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&valxy, 0, 0, DT_REAL, _state, ae_true); - _mlpreport_init(&tmprep, _state, ae_true); - _modelerrors_init(&moderr, _state, ae_true); - - nin = mlpgetinputscount(&ensemble->network, _state); - nout = mlpgetoutputscount(&ensemble->network, _state); - wcount = mlpgetweightscount(&ensemble->network, _state); - if( (npoints<2||restarts<1)||ae_fp_less(decay,0) ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - if( mlpissoftmax(&ensemble->network, _state) ) - { - for(i=0; i<=npoints-1; i++) - { - if( ae_round(xy->ptr.pp_double[i][nin], _state)<0||ae_round(xy->ptr.pp_double[i][nin], _state)>=nout ) - { - *info = -2; - ae_frame_leave(_state); - return; - } - } - } - *info = 6; - - /* - * allocate - */ - if( mlpissoftmax(&ensemble->network, _state) ) - { - ccount = nin+1; - pcount = nin; - } - else - { - ccount = nin+nout; - pcount = nin+nout; - } - ae_matrix_set_length(&trnxy, npoints, ccount, _state); - ae_matrix_set_length(&valxy, npoints, ccount, _state); - rep->ngrad = 0; - rep->nhess = 0; - rep->ncholesky = 0; - - /* - * train networks - */ - for(k=0; k<=ensemble->ensemblesize-1; k++) - { - - /* - * Split set - */ - do - { - trnsize = 0; - valsize = 0; - for(i=0; i<=npoints-1; i++) - { - if( ae_fp_less(ae_randomreal(_state),0.66) ) - { - - /* - * Assign sample to training set - */ - ae_v_move(&trnxy.ptr.pp_double[trnsize][0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,ccount-1)); - trnsize = trnsize+1; - } - else - { - - /* - * Assign sample to validation set - */ - ae_v_move(&valxy.ptr.pp_double[valsize][0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,ccount-1)); - valsize = valsize+1; - } - } - } - while(!(trnsize!=0&&valsize!=0)); - - /* - * Train - */ - mlptraines(&ensemble->network, &trnxy, trnsize, &valxy, valsize, decay, restarts, &tmpinfo, &tmprep, _state); - if( tmpinfo<0 ) - { - *info = tmpinfo; - ae_frame_leave(_state); - return; - } - - /* - * save results - */ - ae_v_move(&ensemble->weights.ptr.p_double[k*wcount], 1, &ensemble->network.weights.ptr.p_double[0], 1, ae_v_len(k*wcount,(k+1)*wcount-1)); - ae_v_move(&ensemble->columnmeans.ptr.p_double[k*pcount], 1, &ensemble->network.columnmeans.ptr.p_double[0], 1, ae_v_len(k*pcount,(k+1)*pcount-1)); - ae_v_move(&ensemble->columnsigmas.ptr.p_double[k*pcount], 1, &ensemble->network.columnsigmas.ptr.p_double[0], 1, ae_v_len(k*pcount,(k+1)*pcount-1)); - rep->ngrad = rep->ngrad+tmprep.ngrad; - rep->nhess = rep->nhess+tmprep.nhess; - rep->ncholesky = rep->ncholesky+tmprep.ncholesky; - } - mlpeallerrorsx(ensemble, xy, &ensemble->network.dummysxy, npoints, 0, &ensemble->network.dummyidx, 0, npoints, 0, &ensemble->network.buf, &moderr, _state); - rep->relclserror = moderr.relclserror; - rep->avgce = moderr.avgce; - rep->rmserror = moderr.rmserror; - rep->avgerror = moderr.avgerror; - rep->avgrelerror = moderr.avgrelerror; - ae_frame_leave(_state); -} - - -/************************************************************************* -This function trains neural network ensemble passed to this function using -current dataset and early stopping training algorithm. Each early stopping -round performs NRestarts random restarts (thus, EnsembleSize*NRestarts -training rounds is performed in total). - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support (C++ computational core) - ! - ! Second improvement gives constant speedup (2-3X). First improvement - ! gives close-to-linear speedup on multicore systems. Following - ! operations can be executed in parallel: - ! * EnsembleSize training sessions performed for each of ensemble - ! members (always parallelized) - ! * NRestarts training sessions performed within each of training - ! sessions (if NRestarts>1) - ! * gradient calculation over large dataset (if dataset is large enough) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - -INPUT PARAMETERS: - S - trainer object; - Ensemble - neural network ensemble. It must have same number of - inputs and outputs/classes as was specified during - creation of the trainer object. - NRestarts - number of restarts, >=0: - * NRestarts>0 means that specified number of random - restarts are performed during each ES round; - * NRestarts=0 is silently replaced by 1. - -OUTPUT PARAMETERS: - Ensemble - trained ensemble; - Rep - it contains all type of errors. - -NOTE: this training method uses BOTH early stopping and weight decay! So, - you should select weight decay before starting training just as you - select it before training "conventional" networks. - -NOTE: when no dataset was specified with MLPSetDataset/SetSparseDataset(), - or single-point dataset was passed, ensemble is filled by zero - values. - -NOTE: this method uses sum-of-squares error function for training. - - -- ALGLIB -- - Copyright 22.08.2012 by Bochkanov Sergey -*************************************************************************/ -void mlptrainensemblees(mlptrainer* s, - mlpensemble* ensemble, - ae_int_t nrestarts, - mlpreport* rep, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t nin; - ae_int_t nout; - ae_int_t ntype; - ae_int_t ttype; - ae_shared_pool esessions; - sinteger sgrad; - modelerrors tmprep; - - ae_frame_make(_state, &_frame_block); - _mlpreport_clear(rep); - ae_shared_pool_init(&esessions, _state, ae_true); - _sinteger_init(&sgrad, _state, ae_true); - _modelerrors_init(&tmprep, _state, ae_true); - - ae_assert(s->npoints>=0, "MLPTrainEnsembleES: parameter S is not initialized or is spoiled(S.NPoints<0)", _state); - if( !mlpeissoftmax(ensemble, _state) ) - { - ntype = 0; - } - else - { - ntype = 1; - } - if( s->rcpar ) - { - ttype = 0; - } - else - { - ttype = 1; - } - ae_assert(ntype==ttype, "MLPTrainEnsembleES: internal error - type of input network is not similar to network type in trainer object", _state); - nin = mlpgetinputscount(&ensemble->network, _state); - ae_assert(s->nin==nin, "MLPTrainEnsembleES: number of inputs in trainer is not equal to number of inputs in ensemble network", _state); - nout = mlpgetoutputscount(&ensemble->network, _state); - ae_assert(s->nout==nout, "MLPTrainEnsembleES: number of outputs in trainer is not equal to number of outputs in ensemble network", _state); - ae_assert(nrestarts>=0, "MLPTrainEnsembleES: NRestarts<0.", _state); - - /* - * Initialize parameter Rep - */ - rep->relclserror = 0; - rep->avgce = 0; - rep->rmserror = 0; - rep->avgerror = 0; - rep->avgrelerror = 0; - rep->ngrad = 0; - rep->nhess = 0; - rep->ncholesky = 0; - - /* - * Allocate - */ - ivectorsetlengthatleast(&s->subset, s->npoints, _state); - ivectorsetlengthatleast(&s->valsubset, s->npoints, _state); - - /* - * Start training - * - * NOTE: ESessions is not initialized because MLPTrainEnsembleX - * needs uninitialized pool. - */ - sgrad.val = 0; - mlptrain_mlptrainensemblex(s, ensemble, 0, ensemble->ensemblesize, nrestarts, 0, &sgrad, ae_true, &esessions, _state); - rep->ngrad = sgrad.val; - - /* - * Calculate errors. - */ - if( s->datatype==0 ) - { - mlpeallerrorsx(ensemble, &s->densexy, &s->sparsexy, s->npoints, 0, &ensemble->network.dummyidx, 0, s->npoints, 0, &ensemble->network.buf, &tmprep, _state); - } - if( s->datatype==1 ) - { - mlpeallerrorsx(ensemble, &s->densexy, &s->sparsexy, s->npoints, 1, &ensemble->network.dummyidx, 0, s->npoints, 0, &ensemble->network.buf, &tmprep, _state); - } - rep->relclserror = tmprep.relclserror; - rep->avgce = tmprep.avgce; - rep->rmserror = tmprep.rmserror; - rep->avgerror = tmprep.avgerror; - rep->avgrelerror = tmprep.avgrelerror; - ae_frame_leave(_state); -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -void _pexec_mlptrainensemblees(mlptrainer* s, - mlpensemble* ensemble, - ae_int_t nrestarts, - mlpreport* rep, ae_state *_state) -{ - mlptrainensemblees(s,ensemble,nrestarts,rep, _state); -} - - -/************************************************************************* -Internal cross-validation subroutine -*************************************************************************/ -static void mlptrain_mlpkfoldcvgeneral(multilayerperceptron* n, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - double decay, - ae_int_t restarts, - ae_int_t foldscount, - ae_bool lmalgorithm, - double wstep, - ae_int_t maxits, - ae_int_t* info, - mlpreport* rep, - mlpcvreport* cvrep, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t fold; - ae_int_t j; - ae_int_t k; - multilayerperceptron network; - ae_int_t nin; - ae_int_t nout; - ae_int_t rowlen; - ae_int_t wcount; - ae_int_t nclasses; - ae_int_t tssize; - ae_int_t cvssize; - ae_matrix cvset; - ae_matrix testset; - ae_vector folds; - ae_int_t relcnt; - mlpreport internalrep; - ae_vector x; - ae_vector y; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _mlpreport_clear(rep); - _mlpcvreport_clear(cvrep); - _multilayerperceptron_init(&network, _state, ae_true); - ae_matrix_init(&cvset, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&testset, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&folds, 0, DT_INT, _state, ae_true); - _mlpreport_init(&internalrep, _state, ae_true); - ae_vector_init(&x, 0, DT_REAL, _state, ae_true); - ae_vector_init(&y, 0, DT_REAL, _state, ae_true); - - - /* - * Read network geometry, test parameters - */ - mlpproperties(n, &nin, &nout, &wcount, _state); - if( mlpissoftmax(n, _state) ) - { - nclasses = nout; - rowlen = nin+1; - } - else - { - nclasses = -nout; - rowlen = nin+nout; - } - if( (npoints<=0||foldscount<2)||foldscount>npoints ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - mlpcopy(n, &network, _state); - - /* - * K-fold out cross-validation. - * First, estimate generalization error - */ - ae_matrix_set_length(&testset, npoints-1+1, rowlen-1+1, _state); - ae_matrix_set_length(&cvset, npoints-1+1, rowlen-1+1, _state); - ae_vector_set_length(&x, nin-1+1, _state); - ae_vector_set_length(&y, nout-1+1, _state); - mlptrain_mlpkfoldsplit(xy, npoints, nclasses, foldscount, ae_false, &folds, _state); - cvrep->relclserror = 0; - cvrep->avgce = 0; - cvrep->rmserror = 0; - cvrep->avgerror = 0; - cvrep->avgrelerror = 0; - rep->ngrad = 0; - rep->nhess = 0; - rep->ncholesky = 0; - relcnt = 0; - for(fold=0; fold<=foldscount-1; fold++) - { - - /* - * Separate set - */ - tssize = 0; - cvssize = 0; - for(i=0; i<=npoints-1; i++) - { - if( folds.ptr.p_int[i]==fold ) - { - ae_v_move(&testset.ptr.pp_double[tssize][0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,rowlen-1)); - tssize = tssize+1; - } - else - { - ae_v_move(&cvset.ptr.pp_double[cvssize][0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,rowlen-1)); - cvssize = cvssize+1; - } - } - - /* - * Train on CV training set - */ - if( lmalgorithm ) - { - mlptrainlm(&network, &cvset, cvssize, decay, restarts, info, &internalrep, _state); - } - else - { - mlptrainlbfgs(&network, &cvset, cvssize, decay, restarts, wstep, maxits, info, &internalrep, _state); - } - if( *info<0 ) - { - cvrep->relclserror = 0; - cvrep->avgce = 0; - cvrep->rmserror = 0; - cvrep->avgerror = 0; - cvrep->avgrelerror = 0; - ae_frame_leave(_state); - return; - } - rep->ngrad = rep->ngrad+internalrep.ngrad; - rep->nhess = rep->nhess+internalrep.nhess; - rep->ncholesky = rep->ncholesky+internalrep.ncholesky; - - /* - * Estimate error using CV test set - */ - if( mlpissoftmax(&network, _state) ) - { - - /* - * classification-only code - */ - cvrep->relclserror = cvrep->relclserror+mlpclserror(&network, &testset, tssize, _state); - cvrep->avgce = cvrep->avgce+mlperrorn(&network, &testset, tssize, _state); - } - for(i=0; i<=tssize-1; i++) - { - ae_v_move(&x.ptr.p_double[0], 1, &testset.ptr.pp_double[i][0], 1, ae_v_len(0,nin-1)); - mlpprocess(&network, &x, &y, _state); - if( mlpissoftmax(&network, _state) ) - { - - /* - * Classification-specific code - */ - k = ae_round(testset.ptr.pp_double[i][nin], _state); - for(j=0; j<=nout-1; j++) - { - if( j==k ) - { - cvrep->rmserror = cvrep->rmserror+ae_sqr(y.ptr.p_double[j]-1, _state); - cvrep->avgerror = cvrep->avgerror+ae_fabs(y.ptr.p_double[j]-1, _state); - cvrep->avgrelerror = cvrep->avgrelerror+ae_fabs(y.ptr.p_double[j]-1, _state); - relcnt = relcnt+1; - } - else - { - cvrep->rmserror = cvrep->rmserror+ae_sqr(y.ptr.p_double[j], _state); - cvrep->avgerror = cvrep->avgerror+ae_fabs(y.ptr.p_double[j], _state); - } - } - } - else - { - - /* - * Regression-specific code - */ - for(j=0; j<=nout-1; j++) - { - cvrep->rmserror = cvrep->rmserror+ae_sqr(y.ptr.p_double[j]-testset.ptr.pp_double[i][nin+j], _state); - cvrep->avgerror = cvrep->avgerror+ae_fabs(y.ptr.p_double[j]-testset.ptr.pp_double[i][nin+j], _state); - if( ae_fp_neq(testset.ptr.pp_double[i][nin+j],0) ) - { - cvrep->avgrelerror = cvrep->avgrelerror+ae_fabs((y.ptr.p_double[j]-testset.ptr.pp_double[i][nin+j])/testset.ptr.pp_double[i][nin+j], _state); - relcnt = relcnt+1; - } - } - } - } - } - if( mlpissoftmax(&network, _state) ) - { - cvrep->relclserror = cvrep->relclserror/npoints; - cvrep->avgce = cvrep->avgce/(ae_log(2, _state)*npoints); - } - cvrep->rmserror = ae_sqrt(cvrep->rmserror/(npoints*nout), _state); - cvrep->avgerror = cvrep->avgerror/(npoints*nout); - if( relcnt>0 ) - { - cvrep->avgrelerror = cvrep->avgrelerror/relcnt; - } - *info = 1; - ae_frame_leave(_state); -} - - -/************************************************************************* -Subroutine prepares K-fold split of the training set. - -NOTES: - "NClasses>0" means that we have classification task. - "NClasses<0" means regression task with -NClasses real outputs. -*************************************************************************/ -static void mlptrain_mlpkfoldsplit(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nclasses, - ae_int_t foldscount, - ae_bool stratifiedsplits, - /* Integer */ ae_vector* folds, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - ae_int_t k; - hqrndstate rs; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(folds); - _hqrndstate_init(&rs, _state, ae_true); - - - /* - * test parameters - */ - ae_assert(npoints>0, "MLPKFoldSplit: wrong NPoints!", _state); - ae_assert(nclasses>1||nclasses<0, "MLPKFoldSplit: wrong NClasses!", _state); - ae_assert(foldscount>=2&&foldscount<=npoints, "MLPKFoldSplit: wrong FoldsCount!", _state); - ae_assert(!stratifiedsplits, "MLPKFoldSplit: stratified splits are not supported!", _state); - - /* - * Folds - */ - hqrndrandomize(&rs, _state); - ae_vector_set_length(folds, npoints-1+1, _state); - for(i=0; i<=npoints-1; i++) - { - folds->ptr.p_int[i] = i*foldscount/npoints; - } - for(i=0; i<=npoints-2; i++) - { - j = i+hqrnduniformi(&rs, npoints-i, _state); - if( j!=i ) - { - k = folds->ptr.p_int[i]; - folds->ptr.p_int[i] = folds->ptr.p_int[j]; - folds->ptr.p_int[j] = k; - } - } - ae_frame_leave(_state); -} - - -static void mlptrain_mthreadcv(mlptrainer* s, - ae_int_t rowsize, - ae_int_t nrestarts, - /* Integer */ ae_vector* folds, - ae_int_t fold, - ae_int_t dfold, - /* Real */ ae_matrix* cvy, - ae_shared_pool* pooldatacv, - ae_state *_state) -{ - ae_frame _frame_block; - mlpparallelizationcv *datacv; - ae_smart_ptr _datacv; - ae_int_t i; - - ae_frame_make(_state, &_frame_block); - ae_smart_ptr_init(&_datacv, (void**)&datacv, _state, ae_true); - - if( fold==dfold-1 ) - { - - /* - * Separate set - */ - ae_shared_pool_retrieve(pooldatacv, &_datacv, _state); - datacv->subsetsize = 0; - for(i=0; i<=s->npoints-1; i++) - { - if( folds->ptr.p_int[i]!=fold ) - { - datacv->subset.ptr.p_int[datacv->subsetsize] = i; - datacv->subsetsize = datacv->subsetsize+1; - } - } - - /* - * Train on CV training set - */ - mlptrain_mlptrainnetworkx(s, nrestarts, -1, &datacv->subset, datacv->subsetsize, &datacv->subset, 0, &datacv->network, &datacv->rep, ae_true, &datacv->trnpool, _state); - datacv->ngrad = datacv->ngrad+datacv->rep.ngrad; - - /* - * Estimate error using CV test set - */ - for(i=0; i<=s->npoints-1; i++) - { - if( folds->ptr.p_int[i]==fold ) - { - if( s->datatype==0 ) - { - ae_v_move(&datacv->xyrow.ptr.p_double[0], 1, &s->densexy.ptr.pp_double[i][0], 1, ae_v_len(0,rowsize-1)); - } - if( s->datatype==1 ) - { - sparsegetrow(&s->sparsexy, i, &datacv->xyrow, _state); - } - mlpprocess(&datacv->network, &datacv->xyrow, &datacv->y, _state); - ae_v_move(&cvy->ptr.pp_double[i][0], 1, &datacv->y.ptr.p_double[0], 1, ae_v_len(0,s->nout-1)); - } - } - ae_shared_pool_recycle(pooldatacv, &_datacv, _state); - } - else - { - ae_assert(foldDFold-1).", _state); - mlptrain_mthreadcv(s, rowsize, nrestarts, folds, fold, (fold+dfold)/2, cvy, pooldatacv, _state); - mlptrain_mthreadcv(s, rowsize, nrestarts, folds, (fold+dfold)/2, dfold, cvy, pooldatacv, _state); - } - ae_frame_leave(_state); -} - - -static void mlptrain_mlptrainnetworkx(mlptrainer* s, - ae_int_t nrestarts, - ae_int_t algokind, - /* Integer */ ae_vector* trnsubset, - ae_int_t trnsubsetsize, - /* Integer */ ae_vector* valsubset, - ae_int_t valsubsetsize, - multilayerperceptron* network, - mlpreport* rep, - ae_bool isrootcall, - ae_shared_pool* sessions, - ae_state *_state) -{ - ae_frame _frame_block; - modelerrors modrep; - double eval; - double ebest; - ae_int_t ngradbatch; - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - ae_int_t pcount; - ae_int_t itbest; - ae_int_t itcnt; - ae_int_t ntype; - ae_int_t ttype; - ae_bool rndstart; - ae_int_t i; - ae_int_t nr0; - ae_int_t nr1; - mlpreport rep0; - mlpreport rep1; - ae_bool randomizenetwork; - double bestrmserror; - smlptrnsession *psession; - ae_smart_ptr _psession; - - ae_frame_make(_state, &_frame_block); - _modelerrors_init(&modrep, _state, ae_true); - _mlpreport_init(&rep0, _state, ae_true); - _mlpreport_init(&rep1, _state, ae_true); - ae_smart_ptr_init(&_psession, (void**)&psession, _state, ae_true); - - mlpproperties(network, &nin, &nout, &wcount, _state); - - /* - * Process root call - */ - if( isrootcall ) - { - - /* - * Check correctness of parameters - */ - ae_assert(algokind==0||algokind==-1, "MLPTrainNetworkX: unexpected AlgoKind", _state); - ae_assert(s->npoints>=0, "MLPTrainNetworkX: internal error - parameter S is not initialized or is spoiled(S.NPoints<0)", _state); - if( s->rcpar ) - { - ttype = 0; - } - else - { - ttype = 1; - } - if( !mlpissoftmax(network, _state) ) - { - ntype = 0; - } - else - { - ntype = 1; - } - ae_assert(ntype==ttype, "MLPTrainNetworkX: internal error - type of the training network is not similar to network type in trainer object", _state); - ae_assert(s->nin==nin, "MLPTrainNetworkX: internal error - number of inputs in trainer is not equal to number of inputs in the training network.", _state); - ae_assert(s->nout==nout, "MLPTrainNetworkX: internal error - number of outputs in trainer is not equal to number of outputs in the training network.", _state); - ae_assert(nrestarts>=0, "MLPTrainNetworkX: internal error - NRestarts<0.", _state); - ae_assert(trnsubset->cnt>=trnsubsetsize, "MLPTrainNetworkX: internal error - parameter TrnSubsetSize more than input subset size(Length(TrnSubset)ptr.p_int[i]>=0&&trnsubset->ptr.p_int[i]<=s->npoints-1, "MLPTrainNetworkX: internal error - parameter TrnSubset contains incorrect index(TrnSubset[I]<0 or TrnSubset[I]>S.NPoints-1)", _state); - } - ae_assert(valsubset->cnt>=valsubsetsize, "MLPTrainNetworkX: internal error - parameter ValSubsetSize more than input subset size(Length(ValSubset)ptr.p_int[i]>=0&&valsubset->ptr.p_int[i]<=s->npoints-1, "MLPTrainNetworkX: internal error - parameter ValSubset contains incorrect index(ValSubset[I]<0 or ValSubset[I]>S.NPoints-1)", _state); - } - - /* - * Train - */ - randomizenetwork = nrestarts>0; - mlptrain_initmlptrnsessions(network, randomizenetwork, s, sessions, _state); - mlptrain_mlptrainnetworkx(s, nrestarts, algokind, trnsubset, trnsubsetsize, valsubset, valsubsetsize, network, rep, ae_false, sessions, _state); - - /* - * Choose best network - */ - bestrmserror = ae_maxrealnumber; - ae_shared_pool_first_recycled(sessions, &_psession, _state); - while(psession!=NULL) - { - if( ae_fp_less(psession->bestrmserror,bestrmserror) ) - { - mlpimporttunableparameters(network, &psession->bestparameters, _state); - bestrmserror = psession->bestrmserror; - } - ae_shared_pool_next_recycled(sessions, &_psession, _state); - } - - /* - * Calculate errors - */ - if( s->datatype==0 ) - { - mlpallerrorssubset(network, &s->densexy, s->npoints, trnsubset, trnsubsetsize, &modrep, _state); - } - if( s->datatype==1 ) - { - mlpallerrorssparsesubset(network, &s->sparsexy, s->npoints, trnsubset, trnsubsetsize, &modrep, _state); - } - rep->relclserror = modrep.relclserror; - rep->avgce = modrep.avgce; - rep->rmserror = modrep.rmserror; - rep->avgerror = modrep.avgerror; - rep->avgrelerror = modrep.avgrelerror; - - /* - * Done - */ - ae_frame_leave(_state); - return; - } - - /* - * Split problem, if we have more than 1 restart - */ - if( nrestarts>=2 ) - { - - /* - * Divide problem with NRestarts into two: NR0 and NR1. - */ - nr0 = nrestarts/2; - nr1 = nrestarts-nr0; - mlptrain_mlptrainnetworkx(s, nr0, algokind, trnsubset, trnsubsetsize, valsubset, valsubsetsize, network, &rep0, ae_false, sessions, _state); - mlptrain_mlptrainnetworkx(s, nr1, algokind, trnsubset, trnsubsetsize, valsubset, valsubsetsize, network, &rep1, ae_false, sessions, _state); - - /* - * Aggregate results - */ - rep->ngrad = rep0.ngrad+rep1.ngrad; - rep->nhess = rep0.nhess+rep1.nhess; - rep->ncholesky = rep0.ncholesky+rep1.ncholesky; - - /* - * Done :) - */ - ae_frame_leave(_state); - return; - } - - /* - * Execution with NRestarts=1 or NRestarts=0: - * * NRestarts=1 means that network is restarted from random position - * * NRestarts=0 means that network is not randomized - */ - ae_assert(nrestarts==0||nrestarts==1, "MLPTrainNetworkX: internal error", _state); - rep->ngrad = 0; - rep->nhess = 0; - rep->ncholesky = 0; - ae_shared_pool_retrieve(sessions, &_psession, _state); - if( ((s->datatype==0||s->datatype==1)&&s->npoints>0)&&trnsubsetsize!=0 ) - { - - /* - * Train network using combination of early stopping and step-size - * and step-count based criteria. Network state with best value of - * validation set error is stored in WBuf0. When validation set is - * zero, most recent state of network is stored. - */ - rndstart = nrestarts!=0; - ngradbatch = 0; - eval = 0; - ebest = 0; - itbest = 0; - itcnt = 0; - mlptrain_mlpstarttrainingx(s, rndstart, algokind, trnsubset, trnsubsetsize, psession, _state); - if( s->datatype==0 ) - { - ebest = mlperrorsubset(&psession->network, &s->densexy, s->npoints, valsubset, valsubsetsize, _state); - } - if( s->datatype==1 ) - { - ebest = mlperrorsparsesubset(&psession->network, &s->sparsexy, s->npoints, valsubset, valsubsetsize, _state); - } - ae_v_move(&psession->wbuf0.ptr.p_double[0], 1, &psession->network.weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - while(mlptrain_mlpcontinuetrainingx(s, trnsubset, trnsubsetsize, &ngradbatch, psession, _state)) - { - if( s->datatype==0 ) - { - eval = mlperrorsubset(&psession->network, &s->densexy, s->npoints, valsubset, valsubsetsize, _state); - } - if( s->datatype==1 ) - { - eval = mlperrorsparsesubset(&psession->network, &s->sparsexy, s->npoints, valsubset, valsubsetsize, _state); - } - if( ae_fp_less_eq(eval,ebest)||valsubsetsize==0 ) - { - ae_v_move(&psession->wbuf0.ptr.p_double[0], 1, &psession->network.weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - ebest = eval; - itbest = itcnt; - } - if( itcnt>30&&ae_fp_greater(itcnt,1.5*itbest) ) - { - break; - } - itcnt = itcnt+1; - } - ae_v_move(&psession->network.weights.ptr.p_double[0], 1, &psession->wbuf0.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - rep->ngrad = ngradbatch; - } - else - { - for(i=0; i<=wcount-1; i++) - { - psession->network.weights.ptr.p_double[i] = 0; - } - } - - /* - * Evaluate network performance and update PSession.BestParameters/BestRMSError - * (if needed). - */ - if( s->datatype==0 ) - { - mlpallerrorssubset(&psession->network, &s->densexy, s->npoints, trnsubset, trnsubsetsize, &modrep, _state); - } - if( s->datatype==1 ) - { - mlpallerrorssparsesubset(&psession->network, &s->sparsexy, s->npoints, trnsubset, trnsubsetsize, &modrep, _state); - } - if( ae_fp_less(modrep.rmserror,psession->bestrmserror) ) - { - mlpexporttunableparameters(&psession->network, &psession->bestparameters, &pcount, _state); - psession->bestrmserror = modrep.rmserror; - } - - /* - * Move session back to pool - */ - ae_shared_pool_recycle(sessions, &_psession, _state); - ae_frame_leave(_state); -} - - -static void mlptrain_mlptrainensemblex(mlptrainer* s, - mlpensemble* ensemble, - ae_int_t idx0, - ae_int_t idx1, - ae_int_t nrestarts, - ae_int_t trainingmethod, - sinteger* ngrad, - ae_bool isrootcall, - ae_shared_pool* esessions, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t pcount; - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t trnsubsetsize; - ae_int_t valsubsetsize; - ae_int_t k0; - sinteger ngrad0; - sinteger ngrad1; - mlpetrnsession *psession; - ae_smart_ptr _psession; - hqrndstate rs; - - ae_frame_make(_state, &_frame_block); - _sinteger_init(&ngrad0, _state, ae_true); - _sinteger_init(&ngrad1, _state, ae_true); - ae_smart_ptr_init(&_psession, (void**)&psession, _state, ae_true); - _hqrndstate_init(&rs, _state, ae_true); - - nin = mlpgetinputscount(&ensemble->network, _state); - nout = mlpgetoutputscount(&ensemble->network, _state); - wcount = mlpgetweightscount(&ensemble->network, _state); - if( mlpissoftmax(&ensemble->network, _state) ) - { - pcount = nin; - } - else - { - pcount = nin+nout; - } - if( nrestarts<=0 ) - { - nrestarts = 1; - } - - /* - * Handle degenerate case - */ - if( s->npoints<2 ) - { - for(i=idx0; i<=idx1-1; i++) - { - for(j=0; j<=wcount-1; j++) - { - ensemble->weights.ptr.p_double[i*wcount+j] = 0.0; - } - for(j=0; j<=pcount-1; j++) - { - ensemble->columnmeans.ptr.p_double[i*pcount+j] = 0.0; - ensemble->columnsigmas.ptr.p_double[i*pcount+j] = 1.0; - } - } - ae_frame_leave(_state); - return; - } - - /* - * Process root call - */ - if( isrootcall ) - { - - /* - * Prepare: - * * prepare MLPETrnSessions - * * fill ensemble by zeros (helps to detect errors) - */ - mlptrain_initmlpetrnsessions(&ensemble->network, s, esessions, _state); - for(i=idx0; i<=idx1-1; i++) - { - for(j=0; j<=wcount-1; j++) - { - ensemble->weights.ptr.p_double[i*wcount+j] = 0.0; - } - for(j=0; j<=pcount-1; j++) - { - ensemble->columnmeans.ptr.p_double[i*pcount+j] = 0.0; - ensemble->columnsigmas.ptr.p_double[i*pcount+j] = 0.0; - } - } - - /* - * Train in non-root mode and exit - */ - mlptrain_mlptrainensemblex(s, ensemble, idx0, idx1, nrestarts, trainingmethod, ngrad, ae_false, esessions, _state); - ae_frame_leave(_state); - return; - } - - /* - * Split problem - */ - if( idx1-idx0>=2 ) - { - k0 = (idx1-idx0)/2; - ngrad0.val = 0; - ngrad1.val = 0; - mlptrain_mlptrainensemblex(s, ensemble, idx0, idx0+k0, nrestarts, trainingmethod, &ngrad0, ae_false, esessions, _state); - mlptrain_mlptrainensemblex(s, ensemble, idx0+k0, idx1, nrestarts, trainingmethod, &ngrad1, ae_false, esessions, _state); - ngrad->val = ngrad0.val+ngrad1.val; - ae_frame_leave(_state); - return; - } - - /* - * Retrieve and prepare session - */ - ae_shared_pool_retrieve(esessions, &_psession, _state); - - /* - * Train - */ - hqrndrandomize(&rs, _state); - for(k=idx0; k<=idx1-1; k++) - { - - /* - * Split set - */ - trnsubsetsize = 0; - valsubsetsize = 0; - if( trainingmethod==0 ) - { - do - { - trnsubsetsize = 0; - valsubsetsize = 0; - for(i=0; i<=s->npoints-1; i++) - { - if( ae_fp_less(ae_randomreal(_state),0.66) ) - { - - /* - * Assign sample to training set - */ - psession->trnsubset.ptr.p_int[trnsubsetsize] = i; - trnsubsetsize = trnsubsetsize+1; - } - else - { - - /* - * Assign sample to validation set - */ - psession->valsubset.ptr.p_int[valsubsetsize] = i; - valsubsetsize = valsubsetsize+1; - } - } - } - while(!(trnsubsetsize!=0&&valsubsetsize!=0)); - } - if( trainingmethod==1 ) - { - valsubsetsize = 0; - trnsubsetsize = s->npoints; - for(i=0; i<=s->npoints-1; i++) - { - psession->trnsubset.ptr.p_int[i] = hqrnduniformi(&rs, s->npoints, _state); - } - } - - /* - * Train - */ - mlptrain_mlptrainnetworkx(s, nrestarts, -1, &psession->trnsubset, trnsubsetsize, &psession->valsubset, valsubsetsize, &psession->network, &psession->mlprep, ae_true, &psession->mlpsessions, _state); - ngrad->val = ngrad->val+psession->mlprep.ngrad; - - /* - * Save results - */ - ae_v_move(&ensemble->weights.ptr.p_double[k*wcount], 1, &psession->network.weights.ptr.p_double[0], 1, ae_v_len(k*wcount,(k+1)*wcount-1)); - ae_v_move(&ensemble->columnmeans.ptr.p_double[k*pcount], 1, &psession->network.columnmeans.ptr.p_double[0], 1, ae_v_len(k*pcount,(k+1)*pcount-1)); - ae_v_move(&ensemble->columnsigmas.ptr.p_double[k*pcount], 1, &psession->network.columnsigmas.ptr.p_double[0], 1, ae_v_len(k*pcount,(k+1)*pcount-1)); - } - - /* - * Recycle session - */ - ae_shared_pool_recycle(esessions, &_psession, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -This function performs step-by-step training of the neural network. Here -"step-by-step" means that training starts with MLPStartTrainingX call, -and then user subsequently calls MLPContinueTrainingX to perform one more -iteration of the training. - -After call to this function trainer object remembers network and is ready -to train it. However, no training is performed until first call to -MLPContinueTraining() function. Subsequent calls to MLPContinueTraining() -will advance traing progress one iteration further. - - - -- ALGLIB -- - Copyright 13.08.2012 by Bochkanov Sergey -*************************************************************************/ -static void mlptrain_mlpstarttrainingx(mlptrainer* s, - ae_bool randomstart, - ae_int_t algokind, - /* Integer */ ae_vector* subset, - ae_int_t subsetsize, - smlptrnsession* session, - ae_state *_state) -{ - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - ae_int_t ntype; - ae_int_t ttype; - ae_int_t i; - - - - /* - * Check parameters - */ - ae_assert(s->npoints>=0, "MLPStartTrainingX: internal error - parameter S is not initialized or is spoiled(S.NPoints<0)", _state); - ae_assert(algokind==0||algokind==-1, "MLPStartTrainingX: unexpected AlgoKind", _state); - if( s->rcpar ) - { - ttype = 0; - } - else - { - ttype = 1; - } - if( !mlpissoftmax(&session->network, _state) ) - { - ntype = 0; - } - else - { - ntype = 1; - } - ae_assert(ntype==ttype, "MLPStartTrainingX: internal error - type of the resulting network is not similar to network type in trainer object", _state); - mlpproperties(&session->network, &nin, &nout, &wcount, _state); - ae_assert(s->nin==nin, "MLPStartTrainingX: number of inputs in trainer is not equal to number of inputs in the network.", _state); - ae_assert(s->nout==nout, "MLPStartTrainingX: number of outputs in trainer is not equal to number of outputs in the network.", _state); - ae_assert(subset->cnt>=subsetsize, "MLPStartTrainingX: internal error - parameter SubsetSize more than input subset size(Length(Subset)ptr.p_int[i]>=0&&subset->ptr.p_int[i]<=s->npoints-1, "MLPStartTrainingX: internal error - parameter Subset contains incorrect index(Subset[I]<0 or Subset[I]>S.NPoints-1)", _state); - } - - /* - * Prepare session - */ - minlbfgssetcond(&session->optimizer, 0.0, 0.0, s->wstep, s->maxits, _state); - if( s->npoints>0&&subsetsize!=0 ) - { - if( randomstart ) - { - mlprandomize(&session->network, _state); - } - minlbfgsrestartfrom(&session->optimizer, &session->network.weights, _state); - } - else - { - for(i=0; i<=wcount-1; i++) - { - session->network.weights.ptr.p_double[i] = 0; - } - } - if( algokind==-1 ) - { - session->algoused = s->algokind; - if( s->algokind==1 ) - { - session->minibatchsize = s->minibatchsize; - } - } - else - { - session->algoused = 0; - } - hqrndrandomize(&session->generator, _state); - ae_vector_set_length(&session->rstate.ia, 15+1, _state); - ae_vector_set_length(&session->rstate.ra, 1+1, _state); - session->rstate.stage = -1; -} - - -/************************************************************************* -This function performs step-by-step training of the neural network. Here -"step-by-step" means that training starts with MLPStartTrainingX call, -and then user subsequently calls MLPContinueTrainingX to perform one more -iteration of the training. - -This function performs one more iteration of the training and returns -either True (training continues) or False (training stopped). In case True -was returned, Network weights are updated according to the current state -of the optimization progress. In case False was returned, no additional -updates is performed (previous update of the network weights moved us to -the final point, and no additional updates is needed). - -EXAMPLE: - > - > [initialize network and trainer object] - > - > MLPStartTraining(Trainer, Network, True) - > while MLPContinueTraining(Trainer, Network) do - > [visualize training progress] - > - - - -- ALGLIB -- - Copyright 13.08.2012 by Bochkanov Sergey -*************************************************************************/ -static ae_bool mlptrain_mlpcontinuetrainingx(mlptrainer* s, - /* Integer */ ae_vector* subset, - ae_int_t subsetsize, - ae_int_t* ngradbatch, - smlptrnsession* session, - ae_state *_state) -{ - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - ae_int_t twcount; - ae_int_t ntype; - ae_int_t ttype; - double decay; - double v; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t trnsetsize; - ae_int_t epoch; - ae_int_t minibatchcount; - ae_int_t minibatchidx; - ae_int_t cursize; - ae_int_t idx0; - ae_int_t idx1; - ae_bool result; - - - - /* - * Reverse communication preparations - * I know it looks ugly, but it works the same way - * anywhere from C++ to Python. - * - * This code initializes locals by: - * * random values determined during code - * generation - on first subroutine call - * * values from previous call - on subsequent calls - */ - if( session->rstate.stage>=0 ) - { - nin = session->rstate.ia.ptr.p_int[0]; - nout = session->rstate.ia.ptr.p_int[1]; - wcount = session->rstate.ia.ptr.p_int[2]; - twcount = session->rstate.ia.ptr.p_int[3]; - ntype = session->rstate.ia.ptr.p_int[4]; - ttype = session->rstate.ia.ptr.p_int[5]; - i = session->rstate.ia.ptr.p_int[6]; - j = session->rstate.ia.ptr.p_int[7]; - k = session->rstate.ia.ptr.p_int[8]; - trnsetsize = session->rstate.ia.ptr.p_int[9]; - epoch = session->rstate.ia.ptr.p_int[10]; - minibatchcount = session->rstate.ia.ptr.p_int[11]; - minibatchidx = session->rstate.ia.ptr.p_int[12]; - cursize = session->rstate.ia.ptr.p_int[13]; - idx0 = session->rstate.ia.ptr.p_int[14]; - idx1 = session->rstate.ia.ptr.p_int[15]; - decay = session->rstate.ra.ptr.p_double[0]; - v = session->rstate.ra.ptr.p_double[1]; - } - else - { - nin = -983; - nout = -989; - wcount = -834; - twcount = 900; - ntype = -287; - ttype = 364; - i = 214; - j = -338; - k = -686; - trnsetsize = 912; - epoch = 585; - minibatchcount = 497; - minibatchidx = -271; - cursize = -581; - idx0 = 745; - idx1 = -533; - decay = -77; - v = 678; - } - if( session->rstate.stage==0 ) - { - goto lbl_0; - } - - /* - * Routine body - */ - - /* - * Check correctness of inputs - */ - ae_assert(s->npoints>=0, "MLPContinueTrainingX: internal error - parameter S is not initialized or is spoiled(S.NPoints<0).", _state); - if( s->rcpar ) - { - ttype = 0; - } - else - { - ttype = 1; - } - if( !mlpissoftmax(&session->network, _state) ) - { - ntype = 0; - } - else - { - ntype = 1; - } - ae_assert(ntype==ttype, "MLPContinueTrainingX: internal error - type of the resulting network is not similar to network type in trainer object.", _state); - mlpproperties(&session->network, &nin, &nout, &wcount, _state); - ae_assert(s->nin==nin, "MLPContinueTrainingX: internal error - number of inputs in trainer is not equal to number of inputs in the network.", _state); - ae_assert(s->nout==nout, "MLPContinueTrainingX: internal error - number of outputs in trainer is not equal to number of outputs in the network.", _state); - ae_assert(subset->cnt>=subsetsize, "MLPContinueTrainingX: internal error - parameter SubsetSize more than input subset size(Length(Subset)ptr.p_int[i]>=0&&subset->ptr.p_int[i]<=s->npoints-1, "MLPContinueTrainingX: internal error - parameter Subset contains incorrect index(Subset[I]<0 or Subset[I]>S.NPoints-1).", _state); - } - - /* - * Quick exit on empty training set - */ - if( s->npoints==0||subsetsize==0 ) - { - result = ae_false; - return result; - } - - /* - * Minibatch training - */ - if( session->algoused==1 ) - { - ae_assert(ae_false, "MINIBATCH TRAINING IS NOT IMPLEMENTED YET", _state); - } - - /* - * Last option: full batch training - */ - decay = s->decay; -lbl_1: - if( !minlbfgsiteration(&session->optimizer, _state) ) - { - goto lbl_2; - } - if( !session->optimizer.xupdated ) - { - goto lbl_3; - } - ae_v_move(&session->network.weights.ptr.p_double[0], 1, &session->optimizer.x.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - session->rstate.stage = 0; - goto lbl_rcomm; -lbl_0: -lbl_3: - ae_v_move(&session->network.weights.ptr.p_double[0], 1, &session->optimizer.x.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - if( s->datatype==0 ) - { - mlpgradbatchsubset(&session->network, &s->densexy, s->npoints, subset, subsetsize, &session->optimizer.f, &session->optimizer.g, _state); - } - if( s->datatype==1 ) - { - mlpgradbatchsparsesubset(&session->network, &s->sparsexy, s->npoints, subset, subsetsize, &session->optimizer.f, &session->optimizer.g, _state); - } - - /* - * Increment number of operations performed on batch gradient - */ - *ngradbatch = *ngradbatch+1; - v = ae_v_dotproduct(&session->network.weights.ptr.p_double[0], 1, &session->network.weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); - session->optimizer.f = session->optimizer.f+0.5*decay*v; - ae_v_addd(&session->optimizer.g.ptr.p_double[0], 1, &session->network.weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1), decay); - goto lbl_1; -lbl_2: - minlbfgsresultsbuf(&session->optimizer, &session->network.weights, &session->optimizerrep, _state); - result = ae_false; - return result; - - /* - * Saving state - */ -lbl_rcomm: - result = ae_true; - session->rstate.ia.ptr.p_int[0] = nin; - session->rstate.ia.ptr.p_int[1] = nout; - session->rstate.ia.ptr.p_int[2] = wcount; - session->rstate.ia.ptr.p_int[3] = twcount; - session->rstate.ia.ptr.p_int[4] = ntype; - session->rstate.ia.ptr.p_int[5] = ttype; - session->rstate.ia.ptr.p_int[6] = i; - session->rstate.ia.ptr.p_int[7] = j; - session->rstate.ia.ptr.p_int[8] = k; - session->rstate.ia.ptr.p_int[9] = trnsetsize; - session->rstate.ia.ptr.p_int[10] = epoch; - session->rstate.ia.ptr.p_int[11] = minibatchcount; - session->rstate.ia.ptr.p_int[12] = minibatchidx; - session->rstate.ia.ptr.p_int[13] = cursize; - session->rstate.ia.ptr.p_int[14] = idx0; - session->rstate.ia.ptr.p_int[15] = idx1; - session->rstate.ra.ptr.p_double[0] = decay; - session->rstate.ra.ptr.p_double[1] = v; - return result; -} - - -/************************************************************************* -Internal bagging subroutine. - - -- ALGLIB -- - Copyright 19.02.2009 by Bochkanov Sergey -*************************************************************************/ -static void mlptrain_mlpebagginginternal(mlpensemble* ensemble, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - double decay, - ae_int_t restarts, - double wstep, - ae_int_t maxits, - ae_bool lmalgorithm, - ae_int_t* info, - mlpreport* rep, - mlpcvreport* ooberrors, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix xys; - ae_vector s; - ae_matrix oobbuf; - ae_vector oobcntbuf; - ae_vector x; - ae_vector y; - ae_vector dy; - ae_vector dsbuf; - ae_int_t ccnt; - ae_int_t pcnt; - ae_int_t i; - ae_int_t j; - ae_int_t k; - double v; - mlpreport tmprep; - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - hqrndstate rs; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _mlpreport_clear(rep); - _mlpcvreport_clear(ooberrors); - ae_matrix_init(&xys, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&s, 0, DT_BOOL, _state, ae_true); - ae_matrix_init(&oobbuf, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&oobcntbuf, 0, DT_INT, _state, ae_true); - ae_vector_init(&x, 0, DT_REAL, _state, ae_true); - ae_vector_init(&y, 0, DT_REAL, _state, ae_true); - ae_vector_init(&dy, 0, DT_REAL, _state, ae_true); - ae_vector_init(&dsbuf, 0, DT_REAL, _state, ae_true); - _mlpreport_init(&tmprep, _state, ae_true); - _hqrndstate_init(&rs, _state, ae_true); - - nin = mlpgetinputscount(&ensemble->network, _state); - nout = mlpgetoutputscount(&ensemble->network, _state); - wcount = mlpgetweightscount(&ensemble->network, _state); - - /* - * Test for inputs - */ - if( (!lmalgorithm&&ae_fp_eq(wstep,0))&&maxits==0 ) - { - *info = -8; - ae_frame_leave(_state); - return; - } - if( ((npoints<=0||restarts<1)||ae_fp_less(wstep,0))||maxits<0 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - if( mlpissoftmax(&ensemble->network, _state) ) - { - for(i=0; i<=npoints-1; i++) - { - if( ae_round(xy->ptr.pp_double[i][nin], _state)<0||ae_round(xy->ptr.pp_double[i][nin], _state)>=nout ) - { - *info = -2; - ae_frame_leave(_state); - return; - } - } - } - - /* - * allocate temporaries - */ - *info = 2; - rep->ngrad = 0; - rep->nhess = 0; - rep->ncholesky = 0; - ooberrors->relclserror = 0; - ooberrors->avgce = 0; - ooberrors->rmserror = 0; - ooberrors->avgerror = 0; - ooberrors->avgrelerror = 0; - if( mlpissoftmax(&ensemble->network, _state) ) - { - ccnt = nin+1; - pcnt = nin; - } - else - { - ccnt = nin+nout; - pcnt = nin+nout; - } - ae_matrix_set_length(&xys, npoints, ccnt, _state); - ae_vector_set_length(&s, npoints, _state); - ae_matrix_set_length(&oobbuf, npoints, nout, _state); - ae_vector_set_length(&oobcntbuf, npoints, _state); - ae_vector_set_length(&x, nin, _state); - ae_vector_set_length(&y, nout, _state); - if( mlpissoftmax(&ensemble->network, _state) ) - { - ae_vector_set_length(&dy, 1, _state); - } - else - { - ae_vector_set_length(&dy, nout, _state); - } - for(i=0; i<=npoints-1; i++) - { - for(j=0; j<=nout-1; j++) - { - oobbuf.ptr.pp_double[i][j] = 0; - } - } - for(i=0; i<=npoints-1; i++) - { - oobcntbuf.ptr.p_int[i] = 0; - } - - /* - * main bagging cycle - */ - hqrndrandomize(&rs, _state); - for(k=0; k<=ensemble->ensemblesize-1; k++) - { - - /* - * prepare dataset - */ - for(i=0; i<=npoints-1; i++) - { - s.ptr.p_bool[i] = ae_false; - } - for(i=0; i<=npoints-1; i++) - { - j = hqrnduniformi(&rs, npoints, _state); - s.ptr.p_bool[j] = ae_true; - ae_v_move(&xys.ptr.pp_double[i][0], 1, &xy->ptr.pp_double[j][0], 1, ae_v_len(0,ccnt-1)); - } - - /* - * train - */ - if( lmalgorithm ) - { - mlptrainlm(&ensemble->network, &xys, npoints, decay, restarts, info, &tmprep, _state); - } - else - { - mlptrainlbfgs(&ensemble->network, &xys, npoints, decay, restarts, wstep, maxits, info, &tmprep, _state); - } - if( *info<0 ) - { - ae_frame_leave(_state); - return; - } - - /* - * save results - */ - rep->ngrad = rep->ngrad+tmprep.ngrad; - rep->nhess = rep->nhess+tmprep.nhess; - rep->ncholesky = rep->ncholesky+tmprep.ncholesky; - ae_v_move(&ensemble->weights.ptr.p_double[k*wcount], 1, &ensemble->network.weights.ptr.p_double[0], 1, ae_v_len(k*wcount,(k+1)*wcount-1)); - ae_v_move(&ensemble->columnmeans.ptr.p_double[k*pcnt], 1, &ensemble->network.columnmeans.ptr.p_double[0], 1, ae_v_len(k*pcnt,(k+1)*pcnt-1)); - ae_v_move(&ensemble->columnsigmas.ptr.p_double[k*pcnt], 1, &ensemble->network.columnsigmas.ptr.p_double[0], 1, ae_v_len(k*pcnt,(k+1)*pcnt-1)); - - /* - * OOB estimates - */ - for(i=0; i<=npoints-1; i++) - { - if( !s.ptr.p_bool[i] ) - { - ae_v_move(&x.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nin-1)); - mlpprocess(&ensemble->network, &x, &y, _state); - ae_v_add(&oobbuf.ptr.pp_double[i][0], 1, &y.ptr.p_double[0], 1, ae_v_len(0,nout-1)); - oobcntbuf.ptr.p_int[i] = oobcntbuf.ptr.p_int[i]+1; - } - } - } - - /* - * OOB estimates - */ - if( mlpissoftmax(&ensemble->network, _state) ) - { - dserrallocate(nout, &dsbuf, _state); - } - else - { - dserrallocate(-nout, &dsbuf, _state); - } - for(i=0; i<=npoints-1; i++) - { - if( oobcntbuf.ptr.p_int[i]!=0 ) - { - v = (double)1/(double)oobcntbuf.ptr.p_int[i]; - ae_v_moved(&y.ptr.p_double[0], 1, &oobbuf.ptr.pp_double[i][0], 1, ae_v_len(0,nout-1), v); - if( mlpissoftmax(&ensemble->network, _state) ) - { - dy.ptr.p_double[0] = xy->ptr.pp_double[i][nin]; - } - else - { - ae_v_moved(&dy.ptr.p_double[0], 1, &xy->ptr.pp_double[i][nin], 1, ae_v_len(0,nout-1), v); - } - dserraccumulate(&dsbuf, &y, &dy, _state); - } - } - dserrfinish(&dsbuf, _state); - ooberrors->relclserror = dsbuf.ptr.p_double[0]; - ooberrors->avgce = dsbuf.ptr.p_double[1]; - ooberrors->rmserror = dsbuf.ptr.p_double[2]; - ooberrors->avgerror = dsbuf.ptr.p_double[3]; - ooberrors->avgrelerror = dsbuf.ptr.p_double[4]; - ae_frame_leave(_state); -} - - -/************************************************************************* -This function initializes temporaries needed for training session. - - - -- ALGLIB -- - Copyright 01.07.2013 by Bochkanov Sergey -*************************************************************************/ -static void mlptrain_initmlptrnsession(multilayerperceptron* networktrained, - ae_bool randomizenetwork, - mlptrainer* trainer, - smlptrnsession* session, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t nin; - ae_int_t nout; - ae_int_t wcount; - ae_int_t pcount; - ae_vector dummysubset; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&dummysubset, 0, DT_INT, _state, ae_true); - - - /* - * Prepare network: - * * copy input network to Session.Network - * * re-initialize preprocessor and weights if RandomizeNetwork=True - */ - mlpcopy(networktrained, &session->network, _state); - if( randomizenetwork ) - { - ae_assert(trainer->datatype==0||trainer->datatype==1, "InitTemporaries: unexpected Trainer.DataType", _state); - if( trainer->datatype==0 ) - { - mlpinitpreprocessorsubset(&session->network, &trainer->densexy, trainer->npoints, &dummysubset, -1, _state); - } - if( trainer->datatype==1 ) - { - mlpinitpreprocessorsparsesubset(&session->network, &trainer->sparsexy, trainer->npoints, &dummysubset, -1, _state); - } - mlprandomize(&session->network, _state); - session->randomizenetwork = ae_true; - } - else - { - session->randomizenetwork = ae_false; - } - - /* - * Determine network geometry and initialize optimizer - */ - mlpproperties(&session->network, &nin, &nout, &wcount, _state); - minlbfgscreate(wcount, ae_minint(wcount, trainer->lbfgsfactor, _state), &session->network.weights, &session->optimizer, _state); - minlbfgssetxrep(&session->optimizer, ae_true, _state); - - /* - * Create buffers - */ - ae_vector_set_length(&session->wbuf0, wcount, _state); - ae_vector_set_length(&session->wbuf1, wcount, _state); - - /* - * Initialize session result - */ - mlpexporttunableparameters(&session->network, &session->bestparameters, &pcount, _state); - session->bestrmserror = ae_maxrealnumber; - ae_frame_leave(_state); -} - - -/************************************************************************* -This function initializes temporaries needed for training session. - -*************************************************************************/ -static void mlptrain_initmlptrnsessions(multilayerperceptron* networktrained, - ae_bool randomizenetwork, - mlptrainer* trainer, - ae_shared_pool* sessions, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector dummysubset; - smlptrnsession t; - smlptrnsession *p; - ae_smart_ptr _p; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&dummysubset, 0, DT_INT, _state, ae_true); - _smlptrnsession_init(&t, _state, ae_true); - ae_smart_ptr_init(&_p, (void**)&p, _state, ae_true); - - if( ae_shared_pool_is_initialized(sessions) ) - { - - /* - * Pool was already initialized. - * Clear sessions stored in the pool. - */ - ae_shared_pool_first_recycled(sessions, &_p, _state); - while(p!=NULL) - { - ae_assert(mlpsamearchitecture(&p->network, networktrained, _state), "InitMLPTrnSessions: internal consistency error", _state); - p->bestrmserror = ae_maxrealnumber; - ae_shared_pool_next_recycled(sessions, &_p, _state); - } - } - else - { - - /* - * Prepare session and seed pool - */ - mlptrain_initmlptrnsession(networktrained, randomizenetwork, trainer, &t, _state); - ae_shared_pool_set_seed(sessions, &t, sizeof(t), _smlptrnsession_init, _smlptrnsession_init_copy, _smlptrnsession_destroy, _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -This function initializes temporaries needed for ensemble training. - -*************************************************************************/ -static void mlptrain_initmlpetrnsession(multilayerperceptron* individualnetwork, - mlptrainer* trainer, - mlpetrnsession* session, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector dummysubset; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&dummysubset, 0, DT_INT, _state, ae_true); - - - /* - * Prepare network: - * * copy input network to Session.Network - * * re-initialize preprocessor and weights if RandomizeNetwork=True - */ - mlpcopy(individualnetwork, &session->network, _state); - mlptrain_initmlptrnsessions(individualnetwork, ae_true, trainer, &session->mlpsessions, _state); - ivectorsetlengthatleast(&session->trnsubset, trainer->npoints, _state); - ivectorsetlengthatleast(&session->valsubset, trainer->npoints, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -This function initializes temporaries needed for training session. - -*************************************************************************/ -static void mlptrain_initmlpetrnsessions(multilayerperceptron* individualnetwork, - mlptrainer* trainer, - ae_shared_pool* sessions, - ae_state *_state) -{ - ae_frame _frame_block; - mlpetrnsession t; - - ae_frame_make(_state, &_frame_block); - _mlpetrnsession_init(&t, _state, ae_true); - - if( !ae_shared_pool_is_initialized(sessions) ) - { - mlptrain_initmlpetrnsession(individualnetwork, trainer, &t, _state); - ae_shared_pool_set_seed(sessions, &t, sizeof(t), _mlpetrnsession_init, _mlpetrnsession_init_copy, _mlpetrnsession_destroy, _state); - } - ae_frame_leave(_state); -} - - -ae_bool _mlpreport_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - mlpreport *p = (mlpreport*)_p; - ae_touch_ptr((void*)p); - return ae_true; -} - - -ae_bool _mlpreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - mlpreport *dst = (mlpreport*)_dst; - mlpreport *src = (mlpreport*)_src; - dst->relclserror = src->relclserror; - dst->avgce = src->avgce; - dst->rmserror = src->rmserror; - dst->avgerror = src->avgerror; - dst->avgrelerror = src->avgrelerror; - dst->ngrad = src->ngrad; - dst->nhess = src->nhess; - dst->ncholesky = src->ncholesky; - return ae_true; -} - - -void _mlpreport_clear(void* _p) -{ - mlpreport *p = (mlpreport*)_p; - ae_touch_ptr((void*)p); -} - - -void _mlpreport_destroy(void* _p) -{ - mlpreport *p = (mlpreport*)_p; - ae_touch_ptr((void*)p); -} - - -ae_bool _mlpcvreport_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - mlpcvreport *p = (mlpcvreport*)_p; - ae_touch_ptr((void*)p); - return ae_true; -} - - -ae_bool _mlpcvreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - mlpcvreport *dst = (mlpcvreport*)_dst; - mlpcvreport *src = (mlpcvreport*)_src; - dst->relclserror = src->relclserror; - dst->avgce = src->avgce; - dst->rmserror = src->rmserror; - dst->avgerror = src->avgerror; - dst->avgrelerror = src->avgrelerror; - return ae_true; -} - - -void _mlpcvreport_clear(void* _p) -{ - mlpcvreport *p = (mlpcvreport*)_p; - ae_touch_ptr((void*)p); -} - - -void _mlpcvreport_destroy(void* _p) -{ - mlpcvreport *p = (mlpcvreport*)_p; - ae_touch_ptr((void*)p); -} - - -ae_bool _smlptrnsession_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - smlptrnsession *p = (smlptrnsession*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->bestparameters, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !_multilayerperceptron_init(&p->network, _state, make_automatic) ) - return ae_false; - if( !_minlbfgsstate_init(&p->optimizer, _state, make_automatic) ) - return ae_false; - if( !_minlbfgsreport_init(&p->optimizerrep, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->wbuf0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->wbuf1, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->allminibatches, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->currentminibatch, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) - return ae_false; - if( !_hqrndstate_init(&p->generator, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _smlptrnsession_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - smlptrnsession *dst = (smlptrnsession*)_dst; - smlptrnsession *src = (smlptrnsession*)_src; - if( !ae_vector_init_copy(&dst->bestparameters, &src->bestparameters, _state, make_automatic) ) - return ae_false; - dst->bestrmserror = src->bestrmserror; - dst->randomizenetwork = src->randomizenetwork; - if( !_multilayerperceptron_init_copy(&dst->network, &src->network, _state, make_automatic) ) - return ae_false; - if( !_minlbfgsstate_init_copy(&dst->optimizer, &src->optimizer, _state, make_automatic) ) - return ae_false; - if( !_minlbfgsreport_init_copy(&dst->optimizerrep, &src->optimizerrep, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->wbuf0, &src->wbuf0, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->wbuf1, &src->wbuf1, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->allminibatches, &src->allminibatches, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->currentminibatch, &src->currentminibatch, _state, make_automatic) ) - return ae_false; - if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) - return ae_false; - dst->algoused = src->algoused; - dst->minibatchsize = src->minibatchsize; - if( !_hqrndstate_init_copy(&dst->generator, &src->generator, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _smlptrnsession_clear(void* _p) -{ - smlptrnsession *p = (smlptrnsession*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->bestparameters); - _multilayerperceptron_clear(&p->network); - _minlbfgsstate_clear(&p->optimizer); - _minlbfgsreport_clear(&p->optimizerrep); - ae_vector_clear(&p->wbuf0); - ae_vector_clear(&p->wbuf1); - ae_vector_clear(&p->allminibatches); - ae_vector_clear(&p->currentminibatch); - _rcommstate_clear(&p->rstate); - _hqrndstate_clear(&p->generator); -} - - -void _smlptrnsession_destroy(void* _p) -{ - smlptrnsession *p = (smlptrnsession*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->bestparameters); - _multilayerperceptron_destroy(&p->network); - _minlbfgsstate_destroy(&p->optimizer); - _minlbfgsreport_destroy(&p->optimizerrep); - ae_vector_destroy(&p->wbuf0); - ae_vector_destroy(&p->wbuf1); - ae_vector_destroy(&p->allminibatches); - ae_vector_destroy(&p->currentminibatch); - _rcommstate_destroy(&p->rstate); - _hqrndstate_destroy(&p->generator); -} - - -ae_bool _mlpetrnsession_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - mlpetrnsession *p = (mlpetrnsession*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->trnsubset, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->valsubset, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_shared_pool_init(&p->mlpsessions, _state, make_automatic) ) - return ae_false; - if( !_mlpreport_init(&p->mlprep, _state, make_automatic) ) - return ae_false; - if( !_multilayerperceptron_init(&p->network, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _mlpetrnsession_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - mlpetrnsession *dst = (mlpetrnsession*)_dst; - mlpetrnsession *src = (mlpetrnsession*)_src; - if( !ae_vector_init_copy(&dst->trnsubset, &src->trnsubset, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->valsubset, &src->valsubset, _state, make_automatic) ) - return ae_false; - if( !ae_shared_pool_init_copy(&dst->mlpsessions, &src->mlpsessions, _state, make_automatic) ) - return ae_false; - if( !_mlpreport_init_copy(&dst->mlprep, &src->mlprep, _state, make_automatic) ) - return ae_false; - if( !_multilayerperceptron_init_copy(&dst->network, &src->network, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _mlpetrnsession_clear(void* _p) -{ - mlpetrnsession *p = (mlpetrnsession*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->trnsubset); - ae_vector_clear(&p->valsubset); - ae_shared_pool_clear(&p->mlpsessions); - _mlpreport_clear(&p->mlprep); - _multilayerperceptron_clear(&p->network); -} - - -void _mlpetrnsession_destroy(void* _p) -{ - mlpetrnsession *p = (mlpetrnsession*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->trnsubset); - ae_vector_destroy(&p->valsubset); - ae_shared_pool_destroy(&p->mlpsessions); - _mlpreport_destroy(&p->mlprep); - _multilayerperceptron_destroy(&p->network); -} - - -ae_bool _mlptrainer_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - mlptrainer *p = (mlptrainer*)_p; - ae_touch_ptr((void*)p); - if( !ae_matrix_init(&p->densexy, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !_sparsematrix_init(&p->sparsexy, _state, make_automatic) ) - return ae_false; - if( !_smlptrnsession_init(&p->session, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->subset, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->valsubset, 0, DT_INT, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _mlptrainer_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - mlptrainer *dst = (mlptrainer*)_dst; - mlptrainer *src = (mlptrainer*)_src; - dst->nin = src->nin; - dst->nout = src->nout; - dst->rcpar = src->rcpar; - dst->lbfgsfactor = src->lbfgsfactor; - dst->decay = src->decay; - dst->wstep = src->wstep; - dst->maxits = src->maxits; - dst->datatype = src->datatype; - dst->npoints = src->npoints; - if( !ae_matrix_init_copy(&dst->densexy, &src->densexy, _state, make_automatic) ) - return ae_false; - if( !_sparsematrix_init_copy(&dst->sparsexy, &src->sparsexy, _state, make_automatic) ) - return ae_false; - if( !_smlptrnsession_init_copy(&dst->session, &src->session, _state, make_automatic) ) - return ae_false; - dst->ngradbatch = src->ngradbatch; - if( !ae_vector_init_copy(&dst->subset, &src->subset, _state, make_automatic) ) - return ae_false; - dst->subsetsize = src->subsetsize; - if( !ae_vector_init_copy(&dst->valsubset, &src->valsubset, _state, make_automatic) ) - return ae_false; - dst->valsubsetsize = src->valsubsetsize; - dst->algokind = src->algokind; - dst->minibatchsize = src->minibatchsize; - return ae_true; -} - - -void _mlptrainer_clear(void* _p) -{ - mlptrainer *p = (mlptrainer*)_p; - ae_touch_ptr((void*)p); - ae_matrix_clear(&p->densexy); - _sparsematrix_clear(&p->sparsexy); - _smlptrnsession_clear(&p->session); - ae_vector_clear(&p->subset); - ae_vector_clear(&p->valsubset); -} - - -void _mlptrainer_destroy(void* _p) -{ - mlptrainer *p = (mlptrainer*)_p; - ae_touch_ptr((void*)p); - ae_matrix_destroy(&p->densexy); - _sparsematrix_destroy(&p->sparsexy); - _smlptrnsession_destroy(&p->session); - ae_vector_destroy(&p->subset); - ae_vector_destroy(&p->valsubset); -} - - -ae_bool _mlpparallelizationcv_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - mlpparallelizationcv *p = (mlpparallelizationcv*)_p; - ae_touch_ptr((void*)p); - if( !_multilayerperceptron_init(&p->network, _state, make_automatic) ) - return ae_false; - if( !_mlpreport_init(&p->rep, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->subset, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->xyrow, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->y, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_shared_pool_init(&p->trnpool, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _mlpparallelizationcv_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - mlpparallelizationcv *dst = (mlpparallelizationcv*)_dst; - mlpparallelizationcv *src = (mlpparallelizationcv*)_src; - if( !_multilayerperceptron_init_copy(&dst->network, &src->network, _state, make_automatic) ) - return ae_false; - if( !_mlpreport_init_copy(&dst->rep, &src->rep, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->subset, &src->subset, _state, make_automatic) ) - return ae_false; - dst->subsetsize = src->subsetsize; - if( !ae_vector_init_copy(&dst->xyrow, &src->xyrow, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->y, &src->y, _state, make_automatic) ) - return ae_false; - dst->ngrad = src->ngrad; - if( !ae_shared_pool_init_copy(&dst->trnpool, &src->trnpool, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _mlpparallelizationcv_clear(void* _p) -{ - mlpparallelizationcv *p = (mlpparallelizationcv*)_p; - ae_touch_ptr((void*)p); - _multilayerperceptron_clear(&p->network); - _mlpreport_clear(&p->rep); - ae_vector_clear(&p->subset); - ae_vector_clear(&p->xyrow); - ae_vector_clear(&p->y); - ae_shared_pool_clear(&p->trnpool); -} - - -void _mlpparallelizationcv_destroy(void* _p) -{ - mlpparallelizationcv *p = (mlpparallelizationcv*)_p; - ae_touch_ptr((void*)p); - _multilayerperceptron_destroy(&p->network); - _mlpreport_destroy(&p->rep); - ae_vector_destroy(&p->subset); - ae_vector_destroy(&p->xyrow); - ae_vector_destroy(&p->y); - ae_shared_pool_destroy(&p->trnpool); -} - - - - -/************************************************************************* -Principal components analysis - -Subroutine builds orthogonal basis where first axis corresponds to -direction with maximum variance, second axis maximizes variance in subspace -orthogonal to first axis and so on. - -It should be noted that, unlike LDA, PCA does not use class labels. - -INPUT PARAMETERS: - X - dataset, array[0..NPoints-1,0..NVars-1]. - matrix contains ONLY INDEPENDENT VARIABLES. - NPoints - dataset size, NPoints>=0 - NVars - number of independent variables, NVars>=1 - -ÂÛÕÎÄÍÛÅ ÏÀÐÀÌÅÒÐÛ: - Info - return code: - * -4, if SVD subroutine haven't converged - * -1, if wrong parameters has been passed (NPoints<0, - NVars<1) - * 1, if task is solved - S2 - array[0..NVars-1]. variance values corresponding - to basis vectors. - V - array[0..NVars-1,0..NVars-1] - matrix, whose columns store basis vectors. - - -- ALGLIB -- - Copyright 25.08.2008 by Bochkanov Sergey -*************************************************************************/ -void pcabuildbasis(/* Real */ ae_matrix* x, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t* info, - /* Real */ ae_vector* s2, - /* Real */ ae_matrix* v, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix a; - ae_matrix u; - ae_matrix vt; - ae_vector m; - ae_vector t; - ae_int_t i; - ae_int_t j; - double mean; - double variance; - double skewness; - double kurtosis; - - ae_frame_make(_state, &_frame_block); - *info = 0; - ae_vector_clear(s2); - ae_matrix_clear(v); - ae_matrix_init(&a, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&u, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&vt, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&m, 0, DT_REAL, _state, ae_true); - ae_vector_init(&t, 0, DT_REAL, _state, ae_true); - - - /* - * Check input data - */ - if( npoints<0||nvars<1 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - *info = 1; - - /* - * Special case: NPoints=0 - */ - if( npoints==0 ) - { - ae_vector_set_length(s2, nvars-1+1, _state); - ae_matrix_set_length(v, nvars-1+1, nvars-1+1, _state); - for(i=0; i<=nvars-1; i++) - { - s2->ptr.p_double[i] = 0; - } - for(i=0; i<=nvars-1; i++) - { - for(j=0; j<=nvars-1; j++) - { - if( i==j ) - { - v->ptr.pp_double[i][j] = 1; - } - else - { - v->ptr.pp_double[i][j] = 0; - } - } - } - ae_frame_leave(_state); - return; - } - - /* - * Calculate means - */ - ae_vector_set_length(&m, nvars-1+1, _state); - ae_vector_set_length(&t, npoints-1+1, _state); - for(j=0; j<=nvars-1; j++) - { - ae_v_move(&t.ptr.p_double[0], 1, &x->ptr.pp_double[0][j], x->stride, ae_v_len(0,npoints-1)); - samplemoments(&t, npoints, &mean, &variance, &skewness, &kurtosis, _state); - m.ptr.p_double[j] = mean; - } - - /* - * Center, apply SVD, prepare output - */ - ae_matrix_set_length(&a, ae_maxint(npoints, nvars, _state)-1+1, nvars-1+1, _state); - for(i=0; i<=npoints-1; i++) - { - ae_v_move(&a.ptr.pp_double[i][0], 1, &x->ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); - ae_v_sub(&a.ptr.pp_double[i][0], 1, &m.ptr.p_double[0], 1, ae_v_len(0,nvars-1)); - } - for(i=npoints; i<=nvars-1; i++) - { - for(j=0; j<=nvars-1; j++) - { - a.ptr.pp_double[i][j] = 0; - } - } - if( !rmatrixsvd(&a, ae_maxint(npoints, nvars, _state), nvars, 0, 1, 2, s2, &u, &vt, _state) ) - { - *info = -4; - ae_frame_leave(_state); - return; - } - if( npoints!=1 ) - { - for(i=0; i<=nvars-1; i++) - { - s2->ptr.p_double[i] = ae_sqr(s2->ptr.p_double[i], _state)/(npoints-1); - } - } - ae_matrix_set_length(v, nvars-1+1, nvars-1+1, _state); - copyandtranspose(&vt, 0, nvars-1, 0, nvars-1, v, 0, nvars-1, 0, nvars-1, _state); - ae_frame_leave(_state); -} - - - -} - diff --git a/src/core/alglib/dataanalysis.h b/src/core/alglib/dataanalysis.h deleted file mode 100644 index 69d985c..0000000 --- a/src/core/alglib/dataanalysis.h +++ /dev/null @@ -1,7394 +0,0 @@ -/************************************************************************* -Copyright (c) Sergey Bochkanov (ALGLIB project). - ->>> SOURCE LICENSE >>> -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation (www.fsf.org); either version 2 of the -License, or (at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -A copy of the GNU General Public License is available at -http://www.fsf.org/licensing/licenses ->>> END OF LICENSE >>> -*************************************************************************/ -#ifndef _dataanalysis_pkg_h -#define _dataanalysis_pkg_h -#include "ap.h" -#include "alglibinternal.h" -#include "linalg.h" -#include "statistics.h" -#include "alglibmisc.h" -#include "specialfunctions.h" -#include "solvers.h" -#include "optimization.h" - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (DATATYPES) -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ -typedef struct -{ - double relclserror; - double avgce; - double rmserror; - double avgerror; - double avgrelerror; -} cvreport; -typedef struct -{ - ae_int_t npoints; - ae_int_t nfeatures; - ae_int_t disttype; - ae_matrix xy; - ae_matrix d; - ae_int_t ahcalgo; - ae_int_t kmeansrestarts; - ae_int_t kmeansmaxits; -} clusterizerstate; -typedef struct -{ - ae_int_t npoints; - ae_vector p; - ae_matrix z; - ae_matrix pz; - ae_matrix pm; - ae_vector mergedist; -} ahcreport; -typedef struct -{ - ae_int_t npoints; - ae_int_t nfeatures; - ae_int_t terminationtype; - ae_int_t k; - ae_matrix c; - ae_vector cidx; -} kmeansreport; -typedef struct -{ - ae_int_t nvars; - ae_int_t nclasses; - ae_int_t ntrees; - ae_int_t bufsize; - ae_vector trees; -} decisionforest; -typedef struct -{ - double relclserror; - double avgce; - double rmserror; - double avgerror; - double avgrelerror; - double oobrelclserror; - double oobavgce; - double oobrmserror; - double oobavgerror; - double oobavgrelerror; -} dfreport; -typedef struct -{ - ae_vector treebuf; - ae_vector idxbuf; - ae_vector tmpbufr; - ae_vector tmpbufr2; - ae_vector tmpbufi; - ae_vector classibuf; - ae_vector sortrbuf; - ae_vector sortrbuf2; - ae_vector sortibuf; - ae_vector varpool; - ae_vector evsbin; - ae_vector evssplits; -} dfinternalbuffers; -typedef struct -{ - ae_vector w; -} linearmodel; -typedef struct -{ - ae_matrix c; - double rmserror; - double avgerror; - double avgrelerror; - double cvrmserror; - double cvavgerror; - double cvavgrelerror; - ae_int_t ncvdefects; - ae_vector cvdefects; -} lrreport; -typedef struct -{ - double relclserror; - double avgce; - double rmserror; - double avgerror; - double avgrelerror; -} modelerrors; -typedef struct -{ - double f; - ae_vector g; -} smlpgrad; -typedef struct -{ - ae_int_t hlnetworktype; - ae_int_t hlnormtype; - ae_vector hllayersizes; - ae_vector hlconnections; - ae_vector hlneurons; - ae_vector structinfo; - ae_vector weights; - ae_vector columnmeans; - ae_vector columnsigmas; - ae_vector neurons; - ae_vector dfdnet; - ae_vector derror; - ae_vector x; - ae_vector y; - ae_matrix xy; - ae_vector xyrow; - ae_vector nwbuf; - ae_vector integerbuf; - modelerrors err; - ae_vector rndbuf; - ae_shared_pool buf; - ae_shared_pool gradbuf; - ae_matrix dummydxy; - sparsematrix dummysxy; - ae_vector dummyidx; - ae_shared_pool dummypool; -} multilayerperceptron; -typedef struct -{ - ae_vector w; -} logitmodel; -typedef struct -{ - ae_bool brackt; - ae_bool stage1; - ae_int_t infoc; - double dg; - double dgm; - double dginit; - double dgtest; - double dgx; - double dgxm; - double dgy; - double dgym; - double finit; - double ftest1; - double fm; - double fx; - double fxm; - double fy; - double fym; - double stx; - double sty; - double stmin; - double stmax; - double width; - double width1; - double xtrapf; -} logitmcstate; -typedef struct -{ - ae_int_t ngrad; - ae_int_t nhess; -} mnlreport; -typedef struct -{ - ae_int_t n; - ae_vector states; - ae_int_t npairs; - ae_matrix data; - ae_matrix ec; - ae_matrix bndl; - ae_matrix bndu; - ae_matrix c; - ae_vector ct; - ae_int_t ccnt; - ae_vector pw; - ae_matrix priorp; - double regterm; - minbleicstate bs; - ae_int_t repinneriterationscount; - ae_int_t repouteriterationscount; - ae_int_t repnfev; - ae_int_t repterminationtype; - minbleicreport br; - ae_vector tmpp; - ae_vector effectivew; - ae_vector effectivebndl; - ae_vector effectivebndu; - ae_matrix effectivec; - ae_vector effectivect; - ae_vector h; - ae_matrix p; -} mcpdstate; -typedef struct -{ - ae_int_t inneriterationscount; - ae_int_t outeriterationscount; - ae_int_t nfev; - ae_int_t terminationtype; -} mcpdreport; -typedef struct -{ - ae_int_t ensemblesize; - ae_vector weights; - ae_vector columnmeans; - ae_vector columnsigmas; - multilayerperceptron network; - ae_vector y; -} mlpensemble; -typedef struct -{ - double relclserror; - double avgce; - double rmserror; - double avgerror; - double avgrelerror; - ae_int_t ngrad; - ae_int_t nhess; - ae_int_t ncholesky; -} mlpreport; -typedef struct -{ - double relclserror; - double avgce; - double rmserror; - double avgerror; - double avgrelerror; -} mlpcvreport; -typedef struct -{ - ae_vector bestparameters; - double bestrmserror; - ae_bool randomizenetwork; - multilayerperceptron network; - minlbfgsstate optimizer; - minlbfgsreport optimizerrep; - ae_vector wbuf0; - ae_vector wbuf1; - ae_vector allminibatches; - ae_vector currentminibatch; - rcommstate rstate; - ae_int_t algoused; - ae_int_t minibatchsize; - hqrndstate generator; -} smlptrnsession; -typedef struct -{ - ae_vector trnsubset; - ae_vector valsubset; - ae_shared_pool mlpsessions; - mlpreport mlprep; - multilayerperceptron network; -} mlpetrnsession; -typedef struct -{ - ae_int_t nin; - ae_int_t nout; - ae_bool rcpar; - ae_int_t lbfgsfactor; - double decay; - double wstep; - ae_int_t maxits; - ae_int_t datatype; - ae_int_t npoints; - ae_matrix densexy; - sparsematrix sparsexy; - smlptrnsession session; - ae_int_t ngradbatch; - ae_vector subset; - ae_int_t subsetsize; - ae_vector valsubset; - ae_int_t valsubsetsize; - ae_int_t algokind; - ae_int_t minibatchsize; -} mlptrainer; -typedef struct -{ - multilayerperceptron network; - mlpreport rep; - ae_vector subset; - ae_int_t subsetsize; - ae_vector xyrow; - ae_vector y; - ae_int_t ngrad; - ae_shared_pool trnpool; -} mlpparallelizationcv; - -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS C++ INTERFACE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib -{ - - - -/************************************************************************* -This structure is a clusterization engine. - -You should not try to access its fields directly. -Use ALGLIB functions in order to work with this object. - - -- ALGLIB -- - Copyright 10.07.2012 by Bochkanov Sergey -*************************************************************************/ -class _clusterizerstate_owner -{ -public: - _clusterizerstate_owner(); - _clusterizerstate_owner(const _clusterizerstate_owner &rhs); - _clusterizerstate_owner& operator=(const _clusterizerstate_owner &rhs); - virtual ~_clusterizerstate_owner(); - alglib_impl::clusterizerstate* c_ptr(); - alglib_impl::clusterizerstate* c_ptr() const; -protected: - alglib_impl::clusterizerstate *p_struct; -}; -class clusterizerstate : public _clusterizerstate_owner -{ -public: - clusterizerstate(); - clusterizerstate(const clusterizerstate &rhs); - clusterizerstate& operator=(const clusterizerstate &rhs); - virtual ~clusterizerstate(); - -}; - - -/************************************************************************* -This structure is used to store results of the agglomerative hierarchical -clustering (AHC). - -Following information is returned: - -* NPoints contains number of points in the original dataset - -* Z contains information about merges performed (see below). Z contains - indexes from the original (unsorted) dataset and it can be used when you - need to know what points were merged. However, it is not convenient when - you want to build a dendrograd (see below). - -* if you want to build dendrogram, you can use Z, but it is not good - option, because Z contains indexes from unsorted dataset. Dendrogram - built from such dataset is likely to have intersections. So, you have to - reorder you points before building dendrogram. - Permutation which reorders point is returned in P. Another representation - of merges, which is more convenient for dendorgram construction, is - returned in PM. - -* more information on format of Z, P and PM can be found below and in the - examples from ALGLIB Reference Manual. - -FORMAL DESCRIPTION OF FIELDS: - NPoints number of points - Z array[NPoints-1,2], contains indexes of clusters - linked in pairs to form clustering tree. I-th row - corresponds to I-th merge: - * Z[I,0] - index of the first cluster to merge - * Z[I,1] - index of the second cluster to merge - * Z[I,0]=0 - NFeatures number of variables, >=1 - TerminationType completion code: - * -5 if distance type is anything different from - Euclidean metric - * -3 for degenerate dataset: a) less than K distinct - points, b) K=0 for non-empty dataset. - * +1 for successful completion - K number of clusters - C array[K,NFeatures], rows of the array store centers - CIdx array[NPoints], which contains cluster indexes - - -- ALGLIB -- - Copyright 27.11.2012 by Bochkanov Sergey -*************************************************************************/ -class _kmeansreport_owner -{ -public: - _kmeansreport_owner(); - _kmeansreport_owner(const _kmeansreport_owner &rhs); - _kmeansreport_owner& operator=(const _kmeansreport_owner &rhs); - virtual ~_kmeansreport_owner(); - alglib_impl::kmeansreport* c_ptr(); - alglib_impl::kmeansreport* c_ptr() const; -protected: - alglib_impl::kmeansreport *p_struct; -}; -class kmeansreport : public _kmeansreport_owner -{ -public: - kmeansreport(); - kmeansreport(const kmeansreport &rhs); - kmeansreport& operator=(const kmeansreport &rhs); - virtual ~kmeansreport(); - ae_int_t &npoints; - ae_int_t &nfeatures; - ae_int_t &terminationtype; - ae_int_t &k; - real_2d_array c; - integer_1d_array cidx; - -}; - - - -/************************************************************************* - -*************************************************************************/ -class _decisionforest_owner -{ -public: - _decisionforest_owner(); - _decisionforest_owner(const _decisionforest_owner &rhs); - _decisionforest_owner& operator=(const _decisionforest_owner &rhs); - virtual ~_decisionforest_owner(); - alglib_impl::decisionforest* c_ptr(); - alglib_impl::decisionforest* c_ptr() const; -protected: - alglib_impl::decisionforest *p_struct; -}; -class decisionforest : public _decisionforest_owner -{ -public: - decisionforest(); - decisionforest(const decisionforest &rhs); - decisionforest& operator=(const decisionforest &rhs); - virtual ~decisionforest(); - -}; - - -/************************************************************************* - -*************************************************************************/ -class _dfreport_owner -{ -public: - _dfreport_owner(); - _dfreport_owner(const _dfreport_owner &rhs); - _dfreport_owner& operator=(const _dfreport_owner &rhs); - virtual ~_dfreport_owner(); - alglib_impl::dfreport* c_ptr(); - alglib_impl::dfreport* c_ptr() const; -protected: - alglib_impl::dfreport *p_struct; -}; -class dfreport : public _dfreport_owner -{ -public: - dfreport(); - dfreport(const dfreport &rhs); - dfreport& operator=(const dfreport &rhs); - virtual ~dfreport(); - double &relclserror; - double &avgce; - double &rmserror; - double &avgerror; - double &avgrelerror; - double &oobrelclserror; - double &oobavgce; - double &oobrmserror; - double &oobavgerror; - double &oobavgrelerror; - -}; - -/************************************************************************* - -*************************************************************************/ -class _linearmodel_owner -{ -public: - _linearmodel_owner(); - _linearmodel_owner(const _linearmodel_owner &rhs); - _linearmodel_owner& operator=(const _linearmodel_owner &rhs); - virtual ~_linearmodel_owner(); - alglib_impl::linearmodel* c_ptr(); - alglib_impl::linearmodel* c_ptr() const; -protected: - alglib_impl::linearmodel *p_struct; -}; -class linearmodel : public _linearmodel_owner -{ -public: - linearmodel(); - linearmodel(const linearmodel &rhs); - linearmodel& operator=(const linearmodel &rhs); - virtual ~linearmodel(); - -}; - - -/************************************************************************* -LRReport structure contains additional information about linear model: -* C - covariation matrix, array[0..NVars,0..NVars]. - C[i,j] = Cov(A[i],A[j]) -* RMSError - root mean square error on a training set -* AvgError - average error on a training set -* AvgRelError - average relative error on a training set (excluding - observations with zero function value). -* CVRMSError - leave-one-out cross-validation estimate of - generalization error. Calculated using fast algorithm - with O(NVars*NPoints) complexity. -* CVAvgError - cross-validation estimate of average error -* CVAvgRelError - cross-validation estimate of average relative error - -All other fields of the structure are intended for internal use and should -not be used outside ALGLIB. -*************************************************************************/ -class _lrreport_owner -{ -public: - _lrreport_owner(); - _lrreport_owner(const _lrreport_owner &rhs); - _lrreport_owner& operator=(const _lrreport_owner &rhs); - virtual ~_lrreport_owner(); - alglib_impl::lrreport* c_ptr(); - alglib_impl::lrreport* c_ptr() const; -protected: - alglib_impl::lrreport *p_struct; -}; -class lrreport : public _lrreport_owner -{ -public: - lrreport(); - lrreport(const lrreport &rhs); - lrreport& operator=(const lrreport &rhs); - virtual ~lrreport(); - real_2d_array c; - double &rmserror; - double &avgerror; - double &avgrelerror; - double &cvrmserror; - double &cvavgerror; - double &cvavgrelerror; - ae_int_t &ncvdefects; - integer_1d_array cvdefects; - -}; - - - - - -/************************************************************************* -Model's errors: - * RelCLSError - fraction of misclassified cases. - * AvgCE - acerage cross-entropy - * RMSError - root-mean-square error - * AvgError - average error - * AvgRelError - average relative error - -NOTE 1: RelCLSError/AvgCE are zero on regression problems. - -NOTE 2: on classification problems RMSError/AvgError/AvgRelError contain - errors in prediction of posterior probabilities -*************************************************************************/ -class _modelerrors_owner -{ -public: - _modelerrors_owner(); - _modelerrors_owner(const _modelerrors_owner &rhs); - _modelerrors_owner& operator=(const _modelerrors_owner &rhs); - virtual ~_modelerrors_owner(); - alglib_impl::modelerrors* c_ptr(); - alglib_impl::modelerrors* c_ptr() const; -protected: - alglib_impl::modelerrors *p_struct; -}; -class modelerrors : public _modelerrors_owner -{ -public: - modelerrors(); - modelerrors(const modelerrors &rhs); - modelerrors& operator=(const modelerrors &rhs); - virtual ~modelerrors(); - double &relclserror; - double &avgce; - double &rmserror; - double &avgerror; - double &avgrelerror; - -}; - - -/************************************************************************* - -*************************************************************************/ -class _multilayerperceptron_owner -{ -public: - _multilayerperceptron_owner(); - _multilayerperceptron_owner(const _multilayerperceptron_owner &rhs); - _multilayerperceptron_owner& operator=(const _multilayerperceptron_owner &rhs); - virtual ~_multilayerperceptron_owner(); - alglib_impl::multilayerperceptron* c_ptr(); - alglib_impl::multilayerperceptron* c_ptr() const; -protected: - alglib_impl::multilayerperceptron *p_struct; -}; -class multilayerperceptron : public _multilayerperceptron_owner -{ -public: - multilayerperceptron(); - multilayerperceptron(const multilayerperceptron &rhs); - multilayerperceptron& operator=(const multilayerperceptron &rhs); - virtual ~multilayerperceptron(); - -}; - -/************************************************************************* - -*************************************************************************/ -class _logitmodel_owner -{ -public: - _logitmodel_owner(); - _logitmodel_owner(const _logitmodel_owner &rhs); - _logitmodel_owner& operator=(const _logitmodel_owner &rhs); - virtual ~_logitmodel_owner(); - alglib_impl::logitmodel* c_ptr(); - alglib_impl::logitmodel* c_ptr() const; -protected: - alglib_impl::logitmodel *p_struct; -}; -class logitmodel : public _logitmodel_owner -{ -public: - logitmodel(); - logitmodel(const logitmodel &rhs); - logitmodel& operator=(const logitmodel &rhs); - virtual ~logitmodel(); - -}; - - -/************************************************************************* -MNLReport structure contains information about training process: -* NGrad - number of gradient calculations -* NHess - number of Hessian calculations -*************************************************************************/ -class _mnlreport_owner -{ -public: - _mnlreport_owner(); - _mnlreport_owner(const _mnlreport_owner &rhs); - _mnlreport_owner& operator=(const _mnlreport_owner &rhs); - virtual ~_mnlreport_owner(); - alglib_impl::mnlreport* c_ptr(); - alglib_impl::mnlreport* c_ptr() const; -protected: - alglib_impl::mnlreport *p_struct; -}; -class mnlreport : public _mnlreport_owner -{ -public: - mnlreport(); - mnlreport(const mnlreport &rhs); - mnlreport& operator=(const mnlreport &rhs); - virtual ~mnlreport(); - ae_int_t &ngrad; - ae_int_t &nhess; - -}; - -/************************************************************************* -This structure is a MCPD (Markov Chains for Population Data) solver. - -You should use ALGLIB functions in order to work with this object. - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -class _mcpdstate_owner -{ -public: - _mcpdstate_owner(); - _mcpdstate_owner(const _mcpdstate_owner &rhs); - _mcpdstate_owner& operator=(const _mcpdstate_owner &rhs); - virtual ~_mcpdstate_owner(); - alglib_impl::mcpdstate* c_ptr(); - alglib_impl::mcpdstate* c_ptr() const; -protected: - alglib_impl::mcpdstate *p_struct; -}; -class mcpdstate : public _mcpdstate_owner -{ -public: - mcpdstate(); - mcpdstate(const mcpdstate &rhs); - mcpdstate& operator=(const mcpdstate &rhs); - virtual ~mcpdstate(); - -}; - - -/************************************************************************* -This structure is a MCPD training report: - InnerIterationsCount - number of inner iterations of the - underlying optimization algorithm - OuterIterationsCount - number of outer iterations of the - underlying optimization algorithm - NFEV - number of merit function evaluations - TerminationType - termination type - (same as for MinBLEIC optimizer, positive - values denote success, negative ones - - failure) - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -class _mcpdreport_owner -{ -public: - _mcpdreport_owner(); - _mcpdreport_owner(const _mcpdreport_owner &rhs); - _mcpdreport_owner& operator=(const _mcpdreport_owner &rhs); - virtual ~_mcpdreport_owner(); - alglib_impl::mcpdreport* c_ptr(); - alglib_impl::mcpdreport* c_ptr() const; -protected: - alglib_impl::mcpdreport *p_struct; -}; -class mcpdreport : public _mcpdreport_owner -{ -public: - mcpdreport(); - mcpdreport(const mcpdreport &rhs); - mcpdreport& operator=(const mcpdreport &rhs); - virtual ~mcpdreport(); - ae_int_t &inneriterationscount; - ae_int_t &outeriterationscount; - ae_int_t &nfev; - ae_int_t &terminationtype; - -}; - -/************************************************************************* -Neural networks ensemble -*************************************************************************/ -class _mlpensemble_owner -{ -public: - _mlpensemble_owner(); - _mlpensemble_owner(const _mlpensemble_owner &rhs); - _mlpensemble_owner& operator=(const _mlpensemble_owner &rhs); - virtual ~_mlpensemble_owner(); - alglib_impl::mlpensemble* c_ptr(); - alglib_impl::mlpensemble* c_ptr() const; -protected: - alglib_impl::mlpensemble *p_struct; -}; -class mlpensemble : public _mlpensemble_owner -{ -public: - mlpensemble(); - mlpensemble(const mlpensemble &rhs); - mlpensemble& operator=(const mlpensemble &rhs); - virtual ~mlpensemble(); - -}; - -/************************************************************************* -Training report: - * RelCLSError - fraction of misclassified cases. - * AvgCE - acerage cross-entropy - * RMSError - root-mean-square error - * AvgError - average error - * AvgRelError - average relative error - * NGrad - number of gradient calculations - * NHess - number of Hessian calculations - * NCholesky - number of Cholesky decompositions - -NOTE 1: RelCLSError/AvgCE are zero on regression problems. - -NOTE 2: on classification problems RMSError/AvgError/AvgRelError contain - errors in prediction of posterior probabilities -*************************************************************************/ -class _mlpreport_owner -{ -public: - _mlpreport_owner(); - _mlpreport_owner(const _mlpreport_owner &rhs); - _mlpreport_owner& operator=(const _mlpreport_owner &rhs); - virtual ~_mlpreport_owner(); - alglib_impl::mlpreport* c_ptr(); - alglib_impl::mlpreport* c_ptr() const; -protected: - alglib_impl::mlpreport *p_struct; -}; -class mlpreport : public _mlpreport_owner -{ -public: - mlpreport(); - mlpreport(const mlpreport &rhs); - mlpreport& operator=(const mlpreport &rhs); - virtual ~mlpreport(); - double &relclserror; - double &avgce; - double &rmserror; - double &avgerror; - double &avgrelerror; - ae_int_t &ngrad; - ae_int_t &nhess; - ae_int_t &ncholesky; - -}; - - -/************************************************************************* -Cross-validation estimates of generalization error -*************************************************************************/ -class _mlpcvreport_owner -{ -public: - _mlpcvreport_owner(); - _mlpcvreport_owner(const _mlpcvreport_owner &rhs); - _mlpcvreport_owner& operator=(const _mlpcvreport_owner &rhs); - virtual ~_mlpcvreport_owner(); - alglib_impl::mlpcvreport* c_ptr(); - alglib_impl::mlpcvreport* c_ptr() const; -protected: - alglib_impl::mlpcvreport *p_struct; -}; -class mlpcvreport : public _mlpcvreport_owner -{ -public: - mlpcvreport(); - mlpcvreport(const mlpcvreport &rhs); - mlpcvreport& operator=(const mlpcvreport &rhs); - virtual ~mlpcvreport(); - double &relclserror; - double &avgce; - double &rmserror; - double &avgerror; - double &avgrelerror; - -}; - - -/************************************************************************* -Trainer object for neural network. - -You should not try to access fields of this object directly - use ALGLIB -functions to work with this object. -*************************************************************************/ -class _mlptrainer_owner -{ -public: - _mlptrainer_owner(); - _mlptrainer_owner(const _mlptrainer_owner &rhs); - _mlptrainer_owner& operator=(const _mlptrainer_owner &rhs); - virtual ~_mlptrainer_owner(); - alglib_impl::mlptrainer* c_ptr(); - alglib_impl::mlptrainer* c_ptr() const; -protected: - alglib_impl::mlptrainer *p_struct; -}; -class mlptrainer : public _mlptrainer_owner -{ -public: - mlptrainer(); - mlptrainer(const mlptrainer &rhs); - mlptrainer& operator=(const mlptrainer &rhs); - virtual ~mlptrainer(); - -}; - -/************************************************************************* -Optimal binary classification - -Algorithms finds optimal (=with minimal cross-entropy) binary partition. -Internal subroutine. - -INPUT PARAMETERS: - A - array[0..N-1], variable - C - array[0..N-1], class numbers (0 or 1). - N - array size - -OUTPUT PARAMETERS: - Info - completion code: - * -3, all values of A[] are same (partition is impossible) - * -2, one of C[] is incorrect (<0, >1) - * -1, incorrect pararemets were passed (N<=0). - * 1, OK - Threshold- partiton boundary. Left part contains values which are - strictly less than Threshold. Right part contains values - which are greater than or equal to Threshold. - PAL, PBL- probabilities P(0|v=Threshold) and P(1|v>=Threshold) - CVE - cross-validation estimate of cross-entropy - - -- ALGLIB -- - Copyright 22.05.2008 by Bochkanov Sergey -*************************************************************************/ -void dsoptimalsplit2(const real_1d_array &a, const integer_1d_array &c, const ae_int_t n, ae_int_t &info, double &threshold, double &pal, double &pbl, double &par, double &pbr, double &cve); - - -/************************************************************************* -Optimal partition, internal subroutine. Fast version. - -Accepts: - A array[0..N-1] array of attributes array[0..N-1] - C array[0..N-1] array of class labels - TiesBuf array[0..N] temporaries (ties) - CntBuf array[0..2*NC-1] temporaries (counts) - Alpha centering factor (0<=alpha<=1, recommended value - 0.05) - BufR array[0..N-1] temporaries - BufI array[0..N-1] temporaries - -Output: - Info error code (">0"=OK, "<0"=bad) - RMS training set RMS error - CVRMS leave-one-out RMS error - -Note: - content of all arrays is changed by subroutine; - it doesn't allocate temporaries. - - -- ALGLIB -- - Copyright 11.12.2008 by Bochkanov Sergey -*************************************************************************/ -void dsoptimalsplit2fast(real_1d_array &a, integer_1d_array &c, integer_1d_array &tiesbuf, integer_1d_array &cntbuf, real_1d_array &bufr, integer_1d_array &bufi, const ae_int_t n, const ae_int_t nc, const double alpha, ae_int_t &info, double &threshold, double &rms, double &cvrms); - -/************************************************************************* -This function initializes clusterizer object. Newly initialized object is -empty, i.e. it does not contain dataset. You should use it as follows: -1. creation -2. dataset is added with ClusterizerSetPoints() -3. additional parameters are set -3. clusterization is performed with one of the clustering functions - - -- ALGLIB -- - Copyright 10.07.2012 by Bochkanov Sergey -*************************************************************************/ -void clusterizercreate(clusterizerstate &s); - - -/************************************************************************* -This function adds dataset to the clusterizer structure. - -This function overrides all previous calls of ClusterizerSetPoints() or -ClusterizerSetDistances(). - -INPUT PARAMETERS: - S - clusterizer state, initialized by ClusterizerCreate() - XY - array[NPoints,NFeatures], dataset - NPoints - number of points, >=0 - NFeatures- number of features, >=1 - DistType- distance function: - * 0 Chebyshev distance (L-inf norm) - * 1 city block distance (L1 norm) - * 2 Euclidean distance (L2 norm) - * 10 Pearson correlation: - dist(a,b) = 1-corr(a,b) - * 11 Absolute Pearson correlation: - dist(a,b) = 1-|corr(a,b)| - * 12 Uncentered Pearson correlation (cosine of the angle): - dist(a,b) = a'*b/(|a|*|b|) - * 13 Absolute uncentered Pearson correlation - dist(a,b) = |a'*b|/(|a|*|b|) - * 20 Spearman rank correlation: - dist(a,b) = 1-rankcorr(a,b) - * 21 Absolute Spearman rank correlation - dist(a,b) = 1-|rankcorr(a,b)| - -NOTE 1: different distance functions have different performance penalty: - * Euclidean or Pearson correlation distances are the fastest ones - * Spearman correlation distance function is a bit slower - * city block and Chebyshev distances are order of magnitude slower - - The reason behing difference in performance is that correlation-based - distance functions are computed using optimized linear algebra kernels, - while Chebyshev and city block distance functions are computed using - simple nested loops with two branches at each iteration. - -NOTE 2: different clustering algorithms have different limitations: - * agglomerative hierarchical clustering algorithms may be used with - any kind of distance metric - * k-means++ clustering algorithm may be used only with Euclidean - distance function - Thus, list of specific clustering algorithms you may use depends - on distance function you specify when you set your dataset. - - -- ALGLIB -- - Copyright 10.07.2012 by Bochkanov Sergey -*************************************************************************/ -void clusterizersetpoints(const clusterizerstate &s, const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nfeatures, const ae_int_t disttype); -void clusterizersetpoints(const clusterizerstate &s, const real_2d_array &xy, const ae_int_t disttype); - - -/************************************************************************* -This function adds dataset given by distance matrix to the clusterizer -structure. It is important that dataset is not given explicitly - only -distance matrix is given. - -This function overrides all previous calls of ClusterizerSetPoints() or -ClusterizerSetDistances(). - -INPUT PARAMETERS: - S - clusterizer state, initialized by ClusterizerCreate() - D - array[NPoints,NPoints], distance matrix given by its upper - or lower triangle (main diagonal is ignored because its - entries are expected to be zero). - NPoints - number of points - IsUpper - whether upper or lower triangle of D is given. - -NOTE 1: different clustering algorithms have different limitations: - * agglomerative hierarchical clustering algorithms may be used with - any kind of distance metric, including one which is given by - distance matrix - * k-means++ clustering algorithm may be used only with Euclidean - distance function and explicitly given points - it can not be - used with dataset given by distance matrix - Thus, if you call this function, you will be unable to use k-means - clustering algorithm to process your problem. - - -- ALGLIB -- - Copyright 10.07.2012 by Bochkanov Sergey -*************************************************************************/ -void clusterizersetdistances(const clusterizerstate &s, const real_2d_array &d, const ae_int_t npoints, const bool isupper); -void clusterizersetdistances(const clusterizerstate &s, const real_2d_array &d, const bool isupper); - - -/************************************************************************* -This function sets agglomerative hierarchical clustering algorithm - -INPUT PARAMETERS: - S - clusterizer state, initialized by ClusterizerCreate() - Algo - algorithm type: - * 0 complete linkage (default algorithm) - * 1 single linkage - * 2 unweighted average linkage - * 3 weighted average linkage - - -- ALGLIB -- - Copyright 10.07.2012 by Bochkanov Sergey -*************************************************************************/ -void clusterizersetahcalgo(const clusterizerstate &s, const ae_int_t algo); - - -/************************************************************************* -This function sets k-means++ properties : number of restarts and maximum -number of iterations per one run. - -INPUT PARAMETERS: - S - clusterizer state, initialized by ClusterizerCreate() - Restarts- restarts count, >=1. - k-means++ algorithm performs several restarts and chooses - best set of centers (one with minimum squared distance). - MaxIts - maximum number of k-means iterations performed during one - run. >=0, zero value means that algorithm performs unlimited - number of iterations. - - -- ALGLIB -- - Copyright 10.07.2012 by Bochkanov Sergey -*************************************************************************/ -void clusterizersetkmeanslimits(const clusterizerstate &s, const ae_int_t restarts, const ae_int_t maxits); - - -/************************************************************************* -This function performs agglomerative hierarchical clustering - -FOR USERS OF SMP EDITION: - - ! This function can utilize multicore capabilities of your system. In - ! order to do this you have to call version with "smp_" prefix, which - ! indicates that multicore code will be used. - ! - ! This note is given for users of SMP edition; if you use GPL edition, - ! or commercial edition of ALGLIB without SMP support, you still will - ! be able to call smp-version of this function, but all computations - ! will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - ! - ! You should remember that starting/stopping worker thread always have - ! non-zero cost. Multicore version is pretty efficient on large - ! problems which need more than 1.000.000 operations to be solved, - ! gives moderate speed-up in mid-range (from 100.000 to 1.000.000 CPU - ! cycles), but gives no speed-up for small problems (less than 100.000 - ! operations). - -INPUT PARAMETERS: - S - clusterizer state, initialized by ClusterizerCreate() - -OUTPUT PARAMETERS: - Rep - clustering results; see description of AHCReport - structure for more information. - -NOTE 1: hierarchical clustering algorithms require large amounts of memory. - In particular, this implementation needs sizeof(double)*NPoints^2 - bytes, which are used to store distance matrix. In case we work - with user-supplied matrix, this amount is multiplied by 2 (we have - to store original matrix and to work with its copy). - - For example, problem with 10000 points would require 800M of RAM, - even when working in a 1-dimensional space. - - -- ALGLIB -- - Copyright 10.07.2012 by Bochkanov Sergey -*************************************************************************/ -void clusterizerrunahc(const clusterizerstate &s, ahcreport &rep); -void smp_clusterizerrunahc(const clusterizerstate &s, ahcreport &rep); - - -/************************************************************************* -This function performs clustering by k-means++ algorithm. - -You may change algorithm properties like number of restarts or iterations -limit by calling ClusterizerSetKMeansLimits() functions. - -INPUT PARAMETERS: - S - clusterizer state, initialized by ClusterizerCreate() - K - number of clusters, K>=0. - K can be zero only when algorithm is called for empty - dataset, in this case completion code is set to - success (+1). - If K=0 and dataset size is non-zero, we can not - meaningfully assign points to some center (there are no - centers because K=0) and return -3 as completion code - (failure). - -OUTPUT PARAMETERS: - Rep - clustering results; see description of KMeansReport - structure for more information. - -NOTE 1: k-means clustering can be performed only for datasets with - Euclidean distance function. Algorithm will return negative - completion code in Rep.TerminationType in case dataset was added - to clusterizer with DistType other than Euclidean (or dataset was - specified by distance matrix instead of explicitly given points). - - -- ALGLIB -- - Copyright 10.07.2012 by Bochkanov Sergey -*************************************************************************/ -void clusterizerrunkmeans(const clusterizerstate &s, const ae_int_t k, kmeansreport &rep); - - -/************************************************************************* -This function returns distance matrix for dataset - -FOR USERS OF SMP EDITION: - - ! This function can utilize multicore capabilities of your system. In - ! order to do this you have to call version with "smp_" prefix, which - ! indicates that multicore code will be used. - ! - ! This note is given for users of SMP edition; if you use GPL edition, - ! or commercial edition of ALGLIB without SMP support, you still will - ! be able to call smp-version of this function, but all computations - ! will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - ! - ! You should remember that starting/stopping worker thread always have - ! non-zero cost. Multicore version is pretty efficient on large - ! problems which need more than 1.000.000 operations to be solved, - ! gives moderate speed-up in mid-range (from 100.000 to 1.000.000 CPU - ! cycles), but gives no speed-up for small problems (less than 100.000 - ! operations). - -INPUT PARAMETERS: - XY - array[NPoints,NFeatures], dataset - NPoints - number of points, >=0 - NFeatures- number of features, >=1 - DistType- distance function: - * 0 Chebyshev distance (L-inf norm) - * 1 city block distance (L1 norm) - * 2 Euclidean distance (L2 norm) - * 10 Pearson correlation: - dist(a,b) = 1-corr(a,b) - * 11 Absolute Pearson correlation: - dist(a,b) = 1-|corr(a,b)| - * 12 Uncentered Pearson correlation (cosine of the angle): - dist(a,b) = a'*b/(|a|*|b|) - * 13 Absolute uncentered Pearson correlation - dist(a,b) = |a'*b|/(|a|*|b|) - * 20 Spearman rank correlation: - dist(a,b) = 1-rankcorr(a,b) - * 21 Absolute Spearman rank correlation - dist(a,b) = 1-|rankcorr(a,b)| - -OUTPUT PARAMETERS: - D - array[NPoints,NPoints], distance matrix - (full matrix is returned, with lower and upper triangles) - -NOTES: different distance functions have different performance penalty: - * Euclidean or Pearson correlation distances are the fastest ones - * Spearman correlation distance function is a bit slower - * city block and Chebyshev distances are order of magnitude slower - - The reason behing difference in performance is that correlation-based - distance functions are computed using optimized linear algebra kernels, - while Chebyshev and city block distance functions are computed using - simple nested loops with two branches at each iteration. - - -- ALGLIB -- - Copyright 10.07.2012 by Bochkanov Sergey -*************************************************************************/ -void clusterizergetdistances(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nfeatures, const ae_int_t disttype, real_2d_array &d); -void smp_clusterizergetdistances(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nfeatures, const ae_int_t disttype, real_2d_array &d); - - -/************************************************************************* -This function takes as input clusterization report Rep, desired clusters -count K, and builds top K clusters from hierarchical clusterization tree. -It returns assignment of points to clusters (array of cluster indexes). - -INPUT PARAMETERS: - Rep - report from ClusterizerRunAHC() performed on XY - K - desired number of clusters, 1<=K<=NPoints. - K can be zero only when NPoints=0. - -OUTPUT PARAMETERS: - CIdx - array[NPoints], I-th element contains cluster index (from - 0 to K-1) for I-th point of the dataset. - CZ - array[K]. This array allows to convert cluster indexes - returned by this function to indexes used by Rep.Z. J-th - cluster returned by this function corresponds to CZ[J]-th - cluster stored in Rep.Z/PZ/PM. - It is guaranteed that CZ[I]=0 - -OUTPUT PARAMETERS: - K - number of clusters, 1<=K<=NPoints - CIdx - array[NPoints], I-th element contains cluster index (from - 0 to K-1) for I-th point of the dataset. - CZ - array[K]. This array allows to convert cluster indexes - returned by this function to indexes used by Rep.Z. J-th - cluster returned by this function corresponds to CZ[J]-th - cluster stored in Rep.Z/PZ/PM. - It is guaranteed that CZ[I]=1 - NVars - number of independent variables, NVars>=1 - NClasses - task type: - * NClasses=1 - regression task with one - dependent variable - * NClasses>1 - classification task with - NClasses classes. - NTrees - number of trees in a forest, NTrees>=1. - recommended values: 50-100. - R - percent of a training set used to build - individual trees. 01). - * 1, if task has been solved - DF - model built - Rep - training report, contains error on a training set - and out-of-bag estimates of generalization error. - - -- ALGLIB -- - Copyright 19.02.2009 by Bochkanov Sergey -*************************************************************************/ -void dfbuildrandomdecisionforest(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nvars, const ae_int_t nclasses, const ae_int_t ntrees, const double r, ae_int_t &info, decisionforest &df, dfreport &rep); - - -/************************************************************************* -This subroutine builds random decision forest. -This function gives ability to tune number of variables used when choosing -best split. - -INPUT PARAMETERS: - XY - training set - NPoints - training set size, NPoints>=1 - NVars - number of independent variables, NVars>=1 - NClasses - task type: - * NClasses=1 - regression task with one - dependent variable - * NClasses>1 - classification task with - NClasses classes. - NTrees - number of trees in a forest, NTrees>=1. - recommended values: 50-100. - NRndVars - number of variables used when choosing best split - R - percent of a training set used to build - individual trees. 01). - * 1, if task has been solved - DF - model built - Rep - training report, contains error on a training set - and out-of-bag estimates of generalization error. - - -- ALGLIB -- - Copyright 19.02.2009 by Bochkanov Sergey -*************************************************************************/ -void dfbuildrandomdecisionforestx1(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nvars, const ae_int_t nclasses, const ae_int_t ntrees, const ae_int_t nrndvars, const double r, ae_int_t &info, decisionforest &df, dfreport &rep); - - -/************************************************************************* -Procesing - -INPUT PARAMETERS: - DF - decision forest model - X - input vector, array[0..NVars-1]. - -OUTPUT PARAMETERS: - Y - result. Regression estimate when solving regression task, - vector of posterior probabilities for classification task. - -See also DFProcessI. - - -- ALGLIB -- - Copyright 16.02.2009 by Bochkanov Sergey -*************************************************************************/ -void dfprocess(const decisionforest &df, const real_1d_array &x, real_1d_array &y); - - -/************************************************************************* -'interactive' variant of DFProcess for languages like Python which support -constructs like "Y = DFProcessI(DF,X)" and interactive mode of interpreter - -This function allocates new array on each call, so it is significantly -slower than its 'non-interactive' counterpart, but it is more convenient -when you call it from command line. - - -- ALGLIB -- - Copyright 28.02.2010 by Bochkanov Sergey -*************************************************************************/ -void dfprocessi(const decisionforest &df, const real_1d_array &x, real_1d_array &y); - - -/************************************************************************* -Relative classification error on the test set - -INPUT PARAMETERS: - DF - decision forest model - XY - test set - NPoints - test set size - -RESULT: - percent of incorrectly classified cases. - Zero if model solves regression task. - - -- ALGLIB -- - Copyright 16.02.2009 by Bochkanov Sergey -*************************************************************************/ -double dfrelclserror(const decisionforest &df, const real_2d_array &xy, const ae_int_t npoints); - - -/************************************************************************* -Average cross-entropy (in bits per element) on the test set - -INPUT PARAMETERS: - DF - decision forest model - XY - test set - NPoints - test set size - -RESULT: - CrossEntropy/(NPoints*LN(2)). - Zero if model solves regression task. - - -- ALGLIB -- - Copyright 16.02.2009 by Bochkanov Sergey -*************************************************************************/ -double dfavgce(const decisionforest &df, const real_2d_array &xy, const ae_int_t npoints); - - -/************************************************************************* -RMS error on the test set - -INPUT PARAMETERS: - DF - decision forest model - XY - test set - NPoints - test set size - -RESULT: - root mean square error. - Its meaning for regression task is obvious. As for - classification task, RMS error means error when estimating posterior - probabilities. - - -- ALGLIB -- - Copyright 16.02.2009 by Bochkanov Sergey -*************************************************************************/ -double dfrmserror(const decisionforest &df, const real_2d_array &xy, const ae_int_t npoints); - - -/************************************************************************* -Average error on the test set - -INPUT PARAMETERS: - DF - decision forest model - XY - test set - NPoints - test set size - -RESULT: - Its meaning for regression task is obvious. As for - classification task, it means average error when estimating posterior - probabilities. - - -- ALGLIB -- - Copyright 16.02.2009 by Bochkanov Sergey -*************************************************************************/ -double dfavgerror(const decisionforest &df, const real_2d_array &xy, const ae_int_t npoints); - - -/************************************************************************* -Average relative error on the test set - -INPUT PARAMETERS: - DF - decision forest model - XY - test set - NPoints - test set size - -RESULT: - Its meaning for regression task is obvious. As for - classification task, it means average relative error when estimating - posterior probability of belonging to the correct class. - - -- ALGLIB -- - Copyright 16.02.2009 by Bochkanov Sergey -*************************************************************************/ -double dfavgrelerror(const decisionforest &df, const real_2d_array &xy, const ae_int_t npoints); - -/************************************************************************* -Linear regression - -Subroutine builds model: - - Y = A(0)*X[0] + ... + A(N-1)*X[N-1] + A(N) - -and model found in ALGLIB format, covariation matrix, training set errors -(rms, average, average relative) and leave-one-out cross-validation -estimate of the generalization error. CV estimate calculated using fast -algorithm with O(NPoints*NVars) complexity. - -When covariation matrix is calculated standard deviations of function -values are assumed to be equal to RMS error on the training set. - -INPUT PARAMETERS: - XY - training set, array [0..NPoints-1,0..NVars]: - * NVars columns - independent variables - * last column - dependent variable - NPoints - training set size, NPoints>NVars+1 - NVars - number of independent variables - -OUTPUT PARAMETERS: - Info - return code: - * -255, in case of unknown internal error - * -4, if internal SVD subroutine haven't converged - * -1, if incorrect parameters was passed (NPoints0. - NPoints - training set size, NPoints>NVars+1 - NVars - number of independent variables - -OUTPUT PARAMETERS: - Info - return code: - * -255, in case of unknown internal error - * -4, if internal SVD subroutine haven't converged - * -1, if incorrect parameters was passed (NPoints=0 - K - K>=1 (K can be larger than N , such cases will be - correctly handled). Window width. K=1 corresponds to - identity transformation (nothing changes). - -OUTPUT PARAMETERS: - X - array, whose first N elements were processed with SMA(K) - -NOTE 1: this function uses efficient in-place algorithm which does not - allocate temporary arrays. - -NOTE 2: this algorithm makes only one pass through array and uses running - sum to speed-up calculation of the averages. Additional measures - are taken to ensure that running sum on a long sequence of zero - elements will be correctly reset to zero even in the presence of - round-off error. - -NOTE 3: this is unsymmetric version of the algorithm, which does NOT - averages points after the current one. Only X[i], X[i-1], ... are - used when calculating new value of X[i]. We should also note that - this algorithm uses BOTH previous points and current one, i.e. - new value of X[i] depends on BOTH previous point and X[i] itself. - - -- ALGLIB -- - Copyright 25.10.2011 by Bochkanov Sergey -*************************************************************************/ -void filtersma(real_1d_array &x, const ae_int_t n, const ae_int_t k); -void filtersma(real_1d_array &x, const ae_int_t k); - - -/************************************************************************* -Filters: exponential moving averages. - -This filter replaces array by results of EMA(alpha) filter. EMA(alpha) is -defined as filter which replaces X[] by S[]: - S[0] = X[0] - S[t] = alpha*X[t] + (1-alpha)*S[t-1] - -INPUT PARAMETERS: - X - array[N], array to process. It can be larger than N, - in this case only first N points are processed. - N - points count, N>=0 - alpha - 0=0 - K - K>=1 (K can be larger than N , such cases will be - correctly handled). Window width. K=1 corresponds to - identity transformation (nothing changes). - -OUTPUT PARAMETERS: - X - array, whose first N elements were processed with SMA(K) - -NOTE 1: this function uses efficient in-place algorithm which does not - allocate temporary arrays. - -NOTE 2: this algorithm makes only one pass through array and uses running - sum to speed-up calculation of the averages. Additional measures - are taken to ensure that running sum on a long sequence of zero - elements will be correctly reset to zero even in the presence of - round-off error. - -NOTE 3: this is unsymmetric version of the algorithm, which does NOT - averages points after the current one. Only X[i], X[i-1], ... are - used when calculating new value of X[i]. We should also note that - this algorithm uses BOTH previous points and current one, i.e. - new value of X[i] depends on BOTH previous point and X[i] itself. - - -- ALGLIB -- - Copyright 25.10.2011 by Bochkanov Sergey -*************************************************************************/ -void filterlrma(real_1d_array &x, const ae_int_t n, const ae_int_t k); -void filterlrma(real_1d_array &x, const ae_int_t k); - -/************************************************************************* -Multiclass Fisher LDA - -Subroutine finds coefficients of linear combination which optimally separates -training set on classes. - -INPUT PARAMETERS: - XY - training set, array[0..NPoints-1,0..NVars]. - First NVars columns store values of independent - variables, next column stores number of class (from 0 - to NClasses-1) which dataset element belongs to. Fractional - values are rounded to nearest integer. - NPoints - training set size, NPoints>=0 - NVars - number of independent variables, NVars>=1 - NClasses - number of classes, NClasses>=2 - - -OUTPUT PARAMETERS: - Info - return code: - * -4, if internal EVD subroutine hasn't converged - * -2, if there is a point with class number - outside of [0..NClasses-1]. - * -1, if incorrect parameters was passed (NPoints<0, - NVars<1, NClasses<2) - * 1, if task has been solved - * 2, if there was a multicollinearity in training set, - but task has been solved. - W - linear combination coefficients, array[0..NVars-1] - - -- ALGLIB -- - Copyright 31.05.2008 by Bochkanov Sergey -*************************************************************************/ -void fisherlda(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nvars, const ae_int_t nclasses, ae_int_t &info, real_1d_array &w); - - -/************************************************************************* -N-dimensional multiclass Fisher LDA - -Subroutine finds coefficients of linear combinations which optimally separates -training set on classes. It returns N-dimensional basis whose vector are sorted -by quality of training set separation (in descending order). - -INPUT PARAMETERS: - XY - training set, array[0..NPoints-1,0..NVars]. - First NVars columns store values of independent - variables, next column stores number of class (from 0 - to NClasses-1) which dataset element belongs to. Fractional - values are rounded to nearest integer. - NPoints - training set size, NPoints>=0 - NVars - number of independent variables, NVars>=1 - NClasses - number of classes, NClasses>=2 - - -OUTPUT PARAMETERS: - Info - return code: - * -4, if internal EVD subroutine hasn't converged - * -2, if there is a point with class number - outside of [0..NClasses-1]. - * -1, if incorrect parameters was passed (NPoints<0, - NVars<1, NClasses<2) - * 1, if task has been solved - * 2, if there was a multicollinearity in training set, - but task has been solved. - W - basis, array[0..NVars-1,0..NVars-1] - columns of matrix stores basis vectors, sorted by - quality of training set separation (in descending order) - - -- ALGLIB -- - Copyright 31.05.2008 by Bochkanov Sergey -*************************************************************************/ -void fisherldan(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nvars, const ae_int_t nclasses, ae_int_t &info, real_2d_array &w); - -/************************************************************************* -This function serializes data structure to string. - -Important properties of s_out: -* it contains alphanumeric characters, dots, underscores, minus signs -* these symbols are grouped into words, which are separated by spaces - and Windows-style (CR+LF) newlines -* although serializer uses spaces and CR+LF as separators, you can - replace any separator character by arbitrary combination of spaces, - tabs, Windows or Unix newlines. It allows flexible reformatting of - the string in case you want to include it into text or XML file. - But you should not insert separators into the middle of the "words" - nor you should change case of letters. -* s_out can be freely moved between 32-bit and 64-bit systems, little - and big endian machines, and so on. You can serialize structure on - 32-bit machine and unserialize it on 64-bit one (or vice versa), or - serialize it on SPARC and unserialize on x86. You can also - serialize it in C++ version of ALGLIB and unserialize in C# one, - and vice versa. -*************************************************************************/ -void mlpserialize(multilayerperceptron &obj, std::string &s_out); - - -/************************************************************************* -This function unserializes data structure from string. -*************************************************************************/ -void mlpunserialize(std::string &s_in, multilayerperceptron &obj); - - -/************************************************************************* -Creates neural network with NIn inputs, NOut outputs, without hidden -layers, with linear output layer. Network weights are filled with small -random values. - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpcreate0(const ae_int_t nin, const ae_int_t nout, multilayerperceptron &network); - - -/************************************************************************* -Same as MLPCreate0, but with one hidden layer (NHid neurons) with -non-linear activation function. Output layer is linear. - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpcreate1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, multilayerperceptron &network); - - -/************************************************************************* -Same as MLPCreate0, but with two hidden layers (NHid1 and NHid2 neurons) -with non-linear activation function. Output layer is linear. - $ALL - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpcreate2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, multilayerperceptron &network); - - -/************************************************************************* -Creates neural network with NIn inputs, NOut outputs, without hidden -layers with non-linear output layer. Network weights are filled with small -random values. - -Activation function of the output layer takes values: - - (B, +INF), if D>=0 - -or - - (-INF, B), if D<0. - - - -- ALGLIB -- - Copyright 30.03.2008 by Bochkanov Sergey -*************************************************************************/ -void mlpcreateb0(const ae_int_t nin, const ae_int_t nout, const double b, const double d, multilayerperceptron &network); - - -/************************************************************************* -Same as MLPCreateB0 but with non-linear hidden layer. - - -- ALGLIB -- - Copyright 30.03.2008 by Bochkanov Sergey -*************************************************************************/ -void mlpcreateb1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, const double b, const double d, multilayerperceptron &network); - - -/************************************************************************* -Same as MLPCreateB0 but with two non-linear hidden layers. - - -- ALGLIB -- - Copyright 30.03.2008 by Bochkanov Sergey -*************************************************************************/ -void mlpcreateb2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, const double b, const double d, multilayerperceptron &network); - - -/************************************************************************* -Creates neural network with NIn inputs, NOut outputs, without hidden -layers with non-linear output layer. Network weights are filled with small -random values. Activation function of the output layer takes values [A,B]. - - -- ALGLIB -- - Copyright 30.03.2008 by Bochkanov Sergey -*************************************************************************/ -void mlpcreater0(const ae_int_t nin, const ae_int_t nout, const double a, const double b, multilayerperceptron &network); - - -/************************************************************************* -Same as MLPCreateR0, but with non-linear hidden layer. - - -- ALGLIB -- - Copyright 30.03.2008 by Bochkanov Sergey -*************************************************************************/ -void mlpcreater1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, const double a, const double b, multilayerperceptron &network); - - -/************************************************************************* -Same as MLPCreateR0, but with two non-linear hidden layers. - - -- ALGLIB -- - Copyright 30.03.2008 by Bochkanov Sergey -*************************************************************************/ -void mlpcreater2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, const double a, const double b, multilayerperceptron &network); - - -/************************************************************************* -Creates classifier network with NIn inputs and NOut possible classes. -Network contains no hidden layers and linear output layer with SOFTMAX- -normalization (so outputs sums up to 1.0 and converge to posterior -probabilities). - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpcreatec0(const ae_int_t nin, const ae_int_t nout, multilayerperceptron &network); - - -/************************************************************************* -Same as MLPCreateC0, but with one non-linear hidden layer. - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpcreatec1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, multilayerperceptron &network); - - -/************************************************************************* -Same as MLPCreateC0, but with two non-linear hidden layers. - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpcreatec2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, multilayerperceptron &network); - - -/************************************************************************* -Randomization of neural network weights - - -- ALGLIB -- - Copyright 06.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlprandomize(const multilayerperceptron &network); - - -/************************************************************************* -Randomization of neural network weights and standartisator - - -- ALGLIB -- - Copyright 10.03.2008 by Bochkanov Sergey -*************************************************************************/ -void mlprandomizefull(const multilayerperceptron &network); - - -/************************************************************************* -Returns information about initialized network: number of inputs, outputs, -weights. - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpproperties(const multilayerperceptron &network, ae_int_t &nin, ae_int_t &nout, ae_int_t &wcount); - - -/************************************************************************* -Returns number of inputs. - - -- ALGLIB -- - Copyright 19.10.2011 by Bochkanov Sergey -*************************************************************************/ -ae_int_t mlpgetinputscount(const multilayerperceptron &network); - - -/************************************************************************* -Returns number of outputs. - - -- ALGLIB -- - Copyright 19.10.2011 by Bochkanov Sergey -*************************************************************************/ -ae_int_t mlpgetoutputscount(const multilayerperceptron &network); - - -/************************************************************************* -Returns number of weights. - - -- ALGLIB -- - Copyright 19.10.2011 by Bochkanov Sergey -*************************************************************************/ -ae_int_t mlpgetweightscount(const multilayerperceptron &network); - - -/************************************************************************* -Tells whether network is SOFTMAX-normalized (i.e. classifier) or not. - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -bool mlpissoftmax(const multilayerperceptron &network); - - -/************************************************************************* -This function returns total number of layers (including input, hidden and -output layers). - - -- ALGLIB -- - Copyright 25.03.2011 by Bochkanov Sergey -*************************************************************************/ -ae_int_t mlpgetlayerscount(const multilayerperceptron &network); - - -/************************************************************************* -This function returns size of K-th layer. - -K=0 corresponds to input layer, K=CNT-1 corresponds to output layer. - -Size of the output layer is always equal to the number of outputs, although -when we have softmax-normalized network, last neuron doesn't have any -connections - it is just zero. - - -- ALGLIB -- - Copyright 25.03.2011 by Bochkanov Sergey -*************************************************************************/ -ae_int_t mlpgetlayersize(const multilayerperceptron &network, const ae_int_t k); - - -/************************************************************************* -This function returns offset/scaling coefficients for I-th input of the -network. - -INPUT PARAMETERS: - Network - network - I - input index - -OUTPUT PARAMETERS: - Mean - mean term - Sigma - sigma term, guaranteed to be nonzero. - -I-th input is passed through linear transformation - IN[i] = (IN[i]-Mean)/Sigma -before feeding to the network - - -- ALGLIB -- - Copyright 25.03.2011 by Bochkanov Sergey -*************************************************************************/ -void mlpgetinputscaling(const multilayerperceptron &network, const ae_int_t i, double &mean, double &sigma); - - -/************************************************************************* -This function returns offset/scaling coefficients for I-th output of the -network. - -INPUT PARAMETERS: - Network - network - I - input index - -OUTPUT PARAMETERS: - Mean - mean term - Sigma - sigma term, guaranteed to be nonzero. - -I-th output is passed through linear transformation - OUT[i] = OUT[i]*Sigma+Mean -before returning it to user. In case we have SOFTMAX-normalized network, -we return (Mean,Sigma)=(0.0,1.0). - - -- ALGLIB -- - Copyright 25.03.2011 by Bochkanov Sergey -*************************************************************************/ -void mlpgetoutputscaling(const multilayerperceptron &network, const ae_int_t i, double &mean, double &sigma); - - -/************************************************************************* -This function returns information about Ith neuron of Kth layer - -INPUT PARAMETERS: - Network - network - K - layer index - I - neuron index (within layer) - -OUTPUT PARAMETERS: - FKind - activation function type (used by MLPActivationFunction()) - this value is zero for input or linear neurons - Threshold - also called offset, bias - zero for input neurons - -NOTE: this function throws exception if layer or neuron with given index -do not exists. - - -- ALGLIB -- - Copyright 25.03.2011 by Bochkanov Sergey -*************************************************************************/ -void mlpgetneuroninfo(const multilayerperceptron &network, const ae_int_t k, const ae_int_t i, ae_int_t &fkind, double &threshold); - - -/************************************************************************* -This function returns information about connection from I0-th neuron of -K0-th layer to I1-th neuron of K1-th layer. - -INPUT PARAMETERS: - Network - network - K0 - layer index - I0 - neuron index (within layer) - K1 - layer index - I1 - neuron index (within layer) - -RESULT: - connection weight (zero for non-existent connections) - -This function: -1. throws exception if layer or neuron with given index do not exists. -2. returns zero if neurons exist, but there is no connection between them - - -- ALGLIB -- - Copyright 25.03.2011 by Bochkanov Sergey -*************************************************************************/ -double mlpgetweight(const multilayerperceptron &network, const ae_int_t k0, const ae_int_t i0, const ae_int_t k1, const ae_int_t i1); - - -/************************************************************************* -This function sets offset/scaling coefficients for I-th input of the -network. - -INPUT PARAMETERS: - Network - network - I - input index - Mean - mean term - Sigma - sigma term (if zero, will be replaced by 1.0) - -NTE: I-th input is passed through linear transformation - IN[i] = (IN[i]-Mean)/Sigma -before feeding to the network. This function sets Mean and Sigma. - - -- ALGLIB -- - Copyright 25.03.2011 by Bochkanov Sergey -*************************************************************************/ -void mlpsetinputscaling(const multilayerperceptron &network, const ae_int_t i, const double mean, const double sigma); - - -/************************************************************************* -This function sets offset/scaling coefficients for I-th output of the -network. - -INPUT PARAMETERS: - Network - network - I - input index - Mean - mean term - Sigma - sigma term (if zero, will be replaced by 1.0) - -OUTPUT PARAMETERS: - -NOTE: I-th output is passed through linear transformation - OUT[i] = OUT[i]*Sigma+Mean -before returning it to user. This function sets Sigma/Mean. In case we -have SOFTMAX-normalized network, you can not set (Sigma,Mean) to anything -other than(0.0,1.0) - this function will throw exception. - - -- ALGLIB -- - Copyright 25.03.2011 by Bochkanov Sergey -*************************************************************************/ -void mlpsetoutputscaling(const multilayerperceptron &network, const ae_int_t i, const double mean, const double sigma); - - -/************************************************************************* -This function modifies information about Ith neuron of Kth layer - -INPUT PARAMETERS: - Network - network - K - layer index - I - neuron index (within layer) - FKind - activation function type (used by MLPActivationFunction()) - this value must be zero for input neurons - (you can not set activation function for input neurons) - Threshold - also called offset, bias - this value must be zero for input neurons - (you can not set threshold for input neurons) - -NOTES: -1. this function throws exception if layer or neuron with given index do - not exists. -2. this function also throws exception when you try to set non-linear - activation function for input neurons (any kind of network) or for output - neurons of classifier network. -3. this function throws exception when you try to set non-zero threshold for - input neurons (any kind of network). - - -- ALGLIB -- - Copyright 25.03.2011 by Bochkanov Sergey -*************************************************************************/ -void mlpsetneuroninfo(const multilayerperceptron &network, const ae_int_t k, const ae_int_t i, const ae_int_t fkind, const double threshold); - - -/************************************************************************* -This function modifies information about connection from I0-th neuron of -K0-th layer to I1-th neuron of K1-th layer. - -INPUT PARAMETERS: - Network - network - K0 - layer index - I0 - neuron index (within layer) - K1 - layer index - I1 - neuron index (within layer) - W - connection weight (must be zero for non-existent - connections) - -This function: -1. throws exception if layer or neuron with given index do not exists. -2. throws exception if you try to set non-zero weight for non-existent - connection - - -- ALGLIB -- - Copyright 25.03.2011 by Bochkanov Sergey -*************************************************************************/ -void mlpsetweight(const multilayerperceptron &network, const ae_int_t k0, const ae_int_t i0, const ae_int_t k1, const ae_int_t i1, const double w); - - -/************************************************************************* -Neural network activation function - -INPUT PARAMETERS: - NET - neuron input - K - function index (zero for linear function) - -OUTPUT PARAMETERS: - F - function - DF - its derivative - D2F - its second derivative - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpactivationfunction(const double net, const ae_int_t k, double &f, double &df, double &d2f); - - -/************************************************************************* -Procesing - -INPUT PARAMETERS: - Network - neural network - X - input vector, array[0..NIn-1]. - -OUTPUT PARAMETERS: - Y - result. Regression estimate when solving regression task, - vector of posterior probabilities for classification task. - -See also MLPProcessI - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpprocess(const multilayerperceptron &network, const real_1d_array &x, real_1d_array &y); - - -/************************************************************************* -'interactive' variant of MLPProcess for languages like Python which -support constructs like "Y = MLPProcess(NN,X)" and interactive mode of the -interpreter - -This function allocates new array on each call, so it is significantly -slower than its 'non-interactive' counterpart, but it is more convenient -when you call it from command line. - - -- ALGLIB -- - Copyright 21.09.2010 by Bochkanov Sergey -*************************************************************************/ -void mlpprocessi(const multilayerperceptron &network, const real_1d_array &x, real_1d_array &y); - - -/************************************************************************* -Error of the neural network on dataset. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x, depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format; - NPoints - points count. - -RESULT: - sum-of-squares error, SUM(sqr(y[i]-desired_y[i])/2) - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -double mlperror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints); -double smp_mlperror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints); - - -/************************************************************************* -Error of the neural network on dataset given by sparse matrix. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x, depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network - XY - training set, see below for information on the - training set format. This function checks correctness - of the dataset (no NANs/INFs, class numbers are - correct) and throws exception when incorrect dataset - is passed. Sparse matrix must use CRS format for - storage. - NPoints - points count, >=0 - -RESULT: - sum-of-squares error, SUM(sqr(y[i]-desired_y[i])/2) - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -double mlperrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints); -double smp_mlperrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints); - - -/************************************************************************* -Natural error function for neural network, internal subroutine. - -NOTE: this function is single-threaded. Unlike other error function, it -receives no speed-up from being executed in SMP mode. - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -double mlperrorn(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t ssize); - - -/************************************************************************* -Classification error of the neural network on dataset. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format; - NPoints - points count. - -RESULT: - classification error (number of misclassified cases) - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -ae_int_t mlpclserror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints); -ae_int_t smp_mlpclserror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints); - - -/************************************************************************* -Relative classification error on the test set. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format; - NPoints - points count. - -RESULT: -Percent of incorrectly classified cases. Works both for classifier -networks and general purpose networks used as classifiers. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 25.12.2008 by Bochkanov Sergey -*************************************************************************/ -double mlprelclserror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints); -double smp_mlprelclserror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints); - - -/************************************************************************* -Relative classification error on the test set given by sparse matrix. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format. Sparse matrix must use CRS format - for storage. - NPoints - points count, >=0. - -RESULT: -Percent of incorrectly classified cases. Works both for classifier -networks and general purpose networks used as classifiers. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 09.08.2012 by Bochkanov Sergey -*************************************************************************/ -double mlprelclserrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints); -double smp_mlprelclserrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints); - - -/************************************************************************* -Average cross-entropy (in bits per element) on the test set. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format; - NPoints - points count. - -RESULT: -CrossEntropy/(NPoints*LN(2)). -Zero if network solves regression task. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 08.01.2009 by Bochkanov Sergey -*************************************************************************/ -double mlpavgce(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints); -double smp_mlpavgce(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints); - - -/************************************************************************* -Average cross-entropy (in bits per element) on the test set given by -sparse matrix. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format. This function checks correctness - of the dataset (no NANs/INFs, class numbers are - correct) and throws exception when incorrect dataset - is passed. Sparse matrix must use CRS format for - storage. - NPoints - points count, >=0. - -RESULT: -CrossEntropy/(NPoints*LN(2)). -Zero if network solves regression task. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 9.08.2012 by Bochkanov Sergey -*************************************************************************/ -double mlpavgcesparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints); -double smp_mlpavgcesparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints); - - -/************************************************************************* -RMS error on the test set given. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format; - NPoints - points count. - -RESULT: -Root mean square error. Its meaning for regression task is obvious. As for -classification task, RMS error means error when estimating posterior -probabilities. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -double mlprmserror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints); -double smp_mlprmserror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints); - - -/************************************************************************* -RMS error on the test set given by sparse matrix. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format. This function checks correctness - of the dataset (no NANs/INFs, class numbers are - correct) and throws exception when incorrect dataset - is passed. Sparse matrix must use CRS format for - storage. - NPoints - points count, >=0. - -RESULT: -Root mean square error. Its meaning for regression task is obvious. As for -classification task, RMS error means error when estimating posterior -probabilities. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 09.08.2012 by Bochkanov Sergey -*************************************************************************/ -double mlprmserrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints); -double smp_mlprmserrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints); - - -/************************************************************************* -Average absolute error on the test set. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format; - NPoints - points count. - -RESULT: -Its meaning for regression task is obvious. As for classification task, it -means average error when estimating posterior probabilities. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 11.03.2008 by Bochkanov Sergey -*************************************************************************/ -double mlpavgerror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints); -double smp_mlpavgerror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints); - - -/************************************************************************* -Average absolute error on the test set given by sparse matrix. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format. This function checks correctness - of the dataset (no NANs/INFs, class numbers are - correct) and throws exception when incorrect dataset - is passed. Sparse matrix must use CRS format for - storage. - NPoints - points count, >=0. - -RESULT: -Its meaning for regression task is obvious. As for classification task, it -means average error when estimating posterior probabilities. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 09.08.2012 by Bochkanov Sergey -*************************************************************************/ -double mlpavgerrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints); -double smp_mlpavgerrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints); - - -/************************************************************************* -Average relative error on the test set. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format; - NPoints - points count. - -RESULT: -Its meaning for regression task is obvious. As for classification task, it -means average relative error when estimating posterior probability of -belonging to the correct class. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 11.03.2008 by Bochkanov Sergey -*************************************************************************/ -double mlpavgrelerror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints); -double smp_mlpavgrelerror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints); - - -/************************************************************************* -Average relative error on the test set given by sparse matrix. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format. This function checks correctness - of the dataset (no NANs/INFs, class numbers are - correct) and throws exception when incorrect dataset - is passed. Sparse matrix must use CRS format for - storage. - NPoints - points count, >=0. - -RESULT: -Its meaning for regression task is obvious. As for classification task, it -means average relative error when estimating posterior probability of -belonging to the correct class. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 09.08.2012 by Bochkanov Sergey -*************************************************************************/ -double mlpavgrelerrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints); -double smp_mlpavgrelerrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints); - - -/************************************************************************* -Gradient calculation - -INPUT PARAMETERS: - Network - network initialized with one of the network creation funcs - X - input vector, length of array must be at least NIn - DesiredY- desired outputs, length of array must be at least NOut - Grad - possibly preallocated array. If size of array is smaller - than WCount, it will be reallocated. It is recommended to - reuse previously allocated array to reduce allocation - overhead. - -OUTPUT PARAMETERS: - E - error function, SUM(sqr(y[i]-desiredy[i])/2,i) - Grad - gradient of E with respect to weights of network, array[WCount] - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpgrad(const multilayerperceptron &network, const real_1d_array &x, const real_1d_array &desiredy, double &e, real_1d_array &grad); - - -/************************************************************************* -Gradient calculation (natural error function is used) - -INPUT PARAMETERS: - Network - network initialized with one of the network creation funcs - X - input vector, length of array must be at least NIn - DesiredY- desired outputs, length of array must be at least NOut - Grad - possibly preallocated array. If size of array is smaller - than WCount, it will be reallocated. It is recommended to - reuse previously allocated array to reduce allocation - overhead. - -OUTPUT PARAMETERS: - E - error function, sum-of-squares for regression networks, - cross-entropy for classification networks. - Grad - gradient of E with respect to weights of network, array[WCount] - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpgradn(const multilayerperceptron &network, const real_1d_array &x, const real_1d_array &desiredy, double &e, real_1d_array &grad); - - -/************************************************************************* -Batch gradient calculation for a set of inputs/outputs - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - network initialized with one of the network creation funcs - XY - original dataset in dense format; one sample = one row: - * first NIn columns contain inputs, - * for regression problem, next NOut columns store - desired outputs. - * for classification problem, next column (just one!) - stores class number. - SSize - number of elements in XY - Grad - possibly preallocated array. If size of array is smaller - than WCount, it will be reallocated. It is recommended to - reuse previously allocated array to reduce allocation - overhead. - -OUTPUT PARAMETERS: - E - error function, SUM(sqr(y[i]-desiredy[i])/2,i) - Grad - gradient of E with respect to weights of network, array[WCount] - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpgradbatch(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t ssize, double &e, real_1d_array &grad); -void smp_mlpgradbatch(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t ssize, double &e, real_1d_array &grad); - - -/************************************************************************* -Batch gradient calculation for a set of inputs/outputs given by sparse -matrices - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - network initialized with one of the network creation funcs - XY - original dataset in sparse format; one sample = one row: - * MATRIX MUST BE STORED IN CRS FORMAT - * first NIn columns contain inputs. - * for regression problem, next NOut columns store - desired outputs. - * for classification problem, next column (just one!) - stores class number. - SSize - number of elements in XY - Grad - possibly preallocated array. If size of array is smaller - than WCount, it will be reallocated. It is recommended to - reuse previously allocated array to reduce allocation - overhead. - -OUTPUT PARAMETERS: - E - error function, SUM(sqr(y[i]-desiredy[i])/2,i) - Grad - gradient of E with respect to weights of network, array[WCount] - - -- ALGLIB -- - Copyright 26.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpgradbatchsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t ssize, double &e, real_1d_array &grad); -void smp_mlpgradbatchsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t ssize, double &e, real_1d_array &grad); - - -/************************************************************************* -Batch gradient calculation for a subset of dataset - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - network initialized with one of the network creation funcs - XY - original dataset in dense format; one sample = one row: - * first NIn columns contain inputs, - * for regression problem, next NOut columns store - desired outputs. - * for classification problem, next column (just one!) - stores class number. - SetSize - real size of XY, SetSize>=0; - Idx - subset of SubsetSize elements, array[SubsetSize]: - * Idx[I] stores row index in the original dataset which is - given by XY. Gradient is calculated with respect to rows - whose indexes are stored in Idx[]. - * Idx[] must store correct indexes; this function throws - an exception in case incorrect index (less than 0 or - larger than rows(XY)) is given - * Idx[] may store indexes in any order and even with - repetitions. - SubsetSize- number of elements in Idx[] array: - * positive value means that subset given by Idx[] is processed - * zero value results in zero gradient - * negative value means that full dataset is processed - Grad - possibly preallocated array. If size of array is smaller - than WCount, it will be reallocated. It is recommended to - reuse previously allocated array to reduce allocation - overhead. - -OUTPUT PARAMETERS: - E - error function, SUM(sqr(y[i]-desiredy[i])/2,i) - Grad - gradient of E with respect to weights of network, - array[WCount] - - -- ALGLIB -- - Copyright 26.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpgradbatchsubset(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t setsize, const integer_1d_array &idx, const ae_int_t subsetsize, double &e, real_1d_array &grad); -void smp_mlpgradbatchsubset(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t setsize, const integer_1d_array &idx, const ae_int_t subsetsize, double &e, real_1d_array &grad); - - -/************************************************************************* -Batch gradient calculation for a set of inputs/outputs for a subset of -dataset given by set of indexes. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - network initialized with one of the network creation funcs - XY - original dataset in sparse format; one sample = one row: - * MATRIX MUST BE STORED IN CRS FORMAT - * first NIn columns contain inputs, - * for regression problem, next NOut columns store - desired outputs. - * for classification problem, next column (just one!) - stores class number. - SetSize - real size of XY, SetSize>=0; - Idx - subset of SubsetSize elements, array[SubsetSize]: - * Idx[I] stores row index in the original dataset which is - given by XY. Gradient is calculated with respect to rows - whose indexes are stored in Idx[]. - * Idx[] must store correct indexes; this function throws - an exception in case incorrect index (less than 0 or - larger than rows(XY)) is given - * Idx[] may store indexes in any order and even with - repetitions. - SubsetSize- number of elements in Idx[] array: - * positive value means that subset given by Idx[] is processed - * zero value results in zero gradient - * negative value means that full dataset is processed - Grad - possibly preallocated array. If size of array is smaller - than WCount, it will be reallocated. It is recommended to - reuse previously allocated array to reduce allocation - overhead. - -OUTPUT PARAMETERS: - E - error function, SUM(sqr(y[i]-desiredy[i])/2,i) - Grad - gradient of E with respect to weights of network, - array[WCount] - -NOTE: when SubsetSize<0 is used full dataset by call MLPGradBatchSparse - function. - - -- ALGLIB -- - Copyright 26.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpgradbatchsparsesubset(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t setsize, const integer_1d_array &idx, const ae_int_t subsetsize, double &e, real_1d_array &grad); -void smp_mlpgradbatchsparsesubset(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t setsize, const integer_1d_array &idx, const ae_int_t subsetsize, double &e, real_1d_array &grad); - - -/************************************************************************* -Batch gradient calculation for a set of inputs/outputs -(natural error function is used) - -INPUT PARAMETERS: - Network - network initialized with one of the network creation funcs - XY - set of inputs/outputs; one sample = one row; - first NIn columns contain inputs, - next NOut columns - desired outputs. - SSize - number of elements in XY - Grad - possibly preallocated array. If size of array is smaller - than WCount, it will be reallocated. It is recommended to - reuse previously allocated array to reduce allocation - overhead. - -OUTPUT PARAMETERS: - E - error function, sum-of-squares for regression networks, - cross-entropy for classification networks. - Grad - gradient of E with respect to weights of network, array[WCount] - - -- ALGLIB -- - Copyright 04.11.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpgradnbatch(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t ssize, double &e, real_1d_array &grad); - - -/************************************************************************* -Batch Hessian calculation (natural error function) using R-algorithm. -Internal subroutine. - - -- ALGLIB -- - Copyright 26.01.2008 by Bochkanov Sergey. - - Hessian calculation based on R-algorithm described in - "Fast Exact Multiplication by the Hessian", - B. A. Pearlmutter, - Neural Computation, 1994. -*************************************************************************/ -void mlphessiannbatch(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t ssize, double &e, real_1d_array &grad, real_2d_array &h); - - -/************************************************************************* -Batch Hessian calculation using R-algorithm. -Internal subroutine. - - -- ALGLIB -- - Copyright 26.01.2008 by Bochkanov Sergey. - - Hessian calculation based on R-algorithm described in - "Fast Exact Multiplication by the Hessian", - B. A. Pearlmutter, - Neural Computation, 1994. -*************************************************************************/ -void mlphessianbatch(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t ssize, double &e, real_1d_array &grad, real_2d_array &h); - - -/************************************************************************* -Calculation of all types of errors. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - network initialized with one of the network creation funcs - XY - original dataset; one sample = one row; - first NIn columns contain inputs, - next NOut columns - desired outputs. - SetSize - real size of XY, SetSize>=0; - Subset - subset of SubsetSize elements, array[SubsetSize]; - SubsetSize- number of elements in Subset[] array. - -OUTPUT PARAMETERS: - Rep - it contains all type of errors. - -NOTE: when SubsetSize<0 is used full dataset by call MLPGradBatch function. - - -- ALGLIB -- - Copyright 04.09.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpallerrorssubset(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize, modelerrors &rep); -void smp_mlpallerrorssubset(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize, modelerrors &rep); - - -/************************************************************************* -Calculation of all types of errors on sparse dataset. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - network initialized with one of the network creation funcs - XY - original dataset given by sparse matrix; - one sample = one row; - first NIn columns contain inputs, - next NOut columns - desired outputs. - SetSize - real size of XY, SetSize>=0; - Subset - subset of SubsetSize elements, array[SubsetSize]; - SubsetSize- number of elements in Subset[] array. - -OUTPUT PARAMETERS: - Rep - it contains all type of errors. - -NOTE: when SubsetSize<0 is used full dataset by call MLPGradBatch function. - - -- ALGLIB -- - Copyright 04.09.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpallerrorssparsesubset(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize, modelerrors &rep); -void smp_mlpallerrorssparsesubset(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize, modelerrors &rep); - - -/************************************************************************* -Error of the neural network on dataset. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format; - SetSize - real size of XY, SetSize>=0; - Subset - subset of SubsetSize elements, array[SubsetSize]; - SubsetSize- number of elements in Subset[] array. - -RESULT: - sum-of-squares error, SUM(sqr(y[i]-desired_y[i])/2) - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 04.09.2012 by Bochkanov Sergey -*************************************************************************/ -double mlperrorsubset(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize); -double smp_mlperrorsubset(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize); - - -/************************************************************************* -Error of the neural network on sparse dataset. - - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support - ! - ! First improvement gives close-to-linear speedup on multicore systems. - ! Second improvement gives constant speedup (2-3x depending on your CPU) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - - -INPUT PARAMETERS: - Network - neural network; - XY - training set, see below for information on the - training set format. This function checks correctness - of the dataset (no NANs/INFs, class numbers are - correct) and throws exception when incorrect dataset - is passed. Sparse matrix must use CRS format for - storage. - SetSize - real size of XY, SetSize>=0; - it is used when SubsetSize<0; - Subset - subset of SubsetSize elements, array[SubsetSize]; - SubsetSize- number of elements in Subset[] array. - -RESULT: - sum-of-squares error, SUM(sqr(y[i]-desired_y[i])/2) - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -dataset format is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 04.09.2012 by Bochkanov Sergey -*************************************************************************/ -double mlperrorsparsesubset(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize); -double smp_mlperrorsparsesubset(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize); - -/************************************************************************* -This subroutine trains logit model. - -INPUT PARAMETERS: - XY - training set, array[0..NPoints-1,0..NVars] - First NVars columns store values of independent - variables, next column stores number of class (from 0 - to NClasses-1) which dataset element belongs to. Fractional - values are rounded to nearest integer. - NPoints - training set size, NPoints>=1 - NVars - number of independent variables, NVars>=1 - NClasses - number of classes, NClasses>=2 - -OUTPUT PARAMETERS: - Info - return code: - * -2, if there is a point with class number - outside of [0..NClasses-1]. - * -1, if incorrect parameters was passed - (NPoints=1 - -OUTPUT PARAMETERS: - State - structure stores algorithm state - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdcreate(const ae_int_t n, mcpdstate &s); - - -/************************************************************************* -DESCRIPTION: - -This function is a specialized version of MCPDCreate() function, and we -recommend you to read comments for this function for general information -about MCPD solver. - -This function creates MCPD (Markov Chains for Population Data) solver -for "Entry-state" model, i.e. model where transition from X[i] to X[i+1] -is modelled as - X[i+1] = P*X[i] -where - X[i] and X[i+1] are N-dimensional state vectors - P is a N*N transition matrix -and one selected component of X[] is called "entry" state and is treated -in a special way: - system state always transits from "entry" state to some another state - system state can not transit from any state into "entry" state -Such conditions basically mean that row of P which corresponds to "entry" -state is zero. - -Such models arise when: -* there is some population of individuals -* individuals can have different states -* individuals can transit from one state to another -* population size is NOT constant - at every moment of time there is some - (unpredictable) amount of "new" individuals, which can transit into one - of the states at the next turn, but still no one leaves population -* you want to model transitions of individuals from one state into another -* but you do NOT want to predict amount of "new" individuals because it - does not depends on individuals already present (hence system can not - transit INTO entry state - it can only transit FROM it). - -This model is discussed in more details in the ALGLIB User Guide (see -http://www.alglib.net/dataanalysis/ for more data). - -INPUT PARAMETERS: - N - problem dimension, N>=2 - EntryState- index of entry state, in 0..N-1 - -OUTPUT PARAMETERS: - State - structure stores algorithm state - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdcreateentry(const ae_int_t n, const ae_int_t entrystate, mcpdstate &s); - - -/************************************************************************* -DESCRIPTION: - -This function is a specialized version of MCPDCreate() function, and we -recommend you to read comments for this function for general information -about MCPD solver. - -This function creates MCPD (Markov Chains for Population Data) solver -for "Exit-state" model, i.e. model where transition from X[i] to X[i+1] -is modelled as - X[i+1] = P*X[i] -where - X[i] and X[i+1] are N-dimensional state vectors - P is a N*N transition matrix -and one selected component of X[] is called "exit" state and is treated -in a special way: - system state can transit from any state into "exit" state - system state can not transit from "exit" state into any other state - transition operator discards "exit" state (makes it zero at each turn) -Such conditions basically mean that column of P which corresponds to -"exit" state is zero. Multiplication by such P may decrease sum of vector -components. - -Such models arise when: -* there is some population of individuals -* individuals can have different states -* individuals can transit from one state to another -* population size is NOT constant - individuals can move into "exit" state - and leave population at the next turn, but there are no new individuals -* amount of individuals which leave population can be predicted -* you want to model transitions of individuals from one state into another - (including transitions into the "exit" state) - -This model is discussed in more details in the ALGLIB User Guide (see -http://www.alglib.net/dataanalysis/ for more data). - -INPUT PARAMETERS: - N - problem dimension, N>=2 - ExitState- index of exit state, in 0..N-1 - -OUTPUT PARAMETERS: - State - structure stores algorithm state - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdcreateexit(const ae_int_t n, const ae_int_t exitstate, mcpdstate &s); - - -/************************************************************************* -DESCRIPTION: - -This function is a specialized version of MCPDCreate() function, and we -recommend you to read comments for this function for general information -about MCPD solver. - -This function creates MCPD (Markov Chains for Population Data) solver -for "Entry-Exit-states" model, i.e. model where transition from X[i] to -X[i+1] is modelled as - X[i+1] = P*X[i] -where - X[i] and X[i+1] are N-dimensional state vectors - P is a N*N transition matrix -one selected component of X[] is called "entry" state and is treated in a -special way: - system state always transits from "entry" state to some another state - system state can not transit from any state into "entry" state -and another one component of X[] is called "exit" state and is treated in -a special way too: - system state can transit from any state into "exit" state - system state can not transit from "exit" state into any other state - transition operator discards "exit" state (makes it zero at each turn) -Such conditions basically mean that: - row of P which corresponds to "entry" state is zero - column of P which corresponds to "exit" state is zero -Multiplication by such P may decrease sum of vector components. - -Such models arise when: -* there is some population of individuals -* individuals can have different states -* individuals can transit from one state to another -* population size is NOT constant -* at every moment of time there is some (unpredictable) amount of "new" - individuals, which can transit into one of the states at the next turn -* some individuals can move (predictably) into "exit" state and leave - population at the next turn -* you want to model transitions of individuals from one state into another, - including transitions from the "entry" state and into the "exit" state. -* but you do NOT want to predict amount of "new" individuals because it - does not depends on individuals already present (hence system can not - transit INTO entry state - it can only transit FROM it). - -This model is discussed in more details in the ALGLIB User Guide (see -http://www.alglib.net/dataanalysis/ for more data). - -INPUT PARAMETERS: - N - problem dimension, N>=2 - EntryState- index of entry state, in 0..N-1 - ExitState- index of exit state, in 0..N-1 - -OUTPUT PARAMETERS: - State - structure stores algorithm state - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdcreateentryexit(const ae_int_t n, const ae_int_t entrystate, const ae_int_t exitstate, mcpdstate &s); - - -/************************************************************************* -This function is used to add a track - sequence of system states at the -different moments of its evolution. - -You may add one or several tracks to the MCPD solver. In case you have -several tracks, they won't overwrite each other. For example, if you pass -two tracks, A1-A2-A3 (system at t=A+1, t=A+2 and t=A+3) and B1-B2-B3, then -solver will try to model transitions from t=A+1 to t=A+2, t=A+2 to t=A+3, -t=B+1 to t=B+2, t=B+2 to t=B+3. But it WON'T mix these two tracks - i.e. it -won't try to model transition from t=A+3 to t=B+1. - -INPUT PARAMETERS: - S - solver - XY - track, array[K,N]: - * I-th row is a state at t=I - * elements of XY must be non-negative (exception will be - thrown on negative elements) - K - number of points in a track - * if given, only leading K rows of XY are used - * if not given, automatically determined from size of XY - -NOTES: - -1. Track may contain either proportional or population data: - * with proportional data all rows of XY must sum to 1.0, i.e. we have - proportions instead of absolute population values - * with population data rows of XY contain population counts and generally - do not sum to 1.0 (although they still must be non-negative) - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdaddtrack(const mcpdstate &s, const real_2d_array &xy, const ae_int_t k); -void mcpdaddtrack(const mcpdstate &s, const real_2d_array &xy); - - -/************************************************************************* -This function is used to add equality constraints on the elements of the -transition matrix P. - -MCPD solver has four types of constraints which can be placed on P: -* user-specified equality constraints (optional) -* user-specified bound constraints (optional) -* user-specified general linear constraints (optional) -* basic constraints (always present): - * non-negativity: P[i,j]>=0 - * consistency: every column of P sums to 1.0 - -Final constraints which are passed to the underlying optimizer are -calculated as intersection of all present constraints. For example, you -may specify boundary constraint on P[0,0] and equality one: - 0.1<=P[0,0]<=0.9 - P[0,0]=0.5 -Such combination of constraints will be silently reduced to their -intersection, which is P[0,0]=0.5. - -This function can be used to place equality constraints on arbitrary -subset of elements of P. Set of constraints is specified by EC, which may -contain either NAN's or finite numbers from [0,1]. NAN denotes absence of -constraint, finite number denotes equality constraint on specific element -of P. - -You can also use MCPDAddEC() function which allows to ADD equality -constraint for one element of P without changing constraints for other -elements. - -These functions (MCPDSetEC and MCPDAddEC) interact as follows: -* there is internal matrix of equality constraints which is stored in the - MCPD solver -* MCPDSetEC() replaces this matrix by another one (SET) -* MCPDAddEC() modifies one element of this matrix and leaves other ones - unchanged (ADD) -* thus MCPDAddEC() call preserves all modifications done by previous - calls, while MCPDSetEC() completely discards all changes done to the - equality constraints. - -INPUT PARAMETERS: - S - solver - EC - equality constraints, array[N,N]. Elements of EC can be - either NAN's or finite numbers from [0,1]. NAN denotes - absence of constraints, while finite value denotes - equality constraint on the corresponding element of P. - -NOTES: - -1. infinite values of EC will lead to exception being thrown. Values less -than 0.0 or greater than 1.0 will lead to error code being returned after -call to MCPDSolve(). - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdsetec(const mcpdstate &s, const real_2d_array &ec); - - -/************************************************************************* -This function is used to add equality constraints on the elements of the -transition matrix P. - -MCPD solver has four types of constraints which can be placed on P: -* user-specified equality constraints (optional) -* user-specified bound constraints (optional) -* user-specified general linear constraints (optional) -* basic constraints (always present): - * non-negativity: P[i,j]>=0 - * consistency: every column of P sums to 1.0 - -Final constraints which are passed to the underlying optimizer are -calculated as intersection of all present constraints. For example, you -may specify boundary constraint on P[0,0] and equality one: - 0.1<=P[0,0]<=0.9 - P[0,0]=0.5 -Such combination of constraints will be silently reduced to their -intersection, which is P[0,0]=0.5. - -This function can be used to ADD equality constraint for one element of P -without changing constraints for other elements. - -You can also use MCPDSetEC() function which allows you to specify -arbitrary set of equality constraints in one call. - -These functions (MCPDSetEC and MCPDAddEC) interact as follows: -* there is internal matrix of equality constraints which is stored in the - MCPD solver -* MCPDSetEC() replaces this matrix by another one (SET) -* MCPDAddEC() modifies one element of this matrix and leaves other ones - unchanged (ADD) -* thus MCPDAddEC() call preserves all modifications done by previous - calls, while MCPDSetEC() completely discards all changes done to the - equality constraints. - -INPUT PARAMETERS: - S - solver - I - row index of element being constrained - J - column index of element being constrained - C - value (constraint for P[I,J]). Can be either NAN (no - constraint) or finite value from [0,1]. - -NOTES: - -1. infinite values of C will lead to exception being thrown. Values less -than 0.0 or greater than 1.0 will lead to error code being returned after -call to MCPDSolve(). - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdaddec(const mcpdstate &s, const ae_int_t i, const ae_int_t j, const double c); - - -/************************************************************************* -This function is used to add bound constraints on the elements of the -transition matrix P. - -MCPD solver has four types of constraints which can be placed on P: -* user-specified equality constraints (optional) -* user-specified bound constraints (optional) -* user-specified general linear constraints (optional) -* basic constraints (always present): - * non-negativity: P[i,j]>=0 - * consistency: every column of P sums to 1.0 - -Final constraints which are passed to the underlying optimizer are -calculated as intersection of all present constraints. For example, you -may specify boundary constraint on P[0,0] and equality one: - 0.1<=P[0,0]<=0.9 - P[0,0]=0.5 -Such combination of constraints will be silently reduced to their -intersection, which is P[0,0]=0.5. - -This function can be used to place bound constraints on arbitrary -subset of elements of P. Set of constraints is specified by BndL/BndU -matrices, which may contain arbitrary combination of finite numbers or -infinities (like -INF=0 - * consistency: every column of P sums to 1.0 - -Final constraints which are passed to the underlying optimizer are -calculated as intersection of all present constraints. For example, you -may specify boundary constraint on P[0,0] and equality one: - 0.1<=P[0,0]<=0.9 - P[0,0]=0.5 -Such combination of constraints will be silently reduced to their -intersection, which is P[0,0]=0.5. - -This function can be used to ADD bound constraint for one element of P -without changing constraints for other elements. - -You can also use MCPDSetBC() function which allows to place bound -constraints on arbitrary subset of elements of P. Set of constraints is -specified by BndL/BndU matrices, which may contain arbitrary combination -of finite numbers or infinities (like -INF=" (CT[i]>0). - -Your constraint may involve only some subset of P (less than N*N elements). -For example it can be something like - P[0,0] + P[0,1] = 0.5 -In this case you still should pass matrix with N*N+1 columns, but all its -elements (except for C[0,0], C[0,1] and C[0,N*N-1]) will be zero. - -INPUT PARAMETERS: - S - solver - C - array[K,N*N+1] - coefficients of constraints - (see above for complete description) - CT - array[K] - constraint types - (see above for complete description) - K - number of equality/inequality constraints, K>=0: - * if given, only leading K elements of C/CT are used - * if not given, automatically determined from sizes of C/CT - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdsetlc(const mcpdstate &s, const real_2d_array &c, const integer_1d_array &ct, const ae_int_t k); -void mcpdsetlc(const mcpdstate &s, const real_2d_array &c, const integer_1d_array &ct); - - -/************************************************************************* -This function allows to tune amount of Tikhonov regularization being -applied to your problem. - -By default, regularizing term is equal to r*||P-prior_P||^2, where r is a -small non-zero value, P is transition matrix, prior_P is identity matrix, -||X||^2 is a sum of squared elements of X. - -This function allows you to change coefficient r. You can also change -prior values with MCPDSetPrior() function. - -INPUT PARAMETERS: - S - solver - V - regularization coefficient, finite non-negative value. It - is not recommended to specify zero value unless you are - pretty sure that you want it. - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdsettikhonovregularizer(const mcpdstate &s, const double v); - - -/************************************************************************* -This function allows to set prior values used for regularization of your -problem. - -By default, regularizing term is equal to r*||P-prior_P||^2, where r is a -small non-zero value, P is transition matrix, prior_P is identity matrix, -||X||^2 is a sum of squared elements of X. - -This function allows you to change prior values prior_P. You can also -change r with MCPDSetTikhonovRegularizer() function. - -INPUT PARAMETERS: - S - solver - PP - array[N,N], matrix of prior values: - 1. elements must be real numbers from [0,1] - 2. columns must sum to 1.0. - First property is checked (exception is thrown otherwise), - while second one is not checked/enforced. - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdsetprior(const mcpdstate &s, const real_2d_array &pp); - - -/************************************************************************* -This function is used to change prediction weights - -MCPD solver scales prediction errors as follows - Error(P) = ||W*(y-P*x)||^2 -where - x is a system state at time t - y is a system state at time t+1 - P is a transition matrix - W is a diagonal scaling matrix - -By default, weights are chosen in order to minimize relative prediction -error instead of absolute one. For example, if one component of state is -about 0.5 in magnitude and another one is about 0.05, then algorithm will -make corresponding weights equal to 2.0 and 20.0. - -INPUT PARAMETERS: - S - solver - PW - array[N], weights: - * must be non-negative values (exception will be thrown otherwise) - * zero values will be replaced by automatically chosen values - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdsetpredictionweights(const mcpdstate &s, const real_1d_array &pw); - - -/************************************************************************* -This function is used to start solution of the MCPD problem. - -After return from this function, you can use MCPDResults() to get solution -and completion code. - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdsolve(const mcpdstate &s); - - -/************************************************************************* -MCPD results - -INPUT PARAMETERS: - State - algorithm state - -OUTPUT PARAMETERS: - P - array[N,N], transition matrix - Rep - optimization report. You should check Rep.TerminationType - in order to distinguish successful termination from - unsuccessful one. Speaking short, positive values denote - success, negative ones are failures. - More information about fields of this structure can be - found in the comments on MCPDReport datatype. - - - -- ALGLIB -- - Copyright 23.05.2010 by Bochkanov Sergey -*************************************************************************/ -void mcpdresults(const mcpdstate &s, real_2d_array &p, mcpdreport &rep); - -/************************************************************************* -This function serializes data structure to string. - -Important properties of s_out: -* it contains alphanumeric characters, dots, underscores, minus signs -* these symbols are grouped into words, which are separated by spaces - and Windows-style (CR+LF) newlines -* although serializer uses spaces and CR+LF as separators, you can - replace any separator character by arbitrary combination of spaces, - tabs, Windows or Unix newlines. It allows flexible reformatting of - the string in case you want to include it into text or XML file. - But you should not insert separators into the middle of the "words" - nor you should change case of letters. -* s_out can be freely moved between 32-bit and 64-bit systems, little - and big endian machines, and so on. You can serialize structure on - 32-bit machine and unserialize it on 64-bit one (or vice versa), or - serialize it on SPARC and unserialize on x86. You can also - serialize it in C++ version of ALGLIB and unserialize in C# one, - and vice versa. -*************************************************************************/ -void mlpeserialize(mlpensemble &obj, std::string &s_out); - - -/************************************************************************* -This function unserializes data structure from string. -*************************************************************************/ -void mlpeunserialize(std::string &s_in, mlpensemble &obj); - - -/************************************************************************* -Like MLPCreate0, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreate0(const ae_int_t nin, const ae_int_t nout, const ae_int_t ensemblesize, mlpensemble &ensemble); - - -/************************************************************************* -Like MLPCreate1, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreate1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, const ae_int_t ensemblesize, mlpensemble &ensemble); - - -/************************************************************************* -Like MLPCreate2, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreate2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, const ae_int_t ensemblesize, mlpensemble &ensemble); - - -/************************************************************************* -Like MLPCreateB0, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreateb0(const ae_int_t nin, const ae_int_t nout, const double b, const double d, const ae_int_t ensemblesize, mlpensemble &ensemble); - - -/************************************************************************* -Like MLPCreateB1, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreateb1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, const double b, const double d, const ae_int_t ensemblesize, mlpensemble &ensemble); - - -/************************************************************************* -Like MLPCreateB2, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreateb2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, const double b, const double d, const ae_int_t ensemblesize, mlpensemble &ensemble); - - -/************************************************************************* -Like MLPCreateR0, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreater0(const ae_int_t nin, const ae_int_t nout, const double a, const double b, const ae_int_t ensemblesize, mlpensemble &ensemble); - - -/************************************************************************* -Like MLPCreateR1, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreater1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, const double a, const double b, const ae_int_t ensemblesize, mlpensemble &ensemble); - - -/************************************************************************* -Like MLPCreateR2, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreater2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, const double a, const double b, const ae_int_t ensemblesize, mlpensemble &ensemble); - - -/************************************************************************* -Like MLPCreateC0, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreatec0(const ae_int_t nin, const ae_int_t nout, const ae_int_t ensemblesize, mlpensemble &ensemble); - - -/************************************************************************* -Like MLPCreateC1, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreatec1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, const ae_int_t ensemblesize, mlpensemble &ensemble); - - -/************************************************************************* -Like MLPCreateC2, but for ensembles. - - -- ALGLIB -- - Copyright 18.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreatec2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, const ae_int_t ensemblesize, mlpensemble &ensemble); - - -/************************************************************************* -Creates ensemble from network. Only network geometry is copied. - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpecreatefromnetwork(const multilayerperceptron &network, const ae_int_t ensemblesize, mlpensemble &ensemble); - - -/************************************************************************* -Randomization of MLP ensemble - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlperandomize(const mlpensemble &ensemble); - - -/************************************************************************* -Return ensemble properties (number of inputs and outputs). - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpeproperties(const mlpensemble &ensemble, ae_int_t &nin, ae_int_t &nout); - - -/************************************************************************* -Return normalization type (whether ensemble is SOFTMAX-normalized or not). - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -bool mlpeissoftmax(const mlpensemble &ensemble); - - -/************************************************************************* -Procesing - -INPUT PARAMETERS: - Ensemble- neural networks ensemble - X - input vector, array[0..NIn-1]. - Y - (possibly) preallocated buffer; if size of Y is less than - NOut, it will be reallocated. If it is large enough, it - is NOT reallocated, so we can save some time on reallocation. - - -OUTPUT PARAMETERS: - Y - result. Regression estimate when solving regression task, - vector of posterior probabilities for classification task. - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpeprocess(const mlpensemble &ensemble, const real_1d_array &x, real_1d_array &y); - - -/************************************************************************* -'interactive' variant of MLPEProcess for languages like Python which -support constructs like "Y = MLPEProcess(LM,X)" and interactive mode of the -interpreter - -This function allocates new array on each call, so it is significantly -slower than its 'non-interactive' counterpart, but it is more convenient -when you call it from command line. - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpeprocessi(const mlpensemble &ensemble, const real_1d_array &x, real_1d_array &y); - - -/************************************************************************* -Relative classification error on the test set - -INPUT PARAMETERS: - Ensemble- ensemble - XY - test set - NPoints - test set size - -RESULT: - percent of incorrectly classified cases. - Works both for classifier betwork and for regression networks which -are used as classifiers. - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -double mlperelclserror(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints); - - -/************************************************************************* -Average cross-entropy (in bits per element) on the test set - -INPUT PARAMETERS: - Ensemble- ensemble - XY - test set - NPoints - test set size - -RESULT: - CrossEntropy/(NPoints*LN(2)). - Zero if ensemble solves regression task. - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -double mlpeavgce(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints); - - -/************************************************************************* -RMS error on the test set - -INPUT PARAMETERS: - Ensemble- ensemble - XY - test set - NPoints - test set size - -RESULT: - root mean square error. - Its meaning for regression task is obvious. As for classification task -RMS error means error when estimating posterior probabilities. - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -double mlpermserror(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints); - - -/************************************************************************* -Average error on the test set - -INPUT PARAMETERS: - Ensemble- ensemble - XY - test set - NPoints - test set size - -RESULT: - Its meaning for regression task is obvious. As for classification task -it means average error when estimating posterior probabilities. - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -double mlpeavgerror(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints); - - -/************************************************************************* -Average relative error on the test set - -INPUT PARAMETERS: - Ensemble- ensemble - XY - test set - NPoints - test set size - -RESULT: - Its meaning for regression task is obvious. As for classification task -it means average relative error when estimating posterior probabilities. - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -double mlpeavgrelerror(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints); - -/************************************************************************* -Neural network training using modified Levenberg-Marquardt with exact -Hessian calculation and regularization. Subroutine trains neural network -with restarts from random positions. Algorithm is well suited for small -and medium scale problems (hundreds of weights). - -INPUT PARAMETERS: - Network - neural network with initialized geometry - XY - training set - NPoints - training set size - Decay - weight decay constant, >=0.001 - Decay term 'Decay*||Weights||^2' is added to error - function. - If you don't know what Decay to choose, use 0.001. - Restarts - number of restarts from random position, >0. - If you don't know what Restarts to choose, use 2. - -OUTPUT PARAMETERS: - Network - trained neural network. - Info - return code: - * -9, if internal matrix inverse subroutine failed - * -2, if there is a point with class number - outside of [0..NOut-1]. - * -1, if wrong parameters specified - (NPoints<0, Restarts<1). - * 2, if task has been solved. - Rep - training report - - -- ALGLIB -- - Copyright 10.03.2009 by Bochkanov Sergey -*************************************************************************/ -void mlptrainlm(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints, const double decay, const ae_int_t restarts, ae_int_t &info, mlpreport &rep); - - -/************************************************************************* -Neural network training using L-BFGS algorithm with regularization. -Subroutine trains neural network with restarts from random positions. -Algorithm is well suited for problems of any dimensionality (memory -requirements and step complexity are linear by weights number). - -INPUT PARAMETERS: - Network - neural network with initialized geometry - XY - training set - NPoints - training set size - Decay - weight decay constant, >=0.001 - Decay term 'Decay*||Weights||^2' is added to error - function. - If you don't know what Decay to choose, use 0.001. - Restarts - number of restarts from random position, >0. - If you don't know what Restarts to choose, use 2. - WStep - stopping criterion. Algorithm stops if step size is - less than WStep. Recommended value - 0.01. Zero step - size means stopping after MaxIts iterations. - MaxIts - stopping criterion. Algorithm stops after MaxIts - iterations (NOT gradient calculations). Zero MaxIts - means stopping when step is sufficiently small. - -OUTPUT PARAMETERS: - Network - trained neural network. - Info - return code: - * -8, if both WStep=0 and MaxIts=0 - * -2, if there is a point with class number - outside of [0..NOut-1]. - * -1, if wrong parameters specified - (NPoints<0, Restarts<1). - * 2, if task has been solved. - Rep - training report - - -- ALGLIB -- - Copyright 09.12.2007 by Bochkanov Sergey -*************************************************************************/ -void mlptrainlbfgs(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints, const double decay, const ae_int_t restarts, const double wstep, const ae_int_t maxits, ae_int_t &info, mlpreport &rep); - - -/************************************************************************* -Neural network training using early stopping (base algorithm - L-BFGS with -regularization). - -INPUT PARAMETERS: - Network - neural network with initialized geometry - TrnXY - training set - TrnSize - training set size, TrnSize>0 - ValXY - validation set - ValSize - validation set size, ValSize>0 - Decay - weight decay constant, >=0.001 - Decay term 'Decay*||Weights||^2' is added to error - function. - If you don't know what Decay to choose, use 0.001. - Restarts - number of restarts, either: - * strictly positive number - algorithm make specified - number of restarts from random position. - * -1, in which case algorithm makes exactly one run - from the initial state of the network (no randomization). - If you don't know what Restarts to choose, choose one - one the following: - * -1 (deterministic start) - * +1 (one random restart) - * +5 (moderate amount of random restarts) - -OUTPUT PARAMETERS: - Network - trained neural network. - Info - return code: - * -2, if there is a point with class number - outside of [0..NOut-1]. - * -1, if wrong parameters specified - (NPoints<0, Restarts<1, ...). - * 2, task has been solved, stopping criterion met - - sufficiently small step size. Not expected (we - use EARLY stopping) but possible and not an - error. - * 6, task has been solved, stopping criterion met - - increasing of validation set error. - Rep - training report - -NOTE: - -Algorithm stops if validation set error increases for a long enough or -step size is small enought (there are task where validation set may -decrease for eternity). In any case solution returned corresponds to the -minimum of validation set error. - - -- ALGLIB -- - Copyright 10.03.2009 by Bochkanov Sergey -*************************************************************************/ -void mlptraines(const multilayerperceptron &network, const real_2d_array &trnxy, const ae_int_t trnsize, const real_2d_array &valxy, const ae_int_t valsize, const double decay, const ae_int_t restarts, ae_int_t &info, mlpreport &rep); - - -/************************************************************************* -Cross-validation estimate of generalization error. - -Base algorithm - L-BFGS. - -INPUT PARAMETERS: - Network - neural network with initialized geometry. Network is - not changed during cross-validation - it is used only - as a representative of its architecture. - XY - training set. - SSize - training set size - Decay - weight decay, same as in MLPTrainLBFGS - Restarts - number of restarts, >0. - restarts are counted for each partition separately, so - total number of restarts will be Restarts*FoldsCount. - WStep - stopping criterion, same as in MLPTrainLBFGS - MaxIts - stopping criterion, same as in MLPTrainLBFGS - FoldsCount - number of folds in k-fold cross-validation, - 2<=FoldsCount<=SSize. - recommended value: 10. - -OUTPUT PARAMETERS: - Info - return code, same as in MLPTrainLBFGS - Rep - report, same as in MLPTrainLM/MLPTrainLBFGS - CVRep - generalization error estimates - - -- ALGLIB -- - Copyright 09.12.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpkfoldcvlbfgs(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints, const double decay, const ae_int_t restarts, const double wstep, const ae_int_t maxits, const ae_int_t foldscount, ae_int_t &info, mlpreport &rep, mlpcvreport &cvrep); - - -/************************************************************************* -Cross-validation estimate of generalization error. - -Base algorithm - Levenberg-Marquardt. - -INPUT PARAMETERS: - Network - neural network with initialized geometry. Network is - not changed during cross-validation - it is used only - as a representative of its architecture. - XY - training set. - SSize - training set size - Decay - weight decay, same as in MLPTrainLBFGS - Restarts - number of restarts, >0. - restarts are counted for each partition separately, so - total number of restarts will be Restarts*FoldsCount. - FoldsCount - number of folds in k-fold cross-validation, - 2<=FoldsCount<=SSize. - recommended value: 10. - -OUTPUT PARAMETERS: - Info - return code, same as in MLPTrainLBFGS - Rep - report, same as in MLPTrainLM/MLPTrainLBFGS - CVRep - generalization error estimates - - -- ALGLIB -- - Copyright 09.12.2007 by Bochkanov Sergey -*************************************************************************/ -void mlpkfoldcvlm(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints, const double decay, const ae_int_t restarts, const ae_int_t foldscount, ae_int_t &info, mlpreport &rep, mlpcvreport &cvrep); - - -/************************************************************************* -This function estimates generalization error using cross-validation on the -current dataset with current training settings. - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support (C++ computational core) - ! - ! Second improvement gives constant speedup (2-3X). First improvement - ! gives close-to-linear speedup on multicore systems. Following - ! operations can be executed in parallel: - ! * FoldsCount cross-validation rounds (always) - ! * NRestarts training sessions performed within each of - ! cross-validation rounds (if NRestarts>1) - ! * gradient calculation over large dataset (if dataset is large enough) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - -INPUT PARAMETERS: - S - trainer object - Network - neural network. It must have same number of inputs and - output/classes as was specified during creation of the - trainer object. Network is not changed during cross- - validation and is not trained - it is used only as - representative of its architecture. I.e., we estimate - generalization properties of ARCHITECTURE, not some - specific network. - NRestarts - number of restarts, >=0: - * NRestarts>0 means that for each cross-validation - round specified number of random restarts is - performed, with best network being chosen after - training. - * NRestarts=0 is same as NRestarts=1 - FoldsCount - number of folds in k-fold cross-validation: - * 2<=FoldsCount<=size of dataset - * recommended value: 10. - * values larger than dataset size will be silently - truncated down to dataset size - -OUTPUT PARAMETERS: - Rep - structure which contains cross-validation estimates: - * Rep.RelCLSError - fraction of misclassified cases. - * Rep.AvgCE - acerage cross-entropy - * Rep.RMSError - root-mean-square error - * Rep.AvgError - average error - * Rep.AvgRelError - average relative error - -NOTE: when no dataset was specified with MLPSetDataset/SetSparseDataset(), - or subset with only one point was given, zeros are returned as - estimates. - -NOTE: this method performs FoldsCount cross-validation rounds, each one - with NRestarts random starts. Thus, FoldsCount*NRestarts networks - are trained in total. - -NOTE: Rep.RelCLSError/Rep.AvgCE are zero on regression problems. - -NOTE: on classification problems Rep.RMSError/Rep.AvgError/Rep.AvgRelError - contain errors in prediction of posterior probabilities. - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpkfoldcv(const mlptrainer &s, const multilayerperceptron &network, const ae_int_t nrestarts, const ae_int_t foldscount, mlpreport &rep); -void smp_mlpkfoldcv(const mlptrainer &s, const multilayerperceptron &network, const ae_int_t nrestarts, const ae_int_t foldscount, mlpreport &rep); - - -/************************************************************************* -Creation of the network trainer object for regression networks - -INPUT PARAMETERS: - NIn - number of inputs, NIn>=1 - NOut - number of outputs, NOut>=1 - -OUTPUT PARAMETERS: - S - neural network trainer object. - This structure can be used to train any regression - network with NIn inputs and NOut outputs. - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpcreatetrainer(const ae_int_t nin, const ae_int_t nout, mlptrainer &s); - - -/************************************************************************* -Creation of the network trainer object for classification networks - -INPUT PARAMETERS: - NIn - number of inputs, NIn>=1 - NClasses - number of classes, NClasses>=2 - -OUTPUT PARAMETERS: - S - neural network trainer object. - This structure can be used to train any classification - network with NIn inputs and NOut outputs. - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpcreatetrainercls(const ae_int_t nin, const ae_int_t nclasses, mlptrainer &s); - - -/************************************************************************* -This function sets "current dataset" of the trainer object to one passed -by user. - -INPUT PARAMETERS: - S - trainer object - XY - training set, see below for information on the - training set format. This function checks correctness - of the dataset (no NANs/INFs, class numbers are - correct) and throws exception when incorrect dataset - is passed. - NPoints - points count, >=0. - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -datasetformat is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpsetdataset(const mlptrainer &s, const real_2d_array &xy, const ae_int_t npoints); - - -/************************************************************************* -This function sets "current dataset" of the trainer object to one passed -by user (sparse matrix is used to store dataset). - -INPUT PARAMETERS: - S - trainer object - XY - training set, see below for information on the - training set format. This function checks correctness - of the dataset (no NANs/INFs, class numbers are - correct) and throws exception when incorrect dataset - is passed. Any sparse storage format can be used: - Hash-table, CRS... - NPoints - points count, >=0 - -DATASET FORMAT: - -This function uses two different dataset formats - one for regression -networks, another one for classification networks. - -For regression networks with NIn inputs and NOut outputs following dataset -format is used: -* dataset is given by NPoints*(NIn+NOut) matrix -* each row corresponds to one example -* first NIn columns are inputs, next NOut columns are outputs - -For classification networks with NIn inputs and NClasses clases following -datasetformat is used: -* dataset is given by NPoints*(NIn+1) matrix -* each row corresponds to one example -* first NIn columns are inputs, last column stores class number (from 0 to - NClasses-1). - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpsetsparsedataset(const mlptrainer &s, const sparsematrix &xy, const ae_int_t npoints); - - -/************************************************************************* -This function sets weight decay coefficient which is used for training. - -INPUT PARAMETERS: - S - trainer object - Decay - weight decay coefficient, >=0. Weight decay term - 'Decay*||Weights||^2' is added to error function. If - you don't know what Decay to choose, use 1.0E-3. - Weight decay can be set to zero, in this case network - is trained without weight decay. - -NOTE: by default network uses some small nonzero value for weight decay. - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpsetdecay(const mlptrainer &s, const double decay); - - -/************************************************************************* -This function sets stopping criteria for the optimizer. - -INPUT PARAMETERS: - S - trainer object - WStep - stopping criterion. Algorithm stops if step size is - less than WStep. Recommended value - 0.01. Zero step - size means stopping after MaxIts iterations. - WStep>=0. - MaxIts - stopping criterion. Algorithm stops after MaxIts - epochs (full passes over entire dataset). Zero MaxIts - means stopping when step is sufficiently small. - MaxIts>=0. - -NOTE: by default, WStep=0.005 and MaxIts=0 are used. These values are also - used when MLPSetCond() is called with WStep=0 and MaxIts=0. - -NOTE: these stopping criteria are used for all kinds of neural training - - from "conventional" networks to early stopping ensembles. When used - for "conventional" networks, they are used as the only stopping - criteria. When combined with early stopping, they used as ADDITIONAL - stopping criteria which can terminate early stopping algorithm. - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpsetcond(const mlptrainer &s, const double wstep, const ae_int_t maxits); - - -/************************************************************************* -This function sets training algorithm: batch training using L-BFGS will be -used. - -This algorithm: -* the most robust for small-scale problems, but may be too slow for large - scale ones. -* perfoms full pass through the dataset before performing step -* uses conditions specified by MLPSetCond() for stopping -* is default one used by trainer object - -INPUT PARAMETERS: - S - trainer object - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpsetalgobatch(const mlptrainer &s); - - -/************************************************************************* -This function trains neural network passed to this function, using current -dataset (one which was passed to MLPSetDataset() or MLPSetSparseDataset()) -and current training settings. Training from NRestarts random starting -positions is performed, best network is chosen. - -Training is performed using current training algorithm. - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support (C++ computational core) - ! - ! Second improvement gives constant speedup (2-3X). First improvement - ! gives close-to-linear speedup on multicore systems. Following - ! operations can be executed in parallel: - ! * NRestarts training sessions performed within each of - ! cross-validation rounds (if NRestarts>1) - ! * gradient calculation over large dataset (if dataset is large enough) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - -INPUT PARAMETERS: - S - trainer object - Network - neural network. It must have same number of inputs and - output/classes as was specified during creation of the - trainer object. - NRestarts - number of restarts, >=0: - * NRestarts>0 means that specified number of random - restarts are performed, best network is chosen after - training - * NRestarts=0 means that current state of the network - is used for training. - -OUTPUT PARAMETERS: - Network - trained network - -NOTE: when no dataset was specified with MLPSetDataset/SetSparseDataset(), - network is filled by zero values. Same behavior for functions - MLPStartTraining and MLPContinueTraining. - -NOTE: this method uses sum-of-squares error function for training. - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlptrainnetwork(const mlptrainer &s, const multilayerperceptron &network, const ae_int_t nrestarts, mlpreport &rep); -void smp_mlptrainnetwork(const mlptrainer &s, const multilayerperceptron &network, const ae_int_t nrestarts, mlpreport &rep); - - -/************************************************************************* -IMPORTANT: this is an "expert" version of the MLPTrain() function. We do - not recommend you to use it unless you are pretty sure that you - need ability to monitor training progress. - -This function performs step-by-step training of the neural network. Here -"step-by-step" means that training starts with MLPStartTraining() call, -and then user subsequently calls MLPContinueTraining() to perform one more -iteration of the training. - -After call to this function trainer object remembers network and is ready -to train it. However, no training is performed until first call to -MLPContinueTraining() function. Subsequent calls to MLPContinueTraining() -will advance training progress one iteration further. - -EXAMPLE: - > - > ...initialize network and trainer object.... - > - > MLPStartTraining(Trainer, Network, True) - > while MLPContinueTraining(Trainer, Network) do - > ...visualize training progress... - > - -INPUT PARAMETERS: - S - trainer object - Network - neural network. It must have same number of inputs and - output/classes as was specified during creation of the - trainer object. - RandomStart - randomize network before training or not: - * True means that network is randomized and its - initial state (one which was passed to the trainer - object) is lost. - * False means that training is started from the - current state of the network - -OUTPUT PARAMETERS: - Network - neural network which is ready to training (weights are - initialized, preprocessor is initialized using current - training set) - -NOTE: this method uses sum-of-squares error function for training. - -NOTE: it is expected that trainer object settings are NOT changed during - step-by-step training, i.e. no one changes stopping criteria or - training set during training. It is possible and there is no defense - against such actions, but algorithm behavior in such cases is - undefined and can be unpredictable. - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -void mlpstarttraining(const mlptrainer &s, const multilayerperceptron &network, const bool randomstart); - - -/************************************************************************* -IMPORTANT: this is an "expert" version of the MLPTrain() function. We do - not recommend you to use it unless you are pretty sure that you - need ability to monitor training progress. - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support (C++ computational core) - ! - ! Second improvement gives constant speedup (2-3X). First improvement - ! gives close-to-linear speedup on multicore systems. Following - ! operations can be executed in parallel: - ! * gradient calculation over large dataset (if dataset is large enough) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - -This function performs step-by-step training of the neural network. Here -"step-by-step" means that training starts with MLPStartTraining() call, -and then user subsequently calls MLPContinueTraining() to perform one more -iteration of the training. - -This function performs one more iteration of the training and returns -either True (training continues) or False (training stopped). In case True -was returned, Network weights are updated according to the current state -of the optimization progress. In case False was returned, no additional -updates is performed (previous update of the network weights moved us to -the final point, and no additional updates is needed). - -EXAMPLE: - > - > [initialize network and trainer object] - > - > MLPStartTraining(Trainer, Network, True) - > while MLPContinueTraining(Trainer, Network) do - > [visualize training progress] - > - -INPUT PARAMETERS: - S - trainer object - Network - neural network structure, which is used to store - current state of the training process. - -OUTPUT PARAMETERS: - Network - weights of the neural network are rewritten by the - current approximation. - -NOTE: this method uses sum-of-squares error function for training. - -NOTE: it is expected that trainer object settings are NOT changed during - step-by-step training, i.e. no one changes stopping criteria or - training set during training. It is possible and there is no defense - against such actions, but algorithm behavior in such cases is - undefined and can be unpredictable. - -NOTE: It is expected that Network is the same one which was passed to - MLPStartTraining() function. However, THIS function checks only - following: - * that number of network inputs is consistent with trainer object - settings - * that number of network outputs/classes is consistent with trainer - object settings - * that number of network weights is the same as number of weights in - the network passed to MLPStartTraining() function - Exception is thrown when these conditions are violated. - - It is also expected that you do not change state of the network on - your own - the only party who has right to change network during its - training is a trainer object. Any attempt to interfere with trainer - may lead to unpredictable results. - - - -- ALGLIB -- - Copyright 23.07.2012 by Bochkanov Sergey -*************************************************************************/ -bool mlpcontinuetraining(const mlptrainer &s, const multilayerperceptron &network); -bool smp_mlpcontinuetraining(const mlptrainer &s, const multilayerperceptron &network); - - -/************************************************************************* -Training neural networks ensemble using bootstrap aggregating (bagging). -Modified Levenberg-Marquardt algorithm is used as base training method. - -INPUT PARAMETERS: - Ensemble - model with initialized geometry - XY - training set - NPoints - training set size - Decay - weight decay coefficient, >=0.001 - Restarts - restarts, >0. - -OUTPUT PARAMETERS: - Ensemble - trained model - Info - return code: - * -2, if there is a point with class number - outside of [0..NClasses-1]. - * -1, if incorrect parameters was passed - (NPoints<0, Restarts<1). - * 2, if task has been solved. - Rep - training report. - OOBErrors - out-of-bag generalization error estimate - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpebagginglm(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints, const double decay, const ae_int_t restarts, ae_int_t &info, mlpreport &rep, mlpcvreport &ooberrors); - - -/************************************************************************* -Training neural networks ensemble using bootstrap aggregating (bagging). -L-BFGS algorithm is used as base training method. - -INPUT PARAMETERS: - Ensemble - model with initialized geometry - XY - training set - NPoints - training set size - Decay - weight decay coefficient, >=0.001 - Restarts - restarts, >0. - WStep - stopping criterion, same as in MLPTrainLBFGS - MaxIts - stopping criterion, same as in MLPTrainLBFGS - -OUTPUT PARAMETERS: - Ensemble - trained model - Info - return code: - * -8, if both WStep=0 and MaxIts=0 - * -2, if there is a point with class number - outside of [0..NClasses-1]. - * -1, if incorrect parameters was passed - (NPoints<0, Restarts<1). - * 2, if task has been solved. - Rep - training report. - OOBErrors - out-of-bag generalization error estimate - - -- ALGLIB -- - Copyright 17.02.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpebagginglbfgs(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints, const double decay, const ae_int_t restarts, const double wstep, const ae_int_t maxits, ae_int_t &info, mlpreport &rep, mlpcvreport &ooberrors); - - -/************************************************************************* -Training neural networks ensemble using early stopping. - -INPUT PARAMETERS: - Ensemble - model with initialized geometry - XY - training set - NPoints - training set size - Decay - weight decay coefficient, >=0.001 - Restarts - restarts, >0. - -OUTPUT PARAMETERS: - Ensemble - trained model - Info - return code: - * -2, if there is a point with class number - outside of [0..NClasses-1]. - * -1, if incorrect parameters was passed - (NPoints<0, Restarts<1). - * 6, if task has been solved. - Rep - training report. - OOBErrors - out-of-bag generalization error estimate - - -- ALGLIB -- - Copyright 10.03.2009 by Bochkanov Sergey -*************************************************************************/ -void mlpetraines(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints, const double decay, const ae_int_t restarts, ae_int_t &info, mlpreport &rep); - - -/************************************************************************* -This function trains neural network ensemble passed to this function using -current dataset and early stopping training algorithm. Each early stopping -round performs NRestarts random restarts (thus, EnsembleSize*NRestarts -training rounds is performed in total). - -FOR USERS OF COMMERCIAL EDITION: - - ! Commercial version of ALGLIB includes two important improvements of - ! this function: - ! * multicore support (C++ and C# computational cores) - ! * SSE support (C++ computational core) - ! - ! Second improvement gives constant speedup (2-3X). First improvement - ! gives close-to-linear speedup on multicore systems. Following - ! operations can be executed in parallel: - ! * EnsembleSize training sessions performed for each of ensemble - ! members (always parallelized) - ! * NRestarts training sessions performed within each of training - ! sessions (if NRestarts>1) - ! * gradient calculation over large dataset (if dataset is large enough) - ! - ! In order to use multicore features you have to: - ! * use commercial version of ALGLIB - ! * call this function with "smp_" prefix, which indicates that - ! multicore code will be used (for multicore support) - ! - ! In order to use SSE features you have to: - ! * use commercial version of ALGLIB on Intel processors - ! * use C++ computational core - ! - ! This note is given for users of commercial edition; if you use GPL - ! edition, you still will be able to call smp-version of this function, - ! but all computations will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - -INPUT PARAMETERS: - S - trainer object; - Ensemble - neural network ensemble. It must have same number of - inputs and outputs/classes as was specified during - creation of the trainer object. - NRestarts - number of restarts, >=0: - * NRestarts>0 means that specified number of random - restarts are performed during each ES round; - * NRestarts=0 is silently replaced by 1. - -OUTPUT PARAMETERS: - Ensemble - trained ensemble; - Rep - it contains all type of errors. - -NOTE: this training method uses BOTH early stopping and weight decay! So, - you should select weight decay before starting training just as you - select it before training "conventional" networks. - -NOTE: when no dataset was specified with MLPSetDataset/SetSparseDataset(), - or single-point dataset was passed, ensemble is filled by zero - values. - -NOTE: this method uses sum-of-squares error function for training. - - -- ALGLIB -- - Copyright 22.08.2012 by Bochkanov Sergey -*************************************************************************/ -void mlptrainensemblees(const mlptrainer &s, const mlpensemble &ensemble, const ae_int_t nrestarts, mlpreport &rep); -void smp_mlptrainensemblees(const mlptrainer &s, const mlpensemble &ensemble, const ae_int_t nrestarts, mlpreport &rep); - -/************************************************************************* -Principal components analysis - -Subroutine builds orthogonal basis where first axis corresponds to -direction with maximum variance, second axis maximizes variance in subspace -orthogonal to first axis and so on. - -It should be noted that, unlike LDA, PCA does not use class labels. - -INPUT PARAMETERS: - X - dataset, array[0..NPoints-1,0..NVars-1]. - matrix contains ONLY INDEPENDENT VARIABLES. - NPoints - dataset size, NPoints>=0 - NVars - number of independent variables, NVars>=1 - -ÂÛÕÎÄÍÛÅ ÏÀÐÀÌÅÒÐÛ: - Info - return code: - * -4, if SVD subroutine haven't converged - * -1, if wrong parameters has been passed (NPoints<0, - NVars<1) - * 1, if task is solved - S2 - array[0..NVars-1]. variance values corresponding - to basis vectors. - V - array[0..NVars-1,0..NVars-1] - matrix, whose columns store basis vectors. - - -- ALGLIB -- - Copyright 25.08.2008 by Bochkanov Sergey -*************************************************************************/ -void pcabuildbasis(const real_2d_array &x, const ae_int_t npoints, const ae_int_t nvars, ae_int_t &info, real_1d_array &s2, real_2d_array &v); -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (FUNCTIONS) -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ -void dserrallocate(ae_int_t nclasses, - /* Real */ ae_vector* buf, - ae_state *_state); -void dserraccumulate(/* Real */ ae_vector* buf, - /* Real */ ae_vector* y, - /* Real */ ae_vector* desiredy, - ae_state *_state); -void dserrfinish(/* Real */ ae_vector* buf, ae_state *_state); -void dsnormalize(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t* info, - /* Real */ ae_vector* means, - /* Real */ ae_vector* sigmas, - ae_state *_state); -void dsnormalizec(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t* info, - /* Real */ ae_vector* means, - /* Real */ ae_vector* sigmas, - ae_state *_state); -double dsgetmeanmindistance(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nvars, - ae_state *_state); -void dstie(/* Real */ ae_vector* a, - ae_int_t n, - /* Integer */ ae_vector* ties, - ae_int_t* tiecount, - /* Integer */ ae_vector* p1, - /* Integer */ ae_vector* p2, - ae_state *_state); -void dstiefasti(/* Real */ ae_vector* a, - /* Integer */ ae_vector* b, - ae_int_t n, - /* Integer */ ae_vector* ties, - ae_int_t* tiecount, - /* Real */ ae_vector* bufr, - /* Integer */ ae_vector* bufi, - ae_state *_state); -void dsoptimalsplit2(/* Real */ ae_vector* a, - /* Integer */ ae_vector* c, - ae_int_t n, - ae_int_t* info, - double* threshold, - double* pal, - double* pbl, - double* par, - double* pbr, - double* cve, - ae_state *_state); -void dsoptimalsplit2fast(/* Real */ ae_vector* a, - /* Integer */ ae_vector* c, - /* Integer */ ae_vector* tiesbuf, - /* Integer */ ae_vector* cntbuf, - /* Real */ ae_vector* bufr, - /* Integer */ ae_vector* bufi, - ae_int_t n, - ae_int_t nc, - double alpha, - ae_int_t* info, - double* threshold, - double* rms, - double* cvrms, - ae_state *_state); -void dssplitk(/* Real */ ae_vector* a, - /* Integer */ ae_vector* c, - ae_int_t n, - ae_int_t nc, - ae_int_t kmax, - ae_int_t* info, - /* Real */ ae_vector* thresholds, - ae_int_t* ni, - double* cve, - ae_state *_state); -void dsoptimalsplitk(/* Real */ ae_vector* a, - /* Integer */ ae_vector* c, - ae_int_t n, - ae_int_t nc, - ae_int_t kmax, - ae_int_t* info, - /* Real */ ae_vector* thresholds, - ae_int_t* ni, - double* cve, - ae_state *_state); -ae_bool _cvreport_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _cvreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _cvreport_clear(void* _p); -void _cvreport_destroy(void* _p); -void clusterizercreate(clusterizerstate* s, ae_state *_state); -void clusterizersetpoints(clusterizerstate* s, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nfeatures, - ae_int_t disttype, - ae_state *_state); -void clusterizersetdistances(clusterizerstate* s, - /* Real */ ae_matrix* d, - ae_int_t npoints, - ae_bool isupper, - ae_state *_state); -void clusterizersetahcalgo(clusterizerstate* s, - ae_int_t algo, - ae_state *_state); -void clusterizersetkmeanslimits(clusterizerstate* s, - ae_int_t restarts, - ae_int_t maxits, - ae_state *_state); -void clusterizerrunahc(clusterizerstate* s, - ahcreport* rep, - ae_state *_state); -void _pexec_clusterizerrunahc(clusterizerstate* s, - ahcreport* rep, ae_state *_state); -void clusterizerrunkmeans(clusterizerstate* s, - ae_int_t k, - kmeansreport* rep, - ae_state *_state); -void clusterizergetdistances(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nfeatures, - ae_int_t disttype, - /* Real */ ae_matrix* d, - ae_state *_state); -void _pexec_clusterizergetdistances(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nfeatures, - ae_int_t disttype, - /* Real */ ae_matrix* d, ae_state *_state); -void clusterizergetkclusters(ahcreport* rep, - ae_int_t k, - /* Integer */ ae_vector* cidx, - /* Integer */ ae_vector* cz, - ae_state *_state); -void clusterizerseparatedbydist(ahcreport* rep, - double r, - ae_int_t* k, - /* Integer */ ae_vector* cidx, - /* Integer */ ae_vector* cz, - ae_state *_state); -void clusterizerseparatedbycorr(ahcreport* rep, - double r, - ae_int_t* k, - /* Integer */ ae_vector* cidx, - /* Integer */ ae_vector* cz, - ae_state *_state); -void kmeansgenerateinternal(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t k, - ae_int_t maxits, - ae_int_t restarts, - ae_int_t* info, - /* Real */ ae_matrix* ccol, - ae_bool needccol, - /* Real */ ae_matrix* crow, - ae_bool needcrow, - /* Integer */ ae_vector* xyc, - ae_state *_state); -ae_bool _clusterizerstate_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _clusterizerstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _clusterizerstate_clear(void* _p); -void _clusterizerstate_destroy(void* _p); -ae_bool _ahcreport_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _ahcreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _ahcreport_clear(void* _p); -void _ahcreport_destroy(void* _p); -ae_bool _kmeansreport_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _kmeansreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _kmeansreport_clear(void* _p); -void _kmeansreport_destroy(void* _p); -void kmeansgenerate(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t k, - ae_int_t restarts, - ae_int_t* info, - /* Real */ ae_matrix* c, - /* Integer */ ae_vector* xyc, - ae_state *_state); -void dfbuildrandomdecisionforest(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t nclasses, - ae_int_t ntrees, - double r, - ae_int_t* info, - decisionforest* df, - dfreport* rep, - ae_state *_state); -void dfbuildrandomdecisionforestx1(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t nclasses, - ae_int_t ntrees, - ae_int_t nrndvars, - double r, - ae_int_t* info, - decisionforest* df, - dfreport* rep, - ae_state *_state); -void dfbuildinternal(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t nclasses, - ae_int_t ntrees, - ae_int_t samplesize, - ae_int_t nfeatures, - ae_int_t flags, - ae_int_t* info, - decisionforest* df, - dfreport* rep, - ae_state *_state); -void dfprocess(decisionforest* df, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state); -void dfprocessi(decisionforest* df, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state); -double dfrelclserror(decisionforest* df, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state); -double dfavgce(decisionforest* df, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state); -double dfrmserror(decisionforest* df, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state); -double dfavgerror(decisionforest* df, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state); -double dfavgrelerror(decisionforest* df, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state); -void dfcopy(decisionforest* df1, decisionforest* df2, ae_state *_state); -void dfalloc(ae_serializer* s, decisionforest* forest, ae_state *_state); -void dfserialize(ae_serializer* s, - decisionforest* forest, - ae_state *_state); -void dfunserialize(ae_serializer* s, - decisionforest* forest, - ae_state *_state); -ae_bool _decisionforest_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _decisionforest_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _decisionforest_clear(void* _p); -void _decisionforest_destroy(void* _p); -ae_bool _dfreport_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _dfreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _dfreport_clear(void* _p); -void _dfreport_destroy(void* _p); -ae_bool _dfinternalbuffers_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _dfinternalbuffers_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _dfinternalbuffers_clear(void* _p); -void _dfinternalbuffers_destroy(void* _p); -void lrbuild(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t* info, - linearmodel* lm, - lrreport* ar, - ae_state *_state); -void lrbuilds(/* Real */ ae_matrix* xy, - /* Real */ ae_vector* s, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t* info, - linearmodel* lm, - lrreport* ar, - ae_state *_state); -void lrbuildzs(/* Real */ ae_matrix* xy, - /* Real */ ae_vector* s, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t* info, - linearmodel* lm, - lrreport* ar, - ae_state *_state); -void lrbuildz(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t* info, - linearmodel* lm, - lrreport* ar, - ae_state *_state); -void lrunpack(linearmodel* lm, - /* Real */ ae_vector* v, - ae_int_t* nvars, - ae_state *_state); -void lrpack(/* Real */ ae_vector* v, - ae_int_t nvars, - linearmodel* lm, - ae_state *_state); -double lrprocess(linearmodel* lm, - /* Real */ ae_vector* x, - ae_state *_state); -double lrrmserror(linearmodel* lm, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state); -double lravgerror(linearmodel* lm, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state); -double lravgrelerror(linearmodel* lm, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state); -void lrcopy(linearmodel* lm1, linearmodel* lm2, ae_state *_state); -void lrlines(/* Real */ ae_matrix* xy, - /* Real */ ae_vector* s, - ae_int_t n, - ae_int_t* info, - double* a, - double* b, - double* vara, - double* varb, - double* covab, - double* corrab, - double* p, - ae_state *_state); -void lrline(/* Real */ ae_matrix* xy, - ae_int_t n, - ae_int_t* info, - double* a, - double* b, - ae_state *_state); -ae_bool _linearmodel_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _linearmodel_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _linearmodel_clear(void* _p); -void _linearmodel_destroy(void* _p); -ae_bool _lrreport_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _lrreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _lrreport_clear(void* _p); -void _lrreport_destroy(void* _p); -void filtersma(/* Real */ ae_vector* x, - ae_int_t n, - ae_int_t k, - ae_state *_state); -void filterema(/* Real */ ae_vector* x, - ae_int_t n, - double alpha, - ae_state *_state); -void filterlrma(/* Real */ ae_vector* x, - ae_int_t n, - ae_int_t k, - ae_state *_state); -void fisherlda(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t nclasses, - ae_int_t* info, - /* Real */ ae_vector* w, - ae_state *_state); -void fisherldan(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t nclasses, - ae_int_t* info, - /* Real */ ae_matrix* w, - ae_state *_state); -ae_int_t mlpgradsplitcost(ae_state *_state); -ae_int_t mlpgradsplitsize(ae_state *_state); -void mlpcreate0(ae_int_t nin, - ae_int_t nout, - multilayerperceptron* network, - ae_state *_state); -void mlpcreate1(ae_int_t nin, - ae_int_t nhid, - ae_int_t nout, - multilayerperceptron* network, - ae_state *_state); -void mlpcreate2(ae_int_t nin, - ae_int_t nhid1, - ae_int_t nhid2, - ae_int_t nout, - multilayerperceptron* network, - ae_state *_state); -void mlpcreateb0(ae_int_t nin, - ae_int_t nout, - double b, - double d, - multilayerperceptron* network, - ae_state *_state); -void mlpcreateb1(ae_int_t nin, - ae_int_t nhid, - ae_int_t nout, - double b, - double d, - multilayerperceptron* network, - ae_state *_state); -void mlpcreateb2(ae_int_t nin, - ae_int_t nhid1, - ae_int_t nhid2, - ae_int_t nout, - double b, - double d, - multilayerperceptron* network, - ae_state *_state); -void mlpcreater0(ae_int_t nin, - ae_int_t nout, - double a, - double b, - multilayerperceptron* network, - ae_state *_state); -void mlpcreater1(ae_int_t nin, - ae_int_t nhid, - ae_int_t nout, - double a, - double b, - multilayerperceptron* network, - ae_state *_state); -void mlpcreater2(ae_int_t nin, - ae_int_t nhid1, - ae_int_t nhid2, - ae_int_t nout, - double a, - double b, - multilayerperceptron* network, - ae_state *_state); -void mlpcreatec0(ae_int_t nin, - ae_int_t nout, - multilayerperceptron* network, - ae_state *_state); -void mlpcreatec1(ae_int_t nin, - ae_int_t nhid, - ae_int_t nout, - multilayerperceptron* network, - ae_state *_state); -void mlpcreatec2(ae_int_t nin, - ae_int_t nhid1, - ae_int_t nhid2, - ae_int_t nout, - multilayerperceptron* network, - ae_state *_state); -void mlpcopy(multilayerperceptron* network1, - multilayerperceptron* network2, - ae_state *_state); -void mlpcopyshared(multilayerperceptron* network1, - multilayerperceptron* network2, - ae_state *_state); -ae_bool mlpsamearchitecture(multilayerperceptron* network1, - multilayerperceptron* network2, - ae_state *_state); -void mlpcopytunableparameters(multilayerperceptron* network1, - multilayerperceptron* network2, - ae_state *_state); -void mlpexporttunableparameters(multilayerperceptron* network, - /* Real */ ae_vector* p, - ae_int_t* pcount, - ae_state *_state); -void mlpimporttunableparameters(multilayerperceptron* network, - /* Real */ ae_vector* p, - ae_state *_state); -void mlpserializeold(multilayerperceptron* network, - /* Real */ ae_vector* ra, - ae_int_t* rlen, - ae_state *_state); -void mlpunserializeold(/* Real */ ae_vector* ra, - multilayerperceptron* network, - ae_state *_state); -void mlprandomize(multilayerperceptron* network, ae_state *_state); -void mlprandomizefull(multilayerperceptron* network, ae_state *_state); -void mlpinitpreprocessor(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t ssize, - ae_state *_state); -void mlpinitpreprocessorsparse(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t ssize, - ae_state *_state); -void mlpinitpreprocessorsubset(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t setsize, - /* Integer */ ae_vector* idx, - ae_int_t subsetsize, - ae_state *_state); -void mlpinitpreprocessorsparsesubset(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t setsize, - /* Integer */ ae_vector* idx, - ae_int_t subsetsize, - ae_state *_state); -void mlpproperties(multilayerperceptron* network, - ae_int_t* nin, - ae_int_t* nout, - ae_int_t* wcount, - ae_state *_state); -ae_int_t mlpntotal(multilayerperceptron* network, ae_state *_state); -ae_int_t mlpgetinputscount(multilayerperceptron* network, - ae_state *_state); -ae_int_t mlpgetoutputscount(multilayerperceptron* network, - ae_state *_state); -ae_int_t mlpgetweightscount(multilayerperceptron* network, - ae_state *_state); -ae_bool mlpissoftmax(multilayerperceptron* network, ae_state *_state); -ae_int_t mlpgetlayerscount(multilayerperceptron* network, - ae_state *_state); -ae_int_t mlpgetlayersize(multilayerperceptron* network, - ae_int_t k, - ae_state *_state); -void mlpgetinputscaling(multilayerperceptron* network, - ae_int_t i, - double* mean, - double* sigma, - ae_state *_state); -void mlpgetoutputscaling(multilayerperceptron* network, - ae_int_t i, - double* mean, - double* sigma, - ae_state *_state); -void mlpgetneuroninfo(multilayerperceptron* network, - ae_int_t k, - ae_int_t i, - ae_int_t* fkind, - double* threshold, - ae_state *_state); -double mlpgetweight(multilayerperceptron* network, - ae_int_t k0, - ae_int_t i0, - ae_int_t k1, - ae_int_t i1, - ae_state *_state); -void mlpsetinputscaling(multilayerperceptron* network, - ae_int_t i, - double mean, - double sigma, - ae_state *_state); -void mlpsetoutputscaling(multilayerperceptron* network, - ae_int_t i, - double mean, - double sigma, - ae_state *_state); -void mlpsetneuroninfo(multilayerperceptron* network, - ae_int_t k, - ae_int_t i, - ae_int_t fkind, - double threshold, - ae_state *_state); -void mlpsetweight(multilayerperceptron* network, - ae_int_t k0, - ae_int_t i0, - ae_int_t k1, - ae_int_t i1, - double w, - ae_state *_state); -void mlpactivationfunction(double net, - ae_int_t k, - double* f, - double* df, - double* d2f, - ae_state *_state); -void mlpprocess(multilayerperceptron* network, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state); -void mlpprocessi(multilayerperceptron* network, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state); -double mlperror(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state); -double _pexec_mlperror(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, ae_state *_state); -double mlperrorsparse(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t npoints, - ae_state *_state); -double _pexec_mlperrorsparse(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t npoints, ae_state *_state); -double mlperrorn(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t ssize, - ae_state *_state); -ae_int_t mlpclserror(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state); -ae_int_t _pexec_mlpclserror(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, ae_state *_state); -double mlprelclserror(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state); -double _pexec_mlprelclserror(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, ae_state *_state); -double mlprelclserrorsparse(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t npoints, - ae_state *_state); -double _pexec_mlprelclserrorsparse(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t npoints, ae_state *_state); -double mlpavgce(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state); -double _pexec_mlpavgce(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, ae_state *_state); -double mlpavgcesparse(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t npoints, - ae_state *_state); -double _pexec_mlpavgcesparse(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t npoints, ae_state *_state); -double mlprmserror(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state); -double _pexec_mlprmserror(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, ae_state *_state); -double mlprmserrorsparse(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t npoints, - ae_state *_state); -double _pexec_mlprmserrorsparse(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t npoints, ae_state *_state); -double mlpavgerror(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state); -double _pexec_mlpavgerror(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, ae_state *_state); -double mlpavgerrorsparse(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t npoints, - ae_state *_state); -double _pexec_mlpavgerrorsparse(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t npoints, ae_state *_state); -double mlpavgrelerror(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state); -double _pexec_mlpavgrelerror(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, ae_state *_state); -double mlpavgrelerrorsparse(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t npoints, - ae_state *_state); -double _pexec_mlpavgrelerrorsparse(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t npoints, ae_state *_state); -void mlpgrad(multilayerperceptron* network, - /* Real */ ae_vector* x, - /* Real */ ae_vector* desiredy, - double* e, - /* Real */ ae_vector* grad, - ae_state *_state); -void mlpgradn(multilayerperceptron* network, - /* Real */ ae_vector* x, - /* Real */ ae_vector* desiredy, - double* e, - /* Real */ ae_vector* grad, - ae_state *_state); -void mlpgradbatch(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t ssize, - double* e, - /* Real */ ae_vector* grad, - ae_state *_state); -void _pexec_mlpgradbatch(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t ssize, - double* e, - /* Real */ ae_vector* grad, ae_state *_state); -void mlpgradbatchsparse(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t ssize, - double* e, - /* Real */ ae_vector* grad, - ae_state *_state); -void _pexec_mlpgradbatchsparse(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t ssize, - double* e, - /* Real */ ae_vector* grad, ae_state *_state); -void mlpgradbatchsubset(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t setsize, - /* Integer */ ae_vector* idx, - ae_int_t subsetsize, - double* e, - /* Real */ ae_vector* grad, - ae_state *_state); -void _pexec_mlpgradbatchsubset(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t setsize, - /* Integer */ ae_vector* idx, - ae_int_t subsetsize, - double* e, - /* Real */ ae_vector* grad, ae_state *_state); -void mlpgradbatchsparsesubset(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t setsize, - /* Integer */ ae_vector* idx, - ae_int_t subsetsize, - double* e, - /* Real */ ae_vector* grad, - ae_state *_state); -void _pexec_mlpgradbatchsparsesubset(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t setsize, - /* Integer */ ae_vector* idx, - ae_int_t subsetsize, - double* e, - /* Real */ ae_vector* grad, ae_state *_state); -void mlpgradbatchx(multilayerperceptron* network, - /* Real */ ae_matrix* densexy, - sparsematrix* sparsexy, - ae_int_t datasetsize, - ae_int_t datasettype, - /* Integer */ ae_vector* idx, - ae_int_t subset0, - ae_int_t subset1, - ae_int_t subsettype, - ae_shared_pool* buf, - ae_shared_pool* gradbuf, - ae_state *_state); -void mlpgradnbatch(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t ssize, - double* e, - /* Real */ ae_vector* grad, - ae_state *_state); -void mlphessiannbatch(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t ssize, - double* e, - /* Real */ ae_vector* grad, - /* Real */ ae_matrix* h, - ae_state *_state); -void mlphessianbatch(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t ssize, - double* e, - /* Real */ ae_vector* grad, - /* Real */ ae_matrix* h, - ae_state *_state); -void mlpinternalprocessvector(/* Integer */ ae_vector* structinfo, - /* Real */ ae_vector* weights, - /* Real */ ae_vector* columnmeans, - /* Real */ ae_vector* columnsigmas, - /* Real */ ae_vector* neurons, - /* Real */ ae_vector* dfdnet, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state); -void mlpalloc(ae_serializer* s, - multilayerperceptron* network, - ae_state *_state); -void mlpserialize(ae_serializer* s, - multilayerperceptron* network, - ae_state *_state); -void mlpunserialize(ae_serializer* s, - multilayerperceptron* network, - ae_state *_state); -void mlpallerrorssubset(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t setsize, - /* Integer */ ae_vector* subset, - ae_int_t subsetsize, - modelerrors* rep, - ae_state *_state); -void _pexec_mlpallerrorssubset(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t setsize, - /* Integer */ ae_vector* subset, - ae_int_t subsetsize, - modelerrors* rep, ae_state *_state); -void mlpallerrorssparsesubset(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t setsize, - /* Integer */ ae_vector* subset, - ae_int_t subsetsize, - modelerrors* rep, - ae_state *_state); -void _pexec_mlpallerrorssparsesubset(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t setsize, - /* Integer */ ae_vector* subset, - ae_int_t subsetsize, - modelerrors* rep, ae_state *_state); -double mlperrorsubset(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t setsize, - /* Integer */ ae_vector* subset, - ae_int_t subsetsize, - ae_state *_state); -double _pexec_mlperrorsubset(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t setsize, - /* Integer */ ae_vector* subset, - ae_int_t subsetsize, ae_state *_state); -double mlperrorsparsesubset(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t setsize, - /* Integer */ ae_vector* subset, - ae_int_t subsetsize, - ae_state *_state); -double _pexec_mlperrorsparsesubset(multilayerperceptron* network, - sparsematrix* xy, - ae_int_t setsize, - /* Integer */ ae_vector* subset, - ae_int_t subsetsize, ae_state *_state); -void mlpallerrorsx(multilayerperceptron* network, - /* Real */ ae_matrix* densexy, - sparsematrix* sparsexy, - ae_int_t datasetsize, - ae_int_t datasettype, - /* Integer */ ae_vector* idx, - ae_int_t subset0, - ae_int_t subset1, - ae_int_t subsettype, - ae_shared_pool* buf, - modelerrors* rep, - ae_state *_state); -ae_bool _modelerrors_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _modelerrors_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _modelerrors_clear(void* _p); -void _modelerrors_destroy(void* _p); -ae_bool _smlpgrad_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _smlpgrad_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _smlpgrad_clear(void* _p); -void _smlpgrad_destroy(void* _p); -ae_bool _multilayerperceptron_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _multilayerperceptron_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _multilayerperceptron_clear(void* _p); -void _multilayerperceptron_destroy(void* _p); -void mnltrainh(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t nclasses, - ae_int_t* info, - logitmodel* lm, - mnlreport* rep, - ae_state *_state); -void mnlprocess(logitmodel* lm, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state); -void mnlprocessi(logitmodel* lm, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state); -void mnlunpack(logitmodel* lm, - /* Real */ ae_matrix* a, - ae_int_t* nvars, - ae_int_t* nclasses, - ae_state *_state); -void mnlpack(/* Real */ ae_matrix* a, - ae_int_t nvars, - ae_int_t nclasses, - logitmodel* lm, - ae_state *_state); -void mnlcopy(logitmodel* lm1, logitmodel* lm2, ae_state *_state); -double mnlavgce(logitmodel* lm, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state); -double mnlrelclserror(logitmodel* lm, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state); -double mnlrmserror(logitmodel* lm, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state); -double mnlavgerror(logitmodel* lm, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state); -double mnlavgrelerror(logitmodel* lm, - /* Real */ ae_matrix* xy, - ae_int_t ssize, - ae_state *_state); -ae_int_t mnlclserror(logitmodel* lm, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state); -ae_bool _logitmodel_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _logitmodel_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _logitmodel_clear(void* _p); -void _logitmodel_destroy(void* _p); -ae_bool _logitmcstate_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _logitmcstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _logitmcstate_clear(void* _p); -void _logitmcstate_destroy(void* _p); -ae_bool _mnlreport_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _mnlreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _mnlreport_clear(void* _p); -void _mnlreport_destroy(void* _p); -void mcpdcreate(ae_int_t n, mcpdstate* s, ae_state *_state); -void mcpdcreateentry(ae_int_t n, - ae_int_t entrystate, - mcpdstate* s, - ae_state *_state); -void mcpdcreateexit(ae_int_t n, - ae_int_t exitstate, - mcpdstate* s, - ae_state *_state); -void mcpdcreateentryexit(ae_int_t n, - ae_int_t entrystate, - ae_int_t exitstate, - mcpdstate* s, - ae_state *_state); -void mcpdaddtrack(mcpdstate* s, - /* Real */ ae_matrix* xy, - ae_int_t k, - ae_state *_state); -void mcpdsetec(mcpdstate* s, - /* Real */ ae_matrix* ec, - ae_state *_state); -void mcpdaddec(mcpdstate* s, - ae_int_t i, - ae_int_t j, - double c, - ae_state *_state); -void mcpdsetbc(mcpdstate* s, - /* Real */ ae_matrix* bndl, - /* Real */ ae_matrix* bndu, - ae_state *_state); -void mcpdaddbc(mcpdstate* s, - ae_int_t i, - ae_int_t j, - double bndl, - double bndu, - ae_state *_state); -void mcpdsetlc(mcpdstate* s, - /* Real */ ae_matrix* c, - /* Integer */ ae_vector* ct, - ae_int_t k, - ae_state *_state); -void mcpdsettikhonovregularizer(mcpdstate* s, double v, ae_state *_state); -void mcpdsetprior(mcpdstate* s, - /* Real */ ae_matrix* pp, - ae_state *_state); -void mcpdsetpredictionweights(mcpdstate* s, - /* Real */ ae_vector* pw, - ae_state *_state); -void mcpdsolve(mcpdstate* s, ae_state *_state); -void mcpdresults(mcpdstate* s, - /* Real */ ae_matrix* p, - mcpdreport* rep, - ae_state *_state); -ae_bool _mcpdstate_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _mcpdstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _mcpdstate_clear(void* _p); -void _mcpdstate_destroy(void* _p); -ae_bool _mcpdreport_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _mcpdreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _mcpdreport_clear(void* _p); -void _mcpdreport_destroy(void* _p); -void mlpecreate0(ae_int_t nin, - ae_int_t nout, - ae_int_t ensemblesize, - mlpensemble* ensemble, - ae_state *_state); -void mlpecreate1(ae_int_t nin, - ae_int_t nhid, - ae_int_t nout, - ae_int_t ensemblesize, - mlpensemble* ensemble, - ae_state *_state); -void mlpecreate2(ae_int_t nin, - ae_int_t nhid1, - ae_int_t nhid2, - ae_int_t nout, - ae_int_t ensemblesize, - mlpensemble* ensemble, - ae_state *_state); -void mlpecreateb0(ae_int_t nin, - ae_int_t nout, - double b, - double d, - ae_int_t ensemblesize, - mlpensemble* ensemble, - ae_state *_state); -void mlpecreateb1(ae_int_t nin, - ae_int_t nhid, - ae_int_t nout, - double b, - double d, - ae_int_t ensemblesize, - mlpensemble* ensemble, - ae_state *_state); -void mlpecreateb2(ae_int_t nin, - ae_int_t nhid1, - ae_int_t nhid2, - ae_int_t nout, - double b, - double d, - ae_int_t ensemblesize, - mlpensemble* ensemble, - ae_state *_state); -void mlpecreater0(ae_int_t nin, - ae_int_t nout, - double a, - double b, - ae_int_t ensemblesize, - mlpensemble* ensemble, - ae_state *_state); -void mlpecreater1(ae_int_t nin, - ae_int_t nhid, - ae_int_t nout, - double a, - double b, - ae_int_t ensemblesize, - mlpensemble* ensemble, - ae_state *_state); -void mlpecreater2(ae_int_t nin, - ae_int_t nhid1, - ae_int_t nhid2, - ae_int_t nout, - double a, - double b, - ae_int_t ensemblesize, - mlpensemble* ensemble, - ae_state *_state); -void mlpecreatec0(ae_int_t nin, - ae_int_t nout, - ae_int_t ensemblesize, - mlpensemble* ensemble, - ae_state *_state); -void mlpecreatec1(ae_int_t nin, - ae_int_t nhid, - ae_int_t nout, - ae_int_t ensemblesize, - mlpensemble* ensemble, - ae_state *_state); -void mlpecreatec2(ae_int_t nin, - ae_int_t nhid1, - ae_int_t nhid2, - ae_int_t nout, - ae_int_t ensemblesize, - mlpensemble* ensemble, - ae_state *_state); -void mlpecreatefromnetwork(multilayerperceptron* network, - ae_int_t ensemblesize, - mlpensemble* ensemble, - ae_state *_state); -void mlpecopy(mlpensemble* ensemble1, - mlpensemble* ensemble2, - ae_state *_state); -void mlperandomize(mlpensemble* ensemble, ae_state *_state); -void mlpeproperties(mlpensemble* ensemble, - ae_int_t* nin, - ae_int_t* nout, - ae_state *_state); -ae_bool mlpeissoftmax(mlpensemble* ensemble, ae_state *_state); -void mlpeprocess(mlpensemble* ensemble, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state); -void mlpeprocessi(mlpensemble* ensemble, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state); -void mlpeallerrorsx(mlpensemble* ensemble, - /* Real */ ae_matrix* densexy, - sparsematrix* sparsexy, - ae_int_t datasetsize, - ae_int_t datasettype, - /* Integer */ ae_vector* idx, - ae_int_t subset0, - ae_int_t subset1, - ae_int_t subsettype, - ae_shared_pool* buf, - modelerrors* rep, - ae_state *_state); -void mlpeallerrorssparse(mlpensemble* ensemble, - sparsematrix* xy, - ae_int_t npoints, - double* relcls, - double* avgce, - double* rms, - double* avg, - double* avgrel, - ae_state *_state); -double mlperelclserror(mlpensemble* ensemble, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state); -double mlpeavgce(mlpensemble* ensemble, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state); -double mlpermserror(mlpensemble* ensemble, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state); -double mlpeavgerror(mlpensemble* ensemble, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state); -double mlpeavgrelerror(mlpensemble* ensemble, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state); -void mlpealloc(ae_serializer* s, mlpensemble* ensemble, ae_state *_state); -void mlpeserialize(ae_serializer* s, - mlpensemble* ensemble, - ae_state *_state); -void mlpeunserialize(ae_serializer* s, - mlpensemble* ensemble, - ae_state *_state); -ae_bool _mlpensemble_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _mlpensemble_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _mlpensemble_clear(void* _p); -void _mlpensemble_destroy(void* _p); -void mlptrainlm(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - double decay, - ae_int_t restarts, - ae_int_t* info, - mlpreport* rep, - ae_state *_state); -void mlptrainlbfgs(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - double decay, - ae_int_t restarts, - double wstep, - ae_int_t maxits, - ae_int_t* info, - mlpreport* rep, - ae_state *_state); -void mlptraines(multilayerperceptron* network, - /* Real */ ae_matrix* trnxy, - ae_int_t trnsize, - /* Real */ ae_matrix* valxy, - ae_int_t valsize, - double decay, - ae_int_t restarts, - ae_int_t* info, - mlpreport* rep, - ae_state *_state); -void mlpkfoldcvlbfgs(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - double decay, - ae_int_t restarts, - double wstep, - ae_int_t maxits, - ae_int_t foldscount, - ae_int_t* info, - mlpreport* rep, - mlpcvreport* cvrep, - ae_state *_state); -void mlpkfoldcvlm(multilayerperceptron* network, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - double decay, - ae_int_t restarts, - ae_int_t foldscount, - ae_int_t* info, - mlpreport* rep, - mlpcvreport* cvrep, - ae_state *_state); -void mlpkfoldcv(mlptrainer* s, - multilayerperceptron* network, - ae_int_t nrestarts, - ae_int_t foldscount, - mlpreport* rep, - ae_state *_state); -void _pexec_mlpkfoldcv(mlptrainer* s, - multilayerperceptron* network, - ae_int_t nrestarts, - ae_int_t foldscount, - mlpreport* rep, ae_state *_state); -void mlpcreatetrainer(ae_int_t nin, - ae_int_t nout, - mlptrainer* s, - ae_state *_state); -void mlpcreatetrainercls(ae_int_t nin, - ae_int_t nclasses, - mlptrainer* s, - ae_state *_state); -void mlpsetdataset(mlptrainer* s, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_state *_state); -void mlpsetsparsedataset(mlptrainer* s, - sparsematrix* xy, - ae_int_t npoints, - ae_state *_state); -void mlpsetdecay(mlptrainer* s, double decay, ae_state *_state); -void mlpsetcond(mlptrainer* s, - double wstep, - ae_int_t maxits, - ae_state *_state); -void mlpsetalgobatch(mlptrainer* s, ae_state *_state); -void mlptrainnetwork(mlptrainer* s, - multilayerperceptron* network, - ae_int_t nrestarts, - mlpreport* rep, - ae_state *_state); -void _pexec_mlptrainnetwork(mlptrainer* s, - multilayerperceptron* network, - ae_int_t nrestarts, - mlpreport* rep, ae_state *_state); -void mlpstarttraining(mlptrainer* s, - multilayerperceptron* network, - ae_bool randomstart, - ae_state *_state); -ae_bool mlpcontinuetraining(mlptrainer* s, - multilayerperceptron* network, - ae_state *_state); -ae_bool _pexec_mlpcontinuetraining(mlptrainer* s, - multilayerperceptron* network, ae_state *_state); -void mlpebagginglm(mlpensemble* ensemble, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - double decay, - ae_int_t restarts, - ae_int_t* info, - mlpreport* rep, - mlpcvreport* ooberrors, - ae_state *_state); -void mlpebagginglbfgs(mlpensemble* ensemble, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - double decay, - ae_int_t restarts, - double wstep, - ae_int_t maxits, - ae_int_t* info, - mlpreport* rep, - mlpcvreport* ooberrors, - ae_state *_state); -void mlpetraines(mlpensemble* ensemble, - /* Real */ ae_matrix* xy, - ae_int_t npoints, - double decay, - ae_int_t restarts, - ae_int_t* info, - mlpreport* rep, - ae_state *_state); -void mlptrainensemblees(mlptrainer* s, - mlpensemble* ensemble, - ae_int_t nrestarts, - mlpreport* rep, - ae_state *_state); -void _pexec_mlptrainensemblees(mlptrainer* s, - mlpensemble* ensemble, - ae_int_t nrestarts, - mlpreport* rep, ae_state *_state); -ae_bool _mlpreport_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _mlpreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _mlpreport_clear(void* _p); -void _mlpreport_destroy(void* _p); -ae_bool _mlpcvreport_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _mlpcvreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _mlpcvreport_clear(void* _p); -void _mlpcvreport_destroy(void* _p); -ae_bool _smlptrnsession_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _smlptrnsession_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _smlptrnsession_clear(void* _p); -void _smlptrnsession_destroy(void* _p); -ae_bool _mlpetrnsession_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _mlpetrnsession_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _mlpetrnsession_clear(void* _p); -void _mlpetrnsession_destroy(void* _p); -ae_bool _mlptrainer_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _mlptrainer_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _mlptrainer_clear(void* _p); -void _mlptrainer_destroy(void* _p); -ae_bool _mlpparallelizationcv_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _mlpparallelizationcv_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _mlpparallelizationcv_clear(void* _p); -void _mlpparallelizationcv_destroy(void* _p); -void pcabuildbasis(/* Real */ ae_matrix* x, - ae_int_t npoints, - ae_int_t nvars, - ae_int_t* info, - /* Real */ ae_vector* s2, - /* Real */ ae_matrix* v, - ae_state *_state); - -} -#endif - diff --git a/src/core/alglib/diffequations.cpp b/src/core/alglib/diffequations.cpp deleted file mode 100644 index f8ab421..0000000 --- a/src/core/alglib/diffequations.cpp +++ /dev/null @@ -1,1187 +0,0 @@ -/************************************************************************* -Copyright (c) Sergey Bochkanov (ALGLIB project). - ->>> SOURCE LICENSE >>> -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation (www.fsf.org); either version 2 of the -License, or (at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -A copy of the GNU General Public License is available at -http://www.fsf.org/licensing/licenses ->>> END OF LICENSE >>> -*************************************************************************/ -#include "stdafx.h" -#include "diffequations.h" - -// disable some irrelevant warnings -#if (AE_COMPILER==AE_MSVC) -#pragma warning(disable:4100) -#pragma warning(disable:4127) -#pragma warning(disable:4702) -#pragma warning(disable:4996) -#endif -using namespace std; - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS IMPLEMENTATION OF C++ INTERFACE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib -{ - - -/************************************************************************* - -*************************************************************************/ -_odesolverstate_owner::_odesolverstate_owner() -{ - p_struct = (alglib_impl::odesolverstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::odesolverstate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_odesolverstate_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_odesolverstate_owner::_odesolverstate_owner(const _odesolverstate_owner &rhs) -{ - p_struct = (alglib_impl::odesolverstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::odesolverstate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_odesolverstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_odesolverstate_owner& _odesolverstate_owner::operator=(const _odesolverstate_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_odesolverstate_clear(p_struct); - if( !alglib_impl::_odesolverstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_odesolverstate_owner::~_odesolverstate_owner() -{ - alglib_impl::_odesolverstate_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::odesolverstate* _odesolverstate_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::odesolverstate* _odesolverstate_owner::c_ptr() const -{ - return const_cast(p_struct); -} -odesolverstate::odesolverstate() : _odesolverstate_owner() ,needdy(p_struct->needdy),y(&p_struct->y),dy(&p_struct->dy),x(p_struct->x) -{ -} - -odesolverstate::odesolverstate(const odesolverstate &rhs):_odesolverstate_owner(rhs) ,needdy(p_struct->needdy),y(&p_struct->y),dy(&p_struct->dy),x(p_struct->x) -{ -} - -odesolverstate& odesolverstate::operator=(const odesolverstate &rhs) -{ - if( this==&rhs ) - return *this; - _odesolverstate_owner::operator=(rhs); - return *this; -} - -odesolverstate::~odesolverstate() -{ -} - - -/************************************************************************* - -*************************************************************************/ -_odesolverreport_owner::_odesolverreport_owner() -{ - p_struct = (alglib_impl::odesolverreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::odesolverreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_odesolverreport_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_odesolverreport_owner::_odesolverreport_owner(const _odesolverreport_owner &rhs) -{ - p_struct = (alglib_impl::odesolverreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::odesolverreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_odesolverreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_odesolverreport_owner& _odesolverreport_owner::operator=(const _odesolverreport_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_odesolverreport_clear(p_struct); - if( !alglib_impl::_odesolverreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_odesolverreport_owner::~_odesolverreport_owner() -{ - alglib_impl::_odesolverreport_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::odesolverreport* _odesolverreport_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::odesolverreport* _odesolverreport_owner::c_ptr() const -{ - return const_cast(p_struct); -} -odesolverreport::odesolverreport() : _odesolverreport_owner() ,nfev(p_struct->nfev),terminationtype(p_struct->terminationtype) -{ -} - -odesolverreport::odesolverreport(const odesolverreport &rhs):_odesolverreport_owner(rhs) ,nfev(p_struct->nfev),terminationtype(p_struct->terminationtype) -{ -} - -odesolverreport& odesolverreport::operator=(const odesolverreport &rhs) -{ - if( this==&rhs ) - return *this; - _odesolverreport_owner::operator=(rhs); - return *this; -} - -odesolverreport::~odesolverreport() -{ -} - -/************************************************************************* -Cash-Karp adaptive ODE solver. - -This subroutine solves ODE Y'=f(Y,x) with initial conditions Y(xs)=Ys -(here Y may be single variable or vector of N variables). - -INPUT PARAMETERS: - Y - initial conditions, array[0..N-1]. - contains values of Y[] at X[0] - N - system size - X - points at which Y should be tabulated, array[0..M-1] - integrations starts at X[0], ends at X[M-1], intermediate - values at X[i] are returned too. - SHOULD BE ORDERED BY ASCENDING OR BY DESCENDING!!!! - M - number of intermediate points + first point + last point: - * M>2 means that you need both Y(X[M-1]) and M-2 values at - intermediate points - * M=2 means that you want just to integrate from X[0] to - X[1] and don't interested in intermediate values. - * M=1 means that you don't want to integrate :) - it is degenerate case, but it will be handled correctly. - * M<1 means error - Eps - tolerance (absolute/relative error on each step will be - less than Eps). When passing: - * Eps>0, it means desired ABSOLUTE error - * Eps<0, it means desired RELATIVE error. Relative errors - are calculated with respect to maximum values of Y seen - so far. Be careful to use this criterion when starting - from Y[] that are close to zero. - H - initial step lenth, it will be adjusted automatically - after the first step. If H=0, step will be selected - automatically (usually it will be equal to 0.001 of - min(x[i]-x[j])). - -OUTPUT PARAMETERS - State - structure which stores algorithm state between subsequent - calls of OdeSolverIteration. Used for reverse communication. - This structure should be passed to the OdeSolverIteration - subroutine. - -SEE ALSO - AutoGKSmoothW, AutoGKSingular, AutoGKIteration, AutoGKResults. - - - -- ALGLIB -- - Copyright 01.09.2009 by Bochkanov Sergey -*************************************************************************/ -void odesolverrkck(const real_1d_array &y, const ae_int_t n, const real_1d_array &x, const ae_int_t m, const double eps, const double h, odesolverstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::odesolverrkck(const_cast(y.c_ptr()), n, const_cast(x.c_ptr()), m, eps, h, const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Cash-Karp adaptive ODE solver. - -This subroutine solves ODE Y'=f(Y,x) with initial conditions Y(xs)=Ys -(here Y may be single variable or vector of N variables). - -INPUT PARAMETERS: - Y - initial conditions, array[0..N-1]. - contains values of Y[] at X[0] - N - system size - X - points at which Y should be tabulated, array[0..M-1] - integrations starts at X[0], ends at X[M-1], intermediate - values at X[i] are returned too. - SHOULD BE ORDERED BY ASCENDING OR BY DESCENDING!!!! - M - number of intermediate points + first point + last point: - * M>2 means that you need both Y(X[M-1]) and M-2 values at - intermediate points - * M=2 means that you want just to integrate from X[0] to - X[1] and don't interested in intermediate values. - * M=1 means that you don't want to integrate :) - it is degenerate case, but it will be handled correctly. - * M<1 means error - Eps - tolerance (absolute/relative error on each step will be - less than Eps). When passing: - * Eps>0, it means desired ABSOLUTE error - * Eps<0, it means desired RELATIVE error. Relative errors - are calculated with respect to maximum values of Y seen - so far. Be careful to use this criterion when starting - from Y[] that are close to zero. - H - initial step lenth, it will be adjusted automatically - after the first step. If H=0, step will be selected - automatically (usually it will be equal to 0.001 of - min(x[i]-x[j])). - -OUTPUT PARAMETERS - State - structure which stores algorithm state between subsequent - calls of OdeSolverIteration. Used for reverse communication. - This structure should be passed to the OdeSolverIteration - subroutine. - -SEE ALSO - AutoGKSmoothW, AutoGKSingular, AutoGKIteration, AutoGKResults. - - - -- ALGLIB -- - Copyright 01.09.2009 by Bochkanov Sergey -*************************************************************************/ -void odesolverrkck(const real_1d_array &y, const real_1d_array &x, const double eps, const double h, odesolverstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t m; - - n = y.length(); - m = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::odesolverrkck(const_cast(y.c_ptr()), n, const_cast(x.c_ptr()), m, eps, h, const_cast(state.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function provides reverse communication interface -Reverse communication interface is not documented or recommended to use. -See below for functions which provide better documented API -*************************************************************************/ -bool odesolveriteration(const odesolverstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::odesolveriteration(const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void odesolversolve(odesolverstate &state, - void (*diff)(const real_1d_array &y, double x, real_1d_array &dy, void *ptr), - void *ptr){ - alglib_impl::ae_state _alglib_env_state; - if( diff==NULL ) - throw ap_error("ALGLIB: error in 'odesolversolve()' (diff is NULL)"); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - while( alglib_impl::odesolveriteration(state.c_ptr(), &_alglib_env_state) ) - { - if( state.needdy ) - { - diff(state.y, state.x, state.dy, ptr); - continue; - } - throw ap_error("ALGLIB: unexpected error in 'odesolversolve'"); - } - alglib_impl::ae_state_clear(&_alglib_env_state); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - - -/************************************************************************* -ODE solver results - -Called after OdeSolverIteration returned False. - -INPUT PARAMETERS: - State - algorithm state (used by OdeSolverIteration). - -OUTPUT PARAMETERS: - M - number of tabulated values, M>=1 - XTbl - array[0..M-1], values of X - YTbl - array[0..M-1,0..N-1], values of Y in X[i] - Rep - solver report: - * Rep.TerminationType completion code: - * -2 X is not ordered by ascending/descending or - there are non-distinct X[], i.e. X[i]=X[i+1] - * -1 incorrect parameters were specified - * 1 task has been solved - * Rep.NFEV contains number of function calculations - - -- ALGLIB -- - Copyright 01.09.2009 by Bochkanov Sergey -*************************************************************************/ -void odesolverresults(const odesolverstate &state, ae_int_t &m, real_1d_array &xtbl, real_2d_array &ytbl, odesolverreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::odesolverresults(const_cast(state.c_ptr()), &m, const_cast(xtbl.c_ptr()), const_cast(ytbl.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS IMPLEMENTATION OF COMPUTATIONAL CORE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ -static double odesolver_odesolvermaxgrow = 3.0; -static double odesolver_odesolvermaxshrink = 10.0; -static void odesolver_odesolverinit(ae_int_t solvertype, - /* Real */ ae_vector* y, - ae_int_t n, - /* Real */ ae_vector* x, - ae_int_t m, - double eps, - double h, - odesolverstate* state, - ae_state *_state); - - - - - -/************************************************************************* -Cash-Karp adaptive ODE solver. - -This subroutine solves ODE Y'=f(Y,x) with initial conditions Y(xs)=Ys -(here Y may be single variable or vector of N variables). - -INPUT PARAMETERS: - Y - initial conditions, array[0..N-1]. - contains values of Y[] at X[0] - N - system size - X - points at which Y should be tabulated, array[0..M-1] - integrations starts at X[0], ends at X[M-1], intermediate - values at X[i] are returned too. - SHOULD BE ORDERED BY ASCENDING OR BY DESCENDING!!!! - M - number of intermediate points + first point + last point: - * M>2 means that you need both Y(X[M-1]) and M-2 values at - intermediate points - * M=2 means that you want just to integrate from X[0] to - X[1] and don't interested in intermediate values. - * M=1 means that you don't want to integrate :) - it is degenerate case, but it will be handled correctly. - * M<1 means error - Eps - tolerance (absolute/relative error on each step will be - less than Eps). When passing: - * Eps>0, it means desired ABSOLUTE error - * Eps<0, it means desired RELATIVE error. Relative errors - are calculated with respect to maximum values of Y seen - so far. Be careful to use this criterion when starting - from Y[] that are close to zero. - H - initial step lenth, it will be adjusted automatically - after the first step. If H=0, step will be selected - automatically (usually it will be equal to 0.001 of - min(x[i]-x[j])). - -OUTPUT PARAMETERS - State - structure which stores algorithm state between subsequent - calls of OdeSolverIteration. Used for reverse communication. - This structure should be passed to the OdeSolverIteration - subroutine. - -SEE ALSO - AutoGKSmoothW, AutoGKSingular, AutoGKIteration, AutoGKResults. - - - -- ALGLIB -- - Copyright 01.09.2009 by Bochkanov Sergey -*************************************************************************/ -void odesolverrkck(/* Real */ ae_vector* y, - ae_int_t n, - /* Real */ ae_vector* x, - ae_int_t m, - double eps, - double h, - odesolverstate* state, - ae_state *_state) -{ - - _odesolverstate_clear(state); - - ae_assert(n>=1, "ODESolverRKCK: N<1!", _state); - ae_assert(m>=1, "ODESolverRKCK: M<1!", _state); - ae_assert(y->cnt>=n, "ODESolverRKCK: Length(Y)cnt>=m, "ODESolverRKCK: Length(X)rstate.stage>=0 ) - { - n = state->rstate.ia.ptr.p_int[0]; - m = state->rstate.ia.ptr.p_int[1]; - i = state->rstate.ia.ptr.p_int[2]; - j = state->rstate.ia.ptr.p_int[3]; - k = state->rstate.ia.ptr.p_int[4]; - klimit = state->rstate.ia.ptr.p_int[5]; - gridpoint = state->rstate.ba.ptr.p_bool[0]; - xc = state->rstate.ra.ptr.p_double[0]; - v = state->rstate.ra.ptr.p_double[1]; - h = state->rstate.ra.ptr.p_double[2]; - h2 = state->rstate.ra.ptr.p_double[3]; - err = state->rstate.ra.ptr.p_double[4]; - maxgrowpow = state->rstate.ra.ptr.p_double[5]; - } - else - { - n = -983; - m = -989; - i = -834; - j = 900; - k = -287; - klimit = 364; - gridpoint = ae_false; - xc = -338; - v = -686; - h = 912; - h2 = 585; - err = 497; - maxgrowpow = -271; - } - if( state->rstate.stage==0 ) - { - goto lbl_0; - } - - /* - * Routine body - */ - - /* - * prepare - */ - if( state->repterminationtype!=0 ) - { - result = ae_false; - return result; - } - n = state->n; - m = state->m; - h = state->h; - maxgrowpow = ae_pow(odesolver_odesolvermaxgrow, 5, _state); - state->repnfev = 0; - - /* - * some preliminary checks for internal errors - * after this we assume that H>0 and M>1 - */ - ae_assert(ae_fp_greater(state->h,0), "ODESolver: internal error", _state); - ae_assert(m>1, "ODESolverIteration: internal error", _state); - - /* - * choose solver - */ - if( state->solvertype!=0 ) - { - goto lbl_1; - } - - /* - * Cask-Karp solver - * Prepare coefficients table. - * Check it for errors - */ - ae_vector_set_length(&state->rka, 6, _state); - state->rka.ptr.p_double[0] = 0; - state->rka.ptr.p_double[1] = (double)1/(double)5; - state->rka.ptr.p_double[2] = (double)3/(double)10; - state->rka.ptr.p_double[3] = (double)3/(double)5; - state->rka.ptr.p_double[4] = 1; - state->rka.ptr.p_double[5] = (double)7/(double)8; - ae_matrix_set_length(&state->rkb, 6, 5, _state); - state->rkb.ptr.pp_double[1][0] = (double)1/(double)5; - state->rkb.ptr.pp_double[2][0] = (double)3/(double)40; - state->rkb.ptr.pp_double[2][1] = (double)9/(double)40; - state->rkb.ptr.pp_double[3][0] = (double)3/(double)10; - state->rkb.ptr.pp_double[3][1] = -(double)9/(double)10; - state->rkb.ptr.pp_double[3][2] = (double)6/(double)5; - state->rkb.ptr.pp_double[4][0] = -(double)11/(double)54; - state->rkb.ptr.pp_double[4][1] = (double)5/(double)2; - state->rkb.ptr.pp_double[4][2] = -(double)70/(double)27; - state->rkb.ptr.pp_double[4][3] = (double)35/(double)27; - state->rkb.ptr.pp_double[5][0] = (double)1631/(double)55296; - state->rkb.ptr.pp_double[5][1] = (double)175/(double)512; - state->rkb.ptr.pp_double[5][2] = (double)575/(double)13824; - state->rkb.ptr.pp_double[5][3] = (double)44275/(double)110592; - state->rkb.ptr.pp_double[5][4] = (double)253/(double)4096; - ae_vector_set_length(&state->rkc, 6, _state); - state->rkc.ptr.p_double[0] = (double)37/(double)378; - state->rkc.ptr.p_double[1] = 0; - state->rkc.ptr.p_double[2] = (double)250/(double)621; - state->rkc.ptr.p_double[3] = (double)125/(double)594; - state->rkc.ptr.p_double[4] = 0; - state->rkc.ptr.p_double[5] = (double)512/(double)1771; - ae_vector_set_length(&state->rkcs, 6, _state); - state->rkcs.ptr.p_double[0] = (double)2825/(double)27648; - state->rkcs.ptr.p_double[1] = 0; - state->rkcs.ptr.p_double[2] = (double)18575/(double)48384; - state->rkcs.ptr.p_double[3] = (double)13525/(double)55296; - state->rkcs.ptr.p_double[4] = (double)277/(double)14336; - state->rkcs.ptr.p_double[5] = (double)1/(double)4; - ae_matrix_set_length(&state->rkk, 6, n, _state); - - /* - * Main cycle consists of two iterations: - * * outer where we travel from X[i-1] to X[i] - * * inner where we travel inside [X[i-1],X[i]] - */ - ae_matrix_set_length(&state->ytbl, m, n, _state); - ae_vector_set_length(&state->escale, n, _state); - ae_vector_set_length(&state->yn, n, _state); - ae_vector_set_length(&state->yns, n, _state); - xc = state->xg.ptr.p_double[0]; - ae_v_move(&state->ytbl.ptr.pp_double[0][0], 1, &state->yc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - for(j=0; j<=n-1; j++) - { - state->escale.ptr.p_double[j] = 0; - } - i = 1; -lbl_3: - if( i>m-1 ) - { - goto lbl_5; - } - - /* - * begin inner iteration - */ -lbl_6: - if( ae_false ) - { - goto lbl_7; - } - - /* - * truncate step if needed (beyond right boundary). - * determine should we store X or not - */ - if( ae_fp_greater_eq(xc+h,state->xg.ptr.p_double[i]) ) - { - h = state->xg.ptr.p_double[i]-xc; - gridpoint = ae_true; - } - else - { - gridpoint = ae_false; - } - - /* - * Update error scale maximums - * - * These maximums are initialized by zeros, - * then updated every iterations. - */ - for(j=0; j<=n-1; j++) - { - state->escale.ptr.p_double[j] = ae_maxreal(state->escale.ptr.p_double[j], ae_fabs(state->yc.ptr.p_double[j], _state), _state); - } - - /* - * make one step: - * 1. calculate all info needed to do step - * 2. update errors scale maximums using values/derivatives - * obtained during (1) - * - * Take into account that we use scaling of X to reduce task - * to the form where x[0] < x[1] < ... < x[n-1]. So X is - * replaced by x=xscale*t, and dy/dx=f(y,x) is replaced - * by dy/dt=xscale*f(y,xscale*t). - */ - ae_v_move(&state->yn.ptr.p_double[0], 1, &state->yc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_move(&state->yns.ptr.p_double[0], 1, &state->yc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - k = 0; -lbl_8: - if( k>5 ) - { - goto lbl_10; - } - - /* - * prepare data for the next update of YN/YNS - */ - state->x = state->xscale*(xc+state->rka.ptr.p_double[k]*h); - ae_v_move(&state->y.ptr.p_double[0], 1, &state->yc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - for(j=0; j<=k-1; j++) - { - v = state->rkb.ptr.pp_double[k][j]; - ae_v_addd(&state->y.ptr.p_double[0], 1, &state->rkk.ptr.pp_double[j][0], 1, ae_v_len(0,n-1), v); - } - state->needdy = ae_true; - state->rstate.stage = 0; - goto lbl_rcomm; -lbl_0: - state->needdy = ae_false; - state->repnfev = state->repnfev+1; - v = h*state->xscale; - ae_v_moved(&state->rkk.ptr.pp_double[k][0], 1, &state->dy.ptr.p_double[0], 1, ae_v_len(0,n-1), v); - - /* - * update YN/YNS - */ - v = state->rkc.ptr.p_double[k]; - ae_v_addd(&state->yn.ptr.p_double[0], 1, &state->rkk.ptr.pp_double[k][0], 1, ae_v_len(0,n-1), v); - v = state->rkcs.ptr.p_double[k]; - ae_v_addd(&state->yns.ptr.p_double[0], 1, &state->rkk.ptr.pp_double[k][0], 1, ae_v_len(0,n-1), v); - k = k+1; - goto lbl_8; -lbl_10: - - /* - * estimate error - */ - err = 0; - for(j=0; j<=n-1; j++) - { - if( !state->fraceps ) - { - - /* - * absolute error is estimated - */ - err = ae_maxreal(err, ae_fabs(state->yn.ptr.p_double[j]-state->yns.ptr.p_double[j], _state), _state); - } - else - { - - /* - * Relative error is estimated - */ - v = state->escale.ptr.p_double[j]; - if( ae_fp_eq(v,0) ) - { - v = 1; - } - err = ae_maxreal(err, ae_fabs(state->yn.ptr.p_double[j]-state->yns.ptr.p_double[j], _state)/v, _state); - } - } - - /* - * calculate new step, restart if necessary - */ - if( ae_fp_less_eq(maxgrowpow*err,state->eps) ) - { - h2 = odesolver_odesolvermaxgrow*h; - } - else - { - h2 = h*ae_pow(state->eps/err, 0.2, _state); - } - if( ae_fp_less(h2,h/odesolver_odesolvermaxshrink) ) - { - h2 = h/odesolver_odesolvermaxshrink; - } - if( ae_fp_greater(err,state->eps) ) - { - h = h2; - goto lbl_6; - } - - /* - * advance position - */ - xc = xc+h; - ae_v_move(&state->yc.ptr.p_double[0], 1, &state->yn.ptr.p_double[0], 1, ae_v_len(0,n-1)); - - /* - * update H - */ - h = h2; - - /* - * break on grid point - */ - if( gridpoint ) - { - goto lbl_7; - } - goto lbl_6; -lbl_7: - - /* - * save result - */ - ae_v_move(&state->ytbl.ptr.pp_double[i][0], 1, &state->yc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - i = i+1; - goto lbl_3; -lbl_5: - state->repterminationtype = 1; - result = ae_false; - return result; -lbl_1: - result = ae_false; - return result; - - /* - * Saving state - */ -lbl_rcomm: - result = ae_true; - state->rstate.ia.ptr.p_int[0] = n; - state->rstate.ia.ptr.p_int[1] = m; - state->rstate.ia.ptr.p_int[2] = i; - state->rstate.ia.ptr.p_int[3] = j; - state->rstate.ia.ptr.p_int[4] = k; - state->rstate.ia.ptr.p_int[5] = klimit; - state->rstate.ba.ptr.p_bool[0] = gridpoint; - state->rstate.ra.ptr.p_double[0] = xc; - state->rstate.ra.ptr.p_double[1] = v; - state->rstate.ra.ptr.p_double[2] = h; - state->rstate.ra.ptr.p_double[3] = h2; - state->rstate.ra.ptr.p_double[4] = err; - state->rstate.ra.ptr.p_double[5] = maxgrowpow; - return result; -} - - -/************************************************************************* -ODE solver results - -Called after OdeSolverIteration returned False. - -INPUT PARAMETERS: - State - algorithm state (used by OdeSolverIteration). - -OUTPUT PARAMETERS: - M - number of tabulated values, M>=1 - XTbl - array[0..M-1], values of X - YTbl - array[0..M-1,0..N-1], values of Y in X[i] - Rep - solver report: - * Rep.TerminationType completion code: - * -2 X is not ordered by ascending/descending or - there are non-distinct X[], i.e. X[i]=X[i+1] - * -1 incorrect parameters were specified - * 1 task has been solved - * Rep.NFEV contains number of function calculations - - -- ALGLIB -- - Copyright 01.09.2009 by Bochkanov Sergey -*************************************************************************/ -void odesolverresults(odesolverstate* state, - ae_int_t* m, - /* Real */ ae_vector* xtbl, - /* Real */ ae_matrix* ytbl, - odesolverreport* rep, - ae_state *_state) -{ - double v; - ae_int_t i; - - *m = 0; - ae_vector_clear(xtbl); - ae_matrix_clear(ytbl); - _odesolverreport_clear(rep); - - rep->terminationtype = state->repterminationtype; - if( rep->terminationtype>0 ) - { - *m = state->m; - rep->nfev = state->repnfev; - ae_vector_set_length(xtbl, state->m, _state); - v = state->xscale; - ae_v_moved(&xtbl->ptr.p_double[0], 1, &state->xg.ptr.p_double[0], 1, ae_v_len(0,state->m-1), v); - ae_matrix_set_length(ytbl, state->m, state->n, _state); - for(i=0; i<=state->m-1; i++) - { - ae_v_move(&ytbl->ptr.pp_double[i][0], 1, &state->ytbl.ptr.pp_double[i][0], 1, ae_v_len(0,state->n-1)); - } - } - else - { - rep->nfev = 0; - } -} - - -/************************************************************************* -Internal initialization subroutine -*************************************************************************/ -static void odesolver_odesolverinit(ae_int_t solvertype, - /* Real */ ae_vector* y, - ae_int_t n, - /* Real */ ae_vector* x, - ae_int_t m, - double eps, - double h, - odesolverstate* state, - ae_state *_state) -{ - ae_int_t i; - double v; - - _odesolverstate_clear(state); - - - /* - * Prepare RComm - */ - ae_vector_set_length(&state->rstate.ia, 5+1, _state); - ae_vector_set_length(&state->rstate.ba, 0+1, _state); - ae_vector_set_length(&state->rstate.ra, 5+1, _state); - state->rstate.stage = -1; - state->needdy = ae_false; - - /* - * check parameters. - */ - if( (n<=0||m<1)||ae_fp_eq(eps,0) ) - { - state->repterminationtype = -1; - return; - } - if( ae_fp_less(h,0) ) - { - h = -h; - } - - /* - * quick exit if necessary. - * after this block we assume that M>1 - */ - if( m==1 ) - { - state->repnfev = 0; - state->repterminationtype = 1; - ae_matrix_set_length(&state->ytbl, 1, n, _state); - ae_v_move(&state->ytbl.ptr.pp_double[0][0], 1, &y->ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_vector_set_length(&state->xg, m, _state); - ae_v_move(&state->xg.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,m-1)); - return; - } - - /* - * check again: correct order of X[] - */ - if( ae_fp_eq(x->ptr.p_double[1],x->ptr.p_double[0]) ) - { - state->repterminationtype = -2; - return; - } - for(i=1; i<=m-1; i++) - { - if( (ae_fp_greater(x->ptr.p_double[1],x->ptr.p_double[0])&&ae_fp_less_eq(x->ptr.p_double[i],x->ptr.p_double[i-1]))||(ae_fp_less(x->ptr.p_double[1],x->ptr.p_double[0])&&ae_fp_greater_eq(x->ptr.p_double[i],x->ptr.p_double[i-1])) ) - { - state->repterminationtype = -2; - return; - } - } - - /* - * auto-select H if necessary - */ - if( ae_fp_eq(h,0) ) - { - v = ae_fabs(x->ptr.p_double[1]-x->ptr.p_double[0], _state); - for(i=2; i<=m-1; i++) - { - v = ae_minreal(v, ae_fabs(x->ptr.p_double[i]-x->ptr.p_double[i-1], _state), _state); - } - h = 0.001*v; - } - - /* - * store parameters - */ - state->n = n; - state->m = m; - state->h = h; - state->eps = ae_fabs(eps, _state); - state->fraceps = ae_fp_less(eps,0); - ae_vector_set_length(&state->xg, m, _state); - ae_v_move(&state->xg.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,m-1)); - if( ae_fp_greater(x->ptr.p_double[1],x->ptr.p_double[0]) ) - { - state->xscale = 1; - } - else - { - state->xscale = -1; - ae_v_muld(&state->xg.ptr.p_double[0], 1, ae_v_len(0,m-1), -1); - } - ae_vector_set_length(&state->yc, n, _state); - ae_v_move(&state->yc.ptr.p_double[0], 1, &y->ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->solvertype = solvertype; - state->repterminationtype = 0; - - /* - * Allocate arrays - */ - ae_vector_set_length(&state->y, n, _state); - ae_vector_set_length(&state->dy, n, _state); -} - - -ae_bool _odesolverstate_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - odesolverstate *p = (odesolverstate*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->yc, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->escale, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->xg, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->y, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->dy, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->ytbl, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->yn, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->yns, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->rka, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->rkc, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->rkcs, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->rkb, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->rkk, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _odesolverstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - odesolverstate *dst = (odesolverstate*)_dst; - odesolverstate *src = (odesolverstate*)_src; - dst->n = src->n; - dst->m = src->m; - dst->xscale = src->xscale; - dst->h = src->h; - dst->eps = src->eps; - dst->fraceps = src->fraceps; - if( !ae_vector_init_copy(&dst->yc, &src->yc, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->escale, &src->escale, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->xg, &src->xg, _state, make_automatic) ) - return ae_false; - dst->solvertype = src->solvertype; - dst->needdy = src->needdy; - dst->x = src->x; - if( !ae_vector_init_copy(&dst->y, &src->y, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->dy, &src->dy, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->ytbl, &src->ytbl, _state, make_automatic) ) - return ae_false; - dst->repterminationtype = src->repterminationtype; - dst->repnfev = src->repnfev; - if( !ae_vector_init_copy(&dst->yn, &src->yn, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->yns, &src->yns, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->rka, &src->rka, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->rkc, &src->rkc, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->rkcs, &src->rkcs, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->rkb, &src->rkb, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->rkk, &src->rkk, _state, make_automatic) ) - return ae_false; - if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _odesolverstate_clear(void* _p) -{ - odesolverstate *p = (odesolverstate*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->yc); - ae_vector_clear(&p->escale); - ae_vector_clear(&p->xg); - ae_vector_clear(&p->y); - ae_vector_clear(&p->dy); - ae_matrix_clear(&p->ytbl); - ae_vector_clear(&p->yn); - ae_vector_clear(&p->yns); - ae_vector_clear(&p->rka); - ae_vector_clear(&p->rkc); - ae_vector_clear(&p->rkcs); - ae_matrix_clear(&p->rkb); - ae_matrix_clear(&p->rkk); - _rcommstate_clear(&p->rstate); -} - - -void _odesolverstate_destroy(void* _p) -{ - odesolverstate *p = (odesolverstate*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->yc); - ae_vector_destroy(&p->escale); - ae_vector_destroy(&p->xg); - ae_vector_destroy(&p->y); - ae_vector_destroy(&p->dy); - ae_matrix_destroy(&p->ytbl); - ae_vector_destroy(&p->yn); - ae_vector_destroy(&p->yns); - ae_vector_destroy(&p->rka); - ae_vector_destroy(&p->rkc); - ae_vector_destroy(&p->rkcs); - ae_matrix_destroy(&p->rkb); - ae_matrix_destroy(&p->rkk); - _rcommstate_destroy(&p->rstate); -} - - -ae_bool _odesolverreport_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - odesolverreport *p = (odesolverreport*)_p; - ae_touch_ptr((void*)p); - return ae_true; -} - - -ae_bool _odesolverreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - odesolverreport *dst = (odesolverreport*)_dst; - odesolverreport *src = (odesolverreport*)_src; - dst->nfev = src->nfev; - dst->terminationtype = src->terminationtype; - return ae_true; -} - - -void _odesolverreport_clear(void* _p) -{ - odesolverreport *p = (odesolverreport*)_p; - ae_touch_ptr((void*)p); -} - - -void _odesolverreport_destroy(void* _p) -{ - odesolverreport *p = (odesolverreport*)_p; - ae_touch_ptr((void*)p); -} - - - -} - diff --git a/src/core/alglib/diffequations.h b/src/core/alglib/diffequations.h deleted file mode 100644 index d101269..0000000 --- a/src/core/alglib/diffequations.h +++ /dev/null @@ -1,267 +0,0 @@ -/************************************************************************* -Copyright (c) Sergey Bochkanov (ALGLIB project). - ->>> SOURCE LICENSE >>> -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation (www.fsf.org); either version 2 of the -License, or (at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -A copy of the GNU General Public License is available at -http://www.fsf.org/licensing/licenses ->>> END OF LICENSE >>> -*************************************************************************/ -#ifndef _diffequations_pkg_h -#define _diffequations_pkg_h -#include "ap.h" -#include "alglibinternal.h" - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (DATATYPES) -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ -typedef struct -{ - ae_int_t n; - ae_int_t m; - double xscale; - double h; - double eps; - ae_bool fraceps; - ae_vector yc; - ae_vector escale; - ae_vector xg; - ae_int_t solvertype; - ae_bool needdy; - double x; - ae_vector y; - ae_vector dy; - ae_matrix ytbl; - ae_int_t repterminationtype; - ae_int_t repnfev; - ae_vector yn; - ae_vector yns; - ae_vector rka; - ae_vector rkc; - ae_vector rkcs; - ae_matrix rkb; - ae_matrix rkk; - rcommstate rstate; -} odesolverstate; -typedef struct -{ - ae_int_t nfev; - ae_int_t terminationtype; -} odesolverreport; - -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS C++ INTERFACE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib -{ - -/************************************************************************* - -*************************************************************************/ -class _odesolverstate_owner -{ -public: - _odesolverstate_owner(); - _odesolverstate_owner(const _odesolverstate_owner &rhs); - _odesolverstate_owner& operator=(const _odesolverstate_owner &rhs); - virtual ~_odesolverstate_owner(); - alglib_impl::odesolverstate* c_ptr(); - alglib_impl::odesolverstate* c_ptr() const; -protected: - alglib_impl::odesolverstate *p_struct; -}; -class odesolverstate : public _odesolverstate_owner -{ -public: - odesolverstate(); - odesolverstate(const odesolverstate &rhs); - odesolverstate& operator=(const odesolverstate &rhs); - virtual ~odesolverstate(); - ae_bool &needdy; - real_1d_array y; - real_1d_array dy; - double &x; - -}; - - -/************************************************************************* - -*************************************************************************/ -class _odesolverreport_owner -{ -public: - _odesolverreport_owner(); - _odesolverreport_owner(const _odesolverreport_owner &rhs); - _odesolverreport_owner& operator=(const _odesolverreport_owner &rhs); - virtual ~_odesolverreport_owner(); - alglib_impl::odesolverreport* c_ptr(); - alglib_impl::odesolverreport* c_ptr() const; -protected: - alglib_impl::odesolverreport *p_struct; -}; -class odesolverreport : public _odesolverreport_owner -{ -public: - odesolverreport(); - odesolverreport(const odesolverreport &rhs); - odesolverreport& operator=(const odesolverreport &rhs); - virtual ~odesolverreport(); - ae_int_t &nfev; - ae_int_t &terminationtype; - -}; - -/************************************************************************* -Cash-Karp adaptive ODE solver. - -This subroutine solves ODE Y'=f(Y,x) with initial conditions Y(xs)=Ys -(here Y may be single variable or vector of N variables). - -INPUT PARAMETERS: - Y - initial conditions, array[0..N-1]. - contains values of Y[] at X[0] - N - system size - X - points at which Y should be tabulated, array[0..M-1] - integrations starts at X[0], ends at X[M-1], intermediate - values at X[i] are returned too. - SHOULD BE ORDERED BY ASCENDING OR BY DESCENDING!!!! - M - number of intermediate points + first point + last point: - * M>2 means that you need both Y(X[M-1]) and M-2 values at - intermediate points - * M=2 means that you want just to integrate from X[0] to - X[1] and don't interested in intermediate values. - * M=1 means that you don't want to integrate :) - it is degenerate case, but it will be handled correctly. - * M<1 means error - Eps - tolerance (absolute/relative error on each step will be - less than Eps). When passing: - * Eps>0, it means desired ABSOLUTE error - * Eps<0, it means desired RELATIVE error. Relative errors - are calculated with respect to maximum values of Y seen - so far. Be careful to use this criterion when starting - from Y[] that are close to zero. - H - initial step lenth, it will be adjusted automatically - after the first step. If H=0, step will be selected - automatically (usually it will be equal to 0.001 of - min(x[i]-x[j])). - -OUTPUT PARAMETERS - State - structure which stores algorithm state between subsequent - calls of OdeSolverIteration. Used for reverse communication. - This structure should be passed to the OdeSolverIteration - subroutine. - -SEE ALSO - AutoGKSmoothW, AutoGKSingular, AutoGKIteration, AutoGKResults. - - - -- ALGLIB -- - Copyright 01.09.2009 by Bochkanov Sergey -*************************************************************************/ -void odesolverrkck(const real_1d_array &y, const ae_int_t n, const real_1d_array &x, const ae_int_t m, const double eps, const double h, odesolverstate &state); -void odesolverrkck(const real_1d_array &y, const real_1d_array &x, const double eps, const double h, odesolverstate &state); - - -/************************************************************************* -This function provides reverse communication interface -Reverse communication interface is not documented or recommended to use. -See below for functions which provide better documented API -*************************************************************************/ -bool odesolveriteration(const odesolverstate &state); - - -/************************************************************************* -This function is used to launcn iterations of ODE solver - -It accepts following parameters: - diff - callback which calculates dy/dx for given y and x - ptr - optional pointer which is passed to diff; can be NULL - - - -- ALGLIB -- - Copyright 01.09.2009 by Bochkanov Sergey - -*************************************************************************/ -void odesolversolve(odesolverstate &state, - void (*diff)(const real_1d_array &y, double x, real_1d_array &dy, void *ptr), - void *ptr = NULL); - - -/************************************************************************* -ODE solver results - -Called after OdeSolverIteration returned False. - -INPUT PARAMETERS: - State - algorithm state (used by OdeSolverIteration). - -OUTPUT PARAMETERS: - M - number of tabulated values, M>=1 - XTbl - array[0..M-1], values of X - YTbl - array[0..M-1,0..N-1], values of Y in X[i] - Rep - solver report: - * Rep.TerminationType completion code: - * -2 X is not ordered by ascending/descending or - there are non-distinct X[], i.e. X[i]=X[i+1] - * -1 incorrect parameters were specified - * 1 task has been solved - * Rep.NFEV contains number of function calculations - - -- ALGLIB -- - Copyright 01.09.2009 by Bochkanov Sergey -*************************************************************************/ -void odesolverresults(const odesolverstate &state, ae_int_t &m, real_1d_array &xtbl, real_2d_array &ytbl, odesolverreport &rep); -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (FUNCTIONS) -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ -void odesolverrkck(/* Real */ ae_vector* y, - ae_int_t n, - /* Real */ ae_vector* x, - ae_int_t m, - double eps, - double h, - odesolverstate* state, - ae_state *_state); -ae_bool odesolveriteration(odesolverstate* state, ae_state *_state); -void odesolverresults(odesolverstate* state, - ae_int_t* m, - /* Real */ ae_vector* xtbl, - /* Real */ ae_matrix* ytbl, - odesolverreport* rep, - ae_state *_state); -ae_bool _odesolverstate_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _odesolverstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _odesolverstate_clear(void* _p); -void _odesolverstate_destroy(void* _p); -ae_bool _odesolverreport_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _odesolverreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _odesolverreport_clear(void* _p); -void _odesolverreport_destroy(void* _p); - -} -#endif - diff --git a/src/core/alglib/fasttransforms.cpp b/src/core/alglib/fasttransforms.cpp deleted file mode 100644 index 2dd0ca3..0000000 --- a/src/core/alglib/fasttransforms.cpp +++ /dev/null @@ -1,3554 +0,0 @@ -/************************************************************************* -Copyright (c) Sergey Bochkanov (ALGLIB project). - ->>> SOURCE LICENSE >>> -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation (www.fsf.org); either version 2 of the -License, or (at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -A copy of the GNU General Public License is available at -http://www.fsf.org/licensing/licenses ->>> END OF LICENSE >>> -*************************************************************************/ -#include "stdafx.h" -#include "fasttransforms.h" - -// disable some irrelevant warnings -#if (AE_COMPILER==AE_MSVC) -#pragma warning(disable:4100) -#pragma warning(disable:4127) -#pragma warning(disable:4702) -#pragma warning(disable:4996) -#endif -using namespace std; - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS IMPLEMENTATION OF C++ INTERFACE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib -{ - - -/************************************************************************* -1-dimensional complex FFT. - -Array size N may be arbitrary number (composite or prime). Composite N's -are handled with cache-oblivious variation of a Cooley-Tukey algorithm. -Small prime-factors are transformed using hard coded codelets (similar to -FFTW codelets, but without low-level optimization), large prime-factors -are handled with Bluestein's algorithm. - -Fastests transforms are for smooth N's (prime factors are 2, 3, 5 only), -most fast for powers of 2. When N have prime factors larger than these, -but orders of magnitude smaller than N, computations will be about 4 times -slower than for nearby highly composite N's. When N itself is prime, speed -will be 6 times lower. - -Algorithm has O(N*logN) complexity for any N (composite or prime). - -INPUT PARAMETERS - A - array[0..N-1] - complex function to be transformed - N - problem size - -OUTPUT PARAMETERS - A - DFT of a input array, array[0..N-1] - A_out[j] = SUM(A_in[k]*exp(-2*pi*sqrt(-1)*j*k/N), k = 0..N-1) - - - -- ALGLIB -- - Copyright 29.05.2009 by Bochkanov Sergey -*************************************************************************/ -void fftc1d(complex_1d_array &a, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::fftc1d(const_cast(a.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -1-dimensional complex FFT. - -Array size N may be arbitrary number (composite or prime). Composite N's -are handled with cache-oblivious variation of a Cooley-Tukey algorithm. -Small prime-factors are transformed using hard coded codelets (similar to -FFTW codelets, but without low-level optimization), large prime-factors -are handled with Bluestein's algorithm. - -Fastests transforms are for smooth N's (prime factors are 2, 3, 5 only), -most fast for powers of 2. When N have prime factors larger than these, -but orders of magnitude smaller than N, computations will be about 4 times -slower than for nearby highly composite N's. When N itself is prime, speed -will be 6 times lower. - -Algorithm has O(N*logN) complexity for any N (composite or prime). - -INPUT PARAMETERS - A - array[0..N-1] - complex function to be transformed - N - problem size - -OUTPUT PARAMETERS - A - DFT of a input array, array[0..N-1] - A_out[j] = SUM(A_in[k]*exp(-2*pi*sqrt(-1)*j*k/N), k = 0..N-1) - - - -- ALGLIB -- - Copyright 29.05.2009 by Bochkanov Sergey -*************************************************************************/ -void fftc1d(complex_1d_array &a) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = a.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::fftc1d(const_cast(a.c_ptr()), n, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -1-dimensional complex inverse FFT. - -Array size N may be arbitrary number (composite or prime). Algorithm has -O(N*logN) complexity for any N (composite or prime). - -See FFTC1D() description for more information about algorithm performance. - -INPUT PARAMETERS - A - array[0..N-1] - complex array to be transformed - N - problem size - -OUTPUT PARAMETERS - A - inverse DFT of a input array, array[0..N-1] - A_out[j] = SUM(A_in[k]/N*exp(+2*pi*sqrt(-1)*j*k/N), k = 0..N-1) - - - -- ALGLIB -- - Copyright 29.05.2009 by Bochkanov Sergey -*************************************************************************/ -void fftc1dinv(complex_1d_array &a, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::fftc1dinv(const_cast(a.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -1-dimensional complex inverse FFT. - -Array size N may be arbitrary number (composite or prime). Algorithm has -O(N*logN) complexity for any N (composite or prime). - -See FFTC1D() description for more information about algorithm performance. - -INPUT PARAMETERS - A - array[0..N-1] - complex array to be transformed - N - problem size - -OUTPUT PARAMETERS - A - inverse DFT of a input array, array[0..N-1] - A_out[j] = SUM(A_in[k]/N*exp(+2*pi*sqrt(-1)*j*k/N), k = 0..N-1) - - - -- ALGLIB -- - Copyright 29.05.2009 by Bochkanov Sergey -*************************************************************************/ -void fftc1dinv(complex_1d_array &a) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = a.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::fftc1dinv(const_cast(a.c_ptr()), n, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -1-dimensional real FFT. - -Algorithm has O(N*logN) complexity for any N (composite or prime). - -INPUT PARAMETERS - A - array[0..N-1] - real function to be transformed - N - problem size - -OUTPUT PARAMETERS - F - DFT of a input array, array[0..N-1] - F[j] = SUM(A[k]*exp(-2*pi*sqrt(-1)*j*k/N), k = 0..N-1) - -NOTE: - F[] satisfies symmetry property F[k] = conj(F[N-k]), so just one half -of array is usually needed. But for convenience subroutine returns full -complex array (with frequencies above N/2), so its result may be used by -other FFT-related subroutines. - - - -- ALGLIB -- - Copyright 01.06.2009 by Bochkanov Sergey -*************************************************************************/ -void fftr1d(const real_1d_array &a, const ae_int_t n, complex_1d_array &f) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::fftr1d(const_cast(a.c_ptr()), n, const_cast(f.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -1-dimensional real FFT. - -Algorithm has O(N*logN) complexity for any N (composite or prime). - -INPUT PARAMETERS - A - array[0..N-1] - real function to be transformed - N - problem size - -OUTPUT PARAMETERS - F - DFT of a input array, array[0..N-1] - F[j] = SUM(A[k]*exp(-2*pi*sqrt(-1)*j*k/N), k = 0..N-1) - -NOTE: - F[] satisfies symmetry property F[k] = conj(F[N-k]), so just one half -of array is usually needed. But for convenience subroutine returns full -complex array (with frequencies above N/2), so its result may be used by -other FFT-related subroutines. - - - -- ALGLIB -- - Copyright 01.06.2009 by Bochkanov Sergey -*************************************************************************/ -void fftr1d(const real_1d_array &a, complex_1d_array &f) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = a.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::fftr1d(const_cast(a.c_ptr()), n, const_cast(f.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -1-dimensional real inverse FFT. - -Algorithm has O(N*logN) complexity for any N (composite or prime). - -INPUT PARAMETERS - F - array[0..floor(N/2)] - frequencies from forward real FFT - N - problem size - -OUTPUT PARAMETERS - A - inverse DFT of a input array, array[0..N-1] - -NOTE: - F[] should satisfy symmetry property F[k] = conj(F[N-k]), so just one -half of frequencies array is needed - elements from 0 to floor(N/2). F[0] -is ALWAYS real. If N is even F[floor(N/2)] is real too. If N is odd, then -F[floor(N/2)] has no special properties. - -Relying on properties noted above, FFTR1DInv subroutine uses only elements -from 0th to floor(N/2)-th. It ignores imaginary part of F[0], and in case -N is even it ignores imaginary part of F[floor(N/2)] too. - -When you call this function using full arguments list - "FFTR1DInv(F,N,A)" -- you can pass either either frequencies array with N elements or reduced -array with roughly N/2 elements - subroutine will successfully transform -both. - -If you call this function using reduced arguments list - "FFTR1DInv(F,A)" -- you must pass FULL array with N elements (although higher N/2 are still -not used) because array size is used to automatically determine FFT length - - - -- ALGLIB -- - Copyright 01.06.2009 by Bochkanov Sergey -*************************************************************************/ -void fftr1dinv(const complex_1d_array &f, const ae_int_t n, real_1d_array &a) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::fftr1dinv(const_cast(f.c_ptr()), n, const_cast(a.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -1-dimensional real inverse FFT. - -Algorithm has O(N*logN) complexity for any N (composite or prime). - -INPUT PARAMETERS - F - array[0..floor(N/2)] - frequencies from forward real FFT - N - problem size - -OUTPUT PARAMETERS - A - inverse DFT of a input array, array[0..N-1] - -NOTE: - F[] should satisfy symmetry property F[k] = conj(F[N-k]), so just one -half of frequencies array is needed - elements from 0 to floor(N/2). F[0] -is ALWAYS real. If N is even F[floor(N/2)] is real too. If N is odd, then -F[floor(N/2)] has no special properties. - -Relying on properties noted above, FFTR1DInv subroutine uses only elements -from 0th to floor(N/2)-th. It ignores imaginary part of F[0], and in case -N is even it ignores imaginary part of F[floor(N/2)] too. - -When you call this function using full arguments list - "FFTR1DInv(F,N,A)" -- you can pass either either frequencies array with N elements or reduced -array with roughly N/2 elements - subroutine will successfully transform -both. - -If you call this function using reduced arguments list - "FFTR1DInv(F,A)" -- you must pass FULL array with N elements (although higher N/2 are still -not used) because array size is used to automatically determine FFT length - - - -- ALGLIB -- - Copyright 01.06.2009 by Bochkanov Sergey -*************************************************************************/ -void fftr1dinv(const complex_1d_array &f, real_1d_array &a) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = f.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::fftr1dinv(const_cast(f.c_ptr()), n, const_cast(a.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -1-dimensional complex convolution. - -For given A/B returns conv(A,B) (non-circular). Subroutine can automatically -choose between three implementations: straightforward O(M*N) formula for -very small N (or M), overlap-add algorithm for cases where max(M,N) is -significantly larger than min(M,N), but O(M*N) algorithm is too slow, and -general FFT-based formula for cases where two previois algorithms are too -slow. - -Algorithm has max(M,N)*log(max(M,N)) complexity for any M/N. - -INPUT PARAMETERS - A - array[0..M-1] - complex function to be transformed - M - problem size - B - array[0..N-1] - complex function to be transformed - N - problem size - -OUTPUT PARAMETERS - R - convolution: A*B. array[0..N+M-2]. - -NOTE: - It is assumed that A is zero at T<0, B is zero too. If one or both -functions have non-zero values at negative T's, you can still use this -subroutine - just shift its result correspondingly. - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void convc1d(const complex_1d_array &a, const ae_int_t m, const complex_1d_array &b, const ae_int_t n, complex_1d_array &r) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::convc1d(const_cast(a.c_ptr()), m, const_cast(b.c_ptr()), n, const_cast(r.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -1-dimensional complex non-circular deconvolution (inverse of ConvC1D()). - -Algorithm has M*log(M)) complexity for any M (composite or prime). - -INPUT PARAMETERS - A - array[0..M-1] - convolved signal, A = conv(R, B) - M - convolved signal length - B - array[0..N-1] - response - N - response length, N<=M - -OUTPUT PARAMETERS - R - deconvolved signal. array[0..M-N]. - -NOTE: - deconvolution is unstable process and may result in division by zero -(if your response function is degenerate, i.e. has zero Fourier coefficient). - -NOTE: - It is assumed that A is zero at T<0, B is zero too. If one or both -functions have non-zero values at negative T's, you can still use this -subroutine - just shift its result correspondingly. - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void convc1dinv(const complex_1d_array &a, const ae_int_t m, const complex_1d_array &b, const ae_int_t n, complex_1d_array &r) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::convc1dinv(const_cast(a.c_ptr()), m, const_cast(b.c_ptr()), n, const_cast(r.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -1-dimensional circular complex convolution. - -For given S/R returns conv(S,R) (circular). Algorithm has linearithmic -complexity for any M/N. - -IMPORTANT: normal convolution is commutative, i.e. it is symmetric - -conv(A,B)=conv(B,A). Cyclic convolution IS NOT. One function - S - is a -signal, periodic function, and another - R - is a response, non-periodic -function with limited length. - -INPUT PARAMETERS - S - array[0..M-1] - complex periodic signal - M - problem size - B - array[0..N-1] - complex non-periodic response - N - problem size - -OUTPUT PARAMETERS - R - convolution: A*B. array[0..M-1]. - -NOTE: - It is assumed that B is zero at T<0. If it has non-zero values at -negative T's, you can still use this subroutine - just shift its result -correspondingly. - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void convc1dcircular(const complex_1d_array &s, const ae_int_t m, const complex_1d_array &r, const ae_int_t n, complex_1d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::convc1dcircular(const_cast(s.c_ptr()), m, const_cast(r.c_ptr()), n, const_cast(c.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -1-dimensional circular complex deconvolution (inverse of ConvC1DCircular()). - -Algorithm has M*log(M)) complexity for any M (composite or prime). - -INPUT PARAMETERS - A - array[0..M-1] - convolved periodic signal, A = conv(R, B) - M - convolved signal length - B - array[0..N-1] - non-periodic response - N - response length - -OUTPUT PARAMETERS - R - deconvolved signal. array[0..M-1]. - -NOTE: - deconvolution is unstable process and may result in division by zero -(if your response function is degenerate, i.e. has zero Fourier coefficient). - -NOTE: - It is assumed that B is zero at T<0. If it has non-zero values at -negative T's, you can still use this subroutine - just shift its result -correspondingly. - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void convc1dcircularinv(const complex_1d_array &a, const ae_int_t m, const complex_1d_array &b, const ae_int_t n, complex_1d_array &r) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::convc1dcircularinv(const_cast(a.c_ptr()), m, const_cast(b.c_ptr()), n, const_cast(r.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -1-dimensional real convolution. - -Analogous to ConvC1D(), see ConvC1D() comments for more details. - -INPUT PARAMETERS - A - array[0..M-1] - real function to be transformed - M - problem size - B - array[0..N-1] - real function to be transformed - N - problem size - -OUTPUT PARAMETERS - R - convolution: A*B. array[0..N+M-2]. - -NOTE: - It is assumed that A is zero at T<0, B is zero too. If one or both -functions have non-zero values at negative T's, you can still use this -subroutine - just shift its result correspondingly. - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void convr1d(const real_1d_array &a, const ae_int_t m, const real_1d_array &b, const ae_int_t n, real_1d_array &r) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::convr1d(const_cast(a.c_ptr()), m, const_cast(b.c_ptr()), n, const_cast(r.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -1-dimensional real deconvolution (inverse of ConvC1D()). - -Algorithm has M*log(M)) complexity for any M (composite or prime). - -INPUT PARAMETERS - A - array[0..M-1] - convolved signal, A = conv(R, B) - M - convolved signal length - B - array[0..N-1] - response - N - response length, N<=M - -OUTPUT PARAMETERS - R - deconvolved signal. array[0..M-N]. - -NOTE: - deconvolution is unstable process and may result in division by zero -(if your response function is degenerate, i.e. has zero Fourier coefficient). - -NOTE: - It is assumed that A is zero at T<0, B is zero too. If one or both -functions have non-zero values at negative T's, you can still use this -subroutine - just shift its result correspondingly. - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void convr1dinv(const real_1d_array &a, const ae_int_t m, const real_1d_array &b, const ae_int_t n, real_1d_array &r) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::convr1dinv(const_cast(a.c_ptr()), m, const_cast(b.c_ptr()), n, const_cast(r.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -1-dimensional circular real convolution. - -Analogous to ConvC1DCircular(), see ConvC1DCircular() comments for more details. - -INPUT PARAMETERS - S - array[0..M-1] - real signal - M - problem size - B - array[0..N-1] - real response - N - problem size - -OUTPUT PARAMETERS - R - convolution: A*B. array[0..M-1]. - -NOTE: - It is assumed that B is zero at T<0. If it has non-zero values at -negative T's, you can still use this subroutine - just shift its result -correspondingly. - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void convr1dcircular(const real_1d_array &s, const ae_int_t m, const real_1d_array &r, const ae_int_t n, real_1d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::convr1dcircular(const_cast(s.c_ptr()), m, const_cast(r.c_ptr()), n, const_cast(c.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -1-dimensional complex deconvolution (inverse of ConvC1D()). - -Algorithm has M*log(M)) complexity for any M (composite or prime). - -INPUT PARAMETERS - A - array[0..M-1] - convolved signal, A = conv(R, B) - M - convolved signal length - B - array[0..N-1] - response - N - response length - -OUTPUT PARAMETERS - R - deconvolved signal. array[0..M-N]. - -NOTE: - deconvolution is unstable process and may result in division by zero -(if your response function is degenerate, i.e. has zero Fourier coefficient). - -NOTE: - It is assumed that B is zero at T<0. If it has non-zero values at -negative T's, you can still use this subroutine - just shift its result -correspondingly. - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void convr1dcircularinv(const real_1d_array &a, const ae_int_t m, const real_1d_array &b, const ae_int_t n, real_1d_array &r) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::convr1dcircularinv(const_cast(a.c_ptr()), m, const_cast(b.c_ptr()), n, const_cast(r.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -1-dimensional complex cross-correlation. - -For given Pattern/Signal returns corr(Pattern,Signal) (non-circular). - -Correlation is calculated using reduction to convolution. Algorithm with -max(N,N)*log(max(N,N)) complexity is used (see ConvC1D() for more info -about performance). - -IMPORTANT: - for historical reasons subroutine accepts its parameters in reversed - order: CorrC1D(Signal, Pattern) = Pattern x Signal (using traditional - definition of cross-correlation, denoting cross-correlation as "x"). - -INPUT PARAMETERS - Signal - array[0..N-1] - complex function to be transformed, - signal containing pattern - N - problem size - Pattern - array[0..M-1] - complex function to be transformed, - pattern to search within signal - M - problem size - -OUTPUT PARAMETERS - R - cross-correlation, array[0..N+M-2]: - * positive lags are stored in R[0..N-1], - R[i] = sum(conj(pattern[j])*signal[i+j] - * negative lags are stored in R[N..N+M-2], - R[N+M-1-i] = sum(conj(pattern[j])*signal[-i+j] - -NOTE: - It is assumed that pattern domain is [0..M-1]. If Pattern is non-zero -on [-K..M-1], you can still use this subroutine, just shift result by K. - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void corrc1d(const complex_1d_array &signal, const ae_int_t n, const complex_1d_array &pattern, const ae_int_t m, complex_1d_array &r) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::corrc1d(const_cast(signal.c_ptr()), n, const_cast(pattern.c_ptr()), m, const_cast(r.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -1-dimensional circular complex cross-correlation. - -For given Pattern/Signal returns corr(Pattern,Signal) (circular). -Algorithm has linearithmic complexity for any M/N. - -IMPORTANT: - for historical reasons subroutine accepts its parameters in reversed - order: CorrC1DCircular(Signal, Pattern) = Pattern x Signal (using - traditional definition of cross-correlation, denoting cross-correlation - as "x"). - -INPUT PARAMETERS - Signal - array[0..N-1] - complex function to be transformed, - periodic signal containing pattern - N - problem size - Pattern - array[0..M-1] - complex function to be transformed, - non-periodic pattern to search within signal - M - problem size - -OUTPUT PARAMETERS - R - convolution: A*B. array[0..M-1]. - - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void corrc1dcircular(const complex_1d_array &signal, const ae_int_t m, const complex_1d_array &pattern, const ae_int_t n, complex_1d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::corrc1dcircular(const_cast(signal.c_ptr()), m, const_cast(pattern.c_ptr()), n, const_cast(c.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -1-dimensional real cross-correlation. - -For given Pattern/Signal returns corr(Pattern,Signal) (non-circular). - -Correlation is calculated using reduction to convolution. Algorithm with -max(N,N)*log(max(N,N)) complexity is used (see ConvC1D() for more info -about performance). - -IMPORTANT: - for historical reasons subroutine accepts its parameters in reversed - order: CorrR1D(Signal, Pattern) = Pattern x Signal (using traditional - definition of cross-correlation, denoting cross-correlation as "x"). - -INPUT PARAMETERS - Signal - array[0..N-1] - real function to be transformed, - signal containing pattern - N - problem size - Pattern - array[0..M-1] - real function to be transformed, - pattern to search within signal - M - problem size - -OUTPUT PARAMETERS - R - cross-correlation, array[0..N+M-2]: - * positive lags are stored in R[0..N-1], - R[i] = sum(pattern[j]*signal[i+j] - * negative lags are stored in R[N..N+M-2], - R[N+M-1-i] = sum(pattern[j]*signal[-i+j] - -NOTE: - It is assumed that pattern domain is [0..M-1]. If Pattern is non-zero -on [-K..M-1], you can still use this subroutine, just shift result by K. - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void corrr1d(const real_1d_array &signal, const ae_int_t n, const real_1d_array &pattern, const ae_int_t m, real_1d_array &r) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::corrr1d(const_cast(signal.c_ptr()), n, const_cast(pattern.c_ptr()), m, const_cast(r.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -1-dimensional circular real cross-correlation. - -For given Pattern/Signal returns corr(Pattern,Signal) (circular). -Algorithm has linearithmic complexity for any M/N. - -IMPORTANT: - for historical reasons subroutine accepts its parameters in reversed - order: CorrR1DCircular(Signal, Pattern) = Pattern x Signal (using - traditional definition of cross-correlation, denoting cross-correlation - as "x"). - -INPUT PARAMETERS - Signal - array[0..N-1] - real function to be transformed, - periodic signal containing pattern - N - problem size - Pattern - array[0..M-1] - real function to be transformed, - non-periodic pattern to search within signal - M - problem size - -OUTPUT PARAMETERS - R - convolution: A*B. array[0..M-1]. - - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void corrr1dcircular(const real_1d_array &signal, const ae_int_t m, const real_1d_array &pattern, const ae_int_t n, real_1d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::corrr1dcircular(const_cast(signal.c_ptr()), m, const_cast(pattern.c_ptr()), n, const_cast(c.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -1-dimensional Fast Hartley Transform. - -Algorithm has O(N*logN) complexity for any N (composite or prime). - -INPUT PARAMETERS - A - array[0..N-1] - real function to be transformed - N - problem size - -OUTPUT PARAMETERS - A - FHT of a input array, array[0..N-1], - A_out[k] = sum(A_in[j]*(cos(2*pi*j*k/N)+sin(2*pi*j*k/N)), j=0..N-1) - - - -- ALGLIB -- - Copyright 04.06.2009 by Bochkanov Sergey -*************************************************************************/ -void fhtr1d(real_1d_array &a, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::fhtr1d(const_cast(a.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -1-dimensional inverse FHT. - -Algorithm has O(N*logN) complexity for any N (composite or prime). - -INPUT PARAMETERS - A - array[0..N-1] - complex array to be transformed - N - problem size - -OUTPUT PARAMETERS - A - inverse FHT of a input array, array[0..N-1] - - - -- ALGLIB -- - Copyright 29.05.2009 by Bochkanov Sergey -*************************************************************************/ -void fhtr1dinv(real_1d_array &a, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::fhtr1dinv(const_cast(a.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS IMPLEMENTATION OF COMPUTATIONAL CORE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ - - - - - - - - - - - -/************************************************************************* -1-dimensional complex FFT. - -Array size N may be arbitrary number (composite or prime). Composite N's -are handled with cache-oblivious variation of a Cooley-Tukey algorithm. -Small prime-factors are transformed using hard coded codelets (similar to -FFTW codelets, but without low-level optimization), large prime-factors -are handled with Bluestein's algorithm. - -Fastests transforms are for smooth N's (prime factors are 2, 3, 5 only), -most fast for powers of 2. When N have prime factors larger than these, -but orders of magnitude smaller than N, computations will be about 4 times -slower than for nearby highly composite N's. When N itself is prime, speed -will be 6 times lower. - -Algorithm has O(N*logN) complexity for any N (composite or prime). - -INPUT PARAMETERS - A - array[0..N-1] - complex function to be transformed - N - problem size - -OUTPUT PARAMETERS - A - DFT of a input array, array[0..N-1] - A_out[j] = SUM(A_in[k]*exp(-2*pi*sqrt(-1)*j*k/N), k = 0..N-1) - - - -- ALGLIB -- - Copyright 29.05.2009 by Bochkanov Sergey -*************************************************************************/ -void fftc1d(/* Complex */ ae_vector* a, ae_int_t n, ae_state *_state) -{ - ae_frame _frame_block; - fasttransformplan plan; - ae_int_t i; - ae_vector buf; - - ae_frame_make(_state, &_frame_block); - _fasttransformplan_init(&plan, _state, ae_true); - ae_vector_init(&buf, 0, DT_REAL, _state, ae_true); - - ae_assert(n>0, "FFTC1D: incorrect N!", _state); - ae_assert(a->cnt>=n, "FFTC1D: Length(A)ptr.p_complex[i].x; - buf.ptr.p_double[2*i+1] = a->ptr.p_complex[i].y; - } - - /* - * Generate plan and execute it. - * - * Plan is a combination of a successive factorizations of N and - * precomputed data. It is much like a FFTW plan, but is not stored - * between subroutine calls and is much simpler. - */ - ftcomplexfftplan(n, 1, &plan, _state); - ftapplyplan(&plan, &buf, 0, 1, _state); - - /* - * result - */ - for(i=0; i<=n-1; i++) - { - a->ptr.p_complex[i].x = buf.ptr.p_double[2*i+0]; - a->ptr.p_complex[i].y = buf.ptr.p_double[2*i+1]; - } - ae_frame_leave(_state); -} - - -/************************************************************************* -1-dimensional complex inverse FFT. - -Array size N may be arbitrary number (composite or prime). Algorithm has -O(N*logN) complexity for any N (composite or prime). - -See FFTC1D() description for more information about algorithm performance. - -INPUT PARAMETERS - A - array[0..N-1] - complex array to be transformed - N - problem size - -OUTPUT PARAMETERS - A - inverse DFT of a input array, array[0..N-1] - A_out[j] = SUM(A_in[k]/N*exp(+2*pi*sqrt(-1)*j*k/N), k = 0..N-1) - - - -- ALGLIB -- - Copyright 29.05.2009 by Bochkanov Sergey -*************************************************************************/ -void fftc1dinv(/* Complex */ ae_vector* a, ae_int_t n, ae_state *_state) -{ - ae_int_t i; - - - ae_assert(n>0, "FFTC1DInv: incorrect N!", _state); - ae_assert(a->cnt>=n, "FFTC1DInv: Length(A)ptr.p_complex[i].y = -a->ptr.p_complex[i].y; - } - fftc1d(a, n, _state); - for(i=0; i<=n-1; i++) - { - a->ptr.p_complex[i].x = a->ptr.p_complex[i].x/n; - a->ptr.p_complex[i].y = -a->ptr.p_complex[i].y/n; - } -} - - -/************************************************************************* -1-dimensional real FFT. - -Algorithm has O(N*logN) complexity for any N (composite or prime). - -INPUT PARAMETERS - A - array[0..N-1] - real function to be transformed - N - problem size - -OUTPUT PARAMETERS - F - DFT of a input array, array[0..N-1] - F[j] = SUM(A[k]*exp(-2*pi*sqrt(-1)*j*k/N), k = 0..N-1) - -NOTE: - F[] satisfies symmetry property F[k] = conj(F[N-k]), so just one half -of array is usually needed. But for convenience subroutine returns full -complex array (with frequencies above N/2), so its result may be used by -other FFT-related subroutines. - - - -- ALGLIB -- - Copyright 01.06.2009 by Bochkanov Sergey -*************************************************************************/ -void fftr1d(/* Real */ ae_vector* a, - ae_int_t n, - /* Complex */ ae_vector* f, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t n2; - ae_int_t idx; - ae_complex hn; - ae_complex hmnc; - ae_complex v; - ae_vector buf; - fasttransformplan plan; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(f); - ae_vector_init(&buf, 0, DT_REAL, _state, ae_true); - _fasttransformplan_init(&plan, _state, ae_true); - - ae_assert(n>0, "FFTR1D: incorrect N!", _state); - ae_assert(a->cnt>=n, "FFTR1D: Length(A)ptr.p_complex[0] = ae_complex_from_d(a->ptr.p_double[0]); - ae_frame_leave(_state); - return; - } - if( n==2 ) - { - ae_vector_set_length(f, 2, _state); - f->ptr.p_complex[0].x = a->ptr.p_double[0]+a->ptr.p_double[1]; - f->ptr.p_complex[0].y = 0; - f->ptr.p_complex[1].x = a->ptr.p_double[0]-a->ptr.p_double[1]; - f->ptr.p_complex[1].y = 0; - ae_frame_leave(_state); - return; - } - - /* - * Choose between odd-size and even-size FFTs - */ - if( n%2==0 ) - { - - /* - * even-size real FFT, use reduction to the complex task - */ - n2 = n/2; - ae_vector_set_length(&buf, n, _state); - ae_v_move(&buf.ptr.p_double[0], 1, &a->ptr.p_double[0], 1, ae_v_len(0,n-1)); - ftcomplexfftplan(n2, 1, &plan, _state); - ftapplyplan(&plan, &buf, 0, 1, _state); - ae_vector_set_length(f, n, _state); - for(i=0; i<=n2; i++) - { - idx = 2*(i%n2); - hn.x = buf.ptr.p_double[idx+0]; - hn.y = buf.ptr.p_double[idx+1]; - idx = 2*((n2-i)%n2); - hmnc.x = buf.ptr.p_double[idx+0]; - hmnc.y = -buf.ptr.p_double[idx+1]; - v.x = -ae_sin(-2*ae_pi*i/n, _state); - v.y = ae_cos(-2*ae_pi*i/n, _state); - f->ptr.p_complex[i] = ae_c_sub(ae_c_add(hn,hmnc),ae_c_mul(v,ae_c_sub(hn,hmnc))); - f->ptr.p_complex[i].x = 0.5*f->ptr.p_complex[i].x; - f->ptr.p_complex[i].y = 0.5*f->ptr.p_complex[i].y; - } - for(i=n2+1; i<=n-1; i++) - { - f->ptr.p_complex[i] = ae_c_conj(f->ptr.p_complex[n-i], _state); - } - } - else - { - - /* - * use complex FFT - */ - ae_vector_set_length(f, n, _state); - for(i=0; i<=n-1; i++) - { - f->ptr.p_complex[i] = ae_complex_from_d(a->ptr.p_double[i]); - } - fftc1d(f, n, _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -1-dimensional real inverse FFT. - -Algorithm has O(N*logN) complexity for any N (composite or prime). - -INPUT PARAMETERS - F - array[0..floor(N/2)] - frequencies from forward real FFT - N - problem size - -OUTPUT PARAMETERS - A - inverse DFT of a input array, array[0..N-1] - -NOTE: - F[] should satisfy symmetry property F[k] = conj(F[N-k]), so just one -half of frequencies array is needed - elements from 0 to floor(N/2). F[0] -is ALWAYS real. If N is even F[floor(N/2)] is real too. If N is odd, then -F[floor(N/2)] has no special properties. - -Relying on properties noted above, FFTR1DInv subroutine uses only elements -from 0th to floor(N/2)-th. It ignores imaginary part of F[0], and in case -N is even it ignores imaginary part of F[floor(N/2)] too. - -When you call this function using full arguments list - "FFTR1DInv(F,N,A)" -- you can pass either either frequencies array with N elements or reduced -array with roughly N/2 elements - subroutine will successfully transform -both. - -If you call this function using reduced arguments list - "FFTR1DInv(F,A)" -- you must pass FULL array with N elements (although higher N/2 are still -not used) because array size is used to automatically determine FFT length - - - -- ALGLIB -- - Copyright 01.06.2009 by Bochkanov Sergey -*************************************************************************/ -void fftr1dinv(/* Complex */ ae_vector* f, - ae_int_t n, - /* Real */ ae_vector* a, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_vector h; - ae_vector fh; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(a); - ae_vector_init(&h, 0, DT_REAL, _state, ae_true); - ae_vector_init(&fh, 0, DT_COMPLEX, _state, ae_true); - - ae_assert(n>0, "FFTR1DInv: incorrect N!", _state); - ae_assert(f->cnt>=ae_ifloor((double)n/(double)2, _state)+1, "FFTR1DInv: Length(F)ptr.p_complex[0].x, _state), "FFTR1DInv: F contains infinite or NAN values!", _state); - for(i=1; i<=ae_ifloor((double)n/(double)2, _state)-1; i++) - { - ae_assert(ae_isfinite(f->ptr.p_complex[i].x, _state)&&ae_isfinite(f->ptr.p_complex[i].y, _state), "FFTR1DInv: F contains infinite or NAN values!", _state); - } - ae_assert(ae_isfinite(f->ptr.p_complex[ae_ifloor((double)n/(double)2, _state)].x, _state), "FFTR1DInv: F contains infinite or NAN values!", _state); - if( n%2!=0 ) - { - ae_assert(ae_isfinite(f->ptr.p_complex[ae_ifloor((double)n/(double)2, _state)].y, _state), "FFTR1DInv: F contains infinite or NAN values!", _state); - } - - /* - * Special case: N=1, FFT is just identity transform. - * After this block we assume that N is strictly greater than 1. - */ - if( n==1 ) - { - ae_vector_set_length(a, 1, _state); - a->ptr.p_double[0] = f->ptr.p_complex[0].x; - ae_frame_leave(_state); - return; - } - - /* - * inverse real FFT is reduced to the inverse real FHT, - * which is reduced to the forward real FHT, - * which is reduced to the forward real FFT. - * - * Don't worry, it is really compact and efficient reduction :) - */ - ae_vector_set_length(&h, n, _state); - ae_vector_set_length(a, n, _state); - h.ptr.p_double[0] = f->ptr.p_complex[0].x; - for(i=1; i<=ae_ifloor((double)n/(double)2, _state)-1; i++) - { - h.ptr.p_double[i] = f->ptr.p_complex[i].x-f->ptr.p_complex[i].y; - h.ptr.p_double[n-i] = f->ptr.p_complex[i].x+f->ptr.p_complex[i].y; - } - if( n%2==0 ) - { - h.ptr.p_double[ae_ifloor((double)n/(double)2, _state)] = f->ptr.p_complex[ae_ifloor((double)n/(double)2, _state)].x; - } - else - { - h.ptr.p_double[ae_ifloor((double)n/(double)2, _state)] = f->ptr.p_complex[ae_ifloor((double)n/(double)2, _state)].x-f->ptr.p_complex[ae_ifloor((double)n/(double)2, _state)].y; - h.ptr.p_double[ae_ifloor((double)n/(double)2, _state)+1] = f->ptr.p_complex[ae_ifloor((double)n/(double)2, _state)].x+f->ptr.p_complex[ae_ifloor((double)n/(double)2, _state)].y; - } - fftr1d(&h, n, &fh, _state); - for(i=0; i<=n-1; i++) - { - a->ptr.p_double[i] = (fh.ptr.p_complex[i].x-fh.ptr.p_complex[i].y)/n; - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Internal subroutine. Never call it directly! - - - -- ALGLIB -- - Copyright 01.06.2009 by Bochkanov Sergey -*************************************************************************/ -void fftr1dinternaleven(/* Real */ ae_vector* a, - ae_int_t n, - /* Real */ ae_vector* buf, - fasttransformplan* plan, - ae_state *_state) -{ - double x; - double y; - ae_int_t i; - ae_int_t n2; - ae_int_t idx; - ae_complex hn; - ae_complex hmnc; - ae_complex v; - - - ae_assert(n>0&&n%2==0, "FFTR1DEvenInplace: incorrect N!", _state); - - /* - * Special cases: - * * N=2 - * - * After this block we assume that N is strictly greater than 2 - */ - if( n==2 ) - { - x = a->ptr.p_double[0]+a->ptr.p_double[1]; - y = a->ptr.p_double[0]-a->ptr.p_double[1]; - a->ptr.p_double[0] = x; - a->ptr.p_double[1] = y; - return; - } - - /* - * even-size real FFT, use reduction to the complex task - */ - n2 = n/2; - ae_v_move(&buf->ptr.p_double[0], 1, &a->ptr.p_double[0], 1, ae_v_len(0,n-1)); - ftapplyplan(plan, buf, 0, 1, _state); - a->ptr.p_double[0] = buf->ptr.p_double[0]+buf->ptr.p_double[1]; - for(i=1; i<=n2-1; i++) - { - idx = 2*(i%n2); - hn.x = buf->ptr.p_double[idx+0]; - hn.y = buf->ptr.p_double[idx+1]; - idx = 2*(n2-i); - hmnc.x = buf->ptr.p_double[idx+0]; - hmnc.y = -buf->ptr.p_double[idx+1]; - v.x = -ae_sin(-2*ae_pi*i/n, _state); - v.y = ae_cos(-2*ae_pi*i/n, _state); - v = ae_c_sub(ae_c_add(hn,hmnc),ae_c_mul(v,ae_c_sub(hn,hmnc))); - a->ptr.p_double[2*i+0] = 0.5*v.x; - a->ptr.p_double[2*i+1] = 0.5*v.y; - } - a->ptr.p_double[1] = buf->ptr.p_double[0]-buf->ptr.p_double[1]; -} - - -/************************************************************************* -Internal subroutine. Never call it directly! - - - -- ALGLIB -- - Copyright 01.06.2009 by Bochkanov Sergey -*************************************************************************/ -void fftr1dinvinternaleven(/* Real */ ae_vector* a, - ae_int_t n, - /* Real */ ae_vector* buf, - fasttransformplan* plan, - ae_state *_state) -{ - double x; - double y; - double t; - ae_int_t i; - ae_int_t n2; - - - ae_assert(n>0&&n%2==0, "FFTR1DInvInternalEven: incorrect N!", _state); - - /* - * Special cases: - * * N=2 - * - * After this block we assume that N is strictly greater than 2 - */ - if( n==2 ) - { - x = 0.5*(a->ptr.p_double[0]+a->ptr.p_double[1]); - y = 0.5*(a->ptr.p_double[0]-a->ptr.p_double[1]); - a->ptr.p_double[0] = x; - a->ptr.p_double[1] = y; - return; - } - - /* - * inverse real FFT is reduced to the inverse real FHT, - * which is reduced to the forward real FHT, - * which is reduced to the forward real FFT. - * - * Don't worry, it is really compact and efficient reduction :) - */ - n2 = n/2; - buf->ptr.p_double[0] = a->ptr.p_double[0]; - for(i=1; i<=n2-1; i++) - { - x = a->ptr.p_double[2*i+0]; - y = a->ptr.p_double[2*i+1]; - buf->ptr.p_double[i] = x-y; - buf->ptr.p_double[n-i] = x+y; - } - buf->ptr.p_double[n2] = a->ptr.p_double[1]; - fftr1dinternaleven(buf, n, a, plan, _state); - a->ptr.p_double[0] = buf->ptr.p_double[0]/n; - t = (double)1/(double)n; - for(i=1; i<=n2-1; i++) - { - x = buf->ptr.p_double[2*i+0]; - y = buf->ptr.p_double[2*i+1]; - a->ptr.p_double[i] = t*(x-y); - a->ptr.p_double[n-i] = t*(x+y); - } - a->ptr.p_double[n2] = buf->ptr.p_double[1]/n; -} - - - - -/************************************************************************* -1-dimensional complex convolution. - -For given A/B returns conv(A,B) (non-circular). Subroutine can automatically -choose between three implementations: straightforward O(M*N) formula for -very small N (or M), overlap-add algorithm for cases where max(M,N) is -significantly larger than min(M,N), but O(M*N) algorithm is too slow, and -general FFT-based formula for cases where two previois algorithms are too -slow. - -Algorithm has max(M,N)*log(max(M,N)) complexity for any M/N. - -INPUT PARAMETERS - A - array[0..M-1] - complex function to be transformed - M - problem size - B - array[0..N-1] - complex function to be transformed - N - problem size - -OUTPUT PARAMETERS - R - convolution: A*B. array[0..N+M-2]. - -NOTE: - It is assumed that A is zero at T<0, B is zero too. If one or both -functions have non-zero values at negative T's, you can still use this -subroutine - just shift its result correspondingly. - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void convc1d(/* Complex */ ae_vector* a, - ae_int_t m, - /* Complex */ ae_vector* b, - ae_int_t n, - /* Complex */ ae_vector* r, - ae_state *_state) -{ - - ae_vector_clear(r); - - ae_assert(n>0&&m>0, "ConvC1D: incorrect N or M!", _state); - - /* - * normalize task: make M>=N, - * so A will be longer that B. - */ - if( m0&&m>0)&&n<=m, "ConvC1DInv: incorrect N or M!", _state); - p = ftbasefindsmooth(m, _state); - ftcomplexfftplan(p, 1, &plan, _state); - ae_vector_set_length(&buf, 2*p, _state); - for(i=0; i<=m-1; i++) - { - buf.ptr.p_double[2*i+0] = a->ptr.p_complex[i].x; - buf.ptr.p_double[2*i+1] = a->ptr.p_complex[i].y; - } - for(i=m; i<=p-1; i++) - { - buf.ptr.p_double[2*i+0] = 0; - buf.ptr.p_double[2*i+1] = 0; - } - ae_vector_set_length(&buf2, 2*p, _state); - for(i=0; i<=n-1; i++) - { - buf2.ptr.p_double[2*i+0] = b->ptr.p_complex[i].x; - buf2.ptr.p_double[2*i+1] = b->ptr.p_complex[i].y; - } - for(i=n; i<=p-1; i++) - { - buf2.ptr.p_double[2*i+0] = 0; - buf2.ptr.p_double[2*i+1] = 0; - } - ftapplyplan(&plan, &buf, 0, 1, _state); - ftapplyplan(&plan, &buf2, 0, 1, _state); - for(i=0; i<=p-1; i++) - { - c1.x = buf.ptr.p_double[2*i+0]; - c1.y = buf.ptr.p_double[2*i+1]; - c2.x = buf2.ptr.p_double[2*i+0]; - c2.y = buf2.ptr.p_double[2*i+1]; - c3 = ae_c_div(c1,c2); - buf.ptr.p_double[2*i+0] = c3.x; - buf.ptr.p_double[2*i+1] = -c3.y; - } - ftapplyplan(&plan, &buf, 0, 1, _state); - t = (double)1/(double)p; - ae_vector_set_length(r, m-n+1, _state); - for(i=0; i<=m-n; i++) - { - r->ptr.p_complex[i].x = t*buf.ptr.p_double[2*i+0]; - r->ptr.p_complex[i].y = -t*buf.ptr.p_double[2*i+1]; - } - ae_frame_leave(_state); -} - - -/************************************************************************* -1-dimensional circular complex convolution. - -For given S/R returns conv(S,R) (circular). Algorithm has linearithmic -complexity for any M/N. - -IMPORTANT: normal convolution is commutative, i.e. it is symmetric - -conv(A,B)=conv(B,A). Cyclic convolution IS NOT. One function - S - is a -signal, periodic function, and another - R - is a response, non-periodic -function with limited length. - -INPUT PARAMETERS - S - array[0..M-1] - complex periodic signal - M - problem size - B - array[0..N-1] - complex non-periodic response - N - problem size - -OUTPUT PARAMETERS - R - convolution: A*B. array[0..M-1]. - -NOTE: - It is assumed that B is zero at T<0. If it has non-zero values at -negative T's, you can still use this subroutine - just shift its result -correspondingly. - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void convc1dcircular(/* Complex */ ae_vector* s, - ae_int_t m, - /* Complex */ ae_vector* r, - ae_int_t n, - /* Complex */ ae_vector* c, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector buf; - ae_int_t i1; - ae_int_t i2; - ae_int_t j2; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(c); - ae_vector_init(&buf, 0, DT_COMPLEX, _state, ae_true); - - ae_assert(n>0&&m>0, "ConvC1DCircular: incorrect N or M!", _state); - - /* - * normalize task: make M>=N, - * so A will be longer (at least - not shorter) that B. - */ - if( mptr.p_complex[i1], 1, "N", ae_v_len(0,j2)); - i1 = i1+m; - } - convc1dcircular(s, m, &buf, m, c, _state); - ae_frame_leave(_state); - return; - } - convc1dx(s, m, r, n, ae_true, -1, 0, c, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -1-dimensional circular complex deconvolution (inverse of ConvC1DCircular()). - -Algorithm has M*log(M)) complexity for any M (composite or prime). - -INPUT PARAMETERS - A - array[0..M-1] - convolved periodic signal, A = conv(R, B) - M - convolved signal length - B - array[0..N-1] - non-periodic response - N - response length - -OUTPUT PARAMETERS - R - deconvolved signal. array[0..M-1]. - -NOTE: - deconvolution is unstable process and may result in division by zero -(if your response function is degenerate, i.e. has zero Fourier coefficient). - -NOTE: - It is assumed that B is zero at T<0. If it has non-zero values at -negative T's, you can still use this subroutine - just shift its result -correspondingly. - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void convc1dcircularinv(/* Complex */ ae_vector* a, - ae_int_t m, - /* Complex */ ae_vector* b, - ae_int_t n, - /* Complex */ ae_vector* r, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t i1; - ae_int_t i2; - ae_int_t j2; - ae_vector buf; - ae_vector buf2; - ae_vector cbuf; - fasttransformplan plan; - ae_complex c1; - ae_complex c2; - ae_complex c3; - double t; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(r); - ae_vector_init(&buf, 0, DT_REAL, _state, ae_true); - ae_vector_init(&buf2, 0, DT_REAL, _state, ae_true); - ae_vector_init(&cbuf, 0, DT_COMPLEX, _state, ae_true); - _fasttransformplan_init(&plan, _state, ae_true); - - ae_assert(n>0&&m>0, "ConvC1DCircularInv: incorrect N or M!", _state); - - /* - * normalize task: make M>=N, - * so A will be longer (at least - not shorter) that B. - */ - if( mptr.p_complex[i1], 1, "N", ae_v_len(0,j2)); - i1 = i1+m; - } - convc1dcircularinv(a, m, &cbuf, m, r, _state); - ae_frame_leave(_state); - return; - } - - /* - * Task is normalized - */ - ftcomplexfftplan(m, 1, &plan, _state); - ae_vector_set_length(&buf, 2*m, _state); - for(i=0; i<=m-1; i++) - { - buf.ptr.p_double[2*i+0] = a->ptr.p_complex[i].x; - buf.ptr.p_double[2*i+1] = a->ptr.p_complex[i].y; - } - ae_vector_set_length(&buf2, 2*m, _state); - for(i=0; i<=n-1; i++) - { - buf2.ptr.p_double[2*i+0] = b->ptr.p_complex[i].x; - buf2.ptr.p_double[2*i+1] = b->ptr.p_complex[i].y; - } - for(i=n; i<=m-1; i++) - { - buf2.ptr.p_double[2*i+0] = 0; - buf2.ptr.p_double[2*i+1] = 0; - } - ftapplyplan(&plan, &buf, 0, 1, _state); - ftapplyplan(&plan, &buf2, 0, 1, _state); - for(i=0; i<=m-1; i++) - { - c1.x = buf.ptr.p_double[2*i+0]; - c1.y = buf.ptr.p_double[2*i+1]; - c2.x = buf2.ptr.p_double[2*i+0]; - c2.y = buf2.ptr.p_double[2*i+1]; - c3 = ae_c_div(c1,c2); - buf.ptr.p_double[2*i+0] = c3.x; - buf.ptr.p_double[2*i+1] = -c3.y; - } - ftapplyplan(&plan, &buf, 0, 1, _state); - t = (double)1/(double)m; - ae_vector_set_length(r, m, _state); - for(i=0; i<=m-1; i++) - { - r->ptr.p_complex[i].x = t*buf.ptr.p_double[2*i+0]; - r->ptr.p_complex[i].y = -t*buf.ptr.p_double[2*i+1]; - } - ae_frame_leave(_state); -} - - -/************************************************************************* -1-dimensional real convolution. - -Analogous to ConvC1D(), see ConvC1D() comments for more details. - -INPUT PARAMETERS - A - array[0..M-1] - real function to be transformed - M - problem size - B - array[0..N-1] - real function to be transformed - N - problem size - -OUTPUT PARAMETERS - R - convolution: A*B. array[0..N+M-2]. - -NOTE: - It is assumed that A is zero at T<0, B is zero too. If one or both -functions have non-zero values at negative T's, you can still use this -subroutine - just shift its result correspondingly. - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void convr1d(/* Real */ ae_vector* a, - ae_int_t m, - /* Real */ ae_vector* b, - ae_int_t n, - /* Real */ ae_vector* r, - ae_state *_state) -{ - - ae_vector_clear(r); - - ae_assert(n>0&&m>0, "ConvR1D: incorrect N or M!", _state); - - /* - * normalize task: make M>=N, - * so A will be longer that B. - */ - if( m0&&m>0)&&n<=m, "ConvR1DInv: incorrect N or M!", _state); - p = ftbasefindsmootheven(m, _state); - ae_vector_set_length(&buf, p, _state); - ae_v_move(&buf.ptr.p_double[0], 1, &a->ptr.p_double[0], 1, ae_v_len(0,m-1)); - for(i=m; i<=p-1; i++) - { - buf.ptr.p_double[i] = 0; - } - ae_vector_set_length(&buf2, p, _state); - ae_v_move(&buf2.ptr.p_double[0], 1, &b->ptr.p_double[0], 1, ae_v_len(0,n-1)); - for(i=n; i<=p-1; i++) - { - buf2.ptr.p_double[i] = 0; - } - ae_vector_set_length(&buf3, p, _state); - ftcomplexfftplan(p/2, 1, &plan, _state); - fftr1dinternaleven(&buf, p, &buf3, &plan, _state); - fftr1dinternaleven(&buf2, p, &buf3, &plan, _state); - buf.ptr.p_double[0] = buf.ptr.p_double[0]/buf2.ptr.p_double[0]; - buf.ptr.p_double[1] = buf.ptr.p_double[1]/buf2.ptr.p_double[1]; - for(i=1; i<=p/2-1; i++) - { - c1.x = buf.ptr.p_double[2*i+0]; - c1.y = buf.ptr.p_double[2*i+1]; - c2.x = buf2.ptr.p_double[2*i+0]; - c2.y = buf2.ptr.p_double[2*i+1]; - c3 = ae_c_div(c1,c2); - buf.ptr.p_double[2*i+0] = c3.x; - buf.ptr.p_double[2*i+1] = c3.y; - } - fftr1dinvinternaleven(&buf, p, &buf3, &plan, _state); - ae_vector_set_length(r, m-n+1, _state); - ae_v_move(&r->ptr.p_double[0], 1, &buf.ptr.p_double[0], 1, ae_v_len(0,m-n)); - ae_frame_leave(_state); -} - - -/************************************************************************* -1-dimensional circular real convolution. - -Analogous to ConvC1DCircular(), see ConvC1DCircular() comments for more details. - -INPUT PARAMETERS - S - array[0..M-1] - real signal - M - problem size - B - array[0..N-1] - real response - N - problem size - -OUTPUT PARAMETERS - R - convolution: A*B. array[0..M-1]. - -NOTE: - It is assumed that B is zero at T<0. If it has non-zero values at -negative T's, you can still use this subroutine - just shift its result -correspondingly. - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void convr1dcircular(/* Real */ ae_vector* s, - ae_int_t m, - /* Real */ ae_vector* r, - ae_int_t n, - /* Real */ ae_vector* c, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector buf; - ae_int_t i1; - ae_int_t i2; - ae_int_t j2; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(c); - ae_vector_init(&buf, 0, DT_REAL, _state, ae_true); - - ae_assert(n>0&&m>0, "ConvC1DCircular: incorrect N or M!", _state); - - /* - * normalize task: make M>=N, - * so A will be longer (at least - not shorter) that B. - */ - if( mptr.p_double[i1], 1, ae_v_len(0,j2)); - i1 = i1+m; - } - convr1dcircular(s, m, &buf, m, c, _state); - ae_frame_leave(_state); - return; - } - - /* - * reduce to usual convolution - */ - convr1dx(s, m, r, n, ae_true, -1, 0, c, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -1-dimensional complex deconvolution (inverse of ConvC1D()). - -Algorithm has M*log(M)) complexity for any M (composite or prime). - -INPUT PARAMETERS - A - array[0..M-1] - convolved signal, A = conv(R, B) - M - convolved signal length - B - array[0..N-1] - response - N - response length - -OUTPUT PARAMETERS - R - deconvolved signal. array[0..M-N]. - -NOTE: - deconvolution is unstable process and may result in division by zero -(if your response function is degenerate, i.e. has zero Fourier coefficient). - -NOTE: - It is assumed that B is zero at T<0. If it has non-zero values at -negative T's, you can still use this subroutine - just shift its result -correspondingly. - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void convr1dcircularinv(/* Real */ ae_vector* a, - ae_int_t m, - /* Real */ ae_vector* b, - ae_int_t n, - /* Real */ ae_vector* r, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t i1; - ae_int_t i2; - ae_int_t j2; - ae_vector buf; - ae_vector buf2; - ae_vector buf3; - ae_vector cbuf; - ae_vector cbuf2; - fasttransformplan plan; - ae_complex c1; - ae_complex c2; - ae_complex c3; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(r); - ae_vector_init(&buf, 0, DT_REAL, _state, ae_true); - ae_vector_init(&buf2, 0, DT_REAL, _state, ae_true); - ae_vector_init(&buf3, 0, DT_REAL, _state, ae_true); - ae_vector_init(&cbuf, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&cbuf2, 0, DT_COMPLEX, _state, ae_true); - _fasttransformplan_init(&plan, _state, ae_true); - - ae_assert(n>0&&m>0, "ConvR1DCircularInv: incorrect N or M!", _state); - - /* - * normalize task: make M>=N, - * so A will be longer (at least - not shorter) that B. - */ - if( mptr.p_double[i1], 1, ae_v_len(0,j2)); - i1 = i1+m; - } - convr1dcircularinv(a, m, &buf, m, r, _state); - ae_frame_leave(_state); - return; - } - - /* - * Task is normalized - */ - if( m%2==0 ) - { - - /* - * size is even, use fast even-size FFT - */ - ae_vector_set_length(&buf, m, _state); - ae_v_move(&buf.ptr.p_double[0], 1, &a->ptr.p_double[0], 1, ae_v_len(0,m-1)); - ae_vector_set_length(&buf2, m, _state); - ae_v_move(&buf2.ptr.p_double[0], 1, &b->ptr.p_double[0], 1, ae_v_len(0,n-1)); - for(i=n; i<=m-1; i++) - { - buf2.ptr.p_double[i] = 0; - } - ae_vector_set_length(&buf3, m, _state); - ftcomplexfftplan(m/2, 1, &plan, _state); - fftr1dinternaleven(&buf, m, &buf3, &plan, _state); - fftr1dinternaleven(&buf2, m, &buf3, &plan, _state); - buf.ptr.p_double[0] = buf.ptr.p_double[0]/buf2.ptr.p_double[0]; - buf.ptr.p_double[1] = buf.ptr.p_double[1]/buf2.ptr.p_double[1]; - for(i=1; i<=m/2-1; i++) - { - c1.x = buf.ptr.p_double[2*i+0]; - c1.y = buf.ptr.p_double[2*i+1]; - c2.x = buf2.ptr.p_double[2*i+0]; - c2.y = buf2.ptr.p_double[2*i+1]; - c3 = ae_c_div(c1,c2); - buf.ptr.p_double[2*i+0] = c3.x; - buf.ptr.p_double[2*i+1] = c3.y; - } - fftr1dinvinternaleven(&buf, m, &buf3, &plan, _state); - ae_vector_set_length(r, m, _state); - ae_v_move(&r->ptr.p_double[0], 1, &buf.ptr.p_double[0], 1, ae_v_len(0,m-1)); - } - else - { - - /* - * odd-size, use general real FFT - */ - fftr1d(a, m, &cbuf, _state); - ae_vector_set_length(&buf2, m, _state); - ae_v_move(&buf2.ptr.p_double[0], 1, &b->ptr.p_double[0], 1, ae_v_len(0,n-1)); - for(i=n; i<=m-1; i++) - { - buf2.ptr.p_double[i] = 0; - } - fftr1d(&buf2, m, &cbuf2, _state); - for(i=0; i<=ae_ifloor((double)m/(double)2, _state); i++) - { - cbuf.ptr.p_complex[i] = ae_c_div(cbuf.ptr.p_complex[i],cbuf2.ptr.p_complex[i]); - } - fftr1dinv(&cbuf, m, r, _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -1-dimensional complex convolution. - -Extended subroutine which allows to choose convolution algorithm. -Intended for internal use, ALGLIB users should call ConvC1D()/ConvC1DCircular(). - -INPUT PARAMETERS - A - array[0..M-1] - complex function to be transformed - M - problem size - B - array[0..N-1] - complex function to be transformed - N - problem size, N<=M - Alg - algorithm type: - *-2 auto-select Q for overlap-add - *-1 auto-select algorithm and parameters - * 0 straightforward formula for small N's - * 1 general FFT-based code - * 2 overlap-add with length Q - Q - length for overlap-add - -OUTPUT PARAMETERS - R - convolution: A*B. array[0..N+M-1]. - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void convc1dx(/* Complex */ ae_vector* a, - ae_int_t m, - /* Complex */ ae_vector* b, - ae_int_t n, - ae_bool circular, - ae_int_t alg, - ae_int_t q, - /* Complex */ ae_vector* r, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - ae_int_t p; - ae_int_t ptotal; - ae_int_t i1; - ae_int_t i2; - ae_int_t j1; - ae_int_t j2; - ae_vector bbuf; - ae_complex v; - double ax; - double ay; - double bx; - double by; - double t; - double tx; - double ty; - double flopcand; - double flopbest; - ae_int_t algbest; - fasttransformplan plan; - ae_vector buf; - ae_vector buf2; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(r); - ae_vector_init(&bbuf, 0, DT_COMPLEX, _state, ae_true); - _fasttransformplan_init(&plan, _state, ae_true); - ae_vector_init(&buf, 0, DT_REAL, _state, ae_true); - ae_vector_init(&buf2, 0, DT_REAL, _state, ae_true); - - ae_assert(n>0&&m>0, "ConvC1DX: incorrect N or M!", _state); - ae_assert(n<=m, "ConvC1DX: Nptr.p_complex[0]; - ae_v_cmovec(&r->ptr.p_complex[0], 1, &a->ptr.p_complex[0], 1, "N", ae_v_len(0,m-1), v); - ae_frame_leave(_state); - return; - } - - /* - * use straightforward formula - */ - if( circular ) - { - - /* - * circular convolution - */ - ae_vector_set_length(r, m, _state); - v = b->ptr.p_complex[0]; - ae_v_cmovec(&r->ptr.p_complex[0], 1, &a->ptr.p_complex[0], 1, "N", ae_v_len(0,m-1), v); - for(i=1; i<=n-1; i++) - { - v = b->ptr.p_complex[i]; - i1 = 0; - i2 = i-1; - j1 = m-i; - j2 = m-1; - ae_v_caddc(&r->ptr.p_complex[i1], 1, &a->ptr.p_complex[j1], 1, "N", ae_v_len(i1,i2), v); - i1 = i; - i2 = m-1; - j1 = 0; - j2 = m-i-1; - ae_v_caddc(&r->ptr.p_complex[i1], 1, &a->ptr.p_complex[j1], 1, "N", ae_v_len(i1,i2), v); - } - } - else - { - - /* - * non-circular convolution - */ - ae_vector_set_length(r, m+n-1, _state); - for(i=0; i<=m+n-2; i++) - { - r->ptr.p_complex[i] = ae_complex_from_d(0); - } - for(i=0; i<=n-1; i++) - { - v = b->ptr.p_complex[i]; - ae_v_caddc(&r->ptr.p_complex[i], 1, &a->ptr.p_complex[0], 1, "N", ae_v_len(i,i+m-1), v); - } - } - ae_frame_leave(_state); - return; - } - - /* - * general FFT-based code for - * circular and non-circular convolutions. - * - * First, if convolution is circular, we test whether M is smooth or not. - * If it is smooth, we just use M-length FFT to calculate convolution. - * If it is not, we calculate non-circular convolution and wrap it arount. - * - * IF convolution is non-circular, we use zero-padding + FFT. - */ - if( alg==1 ) - { - if( circular&&ftbaseissmooth(m, _state) ) - { - - /* - * special code for circular convolution with smooth M - */ - ftcomplexfftplan(m, 1, &plan, _state); - ae_vector_set_length(&buf, 2*m, _state); - for(i=0; i<=m-1; i++) - { - buf.ptr.p_double[2*i+0] = a->ptr.p_complex[i].x; - buf.ptr.p_double[2*i+1] = a->ptr.p_complex[i].y; - } - ae_vector_set_length(&buf2, 2*m, _state); - for(i=0; i<=n-1; i++) - { - buf2.ptr.p_double[2*i+0] = b->ptr.p_complex[i].x; - buf2.ptr.p_double[2*i+1] = b->ptr.p_complex[i].y; - } - for(i=n; i<=m-1; i++) - { - buf2.ptr.p_double[2*i+0] = 0; - buf2.ptr.p_double[2*i+1] = 0; - } - ftapplyplan(&plan, &buf, 0, 1, _state); - ftapplyplan(&plan, &buf2, 0, 1, _state); - for(i=0; i<=m-1; i++) - { - ax = buf.ptr.p_double[2*i+0]; - ay = buf.ptr.p_double[2*i+1]; - bx = buf2.ptr.p_double[2*i+0]; - by = buf2.ptr.p_double[2*i+1]; - tx = ax*bx-ay*by; - ty = ax*by+ay*bx; - buf.ptr.p_double[2*i+0] = tx; - buf.ptr.p_double[2*i+1] = -ty; - } - ftapplyplan(&plan, &buf, 0, 1, _state); - t = (double)1/(double)m; - ae_vector_set_length(r, m, _state); - for(i=0; i<=m-1; i++) - { - r->ptr.p_complex[i].x = t*buf.ptr.p_double[2*i+0]; - r->ptr.p_complex[i].y = -t*buf.ptr.p_double[2*i+1]; - } - } - else - { - - /* - * M is non-smooth, general code (circular/non-circular): - * * first part is the same for circular and non-circular - * convolutions. zero padding, FFTs, inverse FFTs - * * second part differs: - * * for non-circular convolution we just copy array - * * for circular convolution we add array tail to its head - */ - p = ftbasefindsmooth(m+n-1, _state); - ftcomplexfftplan(p, 1, &plan, _state); - ae_vector_set_length(&buf, 2*p, _state); - for(i=0; i<=m-1; i++) - { - buf.ptr.p_double[2*i+0] = a->ptr.p_complex[i].x; - buf.ptr.p_double[2*i+1] = a->ptr.p_complex[i].y; - } - for(i=m; i<=p-1; i++) - { - buf.ptr.p_double[2*i+0] = 0; - buf.ptr.p_double[2*i+1] = 0; - } - ae_vector_set_length(&buf2, 2*p, _state); - for(i=0; i<=n-1; i++) - { - buf2.ptr.p_double[2*i+0] = b->ptr.p_complex[i].x; - buf2.ptr.p_double[2*i+1] = b->ptr.p_complex[i].y; - } - for(i=n; i<=p-1; i++) - { - buf2.ptr.p_double[2*i+0] = 0; - buf2.ptr.p_double[2*i+1] = 0; - } - ftapplyplan(&plan, &buf, 0, 1, _state); - ftapplyplan(&plan, &buf2, 0, 1, _state); - for(i=0; i<=p-1; i++) - { - ax = buf.ptr.p_double[2*i+0]; - ay = buf.ptr.p_double[2*i+1]; - bx = buf2.ptr.p_double[2*i+0]; - by = buf2.ptr.p_double[2*i+1]; - tx = ax*bx-ay*by; - ty = ax*by+ay*bx; - buf.ptr.p_double[2*i+0] = tx; - buf.ptr.p_double[2*i+1] = -ty; - } - ftapplyplan(&plan, &buf, 0, 1, _state); - t = (double)1/(double)p; - if( circular ) - { - - /* - * circular, add tail to head - */ - ae_vector_set_length(r, m, _state); - for(i=0; i<=m-1; i++) - { - r->ptr.p_complex[i].x = t*buf.ptr.p_double[2*i+0]; - r->ptr.p_complex[i].y = -t*buf.ptr.p_double[2*i+1]; - } - for(i=m; i<=m+n-2; i++) - { - r->ptr.p_complex[i-m].x = r->ptr.p_complex[i-m].x+t*buf.ptr.p_double[2*i+0]; - r->ptr.p_complex[i-m].y = r->ptr.p_complex[i-m].y-t*buf.ptr.p_double[2*i+1]; - } - } - else - { - - /* - * non-circular, just copy - */ - ae_vector_set_length(r, m+n-1, _state); - for(i=0; i<=m+n-2; i++) - { - r->ptr.p_complex[i].x = t*buf.ptr.p_double[2*i+0]; - r->ptr.p_complex[i].y = -t*buf.ptr.p_double[2*i+1]; - } - } - } - ae_frame_leave(_state); - return; - } - - /* - * overlap-add method for - * circular and non-circular convolutions. - * - * First part of code (separate FFTs of input blocks) is the same - * for all types of convolution. Second part (overlapping outputs) - * differs for different types of convolution. We just copy output - * when convolution is non-circular. We wrap it around, if it is - * circular. - */ - if( alg==2 ) - { - ae_vector_set_length(&buf, 2*(q+n-1), _state); - - /* - * prepare R - */ - if( circular ) - { - ae_vector_set_length(r, m, _state); - for(i=0; i<=m-1; i++) - { - r->ptr.p_complex[i] = ae_complex_from_d(0); - } - } - else - { - ae_vector_set_length(r, m+n-1, _state); - for(i=0; i<=m+n-2; i++) - { - r->ptr.p_complex[i] = ae_complex_from_d(0); - } - } - - /* - * pre-calculated FFT(B) - */ - ae_vector_set_length(&bbuf, q+n-1, _state); - ae_v_cmove(&bbuf.ptr.p_complex[0], 1, &b->ptr.p_complex[0], 1, "N", ae_v_len(0,n-1)); - for(j=n; j<=q+n-2; j++) - { - bbuf.ptr.p_complex[j] = ae_complex_from_d(0); - } - fftc1d(&bbuf, q+n-1, _state); - - /* - * prepare FFT plan for chunks of A - */ - ftcomplexfftplan(q+n-1, 1, &plan, _state); - - /* - * main overlap-add cycle - */ - i = 0; - while(i<=m-1) - { - p = ae_minint(q, m-i, _state); - for(j=0; j<=p-1; j++) - { - buf.ptr.p_double[2*j+0] = a->ptr.p_complex[i+j].x; - buf.ptr.p_double[2*j+1] = a->ptr.p_complex[i+j].y; - } - for(j=p; j<=q+n-2; j++) - { - buf.ptr.p_double[2*j+0] = 0; - buf.ptr.p_double[2*j+1] = 0; - } - ftapplyplan(&plan, &buf, 0, 1, _state); - for(j=0; j<=q+n-2; j++) - { - ax = buf.ptr.p_double[2*j+0]; - ay = buf.ptr.p_double[2*j+1]; - bx = bbuf.ptr.p_complex[j].x; - by = bbuf.ptr.p_complex[j].y; - tx = ax*bx-ay*by; - ty = ax*by+ay*bx; - buf.ptr.p_double[2*j+0] = tx; - buf.ptr.p_double[2*j+1] = -ty; - } - ftapplyplan(&plan, &buf, 0, 1, _state); - t = (double)1/(double)(q+n-1); - if( circular ) - { - j1 = ae_minint(i+p+n-2, m-1, _state)-i; - j2 = j1+1; - } - else - { - j1 = p+n-2; - j2 = j1+1; - } - for(j=0; j<=j1; j++) - { - r->ptr.p_complex[i+j].x = r->ptr.p_complex[i+j].x+buf.ptr.p_double[2*j+0]*t; - r->ptr.p_complex[i+j].y = r->ptr.p_complex[i+j].y-buf.ptr.p_double[2*j+1]*t; - } - for(j=j2; j<=p+n-2; j++) - { - r->ptr.p_complex[j-j2].x = r->ptr.p_complex[j-j2].x+buf.ptr.p_double[2*j+0]*t; - r->ptr.p_complex[j-j2].y = r->ptr.p_complex[j-j2].y-buf.ptr.p_double[2*j+1]*t; - } - i = i+p; - } - ae_frame_leave(_state); - return; - } - ae_frame_leave(_state); -} - - -/************************************************************************* -1-dimensional real convolution. - -Extended subroutine which allows to choose convolution algorithm. -Intended for internal use, ALGLIB users should call ConvR1D(). - -INPUT PARAMETERS - A - array[0..M-1] - complex function to be transformed - M - problem size - B - array[0..N-1] - complex function to be transformed - N - problem size, N<=M - Alg - algorithm type: - *-2 auto-select Q for overlap-add - *-1 auto-select algorithm and parameters - * 0 straightforward formula for small N's - * 1 general FFT-based code - * 2 overlap-add with length Q - Q - length for overlap-add - -OUTPUT PARAMETERS - R - convolution: A*B. array[0..N+M-1]. - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void convr1dx(/* Real */ ae_vector* a, - ae_int_t m, - /* Real */ ae_vector* b, - ae_int_t n, - ae_bool circular, - ae_int_t alg, - ae_int_t q, - /* Real */ ae_vector* r, - ae_state *_state) -{ - ae_frame _frame_block; - double v; - ae_int_t i; - ae_int_t j; - ae_int_t p; - ae_int_t ptotal; - ae_int_t i1; - ae_int_t i2; - ae_int_t j1; - ae_int_t j2; - double ax; - double ay; - double bx; - double by; - double tx; - double ty; - double flopcand; - double flopbest; - ae_int_t algbest; - fasttransformplan plan; - ae_vector buf; - ae_vector buf2; - ae_vector buf3; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(r); - _fasttransformplan_init(&plan, _state, ae_true); - ae_vector_init(&buf, 0, DT_REAL, _state, ae_true); - ae_vector_init(&buf2, 0, DT_REAL, _state, ae_true); - ae_vector_init(&buf3, 0, DT_REAL, _state, ae_true); - - ae_assert(n>0&&m>0, "ConvC1DX: incorrect N or M!", _state); - ae_assert(n<=m, "ConvC1DX: Nptr.p_double[0]; - ae_v_moved(&r->ptr.p_double[0], 1, &a->ptr.p_double[0], 1, ae_v_len(0,m-1), v); - ae_frame_leave(_state); - return; - } - - /* - * use straightforward formula - */ - if( circular ) - { - - /* - * circular convolution - */ - ae_vector_set_length(r, m, _state); - v = b->ptr.p_double[0]; - ae_v_moved(&r->ptr.p_double[0], 1, &a->ptr.p_double[0], 1, ae_v_len(0,m-1), v); - for(i=1; i<=n-1; i++) - { - v = b->ptr.p_double[i]; - i1 = 0; - i2 = i-1; - j1 = m-i; - j2 = m-1; - ae_v_addd(&r->ptr.p_double[i1], 1, &a->ptr.p_double[j1], 1, ae_v_len(i1,i2), v); - i1 = i; - i2 = m-1; - j1 = 0; - j2 = m-i-1; - ae_v_addd(&r->ptr.p_double[i1], 1, &a->ptr.p_double[j1], 1, ae_v_len(i1,i2), v); - } - } - else - { - - /* - * non-circular convolution - */ - ae_vector_set_length(r, m+n-1, _state); - for(i=0; i<=m+n-2; i++) - { - r->ptr.p_double[i] = 0; - } - for(i=0; i<=n-1; i++) - { - v = b->ptr.p_double[i]; - ae_v_addd(&r->ptr.p_double[i], 1, &a->ptr.p_double[0], 1, ae_v_len(i,i+m-1), v); - } - } - ae_frame_leave(_state); - return; - } - - /* - * general FFT-based code for - * circular and non-circular convolutions. - * - * First, if convolution is circular, we test whether M is smooth or not. - * If it is smooth, we just use M-length FFT to calculate convolution. - * If it is not, we calculate non-circular convolution and wrap it arount. - * - * If convolution is non-circular, we use zero-padding + FFT. - * - * We assume that M+N-1>2 - we should call small case code otherwise - */ - if( alg==1 ) - { - ae_assert(m+n-1>2, "ConvR1DX: internal error!", _state); - if( (circular&&ftbaseissmooth(m, _state))&&m%2==0 ) - { - - /* - * special code for circular convolution with smooth even M - */ - ae_vector_set_length(&buf, m, _state); - ae_v_move(&buf.ptr.p_double[0], 1, &a->ptr.p_double[0], 1, ae_v_len(0,m-1)); - ae_vector_set_length(&buf2, m, _state); - ae_v_move(&buf2.ptr.p_double[0], 1, &b->ptr.p_double[0], 1, ae_v_len(0,n-1)); - for(i=n; i<=m-1; i++) - { - buf2.ptr.p_double[i] = 0; - } - ae_vector_set_length(&buf3, m, _state); - ftcomplexfftplan(m/2, 1, &plan, _state); - fftr1dinternaleven(&buf, m, &buf3, &plan, _state); - fftr1dinternaleven(&buf2, m, &buf3, &plan, _state); - buf.ptr.p_double[0] = buf.ptr.p_double[0]*buf2.ptr.p_double[0]; - buf.ptr.p_double[1] = buf.ptr.p_double[1]*buf2.ptr.p_double[1]; - for(i=1; i<=m/2-1; i++) - { - ax = buf.ptr.p_double[2*i+0]; - ay = buf.ptr.p_double[2*i+1]; - bx = buf2.ptr.p_double[2*i+0]; - by = buf2.ptr.p_double[2*i+1]; - tx = ax*bx-ay*by; - ty = ax*by+ay*bx; - buf.ptr.p_double[2*i+0] = tx; - buf.ptr.p_double[2*i+1] = ty; - } - fftr1dinvinternaleven(&buf, m, &buf3, &plan, _state); - ae_vector_set_length(r, m, _state); - ae_v_move(&r->ptr.p_double[0], 1, &buf.ptr.p_double[0], 1, ae_v_len(0,m-1)); - } - else - { - - /* - * M is non-smooth or non-even, general code (circular/non-circular): - * * first part is the same for circular and non-circular - * convolutions. zero padding, FFTs, inverse FFTs - * * second part differs: - * * for non-circular convolution we just copy array - * * for circular convolution we add array tail to its head - */ - p = ftbasefindsmootheven(m+n-1, _state); - ae_vector_set_length(&buf, p, _state); - ae_v_move(&buf.ptr.p_double[0], 1, &a->ptr.p_double[0], 1, ae_v_len(0,m-1)); - for(i=m; i<=p-1; i++) - { - buf.ptr.p_double[i] = 0; - } - ae_vector_set_length(&buf2, p, _state); - ae_v_move(&buf2.ptr.p_double[0], 1, &b->ptr.p_double[0], 1, ae_v_len(0,n-1)); - for(i=n; i<=p-1; i++) - { - buf2.ptr.p_double[i] = 0; - } - ae_vector_set_length(&buf3, p, _state); - ftcomplexfftplan(p/2, 1, &plan, _state); - fftr1dinternaleven(&buf, p, &buf3, &plan, _state); - fftr1dinternaleven(&buf2, p, &buf3, &plan, _state); - buf.ptr.p_double[0] = buf.ptr.p_double[0]*buf2.ptr.p_double[0]; - buf.ptr.p_double[1] = buf.ptr.p_double[1]*buf2.ptr.p_double[1]; - for(i=1; i<=p/2-1; i++) - { - ax = buf.ptr.p_double[2*i+0]; - ay = buf.ptr.p_double[2*i+1]; - bx = buf2.ptr.p_double[2*i+0]; - by = buf2.ptr.p_double[2*i+1]; - tx = ax*bx-ay*by; - ty = ax*by+ay*bx; - buf.ptr.p_double[2*i+0] = tx; - buf.ptr.p_double[2*i+1] = ty; - } - fftr1dinvinternaleven(&buf, p, &buf3, &plan, _state); - if( circular ) - { - - /* - * circular, add tail to head - */ - ae_vector_set_length(r, m, _state); - ae_v_move(&r->ptr.p_double[0], 1, &buf.ptr.p_double[0], 1, ae_v_len(0,m-1)); - if( n>=2 ) - { - ae_v_add(&r->ptr.p_double[0], 1, &buf.ptr.p_double[m], 1, ae_v_len(0,n-2)); - } - } - else - { - - /* - * non-circular, just copy - */ - ae_vector_set_length(r, m+n-1, _state); - ae_v_move(&r->ptr.p_double[0], 1, &buf.ptr.p_double[0], 1, ae_v_len(0,m+n-2)); - } - } - ae_frame_leave(_state); - return; - } - - /* - * overlap-add method - */ - if( alg==2 ) - { - ae_assert((q+n-1)%2==0, "ConvR1DX: internal error!", _state); - ae_vector_set_length(&buf, q+n-1, _state); - ae_vector_set_length(&buf2, q+n-1, _state); - ae_vector_set_length(&buf3, q+n-1, _state); - ftcomplexfftplan((q+n-1)/2, 1, &plan, _state); - - /* - * prepare R - */ - if( circular ) - { - ae_vector_set_length(r, m, _state); - for(i=0; i<=m-1; i++) - { - r->ptr.p_double[i] = 0; - } - } - else - { - ae_vector_set_length(r, m+n-1, _state); - for(i=0; i<=m+n-2; i++) - { - r->ptr.p_double[i] = 0; - } - } - - /* - * pre-calculated FFT(B) - */ - ae_v_move(&buf2.ptr.p_double[0], 1, &b->ptr.p_double[0], 1, ae_v_len(0,n-1)); - for(j=n; j<=q+n-2; j++) - { - buf2.ptr.p_double[j] = 0; - } - fftr1dinternaleven(&buf2, q+n-1, &buf3, &plan, _state); - - /* - * main overlap-add cycle - */ - i = 0; - while(i<=m-1) - { - p = ae_minint(q, m-i, _state); - ae_v_move(&buf.ptr.p_double[0], 1, &a->ptr.p_double[i], 1, ae_v_len(0,p-1)); - for(j=p; j<=q+n-2; j++) - { - buf.ptr.p_double[j] = 0; - } - fftr1dinternaleven(&buf, q+n-1, &buf3, &plan, _state); - buf.ptr.p_double[0] = buf.ptr.p_double[0]*buf2.ptr.p_double[0]; - buf.ptr.p_double[1] = buf.ptr.p_double[1]*buf2.ptr.p_double[1]; - for(j=1; j<=(q+n-1)/2-1; j++) - { - ax = buf.ptr.p_double[2*j+0]; - ay = buf.ptr.p_double[2*j+1]; - bx = buf2.ptr.p_double[2*j+0]; - by = buf2.ptr.p_double[2*j+1]; - tx = ax*bx-ay*by; - ty = ax*by+ay*bx; - buf.ptr.p_double[2*j+0] = tx; - buf.ptr.p_double[2*j+1] = ty; - } - fftr1dinvinternaleven(&buf, q+n-1, &buf3, &plan, _state); - if( circular ) - { - j1 = ae_minint(i+p+n-2, m-1, _state)-i; - j2 = j1+1; - } - else - { - j1 = p+n-2; - j2 = j1+1; - } - ae_v_add(&r->ptr.p_double[i], 1, &buf.ptr.p_double[0], 1, ae_v_len(i,i+j1)); - if( p+n-2>=j2 ) - { - ae_v_add(&r->ptr.p_double[0], 1, &buf.ptr.p_double[j2], 1, ae_v_len(0,p+n-2-j2)); - } - i = i+p; - } - ae_frame_leave(_state); - return; - } - ae_frame_leave(_state); -} - - - - -/************************************************************************* -1-dimensional complex cross-correlation. - -For given Pattern/Signal returns corr(Pattern,Signal) (non-circular). - -Correlation is calculated using reduction to convolution. Algorithm with -max(N,N)*log(max(N,N)) complexity is used (see ConvC1D() for more info -about performance). - -IMPORTANT: - for historical reasons subroutine accepts its parameters in reversed - order: CorrC1D(Signal, Pattern) = Pattern x Signal (using traditional - definition of cross-correlation, denoting cross-correlation as "x"). - -INPUT PARAMETERS - Signal - array[0..N-1] - complex function to be transformed, - signal containing pattern - N - problem size - Pattern - array[0..M-1] - complex function to be transformed, - pattern to search within signal - M - problem size - -OUTPUT PARAMETERS - R - cross-correlation, array[0..N+M-2]: - * positive lags are stored in R[0..N-1], - R[i] = sum(conj(pattern[j])*signal[i+j] - * negative lags are stored in R[N..N+M-2], - R[N+M-1-i] = sum(conj(pattern[j])*signal[-i+j] - -NOTE: - It is assumed that pattern domain is [0..M-1]. If Pattern is non-zero -on [-K..M-1], you can still use this subroutine, just shift result by K. - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void corrc1d(/* Complex */ ae_vector* signal, - ae_int_t n, - /* Complex */ ae_vector* pattern, - ae_int_t m, - /* Complex */ ae_vector* r, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector p; - ae_vector b; - ae_int_t i; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(r); - ae_vector_init(&p, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&b, 0, DT_COMPLEX, _state, ae_true); - - ae_assert(n>0&&m>0, "CorrC1D: incorrect N or M!", _state); - ae_vector_set_length(&p, m, _state); - for(i=0; i<=m-1; i++) - { - p.ptr.p_complex[m-1-i] = ae_c_conj(pattern->ptr.p_complex[i], _state); - } - convc1d(&p, m, signal, n, &b, _state); - ae_vector_set_length(r, m+n-1, _state); - ae_v_cmove(&r->ptr.p_complex[0], 1, &b.ptr.p_complex[m-1], 1, "N", ae_v_len(0,n-1)); - if( m+n-2>=n ) - { - ae_v_cmove(&r->ptr.p_complex[n], 1, &b.ptr.p_complex[0], 1, "N", ae_v_len(n,m+n-2)); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -1-dimensional circular complex cross-correlation. - -For given Pattern/Signal returns corr(Pattern,Signal) (circular). -Algorithm has linearithmic complexity for any M/N. - -IMPORTANT: - for historical reasons subroutine accepts its parameters in reversed - order: CorrC1DCircular(Signal, Pattern) = Pattern x Signal (using - traditional definition of cross-correlation, denoting cross-correlation - as "x"). - -INPUT PARAMETERS - Signal - array[0..N-1] - complex function to be transformed, - periodic signal containing pattern - N - problem size - Pattern - array[0..M-1] - complex function to be transformed, - non-periodic pattern to search within signal - M - problem size - -OUTPUT PARAMETERS - R - convolution: A*B. array[0..M-1]. - - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void corrc1dcircular(/* Complex */ ae_vector* signal, - ae_int_t m, - /* Complex */ ae_vector* pattern, - ae_int_t n, - /* Complex */ ae_vector* c, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector p; - ae_vector b; - ae_int_t i1; - ae_int_t i2; - ae_int_t i; - ae_int_t j2; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(c); - ae_vector_init(&p, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&b, 0, DT_COMPLEX, _state, ae_true); - - ae_assert(n>0&&m>0, "ConvC1DCircular: incorrect N or M!", _state); - - /* - * normalize task: make M>=N, - * so A will be longer (at least - not shorter) that B. - */ - if( mptr.p_complex[i1], 1, "N", ae_v_len(0,j2)); - i1 = i1+m; - } - corrc1dcircular(signal, m, &b, m, c, _state); - ae_frame_leave(_state); - return; - } - - /* - * Task is normalized - */ - ae_vector_set_length(&p, n, _state); - for(i=0; i<=n-1; i++) - { - p.ptr.p_complex[n-1-i] = ae_c_conj(pattern->ptr.p_complex[i], _state); - } - convc1dcircular(signal, m, &p, n, &b, _state); - ae_vector_set_length(c, m, _state); - ae_v_cmove(&c->ptr.p_complex[0], 1, &b.ptr.p_complex[n-1], 1, "N", ae_v_len(0,m-n)); - if( m-n+1<=m-1 ) - { - ae_v_cmove(&c->ptr.p_complex[m-n+1], 1, &b.ptr.p_complex[0], 1, "N", ae_v_len(m-n+1,m-1)); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -1-dimensional real cross-correlation. - -For given Pattern/Signal returns corr(Pattern,Signal) (non-circular). - -Correlation is calculated using reduction to convolution. Algorithm with -max(N,N)*log(max(N,N)) complexity is used (see ConvC1D() for more info -about performance). - -IMPORTANT: - for historical reasons subroutine accepts its parameters in reversed - order: CorrR1D(Signal, Pattern) = Pattern x Signal (using traditional - definition of cross-correlation, denoting cross-correlation as "x"). - -INPUT PARAMETERS - Signal - array[0..N-1] - real function to be transformed, - signal containing pattern - N - problem size - Pattern - array[0..M-1] - real function to be transformed, - pattern to search within signal - M - problem size - -OUTPUT PARAMETERS - R - cross-correlation, array[0..N+M-2]: - * positive lags are stored in R[0..N-1], - R[i] = sum(pattern[j]*signal[i+j] - * negative lags are stored in R[N..N+M-2], - R[N+M-1-i] = sum(pattern[j]*signal[-i+j] - -NOTE: - It is assumed that pattern domain is [0..M-1]. If Pattern is non-zero -on [-K..M-1], you can still use this subroutine, just shift result by K. - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void corrr1d(/* Real */ ae_vector* signal, - ae_int_t n, - /* Real */ ae_vector* pattern, - ae_int_t m, - /* Real */ ae_vector* r, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector p; - ae_vector b; - ae_int_t i; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(r); - ae_vector_init(&p, 0, DT_REAL, _state, ae_true); - ae_vector_init(&b, 0, DT_REAL, _state, ae_true); - - ae_assert(n>0&&m>0, "CorrR1D: incorrect N or M!", _state); - ae_vector_set_length(&p, m, _state); - for(i=0; i<=m-1; i++) - { - p.ptr.p_double[m-1-i] = pattern->ptr.p_double[i]; - } - convr1d(&p, m, signal, n, &b, _state); - ae_vector_set_length(r, m+n-1, _state); - ae_v_move(&r->ptr.p_double[0], 1, &b.ptr.p_double[m-1], 1, ae_v_len(0,n-1)); - if( m+n-2>=n ) - { - ae_v_move(&r->ptr.p_double[n], 1, &b.ptr.p_double[0], 1, ae_v_len(n,m+n-2)); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -1-dimensional circular real cross-correlation. - -For given Pattern/Signal returns corr(Pattern,Signal) (circular). -Algorithm has linearithmic complexity for any M/N. - -IMPORTANT: - for historical reasons subroutine accepts its parameters in reversed - order: CorrR1DCircular(Signal, Pattern) = Pattern x Signal (using - traditional definition of cross-correlation, denoting cross-correlation - as "x"). - -INPUT PARAMETERS - Signal - array[0..N-1] - real function to be transformed, - periodic signal containing pattern - N - problem size - Pattern - array[0..M-1] - real function to be transformed, - non-periodic pattern to search within signal - M - problem size - -OUTPUT PARAMETERS - R - convolution: A*B. array[0..M-1]. - - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void corrr1dcircular(/* Real */ ae_vector* signal, - ae_int_t m, - /* Real */ ae_vector* pattern, - ae_int_t n, - /* Real */ ae_vector* c, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector p; - ae_vector b; - ae_int_t i1; - ae_int_t i2; - ae_int_t i; - ae_int_t j2; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(c); - ae_vector_init(&p, 0, DT_REAL, _state, ae_true); - ae_vector_init(&b, 0, DT_REAL, _state, ae_true); - - ae_assert(n>0&&m>0, "ConvC1DCircular: incorrect N or M!", _state); - - /* - * normalize task: make M>=N, - * so A will be longer (at least - not shorter) that B. - */ - if( mptr.p_double[i1], 1, ae_v_len(0,j2)); - i1 = i1+m; - } - corrr1dcircular(signal, m, &b, m, c, _state); - ae_frame_leave(_state); - return; - } - - /* - * Task is normalized - */ - ae_vector_set_length(&p, n, _state); - for(i=0; i<=n-1; i++) - { - p.ptr.p_double[n-1-i] = pattern->ptr.p_double[i]; - } - convr1dcircular(signal, m, &p, n, &b, _state); - ae_vector_set_length(c, m, _state); - ae_v_move(&c->ptr.p_double[0], 1, &b.ptr.p_double[n-1], 1, ae_v_len(0,m-n)); - if( m-n+1<=m-1 ) - { - ae_v_move(&c->ptr.p_double[m-n+1], 1, &b.ptr.p_double[0], 1, ae_v_len(m-n+1,m-1)); - } - ae_frame_leave(_state); -} - - - - -/************************************************************************* -1-dimensional Fast Hartley Transform. - -Algorithm has O(N*logN) complexity for any N (composite or prime). - -INPUT PARAMETERS - A - array[0..N-1] - real function to be transformed - N - problem size - -OUTPUT PARAMETERS - A - FHT of a input array, array[0..N-1], - A_out[k] = sum(A_in[j]*(cos(2*pi*j*k/N)+sin(2*pi*j*k/N)), j=0..N-1) - - - -- ALGLIB -- - Copyright 04.06.2009 by Bochkanov Sergey -*************************************************************************/ -void fhtr1d(/* Real */ ae_vector* a, ae_int_t n, ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_vector fa; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&fa, 0, DT_COMPLEX, _state, ae_true); - - ae_assert(n>0, "FHTR1D: incorrect N!", _state); - - /* - * Special case: N=1, FHT is just identity transform. - * After this block we assume that N is strictly greater than 1. - */ - if( n==1 ) - { - ae_frame_leave(_state); - return; - } - - /* - * Reduce FHt to real FFT - */ - fftr1d(a, n, &fa, _state); - for(i=0; i<=n-1; i++) - { - a->ptr.p_double[i] = fa.ptr.p_complex[i].x-fa.ptr.p_complex[i].y; - } - ae_frame_leave(_state); -} - - -/************************************************************************* -1-dimensional inverse FHT. - -Algorithm has O(N*logN) complexity for any N (composite or prime). - -INPUT PARAMETERS - A - array[0..N-1] - complex array to be transformed - N - problem size - -OUTPUT PARAMETERS - A - inverse FHT of a input array, array[0..N-1] - - - -- ALGLIB -- - Copyright 29.05.2009 by Bochkanov Sergey -*************************************************************************/ -void fhtr1dinv(/* Real */ ae_vector* a, ae_int_t n, ae_state *_state) -{ - ae_int_t i; - - - ae_assert(n>0, "FHTR1DInv: incorrect N!", _state); - - /* - * Special case: N=1, iFHT is just identity transform. - * After this block we assume that N is strictly greater than 1. - */ - if( n==1 ) - { - return; - } - - /* - * Inverse FHT can be expressed in terms of the FHT as - * - * invfht(x) = fht(x)/N - */ - fhtr1d(a, n, _state); - for(i=0; i<=n-1; i++) - { - a->ptr.p_double[i] = a->ptr.p_double[i]/n; - } -} - - - -} - diff --git a/src/core/alglib/fasttransforms.h b/src/core/alglib/fasttransforms.h deleted file mode 100644 index 20f91ff..0000000 --- a/src/core/alglib/fasttransforms.h +++ /dev/null @@ -1,691 +0,0 @@ -/************************************************************************* -Copyright (c) Sergey Bochkanov (ALGLIB project). - ->>> SOURCE LICENSE >>> -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation (www.fsf.org); either version 2 of the -License, or (at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -A copy of the GNU General Public License is available at -http://www.fsf.org/licensing/licenses ->>> END OF LICENSE >>> -*************************************************************************/ -#ifndef _fasttransforms_pkg_h -#define _fasttransforms_pkg_h -#include "ap.h" -#include "alglibinternal.h" - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (DATATYPES) -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ - -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS C++ INTERFACE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib -{ - - -/************************************************************************* -1-dimensional complex FFT. - -Array size N may be arbitrary number (composite or prime). Composite N's -are handled with cache-oblivious variation of a Cooley-Tukey algorithm. -Small prime-factors are transformed using hard coded codelets (similar to -FFTW codelets, but without low-level optimization), large prime-factors -are handled with Bluestein's algorithm. - -Fastests transforms are for smooth N's (prime factors are 2, 3, 5 only), -most fast for powers of 2. When N have prime factors larger than these, -but orders of magnitude smaller than N, computations will be about 4 times -slower than for nearby highly composite N's. When N itself is prime, speed -will be 6 times lower. - -Algorithm has O(N*logN) complexity for any N (composite or prime). - -INPUT PARAMETERS - A - array[0..N-1] - complex function to be transformed - N - problem size - -OUTPUT PARAMETERS - A - DFT of a input array, array[0..N-1] - A_out[j] = SUM(A_in[k]*exp(-2*pi*sqrt(-1)*j*k/N), k = 0..N-1) - - - -- ALGLIB -- - Copyright 29.05.2009 by Bochkanov Sergey -*************************************************************************/ -void fftc1d(complex_1d_array &a, const ae_int_t n); -void fftc1d(complex_1d_array &a); - - -/************************************************************************* -1-dimensional complex inverse FFT. - -Array size N may be arbitrary number (composite or prime). Algorithm has -O(N*logN) complexity for any N (composite or prime). - -See FFTC1D() description for more information about algorithm performance. - -INPUT PARAMETERS - A - array[0..N-1] - complex array to be transformed - N - problem size - -OUTPUT PARAMETERS - A - inverse DFT of a input array, array[0..N-1] - A_out[j] = SUM(A_in[k]/N*exp(+2*pi*sqrt(-1)*j*k/N), k = 0..N-1) - - - -- ALGLIB -- - Copyright 29.05.2009 by Bochkanov Sergey -*************************************************************************/ -void fftc1dinv(complex_1d_array &a, const ae_int_t n); -void fftc1dinv(complex_1d_array &a); - - -/************************************************************************* -1-dimensional real FFT. - -Algorithm has O(N*logN) complexity for any N (composite or prime). - -INPUT PARAMETERS - A - array[0..N-1] - real function to be transformed - N - problem size - -OUTPUT PARAMETERS - F - DFT of a input array, array[0..N-1] - F[j] = SUM(A[k]*exp(-2*pi*sqrt(-1)*j*k/N), k = 0..N-1) - -NOTE: - F[] satisfies symmetry property F[k] = conj(F[N-k]), so just one half -of array is usually needed. But for convenience subroutine returns full -complex array (with frequencies above N/2), so its result may be used by -other FFT-related subroutines. - - - -- ALGLIB -- - Copyright 01.06.2009 by Bochkanov Sergey -*************************************************************************/ -void fftr1d(const real_1d_array &a, const ae_int_t n, complex_1d_array &f); -void fftr1d(const real_1d_array &a, complex_1d_array &f); - - -/************************************************************************* -1-dimensional real inverse FFT. - -Algorithm has O(N*logN) complexity for any N (composite or prime). - -INPUT PARAMETERS - F - array[0..floor(N/2)] - frequencies from forward real FFT - N - problem size - -OUTPUT PARAMETERS - A - inverse DFT of a input array, array[0..N-1] - -NOTE: - F[] should satisfy symmetry property F[k] = conj(F[N-k]), so just one -half of frequencies array is needed - elements from 0 to floor(N/2). F[0] -is ALWAYS real. If N is even F[floor(N/2)] is real too. If N is odd, then -F[floor(N/2)] has no special properties. - -Relying on properties noted above, FFTR1DInv subroutine uses only elements -from 0th to floor(N/2)-th. It ignores imaginary part of F[0], and in case -N is even it ignores imaginary part of F[floor(N/2)] too. - -When you call this function using full arguments list - "FFTR1DInv(F,N,A)" -- you can pass either either frequencies array with N elements or reduced -array with roughly N/2 elements - subroutine will successfully transform -both. - -If you call this function using reduced arguments list - "FFTR1DInv(F,A)" -- you must pass FULL array with N elements (although higher N/2 are still -not used) because array size is used to automatically determine FFT length - - - -- ALGLIB -- - Copyright 01.06.2009 by Bochkanov Sergey -*************************************************************************/ -void fftr1dinv(const complex_1d_array &f, const ae_int_t n, real_1d_array &a); -void fftr1dinv(const complex_1d_array &f, real_1d_array &a); - -/************************************************************************* -1-dimensional complex convolution. - -For given A/B returns conv(A,B) (non-circular). Subroutine can automatically -choose between three implementations: straightforward O(M*N) formula for -very small N (or M), overlap-add algorithm for cases where max(M,N) is -significantly larger than min(M,N), but O(M*N) algorithm is too slow, and -general FFT-based formula for cases where two previois algorithms are too -slow. - -Algorithm has max(M,N)*log(max(M,N)) complexity for any M/N. - -INPUT PARAMETERS - A - array[0..M-1] - complex function to be transformed - M - problem size - B - array[0..N-1] - complex function to be transformed - N - problem size - -OUTPUT PARAMETERS - R - convolution: A*B. array[0..N+M-2]. - -NOTE: - It is assumed that A is zero at T<0, B is zero too. If one or both -functions have non-zero values at negative T's, you can still use this -subroutine - just shift its result correspondingly. - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void convc1d(const complex_1d_array &a, const ae_int_t m, const complex_1d_array &b, const ae_int_t n, complex_1d_array &r); - - -/************************************************************************* -1-dimensional complex non-circular deconvolution (inverse of ConvC1D()). - -Algorithm has M*log(M)) complexity for any M (composite or prime). - -INPUT PARAMETERS - A - array[0..M-1] - convolved signal, A = conv(R, B) - M - convolved signal length - B - array[0..N-1] - response - N - response length, N<=M - -OUTPUT PARAMETERS - R - deconvolved signal. array[0..M-N]. - -NOTE: - deconvolution is unstable process and may result in division by zero -(if your response function is degenerate, i.e. has zero Fourier coefficient). - -NOTE: - It is assumed that A is zero at T<0, B is zero too. If one or both -functions have non-zero values at negative T's, you can still use this -subroutine - just shift its result correspondingly. - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void convc1dinv(const complex_1d_array &a, const ae_int_t m, const complex_1d_array &b, const ae_int_t n, complex_1d_array &r); - - -/************************************************************************* -1-dimensional circular complex convolution. - -For given S/R returns conv(S,R) (circular). Algorithm has linearithmic -complexity for any M/N. - -IMPORTANT: normal convolution is commutative, i.e. it is symmetric - -conv(A,B)=conv(B,A). Cyclic convolution IS NOT. One function - S - is a -signal, periodic function, and another - R - is a response, non-periodic -function with limited length. - -INPUT PARAMETERS - S - array[0..M-1] - complex periodic signal - M - problem size - B - array[0..N-1] - complex non-periodic response - N - problem size - -OUTPUT PARAMETERS - R - convolution: A*B. array[0..M-1]. - -NOTE: - It is assumed that B is zero at T<0. If it has non-zero values at -negative T's, you can still use this subroutine - just shift its result -correspondingly. - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void convc1dcircular(const complex_1d_array &s, const ae_int_t m, const complex_1d_array &r, const ae_int_t n, complex_1d_array &c); - - -/************************************************************************* -1-dimensional circular complex deconvolution (inverse of ConvC1DCircular()). - -Algorithm has M*log(M)) complexity for any M (composite or prime). - -INPUT PARAMETERS - A - array[0..M-1] - convolved periodic signal, A = conv(R, B) - M - convolved signal length - B - array[0..N-1] - non-periodic response - N - response length - -OUTPUT PARAMETERS - R - deconvolved signal. array[0..M-1]. - -NOTE: - deconvolution is unstable process and may result in division by zero -(if your response function is degenerate, i.e. has zero Fourier coefficient). - -NOTE: - It is assumed that B is zero at T<0. If it has non-zero values at -negative T's, you can still use this subroutine - just shift its result -correspondingly. - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void convc1dcircularinv(const complex_1d_array &a, const ae_int_t m, const complex_1d_array &b, const ae_int_t n, complex_1d_array &r); - - -/************************************************************************* -1-dimensional real convolution. - -Analogous to ConvC1D(), see ConvC1D() comments for more details. - -INPUT PARAMETERS - A - array[0..M-1] - real function to be transformed - M - problem size - B - array[0..N-1] - real function to be transformed - N - problem size - -OUTPUT PARAMETERS - R - convolution: A*B. array[0..N+M-2]. - -NOTE: - It is assumed that A is zero at T<0, B is zero too. If one or both -functions have non-zero values at negative T's, you can still use this -subroutine - just shift its result correspondingly. - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void convr1d(const real_1d_array &a, const ae_int_t m, const real_1d_array &b, const ae_int_t n, real_1d_array &r); - - -/************************************************************************* -1-dimensional real deconvolution (inverse of ConvC1D()). - -Algorithm has M*log(M)) complexity for any M (composite or prime). - -INPUT PARAMETERS - A - array[0..M-1] - convolved signal, A = conv(R, B) - M - convolved signal length - B - array[0..N-1] - response - N - response length, N<=M - -OUTPUT PARAMETERS - R - deconvolved signal. array[0..M-N]. - -NOTE: - deconvolution is unstable process and may result in division by zero -(if your response function is degenerate, i.e. has zero Fourier coefficient). - -NOTE: - It is assumed that A is zero at T<0, B is zero too. If one or both -functions have non-zero values at negative T's, you can still use this -subroutine - just shift its result correspondingly. - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void convr1dinv(const real_1d_array &a, const ae_int_t m, const real_1d_array &b, const ae_int_t n, real_1d_array &r); - - -/************************************************************************* -1-dimensional circular real convolution. - -Analogous to ConvC1DCircular(), see ConvC1DCircular() comments for more details. - -INPUT PARAMETERS - S - array[0..M-1] - real signal - M - problem size - B - array[0..N-1] - real response - N - problem size - -OUTPUT PARAMETERS - R - convolution: A*B. array[0..M-1]. - -NOTE: - It is assumed that B is zero at T<0. If it has non-zero values at -negative T's, you can still use this subroutine - just shift its result -correspondingly. - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void convr1dcircular(const real_1d_array &s, const ae_int_t m, const real_1d_array &r, const ae_int_t n, real_1d_array &c); - - -/************************************************************************* -1-dimensional complex deconvolution (inverse of ConvC1D()). - -Algorithm has M*log(M)) complexity for any M (composite or prime). - -INPUT PARAMETERS - A - array[0..M-1] - convolved signal, A = conv(R, B) - M - convolved signal length - B - array[0..N-1] - response - N - response length - -OUTPUT PARAMETERS - R - deconvolved signal. array[0..M-N]. - -NOTE: - deconvolution is unstable process and may result in division by zero -(if your response function is degenerate, i.e. has zero Fourier coefficient). - -NOTE: - It is assumed that B is zero at T<0. If it has non-zero values at -negative T's, you can still use this subroutine - just shift its result -correspondingly. - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void convr1dcircularinv(const real_1d_array &a, const ae_int_t m, const real_1d_array &b, const ae_int_t n, real_1d_array &r); - -/************************************************************************* -1-dimensional complex cross-correlation. - -For given Pattern/Signal returns corr(Pattern,Signal) (non-circular). - -Correlation is calculated using reduction to convolution. Algorithm with -max(N,N)*log(max(N,N)) complexity is used (see ConvC1D() for more info -about performance). - -IMPORTANT: - for historical reasons subroutine accepts its parameters in reversed - order: CorrC1D(Signal, Pattern) = Pattern x Signal (using traditional - definition of cross-correlation, denoting cross-correlation as "x"). - -INPUT PARAMETERS - Signal - array[0..N-1] - complex function to be transformed, - signal containing pattern - N - problem size - Pattern - array[0..M-1] - complex function to be transformed, - pattern to search within signal - M - problem size - -OUTPUT PARAMETERS - R - cross-correlation, array[0..N+M-2]: - * positive lags are stored in R[0..N-1], - R[i] = sum(conj(pattern[j])*signal[i+j] - * negative lags are stored in R[N..N+M-2], - R[N+M-1-i] = sum(conj(pattern[j])*signal[-i+j] - -NOTE: - It is assumed that pattern domain is [0..M-1]. If Pattern is non-zero -on [-K..M-1], you can still use this subroutine, just shift result by K. - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void corrc1d(const complex_1d_array &signal, const ae_int_t n, const complex_1d_array &pattern, const ae_int_t m, complex_1d_array &r); - - -/************************************************************************* -1-dimensional circular complex cross-correlation. - -For given Pattern/Signal returns corr(Pattern,Signal) (circular). -Algorithm has linearithmic complexity for any M/N. - -IMPORTANT: - for historical reasons subroutine accepts its parameters in reversed - order: CorrC1DCircular(Signal, Pattern) = Pattern x Signal (using - traditional definition of cross-correlation, denoting cross-correlation - as "x"). - -INPUT PARAMETERS - Signal - array[0..N-1] - complex function to be transformed, - periodic signal containing pattern - N - problem size - Pattern - array[0..M-1] - complex function to be transformed, - non-periodic pattern to search within signal - M - problem size - -OUTPUT PARAMETERS - R - convolution: A*B. array[0..M-1]. - - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void corrc1dcircular(const complex_1d_array &signal, const ae_int_t m, const complex_1d_array &pattern, const ae_int_t n, complex_1d_array &c); - - -/************************************************************************* -1-dimensional real cross-correlation. - -For given Pattern/Signal returns corr(Pattern,Signal) (non-circular). - -Correlation is calculated using reduction to convolution. Algorithm with -max(N,N)*log(max(N,N)) complexity is used (see ConvC1D() for more info -about performance). - -IMPORTANT: - for historical reasons subroutine accepts its parameters in reversed - order: CorrR1D(Signal, Pattern) = Pattern x Signal (using traditional - definition of cross-correlation, denoting cross-correlation as "x"). - -INPUT PARAMETERS - Signal - array[0..N-1] - real function to be transformed, - signal containing pattern - N - problem size - Pattern - array[0..M-1] - real function to be transformed, - pattern to search within signal - M - problem size - -OUTPUT PARAMETERS - R - cross-correlation, array[0..N+M-2]: - * positive lags are stored in R[0..N-1], - R[i] = sum(pattern[j]*signal[i+j] - * negative lags are stored in R[N..N+M-2], - R[N+M-1-i] = sum(pattern[j]*signal[-i+j] - -NOTE: - It is assumed that pattern domain is [0..M-1]. If Pattern is non-zero -on [-K..M-1], you can still use this subroutine, just shift result by K. - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void corrr1d(const real_1d_array &signal, const ae_int_t n, const real_1d_array &pattern, const ae_int_t m, real_1d_array &r); - - -/************************************************************************* -1-dimensional circular real cross-correlation. - -For given Pattern/Signal returns corr(Pattern,Signal) (circular). -Algorithm has linearithmic complexity for any M/N. - -IMPORTANT: - for historical reasons subroutine accepts its parameters in reversed - order: CorrR1DCircular(Signal, Pattern) = Pattern x Signal (using - traditional definition of cross-correlation, denoting cross-correlation - as "x"). - -INPUT PARAMETERS - Signal - array[0..N-1] - real function to be transformed, - periodic signal containing pattern - N - problem size - Pattern - array[0..M-1] - real function to be transformed, - non-periodic pattern to search within signal - M - problem size - -OUTPUT PARAMETERS - R - convolution: A*B. array[0..M-1]. - - - -- ALGLIB -- - Copyright 21.07.2009 by Bochkanov Sergey -*************************************************************************/ -void corrr1dcircular(const real_1d_array &signal, const ae_int_t m, const real_1d_array &pattern, const ae_int_t n, real_1d_array &c); - -/************************************************************************* -1-dimensional Fast Hartley Transform. - -Algorithm has O(N*logN) complexity for any N (composite or prime). - -INPUT PARAMETERS - A - array[0..N-1] - real function to be transformed - N - problem size - -OUTPUT PARAMETERS - A - FHT of a input array, array[0..N-1], - A_out[k] = sum(A_in[j]*(cos(2*pi*j*k/N)+sin(2*pi*j*k/N)), j=0..N-1) - - - -- ALGLIB -- - Copyright 04.06.2009 by Bochkanov Sergey -*************************************************************************/ -void fhtr1d(real_1d_array &a, const ae_int_t n); - - -/************************************************************************* -1-dimensional inverse FHT. - -Algorithm has O(N*logN) complexity for any N (composite or prime). - -INPUT PARAMETERS - A - array[0..N-1] - complex array to be transformed - N - problem size - -OUTPUT PARAMETERS - A - inverse FHT of a input array, array[0..N-1] - - - -- ALGLIB -- - Copyright 29.05.2009 by Bochkanov Sergey -*************************************************************************/ -void fhtr1dinv(real_1d_array &a, const ae_int_t n); -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (FUNCTIONS) -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ -void fftc1d(/* Complex */ ae_vector* a, ae_int_t n, ae_state *_state); -void fftc1dinv(/* Complex */ ae_vector* a, ae_int_t n, ae_state *_state); -void fftr1d(/* Real */ ae_vector* a, - ae_int_t n, - /* Complex */ ae_vector* f, - ae_state *_state); -void fftr1dinv(/* Complex */ ae_vector* f, - ae_int_t n, - /* Real */ ae_vector* a, - ae_state *_state); -void fftr1dinternaleven(/* Real */ ae_vector* a, - ae_int_t n, - /* Real */ ae_vector* buf, - fasttransformplan* plan, - ae_state *_state); -void fftr1dinvinternaleven(/* Real */ ae_vector* a, - ae_int_t n, - /* Real */ ae_vector* buf, - fasttransformplan* plan, - ae_state *_state); -void convc1d(/* Complex */ ae_vector* a, - ae_int_t m, - /* Complex */ ae_vector* b, - ae_int_t n, - /* Complex */ ae_vector* r, - ae_state *_state); -void convc1dinv(/* Complex */ ae_vector* a, - ae_int_t m, - /* Complex */ ae_vector* b, - ae_int_t n, - /* Complex */ ae_vector* r, - ae_state *_state); -void convc1dcircular(/* Complex */ ae_vector* s, - ae_int_t m, - /* Complex */ ae_vector* r, - ae_int_t n, - /* Complex */ ae_vector* c, - ae_state *_state); -void convc1dcircularinv(/* Complex */ ae_vector* a, - ae_int_t m, - /* Complex */ ae_vector* b, - ae_int_t n, - /* Complex */ ae_vector* r, - ae_state *_state); -void convr1d(/* Real */ ae_vector* a, - ae_int_t m, - /* Real */ ae_vector* b, - ae_int_t n, - /* Real */ ae_vector* r, - ae_state *_state); -void convr1dinv(/* Real */ ae_vector* a, - ae_int_t m, - /* Real */ ae_vector* b, - ae_int_t n, - /* Real */ ae_vector* r, - ae_state *_state); -void convr1dcircular(/* Real */ ae_vector* s, - ae_int_t m, - /* Real */ ae_vector* r, - ae_int_t n, - /* Real */ ae_vector* c, - ae_state *_state); -void convr1dcircularinv(/* Real */ ae_vector* a, - ae_int_t m, - /* Real */ ae_vector* b, - ae_int_t n, - /* Real */ ae_vector* r, - ae_state *_state); -void convc1dx(/* Complex */ ae_vector* a, - ae_int_t m, - /* Complex */ ae_vector* b, - ae_int_t n, - ae_bool circular, - ae_int_t alg, - ae_int_t q, - /* Complex */ ae_vector* r, - ae_state *_state); -void convr1dx(/* Real */ ae_vector* a, - ae_int_t m, - /* Real */ ae_vector* b, - ae_int_t n, - ae_bool circular, - ae_int_t alg, - ae_int_t q, - /* Real */ ae_vector* r, - ae_state *_state); -void corrc1d(/* Complex */ ae_vector* signal, - ae_int_t n, - /* Complex */ ae_vector* pattern, - ae_int_t m, - /* Complex */ ae_vector* r, - ae_state *_state); -void corrc1dcircular(/* Complex */ ae_vector* signal, - ae_int_t m, - /* Complex */ ae_vector* pattern, - ae_int_t n, - /* Complex */ ae_vector* c, - ae_state *_state); -void corrr1d(/* Real */ ae_vector* signal, - ae_int_t n, - /* Real */ ae_vector* pattern, - ae_int_t m, - /* Real */ ae_vector* r, - ae_state *_state); -void corrr1dcircular(/* Real */ ae_vector* signal, - ae_int_t m, - /* Real */ ae_vector* pattern, - ae_int_t n, - /* Real */ ae_vector* c, - ae_state *_state); -void fhtr1d(/* Real */ ae_vector* a, ae_int_t n, ae_state *_state); -void fhtr1dinv(/* Real */ ae_vector* a, ae_int_t n, ae_state *_state); - -} -#endif - diff --git a/src/core/alglib/integration.cpp b/src/core/alglib/integration.cpp deleted file mode 100644 index 2745889..0000000 --- a/src/core/alglib/integration.cpp +++ /dev/null @@ -1,3961 +0,0 @@ -/************************************************************************* -Copyright (c) Sergey Bochkanov (ALGLIB project). - ->>> SOURCE LICENSE >>> -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation (www.fsf.org); either version 2 of the -License, or (at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -A copy of the GNU General Public License is available at -http://www.fsf.org/licensing/licenses ->>> END OF LICENSE >>> -*************************************************************************/ -#include "stdafx.h" -#include "integration.h" - -// disable some irrelevant warnings -#if (AE_COMPILER==AE_MSVC) -#pragma warning(disable:4100) -#pragma warning(disable:4127) -#pragma warning(disable:4702) -#pragma warning(disable:4996) -#endif -using namespace std; - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS IMPLEMENTATION OF C++ INTERFACE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib -{ - - -/************************************************************************* -Computation of nodes and weights for a Gauss quadrature formula - -The algorithm generates the N-point Gauss quadrature formula with weight -function given by coefficients alpha and beta of a recurrence relation -which generates a system of orthogonal polynomials: - -P-1(x) = 0 -P0(x) = 1 -Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x) - -and zeroth moment Mu0 - -Mu0 = integral(W(x)dx,a,b) - -INPUT PARAMETERS: - Alpha – array[0..N-1], alpha coefficients - Beta – array[0..N-1], beta coefficients - Zero-indexed element is not used and may be arbitrary. - Beta[I]>0. - Mu0 – zeroth moment of the weight function. - N – number of nodes of the quadrature formula, N>=1 - -OUTPUT PARAMETERS: - Info - error code: - * -3 internal eigenproblem solver hasn't converged - * -2 Beta[i]<=0 - * -1 incorrect N was passed - * 1 OK - X - array[0..N-1] - array of quadrature nodes, - in ascending order. - W - array[0..N-1] - array of quadrature weights. - - -- ALGLIB -- - Copyright 2005-2009 by Bochkanov Sergey -*************************************************************************/ -void gqgeneraterec(const real_1d_array &alpha, const real_1d_array &beta, const double mu0, const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::gqgeneraterec(const_cast(alpha.c_ptr()), const_cast(beta.c_ptr()), mu0, n, &info, const_cast(x.c_ptr()), const_cast(w.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Computation of nodes and weights for a Gauss-Lobatto quadrature formula - -The algorithm generates the N-point Gauss-Lobatto quadrature formula with -weight function given by coefficients alpha and beta of a recurrence which -generates a system of orthogonal polynomials. - -P-1(x) = 0 -P0(x) = 1 -Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x) - -and zeroth moment Mu0 - -Mu0 = integral(W(x)dx,a,b) - -INPUT PARAMETERS: - Alpha – array[0..N-2], alpha coefficients - Beta – array[0..N-2], beta coefficients. - Zero-indexed element is not used, may be arbitrary. - Beta[I]>0 - Mu0 – zeroth moment of the weighting function. - A – left boundary of the integration interval. - B – right boundary of the integration interval. - N – number of nodes of the quadrature formula, N>=3 - (including the left and right boundary nodes). - -OUTPUT PARAMETERS: - Info - error code: - * -3 internal eigenproblem solver hasn't converged - * -2 Beta[i]<=0 - * -1 incorrect N was passed - * 1 OK - X - array[0..N-1] - array of quadrature nodes, - in ascending order. - W - array[0..N-1] - array of quadrature weights. - - -- ALGLIB -- - Copyright 2005-2009 by Bochkanov Sergey -*************************************************************************/ -void gqgenerategausslobattorec(const real_1d_array &alpha, const real_1d_array &beta, const double mu0, const double a, const double b, const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::gqgenerategausslobattorec(const_cast(alpha.c_ptr()), const_cast(beta.c_ptr()), mu0, a, b, n, &info, const_cast(x.c_ptr()), const_cast(w.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Computation of nodes and weights for a Gauss-Radau quadrature formula - -The algorithm generates the N-point Gauss-Radau quadrature formula with -weight function given by the coefficients alpha and beta of a recurrence -which generates a system of orthogonal polynomials. - -P-1(x) = 0 -P0(x) = 1 -Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x) - -and zeroth moment Mu0 - -Mu0 = integral(W(x)dx,a,b) - -INPUT PARAMETERS: - Alpha – array[0..N-2], alpha coefficients. - Beta – array[0..N-1], beta coefficients - Zero-indexed element is not used. - Beta[I]>0 - Mu0 – zeroth moment of the weighting function. - A – left boundary of the integration interval. - N – number of nodes of the quadrature formula, N>=2 - (including the left boundary node). - -OUTPUT PARAMETERS: - Info - error code: - * -3 internal eigenproblem solver hasn't converged - * -2 Beta[i]<=0 - * -1 incorrect N was passed - * 1 OK - X - array[0..N-1] - array of quadrature nodes, - in ascending order. - W - array[0..N-1] - array of quadrature weights. - - - -- ALGLIB -- - Copyright 2005-2009 by Bochkanov Sergey -*************************************************************************/ -void gqgenerategaussradaurec(const real_1d_array &alpha, const real_1d_array &beta, const double mu0, const double a, const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::gqgenerategaussradaurec(const_cast(alpha.c_ptr()), const_cast(beta.c_ptr()), mu0, a, n, &info, const_cast(x.c_ptr()), const_cast(w.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Returns nodes/weights for Gauss-Legendre quadrature on [-1,1] with N -nodes. - -INPUT PARAMETERS: - N - number of nodes, >=1 - -OUTPUT PARAMETERS: - Info - error code: - * -4 an error was detected when calculating - weights/nodes. N is too large to obtain - weights/nodes with high enough accuracy. - Try to use multiple precision version. - * -3 internal eigenproblem solver hasn't converged - * -1 incorrect N was passed - * +1 OK - X - array[0..N-1] - array of quadrature nodes, - in ascending order. - W - array[0..N-1] - array of quadrature weights. - - - -- ALGLIB -- - Copyright 12.05.2009 by Bochkanov Sergey -*************************************************************************/ -void gqgenerategausslegendre(const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::gqgenerategausslegendre(n, &info, const_cast(x.c_ptr()), const_cast(w.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Returns nodes/weights for Gauss-Jacobi quadrature on [-1,1] with weight -function W(x)=Power(1-x,Alpha)*Power(1+x,Beta). - -INPUT PARAMETERS: - N - number of nodes, >=1 - Alpha - power-law coefficient, Alpha>-1 - Beta - power-law coefficient, Beta>-1 - -OUTPUT PARAMETERS: - Info - error code: - * -4 an error was detected when calculating - weights/nodes. Alpha or Beta are too close - to -1 to obtain weights/nodes with high enough - accuracy, or, may be, N is too large. Try to - use multiple precision version. - * -3 internal eigenproblem solver hasn't converged - * -1 incorrect N/Alpha/Beta was passed - * +1 OK - X - array[0..N-1] - array of quadrature nodes, - in ascending order. - W - array[0..N-1] - array of quadrature weights. - - - -- ALGLIB -- - Copyright 12.05.2009 by Bochkanov Sergey -*************************************************************************/ -void gqgenerategaussjacobi(const ae_int_t n, const double alpha, const double beta, ae_int_t &info, real_1d_array &x, real_1d_array &w) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::gqgenerategaussjacobi(n, alpha, beta, &info, const_cast(x.c_ptr()), const_cast(w.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Returns nodes/weights for Gauss-Laguerre quadrature on [0,+inf) with -weight function W(x)=Power(x,Alpha)*Exp(-x) - -INPUT PARAMETERS: - N - number of nodes, >=1 - Alpha - power-law coefficient, Alpha>-1 - -OUTPUT PARAMETERS: - Info - error code: - * -4 an error was detected when calculating - weights/nodes. Alpha is too close to -1 to - obtain weights/nodes with high enough accuracy - or, may be, N is too large. Try to use - multiple precision version. - * -3 internal eigenproblem solver hasn't converged - * -1 incorrect N/Alpha was passed - * +1 OK - X - array[0..N-1] - array of quadrature nodes, - in ascending order. - W - array[0..N-1] - array of quadrature weights. - - - -- ALGLIB -- - Copyright 12.05.2009 by Bochkanov Sergey -*************************************************************************/ -void gqgenerategausslaguerre(const ae_int_t n, const double alpha, ae_int_t &info, real_1d_array &x, real_1d_array &w) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::gqgenerategausslaguerre(n, alpha, &info, const_cast(x.c_ptr()), const_cast(w.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Returns nodes/weights for Gauss-Hermite quadrature on (-inf,+inf) with -weight function W(x)=Exp(-x*x) - -INPUT PARAMETERS: - N - number of nodes, >=1 - -OUTPUT PARAMETERS: - Info - error code: - * -4 an error was detected when calculating - weights/nodes. May be, N is too large. Try to - use multiple precision version. - * -3 internal eigenproblem solver hasn't converged - * -1 incorrect N/Alpha was passed - * +1 OK - X - array[0..N-1] - array of quadrature nodes, - in ascending order. - W - array[0..N-1] - array of quadrature weights. - - - -- ALGLIB -- - Copyright 12.05.2009 by Bochkanov Sergey -*************************************************************************/ -void gqgenerategausshermite(const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::gqgenerategausshermite(n, &info, const_cast(x.c_ptr()), const_cast(w.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Computation of nodes and weights of a Gauss-Kronrod quadrature formula - -The algorithm generates the N-point Gauss-Kronrod quadrature formula with -weight function given by coefficients alpha and beta of a recurrence -relation which generates a system of orthogonal polynomials: - - P-1(x) = 0 - P0(x) = 1 - Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x) - -and zero moment Mu0 - - Mu0 = integral(W(x)dx,a,b) - - -INPUT PARAMETERS: - Alpha – alpha coefficients, array[0..floor(3*K/2)]. - Beta – beta coefficients, array[0..ceil(3*K/2)]. - Beta[0] is not used and may be arbitrary. - Beta[I]>0. - Mu0 – zeroth moment of the weight function. - N – number of nodes of the Gauss-Kronrod quadrature formula, - N >= 3, - N = 2*K+1. - -OUTPUT PARAMETERS: - Info - error code: - * -5 no real and positive Gauss-Kronrod formula can - be created for such a weight function with a - given number of nodes. - * -4 N is too large, task may be ill conditioned - - x[i]=x[i+1] found. - * -3 internal eigenproblem solver hasn't converged - * -2 Beta[i]<=0 - * -1 incorrect N was passed - * +1 OK - X - array[0..N-1] - array of quadrature nodes, - in ascending order. - WKronrod - array[0..N-1] - Kronrod weights - WGauss - array[0..N-1] - Gauss weights (interleaved with zeros - corresponding to extended Kronrod nodes). - - -- ALGLIB -- - Copyright 08.05.2009 by Bochkanov Sergey -*************************************************************************/ -void gkqgeneraterec(const real_1d_array &alpha, const real_1d_array &beta, const double mu0, const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::gkqgeneraterec(const_cast(alpha.c_ptr()), const_cast(beta.c_ptr()), mu0, n, &info, const_cast(x.c_ptr()), const_cast(wkronrod.c_ptr()), const_cast(wgauss.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Returns Gauss and Gauss-Kronrod nodes/weights for Gauss-Legendre -quadrature with N points. - -GKQLegendreCalc (calculation) or GKQLegendreTbl (precomputed table) is -used depending on machine precision and number of nodes. - -INPUT PARAMETERS: - N - number of Kronrod nodes, must be odd number, >=3. - -OUTPUT PARAMETERS: - Info - error code: - * -4 an error was detected when calculating - weights/nodes. N is too large to obtain - weights/nodes with high enough accuracy. - Try to use multiple precision version. - * -3 internal eigenproblem solver hasn't converged - * -1 incorrect N was passed - * +1 OK - X - array[0..N-1] - array of quadrature nodes, ordered in - ascending order. - WKronrod - array[0..N-1] - Kronrod weights - WGauss - array[0..N-1] - Gauss weights (interleaved with zeros - corresponding to extended Kronrod nodes). - - - -- ALGLIB -- - Copyright 12.05.2009 by Bochkanov Sergey -*************************************************************************/ -void gkqgenerategausslegendre(const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::gkqgenerategausslegendre(n, &info, const_cast(x.c_ptr()), const_cast(wkronrod.c_ptr()), const_cast(wgauss.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Returns Gauss and Gauss-Kronrod nodes/weights for Gauss-Jacobi -quadrature on [-1,1] with weight function - - W(x)=Power(1-x,Alpha)*Power(1+x,Beta). - -INPUT PARAMETERS: - N - number of Kronrod nodes, must be odd number, >=3. - Alpha - power-law coefficient, Alpha>-1 - Beta - power-law coefficient, Beta>-1 - -OUTPUT PARAMETERS: - Info - error code: - * -5 no real and positive Gauss-Kronrod formula can - be created for such a weight function with a - given number of nodes. - * -4 an error was detected when calculating - weights/nodes. Alpha or Beta are too close - to -1 to obtain weights/nodes with high enough - accuracy, or, may be, N is too large. Try to - use multiple precision version. - * -3 internal eigenproblem solver hasn't converged - * -1 incorrect N was passed - * +1 OK - * +2 OK, but quadrature rule have exterior nodes, - x[0]<-1 or x[n-1]>+1 - X - array[0..N-1] - array of quadrature nodes, ordered in - ascending order. - WKronrod - array[0..N-1] - Kronrod weights - WGauss - array[0..N-1] - Gauss weights (interleaved with zeros - corresponding to extended Kronrod nodes). - - - -- ALGLIB -- - Copyright 12.05.2009 by Bochkanov Sergey -*************************************************************************/ -void gkqgenerategaussjacobi(const ae_int_t n, const double alpha, const double beta, ae_int_t &info, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::gkqgenerategaussjacobi(n, alpha, beta, &info, const_cast(x.c_ptr()), const_cast(wkronrod.c_ptr()), const_cast(wgauss.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Returns Gauss and Gauss-Kronrod nodes for quadrature with N points. - -Reduction to tridiagonal eigenproblem is used. - -INPUT PARAMETERS: - N - number of Kronrod nodes, must be odd number, >=3. - -OUTPUT PARAMETERS: - Info - error code: - * -4 an error was detected when calculating - weights/nodes. N is too large to obtain - weights/nodes with high enough accuracy. - Try to use multiple precision version. - * -3 internal eigenproblem solver hasn't converged - * -1 incorrect N was passed - * +1 OK - X - array[0..N-1] - array of quadrature nodes, ordered in - ascending order. - WKronrod - array[0..N-1] - Kronrod weights - WGauss - array[0..N-1] - Gauss weights (interleaved with zeros - corresponding to extended Kronrod nodes). - - -- ALGLIB -- - Copyright 12.05.2009 by Bochkanov Sergey -*************************************************************************/ -void gkqlegendrecalc(const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::gkqlegendrecalc(n, &info, const_cast(x.c_ptr()), const_cast(wkronrod.c_ptr()), const_cast(wgauss.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Returns Gauss and Gauss-Kronrod nodes for quadrature with N points using -pre-calculated table. Nodes/weights were computed with accuracy up to -1.0E-32 (if MPFR version of ALGLIB is used). In standard double precision -accuracy reduces to something about 2.0E-16 (depending on your compiler's -handling of long floating point constants). - -INPUT PARAMETERS: - N - number of Kronrod nodes. - N can be 15, 21, 31, 41, 51, 61. - -OUTPUT PARAMETERS: - X - array[0..N-1] - array of quadrature nodes, ordered in - ascending order. - WKronrod - array[0..N-1] - Kronrod weights - WGauss - array[0..N-1] - Gauss weights (interleaved with zeros - corresponding to extended Kronrod nodes). - - - -- ALGLIB -- - Copyright 12.05.2009 by Bochkanov Sergey -*************************************************************************/ -void gkqlegendretbl(const ae_int_t n, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss, double &eps) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::gkqlegendretbl(n, const_cast(x.c_ptr()), const_cast(wkronrod.c_ptr()), const_cast(wgauss.c_ptr()), &eps, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Integration report: -* TerminationType = completion code: - * -5 non-convergence of Gauss-Kronrod nodes - calculation subroutine. - * -1 incorrect parameters were specified - * 1 OK -* Rep.NFEV contains number of function calculations -* Rep.NIntervals contains number of intervals [a,b] - was partitioned into. -*************************************************************************/ -_autogkreport_owner::_autogkreport_owner() -{ - p_struct = (alglib_impl::autogkreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::autogkreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_autogkreport_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_autogkreport_owner::_autogkreport_owner(const _autogkreport_owner &rhs) -{ - p_struct = (alglib_impl::autogkreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::autogkreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_autogkreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_autogkreport_owner& _autogkreport_owner::operator=(const _autogkreport_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_autogkreport_clear(p_struct); - if( !alglib_impl::_autogkreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_autogkreport_owner::~_autogkreport_owner() -{ - alglib_impl::_autogkreport_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::autogkreport* _autogkreport_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::autogkreport* _autogkreport_owner::c_ptr() const -{ - return const_cast(p_struct); -} -autogkreport::autogkreport() : _autogkreport_owner() ,terminationtype(p_struct->terminationtype),nfev(p_struct->nfev),nintervals(p_struct->nintervals) -{ -} - -autogkreport::autogkreport(const autogkreport &rhs):_autogkreport_owner(rhs) ,terminationtype(p_struct->terminationtype),nfev(p_struct->nfev),nintervals(p_struct->nintervals) -{ -} - -autogkreport& autogkreport::operator=(const autogkreport &rhs) -{ - if( this==&rhs ) - return *this; - _autogkreport_owner::operator=(rhs); - return *this; -} - -autogkreport::~autogkreport() -{ -} - - -/************************************************************************* -This structure stores state of the integration algorithm. - -Although this class has public fields, they are not intended for external -use. You should use ALGLIB functions to work with this class: -* autogksmooth()/AutoGKSmoothW()/... to create objects -* autogkintegrate() to begin integration -* autogkresults() to get results -*************************************************************************/ -_autogkstate_owner::_autogkstate_owner() -{ - p_struct = (alglib_impl::autogkstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::autogkstate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_autogkstate_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_autogkstate_owner::_autogkstate_owner(const _autogkstate_owner &rhs) -{ - p_struct = (alglib_impl::autogkstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::autogkstate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_autogkstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_autogkstate_owner& _autogkstate_owner::operator=(const _autogkstate_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_autogkstate_clear(p_struct); - if( !alglib_impl::_autogkstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_autogkstate_owner::~_autogkstate_owner() -{ - alglib_impl::_autogkstate_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::autogkstate* _autogkstate_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::autogkstate* _autogkstate_owner::c_ptr() const -{ - return const_cast(p_struct); -} -autogkstate::autogkstate() : _autogkstate_owner() ,needf(p_struct->needf),x(p_struct->x),xminusa(p_struct->xminusa),bminusx(p_struct->bminusx),f(p_struct->f) -{ -} - -autogkstate::autogkstate(const autogkstate &rhs):_autogkstate_owner(rhs) ,needf(p_struct->needf),x(p_struct->x),xminusa(p_struct->xminusa),bminusx(p_struct->bminusx),f(p_struct->f) -{ -} - -autogkstate& autogkstate::operator=(const autogkstate &rhs) -{ - if( this==&rhs ) - return *this; - _autogkstate_owner::operator=(rhs); - return *this; -} - -autogkstate::~autogkstate() -{ -} - -/************************************************************************* -Integration of a smooth function F(x) on a finite interval [a,b]. - -Fast-convergent algorithm based on a Gauss-Kronrod formula is used. Result -is calculated with accuracy close to the machine precision. - -Algorithm works well only with smooth integrands. It may be used with -continuous non-smooth integrands, but with less performance. - -It should never be used with integrands which have integrable singularities -at lower or upper limits - algorithm may crash. Use AutoGKSingular in such -cases. - -INPUT PARAMETERS: - A, B - interval boundaries (AB) - -OUTPUT PARAMETERS - State - structure which stores algorithm state - -SEE ALSO - AutoGKSmoothW, AutoGKSingular, AutoGKResults. - - - -- ALGLIB -- - Copyright 06.05.2009 by Bochkanov Sergey -*************************************************************************/ -void autogksmooth(const double a, const double b, autogkstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::autogksmooth(a, b, const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Integration of a smooth function F(x) on a finite interval [a,b]. - -This subroutine is same as AutoGKSmooth(), but it guarantees that interval -[a,b] is partitioned into subintervals which have width at most XWidth. - -Subroutine can be used when integrating nearly-constant function with -narrow "bumps" (about XWidth wide). If "bumps" are too narrow, AutoGKSmooth -subroutine can overlook them. - -INPUT PARAMETERS: - A, B - interval boundaries (AB) - -OUTPUT PARAMETERS - State - structure which stores algorithm state - -SEE ALSO - AutoGKSmooth, AutoGKSingular, AutoGKResults. - - - -- ALGLIB -- - Copyright 06.05.2009 by Bochkanov Sergey -*************************************************************************/ -void autogksmoothw(const double a, const double b, const double xwidth, autogkstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::autogksmoothw(a, b, xwidth, const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Integration on a finite interval [A,B]. -Integrand have integrable singularities at A/B. - -F(X) must diverge as "(x-A)^alpha" at A, as "(B-x)^beta" at B, with known -alpha/beta (alpha>-1, beta>-1). If alpha/beta are not known, estimates -from below can be used (but these estimates should be greater than -1 too). - -One of alpha/beta variables (or even both alpha/beta) may be equal to 0, -which means than function F(x) is non-singular at A/B. Anyway (singular at -bounds or not), function F(x) is supposed to be continuous on (A,B). - -Fast-convergent algorithm based on a Gauss-Kronrod formula is used. Result -is calculated with accuracy close to the machine precision. - -INPUT PARAMETERS: - A, B - interval boundaries (AB) - Alpha - power-law coefficient of the F(x) at A, - Alpha>-1 - Beta - power-law coefficient of the F(x) at B, - Beta>-1 - -OUTPUT PARAMETERS - State - structure which stores algorithm state - -SEE ALSO - AutoGKSmooth, AutoGKSmoothW, AutoGKResults. - - - -- ALGLIB -- - Copyright 06.05.2009 by Bochkanov Sergey -*************************************************************************/ -void autogksingular(const double a, const double b, const double alpha, const double beta, autogkstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::autogksingular(a, b, alpha, beta, const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function provides reverse communication interface -Reverse communication interface is not documented or recommended to use. -See below for functions which provide better documented API -*************************************************************************/ -bool autogkiteration(const autogkstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::autogkiteration(const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void autogkintegrate(autogkstate &state, - void (*func)(double x, double xminusa, double bminusx, double &y, void *ptr), - void *ptr){ - alglib_impl::ae_state _alglib_env_state; - if( func==NULL ) - throw ap_error("ALGLIB: error in 'autogkintegrate()' (func is NULL)"); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - while( alglib_impl::autogkiteration(state.c_ptr(), &_alglib_env_state) ) - { - if( state.needf ) - { - func(state.x, state.xminusa, state.bminusx, state.f, ptr); - continue; - } - throw ap_error("ALGLIB: unexpected error in 'autogkintegrate()'"); - } - alglib_impl::ae_state_clear(&_alglib_env_state); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - - -/************************************************************************* -Adaptive integration results - -Called after AutoGKIteration returned False. - -Input parameters: - State - algorithm state (used by AutoGKIteration). - -Output parameters: - V - integral(f(x)dx,a,b) - Rep - optimization report (see AutoGKReport description) - - -- ALGLIB -- - Copyright 14.11.2007 by Bochkanov Sergey -*************************************************************************/ -void autogkresults(const autogkstate &state, double &v, autogkreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::autogkresults(const_cast(state.c_ptr()), &v, const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS IMPLEMENTATION OF COMPUTATIONAL CORE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ - - - - -static ae_int_t autogk_maxsubintervals = 10000; -static void autogk_autogkinternalprepare(double a, - double b, - double eps, - double xwidth, - autogkinternalstate* state, - ae_state *_state); -static ae_bool autogk_autogkinternaliteration(autogkinternalstate* state, - ae_state *_state); -static void autogk_mheappop(/* Real */ ae_matrix* heap, - ae_int_t heapsize, - ae_int_t heapwidth, - ae_state *_state); -static void autogk_mheappush(/* Real */ ae_matrix* heap, - ae_int_t heapsize, - ae_int_t heapwidth, - ae_state *_state); -static void autogk_mheapresize(/* Real */ ae_matrix* heap, - ae_int_t* heapsize, - ae_int_t newheapsize, - ae_int_t heapwidth, - ae_state *_state); - - - - - -/************************************************************************* -Computation of nodes and weights for a Gauss quadrature formula - -The algorithm generates the N-point Gauss quadrature formula with weight -function given by coefficients alpha and beta of a recurrence relation -which generates a system of orthogonal polynomials: - -P-1(x) = 0 -P0(x) = 1 -Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x) - -and zeroth moment Mu0 - -Mu0 = integral(W(x)dx,a,b) - -INPUT PARAMETERS: - Alpha – array[0..N-1], alpha coefficients - Beta – array[0..N-1], beta coefficients - Zero-indexed element is not used and may be arbitrary. - Beta[I]>0. - Mu0 – zeroth moment of the weight function. - N – number of nodes of the quadrature formula, N>=1 - -OUTPUT PARAMETERS: - Info - error code: - * -3 internal eigenproblem solver hasn't converged - * -2 Beta[i]<=0 - * -1 incorrect N was passed - * 1 OK - X - array[0..N-1] - array of quadrature nodes, - in ascending order. - W - array[0..N-1] - array of quadrature weights. - - -- ALGLIB -- - Copyright 2005-2009 by Bochkanov Sergey -*************************************************************************/ -void gqgeneraterec(/* Real */ ae_vector* alpha, - /* Real */ ae_vector* beta, - double mu0, - ae_int_t n, - ae_int_t* info, - /* Real */ ae_vector* x, - /* Real */ ae_vector* w, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_vector d; - ae_vector e; - ae_matrix z; - - ae_frame_make(_state, &_frame_block); - *info = 0; - ae_vector_clear(x); - ae_vector_clear(w); - ae_vector_init(&d, 0, DT_REAL, _state, ae_true); - ae_vector_init(&e, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&z, 0, 0, DT_REAL, _state, ae_true); - - if( n<1 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - *info = 1; - - /* - * Initialize - */ - ae_vector_set_length(&d, n, _state); - ae_vector_set_length(&e, n, _state); - for(i=1; i<=n-1; i++) - { - d.ptr.p_double[i-1] = alpha->ptr.p_double[i-1]; - if( ae_fp_less_eq(beta->ptr.p_double[i],0) ) - { - *info = -2; - ae_frame_leave(_state); - return; - } - e.ptr.p_double[i-1] = ae_sqrt(beta->ptr.p_double[i], _state); - } - d.ptr.p_double[n-1] = alpha->ptr.p_double[n-1]; - - /* - * EVD - */ - if( !smatrixtdevd(&d, &e, n, 3, &z, _state) ) - { - *info = -3; - ae_frame_leave(_state); - return; - } - - /* - * Generate - */ - ae_vector_set_length(x, n, _state); - ae_vector_set_length(w, n, _state); - for(i=1; i<=n; i++) - { - x->ptr.p_double[i-1] = d.ptr.p_double[i-1]; - w->ptr.p_double[i-1] = mu0*ae_sqr(z.ptr.pp_double[0][i-1], _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Computation of nodes and weights for a Gauss-Lobatto quadrature formula - -The algorithm generates the N-point Gauss-Lobatto quadrature formula with -weight function given by coefficients alpha and beta of a recurrence which -generates a system of orthogonal polynomials. - -P-1(x) = 0 -P0(x) = 1 -Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x) - -and zeroth moment Mu0 - -Mu0 = integral(W(x)dx,a,b) - -INPUT PARAMETERS: - Alpha – array[0..N-2], alpha coefficients - Beta – array[0..N-2], beta coefficients. - Zero-indexed element is not used, may be arbitrary. - Beta[I]>0 - Mu0 – zeroth moment of the weighting function. - A – left boundary of the integration interval. - B – right boundary of the integration interval. - N – number of nodes of the quadrature formula, N>=3 - (including the left and right boundary nodes). - -OUTPUT PARAMETERS: - Info - error code: - * -3 internal eigenproblem solver hasn't converged - * -2 Beta[i]<=0 - * -1 incorrect N was passed - * 1 OK - X - array[0..N-1] - array of quadrature nodes, - in ascending order. - W - array[0..N-1] - array of quadrature weights. - - -- ALGLIB -- - Copyright 2005-2009 by Bochkanov Sergey -*************************************************************************/ -void gqgenerategausslobattorec(/* Real */ ae_vector* alpha, - /* Real */ ae_vector* beta, - double mu0, - double a, - double b, - ae_int_t n, - ae_int_t* info, - /* Real */ ae_vector* x, - /* Real */ ae_vector* w, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _alpha; - ae_vector _beta; - ae_int_t i; - ae_vector d; - ae_vector e; - ae_matrix z; - double pim1a; - double pia; - double pim1b; - double pib; - double t; - double a11; - double a12; - double a21; - double a22; - double b1; - double b2; - double alph; - double bet; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_alpha, alpha, _state, ae_true); - alpha = &_alpha; - ae_vector_init_copy(&_beta, beta, _state, ae_true); - beta = &_beta; - *info = 0; - ae_vector_clear(x); - ae_vector_clear(w); - ae_vector_init(&d, 0, DT_REAL, _state, ae_true); - ae_vector_init(&e, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&z, 0, 0, DT_REAL, _state, ae_true); - - if( n<=2 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - *info = 1; - - /* - * Initialize, D[1:N+1], E[1:N] - */ - n = n-2; - ae_vector_set_length(&d, n+2, _state); - ae_vector_set_length(&e, n+1, _state); - for(i=1; i<=n+1; i++) - { - d.ptr.p_double[i-1] = alpha->ptr.p_double[i-1]; - } - for(i=1; i<=n; i++) - { - if( ae_fp_less_eq(beta->ptr.p_double[i],0) ) - { - *info = -2; - ae_frame_leave(_state); - return; - } - e.ptr.p_double[i-1] = ae_sqrt(beta->ptr.p_double[i], _state); - } - - /* - * Caclulate Pn(a), Pn+1(a), Pn(b), Pn+1(b) - */ - beta->ptr.p_double[0] = 0; - pim1a = 0; - pia = 1; - pim1b = 0; - pib = 1; - for(i=1; i<=n+1; i++) - { - - /* - * Pi(a) - */ - t = (a-alpha->ptr.p_double[i-1])*pia-beta->ptr.p_double[i-1]*pim1a; - pim1a = pia; - pia = t; - - /* - * Pi(b) - */ - t = (b-alpha->ptr.p_double[i-1])*pib-beta->ptr.p_double[i-1]*pim1b; - pim1b = pib; - pib = t; - } - - /* - * Calculate alpha'(n+1), beta'(n+1) - */ - a11 = pia; - a12 = pim1a; - a21 = pib; - a22 = pim1b; - b1 = a*pia; - b2 = b*pib; - if( ae_fp_greater(ae_fabs(a11, _state),ae_fabs(a21, _state)) ) - { - a22 = a22-a12*a21/a11; - b2 = b2-b1*a21/a11; - bet = b2/a22; - alph = (b1-bet*a12)/a11; - } - else - { - a12 = a12-a22*a11/a21; - b1 = b1-b2*a11/a21; - bet = b1/a12; - alph = (b2-bet*a22)/a21; - } - if( ae_fp_less(bet,0) ) - { - *info = -3; - ae_frame_leave(_state); - return; - } - d.ptr.p_double[n+1] = alph; - e.ptr.p_double[n] = ae_sqrt(bet, _state); - - /* - * EVD - */ - if( !smatrixtdevd(&d, &e, n+2, 3, &z, _state) ) - { - *info = -3; - ae_frame_leave(_state); - return; - } - - /* - * Generate - */ - ae_vector_set_length(x, n+2, _state); - ae_vector_set_length(w, n+2, _state); - for(i=1; i<=n+2; i++) - { - x->ptr.p_double[i-1] = d.ptr.p_double[i-1]; - w->ptr.p_double[i-1] = mu0*ae_sqr(z.ptr.pp_double[0][i-1], _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Computation of nodes and weights for a Gauss-Radau quadrature formula - -The algorithm generates the N-point Gauss-Radau quadrature formula with -weight function given by the coefficients alpha and beta of a recurrence -which generates a system of orthogonal polynomials. - -P-1(x) = 0 -P0(x) = 1 -Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x) - -and zeroth moment Mu0 - -Mu0 = integral(W(x)dx,a,b) - -INPUT PARAMETERS: - Alpha – array[0..N-2], alpha coefficients. - Beta – array[0..N-1], beta coefficients - Zero-indexed element is not used. - Beta[I]>0 - Mu0 – zeroth moment of the weighting function. - A – left boundary of the integration interval. - N – number of nodes of the quadrature formula, N>=2 - (including the left boundary node). - -OUTPUT PARAMETERS: - Info - error code: - * -3 internal eigenproblem solver hasn't converged - * -2 Beta[i]<=0 - * -1 incorrect N was passed - * 1 OK - X - array[0..N-1] - array of quadrature nodes, - in ascending order. - W - array[0..N-1] - array of quadrature weights. - - - -- ALGLIB -- - Copyright 2005-2009 by Bochkanov Sergey -*************************************************************************/ -void gqgenerategaussradaurec(/* Real */ ae_vector* alpha, - /* Real */ ae_vector* beta, - double mu0, - double a, - ae_int_t n, - ae_int_t* info, - /* Real */ ae_vector* x, - /* Real */ ae_vector* w, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _alpha; - ae_vector _beta; - ae_int_t i; - ae_vector d; - ae_vector e; - ae_matrix z; - double polim1; - double poli; - double t; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_alpha, alpha, _state, ae_true); - alpha = &_alpha; - ae_vector_init_copy(&_beta, beta, _state, ae_true); - beta = &_beta; - *info = 0; - ae_vector_clear(x); - ae_vector_clear(w); - ae_vector_init(&d, 0, DT_REAL, _state, ae_true); - ae_vector_init(&e, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&z, 0, 0, DT_REAL, _state, ae_true); - - if( n<2 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - *info = 1; - - /* - * Initialize, D[1:N], E[1:N] - */ - n = n-1; - ae_vector_set_length(&d, n+1, _state); - ae_vector_set_length(&e, n, _state); - for(i=1; i<=n; i++) - { - d.ptr.p_double[i-1] = alpha->ptr.p_double[i-1]; - if( ae_fp_less_eq(beta->ptr.p_double[i],0) ) - { - *info = -2; - ae_frame_leave(_state); - return; - } - e.ptr.p_double[i-1] = ae_sqrt(beta->ptr.p_double[i], _state); - } - - /* - * Caclulate Pn(a), Pn-1(a), and D[N+1] - */ - beta->ptr.p_double[0] = 0; - polim1 = 0; - poli = 1; - for(i=1; i<=n; i++) - { - t = (a-alpha->ptr.p_double[i-1])*poli-beta->ptr.p_double[i-1]*polim1; - polim1 = poli; - poli = t; - } - d.ptr.p_double[n] = a-beta->ptr.p_double[n]*polim1/poli; - - /* - * EVD - */ - if( !smatrixtdevd(&d, &e, n+1, 3, &z, _state) ) - { - *info = -3; - ae_frame_leave(_state); - return; - } - - /* - * Generate - */ - ae_vector_set_length(x, n+1, _state); - ae_vector_set_length(w, n+1, _state); - for(i=1; i<=n+1; i++) - { - x->ptr.p_double[i-1] = d.ptr.p_double[i-1]; - w->ptr.p_double[i-1] = mu0*ae_sqr(z.ptr.pp_double[0][i-1], _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Returns nodes/weights for Gauss-Legendre quadrature on [-1,1] with N -nodes. - -INPUT PARAMETERS: - N - number of nodes, >=1 - -OUTPUT PARAMETERS: - Info - error code: - * -4 an error was detected when calculating - weights/nodes. N is too large to obtain - weights/nodes with high enough accuracy. - Try to use multiple precision version. - * -3 internal eigenproblem solver hasn't converged - * -1 incorrect N was passed - * +1 OK - X - array[0..N-1] - array of quadrature nodes, - in ascending order. - W - array[0..N-1] - array of quadrature weights. - - - -- ALGLIB -- - Copyright 12.05.2009 by Bochkanov Sergey -*************************************************************************/ -void gqgenerategausslegendre(ae_int_t n, - ae_int_t* info, - /* Real */ ae_vector* x, - /* Real */ ae_vector* w, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector alpha; - ae_vector beta; - ae_int_t i; - - ae_frame_make(_state, &_frame_block); - *info = 0; - ae_vector_clear(x); - ae_vector_clear(w); - ae_vector_init(&alpha, 0, DT_REAL, _state, ae_true); - ae_vector_init(&beta, 0, DT_REAL, _state, ae_true); - - if( n<1 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - ae_vector_set_length(&alpha, n, _state); - ae_vector_set_length(&beta, n, _state); - for(i=0; i<=n-1; i++) - { - alpha.ptr.p_double[i] = 0; - } - beta.ptr.p_double[0] = 2; - for(i=1; i<=n-1; i++) - { - beta.ptr.p_double[i] = 1/(4-1/ae_sqr(i, _state)); - } - gqgeneraterec(&alpha, &beta, beta.ptr.p_double[0], n, info, x, w, _state); - - /* - * test basic properties to detect errors - */ - if( *info>0 ) - { - if( ae_fp_less(x->ptr.p_double[0],-1)||ae_fp_greater(x->ptr.p_double[n-1],1) ) - { - *info = -4; - } - for(i=0; i<=n-2; i++) - { - if( ae_fp_greater_eq(x->ptr.p_double[i],x->ptr.p_double[i+1]) ) - { - *info = -4; - } - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Returns nodes/weights for Gauss-Jacobi quadrature on [-1,1] with weight -function W(x)=Power(1-x,Alpha)*Power(1+x,Beta). - -INPUT PARAMETERS: - N - number of nodes, >=1 - Alpha - power-law coefficient, Alpha>-1 - Beta - power-law coefficient, Beta>-1 - -OUTPUT PARAMETERS: - Info - error code: - * -4 an error was detected when calculating - weights/nodes. Alpha or Beta are too close - to -1 to obtain weights/nodes with high enough - accuracy, or, may be, N is too large. Try to - use multiple precision version. - * -3 internal eigenproblem solver hasn't converged - * -1 incorrect N/Alpha/Beta was passed - * +1 OK - X - array[0..N-1] - array of quadrature nodes, - in ascending order. - W - array[0..N-1] - array of quadrature weights. - - - -- ALGLIB -- - Copyright 12.05.2009 by Bochkanov Sergey -*************************************************************************/ -void gqgenerategaussjacobi(ae_int_t n, - double alpha, - double beta, - ae_int_t* info, - /* Real */ ae_vector* x, - /* Real */ ae_vector* w, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector a; - ae_vector b; - double alpha2; - double beta2; - double apb; - double t; - ae_int_t i; - double s; - - ae_frame_make(_state, &_frame_block); - *info = 0; - ae_vector_clear(x); - ae_vector_clear(w); - ae_vector_init(&a, 0, DT_REAL, _state, ae_true); - ae_vector_init(&b, 0, DT_REAL, _state, ae_true); - - if( (n<1||ae_fp_less_eq(alpha,-1))||ae_fp_less_eq(beta,-1) ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - ae_vector_set_length(&a, n, _state); - ae_vector_set_length(&b, n, _state); - apb = alpha+beta; - a.ptr.p_double[0] = (beta-alpha)/(apb+2); - t = (apb+1)*ae_log(2, _state)+lngamma(alpha+1, &s, _state)+lngamma(beta+1, &s, _state)-lngamma(apb+2, &s, _state); - if( ae_fp_greater(t,ae_log(ae_maxrealnumber, _state)) ) - { - *info = -4; - ae_frame_leave(_state); - return; - } - b.ptr.p_double[0] = ae_exp(t, _state); - if( n>1 ) - { - alpha2 = ae_sqr(alpha, _state); - beta2 = ae_sqr(beta, _state); - a.ptr.p_double[1] = (beta2-alpha2)/((apb+2)*(apb+4)); - b.ptr.p_double[1] = 4*(alpha+1)*(beta+1)/((apb+3)*ae_sqr(apb+2, _state)); - for(i=2; i<=n-1; i++) - { - a.ptr.p_double[i] = 0.25*(beta2-alpha2)/(i*i*(1+0.5*apb/i)*(1+0.5*(apb+2)/i)); - b.ptr.p_double[i] = 0.25*(1+alpha/i)*(1+beta/i)*(1+apb/i)/((1+0.5*(apb+1)/i)*(1+0.5*(apb-1)/i)*ae_sqr(1+0.5*apb/i, _state)); - } - } - gqgeneraterec(&a, &b, b.ptr.p_double[0], n, info, x, w, _state); - - /* - * test basic properties to detect errors - */ - if( *info>0 ) - { - if( ae_fp_less(x->ptr.p_double[0],-1)||ae_fp_greater(x->ptr.p_double[n-1],1) ) - { - *info = -4; - } - for(i=0; i<=n-2; i++) - { - if( ae_fp_greater_eq(x->ptr.p_double[i],x->ptr.p_double[i+1]) ) - { - *info = -4; - } - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Returns nodes/weights for Gauss-Laguerre quadrature on [0,+inf) with -weight function W(x)=Power(x,Alpha)*Exp(-x) - -INPUT PARAMETERS: - N - number of nodes, >=1 - Alpha - power-law coefficient, Alpha>-1 - -OUTPUT PARAMETERS: - Info - error code: - * -4 an error was detected when calculating - weights/nodes. Alpha is too close to -1 to - obtain weights/nodes with high enough accuracy - or, may be, N is too large. Try to use - multiple precision version. - * -3 internal eigenproblem solver hasn't converged - * -1 incorrect N/Alpha was passed - * +1 OK - X - array[0..N-1] - array of quadrature nodes, - in ascending order. - W - array[0..N-1] - array of quadrature weights. - - - -- ALGLIB -- - Copyright 12.05.2009 by Bochkanov Sergey -*************************************************************************/ -void gqgenerategausslaguerre(ae_int_t n, - double alpha, - ae_int_t* info, - /* Real */ ae_vector* x, - /* Real */ ae_vector* w, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector a; - ae_vector b; - double t; - ae_int_t i; - double s; - - ae_frame_make(_state, &_frame_block); - *info = 0; - ae_vector_clear(x); - ae_vector_clear(w); - ae_vector_init(&a, 0, DT_REAL, _state, ae_true); - ae_vector_init(&b, 0, DT_REAL, _state, ae_true); - - if( n<1||ae_fp_less_eq(alpha,-1) ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - ae_vector_set_length(&a, n, _state); - ae_vector_set_length(&b, n, _state); - a.ptr.p_double[0] = alpha+1; - t = lngamma(alpha+1, &s, _state); - if( ae_fp_greater_eq(t,ae_log(ae_maxrealnumber, _state)) ) - { - *info = -4; - ae_frame_leave(_state); - return; - } - b.ptr.p_double[0] = ae_exp(t, _state); - if( n>1 ) - { - for(i=1; i<=n-1; i++) - { - a.ptr.p_double[i] = 2*i+alpha+1; - b.ptr.p_double[i] = i*(i+alpha); - } - } - gqgeneraterec(&a, &b, b.ptr.p_double[0], n, info, x, w, _state); - - /* - * test basic properties to detect errors - */ - if( *info>0 ) - { - if( ae_fp_less(x->ptr.p_double[0],0) ) - { - *info = -4; - } - for(i=0; i<=n-2; i++) - { - if( ae_fp_greater_eq(x->ptr.p_double[i],x->ptr.p_double[i+1]) ) - { - *info = -4; - } - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Returns nodes/weights for Gauss-Hermite quadrature on (-inf,+inf) with -weight function W(x)=Exp(-x*x) - -INPUT PARAMETERS: - N - number of nodes, >=1 - -OUTPUT PARAMETERS: - Info - error code: - * -4 an error was detected when calculating - weights/nodes. May be, N is too large. Try to - use multiple precision version. - * -3 internal eigenproblem solver hasn't converged - * -1 incorrect N/Alpha was passed - * +1 OK - X - array[0..N-1] - array of quadrature nodes, - in ascending order. - W - array[0..N-1] - array of quadrature weights. - - - -- ALGLIB -- - Copyright 12.05.2009 by Bochkanov Sergey -*************************************************************************/ -void gqgenerategausshermite(ae_int_t n, - ae_int_t* info, - /* Real */ ae_vector* x, - /* Real */ ae_vector* w, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector a; - ae_vector b; - ae_int_t i; - - ae_frame_make(_state, &_frame_block); - *info = 0; - ae_vector_clear(x); - ae_vector_clear(w); - ae_vector_init(&a, 0, DT_REAL, _state, ae_true); - ae_vector_init(&b, 0, DT_REAL, _state, ae_true); - - if( n<1 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - ae_vector_set_length(&a, n, _state); - ae_vector_set_length(&b, n, _state); - for(i=0; i<=n-1; i++) - { - a.ptr.p_double[i] = 0; - } - b.ptr.p_double[0] = ae_sqrt(4*ae_atan(1, _state), _state); - if( n>1 ) - { - for(i=1; i<=n-1; i++) - { - b.ptr.p_double[i] = 0.5*i; - } - } - gqgeneraterec(&a, &b, b.ptr.p_double[0], n, info, x, w, _state); - - /* - * test basic properties to detect errors - */ - if( *info>0 ) - { - for(i=0; i<=n-2; i++) - { - if( ae_fp_greater_eq(x->ptr.p_double[i],x->ptr.p_double[i+1]) ) - { - *info = -4; - } - } - } - ae_frame_leave(_state); -} - - - - -/************************************************************************* -Computation of nodes and weights of a Gauss-Kronrod quadrature formula - -The algorithm generates the N-point Gauss-Kronrod quadrature formula with -weight function given by coefficients alpha and beta of a recurrence -relation which generates a system of orthogonal polynomials: - - P-1(x) = 0 - P0(x) = 1 - Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x) - -and zero moment Mu0 - - Mu0 = integral(W(x)dx,a,b) - - -INPUT PARAMETERS: - Alpha – alpha coefficients, array[0..floor(3*K/2)]. - Beta – beta coefficients, array[0..ceil(3*K/2)]. - Beta[0] is not used and may be arbitrary. - Beta[I]>0. - Mu0 – zeroth moment of the weight function. - N – number of nodes of the Gauss-Kronrod quadrature formula, - N >= 3, - N = 2*K+1. - -OUTPUT PARAMETERS: - Info - error code: - * -5 no real and positive Gauss-Kronrod formula can - be created for such a weight function with a - given number of nodes. - * -4 N is too large, task may be ill conditioned - - x[i]=x[i+1] found. - * -3 internal eigenproblem solver hasn't converged - * -2 Beta[i]<=0 - * -1 incorrect N was passed - * +1 OK - X - array[0..N-1] - array of quadrature nodes, - in ascending order. - WKronrod - array[0..N-1] - Kronrod weights - WGauss - array[0..N-1] - Gauss weights (interleaved with zeros - corresponding to extended Kronrod nodes). - - -- ALGLIB -- - Copyright 08.05.2009 by Bochkanov Sergey -*************************************************************************/ -void gkqgeneraterec(/* Real */ ae_vector* alpha, - /* Real */ ae_vector* beta, - double mu0, - ae_int_t n, - ae_int_t* info, - /* Real */ ae_vector* x, - /* Real */ ae_vector* wkronrod, - /* Real */ ae_vector* wgauss, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _alpha; - ae_vector _beta; - ae_vector ta; - ae_int_t i; - ae_int_t j; - ae_vector t; - ae_vector s; - ae_int_t wlen; - ae_int_t woffs; - double u; - ae_int_t m; - ae_int_t l; - ae_int_t k; - ae_vector xgtmp; - ae_vector wgtmp; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_alpha, alpha, _state, ae_true); - alpha = &_alpha; - ae_vector_init_copy(&_beta, beta, _state, ae_true); - beta = &_beta; - *info = 0; - ae_vector_clear(x); - ae_vector_clear(wkronrod); - ae_vector_clear(wgauss); - ae_vector_init(&ta, 0, DT_REAL, _state, ae_true); - ae_vector_init(&t, 0, DT_REAL, _state, ae_true); - ae_vector_init(&s, 0, DT_REAL, _state, ae_true); - ae_vector_init(&xgtmp, 0, DT_REAL, _state, ae_true); - ae_vector_init(&wgtmp, 0, DT_REAL, _state, ae_true); - - if( n%2!=1||n<3 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - for(i=0; i<=ae_iceil((double)(3*(n/2))/(double)2, _state); i++) - { - if( ae_fp_less_eq(beta->ptr.p_double[i],0) ) - { - *info = -2; - ae_frame_leave(_state); - return; - } - } - *info = 1; - - /* - * from external conventions about N/Beta/Mu0 to internal - */ - n = n/2; - beta->ptr.p_double[0] = mu0; - - /* - * Calculate Gauss nodes/weights, save them for later processing - */ - gqgeneraterec(alpha, beta, mu0, n, info, &xgtmp, &wgtmp, _state); - if( *info<0 ) - { - ae_frame_leave(_state); - return; - } - - /* - * Resize: - * * A from 0..floor(3*n/2) to 0..2*n - * * B from 0..ceil(3*n/2) to 0..2*n - */ - ae_vector_set_length(&ta, ae_ifloor((double)(3*n)/(double)2, _state)+1, _state); - ae_v_move(&ta.ptr.p_double[0], 1, &alpha->ptr.p_double[0], 1, ae_v_len(0,ae_ifloor((double)(3*n)/(double)2, _state))); - ae_vector_set_length(alpha, 2*n+1, _state); - ae_v_move(&alpha->ptr.p_double[0], 1, &ta.ptr.p_double[0], 1, ae_v_len(0,ae_ifloor((double)(3*n)/(double)2, _state))); - for(i=ae_ifloor((double)(3*n)/(double)2, _state)+1; i<=2*n; i++) - { - alpha->ptr.p_double[i] = 0; - } - ae_vector_set_length(&ta, ae_iceil((double)(3*n)/(double)2, _state)+1, _state); - ae_v_move(&ta.ptr.p_double[0], 1, &beta->ptr.p_double[0], 1, ae_v_len(0,ae_iceil((double)(3*n)/(double)2, _state))); - ae_vector_set_length(beta, 2*n+1, _state); - ae_v_move(&beta->ptr.p_double[0], 1, &ta.ptr.p_double[0], 1, ae_v_len(0,ae_iceil((double)(3*n)/(double)2, _state))); - for(i=ae_iceil((double)(3*n)/(double)2, _state)+1; i<=2*n; i++) - { - beta->ptr.p_double[i] = 0; - } - - /* - * Initialize T, S - */ - wlen = 2+n/2; - ae_vector_set_length(&t, wlen, _state); - ae_vector_set_length(&s, wlen, _state); - ae_vector_set_length(&ta, wlen, _state); - woffs = 1; - for(i=0; i<=wlen-1; i++) - { - t.ptr.p_double[i] = 0; - s.ptr.p_double[i] = 0; - } - - /* - * Algorithm from Dirk P. Laurie, "Calculation of Gauss-Kronrod quadrature rules", 1997. - */ - t.ptr.p_double[woffs+0] = beta->ptr.p_double[n+1]; - for(m=0; m<=n-2; m++) - { - u = 0; - for(k=(m+1)/2; k>=0; k--) - { - l = m-k; - u = u+(alpha->ptr.p_double[k+n+1]-alpha->ptr.p_double[l])*t.ptr.p_double[woffs+k]+beta->ptr.p_double[k+n+1]*s.ptr.p_double[woffs+k-1]-beta->ptr.p_double[l]*s.ptr.p_double[woffs+k]; - s.ptr.p_double[woffs+k] = u; - } - ae_v_move(&ta.ptr.p_double[0], 1, &t.ptr.p_double[0], 1, ae_v_len(0,wlen-1)); - ae_v_move(&t.ptr.p_double[0], 1, &s.ptr.p_double[0], 1, ae_v_len(0,wlen-1)); - ae_v_move(&s.ptr.p_double[0], 1, &ta.ptr.p_double[0], 1, ae_v_len(0,wlen-1)); - } - for(j=n/2; j>=0; j--) - { - s.ptr.p_double[woffs+j] = s.ptr.p_double[woffs+j-1]; - } - for(m=n-1; m<=2*n-3; m++) - { - u = 0; - for(k=m+1-n; k<=(m-1)/2; k++) - { - l = m-k; - j = n-1-l; - u = u-(alpha->ptr.p_double[k+n+1]-alpha->ptr.p_double[l])*t.ptr.p_double[woffs+j]-beta->ptr.p_double[k+n+1]*s.ptr.p_double[woffs+j]+beta->ptr.p_double[l]*s.ptr.p_double[woffs+j+1]; - s.ptr.p_double[woffs+j] = u; - } - if( m%2==0 ) - { - k = m/2; - alpha->ptr.p_double[k+n+1] = alpha->ptr.p_double[k]+(s.ptr.p_double[woffs+j]-beta->ptr.p_double[k+n+1]*s.ptr.p_double[woffs+j+1])/t.ptr.p_double[woffs+j+1]; - } - else - { - k = (m+1)/2; - beta->ptr.p_double[k+n+1] = s.ptr.p_double[woffs+j]/s.ptr.p_double[woffs+j+1]; - } - ae_v_move(&ta.ptr.p_double[0], 1, &t.ptr.p_double[0], 1, ae_v_len(0,wlen-1)); - ae_v_move(&t.ptr.p_double[0], 1, &s.ptr.p_double[0], 1, ae_v_len(0,wlen-1)); - ae_v_move(&s.ptr.p_double[0], 1, &ta.ptr.p_double[0], 1, ae_v_len(0,wlen-1)); - } - alpha->ptr.p_double[2*n] = alpha->ptr.p_double[n-1]-beta->ptr.p_double[2*n]*s.ptr.p_double[woffs+0]/t.ptr.p_double[woffs+0]; - - /* - * calculation of Kronrod nodes and weights, unpacking of Gauss weights - */ - gqgeneraterec(alpha, beta, mu0, 2*n+1, info, x, wkronrod, _state); - if( *info==-2 ) - { - *info = -5; - } - if( *info<0 ) - { - ae_frame_leave(_state); - return; - } - for(i=0; i<=2*n-1; i++) - { - if( ae_fp_greater_eq(x->ptr.p_double[i],x->ptr.p_double[i+1]) ) - { - *info = -4; - } - } - if( *info<0 ) - { - ae_frame_leave(_state); - return; - } - ae_vector_set_length(wgauss, 2*n+1, _state); - for(i=0; i<=2*n; i++) - { - wgauss->ptr.p_double[i] = 0; - } - for(i=0; i<=n-1; i++) - { - wgauss->ptr.p_double[2*i+1] = wgtmp.ptr.p_double[i]; - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Returns Gauss and Gauss-Kronrod nodes/weights for Gauss-Legendre -quadrature with N points. - -GKQLegendreCalc (calculation) or GKQLegendreTbl (precomputed table) is -used depending on machine precision and number of nodes. - -INPUT PARAMETERS: - N - number of Kronrod nodes, must be odd number, >=3. - -OUTPUT PARAMETERS: - Info - error code: - * -4 an error was detected when calculating - weights/nodes. N is too large to obtain - weights/nodes with high enough accuracy. - Try to use multiple precision version. - * -3 internal eigenproblem solver hasn't converged - * -1 incorrect N was passed - * +1 OK - X - array[0..N-1] - array of quadrature nodes, ordered in - ascending order. - WKronrod - array[0..N-1] - Kronrod weights - WGauss - array[0..N-1] - Gauss weights (interleaved with zeros - corresponding to extended Kronrod nodes). - - - -- ALGLIB -- - Copyright 12.05.2009 by Bochkanov Sergey -*************************************************************************/ -void gkqgenerategausslegendre(ae_int_t n, - ae_int_t* info, - /* Real */ ae_vector* x, - /* Real */ ae_vector* wkronrod, - /* Real */ ae_vector* wgauss, - ae_state *_state) -{ - double eps; - - *info = 0; - ae_vector_clear(x); - ae_vector_clear(wkronrod); - ae_vector_clear(wgauss); - - if( ae_fp_greater(ae_machineepsilon,1.0E-32)&&(((((n==15||n==21)||n==31)||n==41)||n==51)||n==61) ) - { - *info = 1; - gkqlegendretbl(n, x, wkronrod, wgauss, &eps, _state); - } - else - { - gkqlegendrecalc(n, info, x, wkronrod, wgauss, _state); - } -} - - -/************************************************************************* -Returns Gauss and Gauss-Kronrod nodes/weights for Gauss-Jacobi -quadrature on [-1,1] with weight function - - W(x)=Power(1-x,Alpha)*Power(1+x,Beta). - -INPUT PARAMETERS: - N - number of Kronrod nodes, must be odd number, >=3. - Alpha - power-law coefficient, Alpha>-1 - Beta - power-law coefficient, Beta>-1 - -OUTPUT PARAMETERS: - Info - error code: - * -5 no real and positive Gauss-Kronrod formula can - be created for such a weight function with a - given number of nodes. - * -4 an error was detected when calculating - weights/nodes. Alpha or Beta are too close - to -1 to obtain weights/nodes with high enough - accuracy, or, may be, N is too large. Try to - use multiple precision version. - * -3 internal eigenproblem solver hasn't converged - * -1 incorrect N was passed - * +1 OK - * +2 OK, but quadrature rule have exterior nodes, - x[0]<-1 or x[n-1]>+1 - X - array[0..N-1] - array of quadrature nodes, ordered in - ascending order. - WKronrod - array[0..N-1] - Kronrod weights - WGauss - array[0..N-1] - Gauss weights (interleaved with zeros - corresponding to extended Kronrod nodes). - - - -- ALGLIB -- - Copyright 12.05.2009 by Bochkanov Sergey -*************************************************************************/ -void gkqgenerategaussjacobi(ae_int_t n, - double alpha, - double beta, - ae_int_t* info, - /* Real */ ae_vector* x, - /* Real */ ae_vector* wkronrod, - /* Real */ ae_vector* wgauss, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t clen; - ae_vector a; - ae_vector b; - double alpha2; - double beta2; - double apb; - double t; - ae_int_t i; - double s; - - ae_frame_make(_state, &_frame_block); - *info = 0; - ae_vector_clear(x); - ae_vector_clear(wkronrod); - ae_vector_clear(wgauss); - ae_vector_init(&a, 0, DT_REAL, _state, ae_true); - ae_vector_init(&b, 0, DT_REAL, _state, ae_true); - - if( n%2!=1||n<3 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - if( ae_fp_less_eq(alpha,-1)||ae_fp_less_eq(beta,-1) ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - clen = ae_iceil((double)(3*(n/2))/(double)2, _state)+1; - ae_vector_set_length(&a, clen, _state); - ae_vector_set_length(&b, clen, _state); - for(i=0; i<=clen-1; i++) - { - a.ptr.p_double[i] = 0; - } - apb = alpha+beta; - a.ptr.p_double[0] = (beta-alpha)/(apb+2); - t = (apb+1)*ae_log(2, _state)+lngamma(alpha+1, &s, _state)+lngamma(beta+1, &s, _state)-lngamma(apb+2, &s, _state); - if( ae_fp_greater(t,ae_log(ae_maxrealnumber, _state)) ) - { - *info = -4; - ae_frame_leave(_state); - return; - } - b.ptr.p_double[0] = ae_exp(t, _state); - if( clen>1 ) - { - alpha2 = ae_sqr(alpha, _state); - beta2 = ae_sqr(beta, _state); - a.ptr.p_double[1] = (beta2-alpha2)/((apb+2)*(apb+4)); - b.ptr.p_double[1] = 4*(alpha+1)*(beta+1)/((apb+3)*ae_sqr(apb+2, _state)); - for(i=2; i<=clen-1; i++) - { - a.ptr.p_double[i] = 0.25*(beta2-alpha2)/(i*i*(1+0.5*apb/i)*(1+0.5*(apb+2)/i)); - b.ptr.p_double[i] = 0.25*(1+alpha/i)*(1+beta/i)*(1+apb/i)/((1+0.5*(apb+1)/i)*(1+0.5*(apb-1)/i)*ae_sqr(1+0.5*apb/i, _state)); - } - } - gkqgeneraterec(&a, &b, b.ptr.p_double[0], n, info, x, wkronrod, wgauss, _state); - - /* - * test basic properties to detect errors - */ - if( *info>0 ) - { - if( ae_fp_less(x->ptr.p_double[0],-1)||ae_fp_greater(x->ptr.p_double[n-1],1) ) - { - *info = 2; - } - for(i=0; i<=n-2; i++) - { - if( ae_fp_greater_eq(x->ptr.p_double[i],x->ptr.p_double[i+1]) ) - { - *info = -4; - } - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Returns Gauss and Gauss-Kronrod nodes for quadrature with N points. - -Reduction to tridiagonal eigenproblem is used. - -INPUT PARAMETERS: - N - number of Kronrod nodes, must be odd number, >=3. - -OUTPUT PARAMETERS: - Info - error code: - * -4 an error was detected when calculating - weights/nodes. N is too large to obtain - weights/nodes with high enough accuracy. - Try to use multiple precision version. - * -3 internal eigenproblem solver hasn't converged - * -1 incorrect N was passed - * +1 OK - X - array[0..N-1] - array of quadrature nodes, ordered in - ascending order. - WKronrod - array[0..N-1] - Kronrod weights - WGauss - array[0..N-1] - Gauss weights (interleaved with zeros - corresponding to extended Kronrod nodes). - - -- ALGLIB -- - Copyright 12.05.2009 by Bochkanov Sergey -*************************************************************************/ -void gkqlegendrecalc(ae_int_t n, - ae_int_t* info, - /* Real */ ae_vector* x, - /* Real */ ae_vector* wkronrod, - /* Real */ ae_vector* wgauss, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector alpha; - ae_vector beta; - ae_int_t alen; - ae_int_t blen; - double mu0; - ae_int_t k; - ae_int_t i; - - ae_frame_make(_state, &_frame_block); - *info = 0; - ae_vector_clear(x); - ae_vector_clear(wkronrod); - ae_vector_clear(wgauss); - ae_vector_init(&alpha, 0, DT_REAL, _state, ae_true); - ae_vector_init(&beta, 0, DT_REAL, _state, ae_true); - - if( n%2!=1||n<3 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - mu0 = 2; - alen = ae_ifloor((double)(3*(n/2))/(double)2, _state)+1; - blen = ae_iceil((double)(3*(n/2))/(double)2, _state)+1; - ae_vector_set_length(&alpha, alen, _state); - ae_vector_set_length(&beta, blen, _state); - for(k=0; k<=alen-1; k++) - { - alpha.ptr.p_double[k] = 0; - } - beta.ptr.p_double[0] = 2; - for(k=1; k<=blen-1; k++) - { - beta.ptr.p_double[k] = 1/(4-1/ae_sqr(k, _state)); - } - gkqgeneraterec(&alpha, &beta, mu0, n, info, x, wkronrod, wgauss, _state); - - /* - * test basic properties to detect errors - */ - if( *info>0 ) - { - if( ae_fp_less(x->ptr.p_double[0],-1)||ae_fp_greater(x->ptr.p_double[n-1],1) ) - { - *info = -4; - } - for(i=0; i<=n-2; i++) - { - if( ae_fp_greater_eq(x->ptr.p_double[i],x->ptr.p_double[i+1]) ) - { - *info = -4; - } - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Returns Gauss and Gauss-Kronrod nodes for quadrature with N points using -pre-calculated table. Nodes/weights were computed with accuracy up to -1.0E-32 (if MPFR version of ALGLIB is used). In standard double precision -accuracy reduces to something about 2.0E-16 (depending on your compiler's -handling of long floating point constants). - -INPUT PARAMETERS: - N - number of Kronrod nodes. - N can be 15, 21, 31, 41, 51, 61. - -OUTPUT PARAMETERS: - X - array[0..N-1] - array of quadrature nodes, ordered in - ascending order. - WKronrod - array[0..N-1] - Kronrod weights - WGauss - array[0..N-1] - Gauss weights (interleaved with zeros - corresponding to extended Kronrod nodes). - - - -- ALGLIB -- - Copyright 12.05.2009 by Bochkanov Sergey -*************************************************************************/ -void gkqlegendretbl(ae_int_t n, - /* Real */ ae_vector* x, - /* Real */ ae_vector* wkronrod, - /* Real */ ae_vector* wgauss, - double* eps, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t ng; - ae_vector p1; - ae_vector p2; - double tmp; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(x); - ae_vector_clear(wkronrod); - ae_vector_clear(wgauss); - *eps = 0; - ae_vector_init(&p1, 0, DT_INT, _state, ae_true); - ae_vector_init(&p2, 0, DT_INT, _state, ae_true); - - - /* - * these initializers are not really necessary, - * but without them compiler complains about uninitialized locals - */ - ng = 0; - - /* - * Process - */ - ae_assert(((((n==15||n==21)||n==31)||n==41)||n==51)||n==61, "GKQNodesTbl: incorrect N!", _state); - ae_vector_set_length(x, n, _state); - ae_vector_set_length(wkronrod, n, _state); - ae_vector_set_length(wgauss, n, _state); - for(i=0; i<=n-1; i++) - { - x->ptr.p_double[i] = 0; - wkronrod->ptr.p_double[i] = 0; - wgauss->ptr.p_double[i] = 0; - } - *eps = ae_maxreal(ae_machineepsilon, 1.0E-32, _state); - if( n==15 ) - { - ng = 4; - wgauss->ptr.p_double[0] = 0.129484966168869693270611432679082; - wgauss->ptr.p_double[1] = 0.279705391489276667901467771423780; - wgauss->ptr.p_double[2] = 0.381830050505118944950369775488975; - wgauss->ptr.p_double[3] = 0.417959183673469387755102040816327; - x->ptr.p_double[0] = 0.991455371120812639206854697526329; - x->ptr.p_double[1] = 0.949107912342758524526189684047851; - x->ptr.p_double[2] = 0.864864423359769072789712788640926; - x->ptr.p_double[3] = 0.741531185599394439863864773280788; - x->ptr.p_double[4] = 0.586087235467691130294144838258730; - x->ptr.p_double[5] = 0.405845151377397166906606412076961; - x->ptr.p_double[6] = 0.207784955007898467600689403773245; - x->ptr.p_double[7] = 0.000000000000000000000000000000000; - wkronrod->ptr.p_double[0] = 0.022935322010529224963732008058970; - wkronrod->ptr.p_double[1] = 0.063092092629978553290700663189204; - wkronrod->ptr.p_double[2] = 0.104790010322250183839876322541518; - wkronrod->ptr.p_double[3] = 0.140653259715525918745189590510238; - wkronrod->ptr.p_double[4] = 0.169004726639267902826583426598550; - wkronrod->ptr.p_double[5] = 0.190350578064785409913256402421014; - wkronrod->ptr.p_double[6] = 0.204432940075298892414161999234649; - wkronrod->ptr.p_double[7] = 0.209482141084727828012999174891714; - } - if( n==21 ) - { - ng = 5; - wgauss->ptr.p_double[0] = 0.066671344308688137593568809893332; - wgauss->ptr.p_double[1] = 0.149451349150580593145776339657697; - wgauss->ptr.p_double[2] = 0.219086362515982043995534934228163; - wgauss->ptr.p_double[3] = 0.269266719309996355091226921569469; - wgauss->ptr.p_double[4] = 0.295524224714752870173892994651338; - x->ptr.p_double[0] = 0.995657163025808080735527280689003; - x->ptr.p_double[1] = 0.973906528517171720077964012084452; - x->ptr.p_double[2] = 0.930157491355708226001207180059508; - x->ptr.p_double[3] = 0.865063366688984510732096688423493; - x->ptr.p_double[4] = 0.780817726586416897063717578345042; - x->ptr.p_double[5] = 0.679409568299024406234327365114874; - x->ptr.p_double[6] = 0.562757134668604683339000099272694; - x->ptr.p_double[7] = 0.433395394129247190799265943165784; - x->ptr.p_double[8] = 0.294392862701460198131126603103866; - x->ptr.p_double[9] = 0.148874338981631210884826001129720; - x->ptr.p_double[10] = 0.000000000000000000000000000000000; - wkronrod->ptr.p_double[0] = 0.011694638867371874278064396062192; - wkronrod->ptr.p_double[1] = 0.032558162307964727478818972459390; - wkronrod->ptr.p_double[2] = 0.054755896574351996031381300244580; - wkronrod->ptr.p_double[3] = 0.075039674810919952767043140916190; - wkronrod->ptr.p_double[4] = 0.093125454583697605535065465083366; - wkronrod->ptr.p_double[5] = 0.109387158802297641899210590325805; - wkronrod->ptr.p_double[6] = 0.123491976262065851077958109831074; - wkronrod->ptr.p_double[7] = 0.134709217311473325928054001771707; - wkronrod->ptr.p_double[8] = 0.142775938577060080797094273138717; - wkronrod->ptr.p_double[9] = 0.147739104901338491374841515972068; - wkronrod->ptr.p_double[10] = 0.149445554002916905664936468389821; - } - if( n==31 ) - { - ng = 8; - wgauss->ptr.p_double[0] = 0.030753241996117268354628393577204; - wgauss->ptr.p_double[1] = 0.070366047488108124709267416450667; - wgauss->ptr.p_double[2] = 0.107159220467171935011869546685869; - wgauss->ptr.p_double[3] = 0.139570677926154314447804794511028; - wgauss->ptr.p_double[4] = 0.166269205816993933553200860481209; - wgauss->ptr.p_double[5] = 0.186161000015562211026800561866423; - wgauss->ptr.p_double[6] = 0.198431485327111576456118326443839; - wgauss->ptr.p_double[7] = 0.202578241925561272880620199967519; - x->ptr.p_double[0] = 0.998002298693397060285172840152271; - x->ptr.p_double[1] = 0.987992518020485428489565718586613; - x->ptr.p_double[2] = 0.967739075679139134257347978784337; - x->ptr.p_double[3] = 0.937273392400705904307758947710209; - x->ptr.p_double[4] = 0.897264532344081900882509656454496; - x->ptr.p_double[5] = 0.848206583410427216200648320774217; - x->ptr.p_double[6] = 0.790418501442465932967649294817947; - x->ptr.p_double[7] = 0.724417731360170047416186054613938; - x->ptr.p_double[8] = 0.650996741297416970533735895313275; - x->ptr.p_double[9] = 0.570972172608538847537226737253911; - x->ptr.p_double[10] = 0.485081863640239680693655740232351; - x->ptr.p_double[11] = 0.394151347077563369897207370981045; - x->ptr.p_double[12] = 0.299180007153168812166780024266389; - x->ptr.p_double[13] = 0.201194093997434522300628303394596; - x->ptr.p_double[14] = 0.101142066918717499027074231447392; - x->ptr.p_double[15] = 0.000000000000000000000000000000000; - wkronrod->ptr.p_double[0] = 0.005377479872923348987792051430128; - wkronrod->ptr.p_double[1] = 0.015007947329316122538374763075807; - wkronrod->ptr.p_double[2] = 0.025460847326715320186874001019653; - wkronrod->ptr.p_double[3] = 0.035346360791375846222037948478360; - wkronrod->ptr.p_double[4] = 0.044589751324764876608227299373280; - wkronrod->ptr.p_double[5] = 0.053481524690928087265343147239430; - wkronrod->ptr.p_double[6] = 0.062009567800670640285139230960803; - wkronrod->ptr.p_double[7] = 0.069854121318728258709520077099147; - wkronrod->ptr.p_double[8] = 0.076849680757720378894432777482659; - wkronrod->ptr.p_double[9] = 0.083080502823133021038289247286104; - wkronrod->ptr.p_double[10] = 0.088564443056211770647275443693774; - wkronrod->ptr.p_double[11] = 0.093126598170825321225486872747346; - wkronrod->ptr.p_double[12] = 0.096642726983623678505179907627589; - wkronrod->ptr.p_double[13] = 0.099173598721791959332393173484603; - wkronrod->ptr.p_double[14] = 0.100769845523875595044946662617570; - wkronrod->ptr.p_double[15] = 0.101330007014791549017374792767493; - } - if( n==41 ) - { - ng = 10; - wgauss->ptr.p_double[0] = 0.017614007139152118311861962351853; - wgauss->ptr.p_double[1] = 0.040601429800386941331039952274932; - wgauss->ptr.p_double[2] = 0.062672048334109063569506535187042; - wgauss->ptr.p_double[3] = 0.083276741576704748724758143222046; - wgauss->ptr.p_double[4] = 0.101930119817240435036750135480350; - wgauss->ptr.p_double[5] = 0.118194531961518417312377377711382; - wgauss->ptr.p_double[6] = 0.131688638449176626898494499748163; - wgauss->ptr.p_double[7] = 0.142096109318382051329298325067165; - wgauss->ptr.p_double[8] = 0.149172986472603746787828737001969; - wgauss->ptr.p_double[9] = 0.152753387130725850698084331955098; - x->ptr.p_double[0] = 0.998859031588277663838315576545863; - x->ptr.p_double[1] = 0.993128599185094924786122388471320; - x->ptr.p_double[2] = 0.981507877450250259193342994720217; - x->ptr.p_double[3] = 0.963971927277913791267666131197277; - x->ptr.p_double[4] = 0.940822633831754753519982722212443; - x->ptr.p_double[5] = 0.912234428251325905867752441203298; - x->ptr.p_double[6] = 0.878276811252281976077442995113078; - x->ptr.p_double[7] = 0.839116971822218823394529061701521; - x->ptr.p_double[8] = 0.795041428837551198350638833272788; - x->ptr.p_double[9] = 0.746331906460150792614305070355642; - x->ptr.p_double[10] = 0.693237656334751384805490711845932; - x->ptr.p_double[11] = 0.636053680726515025452836696226286; - x->ptr.p_double[12] = 0.575140446819710315342946036586425; - x->ptr.p_double[13] = 0.510867001950827098004364050955251; - x->ptr.p_double[14] = 0.443593175238725103199992213492640; - x->ptr.p_double[15] = 0.373706088715419560672548177024927; - x->ptr.p_double[16] = 0.301627868114913004320555356858592; - x->ptr.p_double[17] = 0.227785851141645078080496195368575; - x->ptr.p_double[18] = 0.152605465240922675505220241022678; - x->ptr.p_double[19] = 0.076526521133497333754640409398838; - x->ptr.p_double[20] = 0.000000000000000000000000000000000; - wkronrod->ptr.p_double[0] = 0.003073583718520531501218293246031; - wkronrod->ptr.p_double[1] = 0.008600269855642942198661787950102; - wkronrod->ptr.p_double[2] = 0.014626169256971252983787960308868; - wkronrod->ptr.p_double[3] = 0.020388373461266523598010231432755; - wkronrod->ptr.p_double[4] = 0.025882133604951158834505067096153; - wkronrod->ptr.p_double[5] = 0.031287306777032798958543119323801; - wkronrod->ptr.p_double[6] = 0.036600169758200798030557240707211; - wkronrod->ptr.p_double[7] = 0.041668873327973686263788305936895; - wkronrod->ptr.p_double[8] = 0.046434821867497674720231880926108; - wkronrod->ptr.p_double[9] = 0.050944573923728691932707670050345; - wkronrod->ptr.p_double[10] = 0.055195105348285994744832372419777; - wkronrod->ptr.p_double[11] = 0.059111400880639572374967220648594; - wkronrod->ptr.p_double[12] = 0.062653237554781168025870122174255; - wkronrod->ptr.p_double[13] = 0.065834597133618422111563556969398; - wkronrod->ptr.p_double[14] = 0.068648672928521619345623411885368; - wkronrod->ptr.p_double[15] = 0.071054423553444068305790361723210; - wkronrod->ptr.p_double[16] = 0.073030690332786667495189417658913; - wkronrod->ptr.p_double[17] = 0.074582875400499188986581418362488; - wkronrod->ptr.p_double[18] = 0.075704497684556674659542775376617; - wkronrod->ptr.p_double[19] = 0.076377867672080736705502835038061; - wkronrod->ptr.p_double[20] = 0.076600711917999656445049901530102; - } - if( n==51 ) - { - ng = 13; - wgauss->ptr.p_double[0] = 0.011393798501026287947902964113235; - wgauss->ptr.p_double[1] = 0.026354986615032137261901815295299; - wgauss->ptr.p_double[2] = 0.040939156701306312655623487711646; - wgauss->ptr.p_double[3] = 0.054904695975835191925936891540473; - wgauss->ptr.p_double[4] = 0.068038333812356917207187185656708; - wgauss->ptr.p_double[5] = 0.080140700335001018013234959669111; - wgauss->ptr.p_double[6] = 0.091028261982963649811497220702892; - wgauss->ptr.p_double[7] = 0.100535949067050644202206890392686; - wgauss->ptr.p_double[8] = 0.108519624474263653116093957050117; - wgauss->ptr.p_double[9] = 0.114858259145711648339325545869556; - wgauss->ptr.p_double[10] = 0.119455763535784772228178126512901; - wgauss->ptr.p_double[11] = 0.122242442990310041688959518945852; - wgauss->ptr.p_double[12] = 0.123176053726715451203902873079050; - x->ptr.p_double[0] = 0.999262104992609834193457486540341; - x->ptr.p_double[1] = 0.995556969790498097908784946893902; - x->ptr.p_double[2] = 0.988035794534077247637331014577406; - x->ptr.p_double[3] = 0.976663921459517511498315386479594; - x->ptr.p_double[4] = 0.961614986425842512418130033660167; - x->ptr.p_double[5] = 0.942974571228974339414011169658471; - x->ptr.p_double[6] = 0.920747115281701561746346084546331; - x->ptr.p_double[7] = 0.894991997878275368851042006782805; - x->ptr.p_double[8] = 0.865847065293275595448996969588340; - x->ptr.p_double[9] = 0.833442628760834001421021108693570; - x->ptr.p_double[10] = 0.797873797998500059410410904994307; - x->ptr.p_double[11] = 0.759259263037357630577282865204361; - x->ptr.p_double[12] = 0.717766406813084388186654079773298; - x->ptr.p_double[13] = 0.673566368473468364485120633247622; - x->ptr.p_double[14] = 0.626810099010317412788122681624518; - x->ptr.p_double[15] = 0.577662930241222967723689841612654; - x->ptr.p_double[16] = 0.526325284334719182599623778158010; - x->ptr.p_double[17] = 0.473002731445714960522182115009192; - x->ptr.p_double[18] = 0.417885382193037748851814394594572; - x->ptr.p_double[19] = 0.361172305809387837735821730127641; - x->ptr.p_double[20] = 0.303089538931107830167478909980339; - x->ptr.p_double[21] = 0.243866883720988432045190362797452; - x->ptr.p_double[22] = 0.183718939421048892015969888759528; - x->ptr.p_double[23] = 0.122864692610710396387359818808037; - x->ptr.p_double[24] = 0.061544483005685078886546392366797; - x->ptr.p_double[25] = 0.000000000000000000000000000000000; - wkronrod->ptr.p_double[0] = 0.001987383892330315926507851882843; - wkronrod->ptr.p_double[1] = 0.005561932135356713758040236901066; - wkronrod->ptr.p_double[2] = 0.009473973386174151607207710523655; - wkronrod->ptr.p_double[3] = 0.013236229195571674813656405846976; - wkronrod->ptr.p_double[4] = 0.016847817709128298231516667536336; - wkronrod->ptr.p_double[5] = 0.020435371145882835456568292235939; - wkronrod->ptr.p_double[6] = 0.024009945606953216220092489164881; - wkronrod->ptr.p_double[7] = 0.027475317587851737802948455517811; - wkronrod->ptr.p_double[8] = 0.030792300167387488891109020215229; - wkronrod->ptr.p_double[9] = 0.034002130274329337836748795229551; - wkronrod->ptr.p_double[10] = 0.037116271483415543560330625367620; - wkronrod->ptr.p_double[11] = 0.040083825504032382074839284467076; - wkronrod->ptr.p_double[12] = 0.042872845020170049476895792439495; - wkronrod->ptr.p_double[13] = 0.045502913049921788909870584752660; - wkronrod->ptr.p_double[14] = 0.047982537138836713906392255756915; - wkronrod->ptr.p_double[15] = 0.050277679080715671963325259433440; - wkronrod->ptr.p_double[16] = 0.052362885806407475864366712137873; - wkronrod->ptr.p_double[17] = 0.054251129888545490144543370459876; - wkronrod->ptr.p_double[18] = 0.055950811220412317308240686382747; - wkronrod->ptr.p_double[19] = 0.057437116361567832853582693939506; - wkronrod->ptr.p_double[20] = 0.058689680022394207961974175856788; - wkronrod->ptr.p_double[21] = 0.059720340324174059979099291932562; - wkronrod->ptr.p_double[22] = 0.060539455376045862945360267517565; - wkronrod->ptr.p_double[23] = 0.061128509717053048305859030416293; - wkronrod->ptr.p_double[24] = 0.061471189871425316661544131965264; - wkronrod->ptr.p_double[25] = 0.061580818067832935078759824240055; - } - if( n==61 ) - { - ng = 15; - wgauss->ptr.p_double[0] = 0.007968192496166605615465883474674; - wgauss->ptr.p_double[1] = 0.018466468311090959142302131912047; - wgauss->ptr.p_double[2] = 0.028784707883323369349719179611292; - wgauss->ptr.p_double[3] = 0.038799192569627049596801936446348; - wgauss->ptr.p_double[4] = 0.048402672830594052902938140422808; - wgauss->ptr.p_double[5] = 0.057493156217619066481721689402056; - wgauss->ptr.p_double[6] = 0.065974229882180495128128515115962; - wgauss->ptr.p_double[7] = 0.073755974737705206268243850022191; - wgauss->ptr.p_double[8] = 0.080755895229420215354694938460530; - wgauss->ptr.p_double[9] = 0.086899787201082979802387530715126; - wgauss->ptr.p_double[10] = 0.092122522237786128717632707087619; - wgauss->ptr.p_double[11] = 0.096368737174644259639468626351810; - wgauss->ptr.p_double[12] = 0.099593420586795267062780282103569; - wgauss->ptr.p_double[13] = 0.101762389748405504596428952168554; - wgauss->ptr.p_double[14] = 0.102852652893558840341285636705415; - x->ptr.p_double[0] = 0.999484410050490637571325895705811; - x->ptr.p_double[1] = 0.996893484074649540271630050918695; - x->ptr.p_double[2] = 0.991630996870404594858628366109486; - x->ptr.p_double[3] = 0.983668123279747209970032581605663; - x->ptr.p_double[4] = 0.973116322501126268374693868423707; - x->ptr.p_double[5] = 0.960021864968307512216871025581798; - x->ptr.p_double[6] = 0.944374444748559979415831324037439; - x->ptr.p_double[7] = 0.926200047429274325879324277080474; - x->ptr.p_double[8] = 0.905573307699907798546522558925958; - x->ptr.p_double[9] = 0.882560535792052681543116462530226; - x->ptr.p_double[10] = 0.857205233546061098958658510658944; - x->ptr.p_double[11] = 0.829565762382768397442898119732502; - x->ptr.p_double[12] = 0.799727835821839083013668942322683; - x->ptr.p_double[13] = 0.767777432104826194917977340974503; - x->ptr.p_double[14] = 0.733790062453226804726171131369528; - x->ptr.p_double[15] = 0.697850494793315796932292388026640; - x->ptr.p_double[16] = 0.660061064126626961370053668149271; - x->ptr.p_double[17] = 0.620526182989242861140477556431189; - x->ptr.p_double[18] = 0.579345235826361691756024932172540; - x->ptr.p_double[19] = 0.536624148142019899264169793311073; - x->ptr.p_double[20] = 0.492480467861778574993693061207709; - x->ptr.p_double[21] = 0.447033769538089176780609900322854; - x->ptr.p_double[22] = 0.400401254830394392535476211542661; - x->ptr.p_double[23] = 0.352704725530878113471037207089374; - x->ptr.p_double[24] = 0.304073202273625077372677107199257; - x->ptr.p_double[25] = 0.254636926167889846439805129817805; - x->ptr.p_double[26] = 0.204525116682309891438957671002025; - x->ptr.p_double[27] = 0.153869913608583546963794672743256; - x->ptr.p_double[28] = 0.102806937966737030147096751318001; - x->ptr.p_double[29] = 0.051471842555317695833025213166723; - x->ptr.p_double[30] = 0.000000000000000000000000000000000; - wkronrod->ptr.p_double[0] = 0.001389013698677007624551591226760; - wkronrod->ptr.p_double[1] = 0.003890461127099884051267201844516; - wkronrod->ptr.p_double[2] = 0.006630703915931292173319826369750; - wkronrod->ptr.p_double[3] = 0.009273279659517763428441146892024; - wkronrod->ptr.p_double[4] = 0.011823015253496341742232898853251; - wkronrod->ptr.p_double[5] = 0.014369729507045804812451432443580; - wkronrod->ptr.p_double[6] = 0.016920889189053272627572289420322; - wkronrod->ptr.p_double[7] = 0.019414141193942381173408951050128; - wkronrod->ptr.p_double[8] = 0.021828035821609192297167485738339; - wkronrod->ptr.p_double[9] = 0.024191162078080601365686370725232; - wkronrod->ptr.p_double[10] = 0.026509954882333101610601709335075; - wkronrod->ptr.p_double[11] = 0.028754048765041292843978785354334; - wkronrod->ptr.p_double[12] = 0.030907257562387762472884252943092; - wkronrod->ptr.p_double[13] = 0.032981447057483726031814191016854; - wkronrod->ptr.p_double[14] = 0.034979338028060024137499670731468; - wkronrod->ptr.p_double[15] = 0.036882364651821229223911065617136; - wkronrod->ptr.p_double[16] = 0.038678945624727592950348651532281; - wkronrod->ptr.p_double[17] = 0.040374538951535959111995279752468; - wkronrod->ptr.p_double[18] = 0.041969810215164246147147541285970; - wkronrod->ptr.p_double[19] = 0.043452539701356069316831728117073; - wkronrod->ptr.p_double[20] = 0.044814800133162663192355551616723; - wkronrod->ptr.p_double[21] = 0.046059238271006988116271735559374; - wkronrod->ptr.p_double[22] = 0.047185546569299153945261478181099; - wkronrod->ptr.p_double[23] = 0.048185861757087129140779492298305; - wkronrod->ptr.p_double[24] = 0.049055434555029778887528165367238; - wkronrod->ptr.p_double[25] = 0.049795683427074206357811569379942; - wkronrod->ptr.p_double[26] = 0.050405921402782346840893085653585; - wkronrod->ptr.p_double[27] = 0.050881795898749606492297473049805; - wkronrod->ptr.p_double[28] = 0.051221547849258772170656282604944; - wkronrod->ptr.p_double[29] = 0.051426128537459025933862879215781; - wkronrod->ptr.p_double[30] = 0.051494729429451567558340433647099; - } - - /* - * copy nodes - */ - for(i=n-1; i>=n/2; i--) - { - x->ptr.p_double[i] = -x->ptr.p_double[n-1-i]; - } - - /* - * copy Kronrod weights - */ - for(i=n-1; i>=n/2; i--) - { - wkronrod->ptr.p_double[i] = wkronrod->ptr.p_double[n-1-i]; - } - - /* - * copy Gauss weights - */ - for(i=ng-1; i>=0; i--) - { - wgauss->ptr.p_double[n-2-2*i] = wgauss->ptr.p_double[i]; - wgauss->ptr.p_double[1+2*i] = wgauss->ptr.p_double[i]; - } - for(i=0; i<=n/2; i++) - { - wgauss->ptr.p_double[2*i] = 0; - } - - /* - * reorder - */ - tagsort(x, n, &p1, &p2, _state); - for(i=0; i<=n-1; i++) - { - tmp = wkronrod->ptr.p_double[i]; - wkronrod->ptr.p_double[i] = wkronrod->ptr.p_double[p2.ptr.p_int[i]]; - wkronrod->ptr.p_double[p2.ptr.p_int[i]] = tmp; - tmp = wgauss->ptr.p_double[i]; - wgauss->ptr.p_double[i] = wgauss->ptr.p_double[p2.ptr.p_int[i]]; - wgauss->ptr.p_double[p2.ptr.p_int[i]] = tmp; - } - ae_frame_leave(_state); -} - - - - -/************************************************************************* -Integration of a smooth function F(x) on a finite interval [a,b]. - -Fast-convergent algorithm based on a Gauss-Kronrod formula is used. Result -is calculated with accuracy close to the machine precision. - -Algorithm works well only with smooth integrands. It may be used with -continuous non-smooth integrands, but with less performance. - -It should never be used with integrands which have integrable singularities -at lower or upper limits - algorithm may crash. Use AutoGKSingular in such -cases. - -INPUT PARAMETERS: - A, B - interval boundaries (AB) - -OUTPUT PARAMETERS - State - structure which stores algorithm state - -SEE ALSO - AutoGKSmoothW, AutoGKSingular, AutoGKResults. - - - -- ALGLIB -- - Copyright 06.05.2009 by Bochkanov Sergey -*************************************************************************/ -void autogksmooth(double a, - double b, - autogkstate* state, - ae_state *_state) -{ - - _autogkstate_clear(state); - - ae_assert(ae_isfinite(a, _state), "AutoGKSmooth: A is not finite!", _state); - ae_assert(ae_isfinite(b, _state), "AutoGKSmooth: B is not finite!", _state); - autogksmoothw(a, b, 0.0, state, _state); -} - - -/************************************************************************* -Integration of a smooth function F(x) on a finite interval [a,b]. - -This subroutine is same as AutoGKSmooth(), but it guarantees that interval -[a,b] is partitioned into subintervals which have width at most XWidth. - -Subroutine can be used when integrating nearly-constant function with -narrow "bumps" (about XWidth wide). If "bumps" are too narrow, AutoGKSmooth -subroutine can overlook them. - -INPUT PARAMETERS: - A, B - interval boundaries (AB) - -OUTPUT PARAMETERS - State - structure which stores algorithm state - -SEE ALSO - AutoGKSmooth, AutoGKSingular, AutoGKResults. - - - -- ALGLIB -- - Copyright 06.05.2009 by Bochkanov Sergey -*************************************************************************/ -void autogksmoothw(double a, - double b, - double xwidth, - autogkstate* state, - ae_state *_state) -{ - - _autogkstate_clear(state); - - ae_assert(ae_isfinite(a, _state), "AutoGKSmoothW: A is not finite!", _state); - ae_assert(ae_isfinite(b, _state), "AutoGKSmoothW: B is not finite!", _state); - ae_assert(ae_isfinite(xwidth, _state), "AutoGKSmoothW: XWidth is not finite!", _state); - state->wrappermode = 0; - state->a = a; - state->b = b; - state->xwidth = xwidth; - state->needf = ae_false; - ae_vector_set_length(&state->rstate.ra, 10+1, _state); - state->rstate.stage = -1; -} - - -/************************************************************************* -Integration on a finite interval [A,B]. -Integrand have integrable singularities at A/B. - -F(X) must diverge as "(x-A)^alpha" at A, as "(B-x)^beta" at B, with known -alpha/beta (alpha>-1, beta>-1). If alpha/beta are not known, estimates -from below can be used (but these estimates should be greater than -1 too). - -One of alpha/beta variables (or even both alpha/beta) may be equal to 0, -which means than function F(x) is non-singular at A/B. Anyway (singular at -bounds or not), function F(x) is supposed to be continuous on (A,B). - -Fast-convergent algorithm based on a Gauss-Kronrod formula is used. Result -is calculated with accuracy close to the machine precision. - -INPUT PARAMETERS: - A, B - interval boundaries (AB) - Alpha - power-law coefficient of the F(x) at A, - Alpha>-1 - Beta - power-law coefficient of the F(x) at B, - Beta>-1 - -OUTPUT PARAMETERS - State - structure which stores algorithm state - -SEE ALSO - AutoGKSmooth, AutoGKSmoothW, AutoGKResults. - - - -- ALGLIB -- - Copyright 06.05.2009 by Bochkanov Sergey -*************************************************************************/ -void autogksingular(double a, - double b, - double alpha, - double beta, - autogkstate* state, - ae_state *_state) -{ - - _autogkstate_clear(state); - - ae_assert(ae_isfinite(a, _state), "AutoGKSingular: A is not finite!", _state); - ae_assert(ae_isfinite(b, _state), "AutoGKSingular: B is not finite!", _state); - ae_assert(ae_isfinite(alpha, _state), "AutoGKSingular: Alpha is not finite!", _state); - ae_assert(ae_isfinite(beta, _state), "AutoGKSingular: Beta is not finite!", _state); - state->wrappermode = 1; - state->a = a; - state->b = b; - state->alpha = alpha; - state->beta = beta; - state->xwidth = 0.0; - state->needf = ae_false; - ae_vector_set_length(&state->rstate.ra, 10+1, _state); - state->rstate.stage = -1; -} - - -/************************************************************************* - - -- ALGLIB -- - Copyright 07.05.2009 by Bochkanov Sergey -*************************************************************************/ -ae_bool autogkiteration(autogkstate* state, ae_state *_state) -{ - double s; - double tmp; - double eps; - double a; - double b; - double x; - double t; - double alpha; - double beta; - double v1; - double v2; - ae_bool result; - - - - /* - * Reverse communication preparations - * I know it looks ugly, but it works the same way - * anywhere from C++ to Python. - * - * This code initializes locals by: - * * random values determined during code - * generation - on first subroutine call - * * values from previous call - on subsequent calls - */ - if( state->rstate.stage>=0 ) - { - s = state->rstate.ra.ptr.p_double[0]; - tmp = state->rstate.ra.ptr.p_double[1]; - eps = state->rstate.ra.ptr.p_double[2]; - a = state->rstate.ra.ptr.p_double[3]; - b = state->rstate.ra.ptr.p_double[4]; - x = state->rstate.ra.ptr.p_double[5]; - t = state->rstate.ra.ptr.p_double[6]; - alpha = state->rstate.ra.ptr.p_double[7]; - beta = state->rstate.ra.ptr.p_double[8]; - v1 = state->rstate.ra.ptr.p_double[9]; - v2 = state->rstate.ra.ptr.p_double[10]; - } - else - { - s = -983; - tmp = -989; - eps = -834; - a = 900; - b = -287; - x = 364; - t = 214; - alpha = -338; - beta = -686; - v1 = 912; - v2 = 585; - } - if( state->rstate.stage==0 ) - { - goto lbl_0; - } - if( state->rstate.stage==1 ) - { - goto lbl_1; - } - if( state->rstate.stage==2 ) - { - goto lbl_2; - } - - /* - * Routine body - */ - eps = 0; - a = state->a; - b = state->b; - alpha = state->alpha; - beta = state->beta; - state->terminationtype = -1; - state->nfev = 0; - state->nintervals = 0; - - /* - * smooth function at a finite interval - */ - if( state->wrappermode!=0 ) - { - goto lbl_3; - } - - /* - * special case - */ - if( ae_fp_eq(a,b) ) - { - state->terminationtype = 1; - state->v = 0; - result = ae_false; - return result; - } - - /* - * general case - */ - autogk_autogkinternalprepare(a, b, eps, state->xwidth, &state->internalstate, _state); -lbl_5: - if( !autogk_autogkinternaliteration(&state->internalstate, _state) ) - { - goto lbl_6; - } - x = state->internalstate.x; - state->x = x; - state->xminusa = x-a; - state->bminusx = b-x; - state->needf = ae_true; - state->rstate.stage = 0; - goto lbl_rcomm; -lbl_0: - state->needf = ae_false; - state->nfev = state->nfev+1; - state->internalstate.f = state->f; - goto lbl_5; -lbl_6: - state->v = state->internalstate.r; - state->terminationtype = state->internalstate.info; - state->nintervals = state->internalstate.heapused; - result = ae_false; - return result; -lbl_3: - - /* - * function with power-law singularities at the ends of a finite interval - */ - if( state->wrappermode!=1 ) - { - goto lbl_7; - } - - /* - * test coefficients - */ - if( ae_fp_less_eq(alpha,-1)||ae_fp_less_eq(beta,-1) ) - { - state->terminationtype = -1; - state->v = 0; - result = ae_false; - return result; - } - - /* - * special cases - */ - if( ae_fp_eq(a,b) ) - { - state->terminationtype = 1; - state->v = 0; - result = ae_false; - return result; - } - - /* - * reduction to general form - */ - if( ae_fp_less(a,b) ) - { - s = 1; - } - else - { - s = -1; - tmp = a; - a = b; - b = tmp; - tmp = alpha; - alpha = beta; - beta = tmp; - } - alpha = ae_minreal(alpha, 0, _state); - beta = ae_minreal(beta, 0, _state); - - /* - * first, integrate left half of [a,b]: - * integral(f(x)dx, a, (b+a)/2) = - * = 1/(1+alpha) * integral(t^(-alpha/(1+alpha))*f(a+t^(1/(1+alpha)))dt, 0, (0.5*(b-a))^(1+alpha)) - */ - autogk_autogkinternalprepare(0, ae_pow(0.5*(b-a), 1+alpha, _state), eps, state->xwidth, &state->internalstate, _state); -lbl_9: - if( !autogk_autogkinternaliteration(&state->internalstate, _state) ) - { - goto lbl_10; - } - - /* - * Fill State.X, State.XMinusA, State.BMinusX. - * Latter two are filled correctly even if Binternalstate.x; - t = ae_pow(x, 1/(1+alpha), _state); - state->x = a+t; - if( ae_fp_greater(s,0) ) - { - state->xminusa = t; - state->bminusx = b-(a+t); - } - else - { - state->xminusa = a+t-b; - state->bminusx = -t; - } - state->needf = ae_true; - state->rstate.stage = 1; - goto lbl_rcomm; -lbl_1: - state->needf = ae_false; - if( ae_fp_neq(alpha,0) ) - { - state->internalstate.f = state->f*ae_pow(x, -alpha/(1+alpha), _state)/(1+alpha); - } - else - { - state->internalstate.f = state->f; - } - state->nfev = state->nfev+1; - goto lbl_9; -lbl_10: - v1 = state->internalstate.r; - state->nintervals = state->nintervals+state->internalstate.heapused; - - /* - * then, integrate right half of [a,b]: - * integral(f(x)dx, (b+a)/2, b) = - * = 1/(1+beta) * integral(t^(-beta/(1+beta))*f(b-t^(1/(1+beta)))dt, 0, (0.5*(b-a))^(1+beta)) - */ - autogk_autogkinternalprepare(0, ae_pow(0.5*(b-a), 1+beta, _state), eps, state->xwidth, &state->internalstate, _state); -lbl_11: - if( !autogk_autogkinternaliteration(&state->internalstate, _state) ) - { - goto lbl_12; - } - - /* - * Fill State.X, State.XMinusA, State.BMinusX. - * Latter two are filled correctly (X-A, B-X) even if Binternalstate.x; - t = ae_pow(x, 1/(1+beta), _state); - state->x = b-t; - if( ae_fp_greater(s,0) ) - { - state->xminusa = b-t-a; - state->bminusx = t; - } - else - { - state->xminusa = -t; - state->bminusx = a-(b-t); - } - state->needf = ae_true; - state->rstate.stage = 2; - goto lbl_rcomm; -lbl_2: - state->needf = ae_false; - if( ae_fp_neq(beta,0) ) - { - state->internalstate.f = state->f*ae_pow(x, -beta/(1+beta), _state)/(1+beta); - } - else - { - state->internalstate.f = state->f; - } - state->nfev = state->nfev+1; - goto lbl_11; -lbl_12: - v2 = state->internalstate.r; - state->nintervals = state->nintervals+state->internalstate.heapused; - - /* - * final result - */ - state->v = s*(v1+v2); - state->terminationtype = 1; - result = ae_false; - return result; -lbl_7: - result = ae_false; - return result; - - /* - * Saving state - */ -lbl_rcomm: - result = ae_true; - state->rstate.ra.ptr.p_double[0] = s; - state->rstate.ra.ptr.p_double[1] = tmp; - state->rstate.ra.ptr.p_double[2] = eps; - state->rstate.ra.ptr.p_double[3] = a; - state->rstate.ra.ptr.p_double[4] = b; - state->rstate.ra.ptr.p_double[5] = x; - state->rstate.ra.ptr.p_double[6] = t; - state->rstate.ra.ptr.p_double[7] = alpha; - state->rstate.ra.ptr.p_double[8] = beta; - state->rstate.ra.ptr.p_double[9] = v1; - state->rstate.ra.ptr.p_double[10] = v2; - return result; -} - - -/************************************************************************* -Adaptive integration results - -Called after AutoGKIteration returned False. - -Input parameters: - State - algorithm state (used by AutoGKIteration). - -Output parameters: - V - integral(f(x)dx,a,b) - Rep - optimization report (see AutoGKReport description) - - -- ALGLIB -- - Copyright 14.11.2007 by Bochkanov Sergey -*************************************************************************/ -void autogkresults(autogkstate* state, - double* v, - autogkreport* rep, - ae_state *_state) -{ - - *v = 0; - _autogkreport_clear(rep); - - *v = state->v; - rep->terminationtype = state->terminationtype; - rep->nfev = state->nfev; - rep->nintervals = state->nintervals; -} - - -/************************************************************************* -Internal AutoGK subroutine -eps<0 - error -eps=0 - automatic eps selection - -width<0 - error -width=0 - no width requirements -*************************************************************************/ -static void autogk_autogkinternalprepare(double a, - double b, - double eps, - double xwidth, - autogkinternalstate* state, - ae_state *_state) -{ - - - - /* - * Save settings - */ - state->a = a; - state->b = b; - state->eps = eps; - state->xwidth = xwidth; - - /* - * Prepare RComm structure - */ - ae_vector_set_length(&state->rstate.ia, 3+1, _state); - ae_vector_set_length(&state->rstate.ra, 8+1, _state); - state->rstate.stage = -1; -} - - -/************************************************************************* -Internal AutoGK subroutine -*************************************************************************/ -static ae_bool autogk_autogkinternaliteration(autogkinternalstate* state, - ae_state *_state) -{ - double c1; - double c2; - ae_int_t i; - ae_int_t j; - double intg; - double intk; - double inta; - double v; - double ta; - double tb; - ae_int_t ns; - double qeps; - ae_int_t info; - ae_bool result; - - - - /* - * Reverse communication preparations - * I know it looks ugly, but it works the same way - * anywhere from C++ to Python. - * - * This code initializes locals by: - * * random values determined during code - * generation - on first subroutine call - * * values from previous call - on subsequent calls - */ - if( state->rstate.stage>=0 ) - { - i = state->rstate.ia.ptr.p_int[0]; - j = state->rstate.ia.ptr.p_int[1]; - ns = state->rstate.ia.ptr.p_int[2]; - info = state->rstate.ia.ptr.p_int[3]; - c1 = state->rstate.ra.ptr.p_double[0]; - c2 = state->rstate.ra.ptr.p_double[1]; - intg = state->rstate.ra.ptr.p_double[2]; - intk = state->rstate.ra.ptr.p_double[3]; - inta = state->rstate.ra.ptr.p_double[4]; - v = state->rstate.ra.ptr.p_double[5]; - ta = state->rstate.ra.ptr.p_double[6]; - tb = state->rstate.ra.ptr.p_double[7]; - qeps = state->rstate.ra.ptr.p_double[8]; - } - else - { - i = 497; - j = -271; - ns = -581; - info = 745; - c1 = -533; - c2 = -77; - intg = 678; - intk = -293; - inta = 316; - v = 647; - ta = -756; - tb = 830; - qeps = -871; - } - if( state->rstate.stage==0 ) - { - goto lbl_0; - } - if( state->rstate.stage==1 ) - { - goto lbl_1; - } - if( state->rstate.stage==2 ) - { - goto lbl_2; - } - - /* - * Routine body - */ - - /* - * initialize quadratures. - * use 15-point Gauss-Kronrod formula. - */ - state->n = 15; - gkqgenerategausslegendre(state->n, &info, &state->qn, &state->wk, &state->wg, _state); - if( info<0 ) - { - state->info = -5; - state->r = 0; - result = ae_false; - return result; - } - ae_vector_set_length(&state->wr, state->n, _state); - for(i=0; i<=state->n-1; i++) - { - if( i==0 ) - { - state->wr.ptr.p_double[i] = 0.5*ae_fabs(state->qn.ptr.p_double[1]-state->qn.ptr.p_double[0], _state); - continue; - } - if( i==state->n-1 ) - { - state->wr.ptr.p_double[state->n-1] = 0.5*ae_fabs(state->qn.ptr.p_double[state->n-1]-state->qn.ptr.p_double[state->n-2], _state); - continue; - } - state->wr.ptr.p_double[i] = 0.5*ae_fabs(state->qn.ptr.p_double[i-1]-state->qn.ptr.p_double[i+1], _state); - } - - /* - * special case - */ - if( ae_fp_eq(state->a,state->b) ) - { - state->info = 1; - state->r = 0; - result = ae_false; - return result; - } - - /* - * test parameters - */ - if( ae_fp_less(state->eps,0)||ae_fp_less(state->xwidth,0) ) - { - state->info = -1; - state->r = 0; - result = ae_false; - return result; - } - state->info = 1; - if( ae_fp_eq(state->eps,0) ) - { - state->eps = 100000*ae_machineepsilon; - } - - /* - * First, prepare heap - * * column 0 - absolute error - * * column 1 - integral of a F(x) (calculated using Kronrod extension nodes) - * * column 2 - integral of a |F(x)| (calculated using modified rect. method) - * * column 3 - left boundary of a subinterval - * * column 4 - right boundary of a subinterval - */ - if( ae_fp_neq(state->xwidth,0) ) - { - goto lbl_3; - } - - /* - * no maximum width requirements - * start from one big subinterval - */ - state->heapwidth = 5; - state->heapsize = 1; - state->heapused = 1; - ae_matrix_set_length(&state->heap, state->heapsize, state->heapwidth, _state); - c1 = 0.5*(state->b-state->a); - c2 = 0.5*(state->b+state->a); - intg = 0; - intk = 0; - inta = 0; - i = 0; -lbl_5: - if( i>state->n-1 ) - { - goto lbl_7; - } - - /* - * obtain F - */ - state->x = c1*state->qn.ptr.p_double[i]+c2; - state->rstate.stage = 0; - goto lbl_rcomm; -lbl_0: - v = state->f; - - /* - * Gauss-Kronrod formula - */ - intk = intk+v*state->wk.ptr.p_double[i]; - if( i%2==1 ) - { - intg = intg+v*state->wg.ptr.p_double[i]; - } - - /* - * Integral |F(x)| - * Use rectangles method - */ - inta = inta+ae_fabs(v, _state)*state->wr.ptr.p_double[i]; - i = i+1; - goto lbl_5; -lbl_7: - intk = intk*(state->b-state->a)*0.5; - intg = intg*(state->b-state->a)*0.5; - inta = inta*(state->b-state->a)*0.5; - state->heap.ptr.pp_double[0][0] = ae_fabs(intg-intk, _state); - state->heap.ptr.pp_double[0][1] = intk; - state->heap.ptr.pp_double[0][2] = inta; - state->heap.ptr.pp_double[0][3] = state->a; - state->heap.ptr.pp_double[0][4] = state->b; - state->sumerr = state->heap.ptr.pp_double[0][0]; - state->sumabs = ae_fabs(inta, _state); - goto lbl_4; -lbl_3: - - /* - * maximum subinterval should be no more than XWidth. - * so we create Ceil((B-A)/XWidth)+1 small subintervals - */ - ns = ae_iceil(ae_fabs(state->b-state->a, _state)/state->xwidth, _state)+1; - state->heapsize = ns; - state->heapused = ns; - state->heapwidth = 5; - ae_matrix_set_length(&state->heap, state->heapsize, state->heapwidth, _state); - state->sumerr = 0; - state->sumabs = 0; - j = 0; -lbl_8: - if( j>ns-1 ) - { - goto lbl_10; - } - ta = state->a+j*(state->b-state->a)/ns; - tb = state->a+(j+1)*(state->b-state->a)/ns; - c1 = 0.5*(tb-ta); - c2 = 0.5*(tb+ta); - intg = 0; - intk = 0; - inta = 0; - i = 0; -lbl_11: - if( i>state->n-1 ) - { - goto lbl_13; - } - - /* - * obtain F - */ - state->x = c1*state->qn.ptr.p_double[i]+c2; - state->rstate.stage = 1; - goto lbl_rcomm; -lbl_1: - v = state->f; - - /* - * Gauss-Kronrod formula - */ - intk = intk+v*state->wk.ptr.p_double[i]; - if( i%2==1 ) - { - intg = intg+v*state->wg.ptr.p_double[i]; - } - - /* - * Integral |F(x)| - * Use rectangles method - */ - inta = inta+ae_fabs(v, _state)*state->wr.ptr.p_double[i]; - i = i+1; - goto lbl_11; -lbl_13: - intk = intk*(tb-ta)*0.5; - intg = intg*(tb-ta)*0.5; - inta = inta*(tb-ta)*0.5; - state->heap.ptr.pp_double[j][0] = ae_fabs(intg-intk, _state); - state->heap.ptr.pp_double[j][1] = intk; - state->heap.ptr.pp_double[j][2] = inta; - state->heap.ptr.pp_double[j][3] = ta; - state->heap.ptr.pp_double[j][4] = tb; - state->sumerr = state->sumerr+state->heap.ptr.pp_double[j][0]; - state->sumabs = state->sumabs+ae_fabs(inta, _state); - j = j+1; - goto lbl_8; -lbl_10: -lbl_4: - - /* - * method iterations - */ -lbl_14: - if( ae_false ) - { - goto lbl_15; - } - - /* - * additional memory if needed - */ - if( state->heapused==state->heapsize ) - { - autogk_mheapresize(&state->heap, &state->heapsize, 4*state->heapsize, state->heapwidth, _state); - } - - /* - * TODO: every 20 iterations recalculate errors/sums - */ - if( ae_fp_less_eq(state->sumerr,state->eps*state->sumabs)||state->heapused>=autogk_maxsubintervals ) - { - state->r = 0; - for(j=0; j<=state->heapused-1; j++) - { - state->r = state->r+state->heap.ptr.pp_double[j][1]; - } - result = ae_false; - return result; - } - - /* - * Exclude interval with maximum absolute error - */ - autogk_mheappop(&state->heap, state->heapused, state->heapwidth, _state); - state->sumerr = state->sumerr-state->heap.ptr.pp_double[state->heapused-1][0]; - state->sumabs = state->sumabs-state->heap.ptr.pp_double[state->heapused-1][2]; - - /* - * Divide interval, create subintervals - */ - ta = state->heap.ptr.pp_double[state->heapused-1][3]; - tb = state->heap.ptr.pp_double[state->heapused-1][4]; - state->heap.ptr.pp_double[state->heapused-1][3] = ta; - state->heap.ptr.pp_double[state->heapused-1][4] = 0.5*(ta+tb); - state->heap.ptr.pp_double[state->heapused][3] = 0.5*(ta+tb); - state->heap.ptr.pp_double[state->heapused][4] = tb; - j = state->heapused-1; -lbl_16: - if( j>state->heapused ) - { - goto lbl_18; - } - c1 = 0.5*(state->heap.ptr.pp_double[j][4]-state->heap.ptr.pp_double[j][3]); - c2 = 0.5*(state->heap.ptr.pp_double[j][4]+state->heap.ptr.pp_double[j][3]); - intg = 0; - intk = 0; - inta = 0; - i = 0; -lbl_19: - if( i>state->n-1 ) - { - goto lbl_21; - } - - /* - * F(x) - */ - state->x = c1*state->qn.ptr.p_double[i]+c2; - state->rstate.stage = 2; - goto lbl_rcomm; -lbl_2: - v = state->f; - - /* - * Gauss-Kronrod formula - */ - intk = intk+v*state->wk.ptr.p_double[i]; - if( i%2==1 ) - { - intg = intg+v*state->wg.ptr.p_double[i]; - } - - /* - * Integral |F(x)| - * Use rectangles method - */ - inta = inta+ae_fabs(v, _state)*state->wr.ptr.p_double[i]; - i = i+1; - goto lbl_19; -lbl_21: - intk = intk*(state->heap.ptr.pp_double[j][4]-state->heap.ptr.pp_double[j][3])*0.5; - intg = intg*(state->heap.ptr.pp_double[j][4]-state->heap.ptr.pp_double[j][3])*0.5; - inta = inta*(state->heap.ptr.pp_double[j][4]-state->heap.ptr.pp_double[j][3])*0.5; - state->heap.ptr.pp_double[j][0] = ae_fabs(intg-intk, _state); - state->heap.ptr.pp_double[j][1] = intk; - state->heap.ptr.pp_double[j][2] = inta; - state->sumerr = state->sumerr+state->heap.ptr.pp_double[j][0]; - state->sumabs = state->sumabs+state->heap.ptr.pp_double[j][2]; - j = j+1; - goto lbl_16; -lbl_18: - autogk_mheappush(&state->heap, state->heapused-1, state->heapwidth, _state); - autogk_mheappush(&state->heap, state->heapused, state->heapwidth, _state); - state->heapused = state->heapused+1; - goto lbl_14; -lbl_15: - result = ae_false; - return result; - - /* - * Saving state - */ -lbl_rcomm: - result = ae_true; - state->rstate.ia.ptr.p_int[0] = i; - state->rstate.ia.ptr.p_int[1] = j; - state->rstate.ia.ptr.p_int[2] = ns; - state->rstate.ia.ptr.p_int[3] = info; - state->rstate.ra.ptr.p_double[0] = c1; - state->rstate.ra.ptr.p_double[1] = c2; - state->rstate.ra.ptr.p_double[2] = intg; - state->rstate.ra.ptr.p_double[3] = intk; - state->rstate.ra.ptr.p_double[4] = inta; - state->rstate.ra.ptr.p_double[5] = v; - state->rstate.ra.ptr.p_double[6] = ta; - state->rstate.ra.ptr.p_double[7] = tb; - state->rstate.ra.ptr.p_double[8] = qeps; - return result; -} - - -static void autogk_mheappop(/* Real */ ae_matrix* heap, - ae_int_t heapsize, - ae_int_t heapwidth, - ae_state *_state) -{ - ae_int_t i; - ae_int_t p; - double t; - ae_int_t maxcp; - - - if( heapsize==1 ) - { - return; - } - for(i=0; i<=heapwidth-1; i++) - { - t = heap->ptr.pp_double[heapsize-1][i]; - heap->ptr.pp_double[heapsize-1][i] = heap->ptr.pp_double[0][i]; - heap->ptr.pp_double[0][i] = t; - } - p = 0; - while(2*p+1ptr.pp_double[2*p+2][0],heap->ptr.pp_double[2*p+1][0]) ) - { - maxcp = 2*p+2; - } - } - if( ae_fp_less(heap->ptr.pp_double[p][0],heap->ptr.pp_double[maxcp][0]) ) - { - for(i=0; i<=heapwidth-1; i++) - { - t = heap->ptr.pp_double[p][i]; - heap->ptr.pp_double[p][i] = heap->ptr.pp_double[maxcp][i]; - heap->ptr.pp_double[maxcp][i] = t; - } - p = maxcp; - } - else - { - break; - } - } -} - - -static void autogk_mheappush(/* Real */ ae_matrix* heap, - ae_int_t heapsize, - ae_int_t heapwidth, - ae_state *_state) -{ - ae_int_t i; - ae_int_t p; - double t; - ae_int_t parent; - - - if( heapsize==0 ) - { - return; - } - p = heapsize; - while(p!=0) - { - parent = (p-1)/2; - if( ae_fp_greater(heap->ptr.pp_double[p][0],heap->ptr.pp_double[parent][0]) ) - { - for(i=0; i<=heapwidth-1; i++) - { - t = heap->ptr.pp_double[p][i]; - heap->ptr.pp_double[p][i] = heap->ptr.pp_double[parent][i]; - heap->ptr.pp_double[parent][i] = t; - } - p = parent; - } - else - { - break; - } - } -} - - -static void autogk_mheapresize(/* Real */ ae_matrix* heap, - ae_int_t* heapsize, - ae_int_t newheapsize, - ae_int_t heapwidth, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix tmp; - ae_int_t i; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init(&tmp, 0, 0, DT_REAL, _state, ae_true); - - ae_matrix_set_length(&tmp, *heapsize, heapwidth, _state); - for(i=0; i<=*heapsize-1; i++) - { - ae_v_move(&tmp.ptr.pp_double[i][0], 1, &heap->ptr.pp_double[i][0], 1, ae_v_len(0,heapwidth-1)); - } - ae_matrix_set_length(heap, newheapsize, heapwidth, _state); - for(i=0; i<=*heapsize-1; i++) - { - ae_v_move(&heap->ptr.pp_double[i][0], 1, &tmp.ptr.pp_double[i][0], 1, ae_v_len(0,heapwidth-1)); - } - *heapsize = newheapsize; - ae_frame_leave(_state); -} - - -ae_bool _autogkreport_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - autogkreport *p = (autogkreport*)_p; - ae_touch_ptr((void*)p); - return ae_true; -} - - -ae_bool _autogkreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - autogkreport *dst = (autogkreport*)_dst; - autogkreport *src = (autogkreport*)_src; - dst->terminationtype = src->terminationtype; - dst->nfev = src->nfev; - dst->nintervals = src->nintervals; - return ae_true; -} - - -void _autogkreport_clear(void* _p) -{ - autogkreport *p = (autogkreport*)_p; - ae_touch_ptr((void*)p); -} - - -void _autogkreport_destroy(void* _p) -{ - autogkreport *p = (autogkreport*)_p; - ae_touch_ptr((void*)p); -} - - -ae_bool _autogkinternalstate_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - autogkinternalstate *p = (autogkinternalstate*)_p; - ae_touch_ptr((void*)p); - if( !ae_matrix_init(&p->heap, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->qn, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->wg, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->wk, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->wr, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _autogkinternalstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - autogkinternalstate *dst = (autogkinternalstate*)_dst; - autogkinternalstate *src = (autogkinternalstate*)_src; - dst->a = src->a; - dst->b = src->b; - dst->eps = src->eps; - dst->xwidth = src->xwidth; - dst->x = src->x; - dst->f = src->f; - dst->info = src->info; - dst->r = src->r; - if( !ae_matrix_init_copy(&dst->heap, &src->heap, _state, make_automatic) ) - return ae_false; - dst->heapsize = src->heapsize; - dst->heapwidth = src->heapwidth; - dst->heapused = src->heapused; - dst->sumerr = src->sumerr; - dst->sumabs = src->sumabs; - if( !ae_vector_init_copy(&dst->qn, &src->qn, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->wg, &src->wg, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->wk, &src->wk, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->wr, &src->wr, _state, make_automatic) ) - return ae_false; - dst->n = src->n; - if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _autogkinternalstate_clear(void* _p) -{ - autogkinternalstate *p = (autogkinternalstate*)_p; - ae_touch_ptr((void*)p); - ae_matrix_clear(&p->heap); - ae_vector_clear(&p->qn); - ae_vector_clear(&p->wg); - ae_vector_clear(&p->wk); - ae_vector_clear(&p->wr); - _rcommstate_clear(&p->rstate); -} - - -void _autogkinternalstate_destroy(void* _p) -{ - autogkinternalstate *p = (autogkinternalstate*)_p; - ae_touch_ptr((void*)p); - ae_matrix_destroy(&p->heap); - ae_vector_destroy(&p->qn); - ae_vector_destroy(&p->wg); - ae_vector_destroy(&p->wk); - ae_vector_destroy(&p->wr); - _rcommstate_destroy(&p->rstate); -} - - -ae_bool _autogkstate_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - autogkstate *p = (autogkstate*)_p; - ae_touch_ptr((void*)p); - if( !_autogkinternalstate_init(&p->internalstate, _state, make_automatic) ) - return ae_false; - if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _autogkstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - autogkstate *dst = (autogkstate*)_dst; - autogkstate *src = (autogkstate*)_src; - dst->a = src->a; - dst->b = src->b; - dst->alpha = src->alpha; - dst->beta = src->beta; - dst->xwidth = src->xwidth; - dst->x = src->x; - dst->xminusa = src->xminusa; - dst->bminusx = src->bminusx; - dst->needf = src->needf; - dst->f = src->f; - dst->wrappermode = src->wrappermode; - if( !_autogkinternalstate_init_copy(&dst->internalstate, &src->internalstate, _state, make_automatic) ) - return ae_false; - if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) - return ae_false; - dst->v = src->v; - dst->terminationtype = src->terminationtype; - dst->nfev = src->nfev; - dst->nintervals = src->nintervals; - return ae_true; -} - - -void _autogkstate_clear(void* _p) -{ - autogkstate *p = (autogkstate*)_p; - ae_touch_ptr((void*)p); - _autogkinternalstate_clear(&p->internalstate); - _rcommstate_clear(&p->rstate); -} - - -void _autogkstate_destroy(void* _p) -{ - autogkstate *p = (autogkstate*)_p; - ae_touch_ptr((void*)p); - _autogkinternalstate_destroy(&p->internalstate); - _rcommstate_destroy(&p->rstate); -} - - - -} - diff --git a/src/core/alglib/integration.h b/src/core/alglib/integration.h deleted file mode 100644 index 62ad78b..0000000 --- a/src/core/alglib/integration.h +++ /dev/null @@ -1,837 +0,0 @@ -/************************************************************************* -Copyright (c) Sergey Bochkanov (ALGLIB project). - ->>> SOURCE LICENSE >>> -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation (www.fsf.org); either version 2 of the -License, or (at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -A copy of the GNU General Public License is available at -http://www.fsf.org/licensing/licenses ->>> END OF LICENSE >>> -*************************************************************************/ -#ifndef _integration_pkg_h -#define _integration_pkg_h -#include "ap.h" -#include "alglibinternal.h" -#include "linalg.h" -#include "specialfunctions.h" - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (DATATYPES) -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ -typedef struct -{ - ae_int_t terminationtype; - ae_int_t nfev; - ae_int_t nintervals; -} autogkreport; -typedef struct -{ - double a; - double b; - double eps; - double xwidth; - double x; - double f; - ae_int_t info; - double r; - ae_matrix heap; - ae_int_t heapsize; - ae_int_t heapwidth; - ae_int_t heapused; - double sumerr; - double sumabs; - ae_vector qn; - ae_vector wg; - ae_vector wk; - ae_vector wr; - ae_int_t n; - rcommstate rstate; -} autogkinternalstate; -typedef struct -{ - double a; - double b; - double alpha; - double beta; - double xwidth; - double x; - double xminusa; - double bminusx; - ae_bool needf; - double f; - ae_int_t wrappermode; - autogkinternalstate internalstate; - rcommstate rstate; - double v; - ae_int_t terminationtype; - ae_int_t nfev; - ae_int_t nintervals; -} autogkstate; - -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS C++ INTERFACE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib -{ - - - - - -/************************************************************************* -Integration report: -* TerminationType = completion code: - * -5 non-convergence of Gauss-Kronrod nodes - calculation subroutine. - * -1 incorrect parameters were specified - * 1 OK -* Rep.NFEV contains number of function calculations -* Rep.NIntervals contains number of intervals [a,b] - was partitioned into. -*************************************************************************/ -class _autogkreport_owner -{ -public: - _autogkreport_owner(); - _autogkreport_owner(const _autogkreport_owner &rhs); - _autogkreport_owner& operator=(const _autogkreport_owner &rhs); - virtual ~_autogkreport_owner(); - alglib_impl::autogkreport* c_ptr(); - alglib_impl::autogkreport* c_ptr() const; -protected: - alglib_impl::autogkreport *p_struct; -}; -class autogkreport : public _autogkreport_owner -{ -public: - autogkreport(); - autogkreport(const autogkreport &rhs); - autogkreport& operator=(const autogkreport &rhs); - virtual ~autogkreport(); - ae_int_t &terminationtype; - ae_int_t &nfev; - ae_int_t &nintervals; - -}; - - -/************************************************************************* -This structure stores state of the integration algorithm. - -Although this class has public fields, they are not intended for external -use. You should use ALGLIB functions to work with this class: -* autogksmooth()/AutoGKSmoothW()/... to create objects -* autogkintegrate() to begin integration -* autogkresults() to get results -*************************************************************************/ -class _autogkstate_owner -{ -public: - _autogkstate_owner(); - _autogkstate_owner(const _autogkstate_owner &rhs); - _autogkstate_owner& operator=(const _autogkstate_owner &rhs); - virtual ~_autogkstate_owner(); - alglib_impl::autogkstate* c_ptr(); - alglib_impl::autogkstate* c_ptr() const; -protected: - alglib_impl::autogkstate *p_struct; -}; -class autogkstate : public _autogkstate_owner -{ -public: - autogkstate(); - autogkstate(const autogkstate &rhs); - autogkstate& operator=(const autogkstate &rhs); - virtual ~autogkstate(); - ae_bool &needf; - double &x; - double &xminusa; - double &bminusx; - double &f; - -}; - -/************************************************************************* -Computation of nodes and weights for a Gauss quadrature formula - -The algorithm generates the N-point Gauss quadrature formula with weight -function given by coefficients alpha and beta of a recurrence relation -which generates a system of orthogonal polynomials: - -P-1(x) = 0 -P0(x) = 1 -Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x) - -and zeroth moment Mu0 - -Mu0 = integral(W(x)dx,a,b) - -INPUT PARAMETERS: - Alpha – array[0..N-1], alpha coefficients - Beta – array[0..N-1], beta coefficients - Zero-indexed element is not used and may be arbitrary. - Beta[I]>0. - Mu0 – zeroth moment of the weight function. - N – number of nodes of the quadrature formula, N>=1 - -OUTPUT PARAMETERS: - Info - error code: - * -3 internal eigenproblem solver hasn't converged - * -2 Beta[i]<=0 - * -1 incorrect N was passed - * 1 OK - X - array[0..N-1] - array of quadrature nodes, - in ascending order. - W - array[0..N-1] - array of quadrature weights. - - -- ALGLIB -- - Copyright 2005-2009 by Bochkanov Sergey -*************************************************************************/ -void gqgeneraterec(const real_1d_array &alpha, const real_1d_array &beta, const double mu0, const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w); - - -/************************************************************************* -Computation of nodes and weights for a Gauss-Lobatto quadrature formula - -The algorithm generates the N-point Gauss-Lobatto quadrature formula with -weight function given by coefficients alpha and beta of a recurrence which -generates a system of orthogonal polynomials. - -P-1(x) = 0 -P0(x) = 1 -Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x) - -and zeroth moment Mu0 - -Mu0 = integral(W(x)dx,a,b) - -INPUT PARAMETERS: - Alpha – array[0..N-2], alpha coefficients - Beta – array[0..N-2], beta coefficients. - Zero-indexed element is not used, may be arbitrary. - Beta[I]>0 - Mu0 – zeroth moment of the weighting function. - A – left boundary of the integration interval. - B – right boundary of the integration interval. - N – number of nodes of the quadrature formula, N>=3 - (including the left and right boundary nodes). - -OUTPUT PARAMETERS: - Info - error code: - * -3 internal eigenproblem solver hasn't converged - * -2 Beta[i]<=0 - * -1 incorrect N was passed - * 1 OK - X - array[0..N-1] - array of quadrature nodes, - in ascending order. - W - array[0..N-1] - array of quadrature weights. - - -- ALGLIB -- - Copyright 2005-2009 by Bochkanov Sergey -*************************************************************************/ -void gqgenerategausslobattorec(const real_1d_array &alpha, const real_1d_array &beta, const double mu0, const double a, const double b, const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w); - - -/************************************************************************* -Computation of nodes and weights for a Gauss-Radau quadrature formula - -The algorithm generates the N-point Gauss-Radau quadrature formula with -weight function given by the coefficients alpha and beta of a recurrence -which generates a system of orthogonal polynomials. - -P-1(x) = 0 -P0(x) = 1 -Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x) - -and zeroth moment Mu0 - -Mu0 = integral(W(x)dx,a,b) - -INPUT PARAMETERS: - Alpha – array[0..N-2], alpha coefficients. - Beta – array[0..N-1], beta coefficients - Zero-indexed element is not used. - Beta[I]>0 - Mu0 – zeroth moment of the weighting function. - A – left boundary of the integration interval. - N – number of nodes of the quadrature formula, N>=2 - (including the left boundary node). - -OUTPUT PARAMETERS: - Info - error code: - * -3 internal eigenproblem solver hasn't converged - * -2 Beta[i]<=0 - * -1 incorrect N was passed - * 1 OK - X - array[0..N-1] - array of quadrature nodes, - in ascending order. - W - array[0..N-1] - array of quadrature weights. - - - -- ALGLIB -- - Copyright 2005-2009 by Bochkanov Sergey -*************************************************************************/ -void gqgenerategaussradaurec(const real_1d_array &alpha, const real_1d_array &beta, const double mu0, const double a, const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w); - - -/************************************************************************* -Returns nodes/weights for Gauss-Legendre quadrature on [-1,1] with N -nodes. - -INPUT PARAMETERS: - N - number of nodes, >=1 - -OUTPUT PARAMETERS: - Info - error code: - * -4 an error was detected when calculating - weights/nodes. N is too large to obtain - weights/nodes with high enough accuracy. - Try to use multiple precision version. - * -3 internal eigenproblem solver hasn't converged - * -1 incorrect N was passed - * +1 OK - X - array[0..N-1] - array of quadrature nodes, - in ascending order. - W - array[0..N-1] - array of quadrature weights. - - - -- ALGLIB -- - Copyright 12.05.2009 by Bochkanov Sergey -*************************************************************************/ -void gqgenerategausslegendre(const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w); - - -/************************************************************************* -Returns nodes/weights for Gauss-Jacobi quadrature on [-1,1] with weight -function W(x)=Power(1-x,Alpha)*Power(1+x,Beta). - -INPUT PARAMETERS: - N - number of nodes, >=1 - Alpha - power-law coefficient, Alpha>-1 - Beta - power-law coefficient, Beta>-1 - -OUTPUT PARAMETERS: - Info - error code: - * -4 an error was detected when calculating - weights/nodes. Alpha or Beta are too close - to -1 to obtain weights/nodes with high enough - accuracy, or, may be, N is too large. Try to - use multiple precision version. - * -3 internal eigenproblem solver hasn't converged - * -1 incorrect N/Alpha/Beta was passed - * +1 OK - X - array[0..N-1] - array of quadrature nodes, - in ascending order. - W - array[0..N-1] - array of quadrature weights. - - - -- ALGLIB -- - Copyright 12.05.2009 by Bochkanov Sergey -*************************************************************************/ -void gqgenerategaussjacobi(const ae_int_t n, const double alpha, const double beta, ae_int_t &info, real_1d_array &x, real_1d_array &w); - - -/************************************************************************* -Returns nodes/weights for Gauss-Laguerre quadrature on [0,+inf) with -weight function W(x)=Power(x,Alpha)*Exp(-x) - -INPUT PARAMETERS: - N - number of nodes, >=1 - Alpha - power-law coefficient, Alpha>-1 - -OUTPUT PARAMETERS: - Info - error code: - * -4 an error was detected when calculating - weights/nodes. Alpha is too close to -1 to - obtain weights/nodes with high enough accuracy - or, may be, N is too large. Try to use - multiple precision version. - * -3 internal eigenproblem solver hasn't converged - * -1 incorrect N/Alpha was passed - * +1 OK - X - array[0..N-1] - array of quadrature nodes, - in ascending order. - W - array[0..N-1] - array of quadrature weights. - - - -- ALGLIB -- - Copyright 12.05.2009 by Bochkanov Sergey -*************************************************************************/ -void gqgenerategausslaguerre(const ae_int_t n, const double alpha, ae_int_t &info, real_1d_array &x, real_1d_array &w); - - -/************************************************************************* -Returns nodes/weights for Gauss-Hermite quadrature on (-inf,+inf) with -weight function W(x)=Exp(-x*x) - -INPUT PARAMETERS: - N - number of nodes, >=1 - -OUTPUT PARAMETERS: - Info - error code: - * -4 an error was detected when calculating - weights/nodes. May be, N is too large. Try to - use multiple precision version. - * -3 internal eigenproblem solver hasn't converged - * -1 incorrect N/Alpha was passed - * +1 OK - X - array[0..N-1] - array of quadrature nodes, - in ascending order. - W - array[0..N-1] - array of quadrature weights. - - - -- ALGLIB -- - Copyright 12.05.2009 by Bochkanov Sergey -*************************************************************************/ -void gqgenerategausshermite(const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w); - -/************************************************************************* -Computation of nodes and weights of a Gauss-Kronrod quadrature formula - -The algorithm generates the N-point Gauss-Kronrod quadrature formula with -weight function given by coefficients alpha and beta of a recurrence -relation which generates a system of orthogonal polynomials: - - P-1(x) = 0 - P0(x) = 1 - Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x) - -and zero moment Mu0 - - Mu0 = integral(W(x)dx,a,b) - - -INPUT PARAMETERS: - Alpha – alpha coefficients, array[0..floor(3*K/2)]. - Beta – beta coefficients, array[0..ceil(3*K/2)]. - Beta[0] is not used and may be arbitrary. - Beta[I]>0. - Mu0 – zeroth moment of the weight function. - N – number of nodes of the Gauss-Kronrod quadrature formula, - N >= 3, - N = 2*K+1. - -OUTPUT PARAMETERS: - Info - error code: - * -5 no real and positive Gauss-Kronrod formula can - be created for such a weight function with a - given number of nodes. - * -4 N is too large, task may be ill conditioned - - x[i]=x[i+1] found. - * -3 internal eigenproblem solver hasn't converged - * -2 Beta[i]<=0 - * -1 incorrect N was passed - * +1 OK - X - array[0..N-1] - array of quadrature nodes, - in ascending order. - WKronrod - array[0..N-1] - Kronrod weights - WGauss - array[0..N-1] - Gauss weights (interleaved with zeros - corresponding to extended Kronrod nodes). - - -- ALGLIB -- - Copyright 08.05.2009 by Bochkanov Sergey -*************************************************************************/ -void gkqgeneraterec(const real_1d_array &alpha, const real_1d_array &beta, const double mu0, const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss); - - -/************************************************************************* -Returns Gauss and Gauss-Kronrod nodes/weights for Gauss-Legendre -quadrature with N points. - -GKQLegendreCalc (calculation) or GKQLegendreTbl (precomputed table) is -used depending on machine precision and number of nodes. - -INPUT PARAMETERS: - N - number of Kronrod nodes, must be odd number, >=3. - -OUTPUT PARAMETERS: - Info - error code: - * -4 an error was detected when calculating - weights/nodes. N is too large to obtain - weights/nodes with high enough accuracy. - Try to use multiple precision version. - * -3 internal eigenproblem solver hasn't converged - * -1 incorrect N was passed - * +1 OK - X - array[0..N-1] - array of quadrature nodes, ordered in - ascending order. - WKronrod - array[0..N-1] - Kronrod weights - WGauss - array[0..N-1] - Gauss weights (interleaved with zeros - corresponding to extended Kronrod nodes). - - - -- ALGLIB -- - Copyright 12.05.2009 by Bochkanov Sergey -*************************************************************************/ -void gkqgenerategausslegendre(const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss); - - -/************************************************************************* -Returns Gauss and Gauss-Kronrod nodes/weights for Gauss-Jacobi -quadrature on [-1,1] with weight function - - W(x)=Power(1-x,Alpha)*Power(1+x,Beta). - -INPUT PARAMETERS: - N - number of Kronrod nodes, must be odd number, >=3. - Alpha - power-law coefficient, Alpha>-1 - Beta - power-law coefficient, Beta>-1 - -OUTPUT PARAMETERS: - Info - error code: - * -5 no real and positive Gauss-Kronrod formula can - be created for such a weight function with a - given number of nodes. - * -4 an error was detected when calculating - weights/nodes. Alpha or Beta are too close - to -1 to obtain weights/nodes with high enough - accuracy, or, may be, N is too large. Try to - use multiple precision version. - * -3 internal eigenproblem solver hasn't converged - * -1 incorrect N was passed - * +1 OK - * +2 OK, but quadrature rule have exterior nodes, - x[0]<-1 or x[n-1]>+1 - X - array[0..N-1] - array of quadrature nodes, ordered in - ascending order. - WKronrod - array[0..N-1] - Kronrod weights - WGauss - array[0..N-1] - Gauss weights (interleaved with zeros - corresponding to extended Kronrod nodes). - - - -- ALGLIB -- - Copyright 12.05.2009 by Bochkanov Sergey -*************************************************************************/ -void gkqgenerategaussjacobi(const ae_int_t n, const double alpha, const double beta, ae_int_t &info, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss); - - -/************************************************************************* -Returns Gauss and Gauss-Kronrod nodes for quadrature with N points. - -Reduction to tridiagonal eigenproblem is used. - -INPUT PARAMETERS: - N - number of Kronrod nodes, must be odd number, >=3. - -OUTPUT PARAMETERS: - Info - error code: - * -4 an error was detected when calculating - weights/nodes. N is too large to obtain - weights/nodes with high enough accuracy. - Try to use multiple precision version. - * -3 internal eigenproblem solver hasn't converged - * -1 incorrect N was passed - * +1 OK - X - array[0..N-1] - array of quadrature nodes, ordered in - ascending order. - WKronrod - array[0..N-1] - Kronrod weights - WGauss - array[0..N-1] - Gauss weights (interleaved with zeros - corresponding to extended Kronrod nodes). - - -- ALGLIB -- - Copyright 12.05.2009 by Bochkanov Sergey -*************************************************************************/ -void gkqlegendrecalc(const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss); - - -/************************************************************************* -Returns Gauss and Gauss-Kronrod nodes for quadrature with N points using -pre-calculated table. Nodes/weights were computed with accuracy up to -1.0E-32 (if MPFR version of ALGLIB is used). In standard double precision -accuracy reduces to something about 2.0E-16 (depending on your compiler's -handling of long floating point constants). - -INPUT PARAMETERS: - N - number of Kronrod nodes. - N can be 15, 21, 31, 41, 51, 61. - -OUTPUT PARAMETERS: - X - array[0..N-1] - array of quadrature nodes, ordered in - ascending order. - WKronrod - array[0..N-1] - Kronrod weights - WGauss - array[0..N-1] - Gauss weights (interleaved with zeros - corresponding to extended Kronrod nodes). - - - -- ALGLIB -- - Copyright 12.05.2009 by Bochkanov Sergey -*************************************************************************/ -void gkqlegendretbl(const ae_int_t n, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss, double &eps); - -/************************************************************************* -Integration of a smooth function F(x) on a finite interval [a,b]. - -Fast-convergent algorithm based on a Gauss-Kronrod formula is used. Result -is calculated with accuracy close to the machine precision. - -Algorithm works well only with smooth integrands. It may be used with -continuous non-smooth integrands, but with less performance. - -It should never be used with integrands which have integrable singularities -at lower or upper limits - algorithm may crash. Use AutoGKSingular in such -cases. - -INPUT PARAMETERS: - A, B - interval boundaries (AB) - -OUTPUT PARAMETERS - State - structure which stores algorithm state - -SEE ALSO - AutoGKSmoothW, AutoGKSingular, AutoGKResults. - - - -- ALGLIB -- - Copyright 06.05.2009 by Bochkanov Sergey -*************************************************************************/ -void autogksmooth(const double a, const double b, autogkstate &state); - - -/************************************************************************* -Integration of a smooth function F(x) on a finite interval [a,b]. - -This subroutine is same as AutoGKSmooth(), but it guarantees that interval -[a,b] is partitioned into subintervals which have width at most XWidth. - -Subroutine can be used when integrating nearly-constant function with -narrow "bumps" (about XWidth wide). If "bumps" are too narrow, AutoGKSmooth -subroutine can overlook them. - -INPUT PARAMETERS: - A, B - interval boundaries (AB) - -OUTPUT PARAMETERS - State - structure which stores algorithm state - -SEE ALSO - AutoGKSmooth, AutoGKSingular, AutoGKResults. - - - -- ALGLIB -- - Copyright 06.05.2009 by Bochkanov Sergey -*************************************************************************/ -void autogksmoothw(const double a, const double b, const double xwidth, autogkstate &state); - - -/************************************************************************* -Integration on a finite interval [A,B]. -Integrand have integrable singularities at A/B. - -F(X) must diverge as "(x-A)^alpha" at A, as "(B-x)^beta" at B, with known -alpha/beta (alpha>-1, beta>-1). If alpha/beta are not known, estimates -from below can be used (but these estimates should be greater than -1 too). - -One of alpha/beta variables (or even both alpha/beta) may be equal to 0, -which means than function F(x) is non-singular at A/B. Anyway (singular at -bounds or not), function F(x) is supposed to be continuous on (A,B). - -Fast-convergent algorithm based on a Gauss-Kronrod formula is used. Result -is calculated with accuracy close to the machine precision. - -INPUT PARAMETERS: - A, B - interval boundaries (AB) - Alpha - power-law coefficient of the F(x) at A, - Alpha>-1 - Beta - power-law coefficient of the F(x) at B, - Beta>-1 - -OUTPUT PARAMETERS - State - structure which stores algorithm state - -SEE ALSO - AutoGKSmooth, AutoGKSmoothW, AutoGKResults. - - - -- ALGLIB -- - Copyright 06.05.2009 by Bochkanov Sergey -*************************************************************************/ -void autogksingular(const double a, const double b, const double alpha, const double beta, autogkstate &state); - - -/************************************************************************* -This function provides reverse communication interface -Reverse communication interface is not documented or recommended to use. -See below for functions which provide better documented API -*************************************************************************/ -bool autogkiteration(const autogkstate &state); - - -/************************************************************************* -This function is used to launcn iterations of the 1-dimensional integrator - -It accepts following parameters: - func - callback which calculates f(x) for given x - ptr - optional pointer which is passed to func; can be NULL - - - -- ALGLIB -- - Copyright 07.05.2009 by Bochkanov Sergey - -*************************************************************************/ -void autogkintegrate(autogkstate &state, - void (*func)(double x, double xminusa, double bminusx, double &y, void *ptr), - void *ptr = NULL); - - -/************************************************************************* -Adaptive integration results - -Called after AutoGKIteration returned False. - -Input parameters: - State - algorithm state (used by AutoGKIteration). - -Output parameters: - V - integral(f(x)dx,a,b) - Rep - optimization report (see AutoGKReport description) - - -- ALGLIB -- - Copyright 14.11.2007 by Bochkanov Sergey -*************************************************************************/ -void autogkresults(const autogkstate &state, double &v, autogkreport &rep); -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (FUNCTIONS) -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ -void gqgeneraterec(/* Real */ ae_vector* alpha, - /* Real */ ae_vector* beta, - double mu0, - ae_int_t n, - ae_int_t* info, - /* Real */ ae_vector* x, - /* Real */ ae_vector* w, - ae_state *_state); -void gqgenerategausslobattorec(/* Real */ ae_vector* alpha, - /* Real */ ae_vector* beta, - double mu0, - double a, - double b, - ae_int_t n, - ae_int_t* info, - /* Real */ ae_vector* x, - /* Real */ ae_vector* w, - ae_state *_state); -void gqgenerategaussradaurec(/* Real */ ae_vector* alpha, - /* Real */ ae_vector* beta, - double mu0, - double a, - ae_int_t n, - ae_int_t* info, - /* Real */ ae_vector* x, - /* Real */ ae_vector* w, - ae_state *_state); -void gqgenerategausslegendre(ae_int_t n, - ae_int_t* info, - /* Real */ ae_vector* x, - /* Real */ ae_vector* w, - ae_state *_state); -void gqgenerategaussjacobi(ae_int_t n, - double alpha, - double beta, - ae_int_t* info, - /* Real */ ae_vector* x, - /* Real */ ae_vector* w, - ae_state *_state); -void gqgenerategausslaguerre(ae_int_t n, - double alpha, - ae_int_t* info, - /* Real */ ae_vector* x, - /* Real */ ae_vector* w, - ae_state *_state); -void gqgenerategausshermite(ae_int_t n, - ae_int_t* info, - /* Real */ ae_vector* x, - /* Real */ ae_vector* w, - ae_state *_state); -void gkqgeneraterec(/* Real */ ae_vector* alpha, - /* Real */ ae_vector* beta, - double mu0, - ae_int_t n, - ae_int_t* info, - /* Real */ ae_vector* x, - /* Real */ ae_vector* wkronrod, - /* Real */ ae_vector* wgauss, - ae_state *_state); -void gkqgenerategausslegendre(ae_int_t n, - ae_int_t* info, - /* Real */ ae_vector* x, - /* Real */ ae_vector* wkronrod, - /* Real */ ae_vector* wgauss, - ae_state *_state); -void gkqgenerategaussjacobi(ae_int_t n, - double alpha, - double beta, - ae_int_t* info, - /* Real */ ae_vector* x, - /* Real */ ae_vector* wkronrod, - /* Real */ ae_vector* wgauss, - ae_state *_state); -void gkqlegendrecalc(ae_int_t n, - ae_int_t* info, - /* Real */ ae_vector* x, - /* Real */ ae_vector* wkronrod, - /* Real */ ae_vector* wgauss, - ae_state *_state); -void gkqlegendretbl(ae_int_t n, - /* Real */ ae_vector* x, - /* Real */ ae_vector* wkronrod, - /* Real */ ae_vector* wgauss, - double* eps, - ae_state *_state); -void autogksmooth(double a, - double b, - autogkstate* state, - ae_state *_state); -void autogksmoothw(double a, - double b, - double xwidth, - autogkstate* state, - ae_state *_state); -void autogksingular(double a, - double b, - double alpha, - double beta, - autogkstate* state, - ae_state *_state); -ae_bool autogkiteration(autogkstate* state, ae_state *_state); -void autogkresults(autogkstate* state, - double* v, - autogkreport* rep, - ae_state *_state); -ae_bool _autogkreport_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _autogkreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _autogkreport_clear(void* _p); -void _autogkreport_destroy(void* _p); -ae_bool _autogkinternalstate_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _autogkinternalstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _autogkinternalstate_clear(void* _p); -void _autogkinternalstate_destroy(void* _p); -ae_bool _autogkstate_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _autogkstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _autogkstate_clear(void* _p); -void _autogkstate_destroy(void* _p); - -} -#endif - diff --git a/src/core/alglib/interpolation.cpp b/src/core/alglib/interpolation.cpp deleted file mode 100644 index 6202bb3..0000000 --- a/src/core/alglib/interpolation.cpp +++ /dev/null @@ -1,30715 +0,0 @@ -/************************************************************************* -Copyright (c) Sergey Bochkanov (ALGLIB project). - ->>> SOURCE LICENSE >>> -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation (www.fsf.org); either version 2 of the -License, or (at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -A copy of the GNU General Public License is available at -http://www.fsf.org/licensing/licenses ->>> END OF LICENSE >>> -*************************************************************************/ -#include "stdafx.h" -#include "interpolation.h" - -// disable some irrelevant warnings -#if (AE_COMPILER==AE_MSVC) -#pragma warning(disable:4100) -#pragma warning(disable:4127) -#pragma warning(disable:4702) -#pragma warning(disable:4996) -#endif -using namespace std; - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS IMPLEMENTATION OF C++ INTERFACE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib -{ - - -/************************************************************************* -IDW interpolant. -*************************************************************************/ -_idwinterpolant_owner::_idwinterpolant_owner() -{ - p_struct = (alglib_impl::idwinterpolant*)alglib_impl::ae_malloc(sizeof(alglib_impl::idwinterpolant), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_idwinterpolant_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_idwinterpolant_owner::_idwinterpolant_owner(const _idwinterpolant_owner &rhs) -{ - p_struct = (alglib_impl::idwinterpolant*)alglib_impl::ae_malloc(sizeof(alglib_impl::idwinterpolant), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_idwinterpolant_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_idwinterpolant_owner& _idwinterpolant_owner::operator=(const _idwinterpolant_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_idwinterpolant_clear(p_struct); - if( !alglib_impl::_idwinterpolant_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_idwinterpolant_owner::~_idwinterpolant_owner() -{ - alglib_impl::_idwinterpolant_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::idwinterpolant* _idwinterpolant_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::idwinterpolant* _idwinterpolant_owner::c_ptr() const -{ - return const_cast(p_struct); -} -idwinterpolant::idwinterpolant() : _idwinterpolant_owner() -{ -} - -idwinterpolant::idwinterpolant(const idwinterpolant &rhs):_idwinterpolant_owner(rhs) -{ -} - -idwinterpolant& idwinterpolant::operator=(const idwinterpolant &rhs) -{ - if( this==&rhs ) - return *this; - _idwinterpolant_owner::operator=(rhs); - return *this; -} - -idwinterpolant::~idwinterpolant() -{ -} - -/************************************************************************* -IDW interpolation - -INPUT PARAMETERS: - Z - IDW interpolant built with one of model building - subroutines. - X - array[0..NX-1], interpolation point - -Result: - IDW interpolant Z(X) - - -- ALGLIB -- - Copyright 02.03.2010 by Bochkanov Sergey -*************************************************************************/ -double idwcalc(const idwinterpolant &z, const real_1d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::idwcalc(const_cast(z.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -IDW interpolant using modified Shepard method for uniform point -distributions. - -INPUT PARAMETERS: - XY - X and Y values, array[0..N-1,0..NX]. - First NX columns contain X-values, last column contain - Y-values. - N - number of nodes, N>0. - NX - space dimension, NX>=1. - D - nodal function type, either: - * 0 constant model. Just for demonstration only, worst - model ever. - * 1 linear model, least squares fitting. Simpe model for - datasets too small for quadratic models - * 2 quadratic model, least squares fitting. Best model - available (if your dataset is large enough). - * -1 "fast" linear model, use with caution!!! It is - significantly faster than linear/quadratic and better - than constant model. But it is less robust (especially - in the presence of noise). - NQ - number of points used to calculate nodal functions (ignored - for constant models). NQ should be LARGER than: - * max(1.5*(1+NX),2^NX+1) for linear model, - * max(3/4*(NX+2)*(NX+1),2^NX+1) for quadratic model. - Values less than this threshold will be silently increased. - NW - number of points used to calculate weights and to interpolate. - Required: >=2^NX+1, values less than this threshold will be - silently increased. - Recommended value: about 2*NQ - -OUTPUT PARAMETERS: - Z - IDW interpolant. - -NOTES: - * best results are obtained with quadratic models, worst - with constant - models - * when N is large, NQ and NW must be significantly smaller than N both - to obtain optimal performance and to obtain optimal accuracy. In 2 or - 3-dimensional tasks NQ=15 and NW=25 are good values to start with. - * NQ and NW may be greater than N. In such cases they will be - automatically decreased. - * this subroutine is always succeeds (as long as correct parameters are - passed). - * see 'Multivariate Interpolation of Large Sets of Scattered Data' by - Robert J. Renka for more information on this algorithm. - * this subroutine assumes that point distribution is uniform at the small - scales. If it isn't - for example, points are concentrated along - "lines", but "lines" distribution is uniform at the larger scale - then - you should use IDWBuildModifiedShepardR() - - - -- ALGLIB PROJECT -- - Copyright 02.03.2010 by Bochkanov Sergey -*************************************************************************/ -void idwbuildmodifiedshepard(const real_2d_array &xy, const ae_int_t n, const ae_int_t nx, const ae_int_t d, const ae_int_t nq, const ae_int_t nw, idwinterpolant &z) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::idwbuildmodifiedshepard(const_cast(xy.c_ptr()), n, nx, d, nq, nw, const_cast(z.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -IDW interpolant using modified Shepard method for non-uniform datasets. - -This type of model uses constant nodal functions and interpolates using -all nodes which are closer than user-specified radius R. It may be used -when points distribution is non-uniform at the small scale, but it is at -the distances as large as R. - -INPUT PARAMETERS: - XY - X and Y values, array[0..N-1,0..NX]. - First NX columns contain X-values, last column contain - Y-values. - N - number of nodes, N>0. - NX - space dimension, NX>=1. - R - radius, R>0 - -OUTPUT PARAMETERS: - Z - IDW interpolant. - -NOTES: -* if there is less than IDWKMin points within R-ball, algorithm selects - IDWKMin closest ones, so that continuity properties of interpolant are - preserved even far from points. - - -- ALGLIB PROJECT -- - Copyright 11.04.2010 by Bochkanov Sergey -*************************************************************************/ -void idwbuildmodifiedshepardr(const real_2d_array &xy, const ae_int_t n, const ae_int_t nx, const double r, idwinterpolant &z) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::idwbuildmodifiedshepardr(const_cast(xy.c_ptr()), n, nx, r, const_cast(z.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -IDW model for noisy data. - -This subroutine may be used to handle noisy data, i.e. data with noise in -OUTPUT values. It differs from IDWBuildModifiedShepard() in the following -aspects: -* nodal functions are not constrained to pass through nodes: Qi(xi)<>yi, - i.e. we have fitting instead of interpolation. -* weights which are used during least squares fitting stage are all equal - to 1.0 (independently of distance) -* "fast"-linear or constant nodal functions are not supported (either not - robust enough or too rigid) - -This problem require far more complex tuning than interpolation problems. -Below you can find some recommendations regarding this problem: -* focus on tuning NQ; it controls noise reduction. As for NW, you can just - make it equal to 2*NQ. -* you can use cross-validation to determine optimal NQ. -* optimal NQ is a result of complex tradeoff between noise level (more - noise = larger NQ required) and underlying function complexity (given - fixed N, larger NQ means smoothing of compex features in the data). For - example, NQ=N will reduce noise to the minimum level possible, but you - will end up with just constant/linear/quadratic (depending on D) least - squares model for the whole dataset. - -INPUT PARAMETERS: - XY - X and Y values, array[0..N-1,0..NX]. - First NX columns contain X-values, last column contain - Y-values. - N - number of nodes, N>0. - NX - space dimension, NX>=1. - D - nodal function degree, either: - * 1 linear model, least squares fitting. Simpe model for - datasets too small for quadratic models (or for very - noisy problems). - * 2 quadratic model, least squares fitting. Best model - available (if your dataset is large enough). - NQ - number of points used to calculate nodal functions. NQ should - be significantly larger than 1.5 times the number of - coefficients in a nodal function to overcome effects of noise: - * larger than 1.5*(1+NX) for linear model, - * larger than 3/4*(NX+2)*(NX+1) for quadratic model. - Values less than this threshold will be silently increased. - NW - number of points used to calculate weights and to interpolate. - Required: >=2^NX+1, values less than this threshold will be - silently increased. - Recommended value: about 2*NQ or larger - -OUTPUT PARAMETERS: - Z - IDW interpolant. - -NOTES: - * best results are obtained with quadratic models, linear models are not - recommended to use unless you are pretty sure that it is what you want - * this subroutine is always succeeds (as long as correct parameters are - passed). - * see 'Multivariate Interpolation of Large Sets of Scattered Data' by - Robert J. Renka for more information on this algorithm. - - - -- ALGLIB PROJECT -- - Copyright 02.03.2010 by Bochkanov Sergey -*************************************************************************/ -void idwbuildnoisy(const real_2d_array &xy, const ae_int_t n, const ae_int_t nx, const ae_int_t d, const ae_int_t nq, const ae_int_t nw, idwinterpolant &z) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::idwbuildnoisy(const_cast(xy.c_ptr()), n, nx, d, nq, nw, const_cast(z.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Barycentric interpolant. -*************************************************************************/ -_barycentricinterpolant_owner::_barycentricinterpolant_owner() -{ - p_struct = (alglib_impl::barycentricinterpolant*)alglib_impl::ae_malloc(sizeof(alglib_impl::barycentricinterpolant), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_barycentricinterpolant_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_barycentricinterpolant_owner::_barycentricinterpolant_owner(const _barycentricinterpolant_owner &rhs) -{ - p_struct = (alglib_impl::barycentricinterpolant*)alglib_impl::ae_malloc(sizeof(alglib_impl::barycentricinterpolant), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_barycentricinterpolant_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_barycentricinterpolant_owner& _barycentricinterpolant_owner::operator=(const _barycentricinterpolant_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_barycentricinterpolant_clear(p_struct); - if( !alglib_impl::_barycentricinterpolant_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_barycentricinterpolant_owner::~_barycentricinterpolant_owner() -{ - alglib_impl::_barycentricinterpolant_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::barycentricinterpolant* _barycentricinterpolant_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::barycentricinterpolant* _barycentricinterpolant_owner::c_ptr() const -{ - return const_cast(p_struct); -} -barycentricinterpolant::barycentricinterpolant() : _barycentricinterpolant_owner() -{ -} - -barycentricinterpolant::barycentricinterpolant(const barycentricinterpolant &rhs):_barycentricinterpolant_owner(rhs) -{ -} - -barycentricinterpolant& barycentricinterpolant::operator=(const barycentricinterpolant &rhs) -{ - if( this==&rhs ) - return *this; - _barycentricinterpolant_owner::operator=(rhs); - return *this; -} - -barycentricinterpolant::~barycentricinterpolant() -{ -} - -/************************************************************************* -Rational interpolation using barycentric formula - -F(t) = SUM(i=0,n-1,w[i]*f[i]/(t-x[i])) / SUM(i=0,n-1,w[i]/(t-x[i])) - -Input parameters: - B - barycentric interpolant built with one of model building - subroutines. - T - interpolation point - -Result: - barycentric interpolant F(t) - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -double barycentriccalc(const barycentricinterpolant &b, const double t) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::barycentriccalc(const_cast(b.c_ptr()), t, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Differentiation of barycentric interpolant: first derivative. - -Algorithm used in this subroutine is very robust and should not fail until -provided with values too close to MaxRealNumber (usually MaxRealNumber/N -or greater will overflow). - -INPUT PARAMETERS: - B - barycentric interpolant built with one of model building - subroutines. - T - interpolation point - -OUTPUT PARAMETERS: - F - barycentric interpolant at T - DF - first derivative - -NOTE - - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void barycentricdiff1(const barycentricinterpolant &b, const double t, double &f, double &df) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::barycentricdiff1(const_cast(b.c_ptr()), t, &f, &df, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Differentiation of barycentric interpolant: first/second derivatives. - -INPUT PARAMETERS: - B - barycentric interpolant built with one of model building - subroutines. - T - interpolation point - -OUTPUT PARAMETERS: - F - barycentric interpolant at T - DF - first derivative - D2F - second derivative - -NOTE: this algorithm may fail due to overflow/underflor if used on data -whose values are close to MaxRealNumber or MinRealNumber. Use more robust -BarycentricDiff1() subroutine in such cases. - - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void barycentricdiff2(const barycentricinterpolant &b, const double t, double &f, double &df, double &d2f) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::barycentricdiff2(const_cast(b.c_ptr()), t, &f, &df, &d2f, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine performs linear transformation of the argument. - -INPUT PARAMETERS: - B - rational interpolant in barycentric form - CA, CB - transformation coefficients: x = CA*t + CB - -OUTPUT PARAMETERS: - B - transformed interpolant with X replaced by T - - -- ALGLIB PROJECT -- - Copyright 19.08.2009 by Bochkanov Sergey -*************************************************************************/ -void barycentriclintransx(const barycentricinterpolant &b, const double ca, const double cb) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::barycentriclintransx(const_cast(b.c_ptr()), ca, cb, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine performs linear transformation of the barycentric -interpolant. - -INPUT PARAMETERS: - B - rational interpolant in barycentric form - CA, CB - transformation coefficients: B2(x) = CA*B(x) + CB - -OUTPUT PARAMETERS: - B - transformed interpolant - - -- ALGLIB PROJECT -- - Copyright 19.08.2009 by Bochkanov Sergey -*************************************************************************/ -void barycentriclintransy(const barycentricinterpolant &b, const double ca, const double cb) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::barycentriclintransy(const_cast(b.c_ptr()), ca, cb, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Extracts X/Y/W arrays from rational interpolant - -INPUT PARAMETERS: - B - barycentric interpolant - -OUTPUT PARAMETERS: - N - nodes count, N>0 - X - interpolation nodes, array[0..N-1] - F - function values, array[0..N-1] - W - barycentric weights, array[0..N-1] - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void barycentricunpack(const barycentricinterpolant &b, ae_int_t &n, real_1d_array &x, real_1d_array &y, real_1d_array &w) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::barycentricunpack(const_cast(b.c_ptr()), &n, const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Rational interpolant from X/Y/W arrays - -F(t) = SUM(i=0,n-1,w[i]*f[i]/(t-x[i])) / SUM(i=0,n-1,w[i]/(t-x[i])) - -INPUT PARAMETERS: - X - interpolation nodes, array[0..N-1] - F - function values, array[0..N-1] - W - barycentric weights, array[0..N-1] - N - nodes count, N>0 - -OUTPUT PARAMETERS: - B - barycentric interpolant built from (X, Y, W) - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void barycentricbuildxyw(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const ae_int_t n, barycentricinterpolant &b) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::barycentricbuildxyw(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), n, const_cast(b.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Rational interpolant without poles - -The subroutine constructs the rational interpolating function without real -poles (see 'Barycentric rational interpolation with no poles and high -rates of approximation', Michael S. Floater. and Kai Hormann, for more -information on this subject). - -Input parameters: - X - interpolation nodes, array[0..N-1]. - Y - function values, array[0..N-1]. - N - number of nodes, N>0. - D - order of the interpolation scheme, 0 <= D <= N-1. - D<0 will cause an error. - D>=N it will be replaced with D=N-1. - if you don't know what D to choose, use small value about 3-5. - -Output parameters: - B - barycentric interpolant. - -Note: - this algorithm always succeeds and calculates the weights with close - to machine precision. - - -- ALGLIB PROJECT -- - Copyright 17.06.2007 by Bochkanov Sergey -*************************************************************************/ -void barycentricbuildfloaterhormann(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t d, barycentricinterpolant &b) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::barycentricbuildfloaterhormann(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, d, const_cast(b.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Conversion from barycentric representation to Chebyshev basis. -This function has O(N^2) complexity. - -INPUT PARAMETERS: - P - polynomial in barycentric form - A,B - base interval for Chebyshev polynomials (see below) - A<>B - -OUTPUT PARAMETERS - T - coefficients of Chebyshev representation; - P(x) = sum { T[i]*Ti(2*(x-A)/(B-A)-1), i=0..N-1 }, - where Ti - I-th Chebyshev polynomial. - -NOTES: - barycentric interpolant passed as P may be either polynomial obtained - from polynomial interpolation/ fitting or rational function which is - NOT polynomial. We can't distinguish between these two cases, and this - algorithm just tries to work assuming that P IS a polynomial. If not, - algorithm will return results, but they won't have any meaning. - - -- ALGLIB -- - Copyright 30.09.2010 by Bochkanov Sergey -*************************************************************************/ -void polynomialbar2cheb(const barycentricinterpolant &p, const double a, const double b, real_1d_array &t) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::polynomialbar2cheb(const_cast(p.c_ptr()), a, b, const_cast(t.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Conversion from Chebyshev basis to barycentric representation. -This function has O(N^2) complexity. - -INPUT PARAMETERS: - T - coefficients of Chebyshev representation; - P(x) = sum { T[i]*Ti(2*(x-A)/(B-A)-1), i=0..N }, - where Ti - I-th Chebyshev polynomial. - N - number of coefficients: - * if given, only leading N elements of T are used - * if not given, automatically determined from size of T - A,B - base interval for Chebyshev polynomials (see above) - A(t.c_ptr()), n, a, b, const_cast(p.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Conversion from Chebyshev basis to barycentric representation. -This function has O(N^2) complexity. - -INPUT PARAMETERS: - T - coefficients of Chebyshev representation; - P(x) = sum { T[i]*Ti(2*(x-A)/(B-A)-1), i=0..N }, - where Ti - I-th Chebyshev polynomial. - N - number of coefficients: - * if given, only leading N elements of T are used - * if not given, automatically determined from size of T - A,B - base interval for Chebyshev polynomials (see above) - A(t.c_ptr()), n, a, b, const_cast(p.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Conversion from barycentric representation to power basis. -This function has O(N^2) complexity. - -INPUT PARAMETERS: - P - polynomial in barycentric form - C - offset (see below); 0.0 is used as default value. - S - scale (see below); 1.0 is used as default value. S<>0. - -OUTPUT PARAMETERS - A - coefficients, P(x) = sum { A[i]*((X-C)/S)^i, i=0..N-1 } - N - number of coefficients (polynomial degree plus 1) - -NOTES: -1. this function accepts offset and scale, which can be set to improve - numerical properties of polynomial. For example, if P was obtained as - result of interpolation on [-1,+1], you can set C=0 and S=1 and - represent P as sum of 1, x, x^2, x^3 and so on. In most cases you it - is exactly what you need. - - However, if your interpolation model was built on [999,1001], you will - see significant growth of numerical errors when using {1, x, x^2, x^3} - as basis. Representing P as sum of 1, (x-1000), (x-1000)^2, (x-1000)^3 - will be better option. Such representation can be obtained by using - 1000.0 as offset C and 1.0 as scale S. - -2. power basis is ill-conditioned and tricks described above can't solve - this problem completely. This function will return coefficients in - any case, but for N>8 they will become unreliable. However, N's - less than 5 are pretty safe. - -3. barycentric interpolant passed as P may be either polynomial obtained - from polynomial interpolation/ fitting or rational function which is - NOT polynomial. We can't distinguish between these two cases, and this - algorithm just tries to work assuming that P IS a polynomial. If not, - algorithm will return results, but they won't have any meaning. - - -- ALGLIB -- - Copyright 30.09.2010 by Bochkanov Sergey -*************************************************************************/ -void polynomialbar2pow(const barycentricinterpolant &p, const double c, const double s, real_1d_array &a) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::polynomialbar2pow(const_cast(p.c_ptr()), c, s, const_cast(a.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Conversion from barycentric representation to power basis. -This function has O(N^2) complexity. - -INPUT PARAMETERS: - P - polynomial in barycentric form - C - offset (see below); 0.0 is used as default value. - S - scale (see below); 1.0 is used as default value. S<>0. - -OUTPUT PARAMETERS - A - coefficients, P(x) = sum { A[i]*((X-C)/S)^i, i=0..N-1 } - N - number of coefficients (polynomial degree plus 1) - -NOTES: -1. this function accepts offset and scale, which can be set to improve - numerical properties of polynomial. For example, if P was obtained as - result of interpolation on [-1,+1], you can set C=0 and S=1 and - represent P as sum of 1, x, x^2, x^3 and so on. In most cases you it - is exactly what you need. - - However, if your interpolation model was built on [999,1001], you will - see significant growth of numerical errors when using {1, x, x^2, x^3} - as basis. Representing P as sum of 1, (x-1000), (x-1000)^2, (x-1000)^3 - will be better option. Such representation can be obtained by using - 1000.0 as offset C and 1.0 as scale S. - -2. power basis is ill-conditioned and tricks described above can't solve - this problem completely. This function will return coefficients in - any case, but for N>8 they will become unreliable. However, N's - less than 5 are pretty safe. - -3. barycentric interpolant passed as P may be either polynomial obtained - from polynomial interpolation/ fitting or rational function which is - NOT polynomial. We can't distinguish between these two cases, and this - algorithm just tries to work assuming that P IS a polynomial. If not, - algorithm will return results, but they won't have any meaning. - - -- ALGLIB -- - Copyright 30.09.2010 by Bochkanov Sergey -*************************************************************************/ -void polynomialbar2pow(const barycentricinterpolant &p, real_1d_array &a) -{ - alglib_impl::ae_state _alglib_env_state; - double c; - double s; - - c = 0; - s = 1; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::polynomialbar2pow(const_cast(p.c_ptr()), c, s, const_cast(a.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Conversion from power basis to barycentric representation. -This function has O(N^2) complexity. - -INPUT PARAMETERS: - A - coefficients, P(x) = sum { A[i]*((X-C)/S)^i, i=0..N-1 } - N - number of coefficients (polynomial degree plus 1) - * if given, only leading N elements of A are used - * if not given, automatically determined from size of A - C - offset (see below); 0.0 is used as default value. - S - scale (see below); 1.0 is used as default value. S<>0. - -OUTPUT PARAMETERS - P - polynomial in barycentric form - - -NOTES: -1. this function accepts offset and scale, which can be set to improve - numerical properties of polynomial. For example, if you interpolate on - [-1,+1], you can set C=0 and S=1 and convert from sum of 1, x, x^2, - x^3 and so on. In most cases you it is exactly what you need. - - However, if your interpolation model was built on [999,1001], you will - see significant growth of numerical errors when using {1, x, x^2, x^3} - as input basis. Converting from sum of 1, (x-1000), (x-1000)^2, - (x-1000)^3 will be better option (you have to specify 1000.0 as offset - C and 1.0 as scale S). - -2. power basis is ill-conditioned and tricks described above can't solve - this problem completely. This function will return barycentric model - in any case, but for N>8 accuracy well degrade. However, N's less than - 5 are pretty safe. - - -- ALGLIB -- - Copyright 30.09.2010 by Bochkanov Sergey -*************************************************************************/ -void polynomialpow2bar(const real_1d_array &a, const ae_int_t n, const double c, const double s, barycentricinterpolant &p) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::polynomialpow2bar(const_cast(a.c_ptr()), n, c, s, const_cast(p.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Conversion from power basis to barycentric representation. -This function has O(N^2) complexity. - -INPUT PARAMETERS: - A - coefficients, P(x) = sum { A[i]*((X-C)/S)^i, i=0..N-1 } - N - number of coefficients (polynomial degree plus 1) - * if given, only leading N elements of A are used - * if not given, automatically determined from size of A - C - offset (see below); 0.0 is used as default value. - S - scale (see below); 1.0 is used as default value. S<>0. - -OUTPUT PARAMETERS - P - polynomial in barycentric form - - -NOTES: -1. this function accepts offset and scale, which can be set to improve - numerical properties of polynomial. For example, if you interpolate on - [-1,+1], you can set C=0 and S=1 and convert from sum of 1, x, x^2, - x^3 and so on. In most cases you it is exactly what you need. - - However, if your interpolation model was built on [999,1001], you will - see significant growth of numerical errors when using {1, x, x^2, x^3} - as input basis. Converting from sum of 1, (x-1000), (x-1000)^2, - (x-1000)^3 will be better option (you have to specify 1000.0 as offset - C and 1.0 as scale S). - -2. power basis is ill-conditioned and tricks described above can't solve - this problem completely. This function will return barycentric model - in any case, but for N>8 accuracy well degrade. However, N's less than - 5 are pretty safe. - - -- ALGLIB -- - Copyright 30.09.2010 by Bochkanov Sergey -*************************************************************************/ -void polynomialpow2bar(const real_1d_array &a, barycentricinterpolant &p) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - double c; - double s; - - n = a.length(); - c = 0; - s = 1; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::polynomialpow2bar(const_cast(a.c_ptr()), n, c, s, const_cast(p.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Lagrange intepolant: generation of the model on the general grid. -This function has O(N^2) complexity. - -INPUT PARAMETERS: - X - abscissas, array[0..N-1] - Y - function values, array[0..N-1] - N - number of points, N>=1 - -OUTPUT PARAMETERS - P - barycentric model which represents Lagrange interpolant - (see ratint unit info and BarycentricCalc() description for - more information). - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -void polynomialbuild(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, barycentricinterpolant &p) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::polynomialbuild(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, const_cast(p.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Lagrange intepolant: generation of the model on the general grid. -This function has O(N^2) complexity. - -INPUT PARAMETERS: - X - abscissas, array[0..N-1] - Y - function values, array[0..N-1] - N - number of points, N>=1 - -OUTPUT PARAMETERS - P - barycentric model which represents Lagrange interpolant - (see ratint unit info and BarycentricCalc() description for - more information). - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -void polynomialbuild(const real_1d_array &x, const real_1d_array &y, barycentricinterpolant &p) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - if( (x.length()!=y.length())) - throw ap_error("Error while calling 'polynomialbuild': looks like one of arguments has wrong size"); - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::polynomialbuild(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, const_cast(p.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Lagrange intepolant: generation of the model on equidistant grid. -This function has O(N) complexity. - -INPUT PARAMETERS: - A - left boundary of [A,B] - B - right boundary of [A,B] - Y - function values at the nodes, array[0..N-1] - N - number of points, N>=1 - for N=1 a constant model is constructed. - -OUTPUT PARAMETERS - P - barycentric model which represents Lagrange interpolant - (see ratint unit info and BarycentricCalc() description for - more information). - - -- ALGLIB -- - Copyright 03.12.2009 by Bochkanov Sergey -*************************************************************************/ -void polynomialbuildeqdist(const double a, const double b, const real_1d_array &y, const ae_int_t n, barycentricinterpolant &p) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::polynomialbuildeqdist(a, b, const_cast(y.c_ptr()), n, const_cast(p.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Lagrange intepolant: generation of the model on equidistant grid. -This function has O(N) complexity. - -INPUT PARAMETERS: - A - left boundary of [A,B] - B - right boundary of [A,B] - Y - function values at the nodes, array[0..N-1] - N - number of points, N>=1 - for N=1 a constant model is constructed. - -OUTPUT PARAMETERS - P - barycentric model which represents Lagrange interpolant - (see ratint unit info and BarycentricCalc() description for - more information). - - -- ALGLIB -- - Copyright 03.12.2009 by Bochkanov Sergey -*************************************************************************/ -void polynomialbuildeqdist(const double a, const double b, const real_1d_array &y, barycentricinterpolant &p) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = y.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::polynomialbuildeqdist(a, b, const_cast(y.c_ptr()), n, const_cast(p.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Lagrange intepolant on Chebyshev grid (first kind). -This function has O(N) complexity. - -INPUT PARAMETERS: - A - left boundary of [A,B] - B - right boundary of [A,B] - Y - function values at the nodes, array[0..N-1], - Y[I] = Y(0.5*(B+A) + 0.5*(B-A)*Cos(PI*(2*i+1)/(2*n))) - N - number of points, N>=1 - for N=1 a constant model is constructed. - -OUTPUT PARAMETERS - P - barycentric model which represents Lagrange interpolant - (see ratint unit info and BarycentricCalc() description for - more information). - - -- ALGLIB -- - Copyright 03.12.2009 by Bochkanov Sergey -*************************************************************************/ -void polynomialbuildcheb1(const double a, const double b, const real_1d_array &y, const ae_int_t n, barycentricinterpolant &p) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::polynomialbuildcheb1(a, b, const_cast(y.c_ptr()), n, const_cast(p.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Lagrange intepolant on Chebyshev grid (first kind). -This function has O(N) complexity. - -INPUT PARAMETERS: - A - left boundary of [A,B] - B - right boundary of [A,B] - Y - function values at the nodes, array[0..N-1], - Y[I] = Y(0.5*(B+A) + 0.5*(B-A)*Cos(PI*(2*i+1)/(2*n))) - N - number of points, N>=1 - for N=1 a constant model is constructed. - -OUTPUT PARAMETERS - P - barycentric model which represents Lagrange interpolant - (see ratint unit info and BarycentricCalc() description for - more information). - - -- ALGLIB -- - Copyright 03.12.2009 by Bochkanov Sergey -*************************************************************************/ -void polynomialbuildcheb1(const double a, const double b, const real_1d_array &y, barycentricinterpolant &p) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = y.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::polynomialbuildcheb1(a, b, const_cast(y.c_ptr()), n, const_cast(p.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Lagrange intepolant on Chebyshev grid (second kind). -This function has O(N) complexity. - -INPUT PARAMETERS: - A - left boundary of [A,B] - B - right boundary of [A,B] - Y - function values at the nodes, array[0..N-1], - Y[I] = Y(0.5*(B+A) + 0.5*(B-A)*Cos(PI*i/(n-1))) - N - number of points, N>=1 - for N=1 a constant model is constructed. - -OUTPUT PARAMETERS - P - barycentric model which represents Lagrange interpolant - (see ratint unit info and BarycentricCalc() description for - more information). - - -- ALGLIB -- - Copyright 03.12.2009 by Bochkanov Sergey -*************************************************************************/ -void polynomialbuildcheb2(const double a, const double b, const real_1d_array &y, const ae_int_t n, barycentricinterpolant &p) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::polynomialbuildcheb2(a, b, const_cast(y.c_ptr()), n, const_cast(p.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Lagrange intepolant on Chebyshev grid (second kind). -This function has O(N) complexity. - -INPUT PARAMETERS: - A - left boundary of [A,B] - B - right boundary of [A,B] - Y - function values at the nodes, array[0..N-1], - Y[I] = Y(0.5*(B+A) + 0.5*(B-A)*Cos(PI*i/(n-1))) - N - number of points, N>=1 - for N=1 a constant model is constructed. - -OUTPUT PARAMETERS - P - barycentric model which represents Lagrange interpolant - (see ratint unit info and BarycentricCalc() description for - more information). - - -- ALGLIB -- - Copyright 03.12.2009 by Bochkanov Sergey -*************************************************************************/ -void polynomialbuildcheb2(const double a, const double b, const real_1d_array &y, barycentricinterpolant &p) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = y.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::polynomialbuildcheb2(a, b, const_cast(y.c_ptr()), n, const_cast(p.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Fast equidistant polynomial interpolation function with O(N) complexity - -INPUT PARAMETERS: - A - left boundary of [A,B] - B - right boundary of [A,B] - F - function values, array[0..N-1] - N - number of points on equidistant grid, N>=1 - for N=1 a constant model is constructed. - T - position where P(x) is calculated - -RESULT - value of the Lagrange interpolant at T - -IMPORTANT - this function provides fast interface which is not overflow-safe - nor it is very precise. - the best option is to use PolynomialBuildEqDist()/BarycentricCalc() - subroutines unless you are pretty sure that your data will not result - in overflow. - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -double polynomialcalceqdist(const double a, const double b, const real_1d_array &f, const ae_int_t n, const double t) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::polynomialcalceqdist(a, b, const_cast(f.c_ptr()), n, t, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Fast equidistant polynomial interpolation function with O(N) complexity - -INPUT PARAMETERS: - A - left boundary of [A,B] - B - right boundary of [A,B] - F - function values, array[0..N-1] - N - number of points on equidistant grid, N>=1 - for N=1 a constant model is constructed. - T - position where P(x) is calculated - -RESULT - value of the Lagrange interpolant at T - -IMPORTANT - this function provides fast interface which is not overflow-safe - nor it is very precise. - the best option is to use PolynomialBuildEqDist()/BarycentricCalc() - subroutines unless you are pretty sure that your data will not result - in overflow. - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -double polynomialcalceqdist(const double a, const double b, const real_1d_array &f, const double t) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = f.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::polynomialcalceqdist(a, b, const_cast(f.c_ptr()), n, t, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Fast polynomial interpolation function on Chebyshev points (first kind) -with O(N) complexity. - -INPUT PARAMETERS: - A - left boundary of [A,B] - B - right boundary of [A,B] - F - function values, array[0..N-1] - N - number of points on Chebyshev grid (first kind), - X[i] = 0.5*(B+A) + 0.5*(B-A)*Cos(PI*(2*i+1)/(2*n)) - for N=1 a constant model is constructed. - T - position where P(x) is calculated - -RESULT - value of the Lagrange interpolant at T - -IMPORTANT - this function provides fast interface which is not overflow-safe - nor it is very precise. - the best option is to use PolIntBuildCheb1()/BarycentricCalc() - subroutines unless you are pretty sure that your data will not result - in overflow. - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -double polynomialcalccheb1(const double a, const double b, const real_1d_array &f, const ae_int_t n, const double t) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::polynomialcalccheb1(a, b, const_cast(f.c_ptr()), n, t, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Fast polynomial interpolation function on Chebyshev points (first kind) -with O(N) complexity. - -INPUT PARAMETERS: - A - left boundary of [A,B] - B - right boundary of [A,B] - F - function values, array[0..N-1] - N - number of points on Chebyshev grid (first kind), - X[i] = 0.5*(B+A) + 0.5*(B-A)*Cos(PI*(2*i+1)/(2*n)) - for N=1 a constant model is constructed. - T - position where P(x) is calculated - -RESULT - value of the Lagrange interpolant at T - -IMPORTANT - this function provides fast interface which is not overflow-safe - nor it is very precise. - the best option is to use PolIntBuildCheb1()/BarycentricCalc() - subroutines unless you are pretty sure that your data will not result - in overflow. - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -double polynomialcalccheb1(const double a, const double b, const real_1d_array &f, const double t) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = f.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::polynomialcalccheb1(a, b, const_cast(f.c_ptr()), n, t, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Fast polynomial interpolation function on Chebyshev points (second kind) -with O(N) complexity. - -INPUT PARAMETERS: - A - left boundary of [A,B] - B - right boundary of [A,B] - F - function values, array[0..N-1] - N - number of points on Chebyshev grid (second kind), - X[i] = 0.5*(B+A) + 0.5*(B-A)*Cos(PI*i/(n-1)) - for N=1 a constant model is constructed. - T - position where P(x) is calculated - -RESULT - value of the Lagrange interpolant at T - -IMPORTANT - this function provides fast interface which is not overflow-safe - nor it is very precise. - the best option is to use PolIntBuildCheb2()/BarycentricCalc() - subroutines unless you are pretty sure that your data will not result - in overflow. - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -double polynomialcalccheb2(const double a, const double b, const real_1d_array &f, const ae_int_t n, const double t) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::polynomialcalccheb2(a, b, const_cast(f.c_ptr()), n, t, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Fast polynomial interpolation function on Chebyshev points (second kind) -with O(N) complexity. - -INPUT PARAMETERS: - A - left boundary of [A,B] - B - right boundary of [A,B] - F - function values, array[0..N-1] - N - number of points on Chebyshev grid (second kind), - X[i] = 0.5*(B+A) + 0.5*(B-A)*Cos(PI*i/(n-1)) - for N=1 a constant model is constructed. - T - position where P(x) is calculated - -RESULT - value of the Lagrange interpolant at T - -IMPORTANT - this function provides fast interface which is not overflow-safe - nor it is very precise. - the best option is to use PolIntBuildCheb2()/BarycentricCalc() - subroutines unless you are pretty sure that your data will not result - in overflow. - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -double polynomialcalccheb2(const double a, const double b, const real_1d_array &f, const double t) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = f.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::polynomialcalccheb2(a, b, const_cast(f.c_ptr()), n, t, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -1-dimensional spline interpolant -*************************************************************************/ -_spline1dinterpolant_owner::_spline1dinterpolant_owner() -{ - p_struct = (alglib_impl::spline1dinterpolant*)alglib_impl::ae_malloc(sizeof(alglib_impl::spline1dinterpolant), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_spline1dinterpolant_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_spline1dinterpolant_owner::_spline1dinterpolant_owner(const _spline1dinterpolant_owner &rhs) -{ - p_struct = (alglib_impl::spline1dinterpolant*)alglib_impl::ae_malloc(sizeof(alglib_impl::spline1dinterpolant), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_spline1dinterpolant_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_spline1dinterpolant_owner& _spline1dinterpolant_owner::operator=(const _spline1dinterpolant_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_spline1dinterpolant_clear(p_struct); - if( !alglib_impl::_spline1dinterpolant_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_spline1dinterpolant_owner::~_spline1dinterpolant_owner() -{ - alglib_impl::_spline1dinterpolant_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::spline1dinterpolant* _spline1dinterpolant_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::spline1dinterpolant* _spline1dinterpolant_owner::c_ptr() const -{ - return const_cast(p_struct); -} -spline1dinterpolant::spline1dinterpolant() : _spline1dinterpolant_owner() -{ -} - -spline1dinterpolant::spline1dinterpolant(const spline1dinterpolant &rhs):_spline1dinterpolant_owner(rhs) -{ -} - -spline1dinterpolant& spline1dinterpolant::operator=(const spline1dinterpolant &rhs) -{ - if( this==&rhs ) - return *this; - _spline1dinterpolant_owner::operator=(rhs); - return *this; -} - -spline1dinterpolant::~spline1dinterpolant() -{ -} - -/************************************************************************* -This subroutine builds linear spline interpolant - -INPUT PARAMETERS: - X - spline nodes, array[0..N-1] - Y - function values, array[0..N-1] - N - points count (optional): - * N>=2 - * if given, only first N points are used to build spline - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - -OUTPUT PARAMETERS: - C - spline interpolant - - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. - - -- ALGLIB PROJECT -- - Copyright 24.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline1dbuildlinear(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, spline1dinterpolant &c) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dbuildlinear(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, const_cast(c.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine builds linear spline interpolant - -INPUT PARAMETERS: - X - spline nodes, array[0..N-1] - Y - function values, array[0..N-1] - N - points count (optional): - * N>=2 - * if given, only first N points are used to build spline - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - -OUTPUT PARAMETERS: - C - spline interpolant - - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. - - -- ALGLIB PROJECT -- - Copyright 24.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline1dbuildlinear(const real_1d_array &x, const real_1d_array &y, spline1dinterpolant &c) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - if( (x.length()!=y.length())) - throw ap_error("Error while calling 'spline1dbuildlinear': looks like one of arguments has wrong size"); - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dbuildlinear(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, const_cast(c.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine builds cubic spline interpolant. - -INPUT PARAMETERS: - X - spline nodes, array[0..N-1]. - Y - function values, array[0..N-1]. - -OPTIONAL PARAMETERS: - N - points count: - * N>=2 - * if given, only first N points are used to build spline - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - BoundLType - boundary condition type for the left boundary - BoundL - left boundary condition (first or second derivative, - depending on the BoundLType) - BoundRType - boundary condition type for the right boundary - BoundR - right boundary condition (first or second derivative, - depending on the BoundRType) - -OUTPUT PARAMETERS: - C - spline interpolant - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. - -SETTING BOUNDARY VALUES: - -The BoundLType/BoundRType parameters can have the following values: - * -1, which corresonds to the periodic (cyclic) boundary conditions. - In this case: - * both BoundLType and BoundRType must be equal to -1. - * BoundL/BoundR are ignored - * Y[last] is ignored (it is assumed to be equal to Y[first]). - * 0, which corresponds to the parabolically terminated spline - (BoundL and/or BoundR are ignored). - * 1, which corresponds to the first derivative boundary condition - * 2, which corresponds to the second derivative boundary condition - * by default, BoundType=0 is used - -PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: - -Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. -However, this subroutine doesn't require you to specify equal values for -the first and last points - it automatically forces them to be equal by -copying Y[first_point] (corresponds to the leftmost, minimal X[]) to -Y[last_point]. However it is recommended to pass consistent values of Y[], -i.e. to make Y[first_point]=Y[last_point]. - - -- ALGLIB PROJECT -- - Copyright 23.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline1dbuildcubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t boundltype, const double boundl, const ae_int_t boundrtype, const double boundr, spline1dinterpolant &c) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dbuildcubic(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, boundltype, boundl, boundrtype, boundr, const_cast(c.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine builds cubic spline interpolant. - -INPUT PARAMETERS: - X - spline nodes, array[0..N-1]. - Y - function values, array[0..N-1]. - -OPTIONAL PARAMETERS: - N - points count: - * N>=2 - * if given, only first N points are used to build spline - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - BoundLType - boundary condition type for the left boundary - BoundL - left boundary condition (first or second derivative, - depending on the BoundLType) - BoundRType - boundary condition type for the right boundary - BoundR - right boundary condition (first or second derivative, - depending on the BoundRType) - -OUTPUT PARAMETERS: - C - spline interpolant - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. - -SETTING BOUNDARY VALUES: - -The BoundLType/BoundRType parameters can have the following values: - * -1, which corresonds to the periodic (cyclic) boundary conditions. - In this case: - * both BoundLType and BoundRType must be equal to -1. - * BoundL/BoundR are ignored - * Y[last] is ignored (it is assumed to be equal to Y[first]). - * 0, which corresponds to the parabolically terminated spline - (BoundL and/or BoundR are ignored). - * 1, which corresponds to the first derivative boundary condition - * 2, which corresponds to the second derivative boundary condition - * by default, BoundType=0 is used - -PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: - -Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. -However, this subroutine doesn't require you to specify equal values for -the first and last points - it automatically forces them to be equal by -copying Y[first_point] (corresponds to the leftmost, minimal X[]) to -Y[last_point]. However it is recommended to pass consistent values of Y[], -i.e. to make Y[first_point]=Y[last_point]. - - -- ALGLIB PROJECT -- - Copyright 23.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline1dbuildcubic(const real_1d_array &x, const real_1d_array &y, spline1dinterpolant &c) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t boundltype; - double boundl; - ae_int_t boundrtype; - double boundr; - if( (x.length()!=y.length())) - throw ap_error("Error while calling 'spline1dbuildcubic': looks like one of arguments has wrong size"); - n = x.length(); - boundltype = 0; - boundl = 0; - boundrtype = 0; - boundr = 0; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dbuildcubic(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, boundltype, boundl, boundrtype, boundr, const_cast(c.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function solves following problem: given table y[] of function values -at nodes x[], it calculates and returns table of function derivatives d[] -(calculated at the same nodes x[]). - -This function yields same result as Spline1DBuildCubic() call followed by -sequence of Spline1DDiff() calls, but it can be several times faster when -called for ordered X[] and X2[]. - -INPUT PARAMETERS: - X - spline nodes - Y - function values - -OPTIONAL PARAMETERS: - N - points count: - * N>=2 - * if given, only first N points are used - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - BoundLType - boundary condition type for the left boundary - BoundL - left boundary condition (first or second derivative, - depending on the BoundLType) - BoundRType - boundary condition type for the right boundary - BoundR - right boundary condition (first or second derivative, - depending on the BoundRType) - -OUTPUT PARAMETERS: - D - derivative values at X[] - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. -Derivative values are correctly reordered on return, so D[I] is always -equal to S'(X[I]) independently of points order. - -SETTING BOUNDARY VALUES: - -The BoundLType/BoundRType parameters can have the following values: - * -1, which corresonds to the periodic (cyclic) boundary conditions. - In this case: - * both BoundLType and BoundRType must be equal to -1. - * BoundL/BoundR are ignored - * Y[last] is ignored (it is assumed to be equal to Y[first]). - * 0, which corresponds to the parabolically terminated spline - (BoundL and/or BoundR are ignored). - * 1, which corresponds to the first derivative boundary condition - * 2, which corresponds to the second derivative boundary condition - * by default, BoundType=0 is used - -PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: - -Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. -However, this subroutine doesn't require you to specify equal values for -the first and last points - it automatically forces them to be equal by -copying Y[first_point] (corresponds to the leftmost, minimal X[]) to -Y[last_point]. However it is recommended to pass consistent values of Y[], -i.e. to make Y[first_point]=Y[last_point]. - - -- ALGLIB PROJECT -- - Copyright 03.09.2010 by Bochkanov Sergey -*************************************************************************/ -void spline1dgriddiffcubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t boundltype, const double boundl, const ae_int_t boundrtype, const double boundr, real_1d_array &d) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dgriddiffcubic(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, boundltype, boundl, boundrtype, boundr, const_cast(d.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function solves following problem: given table y[] of function values -at nodes x[], it calculates and returns table of function derivatives d[] -(calculated at the same nodes x[]). - -This function yields same result as Spline1DBuildCubic() call followed by -sequence of Spline1DDiff() calls, but it can be several times faster when -called for ordered X[] and X2[]. - -INPUT PARAMETERS: - X - spline nodes - Y - function values - -OPTIONAL PARAMETERS: - N - points count: - * N>=2 - * if given, only first N points are used - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - BoundLType - boundary condition type for the left boundary - BoundL - left boundary condition (first or second derivative, - depending on the BoundLType) - BoundRType - boundary condition type for the right boundary - BoundR - right boundary condition (first or second derivative, - depending on the BoundRType) - -OUTPUT PARAMETERS: - D - derivative values at X[] - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. -Derivative values are correctly reordered on return, so D[I] is always -equal to S'(X[I]) independently of points order. - -SETTING BOUNDARY VALUES: - -The BoundLType/BoundRType parameters can have the following values: - * -1, which corresonds to the periodic (cyclic) boundary conditions. - In this case: - * both BoundLType and BoundRType must be equal to -1. - * BoundL/BoundR are ignored - * Y[last] is ignored (it is assumed to be equal to Y[first]). - * 0, which corresponds to the parabolically terminated spline - (BoundL and/or BoundR are ignored). - * 1, which corresponds to the first derivative boundary condition - * 2, which corresponds to the second derivative boundary condition - * by default, BoundType=0 is used - -PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: - -Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. -However, this subroutine doesn't require you to specify equal values for -the first and last points - it automatically forces them to be equal by -copying Y[first_point] (corresponds to the leftmost, minimal X[]) to -Y[last_point]. However it is recommended to pass consistent values of Y[], -i.e. to make Y[first_point]=Y[last_point]. - - -- ALGLIB PROJECT -- - Copyright 03.09.2010 by Bochkanov Sergey -*************************************************************************/ -void spline1dgriddiffcubic(const real_1d_array &x, const real_1d_array &y, real_1d_array &d) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t boundltype; - double boundl; - ae_int_t boundrtype; - double boundr; - if( (x.length()!=y.length())) - throw ap_error("Error while calling 'spline1dgriddiffcubic': looks like one of arguments has wrong size"); - n = x.length(); - boundltype = 0; - boundl = 0; - boundrtype = 0; - boundr = 0; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dgriddiffcubic(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, boundltype, boundl, boundrtype, boundr, const_cast(d.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function solves following problem: given table y[] of function values -at nodes x[], it calculates and returns tables of first and second -function derivatives d1[] and d2[] (calculated at the same nodes x[]). - -This function yields same result as Spline1DBuildCubic() call followed by -sequence of Spline1DDiff() calls, but it can be several times faster when -called for ordered X[] and X2[]. - -INPUT PARAMETERS: - X - spline nodes - Y - function values - -OPTIONAL PARAMETERS: - N - points count: - * N>=2 - * if given, only first N points are used - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - BoundLType - boundary condition type for the left boundary - BoundL - left boundary condition (first or second derivative, - depending on the BoundLType) - BoundRType - boundary condition type for the right boundary - BoundR - right boundary condition (first or second derivative, - depending on the BoundRType) - -OUTPUT PARAMETERS: - D1 - S' values at X[] - D2 - S'' values at X[] - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. -Derivative values are correctly reordered on return, so D[I] is always -equal to S'(X[I]) independently of points order. - -SETTING BOUNDARY VALUES: - -The BoundLType/BoundRType parameters can have the following values: - * -1, which corresonds to the periodic (cyclic) boundary conditions. - In this case: - * both BoundLType and BoundRType must be equal to -1. - * BoundL/BoundR are ignored - * Y[last] is ignored (it is assumed to be equal to Y[first]). - * 0, which corresponds to the parabolically terminated spline - (BoundL and/or BoundR are ignored). - * 1, which corresponds to the first derivative boundary condition - * 2, which corresponds to the second derivative boundary condition - * by default, BoundType=0 is used - -PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: - -Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. -However, this subroutine doesn't require you to specify equal values for -the first and last points - it automatically forces them to be equal by -copying Y[first_point] (corresponds to the leftmost, minimal X[]) to -Y[last_point]. However it is recommended to pass consistent values of Y[], -i.e. to make Y[first_point]=Y[last_point]. - - -- ALGLIB PROJECT -- - Copyright 03.09.2010 by Bochkanov Sergey -*************************************************************************/ -void spline1dgriddiff2cubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t boundltype, const double boundl, const ae_int_t boundrtype, const double boundr, real_1d_array &d1, real_1d_array &d2) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dgriddiff2cubic(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, boundltype, boundl, boundrtype, boundr, const_cast(d1.c_ptr()), const_cast(d2.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function solves following problem: given table y[] of function values -at nodes x[], it calculates and returns tables of first and second -function derivatives d1[] and d2[] (calculated at the same nodes x[]). - -This function yields same result as Spline1DBuildCubic() call followed by -sequence of Spline1DDiff() calls, but it can be several times faster when -called for ordered X[] and X2[]. - -INPUT PARAMETERS: - X - spline nodes - Y - function values - -OPTIONAL PARAMETERS: - N - points count: - * N>=2 - * if given, only first N points are used - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - BoundLType - boundary condition type for the left boundary - BoundL - left boundary condition (first or second derivative, - depending on the BoundLType) - BoundRType - boundary condition type for the right boundary - BoundR - right boundary condition (first or second derivative, - depending on the BoundRType) - -OUTPUT PARAMETERS: - D1 - S' values at X[] - D2 - S'' values at X[] - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. -Derivative values are correctly reordered on return, so D[I] is always -equal to S'(X[I]) independently of points order. - -SETTING BOUNDARY VALUES: - -The BoundLType/BoundRType parameters can have the following values: - * -1, which corresonds to the periodic (cyclic) boundary conditions. - In this case: - * both BoundLType and BoundRType must be equal to -1. - * BoundL/BoundR are ignored - * Y[last] is ignored (it is assumed to be equal to Y[first]). - * 0, which corresponds to the parabolically terminated spline - (BoundL and/or BoundR are ignored). - * 1, which corresponds to the first derivative boundary condition - * 2, which corresponds to the second derivative boundary condition - * by default, BoundType=0 is used - -PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: - -Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. -However, this subroutine doesn't require you to specify equal values for -the first and last points - it automatically forces them to be equal by -copying Y[first_point] (corresponds to the leftmost, minimal X[]) to -Y[last_point]. However it is recommended to pass consistent values of Y[], -i.e. to make Y[first_point]=Y[last_point]. - - -- ALGLIB PROJECT -- - Copyright 03.09.2010 by Bochkanov Sergey -*************************************************************************/ -void spline1dgriddiff2cubic(const real_1d_array &x, const real_1d_array &y, real_1d_array &d1, real_1d_array &d2) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t boundltype; - double boundl; - ae_int_t boundrtype; - double boundr; - if( (x.length()!=y.length())) - throw ap_error("Error while calling 'spline1dgriddiff2cubic': looks like one of arguments has wrong size"); - n = x.length(); - boundltype = 0; - boundl = 0; - boundrtype = 0; - boundr = 0; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dgriddiff2cubic(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, boundltype, boundl, boundrtype, boundr, const_cast(d1.c_ptr()), const_cast(d2.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function solves following problem: given table y[] of function values -at old nodes x[] and new nodes x2[], it calculates and returns table of -function values y2[] (calculated at x2[]). - -This function yields same result as Spline1DBuildCubic() call followed by -sequence of Spline1DDiff() calls, but it can be several times faster when -called for ordered X[] and X2[]. - -INPUT PARAMETERS: - X - old spline nodes - Y - function values - X2 - new spline nodes - -OPTIONAL PARAMETERS: - N - points count: - * N>=2 - * if given, only first N points from X/Y are used - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - BoundLType - boundary condition type for the left boundary - BoundL - left boundary condition (first or second derivative, - depending on the BoundLType) - BoundRType - boundary condition type for the right boundary - BoundR - right boundary condition (first or second derivative, - depending on the BoundRType) - N2 - new points count: - * N2>=2 - * if given, only first N2 points from X2 are used - * if not given, automatically detected from X2 size - -OUTPUT PARAMETERS: - F2 - function values at X2[] - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. -Function values are correctly reordered on return, so F2[I] is always -equal to S(X2[I]) independently of points order. - -SETTING BOUNDARY VALUES: - -The BoundLType/BoundRType parameters can have the following values: - * -1, which corresonds to the periodic (cyclic) boundary conditions. - In this case: - * both BoundLType and BoundRType must be equal to -1. - * BoundL/BoundR are ignored - * Y[last] is ignored (it is assumed to be equal to Y[first]). - * 0, which corresponds to the parabolically terminated spline - (BoundL and/or BoundR are ignored). - * 1, which corresponds to the first derivative boundary condition - * 2, which corresponds to the second derivative boundary condition - * by default, BoundType=0 is used - -PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: - -Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. -However, this subroutine doesn't require you to specify equal values for -the first and last points - it automatically forces them to be equal by -copying Y[first_point] (corresponds to the leftmost, minimal X[]) to -Y[last_point]. However it is recommended to pass consistent values of Y[], -i.e. to make Y[first_point]=Y[last_point]. - - -- ALGLIB PROJECT -- - Copyright 03.09.2010 by Bochkanov Sergey -*************************************************************************/ -void spline1dconvcubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t boundltype, const double boundl, const ae_int_t boundrtype, const double boundr, const real_1d_array &x2, const ae_int_t n2, real_1d_array &y2) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dconvcubic(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, boundltype, boundl, boundrtype, boundr, const_cast(x2.c_ptr()), n2, const_cast(y2.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function solves following problem: given table y[] of function values -at old nodes x[] and new nodes x2[], it calculates and returns table of -function values y2[] (calculated at x2[]). - -This function yields same result as Spline1DBuildCubic() call followed by -sequence of Spline1DDiff() calls, but it can be several times faster when -called for ordered X[] and X2[]. - -INPUT PARAMETERS: - X - old spline nodes - Y - function values - X2 - new spline nodes - -OPTIONAL PARAMETERS: - N - points count: - * N>=2 - * if given, only first N points from X/Y are used - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - BoundLType - boundary condition type for the left boundary - BoundL - left boundary condition (first or second derivative, - depending on the BoundLType) - BoundRType - boundary condition type for the right boundary - BoundR - right boundary condition (first or second derivative, - depending on the BoundRType) - N2 - new points count: - * N2>=2 - * if given, only first N2 points from X2 are used - * if not given, automatically detected from X2 size - -OUTPUT PARAMETERS: - F2 - function values at X2[] - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. -Function values are correctly reordered on return, so F2[I] is always -equal to S(X2[I]) independently of points order. - -SETTING BOUNDARY VALUES: - -The BoundLType/BoundRType parameters can have the following values: - * -1, which corresonds to the periodic (cyclic) boundary conditions. - In this case: - * both BoundLType and BoundRType must be equal to -1. - * BoundL/BoundR are ignored - * Y[last] is ignored (it is assumed to be equal to Y[first]). - * 0, which corresponds to the parabolically terminated spline - (BoundL and/or BoundR are ignored). - * 1, which corresponds to the first derivative boundary condition - * 2, which corresponds to the second derivative boundary condition - * by default, BoundType=0 is used - -PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: - -Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. -However, this subroutine doesn't require you to specify equal values for -the first and last points - it automatically forces them to be equal by -copying Y[first_point] (corresponds to the leftmost, minimal X[]) to -Y[last_point]. However it is recommended to pass consistent values of Y[], -i.e. to make Y[first_point]=Y[last_point]. - - -- ALGLIB PROJECT -- - Copyright 03.09.2010 by Bochkanov Sergey -*************************************************************************/ -void spline1dconvcubic(const real_1d_array &x, const real_1d_array &y, const real_1d_array &x2, real_1d_array &y2) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t boundltype; - double boundl; - ae_int_t boundrtype; - double boundr; - ae_int_t n2; - if( (x.length()!=y.length())) - throw ap_error("Error while calling 'spline1dconvcubic': looks like one of arguments has wrong size"); - n = x.length(); - boundltype = 0; - boundl = 0; - boundrtype = 0; - boundr = 0; - n2 = x2.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dconvcubic(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, boundltype, boundl, boundrtype, boundr, const_cast(x2.c_ptr()), n2, const_cast(y2.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function solves following problem: given table y[] of function values -at old nodes x[] and new nodes x2[], it calculates and returns table of -function values y2[] and derivatives d2[] (calculated at x2[]). - -This function yields same result as Spline1DBuildCubic() call followed by -sequence of Spline1DDiff() calls, but it can be several times faster when -called for ordered X[] and X2[]. - -INPUT PARAMETERS: - X - old spline nodes - Y - function values - X2 - new spline nodes - -OPTIONAL PARAMETERS: - N - points count: - * N>=2 - * if given, only first N points from X/Y are used - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - BoundLType - boundary condition type for the left boundary - BoundL - left boundary condition (first or second derivative, - depending on the BoundLType) - BoundRType - boundary condition type for the right boundary - BoundR - right boundary condition (first or second derivative, - depending on the BoundRType) - N2 - new points count: - * N2>=2 - * if given, only first N2 points from X2 are used - * if not given, automatically detected from X2 size - -OUTPUT PARAMETERS: - F2 - function values at X2[] - D2 - first derivatives at X2[] - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. -Function values are correctly reordered on return, so F2[I] is always -equal to S(X2[I]) independently of points order. - -SETTING BOUNDARY VALUES: - -The BoundLType/BoundRType parameters can have the following values: - * -1, which corresonds to the periodic (cyclic) boundary conditions. - In this case: - * both BoundLType and BoundRType must be equal to -1. - * BoundL/BoundR are ignored - * Y[last] is ignored (it is assumed to be equal to Y[first]). - * 0, which corresponds to the parabolically terminated spline - (BoundL and/or BoundR are ignored). - * 1, which corresponds to the first derivative boundary condition - * 2, which corresponds to the second derivative boundary condition - * by default, BoundType=0 is used - -PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: - -Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. -However, this subroutine doesn't require you to specify equal values for -the first and last points - it automatically forces them to be equal by -copying Y[first_point] (corresponds to the leftmost, minimal X[]) to -Y[last_point]. However it is recommended to pass consistent values of Y[], -i.e. to make Y[first_point]=Y[last_point]. - - -- ALGLIB PROJECT -- - Copyright 03.09.2010 by Bochkanov Sergey -*************************************************************************/ -void spline1dconvdiffcubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t boundltype, const double boundl, const ae_int_t boundrtype, const double boundr, const real_1d_array &x2, const ae_int_t n2, real_1d_array &y2, real_1d_array &d2) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dconvdiffcubic(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, boundltype, boundl, boundrtype, boundr, const_cast(x2.c_ptr()), n2, const_cast(y2.c_ptr()), const_cast(d2.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function solves following problem: given table y[] of function values -at old nodes x[] and new nodes x2[], it calculates and returns table of -function values y2[] and derivatives d2[] (calculated at x2[]). - -This function yields same result as Spline1DBuildCubic() call followed by -sequence of Spline1DDiff() calls, but it can be several times faster when -called for ordered X[] and X2[]. - -INPUT PARAMETERS: - X - old spline nodes - Y - function values - X2 - new spline nodes - -OPTIONAL PARAMETERS: - N - points count: - * N>=2 - * if given, only first N points from X/Y are used - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - BoundLType - boundary condition type for the left boundary - BoundL - left boundary condition (first or second derivative, - depending on the BoundLType) - BoundRType - boundary condition type for the right boundary - BoundR - right boundary condition (first or second derivative, - depending on the BoundRType) - N2 - new points count: - * N2>=2 - * if given, only first N2 points from X2 are used - * if not given, automatically detected from X2 size - -OUTPUT PARAMETERS: - F2 - function values at X2[] - D2 - first derivatives at X2[] - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. -Function values are correctly reordered on return, so F2[I] is always -equal to S(X2[I]) independently of points order. - -SETTING BOUNDARY VALUES: - -The BoundLType/BoundRType parameters can have the following values: - * -1, which corresonds to the periodic (cyclic) boundary conditions. - In this case: - * both BoundLType and BoundRType must be equal to -1. - * BoundL/BoundR are ignored - * Y[last] is ignored (it is assumed to be equal to Y[first]). - * 0, which corresponds to the parabolically terminated spline - (BoundL and/or BoundR are ignored). - * 1, which corresponds to the first derivative boundary condition - * 2, which corresponds to the second derivative boundary condition - * by default, BoundType=0 is used - -PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: - -Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. -However, this subroutine doesn't require you to specify equal values for -the first and last points - it automatically forces them to be equal by -copying Y[first_point] (corresponds to the leftmost, minimal X[]) to -Y[last_point]. However it is recommended to pass consistent values of Y[], -i.e. to make Y[first_point]=Y[last_point]. - - -- ALGLIB PROJECT -- - Copyright 03.09.2010 by Bochkanov Sergey -*************************************************************************/ -void spline1dconvdiffcubic(const real_1d_array &x, const real_1d_array &y, const real_1d_array &x2, real_1d_array &y2, real_1d_array &d2) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t boundltype; - double boundl; - ae_int_t boundrtype; - double boundr; - ae_int_t n2; - if( (x.length()!=y.length())) - throw ap_error("Error while calling 'spline1dconvdiffcubic': looks like one of arguments has wrong size"); - n = x.length(); - boundltype = 0; - boundl = 0; - boundrtype = 0; - boundr = 0; - n2 = x2.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dconvdiffcubic(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, boundltype, boundl, boundrtype, boundr, const_cast(x2.c_ptr()), n2, const_cast(y2.c_ptr()), const_cast(d2.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function solves following problem: given table y[] of function values -at old nodes x[] and new nodes x2[], it calculates and returns table of -function values y2[], first and second derivatives d2[] and dd2[] -(calculated at x2[]). - -This function yields same result as Spline1DBuildCubic() call followed by -sequence of Spline1DDiff() calls, but it can be several times faster when -called for ordered X[] and X2[]. - -INPUT PARAMETERS: - X - old spline nodes - Y - function values - X2 - new spline nodes - -OPTIONAL PARAMETERS: - N - points count: - * N>=2 - * if given, only first N points from X/Y are used - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - BoundLType - boundary condition type for the left boundary - BoundL - left boundary condition (first or second derivative, - depending on the BoundLType) - BoundRType - boundary condition type for the right boundary - BoundR - right boundary condition (first or second derivative, - depending on the BoundRType) - N2 - new points count: - * N2>=2 - * if given, only first N2 points from X2 are used - * if not given, automatically detected from X2 size - -OUTPUT PARAMETERS: - F2 - function values at X2[] - D2 - first derivatives at X2[] - DD2 - second derivatives at X2[] - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. -Function values are correctly reordered on return, so F2[I] is always -equal to S(X2[I]) independently of points order. - -SETTING BOUNDARY VALUES: - -The BoundLType/BoundRType parameters can have the following values: - * -1, which corresonds to the periodic (cyclic) boundary conditions. - In this case: - * both BoundLType and BoundRType must be equal to -1. - * BoundL/BoundR are ignored - * Y[last] is ignored (it is assumed to be equal to Y[first]). - * 0, which corresponds to the parabolically terminated spline - (BoundL and/or BoundR are ignored). - * 1, which corresponds to the first derivative boundary condition - * 2, which corresponds to the second derivative boundary condition - * by default, BoundType=0 is used - -PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: - -Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. -However, this subroutine doesn't require you to specify equal values for -the first and last points - it automatically forces them to be equal by -copying Y[first_point] (corresponds to the leftmost, minimal X[]) to -Y[last_point]. However it is recommended to pass consistent values of Y[], -i.e. to make Y[first_point]=Y[last_point]. - - -- ALGLIB PROJECT -- - Copyright 03.09.2010 by Bochkanov Sergey -*************************************************************************/ -void spline1dconvdiff2cubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t boundltype, const double boundl, const ae_int_t boundrtype, const double boundr, const real_1d_array &x2, const ae_int_t n2, real_1d_array &y2, real_1d_array &d2, real_1d_array &dd2) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dconvdiff2cubic(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, boundltype, boundl, boundrtype, boundr, const_cast(x2.c_ptr()), n2, const_cast(y2.c_ptr()), const_cast(d2.c_ptr()), const_cast(dd2.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function solves following problem: given table y[] of function values -at old nodes x[] and new nodes x2[], it calculates and returns table of -function values y2[], first and second derivatives d2[] and dd2[] -(calculated at x2[]). - -This function yields same result as Spline1DBuildCubic() call followed by -sequence of Spline1DDiff() calls, but it can be several times faster when -called for ordered X[] and X2[]. - -INPUT PARAMETERS: - X - old spline nodes - Y - function values - X2 - new spline nodes - -OPTIONAL PARAMETERS: - N - points count: - * N>=2 - * if given, only first N points from X/Y are used - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - BoundLType - boundary condition type for the left boundary - BoundL - left boundary condition (first or second derivative, - depending on the BoundLType) - BoundRType - boundary condition type for the right boundary - BoundR - right boundary condition (first or second derivative, - depending on the BoundRType) - N2 - new points count: - * N2>=2 - * if given, only first N2 points from X2 are used - * if not given, automatically detected from X2 size - -OUTPUT PARAMETERS: - F2 - function values at X2[] - D2 - first derivatives at X2[] - DD2 - second derivatives at X2[] - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. -Function values are correctly reordered on return, so F2[I] is always -equal to S(X2[I]) independently of points order. - -SETTING BOUNDARY VALUES: - -The BoundLType/BoundRType parameters can have the following values: - * -1, which corresonds to the periodic (cyclic) boundary conditions. - In this case: - * both BoundLType and BoundRType must be equal to -1. - * BoundL/BoundR are ignored - * Y[last] is ignored (it is assumed to be equal to Y[first]). - * 0, which corresponds to the parabolically terminated spline - (BoundL and/or BoundR are ignored). - * 1, which corresponds to the first derivative boundary condition - * 2, which corresponds to the second derivative boundary condition - * by default, BoundType=0 is used - -PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: - -Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. -However, this subroutine doesn't require you to specify equal values for -the first and last points - it automatically forces them to be equal by -copying Y[first_point] (corresponds to the leftmost, minimal X[]) to -Y[last_point]. However it is recommended to pass consistent values of Y[], -i.e. to make Y[first_point]=Y[last_point]. - - -- ALGLIB PROJECT -- - Copyright 03.09.2010 by Bochkanov Sergey -*************************************************************************/ -void spline1dconvdiff2cubic(const real_1d_array &x, const real_1d_array &y, const real_1d_array &x2, real_1d_array &y2, real_1d_array &d2, real_1d_array &dd2) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t boundltype; - double boundl; - ae_int_t boundrtype; - double boundr; - ae_int_t n2; - if( (x.length()!=y.length())) - throw ap_error("Error while calling 'spline1dconvdiff2cubic': looks like one of arguments has wrong size"); - n = x.length(); - boundltype = 0; - boundl = 0; - boundrtype = 0; - boundr = 0; - n2 = x2.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dconvdiff2cubic(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, boundltype, boundl, boundrtype, boundr, const_cast(x2.c_ptr()), n2, const_cast(y2.c_ptr()), const_cast(d2.c_ptr()), const_cast(dd2.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine builds Catmull-Rom spline interpolant. - -INPUT PARAMETERS: - X - spline nodes, array[0..N-1]. - Y - function values, array[0..N-1]. - -OPTIONAL PARAMETERS: - N - points count: - * N>=2 - * if given, only first N points are used to build spline - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - BoundType - boundary condition type: - * -1 for periodic boundary condition - * 0 for parabolically terminated spline (default) - Tension - tension parameter: - * tension=0 corresponds to classic Catmull-Rom spline (default) - * 0(x.c_ptr()), const_cast(y.c_ptr()), n, boundtype, tension, const_cast(c.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine builds Catmull-Rom spline interpolant. - -INPUT PARAMETERS: - X - spline nodes, array[0..N-1]. - Y - function values, array[0..N-1]. - -OPTIONAL PARAMETERS: - N - points count: - * N>=2 - * if given, only first N points are used to build spline - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - BoundType - boundary condition type: - * -1 for periodic boundary condition - * 0 for parabolically terminated spline (default) - Tension - tension parameter: - * tension=0 corresponds to classic Catmull-Rom spline (default) - * 0(x.c_ptr()), const_cast(y.c_ptr()), n, boundtype, tension, const_cast(c.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine builds Hermite spline interpolant. - -INPUT PARAMETERS: - X - spline nodes, array[0..N-1] - Y - function values, array[0..N-1] - D - derivatives, array[0..N-1] - N - points count (optional): - * N>=2 - * if given, only first N points are used to build spline - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - -OUTPUT PARAMETERS: - C - spline interpolant. - - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. - - -- ALGLIB PROJECT -- - Copyright 23.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline1dbuildhermite(const real_1d_array &x, const real_1d_array &y, const real_1d_array &d, const ae_int_t n, spline1dinterpolant &c) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dbuildhermite(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(d.c_ptr()), n, const_cast(c.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine builds Hermite spline interpolant. - -INPUT PARAMETERS: - X - spline nodes, array[0..N-1] - Y - function values, array[0..N-1] - D - derivatives, array[0..N-1] - N - points count (optional): - * N>=2 - * if given, only first N points are used to build spline - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - -OUTPUT PARAMETERS: - C - spline interpolant. - - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. - - -- ALGLIB PROJECT -- - Copyright 23.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline1dbuildhermite(const real_1d_array &x, const real_1d_array &y, const real_1d_array &d, spline1dinterpolant &c) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - if( (x.length()!=y.length()) || (x.length()!=d.length())) - throw ap_error("Error while calling 'spline1dbuildhermite': looks like one of arguments has wrong size"); - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dbuildhermite(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(d.c_ptr()), n, const_cast(c.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine builds Akima spline interpolant - -INPUT PARAMETERS: - X - spline nodes, array[0..N-1] - Y - function values, array[0..N-1] - N - points count (optional): - * N>=2 - * if given, only first N points are used to build spline - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - -OUTPUT PARAMETERS: - C - spline interpolant - - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. - - -- ALGLIB PROJECT -- - Copyright 24.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline1dbuildakima(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, spline1dinterpolant &c) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dbuildakima(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, const_cast(c.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine builds Akima spline interpolant - -INPUT PARAMETERS: - X - spline nodes, array[0..N-1] - Y - function values, array[0..N-1] - N - points count (optional): - * N>=2 - * if given, only first N points are used to build spline - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - -OUTPUT PARAMETERS: - C - spline interpolant - - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. - - -- ALGLIB PROJECT -- - Copyright 24.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline1dbuildakima(const real_1d_array &x, const real_1d_array &y, spline1dinterpolant &c) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - if( (x.length()!=y.length())) - throw ap_error("Error while calling 'spline1dbuildakima': looks like one of arguments has wrong size"); - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dbuildakima(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, const_cast(c.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine calculates the value of the spline at the given point X. - -INPUT PARAMETERS: - C - spline interpolant - X - point - -Result: - S(x) - - -- ALGLIB PROJECT -- - Copyright 23.06.2007 by Bochkanov Sergey -*************************************************************************/ -double spline1dcalc(const spline1dinterpolant &c, const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::spline1dcalc(const_cast(c.c_ptr()), x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine differentiates the spline. - -INPUT PARAMETERS: - C - spline interpolant. - X - point - -Result: - S - S(x) - DS - S'(x) - D2S - S''(x) - - -- ALGLIB PROJECT -- - Copyright 24.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline1ddiff(const spline1dinterpolant &c, const double x, double &s, double &ds, double &d2s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1ddiff(const_cast(c.c_ptr()), x, &s, &ds, &d2s, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine unpacks the spline into the coefficients table. - -INPUT PARAMETERS: - C - spline interpolant. - X - point - -OUTPUT PARAMETERS: - Tbl - coefficients table, unpacked format, array[0..N-2, 0..5]. - For I = 0...N-2: - Tbl[I,0] = X[i] - Tbl[I,1] = X[i+1] - Tbl[I,2] = C0 - Tbl[I,3] = C1 - Tbl[I,4] = C2 - Tbl[I,5] = C3 - On [x[i], x[i+1]] spline is equals to: - S(x) = C0 + C1*t + C2*t^2 + C3*t^3 - t = x-x[i] - -NOTE: - You can rebuild spline with Spline1DBuildHermite() function, which - accepts as inputs function values and derivatives at nodes, which are - easy to calculate when you have coefficients. - - -- ALGLIB PROJECT -- - Copyright 29.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline1dunpack(const spline1dinterpolant &c, ae_int_t &n, real_2d_array &tbl) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dunpack(const_cast(c.c_ptr()), &n, const_cast(tbl.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine performs linear transformation of the spline argument. - -INPUT PARAMETERS: - C - spline interpolant. - A, B- transformation coefficients: x = A*t + B -Result: - C - transformed spline - - -- ALGLIB PROJECT -- - Copyright 30.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline1dlintransx(const spline1dinterpolant &c, const double a, const double b) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dlintransx(const_cast(c.c_ptr()), a, b, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine performs linear transformation of the spline. - -INPUT PARAMETERS: - C - spline interpolant. - A, B- transformation coefficients: S2(x) = A*S(x) + B -Result: - C - transformed spline - - -- ALGLIB PROJECT -- - Copyright 30.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline1dlintransy(const spline1dinterpolant &c, const double a, const double b) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dlintransy(const_cast(c.c_ptr()), a, b, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine integrates the spline. - -INPUT PARAMETERS: - C - spline interpolant. - X - right bound of the integration interval [a, x], - here 'a' denotes min(x[]) -Result: - integral(S(t)dt,a,x) - - -- ALGLIB PROJECT -- - Copyright 23.06.2007 by Bochkanov Sergey -*************************************************************************/ -double spline1dintegrate(const spline1dinterpolant &c, const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::spline1dintegrate(const_cast(c.c_ptr()), x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function builds monotone cubic Hermite interpolant. This interpolant -is monotonic in [x(0),x(n-1)] and is constant outside of this interval. - -In case y[] form non-monotonic sequence, interpolant is piecewise -monotonic. Say, for x=(0,1,2,3,4) and y=(0,1,2,1,0) interpolant will -monotonically grow at [0..2] and monotonically decrease at [2..4]. - -INPUT PARAMETERS: - X - spline nodes, array[0..N-1]. Subroutine automatically - sorts points, so caller may pass unsorted array. - Y - function values, array[0..N-1] - N - the number of points(N>=2). - -OUTPUT PARAMETERS: - C - spline interpolant. - - -- ALGLIB PROJECT -- - Copyright 21.06.2012 by Bochkanov Sergey -*************************************************************************/ -void spline1dbuildmonotone(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, spline1dinterpolant &c) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dbuildmonotone(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, const_cast(c.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function builds monotone cubic Hermite interpolant. This interpolant -is monotonic in [x(0),x(n-1)] and is constant outside of this interval. - -In case y[] form non-monotonic sequence, interpolant is piecewise -monotonic. Say, for x=(0,1,2,3,4) and y=(0,1,2,1,0) interpolant will -monotonically grow at [0..2] and monotonically decrease at [2..4]. - -INPUT PARAMETERS: - X - spline nodes, array[0..N-1]. Subroutine automatically - sorts points, so caller may pass unsorted array. - Y - function values, array[0..N-1] - N - the number of points(N>=2). - -OUTPUT PARAMETERS: - C - spline interpolant. - - -- ALGLIB PROJECT -- - Copyright 21.06.2012 by Bochkanov Sergey -*************************************************************************/ -void spline1dbuildmonotone(const real_1d_array &x, const real_1d_array &y, spline1dinterpolant &c) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - if( (x.length()!=y.length())) - throw ap_error("Error while calling 'spline1dbuildmonotone': looks like one of arguments has wrong size"); - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dbuildmonotone(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, const_cast(c.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Polynomial fitting report: - TaskRCond reciprocal of task's condition number - RMSError RMS error - AvgError average error - AvgRelError average relative error (for non-zero Y[I]) - MaxError maximum error -*************************************************************************/ -_polynomialfitreport_owner::_polynomialfitreport_owner() -{ - p_struct = (alglib_impl::polynomialfitreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::polynomialfitreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_polynomialfitreport_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_polynomialfitreport_owner::_polynomialfitreport_owner(const _polynomialfitreport_owner &rhs) -{ - p_struct = (alglib_impl::polynomialfitreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::polynomialfitreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_polynomialfitreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_polynomialfitreport_owner& _polynomialfitreport_owner::operator=(const _polynomialfitreport_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_polynomialfitreport_clear(p_struct); - if( !alglib_impl::_polynomialfitreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_polynomialfitreport_owner::~_polynomialfitreport_owner() -{ - alglib_impl::_polynomialfitreport_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::polynomialfitreport* _polynomialfitreport_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::polynomialfitreport* _polynomialfitreport_owner::c_ptr() const -{ - return const_cast(p_struct); -} -polynomialfitreport::polynomialfitreport() : _polynomialfitreport_owner() ,taskrcond(p_struct->taskrcond),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror),maxerror(p_struct->maxerror) -{ -} - -polynomialfitreport::polynomialfitreport(const polynomialfitreport &rhs):_polynomialfitreport_owner(rhs) ,taskrcond(p_struct->taskrcond),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror),maxerror(p_struct->maxerror) -{ -} - -polynomialfitreport& polynomialfitreport::operator=(const polynomialfitreport &rhs) -{ - if( this==&rhs ) - return *this; - _polynomialfitreport_owner::operator=(rhs); - return *this; -} - -polynomialfitreport::~polynomialfitreport() -{ -} - - -/************************************************************************* -Barycentric fitting report: - RMSError RMS error - AvgError average error - AvgRelError average relative error (for non-zero Y[I]) - MaxError maximum error - TaskRCond reciprocal of task's condition number -*************************************************************************/ -_barycentricfitreport_owner::_barycentricfitreport_owner() -{ - p_struct = (alglib_impl::barycentricfitreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::barycentricfitreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_barycentricfitreport_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_barycentricfitreport_owner::_barycentricfitreport_owner(const _barycentricfitreport_owner &rhs) -{ - p_struct = (alglib_impl::barycentricfitreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::barycentricfitreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_barycentricfitreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_barycentricfitreport_owner& _barycentricfitreport_owner::operator=(const _barycentricfitreport_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_barycentricfitreport_clear(p_struct); - if( !alglib_impl::_barycentricfitreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_barycentricfitreport_owner::~_barycentricfitreport_owner() -{ - alglib_impl::_barycentricfitreport_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::barycentricfitreport* _barycentricfitreport_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::barycentricfitreport* _barycentricfitreport_owner::c_ptr() const -{ - return const_cast(p_struct); -} -barycentricfitreport::barycentricfitreport() : _barycentricfitreport_owner() ,taskrcond(p_struct->taskrcond),dbest(p_struct->dbest),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror),maxerror(p_struct->maxerror) -{ -} - -barycentricfitreport::barycentricfitreport(const barycentricfitreport &rhs):_barycentricfitreport_owner(rhs) ,taskrcond(p_struct->taskrcond),dbest(p_struct->dbest),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror),maxerror(p_struct->maxerror) -{ -} - -barycentricfitreport& barycentricfitreport::operator=(const barycentricfitreport &rhs) -{ - if( this==&rhs ) - return *this; - _barycentricfitreport_owner::operator=(rhs); - return *this; -} - -barycentricfitreport::~barycentricfitreport() -{ -} - - -/************************************************************************* -Spline fitting report: - RMSError RMS error - AvgError average error - AvgRelError average relative error (for non-zero Y[I]) - MaxError maximum error - -Fields below are filled by obsolete functions (Spline1DFitCubic, -Spline1DFitHermite). Modern fitting functions do NOT fill these fields: - TaskRCond reciprocal of task's condition number -*************************************************************************/ -_spline1dfitreport_owner::_spline1dfitreport_owner() -{ - p_struct = (alglib_impl::spline1dfitreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::spline1dfitreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_spline1dfitreport_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_spline1dfitreport_owner::_spline1dfitreport_owner(const _spline1dfitreport_owner &rhs) -{ - p_struct = (alglib_impl::spline1dfitreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::spline1dfitreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_spline1dfitreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_spline1dfitreport_owner& _spline1dfitreport_owner::operator=(const _spline1dfitreport_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_spline1dfitreport_clear(p_struct); - if( !alglib_impl::_spline1dfitreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_spline1dfitreport_owner::~_spline1dfitreport_owner() -{ - alglib_impl::_spline1dfitreport_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::spline1dfitreport* _spline1dfitreport_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::spline1dfitreport* _spline1dfitreport_owner::c_ptr() const -{ - return const_cast(p_struct); -} -spline1dfitreport::spline1dfitreport() : _spline1dfitreport_owner() ,taskrcond(p_struct->taskrcond),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror),maxerror(p_struct->maxerror) -{ -} - -spline1dfitreport::spline1dfitreport(const spline1dfitreport &rhs):_spline1dfitreport_owner(rhs) ,taskrcond(p_struct->taskrcond),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror),maxerror(p_struct->maxerror) -{ -} - -spline1dfitreport& spline1dfitreport::operator=(const spline1dfitreport &rhs) -{ - if( this==&rhs ) - return *this; - _spline1dfitreport_owner::operator=(rhs); - return *this; -} - -spline1dfitreport::~spline1dfitreport() -{ -} - - -/************************************************************************* -Least squares fitting report. This structure contains informational fields -which are set by fitting functions provided by this unit. - -Different functions initialize different sets of fields, so you should -read documentation on specific function you used in order to know which -fields are initialized. - - TaskRCond reciprocal of task's condition number - IterationsCount number of internal iterations - - VarIdx if user-supplied gradient contains errors which were - detected by nonlinear fitter, this field is set to - index of the first component of gradient which is - suspected to be spoiled by bugs. - - RMSError RMS error - AvgError average error - AvgRelError average relative error (for non-zero Y[I]) - MaxError maximum error - - WRMSError weighted RMS error - - CovPar covariance matrix for parameters, filled by some solvers - ErrPar vector of errors in parameters, filled by some solvers - ErrCurve vector of fit errors - variability of the best-fit - curve, filled by some solvers. - Noise vector of per-point noise estimates, filled by - some solvers. - R2 coefficient of determination (non-weighted, non-adjusted), - filled by some solvers. -*************************************************************************/ -_lsfitreport_owner::_lsfitreport_owner() -{ - p_struct = (alglib_impl::lsfitreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::lsfitreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_lsfitreport_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_lsfitreport_owner::_lsfitreport_owner(const _lsfitreport_owner &rhs) -{ - p_struct = (alglib_impl::lsfitreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::lsfitreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_lsfitreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_lsfitreport_owner& _lsfitreport_owner::operator=(const _lsfitreport_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_lsfitreport_clear(p_struct); - if( !alglib_impl::_lsfitreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_lsfitreport_owner::~_lsfitreport_owner() -{ - alglib_impl::_lsfitreport_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::lsfitreport* _lsfitreport_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::lsfitreport* _lsfitreport_owner::c_ptr() const -{ - return const_cast(p_struct); -} -lsfitreport::lsfitreport() : _lsfitreport_owner() ,taskrcond(p_struct->taskrcond),iterationscount(p_struct->iterationscount),varidx(p_struct->varidx),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror),maxerror(p_struct->maxerror),wrmserror(p_struct->wrmserror),covpar(&p_struct->covpar),errpar(&p_struct->errpar),errcurve(&p_struct->errcurve),noise(&p_struct->noise),r2(p_struct->r2) -{ -} - -lsfitreport::lsfitreport(const lsfitreport &rhs):_lsfitreport_owner(rhs) ,taskrcond(p_struct->taskrcond),iterationscount(p_struct->iterationscount),varidx(p_struct->varidx),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror),maxerror(p_struct->maxerror),wrmserror(p_struct->wrmserror),covpar(&p_struct->covpar),errpar(&p_struct->errpar),errcurve(&p_struct->errcurve),noise(&p_struct->noise),r2(p_struct->r2) -{ -} - -lsfitreport& lsfitreport::operator=(const lsfitreport &rhs) -{ - if( this==&rhs ) - return *this; - _lsfitreport_owner::operator=(rhs); - return *this; -} - -lsfitreport::~lsfitreport() -{ -} - - -/************************************************************************* -Nonlinear fitter. - -You should use ALGLIB functions to work with fitter. -Never try to access its fields directly! -*************************************************************************/ -_lsfitstate_owner::_lsfitstate_owner() -{ - p_struct = (alglib_impl::lsfitstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::lsfitstate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_lsfitstate_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_lsfitstate_owner::_lsfitstate_owner(const _lsfitstate_owner &rhs) -{ - p_struct = (alglib_impl::lsfitstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::lsfitstate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_lsfitstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_lsfitstate_owner& _lsfitstate_owner::operator=(const _lsfitstate_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_lsfitstate_clear(p_struct); - if( !alglib_impl::_lsfitstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_lsfitstate_owner::~_lsfitstate_owner() -{ - alglib_impl::_lsfitstate_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::lsfitstate* _lsfitstate_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::lsfitstate* _lsfitstate_owner::c_ptr() const -{ - return const_cast(p_struct); -} -lsfitstate::lsfitstate() : _lsfitstate_owner() ,needf(p_struct->needf),needfg(p_struct->needfg),needfgh(p_struct->needfgh),xupdated(p_struct->xupdated),c(&p_struct->c),f(p_struct->f),g(&p_struct->g),h(&p_struct->h),x(&p_struct->x) -{ -} - -lsfitstate::lsfitstate(const lsfitstate &rhs):_lsfitstate_owner(rhs) ,needf(p_struct->needf),needfg(p_struct->needfg),needfgh(p_struct->needfgh),xupdated(p_struct->xupdated),c(&p_struct->c),f(p_struct->f),g(&p_struct->g),h(&p_struct->h),x(&p_struct->x) -{ -} - -lsfitstate& lsfitstate::operator=(const lsfitstate &rhs) -{ - if( this==&rhs ) - return *this; - _lsfitstate_owner::operator=(rhs); - return *this; -} - -lsfitstate::~lsfitstate() -{ -} - -/************************************************************************* -Fitting by polynomials in barycentric form. This function provides simple -unterface for unconstrained unweighted fitting. See PolynomialFitWC() if -you need constrained fitting. - -Task is linear, so linear least squares solver is used. Complexity of this -computational scheme is O(N*M^2), mostly dominated by least squares solver - -SEE ALSO: - PolynomialFitWC() - -INPUT PARAMETERS: - X - points, array[0..N-1]. - Y - function values, array[0..N-1]. - N - number of points, N>0 - * if given, only leading N elements of X/Y are used - * if not given, automatically determined from sizes of X/Y - M - number of basis functions (= polynomial_degree + 1), M>=1 - -OUTPUT PARAMETERS: - Info- same format as in LSFitLinearW() subroutine: - * Info>0 task is solved - * Info<=0 an error occurred: - -4 means inconvergence of internal SVD - P - interpolant in barycentric form. - Rep - report, same format as in LSFitLinearW() subroutine. - Following fields are set: - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -NOTES: - you can convert P from barycentric form to the power or Chebyshev - basis with PolynomialBar2Pow() or PolynomialBar2Cheb() functions from - POLINT subpackage. - - -- ALGLIB PROJECT -- - Copyright 10.12.2009 by Bochkanov Sergey -*************************************************************************/ -void polynomialfit(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t m, ae_int_t &info, barycentricinterpolant &p, polynomialfitreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::polynomialfit(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m, &info, const_cast(p.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Fitting by polynomials in barycentric form. This function provides simple -unterface for unconstrained unweighted fitting. See PolynomialFitWC() if -you need constrained fitting. - -Task is linear, so linear least squares solver is used. Complexity of this -computational scheme is O(N*M^2), mostly dominated by least squares solver - -SEE ALSO: - PolynomialFitWC() - -INPUT PARAMETERS: - X - points, array[0..N-1]. - Y - function values, array[0..N-1]. - N - number of points, N>0 - * if given, only leading N elements of X/Y are used - * if not given, automatically determined from sizes of X/Y - M - number of basis functions (= polynomial_degree + 1), M>=1 - -OUTPUT PARAMETERS: - Info- same format as in LSFitLinearW() subroutine: - * Info>0 task is solved - * Info<=0 an error occurred: - -4 means inconvergence of internal SVD - P - interpolant in barycentric form. - Rep - report, same format as in LSFitLinearW() subroutine. - Following fields are set: - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -NOTES: - you can convert P from barycentric form to the power or Chebyshev - basis with PolynomialBar2Pow() or PolynomialBar2Cheb() functions from - POLINT subpackage. - - -- ALGLIB PROJECT -- - Copyright 10.12.2009 by Bochkanov Sergey -*************************************************************************/ -void polynomialfit(const real_1d_array &x, const real_1d_array &y, const ae_int_t m, ae_int_t &info, barycentricinterpolant &p, polynomialfitreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - if( (x.length()!=y.length())) - throw ap_error("Error while calling 'polynomialfit': looks like one of arguments has wrong size"); - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::polynomialfit(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m, &info, const_cast(p.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Weighted fitting by polynomials in barycentric form, with constraints on -function values or first derivatives. - -Small regularizing term is used when solving constrained tasks (to improve -stability). - -Task is linear, so linear least squares solver is used. Complexity of this -computational scheme is O(N*M^2), mostly dominated by least squares solver - -SEE ALSO: - PolynomialFit() - -INPUT PARAMETERS: - X - points, array[0..N-1]. - Y - function values, array[0..N-1]. - W - weights, array[0..N-1] - Each summand in square sum of approximation deviations from - given values is multiplied by the square of corresponding - weight. Fill it by 1's if you don't want to solve weighted - task. - N - number of points, N>0. - * if given, only leading N elements of X/Y/W are used - * if not given, automatically determined from sizes of X/Y/W - XC - points where polynomial values/derivatives are constrained, - array[0..K-1]. - YC - values of constraints, array[0..K-1] - DC - array[0..K-1], types of constraints: - * DC[i]=0 means that P(XC[i])=YC[i] - * DC[i]=1 means that P'(XC[i])=YC[i] - SEE BELOW FOR IMPORTANT INFORMATION ON CONSTRAINTS - K - number of constraints, 0<=K=1 - -OUTPUT PARAMETERS: - Info- same format as in LSFitLinearW() subroutine: - * Info>0 task is solved - * Info<=0 an error occurred: - -4 means inconvergence of internal SVD - -3 means inconsistent constraints - P - interpolant in barycentric form. - Rep - report, same format as in LSFitLinearW() subroutine. - Following fields are set: - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -IMPORTANT: - this subroitine doesn't calculate task's condition number for K<>0. - -NOTES: - you can convert P from barycentric form to the power or Chebyshev - basis with PolynomialBar2Pow() or PolynomialBar2Cheb() functions from - POLINT subpackage. - -SETTING CONSTRAINTS - DANGERS AND OPPORTUNITIES: - -Setting constraints can lead to undesired results, like ill-conditioned -behavior, or inconsistency being detected. From the other side, it allows -us to improve quality of the fit. Here we summarize our experience with -constrained regression splines: -* even simple constraints can be inconsistent, see Wikipedia article on - this subject: http://en.wikipedia.org/wiki/Birkhoff_interpolation -* the greater is M (given fixed constraints), the more chances that - constraints will be consistent -* in the general case, consistency of constraints is NOT GUARANTEED. -* in the one special cases, however, we can guarantee consistency. This - case is: M>1 and constraints on the function values (NOT DERIVATIVES) - -Our final recommendation is to use constraints WHEN AND ONLY when you -can't solve your task without them. Anything beyond special cases given -above is not guaranteed and may result in inconsistency. - - -- ALGLIB PROJECT -- - Copyright 10.12.2009 by Bochkanov Sergey -*************************************************************************/ -void polynomialfitwc(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const ae_int_t n, const real_1d_array &xc, const real_1d_array &yc, const integer_1d_array &dc, const ae_int_t k, const ae_int_t m, ae_int_t &info, barycentricinterpolant &p, polynomialfitreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::polynomialfitwc(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), n, const_cast(xc.c_ptr()), const_cast(yc.c_ptr()), const_cast(dc.c_ptr()), k, m, &info, const_cast(p.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Weighted fitting by polynomials in barycentric form, with constraints on -function values or first derivatives. - -Small regularizing term is used when solving constrained tasks (to improve -stability). - -Task is linear, so linear least squares solver is used. Complexity of this -computational scheme is O(N*M^2), mostly dominated by least squares solver - -SEE ALSO: - PolynomialFit() - -INPUT PARAMETERS: - X - points, array[0..N-1]. - Y - function values, array[0..N-1]. - W - weights, array[0..N-1] - Each summand in square sum of approximation deviations from - given values is multiplied by the square of corresponding - weight. Fill it by 1's if you don't want to solve weighted - task. - N - number of points, N>0. - * if given, only leading N elements of X/Y/W are used - * if not given, automatically determined from sizes of X/Y/W - XC - points where polynomial values/derivatives are constrained, - array[0..K-1]. - YC - values of constraints, array[0..K-1] - DC - array[0..K-1], types of constraints: - * DC[i]=0 means that P(XC[i])=YC[i] - * DC[i]=1 means that P'(XC[i])=YC[i] - SEE BELOW FOR IMPORTANT INFORMATION ON CONSTRAINTS - K - number of constraints, 0<=K=1 - -OUTPUT PARAMETERS: - Info- same format as in LSFitLinearW() subroutine: - * Info>0 task is solved - * Info<=0 an error occurred: - -4 means inconvergence of internal SVD - -3 means inconsistent constraints - P - interpolant in barycentric form. - Rep - report, same format as in LSFitLinearW() subroutine. - Following fields are set: - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -IMPORTANT: - this subroitine doesn't calculate task's condition number for K<>0. - -NOTES: - you can convert P from barycentric form to the power or Chebyshev - basis with PolynomialBar2Pow() or PolynomialBar2Cheb() functions from - POLINT subpackage. - -SETTING CONSTRAINTS - DANGERS AND OPPORTUNITIES: - -Setting constraints can lead to undesired results, like ill-conditioned -behavior, or inconsistency being detected. From the other side, it allows -us to improve quality of the fit. Here we summarize our experience with -constrained regression splines: -* even simple constraints can be inconsistent, see Wikipedia article on - this subject: http://en.wikipedia.org/wiki/Birkhoff_interpolation -* the greater is M (given fixed constraints), the more chances that - constraints will be consistent -* in the general case, consistency of constraints is NOT GUARANTEED. -* in the one special cases, however, we can guarantee consistency. This - case is: M>1 and constraints on the function values (NOT DERIVATIVES) - -Our final recommendation is to use constraints WHEN AND ONLY when you -can't solve your task without them. Anything beyond special cases given -above is not guaranteed and may result in inconsistency. - - -- ALGLIB PROJECT -- - Copyright 10.12.2009 by Bochkanov Sergey -*************************************************************************/ -void polynomialfitwc(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &xc, const real_1d_array &yc, const integer_1d_array &dc, const ae_int_t m, ae_int_t &info, barycentricinterpolant &p, polynomialfitreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t k; - if( (x.length()!=y.length()) || (x.length()!=w.length())) - throw ap_error("Error while calling 'polynomialfitwc': looks like one of arguments has wrong size"); - if( (xc.length()!=yc.length()) || (xc.length()!=dc.length())) - throw ap_error("Error while calling 'polynomialfitwc': looks like one of arguments has wrong size"); - n = x.length(); - k = xc.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::polynomialfitwc(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), n, const_cast(xc.c_ptr()), const_cast(yc.c_ptr()), const_cast(dc.c_ptr()), k, m, &info, const_cast(p.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Weghted rational least squares fitting using Floater-Hormann rational -functions with optimal D chosen from [0,9], with constraints and -individual weights. - -Equidistant grid with M node on [min(x),max(x)] is used to build basis -functions. Different values of D are tried, optimal D (least WEIGHTED root -mean square error) is chosen. Task is linear, so linear least squares -solver is used. Complexity of this computational scheme is O(N*M^2) -(mostly dominated by the least squares solver). - -SEE ALSO -* BarycentricFitFloaterHormann(), "lightweight" fitting without invididual - weights and constraints. - -INPUT PARAMETERS: - X - points, array[0..N-1]. - Y - function values, array[0..N-1]. - W - weights, array[0..N-1] - Each summand in square sum of approximation deviations from - given values is multiplied by the square of corresponding - weight. Fill it by 1's if you don't want to solve weighted - task. - N - number of points, N>0. - XC - points where function values/derivatives are constrained, - array[0..K-1]. - YC - values of constraints, array[0..K-1] - DC - array[0..K-1], types of constraints: - * DC[i]=0 means that S(XC[i])=YC[i] - * DC[i]=1 means that S'(XC[i])=YC[i] - SEE BELOW FOR IMPORTANT INFORMATION ON CONSTRAINTS - K - number of constraints, 0<=K=2. - -OUTPUT PARAMETERS: - Info- same format as in LSFitLinearWC() subroutine. - * Info>0 task is solved - * Info<=0 an error occurred: - -4 means inconvergence of internal SVD - -3 means inconsistent constraints - -1 means another errors in parameters passed - (N<=0, for example) - B - barycentric interpolant. - Rep - report, same format as in LSFitLinearWC() subroutine. - Following fields are set: - * DBest best value of the D parameter - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -IMPORTANT: - this subroutine doesn't calculate task's condition number for K<>0. - -SETTING CONSTRAINTS - DANGERS AND OPPORTUNITIES: - -Setting constraints can lead to undesired results, like ill-conditioned -behavior, or inconsistency being detected. From the other side, it allows -us to improve quality of the fit. Here we summarize our experience with -constrained barycentric interpolants: -* excessive constraints can be inconsistent. Floater-Hormann basis - functions aren't as flexible as splines (although they are very smooth). -* the more evenly constraints are spread across [min(x),max(x)], the more - chances that they will be consistent -* the greater is M (given fixed constraints), the more chances that - constraints will be consistent -* in the general case, consistency of constraints IS NOT GUARANTEED. -* in the several special cases, however, we CAN guarantee consistency. -* one of this cases is constraints on the function VALUES at the interval - boundaries. Note that consustency of the constraints on the function - DERIVATIVES is NOT guaranteed (you can use in such cases cubic splines - which are more flexible). -* another special case is ONE constraint on the function value (OR, but - not AND, derivative) anywhere in the interval - -Our final recommendation is to use constraints WHEN AND ONLY WHEN you -can't solve your task without them. Anything beyond special cases given -above is not guaranteed and may result in inconsistency. - - -- ALGLIB PROJECT -- - Copyright 18.08.2009 by Bochkanov Sergey -*************************************************************************/ -void barycentricfitfloaterhormannwc(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const ae_int_t n, const real_1d_array &xc, const real_1d_array &yc, const integer_1d_array &dc, const ae_int_t k, const ae_int_t m, ae_int_t &info, barycentricinterpolant &b, barycentricfitreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::barycentricfitfloaterhormannwc(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), n, const_cast(xc.c_ptr()), const_cast(yc.c_ptr()), const_cast(dc.c_ptr()), k, m, &info, const_cast(b.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Rational least squares fitting using Floater-Hormann rational functions -with optimal D chosen from [0,9]. - -Equidistant grid with M node on [min(x),max(x)] is used to build basis -functions. Different values of D are tried, optimal D (least root mean -square error) is chosen. Task is linear, so linear least squares solver -is used. Complexity of this computational scheme is O(N*M^2) (mostly -dominated by the least squares solver). - -INPUT PARAMETERS: - X - points, array[0..N-1]. - Y - function values, array[0..N-1]. - N - number of points, N>0. - M - number of basis functions ( = number_of_nodes), M>=2. - -OUTPUT PARAMETERS: - Info- same format as in LSFitLinearWC() subroutine. - * Info>0 task is solved - * Info<=0 an error occurred: - -4 means inconvergence of internal SVD - -3 means inconsistent constraints - B - barycentric interpolant. - Rep - report, same format as in LSFitLinearWC() subroutine. - Following fields are set: - * DBest best value of the D parameter - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - - -- ALGLIB PROJECT -- - Copyright 18.08.2009 by Bochkanov Sergey -*************************************************************************/ -void barycentricfitfloaterhormann(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t m, ae_int_t &info, barycentricinterpolant &b, barycentricfitreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::barycentricfitfloaterhormann(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m, &info, const_cast(b.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Rational least squares fitting using Floater-Hormann rational functions -with optimal D chosen from [0,9]. - -Equidistant grid with M node on [min(x),max(x)] is used to build basis -functions. Different values of D are tried, optimal D (least root mean -square error) is chosen. Task is linear, so linear least squares solver -is used. Complexity of this computational scheme is O(N*M^2) (mostly -dominated by the least squares solver). - -INPUT PARAMETERS: - X - points, array[0..N-1]. - Y - function values, array[0..N-1]. - N - number of points, N>0. - M - number of basis functions ( = number_of_nodes), M>=2. - -OUTPUT PARAMETERS: - Info- same format as in LSFitLinearWC() subroutine. - * Info>0 task is solved - * Info<=0 an error occurred: - -4 means inconvergence of internal SVD - -3 means inconsistent constraints - B - barycentric interpolant. - Rep - report, same format as in LSFitLinearWC() subroutine. - Following fields are set: - * DBest best value of the D parameter - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - - -- ALGLIB PROJECT -- - Copyright 18.08.2009 by Bochkanov Sergey -*************************************************************************/ -void spline1dfitpenalized(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t m, const double rho, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dfitpenalized(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m, rho, &info, const_cast(s.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Rational least squares fitting using Floater-Hormann rational functions -with optimal D chosen from [0,9]. - -Equidistant grid with M node on [min(x),max(x)] is used to build basis -functions. Different values of D are tried, optimal D (least root mean -square error) is chosen. Task is linear, so linear least squares solver -is used. Complexity of this computational scheme is O(N*M^2) (mostly -dominated by the least squares solver). - -INPUT PARAMETERS: - X - points, array[0..N-1]. - Y - function values, array[0..N-1]. - N - number of points, N>0. - M - number of basis functions ( = number_of_nodes), M>=2. - -OUTPUT PARAMETERS: - Info- same format as in LSFitLinearWC() subroutine. - * Info>0 task is solved - * Info<=0 an error occurred: - -4 means inconvergence of internal SVD - -3 means inconsistent constraints - B - barycentric interpolant. - Rep - report, same format as in LSFitLinearWC() subroutine. - Following fields are set: - * DBest best value of the D parameter - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - - -- ALGLIB PROJECT -- - Copyright 18.08.2009 by Bochkanov Sergey -*************************************************************************/ -void spline1dfitpenalized(const real_1d_array &x, const real_1d_array &y, const ae_int_t m, const double rho, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - if( (x.length()!=y.length())) - throw ap_error("Error while calling 'spline1dfitpenalized': looks like one of arguments has wrong size"); - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dfitpenalized(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m, rho, &info, const_cast(s.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Weighted fitting by penalized cubic spline. - -Equidistant grid with M nodes on [min(x,xc),max(x,xc)] is used to build -basis functions. Basis functions are cubic splines with natural boundary -conditions. Problem is regularized by adding non-linearity penalty to the -usual least squares penalty function: - - S(x) = arg min { LS + P }, where - LS = SUM { w[i]^2*(y[i] - S(x[i]))^2 } - least squares penalty - P = C*10^rho*integral{ S''(x)^2*dx } - non-linearity penalty - rho - tunable constant given by user - C - automatically determined scale parameter, - makes penalty invariant with respect to scaling of X, Y, W. - -INPUT PARAMETERS: - X - points, array[0..N-1]. - Y - function values, array[0..N-1]. - W - weights, array[0..N-1] - Each summand in square sum of approximation deviations from - given values is multiplied by the square of corresponding - weight. Fill it by 1's if you don't want to solve weighted - problem. - N - number of points (optional): - * N>0 - * if given, only first N elements of X/Y/W are processed - * if not given, automatically determined from X/Y/W sizes - M - number of basis functions ( = number_of_nodes), M>=4. - Rho - regularization constant passed by user. It penalizes - nonlinearity in the regression spline. It is logarithmically - scaled, i.e. actual value of regularization constant is - calculated as 10^Rho. It is automatically scaled so that: - * Rho=2.0 corresponds to moderate amount of nonlinearity - * generally, it should be somewhere in the [-8.0,+8.0] - If you do not want to penalize nonlineary, - pass small Rho. Values as low as -15 should work. - -OUTPUT PARAMETERS: - Info- same format as in LSFitLinearWC() subroutine. - * Info>0 task is solved - * Info<=0 an error occurred: - -4 means inconvergence of internal SVD or - Cholesky decomposition; problem may be - too ill-conditioned (very rare) - S - spline interpolant. - Rep - Following fields are set: - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -IMPORTANT: - this subroitine doesn't calculate task's condition number for K<>0. - -NOTE 1: additional nodes are added to the spline outside of the fitting -interval to force linearity when xmax(x,xc). It is done -for consistency - we penalize non-linearity at [min(x,xc),max(x,xc)], so -it is natural to force linearity outside of this interval. - -NOTE 2: function automatically sorts points, so caller may pass unsorted -array. - - -- ALGLIB PROJECT -- - Copyright 19.10.2010 by Bochkanov Sergey -*************************************************************************/ -void spline1dfitpenalizedw(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const ae_int_t n, const ae_int_t m, const double rho, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dfitpenalizedw(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), n, m, rho, &info, const_cast(s.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Weighted fitting by penalized cubic spline. - -Equidistant grid with M nodes on [min(x,xc),max(x,xc)] is used to build -basis functions. Basis functions are cubic splines with natural boundary -conditions. Problem is regularized by adding non-linearity penalty to the -usual least squares penalty function: - - S(x) = arg min { LS + P }, where - LS = SUM { w[i]^2*(y[i] - S(x[i]))^2 } - least squares penalty - P = C*10^rho*integral{ S''(x)^2*dx } - non-linearity penalty - rho - tunable constant given by user - C - automatically determined scale parameter, - makes penalty invariant with respect to scaling of X, Y, W. - -INPUT PARAMETERS: - X - points, array[0..N-1]. - Y - function values, array[0..N-1]. - W - weights, array[0..N-1] - Each summand in square sum of approximation deviations from - given values is multiplied by the square of corresponding - weight. Fill it by 1's if you don't want to solve weighted - problem. - N - number of points (optional): - * N>0 - * if given, only first N elements of X/Y/W are processed - * if not given, automatically determined from X/Y/W sizes - M - number of basis functions ( = number_of_nodes), M>=4. - Rho - regularization constant passed by user. It penalizes - nonlinearity in the regression spline. It is logarithmically - scaled, i.e. actual value of regularization constant is - calculated as 10^Rho. It is automatically scaled so that: - * Rho=2.0 corresponds to moderate amount of nonlinearity - * generally, it should be somewhere in the [-8.0,+8.0] - If you do not want to penalize nonlineary, - pass small Rho. Values as low as -15 should work. - -OUTPUT PARAMETERS: - Info- same format as in LSFitLinearWC() subroutine. - * Info>0 task is solved - * Info<=0 an error occurred: - -4 means inconvergence of internal SVD or - Cholesky decomposition; problem may be - too ill-conditioned (very rare) - S - spline interpolant. - Rep - Following fields are set: - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -IMPORTANT: - this subroitine doesn't calculate task's condition number for K<>0. - -NOTE 1: additional nodes are added to the spline outside of the fitting -interval to force linearity when xmax(x,xc). It is done -for consistency - we penalize non-linearity at [min(x,xc),max(x,xc)], so -it is natural to force linearity outside of this interval. - -NOTE 2: function automatically sorts points, so caller may pass unsorted -array. - - -- ALGLIB PROJECT -- - Copyright 19.10.2010 by Bochkanov Sergey -*************************************************************************/ -void spline1dfitpenalizedw(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const ae_int_t m, const double rho, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - if( (x.length()!=y.length()) || (x.length()!=w.length())) - throw ap_error("Error while calling 'spline1dfitpenalizedw': looks like one of arguments has wrong size"); - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dfitpenalizedw(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), n, m, rho, &info, const_cast(s.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Weighted fitting by cubic spline, with constraints on function values or -derivatives. - -Equidistant grid with M-2 nodes on [min(x,xc),max(x,xc)] is used to build -basis functions. Basis functions are cubic splines with continuous second -derivatives and non-fixed first derivatives at interval ends. Small -regularizing term is used when solving constrained tasks (to improve -stability). - -Task is linear, so linear least squares solver is used. Complexity of this -computational scheme is O(N*M^2), mostly dominated by least squares solver - -SEE ALSO - Spline1DFitHermiteWC() - fitting by Hermite splines (more flexible, - less smooth) - Spline1DFitCubic() - "lightweight" fitting by cubic splines, - without invididual weights and constraints - -INPUT PARAMETERS: - X - points, array[0..N-1]. - Y - function values, array[0..N-1]. - W - weights, array[0..N-1] - Each summand in square sum of approximation deviations from - given values is multiplied by the square of corresponding - weight. Fill it by 1's if you don't want to solve weighted - task. - N - number of points (optional): - * N>0 - * if given, only first N elements of X/Y/W are processed - * if not given, automatically determined from X/Y/W sizes - XC - points where spline values/derivatives are constrained, - array[0..K-1]. - YC - values of constraints, array[0..K-1] - DC - array[0..K-1], types of constraints: - * DC[i]=0 means that S(XC[i])=YC[i] - * DC[i]=1 means that S'(XC[i])=YC[i] - SEE BELOW FOR IMPORTANT INFORMATION ON CONSTRAINTS - K - number of constraints (optional): - * 0<=K=4. - -OUTPUT PARAMETERS: - Info- same format as in LSFitLinearWC() subroutine. - * Info>0 task is solved - * Info<=0 an error occurred: - -4 means inconvergence of internal SVD - -3 means inconsistent constraints - S - spline interpolant. - Rep - report, same format as in LSFitLinearWC() subroutine. - Following fields are set: - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -IMPORTANT: - this subroitine doesn't calculate task's condition number for K<>0. - - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. - -SETTING CONSTRAINTS - DANGERS AND OPPORTUNITIES: - -Setting constraints can lead to undesired results, like ill-conditioned -behavior, or inconsistency being detected. From the other side, it allows -us to improve quality of the fit. Here we summarize our experience with -constrained regression splines: -* excessive constraints can be inconsistent. Splines are piecewise cubic - functions, and it is easy to create an example, where large number of - constraints concentrated in small area will result in inconsistency. - Just because spline is not flexible enough to satisfy all of them. And - same constraints spread across the [min(x),max(x)] will be perfectly - consistent. -* the more evenly constraints are spread across [min(x),max(x)], the more - chances that they will be consistent -* the greater is M (given fixed constraints), the more chances that - constraints will be consistent -* in the general case, consistency of constraints IS NOT GUARANTEED. -* in the several special cases, however, we CAN guarantee consistency. -* one of this cases is constraints on the function values AND/OR its - derivatives at the interval boundaries. -* another special case is ONE constraint on the function value (OR, but - not AND, derivative) anywhere in the interval - -Our final recommendation is to use constraints WHEN AND ONLY WHEN you -can't solve your task without them. Anything beyond special cases given -above is not guaranteed and may result in inconsistency. - - - -- ALGLIB PROJECT -- - Copyright 18.08.2009 by Bochkanov Sergey -*************************************************************************/ -void spline1dfitcubicwc(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const ae_int_t n, const real_1d_array &xc, const real_1d_array &yc, const integer_1d_array &dc, const ae_int_t k, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dfitcubicwc(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), n, const_cast(xc.c_ptr()), const_cast(yc.c_ptr()), const_cast(dc.c_ptr()), k, m, &info, const_cast(s.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Weighted fitting by cubic spline, with constraints on function values or -derivatives. - -Equidistant grid with M-2 nodes on [min(x,xc),max(x,xc)] is used to build -basis functions. Basis functions are cubic splines with continuous second -derivatives and non-fixed first derivatives at interval ends. Small -regularizing term is used when solving constrained tasks (to improve -stability). - -Task is linear, so linear least squares solver is used. Complexity of this -computational scheme is O(N*M^2), mostly dominated by least squares solver - -SEE ALSO - Spline1DFitHermiteWC() - fitting by Hermite splines (more flexible, - less smooth) - Spline1DFitCubic() - "lightweight" fitting by cubic splines, - without invididual weights and constraints - -INPUT PARAMETERS: - X - points, array[0..N-1]. - Y - function values, array[0..N-1]. - W - weights, array[0..N-1] - Each summand in square sum of approximation deviations from - given values is multiplied by the square of corresponding - weight. Fill it by 1's if you don't want to solve weighted - task. - N - number of points (optional): - * N>0 - * if given, only first N elements of X/Y/W are processed - * if not given, automatically determined from X/Y/W sizes - XC - points where spline values/derivatives are constrained, - array[0..K-1]. - YC - values of constraints, array[0..K-1] - DC - array[0..K-1], types of constraints: - * DC[i]=0 means that S(XC[i])=YC[i] - * DC[i]=1 means that S'(XC[i])=YC[i] - SEE BELOW FOR IMPORTANT INFORMATION ON CONSTRAINTS - K - number of constraints (optional): - * 0<=K=4. - -OUTPUT PARAMETERS: - Info- same format as in LSFitLinearWC() subroutine. - * Info>0 task is solved - * Info<=0 an error occurred: - -4 means inconvergence of internal SVD - -3 means inconsistent constraints - S - spline interpolant. - Rep - report, same format as in LSFitLinearWC() subroutine. - Following fields are set: - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -IMPORTANT: - this subroitine doesn't calculate task's condition number for K<>0. - - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. - -SETTING CONSTRAINTS - DANGERS AND OPPORTUNITIES: - -Setting constraints can lead to undesired results, like ill-conditioned -behavior, or inconsistency being detected. From the other side, it allows -us to improve quality of the fit. Here we summarize our experience with -constrained regression splines: -* excessive constraints can be inconsistent. Splines are piecewise cubic - functions, and it is easy to create an example, where large number of - constraints concentrated in small area will result in inconsistency. - Just because spline is not flexible enough to satisfy all of them. And - same constraints spread across the [min(x),max(x)] will be perfectly - consistent. -* the more evenly constraints are spread across [min(x),max(x)], the more - chances that they will be consistent -* the greater is M (given fixed constraints), the more chances that - constraints will be consistent -* in the general case, consistency of constraints IS NOT GUARANTEED. -* in the several special cases, however, we CAN guarantee consistency. -* one of this cases is constraints on the function values AND/OR its - derivatives at the interval boundaries. -* another special case is ONE constraint on the function value (OR, but - not AND, derivative) anywhere in the interval - -Our final recommendation is to use constraints WHEN AND ONLY WHEN you -can't solve your task without them. Anything beyond special cases given -above is not guaranteed and may result in inconsistency. - - - -- ALGLIB PROJECT -- - Copyright 18.08.2009 by Bochkanov Sergey -*************************************************************************/ -void spline1dfitcubicwc(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &xc, const real_1d_array &yc, const integer_1d_array &dc, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t k; - if( (x.length()!=y.length()) || (x.length()!=w.length())) - throw ap_error("Error while calling 'spline1dfitcubicwc': looks like one of arguments has wrong size"); - if( (xc.length()!=yc.length()) || (xc.length()!=dc.length())) - throw ap_error("Error while calling 'spline1dfitcubicwc': looks like one of arguments has wrong size"); - n = x.length(); - k = xc.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dfitcubicwc(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), n, const_cast(xc.c_ptr()), const_cast(yc.c_ptr()), const_cast(dc.c_ptr()), k, m, &info, const_cast(s.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Weighted fitting by Hermite spline, with constraints on function values -or first derivatives. - -Equidistant grid with M nodes on [min(x,xc),max(x,xc)] is used to build -basis functions. Basis functions are Hermite splines. Small regularizing -term is used when solving constrained tasks (to improve stability). - -Task is linear, so linear least squares solver is used. Complexity of this -computational scheme is O(N*M^2), mostly dominated by least squares solver - -SEE ALSO - Spline1DFitCubicWC() - fitting by Cubic splines (less flexible, - more smooth) - Spline1DFitHermite() - "lightweight" Hermite fitting, without - invididual weights and constraints - -INPUT PARAMETERS: - X - points, array[0..N-1]. - Y - function values, array[0..N-1]. - W - weights, array[0..N-1] - Each summand in square sum of approximation deviations from - given values is multiplied by the square of corresponding - weight. Fill it by 1's if you don't want to solve weighted - task. - N - number of points (optional): - * N>0 - * if given, only first N elements of X/Y/W are processed - * if not given, automatically determined from X/Y/W sizes - XC - points where spline values/derivatives are constrained, - array[0..K-1]. - YC - values of constraints, array[0..K-1] - DC - array[0..K-1], types of constraints: - * DC[i]=0 means that S(XC[i])=YC[i] - * DC[i]=1 means that S'(XC[i])=YC[i] - SEE BELOW FOR IMPORTANT INFORMATION ON CONSTRAINTS - K - number of constraints (optional): - * 0<=K=4, - M IS EVEN! - -OUTPUT PARAMETERS: - Info- same format as in LSFitLinearW() subroutine: - * Info>0 task is solved - * Info<=0 an error occurred: - -4 means inconvergence of internal SVD - -3 means inconsistent constraints - -2 means odd M was passed (which is not supported) - -1 means another errors in parameters passed - (N<=0, for example) - S - spline interpolant. - Rep - report, same format as in LSFitLinearW() subroutine. - Following fields are set: - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -IMPORTANT: - this subroitine doesn't calculate task's condition number for K<>0. - -IMPORTANT: - this subroitine supports only even M's - - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. - -SETTING CONSTRAINTS - DANGERS AND OPPORTUNITIES: - -Setting constraints can lead to undesired results, like ill-conditioned -behavior, or inconsistency being detected. From the other side, it allows -us to improve quality of the fit. Here we summarize our experience with -constrained regression splines: -* excessive constraints can be inconsistent. Splines are piecewise cubic - functions, and it is easy to create an example, where large number of - constraints concentrated in small area will result in inconsistency. - Just because spline is not flexible enough to satisfy all of them. And - same constraints spread across the [min(x),max(x)] will be perfectly - consistent. -* the more evenly constraints are spread across [min(x),max(x)], the more - chances that they will be consistent -* the greater is M (given fixed constraints), the more chances that - constraints will be consistent -* in the general case, consistency of constraints is NOT GUARANTEED. -* in the several special cases, however, we can guarantee consistency. -* one of this cases is M>=4 and constraints on the function value - (AND/OR its derivative) at the interval boundaries. -* another special case is M>=4 and ONE constraint on the function value - (OR, BUT NOT AND, derivative) anywhere in [min(x),max(x)] - -Our final recommendation is to use constraints WHEN AND ONLY when you -can't solve your task without them. Anything beyond special cases given -above is not guaranteed and may result in inconsistency. - - -- ALGLIB PROJECT -- - Copyright 18.08.2009 by Bochkanov Sergey -*************************************************************************/ -void spline1dfithermitewc(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const ae_int_t n, const real_1d_array &xc, const real_1d_array &yc, const integer_1d_array &dc, const ae_int_t k, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dfithermitewc(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), n, const_cast(xc.c_ptr()), const_cast(yc.c_ptr()), const_cast(dc.c_ptr()), k, m, &info, const_cast(s.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Weighted fitting by Hermite spline, with constraints on function values -or first derivatives. - -Equidistant grid with M nodes on [min(x,xc),max(x,xc)] is used to build -basis functions. Basis functions are Hermite splines. Small regularizing -term is used when solving constrained tasks (to improve stability). - -Task is linear, so linear least squares solver is used. Complexity of this -computational scheme is O(N*M^2), mostly dominated by least squares solver - -SEE ALSO - Spline1DFitCubicWC() - fitting by Cubic splines (less flexible, - more smooth) - Spline1DFitHermite() - "lightweight" Hermite fitting, without - invididual weights and constraints - -INPUT PARAMETERS: - X - points, array[0..N-1]. - Y - function values, array[0..N-1]. - W - weights, array[0..N-1] - Each summand in square sum of approximation deviations from - given values is multiplied by the square of corresponding - weight. Fill it by 1's if you don't want to solve weighted - task. - N - number of points (optional): - * N>0 - * if given, only first N elements of X/Y/W are processed - * if not given, automatically determined from X/Y/W sizes - XC - points where spline values/derivatives are constrained, - array[0..K-1]. - YC - values of constraints, array[0..K-1] - DC - array[0..K-1], types of constraints: - * DC[i]=0 means that S(XC[i])=YC[i] - * DC[i]=1 means that S'(XC[i])=YC[i] - SEE BELOW FOR IMPORTANT INFORMATION ON CONSTRAINTS - K - number of constraints (optional): - * 0<=K=4, - M IS EVEN! - -OUTPUT PARAMETERS: - Info- same format as in LSFitLinearW() subroutine: - * Info>0 task is solved - * Info<=0 an error occurred: - -4 means inconvergence of internal SVD - -3 means inconsistent constraints - -2 means odd M was passed (which is not supported) - -1 means another errors in parameters passed - (N<=0, for example) - S - spline interpolant. - Rep - report, same format as in LSFitLinearW() subroutine. - Following fields are set: - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -IMPORTANT: - this subroitine doesn't calculate task's condition number for K<>0. - -IMPORTANT: - this subroitine supports only even M's - - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. - -SETTING CONSTRAINTS - DANGERS AND OPPORTUNITIES: - -Setting constraints can lead to undesired results, like ill-conditioned -behavior, or inconsistency being detected. From the other side, it allows -us to improve quality of the fit. Here we summarize our experience with -constrained regression splines: -* excessive constraints can be inconsistent. Splines are piecewise cubic - functions, and it is easy to create an example, where large number of - constraints concentrated in small area will result in inconsistency. - Just because spline is not flexible enough to satisfy all of them. And - same constraints spread across the [min(x),max(x)] will be perfectly - consistent. -* the more evenly constraints are spread across [min(x),max(x)], the more - chances that they will be consistent -* the greater is M (given fixed constraints), the more chances that - constraints will be consistent -* in the general case, consistency of constraints is NOT GUARANTEED. -* in the several special cases, however, we can guarantee consistency. -* one of this cases is M>=4 and constraints on the function value - (AND/OR its derivative) at the interval boundaries. -* another special case is M>=4 and ONE constraint on the function value - (OR, BUT NOT AND, derivative) anywhere in [min(x),max(x)] - -Our final recommendation is to use constraints WHEN AND ONLY when you -can't solve your task without them. Anything beyond special cases given -above is not guaranteed and may result in inconsistency. - - -- ALGLIB PROJECT -- - Copyright 18.08.2009 by Bochkanov Sergey -*************************************************************************/ -void spline1dfithermitewc(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &xc, const real_1d_array &yc, const integer_1d_array &dc, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t k; - if( (x.length()!=y.length()) || (x.length()!=w.length())) - throw ap_error("Error while calling 'spline1dfithermitewc': looks like one of arguments has wrong size"); - if( (xc.length()!=yc.length()) || (xc.length()!=dc.length())) - throw ap_error("Error while calling 'spline1dfithermitewc': looks like one of arguments has wrong size"); - n = x.length(); - k = xc.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dfithermitewc(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), n, const_cast(xc.c_ptr()), const_cast(yc.c_ptr()), const_cast(dc.c_ptr()), k, m, &info, const_cast(s.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Least squares fitting by cubic spline. - -This subroutine is "lightweight" alternative for more complex and feature- -rich Spline1DFitCubicWC(). See Spline1DFitCubicWC() for more information -about subroutine parameters (we don't duplicate it here because of length) - - -- ALGLIB PROJECT -- - Copyright 18.08.2009 by Bochkanov Sergey -*************************************************************************/ -void spline1dfitcubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dfitcubic(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m, &info, const_cast(s.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Least squares fitting by cubic spline. - -This subroutine is "lightweight" alternative for more complex and feature- -rich Spline1DFitCubicWC(). See Spline1DFitCubicWC() for more information -about subroutine parameters (we don't duplicate it here because of length) - - -- ALGLIB PROJECT -- - Copyright 18.08.2009 by Bochkanov Sergey -*************************************************************************/ -void spline1dfitcubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - if( (x.length()!=y.length())) - throw ap_error("Error while calling 'spline1dfitcubic': looks like one of arguments has wrong size"); - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dfitcubic(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m, &info, const_cast(s.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Least squares fitting by Hermite spline. - -This subroutine is "lightweight" alternative for more complex and feature- -rich Spline1DFitHermiteWC(). See Spline1DFitHermiteWC() description for -more information about subroutine parameters (we don't duplicate it here -because of length). - - -- ALGLIB PROJECT -- - Copyright 18.08.2009 by Bochkanov Sergey -*************************************************************************/ -void spline1dfithermite(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dfithermite(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m, &info, const_cast(s.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Least squares fitting by Hermite spline. - -This subroutine is "lightweight" alternative for more complex and feature- -rich Spline1DFitHermiteWC(). See Spline1DFitHermiteWC() description for -more information about subroutine parameters (we don't duplicate it here -because of length). - - -- ALGLIB PROJECT -- - Copyright 18.08.2009 by Bochkanov Sergey -*************************************************************************/ -void spline1dfithermite(const real_1d_array &x, const real_1d_array &y, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - if( (x.length()!=y.length())) - throw ap_error("Error while calling 'spline1dfithermite': looks like one of arguments has wrong size"); - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline1dfithermite(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m, &info, const_cast(s.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Weighted linear least squares fitting. - -QR decomposition is used to reduce task to MxM, then triangular solver or -SVD-based solver is used depending on condition number of the system. It -allows to maximize speed and retain decent accuracy. - -IMPORTANT: if you want to perform polynomial fitting, it may be more - convenient to use PolynomialFit() function. This function gives - best results on polynomial problems and solves numerical - stability issues which arise when you fit high-degree - polynomials to your data. - -INPUT PARAMETERS: - Y - array[0..N-1] Function values in N points. - W - array[0..N-1] Weights corresponding to function values. - Each summand in square sum of approximation deviations - from given values is multiplied by the square of - corresponding weight. - FMatrix - a table of basis functions values, array[0..N-1, 0..M-1]. - FMatrix[I, J] - value of J-th basis function in I-th point. - N - number of points used. N>=1. - M - number of basis functions, M>=1. - -OUTPUT PARAMETERS: - Info - error code: - * -4 internal SVD decomposition subroutine failed (very - rare and for degenerate systems only) - * -1 incorrect N/M were specified - * 1 task is solved - C - decomposition coefficients, array[0..M-1] - Rep - fitting report. Following fields are set: - * Rep.TaskRCond reciprocal of condition number - * R2 non-adjusted coefficient of determination - (non-weighted) - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -ERRORS IN PARAMETERS - -This solver also calculates different kinds of errors in parameters and -fills corresponding fields of report: -* Rep.CovPar covariance matrix for parameters, array[K,K]. -* Rep.ErrPar errors in parameters, array[K], - errpar = sqrt(diag(CovPar)) -* Rep.ErrCurve vector of fit errors - standard deviations of empirical - best-fit curve from "ideal" best-fit curve built with - infinite number of samples, array[N]. - errcurve = sqrt(diag(F*CovPar*F')), - where F is functions matrix. -* Rep.Noise vector of per-point estimates of noise, array[N] - -NOTE: noise in the data is estimated as follows: - * for fitting without user-supplied weights all points are - assumed to have same level of noise, which is estimated from - the data - * for fitting with user-supplied weights we assume that noise - level in I-th point is inversely proportional to Ith weight. - Coefficient of proportionality is estimated from the data. - -NOTE: we apply small amount of regularization when we invert squared - Jacobian and calculate covariance matrix. It guarantees that - algorithm won't divide by zero during inversion, but skews - error estimates a bit (fractional error is about 10^-9). - - However, we believe that this difference is insignificant for - all practical purposes except for the situation when you want - to compare ALGLIB results with "reference" implementation up - to the last significant digit. - -NOTE: covariance matrix is estimated using correction for degrees - of freedom (covariances are divided by N-M instead of dividing - by N). - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitlinearw(const real_1d_array &y, const real_1d_array &w, const real_2d_array &fmatrix, const ae_int_t n, const ae_int_t m, ae_int_t &info, real_1d_array &c, lsfitreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lsfitlinearw(const_cast(y.c_ptr()), const_cast(w.c_ptr()), const_cast(fmatrix.c_ptr()), n, m, &info, const_cast(c.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Weighted linear least squares fitting. - -QR decomposition is used to reduce task to MxM, then triangular solver or -SVD-based solver is used depending on condition number of the system. It -allows to maximize speed and retain decent accuracy. - -IMPORTANT: if you want to perform polynomial fitting, it may be more - convenient to use PolynomialFit() function. This function gives - best results on polynomial problems and solves numerical - stability issues which arise when you fit high-degree - polynomials to your data. - -INPUT PARAMETERS: - Y - array[0..N-1] Function values in N points. - W - array[0..N-1] Weights corresponding to function values. - Each summand in square sum of approximation deviations - from given values is multiplied by the square of - corresponding weight. - FMatrix - a table of basis functions values, array[0..N-1, 0..M-1]. - FMatrix[I, J] - value of J-th basis function in I-th point. - N - number of points used. N>=1. - M - number of basis functions, M>=1. - -OUTPUT PARAMETERS: - Info - error code: - * -4 internal SVD decomposition subroutine failed (very - rare and for degenerate systems only) - * -1 incorrect N/M were specified - * 1 task is solved - C - decomposition coefficients, array[0..M-1] - Rep - fitting report. Following fields are set: - * Rep.TaskRCond reciprocal of condition number - * R2 non-adjusted coefficient of determination - (non-weighted) - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -ERRORS IN PARAMETERS - -This solver also calculates different kinds of errors in parameters and -fills corresponding fields of report: -* Rep.CovPar covariance matrix for parameters, array[K,K]. -* Rep.ErrPar errors in parameters, array[K], - errpar = sqrt(diag(CovPar)) -* Rep.ErrCurve vector of fit errors - standard deviations of empirical - best-fit curve from "ideal" best-fit curve built with - infinite number of samples, array[N]. - errcurve = sqrt(diag(F*CovPar*F')), - where F is functions matrix. -* Rep.Noise vector of per-point estimates of noise, array[N] - -NOTE: noise in the data is estimated as follows: - * for fitting without user-supplied weights all points are - assumed to have same level of noise, which is estimated from - the data - * for fitting with user-supplied weights we assume that noise - level in I-th point is inversely proportional to Ith weight. - Coefficient of proportionality is estimated from the data. - -NOTE: we apply small amount of regularization when we invert squared - Jacobian and calculate covariance matrix. It guarantees that - algorithm won't divide by zero during inversion, but skews - error estimates a bit (fractional error is about 10^-9). - - However, we believe that this difference is insignificant for - all practical purposes except for the situation when you want - to compare ALGLIB results with "reference" implementation up - to the last significant digit. - -NOTE: covariance matrix is estimated using correction for degrees - of freedom (covariances are divided by N-M instead of dividing - by N). - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitlinearw(const real_1d_array &y, const real_1d_array &w, const real_2d_array &fmatrix, ae_int_t &info, real_1d_array &c, lsfitreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t m; - if( (y.length()!=w.length()) || (y.length()!=fmatrix.rows())) - throw ap_error("Error while calling 'lsfitlinearw': looks like one of arguments has wrong size"); - n = y.length(); - m = fmatrix.cols(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lsfitlinearw(const_cast(y.c_ptr()), const_cast(w.c_ptr()), const_cast(fmatrix.c_ptr()), n, m, &info, const_cast(c.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Weighted constained linear least squares fitting. - -This is variation of LSFitLinearW(), which searchs for min|A*x=b| given -that K additional constraints C*x=bc are satisfied. It reduces original -task to modified one: min|B*y-d| WITHOUT constraints, then LSFitLinearW() -is called. - -IMPORTANT: if you want to perform polynomial fitting, it may be more - convenient to use PolynomialFit() function. This function gives - best results on polynomial problems and solves numerical - stability issues which arise when you fit high-degree - polynomials to your data. - -INPUT PARAMETERS: - Y - array[0..N-1] Function values in N points. - W - array[0..N-1] Weights corresponding to function values. - Each summand in square sum of approximation deviations - from given values is multiplied by the square of - corresponding weight. - FMatrix - a table of basis functions values, array[0..N-1, 0..M-1]. - FMatrix[I,J] - value of J-th basis function in I-th point. - CMatrix - a table of constraints, array[0..K-1,0..M]. - I-th row of CMatrix corresponds to I-th linear constraint: - CMatrix[I,0]*C[0] + ... + CMatrix[I,M-1]*C[M-1] = CMatrix[I,M] - N - number of points used. N>=1. - M - number of basis functions, M>=1. - K - number of constraints, 0 <= K < M - K=0 corresponds to absence of constraints. - -OUTPUT PARAMETERS: - Info - error code: - * -4 internal SVD decomposition subroutine failed (very - rare and for degenerate systems only) - * -3 either too many constraints (M or more), - degenerate constraints (some constraints are - repetead twice) or inconsistent constraints were - specified. - * 1 task is solved - C - decomposition coefficients, array[0..M-1] - Rep - fitting report. Following fields are set: - * R2 non-adjusted coefficient of determination - (non-weighted) - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -IMPORTANT: - this subroitine doesn't calculate task's condition number for K<>0. - -ERRORS IN PARAMETERS - -This solver also calculates different kinds of errors in parameters and -fills corresponding fields of report: -* Rep.CovPar covariance matrix for parameters, array[K,K]. -* Rep.ErrPar errors in parameters, array[K], - errpar = sqrt(diag(CovPar)) -* Rep.ErrCurve vector of fit errors - standard deviations of empirical - best-fit curve from "ideal" best-fit curve built with - infinite number of samples, array[N]. - errcurve = sqrt(diag(F*CovPar*F')), - where F is functions matrix. -* Rep.Noise vector of per-point estimates of noise, array[N] - -IMPORTANT: errors in parameters are calculated without taking into - account boundary/linear constraints! Presence of constraints - changes distribution of errors, but there is no easy way to - account for constraints when you calculate covariance matrix. - -NOTE: noise in the data is estimated as follows: - * for fitting without user-supplied weights all points are - assumed to have same level of noise, which is estimated from - the data - * for fitting with user-supplied weights we assume that noise - level in I-th point is inversely proportional to Ith weight. - Coefficient of proportionality is estimated from the data. - -NOTE: we apply small amount of regularization when we invert squared - Jacobian and calculate covariance matrix. It guarantees that - algorithm won't divide by zero during inversion, but skews - error estimates a bit (fractional error is about 10^-9). - - However, we believe that this difference is insignificant for - all practical purposes except for the situation when you want - to compare ALGLIB results with "reference" implementation up - to the last significant digit. - -NOTE: covariance matrix is estimated using correction for degrees - of freedom (covariances are divided by N-M instead of dividing - by N). - - -- ALGLIB -- - Copyright 07.09.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitlinearwc(const real_1d_array &y, const real_1d_array &w, const real_2d_array &fmatrix, const real_2d_array &cmatrix, const ae_int_t n, const ae_int_t m, const ae_int_t k, ae_int_t &info, real_1d_array &c, lsfitreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lsfitlinearwc(const_cast(y.c_ptr()), const_cast(w.c_ptr()), const_cast(fmatrix.c_ptr()), const_cast(cmatrix.c_ptr()), n, m, k, &info, const_cast(c.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Weighted constained linear least squares fitting. - -This is variation of LSFitLinearW(), which searchs for min|A*x=b| given -that K additional constraints C*x=bc are satisfied. It reduces original -task to modified one: min|B*y-d| WITHOUT constraints, then LSFitLinearW() -is called. - -IMPORTANT: if you want to perform polynomial fitting, it may be more - convenient to use PolynomialFit() function. This function gives - best results on polynomial problems and solves numerical - stability issues which arise when you fit high-degree - polynomials to your data. - -INPUT PARAMETERS: - Y - array[0..N-1] Function values in N points. - W - array[0..N-1] Weights corresponding to function values. - Each summand in square sum of approximation deviations - from given values is multiplied by the square of - corresponding weight. - FMatrix - a table of basis functions values, array[0..N-1, 0..M-1]. - FMatrix[I,J] - value of J-th basis function in I-th point. - CMatrix - a table of constraints, array[0..K-1,0..M]. - I-th row of CMatrix corresponds to I-th linear constraint: - CMatrix[I,0]*C[0] + ... + CMatrix[I,M-1]*C[M-1] = CMatrix[I,M] - N - number of points used. N>=1. - M - number of basis functions, M>=1. - K - number of constraints, 0 <= K < M - K=0 corresponds to absence of constraints. - -OUTPUT PARAMETERS: - Info - error code: - * -4 internal SVD decomposition subroutine failed (very - rare and for degenerate systems only) - * -3 either too many constraints (M or more), - degenerate constraints (some constraints are - repetead twice) or inconsistent constraints were - specified. - * 1 task is solved - C - decomposition coefficients, array[0..M-1] - Rep - fitting report. Following fields are set: - * R2 non-adjusted coefficient of determination - (non-weighted) - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -IMPORTANT: - this subroitine doesn't calculate task's condition number for K<>0. - -ERRORS IN PARAMETERS - -This solver also calculates different kinds of errors in parameters and -fills corresponding fields of report: -* Rep.CovPar covariance matrix for parameters, array[K,K]. -* Rep.ErrPar errors in parameters, array[K], - errpar = sqrt(diag(CovPar)) -* Rep.ErrCurve vector of fit errors - standard deviations of empirical - best-fit curve from "ideal" best-fit curve built with - infinite number of samples, array[N]. - errcurve = sqrt(diag(F*CovPar*F')), - where F is functions matrix. -* Rep.Noise vector of per-point estimates of noise, array[N] - -IMPORTANT: errors in parameters are calculated without taking into - account boundary/linear constraints! Presence of constraints - changes distribution of errors, but there is no easy way to - account for constraints when you calculate covariance matrix. - -NOTE: noise in the data is estimated as follows: - * for fitting without user-supplied weights all points are - assumed to have same level of noise, which is estimated from - the data - * for fitting with user-supplied weights we assume that noise - level in I-th point is inversely proportional to Ith weight. - Coefficient of proportionality is estimated from the data. - -NOTE: we apply small amount of regularization when we invert squared - Jacobian and calculate covariance matrix. It guarantees that - algorithm won't divide by zero during inversion, but skews - error estimates a bit (fractional error is about 10^-9). - - However, we believe that this difference is insignificant for - all practical purposes except for the situation when you want - to compare ALGLIB results with "reference" implementation up - to the last significant digit. - -NOTE: covariance matrix is estimated using correction for degrees - of freedom (covariances are divided by N-M instead of dividing - by N). - - -- ALGLIB -- - Copyright 07.09.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitlinearwc(const real_1d_array &y, const real_1d_array &w, const real_2d_array &fmatrix, const real_2d_array &cmatrix, ae_int_t &info, real_1d_array &c, lsfitreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t m; - ae_int_t k; - if( (y.length()!=w.length()) || (y.length()!=fmatrix.rows())) - throw ap_error("Error while calling 'lsfitlinearwc': looks like one of arguments has wrong size"); - if( (fmatrix.cols()!=cmatrix.cols()-1)) - throw ap_error("Error while calling 'lsfitlinearwc': looks like one of arguments has wrong size"); - n = y.length(); - m = fmatrix.cols(); - k = cmatrix.rows(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lsfitlinearwc(const_cast(y.c_ptr()), const_cast(w.c_ptr()), const_cast(fmatrix.c_ptr()), const_cast(cmatrix.c_ptr()), n, m, k, &info, const_cast(c.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Linear least squares fitting. - -QR decomposition is used to reduce task to MxM, then triangular solver or -SVD-based solver is used depending on condition number of the system. It -allows to maximize speed and retain decent accuracy. - -IMPORTANT: if you want to perform polynomial fitting, it may be more - convenient to use PolynomialFit() function. This function gives - best results on polynomial problems and solves numerical - stability issues which arise when you fit high-degree - polynomials to your data. - -INPUT PARAMETERS: - Y - array[0..N-1] Function values in N points. - FMatrix - a table of basis functions values, array[0..N-1, 0..M-1]. - FMatrix[I, J] - value of J-th basis function in I-th point. - N - number of points used. N>=1. - M - number of basis functions, M>=1. - -OUTPUT PARAMETERS: - Info - error code: - * -4 internal SVD decomposition subroutine failed (very - rare and for degenerate systems only) - * 1 task is solved - C - decomposition coefficients, array[0..M-1] - Rep - fitting report. Following fields are set: - * Rep.TaskRCond reciprocal of condition number - * R2 non-adjusted coefficient of determination - (non-weighted) - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -ERRORS IN PARAMETERS - -This solver also calculates different kinds of errors in parameters and -fills corresponding fields of report: -* Rep.CovPar covariance matrix for parameters, array[K,K]. -* Rep.ErrPar errors in parameters, array[K], - errpar = sqrt(diag(CovPar)) -* Rep.ErrCurve vector of fit errors - standard deviations of empirical - best-fit curve from "ideal" best-fit curve built with - infinite number of samples, array[N]. - errcurve = sqrt(diag(F*CovPar*F')), - where F is functions matrix. -* Rep.Noise vector of per-point estimates of noise, array[N] - -NOTE: noise in the data is estimated as follows: - * for fitting without user-supplied weights all points are - assumed to have same level of noise, which is estimated from - the data - * for fitting with user-supplied weights we assume that noise - level in I-th point is inversely proportional to Ith weight. - Coefficient of proportionality is estimated from the data. - -NOTE: we apply small amount of regularization when we invert squared - Jacobian and calculate covariance matrix. It guarantees that - algorithm won't divide by zero during inversion, but skews - error estimates a bit (fractional error is about 10^-9). - - However, we believe that this difference is insignificant for - all practical purposes except for the situation when you want - to compare ALGLIB results with "reference" implementation up - to the last significant digit. - -NOTE: covariance matrix is estimated using correction for degrees - of freedom (covariances are divided by N-M instead of dividing - by N). - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitlinear(const real_1d_array &y, const real_2d_array &fmatrix, const ae_int_t n, const ae_int_t m, ae_int_t &info, real_1d_array &c, lsfitreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lsfitlinear(const_cast(y.c_ptr()), const_cast(fmatrix.c_ptr()), n, m, &info, const_cast(c.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Linear least squares fitting. - -QR decomposition is used to reduce task to MxM, then triangular solver or -SVD-based solver is used depending on condition number of the system. It -allows to maximize speed and retain decent accuracy. - -IMPORTANT: if you want to perform polynomial fitting, it may be more - convenient to use PolynomialFit() function. This function gives - best results on polynomial problems and solves numerical - stability issues which arise when you fit high-degree - polynomials to your data. - -INPUT PARAMETERS: - Y - array[0..N-1] Function values in N points. - FMatrix - a table of basis functions values, array[0..N-1, 0..M-1]. - FMatrix[I, J] - value of J-th basis function in I-th point. - N - number of points used. N>=1. - M - number of basis functions, M>=1. - -OUTPUT PARAMETERS: - Info - error code: - * -4 internal SVD decomposition subroutine failed (very - rare and for degenerate systems only) - * 1 task is solved - C - decomposition coefficients, array[0..M-1] - Rep - fitting report. Following fields are set: - * Rep.TaskRCond reciprocal of condition number - * R2 non-adjusted coefficient of determination - (non-weighted) - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -ERRORS IN PARAMETERS - -This solver also calculates different kinds of errors in parameters and -fills corresponding fields of report: -* Rep.CovPar covariance matrix for parameters, array[K,K]. -* Rep.ErrPar errors in parameters, array[K], - errpar = sqrt(diag(CovPar)) -* Rep.ErrCurve vector of fit errors - standard deviations of empirical - best-fit curve from "ideal" best-fit curve built with - infinite number of samples, array[N]. - errcurve = sqrt(diag(F*CovPar*F')), - where F is functions matrix. -* Rep.Noise vector of per-point estimates of noise, array[N] - -NOTE: noise in the data is estimated as follows: - * for fitting without user-supplied weights all points are - assumed to have same level of noise, which is estimated from - the data - * for fitting with user-supplied weights we assume that noise - level in I-th point is inversely proportional to Ith weight. - Coefficient of proportionality is estimated from the data. - -NOTE: we apply small amount of regularization when we invert squared - Jacobian and calculate covariance matrix. It guarantees that - algorithm won't divide by zero during inversion, but skews - error estimates a bit (fractional error is about 10^-9). - - However, we believe that this difference is insignificant for - all practical purposes except for the situation when you want - to compare ALGLIB results with "reference" implementation up - to the last significant digit. - -NOTE: covariance matrix is estimated using correction for degrees - of freedom (covariances are divided by N-M instead of dividing - by N). - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitlinear(const real_1d_array &y, const real_2d_array &fmatrix, ae_int_t &info, real_1d_array &c, lsfitreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t m; - if( (y.length()!=fmatrix.rows())) - throw ap_error("Error while calling 'lsfitlinear': looks like one of arguments has wrong size"); - n = y.length(); - m = fmatrix.cols(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lsfitlinear(const_cast(y.c_ptr()), const_cast(fmatrix.c_ptr()), n, m, &info, const_cast(c.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Constained linear least squares fitting. - -This is variation of LSFitLinear(), which searchs for min|A*x=b| given -that K additional constraints C*x=bc are satisfied. It reduces original -task to modified one: min|B*y-d| WITHOUT constraints, then LSFitLinear() -is called. - -IMPORTANT: if you want to perform polynomial fitting, it may be more - convenient to use PolynomialFit() function. This function gives - best results on polynomial problems and solves numerical - stability issues which arise when you fit high-degree - polynomials to your data. - -INPUT PARAMETERS: - Y - array[0..N-1] Function values in N points. - FMatrix - a table of basis functions values, array[0..N-1, 0..M-1]. - FMatrix[I,J] - value of J-th basis function in I-th point. - CMatrix - a table of constraints, array[0..K-1,0..M]. - I-th row of CMatrix corresponds to I-th linear constraint: - CMatrix[I,0]*C[0] + ... + CMatrix[I,M-1]*C[M-1] = CMatrix[I,M] - N - number of points used. N>=1. - M - number of basis functions, M>=1. - K - number of constraints, 0 <= K < M - K=0 corresponds to absence of constraints. - -OUTPUT PARAMETERS: - Info - error code: - * -4 internal SVD decomposition subroutine failed (very - rare and for degenerate systems only) - * -3 either too many constraints (M or more), - degenerate constraints (some constraints are - repetead twice) or inconsistent constraints were - specified. - * 1 task is solved - C - decomposition coefficients, array[0..M-1] - Rep - fitting report. Following fields are set: - * R2 non-adjusted coefficient of determination - (non-weighted) - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -IMPORTANT: - this subroitine doesn't calculate task's condition number for K<>0. - -ERRORS IN PARAMETERS - -This solver also calculates different kinds of errors in parameters and -fills corresponding fields of report: -* Rep.CovPar covariance matrix for parameters, array[K,K]. -* Rep.ErrPar errors in parameters, array[K], - errpar = sqrt(diag(CovPar)) -* Rep.ErrCurve vector of fit errors - standard deviations of empirical - best-fit curve from "ideal" best-fit curve built with - infinite number of samples, array[N]. - errcurve = sqrt(diag(F*CovPar*F')), - where F is functions matrix. -* Rep.Noise vector of per-point estimates of noise, array[N] - -IMPORTANT: errors in parameters are calculated without taking into - account boundary/linear constraints! Presence of constraints - changes distribution of errors, but there is no easy way to - account for constraints when you calculate covariance matrix. - -NOTE: noise in the data is estimated as follows: - * for fitting without user-supplied weights all points are - assumed to have same level of noise, which is estimated from - the data - * for fitting with user-supplied weights we assume that noise - level in I-th point is inversely proportional to Ith weight. - Coefficient of proportionality is estimated from the data. - -NOTE: we apply small amount of regularization when we invert squared - Jacobian and calculate covariance matrix. It guarantees that - algorithm won't divide by zero during inversion, but skews - error estimates a bit (fractional error is about 10^-9). - - However, we believe that this difference is insignificant for - all practical purposes except for the situation when you want - to compare ALGLIB results with "reference" implementation up - to the last significant digit. - -NOTE: covariance matrix is estimated using correction for degrees - of freedom (covariances are divided by N-M instead of dividing - by N). - - -- ALGLIB -- - Copyright 07.09.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitlinearc(const real_1d_array &y, const real_2d_array &fmatrix, const real_2d_array &cmatrix, const ae_int_t n, const ae_int_t m, const ae_int_t k, ae_int_t &info, real_1d_array &c, lsfitreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lsfitlinearc(const_cast(y.c_ptr()), const_cast(fmatrix.c_ptr()), const_cast(cmatrix.c_ptr()), n, m, k, &info, const_cast(c.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Constained linear least squares fitting. - -This is variation of LSFitLinear(), which searchs for min|A*x=b| given -that K additional constraints C*x=bc are satisfied. It reduces original -task to modified one: min|B*y-d| WITHOUT constraints, then LSFitLinear() -is called. - -IMPORTANT: if you want to perform polynomial fitting, it may be more - convenient to use PolynomialFit() function. This function gives - best results on polynomial problems and solves numerical - stability issues which arise when you fit high-degree - polynomials to your data. - -INPUT PARAMETERS: - Y - array[0..N-1] Function values in N points. - FMatrix - a table of basis functions values, array[0..N-1, 0..M-1]. - FMatrix[I,J] - value of J-th basis function in I-th point. - CMatrix - a table of constraints, array[0..K-1,0..M]. - I-th row of CMatrix corresponds to I-th linear constraint: - CMatrix[I,0]*C[0] + ... + CMatrix[I,M-1]*C[M-1] = CMatrix[I,M] - N - number of points used. N>=1. - M - number of basis functions, M>=1. - K - number of constraints, 0 <= K < M - K=0 corresponds to absence of constraints. - -OUTPUT PARAMETERS: - Info - error code: - * -4 internal SVD decomposition subroutine failed (very - rare and for degenerate systems only) - * -3 either too many constraints (M or more), - degenerate constraints (some constraints are - repetead twice) or inconsistent constraints were - specified. - * 1 task is solved - C - decomposition coefficients, array[0..M-1] - Rep - fitting report. Following fields are set: - * R2 non-adjusted coefficient of determination - (non-weighted) - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -IMPORTANT: - this subroitine doesn't calculate task's condition number for K<>0. - -ERRORS IN PARAMETERS - -This solver also calculates different kinds of errors in parameters and -fills corresponding fields of report: -* Rep.CovPar covariance matrix for parameters, array[K,K]. -* Rep.ErrPar errors in parameters, array[K], - errpar = sqrt(diag(CovPar)) -* Rep.ErrCurve vector of fit errors - standard deviations of empirical - best-fit curve from "ideal" best-fit curve built with - infinite number of samples, array[N]. - errcurve = sqrt(diag(F*CovPar*F')), - where F is functions matrix. -* Rep.Noise vector of per-point estimates of noise, array[N] - -IMPORTANT: errors in parameters are calculated without taking into - account boundary/linear constraints! Presence of constraints - changes distribution of errors, but there is no easy way to - account for constraints when you calculate covariance matrix. - -NOTE: noise in the data is estimated as follows: - * for fitting without user-supplied weights all points are - assumed to have same level of noise, which is estimated from - the data - * for fitting with user-supplied weights we assume that noise - level in I-th point is inversely proportional to Ith weight. - Coefficient of proportionality is estimated from the data. - -NOTE: we apply small amount of regularization when we invert squared - Jacobian and calculate covariance matrix. It guarantees that - algorithm won't divide by zero during inversion, but skews - error estimates a bit (fractional error is about 10^-9). - - However, we believe that this difference is insignificant for - all practical purposes except for the situation when you want - to compare ALGLIB results with "reference" implementation up - to the last significant digit. - -NOTE: covariance matrix is estimated using correction for degrees - of freedom (covariances are divided by N-M instead of dividing - by N). - - -- ALGLIB -- - Copyright 07.09.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitlinearc(const real_1d_array &y, const real_2d_array &fmatrix, const real_2d_array &cmatrix, ae_int_t &info, real_1d_array &c, lsfitreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t m; - ae_int_t k; - if( (y.length()!=fmatrix.rows())) - throw ap_error("Error while calling 'lsfitlinearc': looks like one of arguments has wrong size"); - if( (fmatrix.cols()!=cmatrix.cols()-1)) - throw ap_error("Error while calling 'lsfitlinearc': looks like one of arguments has wrong size"); - n = y.length(); - m = fmatrix.cols(); - k = cmatrix.rows(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lsfitlinearc(const_cast(y.c_ptr()), const_cast(fmatrix.c_ptr()), const_cast(cmatrix.c_ptr()), n, m, k, &info, const_cast(c.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Weighted nonlinear least squares fitting using function values only. - -Combination of numerical differentiation and secant updates is used to -obtain function Jacobian. - -Nonlinear task min(F(c)) is solved, where - - F(c) = (w[0]*(f(c,x[0])-y[0]))^2 + ... + (w[n-1]*(f(c,x[n-1])-y[n-1]))^2, - - * N is a number of points, - * M is a dimension of a space points belong to, - * K is a dimension of a space of parameters being fitted, - * w is an N-dimensional vector of weight coefficients, - * x is a set of N points, each of them is an M-dimensional vector, - * c is a K-dimensional vector of parameters being fitted - -This subroutine uses only f(c,x[i]). - -INPUT PARAMETERS: - X - array[0..N-1,0..M-1], points (one row = one point) - Y - array[0..N-1], function values. - W - weights, array[0..N-1] - C - array[0..K-1], initial approximation to the solution, - N - number of points, N>1 - M - dimension of space - K - number of parameters being fitted - DiffStep- numerical differentiation step; - should not be very small or large; - large = loss of accuracy - small = growth of round-off errors - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 18.10.2008 by Bochkanov Sergey -*************************************************************************/ -void lsfitcreatewf(const real_2d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &c, const ae_int_t n, const ae_int_t m, const ae_int_t k, const double diffstep, lsfitstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lsfitcreatewf(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), const_cast(c.c_ptr()), n, m, k, diffstep, const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Weighted nonlinear least squares fitting using function values only. - -Combination of numerical differentiation and secant updates is used to -obtain function Jacobian. - -Nonlinear task min(F(c)) is solved, where - - F(c) = (w[0]*(f(c,x[0])-y[0]))^2 + ... + (w[n-1]*(f(c,x[n-1])-y[n-1]))^2, - - * N is a number of points, - * M is a dimension of a space points belong to, - * K is a dimension of a space of parameters being fitted, - * w is an N-dimensional vector of weight coefficients, - * x is a set of N points, each of them is an M-dimensional vector, - * c is a K-dimensional vector of parameters being fitted - -This subroutine uses only f(c,x[i]). - -INPUT PARAMETERS: - X - array[0..N-1,0..M-1], points (one row = one point) - Y - array[0..N-1], function values. - W - weights, array[0..N-1] - C - array[0..K-1], initial approximation to the solution, - N - number of points, N>1 - M - dimension of space - K - number of parameters being fitted - DiffStep- numerical differentiation step; - should not be very small or large; - large = loss of accuracy - small = growth of round-off errors - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 18.10.2008 by Bochkanov Sergey -*************************************************************************/ -void lsfitcreatewf(const real_2d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &c, const double diffstep, lsfitstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t m; - ae_int_t k; - if( (x.rows()!=y.length()) || (x.rows()!=w.length())) - throw ap_error("Error while calling 'lsfitcreatewf': looks like one of arguments has wrong size"); - n = x.rows(); - m = x.cols(); - k = c.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lsfitcreatewf(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), const_cast(c.c_ptr()), n, m, k, diffstep, const_cast(state.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Nonlinear least squares fitting using function values only. - -Combination of numerical differentiation and secant updates is used to -obtain function Jacobian. - -Nonlinear task min(F(c)) is solved, where - - F(c) = (f(c,x[0])-y[0])^2 + ... + (f(c,x[n-1])-y[n-1])^2, - - * N is a number of points, - * M is a dimension of a space points belong to, - * K is a dimension of a space of parameters being fitted, - * w is an N-dimensional vector of weight coefficients, - * x is a set of N points, each of them is an M-dimensional vector, - * c is a K-dimensional vector of parameters being fitted - -This subroutine uses only f(c,x[i]). - -INPUT PARAMETERS: - X - array[0..N-1,0..M-1], points (one row = one point) - Y - array[0..N-1], function values. - C - array[0..K-1], initial approximation to the solution, - N - number of points, N>1 - M - dimension of space - K - number of parameters being fitted - DiffStep- numerical differentiation step; - should not be very small or large; - large = loss of accuracy - small = growth of round-off errors - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 18.10.2008 by Bochkanov Sergey -*************************************************************************/ -void lsfitcreatef(const real_2d_array &x, const real_1d_array &y, const real_1d_array &c, const ae_int_t n, const ae_int_t m, const ae_int_t k, const double diffstep, lsfitstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lsfitcreatef(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(c.c_ptr()), n, m, k, diffstep, const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Nonlinear least squares fitting using function values only. - -Combination of numerical differentiation and secant updates is used to -obtain function Jacobian. - -Nonlinear task min(F(c)) is solved, where - - F(c) = (f(c,x[0])-y[0])^2 + ... + (f(c,x[n-1])-y[n-1])^2, - - * N is a number of points, - * M is a dimension of a space points belong to, - * K is a dimension of a space of parameters being fitted, - * w is an N-dimensional vector of weight coefficients, - * x is a set of N points, each of them is an M-dimensional vector, - * c is a K-dimensional vector of parameters being fitted - -This subroutine uses only f(c,x[i]). - -INPUT PARAMETERS: - X - array[0..N-1,0..M-1], points (one row = one point) - Y - array[0..N-1], function values. - C - array[0..K-1], initial approximation to the solution, - N - number of points, N>1 - M - dimension of space - K - number of parameters being fitted - DiffStep- numerical differentiation step; - should not be very small or large; - large = loss of accuracy - small = growth of round-off errors - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 18.10.2008 by Bochkanov Sergey -*************************************************************************/ -void lsfitcreatef(const real_2d_array &x, const real_1d_array &y, const real_1d_array &c, const double diffstep, lsfitstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t m; - ae_int_t k; - if( (x.rows()!=y.length())) - throw ap_error("Error while calling 'lsfitcreatef': looks like one of arguments has wrong size"); - n = x.rows(); - m = x.cols(); - k = c.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lsfitcreatef(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(c.c_ptr()), n, m, k, diffstep, const_cast(state.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Weighted nonlinear least squares fitting using gradient only. - -Nonlinear task min(F(c)) is solved, where - - F(c) = (w[0]*(f(c,x[0])-y[0]))^2 + ... + (w[n-1]*(f(c,x[n-1])-y[n-1]))^2, - - * N is a number of points, - * M is a dimension of a space points belong to, - * K is a dimension of a space of parameters being fitted, - * w is an N-dimensional vector of weight coefficients, - * x is a set of N points, each of them is an M-dimensional vector, - * c is a K-dimensional vector of parameters being fitted - -This subroutine uses only f(c,x[i]) and its gradient. - -INPUT PARAMETERS: - X - array[0..N-1,0..M-1], points (one row = one point) - Y - array[0..N-1], function values. - W - weights, array[0..N-1] - C - array[0..K-1], initial approximation to the solution, - N - number of points, N>1 - M - dimension of space - K - number of parameters being fitted - CheapFG - boolean flag, which is: - * True if both function and gradient calculation complexity - are less than O(M^2). An improved algorithm can - be used which corresponds to FGJ scheme from - MINLM unit. - * False otherwise. - Standard Jacibian-bases Levenberg-Marquardt algo - will be used (FJ scheme). - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -See also: - LSFitResults - LSFitCreateFG (fitting without weights) - LSFitCreateWFGH (fitting using Hessian) - LSFitCreateFGH (fitting using Hessian, without weights) - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitcreatewfg(const real_2d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &c, const ae_int_t n, const ae_int_t m, const ae_int_t k, const bool cheapfg, lsfitstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lsfitcreatewfg(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), const_cast(c.c_ptr()), n, m, k, cheapfg, const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Weighted nonlinear least squares fitting using gradient only. - -Nonlinear task min(F(c)) is solved, where - - F(c) = (w[0]*(f(c,x[0])-y[0]))^2 + ... + (w[n-1]*(f(c,x[n-1])-y[n-1]))^2, - - * N is a number of points, - * M is a dimension of a space points belong to, - * K is a dimension of a space of parameters being fitted, - * w is an N-dimensional vector of weight coefficients, - * x is a set of N points, each of them is an M-dimensional vector, - * c is a K-dimensional vector of parameters being fitted - -This subroutine uses only f(c,x[i]) and its gradient. - -INPUT PARAMETERS: - X - array[0..N-1,0..M-1], points (one row = one point) - Y - array[0..N-1], function values. - W - weights, array[0..N-1] - C - array[0..K-1], initial approximation to the solution, - N - number of points, N>1 - M - dimension of space - K - number of parameters being fitted - CheapFG - boolean flag, which is: - * True if both function and gradient calculation complexity - are less than O(M^2). An improved algorithm can - be used which corresponds to FGJ scheme from - MINLM unit. - * False otherwise. - Standard Jacibian-bases Levenberg-Marquardt algo - will be used (FJ scheme). - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -See also: - LSFitResults - LSFitCreateFG (fitting without weights) - LSFitCreateWFGH (fitting using Hessian) - LSFitCreateFGH (fitting using Hessian, without weights) - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitcreatewfg(const real_2d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &c, const bool cheapfg, lsfitstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t m; - ae_int_t k; - if( (x.rows()!=y.length()) || (x.rows()!=w.length())) - throw ap_error("Error while calling 'lsfitcreatewfg': looks like one of arguments has wrong size"); - n = x.rows(); - m = x.cols(); - k = c.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lsfitcreatewfg(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), const_cast(c.c_ptr()), n, m, k, cheapfg, const_cast(state.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Nonlinear least squares fitting using gradient only, without individual -weights. - -Nonlinear task min(F(c)) is solved, where - - F(c) = ((f(c,x[0])-y[0]))^2 + ... + ((f(c,x[n-1])-y[n-1]))^2, - - * N is a number of points, - * M is a dimension of a space points belong to, - * K is a dimension of a space of parameters being fitted, - * x is a set of N points, each of them is an M-dimensional vector, - * c is a K-dimensional vector of parameters being fitted - -This subroutine uses only f(c,x[i]) and its gradient. - -INPUT PARAMETERS: - X - array[0..N-1,0..M-1], points (one row = one point) - Y - array[0..N-1], function values. - C - array[0..K-1], initial approximation to the solution, - N - number of points, N>1 - M - dimension of space - K - number of parameters being fitted - CheapFG - boolean flag, which is: - * True if both function and gradient calculation complexity - are less than O(M^2). An improved algorithm can - be used which corresponds to FGJ scheme from - MINLM unit. - * False otherwise. - Standard Jacibian-bases Levenberg-Marquardt algo - will be used (FJ scheme). - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitcreatefg(const real_2d_array &x, const real_1d_array &y, const real_1d_array &c, const ae_int_t n, const ae_int_t m, const ae_int_t k, const bool cheapfg, lsfitstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lsfitcreatefg(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(c.c_ptr()), n, m, k, cheapfg, const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Nonlinear least squares fitting using gradient only, without individual -weights. - -Nonlinear task min(F(c)) is solved, where - - F(c) = ((f(c,x[0])-y[0]))^2 + ... + ((f(c,x[n-1])-y[n-1]))^2, - - * N is a number of points, - * M is a dimension of a space points belong to, - * K is a dimension of a space of parameters being fitted, - * x is a set of N points, each of them is an M-dimensional vector, - * c is a K-dimensional vector of parameters being fitted - -This subroutine uses only f(c,x[i]) and its gradient. - -INPUT PARAMETERS: - X - array[0..N-1,0..M-1], points (one row = one point) - Y - array[0..N-1], function values. - C - array[0..K-1], initial approximation to the solution, - N - number of points, N>1 - M - dimension of space - K - number of parameters being fitted - CheapFG - boolean flag, which is: - * True if both function and gradient calculation complexity - are less than O(M^2). An improved algorithm can - be used which corresponds to FGJ scheme from - MINLM unit. - * False otherwise. - Standard Jacibian-bases Levenberg-Marquardt algo - will be used (FJ scheme). - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitcreatefg(const real_2d_array &x, const real_1d_array &y, const real_1d_array &c, const bool cheapfg, lsfitstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t m; - ae_int_t k; - if( (x.rows()!=y.length())) - throw ap_error("Error while calling 'lsfitcreatefg': looks like one of arguments has wrong size"); - n = x.rows(); - m = x.cols(); - k = c.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lsfitcreatefg(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(c.c_ptr()), n, m, k, cheapfg, const_cast(state.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Weighted nonlinear least squares fitting using gradient/Hessian. - -Nonlinear task min(F(c)) is solved, where - - F(c) = (w[0]*(f(c,x[0])-y[0]))^2 + ... + (w[n-1]*(f(c,x[n-1])-y[n-1]))^2, - - * N is a number of points, - * M is a dimension of a space points belong to, - * K is a dimension of a space of parameters being fitted, - * w is an N-dimensional vector of weight coefficients, - * x is a set of N points, each of them is an M-dimensional vector, - * c is a K-dimensional vector of parameters being fitted - -This subroutine uses f(c,x[i]), its gradient and its Hessian. - -INPUT PARAMETERS: - X - array[0..N-1,0..M-1], points (one row = one point) - Y - array[0..N-1], function values. - W - weights, array[0..N-1] - C - array[0..K-1], initial approximation to the solution, - N - number of points, N>1 - M - dimension of space - K - number of parameters being fitted - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitcreatewfgh(const real_2d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &c, const ae_int_t n, const ae_int_t m, const ae_int_t k, lsfitstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lsfitcreatewfgh(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), const_cast(c.c_ptr()), n, m, k, const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Weighted nonlinear least squares fitting using gradient/Hessian. - -Nonlinear task min(F(c)) is solved, where - - F(c) = (w[0]*(f(c,x[0])-y[0]))^2 + ... + (w[n-1]*(f(c,x[n-1])-y[n-1]))^2, - - * N is a number of points, - * M is a dimension of a space points belong to, - * K is a dimension of a space of parameters being fitted, - * w is an N-dimensional vector of weight coefficients, - * x is a set of N points, each of them is an M-dimensional vector, - * c is a K-dimensional vector of parameters being fitted - -This subroutine uses f(c,x[i]), its gradient and its Hessian. - -INPUT PARAMETERS: - X - array[0..N-1,0..M-1], points (one row = one point) - Y - array[0..N-1], function values. - W - weights, array[0..N-1] - C - array[0..K-1], initial approximation to the solution, - N - number of points, N>1 - M - dimension of space - K - number of parameters being fitted - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitcreatewfgh(const real_2d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &c, lsfitstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t m; - ae_int_t k; - if( (x.rows()!=y.length()) || (x.rows()!=w.length())) - throw ap_error("Error while calling 'lsfitcreatewfgh': looks like one of arguments has wrong size"); - n = x.rows(); - m = x.cols(); - k = c.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lsfitcreatewfgh(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), const_cast(c.c_ptr()), n, m, k, const_cast(state.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Nonlinear least squares fitting using gradient/Hessian, without individial -weights. - -Nonlinear task min(F(c)) is solved, where - - F(c) = ((f(c,x[0])-y[0]))^2 + ... + ((f(c,x[n-1])-y[n-1]))^2, - - * N is a number of points, - * M is a dimension of a space points belong to, - * K is a dimension of a space of parameters being fitted, - * x is a set of N points, each of them is an M-dimensional vector, - * c is a K-dimensional vector of parameters being fitted - -This subroutine uses f(c,x[i]), its gradient and its Hessian. - -INPUT PARAMETERS: - X - array[0..N-1,0..M-1], points (one row = one point) - Y - array[0..N-1], function values. - C - array[0..K-1], initial approximation to the solution, - N - number of points, N>1 - M - dimension of space - K - number of parameters being fitted - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitcreatefgh(const real_2d_array &x, const real_1d_array &y, const real_1d_array &c, const ae_int_t n, const ae_int_t m, const ae_int_t k, lsfitstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lsfitcreatefgh(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(c.c_ptr()), n, m, k, const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Nonlinear least squares fitting using gradient/Hessian, without individial -weights. - -Nonlinear task min(F(c)) is solved, where - - F(c) = ((f(c,x[0])-y[0]))^2 + ... + ((f(c,x[n-1])-y[n-1]))^2, - - * N is a number of points, - * M is a dimension of a space points belong to, - * K is a dimension of a space of parameters being fitted, - * x is a set of N points, each of them is an M-dimensional vector, - * c is a K-dimensional vector of parameters being fitted - -This subroutine uses f(c,x[i]), its gradient and its Hessian. - -INPUT PARAMETERS: - X - array[0..N-1,0..M-1], points (one row = one point) - Y - array[0..N-1], function values. - C - array[0..K-1], initial approximation to the solution, - N - number of points, N>1 - M - dimension of space - K - number of parameters being fitted - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitcreatefgh(const real_2d_array &x, const real_1d_array &y, const real_1d_array &c, lsfitstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t m; - ae_int_t k; - if( (x.rows()!=y.length())) - throw ap_error("Error while calling 'lsfitcreatefgh': looks like one of arguments has wrong size"); - n = x.rows(); - m = x.cols(); - k = c.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lsfitcreatefgh(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(c.c_ptr()), n, m, k, const_cast(state.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Stopping conditions for nonlinear least squares fitting. - -INPUT PARAMETERS: - State - structure which stores algorithm state - EpsF - stopping criterion. Algorithm stops if - |F(k+1)-F(k)| <= EpsF*max{|F(k)|, |F(k+1)|, 1} - EpsX - >=0 - The subroutine finishes its work if on k+1-th iteration - the condition |v|<=EpsX is fulfilled, where: - * |.| means Euclidian norm - * v - scaled step vector, v[i]=dx[i]/s[i] - * dx - ste pvector, dx=X(k+1)-X(k) - * s - scaling coefficients set by LSFitSetScale() - MaxIts - maximum number of iterations. If MaxIts=0, the number of - iterations is unlimited. Only Levenberg-Marquardt - iterations are counted (L-BFGS/CG iterations are NOT - counted because their cost is very low compared to that of - LM). - -NOTE - -Passing EpsF=0, EpsX=0 and MaxIts=0 (simultaneously) will lead to automatic -stopping criterion selection (according to the scheme used by MINLM unit). - - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitsetcond(const lsfitstate &state, const double epsf, const double epsx, const ae_int_t maxits) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lsfitsetcond(const_cast(state.c_ptr()), epsf, epsx, maxits, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets maximum step length - -INPUT PARAMETERS: - State - structure which stores algorithm state - StpMax - maximum step length, >=0. Set StpMax to 0.0, if you don't - want to limit step length. - -Use this subroutine when you optimize target function which contains exp() -or other fast growing functions, and optimization algorithm makes too -large steps which leads to overflow. This function allows us to reject -steps that are too large (and therefore expose us to the possible -overflow) without actually calculating function value at the x+stp*d. - -NOTE: non-zero StpMax leads to moderate performance degradation because -intermediate step of preconditioned L-BFGS optimization is incompatible -with limits on step size. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void lsfitsetstpmax(const lsfitstate &state, const double stpmax) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lsfitsetstpmax(const_cast(state.c_ptr()), stpmax, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function turns on/off reporting. - -INPUT PARAMETERS: - State - structure which stores algorithm state - NeedXRep- whether iteration reports are needed or not - -When reports are needed, State.C (current parameters) and State.F (current -value of fitting function) are reported. - - - -- ALGLIB -- - Copyright 15.08.2010 by Bochkanov Sergey -*************************************************************************/ -void lsfitsetxrep(const lsfitstate &state, const bool needxrep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lsfitsetxrep(const_cast(state.c_ptr()), needxrep, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets scaling coefficients for underlying optimizer. - -ALGLIB optimizers use scaling matrices to test stopping conditions (step -size and gradient are scaled before comparison with tolerances). Scale of -the I-th variable is a translation invariant measure of: -a) "how large" the variable is -b) how large the step should be to make significant changes in the function - -Generally, scale is NOT considered to be a form of preconditioner. But LM -optimizer is unique in that it uses scaling matrix both in the stopping -condition tests and as Marquardt damping factor. - -Proper scaling is very important for the algorithm performance. It is less -important for the quality of results, but still has some influence (it is -easier to converge when variables are properly scaled, so premature -stopping is possible when very badly scalled variables are combined with -relaxed stopping conditions). - -INPUT PARAMETERS: - State - structure stores algorithm state - S - array[N], non-zero scaling coefficients - S[i] may be negative, sign doesn't matter. - - -- ALGLIB -- - Copyright 14.01.2011 by Bochkanov Sergey -*************************************************************************/ -void lsfitsetscale(const lsfitstate &state, const real_1d_array &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lsfitsetscale(const_cast(state.c_ptr()), const_cast(s.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets boundary constraints for underlying optimizer - -Boundary constraints are inactive by default (after initial creation). -They are preserved until explicitly turned off with another SetBC() call. - -INPUT PARAMETERS: - State - structure stores algorithm state - BndL - lower bounds, array[K]. - If some (all) variables are unbounded, you may specify - very small number or -INF (latter is recommended because - it will allow solver to use better algorithm). - BndU - upper bounds, array[K]. - If some (all) variables are unbounded, you may specify - very large number or +INF (latter is recommended because - it will allow solver to use better algorithm). - -NOTE 1: it is possible to specify BndL[i]=BndU[i]. In this case I-th -variable will be "frozen" at X[i]=BndL[i]=BndU[i]. - -NOTE 2: unlike other constrained optimization algorithms, this solver has -following useful properties: -* bound constraints are always satisfied exactly -* function is evaluated only INSIDE area specified by bound constraints - - -- ALGLIB -- - Copyright 14.01.2011 by Bochkanov Sergey -*************************************************************************/ -void lsfitsetbc(const lsfitstate &state, const real_1d_array &bndl, const real_1d_array &bndu) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lsfitsetbc(const_cast(state.c_ptr()), const_cast(bndl.c_ptr()), const_cast(bndu.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function provides reverse communication interface -Reverse communication interface is not documented or recommended to use. -See below for functions which provide better documented API -*************************************************************************/ -bool lsfititeration(const lsfitstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::lsfititeration(const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void lsfitfit(lsfitstate &state, - void (*func)(const real_1d_array &c, const real_1d_array &x, double &func, void *ptr), - void (*rep)(const real_1d_array &c, double func, void *ptr), - void *ptr) -{ - alglib_impl::ae_state _alglib_env_state; - if( func==NULL ) - throw ap_error("ALGLIB: error in 'lsfitfit()' (func is NULL)"); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - while( alglib_impl::lsfititeration(state.c_ptr(), &_alglib_env_state) ) - { - if( state.needf ) - { - func(state.c, state.x, state.f, ptr); - continue; - } - if( state.xupdated ) - { - if( rep!=NULL ) - rep(state.c, state.f, ptr); - continue; - } - throw ap_error("ALGLIB: error in 'lsfitfit' (some derivatives were not provided?)"); - } - alglib_impl::ae_state_clear(&_alglib_env_state); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void lsfitfit(lsfitstate &state, - void (*func)(const real_1d_array &c, const real_1d_array &x, double &func, void *ptr), - void (*grad)(const real_1d_array &c, const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), - void (*rep)(const real_1d_array &c, double func, void *ptr), - void *ptr) -{ - alglib_impl::ae_state _alglib_env_state; - if( func==NULL ) - throw ap_error("ALGLIB: error in 'lsfitfit()' (func is NULL)"); - if( grad==NULL ) - throw ap_error("ALGLIB: error in 'lsfitfit()' (grad is NULL)"); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - while( alglib_impl::lsfititeration(state.c_ptr(), &_alglib_env_state) ) - { - if( state.needf ) - { - func(state.c, state.x, state.f, ptr); - continue; - } - if( state.needfg ) - { - grad(state.c, state.x, state.f, state.g, ptr); - continue; - } - if( state.xupdated ) - { - if( rep!=NULL ) - rep(state.c, state.f, ptr); - continue; - } - throw ap_error("ALGLIB: error in 'lsfitfit' (some derivatives were not provided?)"); - } - alglib_impl::ae_state_clear(&_alglib_env_state); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void lsfitfit(lsfitstate &state, - void (*func)(const real_1d_array &c, const real_1d_array &x, double &func, void *ptr), - void (*grad)(const real_1d_array &c, const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), - void (*hess)(const real_1d_array &c, const real_1d_array &x, double &func, real_1d_array &grad, real_2d_array &hess, void *ptr), - void (*rep)(const real_1d_array &c, double func, void *ptr), - void *ptr) -{ - alglib_impl::ae_state _alglib_env_state; - if( func==NULL ) - throw ap_error("ALGLIB: error in 'lsfitfit()' (func is NULL)"); - if( grad==NULL ) - throw ap_error("ALGLIB: error in 'lsfitfit()' (grad is NULL)"); - if( hess==NULL ) - throw ap_error("ALGLIB: error in 'lsfitfit()' (hess is NULL)"); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - while( alglib_impl::lsfititeration(state.c_ptr(), &_alglib_env_state) ) - { - if( state.needf ) - { - func(state.c, state.x, state.f, ptr); - continue; - } - if( state.needfg ) - { - grad(state.c, state.x, state.f, state.g, ptr); - continue; - } - if( state.needfgh ) - { - hess(state.c, state.x, state.f, state.g, state.h, ptr); - continue; - } - if( state.xupdated ) - { - if( rep!=NULL ) - rep(state.c, state.f, ptr); - continue; - } - throw ap_error("ALGLIB: error in 'lsfitfit' (some derivatives were not provided?)"); - } - alglib_impl::ae_state_clear(&_alglib_env_state); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - - -/************************************************************************* -Nonlinear least squares fitting results. - -Called after return from LSFitFit(). - -INPUT PARAMETERS: - State - algorithm state - -OUTPUT PARAMETERS: - Info - completion code: - * -7 gradient verification failed. - See LSFitSetGradientCheck() for more information. - * 1 relative function improvement is no more than - EpsF. - * 2 relative step is no more than EpsX. - * 4 gradient norm is no more than EpsG - * 5 MaxIts steps was taken - * 7 stopping conditions are too stringent, - further improvement is impossible - C - array[0..K-1], solution - Rep - optimization report. On success following fields are set: - * R2 non-adjusted coefficient of determination - (non-weighted) - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - * WRMSError weighted rms error on the (X,Y). - -ERRORS IN PARAMETERS - -This solver also calculates different kinds of errors in parameters and -fills corresponding fields of report: -* Rep.CovPar covariance matrix for parameters, array[K,K]. -* Rep.ErrPar errors in parameters, array[K], - errpar = sqrt(diag(CovPar)) -* Rep.ErrCurve vector of fit errors - standard deviations of empirical - best-fit curve from "ideal" best-fit curve built with - infinite number of samples, array[N]. - errcurve = sqrt(diag(J*CovPar*J')), - where J is Jacobian matrix. -* Rep.Noise vector of per-point estimates of noise, array[N] - -IMPORTANT: errors in parameters are calculated without taking into - account boundary/linear constraints! Presence of constraints - changes distribution of errors, but there is no easy way to - account for constraints when you calculate covariance matrix. - -NOTE: noise in the data is estimated as follows: - * for fitting without user-supplied weights all points are - assumed to have same level of noise, which is estimated from - the data - * for fitting with user-supplied weights we assume that noise - level in I-th point is inversely proportional to Ith weight. - Coefficient of proportionality is estimated from the data. - -NOTE: we apply small amount of regularization when we invert squared - Jacobian and calculate covariance matrix. It guarantees that - algorithm won't divide by zero during inversion, but skews - error estimates a bit (fractional error is about 10^-9). - - However, we believe that this difference is insignificant for - all practical purposes except for the situation when you want - to compare ALGLIB results with "reference" implementation up - to the last significant digit. - -NOTE: covariance matrix is estimated using correction for degrees - of freedom (covariances are divided by N-M instead of dividing - by N). - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitresults(const lsfitstate &state, ae_int_t &info, real_1d_array &c, lsfitreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lsfitresults(const_cast(state.c_ptr()), &info, const_cast(c.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine turns on verification of the user-supplied analytic -gradient: -* user calls this subroutine before fitting begins -* LSFitFit() is called -* prior to actual fitting, for each point in data set X_i and each - component of parameters being fited C_j algorithm performs following - steps: - * two trial steps are made to C_j-TestStep*S[j] and C_j+TestStep*S[j], - where C_j is j-th parameter and S[j] is a scale of j-th parameter - * if needed, steps are bounded with respect to constraints on C[] - * F(X_i|C) is evaluated at these trial points - * we perform one more evaluation in the middle point of the interval - * we build cubic model using function values and derivatives at trial - points and we compare its prediction with actual value in the middle - point - * in case difference between prediction and actual value is higher than - some predetermined threshold, algorithm stops with completion code -7; - Rep.VarIdx is set to index of the parameter with incorrect derivative. -* after verification is over, algorithm proceeds to the actual optimization. - -NOTE 1: verification needs N*K (points count * parameters count) gradient - evaluations. It is very costly and you should use it only for low - dimensional problems, when you want to be sure that you've - correctly calculated analytic derivatives. You should not use it - in the production code (unless you want to check derivatives - provided by some third party). - -NOTE 2: you should carefully choose TestStep. Value which is too large - (so large that function behaviour is significantly non-cubic) will - lead to false alarms. You may use different step for different - parameters by means of setting scale with LSFitSetScale(). - -NOTE 3: this function may lead to false positives. In case it reports that - I-th derivative was calculated incorrectly, you may decrease test - step and try one more time - maybe your function changes too - sharply and your step is too large for such rapidly chanding - function. - -NOTE 4: this function works only for optimizers created with LSFitCreateWFG() - or LSFitCreateFG() constructors. - -INPUT PARAMETERS: - State - structure used to store algorithm state - TestStep - verification step: - * TestStep=0 turns verification off - * TestStep>0 activates verification - - -- ALGLIB -- - Copyright 15.06.2012 by Bochkanov Sergey -*************************************************************************/ -void lsfitsetgradientcheck(const lsfitstate &state, const double teststep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lsfitsetgradientcheck(const_cast(state.c_ptr()), teststep, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Parametric spline inteprolant: 2-dimensional curve. - -You should not try to access its members directly - use PSpline2XXXXXXXX() -functions instead. -*************************************************************************/ -_pspline2interpolant_owner::_pspline2interpolant_owner() -{ - p_struct = (alglib_impl::pspline2interpolant*)alglib_impl::ae_malloc(sizeof(alglib_impl::pspline2interpolant), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_pspline2interpolant_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_pspline2interpolant_owner::_pspline2interpolant_owner(const _pspline2interpolant_owner &rhs) -{ - p_struct = (alglib_impl::pspline2interpolant*)alglib_impl::ae_malloc(sizeof(alglib_impl::pspline2interpolant), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_pspline2interpolant_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_pspline2interpolant_owner& _pspline2interpolant_owner::operator=(const _pspline2interpolant_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_pspline2interpolant_clear(p_struct); - if( !alglib_impl::_pspline2interpolant_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_pspline2interpolant_owner::~_pspline2interpolant_owner() -{ - alglib_impl::_pspline2interpolant_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::pspline2interpolant* _pspline2interpolant_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::pspline2interpolant* _pspline2interpolant_owner::c_ptr() const -{ - return const_cast(p_struct); -} -pspline2interpolant::pspline2interpolant() : _pspline2interpolant_owner() -{ -} - -pspline2interpolant::pspline2interpolant(const pspline2interpolant &rhs):_pspline2interpolant_owner(rhs) -{ -} - -pspline2interpolant& pspline2interpolant::operator=(const pspline2interpolant &rhs) -{ - if( this==&rhs ) - return *this; - _pspline2interpolant_owner::operator=(rhs); - return *this; -} - -pspline2interpolant::~pspline2interpolant() -{ -} - - -/************************************************************************* -Parametric spline inteprolant: 3-dimensional curve. - -You should not try to access its members directly - use PSpline3XXXXXXXX() -functions instead. -*************************************************************************/ -_pspline3interpolant_owner::_pspline3interpolant_owner() -{ - p_struct = (alglib_impl::pspline3interpolant*)alglib_impl::ae_malloc(sizeof(alglib_impl::pspline3interpolant), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_pspline3interpolant_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_pspline3interpolant_owner::_pspline3interpolant_owner(const _pspline3interpolant_owner &rhs) -{ - p_struct = (alglib_impl::pspline3interpolant*)alglib_impl::ae_malloc(sizeof(alglib_impl::pspline3interpolant), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_pspline3interpolant_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_pspline3interpolant_owner& _pspline3interpolant_owner::operator=(const _pspline3interpolant_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_pspline3interpolant_clear(p_struct); - if( !alglib_impl::_pspline3interpolant_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_pspline3interpolant_owner::~_pspline3interpolant_owner() -{ - alglib_impl::_pspline3interpolant_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::pspline3interpolant* _pspline3interpolant_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::pspline3interpolant* _pspline3interpolant_owner::c_ptr() const -{ - return const_cast(p_struct); -} -pspline3interpolant::pspline3interpolant() : _pspline3interpolant_owner() -{ -} - -pspline3interpolant::pspline3interpolant(const pspline3interpolant &rhs):_pspline3interpolant_owner(rhs) -{ -} - -pspline3interpolant& pspline3interpolant::operator=(const pspline3interpolant &rhs) -{ - if( this==&rhs ) - return *this; - _pspline3interpolant_owner::operator=(rhs); - return *this; -} - -pspline3interpolant::~pspline3interpolant() -{ -} - -/************************************************************************* -This function builds non-periodic 2-dimensional parametric spline which -starts at (X[0],Y[0]) and ends at (X[N-1],Y[N-1]). - -INPUT PARAMETERS: - XY - points, array[0..N-1,0..1]. - XY[I,0:1] corresponds to the Ith point. - Order of points is important! - N - points count, N>=5 for Akima splines, N>=2 for other types of - splines. - ST - spline type: - * 0 Akima spline - * 1 parabolically terminated Catmull-Rom spline (Tension=0) - * 2 parabolically terminated cubic spline - PT - parameterization type: - * 0 uniform - * 1 chord length - * 2 centripetal - -OUTPUT PARAMETERS: - P - parametric spline interpolant - - -NOTES: -* this function assumes that there all consequent points are distinct. - I.e. (x0,y0)<>(x1,y1), (x1,y1)<>(x2,y2), (x2,y2)<>(x3,y3) and so on. - However, non-consequent points may coincide, i.e. we can have (x0,y0)= - =(x2,y2). - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline2build(const real_2d_array &xy, const ae_int_t n, const ae_int_t st, const ae_int_t pt, pspline2interpolant &p) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::pspline2build(const_cast(xy.c_ptr()), n, st, pt, const_cast(p.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function builds non-periodic 3-dimensional parametric spline which -starts at (X[0],Y[0],Z[0]) and ends at (X[N-1],Y[N-1],Z[N-1]). - -Same as PSpline2Build() function, but for 3D, so we won't duplicate its -description here. - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline3build(const real_2d_array &xy, const ae_int_t n, const ae_int_t st, const ae_int_t pt, pspline3interpolant &p) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::pspline3build(const_cast(xy.c_ptr()), n, st, pt, const_cast(p.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function builds periodic 2-dimensional parametric spline which -starts at (X[0],Y[0]), goes through all points to (X[N-1],Y[N-1]) and then -back to (X[0],Y[0]). - -INPUT PARAMETERS: - XY - points, array[0..N-1,0..1]. - XY[I,0:1] corresponds to the Ith point. - XY[N-1,0:1] must be different from XY[0,0:1]. - Order of points is important! - N - points count, N>=3 for other types of splines. - ST - spline type: - * 1 Catmull-Rom spline (Tension=0) with cyclic boundary conditions - * 2 cubic spline with cyclic boundary conditions - PT - parameterization type: - * 0 uniform - * 1 chord length - * 2 centripetal - -OUTPUT PARAMETERS: - P - parametric spline interpolant - - -NOTES: -* this function assumes that there all consequent points are distinct. - I.e. (x0,y0)<>(x1,y1), (x1,y1)<>(x2,y2), (x2,y2)<>(x3,y3) and so on. - However, non-consequent points may coincide, i.e. we can have (x0,y0)= - =(x2,y2). -* last point of sequence is NOT equal to the first point. You shouldn't - make curve "explicitly periodic" by making them equal. - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline2buildperiodic(const real_2d_array &xy, const ae_int_t n, const ae_int_t st, const ae_int_t pt, pspline2interpolant &p) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::pspline2buildperiodic(const_cast(xy.c_ptr()), n, st, pt, const_cast(p.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function builds periodic 3-dimensional parametric spline which -starts at (X[0],Y[0],Z[0]), goes through all points to (X[N-1],Y[N-1],Z[N-1]) -and then back to (X[0],Y[0],Z[0]). - -Same as PSpline2Build() function, but for 3D, so we won't duplicate its -description here. - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline3buildperiodic(const real_2d_array &xy, const ae_int_t n, const ae_int_t st, const ae_int_t pt, pspline3interpolant &p) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::pspline3buildperiodic(const_cast(xy.c_ptr()), n, st, pt, const_cast(p.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function returns vector of parameter values correspoding to points. - -I.e. for P created from (X[0],Y[0])...(X[N-1],Y[N-1]) and U=TValues(P) we -have - (X[0],Y[0]) = PSpline2Calc(P,U[0]), - (X[1],Y[1]) = PSpline2Calc(P,U[1]), - (X[2],Y[2]) = PSpline2Calc(P,U[2]), - ... - -INPUT PARAMETERS: - P - parametric spline interpolant - -OUTPUT PARAMETERS: - N - array size - T - array[0..N-1] - - -NOTES: -* for non-periodic splines U[0]=0, U[0](p.c_ptr()), &n, const_cast(t.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function returns vector of parameter values correspoding to points. - -Same as PSpline2ParameterValues(), but for 3D. - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline3parametervalues(const pspline3interpolant &p, ae_int_t &n, real_1d_array &t) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::pspline3parametervalues(const_cast(p.c_ptr()), &n, const_cast(t.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function calculates the value of the parametric spline for a given -value of parameter T - -INPUT PARAMETERS: - P - parametric spline interpolant - T - point: - * T in [0,1] corresponds to interval spanned by points - * for non-periodic splines T<0 (or T>1) correspond to parts of - the curve before the first (after the last) point - * for periodic splines T<0 (or T>1) are projected into [0,1] - by making T=T-floor(T). - -OUTPUT PARAMETERS: - X - X-position - Y - Y-position - - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline2calc(const pspline2interpolant &p, const double t, double &x, double &y) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::pspline2calc(const_cast(p.c_ptr()), t, &x, &y, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function calculates the value of the parametric spline for a given -value of parameter T. - -INPUT PARAMETERS: - P - parametric spline interpolant - T - point: - * T in [0,1] corresponds to interval spanned by points - * for non-periodic splines T<0 (or T>1) correspond to parts of - the curve before the first (after the last) point - * for periodic splines T<0 (or T>1) are projected into [0,1] - by making T=T-floor(T). - -OUTPUT PARAMETERS: - X - X-position - Y - Y-position - Z - Z-position - - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline3calc(const pspline3interpolant &p, const double t, double &x, double &y, double &z) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::pspline3calc(const_cast(p.c_ptr()), t, &x, &y, &z, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function calculates tangent vector for a given value of parameter T - -INPUT PARAMETERS: - P - parametric spline interpolant - T - point: - * T in [0,1] corresponds to interval spanned by points - * for non-periodic splines T<0 (or T>1) correspond to parts of - the curve before the first (after the last) point - * for periodic splines T<0 (or T>1) are projected into [0,1] - by making T=T-floor(T). - -OUTPUT PARAMETERS: - X - X-component of tangent vector (normalized) - Y - Y-component of tangent vector (normalized) - -NOTE: - X^2+Y^2 is either 1 (for non-zero tangent vector) or 0. - - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline2tangent(const pspline2interpolant &p, const double t, double &x, double &y) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::pspline2tangent(const_cast(p.c_ptr()), t, &x, &y, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function calculates tangent vector for a given value of parameter T - -INPUT PARAMETERS: - P - parametric spline interpolant - T - point: - * T in [0,1] corresponds to interval spanned by points - * for non-periodic splines T<0 (or T>1) correspond to parts of - the curve before the first (after the last) point - * for periodic splines T<0 (or T>1) are projected into [0,1] - by making T=T-floor(T). - -OUTPUT PARAMETERS: - X - X-component of tangent vector (normalized) - Y - Y-component of tangent vector (normalized) - Z - Z-component of tangent vector (normalized) - -NOTE: - X^2+Y^2+Z^2 is either 1 (for non-zero tangent vector) or 0. - - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline3tangent(const pspline3interpolant &p, const double t, double &x, double &y, double &z) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::pspline3tangent(const_cast(p.c_ptr()), t, &x, &y, &z, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function calculates derivative, i.e. it returns (dX/dT,dY/dT). - -INPUT PARAMETERS: - P - parametric spline interpolant - T - point: - * T in [0,1] corresponds to interval spanned by points - * for non-periodic splines T<0 (or T>1) correspond to parts of - the curve before the first (after the last) point - * for periodic splines T<0 (or T>1) are projected into [0,1] - by making T=T-floor(T). - -OUTPUT PARAMETERS: - X - X-value - DX - X-derivative - Y - Y-value - DY - Y-derivative - - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline2diff(const pspline2interpolant &p, const double t, double &x, double &dx, double &y, double &dy) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::pspline2diff(const_cast(p.c_ptr()), t, &x, &dx, &y, &dy, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function calculates derivative, i.e. it returns (dX/dT,dY/dT,dZ/dT). - -INPUT PARAMETERS: - P - parametric spline interpolant - T - point: - * T in [0,1] corresponds to interval spanned by points - * for non-periodic splines T<0 (or T>1) correspond to parts of - the curve before the first (after the last) point - * for periodic splines T<0 (or T>1) are projected into [0,1] - by making T=T-floor(T). - -OUTPUT PARAMETERS: - X - X-value - DX - X-derivative - Y - Y-value - DY - Y-derivative - Z - Z-value - DZ - Z-derivative - - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline3diff(const pspline3interpolant &p, const double t, double &x, double &dx, double &y, double &dy, double &z, double &dz) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::pspline3diff(const_cast(p.c_ptr()), t, &x, &dx, &y, &dy, &z, &dz, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function calculates first and second derivative with respect to T. - -INPUT PARAMETERS: - P - parametric spline interpolant - T - point: - * T in [0,1] corresponds to interval spanned by points - * for non-periodic splines T<0 (or T>1) correspond to parts of - the curve before the first (after the last) point - * for periodic splines T<0 (or T>1) are projected into [0,1] - by making T=T-floor(T). - -OUTPUT PARAMETERS: - X - X-value - DX - derivative - D2X - second derivative - Y - Y-value - DY - derivative - D2Y - second derivative - - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline2diff2(const pspline2interpolant &p, const double t, double &x, double &dx, double &d2x, double &y, double &dy, double &d2y) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::pspline2diff2(const_cast(p.c_ptr()), t, &x, &dx, &d2x, &y, &dy, &d2y, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function calculates first and second derivative with respect to T. - -INPUT PARAMETERS: - P - parametric spline interpolant - T - point: - * T in [0,1] corresponds to interval spanned by points - * for non-periodic splines T<0 (or T>1) correspond to parts of - the curve before the first (after the last) point - * for periodic splines T<0 (or T>1) are projected into [0,1] - by making T=T-floor(T). - -OUTPUT PARAMETERS: - X - X-value - DX - derivative - D2X - second derivative - Y - Y-value - DY - derivative - D2Y - second derivative - Z - Z-value - DZ - derivative - D2Z - second derivative - - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline3diff2(const pspline3interpolant &p, const double t, double &x, double &dx, double &d2x, double &y, double &dy, double &d2y, double &z, double &dz, double &d2z) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::pspline3diff2(const_cast(p.c_ptr()), t, &x, &dx, &d2x, &y, &dy, &d2y, &z, &dz, &d2z, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function calculates arc length, i.e. length of curve between t=a -and t=b. - -INPUT PARAMETERS: - P - parametric spline interpolant - A,B - parameter values corresponding to arc ends: - * B>A will result in positive length returned - * B(p.c_ptr()), a, b, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function calculates arc length, i.e. length of curve between t=a -and t=b. - -INPUT PARAMETERS: - P - parametric spline interpolant - A,B - parameter values corresponding to arc ends: - * B>A will result in positive length returned - * B(p.c_ptr()), a, b, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -RBF model. - -Never try to directly work with fields of this object - always use ALGLIB -functions to use this object. -*************************************************************************/ -_rbfmodel_owner::_rbfmodel_owner() -{ - p_struct = (alglib_impl::rbfmodel*)alglib_impl::ae_malloc(sizeof(alglib_impl::rbfmodel), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_rbfmodel_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_rbfmodel_owner::_rbfmodel_owner(const _rbfmodel_owner &rhs) -{ - p_struct = (alglib_impl::rbfmodel*)alglib_impl::ae_malloc(sizeof(alglib_impl::rbfmodel), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_rbfmodel_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_rbfmodel_owner& _rbfmodel_owner::operator=(const _rbfmodel_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_rbfmodel_clear(p_struct); - if( !alglib_impl::_rbfmodel_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_rbfmodel_owner::~_rbfmodel_owner() -{ - alglib_impl::_rbfmodel_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::rbfmodel* _rbfmodel_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::rbfmodel* _rbfmodel_owner::c_ptr() const -{ - return const_cast(p_struct); -} -rbfmodel::rbfmodel() : _rbfmodel_owner() -{ -} - -rbfmodel::rbfmodel(const rbfmodel &rhs):_rbfmodel_owner(rhs) -{ -} - -rbfmodel& rbfmodel::operator=(const rbfmodel &rhs) -{ - if( this==&rhs ) - return *this; - _rbfmodel_owner::operator=(rhs); - return *this; -} - -rbfmodel::~rbfmodel() -{ -} - - -/************************************************************************* -RBF solution report: -* TerminationType - termination type, positive values - success, - non-positive - failure. -*************************************************************************/ -_rbfreport_owner::_rbfreport_owner() -{ - p_struct = (alglib_impl::rbfreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::rbfreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_rbfreport_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_rbfreport_owner::_rbfreport_owner(const _rbfreport_owner &rhs) -{ - p_struct = (alglib_impl::rbfreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::rbfreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_rbfreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_rbfreport_owner& _rbfreport_owner::operator=(const _rbfreport_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_rbfreport_clear(p_struct); - if( !alglib_impl::_rbfreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_rbfreport_owner::~_rbfreport_owner() -{ - alglib_impl::_rbfreport_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::rbfreport* _rbfreport_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::rbfreport* _rbfreport_owner::c_ptr() const -{ - return const_cast(p_struct); -} -rbfreport::rbfreport() : _rbfreport_owner() ,arows(p_struct->arows),acols(p_struct->acols),annz(p_struct->annz),iterationscount(p_struct->iterationscount),nmv(p_struct->nmv),terminationtype(p_struct->terminationtype) -{ -} - -rbfreport::rbfreport(const rbfreport &rhs):_rbfreport_owner(rhs) ,arows(p_struct->arows),acols(p_struct->acols),annz(p_struct->annz),iterationscount(p_struct->iterationscount),nmv(p_struct->nmv),terminationtype(p_struct->terminationtype) -{ -} - -rbfreport& rbfreport::operator=(const rbfreport &rhs) -{ - if( this==&rhs ) - return *this; - _rbfreport_owner::operator=(rhs); - return *this; -} - -rbfreport::~rbfreport() -{ -} - - -/************************************************************************* -This function serializes data structure to string. - -Important properties of s_out: -* it contains alphanumeric characters, dots, underscores, minus signs -* these symbols are grouped into words, which are separated by spaces - and Windows-style (CR+LF) newlines -* although serializer uses spaces and CR+LF as separators, you can - replace any separator character by arbitrary combination of spaces, - tabs, Windows or Unix newlines. It allows flexible reformatting of - the string in case you want to include it into text or XML file. - But you should not insert separators into the middle of the "words" - nor you should change case of letters. -* s_out can be freely moved between 32-bit and 64-bit systems, little - and big endian machines, and so on. You can serialize structure on - 32-bit machine and unserialize it on 64-bit one (or vice versa), or - serialize it on SPARC and unserialize on x86. You can also - serialize it in C++ version of ALGLIB and unserialize in C# one, - and vice versa. -*************************************************************************/ -void rbfserialize(rbfmodel &obj, std::string &s_out) -{ - alglib_impl::ae_state state; - alglib_impl::ae_serializer serializer; - alglib_impl::ae_int_t ssize; - - alglib_impl::ae_state_init(&state); - try - { - alglib_impl::ae_serializer_init(&serializer); - alglib_impl::ae_serializer_alloc_start(&serializer); - alglib_impl::rbfalloc(&serializer, obj.c_ptr(), &state); - ssize = alglib_impl::ae_serializer_get_alloc_size(&serializer); - s_out.clear(); - s_out.reserve((size_t)(ssize+1)); - alglib_impl::ae_serializer_sstart_str(&serializer, &s_out); - alglib_impl::rbfserialize(&serializer, obj.c_ptr(), &state); - alglib_impl::ae_serializer_stop(&serializer); - if( s_out.length()>(size_t)ssize ) - throw ap_error("ALGLIB: serialization integrity error"); - alglib_impl::ae_serializer_clear(&serializer); - alglib_impl::ae_state_clear(&state); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(state.error_msg); - } -} -/************************************************************************* -This function unserializes data structure from string. -*************************************************************************/ -void rbfunserialize(std::string &s_in, rbfmodel &obj) -{ - alglib_impl::ae_state state; - alglib_impl::ae_serializer serializer; - - alglib_impl::ae_state_init(&state); - try - { - alglib_impl::ae_serializer_init(&serializer); - alglib_impl::ae_serializer_ustart_str(&serializer, &s_in); - alglib_impl::rbfunserialize(&serializer, obj.c_ptr(), &state); - alglib_impl::ae_serializer_stop(&serializer); - alglib_impl::ae_serializer_clear(&serializer); - alglib_impl::ae_state_clear(&state); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(state.error_msg); - } -} - -/************************************************************************* -This function creates RBF model for a scalar (NY=1) or vector (NY>1) -function in a NX-dimensional space (NX=2 or NX=3). - -Newly created model is empty. It can be used for interpolation right after -creation, but it just returns zeros. You have to add points to the model, -tune interpolation settings, and then call model construction function -RBFBuildModel() which will update model according to your specification. - -USAGE: -1. User creates model with RBFCreate() -2. User adds dataset with RBFSetPoints() (points do NOT have to be on a - regular grid) -3. (OPTIONAL) User chooses polynomial term by calling: - * RBFLinTerm() to set linear term - * RBFConstTerm() to set constant term - * RBFZeroTerm() to set zero term - By default, linear term is used. -4. User chooses specific RBF algorithm to use: either QNN (RBFSetAlgoQNN) - or ML (RBFSetAlgoMultiLayer). -5. User calls RBFBuildModel() function which rebuilds model according to - the specification -6. User may call RBFCalc() to calculate model value at the specified point, - RBFGridCalc() to calculate model values at the points of the regular - grid. User may extract model coefficients with RBFUnpack() call. - -INPUT PARAMETERS: - NX - dimension of the space, NX=2 or NX=3 - NY - function dimension, NY>=1 - -OUTPUT PARAMETERS: - S - RBF model (initially equals to zero) - -NOTE 1: memory requirements. RBF models require amount of memory which is - proportional to the number of data points. Memory is allocated - during model construction, but most of this memory is freed after - model coefficients are calculated. - - Some approximate estimates for N centers with default settings are - given below: - * about 250*N*(sizeof(double)+2*sizeof(int)) bytes of memory is - needed during model construction stage. - * about 15*N*sizeof(double) bytes is needed after model is built. - For example, for N=100000 we may need 0.6 GB of memory to build - model, but just about 0.012 GB to store it. - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfcreate(const ae_int_t nx, const ae_int_t ny, rbfmodel &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rbfcreate(nx, ny, const_cast(s.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function adds dataset. - -This function overrides results of the previous calls, i.e. multiple calls -of this function will result in only the last set being added. - -INPUT PARAMETERS: - S - RBF model, initialized by RBFCreate() call. - XY - points, array[N,NX+NY]. One row corresponds to one point - in the dataset. First NX elements are coordinates, next - NY elements are function values. Array may be larger than - specific, in this case only leading [N,NX+NY] elements - will be used. - N - number of points in the dataset - -After you've added dataset and (optionally) tuned algorithm settings you -should call RBFBuildModel() in order to build a model for you. - -NOTE: this function has some serialization-related subtleties. We - recommend you to study serialization examples from ALGLIB Reference - Manual if you want to perform serialization of your models. - - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfsetpoints(const rbfmodel &s, const real_2d_array &xy, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rbfsetpoints(const_cast(s.c_ptr()), const_cast(xy.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function adds dataset. - -This function overrides results of the previous calls, i.e. multiple calls -of this function will result in only the last set being added. - -INPUT PARAMETERS: - S - RBF model, initialized by RBFCreate() call. - XY - points, array[N,NX+NY]. One row corresponds to one point - in the dataset. First NX elements are coordinates, next - NY elements are function values. Array may be larger than - specific, in this case only leading [N,NX+NY] elements - will be used. - N - number of points in the dataset - -After you've added dataset and (optionally) tuned algorithm settings you -should call RBFBuildModel() in order to build a model for you. - -NOTE: this function has some serialization-related subtleties. We - recommend you to study serialization examples from ALGLIB Reference - Manual if you want to perform serialization of your models. - - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfsetpoints(const rbfmodel &s, const real_2d_array &xy) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = xy.rows(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rbfsetpoints(const_cast(s.c_ptr()), const_cast(xy.c_ptr()), n, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets RBF interpolation algorithm. ALGLIB supports several -RBF algorithms with different properties. - -This algorithm is called RBF-QNN and it is good for point sets with -following properties: -a) all points are distinct -b) all points are well separated. -c) points distribution is approximately uniform. There is no "contour - lines", clusters of points, or other small-scale structures. - -Algorithm description: -1) interpolation centers are allocated to data points -2) interpolation radii are calculated as distances to the nearest centers - times Q coefficient (where Q is a value from [0.75,1.50]). -3) after performing (2) radii are transformed in order to avoid situation - when single outlier has very large radius and influences many points - across all dataset. Transformation has following form: - new_r[i] = min(r[i],Z*median(r[])) - where r[i] is I-th radius, median() is a median radius across entire - dataset, Z is user-specified value which controls amount of deviation - from median radius. - -When (a) is violated, we will be unable to build RBF model. When (b) or -(c) are violated, model will be built, but interpolation quality will be -low. See http://www.alglib.net/interpolation/ for more information on this -subject. - -This algorithm is used by default. - -Additional Q parameter controls smoothness properties of the RBF basis: -* Q<0.75 will give perfectly conditioned basis, but terrible smoothness - properties (RBF interpolant will have sharp peaks around function values) -* Q around 1.0 gives good balance between smoothness and condition number -* Q>1.5 will lead to badly conditioned systems and slow convergence of the - underlying linear solver (although smoothness will be very good) -* Q>2.0 will effectively make optimizer useless because it won't converge - within reasonable amount of iterations. It is possible to set such large - Q, but it is advised not to do so. - -INPUT PARAMETERS: - S - RBF model, initialized by RBFCreate() call - Q - Q parameter, Q>0, recommended value - 1.0 - Z - Z parameter, Z>0, recommended value - 5.0 - -NOTE: this function has some serialization-related subtleties. We - recommend you to study serialization examples from ALGLIB Reference - Manual if you want to perform serialization of your models. - - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfsetalgoqnn(const rbfmodel &s, const double q, const double z) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rbfsetalgoqnn(const_cast(s.c_ptr()), q, z, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets RBF interpolation algorithm. ALGLIB supports several -RBF algorithms with different properties. - -This algorithm is called RBF-QNN and it is good for point sets with -following properties: -a) all points are distinct -b) all points are well separated. -c) points distribution is approximately uniform. There is no "contour - lines", clusters of points, or other small-scale structures. - -Algorithm description: -1) interpolation centers are allocated to data points -2) interpolation radii are calculated as distances to the nearest centers - times Q coefficient (where Q is a value from [0.75,1.50]). -3) after performing (2) radii are transformed in order to avoid situation - when single outlier has very large radius and influences many points - across all dataset. Transformation has following form: - new_r[i] = min(r[i],Z*median(r[])) - where r[i] is I-th radius, median() is a median radius across entire - dataset, Z is user-specified value which controls amount of deviation - from median radius. - -When (a) is violated, we will be unable to build RBF model. When (b) or -(c) are violated, model will be built, but interpolation quality will be -low. See http://www.alglib.net/interpolation/ for more information on this -subject. - -This algorithm is used by default. - -Additional Q parameter controls smoothness properties of the RBF basis: -* Q<0.75 will give perfectly conditioned basis, but terrible smoothness - properties (RBF interpolant will have sharp peaks around function values) -* Q around 1.0 gives good balance between smoothness and condition number -* Q>1.5 will lead to badly conditioned systems and slow convergence of the - underlying linear solver (although smoothness will be very good) -* Q>2.0 will effectively make optimizer useless because it won't converge - within reasonable amount of iterations. It is possible to set such large - Q, but it is advised not to do so. - -INPUT PARAMETERS: - S - RBF model, initialized by RBFCreate() call - Q - Q parameter, Q>0, recommended value - 1.0 - Z - Z parameter, Z>0, recommended value - 5.0 - -NOTE: this function has some serialization-related subtleties. We - recommend you to study serialization examples from ALGLIB Reference - Manual if you want to perform serialization of your models. - - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfsetalgoqnn(const rbfmodel &s) -{ - alglib_impl::ae_state _alglib_env_state; - double q; - double z; - - q = 1.0; - z = 5.0; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rbfsetalgoqnn(const_cast(s.c_ptr()), q, z, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets RBF interpolation algorithm. ALGLIB supports several -RBF algorithms with different properties. - -This algorithm is called RBF-ML. It builds multilayer RBF model, i.e. -model with subsequently decreasing radii, which allows us to combine -smoothness (due to large radii of the first layers) with exactness (due -to small radii of the last layers) and fast convergence. - -Internally RBF-ML uses many different means of acceleration, from sparse -matrices to KD-trees, which results in algorithm whose working time is -roughly proportional to N*log(N)*Density*RBase^2*NLayers, where N is a -number of points, Density is an average density if points per unit of the -interpolation space, RBase is an initial radius, NLayers is a number of -layers. - -RBF-ML is good for following kinds of interpolation problems: -1. "exact" problems (perfect fit) with well separated points -2. least squares problems with arbitrary distribution of points (algorithm - gives perfect fit where it is possible, and resorts to least squares - fit in the hard areas). -3. noisy problems where we want to apply some controlled amount of - smoothing. - -INPUT PARAMETERS: - S - RBF model, initialized by RBFCreate() call - RBase - RBase parameter, RBase>0 - NLayers - NLayers parameter, NLayers>0, recommended value to start - with - about 5. - LambdaV - regularization value, can be useful when solving problem - in the least squares sense. Optimal lambda is problem- - dependent and require trial and error. In our experience, - good lambda can be as large as 0.1, and you can use 0.001 - as initial guess. - Default value - 0.01, which is used when LambdaV is not - given. You can specify zero value, but it is not - recommended to do so. - -TUNING ALGORITHM - -In order to use this algorithm you have to choose three parameters: -* initial radius RBase -* number of layers in the model NLayers -* regularization coefficient LambdaV - -Initial radius is easy to choose - you can pick any number several times -larger than the average distance between points. Algorithm won't break -down if you choose radius which is too large (model construction time will -increase, but model will be built correctly). - -Choose such number of layers that RLast=RBase/2^(NLayers-1) (radius used -by the last layer) will be smaller than the typical distance between -points. In case model error is too large, you can increase number of -layers. Having more layers will make model construction and evaluation -proportionally slower, but it will allow you to have model which precisely -fits your data. From the other side, if you want to suppress noise, you -can DECREASE number of layers to make your model less flexible. - -Regularization coefficient LambdaV controls smoothness of the individual -models built for each layer. We recommend you to use default value in case -you don't want to tune this parameter, because having non-zero LambdaV -accelerates and stabilizes internal iterative algorithm. In case you want -to suppress noise you can use LambdaV as additional parameter (larger -value = more smoothness) to tune. - -TYPICAL ERRORS - -1. Using initial radius which is too large. Memory requirements of the - RBF-ML are roughly proportional to N*Density*RBase^2 (where Density is - an average density of points per unit of the interpolation space). In - the extreme case of the very large RBase we will need O(N^2) units of - memory - and many layers in order to decrease radius to some reasonably - small value. - -2. Using too small number of layers - RBF models with large radius are not - flexible enough to reproduce small variations in the target function. - You need many layers with different radii, from large to small, in - order to have good model. - -3. Using initial radius which is too small. You will get model with - "holes" in the areas which are too far away from interpolation centers. - However, algorithm will work correctly (and quickly) in this case. - -4. Using too many layers - you will get too large and too slow model. This - model will perfectly reproduce your function, but maybe you will be - able to achieve similar results with less layers (and less memory). - - -- ALGLIB -- - Copyright 02.03.2012 by Bochkanov Sergey -*************************************************************************/ -void rbfsetalgomultilayer(const rbfmodel &s, const double rbase, const ae_int_t nlayers, const double lambdav) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rbfsetalgomultilayer(const_cast(s.c_ptr()), rbase, nlayers, lambdav, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets RBF interpolation algorithm. ALGLIB supports several -RBF algorithms with different properties. - -This algorithm is called RBF-ML. It builds multilayer RBF model, i.e. -model with subsequently decreasing radii, which allows us to combine -smoothness (due to large radii of the first layers) with exactness (due -to small radii of the last layers) and fast convergence. - -Internally RBF-ML uses many different means of acceleration, from sparse -matrices to KD-trees, which results in algorithm whose working time is -roughly proportional to N*log(N)*Density*RBase^2*NLayers, where N is a -number of points, Density is an average density if points per unit of the -interpolation space, RBase is an initial radius, NLayers is a number of -layers. - -RBF-ML is good for following kinds of interpolation problems: -1. "exact" problems (perfect fit) with well separated points -2. least squares problems with arbitrary distribution of points (algorithm - gives perfect fit where it is possible, and resorts to least squares - fit in the hard areas). -3. noisy problems where we want to apply some controlled amount of - smoothing. - -INPUT PARAMETERS: - S - RBF model, initialized by RBFCreate() call - RBase - RBase parameter, RBase>0 - NLayers - NLayers parameter, NLayers>0, recommended value to start - with - about 5. - LambdaV - regularization value, can be useful when solving problem - in the least squares sense. Optimal lambda is problem- - dependent and require trial and error. In our experience, - good lambda can be as large as 0.1, and you can use 0.001 - as initial guess. - Default value - 0.01, which is used when LambdaV is not - given. You can specify zero value, but it is not - recommended to do so. - -TUNING ALGORITHM - -In order to use this algorithm you have to choose three parameters: -* initial radius RBase -* number of layers in the model NLayers -* regularization coefficient LambdaV - -Initial radius is easy to choose - you can pick any number several times -larger than the average distance between points. Algorithm won't break -down if you choose radius which is too large (model construction time will -increase, but model will be built correctly). - -Choose such number of layers that RLast=RBase/2^(NLayers-1) (radius used -by the last layer) will be smaller than the typical distance between -points. In case model error is too large, you can increase number of -layers. Having more layers will make model construction and evaluation -proportionally slower, but it will allow you to have model which precisely -fits your data. From the other side, if you want to suppress noise, you -can DECREASE number of layers to make your model less flexible. - -Regularization coefficient LambdaV controls smoothness of the individual -models built for each layer. We recommend you to use default value in case -you don't want to tune this parameter, because having non-zero LambdaV -accelerates and stabilizes internal iterative algorithm. In case you want -to suppress noise you can use LambdaV as additional parameter (larger -value = more smoothness) to tune. - -TYPICAL ERRORS - -1. Using initial radius which is too large. Memory requirements of the - RBF-ML are roughly proportional to N*Density*RBase^2 (where Density is - an average density of points per unit of the interpolation space). In - the extreme case of the very large RBase we will need O(N^2) units of - memory - and many layers in order to decrease radius to some reasonably - small value. - -2. Using too small number of layers - RBF models with large radius are not - flexible enough to reproduce small variations in the target function. - You need many layers with different radii, from large to small, in - order to have good model. - -3. Using initial radius which is too small. You will get model with - "holes" in the areas which are too far away from interpolation centers. - However, algorithm will work correctly (and quickly) in this case. - -4. Using too many layers - you will get too large and too slow model. This - model will perfectly reproduce your function, but maybe you will be - able to achieve similar results with less layers (and less memory). - - -- ALGLIB -- - Copyright 02.03.2012 by Bochkanov Sergey -*************************************************************************/ -void rbfsetalgomultilayer(const rbfmodel &s, const double rbase, const ae_int_t nlayers) -{ - alglib_impl::ae_state _alglib_env_state; - double lambdav; - - lambdav = 0.01; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rbfsetalgomultilayer(const_cast(s.c_ptr()), rbase, nlayers, lambdav, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets linear term (model is a sum of radial basis functions -plus linear polynomial). This function won't have effect until next call -to RBFBuildModel(). - -INPUT PARAMETERS: - S - RBF model, initialized by RBFCreate() call - -NOTE: this function has some serialization-related subtleties. We - recommend you to study serialization examples from ALGLIB Reference - Manual if you want to perform serialization of your models. - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfsetlinterm(const rbfmodel &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rbfsetlinterm(const_cast(s.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets constant term (model is a sum of radial basis functions -plus constant). This function won't have effect until next call to -RBFBuildModel(). - -INPUT PARAMETERS: - S - RBF model, initialized by RBFCreate() call - -NOTE: this function has some serialization-related subtleties. We - recommend you to study serialization examples from ALGLIB Reference - Manual if you want to perform serialization of your models. - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfsetconstterm(const rbfmodel &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rbfsetconstterm(const_cast(s.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets zero term (model is a sum of radial basis functions -without polynomial term). This function won't have effect until next call -to RBFBuildModel(). - -INPUT PARAMETERS: - S - RBF model, initialized by RBFCreate() call - -NOTE: this function has some serialization-related subtleties. We - recommend you to study serialization examples from ALGLIB Reference - Manual if you want to perform serialization of your models. - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfsetzeroterm(const rbfmodel &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rbfsetzeroterm(const_cast(s.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function builds RBF model and returns report (contains some -information which can be used for evaluation of the algorithm properties). - -Call to this function modifies RBF model by calculating its centers/radii/ -weights and saving them into RBFModel structure. Initially RBFModel -contain zero coefficients, but after call to this function we will have -coefficients which were calculated in order to fit our dataset. - -After you called this function you can call RBFCalc(), RBFGridCalc() and -other model calculation functions. - -INPUT PARAMETERS: - S - RBF model, initialized by RBFCreate() call - Rep - report: - * Rep.TerminationType: - * -5 - non-distinct basis function centers were detected, - interpolation aborted - * -4 - nonconvergence of the internal SVD solver - * 1 - successful termination - Fields are used for debugging purposes: - * Rep.IterationsCount - iterations count of the LSQR solver - * Rep.NMV - number of matrix-vector products - * Rep.ARows - rows count for the system matrix - * Rep.ACols - columns count for the system matrix - * Rep.ANNZ - number of significantly non-zero elements - (elements above some algorithm-determined threshold) - -NOTE: failure to build model will leave current state of the structure -unchanged. - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfbuildmodel(const rbfmodel &s, rbfreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rbfbuildmodel(const_cast(s.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function calculates values of the RBF model in the given point. - -This function should be used when we have NY=1 (scalar function) and NX=2 -(2-dimensional space). If you have 3-dimensional space, use RBFCalc3(). If -you have general situation (NX-dimensional space, NY-dimensional function) -you should use general, less efficient implementation RBFCalc(). - -If you want to calculate function values many times, consider using -RBFGridCalc2(), which is far more efficient than many subsequent calls to -RBFCalc2(). - -This function returns 0.0 when: -* model is not initialized -* NX<>2 - *NY<>1 - -INPUT PARAMETERS: - S - RBF model - X0 - first coordinate, finite number - X1 - second coordinate, finite number - -RESULT: - value of the model or 0.0 (as defined above) - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -double rbfcalc2(const rbfmodel &s, const double x0, const double x1) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::rbfcalc2(const_cast(s.c_ptr()), x0, x1, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function calculates values of the RBF model in the given point. - -This function should be used when we have NY=1 (scalar function) and NX=3 -(3-dimensional space). If you have 2-dimensional space, use RBFCalc2(). If -you have general situation (NX-dimensional space, NY-dimensional function) -you should use general, less efficient implementation RBFCalc(). - -This function returns 0.0 when: -* model is not initialized -* NX<>3 - *NY<>1 - -INPUT PARAMETERS: - S - RBF model - X0 - first coordinate, finite number - X1 - second coordinate, finite number - X2 - third coordinate, finite number - -RESULT: - value of the model or 0.0 (as defined above) - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -double rbfcalc3(const rbfmodel &s, const double x0, const double x1, const double x2) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::rbfcalc3(const_cast(s.c_ptr()), x0, x1, x2, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function calculates values of the RBF model at the given point. - -This is general function which can be used for arbitrary NX (dimension of -the space of arguments) and NY (dimension of the function itself). However -when you have NY=1 you may find more convenient to use RBFCalc2() or -RBFCalc3(). - -This function returns 0.0 when model is not initialized. - -INPUT PARAMETERS: - S - RBF model - X - coordinates, array[NX]. - X may have more than NX elements, in this case only - leading NX will be used. - -OUTPUT PARAMETERS: - Y - function value, array[NY]. Y is out-parameter and - reallocated after call to this function. In case you want - to reuse previously allocated Y, you may use RBFCalcBuf(), - which reallocates Y only when it is too small. - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfcalc(const rbfmodel &s, const real_1d_array &x, real_1d_array &y) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rbfcalc(const_cast(s.c_ptr()), const_cast(x.c_ptr()), const_cast(y.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function calculates values of the RBF model at the given point. - -Same as RBFCalc(), but does not reallocate Y when in is large enough to -store function values. - -INPUT PARAMETERS: - S - RBF model - X - coordinates, array[NX]. - X may have more than NX elements, in this case only - leading NX will be used. - Y - possibly preallocated array - -OUTPUT PARAMETERS: - Y - function value, array[NY]. Y is not reallocated when it - is larger than NY. - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfcalcbuf(const rbfmodel &s, const real_1d_array &x, real_1d_array &y) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rbfcalcbuf(const_cast(s.c_ptr()), const_cast(x.c_ptr()), const_cast(y.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function calculates values of the RBF model at the regular grid. - -Grid have N0*N1 points, with Point[I,J] = (X0[I], X1[J]) - -This function returns 0.0 when: -* model is not initialized -* NX<>2 - *NY<>1 - -INPUT PARAMETERS: - S - RBF model - X0 - array of grid nodes, first coordinates, array[N0] - N0 - grid size (number of nodes) in the first dimension - X1 - array of grid nodes, second coordinates, array[N1] - N1 - grid size (number of nodes) in the second dimension - -OUTPUT PARAMETERS: - Y - function values, array[N0,N1]. Y is out-variable and - is reallocated by this function. - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfgridcalc2(const rbfmodel &s, const real_1d_array &x0, const ae_int_t n0, const real_1d_array &x1, const ae_int_t n1, real_2d_array &y) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rbfgridcalc2(const_cast(s.c_ptr()), const_cast(x0.c_ptr()), n0, const_cast(x1.c_ptr()), n1, const_cast(y.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function "unpacks" RBF model by extracting its coefficients. - -INPUT PARAMETERS: - S - RBF model - -OUTPUT PARAMETERS: - NX - dimensionality of argument - NY - dimensionality of the target function - XWR - model information, array[NC,NX+NY+1]. - One row of the array corresponds to one basis function: - * first NX columns - coordinates of the center - * next NY columns - weights, one per dimension of the - function being modelled - * last column - radius, same for all dimensions of - the function being modelled - NC - number of the centers - V - polynomial term , array[NY,NX+1]. One row per one - dimension of the function being modelled. First NX - elements are linear coefficients, V[NX] is equal to the - constant part. - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfunpack(const rbfmodel &s, ae_int_t &nx, ae_int_t &ny, real_2d_array &xwr, ae_int_t &nc, real_2d_array &v) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rbfunpack(const_cast(s.c_ptr()), &nx, &ny, const_cast(xwr.c_ptr()), &nc, const_cast(v.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -2-dimensional spline inteprolant -*************************************************************************/ -_spline2dinterpolant_owner::_spline2dinterpolant_owner() -{ - p_struct = (alglib_impl::spline2dinterpolant*)alglib_impl::ae_malloc(sizeof(alglib_impl::spline2dinterpolant), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_spline2dinterpolant_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_spline2dinterpolant_owner::_spline2dinterpolant_owner(const _spline2dinterpolant_owner &rhs) -{ - p_struct = (alglib_impl::spline2dinterpolant*)alglib_impl::ae_malloc(sizeof(alglib_impl::spline2dinterpolant), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_spline2dinterpolant_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_spline2dinterpolant_owner& _spline2dinterpolant_owner::operator=(const _spline2dinterpolant_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_spline2dinterpolant_clear(p_struct); - if( !alglib_impl::_spline2dinterpolant_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_spline2dinterpolant_owner::~_spline2dinterpolant_owner() -{ - alglib_impl::_spline2dinterpolant_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::spline2dinterpolant* _spline2dinterpolant_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::spline2dinterpolant* _spline2dinterpolant_owner::c_ptr() const -{ - return const_cast(p_struct); -} -spline2dinterpolant::spline2dinterpolant() : _spline2dinterpolant_owner() -{ -} - -spline2dinterpolant::spline2dinterpolant(const spline2dinterpolant &rhs):_spline2dinterpolant_owner(rhs) -{ -} - -spline2dinterpolant& spline2dinterpolant::operator=(const spline2dinterpolant &rhs) -{ - if( this==&rhs ) - return *this; - _spline2dinterpolant_owner::operator=(rhs); - return *this; -} - -spline2dinterpolant::~spline2dinterpolant() -{ -} - -/************************************************************************* -This subroutine calculates the value of the bilinear or bicubic spline at -the given point X. - -Input parameters: - C - coefficients table. - Built by BuildBilinearSpline or BuildBicubicSpline. - X, Y- point - -Result: - S(x,y) - - -- ALGLIB PROJECT -- - Copyright 05.07.2007 by Bochkanov Sergey -*************************************************************************/ -double spline2dcalc(const spline2dinterpolant &c, const double x, const double y) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::spline2dcalc(const_cast(c.c_ptr()), x, y, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine calculates the value of the bilinear or bicubic spline at -the given point X and its derivatives. - -Input parameters: - C - spline interpolant. - X, Y- point - -Output parameters: - F - S(x,y) - FX - dS(x,y)/dX - FY - dS(x,y)/dY - FXY - d2S(x,y)/dXdY - - -- ALGLIB PROJECT -- - Copyright 05.07.2007 by Bochkanov Sergey -*************************************************************************/ -void spline2ddiff(const spline2dinterpolant &c, const double x, const double y, double &f, double &fx, double &fy, double &fxy) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline2ddiff(const_cast(c.c_ptr()), x, y, &f, &fx, &fy, &fxy, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine performs linear transformation of the spline argument. - -Input parameters: - C - spline interpolant - AX, BX - transformation coefficients: x = A*t + B - AY, BY - transformation coefficients: y = A*u + B -Result: - C - transformed spline - - -- ALGLIB PROJECT -- - Copyright 30.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline2dlintransxy(const spline2dinterpolant &c, const double ax, const double bx, const double ay, const double by) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline2dlintransxy(const_cast(c.c_ptr()), ax, bx, ay, by, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine performs linear transformation of the spline. - -Input parameters: - C - spline interpolant. - A, B- transformation coefficients: S2(x,y) = A*S(x,y) + B - -Output parameters: - C - transformed spline - - -- ALGLIB PROJECT -- - Copyright 30.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline2dlintransf(const spline2dinterpolant &c, const double a, const double b) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline2dlintransf(const_cast(c.c_ptr()), a, b, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine makes the copy of the spline model. - -Input parameters: - C - spline interpolant - -Output parameters: - CC - spline copy - - -- ALGLIB PROJECT -- - Copyright 29.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline2dcopy(const spline2dinterpolant &c, spline2dinterpolant &cc) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline2dcopy(const_cast(c.c_ptr()), const_cast(cc.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Bicubic spline resampling - -Input parameters: - A - function values at the old grid, - array[0..OldHeight-1, 0..OldWidth-1] - OldHeight - old grid height, OldHeight>1 - OldWidth - old grid width, OldWidth>1 - NewHeight - new grid height, NewHeight>1 - NewWidth - new grid width, NewWidth>1 - -Output parameters: - B - function values at the new grid, - array[0..NewHeight-1, 0..NewWidth-1] - - -- ALGLIB routine -- - 15 May, 2007 - Copyright by Bochkanov Sergey -*************************************************************************/ -void spline2dresamplebicubic(const real_2d_array &a, const ae_int_t oldheight, const ae_int_t oldwidth, real_2d_array &b, const ae_int_t newheight, const ae_int_t newwidth) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline2dresamplebicubic(const_cast(a.c_ptr()), oldheight, oldwidth, const_cast(b.c_ptr()), newheight, newwidth, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Bilinear spline resampling - -Input parameters: - A - function values at the old grid, - array[0..OldHeight-1, 0..OldWidth-1] - OldHeight - old grid height, OldHeight>1 - OldWidth - old grid width, OldWidth>1 - NewHeight - new grid height, NewHeight>1 - NewWidth - new grid width, NewWidth>1 - -Output parameters: - B - function values at the new grid, - array[0..NewHeight-1, 0..NewWidth-1] - - -- ALGLIB routine -- - 09.07.2007 - Copyright by Bochkanov Sergey -*************************************************************************/ -void spline2dresamplebilinear(const real_2d_array &a, const ae_int_t oldheight, const ae_int_t oldwidth, real_2d_array &b, const ae_int_t newheight, const ae_int_t newwidth) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline2dresamplebilinear(const_cast(a.c_ptr()), oldheight, oldwidth, const_cast(b.c_ptr()), newheight, newwidth, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine builds bilinear vector-valued spline. - -Input parameters: - X - spline abscissas, array[0..N-1] - Y - spline ordinates, array[0..M-1] - F - function values, array[0..M*N*D-1]: - * first D elements store D values at (X[0],Y[0]) - * next D elements store D values at (X[1],Y[0]) - * general form - D function values at (X[i],Y[j]) are stored - at F[D*(J*N+I)...D*(J*N+I)+D-1]. - M,N - grid size, M>=2, N>=2 - D - vector dimension, D>=1 - -Output parameters: - C - spline interpolant - - -- ALGLIB PROJECT -- - Copyright 16.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline2dbuildbilinearv(const real_1d_array &x, const ae_int_t n, const real_1d_array &y, const ae_int_t m, const real_1d_array &f, const ae_int_t d, spline2dinterpolant &c) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline2dbuildbilinearv(const_cast(x.c_ptr()), n, const_cast(y.c_ptr()), m, const_cast(f.c_ptr()), d, const_cast(c.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine builds bicubic vector-valued spline. - -Input parameters: - X - spline abscissas, array[0..N-1] - Y - spline ordinates, array[0..M-1] - F - function values, array[0..M*N*D-1]: - * first D elements store D values at (X[0],Y[0]) - * next D elements store D values at (X[1],Y[0]) - * general form - D function values at (X[i],Y[j]) are stored - at F[D*(J*N+I)...D*(J*N+I)+D-1]. - M,N - grid size, M>=2, N>=2 - D - vector dimension, D>=1 - -Output parameters: - C - spline interpolant - - -- ALGLIB PROJECT -- - Copyright 16.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline2dbuildbicubicv(const real_1d_array &x, const ae_int_t n, const real_1d_array &y, const ae_int_t m, const real_1d_array &f, const ae_int_t d, spline2dinterpolant &c) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline2dbuildbicubicv(const_cast(x.c_ptr()), n, const_cast(y.c_ptr()), m, const_cast(f.c_ptr()), d, const_cast(c.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine calculates bilinear or bicubic vector-valued spline at the -given point (X,Y). - -INPUT PARAMETERS: - C - spline interpolant. - X, Y- point - F - output buffer, possibly preallocated array. In case array size - is large enough to store result, it is not reallocated. Array - which is too short will be reallocated - -OUTPUT PARAMETERS: - F - array[D] (or larger) which stores function values - - -- ALGLIB PROJECT -- - Copyright 16.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline2dcalcvbuf(const spline2dinterpolant &c, const double x, const double y, real_1d_array &f) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline2dcalcvbuf(const_cast(c.c_ptr()), x, y, const_cast(f.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine calculates bilinear or bicubic vector-valued spline at the -given point (X,Y). - -INPUT PARAMETERS: - C - spline interpolant. - X, Y- point - -OUTPUT PARAMETERS: - F - array[D] which stores function values. F is out-parameter and - it is reallocated after call to this function. In case you - want to reuse previously allocated F, you may use - Spline2DCalcVBuf(), which reallocates F only when it is too - small. - - -- ALGLIB PROJECT -- - Copyright 16.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline2dcalcv(const spline2dinterpolant &c, const double x, const double y, real_1d_array &f) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline2dcalcv(const_cast(c.c_ptr()), x, y, const_cast(f.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine unpacks two-dimensional spline into the coefficients table - -Input parameters: - C - spline interpolant. - -Result: - M, N- grid size (x-axis and y-axis) - D - number of components - Tbl - coefficients table, unpacked format, - D - components: [0..(N-1)*(M-1)*D-1, 0..19]. - For T=0..D-1 (component index), I = 0...N-2 (x index), - J=0..M-2 (y index): - K := T + I*D + J*D*(N-1) - - K-th row stores decomposition for T-th component of the - vector-valued function - - Tbl[K,0] = X[i] - Tbl[K,1] = X[i+1] - Tbl[K,2] = Y[j] - Tbl[K,3] = Y[j+1] - Tbl[K,4] = C00 - Tbl[K,5] = C01 - Tbl[K,6] = C02 - Tbl[K,7] = C03 - Tbl[K,8] = C10 - Tbl[K,9] = C11 - ... - Tbl[K,19] = C33 - On each grid square spline is equals to: - S(x) = SUM(c[i,j]*(t^i)*(u^j), i=0..3, j=0..3) - t = x-x[j] - u = y-y[i] - - -- ALGLIB PROJECT -- - Copyright 16.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline2dunpackv(const spline2dinterpolant &c, ae_int_t &m, ae_int_t &n, ae_int_t &d, real_2d_array &tbl) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline2dunpackv(const_cast(c.c_ptr()), &m, &n, &d, const_cast(tbl.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine was deprecated in ALGLIB 3.6.0 - -We recommend you to switch to Spline2DBuildBilinearV(), which is more -flexible and accepts its arguments in more convenient order. - - -- ALGLIB PROJECT -- - Copyright 05.07.2007 by Bochkanov Sergey -*************************************************************************/ -void spline2dbuildbilinear(const real_1d_array &x, const real_1d_array &y, const real_2d_array &f, const ae_int_t m, const ae_int_t n, spline2dinterpolant &c) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline2dbuildbilinear(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(f.c_ptr()), m, n, const_cast(c.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine was deprecated in ALGLIB 3.6.0 - -We recommend you to switch to Spline2DBuildBicubicV(), which is more -flexible and accepts its arguments in more convenient order. - - -- ALGLIB PROJECT -- - Copyright 05.07.2007 by Bochkanov Sergey -*************************************************************************/ -void spline2dbuildbicubic(const real_1d_array &x, const real_1d_array &y, const real_2d_array &f, const ae_int_t m, const ae_int_t n, spline2dinterpolant &c) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline2dbuildbicubic(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(f.c_ptr()), m, n, const_cast(c.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine was deprecated in ALGLIB 3.6.0 - -We recommend you to switch to Spline2DUnpackV(), which is more flexible -and accepts its arguments in more convenient order. - - -- ALGLIB PROJECT -- - Copyright 29.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline2dunpack(const spline2dinterpolant &c, ae_int_t &m, ae_int_t &n, real_2d_array &tbl) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline2dunpack(const_cast(c.c_ptr()), &m, &n, const_cast(tbl.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -3-dimensional spline inteprolant -*************************************************************************/ -_spline3dinterpolant_owner::_spline3dinterpolant_owner() -{ - p_struct = (alglib_impl::spline3dinterpolant*)alglib_impl::ae_malloc(sizeof(alglib_impl::spline3dinterpolant), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_spline3dinterpolant_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_spline3dinterpolant_owner::_spline3dinterpolant_owner(const _spline3dinterpolant_owner &rhs) -{ - p_struct = (alglib_impl::spline3dinterpolant*)alglib_impl::ae_malloc(sizeof(alglib_impl::spline3dinterpolant), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_spline3dinterpolant_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_spline3dinterpolant_owner& _spline3dinterpolant_owner::operator=(const _spline3dinterpolant_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_spline3dinterpolant_clear(p_struct); - if( !alglib_impl::_spline3dinterpolant_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_spline3dinterpolant_owner::~_spline3dinterpolant_owner() -{ - alglib_impl::_spline3dinterpolant_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::spline3dinterpolant* _spline3dinterpolant_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::spline3dinterpolant* _spline3dinterpolant_owner::c_ptr() const -{ - return const_cast(p_struct); -} -spline3dinterpolant::spline3dinterpolant() : _spline3dinterpolant_owner() -{ -} - -spline3dinterpolant::spline3dinterpolant(const spline3dinterpolant &rhs):_spline3dinterpolant_owner(rhs) -{ -} - -spline3dinterpolant& spline3dinterpolant::operator=(const spline3dinterpolant &rhs) -{ - if( this==&rhs ) - return *this; - _spline3dinterpolant_owner::operator=(rhs); - return *this; -} - -spline3dinterpolant::~spline3dinterpolant() -{ -} - -/************************************************************************* -This subroutine calculates the value of the trilinear or tricubic spline at -the given point (X,Y,Z). - -INPUT PARAMETERS: - C - coefficients table. - Built by BuildBilinearSpline or BuildBicubicSpline. - X, Y, - Z - point - -Result: - S(x,y,z) - - -- ALGLIB PROJECT -- - Copyright 26.04.2012 by Bochkanov Sergey -*************************************************************************/ -double spline3dcalc(const spline3dinterpolant &c, const double x, const double y, const double z) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::spline3dcalc(const_cast(c.c_ptr()), x, y, z, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine performs linear transformation of the spline argument. - -INPUT PARAMETERS: - C - spline interpolant - AX, BX - transformation coefficients: x = A*u + B - AY, BY - transformation coefficients: y = A*v + B - AZ, BZ - transformation coefficients: z = A*w + B - -OUTPUT PARAMETERS: - C - transformed spline - - -- ALGLIB PROJECT -- - Copyright 26.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline3dlintransxyz(const spline3dinterpolant &c, const double ax, const double bx, const double ay, const double by, const double az, const double bz) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline3dlintransxyz(const_cast(c.c_ptr()), ax, bx, ay, by, az, bz, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine performs linear transformation of the spline. - -INPUT PARAMETERS: - C - spline interpolant. - A, B- transformation coefficients: S2(x,y) = A*S(x,y,z) + B - -OUTPUT PARAMETERS: - C - transformed spline - - -- ALGLIB PROJECT -- - Copyright 26.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline3dlintransf(const spline3dinterpolant &c, const double a, const double b) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline3dlintransf(const_cast(c.c_ptr()), a, b, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Trilinear spline resampling - -INPUT PARAMETERS: - A - array[0..OldXCount*OldYCount*OldZCount-1], function - values at the old grid, : - A[0] x=0,y=0,z=0 - A[1] x=1,y=0,z=0 - A[..] ... - A[..] x=oldxcount-1,y=0,z=0 - A[..] x=0,y=1,z=0 - A[..] ... - ... - OldZCount - old Z-count, OldZCount>1 - OldYCount - old Y-count, OldYCount>1 - OldXCount - old X-count, OldXCount>1 - NewZCount - new Z-count, NewZCount>1 - NewYCount - new Y-count, NewYCount>1 - NewXCount - new X-count, NewXCount>1 - -OUTPUT PARAMETERS: - B - array[0..NewXCount*NewYCount*NewZCount-1], function - values at the new grid: - B[0] x=0,y=0,z=0 - B[1] x=1,y=0,z=0 - B[..] ... - B[..] x=newxcount-1,y=0,z=0 - B[..] x=0,y=1,z=0 - B[..] ... - ... - - -- ALGLIB routine -- - 26.04.2012 - Copyright by Bochkanov Sergey -*************************************************************************/ -void spline3dresampletrilinear(const real_1d_array &a, const ae_int_t oldzcount, const ae_int_t oldycount, const ae_int_t oldxcount, const ae_int_t newzcount, const ae_int_t newycount, const ae_int_t newxcount, real_1d_array &b) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline3dresampletrilinear(const_cast(a.c_ptr()), oldzcount, oldycount, oldxcount, newzcount, newycount, newxcount, const_cast(b.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine builds trilinear vector-valued spline. - -INPUT PARAMETERS: - X - spline abscissas, array[0..N-1] - Y - spline ordinates, array[0..M-1] - Z - spline applicates, array[0..L-1] - F - function values, array[0..M*N*L*D-1]: - * first D elements store D values at (X[0],Y[0],Z[0]) - * next D elements store D values at (X[1],Y[0],Z[0]) - * next D elements store D values at (X[2],Y[0],Z[0]) - * ... - * next D elements store D values at (X[0],Y[1],Z[0]) - * next D elements store D values at (X[1],Y[1],Z[0]) - * next D elements store D values at (X[2],Y[1],Z[0]) - * ... - * next D elements store D values at (X[0],Y[0],Z[1]) - * next D elements store D values at (X[1],Y[0],Z[1]) - * next D elements store D values at (X[2],Y[0],Z[1]) - * ... - * general form - D function values at (X[i],Y[j]) are stored - at F[D*(N*(M*K+J)+I)...D*(N*(M*K+J)+I)+D-1]. - M,N, - L - grid size, M>=2, N>=2, L>=2 - D - vector dimension, D>=1 - -OUTPUT PARAMETERS: - C - spline interpolant - - -- ALGLIB PROJECT -- - Copyright 26.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline3dbuildtrilinearv(const real_1d_array &x, const ae_int_t n, const real_1d_array &y, const ae_int_t m, const real_1d_array &z, const ae_int_t l, const real_1d_array &f, const ae_int_t d, spline3dinterpolant &c) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline3dbuildtrilinearv(const_cast(x.c_ptr()), n, const_cast(y.c_ptr()), m, const_cast(z.c_ptr()), l, const_cast(f.c_ptr()), d, const_cast(c.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine calculates bilinear or bicubic vector-valued spline at the -given point (X,Y,Z). - -INPUT PARAMETERS: - C - spline interpolant. - X, Y, - Z - point - F - output buffer, possibly preallocated array. In case array size - is large enough to store result, it is not reallocated. Array - which is too short will be reallocated - -OUTPUT PARAMETERS: - F - array[D] (or larger) which stores function values - - -- ALGLIB PROJECT -- - Copyright 26.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline3dcalcvbuf(const spline3dinterpolant &c, const double x, const double y, const double z, real_1d_array &f) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline3dcalcvbuf(const_cast(c.c_ptr()), x, y, z, const_cast(f.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine calculates trilinear or tricubic vector-valued spline at the -given point (X,Y,Z). - -INPUT PARAMETERS: - C - spline interpolant. - X, Y, - Z - point - -OUTPUT PARAMETERS: - F - array[D] which stores function values. F is out-parameter and - it is reallocated after call to this function. In case you - want to reuse previously allocated F, you may use - Spline2DCalcVBuf(), which reallocates F only when it is too - small. - - -- ALGLIB PROJECT -- - Copyright 26.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline3dcalcv(const spline3dinterpolant &c, const double x, const double y, const double z, real_1d_array &f) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline3dcalcv(const_cast(c.c_ptr()), x, y, z, const_cast(f.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine unpacks tri-dimensional spline into the coefficients table - -INPUT PARAMETERS: - C - spline interpolant. - -Result: - N - grid size (X) - M - grid size (Y) - L - grid size (Z) - D - number of components - SType- spline type. Currently, only one spline type is supported: - trilinear spline, as indicated by SType=1. - Tbl - spline coefficients: [0..(N-1)*(M-1)*(L-1)*D-1, 0..13]. - For T=0..D-1 (component index), I = 0...N-2 (x index), - J=0..M-2 (y index), K=0..L-2 (z index): - Q := T + I*D + J*D*(N-1) + K*D*(N-1)*(M-1), - - Q-th row stores decomposition for T-th component of the - vector-valued function - - Tbl[Q,0] = X[i] - Tbl[Q,1] = X[i+1] - Tbl[Q,2] = Y[j] - Tbl[Q,3] = Y[j+1] - Tbl[Q,4] = Z[k] - Tbl[Q,5] = Z[k+1] - - Tbl[Q,6] = C000 - Tbl[Q,7] = C100 - Tbl[Q,8] = C010 - Tbl[Q,9] = C110 - Tbl[Q,10]= C001 - Tbl[Q,11]= C101 - Tbl[Q,12]= C011 - Tbl[Q,13]= C111 - On each grid square spline is equals to: - S(x) = SUM(c[i,j,k]*(x^i)*(y^j)*(z^k), i=0..1, j=0..1, k=0..1) - t = x-x[j] - u = y-y[i] - v = z-z[k] - - NOTE: format of Tbl is given for SType=1. Future versions of - ALGLIB can use different formats for different values of - SType. - - -- ALGLIB PROJECT -- - Copyright 26.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline3dunpackv(const spline3dinterpolant &c, ae_int_t &n, ae_int_t &m, ae_int_t &l, ae_int_t &d, ae_int_t &stype, real_2d_array &tbl) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spline3dunpackv(const_cast(c.c_ptr()), &n, &m, &l, &d, &stype, const_cast(tbl.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS IMPLEMENTATION OF COMPUTATIONAL CORE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ -static double idwint_idwqfactor = 1.5; -static ae_int_t idwint_idwkmin = 5; -static double idwint_idwcalcq(idwinterpolant* z, - /* Real */ ae_vector* x, - ae_int_t k, - ae_state *_state); -static void idwint_idwinit1(ae_int_t n, - ae_int_t nx, - ae_int_t d, - ae_int_t nq, - ae_int_t nw, - idwinterpolant* z, - ae_state *_state); -static void idwint_idwinternalsolver(/* Real */ ae_vector* y, - /* Real */ ae_vector* w, - /* Real */ ae_matrix* fmatrix, - /* Real */ ae_vector* temp, - ae_int_t n, - ae_int_t m, - ae_int_t* info, - /* Real */ ae_vector* x, - double* taskrcond, - ae_state *_state); - - -static void ratint_barycentricnormalize(barycentricinterpolant* b, - ae_state *_state); - - - - -static void spline1d_spline1dgriddiffcubicinternal(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_int_t boundltype, - double boundl, - ae_int_t boundrtype, - double boundr, - /* Real */ ae_vector* d, - /* Real */ ae_vector* a1, - /* Real */ ae_vector* a2, - /* Real */ ae_vector* a3, - /* Real */ ae_vector* b, - /* Real */ ae_vector* dt, - ae_state *_state); -static void spline1d_heapsortpoints(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_state *_state); -static void spline1d_heapsortppoints(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Integer */ ae_vector* p, - ae_int_t n, - ae_state *_state); -static void spline1d_solvetridiagonal(/* Real */ ae_vector* a, - /* Real */ ae_vector* b, - /* Real */ ae_vector* c, - /* Real */ ae_vector* d, - ae_int_t n, - /* Real */ ae_vector* x, - ae_state *_state); -static void spline1d_solvecyclictridiagonal(/* Real */ ae_vector* a, - /* Real */ ae_vector* b, - /* Real */ ae_vector* c, - /* Real */ ae_vector* d, - ae_int_t n, - /* Real */ ae_vector* x, - ae_state *_state); -static double spline1d_diffthreepoint(double t, - double x0, - double f0, - double x1, - double f1, - double x2, - double f2, - ae_state *_state); -static void spline1d_hermitecalc(double p0, - double m0, - double p1, - double m1, - double t, - double* s, - double* ds, - ae_state *_state); -static double spline1d_rescaleval(double a0, - double b0, - double a1, - double b1, - double t, - ae_state *_state); - - -static void lsfit_spline1dfitinternal(ae_int_t st, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* w, - ae_int_t n, - /* Real */ ae_vector* xc, - /* Real */ ae_vector* yc, - /* Integer */ ae_vector* dc, - ae_int_t k, - ae_int_t m, - ae_int_t* info, - spline1dinterpolant* s, - spline1dfitreport* rep, - ae_state *_state); -static void lsfit_lsfitlinearinternal(/* Real */ ae_vector* y, - /* Real */ ae_vector* w, - /* Real */ ae_matrix* fmatrix, - ae_int_t n, - ae_int_t m, - ae_int_t* info, - /* Real */ ae_vector* c, - lsfitreport* rep, - ae_state *_state); -static void lsfit_lsfitclearrequestfields(lsfitstate* state, - ae_state *_state); -static void lsfit_barycentriccalcbasis(barycentricinterpolant* b, - double t, - /* Real */ ae_vector* y, - ae_state *_state); -static void lsfit_internalchebyshevfit(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* w, - ae_int_t n, - /* Real */ ae_vector* xc, - /* Real */ ae_vector* yc, - /* Integer */ ae_vector* dc, - ae_int_t k, - ae_int_t m, - ae_int_t* info, - /* Real */ ae_vector* c, - lsfitreport* rep, - ae_state *_state); -static void lsfit_barycentricfitwcfixedd(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* w, - ae_int_t n, - /* Real */ ae_vector* xc, - /* Real */ ae_vector* yc, - /* Integer */ ae_vector* dc, - ae_int_t k, - ae_int_t m, - ae_int_t d, - ae_int_t* info, - barycentricinterpolant* b, - barycentricfitreport* rep, - ae_state *_state); -static void lsfit_clearreport(lsfitreport* rep, ae_state *_state); -static void lsfit_estimateerrors(/* Real */ ae_matrix* f1, - /* Real */ ae_vector* f0, - /* Real */ ae_vector* y, - /* Real */ ae_vector* w, - /* Real */ ae_vector* x, - /* Real */ ae_vector* s, - ae_int_t n, - ae_int_t k, - lsfitreport* rep, - /* Real */ ae_matrix* z, - ae_int_t zkind, - ae_state *_state); - - -static void pspline_pspline2par(/* Real */ ae_matrix* xy, - ae_int_t n, - ae_int_t pt, - /* Real */ ae_vector* p, - ae_state *_state); -static void pspline_pspline3par(/* Real */ ae_matrix* xy, - ae_int_t n, - ae_int_t pt, - /* Real */ ae_vector* p, - ae_state *_state); - - -static double rbf_eps = 1.0E-6; -static ae_int_t rbf_mxnx = 3; -static double rbf_rbffarradius = 6; -static double rbf_rbfnearradius = 2.1; -static double rbf_rbfmlradius = 3; -static ae_int_t rbf_rbffirstversion = 0; -static void rbf_rbfgridpoints(rbfmodel* s, ae_state *_state); -static void rbf_rbfradnn(rbfmodel* s, - double q, - double z, - ae_state *_state); -static ae_bool rbf_buildlinearmodel(/* Real */ ae_matrix* x, - /* Real */ ae_matrix* y, - ae_int_t n, - ae_int_t ny, - ae_int_t modeltype, - /* Real */ ae_matrix* v, - ae_state *_state); -static void rbf_buildrbfmodellsqr(/* Real */ ae_matrix* x, - /* Real */ ae_matrix* y, - /* Real */ ae_matrix* xc, - /* Real */ ae_vector* r, - ae_int_t n, - ae_int_t nc, - ae_int_t ny, - kdtree* pointstree, - kdtree* centerstree, - double epsort, - double epserr, - ae_int_t maxits, - ae_int_t* gnnz, - ae_int_t* snnz, - /* Real */ ae_matrix* w, - ae_int_t* info, - ae_int_t* iterationscount, - ae_int_t* nmv, - ae_state *_state); -static void rbf_buildrbfmlayersmodellsqr(/* Real */ ae_matrix* x, - /* Real */ ae_matrix* y, - /* Real */ ae_matrix* xc, - double rval, - /* Real */ ae_vector* r, - ae_int_t n, - ae_int_t* nc, - ae_int_t ny, - ae_int_t nlayers, - kdtree* centerstree, - double epsort, - double epserr, - ae_int_t maxits, - double lambdav, - ae_int_t* annz, - /* Real */ ae_matrix* w, - ae_int_t* info, - ae_int_t* iterationscount, - ae_int_t* nmv, - ae_state *_state); - - -static void spline2d_bicubiccalcderivatives(/* Real */ ae_matrix* a, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* dx, - /* Real */ ae_matrix* dy, - /* Real */ ae_matrix* dxy, - ae_state *_state); - - -static void spline3d_spline3ddiff(spline3dinterpolant* c, - double x, - double y, - double z, - double* f, - double* fx, - double* fy, - double* fxy, - ae_state *_state); - - - - - -/************************************************************************* -IDW interpolation - -INPUT PARAMETERS: - Z - IDW interpolant built with one of model building - subroutines. - X - array[0..NX-1], interpolation point - -Result: - IDW interpolant Z(X) - - -- ALGLIB -- - Copyright 02.03.2010 by Bochkanov Sergey -*************************************************************************/ -double idwcalc(idwinterpolant* z, - /* Real */ ae_vector* x, - ae_state *_state) -{ - ae_int_t i; - ae_int_t k; - double r; - double s; - double w; - double v1; - double v2; - double d0; - double di; - double result; - - - - /* - * these initializers are not really necessary, - * but without them compiler complains about uninitialized locals - */ - k = 0; - - /* - * Query - */ - if( z->modeltype==0 ) - { - - /* - * NQ/NW-based model - */ - k = kdtreequeryknn(&z->tree, x, z->nw, ae_true, _state); - kdtreequeryresultsdistances(&z->tree, &z->rbuf, _state); - kdtreequeryresultstags(&z->tree, &z->tbuf, _state); - } - if( z->modeltype==1 ) - { - - /* - * R-based model - */ - k = kdtreequeryrnn(&z->tree, x, z->r, ae_true, _state); - kdtreequeryresultsdistances(&z->tree, &z->rbuf, _state); - kdtreequeryresultstags(&z->tree, &z->tbuf, _state); - if( ktree, x, idwint_idwkmin, ae_true, _state); - kdtreequeryresultsdistances(&z->tree, &z->rbuf, _state); - kdtreequeryresultstags(&z->tree, &z->tbuf, _state); - } - } - - /* - * initialize weights for linear/quadratic members calculation. - * - * NOTE 1: weights are calculated using NORMALIZED modified - * Shepard's formula. Original formula gives w(i) = sqr((R-di)/(R*di)), - * where di is i-th distance, R is max(di). Modified formula have - * following form: - * w_mod(i) = 1, if di=d0 - * w_mod(i) = w(i)/w(0), if di<>d0 - * - * NOTE 2: self-match is USED for this query - * - * NOTE 3: last point almost always gain zero weight, but it MUST - * be used for fitting because sometimes it will gain NON-ZERO - * weight - for example, when all distances are equal. - */ - r = z->rbuf.ptr.p_double[k-1]; - d0 = z->rbuf.ptr.p_double[0]; - result = 0; - s = 0; - for(i=0; i<=k-1; i++) - { - di = z->rbuf.ptr.p_double[i]; - if( ae_fp_eq(di,d0) ) - { - - /* - * distance is equal to shortest, set it 1.0 - * without explicitly calculating (which would give - * us same result, but 'll expose us to the risk of - * division by zero). - */ - w = 1; - } - else - { - - /* - * use normalized formula - */ - v1 = (r-di)/(r-d0); - v2 = d0/di; - w = ae_sqr(v1*v2, _state); - } - result = result+w*idwint_idwcalcq(z, x, z->tbuf.ptr.p_int[i], _state); - s = s+w; - } - result = result/s; - return result; -} - - -/************************************************************************* -IDW interpolant using modified Shepard method for uniform point -distributions. - -INPUT PARAMETERS: - XY - X and Y values, array[0..N-1,0..NX]. - First NX columns contain X-values, last column contain - Y-values. - N - number of nodes, N>0. - NX - space dimension, NX>=1. - D - nodal function type, either: - * 0 constant model. Just for demonstration only, worst - model ever. - * 1 linear model, least squares fitting. Simpe model for - datasets too small for quadratic models - * 2 quadratic model, least squares fitting. Best model - available (if your dataset is large enough). - * -1 "fast" linear model, use with caution!!! It is - significantly faster than linear/quadratic and better - than constant model. But it is less robust (especially - in the presence of noise). - NQ - number of points used to calculate nodal functions (ignored - for constant models). NQ should be LARGER than: - * max(1.5*(1+NX),2^NX+1) for linear model, - * max(3/4*(NX+2)*(NX+1),2^NX+1) for quadratic model. - Values less than this threshold will be silently increased. - NW - number of points used to calculate weights and to interpolate. - Required: >=2^NX+1, values less than this threshold will be - silently increased. - Recommended value: about 2*NQ - -OUTPUT PARAMETERS: - Z - IDW interpolant. - -NOTES: - * best results are obtained with quadratic models, worst - with constant - models - * when N is large, NQ and NW must be significantly smaller than N both - to obtain optimal performance and to obtain optimal accuracy. In 2 or - 3-dimensional tasks NQ=15 and NW=25 are good values to start with. - * NQ and NW may be greater than N. In such cases they will be - automatically decreased. - * this subroutine is always succeeds (as long as correct parameters are - passed). - * see 'Multivariate Interpolation of Large Sets of Scattered Data' by - Robert J. Renka for more information on this algorithm. - * this subroutine assumes that point distribution is uniform at the small - scales. If it isn't - for example, points are concentrated along - "lines", but "lines" distribution is uniform at the larger scale - then - you should use IDWBuildModifiedShepardR() - - - -- ALGLIB PROJECT -- - Copyright 02.03.2010 by Bochkanov Sergey -*************************************************************************/ -void idwbuildmodifiedshepard(/* Real */ ae_matrix* xy, - ae_int_t n, - ae_int_t nx, - ae_int_t d, - ae_int_t nq, - ae_int_t nw, - idwinterpolant* z, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t j2; - ae_int_t j3; - double v; - double r; - double s; - double d0; - double di; - double v1; - double v2; - ae_int_t nc; - ae_int_t offs; - ae_vector x; - ae_vector qrbuf; - ae_matrix qxybuf; - ae_vector y; - ae_matrix fmatrix; - ae_vector w; - ae_vector qsol; - ae_vector temp; - ae_vector tags; - ae_int_t info; - double taskrcond; - - ae_frame_make(_state, &_frame_block); - _idwinterpolant_clear(z); - ae_vector_init(&x, 0, DT_REAL, _state, ae_true); - ae_vector_init(&qrbuf, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&qxybuf, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&y, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&fmatrix, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&w, 0, DT_REAL, _state, ae_true); - ae_vector_init(&qsol, 0, DT_REAL, _state, ae_true); - ae_vector_init(&temp, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tags, 0, DT_INT, _state, ae_true); - - - /* - * these initializers are not really necessary, - * but without them compiler complains about uninitialized locals - */ - nc = 0; - - /* - * assertions - */ - ae_assert(n>0, "IDWBuildModifiedShepard: N<=0!", _state); - ae_assert(nx>=1, "IDWBuildModifiedShepard: NX<1!", _state); - ae_assert(d>=-1&&d<=2, "IDWBuildModifiedShepard: D<>-1 and D<>0 and D<>1 and D<>2!", _state); - - /* - * Correct parameters if needed - */ - if( d==1 ) - { - nq = ae_maxint(nq, ae_iceil(idwint_idwqfactor*(1+nx), _state)+1, _state); - nq = ae_maxint(nq, ae_round(ae_pow(2, nx, _state), _state)+1, _state); - } - if( d==2 ) - { - nq = ae_maxint(nq, ae_iceil(idwint_idwqfactor*(nx+2)*(nx+1)/2, _state)+1, _state); - nq = ae_maxint(nq, ae_round(ae_pow(2, nx, _state), _state)+1, _state); - } - nw = ae_maxint(nw, ae_round(ae_pow(2, nx, _state), _state)+1, _state); - nq = ae_minint(nq, n, _state); - nw = ae_minint(nw, n, _state); - - /* - * primary initialization of Z - */ - idwint_idwinit1(n, nx, d, nq, nw, z, _state); - z->modeltype = 0; - - /* - * Create KD-tree - */ - ae_vector_set_length(&tags, n, _state); - for(i=0; i<=n-1; i++) - { - tags.ptr.p_int[i] = i; - } - kdtreebuildtagged(xy, &tags, n, nx, 1, 2, &z->tree, _state); - - /* - * build nodal functions - */ - ae_vector_set_length(&temp, nq+1, _state); - ae_vector_set_length(&x, nx, _state); - ae_vector_set_length(&qrbuf, nq, _state); - ae_matrix_set_length(&qxybuf, nq, nx+1, _state); - if( d==-1 ) - { - ae_vector_set_length(&w, nq, _state); - } - if( d==1 ) - { - ae_vector_set_length(&y, nq, _state); - ae_vector_set_length(&w, nq, _state); - ae_vector_set_length(&qsol, nx, _state); - - /* - * NX for linear members, - * 1 for temporary storage - */ - ae_matrix_set_length(&fmatrix, nq, nx+1, _state); - } - if( d==2 ) - { - ae_vector_set_length(&y, nq, _state); - ae_vector_set_length(&w, nq, _state); - ae_vector_set_length(&qsol, nx+ae_round(nx*(nx+1)*0.5, _state), _state); - - /* - * NX for linear members, - * Round(NX*(NX+1)*0.5) for quadratic model, - * 1 for temporary storage - */ - ae_matrix_set_length(&fmatrix, nq, nx+ae_round(nx*(nx+1)*0.5, _state)+1, _state); - } - for(i=0; i<=n-1; i++) - { - - /* - * Initialize center and function value. - * If D=0 it is all what we need - */ - ae_v_move(&z->q.ptr.pp_double[i][0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nx)); - if( d==0 ) - { - continue; - } - - /* - * calculate weights for linear/quadratic members calculation. - * - * NOTE 1: weights are calculated using NORMALIZED modified - * Shepard's formula. Original formula is w(i) = sqr((R-di)/(R*di)), - * where di is i-th distance, R is max(di). Modified formula have - * following form: - * w_mod(i) = 1, if di=d0 - * w_mod(i) = w(i)/w(0), if di<>d0 - * - * NOTE 2: self-match is NOT used for this query - * - * NOTE 3: last point almost always gain zero weight, but it MUST - * be used for fitting because sometimes it will gain NON-ZERO - * weight - for example, when all distances are equal. - */ - ae_v_move(&x.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nx-1)); - k = kdtreequeryknn(&z->tree, &x, nq, ae_false, _state); - kdtreequeryresultsxy(&z->tree, &qxybuf, _state); - kdtreequeryresultsdistances(&z->tree, &qrbuf, _state); - r = qrbuf.ptr.p_double[k-1]; - d0 = qrbuf.ptr.p_double[0]; - for(j=0; j<=k-1; j++) - { - di = qrbuf.ptr.p_double[j]; - if( ae_fp_eq(di,d0) ) - { - - /* - * distance is equal to shortest, set it 1.0 - * without explicitly calculating (which would give - * us same result, but 'll expose us to the risk of - * division by zero). - */ - w.ptr.p_double[j] = 1; - } - else - { - - /* - * use normalized formula - */ - v1 = (r-di)/(r-d0); - v2 = d0/di; - w.ptr.p_double[j] = ae_sqr(v1*v2, _state); - } - } - - /* - * calculate linear/quadratic members - */ - if( d==-1 ) - { - - /* - * "Fast" linear nodal function calculated using - * inverse distance weighting - */ - for(j=0; j<=nx-1; j++) - { - x.ptr.p_double[j] = 0; - } - s = 0; - for(j=0; j<=k-1; j++) - { - - /* - * calculate J-th inverse distance weighted gradient: - * grad_k = (y_j-y_k)*(x_j-x_k)/sqr(norm(x_j-x_k)) - * grad = sum(wk*grad_k)/sum(w_k) - */ - v = 0; - for(j2=0; j2<=nx-1; j2++) - { - v = v+ae_sqr(qxybuf.ptr.pp_double[j][j2]-xy->ptr.pp_double[i][j2], _state); - } - - /* - * Although x_j<>x_k, sqr(norm(x_j-x_k)) may be zero due to - * underflow. If it is, we assume than J-th gradient is zero - * (i.e. don't add anything) - */ - if( ae_fp_neq(v,0) ) - { - for(j2=0; j2<=nx-1; j2++) - { - x.ptr.p_double[j2] = x.ptr.p_double[j2]+w.ptr.p_double[j]*(qxybuf.ptr.pp_double[j][nx]-xy->ptr.pp_double[i][nx])*(qxybuf.ptr.pp_double[j][j2]-xy->ptr.pp_double[i][j2])/v; - } - } - s = s+w.ptr.p_double[j]; - } - for(j=0; j<=nx-1; j++) - { - z->q.ptr.pp_double[i][nx+1+j] = x.ptr.p_double[j]/s; - } - } - else - { - - /* - * Least squares models: build - */ - if( d==1 ) - { - - /* - * Linear nodal function calculated using - * least squares fitting to its neighbors - */ - for(j=0; j<=k-1; j++) - { - for(j2=0; j2<=nx-1; j2++) - { - fmatrix.ptr.pp_double[j][j2] = qxybuf.ptr.pp_double[j][j2]-xy->ptr.pp_double[i][j2]; - } - y.ptr.p_double[j] = qxybuf.ptr.pp_double[j][nx]-xy->ptr.pp_double[i][nx]; - } - nc = nx; - } - if( d==2 ) - { - - /* - * Quadratic nodal function calculated using - * least squares fitting to its neighbors - */ - for(j=0; j<=k-1; j++) - { - offs = 0; - for(j2=0; j2<=nx-1; j2++) - { - fmatrix.ptr.pp_double[j][offs] = qxybuf.ptr.pp_double[j][j2]-xy->ptr.pp_double[i][j2]; - offs = offs+1; - } - for(j2=0; j2<=nx-1; j2++) - { - for(j3=j2; j3<=nx-1; j3++) - { - fmatrix.ptr.pp_double[j][offs] = (qxybuf.ptr.pp_double[j][j2]-xy->ptr.pp_double[i][j2])*(qxybuf.ptr.pp_double[j][j3]-xy->ptr.pp_double[i][j3]); - offs = offs+1; - } - } - y.ptr.p_double[j] = qxybuf.ptr.pp_double[j][nx]-xy->ptr.pp_double[i][nx]; - } - nc = nx+ae_round(nx*(nx+1)*0.5, _state); - } - idwint_idwinternalsolver(&y, &w, &fmatrix, &temp, k, nc, &info, &qsol, &taskrcond, _state); - - /* - * Least squares models: copy results - */ - if( info>0 ) - { - - /* - * LLS task is solved, copy results - */ - z->debugworstrcond = ae_minreal(z->debugworstrcond, taskrcond, _state); - z->debugbestrcond = ae_maxreal(z->debugbestrcond, taskrcond, _state); - for(j=0; j<=nc-1; j++) - { - z->q.ptr.pp_double[i][nx+1+j] = qsol.ptr.p_double[j]; - } - } - else - { - - /* - * Solver failure, very strange, but we will use - * zero values to handle it. - */ - z->debugsolverfailures = z->debugsolverfailures+1; - for(j=0; j<=nc-1; j++) - { - z->q.ptr.pp_double[i][nx+1+j] = 0; - } - } - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -IDW interpolant using modified Shepard method for non-uniform datasets. - -This type of model uses constant nodal functions and interpolates using -all nodes which are closer than user-specified radius R. It may be used -when points distribution is non-uniform at the small scale, but it is at -the distances as large as R. - -INPUT PARAMETERS: - XY - X and Y values, array[0..N-1,0..NX]. - First NX columns contain X-values, last column contain - Y-values. - N - number of nodes, N>0. - NX - space dimension, NX>=1. - R - radius, R>0 - -OUTPUT PARAMETERS: - Z - IDW interpolant. - -NOTES: -* if there is less than IDWKMin points within R-ball, algorithm selects - IDWKMin closest ones, so that continuity properties of interpolant are - preserved even far from points. - - -- ALGLIB PROJECT -- - Copyright 11.04.2010 by Bochkanov Sergey -*************************************************************************/ -void idwbuildmodifiedshepardr(/* Real */ ae_matrix* xy, - ae_int_t n, - ae_int_t nx, - double r, - idwinterpolant* z, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_vector tags; - - ae_frame_make(_state, &_frame_block); - _idwinterpolant_clear(z); - ae_vector_init(&tags, 0, DT_INT, _state, ae_true); - - - /* - * assertions - */ - ae_assert(n>0, "IDWBuildModifiedShepardR: N<=0!", _state); - ae_assert(nx>=1, "IDWBuildModifiedShepardR: NX<1!", _state); - ae_assert(ae_fp_greater(r,0), "IDWBuildModifiedShepardR: R<=0!", _state); - - /* - * primary initialization of Z - */ - idwint_idwinit1(n, nx, 0, 0, n, z, _state); - z->modeltype = 1; - z->r = r; - - /* - * Create KD-tree - */ - ae_vector_set_length(&tags, n, _state); - for(i=0; i<=n-1; i++) - { - tags.ptr.p_int[i] = i; - } - kdtreebuildtagged(xy, &tags, n, nx, 1, 2, &z->tree, _state); - - /* - * build nodal functions - */ - for(i=0; i<=n-1; i++) - { - ae_v_move(&z->q.ptr.pp_double[i][0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nx)); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -IDW model for noisy data. - -This subroutine may be used to handle noisy data, i.e. data with noise in -OUTPUT values. It differs from IDWBuildModifiedShepard() in the following -aspects: -* nodal functions are not constrained to pass through nodes: Qi(xi)<>yi, - i.e. we have fitting instead of interpolation. -* weights which are used during least squares fitting stage are all equal - to 1.0 (independently of distance) -* "fast"-linear or constant nodal functions are not supported (either not - robust enough or too rigid) - -This problem require far more complex tuning than interpolation problems. -Below you can find some recommendations regarding this problem: -* focus on tuning NQ; it controls noise reduction. As for NW, you can just - make it equal to 2*NQ. -* you can use cross-validation to determine optimal NQ. -* optimal NQ is a result of complex tradeoff between noise level (more - noise = larger NQ required) and underlying function complexity (given - fixed N, larger NQ means smoothing of compex features in the data). For - example, NQ=N will reduce noise to the minimum level possible, but you - will end up with just constant/linear/quadratic (depending on D) least - squares model for the whole dataset. - -INPUT PARAMETERS: - XY - X and Y values, array[0..N-1,0..NX]. - First NX columns contain X-values, last column contain - Y-values. - N - number of nodes, N>0. - NX - space dimension, NX>=1. - D - nodal function degree, either: - * 1 linear model, least squares fitting. Simpe model for - datasets too small for quadratic models (or for very - noisy problems). - * 2 quadratic model, least squares fitting. Best model - available (if your dataset is large enough). - NQ - number of points used to calculate nodal functions. NQ should - be significantly larger than 1.5 times the number of - coefficients in a nodal function to overcome effects of noise: - * larger than 1.5*(1+NX) for linear model, - * larger than 3/4*(NX+2)*(NX+1) for quadratic model. - Values less than this threshold will be silently increased. - NW - number of points used to calculate weights and to interpolate. - Required: >=2^NX+1, values less than this threshold will be - silently increased. - Recommended value: about 2*NQ or larger - -OUTPUT PARAMETERS: - Z - IDW interpolant. - -NOTES: - * best results are obtained with quadratic models, linear models are not - recommended to use unless you are pretty sure that it is what you want - * this subroutine is always succeeds (as long as correct parameters are - passed). - * see 'Multivariate Interpolation of Large Sets of Scattered Data' by - Robert J. Renka for more information on this algorithm. - - - -- ALGLIB PROJECT -- - Copyright 02.03.2010 by Bochkanov Sergey -*************************************************************************/ -void idwbuildnoisy(/* Real */ ae_matrix* xy, - ae_int_t n, - ae_int_t nx, - ae_int_t d, - ae_int_t nq, - ae_int_t nw, - idwinterpolant* z, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t j2; - ae_int_t j3; - double v; - ae_int_t nc; - ae_int_t offs; - double taskrcond; - ae_vector x; - ae_vector qrbuf; - ae_matrix qxybuf; - ae_vector y; - ae_vector w; - ae_matrix fmatrix; - ae_vector qsol; - ae_vector tags; - ae_vector temp; - ae_int_t info; - - ae_frame_make(_state, &_frame_block); - _idwinterpolant_clear(z); - ae_vector_init(&x, 0, DT_REAL, _state, ae_true); - ae_vector_init(&qrbuf, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&qxybuf, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&y, 0, DT_REAL, _state, ae_true); - ae_vector_init(&w, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&fmatrix, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&qsol, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tags, 0, DT_INT, _state, ae_true); - ae_vector_init(&temp, 0, DT_REAL, _state, ae_true); - - - /* - * these initializers are not really necessary, - * but without them compiler complains about uninitialized locals - */ - nc = 0; - - /* - * assertions - */ - ae_assert(n>0, "IDWBuildNoisy: N<=0!", _state); - ae_assert(nx>=1, "IDWBuildNoisy: NX<1!", _state); - ae_assert(d>=1&&d<=2, "IDWBuildNoisy: D<>1 and D<>2!", _state); - - /* - * Correct parameters if needed - */ - if( d==1 ) - { - nq = ae_maxint(nq, ae_iceil(idwint_idwqfactor*(1+nx), _state)+1, _state); - } - if( d==2 ) - { - nq = ae_maxint(nq, ae_iceil(idwint_idwqfactor*(nx+2)*(nx+1)/2, _state)+1, _state); - } - nw = ae_maxint(nw, ae_round(ae_pow(2, nx, _state), _state)+1, _state); - nq = ae_minint(nq, n, _state); - nw = ae_minint(nw, n, _state); - - /* - * primary initialization of Z - */ - idwint_idwinit1(n, nx, d, nq, nw, z, _state); - z->modeltype = 0; - - /* - * Create KD-tree - */ - ae_vector_set_length(&tags, n, _state); - for(i=0; i<=n-1; i++) - { - tags.ptr.p_int[i] = i; - } - kdtreebuildtagged(xy, &tags, n, nx, 1, 2, &z->tree, _state); - - /* - * build nodal functions - * (special algorithm for noisy data is used) - */ - ae_vector_set_length(&temp, nq+1, _state); - ae_vector_set_length(&x, nx, _state); - ae_vector_set_length(&qrbuf, nq, _state); - ae_matrix_set_length(&qxybuf, nq, nx+1, _state); - if( d==1 ) - { - ae_vector_set_length(&y, nq, _state); - ae_vector_set_length(&w, nq, _state); - ae_vector_set_length(&qsol, 1+nx, _state); - - /* - * 1 for constant member, - * NX for linear members, - * 1 for temporary storage - */ - ae_matrix_set_length(&fmatrix, nq, 1+nx+1, _state); - } - if( d==2 ) - { - ae_vector_set_length(&y, nq, _state); - ae_vector_set_length(&w, nq, _state); - ae_vector_set_length(&qsol, 1+nx+ae_round(nx*(nx+1)*0.5, _state), _state); - - /* - * 1 for constant member, - * NX for linear members, - * Round(NX*(NX+1)*0.5) for quadratic model, - * 1 for temporary storage - */ - ae_matrix_set_length(&fmatrix, nq, 1+nx+ae_round(nx*(nx+1)*0.5, _state)+1, _state); - } - for(i=0; i<=n-1; i++) - { - - /* - * Initialize center. - */ - ae_v_move(&z->q.ptr.pp_double[i][0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nx-1)); - - /* - * Calculate linear/quadratic members - * using least squares fit - * NOTE 1: all weight are equal to 1.0 - * NOTE 2: self-match is USED for this query - */ - ae_v_move(&x.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nx-1)); - k = kdtreequeryknn(&z->tree, &x, nq, ae_true, _state); - kdtreequeryresultsxy(&z->tree, &qxybuf, _state); - kdtreequeryresultsdistances(&z->tree, &qrbuf, _state); - if( d==1 ) - { - - /* - * Linear nodal function calculated using - * least squares fitting to its neighbors - */ - for(j=0; j<=k-1; j++) - { - fmatrix.ptr.pp_double[j][0] = 1.0; - for(j2=0; j2<=nx-1; j2++) - { - fmatrix.ptr.pp_double[j][1+j2] = qxybuf.ptr.pp_double[j][j2]-xy->ptr.pp_double[i][j2]; - } - y.ptr.p_double[j] = qxybuf.ptr.pp_double[j][nx]; - w.ptr.p_double[j] = 1; - } - nc = 1+nx; - } - if( d==2 ) - { - - /* - * Quadratic nodal function calculated using - * least squares fitting to its neighbors - */ - for(j=0; j<=k-1; j++) - { - fmatrix.ptr.pp_double[j][0] = 1; - offs = 1; - for(j2=0; j2<=nx-1; j2++) - { - fmatrix.ptr.pp_double[j][offs] = qxybuf.ptr.pp_double[j][j2]-xy->ptr.pp_double[i][j2]; - offs = offs+1; - } - for(j2=0; j2<=nx-1; j2++) - { - for(j3=j2; j3<=nx-1; j3++) - { - fmatrix.ptr.pp_double[j][offs] = (qxybuf.ptr.pp_double[j][j2]-xy->ptr.pp_double[i][j2])*(qxybuf.ptr.pp_double[j][j3]-xy->ptr.pp_double[i][j3]); - offs = offs+1; - } - } - y.ptr.p_double[j] = qxybuf.ptr.pp_double[j][nx]; - w.ptr.p_double[j] = 1; - } - nc = 1+nx+ae_round(nx*(nx+1)*0.5, _state); - } - idwint_idwinternalsolver(&y, &w, &fmatrix, &temp, k, nc, &info, &qsol, &taskrcond, _state); - - /* - * Least squares models: copy results - */ - if( info>0 ) - { - - /* - * LLS task is solved, copy results - */ - z->debugworstrcond = ae_minreal(z->debugworstrcond, taskrcond, _state); - z->debugbestrcond = ae_maxreal(z->debugbestrcond, taskrcond, _state); - for(j=0; j<=nc-1; j++) - { - z->q.ptr.pp_double[i][nx+j] = qsol.ptr.p_double[j]; - } - } - else - { - - /* - * Solver failure, very strange, but we will use - * zero values to handle it. - */ - z->debugsolverfailures = z->debugsolverfailures+1; - v = 0; - for(j=0; j<=k-1; j++) - { - v = v+qxybuf.ptr.pp_double[j][nx]; - } - z->q.ptr.pp_double[i][nx] = v/k; - for(j=0; j<=nc-2; j++) - { - z->q.ptr.pp_double[i][nx+1+j] = 0; - } - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Internal subroutine: K-th nodal function calculation - - -- ALGLIB -- - Copyright 02.03.2010 by Bochkanov Sergey -*************************************************************************/ -static double idwint_idwcalcq(idwinterpolant* z, - /* Real */ ae_vector* x, - ae_int_t k, - ae_state *_state) -{ - ae_int_t nx; - ae_int_t i; - ae_int_t j; - ae_int_t offs; - double result; - - - nx = z->nx; - - /* - * constant member - */ - result = z->q.ptr.pp_double[k][nx]; - - /* - * linear members - */ - if( z->d>=1 ) - { - for(i=0; i<=nx-1; i++) - { - result = result+z->q.ptr.pp_double[k][nx+1+i]*(x->ptr.p_double[i]-z->q.ptr.pp_double[k][i]); - } - } - - /* - * quadratic members - */ - if( z->d>=2 ) - { - offs = nx+1+nx; - for(i=0; i<=nx-1; i++) - { - for(j=i; j<=nx-1; j++) - { - result = result+z->q.ptr.pp_double[k][offs]*(x->ptr.p_double[i]-z->q.ptr.pp_double[k][i])*(x->ptr.p_double[j]-z->q.ptr.pp_double[k][j]); - offs = offs+1; - } - } - } - return result; -} - - -/************************************************************************* -Initialization of internal structures. - -It assumes correctness of all parameters. - - -- ALGLIB -- - Copyright 02.03.2010 by Bochkanov Sergey -*************************************************************************/ -static void idwint_idwinit1(ae_int_t n, - ae_int_t nx, - ae_int_t d, - ae_int_t nq, - ae_int_t nw, - idwinterpolant* z, - ae_state *_state) -{ - - - z->debugsolverfailures = 0; - z->debugworstrcond = 1.0; - z->debugbestrcond = 0; - z->n = n; - z->nx = nx; - z->d = 0; - if( d==1 ) - { - z->d = 1; - } - if( d==2 ) - { - z->d = 2; - } - if( d==-1 ) - { - z->d = 1; - } - z->nw = nw; - if( d==-1 ) - { - ae_matrix_set_length(&z->q, n, nx+1+nx, _state); - } - if( d==0 ) - { - ae_matrix_set_length(&z->q, n, nx+1, _state); - } - if( d==1 ) - { - ae_matrix_set_length(&z->q, n, nx+1+nx, _state); - } - if( d==2 ) - { - ae_matrix_set_length(&z->q, n, nx+1+nx+ae_round(nx*(nx+1)*0.5, _state), _state); - } - ae_vector_set_length(&z->tbuf, nw, _state); - ae_vector_set_length(&z->rbuf, nw, _state); - ae_matrix_set_length(&z->xybuf, nw, nx+1, _state); - ae_vector_set_length(&z->xbuf, nx, _state); -} - - -/************************************************************************* -Linear least squares solver for small tasks. - -Works faster than standard ALGLIB solver in non-degenerate cases (due to -absence of internal allocations and optimized row/colums). In degenerate -cases it calls standard solver, which results in small performance penalty -associated with preliminary steps. - -INPUT PARAMETERS: - Y array[0..N-1] - W array[0..N-1] - FMatrix array[0..N-1,0..M], have additional column for temporary - values - Temp array[0..N] -*************************************************************************/ -static void idwint_idwinternalsolver(/* Real */ ae_vector* y, - /* Real */ ae_vector* w, - /* Real */ ae_matrix* fmatrix, - /* Real */ ae_vector* temp, - ae_int_t n, - ae_int_t m, - ae_int_t* info, - /* Real */ ae_vector* x, - double* taskrcond, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - double v; - double tau; - ae_vector b; - densesolverlsreport srep; - - ae_frame_make(_state, &_frame_block); - *info = 0; - ae_vector_init(&b, 0, DT_REAL, _state, ae_true); - _densesolverlsreport_init(&srep, _state, ae_true); - - - /* - * set up info - */ - *info = 1; - - /* - * prepare matrix - */ - for(i=0; i<=n-1; i++) - { - fmatrix->ptr.pp_double[i][m] = y->ptr.p_double[i]; - v = w->ptr.p_double[i]; - ae_v_muld(&fmatrix->ptr.pp_double[i][0], 1, ae_v_len(0,m), v); - } - - /* - * use either fast algorithm or general algorithm - */ - if( m<=n ) - { - - /* - * QR decomposition - * We assume that M<=N (we would have called LSFit() otherwise) - */ - for(i=0; i<=m-1; i++) - { - if( iptr.p_double[1], 1, &fmatrix->ptr.pp_double[i][i], fmatrix->stride, ae_v_len(1,n-i)); - generatereflection(temp, n-i, &tau, _state); - fmatrix->ptr.pp_double[i][i] = temp->ptr.p_double[1]; - temp->ptr.p_double[1] = 1; - for(j=i+1; j<=m; j++) - { - v = ae_v_dotproduct(&fmatrix->ptr.pp_double[i][j], fmatrix->stride, &temp->ptr.p_double[1], 1, ae_v_len(i,n-1)); - v = tau*v; - ae_v_subd(&fmatrix->ptr.pp_double[i][j], fmatrix->stride, &temp->ptr.p_double[1], 1, ae_v_len(i,n-1), v); - } - } - } - - /* - * Check condition number - */ - *taskrcond = rmatrixtrrcondinf(fmatrix, m, ae_true, ae_false, _state); - - /* - * use either fast algorithm for non-degenerate cases - * or slow algorithm for degenerate cases - */ - if( ae_fp_greater(*taskrcond,10000*n*ae_machineepsilon) ) - { - - /* - * solve triangular system R*x = FMatrix[0:M-1,M] - * using fast algorithm, then exit - */ - x->ptr.p_double[m-1] = fmatrix->ptr.pp_double[m-1][m]/fmatrix->ptr.pp_double[m-1][m-1]; - for(i=m-2; i>=0; i--) - { - v = ae_v_dotproduct(&fmatrix->ptr.pp_double[i][i+1], 1, &x->ptr.p_double[i+1], 1, ae_v_len(i+1,m-1)); - x->ptr.p_double[i] = (fmatrix->ptr.pp_double[i][m]-v)/fmatrix->ptr.pp_double[i][i]; - } - } - else - { - - /* - * use more general algorithm - */ - ae_vector_set_length(&b, m, _state); - for(i=0; i<=m-1; i++) - { - for(j=0; j<=i-1; j++) - { - fmatrix->ptr.pp_double[i][j] = 0.0; - } - b.ptr.p_double[i] = fmatrix->ptr.pp_double[i][m]; - } - rmatrixsolvels(fmatrix, m, m, &b, 10000*ae_machineepsilon, info, &srep, x, _state); - } - } - else - { - - /* - * use more general algorithm - */ - ae_vector_set_length(&b, n, _state); - for(i=0; i<=n-1; i++) - { - b.ptr.p_double[i] = fmatrix->ptr.pp_double[i][m]; - } - rmatrixsolvels(fmatrix, n, m, &b, 10000*ae_machineepsilon, info, &srep, x, _state); - *taskrcond = srep.r2; - } - ae_frame_leave(_state); -} - - -ae_bool _idwinterpolant_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - idwinterpolant *p = (idwinterpolant*)_p; - ae_touch_ptr((void*)p); - if( !_kdtree_init(&p->tree, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->q, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->xbuf, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->tbuf, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->rbuf, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->xybuf, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _idwinterpolant_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - idwinterpolant *dst = (idwinterpolant*)_dst; - idwinterpolant *src = (idwinterpolant*)_src; - dst->n = src->n; - dst->nx = src->nx; - dst->d = src->d; - dst->r = src->r; - dst->nw = src->nw; - if( !_kdtree_init_copy(&dst->tree, &src->tree, _state, make_automatic) ) - return ae_false; - dst->modeltype = src->modeltype; - if( !ae_matrix_init_copy(&dst->q, &src->q, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->xbuf, &src->xbuf, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->tbuf, &src->tbuf, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->rbuf, &src->rbuf, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->xybuf, &src->xybuf, _state, make_automatic) ) - return ae_false; - dst->debugsolverfailures = src->debugsolverfailures; - dst->debugworstrcond = src->debugworstrcond; - dst->debugbestrcond = src->debugbestrcond; - return ae_true; -} - - -void _idwinterpolant_clear(void* _p) -{ - idwinterpolant *p = (idwinterpolant*)_p; - ae_touch_ptr((void*)p); - _kdtree_clear(&p->tree); - ae_matrix_clear(&p->q); - ae_vector_clear(&p->xbuf); - ae_vector_clear(&p->tbuf); - ae_vector_clear(&p->rbuf); - ae_matrix_clear(&p->xybuf); -} - - -void _idwinterpolant_destroy(void* _p) -{ - idwinterpolant *p = (idwinterpolant*)_p; - ae_touch_ptr((void*)p); - _kdtree_destroy(&p->tree); - ae_matrix_destroy(&p->q); - ae_vector_destroy(&p->xbuf); - ae_vector_destroy(&p->tbuf); - ae_vector_destroy(&p->rbuf); - ae_matrix_destroy(&p->xybuf); -} - - - - -/************************************************************************* -Rational interpolation using barycentric formula - -F(t) = SUM(i=0,n-1,w[i]*f[i]/(t-x[i])) / SUM(i=0,n-1,w[i]/(t-x[i])) - -Input parameters: - B - barycentric interpolant built with one of model building - subroutines. - T - interpolation point - -Result: - barycentric interpolant F(t) - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -double barycentriccalc(barycentricinterpolant* b, - double t, - ae_state *_state) -{ - double s1; - double s2; - double s; - double v; - ae_int_t i; - double result; - - - ae_assert(!ae_isinf(t, _state), "BarycentricCalc: infinite T!", _state); - - /* - * special case: NaN - */ - if( ae_isnan(t, _state) ) - { - result = _state->v_nan; - return result; - } - - /* - * special case: N=1 - */ - if( b->n==1 ) - { - result = b->sy*b->y.ptr.p_double[0]; - return result; - } - - /* - * Here we assume that task is normalized, i.e.: - * 1. abs(Y[i])<=1 - * 2. abs(W[i])<=1 - * 3. X[] is ordered - */ - s = ae_fabs(t-b->x.ptr.p_double[0], _state); - for(i=0; i<=b->n-1; i++) - { - v = b->x.ptr.p_double[i]; - if( ae_fp_eq(v,t) ) - { - result = b->sy*b->y.ptr.p_double[i]; - return result; - } - v = ae_fabs(t-v, _state); - if( ae_fp_less(v,s) ) - { - s = v; - } - } - s1 = 0; - s2 = 0; - for(i=0; i<=b->n-1; i++) - { - v = s/(t-b->x.ptr.p_double[i]); - v = v*b->w.ptr.p_double[i]; - s1 = s1+v*b->y.ptr.p_double[i]; - s2 = s2+v; - } - result = b->sy*s1/s2; - return result; -} - - -/************************************************************************* -Differentiation of barycentric interpolant: first derivative. - -Algorithm used in this subroutine is very robust and should not fail until -provided with values too close to MaxRealNumber (usually MaxRealNumber/N -or greater will overflow). - -INPUT PARAMETERS: - B - barycentric interpolant built with one of model building - subroutines. - T - interpolation point - -OUTPUT PARAMETERS: - F - barycentric interpolant at T - DF - first derivative - -NOTE - - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void barycentricdiff1(barycentricinterpolant* b, - double t, - double* f, - double* df, - ae_state *_state) -{ - double v; - double vv; - ae_int_t i; - ae_int_t k; - double n0; - double n1; - double d0; - double d1; - double s0; - double s1; - double xk; - double xi; - double xmin; - double xmax; - double xscale1; - double xoffs1; - double xscale2; - double xoffs2; - double xprev; - - *f = 0; - *df = 0; - - ae_assert(!ae_isinf(t, _state), "BarycentricDiff1: infinite T!", _state); - - /* - * special case: NaN - */ - if( ae_isnan(t, _state) ) - { - *f = _state->v_nan; - *df = _state->v_nan; - return; - } - - /* - * special case: N=1 - */ - if( b->n==1 ) - { - *f = b->sy*b->y.ptr.p_double[0]; - *df = 0; - return; - } - if( ae_fp_eq(b->sy,0) ) - { - *f = 0; - *df = 0; - return; - } - ae_assert(ae_fp_greater(b->sy,0), "BarycentricDiff1: internal error", _state); - - /* - * We assume than N>1 and B.SY>0. Find: - * 1. pivot point (X[i] closest to T) - * 2. width of interval containing X[i] - */ - v = ae_fabs(b->x.ptr.p_double[0]-t, _state); - k = 0; - xmin = b->x.ptr.p_double[0]; - xmax = b->x.ptr.p_double[0]; - for(i=1; i<=b->n-1; i++) - { - vv = b->x.ptr.p_double[i]; - if( ae_fp_less(ae_fabs(vv-t, _state),v) ) - { - v = ae_fabs(vv-t, _state); - k = i; - } - xmin = ae_minreal(xmin, vv, _state); - xmax = ae_maxreal(xmax, vv, _state); - } - - /* - * pivot point found, calculate dNumerator and dDenominator - */ - xscale1 = 1/(xmax-xmin); - xoffs1 = -xmin/(xmax-xmin)+1; - xscale2 = 2; - xoffs2 = -3; - t = t*xscale1+xoffs1; - t = t*xscale2+xoffs2; - xk = b->x.ptr.p_double[k]; - xk = xk*xscale1+xoffs1; - xk = xk*xscale2+xoffs2; - v = t-xk; - n0 = 0; - n1 = 0; - d0 = 0; - d1 = 0; - xprev = -2; - for(i=0; i<=b->n-1; i++) - { - xi = b->x.ptr.p_double[i]; - xi = xi*xscale1+xoffs1; - xi = xi*xscale2+xoffs2; - ae_assert(ae_fp_greater(xi,xprev), "BarycentricDiff1: points are too close!", _state); - xprev = xi; - if( i!=k ) - { - vv = ae_sqr(t-xi, _state); - s0 = (t-xk)/(t-xi); - s1 = (xk-xi)/vv; - } - else - { - s0 = 1; - s1 = 0; - } - vv = b->w.ptr.p_double[i]*b->y.ptr.p_double[i]; - n0 = n0+s0*vv; - n1 = n1+s1*vv; - vv = b->w.ptr.p_double[i]; - d0 = d0+s0*vv; - d1 = d1+s1*vv; - } - *f = b->sy*n0/d0; - *df = (n1*d0-n0*d1)/ae_sqr(d0, _state); - if( ae_fp_neq(*df,0) ) - { - *df = ae_sign(*df, _state)*ae_exp(ae_log(ae_fabs(*df, _state), _state)+ae_log(b->sy, _state)+ae_log(xscale1, _state)+ae_log(xscale2, _state), _state); - } -} - - -/************************************************************************* -Differentiation of barycentric interpolant: first/second derivatives. - -INPUT PARAMETERS: - B - barycentric interpolant built with one of model building - subroutines. - T - interpolation point - -OUTPUT PARAMETERS: - F - barycentric interpolant at T - DF - first derivative - D2F - second derivative - -NOTE: this algorithm may fail due to overflow/underflor if used on data -whose values are close to MaxRealNumber or MinRealNumber. Use more robust -BarycentricDiff1() subroutine in such cases. - - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void barycentricdiff2(barycentricinterpolant* b, - double t, - double* f, - double* df, - double* d2f, - ae_state *_state) -{ - double v; - double vv; - ae_int_t i; - ae_int_t k; - double n0; - double n1; - double n2; - double d0; - double d1; - double d2; - double s0; - double s1; - double s2; - double xk; - double xi; - - *f = 0; - *df = 0; - *d2f = 0; - - ae_assert(!ae_isinf(t, _state), "BarycentricDiff1: infinite T!", _state); - - /* - * special case: NaN - */ - if( ae_isnan(t, _state) ) - { - *f = _state->v_nan; - *df = _state->v_nan; - *d2f = _state->v_nan; - return; - } - - /* - * special case: N=1 - */ - if( b->n==1 ) - { - *f = b->sy*b->y.ptr.p_double[0]; - *df = 0; - *d2f = 0; - return; - } - if( ae_fp_eq(b->sy,0) ) - { - *f = 0; - *df = 0; - *d2f = 0; - return; - } - - /* - * We assume than N>1 and B.SY>0. Find: - * 1. pivot point (X[i] closest to T) - * 2. width of interval containing X[i] - */ - ae_assert(ae_fp_greater(b->sy,0), "BarycentricDiff: internal error", _state); - *f = 0; - *df = 0; - *d2f = 0; - v = ae_fabs(b->x.ptr.p_double[0]-t, _state); - k = 0; - for(i=1; i<=b->n-1; i++) - { - vv = b->x.ptr.p_double[i]; - if( ae_fp_less(ae_fabs(vv-t, _state),v) ) - { - v = ae_fabs(vv-t, _state); - k = i; - } - } - - /* - * pivot point found, calculate dNumerator and dDenominator - */ - xk = b->x.ptr.p_double[k]; - v = t-xk; - n0 = 0; - n1 = 0; - n2 = 0; - d0 = 0; - d1 = 0; - d2 = 0; - for(i=0; i<=b->n-1; i++) - { - if( i!=k ) - { - xi = b->x.ptr.p_double[i]; - vv = ae_sqr(t-xi, _state); - s0 = (t-xk)/(t-xi); - s1 = (xk-xi)/vv; - s2 = -2*(xk-xi)/(vv*(t-xi)); - } - else - { - s0 = 1; - s1 = 0; - s2 = 0; - } - vv = b->w.ptr.p_double[i]*b->y.ptr.p_double[i]; - n0 = n0+s0*vv; - n1 = n1+s1*vv; - n2 = n2+s2*vv; - vv = b->w.ptr.p_double[i]; - d0 = d0+s0*vv; - d1 = d1+s1*vv; - d2 = d2+s2*vv; - } - *f = b->sy*n0/d0; - *df = b->sy*(n1*d0-n0*d1)/ae_sqr(d0, _state); - *d2f = b->sy*((n2*d0-n0*d2)*ae_sqr(d0, _state)-(n1*d0-n0*d1)*2*d0*d1)/ae_sqr(ae_sqr(d0, _state), _state); -} - - -/************************************************************************* -This subroutine performs linear transformation of the argument. - -INPUT PARAMETERS: - B - rational interpolant in barycentric form - CA, CB - transformation coefficients: x = CA*t + CB - -OUTPUT PARAMETERS: - B - transformed interpolant with X replaced by T - - -- ALGLIB PROJECT -- - Copyright 19.08.2009 by Bochkanov Sergey -*************************************************************************/ -void barycentriclintransx(barycentricinterpolant* b, - double ca, - double cb, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - double v; - - - - /* - * special case, replace by constant F(CB) - */ - if( ae_fp_eq(ca,0) ) - { - b->sy = barycentriccalc(b, cb, _state); - v = 1; - for(i=0; i<=b->n-1; i++) - { - b->y.ptr.p_double[i] = 1; - b->w.ptr.p_double[i] = v; - v = -v; - } - return; - } - - /* - * general case: CA<>0 - */ - for(i=0; i<=b->n-1; i++) - { - b->x.ptr.p_double[i] = (b->x.ptr.p_double[i]-cb)/ca; - } - if( ae_fp_less(ca,0) ) - { - for(i=0; i<=b->n-1; i++) - { - if( in-1-i ) - { - j = b->n-1-i; - v = b->x.ptr.p_double[i]; - b->x.ptr.p_double[i] = b->x.ptr.p_double[j]; - b->x.ptr.p_double[j] = v; - v = b->y.ptr.p_double[i]; - b->y.ptr.p_double[i] = b->y.ptr.p_double[j]; - b->y.ptr.p_double[j] = v; - v = b->w.ptr.p_double[i]; - b->w.ptr.p_double[i] = b->w.ptr.p_double[j]; - b->w.ptr.p_double[j] = v; - } - else - { - break; - } - } - } -} - - -/************************************************************************* -This subroutine performs linear transformation of the barycentric -interpolant. - -INPUT PARAMETERS: - B - rational interpolant in barycentric form - CA, CB - transformation coefficients: B2(x) = CA*B(x) + CB - -OUTPUT PARAMETERS: - B - transformed interpolant - - -- ALGLIB PROJECT -- - Copyright 19.08.2009 by Bochkanov Sergey -*************************************************************************/ -void barycentriclintransy(barycentricinterpolant* b, - double ca, - double cb, - ae_state *_state) -{ - ae_int_t i; - double v; - - - for(i=0; i<=b->n-1; i++) - { - b->y.ptr.p_double[i] = ca*b->sy*b->y.ptr.p_double[i]+cb; - } - b->sy = 0; - for(i=0; i<=b->n-1; i++) - { - b->sy = ae_maxreal(b->sy, ae_fabs(b->y.ptr.p_double[i], _state), _state); - } - if( ae_fp_greater(b->sy,0) ) - { - v = 1/b->sy; - ae_v_muld(&b->y.ptr.p_double[0], 1, ae_v_len(0,b->n-1), v); - } -} - - -/************************************************************************* -Extracts X/Y/W arrays from rational interpolant - -INPUT PARAMETERS: - B - barycentric interpolant - -OUTPUT PARAMETERS: - N - nodes count, N>0 - X - interpolation nodes, array[0..N-1] - F - function values, array[0..N-1] - W - barycentric weights, array[0..N-1] - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void barycentricunpack(barycentricinterpolant* b, - ae_int_t* n, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* w, - ae_state *_state) -{ - double v; - - *n = 0; - ae_vector_clear(x); - ae_vector_clear(y); - ae_vector_clear(w); - - *n = b->n; - ae_vector_set_length(x, *n, _state); - ae_vector_set_length(y, *n, _state); - ae_vector_set_length(w, *n, _state); - v = b->sy; - ae_v_move(&x->ptr.p_double[0], 1, &b->x.ptr.p_double[0], 1, ae_v_len(0,*n-1)); - ae_v_moved(&y->ptr.p_double[0], 1, &b->y.ptr.p_double[0], 1, ae_v_len(0,*n-1), v); - ae_v_move(&w->ptr.p_double[0], 1, &b->w.ptr.p_double[0], 1, ae_v_len(0,*n-1)); -} - - -/************************************************************************* -Rational interpolant from X/Y/W arrays - -F(t) = SUM(i=0,n-1,w[i]*f[i]/(t-x[i])) / SUM(i=0,n-1,w[i]/(t-x[i])) - -INPUT PARAMETERS: - X - interpolation nodes, array[0..N-1] - F - function values, array[0..N-1] - W - barycentric weights, array[0..N-1] - N - nodes count, N>0 - -OUTPUT PARAMETERS: - B - barycentric interpolant built from (X, Y, W) - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void barycentricbuildxyw(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* w, - ae_int_t n, - barycentricinterpolant* b, - ae_state *_state) -{ - - _barycentricinterpolant_clear(b); - - ae_assert(n>0, "BarycentricBuildXYW: incorrect N!", _state); - - /* - * fill X/Y/W - */ - ae_vector_set_length(&b->x, n, _state); - ae_vector_set_length(&b->y, n, _state); - ae_vector_set_length(&b->w, n, _state); - ae_v_move(&b->x.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_move(&b->y.ptr.p_double[0], 1, &y->ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_move(&b->w.ptr.p_double[0], 1, &w->ptr.p_double[0], 1, ae_v_len(0,n-1)); - b->n = n; - - /* - * Normalize - */ - ratint_barycentricnormalize(b, _state); -} - - -/************************************************************************* -Rational interpolant without poles - -The subroutine constructs the rational interpolating function without real -poles (see 'Barycentric rational interpolation with no poles and high -rates of approximation', Michael S. Floater. and Kai Hormann, for more -information on this subject). - -Input parameters: - X - interpolation nodes, array[0..N-1]. - Y - function values, array[0..N-1]. - N - number of nodes, N>0. - D - order of the interpolation scheme, 0 <= D <= N-1. - D<0 will cause an error. - D>=N it will be replaced with D=N-1. - if you don't know what D to choose, use small value about 3-5. - -Output parameters: - B - barycentric interpolant. - -Note: - this algorithm always succeeds and calculates the weights with close - to machine precision. - - -- ALGLIB PROJECT -- - Copyright 17.06.2007 by Bochkanov Sergey -*************************************************************************/ -void barycentricbuildfloaterhormann(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_int_t d, - barycentricinterpolant* b, - ae_state *_state) -{ - ae_frame _frame_block; - double s0; - double s; - double v; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_vector perm; - ae_vector wtemp; - ae_vector sortrbuf; - ae_vector sortrbuf2; - - ae_frame_make(_state, &_frame_block); - _barycentricinterpolant_clear(b); - ae_vector_init(&perm, 0, DT_INT, _state, ae_true); - ae_vector_init(&wtemp, 0, DT_REAL, _state, ae_true); - ae_vector_init(&sortrbuf, 0, DT_REAL, _state, ae_true); - ae_vector_init(&sortrbuf2, 0, DT_REAL, _state, ae_true); - - ae_assert(n>0, "BarycentricFloaterHormann: N<=0!", _state); - ae_assert(d>=0, "BarycentricFloaterHormann: incorrect D!", _state); - - /* - * Prepare - */ - if( d>n-1 ) - { - d = n-1; - } - b->n = n; - - /* - * special case: N=1 - */ - if( n==1 ) - { - ae_vector_set_length(&b->x, n, _state); - ae_vector_set_length(&b->y, n, _state); - ae_vector_set_length(&b->w, n, _state); - b->x.ptr.p_double[0] = x->ptr.p_double[0]; - b->y.ptr.p_double[0] = y->ptr.p_double[0]; - b->w.ptr.p_double[0] = 1; - ratint_barycentricnormalize(b, _state); - ae_frame_leave(_state); - return; - } - - /* - * Fill X/Y - */ - ae_vector_set_length(&b->x, n, _state); - ae_vector_set_length(&b->y, n, _state); - ae_v_move(&b->x.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_move(&b->y.ptr.p_double[0], 1, &y->ptr.p_double[0], 1, ae_v_len(0,n-1)); - tagsortfastr(&b->x, &b->y, &sortrbuf, &sortrbuf2, n, _state); - - /* - * Calculate Wk - */ - ae_vector_set_length(&b->w, n, _state); - s0 = 1; - for(k=1; k<=d; k++) - { - s0 = -s0; - } - for(k=0; k<=n-1; k++) - { - - /* - * Wk - */ - s = 0; - for(i=ae_maxint(k-d, 0, _state); i<=ae_minint(k, n-1-d, _state); i++) - { - v = 1; - for(j=i; j<=i+d; j++) - { - if( j!=k ) - { - v = v/ae_fabs(b->x.ptr.p_double[k]-b->x.ptr.p_double[j], _state); - } - } - s = s+v; - } - b->w.ptr.p_double[k] = s0*s; - - /* - * Next S0 - */ - s0 = -s0; - } - - /* - * Normalize - */ - ratint_barycentricnormalize(b, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Copying of the barycentric interpolant (for internal use only) - -INPUT PARAMETERS: - B - barycentric interpolant - -OUTPUT PARAMETERS: - B2 - copy(B1) - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void barycentriccopy(barycentricinterpolant* b, - barycentricinterpolant* b2, - ae_state *_state) -{ - - _barycentricinterpolant_clear(b2); - - b2->n = b->n; - b2->sy = b->sy; - ae_vector_set_length(&b2->x, b2->n, _state); - ae_vector_set_length(&b2->y, b2->n, _state); - ae_vector_set_length(&b2->w, b2->n, _state); - ae_v_move(&b2->x.ptr.p_double[0], 1, &b->x.ptr.p_double[0], 1, ae_v_len(0,b2->n-1)); - ae_v_move(&b2->y.ptr.p_double[0], 1, &b->y.ptr.p_double[0], 1, ae_v_len(0,b2->n-1)); - ae_v_move(&b2->w.ptr.p_double[0], 1, &b->w.ptr.p_double[0], 1, ae_v_len(0,b2->n-1)); -} - - -/************************************************************************* -Normalization of barycentric interpolant: -* B.N, B.X, B.Y and B.W are initialized -* B.SY is NOT initialized -* Y[] is normalized, scaling coefficient is stored in B.SY -* W[] is normalized, no scaling coefficient is stored -* X[] is sorted - -Internal subroutine. -*************************************************************************/ -static void ratint_barycentricnormalize(barycentricinterpolant* b, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector p1; - ae_vector p2; - ae_int_t i; - ae_int_t j; - ae_int_t j2; - double v; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&p1, 0, DT_INT, _state, ae_true); - ae_vector_init(&p2, 0, DT_INT, _state, ae_true); - - - /* - * Normalize task: |Y|<=1, |W|<=1, sort X[] - */ - b->sy = 0; - for(i=0; i<=b->n-1; i++) - { - b->sy = ae_maxreal(b->sy, ae_fabs(b->y.ptr.p_double[i], _state), _state); - } - if( ae_fp_greater(b->sy,0)&&ae_fp_greater(ae_fabs(b->sy-1, _state),10*ae_machineepsilon) ) - { - v = 1/b->sy; - ae_v_muld(&b->y.ptr.p_double[0], 1, ae_v_len(0,b->n-1), v); - } - v = 0; - for(i=0; i<=b->n-1; i++) - { - v = ae_maxreal(v, ae_fabs(b->w.ptr.p_double[i], _state), _state); - } - if( ae_fp_greater(v,0)&&ae_fp_greater(ae_fabs(v-1, _state),10*ae_machineepsilon) ) - { - v = 1/v; - ae_v_muld(&b->w.ptr.p_double[0], 1, ae_v_len(0,b->n-1), v); - } - for(i=0; i<=b->n-2; i++) - { - if( ae_fp_less(b->x.ptr.p_double[i+1],b->x.ptr.p_double[i]) ) - { - tagsort(&b->x, b->n, &p1, &p2, _state); - for(j=0; j<=b->n-1; j++) - { - j2 = p2.ptr.p_int[j]; - v = b->y.ptr.p_double[j]; - b->y.ptr.p_double[j] = b->y.ptr.p_double[j2]; - b->y.ptr.p_double[j2] = v; - v = b->w.ptr.p_double[j]; - b->w.ptr.p_double[j] = b->w.ptr.p_double[j2]; - b->w.ptr.p_double[j2] = v; - } - break; - } - } - ae_frame_leave(_state); -} - - -ae_bool _barycentricinterpolant_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - barycentricinterpolant *p = (barycentricinterpolant*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->y, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->w, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _barycentricinterpolant_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - barycentricinterpolant *dst = (barycentricinterpolant*)_dst; - barycentricinterpolant *src = (barycentricinterpolant*)_src; - dst->n = src->n; - dst->sy = src->sy; - if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->y, &src->y, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->w, &src->w, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _barycentricinterpolant_clear(void* _p) -{ - barycentricinterpolant *p = (barycentricinterpolant*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->x); - ae_vector_clear(&p->y); - ae_vector_clear(&p->w); -} - - -void _barycentricinterpolant_destroy(void* _p) -{ - barycentricinterpolant *p = (barycentricinterpolant*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->x); - ae_vector_destroy(&p->y); - ae_vector_destroy(&p->w); -} - - - - -/************************************************************************* -Conversion from barycentric representation to Chebyshev basis. -This function has O(N^2) complexity. - -INPUT PARAMETERS: - P - polynomial in barycentric form - A,B - base interval for Chebyshev polynomials (see below) - A<>B - -OUTPUT PARAMETERS - T - coefficients of Chebyshev representation; - P(x) = sum { T[i]*Ti(2*(x-A)/(B-A)-1), i=0..N-1 }, - where Ti - I-th Chebyshev polynomial. - -NOTES: - barycentric interpolant passed as P may be either polynomial obtained - from polynomial interpolation/ fitting or rational function which is - NOT polynomial. We can't distinguish between these two cases, and this - algorithm just tries to work assuming that P IS a polynomial. If not, - algorithm will return results, but they won't have any meaning. - - -- ALGLIB -- - Copyright 30.09.2010 by Bochkanov Sergey -*************************************************************************/ -void polynomialbar2cheb(barycentricinterpolant* p, - double a, - double b, - /* Real */ ae_vector* t, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t k; - ae_vector vp; - ae_vector vx; - ae_vector tk; - ae_vector tk1; - double v; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(t); - ae_vector_init(&vp, 0, DT_REAL, _state, ae_true); - ae_vector_init(&vx, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tk, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tk1, 0, DT_REAL, _state, ae_true); - - ae_assert(ae_isfinite(a, _state), "PolynomialBar2Cheb: A is not finite!", _state); - ae_assert(ae_isfinite(b, _state), "PolynomialBar2Cheb: B is not finite!", _state); - ae_assert(ae_fp_neq(a,b), "PolynomialBar2Cheb: A=B!", _state); - ae_assert(p->n>0, "PolynomialBar2Cheb: P is not correctly initialized barycentric interpolant!", _state); - - /* - * Calculate function values on a Chebyshev grid - */ - ae_vector_set_length(&vp, p->n, _state); - ae_vector_set_length(&vx, p->n, _state); - for(i=0; i<=p->n-1; i++) - { - vx.ptr.p_double[i] = ae_cos(ae_pi*(i+0.5)/p->n, _state); - vp.ptr.p_double[i] = barycentriccalc(p, 0.5*(vx.ptr.p_double[i]+1)*(b-a)+a, _state); - } - - /* - * T[0] - */ - ae_vector_set_length(t, p->n, _state); - v = 0; - for(i=0; i<=p->n-1; i++) - { - v = v+vp.ptr.p_double[i]; - } - t->ptr.p_double[0] = v/p->n; - - /* - * other T's. - * - * NOTES: - * 1. TK stores T{k} on VX, TK1 stores T{k-1} on VX - * 2. we can do same calculations with fast DCT, but it - * * adds dependencies - * * still leaves us with O(N^2) algorithm because - * preparation of function values is O(N^2) process - */ - if( p->n>1 ) - { - ae_vector_set_length(&tk, p->n, _state); - ae_vector_set_length(&tk1, p->n, _state); - for(i=0; i<=p->n-1; i++) - { - tk.ptr.p_double[i] = vx.ptr.p_double[i]; - tk1.ptr.p_double[i] = 1; - } - for(k=1; k<=p->n-1; k++) - { - - /* - * calculate discrete product of function vector and TK - */ - v = ae_v_dotproduct(&tk.ptr.p_double[0], 1, &vp.ptr.p_double[0], 1, ae_v_len(0,p->n-1)); - t->ptr.p_double[k] = v/(0.5*p->n); - - /* - * Update TK and TK1 - */ - for(i=0; i<=p->n-1; i++) - { - v = 2*vx.ptr.p_double[i]*tk.ptr.p_double[i]-tk1.ptr.p_double[i]; - tk1.ptr.p_double[i] = tk.ptr.p_double[i]; - tk.ptr.p_double[i] = v; - } - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Conversion from Chebyshev basis to barycentric representation. -This function has O(N^2) complexity. - -INPUT PARAMETERS: - T - coefficients of Chebyshev representation; - P(x) = sum { T[i]*Ti(2*(x-A)/(B-A)-1), i=0..N }, - where Ti - I-th Chebyshev polynomial. - N - number of coefficients: - * if given, only leading N elements of T are used - * if not given, automatically determined from size of T - A,B - base interval for Chebyshev polynomials (see above) - A=1, "PolynomialBar2Cheb: N<1", _state); - ae_assert(t->cnt>=n, "PolynomialBar2Cheb: Length(T)ptr.p_double[0]; - tk1 = 1; - tk = vx; - for(k=1; k<=n-1; k++) - { - vy = vy+t->ptr.p_double[k]*tk; - v = 2*vx*tk-tk1; - tk1 = tk; - tk = v; - } - y.ptr.p_double[i] = vy; - } - - /* - * Build barycentric interpolant, map grid from [-1,+1] to [A,B] - */ - polynomialbuildcheb1(a, b, &y, n, p, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Conversion from barycentric representation to power basis. -This function has O(N^2) complexity. - -INPUT PARAMETERS: - P - polynomial in barycentric form - C - offset (see below); 0.0 is used as default value. - S - scale (see below); 1.0 is used as default value. S<>0. - -OUTPUT PARAMETERS - A - coefficients, P(x) = sum { A[i]*((X-C)/S)^i, i=0..N-1 } - N - number of coefficients (polynomial degree plus 1) - -NOTES: -1. this function accepts offset and scale, which can be set to improve - numerical properties of polynomial. For example, if P was obtained as - result of interpolation on [-1,+1], you can set C=0 and S=1 and - represent P as sum of 1, x, x^2, x^3 and so on. In most cases you it - is exactly what you need. - - However, if your interpolation model was built on [999,1001], you will - see significant growth of numerical errors when using {1, x, x^2, x^3} - as basis. Representing P as sum of 1, (x-1000), (x-1000)^2, (x-1000)^3 - will be better option. Such representation can be obtained by using - 1000.0 as offset C and 1.0 as scale S. - -2. power basis is ill-conditioned and tricks described above can't solve - this problem completely. This function will return coefficients in - any case, but for N>8 they will become unreliable. However, N's - less than 5 are pretty safe. - -3. barycentric interpolant passed as P may be either polynomial obtained - from polynomial interpolation/ fitting or rational function which is - NOT polynomial. We can't distinguish between these two cases, and this - algorithm just tries to work assuming that P IS a polynomial. If not, - algorithm will return results, but they won't have any meaning. - - -- ALGLIB -- - Copyright 30.09.2010 by Bochkanov Sergey -*************************************************************************/ -void polynomialbar2pow(barycentricinterpolant* p, - double c, - double s, - /* Real */ ae_vector* a, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t k; - double e; - double d; - ae_vector vp; - ae_vector vx; - ae_vector tk; - ae_vector tk1; - ae_vector t; - double v; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(a); - ae_vector_init(&vp, 0, DT_REAL, _state, ae_true); - ae_vector_init(&vx, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tk, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tk1, 0, DT_REAL, _state, ae_true); - ae_vector_init(&t, 0, DT_REAL, _state, ae_true); - - ae_assert(ae_isfinite(c, _state), "PolynomialBar2Pow: C is not finite!", _state); - ae_assert(ae_isfinite(s, _state), "PolynomialBar2Pow: S is not finite!", _state); - ae_assert(ae_fp_neq(s,0), "PolynomialBar2Pow: S=0!", _state); - ae_assert(p->n>0, "PolynomialBar2Pow: P is not correctly initialized barycentric interpolant!", _state); - - /* - * Calculate function values on a Chebyshev grid - */ - ae_vector_set_length(&vp, p->n, _state); - ae_vector_set_length(&vx, p->n, _state); - for(i=0; i<=p->n-1; i++) - { - vx.ptr.p_double[i] = ae_cos(ae_pi*(i+0.5)/p->n, _state); - vp.ptr.p_double[i] = barycentriccalc(p, s*vx.ptr.p_double[i]+c, _state); - } - - /* - * T[0] - */ - ae_vector_set_length(&t, p->n, _state); - v = 0; - for(i=0; i<=p->n-1; i++) - { - v = v+vp.ptr.p_double[i]; - } - t.ptr.p_double[0] = v/p->n; - - /* - * other T's. - * - * NOTES: - * 1. TK stores T{k} on VX, TK1 stores T{k-1} on VX - * 2. we can do same calculations with fast DCT, but it - * * adds dependencies - * * still leaves us with O(N^2) algorithm because - * preparation of function values is O(N^2) process - */ - if( p->n>1 ) - { - ae_vector_set_length(&tk, p->n, _state); - ae_vector_set_length(&tk1, p->n, _state); - for(i=0; i<=p->n-1; i++) - { - tk.ptr.p_double[i] = vx.ptr.p_double[i]; - tk1.ptr.p_double[i] = 1; - } - for(k=1; k<=p->n-1; k++) - { - - /* - * calculate discrete product of function vector and TK - */ - v = ae_v_dotproduct(&tk.ptr.p_double[0], 1, &vp.ptr.p_double[0], 1, ae_v_len(0,p->n-1)); - t.ptr.p_double[k] = v/(0.5*p->n); - - /* - * Update TK and TK1 - */ - for(i=0; i<=p->n-1; i++) - { - v = 2*vx.ptr.p_double[i]*tk.ptr.p_double[i]-tk1.ptr.p_double[i]; - tk1.ptr.p_double[i] = tk.ptr.p_double[i]; - tk.ptr.p_double[i] = v; - } - } - } - - /* - * Convert from Chebyshev basis to power basis - */ - ae_vector_set_length(a, p->n, _state); - for(i=0; i<=p->n-1; i++) - { - a->ptr.p_double[i] = 0; - } - d = 0; - for(i=0; i<=p->n-1; i++) - { - for(k=i; k<=p->n-1; k++) - { - e = a->ptr.p_double[k]; - a->ptr.p_double[k] = 0; - if( i<=1&&k==i ) - { - a->ptr.p_double[k] = 1; - } - else - { - if( i!=0 ) - { - a->ptr.p_double[k] = 2*d; - } - if( k>i+1 ) - { - a->ptr.p_double[k] = a->ptr.p_double[k]-a->ptr.p_double[k-2]; - } - } - d = e; - } - d = a->ptr.p_double[i]; - e = 0; - k = i; - while(k<=p->n-1) - { - e = e+a->ptr.p_double[k]*t.ptr.p_double[k]; - k = k+2; - } - a->ptr.p_double[i] = e; - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Conversion from power basis to barycentric representation. -This function has O(N^2) complexity. - -INPUT PARAMETERS: - A - coefficients, P(x) = sum { A[i]*((X-C)/S)^i, i=0..N-1 } - N - number of coefficients (polynomial degree plus 1) - * if given, only leading N elements of A are used - * if not given, automatically determined from size of A - C - offset (see below); 0.0 is used as default value. - S - scale (see below); 1.0 is used as default value. S<>0. - -OUTPUT PARAMETERS - P - polynomial in barycentric form - - -NOTES: -1. this function accepts offset and scale, which can be set to improve - numerical properties of polynomial. For example, if you interpolate on - [-1,+1], you can set C=0 and S=1 and convert from sum of 1, x, x^2, - x^3 and so on. In most cases you it is exactly what you need. - - However, if your interpolation model was built on [999,1001], you will - see significant growth of numerical errors when using {1, x, x^2, x^3} - as input basis. Converting from sum of 1, (x-1000), (x-1000)^2, - (x-1000)^3 will be better option (you have to specify 1000.0 as offset - C and 1.0 as scale S). - -2. power basis is ill-conditioned and tricks described above can't solve - this problem completely. This function will return barycentric model - in any case, but for N>8 accuracy well degrade. However, N's less than - 5 are pretty safe. - - -- ALGLIB -- - Copyright 30.09.2010 by Bochkanov Sergey -*************************************************************************/ -void polynomialpow2bar(/* Real */ ae_vector* a, - ae_int_t n, - double c, - double s, - barycentricinterpolant* p, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t k; - ae_vector y; - double vx; - double vy; - double px; - - ae_frame_make(_state, &_frame_block); - _barycentricinterpolant_clear(p); - ae_vector_init(&y, 0, DT_REAL, _state, ae_true); - - ae_assert(ae_isfinite(c, _state), "PolynomialPow2Bar: C is not finite!", _state); - ae_assert(ae_isfinite(s, _state), "PolynomialPow2Bar: S is not finite!", _state); - ae_assert(ae_fp_neq(s,0), "PolynomialPow2Bar: S is zero!", _state); - ae_assert(n>=1, "PolynomialPow2Bar: N<1", _state); - ae_assert(a->cnt>=n, "PolynomialPow2Bar: Length(A)ptr.p_double[0]; - px = vx; - for(k=1; k<=n-1; k++) - { - vy = vy+px*a->ptr.p_double[k]; - px = px*vx; - } - y.ptr.p_double[i] = vy; - } - - /* - * Build barycentric interpolant, map grid from [-1,+1] to [A,B] - */ - polynomialbuildcheb1(c-s, c+s, &y, n, p, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Lagrange intepolant: generation of the model on the general grid. -This function has O(N^2) complexity. - -INPUT PARAMETERS: - X - abscissas, array[0..N-1] - Y - function values, array[0..N-1] - N - number of points, N>=1 - -OUTPUT PARAMETERS - P - barycentric model which represents Lagrange interpolant - (see ratint unit info and BarycentricCalc() description for - more information). - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -void polynomialbuild(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - barycentricinterpolant* p, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _x; - ae_vector _y; - ae_int_t j; - ae_int_t k; - ae_vector w; - double b; - double a; - double v; - double mx; - ae_vector sortrbuf; - ae_vector sortrbuf2; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_x, x, _state, ae_true); - x = &_x; - ae_vector_init_copy(&_y, y, _state, ae_true); - y = &_y; - _barycentricinterpolant_clear(p); - ae_vector_init(&w, 0, DT_REAL, _state, ae_true); - ae_vector_init(&sortrbuf, 0, DT_REAL, _state, ae_true); - ae_vector_init(&sortrbuf2, 0, DT_REAL, _state, ae_true); - - ae_assert(n>0, "PolynomialBuild: N<=0!", _state); - ae_assert(x->cnt>=n, "PolynomialBuild: Length(X)cnt>=n, "PolynomialBuild: Length(Y)ptr.p_double[0]; - b = x->ptr.p_double[0]; - for(j=0; j<=n-1; j++) - { - w.ptr.p_double[j] = 1; - a = ae_minreal(a, x->ptr.p_double[j], _state); - b = ae_maxreal(b, x->ptr.p_double[j], _state); - } - for(k=0; k<=n-1; k++) - { - - /* - * W[K] is used instead of 0.0 because - * cycle on J does not touch K-th element - * and we MUST get maximum from ALL elements - */ - mx = ae_fabs(w.ptr.p_double[k], _state); - for(j=0; j<=n-1; j++) - { - if( j!=k ) - { - v = (b-a)/(x->ptr.p_double[j]-x->ptr.p_double[k]); - w.ptr.p_double[j] = w.ptr.p_double[j]*v; - mx = ae_maxreal(mx, ae_fabs(w.ptr.p_double[j], _state), _state); - } - } - if( k%5==0 ) - { - - /* - * every 5-th run we renormalize W[] - */ - v = 1/mx; - ae_v_muld(&w.ptr.p_double[0], 1, ae_v_len(0,n-1), v); - } - } - barycentricbuildxyw(x, y, &w, n, p, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Lagrange intepolant: generation of the model on equidistant grid. -This function has O(N) complexity. - -INPUT PARAMETERS: - A - left boundary of [A,B] - B - right boundary of [A,B] - Y - function values at the nodes, array[0..N-1] - N - number of points, N>=1 - for N=1 a constant model is constructed. - -OUTPUT PARAMETERS - P - barycentric model which represents Lagrange interpolant - (see ratint unit info and BarycentricCalc() description for - more information). - - -- ALGLIB -- - Copyright 03.12.2009 by Bochkanov Sergey -*************************************************************************/ -void polynomialbuildeqdist(double a, - double b, - /* Real */ ae_vector* y, - ae_int_t n, - barycentricinterpolant* p, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_vector w; - ae_vector x; - double v; - - ae_frame_make(_state, &_frame_block); - _barycentricinterpolant_clear(p); - ae_vector_init(&w, 0, DT_REAL, _state, ae_true); - ae_vector_init(&x, 0, DT_REAL, _state, ae_true); - - ae_assert(n>0, "PolynomialBuildEqDist: N<=0!", _state); - ae_assert(y->cnt>=n, "PolynomialBuildEqDist: Length(Y)=1 - for N=1 a constant model is constructed. - -OUTPUT PARAMETERS - P - barycentric model which represents Lagrange interpolant - (see ratint unit info and BarycentricCalc() description for - more information). - - -- ALGLIB -- - Copyright 03.12.2009 by Bochkanov Sergey -*************************************************************************/ -void polynomialbuildcheb1(double a, - double b, - /* Real */ ae_vector* y, - ae_int_t n, - barycentricinterpolant* p, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_vector w; - ae_vector x; - double v; - double t; - - ae_frame_make(_state, &_frame_block); - _barycentricinterpolant_clear(p); - ae_vector_init(&w, 0, DT_REAL, _state, ae_true); - ae_vector_init(&x, 0, DT_REAL, _state, ae_true); - - ae_assert(n>0, "PolynomialBuildCheb1: N<=0!", _state); - ae_assert(y->cnt>=n, "PolynomialBuildCheb1: Length(Y)=1 - for N=1 a constant model is constructed. - -OUTPUT PARAMETERS - P - barycentric model which represents Lagrange interpolant - (see ratint unit info and BarycentricCalc() description for - more information). - - -- ALGLIB -- - Copyright 03.12.2009 by Bochkanov Sergey -*************************************************************************/ -void polynomialbuildcheb2(double a, - double b, - /* Real */ ae_vector* y, - ae_int_t n, - barycentricinterpolant* p, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_vector w; - ae_vector x; - double v; - - ae_frame_make(_state, &_frame_block); - _barycentricinterpolant_clear(p); - ae_vector_init(&w, 0, DT_REAL, _state, ae_true); - ae_vector_init(&x, 0, DT_REAL, _state, ae_true); - - ae_assert(n>0, "PolynomialBuildCheb2: N<=0!", _state); - ae_assert(y->cnt>=n, "PolynomialBuildCheb2: Length(Y)=1 - for N=1 a constant model is constructed. - T - position where P(x) is calculated - -RESULT - value of the Lagrange interpolant at T - -IMPORTANT - this function provides fast interface which is not overflow-safe - nor it is very precise. - the best option is to use PolynomialBuildEqDist()/BarycentricCalc() - subroutines unless you are pretty sure that your data will not result - in overflow. - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -double polynomialcalceqdist(double a, - double b, - /* Real */ ae_vector* f, - ae_int_t n, - double t, - ae_state *_state) -{ - double s1; - double s2; - double v; - double threshold; - double s; - double h; - ae_int_t i; - ae_int_t j; - double w; - double x; - double result; - - - ae_assert(n>0, "PolynomialCalcEqDist: N<=0!", _state); - ae_assert(f->cnt>=n, "PolynomialCalcEqDist: Length(F)v_nan; - return result; - } - - /* - * Special case: N=1 - */ - if( n==1 ) - { - result = f->ptr.p_double[0]; - return result; - } - - /* - * First, decide: should we use "safe" formula (guarded - * against overflow) or fast one? - */ - threshold = ae_sqrt(ae_minrealnumber, _state); - j = 0; - s = t-a; - for(i=1; i<=n-1; i++) - { - x = a+(double)i/(double)(n-1)*(b-a); - if( ae_fp_less(ae_fabs(t-x, _state),ae_fabs(s, _state)) ) - { - s = t-x; - j = i; - } - } - if( ae_fp_eq(s,0) ) - { - result = f->ptr.p_double[j]; - return result; - } - if( ae_fp_greater(ae_fabs(s, _state),threshold) ) - { - - /* - * use fast formula - */ - j = -1; - s = 1.0; - } - - /* - * Calculate using safe or fast barycentric formula - */ - s1 = 0; - s2 = 0; - w = 1.0; - h = (b-a)/(n-1); - for(i=0; i<=n-1; i++) - { - if( i!=j ) - { - v = s*w/(t-(a+i*h)); - s1 = s1+v*f->ptr.p_double[i]; - s2 = s2+v; - } - else - { - v = w; - s1 = s1+v*f->ptr.p_double[i]; - s2 = s2+v; - } - w = -w*(n-1-i); - w = w/(i+1); - } - result = s1/s2; - return result; -} - - -/************************************************************************* -Fast polynomial interpolation function on Chebyshev points (first kind) -with O(N) complexity. - -INPUT PARAMETERS: - A - left boundary of [A,B] - B - right boundary of [A,B] - F - function values, array[0..N-1] - N - number of points on Chebyshev grid (first kind), - X[i] = 0.5*(B+A) + 0.5*(B-A)*Cos(PI*(2*i+1)/(2*n)) - for N=1 a constant model is constructed. - T - position where P(x) is calculated - -RESULT - value of the Lagrange interpolant at T - -IMPORTANT - this function provides fast interface which is not overflow-safe - nor it is very precise. - the best option is to use PolIntBuildCheb1()/BarycentricCalc() - subroutines unless you are pretty sure that your data will not result - in overflow. - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -double polynomialcalccheb1(double a, - double b, - /* Real */ ae_vector* f, - ae_int_t n, - double t, - ae_state *_state) -{ - double s1; - double s2; - double v; - double threshold; - double s; - ae_int_t i; - ae_int_t j; - double a0; - double delta; - double alpha; - double beta; - double ca; - double sa; - double tempc; - double temps; - double x; - double w; - double p1; - double result; - - - ae_assert(n>0, "PolynomialCalcCheb1: N<=0!", _state); - ae_assert(f->cnt>=n, "PolynomialCalcCheb1: Length(F)v_nan; - return result; - } - - /* - * Special case: N=1 - */ - if( n==1 ) - { - result = f->ptr.p_double[0]; - return result; - } - - /* - * Prepare information for the recurrence formula - * used to calculate sin(pi*(2j+1)/(2n+2)) and - * cos(pi*(2j+1)/(2n+2)): - * - * A0 = pi/(2n+2) - * Delta = pi/(n+1) - * Alpha = 2 sin^2 (Delta/2) - * Beta = sin(Delta) - * - * so that sin(..) = sin(A0+j*delta) and cos(..) = cos(A0+j*delta). - * Then we use - * - * sin(x+delta) = sin(x) - (alpha*sin(x) - beta*cos(x)) - * cos(x+delta) = cos(x) - (alpha*cos(x) - beta*sin(x)) - * - * to repeatedly calculate sin(..) and cos(..). - */ - threshold = ae_sqrt(ae_minrealnumber, _state); - t = (t-0.5*(a+b))/(0.5*(b-a)); - a0 = ae_pi/(2*(n-1)+2); - delta = 2*ae_pi/(2*(n-1)+2); - alpha = 2*ae_sqr(ae_sin(delta/2, _state), _state); - beta = ae_sin(delta, _state); - - /* - * First, decide: should we use "safe" formula (guarded - * against overflow) or fast one? - */ - ca = ae_cos(a0, _state); - sa = ae_sin(a0, _state); - j = 0; - x = ca; - s = t-x; - for(i=1; i<=n-1; i++) - { - - /* - * Next X[i] - */ - temps = sa-(alpha*sa-beta*ca); - tempc = ca-(alpha*ca+beta*sa); - sa = temps; - ca = tempc; - x = ca; - - /* - * Use X[i] - */ - if( ae_fp_less(ae_fabs(t-x, _state),ae_fabs(s, _state)) ) - { - s = t-x; - j = i; - } - } - if( ae_fp_eq(s,0) ) - { - result = f->ptr.p_double[j]; - return result; - } - if( ae_fp_greater(ae_fabs(s, _state),threshold) ) - { - - /* - * use fast formula - */ - j = -1; - s = 1.0; - } - - /* - * Calculate using safe or fast barycentric formula - */ - s1 = 0; - s2 = 0; - ca = ae_cos(a0, _state); - sa = ae_sin(a0, _state); - p1 = 1.0; - for(i=0; i<=n-1; i++) - { - - /* - * Calculate X[i], W[i] - */ - x = ca; - w = p1*sa; - - /* - * Proceed - */ - if( i!=j ) - { - v = s*w/(t-x); - s1 = s1+v*f->ptr.p_double[i]; - s2 = s2+v; - } - else - { - v = w; - s1 = s1+v*f->ptr.p_double[i]; - s2 = s2+v; - } - - /* - * Next CA, SA, P1 - */ - temps = sa-(alpha*sa-beta*ca); - tempc = ca-(alpha*ca+beta*sa); - sa = temps; - ca = tempc; - p1 = -p1; - } - result = s1/s2; - return result; -} - - -/************************************************************************* -Fast polynomial interpolation function on Chebyshev points (second kind) -with O(N) complexity. - -INPUT PARAMETERS: - A - left boundary of [A,B] - B - right boundary of [A,B] - F - function values, array[0..N-1] - N - number of points on Chebyshev grid (second kind), - X[i] = 0.5*(B+A) + 0.5*(B-A)*Cos(PI*i/(n-1)) - for N=1 a constant model is constructed. - T - position where P(x) is calculated - -RESULT - value of the Lagrange interpolant at T - -IMPORTANT - this function provides fast interface which is not overflow-safe - nor it is very precise. - the best option is to use PolIntBuildCheb2()/BarycentricCalc() - subroutines unless you are pretty sure that your data will not result - in overflow. - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -double polynomialcalccheb2(double a, - double b, - /* Real */ ae_vector* f, - ae_int_t n, - double t, - ae_state *_state) -{ - double s1; - double s2; - double v; - double threshold; - double s; - ae_int_t i; - ae_int_t j; - double a0; - double delta; - double alpha; - double beta; - double ca; - double sa; - double tempc; - double temps; - double x; - double w; - double p1; - double result; - - - ae_assert(n>0, "PolynomialCalcCheb2: N<=0!", _state); - ae_assert(f->cnt>=n, "PolynomialCalcCheb2: Length(F)v_nan; - return result; - } - - /* - * Special case: N=1 - */ - if( n==1 ) - { - result = f->ptr.p_double[0]; - return result; - } - - /* - * Prepare information for the recurrence formula - * used to calculate sin(pi*i/n) and - * cos(pi*i/n): - * - * A0 = 0 - * Delta = pi/n - * Alpha = 2 sin^2 (Delta/2) - * Beta = sin(Delta) - * - * so that sin(..) = sin(A0+j*delta) and cos(..) = cos(A0+j*delta). - * Then we use - * - * sin(x+delta) = sin(x) - (alpha*sin(x) - beta*cos(x)) - * cos(x+delta) = cos(x) - (alpha*cos(x) - beta*sin(x)) - * - * to repeatedly calculate sin(..) and cos(..). - */ - threshold = ae_sqrt(ae_minrealnumber, _state); - t = (t-0.5*(a+b))/(0.5*(b-a)); - a0 = 0.0; - delta = ae_pi/(n-1); - alpha = 2*ae_sqr(ae_sin(delta/2, _state), _state); - beta = ae_sin(delta, _state); - - /* - * First, decide: should we use "safe" formula (guarded - * against overflow) or fast one? - */ - ca = ae_cos(a0, _state); - sa = ae_sin(a0, _state); - j = 0; - x = ca; - s = t-x; - for(i=1; i<=n-1; i++) - { - - /* - * Next X[i] - */ - temps = sa-(alpha*sa-beta*ca); - tempc = ca-(alpha*ca+beta*sa); - sa = temps; - ca = tempc; - x = ca; - - /* - * Use X[i] - */ - if( ae_fp_less(ae_fabs(t-x, _state),ae_fabs(s, _state)) ) - { - s = t-x; - j = i; - } - } - if( ae_fp_eq(s,0) ) - { - result = f->ptr.p_double[j]; - return result; - } - if( ae_fp_greater(ae_fabs(s, _state),threshold) ) - { - - /* - * use fast formula - */ - j = -1; - s = 1.0; - } - - /* - * Calculate using safe or fast barycentric formula - */ - s1 = 0; - s2 = 0; - ca = ae_cos(a0, _state); - sa = ae_sin(a0, _state); - p1 = 1.0; - for(i=0; i<=n-1; i++) - { - - /* - * Calculate X[i], W[i] - */ - x = ca; - if( i==0||i==n-1 ) - { - w = 0.5*p1; - } - else - { - w = 1.0*p1; - } - - /* - * Proceed - */ - if( i!=j ) - { - v = s*w/(t-x); - s1 = s1+v*f->ptr.p_double[i]; - s2 = s2+v; - } - else - { - v = w; - s1 = s1+v*f->ptr.p_double[i]; - s2 = s2+v; - } - - /* - * Next CA, SA, P1 - */ - temps = sa-(alpha*sa-beta*ca); - tempc = ca-(alpha*ca+beta*sa); - sa = temps; - ca = tempc; - p1 = -p1; - } - result = s1/s2; - return result; -} - - - - -/************************************************************************* -This subroutine builds linear spline interpolant - -INPUT PARAMETERS: - X - spline nodes, array[0..N-1] - Y - function values, array[0..N-1] - N - points count (optional): - * N>=2 - * if given, only first N points are used to build spline - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - -OUTPUT PARAMETERS: - C - spline interpolant - - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. - - -- ALGLIB PROJECT -- - Copyright 24.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline1dbuildlinear(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - spline1dinterpolant* c, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _x; - ae_vector _y; - ae_int_t i; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_x, x, _state, ae_true); - x = &_x; - ae_vector_init_copy(&_y, y, _state, ae_true); - y = &_y; - _spline1dinterpolant_clear(c); - - ae_assert(n>1, "Spline1DBuildLinear: N<2!", _state); - ae_assert(x->cnt>=n, "Spline1DBuildLinear: Length(X)cnt>=n, "Spline1DBuildLinear: Length(Y)periodic = ae_false; - c->n = n; - c->k = 3; - c->continuity = 0; - ae_vector_set_length(&c->x, n, _state); - ae_vector_set_length(&c->c, 4*(n-1)+2, _state); - for(i=0; i<=n-1; i++) - { - c->x.ptr.p_double[i] = x->ptr.p_double[i]; - } - for(i=0; i<=n-2; i++) - { - c->c.ptr.p_double[4*i+0] = y->ptr.p_double[i]; - c->c.ptr.p_double[4*i+1] = (y->ptr.p_double[i+1]-y->ptr.p_double[i])/(x->ptr.p_double[i+1]-x->ptr.p_double[i]); - c->c.ptr.p_double[4*i+2] = 0; - c->c.ptr.p_double[4*i+3] = 0; - } - c->c.ptr.p_double[4*(n-1)+0] = y->ptr.p_double[n-1]; - c->c.ptr.p_double[4*(n-1)+1] = c->c.ptr.p_double[4*(n-2)+1]; - ae_frame_leave(_state); -} - - -/************************************************************************* -This subroutine builds cubic spline interpolant. - -INPUT PARAMETERS: - X - spline nodes, array[0..N-1]. - Y - function values, array[0..N-1]. - -OPTIONAL PARAMETERS: - N - points count: - * N>=2 - * if given, only first N points are used to build spline - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - BoundLType - boundary condition type for the left boundary - BoundL - left boundary condition (first or second derivative, - depending on the BoundLType) - BoundRType - boundary condition type for the right boundary - BoundR - right boundary condition (first or second derivative, - depending on the BoundRType) - -OUTPUT PARAMETERS: - C - spline interpolant - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. - -SETTING BOUNDARY VALUES: - -The BoundLType/BoundRType parameters can have the following values: - * -1, which corresonds to the periodic (cyclic) boundary conditions. - In this case: - * both BoundLType and BoundRType must be equal to -1. - * BoundL/BoundR are ignored - * Y[last] is ignored (it is assumed to be equal to Y[first]). - * 0, which corresponds to the parabolically terminated spline - (BoundL and/or BoundR are ignored). - * 1, which corresponds to the first derivative boundary condition - * 2, which corresponds to the second derivative boundary condition - * by default, BoundType=0 is used - -PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: - -Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. -However, this subroutine doesn't require you to specify equal values for -the first and last points - it automatically forces them to be equal by -copying Y[first_point] (corresponds to the leftmost, minimal X[]) to -Y[last_point]. However it is recommended to pass consistent values of Y[], -i.e. to make Y[first_point]=Y[last_point]. - - -- ALGLIB PROJECT -- - Copyright 23.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline1dbuildcubic(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_int_t boundltype, - double boundl, - ae_int_t boundrtype, - double boundr, - spline1dinterpolant* c, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _x; - ae_vector _y; - ae_vector a1; - ae_vector a2; - ae_vector a3; - ae_vector b; - ae_vector dt; - ae_vector d; - ae_vector p; - ae_int_t ylen; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_x, x, _state, ae_true); - x = &_x; - ae_vector_init_copy(&_y, y, _state, ae_true); - y = &_y; - _spline1dinterpolant_clear(c); - ae_vector_init(&a1, 0, DT_REAL, _state, ae_true); - ae_vector_init(&a2, 0, DT_REAL, _state, ae_true); - ae_vector_init(&a3, 0, DT_REAL, _state, ae_true); - ae_vector_init(&b, 0, DT_REAL, _state, ae_true); - ae_vector_init(&dt, 0, DT_REAL, _state, ae_true); - ae_vector_init(&d, 0, DT_REAL, _state, ae_true); - ae_vector_init(&p, 0, DT_INT, _state, ae_true); - - - /* - * check correctness of boundary conditions - */ - ae_assert(((boundltype==-1||boundltype==0)||boundltype==1)||boundltype==2, "Spline1DBuildCubic: incorrect BoundLType!", _state); - ae_assert(((boundrtype==-1||boundrtype==0)||boundrtype==1)||boundrtype==2, "Spline1DBuildCubic: incorrect BoundRType!", _state); - ae_assert((boundrtype==-1&&boundltype==-1)||(boundrtype!=-1&&boundltype!=-1), "Spline1DBuildCubic: incorrect BoundLType/BoundRType!", _state); - if( boundltype==1||boundltype==2 ) - { - ae_assert(ae_isfinite(boundl, _state), "Spline1DBuildCubic: BoundL is infinite or NAN!", _state); - } - if( boundrtype==1||boundrtype==2 ) - { - ae_assert(ae_isfinite(boundr, _state), "Spline1DBuildCubic: BoundR is infinite or NAN!", _state); - } - - /* - * check lengths of arguments - */ - ae_assert(n>=2, "Spline1DBuildCubic: N<2!", _state); - ae_assert(x->cnt>=n, "Spline1DBuildCubic: Length(X)cnt>=n, "Spline1DBuildCubic: Length(Y)ptr.p_double[n-1] = y->ptr.p_double[0]; - } - spline1d_spline1dgriddiffcubicinternal(x, y, n, boundltype, boundl, boundrtype, boundr, &d, &a1, &a2, &a3, &b, &dt, _state); - spline1dbuildhermite(x, y, &d, n, c, _state); - c->periodic = boundltype==-1||boundrtype==-1; - c->continuity = 2; - ae_frame_leave(_state); -} - - -/************************************************************************* -This function solves following problem: given table y[] of function values -at nodes x[], it calculates and returns table of function derivatives d[] -(calculated at the same nodes x[]). - -This function yields same result as Spline1DBuildCubic() call followed by -sequence of Spline1DDiff() calls, but it can be several times faster when -called for ordered X[] and X2[]. - -INPUT PARAMETERS: - X - spline nodes - Y - function values - -OPTIONAL PARAMETERS: - N - points count: - * N>=2 - * if given, only first N points are used - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - BoundLType - boundary condition type for the left boundary - BoundL - left boundary condition (first or second derivative, - depending on the BoundLType) - BoundRType - boundary condition type for the right boundary - BoundR - right boundary condition (first or second derivative, - depending on the BoundRType) - -OUTPUT PARAMETERS: - D - derivative values at X[] - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. -Derivative values are correctly reordered on return, so D[I] is always -equal to S'(X[I]) independently of points order. - -SETTING BOUNDARY VALUES: - -The BoundLType/BoundRType parameters can have the following values: - * -1, which corresonds to the periodic (cyclic) boundary conditions. - In this case: - * both BoundLType and BoundRType must be equal to -1. - * BoundL/BoundR are ignored - * Y[last] is ignored (it is assumed to be equal to Y[first]). - * 0, which corresponds to the parabolically terminated spline - (BoundL and/or BoundR are ignored). - * 1, which corresponds to the first derivative boundary condition - * 2, which corresponds to the second derivative boundary condition - * by default, BoundType=0 is used - -PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: - -Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. -However, this subroutine doesn't require you to specify equal values for -the first and last points - it automatically forces them to be equal by -copying Y[first_point] (corresponds to the leftmost, minimal X[]) to -Y[last_point]. However it is recommended to pass consistent values of Y[], -i.e. to make Y[first_point]=Y[last_point]. - - -- ALGLIB PROJECT -- - Copyright 03.09.2010 by Bochkanov Sergey -*************************************************************************/ -void spline1dgriddiffcubic(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_int_t boundltype, - double boundl, - ae_int_t boundrtype, - double boundr, - /* Real */ ae_vector* d, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _x; - ae_vector _y; - ae_vector a1; - ae_vector a2; - ae_vector a3; - ae_vector b; - ae_vector dt; - ae_vector p; - ae_int_t i; - ae_int_t ylen; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_x, x, _state, ae_true); - x = &_x; - ae_vector_init_copy(&_y, y, _state, ae_true); - y = &_y; - ae_vector_clear(d); - ae_vector_init(&a1, 0, DT_REAL, _state, ae_true); - ae_vector_init(&a2, 0, DT_REAL, _state, ae_true); - ae_vector_init(&a3, 0, DT_REAL, _state, ae_true); - ae_vector_init(&b, 0, DT_REAL, _state, ae_true); - ae_vector_init(&dt, 0, DT_REAL, _state, ae_true); - ae_vector_init(&p, 0, DT_INT, _state, ae_true); - - - /* - * check correctness of boundary conditions - */ - ae_assert(((boundltype==-1||boundltype==0)||boundltype==1)||boundltype==2, "Spline1DGridDiffCubic: incorrect BoundLType!", _state); - ae_assert(((boundrtype==-1||boundrtype==0)||boundrtype==1)||boundrtype==2, "Spline1DGridDiffCubic: incorrect BoundRType!", _state); - ae_assert((boundrtype==-1&&boundltype==-1)||(boundrtype!=-1&&boundltype!=-1), "Spline1DGridDiffCubic: incorrect BoundLType/BoundRType!", _state); - if( boundltype==1||boundltype==2 ) - { - ae_assert(ae_isfinite(boundl, _state), "Spline1DGridDiffCubic: BoundL is infinite or NAN!", _state); - } - if( boundrtype==1||boundrtype==2 ) - { - ae_assert(ae_isfinite(boundr, _state), "Spline1DGridDiffCubic: BoundR is infinite or NAN!", _state); - } - - /* - * check lengths of arguments - */ - ae_assert(n>=2, "Spline1DGridDiffCubic: N<2!", _state); - ae_assert(x->cnt>=n, "Spline1DGridDiffCubic: Length(X)cnt>=n, "Spline1DGridDiffCubic: Length(Y)ptr.p_double[i]; - } - ae_v_move(&d->ptr.p_double[0], 1, &dt.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_frame_leave(_state); -} - - -/************************************************************************* -This function solves following problem: given table y[] of function values -at nodes x[], it calculates and returns tables of first and second -function derivatives d1[] and d2[] (calculated at the same nodes x[]). - -This function yields same result as Spline1DBuildCubic() call followed by -sequence of Spline1DDiff() calls, but it can be several times faster when -called for ordered X[] and X2[]. - -INPUT PARAMETERS: - X - spline nodes - Y - function values - -OPTIONAL PARAMETERS: - N - points count: - * N>=2 - * if given, only first N points are used - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - BoundLType - boundary condition type for the left boundary - BoundL - left boundary condition (first or second derivative, - depending on the BoundLType) - BoundRType - boundary condition type for the right boundary - BoundR - right boundary condition (first or second derivative, - depending on the BoundRType) - -OUTPUT PARAMETERS: - D1 - S' values at X[] - D2 - S'' values at X[] - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. -Derivative values are correctly reordered on return, so D[I] is always -equal to S'(X[I]) independently of points order. - -SETTING BOUNDARY VALUES: - -The BoundLType/BoundRType parameters can have the following values: - * -1, which corresonds to the periodic (cyclic) boundary conditions. - In this case: - * both BoundLType and BoundRType must be equal to -1. - * BoundL/BoundR are ignored - * Y[last] is ignored (it is assumed to be equal to Y[first]). - * 0, which corresponds to the parabolically terminated spline - (BoundL and/or BoundR are ignored). - * 1, which corresponds to the first derivative boundary condition - * 2, which corresponds to the second derivative boundary condition - * by default, BoundType=0 is used - -PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: - -Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. -However, this subroutine doesn't require you to specify equal values for -the first and last points - it automatically forces them to be equal by -copying Y[first_point] (corresponds to the leftmost, minimal X[]) to -Y[last_point]. However it is recommended to pass consistent values of Y[], -i.e. to make Y[first_point]=Y[last_point]. - - -- ALGLIB PROJECT -- - Copyright 03.09.2010 by Bochkanov Sergey -*************************************************************************/ -void spline1dgriddiff2cubic(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_int_t boundltype, - double boundl, - ae_int_t boundrtype, - double boundr, - /* Real */ ae_vector* d1, - /* Real */ ae_vector* d2, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _x; - ae_vector _y; - ae_vector a1; - ae_vector a2; - ae_vector a3; - ae_vector b; - ae_vector dt; - ae_vector p; - ae_int_t i; - ae_int_t ylen; - double delta; - double delta2; - double delta3; - double s2; - double s3; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_x, x, _state, ae_true); - x = &_x; - ae_vector_init_copy(&_y, y, _state, ae_true); - y = &_y; - ae_vector_clear(d1); - ae_vector_clear(d2); - ae_vector_init(&a1, 0, DT_REAL, _state, ae_true); - ae_vector_init(&a2, 0, DT_REAL, _state, ae_true); - ae_vector_init(&a3, 0, DT_REAL, _state, ae_true); - ae_vector_init(&b, 0, DT_REAL, _state, ae_true); - ae_vector_init(&dt, 0, DT_REAL, _state, ae_true); - ae_vector_init(&p, 0, DT_INT, _state, ae_true); - - - /* - * check correctness of boundary conditions - */ - ae_assert(((boundltype==-1||boundltype==0)||boundltype==1)||boundltype==2, "Spline1DGridDiff2Cubic: incorrect BoundLType!", _state); - ae_assert(((boundrtype==-1||boundrtype==0)||boundrtype==1)||boundrtype==2, "Spline1DGridDiff2Cubic: incorrect BoundRType!", _state); - ae_assert((boundrtype==-1&&boundltype==-1)||(boundrtype!=-1&&boundltype!=-1), "Spline1DGridDiff2Cubic: incorrect BoundLType/BoundRType!", _state); - if( boundltype==1||boundltype==2 ) - { - ae_assert(ae_isfinite(boundl, _state), "Spline1DGridDiff2Cubic: BoundL is infinite or NAN!", _state); - } - if( boundrtype==1||boundrtype==2 ) - { - ae_assert(ae_isfinite(boundr, _state), "Spline1DGridDiff2Cubic: BoundR is infinite or NAN!", _state); - } - - /* - * check lengths of arguments - */ - ae_assert(n>=2, "Spline1DGridDiff2Cubic: N<2!", _state); - ae_assert(x->cnt>=n, "Spline1DGridDiff2Cubic: Length(X)cnt>=n, "Spline1DGridDiff2Cubic: Length(Y)ptr.p_double[i+1]-x->ptr.p_double[i]; - delta2 = ae_sqr(delta, _state); - delta3 = delta*delta2; - s2 = (3*(y->ptr.p_double[i+1]-y->ptr.p_double[i])-2*d1->ptr.p_double[i]*delta-d1->ptr.p_double[i+1]*delta)/delta2; - s3 = (2*(y->ptr.p_double[i]-y->ptr.p_double[i+1])+d1->ptr.p_double[i]*delta+d1->ptr.p_double[i+1]*delta)/delta3; - d2->ptr.p_double[i] = 2*s2; - } - d2->ptr.p_double[n-1] = 2*s2+6*s3*delta; - - /* - * Remember that HeapSortPPoints() call? - * Now we have to reorder them back. - */ - if( dt.cntptr.p_double[i]; - } - ae_v_move(&d1->ptr.p_double[0], 1, &dt.ptr.p_double[0], 1, ae_v_len(0,n-1)); - for(i=0; i<=n-1; i++) - { - dt.ptr.p_double[p.ptr.p_int[i]] = d2->ptr.p_double[i]; - } - ae_v_move(&d2->ptr.p_double[0], 1, &dt.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_frame_leave(_state); -} - - -/************************************************************************* -This function solves following problem: given table y[] of function values -at old nodes x[] and new nodes x2[], it calculates and returns table of -function values y2[] (calculated at x2[]). - -This function yields same result as Spline1DBuildCubic() call followed by -sequence of Spline1DDiff() calls, but it can be several times faster when -called for ordered X[] and X2[]. - -INPUT PARAMETERS: - X - old spline nodes - Y - function values - X2 - new spline nodes - -OPTIONAL PARAMETERS: - N - points count: - * N>=2 - * if given, only first N points from X/Y are used - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - BoundLType - boundary condition type for the left boundary - BoundL - left boundary condition (first or second derivative, - depending on the BoundLType) - BoundRType - boundary condition type for the right boundary - BoundR - right boundary condition (first or second derivative, - depending on the BoundRType) - N2 - new points count: - * N2>=2 - * if given, only first N2 points from X2 are used - * if not given, automatically detected from X2 size - -OUTPUT PARAMETERS: - F2 - function values at X2[] - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. -Function values are correctly reordered on return, so F2[I] is always -equal to S(X2[I]) independently of points order. - -SETTING BOUNDARY VALUES: - -The BoundLType/BoundRType parameters can have the following values: - * -1, which corresonds to the periodic (cyclic) boundary conditions. - In this case: - * both BoundLType and BoundRType must be equal to -1. - * BoundL/BoundR are ignored - * Y[last] is ignored (it is assumed to be equal to Y[first]). - * 0, which corresponds to the parabolically terminated spline - (BoundL and/or BoundR are ignored). - * 1, which corresponds to the first derivative boundary condition - * 2, which corresponds to the second derivative boundary condition - * by default, BoundType=0 is used - -PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: - -Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. -However, this subroutine doesn't require you to specify equal values for -the first and last points - it automatically forces them to be equal by -copying Y[first_point] (corresponds to the leftmost, minimal X[]) to -Y[last_point]. However it is recommended to pass consistent values of Y[], -i.e. to make Y[first_point]=Y[last_point]. - - -- ALGLIB PROJECT -- - Copyright 03.09.2010 by Bochkanov Sergey -*************************************************************************/ -void spline1dconvcubic(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_int_t boundltype, - double boundl, - ae_int_t boundrtype, - double boundr, - /* Real */ ae_vector* x2, - ae_int_t n2, - /* Real */ ae_vector* y2, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _x; - ae_vector _y; - ae_vector _x2; - ae_vector a1; - ae_vector a2; - ae_vector a3; - ae_vector b; - ae_vector d; - ae_vector dt; - ae_vector d1; - ae_vector d2; - ae_vector p; - ae_vector p2; - ae_int_t i; - ae_int_t ylen; - double t; - double t2; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_x, x, _state, ae_true); - x = &_x; - ae_vector_init_copy(&_y, y, _state, ae_true); - y = &_y; - ae_vector_init_copy(&_x2, x2, _state, ae_true); - x2 = &_x2; - ae_vector_clear(y2); - ae_vector_init(&a1, 0, DT_REAL, _state, ae_true); - ae_vector_init(&a2, 0, DT_REAL, _state, ae_true); - ae_vector_init(&a3, 0, DT_REAL, _state, ae_true); - ae_vector_init(&b, 0, DT_REAL, _state, ae_true); - ae_vector_init(&d, 0, DT_REAL, _state, ae_true); - ae_vector_init(&dt, 0, DT_REAL, _state, ae_true); - ae_vector_init(&d1, 0, DT_REAL, _state, ae_true); - ae_vector_init(&d2, 0, DT_REAL, _state, ae_true); - ae_vector_init(&p, 0, DT_INT, _state, ae_true); - ae_vector_init(&p2, 0, DT_INT, _state, ae_true); - - - /* - * check correctness of boundary conditions - */ - ae_assert(((boundltype==-1||boundltype==0)||boundltype==1)||boundltype==2, "Spline1DConvCubic: incorrect BoundLType!", _state); - ae_assert(((boundrtype==-1||boundrtype==0)||boundrtype==1)||boundrtype==2, "Spline1DConvCubic: incorrect BoundRType!", _state); - ae_assert((boundrtype==-1&&boundltype==-1)||(boundrtype!=-1&&boundltype!=-1), "Spline1DConvCubic: incorrect BoundLType/BoundRType!", _state); - if( boundltype==1||boundltype==2 ) - { - ae_assert(ae_isfinite(boundl, _state), "Spline1DConvCubic: BoundL is infinite or NAN!", _state); - } - if( boundrtype==1||boundrtype==2 ) - { - ae_assert(ae_isfinite(boundr, _state), "Spline1DConvCubic: BoundR is infinite or NAN!", _state); - } - - /* - * check lengths of arguments - */ - ae_assert(n>=2, "Spline1DConvCubic: N<2!", _state); - ae_assert(x->cnt>=n, "Spline1DConvCubic: Length(X)cnt>=n, "Spline1DConvCubic: Length(Y)=2, "Spline1DConvCubic: N2<2!", _state); - ae_assert(x2->cnt>=n2, "Spline1DConvCubic: Length(X2)ptr.p_double[i]; - apperiodicmap(&t, x->ptr.p_double[0], x->ptr.p_double[n-1], &t2, _state); - x2->ptr.p_double[i] = t; - } - } - spline1d_heapsortppoints(x2, &dt, &p2, n2, _state); - - /* - * Now we've checked and preordered everything, so we: - * * call internal GridDiff() function to get Hermite form of spline - * * convert using internal Conv() function - * * convert Y2 back to original order - */ - spline1d_spline1dgriddiffcubicinternal(x, y, n, boundltype, boundl, boundrtype, boundr, &d, &a1, &a2, &a3, &b, &dt, _state); - spline1dconvdiffinternal(x, y, &d, n, x2, n2, y2, ae_true, &d1, ae_false, &d2, ae_false, _state); - ae_assert(dt.cnt>=n2, "Spline1DConvCubic: internal error!", _state); - for(i=0; i<=n2-1; i++) - { - dt.ptr.p_double[p2.ptr.p_int[i]] = y2->ptr.p_double[i]; - } - ae_v_move(&y2->ptr.p_double[0], 1, &dt.ptr.p_double[0], 1, ae_v_len(0,n2-1)); - ae_frame_leave(_state); -} - - -/************************************************************************* -This function solves following problem: given table y[] of function values -at old nodes x[] and new nodes x2[], it calculates and returns table of -function values y2[] and derivatives d2[] (calculated at x2[]). - -This function yields same result as Spline1DBuildCubic() call followed by -sequence of Spline1DDiff() calls, but it can be several times faster when -called for ordered X[] and X2[]. - -INPUT PARAMETERS: - X - old spline nodes - Y - function values - X2 - new spline nodes - -OPTIONAL PARAMETERS: - N - points count: - * N>=2 - * if given, only first N points from X/Y are used - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - BoundLType - boundary condition type for the left boundary - BoundL - left boundary condition (first or second derivative, - depending on the BoundLType) - BoundRType - boundary condition type for the right boundary - BoundR - right boundary condition (first or second derivative, - depending on the BoundRType) - N2 - new points count: - * N2>=2 - * if given, only first N2 points from X2 are used - * if not given, automatically detected from X2 size - -OUTPUT PARAMETERS: - F2 - function values at X2[] - D2 - first derivatives at X2[] - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. -Function values are correctly reordered on return, so F2[I] is always -equal to S(X2[I]) independently of points order. - -SETTING BOUNDARY VALUES: - -The BoundLType/BoundRType parameters can have the following values: - * -1, which corresonds to the periodic (cyclic) boundary conditions. - In this case: - * both BoundLType and BoundRType must be equal to -1. - * BoundL/BoundR are ignored - * Y[last] is ignored (it is assumed to be equal to Y[first]). - * 0, which corresponds to the parabolically terminated spline - (BoundL and/or BoundR are ignored). - * 1, which corresponds to the first derivative boundary condition - * 2, which corresponds to the second derivative boundary condition - * by default, BoundType=0 is used - -PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: - -Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. -However, this subroutine doesn't require you to specify equal values for -the first and last points - it automatically forces them to be equal by -copying Y[first_point] (corresponds to the leftmost, minimal X[]) to -Y[last_point]. However it is recommended to pass consistent values of Y[], -i.e. to make Y[first_point]=Y[last_point]. - - -- ALGLIB PROJECT -- - Copyright 03.09.2010 by Bochkanov Sergey -*************************************************************************/ -void spline1dconvdiffcubic(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_int_t boundltype, - double boundl, - ae_int_t boundrtype, - double boundr, - /* Real */ ae_vector* x2, - ae_int_t n2, - /* Real */ ae_vector* y2, - /* Real */ ae_vector* d2, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _x; - ae_vector _y; - ae_vector _x2; - ae_vector a1; - ae_vector a2; - ae_vector a3; - ae_vector b; - ae_vector d; - ae_vector dt; - ae_vector rt1; - ae_vector p; - ae_vector p2; - ae_int_t i; - ae_int_t ylen; - double t; - double t2; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_x, x, _state, ae_true); - x = &_x; - ae_vector_init_copy(&_y, y, _state, ae_true); - y = &_y; - ae_vector_init_copy(&_x2, x2, _state, ae_true); - x2 = &_x2; - ae_vector_clear(y2); - ae_vector_clear(d2); - ae_vector_init(&a1, 0, DT_REAL, _state, ae_true); - ae_vector_init(&a2, 0, DT_REAL, _state, ae_true); - ae_vector_init(&a3, 0, DT_REAL, _state, ae_true); - ae_vector_init(&b, 0, DT_REAL, _state, ae_true); - ae_vector_init(&d, 0, DT_REAL, _state, ae_true); - ae_vector_init(&dt, 0, DT_REAL, _state, ae_true); - ae_vector_init(&rt1, 0, DT_REAL, _state, ae_true); - ae_vector_init(&p, 0, DT_INT, _state, ae_true); - ae_vector_init(&p2, 0, DT_INT, _state, ae_true); - - - /* - * check correctness of boundary conditions - */ - ae_assert(((boundltype==-1||boundltype==0)||boundltype==1)||boundltype==2, "Spline1DConvDiffCubic: incorrect BoundLType!", _state); - ae_assert(((boundrtype==-1||boundrtype==0)||boundrtype==1)||boundrtype==2, "Spline1DConvDiffCubic: incorrect BoundRType!", _state); - ae_assert((boundrtype==-1&&boundltype==-1)||(boundrtype!=-1&&boundltype!=-1), "Spline1DConvDiffCubic: incorrect BoundLType/BoundRType!", _state); - if( boundltype==1||boundltype==2 ) - { - ae_assert(ae_isfinite(boundl, _state), "Spline1DConvDiffCubic: BoundL is infinite or NAN!", _state); - } - if( boundrtype==1||boundrtype==2 ) - { - ae_assert(ae_isfinite(boundr, _state), "Spline1DConvDiffCubic: BoundR is infinite or NAN!", _state); - } - - /* - * check lengths of arguments - */ - ae_assert(n>=2, "Spline1DConvDiffCubic: N<2!", _state); - ae_assert(x->cnt>=n, "Spline1DConvDiffCubic: Length(X)cnt>=n, "Spline1DConvDiffCubic: Length(Y)=2, "Spline1DConvDiffCubic: N2<2!", _state); - ae_assert(x2->cnt>=n2, "Spline1DConvDiffCubic: Length(X2)ptr.p_double[i]; - apperiodicmap(&t, x->ptr.p_double[0], x->ptr.p_double[n-1], &t2, _state); - x2->ptr.p_double[i] = t; - } - } - spline1d_heapsortppoints(x2, &dt, &p2, n2, _state); - - /* - * Now we've checked and preordered everything, so we: - * * call internal GridDiff() function to get Hermite form of spline - * * convert using internal Conv() function - * * convert Y2 back to original order - */ - spline1d_spline1dgriddiffcubicinternal(x, y, n, boundltype, boundl, boundrtype, boundr, &d, &a1, &a2, &a3, &b, &dt, _state); - spline1dconvdiffinternal(x, y, &d, n, x2, n2, y2, ae_true, d2, ae_true, &rt1, ae_false, _state); - ae_assert(dt.cnt>=n2, "Spline1DConvDiffCubic: internal error!", _state); - for(i=0; i<=n2-1; i++) - { - dt.ptr.p_double[p2.ptr.p_int[i]] = y2->ptr.p_double[i]; - } - ae_v_move(&y2->ptr.p_double[0], 1, &dt.ptr.p_double[0], 1, ae_v_len(0,n2-1)); - for(i=0; i<=n2-1; i++) - { - dt.ptr.p_double[p2.ptr.p_int[i]] = d2->ptr.p_double[i]; - } - ae_v_move(&d2->ptr.p_double[0], 1, &dt.ptr.p_double[0], 1, ae_v_len(0,n2-1)); - ae_frame_leave(_state); -} - - -/************************************************************************* -This function solves following problem: given table y[] of function values -at old nodes x[] and new nodes x2[], it calculates and returns table of -function values y2[], first and second derivatives d2[] and dd2[] -(calculated at x2[]). - -This function yields same result as Spline1DBuildCubic() call followed by -sequence of Spline1DDiff() calls, but it can be several times faster when -called for ordered X[] and X2[]. - -INPUT PARAMETERS: - X - old spline nodes - Y - function values - X2 - new spline nodes - -OPTIONAL PARAMETERS: - N - points count: - * N>=2 - * if given, only first N points from X/Y are used - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - BoundLType - boundary condition type for the left boundary - BoundL - left boundary condition (first or second derivative, - depending on the BoundLType) - BoundRType - boundary condition type for the right boundary - BoundR - right boundary condition (first or second derivative, - depending on the BoundRType) - N2 - new points count: - * N2>=2 - * if given, only first N2 points from X2 are used - * if not given, automatically detected from X2 size - -OUTPUT PARAMETERS: - F2 - function values at X2[] - D2 - first derivatives at X2[] - DD2 - second derivatives at X2[] - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. -Function values are correctly reordered on return, so F2[I] is always -equal to S(X2[I]) independently of points order. - -SETTING BOUNDARY VALUES: - -The BoundLType/BoundRType parameters can have the following values: - * -1, which corresonds to the periodic (cyclic) boundary conditions. - In this case: - * both BoundLType and BoundRType must be equal to -1. - * BoundL/BoundR are ignored - * Y[last] is ignored (it is assumed to be equal to Y[first]). - * 0, which corresponds to the parabolically terminated spline - (BoundL and/or BoundR are ignored). - * 1, which corresponds to the first derivative boundary condition - * 2, which corresponds to the second derivative boundary condition - * by default, BoundType=0 is used - -PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: - -Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. -However, this subroutine doesn't require you to specify equal values for -the first and last points - it automatically forces them to be equal by -copying Y[first_point] (corresponds to the leftmost, minimal X[]) to -Y[last_point]. However it is recommended to pass consistent values of Y[], -i.e. to make Y[first_point]=Y[last_point]. - - -- ALGLIB PROJECT -- - Copyright 03.09.2010 by Bochkanov Sergey -*************************************************************************/ -void spline1dconvdiff2cubic(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_int_t boundltype, - double boundl, - ae_int_t boundrtype, - double boundr, - /* Real */ ae_vector* x2, - ae_int_t n2, - /* Real */ ae_vector* y2, - /* Real */ ae_vector* d2, - /* Real */ ae_vector* dd2, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _x; - ae_vector _y; - ae_vector _x2; - ae_vector a1; - ae_vector a2; - ae_vector a3; - ae_vector b; - ae_vector d; - ae_vector dt; - ae_vector p; - ae_vector p2; - ae_int_t i; - ae_int_t ylen; - double t; - double t2; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_x, x, _state, ae_true); - x = &_x; - ae_vector_init_copy(&_y, y, _state, ae_true); - y = &_y; - ae_vector_init_copy(&_x2, x2, _state, ae_true); - x2 = &_x2; - ae_vector_clear(y2); - ae_vector_clear(d2); - ae_vector_clear(dd2); - ae_vector_init(&a1, 0, DT_REAL, _state, ae_true); - ae_vector_init(&a2, 0, DT_REAL, _state, ae_true); - ae_vector_init(&a3, 0, DT_REAL, _state, ae_true); - ae_vector_init(&b, 0, DT_REAL, _state, ae_true); - ae_vector_init(&d, 0, DT_REAL, _state, ae_true); - ae_vector_init(&dt, 0, DT_REAL, _state, ae_true); - ae_vector_init(&p, 0, DT_INT, _state, ae_true); - ae_vector_init(&p2, 0, DT_INT, _state, ae_true); - - - /* - * check correctness of boundary conditions - */ - ae_assert(((boundltype==-1||boundltype==0)||boundltype==1)||boundltype==2, "Spline1DConvDiff2Cubic: incorrect BoundLType!", _state); - ae_assert(((boundrtype==-1||boundrtype==0)||boundrtype==1)||boundrtype==2, "Spline1DConvDiff2Cubic: incorrect BoundRType!", _state); - ae_assert((boundrtype==-1&&boundltype==-1)||(boundrtype!=-1&&boundltype!=-1), "Spline1DConvDiff2Cubic: incorrect BoundLType/BoundRType!", _state); - if( boundltype==1||boundltype==2 ) - { - ae_assert(ae_isfinite(boundl, _state), "Spline1DConvDiff2Cubic: BoundL is infinite or NAN!", _state); - } - if( boundrtype==1||boundrtype==2 ) - { - ae_assert(ae_isfinite(boundr, _state), "Spline1DConvDiff2Cubic: BoundR is infinite or NAN!", _state); - } - - /* - * check lengths of arguments - */ - ae_assert(n>=2, "Spline1DConvDiff2Cubic: N<2!", _state); - ae_assert(x->cnt>=n, "Spline1DConvDiff2Cubic: Length(X)cnt>=n, "Spline1DConvDiff2Cubic: Length(Y)=2, "Spline1DConvDiff2Cubic: N2<2!", _state); - ae_assert(x2->cnt>=n2, "Spline1DConvDiff2Cubic: Length(X2)ptr.p_double[i]; - apperiodicmap(&t, x->ptr.p_double[0], x->ptr.p_double[n-1], &t2, _state); - x2->ptr.p_double[i] = t; - } - } - spline1d_heapsortppoints(x2, &dt, &p2, n2, _state); - - /* - * Now we've checked and preordered everything, so we: - * * call internal GridDiff() function to get Hermite form of spline - * * convert using internal Conv() function - * * convert Y2 back to original order - */ - spline1d_spline1dgriddiffcubicinternal(x, y, n, boundltype, boundl, boundrtype, boundr, &d, &a1, &a2, &a3, &b, &dt, _state); - spline1dconvdiffinternal(x, y, &d, n, x2, n2, y2, ae_true, d2, ae_true, dd2, ae_true, _state); - ae_assert(dt.cnt>=n2, "Spline1DConvDiff2Cubic: internal error!", _state); - for(i=0; i<=n2-1; i++) - { - dt.ptr.p_double[p2.ptr.p_int[i]] = y2->ptr.p_double[i]; - } - ae_v_move(&y2->ptr.p_double[0], 1, &dt.ptr.p_double[0], 1, ae_v_len(0,n2-1)); - for(i=0; i<=n2-1; i++) - { - dt.ptr.p_double[p2.ptr.p_int[i]] = d2->ptr.p_double[i]; - } - ae_v_move(&d2->ptr.p_double[0], 1, &dt.ptr.p_double[0], 1, ae_v_len(0,n2-1)); - for(i=0; i<=n2-1; i++) - { - dt.ptr.p_double[p2.ptr.p_int[i]] = dd2->ptr.p_double[i]; - } - ae_v_move(&dd2->ptr.p_double[0], 1, &dt.ptr.p_double[0], 1, ae_v_len(0,n2-1)); - ae_frame_leave(_state); -} - - -/************************************************************************* -This subroutine builds Catmull-Rom spline interpolant. - -INPUT PARAMETERS: - X - spline nodes, array[0..N-1]. - Y - function values, array[0..N-1]. - -OPTIONAL PARAMETERS: - N - points count: - * N>=2 - * if given, only first N points are used to build spline - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - BoundType - boundary condition type: - * -1 for periodic boundary condition - * 0 for parabolically terminated spline (default) - Tension - tension parameter: - * tension=0 corresponds to classic Catmull-Rom spline (default) - * 0=2, "Spline1DBuildCatmullRom: N<2!", _state); - ae_assert(boundtype==-1||boundtype==0, "Spline1DBuildCatmullRom: incorrect BoundType!", _state); - ae_assert(ae_fp_greater_eq(tension,0), "Spline1DBuildCatmullRom: Tension<0!", _state); - ae_assert(ae_fp_less_eq(tension,1), "Spline1DBuildCatmullRom: Tension>1!", _state); - ae_assert(x->cnt>=n, "Spline1DBuildCatmullRom: Length(X)cnt>=n, "Spline1DBuildCatmullRom: Length(Y)ptr.p_double[n-1] = y->ptr.p_double[0]; - ae_vector_set_length(&d, n, _state); - d.ptr.p_double[0] = (y->ptr.p_double[1]-y->ptr.p_double[n-2])/(2*(x->ptr.p_double[1]-x->ptr.p_double[0]+x->ptr.p_double[n-1]-x->ptr.p_double[n-2])); - for(i=1; i<=n-2; i++) - { - d.ptr.p_double[i] = (1-tension)*(y->ptr.p_double[i+1]-y->ptr.p_double[i-1])/(x->ptr.p_double[i+1]-x->ptr.p_double[i-1]); - } - d.ptr.p_double[n-1] = d.ptr.p_double[0]; - - /* - * Now problem is reduced to the cubic Hermite spline - */ - spline1dbuildhermite(x, y, &d, n, c, _state); - c->periodic = ae_true; - } - else - { - - /* - * Non-periodic boundary conditions - */ - ae_vector_set_length(&d, n, _state); - for(i=1; i<=n-2; i++) - { - d.ptr.p_double[i] = (1-tension)*(y->ptr.p_double[i+1]-y->ptr.p_double[i-1])/(x->ptr.p_double[i+1]-x->ptr.p_double[i-1]); - } - d.ptr.p_double[0] = 2*(y->ptr.p_double[1]-y->ptr.p_double[0])/(x->ptr.p_double[1]-x->ptr.p_double[0])-d.ptr.p_double[1]; - d.ptr.p_double[n-1] = 2*(y->ptr.p_double[n-1]-y->ptr.p_double[n-2])/(x->ptr.p_double[n-1]-x->ptr.p_double[n-2])-d.ptr.p_double[n-2]; - - /* - * Now problem is reduced to the cubic Hermite spline - */ - spline1dbuildhermite(x, y, &d, n, c, _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -This subroutine builds Hermite spline interpolant. - -INPUT PARAMETERS: - X - spline nodes, array[0..N-1] - Y - function values, array[0..N-1] - D - derivatives, array[0..N-1] - N - points count (optional): - * N>=2 - * if given, only first N points are used to build spline - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - -OUTPUT PARAMETERS: - C - spline interpolant. - - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. - - -- ALGLIB PROJECT -- - Copyright 23.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline1dbuildhermite(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* d, - ae_int_t n, - spline1dinterpolant* c, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _x; - ae_vector _y; - ae_vector _d; - ae_int_t i; - double delta; - double delta2; - double delta3; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_x, x, _state, ae_true); - x = &_x; - ae_vector_init_copy(&_y, y, _state, ae_true); - y = &_y; - ae_vector_init_copy(&_d, d, _state, ae_true); - d = &_d; - _spline1dinterpolant_clear(c); - - ae_assert(n>=2, "Spline1DBuildHermite: N<2!", _state); - ae_assert(x->cnt>=n, "Spline1DBuildHermite: Length(X)cnt>=n, "Spline1DBuildHermite: Length(Y)cnt>=n, "Spline1DBuildHermite: Length(D)x, n, _state); - ae_vector_set_length(&c->c, 4*(n-1)+2, _state); - c->periodic = ae_false; - c->k = 3; - c->n = n; - c->continuity = 1; - for(i=0; i<=n-1; i++) - { - c->x.ptr.p_double[i] = x->ptr.p_double[i]; - } - for(i=0; i<=n-2; i++) - { - delta = x->ptr.p_double[i+1]-x->ptr.p_double[i]; - delta2 = ae_sqr(delta, _state); - delta3 = delta*delta2; - c->c.ptr.p_double[4*i+0] = y->ptr.p_double[i]; - c->c.ptr.p_double[4*i+1] = d->ptr.p_double[i]; - c->c.ptr.p_double[4*i+2] = (3*(y->ptr.p_double[i+1]-y->ptr.p_double[i])-2*d->ptr.p_double[i]*delta-d->ptr.p_double[i+1]*delta)/delta2; - c->c.ptr.p_double[4*i+3] = (2*(y->ptr.p_double[i]-y->ptr.p_double[i+1])+d->ptr.p_double[i]*delta+d->ptr.p_double[i+1]*delta)/delta3; - } - c->c.ptr.p_double[4*(n-1)+0] = y->ptr.p_double[n-1]; - c->c.ptr.p_double[4*(n-1)+1] = d->ptr.p_double[n-1]; - ae_frame_leave(_state); -} - - -/************************************************************************* -This subroutine builds Akima spline interpolant - -INPUT PARAMETERS: - X - spline nodes, array[0..N-1] - Y - function values, array[0..N-1] - N - points count (optional): - * N>=2 - * if given, only first N points are used to build spline - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - -OUTPUT PARAMETERS: - C - spline interpolant - - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. - - -- ALGLIB PROJECT -- - Copyright 24.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline1dbuildakima(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - spline1dinterpolant* c, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _x; - ae_vector _y; - ae_int_t i; - ae_vector d; - ae_vector w; - ae_vector diff; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_x, x, _state, ae_true); - x = &_x; - ae_vector_init_copy(&_y, y, _state, ae_true); - y = &_y; - _spline1dinterpolant_clear(c); - ae_vector_init(&d, 0, DT_REAL, _state, ae_true); - ae_vector_init(&w, 0, DT_REAL, _state, ae_true); - ae_vector_init(&diff, 0, DT_REAL, _state, ae_true); - - ae_assert(n>=2, "Spline1DBuildAkima: N<2!", _state); - ae_assert(x->cnt>=n, "Spline1DBuildAkima: Length(X)cnt>=n, "Spline1DBuildAkima: Length(Y)ptr.p_double[i+1]-y->ptr.p_double[i])/(x->ptr.p_double[i+1]-x->ptr.p_double[i]); - } - for(i=1; i<=n-2; i++) - { - w.ptr.p_double[i] = ae_fabs(diff.ptr.p_double[i]-diff.ptr.p_double[i-1], _state); - } - - /* - * Prepare Hermite interpolation scheme - */ - ae_vector_set_length(&d, n, _state); - for(i=2; i<=n-3; i++) - { - if( ae_fp_neq(ae_fabs(w.ptr.p_double[i-1], _state)+ae_fabs(w.ptr.p_double[i+1], _state),0) ) - { - d.ptr.p_double[i] = (w.ptr.p_double[i+1]*diff.ptr.p_double[i-1]+w.ptr.p_double[i-1]*diff.ptr.p_double[i])/(w.ptr.p_double[i+1]+w.ptr.p_double[i-1]); - } - else - { - d.ptr.p_double[i] = ((x->ptr.p_double[i+1]-x->ptr.p_double[i])*diff.ptr.p_double[i-1]+(x->ptr.p_double[i]-x->ptr.p_double[i-1])*diff.ptr.p_double[i])/(x->ptr.p_double[i+1]-x->ptr.p_double[i-1]); - } - } - d.ptr.p_double[0] = spline1d_diffthreepoint(x->ptr.p_double[0], x->ptr.p_double[0], y->ptr.p_double[0], x->ptr.p_double[1], y->ptr.p_double[1], x->ptr.p_double[2], y->ptr.p_double[2], _state); - d.ptr.p_double[1] = spline1d_diffthreepoint(x->ptr.p_double[1], x->ptr.p_double[0], y->ptr.p_double[0], x->ptr.p_double[1], y->ptr.p_double[1], x->ptr.p_double[2], y->ptr.p_double[2], _state); - d.ptr.p_double[n-2] = spline1d_diffthreepoint(x->ptr.p_double[n-2], x->ptr.p_double[n-3], y->ptr.p_double[n-3], x->ptr.p_double[n-2], y->ptr.p_double[n-2], x->ptr.p_double[n-1], y->ptr.p_double[n-1], _state); - d.ptr.p_double[n-1] = spline1d_diffthreepoint(x->ptr.p_double[n-1], x->ptr.p_double[n-3], y->ptr.p_double[n-3], x->ptr.p_double[n-2], y->ptr.p_double[n-2], x->ptr.p_double[n-1], y->ptr.p_double[n-1], _state); - - /* - * Build Akima spline using Hermite interpolation scheme - */ - spline1dbuildhermite(x, y, &d, n, c, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -This subroutine calculates the value of the spline at the given point X. - -INPUT PARAMETERS: - C - spline interpolant - X - point - -Result: - S(x) - - -- ALGLIB PROJECT -- - Copyright 23.06.2007 by Bochkanov Sergey -*************************************************************************/ -double spline1dcalc(spline1dinterpolant* c, double x, ae_state *_state) -{ - ae_int_t l; - ae_int_t r; - ae_int_t m; - double t; - double result; - - - ae_assert(c->k==3, "Spline1DCalc: internal error", _state); - ae_assert(!ae_isinf(x, _state), "Spline1DCalc: infinite X!", _state); - - /* - * special case: NaN - */ - if( ae_isnan(x, _state) ) - { - result = _state->v_nan; - return result; - } - - /* - * correct if periodic - */ - if( c->periodic ) - { - apperiodicmap(&x, c->x.ptr.p_double[0], c->x.ptr.p_double[c->n-1], &t, _state); - } - - /* - * Binary search in the [ x[0], ..., x[n-2] ] (x[n-1] is not included) - */ - l = 0; - r = c->n-2+1; - while(l!=r-1) - { - m = (l+r)/2; - if( c->x.ptr.p_double[m]>=x ) - { - r = m; - } - else - { - l = m; - } - } - - /* - * Interpolation - */ - x = x-c->x.ptr.p_double[l]; - m = 4*l; - result = c->c.ptr.p_double[m]+x*(c->c.ptr.p_double[m+1]+x*(c->c.ptr.p_double[m+2]+x*c->c.ptr.p_double[m+3])); - return result; -} - - -/************************************************************************* -This subroutine differentiates the spline. - -INPUT PARAMETERS: - C - spline interpolant. - X - point - -Result: - S - S(x) - DS - S'(x) - D2S - S''(x) - - -- ALGLIB PROJECT -- - Copyright 24.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline1ddiff(spline1dinterpolant* c, - double x, - double* s, - double* ds, - double* d2s, - ae_state *_state) -{ - ae_int_t l; - ae_int_t r; - ae_int_t m; - double t; - - *s = 0; - *ds = 0; - *d2s = 0; - - ae_assert(c->k==3, "Spline1DDiff: internal error", _state); - ae_assert(!ae_isinf(x, _state), "Spline1DDiff: infinite X!", _state); - - /* - * special case: NaN - */ - if( ae_isnan(x, _state) ) - { - *s = _state->v_nan; - *ds = _state->v_nan; - *d2s = _state->v_nan; - return; - } - - /* - * correct if periodic - */ - if( c->periodic ) - { - apperiodicmap(&x, c->x.ptr.p_double[0], c->x.ptr.p_double[c->n-1], &t, _state); - } - - /* - * Binary search - */ - l = 0; - r = c->n-2+1; - while(l!=r-1) - { - m = (l+r)/2; - if( c->x.ptr.p_double[m]>=x ) - { - r = m; - } - else - { - l = m; - } - } - - /* - * Differentiation - */ - x = x-c->x.ptr.p_double[l]; - m = 4*l; - *s = c->c.ptr.p_double[m]+x*(c->c.ptr.p_double[m+1]+x*(c->c.ptr.p_double[m+2]+x*c->c.ptr.p_double[m+3])); - *ds = c->c.ptr.p_double[m+1]+2*x*c->c.ptr.p_double[m+2]+3*ae_sqr(x, _state)*c->c.ptr.p_double[m+3]; - *d2s = 2*c->c.ptr.p_double[m+2]+6*x*c->c.ptr.p_double[m+3]; -} - - -/************************************************************************* -This subroutine makes the copy of the spline. - -INPUT PARAMETERS: - C - spline interpolant. - -Result: - CC - spline copy - - -- ALGLIB PROJECT -- - Copyright 29.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline1dcopy(spline1dinterpolant* c, - spline1dinterpolant* cc, - ae_state *_state) -{ - ae_int_t s; - - _spline1dinterpolant_clear(cc); - - cc->periodic = c->periodic; - cc->n = c->n; - cc->k = c->k; - cc->continuity = c->continuity; - ae_vector_set_length(&cc->x, cc->n, _state); - ae_v_move(&cc->x.ptr.p_double[0], 1, &c->x.ptr.p_double[0], 1, ae_v_len(0,cc->n-1)); - s = c->c.cnt; - ae_vector_set_length(&cc->c, s, _state); - ae_v_move(&cc->c.ptr.p_double[0], 1, &c->c.ptr.p_double[0], 1, ae_v_len(0,s-1)); -} - - -/************************************************************************* -This subroutine unpacks the spline into the coefficients table. - -INPUT PARAMETERS: - C - spline interpolant. - X - point - -OUTPUT PARAMETERS: - Tbl - coefficients table, unpacked format, array[0..N-2, 0..5]. - For I = 0...N-2: - Tbl[I,0] = X[i] - Tbl[I,1] = X[i+1] - Tbl[I,2] = C0 - Tbl[I,3] = C1 - Tbl[I,4] = C2 - Tbl[I,5] = C3 - On [x[i], x[i+1]] spline is equals to: - S(x) = C0 + C1*t + C2*t^2 + C3*t^3 - t = x-x[i] - -NOTE: - You can rebuild spline with Spline1DBuildHermite() function, which - accepts as inputs function values and derivatives at nodes, which are - easy to calculate when you have coefficients. - - -- ALGLIB PROJECT -- - Copyright 29.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline1dunpack(spline1dinterpolant* c, - ae_int_t* n, - /* Real */ ae_matrix* tbl, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - - *n = 0; - ae_matrix_clear(tbl); - - ae_matrix_set_length(tbl, c->n-2+1, 2+c->k+1, _state); - *n = c->n; - - /* - * Fill - */ - for(i=0; i<=*n-2; i++) - { - tbl->ptr.pp_double[i][0] = c->x.ptr.p_double[i]; - tbl->ptr.pp_double[i][1] = c->x.ptr.p_double[i+1]; - for(j=0; j<=c->k; j++) - { - tbl->ptr.pp_double[i][2+j] = c->c.ptr.p_double[(c->k+1)*i+j]; - } - } -} - - -/************************************************************************* -This subroutine performs linear transformation of the spline argument. - -INPUT PARAMETERS: - C - spline interpolant. - A, B- transformation coefficients: x = A*t + B -Result: - C - transformed spline - - -- ALGLIB PROJECT -- - Copyright 30.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline1dlintransx(spline1dinterpolant* c, - double a, - double b, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t n; - double v; - double dv; - double d2v; - ae_vector x; - ae_vector y; - ae_vector d; - ae_bool isperiodic; - ae_int_t contval; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&x, 0, DT_REAL, _state, ae_true); - ae_vector_init(&y, 0, DT_REAL, _state, ae_true); - ae_vector_init(&d, 0, DT_REAL, _state, ae_true); - - ae_assert(c->k==3, "Spline1DLinTransX: internal error", _state); - n = c->n; - ae_vector_set_length(&x, n, _state); - ae_vector_set_length(&y, n, _state); - ae_vector_set_length(&d, n, _state); - - /* - * Unpack, X, Y, dY/dX. - * Scale and pack with Spline1DBuildHermite again. - */ - if( ae_fp_eq(a,0) ) - { - - /* - * Special case: A=0 - */ - v = spline1dcalc(c, b, _state); - for(i=0; i<=n-1; i++) - { - x.ptr.p_double[i] = c->x.ptr.p_double[i]; - y.ptr.p_double[i] = v; - d.ptr.p_double[i] = 0.0; - } - } - else - { - - /* - * General case, A<>0 - */ - for(i=0; i<=n-1; i++) - { - x.ptr.p_double[i] = c->x.ptr.p_double[i]; - spline1ddiff(c, x.ptr.p_double[i], &v, &dv, &d2v, _state); - x.ptr.p_double[i] = (x.ptr.p_double[i]-b)/a; - y.ptr.p_double[i] = v; - d.ptr.p_double[i] = a*dv; - } - } - isperiodic = c->periodic; - contval = c->continuity; - if( contval>0 ) - { - spline1dbuildhermite(&x, &y, &d, n, c, _state); - } - else - { - spline1dbuildlinear(&x, &y, n, c, _state); - } - c->periodic = isperiodic; - c->continuity = contval; - ae_frame_leave(_state); -} - - -/************************************************************************* -This subroutine performs linear transformation of the spline. - -INPUT PARAMETERS: - C - spline interpolant. - A, B- transformation coefficients: S2(x) = A*S(x) + B -Result: - C - transformed spline - - -- ALGLIB PROJECT -- - Copyright 30.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline1dlintransy(spline1dinterpolant* c, - double a, - double b, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t n; - - - ae_assert(c->k==3, "Spline1DLinTransX: internal error", _state); - n = c->n; - for(i=0; i<=n-2; i++) - { - c->c.ptr.p_double[4*i] = a*c->c.ptr.p_double[4*i]+b; - for(j=1; j<=3; j++) - { - c->c.ptr.p_double[4*i+j] = a*c->c.ptr.p_double[4*i+j]; - } - } - c->c.ptr.p_double[4*(n-1)+0] = a*c->c.ptr.p_double[4*(n-1)+0]+b; - c->c.ptr.p_double[4*(n-1)+1] = a*c->c.ptr.p_double[4*(n-1)+1]; -} - - -/************************************************************************* -This subroutine integrates the spline. - -INPUT PARAMETERS: - C - spline interpolant. - X - right bound of the integration interval [a, x], - here 'a' denotes min(x[]) -Result: - integral(S(t)dt,a,x) - - -- ALGLIB PROJECT -- - Copyright 23.06.2007 by Bochkanov Sergey -*************************************************************************/ -double spline1dintegrate(spline1dinterpolant* c, - double x, - ae_state *_state) -{ - ae_int_t n; - ae_int_t i; - ae_int_t j; - ae_int_t l; - ae_int_t r; - ae_int_t m; - double w; - double v; - double t; - double intab; - double additionalterm; - double result; - - - n = c->n; - - /* - * Periodic splines require special treatment. We make - * following transformation: - * - * integral(S(t)dt,A,X) = integral(S(t)dt,A,Z)+AdditionalTerm - * - * here X may lie outside of [A,B], Z lies strictly in [A,B], - * AdditionalTerm is equals to integral(S(t)dt,A,B) times some - * integer number (may be zero). - */ - if( c->periodic&&(ae_fp_less(x,c->x.ptr.p_double[0])||ae_fp_greater(x,c->x.ptr.p_double[c->n-1])) ) - { - - /* - * compute integral(S(x)dx,A,B) - */ - intab = 0; - for(i=0; i<=c->n-2; i++) - { - w = c->x.ptr.p_double[i+1]-c->x.ptr.p_double[i]; - m = (c->k+1)*i; - intab = intab+c->c.ptr.p_double[m]*w; - v = w; - for(j=1; j<=c->k; j++) - { - v = v*w; - intab = intab+c->c.ptr.p_double[m+j]*v/(j+1); - } - } - - /* - * map X into [A,B] - */ - apperiodicmap(&x, c->x.ptr.p_double[0], c->x.ptr.p_double[c->n-1], &t, _state); - additionalterm = t*intab; - } - else - { - additionalterm = 0; - } - - /* - * Binary search in the [ x[0], ..., x[n-2] ] (x[n-1] is not included) - */ - l = 0; - r = n-2+1; - while(l!=r-1) - { - m = (l+r)/2; - if( ae_fp_greater_eq(c->x.ptr.p_double[m],x) ) - { - r = m; - } - else - { - l = m; - } - } - - /* - * Integration - */ - result = 0; - for(i=0; i<=l-1; i++) - { - w = c->x.ptr.p_double[i+1]-c->x.ptr.p_double[i]; - m = (c->k+1)*i; - result = result+c->c.ptr.p_double[m]*w; - v = w; - for(j=1; j<=c->k; j++) - { - v = v*w; - result = result+c->c.ptr.p_double[m+j]*v/(j+1); - } - } - w = x-c->x.ptr.p_double[l]; - m = (c->k+1)*l; - v = w; - result = result+c->c.ptr.p_double[m]*w; - for(j=1; j<=c->k; j++) - { - v = v*w; - result = result+c->c.ptr.p_double[m+j]*v/(j+1); - } - result = result+additionalterm; - return result; -} - - -/************************************************************************* -Internal version of Spline1DConvDiff - -Converts from Hermite spline given by grid XOld to new grid X2 - -INPUT PARAMETERS: - XOld - old grid - YOld - values at old grid - DOld - first derivative at old grid - N - grid size - X2 - new grid - N2 - new grid size - Y - possibly preallocated output array - (reallocate if too small) - NeedY - do we need Y? - D1 - possibly preallocated output array - (reallocate if too small) - NeedD1 - do we need D1? - D2 - possibly preallocated output array - (reallocate if too small) - NeedD2 - do we need D1? - -OUTPUT ARRAYS: - Y - values, if needed - D1 - first derivative, if needed - D2 - second derivative, if needed - - -- ALGLIB PROJECT -- - Copyright 03.09.2010 by Bochkanov Sergey -*************************************************************************/ -void spline1dconvdiffinternal(/* Real */ ae_vector* xold, - /* Real */ ae_vector* yold, - /* Real */ ae_vector* dold, - ae_int_t n, - /* Real */ ae_vector* x2, - ae_int_t n2, - /* Real */ ae_vector* y, - ae_bool needy, - /* Real */ ae_vector* d1, - ae_bool needd1, - /* Real */ ae_vector* d2, - ae_bool needd2, - ae_state *_state) -{ - ae_int_t intervalindex; - ae_int_t pointindex; - ae_bool havetoadvance; - double c0; - double c1; - double c2; - double c3; - double a; - double b; - double w; - double w2; - double w3; - double fa; - double fb; - double da; - double db; - double t; - - - - /* - * Prepare space - */ - if( needy&&y->cntcntcnt=n2 ) - { - break; - } - t = x2->ptr.p_double[pointindex]; - - /* - * do we need to advance interval? - */ - havetoadvance = ae_false; - if( intervalindex==-1 ) - { - havetoadvance = ae_true; - } - else - { - if( intervalindexptr.p_double[intervalindex]; - b = xold->ptr.p_double[intervalindex+1]; - w = b-a; - w2 = w*w; - w3 = w*w2; - fa = yold->ptr.p_double[intervalindex]; - fb = yold->ptr.p_double[intervalindex+1]; - da = dold->ptr.p_double[intervalindex]; - db = dold->ptr.p_double[intervalindex+1]; - c0 = fa; - c1 = da; - c2 = (3*(fb-fa)-2*da*w-db*w)/w2; - c3 = (2*(fa-fb)+da*w+db*w)/w3; - continue; - } - - /* - * Calculate spline and its derivatives using power basis - */ - t = t-a; - if( needy ) - { - y->ptr.p_double[pointindex] = c0+t*(c1+t*(c2+t*c3)); - } - if( needd1 ) - { - d1->ptr.p_double[pointindex] = c1+2*t*c2+3*t*t*c3; - } - if( needd2 ) - { - d2->ptr.p_double[pointindex] = 2*c2+6*t*c3; - } - pointindex = pointindex+1; - } -} - - -/************************************************************************* -This function finds all roots and extrema of the spline S(x) defined at -[A,B] (interval which contains spline nodes). - -It does not extrapolates function, so roots and extrema located outside -of [A,B] will not be found. It returns all isolated (including multiple) -roots and extrema. - -INPUT PARAMETERS - C - spline interpolant - -OUTPUT PARAMETERS - R - array[NR], contains roots of the spline. - In case there is no roots, this array has zero length. - NR - number of roots, >=0 - DR - is set to True in case there is at least one interval - where spline is just a zero constant. Such degenerate - cases are not reported in the R/NR - E - array[NE], contains extrema (maximums/minimums) of - the spline. In case there is no extrema, this array - has zero length. - ET - array[NE], extrema types: - * ET[i]>0 in case I-th extrema is a minimum - * ET[i]<0 in case I-th extrema is a maximum - NE - number of extrema, >=0 - DE - is set to True in case there is at least one interval - where spline is a constant. Such degenerate cases are - not reported in the E/NE. - -NOTES: - -1. This function does NOT report following kinds of roots: - * intervals where function is constantly zero - * roots which are outside of [A,B] (note: it CAN return A or B) - -2. This function does NOT report following kinds of extrema: - * intervals where function is a constant - * extrema which are outside of (A,B) (note: it WON'T return A or B) - - -- ALGLIB PROJECT -- - Copyright 26.09.2011 by Bochkanov Sergey -*************************************************************************/ -void spline1drootsandextrema(spline1dinterpolant* c, - /* Real */ ae_vector* r, - ae_int_t* nr, - ae_bool* dr, - /* Real */ ae_vector* e, - /* Integer */ ae_vector* et, - ae_int_t* ne, - ae_bool* de, - ae_state *_state) -{ - ae_frame _frame_block; - double pl; - double ml; - double pll; - double pr; - double mr; - ae_vector tr; - ae_vector tmpr; - ae_vector tmpe; - ae_vector tmpet; - ae_vector tmpc; - double x0; - double x1; - double x2; - double ex0; - double ex1; - ae_int_t tne; - ae_int_t tnr; - ae_int_t i; - ae_int_t j; - ae_bool nstep; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(r); - *nr = 0; - *dr = ae_false; - ae_vector_clear(e); - ae_vector_clear(et); - *ne = 0; - *de = ae_false; - ae_vector_init(&tr, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tmpr, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tmpe, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tmpet, 0, DT_INT, _state, ae_true); - ae_vector_init(&tmpc, 0, DT_REAL, _state, ae_true); - - - /* - *exception handling - */ - ae_assert(c->k==3, "Spline1DRootsAndExtrema : incorrect parameter C.K!", _state); - ae_assert(c->continuity>=0, "Spline1DRootsAndExtrema : parameter C.Continuity must not be less than 0!", _state); - - /* - *initialization of variable - */ - *nr = 0; - *ne = 0; - *dr = ae_false; - *de = ae_false; - nstep = ae_true; - - /* - *consider case, when C.Continuty=0 - */ - if( c->continuity==0 ) - { - - /* - *allocation for auxiliary arrays - *'TmpR ' - it stores a time value for roots - *'TmpE ' - it stores a time value for extremums - *'TmpET '- it stores a time value for extremums type - */ - rvectorsetlengthatleast(&tmpr, 3*(c->n-1), _state); - rvectorsetlengthatleast(&tmpe, 2*(c->n-1), _state); - ivectorsetlengthatleast(&tmpet, 2*(c->n-1), _state); - - /* - *start calculating - */ - for(i=0; i<=c->n-2; i++) - { - - /* - *initialization pL, mL, pR, mR - */ - pl = c->c.ptr.p_double[4*i]; - ml = c->c.ptr.p_double[4*i+1]; - pr = c->c.ptr.p_double[4*(i+1)]; - mr = c->c.ptr.p_double[4*i+1]+2*c->c.ptr.p_double[4*i+2]*(c->x.ptr.p_double[i+1]-c->x.ptr.p_double[i])+3*c->c.ptr.p_double[4*i+3]*(c->x.ptr.p_double[i+1]-c->x.ptr.p_double[i])*(c->x.ptr.p_double[i+1]-c->x.ptr.p_double[i]); - - /* - *pre-searching roots and extremums - */ - solvecubicpolinom(pl, ml, pr, mr, c->x.ptr.p_double[i], c->x.ptr.p_double[i+1], &x0, &x1, &x2, &ex0, &ex1, &tnr, &tne, &tr, _state); - *dr = *dr||tnr==-1; - *de = *de||tne==-1; - - /* - *searching of roots - */ - if( tnr==1&&nstep ) - { - - /* - *is there roots? - */ - if( *nr>0 ) - { - - /* - *is a next root equal a previous root? - *if is't, then write new root - */ - if( ae_fp_neq(x0,tmpr.ptr.p_double[*nr-1]) ) - { - tmpr.ptr.p_double[*nr] = x0; - *nr = *nr+1; - } - } - else - { - - /* - *write a first root - */ - tmpr.ptr.p_double[*nr] = x0; - *nr = *nr+1; - } - } - else - { - - /* - *case when function at a segment identically to zero - *then we have to clear a root, if the one located on a - *constant segment - */ - if( tnr==-1 ) - { - - /* - *safe state variable as constant - */ - if( nstep ) - { - nstep = ae_false; - } - - /* - *clear the root, if there is - */ - if( *nr>0 ) - { - if( ae_fp_eq(c->x.ptr.p_double[i],tmpr.ptr.p_double[*nr-1]) ) - { - *nr = *nr-1; - } - } - - /* - *change state for 'DR' - */ - if( !*dr ) - { - *dr = ae_true; - } - } - else - { - nstep = ae_true; - } - } - - /* - *searching of extremums - */ - if( i>0 ) - { - pll = c->c.ptr.p_double[4*(i-1)]; - - /* - *if pL=pLL or pL=pR then - */ - if( tne==-1 ) - { - if( !*de ) - { - *de = ae_true; - } - } - else - { - if( ae_fp_greater(pl,pll)&&ae_fp_greater(pl,pr) ) - { - - /* - *maximum - */ - tmpet.ptr.p_int[*ne] = -1; - tmpe.ptr.p_double[*ne] = c->x.ptr.p_double[i]; - *ne = *ne+1; - } - else - { - if( ae_fp_less(pl,pll)&&ae_fp_less(pl,pr) ) - { - - /* - *minimum - */ - tmpet.ptr.p_int[*ne] = 1; - tmpe.ptr.p_double[*ne] = c->x.ptr.p_double[i]; - *ne = *ne+1; - } - } - } - } - } - - /* - *write final result - */ - rvectorsetlengthatleast(r, *nr, _state); - rvectorsetlengthatleast(e, *ne, _state); - ivectorsetlengthatleast(et, *ne, _state); - - /* - *write roots - */ - for(i=0; i<=*nr-1; i++) - { - r->ptr.p_double[i] = tmpr.ptr.p_double[i]; - } - - /* - *write extremums and their types - */ - for(i=0; i<=*ne-1; i++) - { - e->ptr.p_double[i] = tmpe.ptr.p_double[i]; - et->ptr.p_int[i] = tmpet.ptr.p_int[i]; - } - } - else - { - - /* - *case, when C.Continuity>=1 - *'TmpR ' - it stores a time value for roots - *'TmpC' - it stores a time value for extremums and - *their function value (TmpC={EX0,F(EX0), EX1,F(EX1), ..., EXn,F(EXn)};) - *'TmpE' - it stores a time value for extremums only - *'TmpET'- it stores a time value for extremums type - */ - rvectorsetlengthatleast(&tmpr, 2*c->n-1, _state); - rvectorsetlengthatleast(&tmpc, 4*c->n, _state); - rvectorsetlengthatleast(&tmpe, 2*c->n, _state); - ivectorsetlengthatleast(&tmpet, 2*c->n, _state); - - /* - *start calculating - */ - for(i=0; i<=c->n-2; i++) - { - - /* - *we calculate pL,mL, pR,mR as Fi+1(F'i+1) at left border - */ - pl = c->c.ptr.p_double[4*i]; - ml = c->c.ptr.p_double[4*i+1]; - pr = c->c.ptr.p_double[4*(i+1)]; - mr = c->c.ptr.p_double[4*(i+1)+1]; - - /* - *calculating roots and extremums at [X[i],X[i+1]] - */ - solvecubicpolinom(pl, ml, pr, mr, c->x.ptr.p_double[i], c->x.ptr.p_double[i+1], &x0, &x1, &x2, &ex0, &ex1, &tnr, &tne, &tr, _state); - - /* - *searching roots - */ - if( tnr>0 ) - { - - /* - *re-init tR - */ - if( tnr>=1 ) - { - tr.ptr.p_double[0] = x0; - } - if( tnr>=2 ) - { - tr.ptr.p_double[1] = x1; - } - if( tnr==3 ) - { - tr.ptr.p_double[2] = x2; - } - - /* - *start root selection - */ - if( *nr>0 ) - { - if( ae_fp_neq(tmpr.ptr.p_double[*nr-1],x0) ) - { - - /* - *previous segment was't constant identical zero - */ - if( nstep ) - { - for(j=0; j<=tnr-1; j++) - { - tmpr.ptr.p_double[*nr+j] = tr.ptr.p_double[j]; - } - *nr = *nr+tnr; - } - else - { - - /* - *previous segment was constant identical zero - *and we must ignore [NR+j-1] root - */ - for(j=1; j<=tnr-1; j++) - { - tmpr.ptr.p_double[*nr+j-1] = tr.ptr.p_double[j]; - } - *nr = *nr+tnr-1; - nstep = ae_true; - } - } - else - { - for(j=1; j<=tnr-1; j++) - { - tmpr.ptr.p_double[*nr+j-1] = tr.ptr.p_double[j]; - } - *nr = *nr+tnr-1; - } - } - else - { - - /* - *write first root - */ - for(j=0; j<=tnr-1; j++) - { - tmpr.ptr.p_double[*nr+j] = tr.ptr.p_double[j]; - } - *nr = *nr+tnr; - } - } - else - { - if( tnr==-1 ) - { - - /* - *decrement 'NR' if at previous step was written a root - *(previous segment identical zero) - */ - if( *nr>0&&nstep ) - { - *nr = *nr-1; - } - - /* - *previous segment is't constant - */ - if( nstep ) - { - nstep = ae_false; - } - - /* - *rewrite 'DR' - */ - if( !*dr ) - { - *dr = ae_true; - } - } - } - - /* - *searching extremums - *write all term like extremums - */ - if( tne==1 ) - { - if( *ne>0 ) - { - - /* - *just ignore identical extremums - *because he must be one - */ - if( ae_fp_neq(tmpc.ptr.p_double[*ne-2],ex0) ) - { - tmpc.ptr.p_double[*ne] = ex0; - tmpc.ptr.p_double[*ne+1] = c->c.ptr.p_double[4*i]+c->c.ptr.p_double[4*i+1]*(ex0-c->x.ptr.p_double[i])+c->c.ptr.p_double[4*i+2]*(ex0-c->x.ptr.p_double[i])*(ex0-c->x.ptr.p_double[i])+c->c.ptr.p_double[4*i+3]*(ex0-c->x.ptr.p_double[i])*(ex0-c->x.ptr.p_double[i])*(ex0-c->x.ptr.p_double[i]); - *ne = *ne+2; - } - } - else - { - - /* - *write first extremum and it function value - */ - tmpc.ptr.p_double[*ne] = ex0; - tmpc.ptr.p_double[*ne+1] = c->c.ptr.p_double[4*i]+c->c.ptr.p_double[4*i+1]*(ex0-c->x.ptr.p_double[i])+c->c.ptr.p_double[4*i+2]*(ex0-c->x.ptr.p_double[i])*(ex0-c->x.ptr.p_double[i])+c->c.ptr.p_double[4*i+3]*(ex0-c->x.ptr.p_double[i])*(ex0-c->x.ptr.p_double[i])*(ex0-c->x.ptr.p_double[i]); - *ne = *ne+2; - } - } - else - { - if( tne==2 ) - { - if( *ne>0 ) - { - - /* - *ignore identical extremum - */ - if( ae_fp_neq(tmpc.ptr.p_double[*ne-2],ex0) ) - { - tmpc.ptr.p_double[*ne] = ex0; - tmpc.ptr.p_double[*ne+1] = c->c.ptr.p_double[4*i]+c->c.ptr.p_double[4*i+1]*(ex0-c->x.ptr.p_double[i])+c->c.ptr.p_double[4*i+2]*(ex0-c->x.ptr.p_double[i])*(ex0-c->x.ptr.p_double[i])+c->c.ptr.p_double[4*i+3]*(ex0-c->x.ptr.p_double[i])*(ex0-c->x.ptr.p_double[i])*(ex0-c->x.ptr.p_double[i]); - *ne = *ne+2; - } - } - else - { - - /* - *write first extremum - */ - tmpc.ptr.p_double[*ne] = ex0; - tmpc.ptr.p_double[*ne+1] = c->c.ptr.p_double[4*i]+c->c.ptr.p_double[4*i+1]*(ex0-c->x.ptr.p_double[i])+c->c.ptr.p_double[4*i+2]*(ex0-c->x.ptr.p_double[i])*(ex0-c->x.ptr.p_double[i])+c->c.ptr.p_double[4*i+3]*(ex0-c->x.ptr.p_double[i])*(ex0-c->x.ptr.p_double[i])*(ex0-c->x.ptr.p_double[i]); - *ne = *ne+2; - } - - /* - *write second extremum - */ - tmpc.ptr.p_double[*ne] = ex1; - tmpc.ptr.p_double[*ne+1] = c->c.ptr.p_double[4*i]+c->c.ptr.p_double[4*i+1]*(ex1-c->x.ptr.p_double[i])+c->c.ptr.p_double[4*i+2]*(ex1-c->x.ptr.p_double[i])*(ex1-c->x.ptr.p_double[i])+c->c.ptr.p_double[4*i+3]*(ex1-c->x.ptr.p_double[i])*(ex1-c->x.ptr.p_double[i])*(ex1-c->x.ptr.p_double[i]); - *ne = *ne+2; - } - else - { - if( tne==-1 ) - { - if( !*de ) - { - *de = ae_true; - } - } - } - } - } - - /* - *checking of arrays - *get number of extremums (tNe=NE/2) - *initialize pL as value F0(X[0]) and - *initialize pR as value Fn-1(X[N]) - */ - tne = *ne/2; - *ne = 0; - pl = c->c.ptr.p_double[0]; - pr = c->c.ptr.p_double[4*(c->n-1)]; - for(i=0; i<=tne-1; i++) - { - if( i>0&&ix.ptr.p_double[0]) ) - { - if( ae_fp_greater(tmpc.ptr.p_double[2*i+1],pl)&&ae_fp_greater(tmpc.ptr.p_double[2*i+1],tmpc.ptr.p_double[2*(i+1)+1]) ) - { - - /* - *maximum - */ - tmpe.ptr.p_double[*ne] = tmpc.ptr.p_double[2*i]; - tmpet.ptr.p_int[*ne] = -1; - *ne = *ne+1; - } - else - { - if( ae_fp_less(tmpc.ptr.p_double[2*i+1],pl)&&ae_fp_less(tmpc.ptr.p_double[2*i+1],tmpc.ptr.p_double[2*(i+1)+1]) ) - { - - /* - *minimum - */ - tmpe.ptr.p_double[*ne] = tmpc.ptr.p_double[2*i]; - tmpet.ptr.p_int[*ne] = 1; - *ne = *ne+1; - } - } - } - } - else - { - if( i==tne-1 ) - { - if( ae_fp_neq(tmpc.ptr.p_double[2*i],c->x.ptr.p_double[c->n-1]) ) - { - if( ae_fp_greater(tmpc.ptr.p_double[2*i+1],tmpc.ptr.p_double[2*(i-1)+1])&&ae_fp_greater(tmpc.ptr.p_double[2*i+1],pr) ) - { - - /* - *maximum - */ - tmpe.ptr.p_double[*ne] = tmpc.ptr.p_double[2*i]; - tmpet.ptr.p_int[*ne] = -1; - *ne = *ne+1; - } - else - { - if( ae_fp_less(tmpc.ptr.p_double[2*i+1],tmpc.ptr.p_double[2*(i-1)+1])&&ae_fp_less(tmpc.ptr.p_double[2*i+1],pr) ) - { - - /* - *minimum - */ - tmpe.ptr.p_double[*ne] = tmpc.ptr.p_double[2*i]; - tmpet.ptr.p_int[*ne] = 1; - *ne = *ne+1; - } - } - } - } - } - } - } - - /* - *final results - *allocate R, E, ET - */ - rvectorsetlengthatleast(r, *nr, _state); - rvectorsetlengthatleast(e, *ne, _state); - ivectorsetlengthatleast(et, *ne, _state); - - /* - *write result for extremus and their types - */ - for(i=0; i<=*ne-1; i++) - { - e->ptr.p_double[i] = tmpe.ptr.p_double[i]; - et->ptr.p_int[i] = tmpet.ptr.p_int[i]; - } - - /* - *write result for roots - */ - for(i=0; i<=*nr-1; i++) - { - r->ptr.p_double[i] = tmpr.ptr.p_double[i]; - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Internal subroutine. Heap sort. -*************************************************************************/ -void heapsortdpoints(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* d, - ae_int_t n, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector rbuf; - ae_vector ibuf; - ae_vector rbuf2; - ae_vector ibuf2; - ae_int_t i; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&rbuf, 0, DT_REAL, _state, ae_true); - ae_vector_init(&ibuf, 0, DT_INT, _state, ae_true); - ae_vector_init(&rbuf2, 0, DT_REAL, _state, ae_true); - ae_vector_init(&ibuf2, 0, DT_INT, _state, ae_true); - - ae_vector_set_length(&ibuf, n, _state); - ae_vector_set_length(&rbuf, n, _state); - for(i=0; i<=n-1; i++) - { - ibuf.ptr.p_int[i] = i; - } - tagsortfasti(x, &ibuf, &rbuf2, &ibuf2, n, _state); - for(i=0; i<=n-1; i++) - { - rbuf.ptr.p_double[i] = y->ptr.p_double[ibuf.ptr.p_int[i]]; - } - ae_v_move(&y->ptr.p_double[0], 1, &rbuf.ptr.p_double[0], 1, ae_v_len(0,n-1)); - for(i=0; i<=n-1; i++) - { - rbuf.ptr.p_double[i] = d->ptr.p_double[ibuf.ptr.p_int[i]]; - } - ae_v_move(&d->ptr.p_double[0], 1, &rbuf.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_frame_leave(_state); -} - - -/************************************************************************* -This procedure search roots of an quadratic equation inside [0;1] and it number of roots. - -INPUT PARAMETERS: - P0 - value of a function at 0 - M0 - value of a derivative at 0 - P1 - value of a function at 1 - M1 - value of a derivative at 1 - -OUTPUT PARAMETERS: - X0 - first root of an equation - X1 - second root of an equation - NR - number of roots - -RESTRICTIONS OF PARAMETERS: - -Parameters for this procedure has't to be zero simultaneously. Is expected, -that input polinom is't degenerate or constant identicaly ZERO. - - -REMARK: - -The procedure always fill value for X1 and X2, even if it is't belongs to [0;1]. -But first true root(even if existing one) is in X1. -Number of roots is NR. - - -- ALGLIB PROJECT -- - Copyright 26.09.2011 by Bochkanov Sergey -*************************************************************************/ -void solvepolinom2(double p0, - double m0, - double p1, - double m1, - double* x0, - double* x1, - ae_int_t* nr, - ae_state *_state) -{ - double a; - double b; - double c; - double dd; - double tmp; - double exf; - double extr; - - *x0 = 0; - *x1 = 0; - *nr = 0; - - - /* - *calculate parameters for equation: A, B and C - */ - a = 6*p0+3*m0-6*p1+3*m1; - b = -6*p0-4*m0+6*p1-2*m1; - c = m0; - - /* - *check case, when A=0 - *we are considering the linear equation - */ - if( ae_fp_eq(a,0) ) - { - - /* - *B<>0 and root inside [0;1] - *one root - */ - if( (ae_fp_neq(b,0)&&ae_sign(c, _state)*ae_sign(b, _state)<=0)&&ae_fp_greater_eq(ae_fabs(b, _state),ae_fabs(c, _state)) ) - { - *x0 = -c/b; - *nr = 1; - return; - } - else - { - *nr = 0; - return; - } - } - - /* - *consider case, when extremumu outside (0;1) - *exist one root only - */ - if( ae_fp_less_eq(ae_fabs(2*a, _state),ae_fabs(b, _state))||ae_sign(b, _state)*ae_sign(a, _state)>=0 ) - { - if( ae_sign(m0, _state)*ae_sign(m1, _state)>0 ) - { - *nr = 0; - return; - } - - /* - *consider case, when the one exist - *same sign of derivative - */ - if( ae_sign(m0, _state)*ae_sign(m1, _state)<0 ) - { - *nr = 1; - extr = -b/(2*a); - dd = b*b-4*a*c; - if( ae_fp_less(dd,0) ) - { - return; - } - *x0 = (-b-ae_sqrt(dd, _state))/(2*a); - *x1 = (-b+ae_sqrt(dd, _state))/(2*a); - if( (ae_fp_greater_eq(extr,1)&&ae_fp_less_eq(*x1,extr))||(ae_fp_less_eq(extr,0)&&ae_fp_greater_eq(*x1,extr)) ) - { - *x0 = *x1; - } - return; - } - - /* - *consider case, when the one is 0 - */ - if( ae_fp_eq(m0,0) ) - { - *x0 = 0; - *nr = 1; - return; - } - if( ae_fp_eq(m1,0) ) - { - *x0 = 1; - *nr = 1; - return; - } - } - else - { - - /* - *consider case, when both of derivatives is 0 - */ - if( ae_fp_eq(m0,0)&&ae_fp_eq(m1,0) ) - { - *x0 = 0; - *x1 = 1; - *nr = 2; - return; - } - - /* - *consider case, when derivative at 0 is 0, and derivative at 1 is't 0 - */ - if( ae_fp_eq(m0,0)&&ae_fp_neq(m1,0) ) - { - dd = b*b-4*a*c; - if( ae_fp_less(dd,0) ) - { - *x0 = 0; - *nr = 1; - return; - } - *x0 = (-b-ae_sqrt(dd, _state))/(2*a); - *x1 = (-b+ae_sqrt(dd, _state))/(2*a); - extr = -b/(2*a); - exf = a*extr*extr+b*extr+c; - if( ae_sign(exf, _state)*ae_sign(m1, _state)>0 ) - { - *x0 = 0; - *nr = 1; - return; - } - else - { - if( ae_fp_greater(extr,*x0) ) - { - *x0 = 0; - } - else - { - *x1 = 0; - } - *nr = 2; - - /* - *roots must placed ascending - */ - if( ae_fp_greater(*x0,*x1) ) - { - tmp = *x0; - *x0 = *x1; - *x1 = tmp; - } - return; - } - } - if( ae_fp_eq(m1,0)&&ae_fp_neq(m0,0) ) - { - dd = b*b-4*a*c; - if( ae_fp_less(dd,0) ) - { - *x0 = 1; - *nr = 1; - return; - } - *x0 = (-b-ae_sqrt(dd, _state))/(2*a); - *x1 = (-b+ae_sqrt(dd, _state))/(2*a); - extr = -b/(2*a); - exf = a*extr*extr+b*extr+c; - if( ae_sign(exf, _state)*ae_sign(m0, _state)>0 ) - { - *x0 = 1; - *nr = 1; - return; - } - else - { - if( ae_fp_less(extr,*x0) ) - { - *x0 = 1; - } - else - { - *x1 = 1; - } - *nr = 2; - - /* - *roots must placed ascending - */ - if( ae_fp_greater(*x0,*x1) ) - { - tmp = *x0; - *x0 = *x1; - *x1 = tmp; - } - return; - } - } - else - { - extr = -b/(2*a); - exf = a*extr*extr+b*extr+c; - if( ae_sign(exf, _state)*ae_sign(m0, _state)>0&&ae_sign(exf, _state)*ae_sign(m1, _state)>0 ) - { - *nr = 0; - return; - } - dd = b*b-4*a*c; - if( ae_fp_less(dd,0) ) - { - *nr = 0; - return; - } - *x0 = (-b-ae_sqrt(dd, _state))/(2*a); - *x1 = (-b+ae_sqrt(dd, _state))/(2*a); - - /* - *if EXF and m0, EXF and m1 has different signs, then equation has two roots - */ - if( ae_sign(exf, _state)*ae_sign(m0, _state)<0&&ae_sign(exf, _state)*ae_sign(m1, _state)<0 ) - { - *nr = 2; - - /* - *roots must placed ascending - */ - if( ae_fp_greater(*x0,*x1) ) - { - tmp = *x0; - *x0 = *x1; - *x1 = tmp; - } - return; - } - else - { - *nr = 1; - if( ae_sign(exf, _state)*ae_sign(m0, _state)<0 ) - { - if( ae_fp_less(*x1,extr) ) - { - *x0 = *x1; - } - return; - } - if( ae_sign(exf, _state)*ae_sign(m1, _state)<0 ) - { - if( ae_fp_greater(*x1,extr) ) - { - *x0 = *x1; - } - return; - } - } - } - } -} - - -/************************************************************************* -This procedure search roots of an cubic equation inside [A;B], it number of roots -and number of extremums. - -INPUT PARAMETERS: - pA - value of a function at A - mA - value of a derivative at A - pB - value of a function at B - mB - value of a derivative at B - A0 - left border [A0;B0] - B0 - right border [A0;B0] - -OUTPUT PARAMETERS: - X0 - first root of an equation - X1 - second root of an equation - X2 - third root of an equation - EX0 - first extremum of a function - EX0 - second extremum of a function - NR - number of roots - NR - number of extrmums - -RESTRICTIONS OF PARAMETERS: - -Length of [A;B] must be positive and is't zero, i.e. A<>B and AB - */ - ae_assert(ae_fp_less(a,b), "\nSolveCubicPolinom: incorrect borders for [A;B]!\n", _state); - - /* - *case 1 - *function can be identicaly to ZERO - */ - if( ((ae_fp_eq(ma,0)&&ae_fp_eq(mb,0))&&ae_fp_eq(pa,pb))&&ae_fp_eq(pa,0) ) - { - *nr = -1; - *ne = -1; - return; - } - if( (ae_fp_eq(ma,0)&&ae_fp_eq(mb,0))&&ae_fp_eq(pa,pb) ) - { - *nr = 0; - *ne = -1; - return; - } - tmpma = ma*(b-a); - tmpmb = mb*(b-a); - solvepolinom2(pa, tmpma, pb, tmpmb, ex0, ex1, ne, _state); - *ex0 = spline1d_rescaleval(0, 1, a, b, *ex0, _state); - *ex1 = spline1d_rescaleval(0, 1, a, b, *ex1, _state); - - /* - *case 3.1 - *no extremums at [A;B] - */ - if( *ne==0 ) - { - *nr = bisectmethod(pa, tmpma, pb, tmpmb, 0, 1, x0, _state); - if( *nr==1 ) - { - *x0 = spline1d_rescaleval(0, 1, a, b, *x0, _state); - } - return; - } - - /* - *case 3.2 - *one extremum - */ - if( *ne==1 ) - { - if( ae_fp_eq(*ex0,a)||ae_fp_eq(*ex0,b) ) - { - *nr = bisectmethod(pa, tmpma, pb, tmpmb, 0, 1, x0, _state); - if( *nr==1 ) - { - *x0 = spline1d_rescaleval(0, 1, a, b, *x0, _state); - } - return; - } - else - { - *nr = 0; - i = 0; - tex0 = spline1d_rescaleval(a, b, 0, 1, *ex0, _state); - *nr = bisectmethod(pa, tmpma, pb, tmpmb, 0, tex0, x0, _state)+(*nr); - if( *nr>i ) - { - tempdata->ptr.p_double[i] = spline1d_rescaleval(0, tex0, a, *ex0, *x0, _state); - i = i+1; - } - *nr = bisectmethod(pa, tmpma, pb, tmpmb, tex0, 1, x0, _state)+(*nr); - if( *nr>i ) - { - *x0 = spline1d_rescaleval(tex0, 1, *ex0, b, *x0, _state); - if( i>0 ) - { - if( ae_fp_neq(*x0,tempdata->ptr.p_double[i-1]) ) - { - tempdata->ptr.p_double[i] = *x0; - i = i+1; - } - else - { - *nr = *nr-1; - } - } - else - { - tempdata->ptr.p_double[i] = *x0; - i = i+1; - } - } - if( *nr>0 ) - { - *x0 = tempdata->ptr.p_double[0]; - if( *nr>1 ) - { - *x1 = tempdata->ptr.p_double[1]; - } - return; - } - } - return; - } - else - { - - /* - *case 3.3 - *two extremums(or more, but it's impossible) - * - * - *case 3.3.0 - *both extremums at the border - */ - if( ae_fp_eq(*ex0,a)&&ae_fp_eq(*ex1,b) ) - { - *nr = bisectmethod(pa, tmpma, pb, tmpmb, 0, 1, x0, _state); - if( *nr==1 ) - { - *x0 = spline1d_rescaleval(0, 1, a, b, *x0, _state); - } - return; - } - if( ae_fp_eq(*ex0,a)&&ae_fp_neq(*ex1,b) ) - { - *nr = 0; - i = 0; - tex1 = spline1d_rescaleval(a, b, 0, 1, *ex1, _state); - *nr = bisectmethod(pa, tmpma, pb, tmpmb, 0, tex1, x0, _state)+(*nr); - if( *nr>i ) - { - tempdata->ptr.p_double[i] = spline1d_rescaleval(0, tex1, a, *ex1, *x0, _state); - i = i+1; - } - *nr = bisectmethod(pa, tmpma, pb, tmpmb, tex1, 1, x0, _state)+(*nr); - if( *nr>i ) - { - *x0 = spline1d_rescaleval(tex1, 1, *ex1, b, *x0, _state); - if( ae_fp_neq(*x0,tempdata->ptr.p_double[i-1]) ) - { - tempdata->ptr.p_double[i] = *x0; - i = i+1; - } - else - { - *nr = *nr-1; - } - } - if( *nr>0 ) - { - *x0 = tempdata->ptr.p_double[0]; - if( *nr>1 ) - { - *x1 = tempdata->ptr.p_double[1]; - } - return; - } - } - if( ae_fp_eq(*ex1,b)&&ae_fp_neq(*ex0,a) ) - { - *nr = 0; - i = 0; - tex0 = spline1d_rescaleval(a, b, 0, 1, *ex0, _state); - *nr = bisectmethod(pa, tmpma, pb, tmpmb, 0, tex0, x0, _state)+(*nr); - if( *nr>i ) - { - tempdata->ptr.p_double[i] = spline1d_rescaleval(0, tex0, a, *ex0, *x0, _state); - i = i+1; - } - *nr = bisectmethod(pa, tmpma, pb, tmpmb, tex0, 1, x0, _state)+(*nr); - if( *nr>i ) - { - *x0 = spline1d_rescaleval(tex0, 1, *ex0, b, *x0, _state); - if( i>0 ) - { - if( ae_fp_neq(*x0,tempdata->ptr.p_double[i-1]) ) - { - tempdata->ptr.p_double[i] = *x0; - i = i+1; - } - else - { - *nr = *nr-1; - } - } - else - { - tempdata->ptr.p_double[i] = *x0; - i = i+1; - } - } - if( *nr>0 ) - { - *x0 = tempdata->ptr.p_double[0]; - if( *nr>1 ) - { - *x1 = tempdata->ptr.p_double[1]; - } - return; - } - } - else - { - - /* - *case 3.3.2 - *both extremums inside (0;1) - */ - *nr = 0; - i = 0; - tex0 = spline1d_rescaleval(a, b, 0, 1, *ex0, _state); - tex1 = spline1d_rescaleval(a, b, 0, 1, *ex1, _state); - *nr = bisectmethod(pa, tmpma, pb, tmpmb, 0, tex0, x0, _state)+(*nr); - if( *nr>i ) - { - tempdata->ptr.p_double[i] = spline1d_rescaleval(0, tex0, a, *ex0, *x0, _state); - i = i+1; - } - *nr = bisectmethod(pa, tmpma, pb, tmpmb, tex0, tex1, x0, _state)+(*nr); - if( *nr>i ) - { - *x0 = spline1d_rescaleval(tex0, tex1, *ex0, *ex1, *x0, _state); - if( i>0 ) - { - if( ae_fp_neq(*x0,tempdata->ptr.p_double[i-1]) ) - { - tempdata->ptr.p_double[i] = *x0; - i = i+1; - } - else - { - *nr = *nr-1; - } - } - else - { - tempdata->ptr.p_double[i] = *x0; - i = i+1; - } - } - *nr = bisectmethod(pa, tmpma, pb, tmpmb, tex1, 1, x0, _state)+(*nr); - if( *nr>i ) - { - *x0 = spline1d_rescaleval(tex1, 1, *ex1, b, *x0, _state); - if( i>0 ) - { - if( ae_fp_neq(*x0,tempdata->ptr.p_double[i-1]) ) - { - tempdata->ptr.p_double[i] = *x0; - i = i+1; - } - else - { - *nr = *nr-1; - } - } - else - { - tempdata->ptr.p_double[i] = *x0; - i = i+1; - } - } - - /* - *write are found roots - */ - if( *nr>0 ) - { - *x0 = tempdata->ptr.p_double[0]; - if( *nr>1 ) - { - *x1 = tempdata->ptr.p_double[1]; - } - if( *nr>2 ) - { - *x2 = tempdata->ptr.p_double[2]; - } - return; - } - } - } -} - - -/************************************************************************* -Function for searching a root at [A;B] by bisection method and return number of roots -(0 or 1) - -INPUT PARAMETERS: - pA - value of a function at A - mA - value of a derivative at A - pB - value of a function at B - mB - value of a derivative at B - A0 - left border [A0;B0] - B0 - right border [A0;B0] - -RESTRICTIONS OF PARAMETERS: - -We assume, that B0>A0. - - -REMARK: - -Assume, that exist one root only at [A;B], else -function may be work incorrectly. -The function don't check value A0,B0! - - -- ALGLIB PROJECT -- - Copyright 26.09.2011 by Bochkanov Sergey -*************************************************************************/ -ae_int_t bisectmethod(double pa, - double ma, - double pb, - double mb, - double a, - double b, - double* x, - ae_state *_state) -{ - double vacuum; - double eps; - double a0; - double b0; - double m; - double lf; - double rf; - double mf; - ae_int_t result; - - *x = 0; - - - /* - *accuracy - */ - eps = 1000*(b-a)*ae_machineepsilon; - - /* - *initialization left and right borders - */ - a0 = a; - b0 = b; - - /* - *initialize function value at 'A' and 'B' - */ - spline1d_hermitecalc(pa, ma, pb, mb, a, &lf, &vacuum, _state); - spline1d_hermitecalc(pa, ma, pb, mb, b, &rf, &vacuum, _state); - - /* - *check, that 'A' and 'B' are't roots, - *and that root exist - */ - if( ae_sign(lf, _state)*ae_sign(rf, _state)>0 ) - { - result = 0; - return result; - } - else - { - if( ae_fp_eq(lf,0) ) - { - *x = a; - result = 1; - return result; - } - else - { - if( ae_fp_eq(rf,0) ) - { - *x = b; - result = 1; - return result; - } - } - } - - /* - *searching a root - */ - do - { - m = (b0+a0)/2; - spline1d_hermitecalc(pa, ma, pb, mb, a0, &lf, &vacuum, _state); - spline1d_hermitecalc(pa, ma, pb, mb, b0, &rf, &vacuum, _state); - spline1d_hermitecalc(pa, ma, pb, mb, m, &mf, &vacuum, _state); - if( ae_sign(mf, _state)*ae_sign(lf, _state)<0 ) - { - b0 = m; - } - else - { - if( ae_sign(mf, _state)*ae_sign(rf, _state)<0 ) - { - a0 = m; - } - else - { - if( ae_fp_eq(lf,0) ) - { - *x = a0; - result = 1; - return result; - } - if( ae_fp_eq(rf,0) ) - { - *x = b0; - result = 1; - return result; - } - if( ae_fp_eq(mf,0) ) - { - *x = m; - result = 1; - return result; - } - } - } - } - while(ae_fp_greater_eq(ae_fabs(b0-a0, _state),eps)); - *x = m; - result = 1; - return result; -} - - -/************************************************************************* -This function builds monotone cubic Hermite interpolant. This interpolant -is monotonic in [x(0),x(n-1)] and is constant outside of this interval. - -In case y[] form non-monotonic sequence, interpolant is piecewise -monotonic. Say, for x=(0,1,2,3,4) and y=(0,1,2,1,0) interpolant will -monotonically grow at [0..2] and monotonically decrease at [2..4]. - -INPUT PARAMETERS: - X - spline nodes, array[0..N-1]. Subroutine automatically - sorts points, so caller may pass unsorted array. - Y - function values, array[0..N-1] - N - the number of points(N>=2). - -OUTPUT PARAMETERS: - C - spline interpolant. - - -- ALGLIB PROJECT -- - Copyright 21.06.2012 by Bochkanov Sergey -*************************************************************************/ -void spline1dbuildmonotone(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - spline1dinterpolant* c, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _x; - ae_vector _y; - ae_vector d; - ae_vector ex; - ae_vector ey; - ae_vector p; - double delta; - double alpha; - double beta; - ae_int_t tmpn; - ae_int_t sn; - double ca; - double cb; - double epsilon; - ae_int_t i; - ae_int_t j; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_x, x, _state, ae_true); - x = &_x; - ae_vector_init_copy(&_y, y, _state, ae_true); - y = &_y; - _spline1dinterpolant_clear(c); - ae_vector_init(&d, 0, DT_REAL, _state, ae_true); - ae_vector_init(&ex, 0, DT_REAL, _state, ae_true); - ae_vector_init(&ey, 0, DT_REAL, _state, ae_true); - ae_vector_init(&p, 0, DT_INT, _state, ae_true); - - - /* - * Check lengths of arguments - */ - ae_assert(n>=2, "Spline1DBuildMonotone: N<2", _state); - ae_assert(x->cnt>=n, "Spline1DBuildMonotone: Length(X)cnt>=n, "Spline1DBuildMonotone: Length(Y)ptr.p_double[0]-ae_fabs(x->ptr.p_double[1]-x->ptr.p_double[0], _state); - ex.ptr.p_double[n-1] = x->ptr.p_double[n-3]+ae_fabs(x->ptr.p_double[n-3]-x->ptr.p_double[n-4], _state); - ey.ptr.p_double[0] = y->ptr.p_double[0]; - ey.ptr.p_double[n-1] = y->ptr.p_double[n-3]; - for(i=1; i<=n-2; i++) - { - ex.ptr.p_double[i] = x->ptr.p_double[i-1]; - ey.ptr.p_double[i] = y->ptr.p_double[i-1]; - } - - /* - * Init sign of the function for first segment - */ - i = 0; - ca = 0; - do - { - ca = ey.ptr.p_double[i+1]-ey.ptr.p_double[i]; - i = i+1; - } - while(!(ae_fp_neq(ca,0)||i>n-2)); - if( ae_fp_neq(ca,0) ) - { - ca = ca/ae_fabs(ca, _state); - } - i = 0; - while(i=2, "Spline1DBuildMonotone: internal error", _state); - - /* - * Calculate derivatives for current segment - */ - d.ptr.p_double[i] = 0; - d.ptr.p_double[sn-1] = 0; - for(j=i+1; j<=sn-2; j++) - { - d.ptr.p_double[j] = ((ey.ptr.p_double[j]-ey.ptr.p_double[j-1])/(ex.ptr.p_double[j]-ex.ptr.p_double[j-1])+(ey.ptr.p_double[j+1]-ey.ptr.p_double[j])/(ex.ptr.p_double[j+1]-ex.ptr.p_double[j]))/2; - } - for(j=i; j<=sn-2; j++) - { - delta = (ey.ptr.p_double[j+1]-ey.ptr.p_double[j])/(ex.ptr.p_double[j+1]-ex.ptr.p_double[j]); - if( ae_fp_less_eq(ae_fabs(delta, _state),epsilon) ) - { - d.ptr.p_double[j] = 0; - d.ptr.p_double[j+1] = 0; - } - else - { - alpha = d.ptr.p_double[j]/delta; - beta = d.ptr.p_double[j+1]/delta; - if( ae_fp_neq(alpha,0) ) - { - cb = alpha*ae_sqrt(1+ae_sqr(beta/alpha, _state), _state); - } - else - { - if( ae_fp_neq(beta,0) ) - { - cb = beta; - } - else - { - continue; - } - } - if( ae_fp_greater(cb,3) ) - { - d.ptr.p_double[j] = 3*alpha*delta/cb; - d.ptr.p_double[j+1] = 3*beta*delta/cb; - } - } - } - - /* - * Transition to next segment - */ - i = sn-1; - } - spline1dbuildhermite(&ex, &ey, &d, n, c, _state); - c->continuity = 2; - ae_frame_leave(_state); -} - - -/************************************************************************* -Internal version of Spline1DGridDiffCubic. - -Accepts pre-ordered X/Y, temporary arrays (which may be preallocated, if -you want to save time, or not) and output array (which may be preallocated -too). - -Y is passed as var-parameter because we may need to force last element to -be equal to the first one (if periodic boundary conditions are specified). - - -- ALGLIB PROJECT -- - Copyright 03.09.2010 by Bochkanov Sergey -*************************************************************************/ -static void spline1d_spline1dgriddiffcubicinternal(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_int_t boundltype, - double boundl, - ae_int_t boundrtype, - double boundr, - /* Real */ ae_vector* d, - /* Real */ ae_vector* a1, - /* Real */ ae_vector* a2, - /* Real */ ae_vector* a3, - /* Real */ ae_vector* b, - /* Real */ ae_vector* dt, - ae_state *_state) -{ - ae_int_t i; - - - - /* - * allocate arrays - */ - if( d->cntcntcntcntcntcntptr.p_double[0] = (y->ptr.p_double[1]-y->ptr.p_double[0])/(x->ptr.p_double[1]-x->ptr.p_double[0]); - d->ptr.p_double[1] = d->ptr.p_double[0]; - return; - } - if( (n==2&&boundltype==-1)&&boundrtype==-1 ) - { - d->ptr.p_double[0] = 0; - d->ptr.p_double[1] = 0; - return; - } - - /* - * Periodic and non-periodic boundary conditions are - * two separate classes - */ - if( boundrtype==-1&&boundltype==-1 ) - { - - /* - * Periodic boundary conditions - */ - y->ptr.p_double[n-1] = y->ptr.p_double[0]; - - /* - * Boundary conditions at N-1 points - * (one point less because last point is the same as first point). - */ - a1->ptr.p_double[0] = x->ptr.p_double[1]-x->ptr.p_double[0]; - a2->ptr.p_double[0] = 2*(x->ptr.p_double[1]-x->ptr.p_double[0]+x->ptr.p_double[n-1]-x->ptr.p_double[n-2]); - a3->ptr.p_double[0] = x->ptr.p_double[n-1]-x->ptr.p_double[n-2]; - b->ptr.p_double[0] = 3*(y->ptr.p_double[n-1]-y->ptr.p_double[n-2])/(x->ptr.p_double[n-1]-x->ptr.p_double[n-2])*(x->ptr.p_double[1]-x->ptr.p_double[0])+3*(y->ptr.p_double[1]-y->ptr.p_double[0])/(x->ptr.p_double[1]-x->ptr.p_double[0])*(x->ptr.p_double[n-1]-x->ptr.p_double[n-2]); - for(i=1; i<=n-2; i++) - { - - /* - * Although last point is [N-2], we use X[N-1] and Y[N-1] - * (because of periodicity) - */ - a1->ptr.p_double[i] = x->ptr.p_double[i+1]-x->ptr.p_double[i]; - a2->ptr.p_double[i] = 2*(x->ptr.p_double[i+1]-x->ptr.p_double[i-1]); - a3->ptr.p_double[i] = x->ptr.p_double[i]-x->ptr.p_double[i-1]; - b->ptr.p_double[i] = 3*(y->ptr.p_double[i]-y->ptr.p_double[i-1])/(x->ptr.p_double[i]-x->ptr.p_double[i-1])*(x->ptr.p_double[i+1]-x->ptr.p_double[i])+3*(y->ptr.p_double[i+1]-y->ptr.p_double[i])/(x->ptr.p_double[i+1]-x->ptr.p_double[i])*(x->ptr.p_double[i]-x->ptr.p_double[i-1]); - } - - /* - * Solve, add last point (with index N-1) - */ - spline1d_solvecyclictridiagonal(a1, a2, a3, b, n-1, dt, _state); - ae_v_move(&d->ptr.p_double[0], 1, &dt->ptr.p_double[0], 1, ae_v_len(0,n-2)); - d->ptr.p_double[n-1] = d->ptr.p_double[0]; - } - else - { - - /* - * Non-periodic boundary condition. - * Left boundary conditions. - */ - if( boundltype==0 ) - { - a1->ptr.p_double[0] = 0; - a2->ptr.p_double[0] = 1; - a3->ptr.p_double[0] = 1; - b->ptr.p_double[0] = 2*(y->ptr.p_double[1]-y->ptr.p_double[0])/(x->ptr.p_double[1]-x->ptr.p_double[0]); - } - if( boundltype==1 ) - { - a1->ptr.p_double[0] = 0; - a2->ptr.p_double[0] = 1; - a3->ptr.p_double[0] = 0; - b->ptr.p_double[0] = boundl; - } - if( boundltype==2 ) - { - a1->ptr.p_double[0] = 0; - a2->ptr.p_double[0] = 2; - a3->ptr.p_double[0] = 1; - b->ptr.p_double[0] = 3*(y->ptr.p_double[1]-y->ptr.p_double[0])/(x->ptr.p_double[1]-x->ptr.p_double[0])-0.5*boundl*(x->ptr.p_double[1]-x->ptr.p_double[0]); - } - - /* - * Central conditions - */ - for(i=1; i<=n-2; i++) - { - a1->ptr.p_double[i] = x->ptr.p_double[i+1]-x->ptr.p_double[i]; - a2->ptr.p_double[i] = 2*(x->ptr.p_double[i+1]-x->ptr.p_double[i-1]); - a3->ptr.p_double[i] = x->ptr.p_double[i]-x->ptr.p_double[i-1]; - b->ptr.p_double[i] = 3*(y->ptr.p_double[i]-y->ptr.p_double[i-1])/(x->ptr.p_double[i]-x->ptr.p_double[i-1])*(x->ptr.p_double[i+1]-x->ptr.p_double[i])+3*(y->ptr.p_double[i+1]-y->ptr.p_double[i])/(x->ptr.p_double[i+1]-x->ptr.p_double[i])*(x->ptr.p_double[i]-x->ptr.p_double[i-1]); - } - - /* - * Right boundary conditions - */ - if( boundrtype==0 ) - { - a1->ptr.p_double[n-1] = 1; - a2->ptr.p_double[n-1] = 1; - a3->ptr.p_double[n-1] = 0; - b->ptr.p_double[n-1] = 2*(y->ptr.p_double[n-1]-y->ptr.p_double[n-2])/(x->ptr.p_double[n-1]-x->ptr.p_double[n-2]); - } - if( boundrtype==1 ) - { - a1->ptr.p_double[n-1] = 0; - a2->ptr.p_double[n-1] = 1; - a3->ptr.p_double[n-1] = 0; - b->ptr.p_double[n-1] = boundr; - } - if( boundrtype==2 ) - { - a1->ptr.p_double[n-1] = 1; - a2->ptr.p_double[n-1] = 2; - a3->ptr.p_double[n-1] = 0; - b->ptr.p_double[n-1] = 3*(y->ptr.p_double[n-1]-y->ptr.p_double[n-2])/(x->ptr.p_double[n-1]-x->ptr.p_double[n-2])+0.5*boundr*(x->ptr.p_double[n-1]-x->ptr.p_double[n-2]); - } - - /* - * Solve - */ - spline1d_solvetridiagonal(a1, a2, a3, b, n, d, _state); - } -} - - -/************************************************************************* -Internal subroutine. Heap sort. -*************************************************************************/ -static void spline1d_heapsortpoints(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector bufx; - ae_vector bufy; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&bufx, 0, DT_REAL, _state, ae_true); - ae_vector_init(&bufy, 0, DT_REAL, _state, ae_true); - - tagsortfastr(x, y, &bufx, &bufy, n, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Internal subroutine. Heap sort. - -Accepts: - X, Y - points - P - empty or preallocated array - -Returns: - X, Y - sorted by X - P - array of permutations; I-th position of output - arrays X/Y contains (X[P[I]],Y[P[I]]) -*************************************************************************/ -static void spline1d_heapsortppoints(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Integer */ ae_vector* p, - ae_int_t n, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector rbuf; - ae_vector ibuf; - ae_int_t i; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&rbuf, 0, DT_REAL, _state, ae_true); - ae_vector_init(&ibuf, 0, DT_INT, _state, ae_true); - - if( p->cntptr.p_int[i] = i; - } - tagsortfasti(x, p, &rbuf, &ibuf, n, _state); - for(i=0; i<=n-1; i++) - { - rbuf.ptr.p_double[i] = y->ptr.p_double[p->ptr.p_int[i]]; - } - ae_v_move(&y->ptr.p_double[0], 1, &rbuf.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_frame_leave(_state); -} - - -/************************************************************************* -Internal subroutine. Tridiagonal solver. Solves - -( B[0] C[0] -( A[1] B[1] C[1] ) -( A[2] B[2] C[2] ) -( .......... ) * X = D -( .......... ) -( A[N-2] B[N-2] C[N-2] ) -( A[N-1] B[N-1] ) - -*************************************************************************/ -static void spline1d_solvetridiagonal(/* Real */ ae_vector* a, - /* Real */ ae_vector* b, - /* Real */ ae_vector* c, - /* Real */ ae_vector* d, - ae_int_t n, - /* Real */ ae_vector* x, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _b; - ae_vector _d; - ae_int_t k; - double t; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_b, b, _state, ae_true); - b = &_b; - ae_vector_init_copy(&_d, d, _state, ae_true); - d = &_d; - - if( x->cntptr.p_double[k]/b->ptr.p_double[k-1]; - b->ptr.p_double[k] = b->ptr.p_double[k]-t*c->ptr.p_double[k-1]; - d->ptr.p_double[k] = d->ptr.p_double[k]-t*d->ptr.p_double[k-1]; - } - x->ptr.p_double[n-1] = d->ptr.p_double[n-1]/b->ptr.p_double[n-1]; - for(k=n-2; k>=0; k--) - { - x->ptr.p_double[k] = (d->ptr.p_double[k]-c->ptr.p_double[k]*x->ptr.p_double[k+1])/b->ptr.p_double[k]; - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Internal subroutine. Cyclic tridiagonal solver. Solves - -( B[0] C[0] A[0] ) -( A[1] B[1] C[1] ) -( A[2] B[2] C[2] ) -( .......... ) * X = D -( .......... ) -( A[N-2] B[N-2] C[N-2] ) -( C[N-1] A[N-1] B[N-1] ) -*************************************************************************/ -static void spline1d_solvecyclictridiagonal(/* Real */ ae_vector* a, - /* Real */ ae_vector* b, - /* Real */ ae_vector* c, - /* Real */ ae_vector* d, - ae_int_t n, - /* Real */ ae_vector* x, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _b; - ae_int_t k; - double alpha; - double beta; - double gamma; - ae_vector y; - ae_vector z; - ae_vector u; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_b, b, _state, ae_true); - b = &_b; - ae_vector_init(&y, 0, DT_REAL, _state, ae_true); - ae_vector_init(&z, 0, DT_REAL, _state, ae_true); - ae_vector_init(&u, 0, DT_REAL, _state, ae_true); - - if( x->cntptr.p_double[0]; - alpha = c->ptr.p_double[n-1]; - gamma = -b->ptr.p_double[0]; - b->ptr.p_double[0] = 2*b->ptr.p_double[0]; - b->ptr.p_double[n-1] = b->ptr.p_double[n-1]-alpha*beta/gamma; - ae_vector_set_length(&u, n, _state); - for(k=0; k<=n-1; k++) - { - u.ptr.p_double[k] = 0; - } - u.ptr.p_double[0] = gamma; - u.ptr.p_double[n-1] = alpha; - spline1d_solvetridiagonal(a, b, c, d, n, &y, _state); - spline1d_solvetridiagonal(a, b, c, &u, n, &z, _state); - for(k=0; k<=n-1; k++) - { - x->ptr.p_double[k] = y.ptr.p_double[k]-(y.ptr.p_double[0]+beta/gamma*y.ptr.p_double[n-1])/(1+z.ptr.p_double[0]+beta/gamma*z.ptr.p_double[n-1])*z.ptr.p_double[k]; - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Internal subroutine. Three-point differentiation -*************************************************************************/ -static double spline1d_diffthreepoint(double t, - double x0, - double f0, - double x1, - double f1, - double x2, - double f2, - ae_state *_state) -{ - double a; - double b; - double result; - - - t = t-x0; - x1 = x1-x0; - x2 = x2-x0; - a = (f2-f0-x2/x1*(f1-f0))/(ae_sqr(x2, _state)-x1*x2); - b = (f1-f0-a*ae_sqr(x1, _state))/x1; - result = 2*a*t+b; - return result; -} - - -/************************************************************************* -Procedure for calculating value of a function is providet in the form of -Hermite polinom - -INPUT PARAMETERS: - P0 - value of a function at 0 - M0 - value of a derivative at 0 - P1 - value of a function at 1 - M1 - value of a derivative at 1 - T - point inside [0;1] - -OUTPUT PARAMETERS: - S - value of a function at T - B0 - value of a derivative function at T - - -- ALGLIB PROJECT -- - Copyright 26.09.2011 by Bochkanov Sergey -*************************************************************************/ -static void spline1d_hermitecalc(double p0, - double m0, - double p1, - double m1, - double t, - double* s, - double* ds, - ae_state *_state) -{ - - *s = 0; - *ds = 0; - - *s = p0*(1+2*t)*(1-t)*(1-t)+m0*t*(1-t)*(1-t)+p1*(3-2*t)*t*t+m1*t*t*(t-1); - *ds = -p0*6*t*(1-t)+m0*(1-t)*(1-3*t)+p1*6*t*(1-t)+m1*t*(3*t-2); -} - - -/************************************************************************* -Function for mapping from [A0;B0] to [A1;B1] - -INPUT PARAMETERS: - A0 - left border [A0;B0] - B0 - right border [A0;B0] - A1 - left border [A1;B1] - B1 - right border [A1;B1] - T - value inside [A0;B0] - -RESTRICTIONS OF PARAMETERS: - -We assume, that B0>A0 and B1>A1. But we chech, that T is inside [A0;B0], -and if TB0 then T - B1. - -INPUT PARAMETERS: - A0 - left border for segment [A0;B0] from 'T' is converted to [A1;B1] - B0 - right border for segment [A0;B0] from 'T' is converted to [A1;B1] - A1 - left border for segment [A1;B1] to 'T' is converted from [A0;B0] - B1 - right border for segment [A1;B1] to 'T' is converted from [A0;B0] - T - the parameter is mapped from [A0;B0] to [A1;B1] - -Result: - is converted value for 'T' from [A0;B0] to [A1;B1] - -REMARK: - -The function don't check value A0,B0 and A1,B1! - - -- ALGLIB PROJECT -- - Copyright 26.09.2011 by Bochkanov Sergey -*************************************************************************/ -static double spline1d_rescaleval(double a0, - double b0, - double a1, - double b1, - double t, - ae_state *_state) -{ - double result; - - - - /* - *return left border - */ - if( ae_fp_less_eq(t,a0) ) - { - result = a1; - return result; - } - - /* - *return right border - */ - if( ae_fp_greater_eq(t,b0) ) - { - result = b1; - return result; - } - - /* - *return value between left and right borders - */ - result = (b1-a1)*(t-a0)/(b0-a0)+a1; - return result; -} - - -ae_bool _spline1dinterpolant_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - spline1dinterpolant *p = (spline1dinterpolant*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->c, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _spline1dinterpolant_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - spline1dinterpolant *dst = (spline1dinterpolant*)_dst; - spline1dinterpolant *src = (spline1dinterpolant*)_src; - dst->periodic = src->periodic; - dst->n = src->n; - dst->k = src->k; - dst->continuity = src->continuity; - if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->c, &src->c, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _spline1dinterpolant_clear(void* _p) -{ - spline1dinterpolant *p = (spline1dinterpolant*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->x); - ae_vector_clear(&p->c); -} - - -void _spline1dinterpolant_destroy(void* _p) -{ - spline1dinterpolant *p = (spline1dinterpolant*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->x); - ae_vector_destroy(&p->c); -} - - - - -/************************************************************************* -Fitting by polynomials in barycentric form. This function provides simple -unterface for unconstrained unweighted fitting. See PolynomialFitWC() if -you need constrained fitting. - -Task is linear, so linear least squares solver is used. Complexity of this -computational scheme is O(N*M^2), mostly dominated by least squares solver - -SEE ALSO: - PolynomialFitWC() - -INPUT PARAMETERS: - X - points, array[0..N-1]. - Y - function values, array[0..N-1]. - N - number of points, N>0 - * if given, only leading N elements of X/Y are used - * if not given, automatically determined from sizes of X/Y - M - number of basis functions (= polynomial_degree + 1), M>=1 - -OUTPUT PARAMETERS: - Info- same format as in LSFitLinearW() subroutine: - * Info>0 task is solved - * Info<=0 an error occurred: - -4 means inconvergence of internal SVD - P - interpolant in barycentric form. - Rep - report, same format as in LSFitLinearW() subroutine. - Following fields are set: - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -NOTES: - you can convert P from barycentric form to the power or Chebyshev - basis with PolynomialBar2Pow() or PolynomialBar2Cheb() functions from - POLINT subpackage. - - -- ALGLIB PROJECT -- - Copyright 10.12.2009 by Bochkanov Sergey -*************************************************************************/ -void polynomialfit(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_int_t m, - ae_int_t* info, - barycentricinterpolant* p, - polynomialfitreport* rep, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_vector w; - ae_vector xc; - ae_vector yc; - ae_vector dc; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _barycentricinterpolant_clear(p); - _polynomialfitreport_clear(rep); - ae_vector_init(&w, 0, DT_REAL, _state, ae_true); - ae_vector_init(&xc, 0, DT_REAL, _state, ae_true); - ae_vector_init(&yc, 0, DT_REAL, _state, ae_true); - ae_vector_init(&dc, 0, DT_INT, _state, ae_true); - - ae_assert(n>0, "PolynomialFit: N<=0!", _state); - ae_assert(m>0, "PolynomialFit: M<=0!", _state); - ae_assert(x->cnt>=n, "PolynomialFit: Length(X)cnt>=n, "PolynomialFit: Length(Y)0. - * if given, only leading N elements of X/Y/W are used - * if not given, automatically determined from sizes of X/Y/W - XC - points where polynomial values/derivatives are constrained, - array[0..K-1]. - YC - values of constraints, array[0..K-1] - DC - array[0..K-1], types of constraints: - * DC[i]=0 means that P(XC[i])=YC[i] - * DC[i]=1 means that P'(XC[i])=YC[i] - SEE BELOW FOR IMPORTANT INFORMATION ON CONSTRAINTS - K - number of constraints, 0<=K=1 - -OUTPUT PARAMETERS: - Info- same format as in LSFitLinearW() subroutine: - * Info>0 task is solved - * Info<=0 an error occurred: - -4 means inconvergence of internal SVD - -3 means inconsistent constraints - P - interpolant in barycentric form. - Rep - report, same format as in LSFitLinearW() subroutine. - Following fields are set: - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -IMPORTANT: - this subroitine doesn't calculate task's condition number for K<>0. - -NOTES: - you can convert P from barycentric form to the power or Chebyshev - basis with PolynomialBar2Pow() or PolynomialBar2Cheb() functions from - POLINT subpackage. - -SETTING CONSTRAINTS - DANGERS AND OPPORTUNITIES: - -Setting constraints can lead to undesired results, like ill-conditioned -behavior, or inconsistency being detected. From the other side, it allows -us to improve quality of the fit. Here we summarize our experience with -constrained regression splines: -* even simple constraints can be inconsistent, see Wikipedia article on - this subject: http://en.wikipedia.org/wiki/Birkhoff_interpolation -* the greater is M (given fixed constraints), the more chances that - constraints will be consistent -* in the general case, consistency of constraints is NOT GUARANTEED. -* in the one special cases, however, we can guarantee consistency. This - case is: M>1 and constraints on the function values (NOT DERIVATIVES) - -Our final recommendation is to use constraints WHEN AND ONLY when you -can't solve your task without them. Anything beyond special cases given -above is not guaranteed and may result in inconsistency. - - -- ALGLIB PROJECT -- - Copyright 10.12.2009 by Bochkanov Sergey -*************************************************************************/ -void polynomialfitwc(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* w, - ae_int_t n, - /* Real */ ae_vector* xc, - /* Real */ ae_vector* yc, - /* Integer */ ae_vector* dc, - ae_int_t k, - ae_int_t m, - ae_int_t* info, - barycentricinterpolant* p, - polynomialfitreport* rep, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _x; - ae_vector _y; - ae_vector _w; - ae_vector _xc; - ae_vector _yc; - double xa; - double xb; - double sa; - double sb; - ae_vector xoriginal; - ae_vector yoriginal; - ae_vector y2; - ae_vector w2; - ae_vector tmp; - ae_vector tmp2; - ae_vector bx; - ae_vector by; - ae_vector bw; - ae_int_t i; - ae_int_t j; - double u; - double v; - double s; - ae_int_t relcnt; - lsfitreport lrep; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_x, x, _state, ae_true); - x = &_x; - ae_vector_init_copy(&_y, y, _state, ae_true); - y = &_y; - ae_vector_init_copy(&_w, w, _state, ae_true); - w = &_w; - ae_vector_init_copy(&_xc, xc, _state, ae_true); - xc = &_xc; - ae_vector_init_copy(&_yc, yc, _state, ae_true); - yc = &_yc; - *info = 0; - _barycentricinterpolant_clear(p); - _polynomialfitreport_clear(rep); - ae_vector_init(&xoriginal, 0, DT_REAL, _state, ae_true); - ae_vector_init(&yoriginal, 0, DT_REAL, _state, ae_true); - ae_vector_init(&y2, 0, DT_REAL, _state, ae_true); - ae_vector_init(&w2, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tmp2, 0, DT_REAL, _state, ae_true); - ae_vector_init(&bx, 0, DT_REAL, _state, ae_true); - ae_vector_init(&by, 0, DT_REAL, _state, ae_true); - ae_vector_init(&bw, 0, DT_REAL, _state, ae_true); - _lsfitreport_init(&lrep, _state, ae_true); - - ae_assert(n>0, "PolynomialFitWC: N<=0!", _state); - ae_assert(m>0, "PolynomialFitWC: M<=0!", _state); - ae_assert(k>=0, "PolynomialFitWC: K<0!", _state); - ae_assert(k=M!", _state); - ae_assert(x->cnt>=n, "PolynomialFitWC: Length(X)cnt>=n, "PolynomialFitWC: Length(Y)cnt>=n, "PolynomialFitWC: Length(W)cnt>=k, "PolynomialFitWC: Length(XC)cnt>=k, "PolynomialFitWC: Length(YC)cnt>=k, "PolynomialFitWC: Length(DC)ptr.p_int[i]==0||dc->ptr.p_int[i]==1, "PolynomialFitWC: one of DC[] is not 0 or 1!", _state); - } - - /* - * Scale X, Y, XC, YC. - * Solve scaled problem using internal Chebyshev fitting function. - */ - lsfitscalexy(x, y, w, n, xc, yc, dc, k, &xa, &xb, &sa, &sb, &xoriginal, &yoriginal, _state); - lsfit_internalchebyshevfit(x, y, w, n, xc, yc, dc, k, m, info, &tmp, &lrep, _state); - if( *info<0 ) - { - ae_frame_leave(_state); - return; - } - - /* - * Generate barycentric model and scale it - * * BX, BY store barycentric model nodes - * * FMatrix is reused (remember - it is at least MxM, what we need) - * - * Model initialization is done in O(M^2). In principle, it can be - * done in O(M*log(M)), but before it we solved task with O(N*M^2) - * complexity, so it is only a small amount of total time spent. - */ - ae_vector_set_length(&bx, m, _state); - ae_vector_set_length(&by, m, _state); - ae_vector_set_length(&bw, m, _state); - ae_vector_set_length(&tmp2, m, _state); - s = 1; - for(i=0; i<=m-1; i++) - { - if( m!=1 ) - { - u = ae_cos(ae_pi*i/(m-1), _state); - } - else - { - u = 0; - } - v = 0; - for(j=0; j<=m-1; j++) - { - if( j==0 ) - { - tmp2.ptr.p_double[j] = 1; - } - else - { - if( j==1 ) - { - tmp2.ptr.p_double[j] = u; - } - else - { - tmp2.ptr.p_double[j] = 2*u*tmp2.ptr.p_double[j-1]-tmp2.ptr.p_double[j-2]; - } - } - v = v+tmp.ptr.p_double[j]*tmp2.ptr.p_double[j]; - } - bx.ptr.p_double[i] = u; - by.ptr.p_double[i] = v; - bw.ptr.p_double[i] = s; - if( i==0||i==m-1 ) - { - bw.ptr.p_double[i] = 0.5*bw.ptr.p_double[i]; - } - s = -s; - } - barycentricbuildxyw(&bx, &by, &bw, m, p, _state); - barycentriclintransx(p, 2/(xb-xa), -(xa+xb)/(xb-xa), _state); - barycentriclintransy(p, sb-sa, sa, _state); - - /* - * Scale absolute errors obtained from LSFitLinearW. - * Relative error should be calculated separately - * (because of shifting/scaling of the task) - */ - rep->taskrcond = lrep.taskrcond; - rep->rmserror = lrep.rmserror*(sb-sa); - rep->avgerror = lrep.avgerror*(sb-sa); - rep->maxerror = lrep.maxerror*(sb-sa); - rep->avgrelerror = 0; - relcnt = 0; - for(i=0; i<=n-1; i++) - { - if( ae_fp_neq(yoriginal.ptr.p_double[i],0) ) - { - rep->avgrelerror = rep->avgrelerror+ae_fabs(barycentriccalc(p, xoriginal.ptr.p_double[i], _state)-yoriginal.ptr.p_double[i], _state)/ae_fabs(yoriginal.ptr.p_double[i], _state); - relcnt = relcnt+1; - } - } - if( relcnt!=0 ) - { - rep->avgrelerror = rep->avgrelerror/relcnt; - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Weghted rational least squares fitting using Floater-Hormann rational -functions with optimal D chosen from [0,9], with constraints and -individual weights. - -Equidistant grid with M node on [min(x),max(x)] is used to build basis -functions. Different values of D are tried, optimal D (least WEIGHTED root -mean square error) is chosen. Task is linear, so linear least squares -solver is used. Complexity of this computational scheme is O(N*M^2) -(mostly dominated by the least squares solver). - -SEE ALSO -* BarycentricFitFloaterHormann(), "lightweight" fitting without invididual - weights and constraints. - -INPUT PARAMETERS: - X - points, array[0..N-1]. - Y - function values, array[0..N-1]. - W - weights, array[0..N-1] - Each summand in square sum of approximation deviations from - given values is multiplied by the square of corresponding - weight. Fill it by 1's if you don't want to solve weighted - task. - N - number of points, N>0. - XC - points where function values/derivatives are constrained, - array[0..K-1]. - YC - values of constraints, array[0..K-1] - DC - array[0..K-1], types of constraints: - * DC[i]=0 means that S(XC[i])=YC[i] - * DC[i]=1 means that S'(XC[i])=YC[i] - SEE BELOW FOR IMPORTANT INFORMATION ON CONSTRAINTS - K - number of constraints, 0<=K=2. - -OUTPUT PARAMETERS: - Info- same format as in LSFitLinearWC() subroutine. - * Info>0 task is solved - * Info<=0 an error occurred: - -4 means inconvergence of internal SVD - -3 means inconsistent constraints - -1 means another errors in parameters passed - (N<=0, for example) - B - barycentric interpolant. - Rep - report, same format as in LSFitLinearWC() subroutine. - Following fields are set: - * DBest best value of the D parameter - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -IMPORTANT: - this subroutine doesn't calculate task's condition number for K<>0. - -SETTING CONSTRAINTS - DANGERS AND OPPORTUNITIES: - -Setting constraints can lead to undesired results, like ill-conditioned -behavior, or inconsistency being detected. From the other side, it allows -us to improve quality of the fit. Here we summarize our experience with -constrained barycentric interpolants: -* excessive constraints can be inconsistent. Floater-Hormann basis - functions aren't as flexible as splines (although they are very smooth). -* the more evenly constraints are spread across [min(x),max(x)], the more - chances that they will be consistent -* the greater is M (given fixed constraints), the more chances that - constraints will be consistent -* in the general case, consistency of constraints IS NOT GUARANTEED. -* in the several special cases, however, we CAN guarantee consistency. -* one of this cases is constraints on the function VALUES at the interval - boundaries. Note that consustency of the constraints on the function - DERIVATIVES is NOT guaranteed (you can use in such cases cubic splines - which are more flexible). -* another special case is ONE constraint on the function value (OR, but - not AND, derivative) anywhere in the interval - -Our final recommendation is to use constraints WHEN AND ONLY WHEN you -can't solve your task without them. Anything beyond special cases given -above is not guaranteed and may result in inconsistency. - - -- ALGLIB PROJECT -- - Copyright 18.08.2009 by Bochkanov Sergey -*************************************************************************/ -void barycentricfitfloaterhormannwc(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* w, - ae_int_t n, - /* Real */ ae_vector* xc, - /* Real */ ae_vector* yc, - /* Integer */ ae_vector* dc, - ae_int_t k, - ae_int_t m, - ae_int_t* info, - barycentricinterpolant* b, - barycentricfitreport* rep, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t d; - ae_int_t i; - double wrmscur; - double wrmsbest; - barycentricinterpolant locb; - barycentricfitreport locrep; - ae_int_t locinfo; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _barycentricinterpolant_clear(b); - _barycentricfitreport_clear(rep); - _barycentricinterpolant_init(&locb, _state, ae_true); - _barycentricfitreport_init(&locrep, _state, ae_true); - - ae_assert(n>0, "BarycentricFitFloaterHormannWC: N<=0!", _state); - ae_assert(m>0, "BarycentricFitFloaterHormannWC: M<=0!", _state); - ae_assert(k>=0, "BarycentricFitFloaterHormannWC: K<0!", _state); - ae_assert(k=M!", _state); - ae_assert(x->cnt>=n, "BarycentricFitFloaterHormannWC: Length(X)cnt>=n, "BarycentricFitFloaterHormannWC: Length(Y)cnt>=n, "BarycentricFitFloaterHormannWC: Length(W)cnt>=k, "BarycentricFitFloaterHormannWC: Length(XC)cnt>=k, "BarycentricFitFloaterHormannWC: Length(YC)cnt>=k, "BarycentricFitFloaterHormannWC: Length(DC)ptr.p_int[i]==0||dc->ptr.p_int[i]==1, "BarycentricFitFloaterHormannWC: one of DC[] is not 0 or 1!", _state); - } - - /* - * Find optimal D - * - * Info is -3 by default (degenerate constraints). - * If LocInfo will always be equal to -3, Info will remain equal to -3. - * If at least once LocInfo will be -4, Info will be -4. - */ - wrmsbest = ae_maxrealnumber; - rep->dbest = -1; - *info = -3; - for(d=0; d<=ae_minint(9, n-1, _state); d++) - { - lsfit_barycentricfitwcfixedd(x, y, w, n, xc, yc, dc, k, m, d, &locinfo, &locb, &locrep, _state); - ae_assert((locinfo==-4||locinfo==-3)||locinfo>0, "BarycentricFitFloaterHormannWC: unexpected result from BarycentricFitWCFixedD!", _state); - if( locinfo>0 ) - { - - /* - * Calculate weghted RMS - */ - wrmscur = 0; - for(i=0; i<=n-1; i++) - { - wrmscur = wrmscur+ae_sqr(w->ptr.p_double[i]*(y->ptr.p_double[i]-barycentriccalc(&locb, x->ptr.p_double[i], _state)), _state); - } - wrmscur = ae_sqrt(wrmscur/n, _state); - if( ae_fp_less(wrmscur,wrmsbest)||rep->dbest<0 ) - { - barycentriccopy(&locb, b, _state); - rep->dbest = d; - *info = 1; - rep->rmserror = locrep.rmserror; - rep->avgerror = locrep.avgerror; - rep->avgrelerror = locrep.avgrelerror; - rep->maxerror = locrep.maxerror; - rep->taskrcond = locrep.taskrcond; - wrmsbest = wrmscur; - } - } - else - { - if( locinfo!=-3&&*info<0 ) - { - *info = locinfo; - } - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Rational least squares fitting using Floater-Hormann rational functions -with optimal D chosen from [0,9]. - -Equidistant grid with M node on [min(x),max(x)] is used to build basis -functions. Different values of D are tried, optimal D (least root mean -square error) is chosen. Task is linear, so linear least squares solver -is used. Complexity of this computational scheme is O(N*M^2) (mostly -dominated by the least squares solver). - -INPUT PARAMETERS: - X - points, array[0..N-1]. - Y - function values, array[0..N-1]. - N - number of points, N>0. - M - number of basis functions ( = number_of_nodes), M>=2. - -OUTPUT PARAMETERS: - Info- same format as in LSFitLinearWC() subroutine. - * Info>0 task is solved - * Info<=0 an error occurred: - -4 means inconvergence of internal SVD - -3 means inconsistent constraints - B - barycentric interpolant. - Rep - report, same format as in LSFitLinearWC() subroutine. - Following fields are set: - * DBest best value of the D parameter - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - - -- ALGLIB PROJECT -- - Copyright 18.08.2009 by Bochkanov Sergey -*************************************************************************/ -void barycentricfitfloaterhormann(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_int_t m, - ae_int_t* info, - barycentricinterpolant* b, - barycentricfitreport* rep, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector w; - ae_vector xc; - ae_vector yc; - ae_vector dc; - ae_int_t i; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _barycentricinterpolant_clear(b); - _barycentricfitreport_clear(rep); - ae_vector_init(&w, 0, DT_REAL, _state, ae_true); - ae_vector_init(&xc, 0, DT_REAL, _state, ae_true); - ae_vector_init(&yc, 0, DT_REAL, _state, ae_true); - ae_vector_init(&dc, 0, DT_INT, _state, ae_true); - - ae_assert(n>0, "BarycentricFitFloaterHormann: N<=0!", _state); - ae_assert(m>0, "BarycentricFitFloaterHormann: M<=0!", _state); - ae_assert(x->cnt>=n, "BarycentricFitFloaterHormann: Length(X)cnt>=n, "BarycentricFitFloaterHormann: Length(Y)0. - M - number of basis functions ( = number_of_nodes), M>=2. - -OUTPUT PARAMETERS: - Info- same format as in LSFitLinearWC() subroutine. - * Info>0 task is solved - * Info<=0 an error occurred: - -4 means inconvergence of internal SVD - -3 means inconsistent constraints - B - barycentric interpolant. - Rep - report, same format as in LSFitLinearWC() subroutine. - Following fields are set: - * DBest best value of the D parameter - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - - -- ALGLIB PROJECT -- - Copyright 18.08.2009 by Bochkanov Sergey -*************************************************************************/ -void spline1dfitpenalized(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_int_t m, - double rho, - ae_int_t* info, - spline1dinterpolant* s, - spline1dfitreport* rep, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _x; - ae_vector _y; - ae_vector w; - ae_int_t i; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_x, x, _state, ae_true); - x = &_x; - ae_vector_init_copy(&_y, y, _state, ae_true); - y = &_y; - *info = 0; - _spline1dinterpolant_clear(s); - _spline1dfitreport_clear(rep); - ae_vector_init(&w, 0, DT_REAL, _state, ae_true); - - ae_assert(n>=1, "Spline1DFitPenalized: N<1!", _state); - ae_assert(m>=4, "Spline1DFitPenalized: M<4!", _state); - ae_assert(x->cnt>=n, "Spline1DFitPenalized: Length(X)cnt>=n, "Spline1DFitPenalized: Length(Y)0 - * if given, only first N elements of X/Y/W are processed - * if not given, automatically determined from X/Y/W sizes - M - number of basis functions ( = number_of_nodes), M>=4. - Rho - regularization constant passed by user. It penalizes - nonlinearity in the regression spline. It is logarithmically - scaled, i.e. actual value of regularization constant is - calculated as 10^Rho. It is automatically scaled so that: - * Rho=2.0 corresponds to moderate amount of nonlinearity - * generally, it should be somewhere in the [-8.0,+8.0] - If you do not want to penalize nonlineary, - pass small Rho. Values as low as -15 should work. - -OUTPUT PARAMETERS: - Info- same format as in LSFitLinearWC() subroutine. - * Info>0 task is solved - * Info<=0 an error occurred: - -4 means inconvergence of internal SVD or - Cholesky decomposition; problem may be - too ill-conditioned (very rare) - S - spline interpolant. - Rep - Following fields are set: - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -IMPORTANT: - this subroitine doesn't calculate task's condition number for K<>0. - -NOTE 1: additional nodes are added to the spline outside of the fitting -interval to force linearity when xmax(x,xc). It is done -for consistency - we penalize non-linearity at [min(x,xc),max(x,xc)], so -it is natural to force linearity outside of this interval. - -NOTE 2: function automatically sorts points, so caller may pass unsorted -array. - - -- ALGLIB PROJECT -- - Copyright 19.10.2010 by Bochkanov Sergey -*************************************************************************/ -void spline1dfitpenalizedw(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* w, - ae_int_t n, - ae_int_t m, - double rho, - ae_int_t* info, - spline1dinterpolant* s, - spline1dfitreport* rep, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _x; - ae_vector _y; - ae_vector _w; - ae_int_t i; - ae_int_t j; - ae_int_t b; - double v; - double relcnt; - double xa; - double xb; - double sa; - double sb; - ae_vector xoriginal; - ae_vector yoriginal; - double pdecay; - double tdecay; - ae_matrix fmatrix; - ae_vector fcolumn; - ae_vector y2; - ae_vector w2; - ae_vector xc; - ae_vector yc; - ae_vector dc; - double fdmax; - double admax; - ae_matrix amatrix; - ae_matrix d2matrix; - double fa; - double ga; - double fb; - double gb; - double lambdav; - ae_vector bx; - ae_vector by; - ae_vector bd1; - ae_vector bd2; - ae_vector tx; - ae_vector ty; - ae_vector td; - spline1dinterpolant bs; - ae_matrix nmatrix; - ae_vector rightpart; - fblslincgstate cgstate; - ae_vector c; - ae_vector tmp0; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_x, x, _state, ae_true); - x = &_x; - ae_vector_init_copy(&_y, y, _state, ae_true); - y = &_y; - ae_vector_init_copy(&_w, w, _state, ae_true); - w = &_w; - *info = 0; - _spline1dinterpolant_clear(s); - _spline1dfitreport_clear(rep); - ae_vector_init(&xoriginal, 0, DT_REAL, _state, ae_true); - ae_vector_init(&yoriginal, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&fmatrix, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&fcolumn, 0, DT_REAL, _state, ae_true); - ae_vector_init(&y2, 0, DT_REAL, _state, ae_true); - ae_vector_init(&w2, 0, DT_REAL, _state, ae_true); - ae_vector_init(&xc, 0, DT_REAL, _state, ae_true); - ae_vector_init(&yc, 0, DT_REAL, _state, ae_true); - ae_vector_init(&dc, 0, DT_INT, _state, ae_true); - ae_matrix_init(&amatrix, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&d2matrix, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&bx, 0, DT_REAL, _state, ae_true); - ae_vector_init(&by, 0, DT_REAL, _state, ae_true); - ae_vector_init(&bd1, 0, DT_REAL, _state, ae_true); - ae_vector_init(&bd2, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tx, 0, DT_REAL, _state, ae_true); - ae_vector_init(&ty, 0, DT_REAL, _state, ae_true); - ae_vector_init(&td, 0, DT_REAL, _state, ae_true); - _spline1dinterpolant_init(&bs, _state, ae_true); - ae_matrix_init(&nmatrix, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&rightpart, 0, DT_REAL, _state, ae_true); - _fblslincgstate_init(&cgstate, _state, ae_true); - ae_vector_init(&c, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tmp0, 0, DT_REAL, _state, ae_true); - - ae_assert(n>=1, "Spline1DFitPenalizedW: N<1!", _state); - ae_assert(m>=4, "Spline1DFitPenalizedW: M<4!", _state); - ae_assert(x->cnt>=n, "Spline1DFitPenalizedW: Length(X)cnt>=n, "Spline1DFitPenalizedW: Length(Y)cnt>=n, "Spline1DFitPenalizedW: Length(W)ptr.p_double[i]*fcolumn.ptr.p_double[i], _state); - } - fdmax = ae_maxreal(fdmax, v, _state); - - /* - * Fill temporary with second derivatives of basis function - */ - ae_v_move(&d2matrix.ptr.pp_double[b][0], 1, &bd2.ptr.p_double[0], 1, ae_v_len(0,m-1)); - } - - /* - * * calculate penalty matrix A - * * calculate max of diagonal elements of A - * * calculate PDecay - coefficient before penalty matrix - */ - for(i=0; i<=m-1; i++) - { - for(j=i; j<=m-1; j++) - { - - /* - * calculate integral(B_i''*B_j'') where B_i and B_j are - * i-th and j-th basis splines. - * B_i and B_j are piecewise linear functions. - */ - v = 0; - for(b=0; b<=m-2; b++) - { - fa = d2matrix.ptr.pp_double[i][b]; - fb = d2matrix.ptr.pp_double[i][b+1]; - ga = d2matrix.ptr.pp_double[j][b]; - gb = d2matrix.ptr.pp_double[j][b+1]; - v = v+(bx.ptr.p_double[b+1]-bx.ptr.p_double[b])*(fa*ga+(fa*(gb-ga)+ga*(fb-fa))/2+(fb-fa)*(gb-ga)/3); - } - amatrix.ptr.pp_double[i][j] = v; - amatrix.ptr.pp_double[j][i] = v; - } - } - admax = 0; - for(i=0; i<=m-1; i++) - { - admax = ae_maxreal(admax, ae_fabs(amatrix.ptr.pp_double[i][i], _state), _state); - } - pdecay = lambdav*fdmax/admax; - - /* - * Calculate TDecay for Tikhonov regularization - */ - tdecay = fdmax*(1+pdecay)*10*ae_machineepsilon; - - /* - * Prepare system - * - * NOTE: FMatrix is spoiled during this process - */ - for(i=0; i<=n-1; i++) - { - v = w->ptr.p_double[i]; - ae_v_muld(&fmatrix.ptr.pp_double[i][0], 1, ae_v_len(0,m-1), v); - } - rmatrixgemm(m, m, n, 1.0, &fmatrix, 0, 0, 1, &fmatrix, 0, 0, 0, 0.0, &nmatrix, 0, 0, _state); - for(i=0; i<=m-1; i++) - { - for(j=0; j<=m-1; j++) - { - nmatrix.ptr.pp_double[i][j] = nmatrix.ptr.pp_double[i][j]+pdecay*amatrix.ptr.pp_double[i][j]; - } - } - for(i=0; i<=m-1; i++) - { - nmatrix.ptr.pp_double[i][i] = nmatrix.ptr.pp_double[i][i]+tdecay; - } - for(i=0; i<=m-1; i++) - { - rightpart.ptr.p_double[i] = 0; - } - for(i=0; i<=n-1; i++) - { - v = y->ptr.p_double[i]*w->ptr.p_double[i]; - ae_v_addd(&rightpart.ptr.p_double[0], 1, &fmatrix.ptr.pp_double[i][0], 1, ae_v_len(0,m-1), v); - } - - /* - * Solve system - */ - if( !spdmatrixcholesky(&nmatrix, m, ae_true, _state) ) - { - *info = -4; - ae_frame_leave(_state); - return; - } - fblscholeskysolve(&nmatrix, 1.0, m, ae_true, &rightpart, &tmp0, _state); - ae_v_move(&c.ptr.p_double[0], 1, &rightpart.ptr.p_double[0], 1, ae_v_len(0,m-1)); - - /* - * add nodes to force linearity outside of the fitting interval - */ - spline1dgriddiffcubic(&bx, &c, m, 2, 0.0, 2, 0.0, &bd1, _state); - ae_vector_set_length(&tx, m+2, _state); - ae_vector_set_length(&ty, m+2, _state); - ae_vector_set_length(&td, m+2, _state); - ae_v_move(&tx.ptr.p_double[1], 1, &bx.ptr.p_double[0], 1, ae_v_len(1,m)); - ae_v_move(&ty.ptr.p_double[1], 1, &rightpart.ptr.p_double[0], 1, ae_v_len(1,m)); - ae_v_move(&td.ptr.p_double[1], 1, &bd1.ptr.p_double[0], 1, ae_v_len(1,m)); - tx.ptr.p_double[0] = tx.ptr.p_double[1]-(tx.ptr.p_double[2]-tx.ptr.p_double[1]); - ty.ptr.p_double[0] = ty.ptr.p_double[1]-td.ptr.p_double[1]*(tx.ptr.p_double[2]-tx.ptr.p_double[1]); - td.ptr.p_double[0] = td.ptr.p_double[1]; - tx.ptr.p_double[m+1] = tx.ptr.p_double[m]+(tx.ptr.p_double[m]-tx.ptr.p_double[m-1]); - ty.ptr.p_double[m+1] = ty.ptr.p_double[m]+td.ptr.p_double[m]*(tx.ptr.p_double[m]-tx.ptr.p_double[m-1]); - td.ptr.p_double[m+1] = td.ptr.p_double[m]; - spline1dbuildhermite(&tx, &ty, &td, m+2, s, _state); - spline1dlintransx(s, 2/(xb-xa), -(xa+xb)/(xb-xa), _state); - spline1dlintransy(s, sb-sa, sa, _state); - *info = 1; - - /* - * Fill report - */ - rep->rmserror = 0; - rep->avgerror = 0; - rep->avgrelerror = 0; - rep->maxerror = 0; - relcnt = 0; - spline1dconvcubic(&bx, &rightpart, m, 2, 0.0, 2, 0.0, x, n, &fcolumn, _state); - for(i=0; i<=n-1; i++) - { - v = (sb-sa)*fcolumn.ptr.p_double[i]+sa; - rep->rmserror = rep->rmserror+ae_sqr(v-yoriginal.ptr.p_double[i], _state); - rep->avgerror = rep->avgerror+ae_fabs(v-yoriginal.ptr.p_double[i], _state); - if( ae_fp_neq(yoriginal.ptr.p_double[i],0) ) - { - rep->avgrelerror = rep->avgrelerror+ae_fabs(v-yoriginal.ptr.p_double[i], _state)/ae_fabs(yoriginal.ptr.p_double[i], _state); - relcnt = relcnt+1; - } - rep->maxerror = ae_maxreal(rep->maxerror, ae_fabs(v-yoriginal.ptr.p_double[i], _state), _state); - } - rep->rmserror = ae_sqrt(rep->rmserror/n, _state); - rep->avgerror = rep->avgerror/n; - if( ae_fp_neq(relcnt,0) ) - { - rep->avgrelerror = rep->avgrelerror/relcnt; - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Weighted fitting by cubic spline, with constraints on function values or -derivatives. - -Equidistant grid with M-2 nodes on [min(x,xc),max(x,xc)] is used to build -basis functions. Basis functions are cubic splines with continuous second -derivatives and non-fixed first derivatives at interval ends. Small -regularizing term is used when solving constrained tasks (to improve -stability). - -Task is linear, so linear least squares solver is used. Complexity of this -computational scheme is O(N*M^2), mostly dominated by least squares solver - -SEE ALSO - Spline1DFitHermiteWC() - fitting by Hermite splines (more flexible, - less smooth) - Spline1DFitCubic() - "lightweight" fitting by cubic splines, - without invididual weights and constraints - -INPUT PARAMETERS: - X - points, array[0..N-1]. - Y - function values, array[0..N-1]. - W - weights, array[0..N-1] - Each summand in square sum of approximation deviations from - given values is multiplied by the square of corresponding - weight. Fill it by 1's if you don't want to solve weighted - task. - N - number of points (optional): - * N>0 - * if given, only first N elements of X/Y/W are processed - * if not given, automatically determined from X/Y/W sizes - XC - points where spline values/derivatives are constrained, - array[0..K-1]. - YC - values of constraints, array[0..K-1] - DC - array[0..K-1], types of constraints: - * DC[i]=0 means that S(XC[i])=YC[i] - * DC[i]=1 means that S'(XC[i])=YC[i] - SEE BELOW FOR IMPORTANT INFORMATION ON CONSTRAINTS - K - number of constraints (optional): - * 0<=K=4. - -OUTPUT PARAMETERS: - Info- same format as in LSFitLinearWC() subroutine. - * Info>0 task is solved - * Info<=0 an error occurred: - -4 means inconvergence of internal SVD - -3 means inconsistent constraints - S - spline interpolant. - Rep - report, same format as in LSFitLinearWC() subroutine. - Following fields are set: - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -IMPORTANT: - this subroitine doesn't calculate task's condition number for K<>0. - - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. - -SETTING CONSTRAINTS - DANGERS AND OPPORTUNITIES: - -Setting constraints can lead to undesired results, like ill-conditioned -behavior, or inconsistency being detected. From the other side, it allows -us to improve quality of the fit. Here we summarize our experience with -constrained regression splines: -* excessive constraints can be inconsistent. Splines are piecewise cubic - functions, and it is easy to create an example, where large number of - constraints concentrated in small area will result in inconsistency. - Just because spline is not flexible enough to satisfy all of them. And - same constraints spread across the [min(x),max(x)] will be perfectly - consistent. -* the more evenly constraints are spread across [min(x),max(x)], the more - chances that they will be consistent -* the greater is M (given fixed constraints), the more chances that - constraints will be consistent -* in the general case, consistency of constraints IS NOT GUARANTEED. -* in the several special cases, however, we CAN guarantee consistency. -* one of this cases is constraints on the function values AND/OR its - derivatives at the interval boundaries. -* another special case is ONE constraint on the function value (OR, but - not AND, derivative) anywhere in the interval - -Our final recommendation is to use constraints WHEN AND ONLY WHEN you -can't solve your task without them. Anything beyond special cases given -above is not guaranteed and may result in inconsistency. - - - -- ALGLIB PROJECT -- - Copyright 18.08.2009 by Bochkanov Sergey -*************************************************************************/ -void spline1dfitcubicwc(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* w, - ae_int_t n, - /* Real */ ae_vector* xc, - /* Real */ ae_vector* yc, - /* Integer */ ae_vector* dc, - ae_int_t k, - ae_int_t m, - ae_int_t* info, - spline1dinterpolant* s, - spline1dfitreport* rep, - ae_state *_state) -{ - ae_int_t i; - - *info = 0; - _spline1dinterpolant_clear(s); - _spline1dfitreport_clear(rep); - - ae_assert(n>=1, "Spline1DFitCubicWC: N<1!", _state); - ae_assert(m>=4, "Spline1DFitCubicWC: M<4!", _state); - ae_assert(k>=0, "Spline1DFitCubicWC: K<0!", _state); - ae_assert(k=M!", _state); - ae_assert(x->cnt>=n, "Spline1DFitCubicWC: Length(X)cnt>=n, "Spline1DFitCubicWC: Length(Y)cnt>=n, "Spline1DFitCubicWC: Length(W)cnt>=k, "Spline1DFitCubicWC: Length(XC)cnt>=k, "Spline1DFitCubicWC: Length(YC)cnt>=k, "Spline1DFitCubicWC: Length(DC)ptr.p_int[i]==0||dc->ptr.p_int[i]==1, "Spline1DFitCubicWC: DC[i] is neither 0 or 1!", _state); - } - lsfit_spline1dfitinternal(0, x, y, w, n, xc, yc, dc, k, m, info, s, rep, _state); -} - - -/************************************************************************* -Weighted fitting by Hermite spline, with constraints on function values -or first derivatives. - -Equidistant grid with M nodes on [min(x,xc),max(x,xc)] is used to build -basis functions. Basis functions are Hermite splines. Small regularizing -term is used when solving constrained tasks (to improve stability). - -Task is linear, so linear least squares solver is used. Complexity of this -computational scheme is O(N*M^2), mostly dominated by least squares solver - -SEE ALSO - Spline1DFitCubicWC() - fitting by Cubic splines (less flexible, - more smooth) - Spline1DFitHermite() - "lightweight" Hermite fitting, without - invididual weights and constraints - -INPUT PARAMETERS: - X - points, array[0..N-1]. - Y - function values, array[0..N-1]. - W - weights, array[0..N-1] - Each summand in square sum of approximation deviations from - given values is multiplied by the square of corresponding - weight. Fill it by 1's if you don't want to solve weighted - task. - N - number of points (optional): - * N>0 - * if given, only first N elements of X/Y/W are processed - * if not given, automatically determined from X/Y/W sizes - XC - points where spline values/derivatives are constrained, - array[0..K-1]. - YC - values of constraints, array[0..K-1] - DC - array[0..K-1], types of constraints: - * DC[i]=0 means that S(XC[i])=YC[i] - * DC[i]=1 means that S'(XC[i])=YC[i] - SEE BELOW FOR IMPORTANT INFORMATION ON CONSTRAINTS - K - number of constraints (optional): - * 0<=K=4, - M IS EVEN! - -OUTPUT PARAMETERS: - Info- same format as in LSFitLinearW() subroutine: - * Info>0 task is solved - * Info<=0 an error occurred: - -4 means inconvergence of internal SVD - -3 means inconsistent constraints - -2 means odd M was passed (which is not supported) - -1 means another errors in parameters passed - (N<=0, for example) - S - spline interpolant. - Rep - report, same format as in LSFitLinearW() subroutine. - Following fields are set: - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -IMPORTANT: - this subroitine doesn't calculate task's condition number for K<>0. - -IMPORTANT: - this subroitine supports only even M's - - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. - -SETTING CONSTRAINTS - DANGERS AND OPPORTUNITIES: - -Setting constraints can lead to undesired results, like ill-conditioned -behavior, or inconsistency being detected. From the other side, it allows -us to improve quality of the fit. Here we summarize our experience with -constrained regression splines: -* excessive constraints can be inconsistent. Splines are piecewise cubic - functions, and it is easy to create an example, where large number of - constraints concentrated in small area will result in inconsistency. - Just because spline is not flexible enough to satisfy all of them. And - same constraints spread across the [min(x),max(x)] will be perfectly - consistent. -* the more evenly constraints are spread across [min(x),max(x)], the more - chances that they will be consistent -* the greater is M (given fixed constraints), the more chances that - constraints will be consistent -* in the general case, consistency of constraints is NOT GUARANTEED. -* in the several special cases, however, we can guarantee consistency. -* one of this cases is M>=4 and constraints on the function value - (AND/OR its derivative) at the interval boundaries. -* another special case is M>=4 and ONE constraint on the function value - (OR, BUT NOT AND, derivative) anywhere in [min(x),max(x)] - -Our final recommendation is to use constraints WHEN AND ONLY when you -can't solve your task without them. Anything beyond special cases given -above is not guaranteed and may result in inconsistency. - - -- ALGLIB PROJECT -- - Copyright 18.08.2009 by Bochkanov Sergey -*************************************************************************/ -void spline1dfithermitewc(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* w, - ae_int_t n, - /* Real */ ae_vector* xc, - /* Real */ ae_vector* yc, - /* Integer */ ae_vector* dc, - ae_int_t k, - ae_int_t m, - ae_int_t* info, - spline1dinterpolant* s, - spline1dfitreport* rep, - ae_state *_state) -{ - ae_int_t i; - - *info = 0; - _spline1dinterpolant_clear(s); - _spline1dfitreport_clear(rep); - - ae_assert(n>=1, "Spline1DFitHermiteWC: N<1!", _state); - ae_assert(m>=4, "Spline1DFitHermiteWC: M<4!", _state); - ae_assert(m%2==0, "Spline1DFitHermiteWC: M is odd!", _state); - ae_assert(k>=0, "Spline1DFitHermiteWC: K<0!", _state); - ae_assert(k=M!", _state); - ae_assert(x->cnt>=n, "Spline1DFitHermiteWC: Length(X)cnt>=n, "Spline1DFitHermiteWC: Length(Y)cnt>=n, "Spline1DFitHermiteWC: Length(W)cnt>=k, "Spline1DFitHermiteWC: Length(XC)cnt>=k, "Spline1DFitHermiteWC: Length(YC)cnt>=k, "Spline1DFitHermiteWC: Length(DC)ptr.p_int[i]==0||dc->ptr.p_int[i]==1, "Spline1DFitHermiteWC: DC[i] is neither 0 or 1!", _state); - } - lsfit_spline1dfitinternal(1, x, y, w, n, xc, yc, dc, k, m, info, s, rep, _state); -} - - -/************************************************************************* -Least squares fitting by cubic spline. - -This subroutine is "lightweight" alternative for more complex and feature- -rich Spline1DFitCubicWC(). See Spline1DFitCubicWC() for more information -about subroutine parameters (we don't duplicate it here because of length) - - -- ALGLIB PROJECT -- - Copyright 18.08.2009 by Bochkanov Sergey -*************************************************************************/ -void spline1dfitcubic(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_int_t m, - ae_int_t* info, - spline1dinterpolant* s, - spline1dfitreport* rep, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_vector w; - ae_vector xc; - ae_vector yc; - ae_vector dc; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _spline1dinterpolant_clear(s); - _spline1dfitreport_clear(rep); - ae_vector_init(&w, 0, DT_REAL, _state, ae_true); - ae_vector_init(&xc, 0, DT_REAL, _state, ae_true); - ae_vector_init(&yc, 0, DT_REAL, _state, ae_true); - ae_vector_init(&dc, 0, DT_INT, _state, ae_true); - - ae_assert(n>=1, "Spline1DFitCubic: N<1!", _state); - ae_assert(m>=4, "Spline1DFitCubic: M<4!", _state); - ae_assert(x->cnt>=n, "Spline1DFitCubic: Length(X)cnt>=n, "Spline1DFitCubic: Length(Y)=1, "Spline1DFitHermite: N<1!", _state); - ae_assert(m>=4, "Spline1DFitHermite: M<4!", _state); - ae_assert(m%2==0, "Spline1DFitHermite: M is odd!", _state); - ae_assert(x->cnt>=n, "Spline1DFitHermite: Length(X)cnt>=n, "Spline1DFitHermite: Length(Y)=1. - M - number of basis functions, M>=1. - -OUTPUT PARAMETERS: - Info - error code: - * -4 internal SVD decomposition subroutine failed (very - rare and for degenerate systems only) - * -1 incorrect N/M were specified - * 1 task is solved - C - decomposition coefficients, array[0..M-1] - Rep - fitting report. Following fields are set: - * Rep.TaskRCond reciprocal of condition number - * R2 non-adjusted coefficient of determination - (non-weighted) - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -ERRORS IN PARAMETERS - -This solver also calculates different kinds of errors in parameters and -fills corresponding fields of report: -* Rep.CovPar covariance matrix for parameters, array[K,K]. -* Rep.ErrPar errors in parameters, array[K], - errpar = sqrt(diag(CovPar)) -* Rep.ErrCurve vector of fit errors - standard deviations of empirical - best-fit curve from "ideal" best-fit curve built with - infinite number of samples, array[N]. - errcurve = sqrt(diag(F*CovPar*F')), - where F is functions matrix. -* Rep.Noise vector of per-point estimates of noise, array[N] - -NOTE: noise in the data is estimated as follows: - * for fitting without user-supplied weights all points are - assumed to have same level of noise, which is estimated from - the data - * for fitting with user-supplied weights we assume that noise - level in I-th point is inversely proportional to Ith weight. - Coefficient of proportionality is estimated from the data. - -NOTE: we apply small amount of regularization when we invert squared - Jacobian and calculate covariance matrix. It guarantees that - algorithm won't divide by zero during inversion, but skews - error estimates a bit (fractional error is about 10^-9). - - However, we believe that this difference is insignificant for - all practical purposes except for the situation when you want - to compare ALGLIB results with "reference" implementation up - to the last significant digit. - -NOTE: covariance matrix is estimated using correction for degrees - of freedom (covariances are divided by N-M instead of dividing - by N). - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitlinearw(/* Real */ ae_vector* y, - /* Real */ ae_vector* w, - /* Real */ ae_matrix* fmatrix, - ae_int_t n, - ae_int_t m, - ae_int_t* info, - /* Real */ ae_vector* c, - lsfitreport* rep, - ae_state *_state) -{ - - *info = 0; - ae_vector_clear(c); - _lsfitreport_clear(rep); - - ae_assert(n>=1, "LSFitLinearW: N<1!", _state); - ae_assert(m>=1, "LSFitLinearW: M<1!", _state); - ae_assert(y->cnt>=n, "LSFitLinearW: length(Y)cnt>=n, "LSFitLinearW: length(W)rows>=n, "LSFitLinearW: rows(FMatrix)cols>=m, "LSFitLinearW: cols(FMatrix)=1. - M - number of basis functions, M>=1. - K - number of constraints, 0 <= K < M - K=0 corresponds to absence of constraints. - -OUTPUT PARAMETERS: - Info - error code: - * -4 internal SVD decomposition subroutine failed (very - rare and for degenerate systems only) - * -3 either too many constraints (M or more), - degenerate constraints (some constraints are - repetead twice) or inconsistent constraints were - specified. - * 1 task is solved - C - decomposition coefficients, array[0..M-1] - Rep - fitting report. Following fields are set: - * R2 non-adjusted coefficient of determination - (non-weighted) - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -IMPORTANT: - this subroitine doesn't calculate task's condition number for K<>0. - -ERRORS IN PARAMETERS - -This solver also calculates different kinds of errors in parameters and -fills corresponding fields of report: -* Rep.CovPar covariance matrix for parameters, array[K,K]. -* Rep.ErrPar errors in parameters, array[K], - errpar = sqrt(diag(CovPar)) -* Rep.ErrCurve vector of fit errors - standard deviations of empirical - best-fit curve from "ideal" best-fit curve built with - infinite number of samples, array[N]. - errcurve = sqrt(diag(F*CovPar*F')), - where F is functions matrix. -* Rep.Noise vector of per-point estimates of noise, array[N] - -IMPORTANT: errors in parameters are calculated without taking into - account boundary/linear constraints! Presence of constraints - changes distribution of errors, but there is no easy way to - account for constraints when you calculate covariance matrix. - -NOTE: noise in the data is estimated as follows: - * for fitting without user-supplied weights all points are - assumed to have same level of noise, which is estimated from - the data - * for fitting with user-supplied weights we assume that noise - level in I-th point is inversely proportional to Ith weight. - Coefficient of proportionality is estimated from the data. - -NOTE: we apply small amount of regularization when we invert squared - Jacobian and calculate covariance matrix. It guarantees that - algorithm won't divide by zero during inversion, but skews - error estimates a bit (fractional error is about 10^-9). - - However, we believe that this difference is insignificant for - all practical purposes except for the situation when you want - to compare ALGLIB results with "reference" implementation up - to the last significant digit. - -NOTE: covariance matrix is estimated using correction for degrees - of freedom (covariances are divided by N-M instead of dividing - by N). - - -- ALGLIB -- - Copyright 07.09.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitlinearwc(/* Real */ ae_vector* y, - /* Real */ ae_vector* w, - /* Real */ ae_matrix* fmatrix, - /* Real */ ae_matrix* cmatrix, - ae_int_t n, - ae_int_t m, - ae_int_t k, - ae_int_t* info, - /* Real */ ae_vector* c, - lsfitreport* rep, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _y; - ae_matrix _cmatrix; - ae_int_t i; - ae_int_t j; - ae_vector tau; - ae_matrix q; - ae_matrix f2; - ae_vector tmp; - ae_vector c0; - double v; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_y, y, _state, ae_true); - y = &_y; - ae_matrix_init_copy(&_cmatrix, cmatrix, _state, ae_true); - cmatrix = &_cmatrix; - *info = 0; - ae_vector_clear(c); - _lsfitreport_clear(rep); - ae_vector_init(&tau, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&q, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&f2, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); - ae_vector_init(&c0, 0, DT_REAL, _state, ae_true); - - ae_assert(n>=1, "LSFitLinearWC: N<1!", _state); - ae_assert(m>=1, "LSFitLinearWC: M<1!", _state); - ae_assert(k>=0, "LSFitLinearWC: K<0!", _state); - ae_assert(y->cnt>=n, "LSFitLinearWC: length(Y)cnt>=n, "LSFitLinearWC: length(W)rows>=n, "LSFitLinearWC: rows(FMatrix)cols>=m, "LSFitLinearWC: cols(FMatrix)rows>=k, "LSFitLinearWC: rows(CMatrix)cols>=m+1||k==0, "LSFitLinearWC: cols(CMatrix)=m ) - { - *info = -3; - ae_frame_leave(_state); - return; - } - - /* - * Solve - */ - if( k==0 ) - { - - /* - * no constraints - */ - lsfit_lsfitlinearinternal(y, w, fmatrix, n, m, info, c, rep, _state); - } - else - { - - /* - * First, find general form solution of constraints system: - * * factorize C = L*Q - * * unpack Q - * * fill upper part of C with zeros (for RCond) - * - * We got C=C0+Q2'*y where Q2 is lower M-K rows of Q. - */ - rmatrixlq(cmatrix, k, m, &tau, _state); - rmatrixlqunpackq(cmatrix, k, m, &tau, m, &q, _state); - for(i=0; i<=k-1; i++) - { - for(j=i+1; j<=m-1; j++) - { - cmatrix->ptr.pp_double[i][j] = 0.0; - } - } - if( ae_fp_less(rmatrixlurcondinf(cmatrix, k, _state),1000*ae_machineepsilon) ) - { - *info = -3; - ae_frame_leave(_state); - return; - } - ae_vector_set_length(&tmp, k, _state); - for(i=0; i<=k-1; i++) - { - if( i>0 ) - { - v = ae_v_dotproduct(&cmatrix->ptr.pp_double[i][0], 1, &tmp.ptr.p_double[0], 1, ae_v_len(0,i-1)); - } - else - { - v = 0; - } - tmp.ptr.p_double[i] = (cmatrix->ptr.pp_double[i][m]-v)/cmatrix->ptr.pp_double[i][i]; - } - ae_vector_set_length(&c0, m, _state); - for(i=0; i<=m-1; i++) - { - c0.ptr.p_double[i] = 0; - } - for(i=0; i<=k-1; i++) - { - v = tmp.ptr.p_double[i]; - ae_v_addd(&c0.ptr.p_double[0], 1, &q.ptr.pp_double[i][0], 1, ae_v_len(0,m-1), v); - } - - /* - * Second, prepare modified matrix F2 = F*Q2' and solve modified task - */ - ae_vector_set_length(&tmp, ae_maxint(n, m, _state)+1, _state); - ae_matrix_set_length(&f2, n, m-k, _state); - matrixvectormultiply(fmatrix, 0, n-1, 0, m-1, ae_false, &c0, 0, m-1, -1.0, y, 0, n-1, 1.0, _state); - matrixmatrixmultiply(fmatrix, 0, n-1, 0, m-1, ae_false, &q, k, m-1, 0, m-1, ae_true, 1.0, &f2, 0, n-1, 0, m-k-1, 0.0, &tmp, _state); - lsfit_lsfitlinearinternal(y, w, &f2, n, m-k, info, &tmp, rep, _state); - rep->taskrcond = -1; - if( *info<=0 ) - { - ae_frame_leave(_state); - return; - } - - /* - * then, convert back to original answer: C = C0 + Q2'*Y0 - */ - ae_vector_set_length(c, m, _state); - ae_v_move(&c->ptr.p_double[0], 1, &c0.ptr.p_double[0], 1, ae_v_len(0,m-1)); - matrixvectormultiply(&q, k, m-1, 0, m-1, ae_true, &tmp, 0, m-k-1, 1.0, c, 0, m-1, 1.0, _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Linear least squares fitting. - -QR decomposition is used to reduce task to MxM, then triangular solver or -SVD-based solver is used depending on condition number of the system. It -allows to maximize speed and retain decent accuracy. - -IMPORTANT: if you want to perform polynomial fitting, it may be more - convenient to use PolynomialFit() function. This function gives - best results on polynomial problems and solves numerical - stability issues which arise when you fit high-degree - polynomials to your data. - -INPUT PARAMETERS: - Y - array[0..N-1] Function values in N points. - FMatrix - a table of basis functions values, array[0..N-1, 0..M-1]. - FMatrix[I, J] - value of J-th basis function in I-th point. - N - number of points used. N>=1. - M - number of basis functions, M>=1. - -OUTPUT PARAMETERS: - Info - error code: - * -4 internal SVD decomposition subroutine failed (very - rare and for degenerate systems only) - * 1 task is solved - C - decomposition coefficients, array[0..M-1] - Rep - fitting report. Following fields are set: - * Rep.TaskRCond reciprocal of condition number - * R2 non-adjusted coefficient of determination - (non-weighted) - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -ERRORS IN PARAMETERS - -This solver also calculates different kinds of errors in parameters and -fills corresponding fields of report: -* Rep.CovPar covariance matrix for parameters, array[K,K]. -* Rep.ErrPar errors in parameters, array[K], - errpar = sqrt(diag(CovPar)) -* Rep.ErrCurve vector of fit errors - standard deviations of empirical - best-fit curve from "ideal" best-fit curve built with - infinite number of samples, array[N]. - errcurve = sqrt(diag(F*CovPar*F')), - where F is functions matrix. -* Rep.Noise vector of per-point estimates of noise, array[N] - -NOTE: noise in the data is estimated as follows: - * for fitting without user-supplied weights all points are - assumed to have same level of noise, which is estimated from - the data - * for fitting with user-supplied weights we assume that noise - level in I-th point is inversely proportional to Ith weight. - Coefficient of proportionality is estimated from the data. - -NOTE: we apply small amount of regularization when we invert squared - Jacobian and calculate covariance matrix. It guarantees that - algorithm won't divide by zero during inversion, but skews - error estimates a bit (fractional error is about 10^-9). - - However, we believe that this difference is insignificant for - all practical purposes except for the situation when you want - to compare ALGLIB results with "reference" implementation up - to the last significant digit. - -NOTE: covariance matrix is estimated using correction for degrees - of freedom (covariances are divided by N-M instead of dividing - by N). - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitlinear(/* Real */ ae_vector* y, - /* Real */ ae_matrix* fmatrix, - ae_int_t n, - ae_int_t m, - ae_int_t* info, - /* Real */ ae_vector* c, - lsfitreport* rep, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector w; - ae_int_t i; - - ae_frame_make(_state, &_frame_block); - *info = 0; - ae_vector_clear(c); - _lsfitreport_clear(rep); - ae_vector_init(&w, 0, DT_REAL, _state, ae_true); - - ae_assert(n>=1, "LSFitLinear: N<1!", _state); - ae_assert(m>=1, "LSFitLinear: M<1!", _state); - ae_assert(y->cnt>=n, "LSFitLinear: length(Y)rows>=n, "LSFitLinear: rows(FMatrix)cols>=m, "LSFitLinear: cols(FMatrix)=1. - M - number of basis functions, M>=1. - K - number of constraints, 0 <= K < M - K=0 corresponds to absence of constraints. - -OUTPUT PARAMETERS: - Info - error code: - * -4 internal SVD decomposition subroutine failed (very - rare and for degenerate systems only) - * -3 either too many constraints (M or more), - degenerate constraints (some constraints are - repetead twice) or inconsistent constraints were - specified. - * 1 task is solved - C - decomposition coefficients, array[0..M-1] - Rep - fitting report. Following fields are set: - * R2 non-adjusted coefficient of determination - (non-weighted) - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -IMPORTANT: - this subroitine doesn't calculate task's condition number for K<>0. - -ERRORS IN PARAMETERS - -This solver also calculates different kinds of errors in parameters and -fills corresponding fields of report: -* Rep.CovPar covariance matrix for parameters, array[K,K]. -* Rep.ErrPar errors in parameters, array[K], - errpar = sqrt(diag(CovPar)) -* Rep.ErrCurve vector of fit errors - standard deviations of empirical - best-fit curve from "ideal" best-fit curve built with - infinite number of samples, array[N]. - errcurve = sqrt(diag(F*CovPar*F')), - where F is functions matrix. -* Rep.Noise vector of per-point estimates of noise, array[N] - -IMPORTANT: errors in parameters are calculated without taking into - account boundary/linear constraints! Presence of constraints - changes distribution of errors, but there is no easy way to - account for constraints when you calculate covariance matrix. - -NOTE: noise in the data is estimated as follows: - * for fitting without user-supplied weights all points are - assumed to have same level of noise, which is estimated from - the data - * for fitting with user-supplied weights we assume that noise - level in I-th point is inversely proportional to Ith weight. - Coefficient of proportionality is estimated from the data. - -NOTE: we apply small amount of regularization when we invert squared - Jacobian and calculate covariance matrix. It guarantees that - algorithm won't divide by zero during inversion, but skews - error estimates a bit (fractional error is about 10^-9). - - However, we believe that this difference is insignificant for - all practical purposes except for the situation when you want - to compare ALGLIB results with "reference" implementation up - to the last significant digit. - -NOTE: covariance matrix is estimated using correction for degrees - of freedom (covariances are divided by N-M instead of dividing - by N). - - -- ALGLIB -- - Copyright 07.09.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitlinearc(/* Real */ ae_vector* y, - /* Real */ ae_matrix* fmatrix, - /* Real */ ae_matrix* cmatrix, - ae_int_t n, - ae_int_t m, - ae_int_t k, - ae_int_t* info, - /* Real */ ae_vector* c, - lsfitreport* rep, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _y; - ae_vector w; - ae_int_t i; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_y, y, _state, ae_true); - y = &_y; - *info = 0; - ae_vector_clear(c); - _lsfitreport_clear(rep); - ae_vector_init(&w, 0, DT_REAL, _state, ae_true); - - ae_assert(n>=1, "LSFitLinearC: N<1!", _state); - ae_assert(m>=1, "LSFitLinearC: M<1!", _state); - ae_assert(k>=0, "LSFitLinearC: K<0!", _state); - ae_assert(y->cnt>=n, "LSFitLinearC: length(Y)rows>=n, "LSFitLinearC: rows(FMatrix)cols>=m, "LSFitLinearC: cols(FMatrix)rows>=k, "LSFitLinearC: rows(CMatrix)cols>=m+1||k==0, "LSFitLinearC: cols(CMatrix)1 - M - dimension of space - K - number of parameters being fitted - DiffStep- numerical differentiation step; - should not be very small or large; - large = loss of accuracy - small = growth of round-off errors - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 18.10.2008 by Bochkanov Sergey -*************************************************************************/ -void lsfitcreatewf(/* Real */ ae_matrix* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* w, - /* Real */ ae_vector* c, - ae_int_t n, - ae_int_t m, - ae_int_t k, - double diffstep, - lsfitstate* state, - ae_state *_state) -{ - ae_int_t i; - - _lsfitstate_clear(state); - - ae_assert(n>=1, "LSFitCreateWF: N<1!", _state); - ae_assert(m>=1, "LSFitCreateWF: M<1!", _state); - ae_assert(k>=1, "LSFitCreateWF: K<1!", _state); - ae_assert(c->cnt>=k, "LSFitCreateWF: length(C)cnt>=n, "LSFitCreateWF: length(Y)cnt>=n, "LSFitCreateWF: length(W)rows>=n, "LSFitCreateWF: rows(X)cols>=m, "LSFitCreateWF: cols(X)teststep = 0; - state->diffstep = diffstep; - state->npoints = n; - state->nweights = n; - state->wkind = 1; - state->m = m; - state->k = k; - lsfitsetcond(state, 0.0, 0.0, 0, _state); - lsfitsetstpmax(state, 0.0, _state); - lsfitsetxrep(state, ae_false, _state); - ae_matrix_set_length(&state->taskx, n, m, _state); - ae_vector_set_length(&state->tasky, n, _state); - ae_vector_set_length(&state->taskw, n, _state); - ae_vector_set_length(&state->c, k, _state); - ae_vector_set_length(&state->x, m, _state); - ae_v_move(&state->c.ptr.p_double[0], 1, &c->ptr.p_double[0], 1, ae_v_len(0,k-1)); - ae_v_move(&state->taskw.ptr.p_double[0], 1, &w->ptr.p_double[0], 1, ae_v_len(0,n-1)); - for(i=0; i<=n-1; i++) - { - ae_v_move(&state->taskx.ptr.pp_double[i][0], 1, &x->ptr.pp_double[i][0], 1, ae_v_len(0,m-1)); - state->tasky.ptr.p_double[i] = y->ptr.p_double[i]; - } - ae_vector_set_length(&state->s, k, _state); - ae_vector_set_length(&state->bndl, k, _state); - ae_vector_set_length(&state->bndu, k, _state); - for(i=0; i<=k-1; i++) - { - state->s.ptr.p_double[i] = 1.0; - state->bndl.ptr.p_double[i] = _state->v_neginf; - state->bndu.ptr.p_double[i] = _state->v_posinf; - } - state->optalgo = 0; - state->prevnpt = -1; - state->prevalgo = -1; - minlmcreatev(k, n, &state->c, diffstep, &state->optstate, _state); - lsfit_lsfitclearrequestfields(state, _state); - ae_vector_set_length(&state->rstate.ia, 6+1, _state); - ae_vector_set_length(&state->rstate.ra, 8+1, _state); - state->rstate.stage = -1; -} - - -/************************************************************************* -Nonlinear least squares fitting using function values only. - -Combination of numerical differentiation and secant updates is used to -obtain function Jacobian. - -Nonlinear task min(F(c)) is solved, where - - F(c) = (f(c,x[0])-y[0])^2 + ... + (f(c,x[n-1])-y[n-1])^2, - - * N is a number of points, - * M is a dimension of a space points belong to, - * K is a dimension of a space of parameters being fitted, - * w is an N-dimensional vector of weight coefficients, - * x is a set of N points, each of them is an M-dimensional vector, - * c is a K-dimensional vector of parameters being fitted - -This subroutine uses only f(c,x[i]). - -INPUT PARAMETERS: - X - array[0..N-1,0..M-1], points (one row = one point) - Y - array[0..N-1], function values. - C - array[0..K-1], initial approximation to the solution, - N - number of points, N>1 - M - dimension of space - K - number of parameters being fitted - DiffStep- numerical differentiation step; - should not be very small or large; - large = loss of accuracy - small = growth of round-off errors - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 18.10.2008 by Bochkanov Sergey -*************************************************************************/ -void lsfitcreatef(/* Real */ ae_matrix* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* c, - ae_int_t n, - ae_int_t m, - ae_int_t k, - double diffstep, - lsfitstate* state, - ae_state *_state) -{ - ae_int_t i; - - _lsfitstate_clear(state); - - ae_assert(n>=1, "LSFitCreateF: N<1!", _state); - ae_assert(m>=1, "LSFitCreateF: M<1!", _state); - ae_assert(k>=1, "LSFitCreateF: K<1!", _state); - ae_assert(c->cnt>=k, "LSFitCreateF: length(C)cnt>=n, "LSFitCreateF: length(Y)rows>=n, "LSFitCreateF: rows(X)cols>=m, "LSFitCreateF: cols(X)rows>=n, "LSFitCreateF: rows(X)cols>=m, "LSFitCreateF: cols(X)teststep = 0; - state->diffstep = diffstep; - state->npoints = n; - state->wkind = 0; - state->m = m; - state->k = k; - lsfitsetcond(state, 0.0, 0.0, 0, _state); - lsfitsetstpmax(state, 0.0, _state); - lsfitsetxrep(state, ae_false, _state); - ae_matrix_set_length(&state->taskx, n, m, _state); - ae_vector_set_length(&state->tasky, n, _state); - ae_vector_set_length(&state->c, k, _state); - ae_vector_set_length(&state->x, m, _state); - ae_v_move(&state->c.ptr.p_double[0], 1, &c->ptr.p_double[0], 1, ae_v_len(0,k-1)); - for(i=0; i<=n-1; i++) - { - ae_v_move(&state->taskx.ptr.pp_double[i][0], 1, &x->ptr.pp_double[i][0], 1, ae_v_len(0,m-1)); - state->tasky.ptr.p_double[i] = y->ptr.p_double[i]; - } - ae_vector_set_length(&state->s, k, _state); - ae_vector_set_length(&state->bndl, k, _state); - ae_vector_set_length(&state->bndu, k, _state); - for(i=0; i<=k-1; i++) - { - state->s.ptr.p_double[i] = 1.0; - state->bndl.ptr.p_double[i] = _state->v_neginf; - state->bndu.ptr.p_double[i] = _state->v_posinf; - } - state->optalgo = 0; - state->prevnpt = -1; - state->prevalgo = -1; - minlmcreatev(k, n, &state->c, diffstep, &state->optstate, _state); - lsfit_lsfitclearrequestfields(state, _state); - ae_vector_set_length(&state->rstate.ia, 6+1, _state); - ae_vector_set_length(&state->rstate.ra, 8+1, _state); - state->rstate.stage = -1; -} - - -/************************************************************************* -Weighted nonlinear least squares fitting using gradient only. - -Nonlinear task min(F(c)) is solved, where - - F(c) = (w[0]*(f(c,x[0])-y[0]))^2 + ... + (w[n-1]*(f(c,x[n-1])-y[n-1]))^2, - - * N is a number of points, - * M is a dimension of a space points belong to, - * K is a dimension of a space of parameters being fitted, - * w is an N-dimensional vector of weight coefficients, - * x is a set of N points, each of them is an M-dimensional vector, - * c is a K-dimensional vector of parameters being fitted - -This subroutine uses only f(c,x[i]) and its gradient. - -INPUT PARAMETERS: - X - array[0..N-1,0..M-1], points (one row = one point) - Y - array[0..N-1], function values. - W - weights, array[0..N-1] - C - array[0..K-1], initial approximation to the solution, - N - number of points, N>1 - M - dimension of space - K - number of parameters being fitted - CheapFG - boolean flag, which is: - * True if both function and gradient calculation complexity - are less than O(M^2). An improved algorithm can - be used which corresponds to FGJ scheme from - MINLM unit. - * False otherwise. - Standard Jacibian-bases Levenberg-Marquardt algo - will be used (FJ scheme). - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -See also: - LSFitResults - LSFitCreateFG (fitting without weights) - LSFitCreateWFGH (fitting using Hessian) - LSFitCreateFGH (fitting using Hessian, without weights) - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitcreatewfg(/* Real */ ae_matrix* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* w, - /* Real */ ae_vector* c, - ae_int_t n, - ae_int_t m, - ae_int_t k, - ae_bool cheapfg, - lsfitstate* state, - ae_state *_state) -{ - ae_int_t i; - - _lsfitstate_clear(state); - - ae_assert(n>=1, "LSFitCreateWFG: N<1!", _state); - ae_assert(m>=1, "LSFitCreateWFG: M<1!", _state); - ae_assert(k>=1, "LSFitCreateWFG: K<1!", _state); - ae_assert(c->cnt>=k, "LSFitCreateWFG: length(C)cnt>=n, "LSFitCreateWFG: length(Y)cnt>=n, "LSFitCreateWFG: length(W)rows>=n, "LSFitCreateWFG: rows(X)cols>=m, "LSFitCreateWFG: cols(X)teststep = 0; - state->diffstep = 0; - state->npoints = n; - state->nweights = n; - state->wkind = 1; - state->m = m; - state->k = k; - lsfitsetcond(state, 0.0, 0.0, 0, _state); - lsfitsetstpmax(state, 0.0, _state); - lsfitsetxrep(state, ae_false, _state); - ae_matrix_set_length(&state->taskx, n, m, _state); - ae_vector_set_length(&state->tasky, n, _state); - ae_vector_set_length(&state->taskw, n, _state); - ae_vector_set_length(&state->c, k, _state); - ae_vector_set_length(&state->x, m, _state); - ae_vector_set_length(&state->g, k, _state); - ae_v_move(&state->c.ptr.p_double[0], 1, &c->ptr.p_double[0], 1, ae_v_len(0,k-1)); - ae_v_move(&state->taskw.ptr.p_double[0], 1, &w->ptr.p_double[0], 1, ae_v_len(0,n-1)); - for(i=0; i<=n-1; i++) - { - ae_v_move(&state->taskx.ptr.pp_double[i][0], 1, &x->ptr.pp_double[i][0], 1, ae_v_len(0,m-1)); - state->tasky.ptr.p_double[i] = y->ptr.p_double[i]; - } - ae_vector_set_length(&state->s, k, _state); - ae_vector_set_length(&state->bndl, k, _state); - ae_vector_set_length(&state->bndu, k, _state); - for(i=0; i<=k-1; i++) - { - state->s.ptr.p_double[i] = 1.0; - state->bndl.ptr.p_double[i] = _state->v_neginf; - state->bndu.ptr.p_double[i] = _state->v_posinf; - } - state->optalgo = 1; - state->prevnpt = -1; - state->prevalgo = -1; - if( cheapfg ) - { - minlmcreatevgj(k, n, &state->c, &state->optstate, _state); - } - else - { - minlmcreatevj(k, n, &state->c, &state->optstate, _state); - } - lsfit_lsfitclearrequestfields(state, _state); - ae_vector_set_length(&state->rstate.ia, 6+1, _state); - ae_vector_set_length(&state->rstate.ra, 8+1, _state); - state->rstate.stage = -1; -} - - -/************************************************************************* -Nonlinear least squares fitting using gradient only, without individual -weights. - -Nonlinear task min(F(c)) is solved, where - - F(c) = ((f(c,x[0])-y[0]))^2 + ... + ((f(c,x[n-1])-y[n-1]))^2, - - * N is a number of points, - * M is a dimension of a space points belong to, - * K is a dimension of a space of parameters being fitted, - * x is a set of N points, each of them is an M-dimensional vector, - * c is a K-dimensional vector of parameters being fitted - -This subroutine uses only f(c,x[i]) and its gradient. - -INPUT PARAMETERS: - X - array[0..N-1,0..M-1], points (one row = one point) - Y - array[0..N-1], function values. - C - array[0..K-1], initial approximation to the solution, - N - number of points, N>1 - M - dimension of space - K - number of parameters being fitted - CheapFG - boolean flag, which is: - * True if both function and gradient calculation complexity - are less than O(M^2). An improved algorithm can - be used which corresponds to FGJ scheme from - MINLM unit. - * False otherwise. - Standard Jacibian-bases Levenberg-Marquardt algo - will be used (FJ scheme). - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitcreatefg(/* Real */ ae_matrix* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* c, - ae_int_t n, - ae_int_t m, - ae_int_t k, - ae_bool cheapfg, - lsfitstate* state, - ae_state *_state) -{ - ae_int_t i; - - _lsfitstate_clear(state); - - ae_assert(n>=1, "LSFitCreateFG: N<1!", _state); - ae_assert(m>=1, "LSFitCreateFG: M<1!", _state); - ae_assert(k>=1, "LSFitCreateFG: K<1!", _state); - ae_assert(c->cnt>=k, "LSFitCreateFG: length(C)cnt>=n, "LSFitCreateFG: length(Y)rows>=n, "LSFitCreateFG: rows(X)cols>=m, "LSFitCreateFG: cols(X)rows>=n, "LSFitCreateFG: rows(X)cols>=m, "LSFitCreateFG: cols(X)teststep = 0; - state->diffstep = 0; - state->npoints = n; - state->wkind = 0; - state->m = m; - state->k = k; - lsfitsetcond(state, 0.0, 0.0, 0, _state); - lsfitsetstpmax(state, 0.0, _state); - lsfitsetxrep(state, ae_false, _state); - ae_matrix_set_length(&state->taskx, n, m, _state); - ae_vector_set_length(&state->tasky, n, _state); - ae_vector_set_length(&state->c, k, _state); - ae_vector_set_length(&state->x, m, _state); - ae_vector_set_length(&state->g, k, _state); - ae_v_move(&state->c.ptr.p_double[0], 1, &c->ptr.p_double[0], 1, ae_v_len(0,k-1)); - for(i=0; i<=n-1; i++) - { - ae_v_move(&state->taskx.ptr.pp_double[i][0], 1, &x->ptr.pp_double[i][0], 1, ae_v_len(0,m-1)); - state->tasky.ptr.p_double[i] = y->ptr.p_double[i]; - } - ae_vector_set_length(&state->s, k, _state); - ae_vector_set_length(&state->bndl, k, _state); - ae_vector_set_length(&state->bndu, k, _state); - for(i=0; i<=k-1; i++) - { - state->s.ptr.p_double[i] = 1.0; - state->bndl.ptr.p_double[i] = _state->v_neginf; - state->bndu.ptr.p_double[i] = _state->v_posinf; - } - state->optalgo = 1; - state->prevnpt = -1; - state->prevalgo = -1; - if( cheapfg ) - { - minlmcreatevgj(k, n, &state->c, &state->optstate, _state); - } - else - { - minlmcreatevj(k, n, &state->c, &state->optstate, _state); - } - lsfit_lsfitclearrequestfields(state, _state); - ae_vector_set_length(&state->rstate.ia, 6+1, _state); - ae_vector_set_length(&state->rstate.ra, 8+1, _state); - state->rstate.stage = -1; -} - - -/************************************************************************* -Weighted nonlinear least squares fitting using gradient/Hessian. - -Nonlinear task min(F(c)) is solved, where - - F(c) = (w[0]*(f(c,x[0])-y[0]))^2 + ... + (w[n-1]*(f(c,x[n-1])-y[n-1]))^2, - - * N is a number of points, - * M is a dimension of a space points belong to, - * K is a dimension of a space of parameters being fitted, - * w is an N-dimensional vector of weight coefficients, - * x is a set of N points, each of them is an M-dimensional vector, - * c is a K-dimensional vector of parameters being fitted - -This subroutine uses f(c,x[i]), its gradient and its Hessian. - -INPUT PARAMETERS: - X - array[0..N-1,0..M-1], points (one row = one point) - Y - array[0..N-1], function values. - W - weights, array[0..N-1] - C - array[0..K-1], initial approximation to the solution, - N - number of points, N>1 - M - dimension of space - K - number of parameters being fitted - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitcreatewfgh(/* Real */ ae_matrix* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* w, - /* Real */ ae_vector* c, - ae_int_t n, - ae_int_t m, - ae_int_t k, - lsfitstate* state, - ae_state *_state) -{ - ae_int_t i; - - _lsfitstate_clear(state); - - ae_assert(n>=1, "LSFitCreateWFGH: N<1!", _state); - ae_assert(m>=1, "LSFitCreateWFGH: M<1!", _state); - ae_assert(k>=1, "LSFitCreateWFGH: K<1!", _state); - ae_assert(c->cnt>=k, "LSFitCreateWFGH: length(C)cnt>=n, "LSFitCreateWFGH: length(Y)cnt>=n, "LSFitCreateWFGH: length(W)rows>=n, "LSFitCreateWFGH: rows(X)cols>=m, "LSFitCreateWFGH: cols(X)teststep = 0; - state->diffstep = 0; - state->npoints = n; - state->nweights = n; - state->wkind = 1; - state->m = m; - state->k = k; - lsfitsetcond(state, 0.0, 0.0, 0, _state); - lsfitsetstpmax(state, 0.0, _state); - lsfitsetxrep(state, ae_false, _state); - ae_matrix_set_length(&state->taskx, n, m, _state); - ae_vector_set_length(&state->tasky, n, _state); - ae_vector_set_length(&state->taskw, n, _state); - ae_vector_set_length(&state->c, k, _state); - ae_matrix_set_length(&state->h, k, k, _state); - ae_vector_set_length(&state->x, m, _state); - ae_vector_set_length(&state->g, k, _state); - ae_v_move(&state->c.ptr.p_double[0], 1, &c->ptr.p_double[0], 1, ae_v_len(0,k-1)); - ae_v_move(&state->taskw.ptr.p_double[0], 1, &w->ptr.p_double[0], 1, ae_v_len(0,n-1)); - for(i=0; i<=n-1; i++) - { - ae_v_move(&state->taskx.ptr.pp_double[i][0], 1, &x->ptr.pp_double[i][0], 1, ae_v_len(0,m-1)); - state->tasky.ptr.p_double[i] = y->ptr.p_double[i]; - } - ae_vector_set_length(&state->s, k, _state); - ae_vector_set_length(&state->bndl, k, _state); - ae_vector_set_length(&state->bndu, k, _state); - for(i=0; i<=k-1; i++) - { - state->s.ptr.p_double[i] = 1.0; - state->bndl.ptr.p_double[i] = _state->v_neginf; - state->bndu.ptr.p_double[i] = _state->v_posinf; - } - state->optalgo = 2; - state->prevnpt = -1; - state->prevalgo = -1; - minlmcreatefgh(k, &state->c, &state->optstate, _state); - lsfit_lsfitclearrequestfields(state, _state); - ae_vector_set_length(&state->rstate.ia, 6+1, _state); - ae_vector_set_length(&state->rstate.ra, 8+1, _state); - state->rstate.stage = -1; -} - - -/************************************************************************* -Nonlinear least squares fitting using gradient/Hessian, without individial -weights. - -Nonlinear task min(F(c)) is solved, where - - F(c) = ((f(c,x[0])-y[0]))^2 + ... + ((f(c,x[n-1])-y[n-1]))^2, - - * N is a number of points, - * M is a dimension of a space points belong to, - * K is a dimension of a space of parameters being fitted, - * x is a set of N points, each of them is an M-dimensional vector, - * c is a K-dimensional vector of parameters being fitted - -This subroutine uses f(c,x[i]), its gradient and its Hessian. - -INPUT PARAMETERS: - X - array[0..N-1,0..M-1], points (one row = one point) - Y - array[0..N-1], function values. - C - array[0..K-1], initial approximation to the solution, - N - number of points, N>1 - M - dimension of space - K - number of parameters being fitted - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitcreatefgh(/* Real */ ae_matrix* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* c, - ae_int_t n, - ae_int_t m, - ae_int_t k, - lsfitstate* state, - ae_state *_state) -{ - ae_int_t i; - - _lsfitstate_clear(state); - - ae_assert(n>=1, "LSFitCreateFGH: N<1!", _state); - ae_assert(m>=1, "LSFitCreateFGH: M<1!", _state); - ae_assert(k>=1, "LSFitCreateFGH: K<1!", _state); - ae_assert(c->cnt>=k, "LSFitCreateFGH: length(C)cnt>=n, "LSFitCreateFGH: length(Y)rows>=n, "LSFitCreateFGH: rows(X)cols>=m, "LSFitCreateFGH: cols(X)teststep = 0; - state->diffstep = 0; - state->npoints = n; - state->wkind = 0; - state->m = m; - state->k = k; - lsfitsetcond(state, 0.0, 0.0, 0, _state); - lsfitsetstpmax(state, 0.0, _state); - lsfitsetxrep(state, ae_false, _state); - ae_matrix_set_length(&state->taskx, n, m, _state); - ae_vector_set_length(&state->tasky, n, _state); - ae_vector_set_length(&state->c, k, _state); - ae_matrix_set_length(&state->h, k, k, _state); - ae_vector_set_length(&state->x, m, _state); - ae_vector_set_length(&state->g, k, _state); - ae_v_move(&state->c.ptr.p_double[0], 1, &c->ptr.p_double[0], 1, ae_v_len(0,k-1)); - for(i=0; i<=n-1; i++) - { - ae_v_move(&state->taskx.ptr.pp_double[i][0], 1, &x->ptr.pp_double[i][0], 1, ae_v_len(0,m-1)); - state->tasky.ptr.p_double[i] = y->ptr.p_double[i]; - } - ae_vector_set_length(&state->s, k, _state); - ae_vector_set_length(&state->bndl, k, _state); - ae_vector_set_length(&state->bndu, k, _state); - for(i=0; i<=k-1; i++) - { - state->s.ptr.p_double[i] = 1.0; - state->bndl.ptr.p_double[i] = _state->v_neginf; - state->bndu.ptr.p_double[i] = _state->v_posinf; - } - state->optalgo = 2; - state->prevnpt = -1; - state->prevalgo = -1; - minlmcreatefgh(k, &state->c, &state->optstate, _state); - lsfit_lsfitclearrequestfields(state, _state); - ae_vector_set_length(&state->rstate.ia, 6+1, _state); - ae_vector_set_length(&state->rstate.ra, 8+1, _state); - state->rstate.stage = -1; -} - - -/************************************************************************* -Stopping conditions for nonlinear least squares fitting. - -INPUT PARAMETERS: - State - structure which stores algorithm state - EpsF - stopping criterion. Algorithm stops if - |F(k+1)-F(k)| <= EpsF*max{|F(k)|, |F(k+1)|, 1} - EpsX - >=0 - The subroutine finishes its work if on k+1-th iteration - the condition |v|<=EpsX is fulfilled, where: - * |.| means Euclidian norm - * v - scaled step vector, v[i]=dx[i]/s[i] - * dx - ste pvector, dx=X(k+1)-X(k) - * s - scaling coefficients set by LSFitSetScale() - MaxIts - maximum number of iterations. If MaxIts=0, the number of - iterations is unlimited. Only Levenberg-Marquardt - iterations are counted (L-BFGS/CG iterations are NOT - counted because their cost is very low compared to that of - LM). - -NOTE - -Passing EpsF=0, EpsX=0 and MaxIts=0 (simultaneously) will lead to automatic -stopping criterion selection (according to the scheme used by MINLM unit). - - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitsetcond(lsfitstate* state, - double epsf, - double epsx, - ae_int_t maxits, - ae_state *_state) -{ - - - ae_assert(ae_isfinite(epsf, _state), "LSFitSetCond: EpsF is not finite!", _state); - ae_assert(ae_fp_greater_eq(epsf,0), "LSFitSetCond: negative EpsF!", _state); - ae_assert(ae_isfinite(epsx, _state), "LSFitSetCond: EpsX is not finite!", _state); - ae_assert(ae_fp_greater_eq(epsx,0), "LSFitSetCond: negative EpsX!", _state); - ae_assert(maxits>=0, "LSFitSetCond: negative MaxIts!", _state); - state->epsf = epsf; - state->epsx = epsx; - state->maxits = maxits; -} - - -/************************************************************************* -This function sets maximum step length - -INPUT PARAMETERS: - State - structure which stores algorithm state - StpMax - maximum step length, >=0. Set StpMax to 0.0, if you don't - want to limit step length. - -Use this subroutine when you optimize target function which contains exp() -or other fast growing functions, and optimization algorithm makes too -large steps which leads to overflow. This function allows us to reject -steps that are too large (and therefore expose us to the possible -overflow) without actually calculating function value at the x+stp*d. - -NOTE: non-zero StpMax leads to moderate performance degradation because -intermediate step of preconditioned L-BFGS optimization is incompatible -with limits on step size. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void lsfitsetstpmax(lsfitstate* state, double stpmax, ae_state *_state) -{ - - - ae_assert(ae_fp_greater_eq(stpmax,0), "LSFitSetStpMax: StpMax<0!", _state); - state->stpmax = stpmax; -} - - -/************************************************************************* -This function turns on/off reporting. - -INPUT PARAMETERS: - State - structure which stores algorithm state - NeedXRep- whether iteration reports are needed or not - -When reports are needed, State.C (current parameters) and State.F (current -value of fitting function) are reported. - - - -- ALGLIB -- - Copyright 15.08.2010 by Bochkanov Sergey -*************************************************************************/ -void lsfitsetxrep(lsfitstate* state, ae_bool needxrep, ae_state *_state) -{ - - - state->xrep = needxrep; -} - - -/************************************************************************* -This function sets scaling coefficients for underlying optimizer. - -ALGLIB optimizers use scaling matrices to test stopping conditions (step -size and gradient are scaled before comparison with tolerances). Scale of -the I-th variable is a translation invariant measure of: -a) "how large" the variable is -b) how large the step should be to make significant changes in the function - -Generally, scale is NOT considered to be a form of preconditioner. But LM -optimizer is unique in that it uses scaling matrix both in the stopping -condition tests and as Marquardt damping factor. - -Proper scaling is very important for the algorithm performance. It is less -important for the quality of results, but still has some influence (it is -easier to converge when variables are properly scaled, so premature -stopping is possible when very badly scalled variables are combined with -relaxed stopping conditions). - -INPUT PARAMETERS: - State - structure stores algorithm state - S - array[N], non-zero scaling coefficients - S[i] may be negative, sign doesn't matter. - - -- ALGLIB -- - Copyright 14.01.2011 by Bochkanov Sergey -*************************************************************************/ -void lsfitsetscale(lsfitstate* state, - /* Real */ ae_vector* s, - ae_state *_state) -{ - ae_int_t i; - - - ae_assert(s->cnt>=state->k, "LSFitSetScale: Length(S)k-1; i++) - { - ae_assert(ae_isfinite(s->ptr.p_double[i], _state), "LSFitSetScale: S contains infinite or NAN elements", _state); - ae_assert(ae_fp_neq(s->ptr.p_double[i],0), "LSFitSetScale: S contains infinite or NAN elements", _state); - state->s.ptr.p_double[i] = ae_fabs(s->ptr.p_double[i], _state); - } -} - - -/************************************************************************* -This function sets boundary constraints for underlying optimizer - -Boundary constraints are inactive by default (after initial creation). -They are preserved until explicitly turned off with another SetBC() call. - -INPUT PARAMETERS: - State - structure stores algorithm state - BndL - lower bounds, array[K]. - If some (all) variables are unbounded, you may specify - very small number or -INF (latter is recommended because - it will allow solver to use better algorithm). - BndU - upper bounds, array[K]. - If some (all) variables are unbounded, you may specify - very large number or +INF (latter is recommended because - it will allow solver to use better algorithm). - -NOTE 1: it is possible to specify BndL[i]=BndU[i]. In this case I-th -variable will be "frozen" at X[i]=BndL[i]=BndU[i]. - -NOTE 2: unlike other constrained optimization algorithms, this solver has -following useful properties: -* bound constraints are always satisfied exactly -* function is evaluated only INSIDE area specified by bound constraints - - -- ALGLIB -- - Copyright 14.01.2011 by Bochkanov Sergey -*************************************************************************/ -void lsfitsetbc(lsfitstate* state, - /* Real */ ae_vector* bndl, - /* Real */ ae_vector* bndu, - ae_state *_state) -{ - ae_int_t i; - ae_int_t k; - - - k = state->k; - ae_assert(bndl->cnt>=k, "LSFitSetBC: Length(BndL)cnt>=k, "LSFitSetBC: Length(BndU)ptr.p_double[i], _state)||ae_isneginf(bndl->ptr.p_double[i], _state), "LSFitSetBC: BndL contains NAN or +INF", _state); - ae_assert(ae_isfinite(bndu->ptr.p_double[i], _state)||ae_isposinf(bndu->ptr.p_double[i], _state), "LSFitSetBC: BndU contains NAN or -INF", _state); - if( ae_isfinite(bndl->ptr.p_double[i], _state)&&ae_isfinite(bndu->ptr.p_double[i], _state) ) - { - ae_assert(ae_fp_less_eq(bndl->ptr.p_double[i],bndu->ptr.p_double[i]), "LSFitSetBC: BndL[i]>BndU[i]", _state); - } - state->bndl.ptr.p_double[i] = bndl->ptr.p_double[i]; - state->bndu.ptr.p_double[i] = bndu->ptr.p_double[i]; - } -} - - -/************************************************************************* -NOTES: - -1. this algorithm is somewhat unusual because it works with parameterized - function f(C,X), where X is a function argument (we have many points - which are characterized by different argument values), and C is a - parameter to fit. - - For example, if we want to do linear fit by f(c0,c1,x) = c0*x+c1, then - x will be argument, and {c0,c1} will be parameters. - - It is important to understand that this algorithm finds minimum in the - space of function PARAMETERS (not arguments), so it needs derivatives - of f() with respect to C, not X. - - In the example above it will need f=c0*x+c1 and {df/dc0,df/dc1} = {x,1} - instead of {df/dx} = {c0}. - -2. Callback functions accept C as the first parameter, and X as the second - -3. If state was created with LSFitCreateFG(), algorithm needs just - function and its gradient, but if state was created with - LSFitCreateFGH(), algorithm will need function, gradient and Hessian. - - According to the said above, there ase several versions of this - function, which accept different sets of callbacks. - - This flexibility opens way to subtle errors - you may create state with - LSFitCreateFGH() (optimization using Hessian), but call function which - does not accept Hessian. So when algorithm will request Hessian, there - will be no callback to call. In this case exception will be thrown. - - Be careful to avoid such errors because there is no way to find them at - compile time - you can see them at runtime only. - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -ae_bool lsfititeration(lsfitstate* state, ae_state *_state) -{ - double lx; - double lf; - double ld; - double rx; - double rf; - double rd; - ae_int_t n; - ae_int_t m; - ae_int_t k; - double v; - double vv; - double relcnt; - ae_int_t i; - ae_int_t j; - ae_int_t j1; - ae_int_t info; - ae_bool result; - - - - /* - * Reverse communication preparations - * I know it looks ugly, but it works the same way - * anywhere from C++ to Python. - * - * This code initializes locals by: - * * random values determined during code - * generation - on first subroutine call - * * values from previous call - on subsequent calls - */ - if( state->rstate.stage>=0 ) - { - n = state->rstate.ia.ptr.p_int[0]; - m = state->rstate.ia.ptr.p_int[1]; - k = state->rstate.ia.ptr.p_int[2]; - i = state->rstate.ia.ptr.p_int[3]; - j = state->rstate.ia.ptr.p_int[4]; - j1 = state->rstate.ia.ptr.p_int[5]; - info = state->rstate.ia.ptr.p_int[6]; - lx = state->rstate.ra.ptr.p_double[0]; - lf = state->rstate.ra.ptr.p_double[1]; - ld = state->rstate.ra.ptr.p_double[2]; - rx = state->rstate.ra.ptr.p_double[3]; - rf = state->rstate.ra.ptr.p_double[4]; - rd = state->rstate.ra.ptr.p_double[5]; - v = state->rstate.ra.ptr.p_double[6]; - vv = state->rstate.ra.ptr.p_double[7]; - relcnt = state->rstate.ra.ptr.p_double[8]; - } - else - { - n = -983; - m = -989; - k = -834; - i = 900; - j = -287; - j1 = 364; - info = 214; - lx = -338; - lf = -686; - ld = 912; - rx = 585; - rf = 497; - rd = -271; - v = -581; - vv = 745; - relcnt = -533; - } - if( state->rstate.stage==0 ) - { - goto lbl_0; - } - if( state->rstate.stage==1 ) - { - goto lbl_1; - } - if( state->rstate.stage==2 ) - { - goto lbl_2; - } - if( state->rstate.stage==3 ) - { - goto lbl_3; - } - if( state->rstate.stage==4 ) - { - goto lbl_4; - } - if( state->rstate.stage==5 ) - { - goto lbl_5; - } - if( state->rstate.stage==6 ) - { - goto lbl_6; - } - if( state->rstate.stage==7 ) - { - goto lbl_7; - } - if( state->rstate.stage==8 ) - { - goto lbl_8; - } - if( state->rstate.stage==9 ) - { - goto lbl_9; - } - if( state->rstate.stage==10 ) - { - goto lbl_10; - } - if( state->rstate.stage==11 ) - { - goto lbl_11; - } - if( state->rstate.stage==12 ) - { - goto lbl_12; - } - if( state->rstate.stage==13 ) - { - goto lbl_13; - } - - /* - * Routine body - */ - - /* - * Init - */ - if( state->wkind==1 ) - { - ae_assert(state->npoints==state->nweights, "LSFitFit: number of points is not equal to the number of weights", _state); - } - state->repvaridx = -1; - n = state->npoints; - m = state->m; - k = state->k; - minlmsetcond(&state->optstate, 0.0, state->epsf, state->epsx, state->maxits, _state); - minlmsetstpmax(&state->optstate, state->stpmax, _state); - minlmsetxrep(&state->optstate, state->xrep, _state); - minlmsetscale(&state->optstate, &state->s, _state); - minlmsetbc(&state->optstate, &state->bndl, &state->bndu, _state); - - /* - * Check that user-supplied gradient is correct - */ - lsfit_lsfitclearrequestfields(state, _state); - if( !(ae_fp_greater(state->teststep,0)&&state->optalgo==1) ) - { - goto lbl_14; - } - for(i=0; i<=k-1; i++) - { - if( ae_isfinite(state->bndl.ptr.p_double[i], _state) ) - { - state->c.ptr.p_double[i] = ae_maxreal(state->c.ptr.p_double[i], state->bndl.ptr.p_double[i], _state); - } - if( ae_isfinite(state->bndu.ptr.p_double[i], _state) ) - { - state->c.ptr.p_double[i] = ae_minreal(state->c.ptr.p_double[i], state->bndu.ptr.p_double[i], _state); - } - } - state->needfg = ae_true; - i = 0; -lbl_16: - if( i>k-1 ) - { - goto lbl_18; - } - ae_assert(ae_fp_less_eq(state->bndl.ptr.p_double[i],state->c.ptr.p_double[i])&&ae_fp_less_eq(state->c.ptr.p_double[i],state->bndu.ptr.p_double[i]), "LSFitIteration: internal error(State.C is out of bounds)", _state); - v = state->c.ptr.p_double[i]; - j = 0; -lbl_19: - if( j>n-1 ) - { - goto lbl_21; - } - ae_v_move(&state->x.ptr.p_double[0], 1, &state->taskx.ptr.pp_double[j][0], 1, ae_v_len(0,m-1)); - state->c.ptr.p_double[i] = v-state->teststep*state->s.ptr.p_double[i]; - if( ae_isfinite(state->bndl.ptr.p_double[i], _state) ) - { - state->c.ptr.p_double[i] = ae_maxreal(state->c.ptr.p_double[i], state->bndl.ptr.p_double[i], _state); - } - lx = state->c.ptr.p_double[i]; - state->rstate.stage = 0; - goto lbl_rcomm; -lbl_0: - lf = state->f; - ld = state->g.ptr.p_double[i]; - state->c.ptr.p_double[i] = v+state->teststep*state->s.ptr.p_double[i]; - if( ae_isfinite(state->bndu.ptr.p_double[i], _state) ) - { - state->c.ptr.p_double[i] = ae_minreal(state->c.ptr.p_double[i], state->bndu.ptr.p_double[i], _state); - } - rx = state->c.ptr.p_double[i]; - state->rstate.stage = 1; - goto lbl_rcomm; -lbl_1: - rf = state->f; - rd = state->g.ptr.p_double[i]; - state->c.ptr.p_double[i] = (lx+rx)/2; - if( ae_isfinite(state->bndl.ptr.p_double[i], _state) ) - { - state->c.ptr.p_double[i] = ae_maxreal(state->c.ptr.p_double[i], state->bndl.ptr.p_double[i], _state); - } - if( ae_isfinite(state->bndu.ptr.p_double[i], _state) ) - { - state->c.ptr.p_double[i] = ae_minreal(state->c.ptr.p_double[i], state->bndu.ptr.p_double[i], _state); - } - state->rstate.stage = 2; - goto lbl_rcomm; -lbl_2: - state->c.ptr.p_double[i] = v; - if( !derivativecheck(lf, ld, rf, rd, state->f, state->g.ptr.p_double[i], rx-lx, _state) ) - { - state->repvaridx = i; - state->repterminationtype = -7; - result = ae_false; - return result; - } - j = j+1; - goto lbl_19; -lbl_21: - i = i+1; - goto lbl_16; -lbl_18: - state->needfg = ae_false; -lbl_14: - - /* - * Fill WCur by weights: - * * for WKind=0 unit weights are chosen - * * for WKind=1 we use user-supplied weights stored in State.TaskW - */ - rvectorsetlengthatleast(&state->wcur, n, _state); - for(i=0; i<=n-1; i++) - { - state->wcur.ptr.p_double[i] = 1.0; - if( state->wkind==1 ) - { - state->wcur.ptr.p_double[i] = state->taskw.ptr.p_double[i]; - } - } - - /* - * Optimize - */ -lbl_22: - if( !minlmiteration(&state->optstate, _state) ) - { - goto lbl_23; - } - if( !state->optstate.needfi ) - { - goto lbl_24; - } - - /* - * calculate f[] = wi*(f(xi,c)-yi) - */ - i = 0; -lbl_26: - if( i>n-1 ) - { - goto lbl_28; - } - ae_v_move(&state->c.ptr.p_double[0], 1, &state->optstate.x.ptr.p_double[0], 1, ae_v_len(0,k-1)); - ae_v_move(&state->x.ptr.p_double[0], 1, &state->taskx.ptr.pp_double[i][0], 1, ae_v_len(0,m-1)); - state->pointindex = i; - lsfit_lsfitclearrequestfields(state, _state); - state->needf = ae_true; - state->rstate.stage = 3; - goto lbl_rcomm; -lbl_3: - state->needf = ae_false; - vv = state->wcur.ptr.p_double[i]; - state->optstate.fi.ptr.p_double[i] = vv*(state->f-state->tasky.ptr.p_double[i]); - i = i+1; - goto lbl_26; -lbl_28: - goto lbl_22; -lbl_24: - if( !state->optstate.needf ) - { - goto lbl_29; - } - - /* - * calculate F = sum (wi*(f(xi,c)-yi))^2 - */ - state->optstate.f = 0; - i = 0; -lbl_31: - if( i>n-1 ) - { - goto lbl_33; - } - ae_v_move(&state->c.ptr.p_double[0], 1, &state->optstate.x.ptr.p_double[0], 1, ae_v_len(0,k-1)); - ae_v_move(&state->x.ptr.p_double[0], 1, &state->taskx.ptr.pp_double[i][0], 1, ae_v_len(0,m-1)); - state->pointindex = i; - lsfit_lsfitclearrequestfields(state, _state); - state->needf = ae_true; - state->rstate.stage = 4; - goto lbl_rcomm; -lbl_4: - state->needf = ae_false; - vv = state->wcur.ptr.p_double[i]; - state->optstate.f = state->optstate.f+ae_sqr(vv*(state->f-state->tasky.ptr.p_double[i]), _state); - i = i+1; - goto lbl_31; -lbl_33: - goto lbl_22; -lbl_29: - if( !state->optstate.needfg ) - { - goto lbl_34; - } - - /* - * calculate F/gradF - */ - state->optstate.f = 0; - for(i=0; i<=k-1; i++) - { - state->optstate.g.ptr.p_double[i] = 0; - } - i = 0; -lbl_36: - if( i>n-1 ) - { - goto lbl_38; - } - ae_v_move(&state->c.ptr.p_double[0], 1, &state->optstate.x.ptr.p_double[0], 1, ae_v_len(0,k-1)); - ae_v_move(&state->x.ptr.p_double[0], 1, &state->taskx.ptr.pp_double[i][0], 1, ae_v_len(0,m-1)); - state->pointindex = i; - lsfit_lsfitclearrequestfields(state, _state); - state->needfg = ae_true; - state->rstate.stage = 5; - goto lbl_rcomm; -lbl_5: - state->needfg = ae_false; - vv = state->wcur.ptr.p_double[i]; - state->optstate.f = state->optstate.f+ae_sqr(vv*(state->f-state->tasky.ptr.p_double[i]), _state); - v = ae_sqr(vv, _state)*2*(state->f-state->tasky.ptr.p_double[i]); - ae_v_addd(&state->optstate.g.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,k-1), v); - i = i+1; - goto lbl_36; -lbl_38: - goto lbl_22; -lbl_34: - if( !state->optstate.needfij ) - { - goto lbl_39; - } - - /* - * calculate Fi/jac(Fi) - */ - i = 0; -lbl_41: - if( i>n-1 ) - { - goto lbl_43; - } - ae_v_move(&state->c.ptr.p_double[0], 1, &state->optstate.x.ptr.p_double[0], 1, ae_v_len(0,k-1)); - ae_v_move(&state->x.ptr.p_double[0], 1, &state->taskx.ptr.pp_double[i][0], 1, ae_v_len(0,m-1)); - state->pointindex = i; - lsfit_lsfitclearrequestfields(state, _state); - state->needfg = ae_true; - state->rstate.stage = 6; - goto lbl_rcomm; -lbl_6: - state->needfg = ae_false; - vv = state->wcur.ptr.p_double[i]; - state->optstate.fi.ptr.p_double[i] = vv*(state->f-state->tasky.ptr.p_double[i]); - ae_v_moved(&state->optstate.j.ptr.pp_double[i][0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,k-1), vv); - i = i+1; - goto lbl_41; -lbl_43: - goto lbl_22; -lbl_39: - if( !state->optstate.needfgh ) - { - goto lbl_44; - } - - /* - * calculate F/grad(F)/hess(F) - */ - state->optstate.f = 0; - for(i=0; i<=k-1; i++) - { - state->optstate.g.ptr.p_double[i] = 0; - } - for(i=0; i<=k-1; i++) - { - for(j=0; j<=k-1; j++) - { - state->optstate.h.ptr.pp_double[i][j] = 0; - } - } - i = 0; -lbl_46: - if( i>n-1 ) - { - goto lbl_48; - } - ae_v_move(&state->c.ptr.p_double[0], 1, &state->optstate.x.ptr.p_double[0], 1, ae_v_len(0,k-1)); - ae_v_move(&state->x.ptr.p_double[0], 1, &state->taskx.ptr.pp_double[i][0], 1, ae_v_len(0,m-1)); - state->pointindex = i; - lsfit_lsfitclearrequestfields(state, _state); - state->needfgh = ae_true; - state->rstate.stage = 7; - goto lbl_rcomm; -lbl_7: - state->needfgh = ae_false; - vv = state->wcur.ptr.p_double[i]; - state->optstate.f = state->optstate.f+ae_sqr(vv*(state->f-state->tasky.ptr.p_double[i]), _state); - v = ae_sqr(vv, _state)*2*(state->f-state->tasky.ptr.p_double[i]); - ae_v_addd(&state->optstate.g.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,k-1), v); - for(j=0; j<=k-1; j++) - { - v = 2*ae_sqr(vv, _state)*state->g.ptr.p_double[j]; - ae_v_addd(&state->optstate.h.ptr.pp_double[j][0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,k-1), v); - v = 2*ae_sqr(vv, _state)*(state->f-state->tasky.ptr.p_double[i]); - ae_v_addd(&state->optstate.h.ptr.pp_double[j][0], 1, &state->h.ptr.pp_double[j][0], 1, ae_v_len(0,k-1), v); - } - i = i+1; - goto lbl_46; -lbl_48: - goto lbl_22; -lbl_44: - if( !state->optstate.xupdated ) - { - goto lbl_49; - } - - /* - * Report new iteration - */ - ae_v_move(&state->c.ptr.p_double[0], 1, &state->optstate.x.ptr.p_double[0], 1, ae_v_len(0,k-1)); - state->f = state->optstate.f; - lsfit_lsfitclearrequestfields(state, _state); - state->xupdated = ae_true; - state->rstate.stage = 8; - goto lbl_rcomm; -lbl_8: - state->xupdated = ae_false; - goto lbl_22; -lbl_49: - goto lbl_22; -lbl_23: - minlmresults(&state->optstate, &state->c, &state->optrep, _state); - state->repterminationtype = state->optrep.terminationtype; - state->repiterationscount = state->optrep.iterationscount; - - /* - * calculate errors - */ - if( state->repterminationtype<=0 ) - { - goto lbl_51; - } - - /* - * Calculate RMS/Avg/Max/... errors - */ - state->reprmserror = 0; - state->repwrmserror = 0; - state->repavgerror = 0; - state->repavgrelerror = 0; - state->repmaxerror = 0; - relcnt = 0; - i = 0; -lbl_53: - if( i>n-1 ) - { - goto lbl_55; - } - ae_v_move(&state->c.ptr.p_double[0], 1, &state->c.ptr.p_double[0], 1, ae_v_len(0,k-1)); - ae_v_move(&state->x.ptr.p_double[0], 1, &state->taskx.ptr.pp_double[i][0], 1, ae_v_len(0,m-1)); - state->pointindex = i; - lsfit_lsfitclearrequestfields(state, _state); - state->needf = ae_true; - state->rstate.stage = 9; - goto lbl_rcomm; -lbl_9: - state->needf = ae_false; - v = state->f; - vv = state->wcur.ptr.p_double[i]; - state->reprmserror = state->reprmserror+ae_sqr(v-state->tasky.ptr.p_double[i], _state); - state->repwrmserror = state->repwrmserror+ae_sqr(vv*(v-state->tasky.ptr.p_double[i]), _state); - state->repavgerror = state->repavgerror+ae_fabs(v-state->tasky.ptr.p_double[i], _state); - if( ae_fp_neq(state->tasky.ptr.p_double[i],0) ) - { - state->repavgrelerror = state->repavgrelerror+ae_fabs(v-state->tasky.ptr.p_double[i], _state)/ae_fabs(state->tasky.ptr.p_double[i], _state); - relcnt = relcnt+1; - } - state->repmaxerror = ae_maxreal(state->repmaxerror, ae_fabs(v-state->tasky.ptr.p_double[i], _state), _state); - i = i+1; - goto lbl_53; -lbl_55: - state->reprmserror = ae_sqrt(state->reprmserror/n, _state); - state->repwrmserror = ae_sqrt(state->repwrmserror/n, _state); - state->repavgerror = state->repavgerror/n; - if( ae_fp_neq(relcnt,0) ) - { - state->repavgrelerror = state->repavgrelerror/relcnt; - } - - /* - * Calculate covariance matrix - */ - rmatrixsetlengthatleast(&state->tmpjac, n, k, _state); - rvectorsetlengthatleast(&state->tmpf, n, _state); - rvectorsetlengthatleast(&state->tmp, k, _state); - if( ae_fp_less_eq(state->diffstep,0) ) - { - goto lbl_56; - } - - /* - * Compute Jacobian by means of numerical differentiation - */ - lsfit_lsfitclearrequestfields(state, _state); - state->needf = ae_true; - i = 0; -lbl_58: - if( i>n-1 ) - { - goto lbl_60; - } - ae_v_move(&state->x.ptr.p_double[0], 1, &state->taskx.ptr.pp_double[i][0], 1, ae_v_len(0,m-1)); - state->pointindex = i; - state->rstate.stage = 10; - goto lbl_rcomm; -lbl_10: - state->tmpf.ptr.p_double[i] = state->f; - j = 0; -lbl_61: - if( j>k-1 ) - { - goto lbl_63; - } - v = state->c.ptr.p_double[j]; - lx = v-state->diffstep*state->s.ptr.p_double[j]; - state->c.ptr.p_double[j] = lx; - if( ae_isfinite(state->bndl.ptr.p_double[j], _state) ) - { - state->c.ptr.p_double[j] = ae_maxreal(state->c.ptr.p_double[j], state->bndl.ptr.p_double[j], _state); - } - state->rstate.stage = 11; - goto lbl_rcomm; -lbl_11: - lf = state->f; - rx = v+state->diffstep*state->s.ptr.p_double[j]; - state->c.ptr.p_double[j] = rx; - if( ae_isfinite(state->bndu.ptr.p_double[j], _state) ) - { - state->c.ptr.p_double[j] = ae_minreal(state->c.ptr.p_double[j], state->bndu.ptr.p_double[j], _state); - } - state->rstate.stage = 12; - goto lbl_rcomm; -lbl_12: - rf = state->f; - state->c.ptr.p_double[j] = v; - if( ae_fp_neq(rx,lx) ) - { - state->tmpjac.ptr.pp_double[i][j] = (rf-lf)/(rx-lx); - } - else - { - state->tmpjac.ptr.pp_double[i][j] = 0; - } - j = j+1; - goto lbl_61; -lbl_63: - i = i+1; - goto lbl_58; -lbl_60: - state->needf = ae_false; - goto lbl_57; -lbl_56: - - /* - * Jacobian is calculated with user-provided analytic gradient - */ - lsfit_lsfitclearrequestfields(state, _state); - state->needfg = ae_true; - i = 0; -lbl_64: - if( i>n-1 ) - { - goto lbl_66; - } - ae_v_move(&state->x.ptr.p_double[0], 1, &state->taskx.ptr.pp_double[i][0], 1, ae_v_len(0,m-1)); - state->pointindex = i; - state->rstate.stage = 13; - goto lbl_rcomm; -lbl_13: - state->tmpf.ptr.p_double[i] = state->f; - for(j=0; j<=k-1; j++) - { - state->tmpjac.ptr.pp_double[i][j] = state->g.ptr.p_double[j]; - } - i = i+1; - goto lbl_64; -lbl_66: - state->needfg = ae_false; -lbl_57: - for(i=0; i<=k-1; i++) - { - state->tmp.ptr.p_double[i] = 0.0; - } - lsfit_estimateerrors(&state->tmpjac, &state->tmpf, &state->tasky, &state->wcur, &state->tmp, &state->s, n, k, &state->rep, &state->tmpjacw, 0, _state); -lbl_51: - result = ae_false; - return result; - - /* - * Saving state - */ -lbl_rcomm: - result = ae_true; - state->rstate.ia.ptr.p_int[0] = n; - state->rstate.ia.ptr.p_int[1] = m; - state->rstate.ia.ptr.p_int[2] = k; - state->rstate.ia.ptr.p_int[3] = i; - state->rstate.ia.ptr.p_int[4] = j; - state->rstate.ia.ptr.p_int[5] = j1; - state->rstate.ia.ptr.p_int[6] = info; - state->rstate.ra.ptr.p_double[0] = lx; - state->rstate.ra.ptr.p_double[1] = lf; - state->rstate.ra.ptr.p_double[2] = ld; - state->rstate.ra.ptr.p_double[3] = rx; - state->rstate.ra.ptr.p_double[4] = rf; - state->rstate.ra.ptr.p_double[5] = rd; - state->rstate.ra.ptr.p_double[6] = v; - state->rstate.ra.ptr.p_double[7] = vv; - state->rstate.ra.ptr.p_double[8] = relcnt; - return result; -} - - -/************************************************************************* -Nonlinear least squares fitting results. - -Called after return from LSFitFit(). - -INPUT PARAMETERS: - State - algorithm state - -OUTPUT PARAMETERS: - Info - completion code: - * -7 gradient verification failed. - See LSFitSetGradientCheck() for more information. - * 1 relative function improvement is no more than - EpsF. - * 2 relative step is no more than EpsX. - * 4 gradient norm is no more than EpsG - * 5 MaxIts steps was taken - * 7 stopping conditions are too stringent, - further improvement is impossible - C - array[0..K-1], solution - Rep - optimization report. On success following fields are set: - * R2 non-adjusted coefficient of determination - (non-weighted) - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - * WRMSError weighted rms error on the (X,Y). - -ERRORS IN PARAMETERS - -This solver also calculates different kinds of errors in parameters and -fills corresponding fields of report: -* Rep.CovPar covariance matrix for parameters, array[K,K]. -* Rep.ErrPar errors in parameters, array[K], - errpar = sqrt(diag(CovPar)) -* Rep.ErrCurve vector of fit errors - standard deviations of empirical - best-fit curve from "ideal" best-fit curve built with - infinite number of samples, array[N]. - errcurve = sqrt(diag(J*CovPar*J')), - where J is Jacobian matrix. -* Rep.Noise vector of per-point estimates of noise, array[N] - -IMPORTANT: errors in parameters are calculated without taking into - account boundary/linear constraints! Presence of constraints - changes distribution of errors, but there is no easy way to - account for constraints when you calculate covariance matrix. - -NOTE: noise in the data is estimated as follows: - * for fitting without user-supplied weights all points are - assumed to have same level of noise, which is estimated from - the data - * for fitting with user-supplied weights we assume that noise - level in I-th point is inversely proportional to Ith weight. - Coefficient of proportionality is estimated from the data. - -NOTE: we apply small amount of regularization when we invert squared - Jacobian and calculate covariance matrix. It guarantees that - algorithm won't divide by zero during inversion, but skews - error estimates a bit (fractional error is about 10^-9). - - However, we believe that this difference is insignificant for - all practical purposes except for the situation when you want - to compare ALGLIB results with "reference" implementation up - to the last significant digit. - -NOTE: covariance matrix is estimated using correction for degrees - of freedom (covariances are divided by N-M instead of dividing - by N). - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitresults(lsfitstate* state, - ae_int_t* info, - /* Real */ ae_vector* c, - lsfitreport* rep, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - - *info = 0; - ae_vector_clear(c); - _lsfitreport_clear(rep); - - lsfit_clearreport(rep, _state); - *info = state->repterminationtype; - rep->varidx = state->repvaridx; - if( *info>0 ) - { - ae_vector_set_length(c, state->k, _state); - ae_v_move(&c->ptr.p_double[0], 1, &state->c.ptr.p_double[0], 1, ae_v_len(0,state->k-1)); - rep->rmserror = state->reprmserror; - rep->wrmserror = state->repwrmserror; - rep->avgerror = state->repavgerror; - rep->avgrelerror = state->repavgrelerror; - rep->maxerror = state->repmaxerror; - rep->iterationscount = state->repiterationscount; - ae_matrix_set_length(&rep->covpar, state->k, state->k, _state); - ae_vector_set_length(&rep->errpar, state->k, _state); - ae_vector_set_length(&rep->errcurve, state->npoints, _state); - ae_vector_set_length(&rep->noise, state->npoints, _state); - rep->r2 = state->rep.r2; - for(i=0; i<=state->k-1; i++) - { - for(j=0; j<=state->k-1; j++) - { - rep->covpar.ptr.pp_double[i][j] = state->rep.covpar.ptr.pp_double[i][j]; - } - rep->errpar.ptr.p_double[i] = state->rep.errpar.ptr.p_double[i]; - } - for(i=0; i<=state->npoints-1; i++) - { - rep->errcurve.ptr.p_double[i] = state->rep.errcurve.ptr.p_double[i]; - rep->noise.ptr.p_double[i] = state->rep.noise.ptr.p_double[i]; - } - } -} - - -/************************************************************************* -This subroutine turns on verification of the user-supplied analytic -gradient: -* user calls this subroutine before fitting begins -* LSFitFit() is called -* prior to actual fitting, for each point in data set X_i and each - component of parameters being fited C_j algorithm performs following - steps: - * two trial steps are made to C_j-TestStep*S[j] and C_j+TestStep*S[j], - where C_j is j-th parameter and S[j] is a scale of j-th parameter - * if needed, steps are bounded with respect to constraints on C[] - * F(X_i|C) is evaluated at these trial points - * we perform one more evaluation in the middle point of the interval - * we build cubic model using function values and derivatives at trial - points and we compare its prediction with actual value in the middle - point - * in case difference between prediction and actual value is higher than - some predetermined threshold, algorithm stops with completion code -7; - Rep.VarIdx is set to index of the parameter with incorrect derivative. -* after verification is over, algorithm proceeds to the actual optimization. - -NOTE 1: verification needs N*K (points count * parameters count) gradient - evaluations. It is very costly and you should use it only for low - dimensional problems, when you want to be sure that you've - correctly calculated analytic derivatives. You should not use it - in the production code (unless you want to check derivatives - provided by some third party). - -NOTE 2: you should carefully choose TestStep. Value which is too large - (so large that function behaviour is significantly non-cubic) will - lead to false alarms. You may use different step for different - parameters by means of setting scale with LSFitSetScale(). - -NOTE 3: this function may lead to false positives. In case it reports that - I-th derivative was calculated incorrectly, you may decrease test - step and try one more time - maybe your function changes too - sharply and your step is too large for such rapidly chanding - function. - -NOTE 4: this function works only for optimizers created with LSFitCreateWFG() - or LSFitCreateFG() constructors. - -INPUT PARAMETERS: - State - structure used to store algorithm state - TestStep - verification step: - * TestStep=0 turns verification off - * TestStep>0 activates verification - - -- ALGLIB -- - Copyright 15.06.2012 by Bochkanov Sergey -*************************************************************************/ -void lsfitsetgradientcheck(lsfitstate* state, - double teststep, - ae_state *_state) -{ - - - ae_assert(ae_isfinite(teststep, _state), "LSFitSetGradientCheck: TestStep contains NaN or Infinite", _state); - ae_assert(ae_fp_greater_eq(teststep,0), "LSFitSetGradientCheck: invalid argument TestStep(TestStep<0)", _state); - state->teststep = teststep; -} - - -/************************************************************************* -Internal subroutine: automatic scaling for LLS tasks. -NEVER CALL IT DIRECTLY! - -Maps abscissas to [-1,1], standartizes ordinates and correspondingly scales -constraints. It also scales weights so that max(W[i])=1 - -Transformations performed: -* X, XC [XA,XB] => [-1,+1] - transformation makes min(X)=-1, max(X)=+1 - -* Y [SA,SB] => [0,1] - transformation makes mean(Y)=0, stddev(Y)=1 - -* YC transformed accordingly to SA, SB, DC[I] - - -- ALGLIB PROJECT -- - Copyright 08.09.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitscalexy(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* w, - ae_int_t n, - /* Real */ ae_vector* xc, - /* Real */ ae_vector* yc, - /* Integer */ ae_vector* dc, - ae_int_t k, - double* xa, - double* xb, - double* sa, - double* sb, - /* Real */ ae_vector* xoriginal, - /* Real */ ae_vector* yoriginal, - ae_state *_state) -{ - double xmin; - double xmax; - ae_int_t i; - double mx; - - *xa = 0; - *xb = 0; - *sa = 0; - *sb = 0; - ae_vector_clear(xoriginal); - ae_vector_clear(yoriginal); - - ae_assert(n>=1, "LSFitScaleXY: incorrect N", _state); - ae_assert(k>=0, "LSFitScaleXY: incorrect K", _state); - - /* - * Calculate xmin/xmax. - * Force xmin<>xmax. - */ - xmin = x->ptr.p_double[0]; - xmax = x->ptr.p_double[0]; - for(i=1; i<=n-1; i++) - { - xmin = ae_minreal(xmin, x->ptr.p_double[i], _state); - xmax = ae_maxreal(xmax, x->ptr.p_double[i], _state); - } - for(i=0; i<=k-1; i++) - { - xmin = ae_minreal(xmin, xc->ptr.p_double[i], _state); - xmax = ae_maxreal(xmax, xc->ptr.p_double[i], _state); - } - if( ae_fp_eq(xmin,xmax) ) - { - if( ae_fp_eq(xmin,0) ) - { - xmin = -1; - xmax = 1; - } - else - { - if( ae_fp_greater(xmin,0) ) - { - xmin = 0.5*xmin; - } - else - { - xmax = 0.5*xmax; - } - } - } - - /* - * Transform abscissas: map [XA,XB] to [0,1] - * - * Store old X[] in XOriginal[] (it will be used - * to calculate relative error). - */ - ae_vector_set_length(xoriginal, n, _state); - ae_v_move(&xoriginal->ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,n-1)); - *xa = xmin; - *xb = xmax; - for(i=0; i<=n-1; i++) - { - x->ptr.p_double[i] = 2*(x->ptr.p_double[i]-0.5*(*xa+(*xb)))/(*xb-(*xa)); - } - for(i=0; i<=k-1; i++) - { - ae_assert(dc->ptr.p_int[i]>=0, "LSFitScaleXY: internal error!", _state); - xc->ptr.p_double[i] = 2*(xc->ptr.p_double[i]-0.5*(*xa+(*xb)))/(*xb-(*xa)); - yc->ptr.p_double[i] = yc->ptr.p_double[i]*ae_pow(0.5*(*xb-(*xa)), dc->ptr.p_int[i], _state); - } - - /* - * Transform function values: map [SA,SB] to [0,1] - * SA = mean(Y), - * SB = SA+stddev(Y). - * - * Store old Y[] in YOriginal[] (it will be used - * to calculate relative error). - */ - ae_vector_set_length(yoriginal, n, _state); - ae_v_move(&yoriginal->ptr.p_double[0], 1, &y->ptr.p_double[0], 1, ae_v_len(0,n-1)); - *sa = 0; - for(i=0; i<=n-1; i++) - { - *sa = *sa+y->ptr.p_double[i]; - } - *sa = *sa/n; - *sb = 0; - for(i=0; i<=n-1; i++) - { - *sb = *sb+ae_sqr(y->ptr.p_double[i]-(*sa), _state); - } - *sb = ae_sqrt(*sb/n, _state)+(*sa); - if( ae_fp_eq(*sb,*sa) ) - { - *sb = 2*(*sa); - } - if( ae_fp_eq(*sb,*sa) ) - { - *sb = *sa+1; - } - for(i=0; i<=n-1; i++) - { - y->ptr.p_double[i] = (y->ptr.p_double[i]-(*sa))/(*sb-(*sa)); - } - for(i=0; i<=k-1; i++) - { - if( dc->ptr.p_int[i]==0 ) - { - yc->ptr.p_double[i] = (yc->ptr.p_double[i]-(*sa))/(*sb-(*sa)); - } - else - { - yc->ptr.p_double[i] = yc->ptr.p_double[i]/(*sb-(*sa)); - } - } - - /* - * Scale weights - */ - mx = 0; - for(i=0; i<=n-1; i++) - { - mx = ae_maxreal(mx, ae_fabs(w->ptr.p_double[i], _state), _state); - } - if( ae_fp_neq(mx,0) ) - { - for(i=0; i<=n-1; i++) - { - w->ptr.p_double[i] = w->ptr.p_double[i]/mx; - } - } -} - - -/************************************************************************* -Internal spline fitting subroutine - - -- ALGLIB PROJECT -- - Copyright 08.09.2009 by Bochkanov Sergey -*************************************************************************/ -static void lsfit_spline1dfitinternal(ae_int_t st, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* w, - ae_int_t n, - /* Real */ ae_vector* xc, - /* Real */ ae_vector* yc, - /* Integer */ ae_vector* dc, - ae_int_t k, - ae_int_t m, - ae_int_t* info, - spline1dinterpolant* s, - spline1dfitreport* rep, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _x; - ae_vector _y; - ae_vector _w; - ae_vector _xc; - ae_vector _yc; - ae_matrix fmatrix; - ae_matrix cmatrix; - ae_vector y2; - ae_vector w2; - ae_vector sx; - ae_vector sy; - ae_vector sd; - ae_vector tmp; - ae_vector xoriginal; - ae_vector yoriginal; - lsfitreport lrep; - double v0; - double v1; - double v2; - double mx; - spline1dinterpolant s2; - ae_int_t i; - ae_int_t j; - ae_int_t relcnt; - double xa; - double xb; - double sa; - double sb; - double bl; - double br; - double decay; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_x, x, _state, ae_true); - x = &_x; - ae_vector_init_copy(&_y, y, _state, ae_true); - y = &_y; - ae_vector_init_copy(&_w, w, _state, ae_true); - w = &_w; - ae_vector_init_copy(&_xc, xc, _state, ae_true); - xc = &_xc; - ae_vector_init_copy(&_yc, yc, _state, ae_true); - yc = &_yc; - *info = 0; - _spline1dinterpolant_clear(s); - _spline1dfitreport_clear(rep); - ae_matrix_init(&fmatrix, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&cmatrix, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&y2, 0, DT_REAL, _state, ae_true); - ae_vector_init(&w2, 0, DT_REAL, _state, ae_true); - ae_vector_init(&sx, 0, DT_REAL, _state, ae_true); - ae_vector_init(&sy, 0, DT_REAL, _state, ae_true); - ae_vector_init(&sd, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); - ae_vector_init(&xoriginal, 0, DT_REAL, _state, ae_true); - ae_vector_init(&yoriginal, 0, DT_REAL, _state, ae_true); - _lsfitreport_init(&lrep, _state, ae_true); - _spline1dinterpolant_init(&s2, _state, ae_true); - - ae_assert(st==0||st==1, "Spline1DFit: internal error!", _state); - if( st==0&&m<4 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - if( st==1&&m<4 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - if( (n<1||k<0)||k>=m ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - for(i=0; i<=k-1; i++) - { - *info = 0; - if( dc->ptr.p_int[i]<0 ) - { - *info = -1; - } - if( dc->ptr.p_int[i]>1 ) - { - *info = -1; - } - if( *info<0 ) - { - ae_frame_leave(_state); - return; - } - } - if( st==1&&m%2!=0 ) - { - - /* - * Hermite fitter must have even number of basis functions - */ - *info = -2; - ae_frame_leave(_state); - return; - } - - /* - * weight decay for correct handling of task which becomes - * degenerate after constraints are applied - */ - decay = 10000*ae_machineepsilon; - - /* - * Scale X, Y, XC, YC - */ - lsfitscalexy(x, y, w, n, xc, yc, dc, k, &xa, &xb, &sa, &sb, &xoriginal, &yoriginal, _state); - - /* - * allocate space, initialize: - * * SX - grid for basis functions - * * SY - values of basis functions at grid points - * * FMatrix- values of basis functions at X[] - * * CMatrix- values (derivatives) of basis functions at XC[] - */ - ae_vector_set_length(&y2, n+m, _state); - ae_vector_set_length(&w2, n+m, _state); - ae_matrix_set_length(&fmatrix, n+m, m, _state); - if( k>0 ) - { - ae_matrix_set_length(&cmatrix, k, m+1, _state); - } - if( st==0 ) - { - - /* - * allocate space for cubic spline - */ - ae_vector_set_length(&sx, m-2, _state); - ae_vector_set_length(&sy, m-2, _state); - for(j=0; j<=m-2-1; j++) - { - sx.ptr.p_double[j] = (double)(2*j)/(double)(m-2-1)-1; - } - } - if( st==1 ) - { - - /* - * allocate space for Hermite spline - */ - ae_vector_set_length(&sx, m/2, _state); - ae_vector_set_length(&sy, m/2, _state); - ae_vector_set_length(&sd, m/2, _state); - for(j=0; j<=m/2-1; j++) - { - sx.ptr.p_double[j] = (double)(2*j)/(double)(m/2-1)-1; - } - } - - /* - * Prepare design and constraints matrices: - * * fill constraints matrix - * * fill first N rows of design matrix with values - * * fill next M rows of design matrix with regularizing term - * * append M zeros to Y - * * append M elements, mean(abs(W)) each, to W - */ - for(j=0; j<=m-1; j++) - { - - /* - * prepare Jth basis function - */ - if( st==0 ) - { - - /* - * cubic spline basis - */ - for(i=0; i<=m-2-1; i++) - { - sy.ptr.p_double[i] = 0; - } - bl = 0; - br = 0; - if( jptr.p_double[i], _state); - } - for(i=0; i<=k-1; i++) - { - ae_assert(dc->ptr.p_int[i]>=0&&dc->ptr.p_int[i]<=2, "Spline1DFit: internal error!", _state); - spline1ddiff(&s2, xc->ptr.p_double[i], &v0, &v1, &v2, _state); - if( dc->ptr.p_int[i]==0 ) - { - cmatrix.ptr.pp_double[i][j] = v0; - } - if( dc->ptr.p_int[i]==1 ) - { - cmatrix.ptr.pp_double[i][j] = v1; - } - if( dc->ptr.p_int[i]==2 ) - { - cmatrix.ptr.pp_double[i][j] = v2; - } - } - } - for(i=0; i<=k-1; i++) - { - cmatrix.ptr.pp_double[i][m] = yc->ptr.p_double[i]; - } - for(i=0; i<=m-1; i++) - { - for(j=0; j<=m-1; j++) - { - if( i==j ) - { - fmatrix.ptr.pp_double[n+i][j] = decay; - } - else - { - fmatrix.ptr.pp_double[n+i][j] = 0; - } - } - } - ae_vector_set_length(&y2, n+m, _state); - ae_vector_set_length(&w2, n+m, _state); - ae_v_move(&y2.ptr.p_double[0], 1, &y->ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_move(&w2.ptr.p_double[0], 1, &w->ptr.p_double[0], 1, ae_v_len(0,n-1)); - mx = 0; - for(i=0; i<=n-1; i++) - { - mx = mx+ae_fabs(w->ptr.p_double[i], _state); - } - mx = mx/n; - for(i=0; i<=m-1; i++) - { - y2.ptr.p_double[n+i] = 0; - w2.ptr.p_double[n+i] = mx; - } - - /* - * Solve constrained task - */ - if( k>0 ) - { - - /* - * solve using regularization - */ - lsfitlinearwc(&y2, &w2, &fmatrix, &cmatrix, n+m, m, k, info, &tmp, &lrep, _state); - } - else - { - - /* - * no constraints, no regularization needed - */ - lsfitlinearwc(y, w, &fmatrix, &cmatrix, n, m, k, info, &tmp, &lrep, _state); - } - if( *info<0 ) - { - ae_frame_leave(_state); - return; - } - - /* - * Generate spline and scale it - */ - if( st==0 ) - { - - /* - * cubic spline basis - */ - ae_v_move(&sy.ptr.p_double[0], 1, &tmp.ptr.p_double[0], 1, ae_v_len(0,m-2-1)); - spline1dbuildcubic(&sx, &sy, m-2, 1, tmp.ptr.p_double[m-2], 1, tmp.ptr.p_double[m-1], s, _state); - } - if( st==1 ) - { - - /* - * Hermite basis - */ - for(i=0; i<=m/2-1; i++) - { - sy.ptr.p_double[i] = tmp.ptr.p_double[2*i]; - sd.ptr.p_double[i] = tmp.ptr.p_double[2*i+1]; - } - spline1dbuildhermite(&sx, &sy, &sd, m/2, s, _state); - } - spline1dlintransx(s, 2/(xb-xa), -(xa+xb)/(xb-xa), _state); - spline1dlintransy(s, sb-sa, sa, _state); - - /* - * Scale absolute errors obtained from LSFitLinearW. - * Relative error should be calculated separately - * (because of shifting/scaling of the task) - */ - rep->taskrcond = lrep.taskrcond; - rep->rmserror = lrep.rmserror*(sb-sa); - rep->avgerror = lrep.avgerror*(sb-sa); - rep->maxerror = lrep.maxerror*(sb-sa); - rep->avgrelerror = 0; - relcnt = 0; - for(i=0; i<=n-1; i++) - { - if( ae_fp_neq(yoriginal.ptr.p_double[i],0) ) - { - rep->avgrelerror = rep->avgrelerror+ae_fabs(spline1dcalc(s, xoriginal.ptr.p_double[i], _state)-yoriginal.ptr.p_double[i], _state)/ae_fabs(yoriginal.ptr.p_double[i], _state); - relcnt = relcnt+1; - } - } - if( relcnt!=0 ) - { - rep->avgrelerror = rep->avgrelerror/relcnt; - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Internal fitting subroutine -*************************************************************************/ -static void lsfit_lsfitlinearinternal(/* Real */ ae_vector* y, - /* Real */ ae_vector* w, - /* Real */ ae_matrix* fmatrix, - ae_int_t n, - ae_int_t m, - ae_int_t* info, - /* Real */ ae_vector* c, - lsfitreport* rep, - ae_state *_state) -{ - ae_frame _frame_block; - double threshold; - ae_matrix ft; - ae_matrix q; - ae_matrix l; - ae_matrix r; - ae_vector b; - ae_vector wmod; - ae_vector tau; - ae_vector nzeros; - ae_vector s; - ae_int_t i; - ae_int_t j; - double v; - ae_vector sv; - ae_matrix u; - ae_matrix vt; - ae_vector tmp; - ae_vector utb; - ae_vector sutb; - ae_int_t relcnt; - - ae_frame_make(_state, &_frame_block); - *info = 0; - ae_vector_clear(c); - _lsfitreport_clear(rep); - ae_matrix_init(&ft, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&q, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&l, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&r, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&b, 0, DT_REAL, _state, ae_true); - ae_vector_init(&wmod, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tau, 0, DT_REAL, _state, ae_true); - ae_vector_init(&nzeros, 0, DT_REAL, _state, ae_true); - ae_vector_init(&s, 0, DT_REAL, _state, ae_true); - ae_vector_init(&sv, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&u, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&vt, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); - ae_vector_init(&utb, 0, DT_REAL, _state, ae_true); - ae_vector_init(&sutb, 0, DT_REAL, _state, ae_true); - - lsfit_clearreport(rep, _state); - if( n<1||m<1 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - *info = 1; - threshold = ae_sqrt(ae_machineepsilon, _state); - - /* - * Degenerate case, needs special handling - */ - if( nptr.p_double[j]; - ae_v_moved(&ft.ptr.pp_double[j][0], 1, &fmatrix->ptr.pp_double[j][0], 1, ae_v_len(0,m-1), v); - b.ptr.p_double[j] = w->ptr.p_double[j]*y->ptr.p_double[j]; - wmod.ptr.p_double[j] = 1; - } - - /* - * LQ decomposition and reduction to M=N - */ - ae_vector_set_length(c, m, _state); - for(i=0; i<=m-1; i++) - { - c->ptr.p_double[i] = 0; - } - rep->taskrcond = 0; - rmatrixlq(&ft, n, m, &tau, _state); - rmatrixlqunpackq(&ft, n, m, &tau, n, &q, _state); - rmatrixlqunpackl(&ft, n, m, &l, _state); - lsfit_lsfitlinearinternal(&b, &wmod, &l, n, n, info, &tmp, rep, _state); - if( *info<=0 ) - { - ae_frame_leave(_state); - return; - } - for(i=0; i<=n-1; i++) - { - v = tmp.ptr.p_double[i]; - ae_v_addd(&c->ptr.p_double[0], 1, &q.ptr.pp_double[i][0], 1, ae_v_len(0,m-1), v); - } - ae_frame_leave(_state); - return; - } - - /* - * N>=M. Generate design matrix and reduce to N=M using - * QR decomposition. - */ - ae_matrix_set_length(&ft, n, m, _state); - ae_vector_set_length(&b, n, _state); - for(j=0; j<=n-1; j++) - { - v = w->ptr.p_double[j]; - ae_v_moved(&ft.ptr.pp_double[j][0], 1, &fmatrix->ptr.pp_double[j][0], 1, ae_v_len(0,m-1), v); - b.ptr.p_double[j] = w->ptr.p_double[j]*y->ptr.p_double[j]; - } - rmatrixqr(&ft, n, m, &tau, _state); - rmatrixqrunpackq(&ft, n, m, &tau, m, &q, _state); - rmatrixqrunpackr(&ft, n, m, &r, _state); - ae_vector_set_length(&tmp, m, _state); - for(i=0; i<=m-1; i++) - { - tmp.ptr.p_double[i] = 0; - } - for(i=0; i<=n-1; i++) - { - v = b.ptr.p_double[i]; - ae_v_addd(&tmp.ptr.p_double[0], 1, &q.ptr.pp_double[i][0], 1, ae_v_len(0,m-1), v); - } - ae_vector_set_length(&b, m, _state); - ae_v_move(&b.ptr.p_double[0], 1, &tmp.ptr.p_double[0], 1, ae_v_len(0,m-1)); - - /* - * R contains reduced MxM design upper triangular matrix, - * B contains reduced Mx1 right part. - * - * Determine system condition number and decide - * should we use triangular solver (faster) or - * SVD-based solver (more stable). - * - * We can use LU-based RCond estimator for this task. - */ - rep->taskrcond = rmatrixlurcondinf(&r, m, _state); - if( ae_fp_greater(rep->taskrcond,threshold) ) - { - - /* - * use QR-based solver - */ - ae_vector_set_length(c, m, _state); - c->ptr.p_double[m-1] = b.ptr.p_double[m-1]/r.ptr.pp_double[m-1][m-1]; - for(i=m-2; i>=0; i--) - { - v = ae_v_dotproduct(&r.ptr.pp_double[i][i+1], 1, &c->ptr.p_double[i+1], 1, ae_v_len(i+1,m-1)); - c->ptr.p_double[i] = (b.ptr.p_double[i]-v)/r.ptr.pp_double[i][i]; - } - } - else - { - - /* - * use SVD-based solver - */ - if( !rmatrixsvd(&r, m, m, 1, 1, 2, &sv, &u, &vt, _state) ) - { - *info = -4; - ae_frame_leave(_state); - return; - } - ae_vector_set_length(&utb, m, _state); - ae_vector_set_length(&sutb, m, _state); - for(i=0; i<=m-1; i++) - { - utb.ptr.p_double[i] = 0; - } - for(i=0; i<=m-1; i++) - { - v = b.ptr.p_double[i]; - ae_v_addd(&utb.ptr.p_double[0], 1, &u.ptr.pp_double[i][0], 1, ae_v_len(0,m-1), v); - } - if( ae_fp_greater(sv.ptr.p_double[0],0) ) - { - rep->taskrcond = sv.ptr.p_double[m-1]/sv.ptr.p_double[0]; - for(i=0; i<=m-1; i++) - { - if( ae_fp_greater(sv.ptr.p_double[i],threshold*sv.ptr.p_double[0]) ) - { - sutb.ptr.p_double[i] = utb.ptr.p_double[i]/sv.ptr.p_double[i]; - } - else - { - sutb.ptr.p_double[i] = 0; - } - } - } - else - { - rep->taskrcond = 0; - for(i=0; i<=m-1; i++) - { - sutb.ptr.p_double[i] = 0; - } - } - ae_vector_set_length(c, m, _state); - for(i=0; i<=m-1; i++) - { - c->ptr.p_double[i] = 0; - } - for(i=0; i<=m-1; i++) - { - v = sutb.ptr.p_double[i]; - ae_v_addd(&c->ptr.p_double[0], 1, &vt.ptr.pp_double[i][0], 1, ae_v_len(0,m-1), v); - } - } - - /* - * calculate errors - */ - rep->rmserror = 0; - rep->avgerror = 0; - rep->avgrelerror = 0; - rep->maxerror = 0; - relcnt = 0; - for(i=0; i<=n-1; i++) - { - v = ae_v_dotproduct(&fmatrix->ptr.pp_double[i][0], 1, &c->ptr.p_double[0], 1, ae_v_len(0,m-1)); - rep->rmserror = rep->rmserror+ae_sqr(v-y->ptr.p_double[i], _state); - rep->avgerror = rep->avgerror+ae_fabs(v-y->ptr.p_double[i], _state); - if( ae_fp_neq(y->ptr.p_double[i],0) ) - { - rep->avgrelerror = rep->avgrelerror+ae_fabs(v-y->ptr.p_double[i], _state)/ae_fabs(y->ptr.p_double[i], _state); - relcnt = relcnt+1; - } - rep->maxerror = ae_maxreal(rep->maxerror, ae_fabs(v-y->ptr.p_double[i], _state), _state); - } - rep->rmserror = ae_sqrt(rep->rmserror/n, _state); - rep->avgerror = rep->avgerror/n; - if( relcnt!=0 ) - { - rep->avgrelerror = rep->avgrelerror/relcnt; - } - ae_vector_set_length(&nzeros, n, _state); - ae_vector_set_length(&s, m, _state); - for(i=0; i<=m-1; i++) - { - s.ptr.p_double[i] = 0; - } - for(i=0; i<=n-1; i++) - { - for(j=0; j<=m-1; j++) - { - s.ptr.p_double[j] = s.ptr.p_double[j]+ae_sqr(fmatrix->ptr.pp_double[i][j], _state); - } - nzeros.ptr.p_double[i] = 0; - } - for(i=0; i<=m-1; i++) - { - if( ae_fp_neq(s.ptr.p_double[i],0) ) - { - s.ptr.p_double[i] = ae_sqrt(1/s.ptr.p_double[i], _state); - } - else - { - s.ptr.p_double[i] = 1; - } - } - lsfit_estimateerrors(fmatrix, &nzeros, y, w, c, &s, n, m, rep, &r, 1, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Internal subroutine -*************************************************************************/ -static void lsfit_lsfitclearrequestfields(lsfitstate* state, - ae_state *_state) -{ - - - state->needf = ae_false; - state->needfg = ae_false; - state->needfgh = ae_false; - state->xupdated = ae_false; -} - - -/************************************************************************* -Internal subroutine, calculates barycentric basis functions. -Used for efficient simultaneous calculation of N basis functions. - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -static void lsfit_barycentriccalcbasis(barycentricinterpolant* b, - double t, - /* Real */ ae_vector* y, - ae_state *_state) -{ - double s2; - double s; - double v; - ae_int_t i; - ae_int_t j; - - - - /* - * special case: N=1 - */ - if( b->n==1 ) - { - y->ptr.p_double[0] = 1; - return; - } - - /* - * Here we assume that task is normalized, i.e.: - * 1. abs(Y[i])<=1 - * 2. abs(W[i])<=1 - * 3. X[] is ordered - * - * First, we decide: should we use "safe" formula (guarded - * against overflow) or fast one? - */ - s = ae_fabs(t-b->x.ptr.p_double[0], _state); - for(i=0; i<=b->n-1; i++) - { - v = b->x.ptr.p_double[i]; - if( ae_fp_eq(v,t) ) - { - for(j=0; j<=b->n-1; j++) - { - y->ptr.p_double[j] = 0; - } - y->ptr.p_double[i] = 1; - return; - } - v = ae_fabs(t-v, _state); - if( ae_fp_less(v,s) ) - { - s = v; - } - } - s2 = 0; - for(i=0; i<=b->n-1; i++) - { - v = s/(t-b->x.ptr.p_double[i]); - v = v*b->w.ptr.p_double[i]; - y->ptr.p_double[i] = v; - s2 = s2+v; - } - v = 1/s2; - ae_v_muld(&y->ptr.p_double[0], 1, ae_v_len(0,b->n-1), v); -} - - -/************************************************************************* -This is internal function for Chebyshev fitting. - -It assumes that input data are normalized: -* X/XC belong to [-1,+1], -* mean(Y)=0, stddev(Y)=1. - -It does not checks inputs for errors. - -This function is used to fit general (shifted) Chebyshev models, power -basis models or barycentric models. - -INPUT PARAMETERS: - X - points, array[0..N-1]. - Y - function values, array[0..N-1]. - W - weights, array[0..N-1] - N - number of points, N>0. - XC - points where polynomial values/derivatives are constrained, - array[0..K-1]. - YC - values of constraints, array[0..K-1] - DC - array[0..K-1], types of constraints: - * DC[i]=0 means that P(XC[i])=YC[i] - * DC[i]=1 means that P'(XC[i])=YC[i] - K - number of constraints, 0<=K=1 - -OUTPUT PARAMETERS: - Info- same format as in LSFitLinearW() subroutine: - * Info>0 task is solved - * Info<=0 an error occurred: - -4 means inconvergence of internal SVD - -3 means inconsistent constraints - C - interpolant in Chebyshev form; [-1,+1] is used as base interval - Rep - report, same format as in LSFitLinearW() subroutine. - Following fields are set: - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -IMPORTANT: - this subroitine doesn't calculate task's condition number for K<>0. - - -- ALGLIB PROJECT -- - Copyright 10.12.2009 by Bochkanov Sergey -*************************************************************************/ -static void lsfit_internalchebyshevfit(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* w, - ae_int_t n, - /* Real */ ae_vector* xc, - /* Real */ ae_vector* yc, - /* Integer */ ae_vector* dc, - ae_int_t k, - ae_int_t m, - ae_int_t* info, - /* Real */ ae_vector* c, - lsfitreport* rep, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _xc; - ae_vector _yc; - ae_vector y2; - ae_vector w2; - ae_vector tmp; - ae_vector tmp2; - ae_vector tmpdiff; - ae_vector bx; - ae_vector by; - ae_vector bw; - ae_matrix fmatrix; - ae_matrix cmatrix; - ae_int_t i; - ae_int_t j; - double mx; - double decay; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_xc, xc, _state, ae_true); - xc = &_xc; - ae_vector_init_copy(&_yc, yc, _state, ae_true); - yc = &_yc; - *info = 0; - ae_vector_clear(c); - _lsfitreport_clear(rep); - ae_vector_init(&y2, 0, DT_REAL, _state, ae_true); - ae_vector_init(&w2, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tmp2, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tmpdiff, 0, DT_REAL, _state, ae_true); - ae_vector_init(&bx, 0, DT_REAL, _state, ae_true); - ae_vector_init(&by, 0, DT_REAL, _state, ae_true); - ae_vector_init(&bw, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&fmatrix, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&cmatrix, 0, 0, DT_REAL, _state, ae_true); - - lsfit_clearreport(rep, _state); - - /* - * weight decay for correct handling of task which becomes - * degenerate after constraints are applied - */ - decay = 10000*ae_machineepsilon; - - /* - * allocate space, initialize/fill: - * * FMatrix- values of basis functions at X[] - * * CMatrix- values (derivatives) of basis functions at XC[] - * * fill constraints matrix - * * fill first N rows of design matrix with values - * * fill next M rows of design matrix with regularizing term - * * append M zeros to Y - * * append M elements, mean(abs(W)) each, to W - */ - ae_vector_set_length(&y2, n+m, _state); - ae_vector_set_length(&w2, n+m, _state); - ae_vector_set_length(&tmp, m, _state); - ae_vector_set_length(&tmpdiff, m, _state); - ae_matrix_set_length(&fmatrix, n+m, m, _state); - if( k>0 ) - { - ae_matrix_set_length(&cmatrix, k, m+1, _state); - } - - /* - * Fill design matrix, Y2, W2: - * * first N rows with basis functions for original points - * * next M rows with decay terms - */ - for(i=0; i<=n-1; i++) - { - - /* - * prepare Ith row - * use Tmp for calculations to avoid multidimensional arrays overhead - */ - for(j=0; j<=m-1; j++) - { - if( j==0 ) - { - tmp.ptr.p_double[j] = 1; - } - else - { - if( j==1 ) - { - tmp.ptr.p_double[j] = x->ptr.p_double[i]; - } - else - { - tmp.ptr.p_double[j] = 2*x->ptr.p_double[i]*tmp.ptr.p_double[j-1]-tmp.ptr.p_double[j-2]; - } - } - } - ae_v_move(&fmatrix.ptr.pp_double[i][0], 1, &tmp.ptr.p_double[0], 1, ae_v_len(0,m-1)); - } - for(i=0; i<=m-1; i++) - { - for(j=0; j<=m-1; j++) - { - if( i==j ) - { - fmatrix.ptr.pp_double[n+i][j] = decay; - } - else - { - fmatrix.ptr.pp_double[n+i][j] = 0; - } - } - } - ae_v_move(&y2.ptr.p_double[0], 1, &y->ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_move(&w2.ptr.p_double[0], 1, &w->ptr.p_double[0], 1, ae_v_len(0,n-1)); - mx = 0; - for(i=0; i<=n-1; i++) - { - mx = mx+ae_fabs(w->ptr.p_double[i], _state); - } - mx = mx/n; - for(i=0; i<=m-1; i++) - { - y2.ptr.p_double[n+i] = 0; - w2.ptr.p_double[n+i] = mx; - } - - /* - * fill constraints matrix - */ - for(i=0; i<=k-1; i++) - { - - /* - * prepare Ith row - * use Tmp for basis function values, - * TmpDiff for basos function derivatives - */ - for(j=0; j<=m-1; j++) - { - if( j==0 ) - { - tmp.ptr.p_double[j] = 1; - tmpdiff.ptr.p_double[j] = 0; - } - else - { - if( j==1 ) - { - tmp.ptr.p_double[j] = xc->ptr.p_double[i]; - tmpdiff.ptr.p_double[j] = 1; - } - else - { - tmp.ptr.p_double[j] = 2*xc->ptr.p_double[i]*tmp.ptr.p_double[j-1]-tmp.ptr.p_double[j-2]; - tmpdiff.ptr.p_double[j] = 2*(tmp.ptr.p_double[j-1]+xc->ptr.p_double[i]*tmpdiff.ptr.p_double[j-1])-tmpdiff.ptr.p_double[j-2]; - } - } - } - if( dc->ptr.p_int[i]==0 ) - { - ae_v_move(&cmatrix.ptr.pp_double[i][0], 1, &tmp.ptr.p_double[0], 1, ae_v_len(0,m-1)); - } - if( dc->ptr.p_int[i]==1 ) - { - ae_v_move(&cmatrix.ptr.pp_double[i][0], 1, &tmpdiff.ptr.p_double[0], 1, ae_v_len(0,m-1)); - } - cmatrix.ptr.pp_double[i][m] = yc->ptr.p_double[i]; - } - - /* - * Solve constrained task - */ - if( k>0 ) - { - - /* - * solve using regularization - */ - lsfitlinearwc(&y2, &w2, &fmatrix, &cmatrix, n+m, m, k, info, c, rep, _state); - } - else - { - - /* - * no constraints, no regularization needed - */ - lsfitlinearwc(y, w, &fmatrix, &cmatrix, n, m, 0, info, c, rep, _state); - } - if( *info<0 ) - { - ae_frame_leave(_state); - return; - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Internal Floater-Hormann fitting subroutine for fixed D -*************************************************************************/ -static void lsfit_barycentricfitwcfixedd(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* w, - ae_int_t n, - /* Real */ ae_vector* xc, - /* Real */ ae_vector* yc, - /* Integer */ ae_vector* dc, - ae_int_t k, - ae_int_t m, - ae_int_t d, - ae_int_t* info, - barycentricinterpolant* b, - barycentricfitreport* rep, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _x; - ae_vector _y; - ae_vector _w; - ae_vector _xc; - ae_vector _yc; - ae_matrix fmatrix; - ae_matrix cmatrix; - ae_vector y2; - ae_vector w2; - ae_vector sx; - ae_vector sy; - ae_vector sbf; - ae_vector xoriginal; - ae_vector yoriginal; - ae_vector tmp; - lsfitreport lrep; - double v0; - double v1; - double mx; - barycentricinterpolant b2; - ae_int_t i; - ae_int_t j; - ae_int_t relcnt; - double xa; - double xb; - double sa; - double sb; - double decay; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_x, x, _state, ae_true); - x = &_x; - ae_vector_init_copy(&_y, y, _state, ae_true); - y = &_y; - ae_vector_init_copy(&_w, w, _state, ae_true); - w = &_w; - ae_vector_init_copy(&_xc, xc, _state, ae_true); - xc = &_xc; - ae_vector_init_copy(&_yc, yc, _state, ae_true); - yc = &_yc; - *info = 0; - _barycentricinterpolant_clear(b); - _barycentricfitreport_clear(rep); - ae_matrix_init(&fmatrix, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&cmatrix, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&y2, 0, DT_REAL, _state, ae_true); - ae_vector_init(&w2, 0, DT_REAL, _state, ae_true); - ae_vector_init(&sx, 0, DT_REAL, _state, ae_true); - ae_vector_init(&sy, 0, DT_REAL, _state, ae_true); - ae_vector_init(&sbf, 0, DT_REAL, _state, ae_true); - ae_vector_init(&xoriginal, 0, DT_REAL, _state, ae_true); - ae_vector_init(&yoriginal, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); - _lsfitreport_init(&lrep, _state, ae_true); - _barycentricinterpolant_init(&b2, _state, ae_true); - - if( ((n<1||m<2)||k<0)||k>=m ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - for(i=0; i<=k-1; i++) - { - *info = 0; - if( dc->ptr.p_int[i]<0 ) - { - *info = -1; - } - if( dc->ptr.p_int[i]>1 ) - { - *info = -1; - } - if( *info<0 ) - { - ae_frame_leave(_state); - return; - } - } - - /* - * weight decay for correct handling of task which becomes - * degenerate after constraints are applied - */ - decay = 10000*ae_machineepsilon; - - /* - * Scale X, Y, XC, YC - */ - lsfitscalexy(x, y, w, n, xc, yc, dc, k, &xa, &xb, &sa, &sb, &xoriginal, &yoriginal, _state); - - /* - * allocate space, initialize: - * * FMatrix- values of basis functions at X[] - * * CMatrix- values (derivatives) of basis functions at XC[] - */ - ae_vector_set_length(&y2, n+m, _state); - ae_vector_set_length(&w2, n+m, _state); - ae_matrix_set_length(&fmatrix, n+m, m, _state); - if( k>0 ) - { - ae_matrix_set_length(&cmatrix, k, m+1, _state); - } - ae_vector_set_length(&y2, n+m, _state); - ae_vector_set_length(&w2, n+m, _state); - - /* - * Prepare design and constraints matrices: - * * fill constraints matrix - * * fill first N rows of design matrix with values - * * fill next M rows of design matrix with regularizing term - * * append M zeros to Y - * * append M elements, mean(abs(W)) each, to W - */ - ae_vector_set_length(&sx, m, _state); - ae_vector_set_length(&sy, m, _state); - ae_vector_set_length(&sbf, m, _state); - for(j=0; j<=m-1; j++) - { - sx.ptr.p_double[j] = (double)(2*j)/(double)(m-1)-1; - } - for(i=0; i<=m-1; i++) - { - sy.ptr.p_double[i] = 1; - } - barycentricbuildfloaterhormann(&sx, &sy, m, d, &b2, _state); - mx = 0; - for(i=0; i<=n-1; i++) - { - lsfit_barycentriccalcbasis(&b2, x->ptr.p_double[i], &sbf, _state); - ae_v_move(&fmatrix.ptr.pp_double[i][0], 1, &sbf.ptr.p_double[0], 1, ae_v_len(0,m-1)); - y2.ptr.p_double[i] = y->ptr.p_double[i]; - w2.ptr.p_double[i] = w->ptr.p_double[i]; - mx = mx+ae_fabs(w->ptr.p_double[i], _state)/n; - } - for(i=0; i<=m-1; i++) - { - for(j=0; j<=m-1; j++) - { - if( i==j ) - { - fmatrix.ptr.pp_double[n+i][j] = decay; - } - else - { - fmatrix.ptr.pp_double[n+i][j] = 0; - } - } - y2.ptr.p_double[n+i] = 0; - w2.ptr.p_double[n+i] = mx; - } - if( k>0 ) - { - for(j=0; j<=m-1; j++) - { - for(i=0; i<=m-1; i++) - { - sy.ptr.p_double[i] = 0; - } - sy.ptr.p_double[j] = 1; - barycentricbuildfloaterhormann(&sx, &sy, m, d, &b2, _state); - for(i=0; i<=k-1; i++) - { - ae_assert(dc->ptr.p_int[i]>=0&&dc->ptr.p_int[i]<=1, "BarycentricFit: internal error!", _state); - barycentricdiff1(&b2, xc->ptr.p_double[i], &v0, &v1, _state); - if( dc->ptr.p_int[i]==0 ) - { - cmatrix.ptr.pp_double[i][j] = v0; - } - if( dc->ptr.p_int[i]==1 ) - { - cmatrix.ptr.pp_double[i][j] = v1; - } - } - } - for(i=0; i<=k-1; i++) - { - cmatrix.ptr.pp_double[i][m] = yc->ptr.p_double[i]; - } - } - - /* - * Solve constrained task - */ - if( k>0 ) - { - - /* - * solve using regularization - */ - lsfitlinearwc(&y2, &w2, &fmatrix, &cmatrix, n+m, m, k, info, &tmp, &lrep, _state); - } - else - { - - /* - * no constraints, no regularization needed - */ - lsfitlinearwc(y, w, &fmatrix, &cmatrix, n, m, k, info, &tmp, &lrep, _state); - } - if( *info<0 ) - { - ae_frame_leave(_state); - return; - } - - /* - * Generate interpolant and scale it - */ - ae_v_move(&sy.ptr.p_double[0], 1, &tmp.ptr.p_double[0], 1, ae_v_len(0,m-1)); - barycentricbuildfloaterhormann(&sx, &sy, m, d, b, _state); - barycentriclintransx(b, 2/(xb-xa), -(xa+xb)/(xb-xa), _state); - barycentriclintransy(b, sb-sa, sa, _state); - - /* - * Scale absolute errors obtained from LSFitLinearW. - * Relative error should be calculated separately - * (because of shifting/scaling of the task) - */ - rep->taskrcond = lrep.taskrcond; - rep->rmserror = lrep.rmserror*(sb-sa); - rep->avgerror = lrep.avgerror*(sb-sa); - rep->maxerror = lrep.maxerror*(sb-sa); - rep->avgrelerror = 0; - relcnt = 0; - for(i=0; i<=n-1; i++) - { - if( ae_fp_neq(yoriginal.ptr.p_double[i],0) ) - { - rep->avgrelerror = rep->avgrelerror+ae_fabs(barycentriccalc(b, xoriginal.ptr.p_double[i], _state)-yoriginal.ptr.p_double[i], _state)/ae_fabs(yoriginal.ptr.p_double[i], _state); - relcnt = relcnt+1; - } - } - if( relcnt!=0 ) - { - rep->avgrelerror = rep->avgrelerror/relcnt; - } - ae_frame_leave(_state); -} - - -static void lsfit_clearreport(lsfitreport* rep, ae_state *_state) -{ - - - rep->taskrcond = 0; - rep->iterationscount = 0; - rep->varidx = -1; - rep->rmserror = 0; - rep->avgerror = 0; - rep->avgrelerror = 0; - rep->maxerror = 0; - rep->wrmserror = 0; - rep->r2 = 0; - ae_matrix_set_length(&rep->covpar, 0, 0, _state); - ae_vector_set_length(&rep->errpar, 0, _state); - ae_vector_set_length(&rep->errcurve, 0, _state); - ae_vector_set_length(&rep->noise, 0, _state); -} - - -/************************************************************************* -This internal function estimates covariance matrix and other error-related -information for linear/nonlinear least squares model. - -It has a bit awkward interface, but it can be used for both linear and -nonlinear problems. - -INPUT PARAMETERS: - F1 - array[0..N-1,0..K-1]: - * for linear problems - matrix of function values - * for nonlinear problems - Jacobian matrix - F0 - array[0..N-1]: - * for linear problems - must be filled with zeros - * for nonlinear problems - must store values of function being - fitted - Y - array[0..N-1]: - * for linear and nonlinear problems - must store target values - W - weights, array[0..N-1]: - * for linear and nonlinear problems - weights - X - array[0..K-1]: - * for linear and nonlinear problems - current solution - S - array[0..K-1]: - * its components should be strictly positive - * squared inverse of this diagonal matrix is used as damping - factor for covariance matrix (linear and nonlinear problems) - * for nonlinear problems, when scale of the variables is usually - explicitly given by user, you may use scale vector for this - parameter - * for linear problems you may set this parameter to - S=sqrt(1/diag(F'*F)) - * this parameter is automatically rescaled by this function, - only relative magnitudes of its components (with respect to - each other) matter. - N - number of points, N>0. - K - number of dimensions - Rep - structure which is used to store results - Z - additional matrix which, depending on ZKind, may contain some - information used to accelerate calculations - or just can be - temporary buffer: - * for ZKind=0 Z contains no information, just temporary - buffer which can be resized and used as needed - * for ZKind=1 Z contains triangular matrix from QR - decomposition of W*F1. This matrix can be used - to speedup calculation of covariance matrix. - It should not be changed by algorithm. - ZKind- contents of Z - -OUTPUT PARAMETERS: - -* Rep.CovPar covariance matrix for parameters, array[K,K]. -* Rep.ErrPar errors in parameters, array[K], - errpar = sqrt(diag(CovPar)) -* Rep.ErrCurve vector of fit errors - standard deviations of empirical - best-fit curve from "ideal" best-fit curve built with - infinite number of samples, array[N]. - errcurve = sqrt(diag(J*CovPar*J')), - where J is Jacobian matrix. -* Rep.Noise vector of per-point estimates of noise, array[N] -* Rep.R2 coefficient of determination (non-weighted) - -Other fields of Rep are not changed. - -IMPORTANT: errors in parameters are calculated without taking into - account boundary/linear constraints! Presence of constraints - changes distribution of errors, but there is no easy way to - account for constraints when you calculate covariance matrix. - -NOTE: noise in the data is estimated as follows: - * for fitting without user-supplied weights all points are - assumed to have same level of noise, which is estimated from - the data - * for fitting with user-supplied weights we assume that noise - level in I-th point is inversely proportional to Ith weight. - Coefficient of proportionality is estimated from the data. - -NOTE: we apply small amount of regularization when we invert squared - Jacobian and calculate covariance matrix. It guarantees that - algorithm won't divide by zero during inversion, but skews - error estimates a bit (fractional error is about 10^-9). - - However, we believe that this difference is insignificant for - all practical purposes except for the situation when you want - to compare ALGLIB results with "reference" implementation up - to the last significant digit. - - -- ALGLIB PROJECT -- - Copyright 10.12.2009 by Bochkanov Sergey -*************************************************************************/ -static void lsfit_estimateerrors(/* Real */ ae_matrix* f1, - /* Real */ ae_vector* f0, - /* Real */ ae_vector* y, - /* Real */ ae_vector* w, - /* Real */ ae_vector* x, - /* Real */ ae_vector* s, - ae_int_t n, - ae_int_t k, - lsfitreport* rep, - /* Real */ ae_matrix* z, - ae_int_t zkind, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _s; - ae_int_t i; - ae_int_t j; - ae_int_t j1; - double v; - double noisec; - ae_int_t info; - matinvreport invrep; - ae_int_t nzcnt; - double avg; - double rss; - double tss; - double sz; - double ss; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_s, s, _state, ae_true); - s = &_s; - _matinvreport_init(&invrep, _state, ae_true); - - - /* - * Compute NZCnt - count of non-zero weights - */ - nzcnt = 0; - for(i=0; i<=n-1; i++) - { - if( ae_fp_neq(w->ptr.p_double[i],0) ) - { - nzcnt = nzcnt+1; - } - } - - /* - * Compute R2 - */ - if( nzcnt>0 ) - { - avg = 0.0; - for(i=0; i<=n-1; i++) - { - if( ae_fp_neq(w->ptr.p_double[i],0) ) - { - avg = avg+y->ptr.p_double[i]; - } - } - avg = avg/nzcnt; - rss = 0.0; - tss = 0.0; - for(i=0; i<=n-1; i++) - { - if( ae_fp_neq(w->ptr.p_double[i],0) ) - { - v = ae_v_dotproduct(&f1->ptr.pp_double[i][0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,k-1)); - v = v+f0->ptr.p_double[i]; - rss = rss+ae_sqr(v-y->ptr.p_double[i], _state); - tss = tss+ae_sqr(y->ptr.p_double[i]-avg, _state); - } - } - if( ae_fp_neq(tss,0) ) - { - rep->r2 = ae_maxreal(1.0-rss/tss, 0.0, _state); - } - else - { - rep->r2 = 1.0; - } - } - else - { - rep->r2 = 0; - } - - /* - * Compute estimate of proportionality between noise in the data and weights: - * NoiseC = mean(per-point-noise*per-point-weight) - * Noise level (standard deviation) at each point is equal to NoiseC/W[I]. - */ - if( nzcnt>k ) - { - noisec = 0.0; - for(i=0; i<=n-1; i++) - { - if( ae_fp_neq(w->ptr.p_double[i],0) ) - { - v = ae_v_dotproduct(&f1->ptr.pp_double[i][0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,k-1)); - v = v+f0->ptr.p_double[i]; - noisec = noisec+ae_sqr((v-y->ptr.p_double[i])*w->ptr.p_double[i], _state); - } - } - noisec = ae_sqrt(noisec/(nzcnt-k), _state); - } - else - { - noisec = 0.0; - } - - /* - * Two branches on noise level: - * * NoiseC>0 normal situation - * * NoiseC=0 degenerate case CovPar is filled by zeros - */ - rmatrixsetlengthatleast(&rep->covpar, k, k, _state); - if( ae_fp_greater(noisec,0) ) - { - - /* - * Normal situation: non-zero noise level - */ - ae_assert(zkind==0||zkind==1, "LSFit: internal error in EstimateErrors() function", _state); - if( zkind==0 ) - { - - /* - * Z contains no additional information which can be used to speed up - * calculations. We have to calculate covariance matrix on our own: - * * Compute scaled Jacobian N*J, where N[i,i]=WCur[I]/NoiseC, store in Z - * * Compute Z'*Z, store in CovPar - * * Apply moderate regularization to CovPar and compute matrix inverse. - * In case inverse failed, increase regularization parameter and try - * again. - */ - rmatrixsetlengthatleast(z, n, k, _state); - for(i=0; i<=n-1; i++) - { - v = w->ptr.p_double[i]/noisec; - ae_v_moved(&z->ptr.pp_double[i][0], 1, &f1->ptr.pp_double[i][0], 1, ae_v_len(0,k-1), v); - } - - /* - * Convert S to automatically scaled damped matrix: - * * calculate SZ - sum of diagonal elements of Z'*Z - * * calculate SS - sum of diagonal elements of S^(-2) - * * overwrite S by (SZ/SS)*S^(-2) - * * now S has approximately same magnitude as giagonal of Z'*Z - */ - sz = 0; - for(i=0; i<=n-1; i++) - { - for(j=0; j<=k-1; j++) - { - sz = sz+z->ptr.pp_double[i][j]*z->ptr.pp_double[i][j]; - } - } - if( ae_fp_eq(sz,0) ) - { - sz = 1; - } - ss = 0; - for(j=0; j<=k-1; j++) - { - ss = ss+1/ae_sqr(s->ptr.p_double[j], _state); - } - for(j=0; j<=k-1; j++) - { - s->ptr.p_double[j] = sz/ss/ae_sqr(s->ptr.p_double[j], _state); - } - - /* - * Calculate damped inverse inv(Z'*Z+S). - * We increase damping factor V until Z'*Z become well-conditioned. - */ - v = 1.0E3*ae_machineepsilon; - do - { - rmatrixsyrk(k, n, 1.0, z, 0, 0, 2, 0.0, &rep->covpar, 0, 0, ae_true, _state); - for(i=0; i<=k-1; i++) - { - rep->covpar.ptr.pp_double[i][i] = rep->covpar.ptr.pp_double[i][i]+v*s->ptr.p_double[i]; - } - spdmatrixinverse(&rep->covpar, k, ae_true, &info, &invrep, _state); - v = 10*v; - } - while(info<=0); - for(i=0; i<=k-1; i++) - { - for(j=i+1; j<=k-1; j++) - { - rep->covpar.ptr.pp_double[j][i] = rep->covpar.ptr.pp_double[i][j]; - } - } - } - if( zkind==1 ) - { - - /* - * We can reuse additional information: - * * Z contains R matrix from QR decomposition of W*F1 - * * After multiplication by 1/NoiseC we get Z_mod = N*F1, where diag(N)=w[i]/NoiseC - * * Such triangular Z_mod is a Cholesky factor from decomposition of J'*N'*N*J. - * Thus, we can calculate covariance matrix as inverse of the matrix given by - * its Cholesky decomposition. It allow us to avoid time-consuming calculation - * of J'*N'*N*J in CovPar - complexity is reduced from O(N*K^2) to O(K^3), which - * is quite good because K is usually orders of magnitude smaller than N. - * - * First, convert S to automatically scaled damped matrix: - * * calculate SZ - sum of magnitudes of diagonal elements of Z/NoiseC - * * calculate SS - sum of diagonal elements of S^(-1) - * * overwrite S by (SZ/SS)*S^(-1) - * * now S has approximately same magnitude as giagonal of Z'*Z - */ - sz = 0; - for(j=0; j<=k-1; j++) - { - sz = sz+ae_fabs(z->ptr.pp_double[j][j]/noisec, _state); - } - if( ae_fp_eq(sz,0) ) - { - sz = 1; - } - ss = 0; - for(j=0; j<=k-1; j++) - { - ss = ss+1/s->ptr.p_double[j]; - } - for(j=0; j<=k-1; j++) - { - s->ptr.p_double[j] = sz/ss/s->ptr.p_double[j]; - } - - /* - * Calculate damped inverse of inv((Z+v*S)'*(Z+v*S)) - * We increase damping factor V until matrix become well-conditioned. - */ - v = 1.0E3*ae_machineepsilon; - do - { - for(i=0; i<=k-1; i++) - { - for(j=i; j<=k-1; j++) - { - rep->covpar.ptr.pp_double[i][j] = z->ptr.pp_double[i][j]/noisec; - } - rep->covpar.ptr.pp_double[i][i] = rep->covpar.ptr.pp_double[i][i]+v*s->ptr.p_double[i]; - } - spdmatrixcholeskyinverse(&rep->covpar, k, ae_true, &info, &invrep, _state); - v = 10*v; - } - while(info<=0); - for(i=0; i<=k-1; i++) - { - for(j=i+1; j<=k-1; j++) - { - rep->covpar.ptr.pp_double[j][i] = rep->covpar.ptr.pp_double[i][j]; - } - } - } - } - else - { - - /* - * Degenerate situation: zero noise level, covariance matrix is zero. - */ - for(i=0; i<=k-1; i++) - { - for(j=0; j<=k-1; j++) - { - rep->covpar.ptr.pp_double[j][i] = 0; - } - } - } - - /* - * Estimate erorrs in parameters, curve and per-point noise - */ - rvectorsetlengthatleast(&rep->errpar, k, _state); - rvectorsetlengthatleast(&rep->errcurve, n, _state); - rvectorsetlengthatleast(&rep->noise, n, _state); - for(i=0; i<=k-1; i++) - { - rep->errpar.ptr.p_double[i] = ae_sqrt(rep->covpar.ptr.pp_double[i][i], _state); - } - for(i=0; i<=n-1; i++) - { - - /* - * ErrCurve[I] is sqrt(P[i,i]) where P=J*CovPar*J' - */ - v = 0.0; - for(j=0; j<=k-1; j++) - { - for(j1=0; j1<=k-1; j1++) - { - v = v+f1->ptr.pp_double[i][j]*rep->covpar.ptr.pp_double[j][j1]*f1->ptr.pp_double[i][j1]; - } - } - rep->errcurve.ptr.p_double[i] = ae_sqrt(v, _state); - - /* - * Noise[i] is filled using weights and current estimate of noise level - */ - if( ae_fp_neq(w->ptr.p_double[i],0) ) - { - rep->noise.ptr.p_double[i] = noisec/w->ptr.p_double[i]; - } - else - { - rep->noise.ptr.p_double[i] = 0; - } - } - ae_frame_leave(_state); -} - - -ae_bool _polynomialfitreport_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - polynomialfitreport *p = (polynomialfitreport*)_p; - ae_touch_ptr((void*)p); - return ae_true; -} - - -ae_bool _polynomialfitreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - polynomialfitreport *dst = (polynomialfitreport*)_dst; - polynomialfitreport *src = (polynomialfitreport*)_src; - dst->taskrcond = src->taskrcond; - dst->rmserror = src->rmserror; - dst->avgerror = src->avgerror; - dst->avgrelerror = src->avgrelerror; - dst->maxerror = src->maxerror; - return ae_true; -} - - -void _polynomialfitreport_clear(void* _p) -{ - polynomialfitreport *p = (polynomialfitreport*)_p; - ae_touch_ptr((void*)p); -} - - -void _polynomialfitreport_destroy(void* _p) -{ - polynomialfitreport *p = (polynomialfitreport*)_p; - ae_touch_ptr((void*)p); -} - - -ae_bool _barycentricfitreport_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - barycentricfitreport *p = (barycentricfitreport*)_p; - ae_touch_ptr((void*)p); - return ae_true; -} - - -ae_bool _barycentricfitreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - barycentricfitreport *dst = (barycentricfitreport*)_dst; - barycentricfitreport *src = (barycentricfitreport*)_src; - dst->taskrcond = src->taskrcond; - dst->dbest = src->dbest; - dst->rmserror = src->rmserror; - dst->avgerror = src->avgerror; - dst->avgrelerror = src->avgrelerror; - dst->maxerror = src->maxerror; - return ae_true; -} - - -void _barycentricfitreport_clear(void* _p) -{ - barycentricfitreport *p = (barycentricfitreport*)_p; - ae_touch_ptr((void*)p); -} - - -void _barycentricfitreport_destroy(void* _p) -{ - barycentricfitreport *p = (barycentricfitreport*)_p; - ae_touch_ptr((void*)p); -} - - -ae_bool _spline1dfitreport_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - spline1dfitreport *p = (spline1dfitreport*)_p; - ae_touch_ptr((void*)p); - return ae_true; -} - - -ae_bool _spline1dfitreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - spline1dfitreport *dst = (spline1dfitreport*)_dst; - spline1dfitreport *src = (spline1dfitreport*)_src; - dst->taskrcond = src->taskrcond; - dst->rmserror = src->rmserror; - dst->avgerror = src->avgerror; - dst->avgrelerror = src->avgrelerror; - dst->maxerror = src->maxerror; - return ae_true; -} - - -void _spline1dfitreport_clear(void* _p) -{ - spline1dfitreport *p = (spline1dfitreport*)_p; - ae_touch_ptr((void*)p); -} - - -void _spline1dfitreport_destroy(void* _p) -{ - spline1dfitreport *p = (spline1dfitreport*)_p; - ae_touch_ptr((void*)p); -} - - -ae_bool _lsfitreport_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - lsfitreport *p = (lsfitreport*)_p; - ae_touch_ptr((void*)p); - if( !ae_matrix_init(&p->covpar, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->errpar, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->errcurve, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->noise, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _lsfitreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - lsfitreport *dst = (lsfitreport*)_dst; - lsfitreport *src = (lsfitreport*)_src; - dst->taskrcond = src->taskrcond; - dst->iterationscount = src->iterationscount; - dst->varidx = src->varidx; - dst->rmserror = src->rmserror; - dst->avgerror = src->avgerror; - dst->avgrelerror = src->avgrelerror; - dst->maxerror = src->maxerror; - dst->wrmserror = src->wrmserror; - if( !ae_matrix_init_copy(&dst->covpar, &src->covpar, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->errpar, &src->errpar, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->errcurve, &src->errcurve, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->noise, &src->noise, _state, make_automatic) ) - return ae_false; - dst->r2 = src->r2; - return ae_true; -} - - -void _lsfitreport_clear(void* _p) -{ - lsfitreport *p = (lsfitreport*)_p; - ae_touch_ptr((void*)p); - ae_matrix_clear(&p->covpar); - ae_vector_clear(&p->errpar); - ae_vector_clear(&p->errcurve); - ae_vector_clear(&p->noise); -} - - -void _lsfitreport_destroy(void* _p) -{ - lsfitreport *p = (lsfitreport*)_p; - ae_touch_ptr((void*)p); - ae_matrix_destroy(&p->covpar); - ae_vector_destroy(&p->errpar); - ae_vector_destroy(&p->errcurve); - ae_vector_destroy(&p->noise); -} - - -ae_bool _lsfitstate_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - lsfitstate *p = (lsfitstate*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->s, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->bndl, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->bndu, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->taskx, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->tasky, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->taskw, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->c, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->g, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->h, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->wcur, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->tmp, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->tmpf, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->tmpjac, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->tmpjacw, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !_matinvreport_init(&p->invrep, _state, make_automatic) ) - return ae_false; - if( !_lsfitreport_init(&p->rep, _state, make_automatic) ) - return ae_false; - if( !_minlmstate_init(&p->optstate, _state, make_automatic) ) - return ae_false; - if( !_minlmreport_init(&p->optrep, _state, make_automatic) ) - return ae_false; - if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _lsfitstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - lsfitstate *dst = (lsfitstate*)_dst; - lsfitstate *src = (lsfitstate*)_src; - dst->optalgo = src->optalgo; - dst->m = src->m; - dst->k = src->k; - dst->epsf = src->epsf; - dst->epsx = src->epsx; - dst->maxits = src->maxits; - dst->stpmax = src->stpmax; - dst->xrep = src->xrep; - if( !ae_vector_init_copy(&dst->s, &src->s, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->bndl, &src->bndl, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->bndu, &src->bndu, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->taskx, &src->taskx, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->tasky, &src->tasky, _state, make_automatic) ) - return ae_false; - dst->npoints = src->npoints; - if( !ae_vector_init_copy(&dst->taskw, &src->taskw, _state, make_automatic) ) - return ae_false; - dst->nweights = src->nweights; - dst->wkind = src->wkind; - dst->wits = src->wits; - dst->diffstep = src->diffstep; - dst->teststep = src->teststep; - dst->xupdated = src->xupdated; - dst->needf = src->needf; - dst->needfg = src->needfg; - dst->needfgh = src->needfgh; - dst->pointindex = src->pointindex; - if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->c, &src->c, _state, make_automatic) ) - return ae_false; - dst->f = src->f; - if( !ae_vector_init_copy(&dst->g, &src->g, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->h, &src->h, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->wcur, &src->wcur, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->tmp, &src->tmp, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->tmpf, &src->tmpf, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->tmpjac, &src->tmpjac, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->tmpjacw, &src->tmpjacw, _state, make_automatic) ) - return ae_false; - dst->tmpnoise = src->tmpnoise; - if( !_matinvreport_init_copy(&dst->invrep, &src->invrep, _state, make_automatic) ) - return ae_false; - dst->repiterationscount = src->repiterationscount; - dst->repterminationtype = src->repterminationtype; - dst->repvaridx = src->repvaridx; - dst->reprmserror = src->reprmserror; - dst->repavgerror = src->repavgerror; - dst->repavgrelerror = src->repavgrelerror; - dst->repmaxerror = src->repmaxerror; - dst->repwrmserror = src->repwrmserror; - if( !_lsfitreport_init_copy(&dst->rep, &src->rep, _state, make_automatic) ) - return ae_false; - if( !_minlmstate_init_copy(&dst->optstate, &src->optstate, _state, make_automatic) ) - return ae_false; - if( !_minlmreport_init_copy(&dst->optrep, &src->optrep, _state, make_automatic) ) - return ae_false; - dst->prevnpt = src->prevnpt; - dst->prevalgo = src->prevalgo; - if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _lsfitstate_clear(void* _p) -{ - lsfitstate *p = (lsfitstate*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->s); - ae_vector_clear(&p->bndl); - ae_vector_clear(&p->bndu); - ae_matrix_clear(&p->taskx); - ae_vector_clear(&p->tasky); - ae_vector_clear(&p->taskw); - ae_vector_clear(&p->x); - ae_vector_clear(&p->c); - ae_vector_clear(&p->g); - ae_matrix_clear(&p->h); - ae_vector_clear(&p->wcur); - ae_vector_clear(&p->tmp); - ae_vector_clear(&p->tmpf); - ae_matrix_clear(&p->tmpjac); - ae_matrix_clear(&p->tmpjacw); - _matinvreport_clear(&p->invrep); - _lsfitreport_clear(&p->rep); - _minlmstate_clear(&p->optstate); - _minlmreport_clear(&p->optrep); - _rcommstate_clear(&p->rstate); -} - - -void _lsfitstate_destroy(void* _p) -{ - lsfitstate *p = (lsfitstate*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->s); - ae_vector_destroy(&p->bndl); - ae_vector_destroy(&p->bndu); - ae_matrix_destroy(&p->taskx); - ae_vector_destroy(&p->tasky); - ae_vector_destroy(&p->taskw); - ae_vector_destroy(&p->x); - ae_vector_destroy(&p->c); - ae_vector_destroy(&p->g); - ae_matrix_destroy(&p->h); - ae_vector_destroy(&p->wcur); - ae_vector_destroy(&p->tmp); - ae_vector_destroy(&p->tmpf); - ae_matrix_destroy(&p->tmpjac); - ae_matrix_destroy(&p->tmpjacw); - _matinvreport_destroy(&p->invrep); - _lsfitreport_destroy(&p->rep); - _minlmstate_destroy(&p->optstate); - _minlmreport_destroy(&p->optrep); - _rcommstate_destroy(&p->rstate); -} - - - - -/************************************************************************* -This function builds non-periodic 2-dimensional parametric spline which -starts at (X[0],Y[0]) and ends at (X[N-1],Y[N-1]). - -INPUT PARAMETERS: - XY - points, array[0..N-1,0..1]. - XY[I,0:1] corresponds to the Ith point. - Order of points is important! - N - points count, N>=5 for Akima splines, N>=2 for other types of - splines. - ST - spline type: - * 0 Akima spline - * 1 parabolically terminated Catmull-Rom spline (Tension=0) - * 2 parabolically terminated cubic spline - PT - parameterization type: - * 0 uniform - * 1 chord length - * 2 centripetal - -OUTPUT PARAMETERS: - P - parametric spline interpolant - - -NOTES: -* this function assumes that there all consequent points are distinct. - I.e. (x0,y0)<>(x1,y1), (x1,y1)<>(x2,y2), (x2,y2)<>(x3,y3) and so on. - However, non-consequent points may coincide, i.e. we can have (x0,y0)= - =(x2,y2). - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline2build(/* Real */ ae_matrix* xy, - ae_int_t n, - ae_int_t st, - ae_int_t pt, - pspline2interpolant* p, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix _xy; - ae_vector tmp; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init_copy(&_xy, xy, _state, ae_true); - xy = &_xy; - _pspline2interpolant_clear(p); - ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); - - ae_assert(st>=0&&st<=2, "PSpline2Build: incorrect spline type!", _state); - ae_assert(pt>=0&&pt<=2, "PSpline2Build: incorrect parameterization type!", _state); - if( st==0 ) - { - ae_assert(n>=5, "PSpline2Build: N<5 (minimum value for Akima splines)!", _state); - } - else - { - ae_assert(n>=2, "PSpline2Build: N<2!", _state); - } - - /* - * Prepare - */ - p->n = n; - p->periodic = ae_false; - ae_vector_set_length(&tmp, n, _state); - - /* - * Build parameterization, check that all parameters are distinct - */ - pspline_pspline2par(xy, n, pt, &p->p, _state); - ae_assert(aredistinct(&p->p, n, _state), "PSpline2Build: consequent points are too close!", _state); - - /* - * Build splines - */ - if( st==0 ) - { - ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][0], xy->stride, ae_v_len(0,n-1)); - spline1dbuildakima(&p->p, &tmp, n, &p->x, _state); - ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][1], xy->stride, ae_v_len(0,n-1)); - spline1dbuildakima(&p->p, &tmp, n, &p->y, _state); - } - if( st==1 ) - { - ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][0], xy->stride, ae_v_len(0,n-1)); - spline1dbuildcatmullrom(&p->p, &tmp, n, 0, 0.0, &p->x, _state); - ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][1], xy->stride, ae_v_len(0,n-1)); - spline1dbuildcatmullrom(&p->p, &tmp, n, 0, 0.0, &p->y, _state); - } - if( st==2 ) - { - ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][0], xy->stride, ae_v_len(0,n-1)); - spline1dbuildcubic(&p->p, &tmp, n, 0, 0.0, 0, 0.0, &p->x, _state); - ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][1], xy->stride, ae_v_len(0,n-1)); - spline1dbuildcubic(&p->p, &tmp, n, 0, 0.0, 0, 0.0, &p->y, _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -This function builds non-periodic 3-dimensional parametric spline which -starts at (X[0],Y[0],Z[0]) and ends at (X[N-1],Y[N-1],Z[N-1]). - -Same as PSpline2Build() function, but for 3D, so we won't duplicate its -description here. - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline3build(/* Real */ ae_matrix* xy, - ae_int_t n, - ae_int_t st, - ae_int_t pt, - pspline3interpolant* p, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix _xy; - ae_vector tmp; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init_copy(&_xy, xy, _state, ae_true); - xy = &_xy; - _pspline3interpolant_clear(p); - ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); - - ae_assert(st>=0&&st<=2, "PSpline3Build: incorrect spline type!", _state); - ae_assert(pt>=0&&pt<=2, "PSpline3Build: incorrect parameterization type!", _state); - if( st==0 ) - { - ae_assert(n>=5, "PSpline3Build: N<5 (minimum value for Akima splines)!", _state); - } - else - { - ae_assert(n>=2, "PSpline3Build: N<2!", _state); - } - - /* - * Prepare - */ - p->n = n; - p->periodic = ae_false; - ae_vector_set_length(&tmp, n, _state); - - /* - * Build parameterization, check that all parameters are distinct - */ - pspline_pspline3par(xy, n, pt, &p->p, _state); - ae_assert(aredistinct(&p->p, n, _state), "PSpline3Build: consequent points are too close!", _state); - - /* - * Build splines - */ - if( st==0 ) - { - ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][0], xy->stride, ae_v_len(0,n-1)); - spline1dbuildakima(&p->p, &tmp, n, &p->x, _state); - ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][1], xy->stride, ae_v_len(0,n-1)); - spline1dbuildakima(&p->p, &tmp, n, &p->y, _state); - ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][2], xy->stride, ae_v_len(0,n-1)); - spline1dbuildakima(&p->p, &tmp, n, &p->z, _state); - } - if( st==1 ) - { - ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][0], xy->stride, ae_v_len(0,n-1)); - spline1dbuildcatmullrom(&p->p, &tmp, n, 0, 0.0, &p->x, _state); - ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][1], xy->stride, ae_v_len(0,n-1)); - spline1dbuildcatmullrom(&p->p, &tmp, n, 0, 0.0, &p->y, _state); - ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][2], xy->stride, ae_v_len(0,n-1)); - spline1dbuildcatmullrom(&p->p, &tmp, n, 0, 0.0, &p->z, _state); - } - if( st==2 ) - { - ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][0], xy->stride, ae_v_len(0,n-1)); - spline1dbuildcubic(&p->p, &tmp, n, 0, 0.0, 0, 0.0, &p->x, _state); - ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][1], xy->stride, ae_v_len(0,n-1)); - spline1dbuildcubic(&p->p, &tmp, n, 0, 0.0, 0, 0.0, &p->y, _state); - ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][2], xy->stride, ae_v_len(0,n-1)); - spline1dbuildcubic(&p->p, &tmp, n, 0, 0.0, 0, 0.0, &p->z, _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -This function builds periodic 2-dimensional parametric spline which -starts at (X[0],Y[0]), goes through all points to (X[N-1],Y[N-1]) and then -back to (X[0],Y[0]). - -INPUT PARAMETERS: - XY - points, array[0..N-1,0..1]. - XY[I,0:1] corresponds to the Ith point. - XY[N-1,0:1] must be different from XY[0,0:1]. - Order of points is important! - N - points count, N>=3 for other types of splines. - ST - spline type: - * 1 Catmull-Rom spline (Tension=0) with cyclic boundary conditions - * 2 cubic spline with cyclic boundary conditions - PT - parameterization type: - * 0 uniform - * 1 chord length - * 2 centripetal - -OUTPUT PARAMETERS: - P - parametric spline interpolant - - -NOTES: -* this function assumes that there all consequent points are distinct. - I.e. (x0,y0)<>(x1,y1), (x1,y1)<>(x2,y2), (x2,y2)<>(x3,y3) and so on. - However, non-consequent points may coincide, i.e. we can have (x0,y0)= - =(x2,y2). -* last point of sequence is NOT equal to the first point. You shouldn't - make curve "explicitly periodic" by making them equal. - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline2buildperiodic(/* Real */ ae_matrix* xy, - ae_int_t n, - ae_int_t st, - ae_int_t pt, - pspline2interpolant* p, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix _xy; - ae_matrix xyp; - ae_vector tmp; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init_copy(&_xy, xy, _state, ae_true); - xy = &_xy; - _pspline2interpolant_clear(p); - ae_matrix_init(&xyp, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); - - ae_assert(st>=1&&st<=2, "PSpline2BuildPeriodic: incorrect spline type!", _state); - ae_assert(pt>=0&&pt<=2, "PSpline2BuildPeriodic: incorrect parameterization type!", _state); - ae_assert(n>=3, "PSpline2BuildPeriodic: N<3!", _state); - - /* - * Prepare - */ - p->n = n; - p->periodic = ae_true; - ae_vector_set_length(&tmp, n+1, _state); - ae_matrix_set_length(&xyp, n+1, 2, _state); - ae_v_move(&xyp.ptr.pp_double[0][0], xyp.stride, &xy->ptr.pp_double[0][0], xy->stride, ae_v_len(0,n-1)); - ae_v_move(&xyp.ptr.pp_double[0][1], xyp.stride, &xy->ptr.pp_double[0][1], xy->stride, ae_v_len(0,n-1)); - ae_v_move(&xyp.ptr.pp_double[n][0], 1, &xy->ptr.pp_double[0][0], 1, ae_v_len(0,1)); - - /* - * Build parameterization, check that all parameters are distinct - */ - pspline_pspline2par(&xyp, n+1, pt, &p->p, _state); - ae_assert(aredistinct(&p->p, n+1, _state), "PSpline2BuildPeriodic: consequent (or first and last) points are too close!", _state); - - /* - * Build splines - */ - if( st==1 ) - { - ae_v_move(&tmp.ptr.p_double[0], 1, &xyp.ptr.pp_double[0][0], xyp.stride, ae_v_len(0,n)); - spline1dbuildcatmullrom(&p->p, &tmp, n+1, -1, 0.0, &p->x, _state); - ae_v_move(&tmp.ptr.p_double[0], 1, &xyp.ptr.pp_double[0][1], xyp.stride, ae_v_len(0,n)); - spline1dbuildcatmullrom(&p->p, &tmp, n+1, -1, 0.0, &p->y, _state); - } - if( st==2 ) - { - ae_v_move(&tmp.ptr.p_double[0], 1, &xyp.ptr.pp_double[0][0], xyp.stride, ae_v_len(0,n)); - spline1dbuildcubic(&p->p, &tmp, n+1, -1, 0.0, -1, 0.0, &p->x, _state); - ae_v_move(&tmp.ptr.p_double[0], 1, &xyp.ptr.pp_double[0][1], xyp.stride, ae_v_len(0,n)); - spline1dbuildcubic(&p->p, &tmp, n+1, -1, 0.0, -1, 0.0, &p->y, _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -This function builds periodic 3-dimensional parametric spline which -starts at (X[0],Y[0],Z[0]), goes through all points to (X[N-1],Y[N-1],Z[N-1]) -and then back to (X[0],Y[0],Z[0]). - -Same as PSpline2Build() function, but for 3D, so we won't duplicate its -description here. - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline3buildperiodic(/* Real */ ae_matrix* xy, - ae_int_t n, - ae_int_t st, - ae_int_t pt, - pspline3interpolant* p, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix _xy; - ae_matrix xyp; - ae_vector tmp; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init_copy(&_xy, xy, _state, ae_true); - xy = &_xy; - _pspline3interpolant_clear(p); - ae_matrix_init(&xyp, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); - - ae_assert(st>=1&&st<=2, "PSpline3BuildPeriodic: incorrect spline type!", _state); - ae_assert(pt>=0&&pt<=2, "PSpline3BuildPeriodic: incorrect parameterization type!", _state); - ae_assert(n>=3, "PSpline3BuildPeriodic: N<3!", _state); - - /* - * Prepare - */ - p->n = n; - p->periodic = ae_true; - ae_vector_set_length(&tmp, n+1, _state); - ae_matrix_set_length(&xyp, n+1, 3, _state); - ae_v_move(&xyp.ptr.pp_double[0][0], xyp.stride, &xy->ptr.pp_double[0][0], xy->stride, ae_v_len(0,n-1)); - ae_v_move(&xyp.ptr.pp_double[0][1], xyp.stride, &xy->ptr.pp_double[0][1], xy->stride, ae_v_len(0,n-1)); - ae_v_move(&xyp.ptr.pp_double[0][2], xyp.stride, &xy->ptr.pp_double[0][2], xy->stride, ae_v_len(0,n-1)); - ae_v_move(&xyp.ptr.pp_double[n][0], 1, &xy->ptr.pp_double[0][0], 1, ae_v_len(0,2)); - - /* - * Build parameterization, check that all parameters are distinct - */ - pspline_pspline3par(&xyp, n+1, pt, &p->p, _state); - ae_assert(aredistinct(&p->p, n+1, _state), "PSplineBuild2Periodic: consequent (or first and last) points are too close!", _state); - - /* - * Build splines - */ - if( st==1 ) - { - ae_v_move(&tmp.ptr.p_double[0], 1, &xyp.ptr.pp_double[0][0], xyp.stride, ae_v_len(0,n)); - spline1dbuildcatmullrom(&p->p, &tmp, n+1, -1, 0.0, &p->x, _state); - ae_v_move(&tmp.ptr.p_double[0], 1, &xyp.ptr.pp_double[0][1], xyp.stride, ae_v_len(0,n)); - spline1dbuildcatmullrom(&p->p, &tmp, n+1, -1, 0.0, &p->y, _state); - ae_v_move(&tmp.ptr.p_double[0], 1, &xyp.ptr.pp_double[0][2], xyp.stride, ae_v_len(0,n)); - spline1dbuildcatmullrom(&p->p, &tmp, n+1, -1, 0.0, &p->z, _state); - } - if( st==2 ) - { - ae_v_move(&tmp.ptr.p_double[0], 1, &xyp.ptr.pp_double[0][0], xyp.stride, ae_v_len(0,n)); - spline1dbuildcubic(&p->p, &tmp, n+1, -1, 0.0, -1, 0.0, &p->x, _state); - ae_v_move(&tmp.ptr.p_double[0], 1, &xyp.ptr.pp_double[0][1], xyp.stride, ae_v_len(0,n)); - spline1dbuildcubic(&p->p, &tmp, n+1, -1, 0.0, -1, 0.0, &p->y, _state); - ae_v_move(&tmp.ptr.p_double[0], 1, &xyp.ptr.pp_double[0][2], xyp.stride, ae_v_len(0,n)); - spline1dbuildcubic(&p->p, &tmp, n+1, -1, 0.0, -1, 0.0, &p->z, _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -This function returns vector of parameter values correspoding to points. - -I.e. for P created from (X[0],Y[0])...(X[N-1],Y[N-1]) and U=TValues(P) we -have - (X[0],Y[0]) = PSpline2Calc(P,U[0]), - (X[1],Y[1]) = PSpline2Calc(P,U[1]), - (X[2],Y[2]) = PSpline2Calc(P,U[2]), - ... - -INPUT PARAMETERS: - P - parametric spline interpolant - -OUTPUT PARAMETERS: - N - array size - T - array[0..N-1] - - -NOTES: -* for non-periodic splines U[0]=0, U[0]n>=2, "PSpline2ParameterValues: internal error!", _state); - *n = p->n; - ae_vector_set_length(t, *n, _state); - ae_v_move(&t->ptr.p_double[0], 1, &p->p.ptr.p_double[0], 1, ae_v_len(0,*n-1)); - t->ptr.p_double[0] = 0; - if( !p->periodic ) - { - t->ptr.p_double[*n-1] = 1; - } -} - - -/************************************************************************* -This function returns vector of parameter values correspoding to points. - -Same as PSpline2ParameterValues(), but for 3D. - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline3parametervalues(pspline3interpolant* p, - ae_int_t* n, - /* Real */ ae_vector* t, - ae_state *_state) -{ - - *n = 0; - ae_vector_clear(t); - - ae_assert(p->n>=2, "PSpline3ParameterValues: internal error!", _state); - *n = p->n; - ae_vector_set_length(t, *n, _state); - ae_v_move(&t->ptr.p_double[0], 1, &p->p.ptr.p_double[0], 1, ae_v_len(0,*n-1)); - t->ptr.p_double[0] = 0; - if( !p->periodic ) - { - t->ptr.p_double[*n-1] = 1; - } -} - - -/************************************************************************* -This function calculates the value of the parametric spline for a given -value of parameter T - -INPUT PARAMETERS: - P - parametric spline interpolant - T - point: - * T in [0,1] corresponds to interval spanned by points - * for non-periodic splines T<0 (or T>1) correspond to parts of - the curve before the first (after the last) point - * for periodic splines T<0 (or T>1) are projected into [0,1] - by making T=T-floor(T). - -OUTPUT PARAMETERS: - X - X-position - Y - Y-position - - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline2calc(pspline2interpolant* p, - double t, - double* x, - double* y, - ae_state *_state) -{ - - *x = 0; - *y = 0; - - if( p->periodic ) - { - t = t-ae_ifloor(t, _state); - } - *x = spline1dcalc(&p->x, t, _state); - *y = spline1dcalc(&p->y, t, _state); -} - - -/************************************************************************* -This function calculates the value of the parametric spline for a given -value of parameter T. - -INPUT PARAMETERS: - P - parametric spline interpolant - T - point: - * T in [0,1] corresponds to interval spanned by points - * for non-periodic splines T<0 (or T>1) correspond to parts of - the curve before the first (after the last) point - * for periodic splines T<0 (or T>1) are projected into [0,1] - by making T=T-floor(T). - -OUTPUT PARAMETERS: - X - X-position - Y - Y-position - Z - Z-position - - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline3calc(pspline3interpolant* p, - double t, - double* x, - double* y, - double* z, - ae_state *_state) -{ - - *x = 0; - *y = 0; - *z = 0; - - if( p->periodic ) - { - t = t-ae_ifloor(t, _state); - } - *x = spline1dcalc(&p->x, t, _state); - *y = spline1dcalc(&p->y, t, _state); - *z = spline1dcalc(&p->z, t, _state); -} - - -/************************************************************************* -This function calculates tangent vector for a given value of parameter T - -INPUT PARAMETERS: - P - parametric spline interpolant - T - point: - * T in [0,1] corresponds to interval spanned by points - * for non-periodic splines T<0 (or T>1) correspond to parts of - the curve before the first (after the last) point - * for periodic splines T<0 (or T>1) are projected into [0,1] - by making T=T-floor(T). - -OUTPUT PARAMETERS: - X - X-component of tangent vector (normalized) - Y - Y-component of tangent vector (normalized) - -NOTE: - X^2+Y^2 is either 1 (for non-zero tangent vector) or 0. - - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline2tangent(pspline2interpolant* p, - double t, - double* x, - double* y, - ae_state *_state) -{ - double v; - double v0; - double v1; - - *x = 0; - *y = 0; - - if( p->periodic ) - { - t = t-ae_ifloor(t, _state); - } - pspline2diff(p, t, &v0, x, &v1, y, _state); - if( ae_fp_neq(*x,0)||ae_fp_neq(*y,0) ) - { - - /* - * this code is a bit more complex than X^2+Y^2 to avoid - * overflow for large values of X and Y. - */ - v = safepythag2(*x, *y, _state); - *x = *x/v; - *y = *y/v; - } -} - - -/************************************************************************* -This function calculates tangent vector for a given value of parameter T - -INPUT PARAMETERS: - P - parametric spline interpolant - T - point: - * T in [0,1] corresponds to interval spanned by points - * for non-periodic splines T<0 (or T>1) correspond to parts of - the curve before the first (after the last) point - * for periodic splines T<0 (or T>1) are projected into [0,1] - by making T=T-floor(T). - -OUTPUT PARAMETERS: - X - X-component of tangent vector (normalized) - Y - Y-component of tangent vector (normalized) - Z - Z-component of tangent vector (normalized) - -NOTE: - X^2+Y^2+Z^2 is either 1 (for non-zero tangent vector) or 0. - - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline3tangent(pspline3interpolant* p, - double t, - double* x, - double* y, - double* z, - ae_state *_state) -{ - double v; - double v0; - double v1; - double v2; - - *x = 0; - *y = 0; - *z = 0; - - if( p->periodic ) - { - t = t-ae_ifloor(t, _state); - } - pspline3diff(p, t, &v0, x, &v1, y, &v2, z, _state); - if( (ae_fp_neq(*x,0)||ae_fp_neq(*y,0))||ae_fp_neq(*z,0) ) - { - v = safepythag3(*x, *y, *z, _state); - *x = *x/v; - *y = *y/v; - *z = *z/v; - } -} - - -/************************************************************************* -This function calculates derivative, i.e. it returns (dX/dT,dY/dT). - -INPUT PARAMETERS: - P - parametric spline interpolant - T - point: - * T in [0,1] corresponds to interval spanned by points - * for non-periodic splines T<0 (or T>1) correspond to parts of - the curve before the first (after the last) point - * for periodic splines T<0 (or T>1) are projected into [0,1] - by making T=T-floor(T). - -OUTPUT PARAMETERS: - X - X-value - DX - X-derivative - Y - Y-value - DY - Y-derivative - - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline2diff(pspline2interpolant* p, - double t, - double* x, - double* dx, - double* y, - double* dy, - ae_state *_state) -{ - double d2s; - - *x = 0; - *dx = 0; - *y = 0; - *dy = 0; - - if( p->periodic ) - { - t = t-ae_ifloor(t, _state); - } - spline1ddiff(&p->x, t, x, dx, &d2s, _state); - spline1ddiff(&p->y, t, y, dy, &d2s, _state); -} - - -/************************************************************************* -This function calculates derivative, i.e. it returns (dX/dT,dY/dT,dZ/dT). - -INPUT PARAMETERS: - P - parametric spline interpolant - T - point: - * T in [0,1] corresponds to interval spanned by points - * for non-periodic splines T<0 (or T>1) correspond to parts of - the curve before the first (after the last) point - * for periodic splines T<0 (or T>1) are projected into [0,1] - by making T=T-floor(T). - -OUTPUT PARAMETERS: - X - X-value - DX - X-derivative - Y - Y-value - DY - Y-derivative - Z - Z-value - DZ - Z-derivative - - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline3diff(pspline3interpolant* p, - double t, - double* x, - double* dx, - double* y, - double* dy, - double* z, - double* dz, - ae_state *_state) -{ - double d2s; - - *x = 0; - *dx = 0; - *y = 0; - *dy = 0; - *z = 0; - *dz = 0; - - if( p->periodic ) - { - t = t-ae_ifloor(t, _state); - } - spline1ddiff(&p->x, t, x, dx, &d2s, _state); - spline1ddiff(&p->y, t, y, dy, &d2s, _state); - spline1ddiff(&p->z, t, z, dz, &d2s, _state); -} - - -/************************************************************************* -This function calculates first and second derivative with respect to T. - -INPUT PARAMETERS: - P - parametric spline interpolant - T - point: - * T in [0,1] corresponds to interval spanned by points - * for non-periodic splines T<0 (or T>1) correspond to parts of - the curve before the first (after the last) point - * for periodic splines T<0 (or T>1) are projected into [0,1] - by making T=T-floor(T). - -OUTPUT PARAMETERS: - X - X-value - DX - derivative - D2X - second derivative - Y - Y-value - DY - derivative - D2Y - second derivative - - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline2diff2(pspline2interpolant* p, - double t, - double* x, - double* dx, - double* d2x, - double* y, - double* dy, - double* d2y, - ae_state *_state) -{ - - *x = 0; - *dx = 0; - *d2x = 0; - *y = 0; - *dy = 0; - *d2y = 0; - - if( p->periodic ) - { - t = t-ae_ifloor(t, _state); - } - spline1ddiff(&p->x, t, x, dx, d2x, _state); - spline1ddiff(&p->y, t, y, dy, d2y, _state); -} - - -/************************************************************************* -This function calculates first and second derivative with respect to T. - -INPUT PARAMETERS: - P - parametric spline interpolant - T - point: - * T in [0,1] corresponds to interval spanned by points - * for non-periodic splines T<0 (or T>1) correspond to parts of - the curve before the first (after the last) point - * for periodic splines T<0 (or T>1) are projected into [0,1] - by making T=T-floor(T). - -OUTPUT PARAMETERS: - X - X-value - DX - derivative - D2X - second derivative - Y - Y-value - DY - derivative - D2Y - second derivative - Z - Z-value - DZ - derivative - D2Z - second derivative - - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline3diff2(pspline3interpolant* p, - double t, - double* x, - double* dx, - double* d2x, - double* y, - double* dy, - double* d2y, - double* z, - double* dz, - double* d2z, - ae_state *_state) -{ - - *x = 0; - *dx = 0; - *d2x = 0; - *y = 0; - *dy = 0; - *d2y = 0; - *z = 0; - *dz = 0; - *d2z = 0; - - if( p->periodic ) - { - t = t-ae_ifloor(t, _state); - } - spline1ddiff(&p->x, t, x, dx, d2x, _state); - spline1ddiff(&p->y, t, y, dy, d2y, _state); - spline1ddiff(&p->z, t, z, dz, d2z, _state); -} - - -/************************************************************************* -This function calculates arc length, i.e. length of curve between t=a -and t=b. - -INPUT PARAMETERS: - P - parametric spline interpolant - A,B - parameter values corresponding to arc ends: - * B>A will result in positive length returned - * Bx, state.x, &sx, &dsx, &d2sx, _state); - spline1ddiff(&p->y, state.x, &sy, &dsy, &d2sy, _state); - state.f = safepythag2(dsx, dsy, _state); - } - autogkresults(&state, &result, &rep, _state); - ae_assert(rep.terminationtype>0, "PSpline2ArcLength: internal error!", _state); - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -This function calculates arc length, i.e. length of curve between t=a -and t=b. - -INPUT PARAMETERS: - P - parametric spline interpolant - A,B - parameter values corresponding to arc ends: - * B>A will result in positive length returned - * Bx, state.x, &sx, &dsx, &d2sx, _state); - spline1ddiff(&p->y, state.x, &sy, &dsy, &d2sy, _state); - spline1ddiff(&p->z, state.x, &sz, &dsz, &d2sz, _state); - state.f = safepythag3(dsx, dsy, dsz, _state); - } - autogkresults(&state, &result, &rep, _state); - ae_assert(rep.terminationtype>0, "PSpline3ArcLength: internal error!", _state); - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Builds non-periodic parameterization for 2-dimensional spline -*************************************************************************/ -static void pspline_pspline2par(/* Real */ ae_matrix* xy, - ae_int_t n, - ae_int_t pt, - /* Real */ ae_vector* p, - ae_state *_state) -{ - double v; - ae_int_t i; - - ae_vector_clear(p); - - ae_assert(pt>=0&&pt<=2, "PSpline2Par: internal error!", _state); - - /* - * Build parameterization: - * * fill by non-normalized values - * * normalize them so we have P[0]=0, P[N-1]=1. - */ - ae_vector_set_length(p, n, _state); - if( pt==0 ) - { - for(i=0; i<=n-1; i++) - { - p->ptr.p_double[i] = i; - } - } - if( pt==1 ) - { - p->ptr.p_double[0] = 0; - for(i=1; i<=n-1; i++) - { - p->ptr.p_double[i] = p->ptr.p_double[i-1]+safepythag2(xy->ptr.pp_double[i][0]-xy->ptr.pp_double[i-1][0], xy->ptr.pp_double[i][1]-xy->ptr.pp_double[i-1][1], _state); - } - } - if( pt==2 ) - { - p->ptr.p_double[0] = 0; - for(i=1; i<=n-1; i++) - { - p->ptr.p_double[i] = p->ptr.p_double[i-1]+ae_sqrt(safepythag2(xy->ptr.pp_double[i][0]-xy->ptr.pp_double[i-1][0], xy->ptr.pp_double[i][1]-xy->ptr.pp_double[i-1][1], _state), _state); - } - } - v = 1/p->ptr.p_double[n-1]; - ae_v_muld(&p->ptr.p_double[0], 1, ae_v_len(0,n-1), v); -} - - -/************************************************************************* -Builds non-periodic parameterization for 3-dimensional spline -*************************************************************************/ -static void pspline_pspline3par(/* Real */ ae_matrix* xy, - ae_int_t n, - ae_int_t pt, - /* Real */ ae_vector* p, - ae_state *_state) -{ - double v; - ae_int_t i; - - ae_vector_clear(p); - - ae_assert(pt>=0&&pt<=2, "PSpline3Par: internal error!", _state); - - /* - * Build parameterization: - * * fill by non-normalized values - * * normalize them so we have P[0]=0, P[N-1]=1. - */ - ae_vector_set_length(p, n, _state); - if( pt==0 ) - { - for(i=0; i<=n-1; i++) - { - p->ptr.p_double[i] = i; - } - } - if( pt==1 ) - { - p->ptr.p_double[0] = 0; - for(i=1; i<=n-1; i++) - { - p->ptr.p_double[i] = p->ptr.p_double[i-1]+safepythag3(xy->ptr.pp_double[i][0]-xy->ptr.pp_double[i-1][0], xy->ptr.pp_double[i][1]-xy->ptr.pp_double[i-1][1], xy->ptr.pp_double[i][2]-xy->ptr.pp_double[i-1][2], _state); - } - } - if( pt==2 ) - { - p->ptr.p_double[0] = 0; - for(i=1; i<=n-1; i++) - { - p->ptr.p_double[i] = p->ptr.p_double[i-1]+ae_sqrt(safepythag3(xy->ptr.pp_double[i][0]-xy->ptr.pp_double[i-1][0], xy->ptr.pp_double[i][1]-xy->ptr.pp_double[i-1][1], xy->ptr.pp_double[i][2]-xy->ptr.pp_double[i-1][2], _state), _state); - } - } - v = 1/p->ptr.p_double[n-1]; - ae_v_muld(&p->ptr.p_double[0], 1, ae_v_len(0,n-1), v); -} - - -ae_bool _pspline2interpolant_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - pspline2interpolant *p = (pspline2interpolant*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->p, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !_spline1dinterpolant_init(&p->x, _state, make_automatic) ) - return ae_false; - if( !_spline1dinterpolant_init(&p->y, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _pspline2interpolant_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - pspline2interpolant *dst = (pspline2interpolant*)_dst; - pspline2interpolant *src = (pspline2interpolant*)_src; - dst->n = src->n; - dst->periodic = src->periodic; - if( !ae_vector_init_copy(&dst->p, &src->p, _state, make_automatic) ) - return ae_false; - if( !_spline1dinterpolant_init_copy(&dst->x, &src->x, _state, make_automatic) ) - return ae_false; - if( !_spline1dinterpolant_init_copy(&dst->y, &src->y, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _pspline2interpolant_clear(void* _p) -{ - pspline2interpolant *p = (pspline2interpolant*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->p); - _spline1dinterpolant_clear(&p->x); - _spline1dinterpolant_clear(&p->y); -} - - -void _pspline2interpolant_destroy(void* _p) -{ - pspline2interpolant *p = (pspline2interpolant*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->p); - _spline1dinterpolant_destroy(&p->x); - _spline1dinterpolant_destroy(&p->y); -} - - -ae_bool _pspline3interpolant_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - pspline3interpolant *p = (pspline3interpolant*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->p, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !_spline1dinterpolant_init(&p->x, _state, make_automatic) ) - return ae_false; - if( !_spline1dinterpolant_init(&p->y, _state, make_automatic) ) - return ae_false; - if( !_spline1dinterpolant_init(&p->z, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _pspline3interpolant_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - pspline3interpolant *dst = (pspline3interpolant*)_dst; - pspline3interpolant *src = (pspline3interpolant*)_src; - dst->n = src->n; - dst->periodic = src->periodic; - if( !ae_vector_init_copy(&dst->p, &src->p, _state, make_automatic) ) - return ae_false; - if( !_spline1dinterpolant_init_copy(&dst->x, &src->x, _state, make_automatic) ) - return ae_false; - if( !_spline1dinterpolant_init_copy(&dst->y, &src->y, _state, make_automatic) ) - return ae_false; - if( !_spline1dinterpolant_init_copy(&dst->z, &src->z, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _pspline3interpolant_clear(void* _p) -{ - pspline3interpolant *p = (pspline3interpolant*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->p); - _spline1dinterpolant_clear(&p->x); - _spline1dinterpolant_clear(&p->y); - _spline1dinterpolant_clear(&p->z); -} - - -void _pspline3interpolant_destroy(void* _p) -{ - pspline3interpolant *p = (pspline3interpolant*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->p); - _spline1dinterpolant_destroy(&p->x); - _spline1dinterpolant_destroy(&p->y); - _spline1dinterpolant_destroy(&p->z); -} - - - - -/************************************************************************* -This function creates RBF model for a scalar (NY=1) or vector (NY>1) -function in a NX-dimensional space (NX=2 or NX=3). - -Newly created model is empty. It can be used for interpolation right after -creation, but it just returns zeros. You have to add points to the model, -tune interpolation settings, and then call model construction function -RBFBuildModel() which will update model according to your specification. - -USAGE: -1. User creates model with RBFCreate() -2. User adds dataset with RBFSetPoints() (points do NOT have to be on a - regular grid) -3. (OPTIONAL) User chooses polynomial term by calling: - * RBFLinTerm() to set linear term - * RBFConstTerm() to set constant term - * RBFZeroTerm() to set zero term - By default, linear term is used. -4. User chooses specific RBF algorithm to use: either QNN (RBFSetAlgoQNN) - or ML (RBFSetAlgoMultiLayer). -5. User calls RBFBuildModel() function which rebuilds model according to - the specification -6. User may call RBFCalc() to calculate model value at the specified point, - RBFGridCalc() to calculate model values at the points of the regular - grid. User may extract model coefficients with RBFUnpack() call. - -INPUT PARAMETERS: - NX - dimension of the space, NX=2 or NX=3 - NY - function dimension, NY>=1 - -OUTPUT PARAMETERS: - S - RBF model (initially equals to zero) - -NOTE 1: memory requirements. RBF models require amount of memory which is - proportional to the number of data points. Memory is allocated - during model construction, but most of this memory is freed after - model coefficients are calculated. - - Some approximate estimates for N centers with default settings are - given below: - * about 250*N*(sizeof(double)+2*sizeof(int)) bytes of memory is - needed during model construction stage. - * about 15*N*sizeof(double) bytes is needed after model is built. - For example, for N=100000 we may need 0.6 GB of memory to build - model, but just about 0.012 GB to store it. - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfcreate(ae_int_t nx, ae_int_t ny, rbfmodel* s, ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - - _rbfmodel_clear(s); - - ae_assert(nx==2||nx==3, "RBFCreate: NX<>2 and NX<>3", _state); - ae_assert(ny>=1, "RBFCreate: NY<1", _state); - s->nx = nx; - s->ny = ny; - s->nl = 0; - s->nc = 0; - ae_matrix_set_length(&s->v, ny, rbf_mxnx+1, _state); - for(i=0; i<=ny-1; i++) - { - for(j=0; j<=rbf_mxnx; j++) - { - s->v.ptr.pp_double[i][j] = 0; - } - } - s->n = 0; - s->rmax = 0; - s->gridtype = 2; - s->fixrad = ae_false; - s->radvalue = 1; - s->radzvalue = 5; - s->aterm = 1; - s->algorithmtype = 1; - - /* - * stopping criteria - */ - s->epsort = rbf_eps; - s->epserr = rbf_eps; - s->maxits = 0; -} - - -/************************************************************************* -This function adds dataset. - -This function overrides results of the previous calls, i.e. multiple calls -of this function will result in only the last set being added. - -INPUT PARAMETERS: - S - RBF model, initialized by RBFCreate() call. - XY - points, array[N,NX+NY]. One row corresponds to one point - in the dataset. First NX elements are coordinates, next - NY elements are function values. Array may be larger than - specific, in this case only leading [N,NX+NY] elements - will be used. - N - number of points in the dataset - -After you've added dataset and (optionally) tuned algorithm settings you -should call RBFBuildModel() in order to build a model for you. - -NOTE: this function has some serialization-related subtleties. We - recommend you to study serialization examples from ALGLIB Reference - Manual if you want to perform serialization of your models. - - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfsetpoints(rbfmodel* s, - /* Real */ ae_matrix* xy, - ae_int_t n, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - - - ae_assert(n>0, "RBFSetPoints: N<0", _state); - ae_assert(xy->rows>=n, "RBFSetPoints: Rows(XY)cols>=s->nx+s->ny, "RBFSetPoints: Cols(XY)n = n; - ae_matrix_set_length(&s->x, s->n, rbf_mxnx, _state); - ae_matrix_set_length(&s->y, s->n, s->ny, _state); - for(i=0; i<=s->n-1; i++) - { - for(j=0; j<=rbf_mxnx-1; j++) - { - s->x.ptr.pp_double[i][j] = 0; - } - for(j=0; j<=s->nx-1; j++) - { - s->x.ptr.pp_double[i][j] = xy->ptr.pp_double[i][j]; - } - for(j=0; j<=s->ny-1; j++) - { - s->y.ptr.pp_double[i][j] = xy->ptr.pp_double[i][j+s->nx]; - } - } -} - - -/************************************************************************* -This function sets RBF interpolation algorithm. ALGLIB supports several -RBF algorithms with different properties. - -This algorithm is called RBF-QNN and it is good for point sets with -following properties: -a) all points are distinct -b) all points are well separated. -c) points distribution is approximately uniform. There is no "contour - lines", clusters of points, or other small-scale structures. - -Algorithm description: -1) interpolation centers are allocated to data points -2) interpolation radii are calculated as distances to the nearest centers - times Q coefficient (where Q is a value from [0.75,1.50]). -3) after performing (2) radii are transformed in order to avoid situation - when single outlier has very large radius and influences many points - across all dataset. Transformation has following form: - new_r[i] = min(r[i],Z*median(r[])) - where r[i] is I-th radius, median() is a median radius across entire - dataset, Z is user-specified value which controls amount of deviation - from median radius. - -When (a) is violated, we will be unable to build RBF model. When (b) or -(c) are violated, model will be built, but interpolation quality will be -low. See http://www.alglib.net/interpolation/ for more information on this -subject. - -This algorithm is used by default. - -Additional Q parameter controls smoothness properties of the RBF basis: -* Q<0.75 will give perfectly conditioned basis, but terrible smoothness - properties (RBF interpolant will have sharp peaks around function values) -* Q around 1.0 gives good balance between smoothness and condition number -* Q>1.5 will lead to badly conditioned systems and slow convergence of the - underlying linear solver (although smoothness will be very good) -* Q>2.0 will effectively make optimizer useless because it won't converge - within reasonable amount of iterations. It is possible to set such large - Q, but it is advised not to do so. - -INPUT PARAMETERS: - S - RBF model, initialized by RBFCreate() call - Q - Q parameter, Q>0, recommended value - 1.0 - Z - Z parameter, Z>0, recommended value - 5.0 - -NOTE: this function has some serialization-related subtleties. We - recommend you to study serialization examples from ALGLIB Reference - Manual if you want to perform serialization of your models. - - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfsetalgoqnn(rbfmodel* s, double q, double z, ae_state *_state) -{ - - - ae_assert(ae_isfinite(q, _state), "RBFSetAlgoQNN: Q is infinite or NAN", _state); - ae_assert(ae_fp_greater(q,0), "RBFSetAlgoQNN: Q<=0", _state); - rbf_rbfgridpoints(s, _state); - rbf_rbfradnn(s, q, z, _state); - s->algorithmtype = 1; -} - - -/************************************************************************* -This function sets RBF interpolation algorithm. ALGLIB supports several -RBF algorithms with different properties. - -This algorithm is called RBF-ML. It builds multilayer RBF model, i.e. -model with subsequently decreasing radii, which allows us to combine -smoothness (due to large radii of the first layers) with exactness (due -to small radii of the last layers) and fast convergence. - -Internally RBF-ML uses many different means of acceleration, from sparse -matrices to KD-trees, which results in algorithm whose working time is -roughly proportional to N*log(N)*Density*RBase^2*NLayers, where N is a -number of points, Density is an average density if points per unit of the -interpolation space, RBase is an initial radius, NLayers is a number of -layers. - -RBF-ML is good for following kinds of interpolation problems: -1. "exact" problems (perfect fit) with well separated points -2. least squares problems with arbitrary distribution of points (algorithm - gives perfect fit where it is possible, and resorts to least squares - fit in the hard areas). -3. noisy problems where we want to apply some controlled amount of - smoothing. - -INPUT PARAMETERS: - S - RBF model, initialized by RBFCreate() call - RBase - RBase parameter, RBase>0 - NLayers - NLayers parameter, NLayers>0, recommended value to start - with - about 5. - LambdaV - regularization value, can be useful when solving problem - in the least squares sense. Optimal lambda is problem- - dependent and require trial and error. In our experience, - good lambda can be as large as 0.1, and you can use 0.001 - as initial guess. - Default value - 0.01, which is used when LambdaV is not - given. You can specify zero value, but it is not - recommended to do so. - -TUNING ALGORITHM - -In order to use this algorithm you have to choose three parameters: -* initial radius RBase -* number of layers in the model NLayers -* regularization coefficient LambdaV - -Initial radius is easy to choose - you can pick any number several times -larger than the average distance between points. Algorithm won't break -down if you choose radius which is too large (model construction time will -increase, but model will be built correctly). - -Choose such number of layers that RLast=RBase/2^(NLayers-1) (radius used -by the last layer) will be smaller than the typical distance between -points. In case model error is too large, you can increase number of -layers. Having more layers will make model construction and evaluation -proportionally slower, but it will allow you to have model which precisely -fits your data. From the other side, if you want to suppress noise, you -can DECREASE number of layers to make your model less flexible. - -Regularization coefficient LambdaV controls smoothness of the individual -models built for each layer. We recommend you to use default value in case -you don't want to tune this parameter, because having non-zero LambdaV -accelerates and stabilizes internal iterative algorithm. In case you want -to suppress noise you can use LambdaV as additional parameter (larger -value = more smoothness) to tune. - -TYPICAL ERRORS - -1. Using initial radius which is too large. Memory requirements of the - RBF-ML are roughly proportional to N*Density*RBase^2 (where Density is - an average density of points per unit of the interpolation space). In - the extreme case of the very large RBase we will need O(N^2) units of - memory - and many layers in order to decrease radius to some reasonably - small value. - -2. Using too small number of layers - RBF models with large radius are not - flexible enough to reproduce small variations in the target function. - You need many layers with different radii, from large to small, in - order to have good model. - -3. Using initial radius which is too small. You will get model with - "holes" in the areas which are too far away from interpolation centers. - However, algorithm will work correctly (and quickly) in this case. - -4. Using too many layers - you will get too large and too slow model. This - model will perfectly reproduce your function, but maybe you will be - able to achieve similar results with less layers (and less memory). - - -- ALGLIB -- - Copyright 02.03.2012 by Bochkanov Sergey -*************************************************************************/ -void rbfsetalgomultilayer(rbfmodel* s, - double rbase, - ae_int_t nlayers, - double lambdav, - ae_state *_state) -{ - - - ae_assert(ae_isfinite(rbase, _state), "RBFSetAlgoMultiLayer: RBase is infinite or NaN", _state); - ae_assert(ae_fp_greater(rbase,0), "RBFSetAlgoMultiLayer: RBase<=0", _state); - ae_assert(nlayers>=0, "RBFSetAlgoMultiLayer: NLayers<0", _state); - ae_assert(ae_isfinite(lambdav, _state), "RBFSetAlgoMultiLayer: LambdaV is infinite or NAN", _state); - ae_assert(ae_fp_greater_eq(lambdav,0), "RBFSetAlgoMultiLayer: LambdaV<0", _state); - s->radvalue = rbase; - s->nlayers = nlayers; - s->algorithmtype = 2; - s->lambdav = lambdav; -} - - -/************************************************************************* -This function sets linear term (model is a sum of radial basis functions -plus linear polynomial). This function won't have effect until next call -to RBFBuildModel(). - -INPUT PARAMETERS: - S - RBF model, initialized by RBFCreate() call - -NOTE: this function has some serialization-related subtleties. We - recommend you to study serialization examples from ALGLIB Reference - Manual if you want to perform serialization of your models. - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfsetlinterm(rbfmodel* s, ae_state *_state) -{ - - - s->aterm = 1; -} - - -/************************************************************************* -This function sets constant term (model is a sum of radial basis functions -plus constant). This function won't have effect until next call to -RBFBuildModel(). - -INPUT PARAMETERS: - S - RBF model, initialized by RBFCreate() call - -NOTE: this function has some serialization-related subtleties. We - recommend you to study serialization examples from ALGLIB Reference - Manual if you want to perform serialization of your models. - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfsetconstterm(rbfmodel* s, ae_state *_state) -{ - - - s->aterm = 2; -} - - -/************************************************************************* -This function sets zero term (model is a sum of radial basis functions -without polynomial term). This function won't have effect until next call -to RBFBuildModel(). - -INPUT PARAMETERS: - S - RBF model, initialized by RBFCreate() call - -NOTE: this function has some serialization-related subtleties. We - recommend you to study serialization examples from ALGLIB Reference - Manual if you want to perform serialization of your models. - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfsetzeroterm(rbfmodel* s, ae_state *_state) -{ - - - s->aterm = 3; -} - - -/************************************************************************* -This function sets stopping criteria of the underlying linear solver. - -INPUT PARAMETERS: - S - RBF model, initialized by RBFCreate() call - EpsOrt - orthogonality stopping criterion, EpsOrt>=0. Algorithm will - stop when ||A'*r||<=EpsOrt where A' is a transpose of the - system matrix, r is a residual vector. - Recommended value of EpsOrt is equal to 1E-6. - This criterion will stop algorithm when we have "bad fit" - situation, i.e. when we should stop in a point with large, - nonzero residual. - EpsErr - residual stopping criterion. Algorithm will stop when - ||r||<=EpsErr*||b||, where r is a residual vector, b is a - right part of the system (function values). - Recommended value of EpsErr is equal to 1E-3 or 1E-6. - This criterion will stop algorithm in a "good fit" - situation when we have near-zero residual near the desired - solution. - MaxIts - this criterion will stop algorithm after MaxIts iterations. - It should be used for debugging purposes only! - Zero MaxIts means that no limit is placed on the number of - iterations. - -We recommend to set moderate non-zero values EpsOrt and EpsErr -simultaneously. Values equal to 10E-6 are good to start with. In case you -need high performance and do not need high precision , you may decrease -EpsErr down to 0.001. However, we do not recommend decreasing EpsOrt. - -As for MaxIts, we recommend to leave it zero unless you know what you do. - -NOTE: this function has some serialization-related subtleties. We - recommend you to study serialization examples from ALGLIB Reference - Manual if you want to perform serialization of your models. - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfsetcond(rbfmodel* s, - double epsort, - double epserr, - ae_int_t maxits, - ae_state *_state) -{ - - - ae_assert(ae_isfinite(epsort, _state)&&ae_fp_greater_eq(epsort,0), "RBFSetCond: EpsOrt is negative, INF or NAN", _state); - ae_assert(ae_isfinite(epserr, _state)&&ae_fp_greater_eq(epserr,0), "RBFSetCond: EpsB is negative, INF or NAN", _state); - ae_assert(maxits>=0, "RBFSetCond: MaxIts is negative", _state); - if( (ae_fp_eq(epsort,0)&&ae_fp_eq(epserr,0))&&maxits==0 ) - { - s->epsort = rbf_eps; - s->epserr = rbf_eps; - s->maxits = 0; - } - else - { - s->epsort = epsort; - s->epserr = epserr; - s->maxits = maxits; - } -} - - -/************************************************************************* -This function builds RBF model and returns report (contains some -information which can be used for evaluation of the algorithm properties). - -Call to this function modifies RBF model by calculating its centers/radii/ -weights and saving them into RBFModel structure. Initially RBFModel -contain zero coefficients, but after call to this function we will have -coefficients which were calculated in order to fit our dataset. - -After you called this function you can call RBFCalc(), RBFGridCalc() and -other model calculation functions. - -INPUT PARAMETERS: - S - RBF model, initialized by RBFCreate() call - Rep - report: - * Rep.TerminationType: - * -5 - non-distinct basis function centers were detected, - interpolation aborted - * -4 - nonconvergence of the internal SVD solver - * 1 - successful termination - Fields are used for debugging purposes: - * Rep.IterationsCount - iterations count of the LSQR solver - * Rep.NMV - number of matrix-vector products - * Rep.ARows - rows count for the system matrix - * Rep.ACols - columns count for the system matrix - * Rep.ANNZ - number of significantly non-zero elements - (elements above some algorithm-determined threshold) - -NOTE: failure to build model will leave current state of the structure -unchanged. - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfbuildmodel(rbfmodel* s, rbfreport* rep, ae_state *_state) -{ - ae_frame _frame_block; - kdtree tree; - kdtree ctree; - ae_vector dist; - ae_vector xcx; - ae_matrix a; - ae_matrix v; - ae_matrix omega; - ae_vector y; - ae_matrix residualy; - ae_vector radius; - ae_matrix xc; - ae_vector mnx; - ae_vector mxx; - ae_vector edge; - ae_vector mxsteps; - ae_int_t nc; - double rmax; - ae_vector tags; - ae_vector ctags; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t k2; - ae_int_t snnz; - ae_vector tmp0; - ae_vector tmp1; - ae_int_t layerscnt; - - ae_frame_make(_state, &_frame_block); - _rbfreport_clear(rep); - _kdtree_init(&tree, _state, ae_true); - _kdtree_init(&ctree, _state, ae_true); - ae_vector_init(&dist, 0, DT_REAL, _state, ae_true); - ae_vector_init(&xcx, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&a, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&v, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&omega, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&y, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&residualy, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&radius, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&xc, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&mnx, 0, DT_REAL, _state, ae_true); - ae_vector_init(&mxx, 0, DT_REAL, _state, ae_true); - ae_vector_init(&edge, 0, DT_REAL, _state, ae_true); - ae_vector_init(&mxsteps, 0, DT_INT, _state, ae_true); - ae_vector_init(&tags, 0, DT_INT, _state, ae_true); - ae_vector_init(&ctags, 0, DT_INT, _state, ae_true); - ae_vector_init(&tmp0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tmp1, 0, DT_REAL, _state, ae_true); - - ae_assert(s->nx==2||s->nx==3, "RBFBuildModel: S.NX<>2 or S.NX<>3!", _state); - - /* - * Quick exit when we have no points - */ - if( s->n==0 ) - { - rep->terminationtype = 1; - rep->iterationscount = 0; - rep->nmv = 0; - rep->arows = 0; - rep->acols = 0; - kdtreebuildtagged(&s->xc, &tags, 0, rbf_mxnx, 0, 2, &s->tree, _state); - ae_matrix_set_length(&s->xc, 0, 0, _state); - ae_matrix_set_length(&s->wr, 0, 0, _state); - s->nc = 0; - s->rmax = 0; - ae_matrix_set_length(&s->v, s->ny, rbf_mxnx+1, _state); - for(i=0; i<=s->ny-1; i++) - { - for(j=0; j<=rbf_mxnx; j++) - { - s->v.ptr.pp_double[i][j] = 0; - } - } - ae_frame_leave(_state); - return; - } - - /* - * General case, N>0 - */ - rep->annz = 0; - rep->iterationscount = 0; - rep->nmv = 0; - ae_vector_set_length(&xcx, rbf_mxnx, _state); - - /* - * First model in a sequence - linear model. - * Residuals from linear regression are stored in the ResidualY variable - * (used later to build RBF models). - */ - ae_matrix_set_length(&residualy, s->n, s->ny, _state); - for(i=0; i<=s->n-1; i++) - { - for(j=0; j<=s->ny-1; j++) - { - residualy.ptr.pp_double[i][j] = s->y.ptr.pp_double[i][j]; - } - } - if( !rbf_buildlinearmodel(&s->x, &residualy, s->n, s->ny, s->aterm, &v, _state) ) - { - rep->terminationtype = -5; - ae_frame_leave(_state); - return; - } - - /* - * Handle special case: multilayer model with NLayers=0. - * Quick exit. - */ - if( s->algorithmtype==2&&s->nlayers==0 ) - { - rep->terminationtype = 1; - rep->iterationscount = 0; - rep->nmv = 0; - rep->arows = 0; - rep->acols = 0; - kdtreebuildtagged(&s->xc, &tags, 0, rbf_mxnx, 0, 2, &s->tree, _state); - ae_matrix_set_length(&s->xc, 0, 0, _state); - ae_matrix_set_length(&s->wr, 0, 0, _state); - s->nc = 0; - s->rmax = 0; - ae_matrix_set_length(&s->v, s->ny, rbf_mxnx+1, _state); - for(i=0; i<=s->ny-1; i++) - { - for(j=0; j<=rbf_mxnx; j++) - { - s->v.ptr.pp_double[i][j] = v.ptr.pp_double[i][j]; - } - } - ae_frame_leave(_state); - return; - } - - /* - * Second model in a sequence - RBF term. - * - * NOTE: assignments below are not necessary, but without them - * MSVC complains about unitialized variables. - */ - nc = 0; - rmax = 0; - layerscnt = 0; - if( s->algorithmtype==1 ) - { - - /* - * Add RBF model. - * This model uses local KD-trees to speed-up nearest neighbor searches. - */ - if( s->gridtype==1 ) - { - ae_vector_set_length(&mxx, s->nx, _state); - ae_vector_set_length(&mnx, s->nx, _state); - ae_vector_set_length(&mxsteps, s->nx, _state); - ae_vector_set_length(&edge, s->nx, _state); - for(i=0; i<=s->nx-1; i++) - { - mxx.ptr.p_double[i] = s->x.ptr.pp_double[0][i]; - mnx.ptr.p_double[i] = s->x.ptr.pp_double[0][i]; - } - for(i=0; i<=s->n-1; i++) - { - for(j=0; j<=s->nx-1; j++) - { - if( ae_fp_less(mxx.ptr.p_double[j],s->x.ptr.pp_double[i][j]) ) - { - mxx.ptr.p_double[j] = s->x.ptr.pp_double[i][j]; - } - if( ae_fp_greater(mnx.ptr.p_double[j],s->x.ptr.pp_double[i][j]) ) - { - mnx.ptr.p_double[j] = s->x.ptr.pp_double[i][j]; - } - } - } - for(i=0; i<=s->nx-1; i++) - { - mxsteps.ptr.p_int[i] = ae_trunc((mxx.ptr.p_double[i]-mnx.ptr.p_double[i])/(2*s->h), _state)+1; - edge.ptr.p_double[i] = (mxx.ptr.p_double[i]+mnx.ptr.p_double[i])/2-s->h*mxsteps.ptr.p_int[i]; - } - nc = 1; - for(i=0; i<=s->nx-1; i++) - { - mxsteps.ptr.p_int[i] = 2*mxsteps.ptr.p_int[i]+1; - nc = nc*mxsteps.ptr.p_int[i]; - } - ae_matrix_set_length(&xc, nc, rbf_mxnx, _state); - if( s->nx==2 ) - { - for(i=0; i<=mxsteps.ptr.p_int[0]-1; i++) - { - for(j=0; j<=mxsteps.ptr.p_int[1]-1; j++) - { - for(k2=0; k2<=rbf_mxnx-1; k2++) - { - xc.ptr.pp_double[i*mxsteps.ptr.p_int[1]+j][k2] = 0; - } - xc.ptr.pp_double[i*mxsteps.ptr.p_int[1]+j][0] = edge.ptr.p_double[0]+s->h*i; - xc.ptr.pp_double[i*mxsteps.ptr.p_int[1]+j][1] = edge.ptr.p_double[1]+s->h*j; - } - } - } - if( s->nx==3 ) - { - for(i=0; i<=mxsteps.ptr.p_int[0]-1; i++) - { - for(j=0; j<=mxsteps.ptr.p_int[1]-1; j++) - { - for(k=0; k<=mxsteps.ptr.p_int[2]-1; k++) - { - for(k2=0; k2<=rbf_mxnx-1; k2++) - { - xc.ptr.pp_double[i*mxsteps.ptr.p_int[1]+j][k2] = 0; - } - xc.ptr.pp_double[(i*mxsteps.ptr.p_int[1]+j)*mxsteps.ptr.p_int[2]+k][0] = edge.ptr.p_double[0]+s->h*i; - xc.ptr.pp_double[(i*mxsteps.ptr.p_int[1]+j)*mxsteps.ptr.p_int[2]+k][1] = edge.ptr.p_double[1]+s->h*j; - xc.ptr.pp_double[(i*mxsteps.ptr.p_int[1]+j)*mxsteps.ptr.p_int[2]+k][2] = edge.ptr.p_double[2]+s->h*k; - } - } - } - } - } - else - { - if( s->gridtype==2 ) - { - nc = s->n; - ae_matrix_set_length(&xc, nc, rbf_mxnx, _state); - for(i=0; i<=nc-1; i++) - { - for(j=0; j<=rbf_mxnx-1; j++) - { - xc.ptr.pp_double[i][j] = s->x.ptr.pp_double[i][j]; - } - } - } - else - { - if( s->gridtype==3 ) - { - nc = s->nc; - ae_matrix_set_length(&xc, nc, rbf_mxnx, _state); - for(i=0; i<=nc-1; i++) - { - for(j=0; j<=rbf_mxnx-1; j++) - { - xc.ptr.pp_double[i][j] = s->xc.ptr.pp_double[i][j]; - } - } - } - else - { - ae_assert(ae_false, "RBFBuildModel: either S.GridType<1 or S.GridType>3!", _state); - } - } - } - rmax = 0; - ae_vector_set_length(&radius, nc, _state); - ae_vector_set_length(&ctags, nc, _state); - for(i=0; i<=nc-1; i++) - { - ctags.ptr.p_int[i] = i; - } - kdtreebuildtagged(&xc, &ctags, nc, rbf_mxnx, 0, 2, &ctree, _state); - if( s->fixrad ) - { - - /* - * Fixed radius - */ - for(i=0; i<=nc-1; i++) - { - radius.ptr.p_double[i] = s->radvalue; - } - rmax = radius.ptr.p_double[0]; - } - else - { - - /* - * Dynamic radius - */ - if( nc==0 ) - { - rmax = 1; - } - else - { - if( nc==1 ) - { - radius.ptr.p_double[0] = s->radvalue; - rmax = radius.ptr.p_double[0]; - } - else - { - - /* - * NC>1, calculate radii using distances to nearest neigbors - */ - for(i=0; i<=nc-1; i++) - { - for(j=0; j<=rbf_mxnx-1; j++) - { - xcx.ptr.p_double[j] = xc.ptr.pp_double[i][j]; - } - if( kdtreequeryknn(&ctree, &xcx, 1, ae_false, _state)>0 ) - { - kdtreequeryresultsdistances(&ctree, &dist, _state); - radius.ptr.p_double[i] = s->radvalue*dist.ptr.p_double[0]; - } - else - { - - /* - * No neighbors found (it will happen when we have only one center). - * Initialize radius with default value. - */ - radius.ptr.p_double[i] = 1.0; - } - } - - /* - * Apply filtering - */ - rvectorsetlengthatleast(&tmp0, nc, _state); - for(i=0; i<=nc-1; i++) - { - tmp0.ptr.p_double[i] = radius.ptr.p_double[i]; - } - tagsortfast(&tmp0, &tmp1, nc, _state); - for(i=0; i<=nc-1; i++) - { - radius.ptr.p_double[i] = ae_minreal(radius.ptr.p_double[i], s->radzvalue*tmp0.ptr.p_double[nc/2], _state); - } - - /* - * Calculate RMax, check that all radii are non-zero - */ - for(i=0; i<=nc-1; i++) - { - rmax = ae_maxreal(rmax, radius.ptr.p_double[i], _state); - } - for(i=0; i<=nc-1; i++) - { - if( ae_fp_eq(radius.ptr.p_double[i],0) ) - { - rep->terminationtype = -5; - ae_frame_leave(_state); - return; - } - } - } - } - } - ivectorsetlengthatleast(&tags, s->n, _state); - for(i=0; i<=s->n-1; i++) - { - tags.ptr.p_int[i] = i; - } - kdtreebuildtagged(&s->x, &tags, s->n, rbf_mxnx, 0, 2, &tree, _state); - rbf_buildrbfmodellsqr(&s->x, &residualy, &xc, &radius, s->n, nc, s->ny, &tree, &ctree, s->epsort, s->epserr, s->maxits, &rep->annz, &snnz, &omega, &rep->terminationtype, &rep->iterationscount, &rep->nmv, _state); - layerscnt = 1; - } - else - { - if( s->algorithmtype==2 ) - { - rmax = s->radvalue; - rbf_buildrbfmlayersmodellsqr(&s->x, &residualy, &xc, s->radvalue, &radius, s->n, &nc, s->ny, s->nlayers, &ctree, 1.0E-6, 1.0E-6, 50, s->lambdav, &rep->annz, &omega, &rep->terminationtype, &rep->iterationscount, &rep->nmv, _state); - layerscnt = s->nlayers; - } - else - { - ae_assert(ae_false, "RBFBuildModel: internal error(AlgorithmType neither 1 nor 2)", _state); - } - } - if( rep->terminationtype<=0 ) - { - ae_frame_leave(_state); - return; - } - - /* - * Model is built - */ - s->nc = nc/layerscnt; - s->rmax = rmax; - s->nl = layerscnt; - ae_matrix_set_length(&s->xc, s->nc, rbf_mxnx, _state); - ae_matrix_set_length(&s->wr, s->nc, 1+s->nl*s->ny, _state); - ae_matrix_set_length(&s->v, s->ny, rbf_mxnx+1, _state); - for(i=0; i<=s->nc-1; i++) - { - for(j=0; j<=rbf_mxnx-1; j++) - { - s->xc.ptr.pp_double[i][j] = xc.ptr.pp_double[i][j]; - } - } - ivectorsetlengthatleast(&tags, s->nc, _state); - for(i=0; i<=s->nc-1; i++) - { - tags.ptr.p_int[i] = i; - } - kdtreebuildtagged(&s->xc, &tags, s->nc, rbf_mxnx, 0, 2, &s->tree, _state); - for(i=0; i<=s->nc-1; i++) - { - s->wr.ptr.pp_double[i][0] = radius.ptr.p_double[i]; - for(k=0; k<=layerscnt-1; k++) - { - for(j=0; j<=s->ny-1; j++) - { - s->wr.ptr.pp_double[i][1+k*s->ny+j] = omega.ptr.pp_double[k*s->nc+i][j]; - } - } - } - for(i=0; i<=s->ny-1; i++) - { - for(j=0; j<=rbf_mxnx; j++) - { - s->v.ptr.pp_double[i][j] = v.ptr.pp_double[i][j]; - } - } - rep->terminationtype = 1; - rep->arows = s->n; - rep->acols = s->nc; - ae_frame_leave(_state); -} - - -/************************************************************************* -This function calculates values of the RBF model in the given point. - -This function should be used when we have NY=1 (scalar function) and NX=2 -(2-dimensional space). If you have 3-dimensional space, use RBFCalc3(). If -you have general situation (NX-dimensional space, NY-dimensional function) -you should use general, less efficient implementation RBFCalc(). - -If you want to calculate function values many times, consider using -RBFGridCalc2(), which is far more efficient than many subsequent calls to -RBFCalc2(). - -This function returns 0.0 when: -* model is not initialized -* NX<>2 - *NY<>1 - -INPUT PARAMETERS: - S - RBF model - X0 - first coordinate, finite number - X1 - second coordinate, finite number - -RESULT: - value of the model or 0.0 (as defined above) - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -double rbfcalc2(rbfmodel* s, double x0, double x1, ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t lx; - ae_int_t tg; - double d2; - double t; - double bfcur; - double rcur; - double result; - - - ae_assert(ae_isfinite(x0, _state), "RBFCalc2: invalid value for X0 (X0 is Inf)!", _state); - ae_assert(ae_isfinite(x1, _state), "RBFCalc2: invalid value for X1 (X1 is Inf)!", _state); - if( s->ny!=1||s->nx!=2 ) - { - result = 0; - return result; - } - result = s->v.ptr.pp_double[0][0]*x0+s->v.ptr.pp_double[0][1]*x1+s->v.ptr.pp_double[0][rbf_mxnx]; - if( s->nc==0 ) - { - return result; - } - rvectorsetlengthatleast(&s->calcbufxcx, rbf_mxnx, _state); - for(i=0; i<=rbf_mxnx-1; i++) - { - s->calcbufxcx.ptr.p_double[i] = 0.0; - } - s->calcbufxcx.ptr.p_double[0] = x0; - s->calcbufxcx.ptr.p_double[1] = x1; - lx = kdtreequeryrnn(&s->tree, &s->calcbufxcx, s->rmax*rbf_rbffarradius, ae_true, _state); - kdtreequeryresultsx(&s->tree, &s->calcbufx, _state); - kdtreequeryresultstags(&s->tree, &s->calcbuftags, _state); - for(i=0; i<=lx-1; i++) - { - tg = s->calcbuftags.ptr.p_int[i]; - d2 = ae_sqr(x0-s->calcbufx.ptr.pp_double[i][0], _state)+ae_sqr(x1-s->calcbufx.ptr.pp_double[i][1], _state); - rcur = s->wr.ptr.pp_double[tg][0]; - bfcur = ae_exp(-d2/(rcur*rcur), _state); - for(j=0; j<=s->nl-1; j++) - { - result = result+bfcur*s->wr.ptr.pp_double[tg][1+j]; - rcur = 0.5*rcur; - t = bfcur*bfcur; - bfcur = t*t; - } - } - return result; -} - - -/************************************************************************* -This function calculates values of the RBF model in the given point. - -This function should be used when we have NY=1 (scalar function) and NX=3 -(3-dimensional space). If you have 2-dimensional space, use RBFCalc2(). If -you have general situation (NX-dimensional space, NY-dimensional function) -you should use general, less efficient implementation RBFCalc(). - -This function returns 0.0 when: -* model is not initialized -* NX<>3 - *NY<>1 - -INPUT PARAMETERS: - S - RBF model - X0 - first coordinate, finite number - X1 - second coordinate, finite number - X2 - third coordinate, finite number - -RESULT: - value of the model or 0.0 (as defined above) - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -double rbfcalc3(rbfmodel* s, - double x0, - double x1, - double x2, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t lx; - ae_int_t tg; - double t; - double rcur; - double bf; - double result; - - - ae_assert(ae_isfinite(x0, _state), "RBFCalc3: invalid value for X0 (X0 is Inf or NaN)!", _state); - ae_assert(ae_isfinite(x1, _state), "RBFCalc3: invalid value for X1 (X1 is Inf or NaN)!", _state); - ae_assert(ae_isfinite(x2, _state), "RBFCalc3: invalid value for X2 (X2 is Inf or NaN)!", _state); - if( s->ny!=1||s->nx!=3 ) - { - result = 0; - return result; - } - result = s->v.ptr.pp_double[0][0]*x0+s->v.ptr.pp_double[0][1]*x1+s->v.ptr.pp_double[0][2]*x2+s->v.ptr.pp_double[0][rbf_mxnx]; - if( s->nc==0 ) - { - return result; - } - - /* - * calculating value for F(X) - */ - rvectorsetlengthatleast(&s->calcbufxcx, rbf_mxnx, _state); - for(i=0; i<=rbf_mxnx-1; i++) - { - s->calcbufxcx.ptr.p_double[i] = 0.0; - } - s->calcbufxcx.ptr.p_double[0] = x0; - s->calcbufxcx.ptr.p_double[1] = x1; - s->calcbufxcx.ptr.p_double[2] = x2; - lx = kdtreequeryrnn(&s->tree, &s->calcbufxcx, s->rmax*rbf_rbffarradius, ae_true, _state); - kdtreequeryresultsx(&s->tree, &s->calcbufx, _state); - kdtreequeryresultstags(&s->tree, &s->calcbuftags, _state); - for(i=0; i<=lx-1; i++) - { - tg = s->calcbuftags.ptr.p_int[i]; - rcur = s->wr.ptr.pp_double[tg][0]; - bf = ae_exp(-(ae_sqr(x0-s->calcbufx.ptr.pp_double[i][0], _state)+ae_sqr(x1-s->calcbufx.ptr.pp_double[i][1], _state)+ae_sqr(x2-s->calcbufx.ptr.pp_double[i][2], _state))/ae_sqr(rcur, _state), _state); - for(j=0; j<=s->nl-1; j++) - { - result = result+bf*s->wr.ptr.pp_double[tg][1+j]; - t = bf*bf; - bf = t*t; - } - } - return result; -} - - -/************************************************************************* -This function calculates values of the RBF model at the given point. - -This is general function which can be used for arbitrary NX (dimension of -the space of arguments) and NY (dimension of the function itself). However -when you have NY=1 you may find more convenient to use RBFCalc2() or -RBFCalc3(). - -This function returns 0.0 when model is not initialized. - -INPUT PARAMETERS: - S - RBF model - X - coordinates, array[NX]. - X may have more than NX elements, in this case only - leading NX will be used. - -OUTPUT PARAMETERS: - Y - function value, array[NY]. Y is out-parameter and - reallocated after call to this function. In case you want - to reuse previously allocated Y, you may use RBFCalcBuf(), - which reallocates Y only when it is too small. - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfcalc(rbfmodel* s, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state) -{ - - ae_vector_clear(y); - - ae_assert(x->cnt>=s->nx, "RBFCalc: Length(X)nx, _state), "RBFCalc: X contains infinite or NaN values", _state); - rbfcalcbuf(s, x, y, _state); -} - - -/************************************************************************* -This function calculates values of the RBF model at the given point. - -Same as RBFCalc(), but does not reallocate Y when in is large enough to -store function values. - -INPUT PARAMETERS: - S - RBF model - X - coordinates, array[NX]. - X may have more than NX elements, in this case only - leading NX will be used. - Y - possibly preallocated array - -OUTPUT PARAMETERS: - Y - function value, array[NY]. Y is not reallocated when it - is larger than NY. - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfcalcbuf(rbfmodel* s, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t lx; - ae_int_t tg; - double t; - double rcur; - double bf; - - - ae_assert(x->cnt>=s->nx, "RBFCalcBuf: Length(X)nx, _state), "RBFCalcBuf: X contains infinite or NaN values", _state); - if( y->cntny ) - { - ae_vector_set_length(y, s->ny, _state); - } - for(i=0; i<=s->ny-1; i++) - { - y->ptr.p_double[i] = s->v.ptr.pp_double[i][rbf_mxnx]; - for(j=0; j<=s->nx-1; j++) - { - y->ptr.p_double[i] = y->ptr.p_double[i]+s->v.ptr.pp_double[i][j]*x->ptr.p_double[j]; - } - } - if( s->nc==0 ) - { - return; - } - rvectorsetlengthatleast(&s->calcbufxcx, rbf_mxnx, _state); - for(i=0; i<=rbf_mxnx-1; i++) - { - s->calcbufxcx.ptr.p_double[i] = 0.0; - } - for(i=0; i<=s->nx-1; i++) - { - s->calcbufxcx.ptr.p_double[i] = x->ptr.p_double[i]; - } - lx = kdtreequeryrnn(&s->tree, &s->calcbufxcx, s->rmax*rbf_rbffarradius, ae_true, _state); - kdtreequeryresultsx(&s->tree, &s->calcbufx, _state); - kdtreequeryresultstags(&s->tree, &s->calcbuftags, _state); - for(i=0; i<=s->ny-1; i++) - { - for(j=0; j<=lx-1; j++) - { - tg = s->calcbuftags.ptr.p_int[j]; - rcur = s->wr.ptr.pp_double[tg][0]; - bf = ae_exp(-(ae_sqr(s->calcbufxcx.ptr.p_double[0]-s->calcbufx.ptr.pp_double[j][0], _state)+ae_sqr(s->calcbufxcx.ptr.p_double[1]-s->calcbufx.ptr.pp_double[j][1], _state)+ae_sqr(s->calcbufxcx.ptr.p_double[2]-s->calcbufx.ptr.pp_double[j][2], _state))/ae_sqr(rcur, _state), _state); - for(k=0; k<=s->nl-1; k++) - { - y->ptr.p_double[i] = y->ptr.p_double[i]+bf*s->wr.ptr.pp_double[tg][1+k*s->ny+i]; - t = bf*bf; - bf = t*t; - } - } - } -} - - -/************************************************************************* -This function calculates values of the RBF model at the regular grid. - -Grid have N0*N1 points, with Point[I,J] = (X0[I], X1[J]) - -This function returns 0.0 when: -* model is not initialized -* NX<>2 - *NY<>1 - -INPUT PARAMETERS: - S - RBF model - X0 - array of grid nodes, first coordinates, array[N0] - N0 - grid size (number of nodes) in the first dimension - X1 - array of grid nodes, second coordinates, array[N1] - N1 - grid size (number of nodes) in the second dimension - -OUTPUT PARAMETERS: - Y - function values, array[N0,N1]. Y is out-variable and - is reallocated by this function. - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfgridcalc2(rbfmodel* s, - /* Real */ ae_vector* x0, - ae_int_t n0, - /* Real */ ae_vector* x1, - ae_int_t n1, - /* Real */ ae_matrix* y, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector cpx0; - ae_vector cpx1; - ae_vector p01; - ae_vector p11; - ae_vector p2; - double rlimit; - double xcnorm2; - ae_int_t hp01; - double hcpx0; - double xc0; - double xc1; - double omega; - double radius; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t d; - ae_int_t i00; - ae_int_t i01; - ae_int_t i10; - ae_int_t i11; - - ae_frame_make(_state, &_frame_block); - ae_matrix_clear(y); - ae_vector_init(&cpx0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&cpx1, 0, DT_REAL, _state, ae_true); - ae_vector_init(&p01, 0, DT_INT, _state, ae_true); - ae_vector_init(&p11, 0, DT_INT, _state, ae_true); - ae_vector_init(&p2, 0, DT_INT, _state, ae_true); - - ae_assert(n0>0, "RBFGridCalc2: invalid value for N0 (N0<=0)!", _state); - ae_assert(n1>0, "RBFGridCalc2: invalid value for N1 (N1<=0)!", _state); - ae_assert(x0->cnt>=n0, "RBFGridCalc2: Length(X0)cnt>=n1, "RBFGridCalc2: Length(X1)ptr.pp_double[i][j] = 0; - } - } - if( (s->ny!=1||s->nx!=2)||s->nc==0 ) - { - ae_frame_leave(_state); - return; - } - - /* - *create and sort arrays - */ - ae_vector_set_length(&cpx0, n0, _state); - for(i=0; i<=n0-1; i++) - { - cpx0.ptr.p_double[i] = x0->ptr.p_double[i]; - } - tagsort(&cpx0, n0, &p01, &p2, _state); - ae_vector_set_length(&cpx1, n1, _state); - for(i=0; i<=n1-1; i++) - { - cpx1.ptr.p_double[i] = x1->ptr.p_double[i]; - } - tagsort(&cpx1, n1, &p11, &p2, _state); - - /* - *calculate function's value - */ - for(i=0; i<=s->nc-1; i++) - { - radius = s->wr.ptr.pp_double[i][0]; - for(d=0; d<=s->nl-1; d++) - { - omega = s->wr.ptr.pp_double[i][1+d]; - rlimit = radius*rbf_rbffarradius; - - /* - *search lower and upper indexes - */ - i00 = lowerbound(&cpx0, n0, s->xc.ptr.pp_double[i][0]-rlimit, _state); - i01 = upperbound(&cpx0, n0, s->xc.ptr.pp_double[i][0]+rlimit, _state); - i10 = lowerbound(&cpx1, n1, s->xc.ptr.pp_double[i][1]-rlimit, _state); - i11 = upperbound(&cpx1, n1, s->xc.ptr.pp_double[i][1]+rlimit, _state); - xc0 = s->xc.ptr.pp_double[i][0]; - xc1 = s->xc.ptr.pp_double[i][1]; - for(j=i00; j<=i01-1; j++) - { - hcpx0 = cpx0.ptr.p_double[j]; - hp01 = p01.ptr.p_int[j]; - for(k=i10; k<=i11-1; k++) - { - xcnorm2 = ae_sqr(hcpx0-xc0, _state)+ae_sqr(cpx1.ptr.p_double[k]-xc1, _state); - if( ae_fp_less_eq(xcnorm2,rlimit*rlimit) ) - { - y->ptr.pp_double[hp01][p11.ptr.p_int[k]] = y->ptr.pp_double[hp01][p11.ptr.p_int[k]]+ae_exp(-xcnorm2/ae_sqr(radius, _state), _state)*omega; - } - } - } - radius = 0.5*radius; - } - } - - /* - *add linear term - */ - for(i=0; i<=n0-1; i++) - { - for(j=0; j<=n1-1; j++) - { - y->ptr.pp_double[i][j] = y->ptr.pp_double[i][j]+s->v.ptr.pp_double[0][0]*x0->ptr.p_double[i]+s->v.ptr.pp_double[0][1]*x1->ptr.p_double[j]+s->v.ptr.pp_double[0][rbf_mxnx]; - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -This function "unpacks" RBF model by extracting its coefficients. - -INPUT PARAMETERS: - S - RBF model - -OUTPUT PARAMETERS: - NX - dimensionality of argument - NY - dimensionality of the target function - XWR - model information, array[NC,NX+NY+1]. - One row of the array corresponds to one basis function: - * first NX columns - coordinates of the center - * next NY columns - weights, one per dimension of the - function being modelled - * last column - radius, same for all dimensions of - the function being modelled - NC - number of the centers - V - polynomial term , array[NY,NX+1]. One row per one - dimension of the function being modelled. First NX - elements are linear coefficients, V[NX] is equal to the - constant part. - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfunpack(rbfmodel* s, - ae_int_t* nx, - ae_int_t* ny, - /* Real */ ae_matrix* xwr, - ae_int_t* nc, - /* Real */ ae_matrix* v, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - double rcur; - - *nx = 0; - *ny = 0; - ae_matrix_clear(xwr); - *nc = 0; - ae_matrix_clear(v); - - *nx = s->nx; - *ny = s->ny; - *nc = s->nc; - - /* - * Fill V - */ - ae_matrix_set_length(v, s->ny, s->nx+1, _state); - for(i=0; i<=s->ny-1; i++) - { - ae_v_move(&v->ptr.pp_double[i][0], 1, &s->v.ptr.pp_double[i][0], 1, ae_v_len(0,s->nx-1)); - v->ptr.pp_double[i][s->nx] = s->v.ptr.pp_double[i][rbf_mxnx]; - } - - /* - * Fill XWR and V - */ - if( *nc*s->nl>0 ) - { - ae_matrix_set_length(xwr, s->nc*s->nl, s->nx+s->ny+1, _state); - for(i=0; i<=s->nc-1; i++) - { - rcur = s->wr.ptr.pp_double[i][0]; - for(j=0; j<=s->nl-1; j++) - { - ae_v_move(&xwr->ptr.pp_double[i*s->nl+j][0], 1, &s->xc.ptr.pp_double[i][0], 1, ae_v_len(0,s->nx-1)); - ae_v_move(&xwr->ptr.pp_double[i*s->nl+j][s->nx], 1, &s->wr.ptr.pp_double[i][1+j*s->ny], 1, ae_v_len(s->nx,s->nx+s->ny-1)); - xwr->ptr.pp_double[i*s->nl+j][s->nx+s->ny] = rcur; - rcur = 0.5*rcur; - } - } - } -} - - -/************************************************************************* -Serializer: allocation - - -- ALGLIB -- - Copyright 02.02.2012 by Bochkanov Sergey -*************************************************************************/ -void rbfalloc(ae_serializer* s, rbfmodel* model, ae_state *_state) -{ - - - - /* - * Header - */ - ae_serializer_alloc_entry(s); - ae_serializer_alloc_entry(s); - - /* - * Data - */ - ae_serializer_alloc_entry(s); - ae_serializer_alloc_entry(s); - ae_serializer_alloc_entry(s); - ae_serializer_alloc_entry(s); - kdtreealloc(s, &model->tree, _state); - allocrealmatrix(s, &model->xc, -1, -1, _state); - allocrealmatrix(s, &model->wr, -1, -1, _state); - ae_serializer_alloc_entry(s); - allocrealmatrix(s, &model->v, -1, -1, _state); -} - - -/************************************************************************* -Serializer: serialization - - -- ALGLIB -- - Copyright 02.02.2012 by Bochkanov Sergey -*************************************************************************/ -void rbfserialize(ae_serializer* s, rbfmodel* model, ae_state *_state) -{ - - - - /* - * Header - */ - ae_serializer_serialize_int(s, getrbfserializationcode(_state), _state); - ae_serializer_serialize_int(s, rbf_rbffirstversion, _state); - - /* - * Data - */ - ae_serializer_serialize_int(s, model->nx, _state); - ae_serializer_serialize_int(s, model->ny, _state); - ae_serializer_serialize_int(s, model->nc, _state); - ae_serializer_serialize_int(s, model->nl, _state); - kdtreeserialize(s, &model->tree, _state); - serializerealmatrix(s, &model->xc, -1, -1, _state); - serializerealmatrix(s, &model->wr, -1, -1, _state); - ae_serializer_serialize_double(s, model->rmax, _state); - serializerealmatrix(s, &model->v, -1, -1, _state); -} - - -/************************************************************************* -Serializer: unserialization - - -- ALGLIB -- - Copyright 02.02.2012 by Bochkanov Sergey -*************************************************************************/ -void rbfunserialize(ae_serializer* s, rbfmodel* model, ae_state *_state) -{ - ae_int_t i0; - ae_int_t i1; - ae_int_t nx; - ae_int_t ny; - - _rbfmodel_clear(model); - - - /* - * Header - */ - ae_serializer_unserialize_int(s, &i0, _state); - ae_assert(i0==getrbfserializationcode(_state), "RBFUnserialize: stream header corrupted", _state); - ae_serializer_unserialize_int(s, &i1, _state); - ae_assert(i1==rbf_rbffirstversion, "RBFUnserialize: stream header corrupted", _state); - - /* - * Unserialize primary model parameters, initialize model. - * - * It is necessary to call RBFCreate() because some internal fields - * which are NOT unserialized will need initialization. - */ - ae_serializer_unserialize_int(s, &nx, _state); - ae_serializer_unserialize_int(s, &ny, _state); - rbfcreate(nx, ny, model, _state); - ae_serializer_unserialize_int(s, &model->nc, _state); - ae_serializer_unserialize_int(s, &model->nl, _state); - kdtreeunserialize(s, &model->tree, _state); - unserializerealmatrix(s, &model->xc, _state); - unserializerealmatrix(s, &model->wr, _state); - ae_serializer_unserialize_double(s, &model->rmax, _state); - unserializerealmatrix(s, &model->v, _state); -} - - -/************************************************************************* -This function changes centers allocation algorithm to one which allocates -centers exactly at the dataset points (one input point = one center). This -function won't have effect until next call to RBFBuildModel(). - -INPUT PARAMETERS: - S - RBF model, initialized by RBFCreate() call - -NOTE: this function has some serialization-related subtleties. We - recommend you to study serialization examples from ALGLIB Reference - Manual if you want to perform serialization of your models. - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -static void rbf_rbfgridpoints(rbfmodel* s, ae_state *_state) -{ - - - s->gridtype = 2; -} - - -/************************************************************************* -This function changes radii calculation algorithm to one which makes -radius for I-th node equal to R[i]=DistNN[i]*Q, where: -* R[i] is a radius calculated by the algorithm -* DistNN[i] is distance from I-th center to its nearest neighbor center -* Q is a scale parameter, which should be within [0.75,1.50], with - recommended value equal to 1.0 -* after performing radii calculation, radii are transformed in order to - avoid situation when single outlier has very large radius and influences - many points across entire dataset. Transformation has following form: - new_r[i] = min(r[i],Z*median(r[])) - where r[i] is I-th radius, median() is a median radius across entire - dataset, Z is user-specified value which controls amount of deviation - from median radius. - -This function won't have effect until next call to RBFBuildModel(). - -The idea behind this algorithm is to choose radii corresponding to basis -functions is such way that I-th radius is approximately equal to distance -from I-th center to its nearest neighbor. In this case interactions with -distant points will be insignificant, and we will get well conditioned -basis. - -Properties of this basis depend on the value of Q: -* Q<0.75 will give perfectly conditioned basis, but terrible smoothness - properties (RBF interpolant will have sharp peaks around function values) -* Q>1.5 will lead to badly conditioned systems and slow convergence of the - underlying linear solver (although smoothness will be very good) -* Q around 1.0 gives good balance between smoothness and condition number - - -INPUT PARAMETERS: - S - RBF model, initialized by RBFCreate() call - Q - radius coefficient, Q>0 - Z - z-parameter, Z>0 - -Default value of Q is equal to 1.0 -Default value of Z is equal to 5.0 - -NOTE: this function has some serialization-related subtleties. We - recommend you to study serialization examples from ALGLIB Reference - Manual if you want to perform serialization of your models. - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -static void rbf_rbfradnn(rbfmodel* s, - double q, - double z, - ae_state *_state) -{ - - - ae_assert(ae_isfinite(q, _state)&&ae_fp_greater(q,0), "RBFRadNN: Q<=0, infinite or NAN", _state); - ae_assert(ae_isfinite(z, _state)&&ae_fp_greater(z,0), "RBFRadNN: Z<=0, infinite or NAN", _state); - s->fixrad = ae_false; - s->radvalue = q; - s->radzvalue = z; -} - - -static ae_bool rbf_buildlinearmodel(/* Real */ ae_matrix* x, - /* Real */ ae_matrix* y, - ae_int_t n, - ae_int_t ny, - ae_int_t modeltype, - /* Real */ ae_matrix* v, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector tmpy; - ae_matrix a; - double scaling; - ae_vector shifting; - double mn; - double mx; - ae_vector c; - lsfitreport rep; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t info; - ae_bool result; - - ae_frame_make(_state, &_frame_block); - ae_matrix_clear(v); - ae_vector_init(&tmpy, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&a, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&shifting, 0, DT_REAL, _state, ae_true); - ae_vector_init(&c, 0, DT_REAL, _state, ae_true); - _lsfitreport_init(&rep, _state, ae_true); - - ae_assert(n>=0, "BuildLinearModel: N<0", _state); - ae_assert(ny>0, "BuildLinearModel: NY<=0", _state); - - /* - * Handle degenerate case (N=0) - */ - result = ae_true; - ae_matrix_set_length(v, ny, rbf_mxnx+1, _state); - if( n==0 ) - { - for(j=0; j<=rbf_mxnx; j++) - { - for(i=0; i<=ny-1; i++) - { - v->ptr.pp_double[i][j] = 0; - } - } - ae_frame_leave(_state); - return result; - } - - /* - * Allocate temporaries - */ - ae_vector_set_length(&tmpy, n, _state); - - /* - * General linear model. - */ - if( modeltype==1 ) - { - - /* - * Calculate scaling/shifting, transform variables, prepare LLS problem - */ - ae_matrix_set_length(&a, n, rbf_mxnx+1, _state); - ae_vector_set_length(&shifting, rbf_mxnx, _state); - scaling = 0; - for(i=0; i<=rbf_mxnx-1; i++) - { - mn = x->ptr.pp_double[0][i]; - mx = mn; - for(j=1; j<=n-1; j++) - { - if( ae_fp_greater(mn,x->ptr.pp_double[j][i]) ) - { - mn = x->ptr.pp_double[j][i]; - } - if( ae_fp_less(mx,x->ptr.pp_double[j][i]) ) - { - mx = x->ptr.pp_double[j][i]; - } - } - scaling = ae_maxreal(scaling, mx-mn, _state); - shifting.ptr.p_double[i] = 0.5*(mx+mn); - } - if( ae_fp_eq(scaling,0) ) - { - scaling = 1; - } - else - { - scaling = 0.5*scaling; - } - for(i=0; i<=n-1; i++) - { - for(j=0; j<=rbf_mxnx-1; j++) - { - a.ptr.pp_double[i][j] = (x->ptr.pp_double[i][j]-shifting.ptr.p_double[j])/scaling; - } - } - for(i=0; i<=n-1; i++) - { - a.ptr.pp_double[i][rbf_mxnx] = 1; - } - - /* - * Solve linear system in transformed variables, make backward - */ - for(i=0; i<=ny-1; i++) - { - for(j=0; j<=n-1; j++) - { - tmpy.ptr.p_double[j] = y->ptr.pp_double[j][i]; - } - lsfitlinear(&tmpy, &a, n, rbf_mxnx+1, &info, &c, &rep, _state); - if( info<=0 ) - { - result = ae_false; - ae_frame_leave(_state); - return result; - } - for(j=0; j<=rbf_mxnx-1; j++) - { - v->ptr.pp_double[i][j] = c.ptr.p_double[j]/scaling; - } - v->ptr.pp_double[i][rbf_mxnx] = c.ptr.p_double[rbf_mxnx]; - for(j=0; j<=rbf_mxnx-1; j++) - { - v->ptr.pp_double[i][rbf_mxnx] = v->ptr.pp_double[i][rbf_mxnx]-shifting.ptr.p_double[j]*v->ptr.pp_double[i][j]; - } - for(j=0; j<=n-1; j++) - { - for(k=0; k<=rbf_mxnx-1; k++) - { - y->ptr.pp_double[j][i] = y->ptr.pp_double[j][i]-x->ptr.pp_double[j][k]*v->ptr.pp_double[i][k]; - } - y->ptr.pp_double[j][i] = y->ptr.pp_double[j][i]-v->ptr.pp_double[i][rbf_mxnx]; - } - } - ae_frame_leave(_state); - return result; - } - - /* - * Constant model, very simple - */ - if( modeltype==2 ) - { - for(i=0; i<=ny-1; i++) - { - for(j=0; j<=rbf_mxnx; j++) - { - v->ptr.pp_double[i][j] = 0; - } - for(j=0; j<=n-1; j++) - { - v->ptr.pp_double[i][rbf_mxnx] = v->ptr.pp_double[i][rbf_mxnx]+y->ptr.pp_double[j][i]; - } - if( n>0 ) - { - v->ptr.pp_double[i][rbf_mxnx] = v->ptr.pp_double[i][rbf_mxnx]/n; - } - for(j=0; j<=n-1; j++) - { - y->ptr.pp_double[j][i] = y->ptr.pp_double[j][i]-v->ptr.pp_double[i][rbf_mxnx]; - } - } - ae_frame_leave(_state); - return result; - } - - /* - * Zero model - */ - ae_assert(modeltype==3, "BuildLinearModel: unknown model type", _state); - for(i=0; i<=ny-1; i++) - { - for(j=0; j<=rbf_mxnx; j++) - { - v->ptr.pp_double[i][j] = 0; - } - } - ae_frame_leave(_state); - return result; -} - - -static void rbf_buildrbfmodellsqr(/* Real */ ae_matrix* x, - /* Real */ ae_matrix* y, - /* Real */ ae_matrix* xc, - /* Real */ ae_vector* r, - ae_int_t n, - ae_int_t nc, - ae_int_t ny, - kdtree* pointstree, - kdtree* centerstree, - double epsort, - double epserr, - ae_int_t maxits, - ae_int_t* gnnz, - ae_int_t* snnz, - /* Real */ ae_matrix* w, - ae_int_t* info, - ae_int_t* iterationscount, - ae_int_t* nmv, - ae_state *_state) -{ - ae_frame _frame_block; - linlsqrstate state; - linlsqrreport lsqrrep; - sparsematrix spg; - sparsematrix sps; - ae_vector nearcenterscnt; - ae_vector nearpointscnt; - ae_vector skipnearpointscnt; - ae_vector farpointscnt; - ae_int_t maxnearcenterscnt; - ae_int_t maxnearpointscnt; - ae_int_t maxfarpointscnt; - ae_int_t sumnearcenterscnt; - ae_int_t sumnearpointscnt; - ae_int_t sumfarpointscnt; - double maxrad; - ae_vector pointstags; - ae_vector centerstags; - ae_matrix nearpoints; - ae_matrix nearcenters; - ae_matrix farpoints; - ae_int_t tmpi; - ae_int_t pointscnt; - ae_int_t centerscnt; - ae_vector xcx; - ae_vector tmpy; - ae_vector tc; - ae_vector g; - ae_vector c; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t sind; - ae_matrix a; - double vv; - double vx; - double vy; - double vz; - double vr; - double gnorm2; - ae_vector tmp0; - ae_vector tmp1; - ae_vector tmp2; - double fx; - ae_matrix xx; - ae_matrix cx; - double mrad; - - ae_frame_make(_state, &_frame_block); - *gnnz = 0; - *snnz = 0; - ae_matrix_clear(w); - *info = 0; - *iterationscount = 0; - *nmv = 0; - _linlsqrstate_init(&state, _state, ae_true); - _linlsqrreport_init(&lsqrrep, _state, ae_true); - _sparsematrix_init(&spg, _state, ae_true); - _sparsematrix_init(&sps, _state, ae_true); - ae_vector_init(&nearcenterscnt, 0, DT_INT, _state, ae_true); - ae_vector_init(&nearpointscnt, 0, DT_INT, _state, ae_true); - ae_vector_init(&skipnearpointscnt, 0, DT_INT, _state, ae_true); - ae_vector_init(&farpointscnt, 0, DT_INT, _state, ae_true); - ae_vector_init(&pointstags, 0, DT_INT, _state, ae_true); - ae_vector_init(¢erstags, 0, DT_INT, _state, ae_true); - ae_matrix_init(&nearpoints, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&nearcenters, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&farpoints, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&xcx, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tmpy, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tc, 0, DT_REAL, _state, ae_true); - ae_vector_init(&g, 0, DT_REAL, _state, ae_true); - ae_vector_init(&c, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&a, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tmp0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tmp1, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tmp2, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&xx, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&cx, 0, 0, DT_REAL, _state, ae_true); - - - /* - * Handle special cases: NC=0 - */ - if( nc==0 ) - { - *info = 1; - *iterationscount = 0; - *nmv = 0; - ae_frame_leave(_state); - return; - } - - /* - * Prepare for general case, NC>0 - */ - ae_vector_set_length(&xcx, rbf_mxnx, _state); - ae_vector_set_length(&pointstags, n, _state); - ae_vector_set_length(¢erstags, nc, _state); - *info = -1; - *iterationscount = 0; - *nmv = 0; - - /* - * This block prepares quantities used to compute approximate cardinal basis functions (ACBFs): - * * NearCentersCnt[] - array[NC], whose elements store number of near centers used to build ACBF - * * NearPointsCnt[] - array[NC], number of near points used to build ACBF - * * FarPointsCnt[] - array[NC], number of far points (ones where ACBF is nonzero) - * * MaxNearCentersCnt - max(NearCentersCnt) - * * MaxNearPointsCnt - max(NearPointsCnt) - * * SumNearCentersCnt - sum(NearCentersCnt) - * * SumNearPointsCnt - sum(NearPointsCnt) - * * SumFarPointsCnt - sum(FarPointsCnt) - */ - ae_vector_set_length(&nearcenterscnt, nc, _state); - ae_vector_set_length(&nearpointscnt, nc, _state); - ae_vector_set_length(&skipnearpointscnt, nc, _state); - ae_vector_set_length(&farpointscnt, nc, _state); - maxnearcenterscnt = 0; - maxnearpointscnt = 0; - maxfarpointscnt = 0; - sumnearcenterscnt = 0; - sumnearpointscnt = 0; - sumfarpointscnt = 0; - for(i=0; i<=nc-1; i++) - { - for(j=0; j<=rbf_mxnx-1; j++) - { - xcx.ptr.p_double[j] = xc->ptr.pp_double[i][j]; - } - - /* - * Determine number of near centers and maximum radius of near centers - */ - nearcenterscnt.ptr.p_int[i] = kdtreequeryrnn(centerstree, &xcx, r->ptr.p_double[i]*rbf_rbfnearradius, ae_true, _state); - kdtreequeryresultstags(centerstree, ¢erstags, _state); - maxrad = 0; - for(j=0; j<=nearcenterscnt.ptr.p_int[i]-1; j++) - { - maxrad = ae_maxreal(maxrad, ae_fabs(r->ptr.p_double[centerstags.ptr.p_int[j]], _state), _state); - } - - /* - * Determine number of near points (ones which used to build ACBF) - * and skipped points (the most near points which are NOT used to build ACBF - * and are NOT included in the near points count - */ - skipnearpointscnt.ptr.p_int[i] = kdtreequeryrnn(pointstree, &xcx, 0.1*r->ptr.p_double[i], ae_true, _state); - nearpointscnt.ptr.p_int[i] = kdtreequeryrnn(pointstree, &xcx, (r->ptr.p_double[i]+maxrad)*rbf_rbfnearradius, ae_true, _state)-skipnearpointscnt.ptr.p_int[i]; - ae_assert(nearpointscnt.ptr.p_int[i]>=0, "BuildRBFModelLSQR: internal error", _state); - - /* - * Determine number of far points - */ - farpointscnt.ptr.p_int[i] = kdtreequeryrnn(pointstree, &xcx, ae_maxreal(r->ptr.p_double[i]*rbf_rbfnearradius+maxrad*rbf_rbffarradius, r->ptr.p_double[i]*rbf_rbffarradius, _state), ae_true, _state); - - /* - * calculate sum and max, make some basic checks - */ - ae_assert(nearcenterscnt.ptr.p_int[i]>0, "BuildRBFModelLSQR: internal error", _state); - maxnearcenterscnt = ae_maxint(maxnearcenterscnt, nearcenterscnt.ptr.p_int[i], _state); - maxnearpointscnt = ae_maxint(maxnearpointscnt, nearpointscnt.ptr.p_int[i], _state); - maxfarpointscnt = ae_maxint(maxfarpointscnt, farpointscnt.ptr.p_int[i], _state); - sumnearcenterscnt = sumnearcenterscnt+nearcenterscnt.ptr.p_int[i]; - sumnearpointscnt = sumnearpointscnt+nearpointscnt.ptr.p_int[i]; - sumfarpointscnt = sumfarpointscnt+farpointscnt.ptr.p_int[i]; - } - *snnz = sumnearcenterscnt; - *gnnz = sumfarpointscnt; - ae_assert(maxnearcenterscnt>0, "BuildRBFModelLSQR: internal error", _state); - - /* - * Allocate temporaries. - * - * NOTE: we want to avoid allocation of zero-size arrays, so we - * use max(desired_size,1) instead of desired_size when performing - * memory allocation. - */ - ae_matrix_set_length(&a, maxnearpointscnt+maxnearcenterscnt, maxnearcenterscnt, _state); - ae_vector_set_length(&tmpy, maxnearpointscnt+maxnearcenterscnt, _state); - ae_vector_set_length(&g, maxnearcenterscnt, _state); - ae_vector_set_length(&c, maxnearcenterscnt, _state); - ae_matrix_set_length(&nearcenters, maxnearcenterscnt, rbf_mxnx, _state); - ae_matrix_set_length(&nearpoints, ae_maxint(maxnearpointscnt, 1, _state), rbf_mxnx, _state); - ae_matrix_set_length(&farpoints, ae_maxint(maxfarpointscnt, 1, _state), rbf_mxnx, _state); - - /* - * fill matrix SpG - */ - sparsecreate(n, nc, *gnnz, &spg, _state); - sparsecreate(nc, nc, *snnz, &sps, _state); - for(i=0; i<=nc-1; i++) - { - centerscnt = nearcenterscnt.ptr.p_int[i]; - - /* - * main center - */ - for(j=0; j<=rbf_mxnx-1; j++) - { - xcx.ptr.p_double[j] = xc->ptr.pp_double[i][j]; - } - - /* - * center's tree - */ - tmpi = kdtreequeryknn(centerstree, &xcx, centerscnt, ae_true, _state); - ae_assert(tmpi==centerscnt, "BuildRBFModelLSQR: internal error", _state); - kdtreequeryresultsx(centerstree, &cx, _state); - kdtreequeryresultstags(centerstree, ¢erstags, _state); - - /* - * point's tree - */ - mrad = 0; - for(j=0; j<=centerscnt-1; j++) - { - mrad = ae_maxreal(mrad, r->ptr.p_double[centerstags.ptr.p_int[j]], _state); - } - - /* - * we need to be sure that 'CTree' contains - * at least one side center - */ - sparseset(&sps, i, i, 1, _state); - c.ptr.p_double[0] = 1.0; - for(j=1; j<=centerscnt-1; j++) - { - c.ptr.p_double[j] = 0.0; - } - if( centerscnt>1&&nearpointscnt.ptr.p_int[i]>0 ) - { - - /* - * first KDTree request for points - */ - pointscnt = nearpointscnt.ptr.p_int[i]; - tmpi = kdtreequeryknn(pointstree, &xcx, skipnearpointscnt.ptr.p_int[i]+nearpointscnt.ptr.p_int[i], ae_true, _state); - ae_assert(tmpi==skipnearpointscnt.ptr.p_int[i]+nearpointscnt.ptr.p_int[i], "BuildRBFModelLSQR: internal error", _state); - kdtreequeryresultsx(pointstree, &xx, _state); - sind = skipnearpointscnt.ptr.p_int[i]; - for(j=0; j<=pointscnt-1; j++) - { - vx = xx.ptr.pp_double[sind+j][0]; - vy = xx.ptr.pp_double[sind+j][1]; - vz = xx.ptr.pp_double[sind+j][2]; - for(k=0; k<=centerscnt-1; k++) - { - vr = 0.0; - vv = vx-cx.ptr.pp_double[k][0]; - vr = vr+vv*vv; - vv = vy-cx.ptr.pp_double[k][1]; - vr = vr+vv*vv; - vv = vz-cx.ptr.pp_double[k][2]; - vr = vr+vv*vv; - vv = r->ptr.p_double[centerstags.ptr.p_int[k]]; - a.ptr.pp_double[j][k] = ae_exp(-vr/(vv*vv), _state); - } - } - for(j=0; j<=centerscnt-1; j++) - { - g.ptr.p_double[j] = ae_exp(-(ae_sqr(xcx.ptr.p_double[0]-cx.ptr.pp_double[j][0], _state)+ae_sqr(xcx.ptr.p_double[1]-cx.ptr.pp_double[j][1], _state)+ae_sqr(xcx.ptr.p_double[2]-cx.ptr.pp_double[j][2], _state))/ae_sqr(r->ptr.p_double[centerstags.ptr.p_int[j]], _state), _state); - } - - /* - * calculate the problem - */ - gnorm2 = ae_v_dotproduct(&g.ptr.p_double[0], 1, &g.ptr.p_double[0], 1, ae_v_len(0,centerscnt-1)); - for(j=0; j<=pointscnt-1; j++) - { - vv = ae_v_dotproduct(&a.ptr.pp_double[j][0], 1, &g.ptr.p_double[0], 1, ae_v_len(0,centerscnt-1)); - vv = vv/gnorm2; - tmpy.ptr.p_double[j] = -vv; - ae_v_subd(&a.ptr.pp_double[j][0], 1, &g.ptr.p_double[0], 1, ae_v_len(0,centerscnt-1), vv); - } - for(j=pointscnt; j<=pointscnt+centerscnt-1; j++) - { - for(k=0; k<=centerscnt-1; k++) - { - a.ptr.pp_double[j][k] = 0.0; - } - a.ptr.pp_double[j][j-pointscnt] = 1.0E-6; - tmpy.ptr.p_double[j] = 0.0; - } - fblssolvels(&a, &tmpy, pointscnt+centerscnt, centerscnt, &tmp0, &tmp1, &tmp2, _state); - ae_v_move(&c.ptr.p_double[0], 1, &tmpy.ptr.p_double[0], 1, ae_v_len(0,centerscnt-1)); - vv = ae_v_dotproduct(&g.ptr.p_double[0], 1, &c.ptr.p_double[0], 1, ae_v_len(0,centerscnt-1)); - vv = vv/gnorm2; - ae_v_subd(&c.ptr.p_double[0], 1, &g.ptr.p_double[0], 1, ae_v_len(0,centerscnt-1), vv); - vv = 1/gnorm2; - ae_v_addd(&c.ptr.p_double[0], 1, &g.ptr.p_double[0], 1, ae_v_len(0,centerscnt-1), vv); - for(j=0; j<=centerscnt-1; j++) - { - sparseset(&sps, i, centerstags.ptr.p_int[j], c.ptr.p_double[j], _state); - } - } - - /* - * second KDTree request for points - */ - pointscnt = farpointscnt.ptr.p_int[i]; - tmpi = kdtreequeryknn(pointstree, &xcx, pointscnt, ae_true, _state); - ae_assert(tmpi==pointscnt, "BuildRBFModelLSQR: internal error", _state); - kdtreequeryresultsx(pointstree, &xx, _state); - kdtreequeryresultstags(pointstree, &pointstags, _state); - - /* - *fill SpG matrix - */ - for(j=0; j<=pointscnt-1; j++) - { - fx = 0; - vx = xx.ptr.pp_double[j][0]; - vy = xx.ptr.pp_double[j][1]; - vz = xx.ptr.pp_double[j][2]; - for(k=0; k<=centerscnt-1; k++) - { - vr = 0.0; - vv = vx-cx.ptr.pp_double[k][0]; - vr = vr+vv*vv; - vv = vy-cx.ptr.pp_double[k][1]; - vr = vr+vv*vv; - vv = vz-cx.ptr.pp_double[k][2]; - vr = vr+vv*vv; - vv = r->ptr.p_double[centerstags.ptr.p_int[k]]; - vv = vv*vv; - fx = fx+c.ptr.p_double[k]*ae_exp(-vr/vv, _state); - } - sparseset(&spg, pointstags.ptr.p_int[j], i, fx, _state); - } - } - sparseconverttocrs(&spg, _state); - sparseconverttocrs(&sps, _state); - - /* - * solve by LSQR method - */ - ae_vector_set_length(&tmpy, n, _state); - ae_vector_set_length(&tc, nc, _state); - ae_matrix_set_length(w, nc, ny, _state); - linlsqrcreate(n, nc, &state, _state); - linlsqrsetcond(&state, epsort, epserr, maxits, _state); - for(i=0; i<=ny-1; i++) - { - for(j=0; j<=n-1; j++) - { - tmpy.ptr.p_double[j] = y->ptr.pp_double[j][i]; - } - linlsqrsolvesparse(&state, &spg, &tmpy, _state); - linlsqrresults(&state, &c, &lsqrrep, _state); - if( lsqrrep.terminationtype<=0 ) - { - *info = -4; - ae_frame_leave(_state); - return; - } - sparsemtv(&sps, &c, &tc, _state); - for(j=0; j<=nc-1; j++) - { - w->ptr.pp_double[j][i] = tc.ptr.p_double[j]; - } - *iterationscount = *iterationscount+lsqrrep.iterationscount; - *nmv = *nmv+lsqrrep.nmv; - } - *info = 1; - ae_frame_leave(_state); -} - - -static void rbf_buildrbfmlayersmodellsqr(/* Real */ ae_matrix* x, - /* Real */ ae_matrix* y, - /* Real */ ae_matrix* xc, - double rval, - /* Real */ ae_vector* r, - ae_int_t n, - ae_int_t* nc, - ae_int_t ny, - ae_int_t nlayers, - kdtree* centerstree, - double epsort, - double epserr, - ae_int_t maxits, - double lambdav, - ae_int_t* annz, - /* Real */ ae_matrix* w, - ae_int_t* info, - ae_int_t* iterationscount, - ae_int_t* nmv, - ae_state *_state) -{ - ae_frame _frame_block; - linlsqrstate state; - linlsqrreport lsqrrep; - sparsematrix spa; - double anorm; - ae_vector omega; - ae_vector xx; - ae_vector tmpy; - ae_matrix cx; - double yval; - ae_int_t nec; - ae_vector centerstags; - ae_int_t layer; - ae_int_t i; - ae_int_t j; - ae_int_t k; - double v; - double rmaxbefore; - double rmaxafter; - - ae_frame_make(_state, &_frame_block); - ae_matrix_clear(xc); - ae_vector_clear(r); - *nc = 0; - *annz = 0; - ae_matrix_clear(w); - *info = 0; - *iterationscount = 0; - *nmv = 0; - _linlsqrstate_init(&state, _state, ae_true); - _linlsqrreport_init(&lsqrrep, _state, ae_true); - _sparsematrix_init(&spa, _state, ae_true); - ae_vector_init(&omega, 0, DT_REAL, _state, ae_true); - ae_vector_init(&xx, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tmpy, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&cx, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(¢erstags, 0, DT_INT, _state, ae_true); - - ae_assert(nlayers>=0, "BuildRBFMLayersModelLSQR: invalid argument(NLayers<0)", _state); - ae_assert(n>=0, "BuildRBFMLayersModelLSQR: invalid argument(N<0)", _state); - ae_assert(rbf_mxnx>0&&rbf_mxnx<=3, "BuildRBFMLayersModelLSQR: internal error(invalid global const MxNX: either MxNX<=0 or MxNX>3)", _state); - *annz = 0; - if( n==0||nlayers==0 ) - { - *info = 1; - *iterationscount = 0; - *nmv = 0; - ae_frame_leave(_state); - return; - } - *nc = n*nlayers; - ae_vector_set_length(&xx, rbf_mxnx, _state); - ae_vector_set_length(¢erstags, n, _state); - ae_matrix_set_length(xc, *nc, rbf_mxnx, _state); - ae_vector_set_length(r, *nc, _state); - for(i=0; i<=*nc-1; i++) - { - for(j=0; j<=rbf_mxnx-1; j++) - { - xc->ptr.pp_double[i][j] = x->ptr.pp_double[i%n][j]; - } - } - for(i=0; i<=*nc-1; i++) - { - r->ptr.p_double[i] = rval/ae_pow(2, i/n, _state); - } - for(i=0; i<=n-1; i++) - { - centerstags.ptr.p_int[i] = i; - } - kdtreebuildtagged(xc, ¢erstags, n, rbf_mxnx, 0, 2, centerstree, _state); - ae_vector_set_length(&omega, n, _state); - ae_vector_set_length(&tmpy, n, _state); - ae_matrix_set_length(w, *nc, ny, _state); - *info = -1; - *iterationscount = 0; - *nmv = 0; - linlsqrcreate(n, n, &state, _state); - linlsqrsetcond(&state, epsort, epserr, maxits, _state); - linlsqrsetlambdai(&state, 1.0E-6, _state); - - /* - * calculate number of non-zero elements for sparse matrix - */ - for(i=0; i<=n-1; i++) - { - for(j=0; j<=rbf_mxnx-1; j++) - { - xx.ptr.p_double[j] = x->ptr.pp_double[i][j]; - } - *annz = *annz+kdtreequeryrnn(centerstree, &xx, r->ptr.p_double[0]*rbf_rbfmlradius, ae_true, _state); - } - for(layer=0; layer<=nlayers-1; layer++) - { - - /* - * Fill sparse matrix, calculate norm(A) - */ - anorm = 0.0; - sparsecreate(n, n, *annz, &spa, _state); - for(i=0; i<=n-1; i++) - { - for(j=0; j<=rbf_mxnx-1; j++) - { - xx.ptr.p_double[j] = x->ptr.pp_double[i][j]; - } - nec = kdtreequeryrnn(centerstree, &xx, r->ptr.p_double[layer*n]*rbf_rbfmlradius, ae_true, _state); - kdtreequeryresultsx(centerstree, &cx, _state); - kdtreequeryresultstags(centerstree, ¢erstags, _state); - for(j=0; j<=nec-1; j++) - { - v = ae_exp(-(ae_sqr(xx.ptr.p_double[0]-cx.ptr.pp_double[j][0], _state)+ae_sqr(xx.ptr.p_double[1]-cx.ptr.pp_double[j][1], _state)+ae_sqr(xx.ptr.p_double[2]-cx.ptr.pp_double[j][2], _state))/ae_sqr(r->ptr.p_double[layer*n+centerstags.ptr.p_int[j]], _state), _state); - sparseset(&spa, i, centerstags.ptr.p_int[j], v, _state); - anorm = anorm+ae_sqr(v, _state); - } - } - anorm = ae_sqrt(anorm, _state); - sparseconverttocrs(&spa, _state); - - /* - * Calculate maximum residual before adding new layer. - * This value is not used by algorithm, the only purpose is to make debugging easier. - */ - rmaxbefore = 0.0; - for(j=0; j<=n-1; j++) - { - for(i=0; i<=ny-1; i++) - { - rmaxbefore = ae_maxreal(rmaxbefore, ae_fabs(y->ptr.pp_double[j][i], _state), _state); - } - } - - /* - * Process NY dimensions of the target function - */ - for(i=0; i<=ny-1; i++) - { - for(j=0; j<=n-1; j++) - { - tmpy.ptr.p_double[j] = y->ptr.pp_double[j][i]; - } - - /* - * calculate Omega for current layer - */ - linlsqrsetlambdai(&state, lambdav*anorm/n, _state); - linlsqrsolvesparse(&state, &spa, &tmpy, _state); - linlsqrresults(&state, &omega, &lsqrrep, _state); - if( lsqrrep.terminationtype<=0 ) - { - *info = -4; - ae_frame_leave(_state); - return; - } - - /* - * calculate error for current layer - */ - for(j=0; j<=n-1; j++) - { - yval = 0; - for(k=0; k<=rbf_mxnx-1; k++) - { - xx.ptr.p_double[k] = x->ptr.pp_double[j][k]; - } - nec = kdtreequeryrnn(centerstree, &xx, r->ptr.p_double[layer*n]*rbf_rbffarradius, ae_true, _state); - kdtreequeryresultsx(centerstree, &cx, _state); - kdtreequeryresultstags(centerstree, ¢erstags, _state); - for(k=0; k<=nec-1; k++) - { - yval = yval+omega.ptr.p_double[centerstags.ptr.p_int[k]]*ae_exp(-(ae_sqr(xx.ptr.p_double[0]-cx.ptr.pp_double[k][0], _state)+ae_sqr(xx.ptr.p_double[1]-cx.ptr.pp_double[k][1], _state)+ae_sqr(xx.ptr.p_double[2]-cx.ptr.pp_double[k][2], _state))/ae_sqr(r->ptr.p_double[layer*n+centerstags.ptr.p_int[k]], _state), _state); - } - y->ptr.pp_double[j][i] = y->ptr.pp_double[j][i]-yval; - } - - /* - * write Omega in out parameter W - */ - for(j=0; j<=n-1; j++) - { - w->ptr.pp_double[layer*n+j][i] = omega.ptr.p_double[j]; - } - *iterationscount = *iterationscount+lsqrrep.iterationscount; - *nmv = *nmv+lsqrrep.nmv; - } - - /* - * Calculate maximum residual before adding new layer. - * This value is not used by algorithm, the only purpose is to make debugging easier. - */ - rmaxafter = 0.0; - for(j=0; j<=n-1; j++) - { - for(i=0; i<=ny-1; i++) - { - rmaxafter = ae_maxreal(rmaxafter, ae_fabs(y->ptr.pp_double[j][i], _state), _state); - } - } - } - *info = 1; - ae_frame_leave(_state); -} - - -ae_bool _rbfmodel_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - rbfmodel *p = (rbfmodel*)_p; - ae_touch_ptr((void*)p); - if( !_kdtree_init(&p->tree, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->xc, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->wr, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->v, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->x, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->y, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->calcbufxcx, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->calcbufx, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->calcbuftags, 0, DT_INT, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _rbfmodel_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - rbfmodel *dst = (rbfmodel*)_dst; - rbfmodel *src = (rbfmodel*)_src; - dst->ny = src->ny; - dst->nx = src->nx; - dst->nc = src->nc; - dst->nl = src->nl; - if( !_kdtree_init_copy(&dst->tree, &src->tree, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->xc, &src->xc, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->wr, &src->wr, _state, make_automatic) ) - return ae_false; - dst->rmax = src->rmax; - if( !ae_matrix_init_copy(&dst->v, &src->v, _state, make_automatic) ) - return ae_false; - dst->gridtype = src->gridtype; - dst->fixrad = src->fixrad; - dst->lambdav = src->lambdav; - dst->radvalue = src->radvalue; - dst->radzvalue = src->radzvalue; - dst->nlayers = src->nlayers; - dst->aterm = src->aterm; - dst->algorithmtype = src->algorithmtype; - dst->epsort = src->epsort; - dst->epserr = src->epserr; - dst->maxits = src->maxits; - dst->h = src->h; - dst->n = src->n; - if( !ae_matrix_init_copy(&dst->x, &src->x, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->y, &src->y, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->calcbufxcx, &src->calcbufxcx, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->calcbufx, &src->calcbufx, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->calcbuftags, &src->calcbuftags, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _rbfmodel_clear(void* _p) -{ - rbfmodel *p = (rbfmodel*)_p; - ae_touch_ptr((void*)p); - _kdtree_clear(&p->tree); - ae_matrix_clear(&p->xc); - ae_matrix_clear(&p->wr); - ae_matrix_clear(&p->v); - ae_matrix_clear(&p->x); - ae_matrix_clear(&p->y); - ae_vector_clear(&p->calcbufxcx); - ae_matrix_clear(&p->calcbufx); - ae_vector_clear(&p->calcbuftags); -} - - -void _rbfmodel_destroy(void* _p) -{ - rbfmodel *p = (rbfmodel*)_p; - ae_touch_ptr((void*)p); - _kdtree_destroy(&p->tree); - ae_matrix_destroy(&p->xc); - ae_matrix_destroy(&p->wr); - ae_matrix_destroy(&p->v); - ae_matrix_destroy(&p->x); - ae_matrix_destroy(&p->y); - ae_vector_destroy(&p->calcbufxcx); - ae_matrix_destroy(&p->calcbufx); - ae_vector_destroy(&p->calcbuftags); -} - - -ae_bool _rbfreport_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - rbfreport *p = (rbfreport*)_p; - ae_touch_ptr((void*)p); - return ae_true; -} - - -ae_bool _rbfreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - rbfreport *dst = (rbfreport*)_dst; - rbfreport *src = (rbfreport*)_src; - dst->arows = src->arows; - dst->acols = src->acols; - dst->annz = src->annz; - dst->iterationscount = src->iterationscount; - dst->nmv = src->nmv; - dst->terminationtype = src->terminationtype; - return ae_true; -} - - -void _rbfreport_clear(void* _p) -{ - rbfreport *p = (rbfreport*)_p; - ae_touch_ptr((void*)p); -} - - -void _rbfreport_destroy(void* _p) -{ - rbfreport *p = (rbfreport*)_p; - ae_touch_ptr((void*)p); -} - - - - -/************************************************************************* -This subroutine calculates the value of the bilinear or bicubic spline at -the given point X. - -Input parameters: - C - coefficients table. - Built by BuildBilinearSpline or BuildBicubicSpline. - X, Y- point - -Result: - S(x,y) - - -- ALGLIB PROJECT -- - Copyright 05.07.2007 by Bochkanov Sergey -*************************************************************************/ -double spline2dcalc(spline2dinterpolant* c, - double x, - double y, - ae_state *_state) -{ - double v; - double vx; - double vy; - double vxy; - double result; - - - ae_assert(c->stype==-1||c->stype==-3, "Spline2DCalc: incorrect C (incorrect parameter C.SType)", _state); - ae_assert(ae_isfinite(x, _state)&&ae_isfinite(y, _state), "Spline2DCalc: X or Y contains NaN or Infinite value", _state); - if( c->d!=1 ) - { - result = 0; - return result; - } - spline2ddiff(c, x, y, &v, &vx, &vy, &vxy, _state); - result = v; - return result; -} - - -/************************************************************************* -This subroutine calculates the value of the bilinear or bicubic spline at -the given point X and its derivatives. - -Input parameters: - C - spline interpolant. - X, Y- point - -Output parameters: - F - S(x,y) - FX - dS(x,y)/dX - FY - dS(x,y)/dY - FXY - d2S(x,y)/dXdY - - -- ALGLIB PROJECT -- - Copyright 05.07.2007 by Bochkanov Sergey -*************************************************************************/ -void spline2ddiff(spline2dinterpolant* c, - double x, - double y, - double* f, - double* fx, - double* fy, - double* fxy, - ae_state *_state) -{ - double t; - double dt; - double u; - double du; - ae_int_t ix; - ae_int_t iy; - ae_int_t l; - ae_int_t r; - ae_int_t h; - ae_int_t s1; - ae_int_t s2; - ae_int_t s3; - ae_int_t s4; - ae_int_t sfx; - ae_int_t sfy; - ae_int_t sfxy; - double y1; - double y2; - double y3; - double y4; - double v; - double t0; - double t1; - double t2; - double t3; - double u0; - double u1; - double u2; - double u3; - - *f = 0; - *fx = 0; - *fy = 0; - *fxy = 0; - - ae_assert(c->stype==-1||c->stype==-3, "Spline2DDiff: incorrect C (incorrect parameter C.SType)", _state); - ae_assert(ae_isfinite(x, _state)&&ae_isfinite(y, _state), "Spline2DDiff: X or Y contains NaN or Infinite value", _state); - - /* - * Prepare F, dF/dX, dF/dY, d2F/dXdY - */ - *f = 0; - *fx = 0; - *fy = 0; - *fxy = 0; - if( c->d!=1 ) - { - return; - } - - /* - * Binary search in the [ x[0], ..., x[n-2] ] (x[n-1] is not included) - */ - l = 0; - r = c->n-1; - while(l!=r-1) - { - h = (l+r)/2; - if( ae_fp_greater_eq(c->x.ptr.p_double[h],x) ) - { - r = h; - } - else - { - l = h; - } - } - t = (x-c->x.ptr.p_double[l])/(c->x.ptr.p_double[l+1]-c->x.ptr.p_double[l]); - dt = 1.0/(c->x.ptr.p_double[l+1]-c->x.ptr.p_double[l]); - ix = l; - - /* - * Binary search in the [ y[0], ..., y[m-2] ] (y[m-1] is not included) - */ - l = 0; - r = c->m-1; - while(l!=r-1) - { - h = (l+r)/2; - if( ae_fp_greater_eq(c->y.ptr.p_double[h],y) ) - { - r = h; - } - else - { - l = h; - } - } - u = (y-c->y.ptr.p_double[l])/(c->y.ptr.p_double[l+1]-c->y.ptr.p_double[l]); - du = 1.0/(c->y.ptr.p_double[l+1]-c->y.ptr.p_double[l]); - iy = l; - - /* - * Bilinear interpolation - */ - if( c->stype==-1 ) - { - y1 = c->f.ptr.p_double[c->n*iy+ix]; - y2 = c->f.ptr.p_double[c->n*iy+(ix+1)]; - y3 = c->f.ptr.p_double[c->n*(iy+1)+(ix+1)]; - y4 = c->f.ptr.p_double[c->n*(iy+1)+ix]; - *f = (1-t)*(1-u)*y1+t*(1-u)*y2+t*u*y3+(1-t)*u*y4; - *fx = (-(1-u)*y1+(1-u)*y2+u*y3-u*y4)*dt; - *fy = (-(1-t)*y1-t*y2+t*y3+(1-t)*y4)*du; - *fxy = (y1-y2+y3-y4)*du*dt; - return; - } - - /* - * Bicubic interpolation - */ - if( c->stype==-3 ) - { - - /* - * Prepare info - */ - t0 = 1; - t1 = t; - t2 = ae_sqr(t, _state); - t3 = t*t2; - u0 = 1; - u1 = u; - u2 = ae_sqr(u, _state); - u3 = u*u2; - sfx = c->n*c->m; - sfy = 2*c->n*c->m; - sfxy = 3*c->n*c->m; - s1 = c->n*iy+ix; - s2 = c->n*iy+(ix+1); - s3 = c->n*(iy+1)+(ix+1); - s4 = c->n*(iy+1)+ix; - - /* - * Calculate - */ - v = c->f.ptr.p_double[s1]; - *f = *f+v*t0*u0; - v = c->f.ptr.p_double[sfy+s1]/du; - *f = *f+v*t0*u1; - *fy = *fy+v*t0*u0*du; - v = -3*c->f.ptr.p_double[s1]+3*c->f.ptr.p_double[s4]-2*c->f.ptr.p_double[sfy+s1]/du-c->f.ptr.p_double[sfy+s4]/du; - *f = *f+v*t0*u2; - *fy = *fy+2*v*t0*u1*du; - v = 2*c->f.ptr.p_double[s1]-2*c->f.ptr.p_double[s4]+c->f.ptr.p_double[sfy+s1]/du+c->f.ptr.p_double[sfy+s4]/du; - *f = *f+v*t0*u3; - *fy = *fy+3*v*t0*u2*du; - v = c->f.ptr.p_double[sfx+s1]/dt; - *f = *f+v*t1*u0; - *fx = *fx+v*t0*u0*dt; - v = c->f.ptr.p_double[sfxy+s1]/(dt*du); - *f = *f+v*t1*u1; - *fx = *fx+v*t0*u1*dt; - *fy = *fy+v*t1*u0*du; - *fxy = *fxy+v*t0*u0*dt*du; - v = -3*c->f.ptr.p_double[sfx+s1]/dt+3*c->f.ptr.p_double[sfx+s4]/dt-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-c->f.ptr.p_double[sfxy+s4]/(dt*du); - *f = *f+v*t1*u2; - *fx = *fx+v*t0*u2*dt; - *fy = *fy+2*v*t1*u1*du; - *fxy = *fxy+2*v*t0*u1*dt*du; - v = 2*c->f.ptr.p_double[sfx+s1]/dt-2*c->f.ptr.p_double[sfx+s4]/dt+c->f.ptr.p_double[sfxy+s1]/(dt*du)+c->f.ptr.p_double[sfxy+s4]/(dt*du); - *f = *f+v*t1*u3; - *fx = *fx+v*t0*u3*dt; - *fy = *fy+3*v*t1*u2*du; - *fxy = *fxy+3*v*t0*u2*dt*du; - v = -3*c->f.ptr.p_double[s1]+3*c->f.ptr.p_double[s2]-2*c->f.ptr.p_double[sfx+s1]/dt-c->f.ptr.p_double[sfx+s2]/dt; - *f = *f+v*t2*u0; - *fx = *fx+2*v*t1*u0*dt; - v = -3*c->f.ptr.p_double[sfy+s1]/du+3*c->f.ptr.p_double[sfy+s2]/du-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-c->f.ptr.p_double[sfxy+s2]/(dt*du); - *f = *f+v*t2*u1; - *fx = *fx+2*v*t1*u1*dt; - *fy = *fy+v*t2*u0*du; - *fxy = *fxy+2*v*t1*u0*dt*du; - v = 9*c->f.ptr.p_double[s1]-9*c->f.ptr.p_double[s2]+9*c->f.ptr.p_double[s3]-9*c->f.ptr.p_double[s4]+6*c->f.ptr.p_double[sfx+s1]/dt+3*c->f.ptr.p_double[sfx+s2]/dt-3*c->f.ptr.p_double[sfx+s3]/dt-6*c->f.ptr.p_double[sfx+s4]/dt+6*c->f.ptr.p_double[sfy+s1]/du-6*c->f.ptr.p_double[sfy+s2]/du-3*c->f.ptr.p_double[sfy+s3]/du+3*c->f.ptr.p_double[sfy+s4]/du+4*c->f.ptr.p_double[sfxy+s1]/(dt*du)+2*c->f.ptr.p_double[sfxy+s2]/(dt*du)+c->f.ptr.p_double[sfxy+s3]/(dt*du)+2*c->f.ptr.p_double[sfxy+s4]/(dt*du); - *f = *f+v*t2*u2; - *fx = *fx+2*v*t1*u2*dt; - *fy = *fy+2*v*t2*u1*du; - *fxy = *fxy+4*v*t1*u1*dt*du; - v = -6*c->f.ptr.p_double[s1]+6*c->f.ptr.p_double[s2]-6*c->f.ptr.p_double[s3]+6*c->f.ptr.p_double[s4]-4*c->f.ptr.p_double[sfx+s1]/dt-2*c->f.ptr.p_double[sfx+s2]/dt+2*c->f.ptr.p_double[sfx+s3]/dt+4*c->f.ptr.p_double[sfx+s4]/dt-3*c->f.ptr.p_double[sfy+s1]/du+3*c->f.ptr.p_double[sfy+s2]/du+3*c->f.ptr.p_double[sfy+s3]/du-3*c->f.ptr.p_double[sfy+s4]/du-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-c->f.ptr.p_double[sfxy+s2]/(dt*du)-c->f.ptr.p_double[sfxy+s3]/(dt*du)-2*c->f.ptr.p_double[sfxy+s4]/(dt*du); - *f = *f+v*t2*u3; - *fx = *fx+2*v*t1*u3*dt; - *fy = *fy+3*v*t2*u2*du; - *fxy = *fxy+6*v*t1*u2*dt*du; - v = 2*c->f.ptr.p_double[s1]-2*c->f.ptr.p_double[s2]+c->f.ptr.p_double[sfx+s1]/dt+c->f.ptr.p_double[sfx+s2]/dt; - *f = *f+v*t3*u0; - *fx = *fx+3*v*t2*u0*dt; - v = 2*c->f.ptr.p_double[sfy+s1]/du-2*c->f.ptr.p_double[sfy+s2]/du+c->f.ptr.p_double[sfxy+s1]/(dt*du)+c->f.ptr.p_double[sfxy+s2]/(dt*du); - *f = *f+v*t3*u1; - *fx = *fx+3*v*t2*u1*dt; - *fy = *fy+v*t3*u0*du; - *fxy = *fxy+3*v*t2*u0*dt*du; - v = -6*c->f.ptr.p_double[s1]+6*c->f.ptr.p_double[s2]-6*c->f.ptr.p_double[s3]+6*c->f.ptr.p_double[s4]-3*c->f.ptr.p_double[sfx+s1]/dt-3*c->f.ptr.p_double[sfx+s2]/dt+3*c->f.ptr.p_double[sfx+s3]/dt+3*c->f.ptr.p_double[sfx+s4]/dt-4*c->f.ptr.p_double[sfy+s1]/du+4*c->f.ptr.p_double[sfy+s2]/du+2*c->f.ptr.p_double[sfy+s3]/du-2*c->f.ptr.p_double[sfy+s4]/du-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-2*c->f.ptr.p_double[sfxy+s2]/(dt*du)-c->f.ptr.p_double[sfxy+s3]/(dt*du)-c->f.ptr.p_double[sfxy+s4]/(dt*du); - *f = *f+v*t3*u2; - *fx = *fx+3*v*t2*u2*dt; - *fy = *fy+2*v*t3*u1*du; - *fxy = *fxy+6*v*t2*u1*dt*du; - v = 4*c->f.ptr.p_double[s1]-4*c->f.ptr.p_double[s2]+4*c->f.ptr.p_double[s3]-4*c->f.ptr.p_double[s4]+2*c->f.ptr.p_double[sfx+s1]/dt+2*c->f.ptr.p_double[sfx+s2]/dt-2*c->f.ptr.p_double[sfx+s3]/dt-2*c->f.ptr.p_double[sfx+s4]/dt+2*c->f.ptr.p_double[sfy+s1]/du-2*c->f.ptr.p_double[sfy+s2]/du-2*c->f.ptr.p_double[sfy+s3]/du+2*c->f.ptr.p_double[sfy+s4]/du+c->f.ptr.p_double[sfxy+s1]/(dt*du)+c->f.ptr.p_double[sfxy+s2]/(dt*du)+c->f.ptr.p_double[sfxy+s3]/(dt*du)+c->f.ptr.p_double[sfxy+s4]/(dt*du); - *f = *f+v*t3*u3; - *fx = *fx+3*v*t2*u3*dt; - *fy = *fy+3*v*t3*u2*du; - *fxy = *fxy+9*v*t2*u2*dt*du; - return; - } -} - - -/************************************************************************* -This subroutine performs linear transformation of the spline argument. - -Input parameters: - C - spline interpolant - AX, BX - transformation coefficients: x = A*t + B - AY, BY - transformation coefficients: y = A*u + B -Result: - C - transformed spline - - -- ALGLIB PROJECT -- - Copyright 30.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline2dlintransxy(spline2dinterpolant* c, - double ax, - double bx, - double ay, - double by, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector x; - ae_vector y; - ae_vector f; - ae_vector v; - ae_int_t i; - ae_int_t j; - ae_int_t k; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&x, 0, DT_REAL, _state, ae_true); - ae_vector_init(&y, 0, DT_REAL, _state, ae_true); - ae_vector_init(&f, 0, DT_REAL, _state, ae_true); - ae_vector_init(&v, 0, DT_REAL, _state, ae_true); - - ae_assert(c->stype==-3||c->stype==-1, "Spline2DLinTransXY: incorrect C (incorrect parameter C.SType)", _state); - ae_assert(ae_isfinite(ax, _state), "Spline2DLinTransXY: AX is infinite or NaN", _state); - ae_assert(ae_isfinite(bx, _state), "Spline2DLinTransXY: BX is infinite or NaN", _state); - ae_assert(ae_isfinite(ay, _state), "Spline2DLinTransXY: AY is infinite or NaN", _state); - ae_assert(ae_isfinite(by, _state), "Spline2DLinTransXY: BY is infinite or NaN", _state); - ae_vector_set_length(&x, c->n, _state); - ae_vector_set_length(&y, c->m, _state); - ae_vector_set_length(&f, c->m*c->n*c->d, _state); - for(j=0; j<=c->n-1; j++) - { - x.ptr.p_double[j] = c->x.ptr.p_double[j]; - } - for(i=0; i<=c->m-1; i++) - { - y.ptr.p_double[i] = c->y.ptr.p_double[i]; - } - for(i=0; i<=c->m-1; i++) - { - for(j=0; j<=c->n-1; j++) - { - for(k=0; k<=c->d-1; k++) - { - f.ptr.p_double[c->d*(i*c->n+j)+k] = c->f.ptr.p_double[c->d*(i*c->n+j)+k]; - } - } - } - - /* - * Handle different combinations of AX/AY - */ - if( ae_fp_eq(ax,0)&&ae_fp_neq(ay,0) ) - { - for(i=0; i<=c->m-1; i++) - { - spline2dcalcvbuf(c, bx, y.ptr.p_double[i], &v, _state); - y.ptr.p_double[i] = (y.ptr.p_double[i]-by)/ay; - for(j=0; j<=c->n-1; j++) - { - for(k=0; k<=c->d-1; k++) - { - f.ptr.p_double[c->d*(i*c->n+j)+k] = v.ptr.p_double[k]; - } - } - } - } - if( ae_fp_neq(ax,0)&&ae_fp_eq(ay,0) ) - { - for(j=0; j<=c->n-1; j++) - { - spline2dcalcvbuf(c, x.ptr.p_double[j], by, &v, _state); - x.ptr.p_double[j] = (x.ptr.p_double[j]-bx)/ax; - for(i=0; i<=c->m-1; i++) - { - for(k=0; k<=c->d-1; k++) - { - f.ptr.p_double[c->d*(i*c->n+j)+k] = v.ptr.p_double[k]; - } - } - } - } - if( ae_fp_neq(ax,0)&&ae_fp_neq(ay,0) ) - { - for(j=0; j<=c->n-1; j++) - { - x.ptr.p_double[j] = (x.ptr.p_double[j]-bx)/ax; - } - for(i=0; i<=c->m-1; i++) - { - y.ptr.p_double[i] = (y.ptr.p_double[i]-by)/ay; - } - } - if( ae_fp_eq(ax,0)&&ae_fp_eq(ay,0) ) - { - spline2dcalcvbuf(c, bx, by, &v, _state); - for(i=0; i<=c->m-1; i++) - { - for(j=0; j<=c->n-1; j++) - { - for(k=0; k<=c->d-1; k++) - { - f.ptr.p_double[c->d*(i*c->n+j)+k] = v.ptr.p_double[k]; - } - } - } - } - - /* - * Rebuild spline - */ - if( c->stype==-3 ) - { - spline2dbuildbicubicv(&x, c->n, &y, c->m, &f, c->d, c, _state); - } - if( c->stype==-1 ) - { - spline2dbuildbilinearv(&x, c->n, &y, c->m, &f, c->d, c, _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -This subroutine performs linear transformation of the spline. - -Input parameters: - C - spline interpolant. - A, B- transformation coefficients: S2(x,y) = A*S(x,y) + B - -Output parameters: - C - transformed spline - - -- ALGLIB PROJECT -- - Copyright 30.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline2dlintransf(spline2dinterpolant* c, - double a, - double b, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector x; - ae_vector y; - ae_vector f; - ae_int_t i; - ae_int_t j; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&x, 0, DT_REAL, _state, ae_true); - ae_vector_init(&y, 0, DT_REAL, _state, ae_true); - ae_vector_init(&f, 0, DT_REAL, _state, ae_true); - - ae_assert(c->stype==-3||c->stype==-1, "Spline2DLinTransF: incorrect C (incorrect parameter C.SType)", _state); - ae_vector_set_length(&x, c->n, _state); - ae_vector_set_length(&y, c->m, _state); - ae_vector_set_length(&f, c->m*c->n*c->d, _state); - for(j=0; j<=c->n-1; j++) - { - x.ptr.p_double[j] = c->x.ptr.p_double[j]; - } - for(i=0; i<=c->m-1; i++) - { - y.ptr.p_double[i] = c->y.ptr.p_double[i]; - } - for(i=0; i<=c->m*c->n*c->d-1; i++) - { - f.ptr.p_double[i] = a*c->f.ptr.p_double[i]+b; - } - if( c->stype==-3 ) - { - spline2dbuildbicubicv(&x, c->n, &y, c->m, &f, c->d, c, _state); - } - if( c->stype==-1 ) - { - spline2dbuildbilinearv(&x, c->n, &y, c->m, &f, c->d, c, _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -This subroutine makes the copy of the spline model. - -Input parameters: - C - spline interpolant - -Output parameters: - CC - spline copy - - -- ALGLIB PROJECT -- - Copyright 29.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline2dcopy(spline2dinterpolant* c, - spline2dinterpolant* cc, - ae_state *_state) -{ - ae_int_t tblsize; - - _spline2dinterpolant_clear(cc); - - ae_assert(c->k==1||c->k==3, "Spline2DCopy: incorrect C (incorrect parameter C.K)", _state); - cc->k = c->k; - cc->n = c->n; - cc->m = c->m; - cc->d = c->d; - cc->stype = c->stype; - tblsize = -1; - if( c->stype==-3 ) - { - tblsize = 4*c->n*c->m*c->d; - } - if( c->stype==-1 ) - { - tblsize = c->n*c->m*c->d; - } - ae_assert(tblsize>0, "Spline2DCopy: internal error", _state); - ae_vector_set_length(&cc->x, cc->n, _state); - ae_vector_set_length(&cc->y, cc->m, _state); - ae_vector_set_length(&cc->f, tblsize, _state); - ae_v_move(&cc->x.ptr.p_double[0], 1, &c->x.ptr.p_double[0], 1, ae_v_len(0,cc->n-1)); - ae_v_move(&cc->y.ptr.p_double[0], 1, &c->y.ptr.p_double[0], 1, ae_v_len(0,cc->m-1)); - ae_v_move(&cc->f.ptr.p_double[0], 1, &c->f.ptr.p_double[0], 1, ae_v_len(0,tblsize-1)); -} - - -/************************************************************************* -Bicubic spline resampling - -Input parameters: - A - function values at the old grid, - array[0..OldHeight-1, 0..OldWidth-1] - OldHeight - old grid height, OldHeight>1 - OldWidth - old grid width, OldWidth>1 - NewHeight - new grid height, NewHeight>1 - NewWidth - new grid width, NewWidth>1 - -Output parameters: - B - function values at the new grid, - array[0..NewHeight-1, 0..NewWidth-1] - - -- ALGLIB routine -- - 15 May, 2007 - Copyright by Bochkanov Sergey -*************************************************************************/ -void spline2dresamplebicubic(/* Real */ ae_matrix* a, - ae_int_t oldheight, - ae_int_t oldwidth, - /* Real */ ae_matrix* b, - ae_int_t newheight, - ae_int_t newwidth, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix buf; - ae_vector x; - ae_vector y; - spline1dinterpolant c; - ae_int_t mw; - ae_int_t mh; - ae_int_t i; - ae_int_t j; - - ae_frame_make(_state, &_frame_block); - ae_matrix_clear(b); - ae_matrix_init(&buf, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&x, 0, DT_REAL, _state, ae_true); - ae_vector_init(&y, 0, DT_REAL, _state, ae_true); - _spline1dinterpolant_init(&c, _state, ae_true); - - ae_assert(oldwidth>1&&oldheight>1, "Spline2DResampleBicubic: width/height less than 1", _state); - ae_assert(newwidth>1&&newheight>1, "Spline2DResampleBicubic: width/height less than 1", _state); - - /* - * Prepare - */ - mw = ae_maxint(oldwidth, newwidth, _state); - mh = ae_maxint(oldheight, newheight, _state); - ae_matrix_set_length(b, newheight, newwidth, _state); - ae_matrix_set_length(&buf, oldheight, newwidth, _state); - ae_vector_set_length(&x, ae_maxint(mw, mh, _state), _state); - ae_vector_set_length(&y, ae_maxint(mw, mh, _state), _state); - - /* - * Horizontal interpolation - */ - for(i=0; i<=oldheight-1; i++) - { - - /* - * Fill X, Y - */ - for(j=0; j<=oldwidth-1; j++) - { - x.ptr.p_double[j] = (double)j/(double)(oldwidth-1); - y.ptr.p_double[j] = a->ptr.pp_double[i][j]; - } - - /* - * Interpolate and place result into temporary matrix - */ - spline1dbuildcubic(&x, &y, oldwidth, 0, 0.0, 0, 0.0, &c, _state); - for(j=0; j<=newwidth-1; j++) - { - buf.ptr.pp_double[i][j] = spline1dcalc(&c, (double)j/(double)(newwidth-1), _state); - } - } - - /* - * Vertical interpolation - */ - for(j=0; j<=newwidth-1; j++) - { - - /* - * Fill X, Y - */ - for(i=0; i<=oldheight-1; i++) - { - x.ptr.p_double[i] = (double)i/(double)(oldheight-1); - y.ptr.p_double[i] = buf.ptr.pp_double[i][j]; - } - - /* - * Interpolate and place result into B - */ - spline1dbuildcubic(&x, &y, oldheight, 0, 0.0, 0, 0.0, &c, _state); - for(i=0; i<=newheight-1; i++) - { - b->ptr.pp_double[i][j] = spline1dcalc(&c, (double)i/(double)(newheight-1), _state); - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Bilinear spline resampling - -Input parameters: - A - function values at the old grid, - array[0..OldHeight-1, 0..OldWidth-1] - OldHeight - old grid height, OldHeight>1 - OldWidth - old grid width, OldWidth>1 - NewHeight - new grid height, NewHeight>1 - NewWidth - new grid width, NewWidth>1 - -Output parameters: - B - function values at the new grid, - array[0..NewHeight-1, 0..NewWidth-1] - - -- ALGLIB routine -- - 09.07.2007 - Copyright by Bochkanov Sergey -*************************************************************************/ -void spline2dresamplebilinear(/* Real */ ae_matrix* a, - ae_int_t oldheight, - ae_int_t oldwidth, - /* Real */ ae_matrix* b, - ae_int_t newheight, - ae_int_t newwidth, - ae_state *_state) -{ - ae_int_t l; - ae_int_t c; - double t; - double u; - ae_int_t i; - ae_int_t j; - - ae_matrix_clear(b); - - ae_assert(oldwidth>1&&oldheight>1, "Spline2DResampleBilinear: width/height less than 1", _state); - ae_assert(newwidth>1&&newheight>1, "Spline2DResampleBilinear: width/height less than 1", _state); - ae_matrix_set_length(b, newheight, newwidth, _state); - for(i=0; i<=newheight-1; i++) - { - for(j=0; j<=newwidth-1; j++) - { - l = i*(oldheight-1)/(newheight-1); - if( l==oldheight-1 ) - { - l = oldheight-2; - } - u = (double)i/(double)(newheight-1)*(oldheight-1)-l; - c = j*(oldwidth-1)/(newwidth-1); - if( c==oldwidth-1 ) - { - c = oldwidth-2; - } - t = (double)(j*(oldwidth-1))/(double)(newwidth-1)-c; - b->ptr.pp_double[i][j] = (1-t)*(1-u)*a->ptr.pp_double[l][c]+t*(1-u)*a->ptr.pp_double[l][c+1]+t*u*a->ptr.pp_double[l+1][c+1]+(1-t)*u*a->ptr.pp_double[l+1][c]; - } - } -} - - -/************************************************************************* -This subroutine builds bilinear vector-valued spline. - -Input parameters: - X - spline abscissas, array[0..N-1] - Y - spline ordinates, array[0..M-1] - F - function values, array[0..M*N*D-1]: - * first D elements store D values at (X[0],Y[0]) - * next D elements store D values at (X[1],Y[0]) - * general form - D function values at (X[i],Y[j]) are stored - at F[D*(J*N+I)...D*(J*N+I)+D-1]. - M,N - grid size, M>=2, N>=2 - D - vector dimension, D>=1 - -Output parameters: - C - spline interpolant - - -- ALGLIB PROJECT -- - Copyright 16.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline2dbuildbilinearv(/* Real */ ae_vector* x, - ae_int_t n, - /* Real */ ae_vector* y, - ae_int_t m, - /* Real */ ae_vector* f, - ae_int_t d, - spline2dinterpolant* c, - ae_state *_state) -{ - double t; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t i0; - - _spline2dinterpolant_clear(c); - - ae_assert(n>=2, "Spline2DBuildBilinearV: N is less then 2", _state); - ae_assert(m>=2, "Spline2DBuildBilinearV: M is less then 2", _state); - ae_assert(d>=1, "Spline2DBuildBilinearV: invalid argument D (D<1)", _state); - ae_assert(x->cnt>=n&&y->cnt>=m, "Spline2DBuildBilinearV: length of X or Y is too short (Length(X/Y)cnt>=k, "Spline2DBuildBilinearV: length of F is too short (Length(F)k = 1; - c->n = n; - c->m = m; - c->d = d; - c->stype = -1; - ae_vector_set_length(&c->x, c->n, _state); - ae_vector_set_length(&c->y, c->m, _state); - ae_vector_set_length(&c->f, k, _state); - for(i=0; i<=c->n-1; i++) - { - c->x.ptr.p_double[i] = x->ptr.p_double[i]; - } - for(i=0; i<=c->m-1; i++) - { - c->y.ptr.p_double[i] = y->ptr.p_double[i]; - } - for(i=0; i<=k-1; i++) - { - c->f.ptr.p_double[i] = f->ptr.p_double[i]; - } - - /* - * Sort points - */ - for(j=0; j<=c->n-1; j++) - { - k = j; - for(i=j+1; i<=c->n-1; i++) - { - if( ae_fp_less(c->x.ptr.p_double[i],c->x.ptr.p_double[k]) ) - { - k = i; - } - } - if( k!=j ) - { - for(i=0; i<=c->m-1; i++) - { - for(i0=0; i0<=c->d-1; i0++) - { - t = c->f.ptr.p_double[c->d*(i*c->n+j)+i0]; - c->f.ptr.p_double[c->d*(i*c->n+j)+i0] = c->f.ptr.p_double[c->d*(i*c->n+k)+i0]; - c->f.ptr.p_double[c->d*(i*c->n+k)+i0] = t; - } - } - t = c->x.ptr.p_double[j]; - c->x.ptr.p_double[j] = c->x.ptr.p_double[k]; - c->x.ptr.p_double[k] = t; - } - } - for(i=0; i<=c->m-1; i++) - { - k = i; - for(j=i+1; j<=c->m-1; j++) - { - if( ae_fp_less(c->y.ptr.p_double[j],c->y.ptr.p_double[k]) ) - { - k = j; - } - } - if( k!=i ) - { - for(j=0; j<=c->n-1; j++) - { - for(i0=0; i0<=c->d-1; i0++) - { - t = c->f.ptr.p_double[c->d*(i*c->n+j)+i0]; - c->f.ptr.p_double[c->d*(i*c->n+j)+i0] = c->f.ptr.p_double[c->d*(k*c->n+j)+i0]; - c->f.ptr.p_double[c->d*(k*c->n+j)+i0] = t; - } - } - t = c->y.ptr.p_double[i]; - c->y.ptr.p_double[i] = c->y.ptr.p_double[k]; - c->y.ptr.p_double[k] = t; - } - } -} - - -/************************************************************************* -This subroutine builds bicubic vector-valued spline. - -Input parameters: - X - spline abscissas, array[0..N-1] - Y - spline ordinates, array[0..M-1] - F - function values, array[0..M*N*D-1]: - * first D elements store D values at (X[0],Y[0]) - * next D elements store D values at (X[1],Y[0]) - * general form - D function values at (X[i],Y[j]) are stored - at F[D*(J*N+I)...D*(J*N+I)+D-1]. - M,N - grid size, M>=2, N>=2 - D - vector dimension, D>=1 - -Output parameters: - C - spline interpolant - - -- ALGLIB PROJECT -- - Copyright 16.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline2dbuildbicubicv(/* Real */ ae_vector* x, - ae_int_t n, - /* Real */ ae_vector* y, - ae_int_t m, - /* Real */ ae_vector* f, - ae_int_t d, - spline2dinterpolant* c, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _f; - ae_matrix tf; - ae_matrix dx; - ae_matrix dy; - ae_matrix dxy; - double t; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t di; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_f, f, _state, ae_true); - f = &_f; - _spline2dinterpolant_clear(c); - ae_matrix_init(&tf, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&dx, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&dy, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&dxy, 0, 0, DT_REAL, _state, ae_true); - - ae_assert(n>=2, "Spline2DBuildBicubicV: N is less than 2", _state); - ae_assert(m>=2, "Spline2DBuildBicubicV: M is less than 2", _state); - ae_assert(d>=1, "Spline2DBuildBicubicV: invalid argument D (D<1)", _state); - ae_assert(x->cnt>=n&&y->cnt>=m, "Spline2DBuildBicubicV: length of X or Y is too short (Length(X/Y)cnt>=k, "Spline2DBuildBicubicV: length of F is too short (Length(F)k = 3; - c->d = d; - c->n = n; - c->m = m; - c->stype = -3; - k = 4*k; - ae_vector_set_length(&c->x, c->n, _state); - ae_vector_set_length(&c->y, c->m, _state); - ae_vector_set_length(&c->f, k, _state); - ae_matrix_set_length(&tf, c->m, c->n, _state); - for(i=0; i<=c->n-1; i++) - { - c->x.ptr.p_double[i] = x->ptr.p_double[i]; - } - for(i=0; i<=c->m-1; i++) - { - c->y.ptr.p_double[i] = y->ptr.p_double[i]; - } - - /* - * Sort points - */ - for(j=0; j<=c->n-1; j++) - { - k = j; - for(i=j+1; i<=c->n-1; i++) - { - if( ae_fp_less(c->x.ptr.p_double[i],c->x.ptr.p_double[k]) ) - { - k = i; - } - } - if( k!=j ) - { - for(i=0; i<=c->m-1; i++) - { - for(di=0; di<=c->d-1; di++) - { - t = f->ptr.p_double[c->d*(i*c->n+j)+di]; - f->ptr.p_double[c->d*(i*c->n+j)+di] = f->ptr.p_double[c->d*(i*c->n+k)+di]; - f->ptr.p_double[c->d*(i*c->n+k)+di] = t; - } - } - t = c->x.ptr.p_double[j]; - c->x.ptr.p_double[j] = c->x.ptr.p_double[k]; - c->x.ptr.p_double[k] = t; - } - } - for(i=0; i<=c->m-1; i++) - { - k = i; - for(j=i+1; j<=c->m-1; j++) - { - if( ae_fp_less(c->y.ptr.p_double[j],c->y.ptr.p_double[k]) ) - { - k = j; - } - } - if( k!=i ) - { - for(j=0; j<=c->n-1; j++) - { - for(di=0; di<=c->d-1; di++) - { - t = f->ptr.p_double[c->d*(i*c->n+j)+di]; - f->ptr.p_double[c->d*(i*c->n+j)+di] = f->ptr.p_double[c->d*(k*c->n+j)+di]; - f->ptr.p_double[c->d*(k*c->n+j)+di] = t; - } - } - t = c->y.ptr.p_double[i]; - c->y.ptr.p_double[i] = c->y.ptr.p_double[k]; - c->y.ptr.p_double[k] = t; - } - } - for(di=0; di<=c->d-1; di++) - { - for(i=0; i<=c->m-1; i++) - { - for(j=0; j<=c->n-1; j++) - { - tf.ptr.pp_double[i][j] = f->ptr.p_double[c->d*(i*c->n+j)+di]; - } - } - spline2d_bicubiccalcderivatives(&tf, &c->x, &c->y, c->m, c->n, &dx, &dy, &dxy, _state); - for(i=0; i<=c->m-1; i++) - { - for(j=0; j<=c->n-1; j++) - { - k = c->d*(i*c->n+j)+di; - c->f.ptr.p_double[k] = tf.ptr.pp_double[i][j]; - c->f.ptr.p_double[c->n*c->m*c->d+k] = dx.ptr.pp_double[i][j]; - c->f.ptr.p_double[2*c->n*c->m*c->d+k] = dy.ptr.pp_double[i][j]; - c->f.ptr.p_double[3*c->n*c->m*c->d+k] = dxy.ptr.pp_double[i][j]; - } - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -This subroutine calculates bilinear or bicubic vector-valued spline at the -given point (X,Y). - -INPUT PARAMETERS: - C - spline interpolant. - X, Y- point - F - output buffer, possibly preallocated array. In case array size - is large enough to store result, it is not reallocated. Array - which is too short will be reallocated - -OUTPUT PARAMETERS: - F - array[D] (or larger) which stores function values - - -- ALGLIB PROJECT -- - Copyright 16.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline2dcalcvbuf(spline2dinterpolant* c, - double x, - double y, - /* Real */ ae_vector* f, - ae_state *_state) -{ - double t; - double dt; - double u; - double du; - ae_int_t ix; - ae_int_t iy; - ae_int_t l; - ae_int_t r; - ae_int_t h; - ae_int_t s1; - ae_int_t s2; - ae_int_t s3; - ae_int_t s4; - ae_int_t sfx; - ae_int_t sfy; - ae_int_t sfxy; - double y1; - double y2; - double y3; - double y4; - double v; - double t0; - double t1; - double t2; - double t3; - double u0; - double u1; - double u2; - double u3; - ae_int_t i; - - - ae_assert(c->stype==-1||c->stype==-3, "Spline2DCalcVBuf: incorrect C (incorrect parameter C.SType)", _state); - ae_assert(ae_isfinite(x, _state)&&ae_isfinite(y, _state), "Spline2DCalcVBuf: either X=NaN/Infinite or Y=NaN/Infinite", _state); - rvectorsetlengthatleast(f, c->d, _state); - - /* - * Binary search in the [ x[0], ..., x[n-2] ] (x[n-1] is not included) - */ - l = 0; - r = c->n-1; - while(l!=r-1) - { - h = (l+r)/2; - if( ae_fp_greater_eq(c->x.ptr.p_double[h],x) ) - { - r = h; - } - else - { - l = h; - } - } - t = (x-c->x.ptr.p_double[l])/(c->x.ptr.p_double[l+1]-c->x.ptr.p_double[l]); - dt = 1.0/(c->x.ptr.p_double[l+1]-c->x.ptr.p_double[l]); - ix = l; - - /* - * Binary search in the [ y[0], ..., y[m-2] ] (y[m-1] is not included) - */ - l = 0; - r = c->m-1; - while(l!=r-1) - { - h = (l+r)/2; - if( ae_fp_greater_eq(c->y.ptr.p_double[h],y) ) - { - r = h; - } - else - { - l = h; - } - } - u = (y-c->y.ptr.p_double[l])/(c->y.ptr.p_double[l+1]-c->y.ptr.p_double[l]); - du = 1.0/(c->y.ptr.p_double[l+1]-c->y.ptr.p_double[l]); - iy = l; - - /* - * Bilinear interpolation - */ - if( c->stype==-1 ) - { - for(i=0; i<=c->d-1; i++) - { - y1 = c->f.ptr.p_double[c->d*(c->n*iy+ix)+i]; - y2 = c->f.ptr.p_double[c->d*(c->n*iy+(ix+1))+i]; - y3 = c->f.ptr.p_double[c->d*(c->n*(iy+1)+(ix+1))+i]; - y4 = c->f.ptr.p_double[c->d*(c->n*(iy+1)+ix)+i]; - f->ptr.p_double[i] = (1-t)*(1-u)*y1+t*(1-u)*y2+t*u*y3+(1-t)*u*y4; - } - return; - } - - /* - * Bicubic interpolation - */ - if( c->stype==-3 ) - { - - /* - * Prepare info - */ - t0 = 1; - t1 = t; - t2 = ae_sqr(t, _state); - t3 = t*t2; - u0 = 1; - u1 = u; - u2 = ae_sqr(u, _state); - u3 = u*u2; - sfx = c->n*c->m*c->d; - sfy = 2*c->n*c->m*c->d; - sfxy = 3*c->n*c->m*c->d; - for(i=0; i<=c->d-1; i++) - { - - /* - * Prepare F, dF/dX, dF/dY, d2F/dXdY - */ - f->ptr.p_double[i] = 0; - s1 = c->d*(c->n*iy+ix)+i; - s2 = c->d*(c->n*iy+(ix+1))+i; - s3 = c->d*(c->n*(iy+1)+(ix+1))+i; - s4 = c->d*(c->n*(iy+1)+ix)+i; - - /* - * Calculate - */ - v = c->f.ptr.p_double[s1]; - f->ptr.p_double[i] = f->ptr.p_double[i]+v*t0*u0; - v = c->f.ptr.p_double[sfy+s1]/du; - f->ptr.p_double[i] = f->ptr.p_double[i]+v*t0*u1; - v = -3*c->f.ptr.p_double[s1]+3*c->f.ptr.p_double[s4]-2*c->f.ptr.p_double[sfy+s1]/du-c->f.ptr.p_double[sfy+s4]/du; - f->ptr.p_double[i] = f->ptr.p_double[i]+v*t0*u2; - v = 2*c->f.ptr.p_double[s1]-2*c->f.ptr.p_double[s4]+c->f.ptr.p_double[sfy+s1]/du+c->f.ptr.p_double[sfy+s4]/du; - f->ptr.p_double[i] = f->ptr.p_double[i]+v*t0*u3; - v = c->f.ptr.p_double[sfx+s1]/dt; - f->ptr.p_double[i] = f->ptr.p_double[i]+v*t1*u0; - v = c->f.ptr.p_double[sfxy+s1]/(dt*du); - f->ptr.p_double[i] = f->ptr.p_double[i]+v*t1*u1; - v = -3*c->f.ptr.p_double[sfx+s1]/dt+3*c->f.ptr.p_double[sfx+s4]/dt-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-c->f.ptr.p_double[sfxy+s4]/(dt*du); - f->ptr.p_double[i] = f->ptr.p_double[i]+v*t1*u2; - v = 2*c->f.ptr.p_double[sfx+s1]/dt-2*c->f.ptr.p_double[sfx+s4]/dt+c->f.ptr.p_double[sfxy+s1]/(dt*du)+c->f.ptr.p_double[sfxy+s4]/(dt*du); - f->ptr.p_double[i] = f->ptr.p_double[i]+v*t1*u3; - v = -3*c->f.ptr.p_double[s1]+3*c->f.ptr.p_double[s2]-2*c->f.ptr.p_double[sfx+s1]/dt-c->f.ptr.p_double[sfx+s2]/dt; - f->ptr.p_double[i] = f->ptr.p_double[i]+v*t2*u0; - v = -3*c->f.ptr.p_double[sfy+s1]/du+3*c->f.ptr.p_double[sfy+s2]/du-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-c->f.ptr.p_double[sfxy+s2]/(dt*du); - f->ptr.p_double[i] = f->ptr.p_double[i]+v*t2*u1; - v = 9*c->f.ptr.p_double[s1]-9*c->f.ptr.p_double[s2]+9*c->f.ptr.p_double[s3]-9*c->f.ptr.p_double[s4]+6*c->f.ptr.p_double[sfx+s1]/dt+3*c->f.ptr.p_double[sfx+s2]/dt-3*c->f.ptr.p_double[sfx+s3]/dt-6*c->f.ptr.p_double[sfx+s4]/dt+6*c->f.ptr.p_double[sfy+s1]/du-6*c->f.ptr.p_double[sfy+s2]/du-3*c->f.ptr.p_double[sfy+s3]/du+3*c->f.ptr.p_double[sfy+s4]/du+4*c->f.ptr.p_double[sfxy+s1]/(dt*du)+2*c->f.ptr.p_double[sfxy+s2]/(dt*du)+c->f.ptr.p_double[sfxy+s3]/(dt*du)+2*c->f.ptr.p_double[sfxy+s4]/(dt*du); - f->ptr.p_double[i] = f->ptr.p_double[i]+v*t2*u2; - v = -6*c->f.ptr.p_double[s1]+6*c->f.ptr.p_double[s2]-6*c->f.ptr.p_double[s3]+6*c->f.ptr.p_double[s4]-4*c->f.ptr.p_double[sfx+s1]/dt-2*c->f.ptr.p_double[sfx+s2]/dt+2*c->f.ptr.p_double[sfx+s3]/dt+4*c->f.ptr.p_double[sfx+s4]/dt-3*c->f.ptr.p_double[sfy+s1]/du+3*c->f.ptr.p_double[sfy+s2]/du+3*c->f.ptr.p_double[sfy+s3]/du-3*c->f.ptr.p_double[sfy+s4]/du-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-c->f.ptr.p_double[sfxy+s2]/(dt*du)-c->f.ptr.p_double[sfxy+s3]/(dt*du)-2*c->f.ptr.p_double[sfxy+s4]/(dt*du); - f->ptr.p_double[i] = f->ptr.p_double[i]+v*t2*u3; - v = 2*c->f.ptr.p_double[s1]-2*c->f.ptr.p_double[s2]+c->f.ptr.p_double[sfx+s1]/dt+c->f.ptr.p_double[sfx+s2]/dt; - f->ptr.p_double[i] = f->ptr.p_double[i]+v*t3*u0; - v = 2*c->f.ptr.p_double[sfy+s1]/du-2*c->f.ptr.p_double[sfy+s2]/du+c->f.ptr.p_double[sfxy+s1]/(dt*du)+c->f.ptr.p_double[sfxy+s2]/(dt*du); - f->ptr.p_double[i] = f->ptr.p_double[i]+v*t3*u1; - v = -6*c->f.ptr.p_double[s1]+6*c->f.ptr.p_double[s2]-6*c->f.ptr.p_double[s3]+6*c->f.ptr.p_double[s4]-3*c->f.ptr.p_double[sfx+s1]/dt-3*c->f.ptr.p_double[sfx+s2]/dt+3*c->f.ptr.p_double[sfx+s3]/dt+3*c->f.ptr.p_double[sfx+s4]/dt-4*c->f.ptr.p_double[sfy+s1]/du+4*c->f.ptr.p_double[sfy+s2]/du+2*c->f.ptr.p_double[sfy+s3]/du-2*c->f.ptr.p_double[sfy+s4]/du-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-2*c->f.ptr.p_double[sfxy+s2]/(dt*du)-c->f.ptr.p_double[sfxy+s3]/(dt*du)-c->f.ptr.p_double[sfxy+s4]/(dt*du); - f->ptr.p_double[i] = f->ptr.p_double[i]+v*t3*u2; - v = 4*c->f.ptr.p_double[s1]-4*c->f.ptr.p_double[s2]+4*c->f.ptr.p_double[s3]-4*c->f.ptr.p_double[s4]+2*c->f.ptr.p_double[sfx+s1]/dt+2*c->f.ptr.p_double[sfx+s2]/dt-2*c->f.ptr.p_double[sfx+s3]/dt-2*c->f.ptr.p_double[sfx+s4]/dt+2*c->f.ptr.p_double[sfy+s1]/du-2*c->f.ptr.p_double[sfy+s2]/du-2*c->f.ptr.p_double[sfy+s3]/du+2*c->f.ptr.p_double[sfy+s4]/du+c->f.ptr.p_double[sfxy+s1]/(dt*du)+c->f.ptr.p_double[sfxy+s2]/(dt*du)+c->f.ptr.p_double[sfxy+s3]/(dt*du)+c->f.ptr.p_double[sfxy+s4]/(dt*du); - f->ptr.p_double[i] = f->ptr.p_double[i]+v*t3*u3; - } - return; - } -} - - -/************************************************************************* -This subroutine calculates bilinear or bicubic vector-valued spline at the -given point (X,Y). - -INPUT PARAMETERS: - C - spline interpolant. - X, Y- point - -OUTPUT PARAMETERS: - F - array[D] which stores function values. F is out-parameter and - it is reallocated after call to this function. In case you - want to reuse previously allocated F, you may use - Spline2DCalcVBuf(), which reallocates F only when it is too - small. - - -- ALGLIB PROJECT -- - Copyright 16.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline2dcalcv(spline2dinterpolant* c, - double x, - double y, - /* Real */ ae_vector* f, - ae_state *_state) -{ - - ae_vector_clear(f); - - ae_assert(c->stype==-1||c->stype==-3, "Spline2DCalcV: incorrect C (incorrect parameter C.SType)", _state); - ae_assert(ae_isfinite(x, _state)&&ae_isfinite(y, _state), "Spline2DCalcV: either X=NaN/Infinite or Y=NaN/Infinite", _state); - ae_vector_set_length(f, c->d, _state); - spline2dcalcvbuf(c, x, y, f, _state); -} - - -/************************************************************************* -This subroutine unpacks two-dimensional spline into the coefficients table - -Input parameters: - C - spline interpolant. - -Result: - M, N- grid size (x-axis and y-axis) - D - number of components - Tbl - coefficients table, unpacked format, - D - components: [0..(N-1)*(M-1)*D-1, 0..19]. - For T=0..D-1 (component index), I = 0...N-2 (x index), - J=0..M-2 (y index): - K := T + I*D + J*D*(N-1) - - K-th row stores decomposition for T-th component of the - vector-valued function - - Tbl[K,0] = X[i] - Tbl[K,1] = X[i+1] - Tbl[K,2] = Y[j] - Tbl[K,3] = Y[j+1] - Tbl[K,4] = C00 - Tbl[K,5] = C01 - Tbl[K,6] = C02 - Tbl[K,7] = C03 - Tbl[K,8] = C10 - Tbl[K,9] = C11 - ... - Tbl[K,19] = C33 - On each grid square spline is equals to: - S(x) = SUM(c[i,j]*(t^i)*(u^j), i=0..3, j=0..3) - t = x-x[j] - u = y-y[i] - - -- ALGLIB PROJECT -- - Copyright 16.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline2dunpackv(spline2dinterpolant* c, - ae_int_t* m, - ae_int_t* n, - ae_int_t* d, - /* Real */ ae_matrix* tbl, - ae_state *_state) -{ - ae_int_t k; - ae_int_t p; - ae_int_t ci; - ae_int_t cj; - ae_int_t s1; - ae_int_t s2; - ae_int_t s3; - ae_int_t s4; - ae_int_t sfx; - ae_int_t sfy; - ae_int_t sfxy; - double y1; - double y2; - double y3; - double y4; - double dt; - double du; - ae_int_t i; - ae_int_t j; - ae_int_t k0; - - *m = 0; - *n = 0; - *d = 0; - ae_matrix_clear(tbl); - - ae_assert(c->stype==-3||c->stype==-1, "Spline2DUnpackV: incorrect C (incorrect parameter C.SType)", _state); - *n = c->n; - *m = c->m; - *d = c->d; - ae_matrix_set_length(tbl, (*n-1)*(*m-1)*(*d), 20, _state); - sfx = *n*(*m)*(*d); - sfy = 2*(*n)*(*m)*(*d); - sfxy = 3*(*n)*(*m)*(*d); - for(i=0; i<=*m-2; i++) - { - for(j=0; j<=*n-2; j++) - { - for(k=0; k<=*d-1; k++) - { - p = *d*(i*(*n-1)+j)+k; - tbl->ptr.pp_double[p][0] = c->x.ptr.p_double[j]; - tbl->ptr.pp_double[p][1] = c->x.ptr.p_double[j+1]; - tbl->ptr.pp_double[p][2] = c->y.ptr.p_double[i]; - tbl->ptr.pp_double[p][3] = c->y.ptr.p_double[i+1]; - dt = 1/(tbl->ptr.pp_double[p][1]-tbl->ptr.pp_double[p][0]); - du = 1/(tbl->ptr.pp_double[p][3]-tbl->ptr.pp_double[p][2]); - - /* - * Bilinear interpolation - */ - if( c->stype==-1 ) - { - for(k0=4; k0<=19; k0++) - { - tbl->ptr.pp_double[p][k0] = 0; - } - y1 = c->f.ptr.p_double[*d*(*n*i+j)+k]; - y2 = c->f.ptr.p_double[*d*(*n*i+(j+1))+k]; - y3 = c->f.ptr.p_double[*d*(*n*(i+1)+(j+1))+k]; - y4 = c->f.ptr.p_double[*d*(*n*(i+1)+j)+k]; - tbl->ptr.pp_double[p][4] = y1; - tbl->ptr.pp_double[p][4+1*4+0] = y2-y1; - tbl->ptr.pp_double[p][4+0*4+1] = y4-y1; - tbl->ptr.pp_double[p][4+1*4+1] = y3-y2-y4+y1; - } - - /* - * Bicubic interpolation - */ - if( c->stype==-3 ) - { - s1 = *d*(*n*i+j)+k; - s2 = *d*(*n*i+(j+1))+k; - s3 = *d*(*n*(i+1)+(j+1))+k; - s4 = *d*(*n*(i+1)+j)+k; - tbl->ptr.pp_double[p][4+0*4+0] = c->f.ptr.p_double[s1]; - tbl->ptr.pp_double[p][4+0*4+1] = c->f.ptr.p_double[sfy+s1]/du; - tbl->ptr.pp_double[p][4+0*4+2] = -3*c->f.ptr.p_double[s1]+3*c->f.ptr.p_double[s4]-2*c->f.ptr.p_double[sfy+s1]/du-c->f.ptr.p_double[sfy+s4]/du; - tbl->ptr.pp_double[p][4+0*4+3] = 2*c->f.ptr.p_double[s1]-2*c->f.ptr.p_double[s4]+c->f.ptr.p_double[sfy+s1]/du+c->f.ptr.p_double[sfy+s4]/du; - tbl->ptr.pp_double[p][4+1*4+0] = c->f.ptr.p_double[sfx+s1]/dt; - tbl->ptr.pp_double[p][4+1*4+1] = c->f.ptr.p_double[sfxy+s1]/(dt*du); - tbl->ptr.pp_double[p][4+1*4+2] = -3*c->f.ptr.p_double[sfx+s1]/dt+3*c->f.ptr.p_double[sfx+s4]/dt-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-c->f.ptr.p_double[sfxy+s4]/(dt*du); - tbl->ptr.pp_double[p][4+1*4+3] = 2*c->f.ptr.p_double[sfx+s1]/dt-2*c->f.ptr.p_double[sfx+s4]/dt+c->f.ptr.p_double[sfxy+s1]/(dt*du)+c->f.ptr.p_double[sfxy+s4]/(dt*du); - tbl->ptr.pp_double[p][4+2*4+0] = -3*c->f.ptr.p_double[s1]+3*c->f.ptr.p_double[s2]-2*c->f.ptr.p_double[sfx+s1]/dt-c->f.ptr.p_double[sfx+s2]/dt; - tbl->ptr.pp_double[p][4+2*4+1] = -3*c->f.ptr.p_double[sfy+s1]/du+3*c->f.ptr.p_double[sfy+s2]/du-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-c->f.ptr.p_double[sfxy+s2]/(dt*du); - tbl->ptr.pp_double[p][4+2*4+2] = 9*c->f.ptr.p_double[s1]-9*c->f.ptr.p_double[s2]+9*c->f.ptr.p_double[s3]-9*c->f.ptr.p_double[s4]+6*c->f.ptr.p_double[sfx+s1]/dt+3*c->f.ptr.p_double[sfx+s2]/dt-3*c->f.ptr.p_double[sfx+s3]/dt-6*c->f.ptr.p_double[sfx+s4]/dt+6*c->f.ptr.p_double[sfy+s1]/du-6*c->f.ptr.p_double[sfy+s2]/du-3*c->f.ptr.p_double[sfy+s3]/du+3*c->f.ptr.p_double[sfy+s4]/du+4*c->f.ptr.p_double[sfxy+s1]/(dt*du)+2*c->f.ptr.p_double[sfxy+s2]/(dt*du)+c->f.ptr.p_double[sfxy+s3]/(dt*du)+2*c->f.ptr.p_double[sfxy+s4]/(dt*du); - tbl->ptr.pp_double[p][4+2*4+3] = -6*c->f.ptr.p_double[s1]+6*c->f.ptr.p_double[s2]-6*c->f.ptr.p_double[s3]+6*c->f.ptr.p_double[s4]-4*c->f.ptr.p_double[sfx+s1]/dt-2*c->f.ptr.p_double[sfx+s2]/dt+2*c->f.ptr.p_double[sfx+s3]/dt+4*c->f.ptr.p_double[sfx+s4]/dt-3*c->f.ptr.p_double[sfy+s1]/du+3*c->f.ptr.p_double[sfy+s2]/du+3*c->f.ptr.p_double[sfy+s3]/du-3*c->f.ptr.p_double[sfy+s4]/du-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-c->f.ptr.p_double[sfxy+s2]/(dt*du)-c->f.ptr.p_double[sfxy+s3]/(dt*du)-2*c->f.ptr.p_double[sfxy+s4]/(dt*du); - tbl->ptr.pp_double[p][4+3*4+0] = 2*c->f.ptr.p_double[s1]-2*c->f.ptr.p_double[s2]+c->f.ptr.p_double[sfx+s1]/dt+c->f.ptr.p_double[sfx+s2]/dt; - tbl->ptr.pp_double[p][4+3*4+1] = 2*c->f.ptr.p_double[sfy+s1]/du-2*c->f.ptr.p_double[sfy+s2]/du+c->f.ptr.p_double[sfxy+s1]/(dt*du)+c->f.ptr.p_double[sfxy+s2]/(dt*du); - tbl->ptr.pp_double[p][4+3*4+2] = -6*c->f.ptr.p_double[s1]+6*c->f.ptr.p_double[s2]-6*c->f.ptr.p_double[s3]+6*c->f.ptr.p_double[s4]-3*c->f.ptr.p_double[sfx+s1]/dt-3*c->f.ptr.p_double[sfx+s2]/dt+3*c->f.ptr.p_double[sfx+s3]/dt+3*c->f.ptr.p_double[sfx+s4]/dt-4*c->f.ptr.p_double[sfy+s1]/du+4*c->f.ptr.p_double[sfy+s2]/du+2*c->f.ptr.p_double[sfy+s3]/du-2*c->f.ptr.p_double[sfy+s4]/du-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-2*c->f.ptr.p_double[sfxy+s2]/(dt*du)-c->f.ptr.p_double[sfxy+s3]/(dt*du)-c->f.ptr.p_double[sfxy+s4]/(dt*du); - tbl->ptr.pp_double[p][4+3*4+3] = 4*c->f.ptr.p_double[s1]-4*c->f.ptr.p_double[s2]+4*c->f.ptr.p_double[s3]-4*c->f.ptr.p_double[s4]+2*c->f.ptr.p_double[sfx+s1]/dt+2*c->f.ptr.p_double[sfx+s2]/dt-2*c->f.ptr.p_double[sfx+s3]/dt-2*c->f.ptr.p_double[sfx+s4]/dt+2*c->f.ptr.p_double[sfy+s1]/du-2*c->f.ptr.p_double[sfy+s2]/du-2*c->f.ptr.p_double[sfy+s3]/du+2*c->f.ptr.p_double[sfy+s4]/du+c->f.ptr.p_double[sfxy+s1]/(dt*du)+c->f.ptr.p_double[sfxy+s2]/(dt*du)+c->f.ptr.p_double[sfxy+s3]/(dt*du)+c->f.ptr.p_double[sfxy+s4]/(dt*du); - } - - /* - * Rescale Cij - */ - for(ci=0; ci<=3; ci++) - { - for(cj=0; cj<=3; cj++) - { - tbl->ptr.pp_double[p][4+ci*4+cj] = tbl->ptr.pp_double[p][4+ci*4+cj]*ae_pow(dt, ci, _state)*ae_pow(du, cj, _state); - } - } - } - } - } -} - - -/************************************************************************* -This subroutine was deprecated in ALGLIB 3.6.0 - -We recommend you to switch to Spline2DBuildBilinearV(), which is more -flexible and accepts its arguments in more convenient order. - - -- ALGLIB PROJECT -- - Copyright 05.07.2007 by Bochkanov Sergey -*************************************************************************/ -void spline2dbuildbilinear(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_matrix* f, - ae_int_t m, - ae_int_t n, - spline2dinterpolant* c, - ae_state *_state) -{ - double t; - ae_int_t i; - ae_int_t j; - ae_int_t k; - - _spline2dinterpolant_clear(c); - - ae_assert(n>=2, "Spline2DBuildBilinear: N<2", _state); - ae_assert(m>=2, "Spline2DBuildBilinear: M<2", _state); - ae_assert(x->cnt>=n&&y->cnt>=m, "Spline2DBuildBilinear: length of X or Y is too short (Length(X/Y)rows>=m&&f->cols>=n, "Spline2DBuildBilinear: size of F is too small (rows(F)k = 1; - c->n = n; - c->m = m; - c->d = 1; - c->stype = -1; - ae_vector_set_length(&c->x, c->n, _state); - ae_vector_set_length(&c->y, c->m, _state); - ae_vector_set_length(&c->f, c->n*c->m, _state); - for(i=0; i<=c->n-1; i++) - { - c->x.ptr.p_double[i] = x->ptr.p_double[i]; - } - for(i=0; i<=c->m-1; i++) - { - c->y.ptr.p_double[i] = y->ptr.p_double[i]; - } - for(i=0; i<=c->m-1; i++) - { - for(j=0; j<=c->n-1; j++) - { - c->f.ptr.p_double[i*c->n+j] = f->ptr.pp_double[i][j]; - } - } - - /* - * Sort points - */ - for(j=0; j<=c->n-1; j++) - { - k = j; - for(i=j+1; i<=c->n-1; i++) - { - if( ae_fp_less(c->x.ptr.p_double[i],c->x.ptr.p_double[k]) ) - { - k = i; - } - } - if( k!=j ) - { - for(i=0; i<=c->m-1; i++) - { - t = c->f.ptr.p_double[i*c->n+j]; - c->f.ptr.p_double[i*c->n+j] = c->f.ptr.p_double[i*c->n+k]; - c->f.ptr.p_double[i*c->n+k] = t; - } - t = c->x.ptr.p_double[j]; - c->x.ptr.p_double[j] = c->x.ptr.p_double[k]; - c->x.ptr.p_double[k] = t; - } - } - for(i=0; i<=c->m-1; i++) - { - k = i; - for(j=i+1; j<=c->m-1; j++) - { - if( ae_fp_less(c->y.ptr.p_double[j],c->y.ptr.p_double[k]) ) - { - k = j; - } - } - if( k!=i ) - { - for(j=0; j<=c->n-1; j++) - { - t = c->f.ptr.p_double[i*c->n+j]; - c->f.ptr.p_double[i*c->n+j] = c->f.ptr.p_double[k*c->n+j]; - c->f.ptr.p_double[k*c->n+j] = t; - } - t = c->y.ptr.p_double[i]; - c->y.ptr.p_double[i] = c->y.ptr.p_double[k]; - c->y.ptr.p_double[k] = t; - } - } -} - - -/************************************************************************* -This subroutine was deprecated in ALGLIB 3.6.0 - -We recommend you to switch to Spline2DBuildBicubicV(), which is more -flexible and accepts its arguments in more convenient order. - - -- ALGLIB PROJECT -- - Copyright 05.07.2007 by Bochkanov Sergey -*************************************************************************/ -void spline2dbuildbicubic(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_matrix* f, - ae_int_t m, - ae_int_t n, - spline2dinterpolant* c, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix _f; - ae_int_t sfx; - ae_int_t sfy; - ae_int_t sfxy; - ae_matrix dx; - ae_matrix dy; - ae_matrix dxy; - double t; - ae_int_t i; - ae_int_t j; - ae_int_t k; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init_copy(&_f, f, _state, ae_true); - f = &_f; - _spline2dinterpolant_clear(c); - ae_matrix_init(&dx, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&dy, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&dxy, 0, 0, DT_REAL, _state, ae_true); - - ae_assert(n>=2, "Spline2DBuildBicubicSpline: N<2", _state); - ae_assert(m>=2, "Spline2DBuildBicubicSpline: M<2", _state); - ae_assert(x->cnt>=n&&y->cnt>=m, "Spline2DBuildBicubic: length of X or Y is too short (Length(X/Y)rows>=m&&f->cols>=n, "Spline2DBuildBicubic: size of F is too small (rows(F)k = 3; - c->d = 1; - c->n = n; - c->m = m; - c->stype = -3; - sfx = c->n*c->m; - sfy = 2*c->n*c->m; - sfxy = 3*c->n*c->m; - ae_vector_set_length(&c->x, c->n, _state); - ae_vector_set_length(&c->y, c->m, _state); - ae_vector_set_length(&c->f, 4*c->n*c->m, _state); - for(i=0; i<=c->n-1; i++) - { - c->x.ptr.p_double[i] = x->ptr.p_double[i]; - } - for(i=0; i<=c->m-1; i++) - { - c->y.ptr.p_double[i] = y->ptr.p_double[i]; - } - - /* - * Sort points - */ - for(j=0; j<=c->n-1; j++) - { - k = j; - for(i=j+1; i<=c->n-1; i++) - { - if( ae_fp_less(c->x.ptr.p_double[i],c->x.ptr.p_double[k]) ) - { - k = i; - } - } - if( k!=j ) - { - for(i=0; i<=c->m-1; i++) - { - t = f->ptr.pp_double[i][j]; - f->ptr.pp_double[i][j] = f->ptr.pp_double[i][k]; - f->ptr.pp_double[i][k] = t; - } - t = c->x.ptr.p_double[j]; - c->x.ptr.p_double[j] = c->x.ptr.p_double[k]; - c->x.ptr.p_double[k] = t; - } - } - for(i=0; i<=c->m-1; i++) - { - k = i; - for(j=i+1; j<=c->m-1; j++) - { - if( ae_fp_less(c->y.ptr.p_double[j],c->y.ptr.p_double[k]) ) - { - k = j; - } - } - if( k!=i ) - { - for(j=0; j<=c->n-1; j++) - { - t = f->ptr.pp_double[i][j]; - f->ptr.pp_double[i][j] = f->ptr.pp_double[k][j]; - f->ptr.pp_double[k][j] = t; - } - t = c->y.ptr.p_double[i]; - c->y.ptr.p_double[i] = c->y.ptr.p_double[k]; - c->y.ptr.p_double[k] = t; - } - } - spline2d_bicubiccalcderivatives(f, &c->x, &c->y, c->m, c->n, &dx, &dy, &dxy, _state); - for(i=0; i<=c->m-1; i++) - { - for(j=0; j<=c->n-1; j++) - { - k = i*c->n+j; - c->f.ptr.p_double[k] = f->ptr.pp_double[i][j]; - c->f.ptr.p_double[sfx+k] = dx.ptr.pp_double[i][j]; - c->f.ptr.p_double[sfy+k] = dy.ptr.pp_double[i][j]; - c->f.ptr.p_double[sfxy+k] = dxy.ptr.pp_double[i][j]; - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -This subroutine was deprecated in ALGLIB 3.6.0 - -We recommend you to switch to Spline2DUnpackV(), which is more flexible -and accepts its arguments in more convenient order. - - -- ALGLIB PROJECT -- - Copyright 29.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline2dunpack(spline2dinterpolant* c, - ae_int_t* m, - ae_int_t* n, - /* Real */ ae_matrix* tbl, - ae_state *_state) -{ - ae_int_t k; - ae_int_t p; - ae_int_t ci; - ae_int_t cj; - ae_int_t s1; - ae_int_t s2; - ae_int_t s3; - ae_int_t s4; - ae_int_t sfx; - ae_int_t sfy; - ae_int_t sfxy; - double y1; - double y2; - double y3; - double y4; - double dt; - double du; - ae_int_t i; - ae_int_t j; - - *m = 0; - *n = 0; - ae_matrix_clear(tbl); - - ae_assert(c->stype==-3||c->stype==-1, "Spline2DUnpack: incorrect C (incorrect parameter C.SType)", _state); - if( c->d!=1 ) - { - *n = 0; - *m = 0; - return; - } - *n = c->n; - *m = c->m; - ae_matrix_set_length(tbl, (*n-1)*(*m-1), 20, _state); - sfx = *n*(*m); - sfy = 2*(*n)*(*m); - sfxy = 3*(*n)*(*m); - - /* - * Fill - */ - for(i=0; i<=*m-2; i++) - { - for(j=0; j<=*n-2; j++) - { - p = i*(*n-1)+j; - tbl->ptr.pp_double[p][0] = c->x.ptr.p_double[j]; - tbl->ptr.pp_double[p][1] = c->x.ptr.p_double[j+1]; - tbl->ptr.pp_double[p][2] = c->y.ptr.p_double[i]; - tbl->ptr.pp_double[p][3] = c->y.ptr.p_double[i+1]; - dt = 1/(tbl->ptr.pp_double[p][1]-tbl->ptr.pp_double[p][0]); - du = 1/(tbl->ptr.pp_double[p][3]-tbl->ptr.pp_double[p][2]); - - /* - * Bilinear interpolation - */ - if( c->stype==-1 ) - { - for(k=4; k<=19; k++) - { - tbl->ptr.pp_double[p][k] = 0; - } - y1 = c->f.ptr.p_double[*n*i+j]; - y2 = c->f.ptr.p_double[*n*i+(j+1)]; - y3 = c->f.ptr.p_double[*n*(i+1)+(j+1)]; - y4 = c->f.ptr.p_double[*n*(i+1)+j]; - tbl->ptr.pp_double[p][4] = y1; - tbl->ptr.pp_double[p][4+1*4+0] = y2-y1; - tbl->ptr.pp_double[p][4+0*4+1] = y4-y1; - tbl->ptr.pp_double[p][4+1*4+1] = y3-y2-y4+y1; - } - - /* - * Bicubic interpolation - */ - if( c->stype==-3 ) - { - s1 = *n*i+j; - s2 = *n*i+(j+1); - s3 = *n*(i+1)+(j+1); - s4 = *n*(i+1)+j; - tbl->ptr.pp_double[p][4+0*4+0] = c->f.ptr.p_double[s1]; - tbl->ptr.pp_double[p][4+0*4+1] = c->f.ptr.p_double[sfy+s1]/du; - tbl->ptr.pp_double[p][4+0*4+2] = -3*c->f.ptr.p_double[s1]+3*c->f.ptr.p_double[s4]-2*c->f.ptr.p_double[sfy+s1]/du-c->f.ptr.p_double[sfy+s4]/du; - tbl->ptr.pp_double[p][4+0*4+3] = 2*c->f.ptr.p_double[s1]-2*c->f.ptr.p_double[s4]+c->f.ptr.p_double[sfy+s1]/du+c->f.ptr.p_double[sfy+s4]/du; - tbl->ptr.pp_double[p][4+1*4+0] = c->f.ptr.p_double[sfx+s1]/dt; - tbl->ptr.pp_double[p][4+1*4+1] = c->f.ptr.p_double[sfxy+s1]/(dt*du); - tbl->ptr.pp_double[p][4+1*4+2] = -3*c->f.ptr.p_double[sfx+s1]/dt+3*c->f.ptr.p_double[sfx+s4]/dt-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-c->f.ptr.p_double[sfxy+s4]/(dt*du); - tbl->ptr.pp_double[p][4+1*4+3] = 2*c->f.ptr.p_double[sfx+s1]/dt-2*c->f.ptr.p_double[sfx+s4]/dt+c->f.ptr.p_double[sfxy+s1]/(dt*du)+c->f.ptr.p_double[sfxy+s4]/(dt*du); - tbl->ptr.pp_double[p][4+2*4+0] = -3*c->f.ptr.p_double[s1]+3*c->f.ptr.p_double[s2]-2*c->f.ptr.p_double[sfx+s1]/dt-c->f.ptr.p_double[sfx+s2]/dt; - tbl->ptr.pp_double[p][4+2*4+1] = -3*c->f.ptr.p_double[sfy+s1]/du+3*c->f.ptr.p_double[sfy+s2]/du-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-c->f.ptr.p_double[sfxy+s2]/(dt*du); - tbl->ptr.pp_double[p][4+2*4+2] = 9*c->f.ptr.p_double[s1]-9*c->f.ptr.p_double[s2]+9*c->f.ptr.p_double[s3]-9*c->f.ptr.p_double[s4]+6*c->f.ptr.p_double[sfx+s1]/dt+3*c->f.ptr.p_double[sfx+s2]/dt-3*c->f.ptr.p_double[sfx+s3]/dt-6*c->f.ptr.p_double[sfx+s4]/dt+6*c->f.ptr.p_double[sfy+s1]/du-6*c->f.ptr.p_double[sfy+s2]/du-3*c->f.ptr.p_double[sfy+s3]/du+3*c->f.ptr.p_double[sfy+s4]/du+4*c->f.ptr.p_double[sfxy+s1]/(dt*du)+2*c->f.ptr.p_double[sfxy+s2]/(dt*du)+c->f.ptr.p_double[sfxy+s3]/(dt*du)+2*c->f.ptr.p_double[sfxy+s4]/(dt*du); - tbl->ptr.pp_double[p][4+2*4+3] = -6*c->f.ptr.p_double[s1]+6*c->f.ptr.p_double[s2]-6*c->f.ptr.p_double[s3]+6*c->f.ptr.p_double[s4]-4*c->f.ptr.p_double[sfx+s1]/dt-2*c->f.ptr.p_double[sfx+s2]/dt+2*c->f.ptr.p_double[sfx+s3]/dt+4*c->f.ptr.p_double[sfx+s4]/dt-3*c->f.ptr.p_double[sfy+s1]/du+3*c->f.ptr.p_double[sfy+s2]/du+3*c->f.ptr.p_double[sfy+s3]/du-3*c->f.ptr.p_double[sfy+s4]/du-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-c->f.ptr.p_double[sfxy+s2]/(dt*du)-c->f.ptr.p_double[sfxy+s3]/(dt*du)-2*c->f.ptr.p_double[sfxy+s4]/(dt*du); - tbl->ptr.pp_double[p][4+3*4+0] = 2*c->f.ptr.p_double[s1]-2*c->f.ptr.p_double[s2]+c->f.ptr.p_double[sfx+s1]/dt+c->f.ptr.p_double[sfx+s2]/dt; - tbl->ptr.pp_double[p][4+3*4+1] = 2*c->f.ptr.p_double[sfy+s1]/du-2*c->f.ptr.p_double[sfy+s2]/du+c->f.ptr.p_double[sfxy+s1]/(dt*du)+c->f.ptr.p_double[sfxy+s2]/(dt*du); - tbl->ptr.pp_double[p][4+3*4+2] = -6*c->f.ptr.p_double[s1]+6*c->f.ptr.p_double[s2]-6*c->f.ptr.p_double[s3]+6*c->f.ptr.p_double[s4]-3*c->f.ptr.p_double[sfx+s1]/dt-3*c->f.ptr.p_double[sfx+s2]/dt+3*c->f.ptr.p_double[sfx+s3]/dt+3*c->f.ptr.p_double[sfx+s4]/dt-4*c->f.ptr.p_double[sfy+s1]/du+4*c->f.ptr.p_double[sfy+s2]/du+2*c->f.ptr.p_double[sfy+s3]/du-2*c->f.ptr.p_double[sfy+s4]/du-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-2*c->f.ptr.p_double[sfxy+s2]/(dt*du)-c->f.ptr.p_double[sfxy+s3]/(dt*du)-c->f.ptr.p_double[sfxy+s4]/(dt*du); - tbl->ptr.pp_double[p][4+3*4+3] = 4*c->f.ptr.p_double[s1]-4*c->f.ptr.p_double[s2]+4*c->f.ptr.p_double[s3]-4*c->f.ptr.p_double[s4]+2*c->f.ptr.p_double[sfx+s1]/dt+2*c->f.ptr.p_double[sfx+s2]/dt-2*c->f.ptr.p_double[sfx+s3]/dt-2*c->f.ptr.p_double[sfx+s4]/dt+2*c->f.ptr.p_double[sfy+s1]/du-2*c->f.ptr.p_double[sfy+s2]/du-2*c->f.ptr.p_double[sfy+s3]/du+2*c->f.ptr.p_double[sfy+s4]/du+c->f.ptr.p_double[sfxy+s1]/(dt*du)+c->f.ptr.p_double[sfxy+s2]/(dt*du)+c->f.ptr.p_double[sfxy+s3]/(dt*du)+c->f.ptr.p_double[sfxy+s4]/(dt*du); - } - - /* - * Rescale Cij - */ - for(ci=0; ci<=3; ci++) - { - for(cj=0; cj<=3; cj++) - { - tbl->ptr.pp_double[p][4+ci*4+cj] = tbl->ptr.pp_double[p][4+ci*4+cj]*ae_pow(dt, ci, _state)*ae_pow(du, cj, _state); - } - } - } - } -} - - -/************************************************************************* -Internal subroutine. -Calculation of the first derivatives and the cross-derivative. -*************************************************************************/ -static void spline2d_bicubiccalcderivatives(/* Real */ ae_matrix* a, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* dx, - /* Real */ ae_matrix* dy, - /* Real */ ae_matrix* dxy, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - ae_vector xt; - ae_vector ft; - double s; - double ds; - double d2s; - spline1dinterpolant c; - - ae_frame_make(_state, &_frame_block); - ae_matrix_clear(dx); - ae_matrix_clear(dy); - ae_matrix_clear(dxy); - ae_vector_init(&xt, 0, DT_REAL, _state, ae_true); - ae_vector_init(&ft, 0, DT_REAL, _state, ae_true); - _spline1dinterpolant_init(&c, _state, ae_true); - - ae_matrix_set_length(dx, m, n, _state); - ae_matrix_set_length(dy, m, n, _state); - ae_matrix_set_length(dxy, m, n, _state); - - /* - * dF/dX - */ - ae_vector_set_length(&xt, n, _state); - ae_vector_set_length(&ft, n, _state); - for(i=0; i<=m-1; i++) - { - for(j=0; j<=n-1; j++) - { - xt.ptr.p_double[j] = x->ptr.p_double[j]; - ft.ptr.p_double[j] = a->ptr.pp_double[i][j]; - } - spline1dbuildcubic(&xt, &ft, n, 0, 0.0, 0, 0.0, &c, _state); - for(j=0; j<=n-1; j++) - { - spline1ddiff(&c, x->ptr.p_double[j], &s, &ds, &d2s, _state); - dx->ptr.pp_double[i][j] = ds; - } - } - - /* - * dF/dY - */ - ae_vector_set_length(&xt, m, _state); - ae_vector_set_length(&ft, m, _state); - for(j=0; j<=n-1; j++) - { - for(i=0; i<=m-1; i++) - { - xt.ptr.p_double[i] = y->ptr.p_double[i]; - ft.ptr.p_double[i] = a->ptr.pp_double[i][j]; - } - spline1dbuildcubic(&xt, &ft, m, 0, 0.0, 0, 0.0, &c, _state); - for(i=0; i<=m-1; i++) - { - spline1ddiff(&c, y->ptr.p_double[i], &s, &ds, &d2s, _state); - dy->ptr.pp_double[i][j] = ds; - } - } - - /* - * d2F/dXdY - */ - ae_vector_set_length(&xt, n, _state); - ae_vector_set_length(&ft, n, _state); - for(i=0; i<=m-1; i++) - { - for(j=0; j<=n-1; j++) - { - xt.ptr.p_double[j] = x->ptr.p_double[j]; - ft.ptr.p_double[j] = dy->ptr.pp_double[i][j]; - } - spline1dbuildcubic(&xt, &ft, n, 0, 0.0, 0, 0.0, &c, _state); - for(j=0; j<=n-1; j++) - { - spline1ddiff(&c, x->ptr.p_double[j], &s, &ds, &d2s, _state); - dxy->ptr.pp_double[i][j] = ds; - } - } - ae_frame_leave(_state); -} - - -ae_bool _spline2dinterpolant_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - spline2dinterpolant *p = (spline2dinterpolant*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->y, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->f, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _spline2dinterpolant_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - spline2dinterpolant *dst = (spline2dinterpolant*)_dst; - spline2dinterpolant *src = (spline2dinterpolant*)_src; - dst->k = src->k; - dst->stype = src->stype; - dst->n = src->n; - dst->m = src->m; - dst->d = src->d; - if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->y, &src->y, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->f, &src->f, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _spline2dinterpolant_clear(void* _p) -{ - spline2dinterpolant *p = (spline2dinterpolant*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->x); - ae_vector_clear(&p->y); - ae_vector_clear(&p->f); -} - - -void _spline2dinterpolant_destroy(void* _p) -{ - spline2dinterpolant *p = (spline2dinterpolant*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->x); - ae_vector_destroy(&p->y); - ae_vector_destroy(&p->f); -} - - - - -/************************************************************************* -This subroutine calculates the value of the trilinear or tricubic spline at -the given point (X,Y,Z). - -INPUT PARAMETERS: - C - coefficients table. - Built by BuildBilinearSpline or BuildBicubicSpline. - X, Y, - Z - point - -Result: - S(x,y,z) - - -- ALGLIB PROJECT -- - Copyright 26.04.2012 by Bochkanov Sergey -*************************************************************************/ -double spline3dcalc(spline3dinterpolant* c, - double x, - double y, - double z, - ae_state *_state) -{ - double v; - double vx; - double vy; - double vxy; - double result; - - - ae_assert(c->stype==-1||c->stype==-3, "Spline3DCalc: incorrect C (incorrect parameter C.SType)", _state); - ae_assert((ae_isfinite(x, _state)&&ae_isfinite(y, _state))&&ae_isfinite(z, _state), "Spline3DCalc: X=NaN/Infinite, Y=NaN/Infinite or Z=NaN/Infinite", _state); - if( c->d!=1 ) - { - result = 0; - return result; - } - spline3d_spline3ddiff(c, x, y, z, &v, &vx, &vy, &vxy, _state); - result = v; - return result; -} - - -/************************************************************************* -This subroutine performs linear transformation of the spline argument. - -INPUT PARAMETERS: - C - spline interpolant - AX, BX - transformation coefficients: x = A*u + B - AY, BY - transformation coefficients: y = A*v + B - AZ, BZ - transformation coefficients: z = A*w + B - -OUTPUT PARAMETERS: - C - transformed spline - - -- ALGLIB PROJECT -- - Copyright 26.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline3dlintransxyz(spline3dinterpolant* c, - double ax, - double bx, - double ay, - double by, - double az, - double bz, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector x; - ae_vector y; - ae_vector z; - ae_vector f; - ae_vector v; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t di; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&x, 0, DT_REAL, _state, ae_true); - ae_vector_init(&y, 0, DT_REAL, _state, ae_true); - ae_vector_init(&z, 0, DT_REAL, _state, ae_true); - ae_vector_init(&f, 0, DT_REAL, _state, ae_true); - ae_vector_init(&v, 0, DT_REAL, _state, ae_true); - - ae_assert(c->stype==-3||c->stype==-1, "Spline3DLinTransXYZ: incorrect C (incorrect parameter C.SType)", _state); - ae_vector_set_length(&x, c->n, _state); - ae_vector_set_length(&y, c->m, _state); - ae_vector_set_length(&z, c->l, _state); - ae_vector_set_length(&f, c->m*c->n*c->l*c->d, _state); - for(j=0; j<=c->n-1; j++) - { - x.ptr.p_double[j] = c->x.ptr.p_double[j]; - } - for(i=0; i<=c->m-1; i++) - { - y.ptr.p_double[i] = c->y.ptr.p_double[i]; - } - for(i=0; i<=c->l-1; i++) - { - z.ptr.p_double[i] = c->z.ptr.p_double[i]; - } - - /* - * Handle different combinations of zero/nonzero AX/AY/AZ - */ - if( (ae_fp_neq(ax,0)&&ae_fp_neq(ay,0))&&ae_fp_neq(az,0) ) - { - ae_v_move(&f.ptr.p_double[0], 1, &c->f.ptr.p_double[0], 1, ae_v_len(0,c->m*c->n*c->l*c->d-1)); - } - if( (ae_fp_eq(ax,0)&&ae_fp_neq(ay,0))&&ae_fp_neq(az,0) ) - { - for(i=0; i<=c->m-1; i++) - { - for(j=0; j<=c->l-1; j++) - { - spline3dcalcv(c, bx, y.ptr.p_double[i], z.ptr.p_double[j], &v, _state); - for(k=0; k<=c->n-1; k++) - { - for(di=0; di<=c->d-1; di++) - { - f.ptr.p_double[c->d*(c->n*(c->m*j+i)+k)+di] = v.ptr.p_double[di]; - } - } - } - } - ax = 1; - bx = 0; - } - if( (ae_fp_neq(ax,0)&&ae_fp_eq(ay,0))&&ae_fp_neq(az,0) ) - { - for(i=0; i<=c->n-1; i++) - { - for(j=0; j<=c->l-1; j++) - { - spline3dcalcv(c, x.ptr.p_double[i], by, z.ptr.p_double[j], &v, _state); - for(k=0; k<=c->m-1; k++) - { - for(di=0; di<=c->d-1; di++) - { - f.ptr.p_double[c->d*(c->n*(c->m*j+k)+i)+di] = v.ptr.p_double[di]; - } - } - } - } - ay = 1; - by = 0; - } - if( (ae_fp_neq(ax,0)&&ae_fp_neq(ay,0))&&ae_fp_eq(az,0) ) - { - for(i=0; i<=c->n-1; i++) - { - for(j=0; j<=c->m-1; j++) - { - spline3dcalcv(c, x.ptr.p_double[i], y.ptr.p_double[j], bz, &v, _state); - for(k=0; k<=c->l-1; k++) - { - for(di=0; di<=c->d-1; di++) - { - f.ptr.p_double[c->d*(c->n*(c->m*k+j)+i)+di] = v.ptr.p_double[di]; - } - } - } - } - az = 1; - bz = 0; - } - if( (ae_fp_eq(ax,0)&&ae_fp_eq(ay,0))&&ae_fp_neq(az,0) ) - { - for(i=0; i<=c->l-1; i++) - { - spline3dcalcv(c, bx, by, z.ptr.p_double[i], &v, _state); - for(k=0; k<=c->m-1; k++) - { - for(j=0; j<=c->n-1; j++) - { - for(di=0; di<=c->d-1; di++) - { - f.ptr.p_double[c->d*(c->n*(c->m*i+k)+j)+di] = v.ptr.p_double[di]; - } - } - } - } - ax = 1; - bx = 0; - ay = 1; - by = 0; - } - if( (ae_fp_eq(ax,0)&&ae_fp_neq(ay,0))&&ae_fp_eq(az,0) ) - { - for(i=0; i<=c->m-1; i++) - { - spline3dcalcv(c, bx, y.ptr.p_double[i], bz, &v, _state); - for(k=0; k<=c->l-1; k++) - { - for(j=0; j<=c->n-1; j++) - { - for(di=0; di<=c->d-1; di++) - { - f.ptr.p_double[c->d*(c->n*(c->m*k+i)+j)+di] = v.ptr.p_double[di]; - } - } - } - } - ax = 1; - bx = 0; - az = 1; - bz = 0; - } - if( (ae_fp_neq(ax,0)&&ae_fp_eq(ay,0))&&ae_fp_eq(az,0) ) - { - for(i=0; i<=c->n-1; i++) - { - spline3dcalcv(c, x.ptr.p_double[i], by, bz, &v, _state); - for(k=0; k<=c->l-1; k++) - { - for(j=0; j<=c->m-1; j++) - { - for(di=0; di<=c->d-1; di++) - { - f.ptr.p_double[c->d*(c->n*(c->m*k+j)+i)+di] = v.ptr.p_double[di]; - } - } - } - } - ay = 1; - by = 0; - az = 1; - bz = 0; - } - if( (ae_fp_eq(ax,0)&&ae_fp_eq(ay,0))&&ae_fp_eq(az,0) ) - { - spline3dcalcv(c, bx, by, bz, &v, _state); - for(k=0; k<=c->l-1; k++) - { - for(j=0; j<=c->m-1; j++) - { - for(i=0; i<=c->n-1; i++) - { - for(di=0; di<=c->d-1; di++) - { - f.ptr.p_double[c->d*(c->n*(c->m*k+j)+i)+di] = v.ptr.p_double[di]; - } - } - } - } - ax = 1; - bx = 0; - ay = 1; - by = 0; - az = 1; - bz = 0; - } - - /* - * General case: AX<>0, AY<>0, AZ<>0 - * Unpack, scale and pack again. - */ - for(i=0; i<=c->n-1; i++) - { - x.ptr.p_double[i] = (x.ptr.p_double[i]-bx)/ax; - } - for(i=0; i<=c->m-1; i++) - { - y.ptr.p_double[i] = (y.ptr.p_double[i]-by)/ay; - } - for(i=0; i<=c->l-1; i++) - { - z.ptr.p_double[i] = (z.ptr.p_double[i]-bz)/az; - } - if( c->stype==-1 ) - { - spline3dbuildtrilinearv(&x, c->n, &y, c->m, &z, c->l, &f, c->d, c, _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -This subroutine performs linear transformation of the spline. - -INPUT PARAMETERS: - C - spline interpolant. - A, B- transformation coefficients: S2(x,y) = A*S(x,y,z) + B - -OUTPUT PARAMETERS: - C - transformed spline - - -- ALGLIB PROJECT -- - Copyright 26.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline3dlintransf(spline3dinterpolant* c, - double a, - double b, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector x; - ae_vector y; - ae_vector z; - ae_vector f; - ae_int_t i; - ae_int_t j; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&x, 0, DT_REAL, _state, ae_true); - ae_vector_init(&y, 0, DT_REAL, _state, ae_true); - ae_vector_init(&z, 0, DT_REAL, _state, ae_true); - ae_vector_init(&f, 0, DT_REAL, _state, ae_true); - - ae_assert(c->stype==-3||c->stype==-1, "Spline3DLinTransF: incorrect C (incorrect parameter C.SType)", _state); - ae_vector_set_length(&x, c->n, _state); - ae_vector_set_length(&y, c->m, _state); - ae_vector_set_length(&z, c->l, _state); - ae_vector_set_length(&f, c->m*c->n*c->l*c->d, _state); - for(j=0; j<=c->n-1; j++) - { - x.ptr.p_double[j] = c->x.ptr.p_double[j]; - } - for(i=0; i<=c->m-1; i++) - { - y.ptr.p_double[i] = c->y.ptr.p_double[i]; - } - for(i=0; i<=c->l-1; i++) - { - z.ptr.p_double[i] = c->z.ptr.p_double[i]; - } - for(i=0; i<=c->m*c->n*c->l*c->d-1; i++) - { - f.ptr.p_double[i] = a*c->f.ptr.p_double[i]+b; - } - if( c->stype==-1 ) - { - spline3dbuildtrilinearv(&x, c->n, &y, c->m, &z, c->l, &f, c->d, c, _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -This subroutine makes the copy of the spline model. - -INPUT PARAMETERS: - C - spline interpolant - -OUTPUT PARAMETERS: - CC - spline copy - - -- ALGLIB PROJECT -- - Copyright 26.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline3dcopy(spline3dinterpolant* c, - spline3dinterpolant* cc, - ae_state *_state) -{ - ae_int_t tblsize; - - _spline3dinterpolant_clear(cc); - - ae_assert(c->k==1||c->k==3, "Spline3DCopy: incorrect C (incorrect parameter C.K)", _state); - cc->k = c->k; - cc->n = c->n; - cc->m = c->m; - cc->l = c->l; - cc->d = c->d; - tblsize = c->n*c->m*c->l*c->d; - cc->stype = c->stype; - ae_vector_set_length(&cc->x, cc->n, _state); - ae_vector_set_length(&cc->y, cc->m, _state); - ae_vector_set_length(&cc->z, cc->l, _state); - ae_vector_set_length(&cc->f, tblsize, _state); - ae_v_move(&cc->x.ptr.p_double[0], 1, &c->x.ptr.p_double[0], 1, ae_v_len(0,cc->n-1)); - ae_v_move(&cc->y.ptr.p_double[0], 1, &c->y.ptr.p_double[0], 1, ae_v_len(0,cc->m-1)); - ae_v_move(&cc->z.ptr.p_double[0], 1, &c->z.ptr.p_double[0], 1, ae_v_len(0,cc->l-1)); - ae_v_move(&cc->f.ptr.p_double[0], 1, &c->f.ptr.p_double[0], 1, ae_v_len(0,tblsize-1)); -} - - -/************************************************************************* -Trilinear spline resampling - -INPUT PARAMETERS: - A - array[0..OldXCount*OldYCount*OldZCount-1], function - values at the old grid, : - A[0] x=0,y=0,z=0 - A[1] x=1,y=0,z=0 - A[..] ... - A[..] x=oldxcount-1,y=0,z=0 - A[..] x=0,y=1,z=0 - A[..] ... - ... - OldZCount - old Z-count, OldZCount>1 - OldYCount - old Y-count, OldYCount>1 - OldXCount - old X-count, OldXCount>1 - NewZCount - new Z-count, NewZCount>1 - NewYCount - new Y-count, NewYCount>1 - NewXCount - new X-count, NewXCount>1 - -OUTPUT PARAMETERS: - B - array[0..NewXCount*NewYCount*NewZCount-1], function - values at the new grid: - B[0] x=0,y=0,z=0 - B[1] x=1,y=0,z=0 - B[..] ... - B[..] x=newxcount-1,y=0,z=0 - B[..] x=0,y=1,z=0 - B[..] ... - ... - - -- ALGLIB routine -- - 26.04.2012 - Copyright by Bochkanov Sergey -*************************************************************************/ -void spline3dresampletrilinear(/* Real */ ae_vector* a, - ae_int_t oldzcount, - ae_int_t oldycount, - ae_int_t oldxcount, - ae_int_t newzcount, - ae_int_t newycount, - ae_int_t newxcount, - /* Real */ ae_vector* b, - ae_state *_state) -{ - double xd; - double yd; - double zd; - double c0; - double c1; - double c2; - double c3; - ae_int_t ix; - ae_int_t iy; - ae_int_t iz; - ae_int_t i; - ae_int_t j; - ae_int_t k; - - ae_vector_clear(b); - - ae_assert((oldycount>1&&oldzcount>1)&&oldxcount>1, "Spline3DResampleTrilinear: length/width/height less than 1", _state); - ae_assert((newycount>1&&newzcount>1)&&newxcount>1, "Spline3DResampleTrilinear: length/width/height less than 1", _state); - ae_assert(a->cnt>=oldycount*oldzcount*oldxcount, "Spline3DResampleTrilinear: length/width/height less than 1", _state); - ae_vector_set_length(b, newxcount*newycount*newzcount, _state); - for(i=0; i<=newxcount-1; i++) - { - for(j=0; j<=newycount-1; j++) - { - for(k=0; k<=newzcount-1; k++) - { - ix = i*(oldxcount-1)/(newxcount-1); - if( ix==oldxcount-1 ) - { - ix = oldxcount-2; - } - xd = (double)(i*(oldxcount-1))/(double)(newxcount-1)-ix; - iy = j*(oldycount-1)/(newycount-1); - if( iy==oldycount-1 ) - { - iy = oldycount-2; - } - yd = (double)(j*(oldycount-1))/(double)(newycount-1)-iy; - iz = k*(oldzcount-1)/(newzcount-1); - if( iz==oldzcount-1 ) - { - iz = oldzcount-2; - } - zd = (double)(k*(oldzcount-1))/(double)(newzcount-1)-iz; - c0 = a->ptr.p_double[oldxcount*(oldycount*iz+iy)+ix]*(1-xd)+a->ptr.p_double[oldxcount*(oldycount*iz+iy)+(ix+1)]*xd; - c1 = a->ptr.p_double[oldxcount*(oldycount*iz+(iy+1))+ix]*(1-xd)+a->ptr.p_double[oldxcount*(oldycount*iz+(iy+1))+(ix+1)]*xd; - c2 = a->ptr.p_double[oldxcount*(oldycount*(iz+1)+iy)+ix]*(1-xd)+a->ptr.p_double[oldxcount*(oldycount*(iz+1)+iy)+(ix+1)]*xd; - c3 = a->ptr.p_double[oldxcount*(oldycount*(iz+1)+(iy+1))+ix]*(1-xd)+a->ptr.p_double[oldxcount*(oldycount*(iz+1)+(iy+1))+(ix+1)]*xd; - c0 = c0*(1-yd)+c1*yd; - c1 = c2*(1-yd)+c3*yd; - b->ptr.p_double[newxcount*(newycount*k+j)+i] = c0*(1-zd)+c1*zd; - } - } - } -} - - -/************************************************************************* -This subroutine builds trilinear vector-valued spline. - -INPUT PARAMETERS: - X - spline abscissas, array[0..N-1] - Y - spline ordinates, array[0..M-1] - Z - spline applicates, array[0..L-1] - F - function values, array[0..M*N*L*D-1]: - * first D elements store D values at (X[0],Y[0],Z[0]) - * next D elements store D values at (X[1],Y[0],Z[0]) - * next D elements store D values at (X[2],Y[0],Z[0]) - * ... - * next D elements store D values at (X[0],Y[1],Z[0]) - * next D elements store D values at (X[1],Y[1],Z[0]) - * next D elements store D values at (X[2],Y[1],Z[0]) - * ... - * next D elements store D values at (X[0],Y[0],Z[1]) - * next D elements store D values at (X[1],Y[0],Z[1]) - * next D elements store D values at (X[2],Y[0],Z[1]) - * ... - * general form - D function values at (X[i],Y[j]) are stored - at F[D*(N*(M*K+J)+I)...D*(N*(M*K+J)+I)+D-1]. - M,N, - L - grid size, M>=2, N>=2, L>=2 - D - vector dimension, D>=1 - -OUTPUT PARAMETERS: - C - spline interpolant - - -- ALGLIB PROJECT -- - Copyright 26.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline3dbuildtrilinearv(/* Real */ ae_vector* x, - ae_int_t n, - /* Real */ ae_vector* y, - ae_int_t m, - /* Real */ ae_vector* z, - ae_int_t l, - /* Real */ ae_vector* f, - ae_int_t d, - spline3dinterpolant* c, - ae_state *_state) -{ - double t; - ae_int_t tblsize; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t i0; - ae_int_t j0; - - _spline3dinterpolant_clear(c); - - ae_assert(m>=2, "Spline3DBuildTrilinearV: M<2", _state); - ae_assert(n>=2, "Spline3DBuildTrilinearV: N<2", _state); - ae_assert(l>=2, "Spline3DBuildTrilinearV: L<2", _state); - ae_assert(d>=1, "Spline3DBuildTrilinearV: D<1", _state); - ae_assert((x->cnt>=n&&y->cnt>=m)&&z->cnt>=l, "Spline3DBuildTrilinearV: length of X, Y or Z is too short (Length(X/Y/Z)cnt>=tblsize, "Spline3DBuildTrilinearV: length of F is too short (Length(F)k = 1; - c->n = n; - c->m = m; - c->l = l; - c->d = d; - c->stype = -1; - ae_vector_set_length(&c->x, c->n, _state); - ae_vector_set_length(&c->y, c->m, _state); - ae_vector_set_length(&c->z, c->l, _state); - ae_vector_set_length(&c->f, tblsize, _state); - for(i=0; i<=c->n-1; i++) - { - c->x.ptr.p_double[i] = x->ptr.p_double[i]; - } - for(i=0; i<=c->m-1; i++) - { - c->y.ptr.p_double[i] = y->ptr.p_double[i]; - } - for(i=0; i<=c->l-1; i++) - { - c->z.ptr.p_double[i] = z->ptr.p_double[i]; - } - for(i=0; i<=tblsize-1; i++) - { - c->f.ptr.p_double[i] = f->ptr.p_double[i]; - } - - /* - * Sort points: - * * sort x; - * * sort y; - * * sort z. - */ - for(j=0; j<=c->n-1; j++) - { - k = j; - for(i=j+1; i<=c->n-1; i++) - { - if( ae_fp_less(c->x.ptr.p_double[i],c->x.ptr.p_double[k]) ) - { - k = i; - } - } - if( k!=j ) - { - for(i=0; i<=c->m-1; i++) - { - for(j0=0; j0<=c->l-1; j0++) - { - for(i0=0; i0<=c->d-1; i0++) - { - t = c->f.ptr.p_double[c->d*(c->n*(c->m*j0+i)+j)+i0]; - c->f.ptr.p_double[c->d*(c->n*(c->m*j0+i)+j)+i0] = c->f.ptr.p_double[c->d*(c->n*(c->m*j0+i)+k)+i0]; - c->f.ptr.p_double[c->d*(c->n*(c->m*j0+i)+k)+i0] = t; - } - } - } - t = c->x.ptr.p_double[j]; - c->x.ptr.p_double[j] = c->x.ptr.p_double[k]; - c->x.ptr.p_double[k] = t; - } - } - for(i=0; i<=c->m-1; i++) - { - k = i; - for(j=i+1; j<=c->m-1; j++) - { - if( ae_fp_less(c->y.ptr.p_double[j],c->y.ptr.p_double[k]) ) - { - k = j; - } - } - if( k!=i ) - { - for(j=0; j<=c->n-1; j++) - { - for(j0=0; j0<=c->l-1; j0++) - { - for(i0=0; i0<=c->d-1; i0++) - { - t = c->f.ptr.p_double[c->d*(c->n*(c->m*j0+i)+j)+i0]; - c->f.ptr.p_double[c->d*(c->n*(c->m*j0+i)+j)+i0] = c->f.ptr.p_double[c->d*(c->n*(c->m*j0+k)+j)+i0]; - c->f.ptr.p_double[c->d*(c->n*(c->m*j0+k)+j)+i0] = t; - } - } - } - t = c->y.ptr.p_double[i]; - c->y.ptr.p_double[i] = c->y.ptr.p_double[k]; - c->y.ptr.p_double[k] = t; - } - } - for(k=0; k<=c->l-1; k++) - { - i = k; - for(j=i+1; j<=c->l-1; j++) - { - if( ae_fp_less(c->z.ptr.p_double[j],c->z.ptr.p_double[i]) ) - { - i = j; - } - } - if( i!=k ) - { - for(j=0; j<=c->m-1; j++) - { - for(j0=0; j0<=c->n-1; j0++) - { - for(i0=0; i0<=c->d-1; i0++) - { - t = c->f.ptr.p_double[c->d*(c->n*(c->m*k+j)+j0)+i0]; - c->f.ptr.p_double[c->d*(c->n*(c->m*k+j)+j0)+i0] = c->f.ptr.p_double[c->d*(c->n*(c->m*i+j)+j0)+i0]; - c->f.ptr.p_double[c->d*(c->n*(c->m*i+j)+j0)+i0] = t; - } - } - } - t = c->z.ptr.p_double[k]; - c->z.ptr.p_double[k] = c->z.ptr.p_double[i]; - c->z.ptr.p_double[i] = t; - } - } -} - - -/************************************************************************* -This subroutine calculates bilinear or bicubic vector-valued spline at the -given point (X,Y,Z). - -INPUT PARAMETERS: - C - spline interpolant. - X, Y, - Z - point - F - output buffer, possibly preallocated array. In case array size - is large enough to store result, it is not reallocated. Array - which is too short will be reallocated - -OUTPUT PARAMETERS: - F - array[D] (or larger) which stores function values - - -- ALGLIB PROJECT -- - Copyright 26.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline3dcalcvbuf(spline3dinterpolant* c, - double x, - double y, - double z, - /* Real */ ae_vector* f, - ae_state *_state) -{ - double xd; - double yd; - double zd; - double c0; - double c1; - double c2; - double c3; - ae_int_t ix; - ae_int_t iy; - ae_int_t iz; - ae_int_t l; - ae_int_t r; - ae_int_t h; - ae_int_t i; - - - ae_assert(c->stype==-1||c->stype==-3, "Spline3DCalcVBuf: incorrect C (incorrect parameter C.SType)", _state); - ae_assert((ae_isfinite(x, _state)&&ae_isfinite(y, _state))&&ae_isfinite(z, _state), "Spline3DCalcVBuf: X, Y or Z contains NaN/Infinite", _state); - rvectorsetlengthatleast(f, c->d, _state); - - /* - * Binary search in the [ x[0], ..., x[n-2] ] (x[n-1] is not included) - */ - l = 0; - r = c->n-1; - while(l!=r-1) - { - h = (l+r)/2; - if( ae_fp_greater_eq(c->x.ptr.p_double[h],x) ) - { - r = h; - } - else - { - l = h; - } - } - ix = l; - - /* - * Binary search in the [ y[0], ..., y[n-2] ] (y[n-1] is not included) - */ - l = 0; - r = c->m-1; - while(l!=r-1) - { - h = (l+r)/2; - if( ae_fp_greater_eq(c->y.ptr.p_double[h],y) ) - { - r = h; - } - else - { - l = h; - } - } - iy = l; - - /* - * Binary search in the [ z[0], ..., z[n-2] ] (z[n-1] is not included) - */ - l = 0; - r = c->l-1; - while(l!=r-1) - { - h = (l+r)/2; - if( ae_fp_greater_eq(c->z.ptr.p_double[h],z) ) - { - r = h; - } - else - { - l = h; - } - } - iz = l; - xd = (x-c->x.ptr.p_double[ix])/(c->x.ptr.p_double[ix+1]-c->x.ptr.p_double[ix]); - yd = (y-c->y.ptr.p_double[iy])/(c->y.ptr.p_double[iy+1]-c->y.ptr.p_double[iy]); - zd = (z-c->z.ptr.p_double[iz])/(c->z.ptr.p_double[iz+1]-c->z.ptr.p_double[iz]); - for(i=0; i<=c->d-1; i++) - { - - /* - * Trilinear interpolation - */ - if( c->stype==-1 ) - { - c0 = c->f.ptr.p_double[c->d*(c->n*(c->m*iz+iy)+ix)+i]*(1-xd)+c->f.ptr.p_double[c->d*(c->n*(c->m*iz+iy)+(ix+1))+i]*xd; - c1 = c->f.ptr.p_double[c->d*(c->n*(c->m*iz+(iy+1))+ix)+i]*(1-xd)+c->f.ptr.p_double[c->d*(c->n*(c->m*iz+(iy+1))+(ix+1))+i]*xd; - c2 = c->f.ptr.p_double[c->d*(c->n*(c->m*(iz+1)+iy)+ix)+i]*(1-xd)+c->f.ptr.p_double[c->d*(c->n*(c->m*(iz+1)+iy)+(ix+1))+i]*xd; - c3 = c->f.ptr.p_double[c->d*(c->n*(c->m*(iz+1)+(iy+1))+ix)+i]*(1-xd)+c->f.ptr.p_double[c->d*(c->n*(c->m*(iz+1)+(iy+1))+(ix+1))+i]*xd; - c0 = c0*(1-yd)+c1*yd; - c1 = c2*(1-yd)+c3*yd; - f->ptr.p_double[i] = c0*(1-zd)+c1*zd; - } - } -} - - -/************************************************************************* -This subroutine calculates trilinear or tricubic vector-valued spline at the -given point (X,Y,Z). - -INPUT PARAMETERS: - C - spline interpolant. - X, Y, - Z - point - -OUTPUT PARAMETERS: - F - array[D] which stores function values. F is out-parameter and - it is reallocated after call to this function. In case you - want to reuse previously allocated F, you may use - Spline2DCalcVBuf(), which reallocates F only when it is too - small. - - -- ALGLIB PROJECT -- - Copyright 26.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline3dcalcv(spline3dinterpolant* c, - double x, - double y, - double z, - /* Real */ ae_vector* f, - ae_state *_state) -{ - - ae_vector_clear(f); - - ae_assert(c->stype==-1||c->stype==-3, "Spline3DCalcV: incorrect C (incorrect parameter C.SType)", _state); - ae_assert((ae_isfinite(x, _state)&&ae_isfinite(y, _state))&&ae_isfinite(z, _state), "Spline3DCalcV: X=NaN/Infinite, Y=NaN/Infinite or Z=NaN/Infinite", _state); - ae_vector_set_length(f, c->d, _state); - spline3dcalcvbuf(c, x, y, z, f, _state); -} - - -/************************************************************************* -This subroutine unpacks tri-dimensional spline into the coefficients table - -INPUT PARAMETERS: - C - spline interpolant. - -Result: - N - grid size (X) - M - grid size (Y) - L - grid size (Z) - D - number of components - SType- spline type. Currently, only one spline type is supported: - trilinear spline, as indicated by SType=1. - Tbl - spline coefficients: [0..(N-1)*(M-1)*(L-1)*D-1, 0..13]. - For T=0..D-1 (component index), I = 0...N-2 (x index), - J=0..M-2 (y index), K=0..L-2 (z index): - Q := T + I*D + J*D*(N-1) + K*D*(N-1)*(M-1), - - Q-th row stores decomposition for T-th component of the - vector-valued function - - Tbl[Q,0] = X[i] - Tbl[Q,1] = X[i+1] - Tbl[Q,2] = Y[j] - Tbl[Q,3] = Y[j+1] - Tbl[Q,4] = Z[k] - Tbl[Q,5] = Z[k+1] - - Tbl[Q,6] = C000 - Tbl[Q,7] = C100 - Tbl[Q,8] = C010 - Tbl[Q,9] = C110 - Tbl[Q,10]= C001 - Tbl[Q,11]= C101 - Tbl[Q,12]= C011 - Tbl[Q,13]= C111 - On each grid square spline is equals to: - S(x) = SUM(c[i,j,k]*(x^i)*(y^j)*(z^k), i=0..1, j=0..1, k=0..1) - t = x-x[j] - u = y-y[i] - v = z-z[k] - - NOTE: format of Tbl is given for SType=1. Future versions of - ALGLIB can use different formats for different values of - SType. - - -- ALGLIB PROJECT -- - Copyright 26.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline3dunpackv(spline3dinterpolant* c, - ae_int_t* n, - ae_int_t* m, - ae_int_t* l, - ae_int_t* d, - ae_int_t* stype, - /* Real */ ae_matrix* tbl, - ae_state *_state) -{ - ae_int_t p; - ae_int_t ci; - ae_int_t cj; - ae_int_t ck; - double du; - double dv; - double dw; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t di; - ae_int_t i0; - - *n = 0; - *m = 0; - *l = 0; - *d = 0; - *stype = 0; - ae_matrix_clear(tbl); - - ae_assert(c->stype==-1, "Spline3DUnpackV: incorrect C (incorrect parameter C.SType)", _state); - *n = c->n; - *m = c->m; - *l = c->l; - *d = c->d; - *stype = ae_iabs(c->stype, _state); - ae_matrix_set_length(tbl, (*n-1)*(*m-1)*(*l-1)*(*d), 14, _state); - - /* - * Fill - */ - for(i=0; i<=*n-2; i++) - { - for(j=0; j<=*m-2; j++) - { - for(k=0; k<=*l-2; k++) - { - for(di=0; di<=*d-1; di++) - { - p = *d*((*n-1)*((*m-1)*k+j)+i)+di; - tbl->ptr.pp_double[p][0] = c->x.ptr.p_double[i]; - tbl->ptr.pp_double[p][1] = c->x.ptr.p_double[i+1]; - tbl->ptr.pp_double[p][2] = c->y.ptr.p_double[j]; - tbl->ptr.pp_double[p][3] = c->y.ptr.p_double[j+1]; - tbl->ptr.pp_double[p][4] = c->z.ptr.p_double[k]; - tbl->ptr.pp_double[p][5] = c->z.ptr.p_double[k+1]; - du = 1/(tbl->ptr.pp_double[p][1]-tbl->ptr.pp_double[p][0]); - dv = 1/(tbl->ptr.pp_double[p][3]-tbl->ptr.pp_double[p][2]); - dw = 1/(tbl->ptr.pp_double[p][5]-tbl->ptr.pp_double[p][4]); - - /* - * Trilinear interpolation - */ - if( c->stype==-1 ) - { - for(i0=6; i0<=13; i0++) - { - tbl->ptr.pp_double[p][i0] = 0; - } - tbl->ptr.pp_double[p][6+2*(2*0+0)+0] = c->f.ptr.p_double[*d*(*n*(*m*k+j)+i)+di]; - tbl->ptr.pp_double[p][6+2*(2*0+0)+1] = c->f.ptr.p_double[*d*(*n*(*m*k+j)+(i+1))+di]-c->f.ptr.p_double[*d*(*n*(*m*k+j)+i)+di]; - tbl->ptr.pp_double[p][6+2*(2*0+1)+0] = c->f.ptr.p_double[*d*(*n*(*m*k+(j+1))+i)+di]-c->f.ptr.p_double[*d*(*n*(*m*k+j)+i)+di]; - tbl->ptr.pp_double[p][6+2*(2*0+1)+1] = c->f.ptr.p_double[*d*(*n*(*m*k+(j+1))+(i+1))+di]-c->f.ptr.p_double[*d*(*n*(*m*k+(j+1))+i)+di]-c->f.ptr.p_double[*d*(*n*(*m*k+j)+(i+1))+di]+c->f.ptr.p_double[*d*(*n*(*m*k+j)+i)+di]; - tbl->ptr.pp_double[p][6+2*(2*1+0)+0] = c->f.ptr.p_double[*d*(*n*(*m*(k+1)+j)+i)+di]-c->f.ptr.p_double[*d*(*n*(*m*k+j)+i)+di]; - tbl->ptr.pp_double[p][6+2*(2*1+0)+1] = c->f.ptr.p_double[*d*(*n*(*m*(k+1)+j)+(i+1))+di]-c->f.ptr.p_double[*d*(*n*(*m*(k+1)+j)+i)+di]-c->f.ptr.p_double[*d*(*n*(*m*k+j)+(i+1))+di]+c->f.ptr.p_double[*d*(*n*(*m*k+j)+i)+di]; - tbl->ptr.pp_double[p][6+2*(2*1+1)+0] = c->f.ptr.p_double[*d*(*n*(*m*(k+1)+(j+1))+i)+di]-c->f.ptr.p_double[*d*(*n*(*m*(k+1)+j)+i)+di]-c->f.ptr.p_double[*d*(*n*(*m*k+(j+1))+i)+di]+c->f.ptr.p_double[*d*(*n*(*m*k+j)+i)+di]; - tbl->ptr.pp_double[p][6+2*(2*1+1)+1] = c->f.ptr.p_double[*d*(*n*(*m*(k+1)+(j+1))+(i+1))+di]-c->f.ptr.p_double[*d*(*n*(*m*(k+1)+(j+1))+i)+di]-c->f.ptr.p_double[*d*(*n*(*m*(k+1)+j)+(i+1))+di]+c->f.ptr.p_double[*d*(*n*(*m*(k+1)+j)+i)+di]-c->f.ptr.p_double[*d*(*n*(*m*k+(j+1))+(i+1))+di]+c->f.ptr.p_double[*d*(*n*(*m*k+(j+1))+i)+di]+c->f.ptr.p_double[*d*(*n*(*m*k+j)+(i+1))+di]-c->f.ptr.p_double[*d*(*n*(*m*k+j)+i)+di]; - } - - /* - * Rescale Cij - */ - for(ci=0; ci<=1; ci++) - { - for(cj=0; cj<=1; cj++) - { - for(ck=0; ck<=1; ck++) - { - tbl->ptr.pp_double[p][6+2*(2*ck+cj)+ci] = tbl->ptr.pp_double[p][6+2*(2*ck+cj)+ci]*ae_pow(du, ci, _state)*ae_pow(dv, cj, _state)*ae_pow(dw, ck, _state); - } - } - } - } - } - } - } -} - - -/************************************************************************* -This subroutine calculates the value of the trilinear(or tricubic;possible -will be later) spline at the given point X(and its derivatives; possible -will be later). - -INPUT PARAMETERS: - C - spline interpolant. - X, Y, Z - point - -OUTPUT PARAMETERS: - F - S(x,y,z) - FX - dS(x,y,z)/dX - FY - dS(x,y,z)/dY - FXY - d2S(x,y,z)/dXdY - - -- ALGLIB PROJECT -- - Copyright 26.04.2012 by Bochkanov Sergey -*************************************************************************/ -static void spline3d_spline3ddiff(spline3dinterpolant* c, - double x, - double y, - double z, - double* f, - double* fx, - double* fy, - double* fxy, - ae_state *_state) -{ - double xd; - double yd; - double zd; - double c0; - double c1; - double c2; - double c3; - ae_int_t ix; - ae_int_t iy; - ae_int_t iz; - ae_int_t l; - ae_int_t r; - ae_int_t h; - - *f = 0; - *fx = 0; - *fy = 0; - *fxy = 0; - - ae_assert(c->stype==-1||c->stype==-3, "Spline3DDiff: incorrect C (incorrect parameter C.SType)", _state); - ae_assert(ae_isfinite(x, _state)&&ae_isfinite(y, _state), "Spline3DDiff: X or Y contains NaN or Infinite value", _state); - - /* - * Prepare F, dF/dX, dF/dY, d2F/dXdY - */ - *f = 0; - *fx = 0; - *fy = 0; - *fxy = 0; - if( c->d!=1 ) - { - return; - } - - /* - * Binary search in the [ x[0], ..., x[n-2] ] (x[n-1] is not included) - */ - l = 0; - r = c->n-1; - while(l!=r-1) - { - h = (l+r)/2; - if( ae_fp_greater_eq(c->x.ptr.p_double[h],x) ) - { - r = h; - } - else - { - l = h; - } - } - ix = l; - - /* - * Binary search in the [ y[0], ..., y[n-2] ] (y[n-1] is not included) - */ - l = 0; - r = c->m-1; - while(l!=r-1) - { - h = (l+r)/2; - if( ae_fp_greater_eq(c->y.ptr.p_double[h],y) ) - { - r = h; - } - else - { - l = h; - } - } - iy = l; - - /* - * Binary search in the [ z[0], ..., z[n-2] ] (z[n-1] is not included) - */ - l = 0; - r = c->l-1; - while(l!=r-1) - { - h = (l+r)/2; - if( ae_fp_greater_eq(c->z.ptr.p_double[h],z) ) - { - r = h; - } - else - { - l = h; - } - } - iz = l; - xd = (x-c->x.ptr.p_double[ix])/(c->x.ptr.p_double[ix+1]-c->x.ptr.p_double[ix]); - yd = (y-c->y.ptr.p_double[iy])/(c->y.ptr.p_double[iy+1]-c->y.ptr.p_double[iy]); - zd = (z-c->z.ptr.p_double[iz])/(c->z.ptr.p_double[iz+1]-c->z.ptr.p_double[iz]); - - /* - * Trilinear interpolation - */ - if( c->stype==-1 ) - { - c0 = c->f.ptr.p_double[c->n*(c->m*iz+iy)+ix]*(1-xd)+c->f.ptr.p_double[c->n*(c->m*iz+iy)+(ix+1)]*xd; - c1 = c->f.ptr.p_double[c->n*(c->m*iz+(iy+1))+ix]*(1-xd)+c->f.ptr.p_double[c->n*(c->m*iz+(iy+1))+(ix+1)]*xd; - c2 = c->f.ptr.p_double[c->n*(c->m*(iz+1)+iy)+ix]*(1-xd)+c->f.ptr.p_double[c->n*(c->m*(iz+1)+iy)+(ix+1)]*xd; - c3 = c->f.ptr.p_double[c->n*(c->m*(iz+1)+(iy+1))+ix]*(1-xd)+c->f.ptr.p_double[c->n*(c->m*(iz+1)+(iy+1))+(ix+1)]*xd; - c0 = c0*(1-yd)+c1*yd; - c1 = c2*(1-yd)+c3*yd; - *f = c0*(1-zd)+c1*zd; - } -} - - -ae_bool _spline3dinterpolant_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - spline3dinterpolant *p = (spline3dinterpolant*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->y, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->z, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->f, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _spline3dinterpolant_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - spline3dinterpolant *dst = (spline3dinterpolant*)_dst; - spline3dinterpolant *src = (spline3dinterpolant*)_src; - dst->k = src->k; - dst->stype = src->stype; - dst->n = src->n; - dst->m = src->m; - dst->l = src->l; - dst->d = src->d; - if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->y, &src->y, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->z, &src->z, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->f, &src->f, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _spline3dinterpolant_clear(void* _p) -{ - spline3dinterpolant *p = (spline3dinterpolant*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->x); - ae_vector_clear(&p->y); - ae_vector_clear(&p->z); - ae_vector_clear(&p->f); -} - - -void _spline3dinterpolant_destroy(void* _p) -{ - spline3dinterpolant *p = (spline3dinterpolant*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->x); - ae_vector_destroy(&p->y); - ae_vector_destroy(&p->z); - ae_vector_destroy(&p->f); -} - - - -} - diff --git a/src/core/alglib/interpolation.h b/src/core/alglib/interpolation.h deleted file mode 100644 index 18c0667..0000000 --- a/src/core/alglib/interpolation.h +++ /dev/null @@ -1,5906 +0,0 @@ -/************************************************************************* -Copyright (c) Sergey Bochkanov (ALGLIB project). - ->>> SOURCE LICENSE >>> -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation (www.fsf.org); either version 2 of the -License, or (at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -A copy of the GNU General Public License is available at -http://www.fsf.org/licensing/licenses ->>> END OF LICENSE >>> -*************************************************************************/ -#ifndef _interpolation_pkg_h -#define _interpolation_pkg_h -#include "ap.h" -#include "alglibinternal.h" -#include "alglibmisc.h" -#include "linalg.h" -#include "solvers.h" -#include "optimization.h" -#include "specialfunctions.h" -#include "integration.h" - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (DATATYPES) -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ -typedef struct -{ - ae_int_t n; - ae_int_t nx; - ae_int_t d; - double r; - ae_int_t nw; - kdtree tree; - ae_int_t modeltype; - ae_matrix q; - ae_vector xbuf; - ae_vector tbuf; - ae_vector rbuf; - ae_matrix xybuf; - ae_int_t debugsolverfailures; - double debugworstrcond; - double debugbestrcond; -} idwinterpolant; -typedef struct -{ - ae_int_t n; - double sy; - ae_vector x; - ae_vector y; - ae_vector w; -} barycentricinterpolant; -typedef struct -{ - ae_bool periodic; - ae_int_t n; - ae_int_t k; - ae_int_t continuity; - ae_vector x; - ae_vector c; -} spline1dinterpolant; -typedef struct -{ - double taskrcond; - double rmserror; - double avgerror; - double avgrelerror; - double maxerror; -} polynomialfitreport; -typedef struct -{ - double taskrcond; - ae_int_t dbest; - double rmserror; - double avgerror; - double avgrelerror; - double maxerror; -} barycentricfitreport; -typedef struct -{ - double taskrcond; - double rmserror; - double avgerror; - double avgrelerror; - double maxerror; -} spline1dfitreport; -typedef struct -{ - double taskrcond; - ae_int_t iterationscount; - ae_int_t varidx; - double rmserror; - double avgerror; - double avgrelerror; - double maxerror; - double wrmserror; - ae_matrix covpar; - ae_vector errpar; - ae_vector errcurve; - ae_vector noise; - double r2; -} lsfitreport; -typedef struct -{ - ae_int_t optalgo; - ae_int_t m; - ae_int_t k; - double epsf; - double epsx; - ae_int_t maxits; - double stpmax; - ae_bool xrep; - ae_vector s; - ae_vector bndl; - ae_vector bndu; - ae_matrix taskx; - ae_vector tasky; - ae_int_t npoints; - ae_vector taskw; - ae_int_t nweights; - ae_int_t wkind; - ae_int_t wits; - double diffstep; - double teststep; - ae_bool xupdated; - ae_bool needf; - ae_bool needfg; - ae_bool needfgh; - ae_int_t pointindex; - ae_vector x; - ae_vector c; - double f; - ae_vector g; - ae_matrix h; - ae_vector wcur; - ae_vector tmp; - ae_vector tmpf; - ae_matrix tmpjac; - ae_matrix tmpjacw; - double tmpnoise; - matinvreport invrep; - ae_int_t repiterationscount; - ae_int_t repterminationtype; - ae_int_t repvaridx; - double reprmserror; - double repavgerror; - double repavgrelerror; - double repmaxerror; - double repwrmserror; - lsfitreport rep; - minlmstate optstate; - minlmreport optrep; - ae_int_t prevnpt; - ae_int_t prevalgo; - rcommstate rstate; -} lsfitstate; -typedef struct -{ - ae_int_t n; - ae_bool periodic; - ae_vector p; - spline1dinterpolant x; - spline1dinterpolant y; -} pspline2interpolant; -typedef struct -{ - ae_int_t n; - ae_bool periodic; - ae_vector p; - spline1dinterpolant x; - spline1dinterpolant y; - spline1dinterpolant z; -} pspline3interpolant; -typedef struct -{ - ae_int_t ny; - ae_int_t nx; - ae_int_t nc; - ae_int_t nl; - kdtree tree; - ae_matrix xc; - ae_matrix wr; - double rmax; - ae_matrix v; - ae_int_t gridtype; - ae_bool fixrad; - double lambdav; - double radvalue; - double radzvalue; - ae_int_t nlayers; - ae_int_t aterm; - ae_int_t algorithmtype; - double epsort; - double epserr; - ae_int_t maxits; - double h; - ae_int_t n; - ae_matrix x; - ae_matrix y; - ae_vector calcbufxcx; - ae_matrix calcbufx; - ae_vector calcbuftags; -} rbfmodel; -typedef struct -{ - ae_int_t arows; - ae_int_t acols; - ae_int_t annz; - ae_int_t iterationscount; - ae_int_t nmv; - ae_int_t terminationtype; -} rbfreport; -typedef struct -{ - ae_int_t k; - ae_int_t stype; - ae_int_t n; - ae_int_t m; - ae_int_t d; - ae_vector x; - ae_vector y; - ae_vector f; -} spline2dinterpolant; -typedef struct -{ - ae_int_t k; - ae_int_t stype; - ae_int_t n; - ae_int_t m; - ae_int_t l; - ae_int_t d; - ae_vector x; - ae_vector y; - ae_vector z; - ae_vector f; -} spline3dinterpolant; - -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS C++ INTERFACE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib -{ - -/************************************************************************* -IDW interpolant. -*************************************************************************/ -class _idwinterpolant_owner -{ -public: - _idwinterpolant_owner(); - _idwinterpolant_owner(const _idwinterpolant_owner &rhs); - _idwinterpolant_owner& operator=(const _idwinterpolant_owner &rhs); - virtual ~_idwinterpolant_owner(); - alglib_impl::idwinterpolant* c_ptr(); - alglib_impl::idwinterpolant* c_ptr() const; -protected: - alglib_impl::idwinterpolant *p_struct; -}; -class idwinterpolant : public _idwinterpolant_owner -{ -public: - idwinterpolant(); - idwinterpolant(const idwinterpolant &rhs); - idwinterpolant& operator=(const idwinterpolant &rhs); - virtual ~idwinterpolant(); - -}; - -/************************************************************************* -Barycentric interpolant. -*************************************************************************/ -class _barycentricinterpolant_owner -{ -public: - _barycentricinterpolant_owner(); - _barycentricinterpolant_owner(const _barycentricinterpolant_owner &rhs); - _barycentricinterpolant_owner& operator=(const _barycentricinterpolant_owner &rhs); - virtual ~_barycentricinterpolant_owner(); - alglib_impl::barycentricinterpolant* c_ptr(); - alglib_impl::barycentricinterpolant* c_ptr() const; -protected: - alglib_impl::barycentricinterpolant *p_struct; -}; -class barycentricinterpolant : public _barycentricinterpolant_owner -{ -public: - barycentricinterpolant(); - barycentricinterpolant(const barycentricinterpolant &rhs); - barycentricinterpolant& operator=(const barycentricinterpolant &rhs); - virtual ~barycentricinterpolant(); - -}; - - - -/************************************************************************* -1-dimensional spline interpolant -*************************************************************************/ -class _spline1dinterpolant_owner -{ -public: - _spline1dinterpolant_owner(); - _spline1dinterpolant_owner(const _spline1dinterpolant_owner &rhs); - _spline1dinterpolant_owner& operator=(const _spline1dinterpolant_owner &rhs); - virtual ~_spline1dinterpolant_owner(); - alglib_impl::spline1dinterpolant* c_ptr(); - alglib_impl::spline1dinterpolant* c_ptr() const; -protected: - alglib_impl::spline1dinterpolant *p_struct; -}; -class spline1dinterpolant : public _spline1dinterpolant_owner -{ -public: - spline1dinterpolant(); - spline1dinterpolant(const spline1dinterpolant &rhs); - spline1dinterpolant& operator=(const spline1dinterpolant &rhs); - virtual ~spline1dinterpolant(); - -}; - -/************************************************************************* -Polynomial fitting report: - TaskRCond reciprocal of task's condition number - RMSError RMS error - AvgError average error - AvgRelError average relative error (for non-zero Y[I]) - MaxError maximum error -*************************************************************************/ -class _polynomialfitreport_owner -{ -public: - _polynomialfitreport_owner(); - _polynomialfitreport_owner(const _polynomialfitreport_owner &rhs); - _polynomialfitreport_owner& operator=(const _polynomialfitreport_owner &rhs); - virtual ~_polynomialfitreport_owner(); - alglib_impl::polynomialfitreport* c_ptr(); - alglib_impl::polynomialfitreport* c_ptr() const; -protected: - alglib_impl::polynomialfitreport *p_struct; -}; -class polynomialfitreport : public _polynomialfitreport_owner -{ -public: - polynomialfitreport(); - polynomialfitreport(const polynomialfitreport &rhs); - polynomialfitreport& operator=(const polynomialfitreport &rhs); - virtual ~polynomialfitreport(); - double &taskrcond; - double &rmserror; - double &avgerror; - double &avgrelerror; - double &maxerror; - -}; - - -/************************************************************************* -Barycentric fitting report: - RMSError RMS error - AvgError average error - AvgRelError average relative error (for non-zero Y[I]) - MaxError maximum error - TaskRCond reciprocal of task's condition number -*************************************************************************/ -class _barycentricfitreport_owner -{ -public: - _barycentricfitreport_owner(); - _barycentricfitreport_owner(const _barycentricfitreport_owner &rhs); - _barycentricfitreport_owner& operator=(const _barycentricfitreport_owner &rhs); - virtual ~_barycentricfitreport_owner(); - alglib_impl::barycentricfitreport* c_ptr(); - alglib_impl::barycentricfitreport* c_ptr() const; -protected: - alglib_impl::barycentricfitreport *p_struct; -}; -class barycentricfitreport : public _barycentricfitreport_owner -{ -public: - barycentricfitreport(); - barycentricfitreport(const barycentricfitreport &rhs); - barycentricfitreport& operator=(const barycentricfitreport &rhs); - virtual ~barycentricfitreport(); - double &taskrcond; - ae_int_t &dbest; - double &rmserror; - double &avgerror; - double &avgrelerror; - double &maxerror; - -}; - - -/************************************************************************* -Spline fitting report: - RMSError RMS error - AvgError average error - AvgRelError average relative error (for non-zero Y[I]) - MaxError maximum error - -Fields below are filled by obsolete functions (Spline1DFitCubic, -Spline1DFitHermite). Modern fitting functions do NOT fill these fields: - TaskRCond reciprocal of task's condition number -*************************************************************************/ -class _spline1dfitreport_owner -{ -public: - _spline1dfitreport_owner(); - _spline1dfitreport_owner(const _spline1dfitreport_owner &rhs); - _spline1dfitreport_owner& operator=(const _spline1dfitreport_owner &rhs); - virtual ~_spline1dfitreport_owner(); - alglib_impl::spline1dfitreport* c_ptr(); - alglib_impl::spline1dfitreport* c_ptr() const; -protected: - alglib_impl::spline1dfitreport *p_struct; -}; -class spline1dfitreport : public _spline1dfitreport_owner -{ -public: - spline1dfitreport(); - spline1dfitreport(const spline1dfitreport &rhs); - spline1dfitreport& operator=(const spline1dfitreport &rhs); - virtual ~spline1dfitreport(); - double &taskrcond; - double &rmserror; - double &avgerror; - double &avgrelerror; - double &maxerror; - -}; - - -/************************************************************************* -Least squares fitting report. This structure contains informational fields -which are set by fitting functions provided by this unit. - -Different functions initialize different sets of fields, so you should -read documentation on specific function you used in order to know which -fields are initialized. - - TaskRCond reciprocal of task's condition number - IterationsCount number of internal iterations - - VarIdx if user-supplied gradient contains errors which were - detected by nonlinear fitter, this field is set to - index of the first component of gradient which is - suspected to be spoiled by bugs. - - RMSError RMS error - AvgError average error - AvgRelError average relative error (for non-zero Y[I]) - MaxError maximum error - - WRMSError weighted RMS error - - CovPar covariance matrix for parameters, filled by some solvers - ErrPar vector of errors in parameters, filled by some solvers - ErrCurve vector of fit errors - variability of the best-fit - curve, filled by some solvers. - Noise vector of per-point noise estimates, filled by - some solvers. - R2 coefficient of determination (non-weighted, non-adjusted), - filled by some solvers. -*************************************************************************/ -class _lsfitreport_owner -{ -public: - _lsfitreport_owner(); - _lsfitreport_owner(const _lsfitreport_owner &rhs); - _lsfitreport_owner& operator=(const _lsfitreport_owner &rhs); - virtual ~_lsfitreport_owner(); - alglib_impl::lsfitreport* c_ptr(); - alglib_impl::lsfitreport* c_ptr() const; -protected: - alglib_impl::lsfitreport *p_struct; -}; -class lsfitreport : public _lsfitreport_owner -{ -public: - lsfitreport(); - lsfitreport(const lsfitreport &rhs); - lsfitreport& operator=(const lsfitreport &rhs); - virtual ~lsfitreport(); - double &taskrcond; - ae_int_t &iterationscount; - ae_int_t &varidx; - double &rmserror; - double &avgerror; - double &avgrelerror; - double &maxerror; - double &wrmserror; - real_2d_array covpar; - real_1d_array errpar; - real_1d_array errcurve; - real_1d_array noise; - double &r2; - -}; - - -/************************************************************************* -Nonlinear fitter. - -You should use ALGLIB functions to work with fitter. -Never try to access its fields directly! -*************************************************************************/ -class _lsfitstate_owner -{ -public: - _lsfitstate_owner(); - _lsfitstate_owner(const _lsfitstate_owner &rhs); - _lsfitstate_owner& operator=(const _lsfitstate_owner &rhs); - virtual ~_lsfitstate_owner(); - alglib_impl::lsfitstate* c_ptr(); - alglib_impl::lsfitstate* c_ptr() const; -protected: - alglib_impl::lsfitstate *p_struct; -}; -class lsfitstate : public _lsfitstate_owner -{ -public: - lsfitstate(); - lsfitstate(const lsfitstate &rhs); - lsfitstate& operator=(const lsfitstate &rhs); - virtual ~lsfitstate(); - ae_bool &needf; - ae_bool &needfg; - ae_bool &needfgh; - ae_bool &xupdated; - real_1d_array c; - double &f; - real_1d_array g; - real_2d_array h; - real_1d_array x; - -}; - -/************************************************************************* -Parametric spline inteprolant: 2-dimensional curve. - -You should not try to access its members directly - use PSpline2XXXXXXXX() -functions instead. -*************************************************************************/ -class _pspline2interpolant_owner -{ -public: - _pspline2interpolant_owner(); - _pspline2interpolant_owner(const _pspline2interpolant_owner &rhs); - _pspline2interpolant_owner& operator=(const _pspline2interpolant_owner &rhs); - virtual ~_pspline2interpolant_owner(); - alglib_impl::pspline2interpolant* c_ptr(); - alglib_impl::pspline2interpolant* c_ptr() const; -protected: - alglib_impl::pspline2interpolant *p_struct; -}; -class pspline2interpolant : public _pspline2interpolant_owner -{ -public: - pspline2interpolant(); - pspline2interpolant(const pspline2interpolant &rhs); - pspline2interpolant& operator=(const pspline2interpolant &rhs); - virtual ~pspline2interpolant(); - -}; - - -/************************************************************************* -Parametric spline inteprolant: 3-dimensional curve. - -You should not try to access its members directly - use PSpline3XXXXXXXX() -functions instead. -*************************************************************************/ -class _pspline3interpolant_owner -{ -public: - _pspline3interpolant_owner(); - _pspline3interpolant_owner(const _pspline3interpolant_owner &rhs); - _pspline3interpolant_owner& operator=(const _pspline3interpolant_owner &rhs); - virtual ~_pspline3interpolant_owner(); - alglib_impl::pspline3interpolant* c_ptr(); - alglib_impl::pspline3interpolant* c_ptr() const; -protected: - alglib_impl::pspline3interpolant *p_struct; -}; -class pspline3interpolant : public _pspline3interpolant_owner -{ -public: - pspline3interpolant(); - pspline3interpolant(const pspline3interpolant &rhs); - pspline3interpolant& operator=(const pspline3interpolant &rhs); - virtual ~pspline3interpolant(); - -}; - -/************************************************************************* -RBF model. - -Never try to directly work with fields of this object - always use ALGLIB -functions to use this object. -*************************************************************************/ -class _rbfmodel_owner -{ -public: - _rbfmodel_owner(); - _rbfmodel_owner(const _rbfmodel_owner &rhs); - _rbfmodel_owner& operator=(const _rbfmodel_owner &rhs); - virtual ~_rbfmodel_owner(); - alglib_impl::rbfmodel* c_ptr(); - alglib_impl::rbfmodel* c_ptr() const; -protected: - alglib_impl::rbfmodel *p_struct; -}; -class rbfmodel : public _rbfmodel_owner -{ -public: - rbfmodel(); - rbfmodel(const rbfmodel &rhs); - rbfmodel& operator=(const rbfmodel &rhs); - virtual ~rbfmodel(); - -}; - - -/************************************************************************* -RBF solution report: -* TerminationType - termination type, positive values - success, - non-positive - failure. -*************************************************************************/ -class _rbfreport_owner -{ -public: - _rbfreport_owner(); - _rbfreport_owner(const _rbfreport_owner &rhs); - _rbfreport_owner& operator=(const _rbfreport_owner &rhs); - virtual ~_rbfreport_owner(); - alglib_impl::rbfreport* c_ptr(); - alglib_impl::rbfreport* c_ptr() const; -protected: - alglib_impl::rbfreport *p_struct; -}; -class rbfreport : public _rbfreport_owner -{ -public: - rbfreport(); - rbfreport(const rbfreport &rhs); - rbfreport& operator=(const rbfreport &rhs); - virtual ~rbfreport(); - ae_int_t &arows; - ae_int_t &acols; - ae_int_t &annz; - ae_int_t &iterationscount; - ae_int_t &nmv; - ae_int_t &terminationtype; - -}; - -/************************************************************************* -2-dimensional spline inteprolant -*************************************************************************/ -class _spline2dinterpolant_owner -{ -public: - _spline2dinterpolant_owner(); - _spline2dinterpolant_owner(const _spline2dinterpolant_owner &rhs); - _spline2dinterpolant_owner& operator=(const _spline2dinterpolant_owner &rhs); - virtual ~_spline2dinterpolant_owner(); - alglib_impl::spline2dinterpolant* c_ptr(); - alglib_impl::spline2dinterpolant* c_ptr() const; -protected: - alglib_impl::spline2dinterpolant *p_struct; -}; -class spline2dinterpolant : public _spline2dinterpolant_owner -{ -public: - spline2dinterpolant(); - spline2dinterpolant(const spline2dinterpolant &rhs); - spline2dinterpolant& operator=(const spline2dinterpolant &rhs); - virtual ~spline2dinterpolant(); - -}; - -/************************************************************************* -3-dimensional spline inteprolant -*************************************************************************/ -class _spline3dinterpolant_owner -{ -public: - _spline3dinterpolant_owner(); - _spline3dinterpolant_owner(const _spline3dinterpolant_owner &rhs); - _spline3dinterpolant_owner& operator=(const _spline3dinterpolant_owner &rhs); - virtual ~_spline3dinterpolant_owner(); - alglib_impl::spline3dinterpolant* c_ptr(); - alglib_impl::spline3dinterpolant* c_ptr() const; -protected: - alglib_impl::spline3dinterpolant *p_struct; -}; -class spline3dinterpolant : public _spline3dinterpolant_owner -{ -public: - spline3dinterpolant(); - spline3dinterpolant(const spline3dinterpolant &rhs); - spline3dinterpolant& operator=(const spline3dinterpolant &rhs); - virtual ~spline3dinterpolant(); - -}; - -/************************************************************************* -IDW interpolation - -INPUT PARAMETERS: - Z - IDW interpolant built with one of model building - subroutines. - X - array[0..NX-1], interpolation point - -Result: - IDW interpolant Z(X) - - -- ALGLIB -- - Copyright 02.03.2010 by Bochkanov Sergey -*************************************************************************/ -double idwcalc(const idwinterpolant &z, const real_1d_array &x); - - -/************************************************************************* -IDW interpolant using modified Shepard method for uniform point -distributions. - -INPUT PARAMETERS: - XY - X and Y values, array[0..N-1,0..NX]. - First NX columns contain X-values, last column contain - Y-values. - N - number of nodes, N>0. - NX - space dimension, NX>=1. - D - nodal function type, either: - * 0 constant model. Just for demonstration only, worst - model ever. - * 1 linear model, least squares fitting. Simpe model for - datasets too small for quadratic models - * 2 quadratic model, least squares fitting. Best model - available (if your dataset is large enough). - * -1 "fast" linear model, use with caution!!! It is - significantly faster than linear/quadratic and better - than constant model. But it is less robust (especially - in the presence of noise). - NQ - number of points used to calculate nodal functions (ignored - for constant models). NQ should be LARGER than: - * max(1.5*(1+NX),2^NX+1) for linear model, - * max(3/4*(NX+2)*(NX+1),2^NX+1) for quadratic model. - Values less than this threshold will be silently increased. - NW - number of points used to calculate weights and to interpolate. - Required: >=2^NX+1, values less than this threshold will be - silently increased. - Recommended value: about 2*NQ - -OUTPUT PARAMETERS: - Z - IDW interpolant. - -NOTES: - * best results are obtained with quadratic models, worst - with constant - models - * when N is large, NQ and NW must be significantly smaller than N both - to obtain optimal performance and to obtain optimal accuracy. In 2 or - 3-dimensional tasks NQ=15 and NW=25 are good values to start with. - * NQ and NW may be greater than N. In such cases they will be - automatically decreased. - * this subroutine is always succeeds (as long as correct parameters are - passed). - * see 'Multivariate Interpolation of Large Sets of Scattered Data' by - Robert J. Renka for more information on this algorithm. - * this subroutine assumes that point distribution is uniform at the small - scales. If it isn't - for example, points are concentrated along - "lines", but "lines" distribution is uniform at the larger scale - then - you should use IDWBuildModifiedShepardR() - - - -- ALGLIB PROJECT -- - Copyright 02.03.2010 by Bochkanov Sergey -*************************************************************************/ -void idwbuildmodifiedshepard(const real_2d_array &xy, const ae_int_t n, const ae_int_t nx, const ae_int_t d, const ae_int_t nq, const ae_int_t nw, idwinterpolant &z); - - -/************************************************************************* -IDW interpolant using modified Shepard method for non-uniform datasets. - -This type of model uses constant nodal functions and interpolates using -all nodes which are closer than user-specified radius R. It may be used -when points distribution is non-uniform at the small scale, but it is at -the distances as large as R. - -INPUT PARAMETERS: - XY - X and Y values, array[0..N-1,0..NX]. - First NX columns contain X-values, last column contain - Y-values. - N - number of nodes, N>0. - NX - space dimension, NX>=1. - R - radius, R>0 - -OUTPUT PARAMETERS: - Z - IDW interpolant. - -NOTES: -* if there is less than IDWKMin points within R-ball, algorithm selects - IDWKMin closest ones, so that continuity properties of interpolant are - preserved even far from points. - - -- ALGLIB PROJECT -- - Copyright 11.04.2010 by Bochkanov Sergey -*************************************************************************/ -void idwbuildmodifiedshepardr(const real_2d_array &xy, const ae_int_t n, const ae_int_t nx, const double r, idwinterpolant &z); - - -/************************************************************************* -IDW model for noisy data. - -This subroutine may be used to handle noisy data, i.e. data with noise in -OUTPUT values. It differs from IDWBuildModifiedShepard() in the following -aspects: -* nodal functions are not constrained to pass through nodes: Qi(xi)<>yi, - i.e. we have fitting instead of interpolation. -* weights which are used during least squares fitting stage are all equal - to 1.0 (independently of distance) -* "fast"-linear or constant nodal functions are not supported (either not - robust enough or too rigid) - -This problem require far more complex tuning than interpolation problems. -Below you can find some recommendations regarding this problem: -* focus on tuning NQ; it controls noise reduction. As for NW, you can just - make it equal to 2*NQ. -* you can use cross-validation to determine optimal NQ. -* optimal NQ is a result of complex tradeoff between noise level (more - noise = larger NQ required) and underlying function complexity (given - fixed N, larger NQ means smoothing of compex features in the data). For - example, NQ=N will reduce noise to the minimum level possible, but you - will end up with just constant/linear/quadratic (depending on D) least - squares model for the whole dataset. - -INPUT PARAMETERS: - XY - X and Y values, array[0..N-1,0..NX]. - First NX columns contain X-values, last column contain - Y-values. - N - number of nodes, N>0. - NX - space dimension, NX>=1. - D - nodal function degree, either: - * 1 linear model, least squares fitting. Simpe model for - datasets too small for quadratic models (or for very - noisy problems). - * 2 quadratic model, least squares fitting. Best model - available (if your dataset is large enough). - NQ - number of points used to calculate nodal functions. NQ should - be significantly larger than 1.5 times the number of - coefficients in a nodal function to overcome effects of noise: - * larger than 1.5*(1+NX) for linear model, - * larger than 3/4*(NX+2)*(NX+1) for quadratic model. - Values less than this threshold will be silently increased. - NW - number of points used to calculate weights and to interpolate. - Required: >=2^NX+1, values less than this threshold will be - silently increased. - Recommended value: about 2*NQ or larger - -OUTPUT PARAMETERS: - Z - IDW interpolant. - -NOTES: - * best results are obtained with quadratic models, linear models are not - recommended to use unless you are pretty sure that it is what you want - * this subroutine is always succeeds (as long as correct parameters are - passed). - * see 'Multivariate Interpolation of Large Sets of Scattered Data' by - Robert J. Renka for more information on this algorithm. - - - -- ALGLIB PROJECT -- - Copyright 02.03.2010 by Bochkanov Sergey -*************************************************************************/ -void idwbuildnoisy(const real_2d_array &xy, const ae_int_t n, const ae_int_t nx, const ae_int_t d, const ae_int_t nq, const ae_int_t nw, idwinterpolant &z); - -/************************************************************************* -Rational interpolation using barycentric formula - -F(t) = SUM(i=0,n-1,w[i]*f[i]/(t-x[i])) / SUM(i=0,n-1,w[i]/(t-x[i])) - -Input parameters: - B - barycentric interpolant built with one of model building - subroutines. - T - interpolation point - -Result: - barycentric interpolant F(t) - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -double barycentriccalc(const barycentricinterpolant &b, const double t); - - -/************************************************************************* -Differentiation of barycentric interpolant: first derivative. - -Algorithm used in this subroutine is very robust and should not fail until -provided with values too close to MaxRealNumber (usually MaxRealNumber/N -or greater will overflow). - -INPUT PARAMETERS: - B - barycentric interpolant built with one of model building - subroutines. - T - interpolation point - -OUTPUT PARAMETERS: - F - barycentric interpolant at T - DF - first derivative - -NOTE - - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void barycentricdiff1(const barycentricinterpolant &b, const double t, double &f, double &df); - - -/************************************************************************* -Differentiation of barycentric interpolant: first/second derivatives. - -INPUT PARAMETERS: - B - barycentric interpolant built with one of model building - subroutines. - T - interpolation point - -OUTPUT PARAMETERS: - F - barycentric interpolant at T - DF - first derivative - D2F - second derivative - -NOTE: this algorithm may fail due to overflow/underflor if used on data -whose values are close to MaxRealNumber or MinRealNumber. Use more robust -BarycentricDiff1() subroutine in such cases. - - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void barycentricdiff2(const barycentricinterpolant &b, const double t, double &f, double &df, double &d2f); - - -/************************************************************************* -This subroutine performs linear transformation of the argument. - -INPUT PARAMETERS: - B - rational interpolant in barycentric form - CA, CB - transformation coefficients: x = CA*t + CB - -OUTPUT PARAMETERS: - B - transformed interpolant with X replaced by T - - -- ALGLIB PROJECT -- - Copyright 19.08.2009 by Bochkanov Sergey -*************************************************************************/ -void barycentriclintransx(const barycentricinterpolant &b, const double ca, const double cb); - - -/************************************************************************* -This subroutine performs linear transformation of the barycentric -interpolant. - -INPUT PARAMETERS: - B - rational interpolant in barycentric form - CA, CB - transformation coefficients: B2(x) = CA*B(x) + CB - -OUTPUT PARAMETERS: - B - transformed interpolant - - -- ALGLIB PROJECT -- - Copyright 19.08.2009 by Bochkanov Sergey -*************************************************************************/ -void barycentriclintransy(const barycentricinterpolant &b, const double ca, const double cb); - - -/************************************************************************* -Extracts X/Y/W arrays from rational interpolant - -INPUT PARAMETERS: - B - barycentric interpolant - -OUTPUT PARAMETERS: - N - nodes count, N>0 - X - interpolation nodes, array[0..N-1] - F - function values, array[0..N-1] - W - barycentric weights, array[0..N-1] - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void barycentricunpack(const barycentricinterpolant &b, ae_int_t &n, real_1d_array &x, real_1d_array &y, real_1d_array &w); - - -/************************************************************************* -Rational interpolant from X/Y/W arrays - -F(t) = SUM(i=0,n-1,w[i]*f[i]/(t-x[i])) / SUM(i=0,n-1,w[i]/(t-x[i])) - -INPUT PARAMETERS: - X - interpolation nodes, array[0..N-1] - F - function values, array[0..N-1] - W - barycentric weights, array[0..N-1] - N - nodes count, N>0 - -OUTPUT PARAMETERS: - B - barycentric interpolant built from (X, Y, W) - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void barycentricbuildxyw(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const ae_int_t n, barycentricinterpolant &b); - - -/************************************************************************* -Rational interpolant without poles - -The subroutine constructs the rational interpolating function without real -poles (see 'Barycentric rational interpolation with no poles and high -rates of approximation', Michael S. Floater. and Kai Hormann, for more -information on this subject). - -Input parameters: - X - interpolation nodes, array[0..N-1]. - Y - function values, array[0..N-1]. - N - number of nodes, N>0. - D - order of the interpolation scheme, 0 <= D <= N-1. - D<0 will cause an error. - D>=N it will be replaced with D=N-1. - if you don't know what D to choose, use small value about 3-5. - -Output parameters: - B - barycentric interpolant. - -Note: - this algorithm always succeeds and calculates the weights with close - to machine precision. - - -- ALGLIB PROJECT -- - Copyright 17.06.2007 by Bochkanov Sergey -*************************************************************************/ -void barycentricbuildfloaterhormann(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t d, barycentricinterpolant &b); - -/************************************************************************* -Conversion from barycentric representation to Chebyshev basis. -This function has O(N^2) complexity. - -INPUT PARAMETERS: - P - polynomial in barycentric form - A,B - base interval for Chebyshev polynomials (see below) - A<>B - -OUTPUT PARAMETERS - T - coefficients of Chebyshev representation; - P(x) = sum { T[i]*Ti(2*(x-A)/(B-A)-1), i=0..N-1 }, - where Ti - I-th Chebyshev polynomial. - -NOTES: - barycentric interpolant passed as P may be either polynomial obtained - from polynomial interpolation/ fitting or rational function which is - NOT polynomial. We can't distinguish between these two cases, and this - algorithm just tries to work assuming that P IS a polynomial. If not, - algorithm will return results, but they won't have any meaning. - - -- ALGLIB -- - Copyright 30.09.2010 by Bochkanov Sergey -*************************************************************************/ -void polynomialbar2cheb(const barycentricinterpolant &p, const double a, const double b, real_1d_array &t); - - -/************************************************************************* -Conversion from Chebyshev basis to barycentric representation. -This function has O(N^2) complexity. - -INPUT PARAMETERS: - T - coefficients of Chebyshev representation; - P(x) = sum { T[i]*Ti(2*(x-A)/(B-A)-1), i=0..N }, - where Ti - I-th Chebyshev polynomial. - N - number of coefficients: - * if given, only leading N elements of T are used - * if not given, automatically determined from size of T - A,B - base interval for Chebyshev polynomials (see above) - A0. - -OUTPUT PARAMETERS - A - coefficients, P(x) = sum { A[i]*((X-C)/S)^i, i=0..N-1 } - N - number of coefficients (polynomial degree plus 1) - -NOTES: -1. this function accepts offset and scale, which can be set to improve - numerical properties of polynomial. For example, if P was obtained as - result of interpolation on [-1,+1], you can set C=0 and S=1 and - represent P as sum of 1, x, x^2, x^3 and so on. In most cases you it - is exactly what you need. - - However, if your interpolation model was built on [999,1001], you will - see significant growth of numerical errors when using {1, x, x^2, x^3} - as basis. Representing P as sum of 1, (x-1000), (x-1000)^2, (x-1000)^3 - will be better option. Such representation can be obtained by using - 1000.0 as offset C and 1.0 as scale S. - -2. power basis is ill-conditioned and tricks described above can't solve - this problem completely. This function will return coefficients in - any case, but for N>8 they will become unreliable. However, N's - less than 5 are pretty safe. - -3. barycentric interpolant passed as P may be either polynomial obtained - from polynomial interpolation/ fitting or rational function which is - NOT polynomial. We can't distinguish between these two cases, and this - algorithm just tries to work assuming that P IS a polynomial. If not, - algorithm will return results, but they won't have any meaning. - - -- ALGLIB -- - Copyright 30.09.2010 by Bochkanov Sergey -*************************************************************************/ -void polynomialbar2pow(const barycentricinterpolant &p, const double c, const double s, real_1d_array &a); -void polynomialbar2pow(const barycentricinterpolant &p, real_1d_array &a); - - -/************************************************************************* -Conversion from power basis to barycentric representation. -This function has O(N^2) complexity. - -INPUT PARAMETERS: - A - coefficients, P(x) = sum { A[i]*((X-C)/S)^i, i=0..N-1 } - N - number of coefficients (polynomial degree plus 1) - * if given, only leading N elements of A are used - * if not given, automatically determined from size of A - C - offset (see below); 0.0 is used as default value. - S - scale (see below); 1.0 is used as default value. S<>0. - -OUTPUT PARAMETERS - P - polynomial in barycentric form - - -NOTES: -1. this function accepts offset and scale, which can be set to improve - numerical properties of polynomial. For example, if you interpolate on - [-1,+1], you can set C=0 and S=1 and convert from sum of 1, x, x^2, - x^3 and so on. In most cases you it is exactly what you need. - - However, if your interpolation model was built on [999,1001], you will - see significant growth of numerical errors when using {1, x, x^2, x^3} - as input basis. Converting from sum of 1, (x-1000), (x-1000)^2, - (x-1000)^3 will be better option (you have to specify 1000.0 as offset - C and 1.0 as scale S). - -2. power basis is ill-conditioned and tricks described above can't solve - this problem completely. This function will return barycentric model - in any case, but for N>8 accuracy well degrade. However, N's less than - 5 are pretty safe. - - -- ALGLIB -- - Copyright 30.09.2010 by Bochkanov Sergey -*************************************************************************/ -void polynomialpow2bar(const real_1d_array &a, const ae_int_t n, const double c, const double s, barycentricinterpolant &p); -void polynomialpow2bar(const real_1d_array &a, barycentricinterpolant &p); - - -/************************************************************************* -Lagrange intepolant: generation of the model on the general grid. -This function has O(N^2) complexity. - -INPUT PARAMETERS: - X - abscissas, array[0..N-1] - Y - function values, array[0..N-1] - N - number of points, N>=1 - -OUTPUT PARAMETERS - P - barycentric model which represents Lagrange interpolant - (see ratint unit info and BarycentricCalc() description for - more information). - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -void polynomialbuild(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, barycentricinterpolant &p); -void polynomialbuild(const real_1d_array &x, const real_1d_array &y, barycentricinterpolant &p); - - -/************************************************************************* -Lagrange intepolant: generation of the model on equidistant grid. -This function has O(N) complexity. - -INPUT PARAMETERS: - A - left boundary of [A,B] - B - right boundary of [A,B] - Y - function values at the nodes, array[0..N-1] - N - number of points, N>=1 - for N=1 a constant model is constructed. - -OUTPUT PARAMETERS - P - barycentric model which represents Lagrange interpolant - (see ratint unit info and BarycentricCalc() description for - more information). - - -- ALGLIB -- - Copyright 03.12.2009 by Bochkanov Sergey -*************************************************************************/ -void polynomialbuildeqdist(const double a, const double b, const real_1d_array &y, const ae_int_t n, barycentricinterpolant &p); -void polynomialbuildeqdist(const double a, const double b, const real_1d_array &y, barycentricinterpolant &p); - - -/************************************************************************* -Lagrange intepolant on Chebyshev grid (first kind). -This function has O(N) complexity. - -INPUT PARAMETERS: - A - left boundary of [A,B] - B - right boundary of [A,B] - Y - function values at the nodes, array[0..N-1], - Y[I] = Y(0.5*(B+A) + 0.5*(B-A)*Cos(PI*(2*i+1)/(2*n))) - N - number of points, N>=1 - for N=1 a constant model is constructed. - -OUTPUT PARAMETERS - P - barycentric model which represents Lagrange interpolant - (see ratint unit info and BarycentricCalc() description for - more information). - - -- ALGLIB -- - Copyright 03.12.2009 by Bochkanov Sergey -*************************************************************************/ -void polynomialbuildcheb1(const double a, const double b, const real_1d_array &y, const ae_int_t n, barycentricinterpolant &p); -void polynomialbuildcheb1(const double a, const double b, const real_1d_array &y, barycentricinterpolant &p); - - -/************************************************************************* -Lagrange intepolant on Chebyshev grid (second kind). -This function has O(N) complexity. - -INPUT PARAMETERS: - A - left boundary of [A,B] - B - right boundary of [A,B] - Y - function values at the nodes, array[0..N-1], - Y[I] = Y(0.5*(B+A) + 0.5*(B-A)*Cos(PI*i/(n-1))) - N - number of points, N>=1 - for N=1 a constant model is constructed. - -OUTPUT PARAMETERS - P - barycentric model which represents Lagrange interpolant - (see ratint unit info and BarycentricCalc() description for - more information). - - -- ALGLIB -- - Copyright 03.12.2009 by Bochkanov Sergey -*************************************************************************/ -void polynomialbuildcheb2(const double a, const double b, const real_1d_array &y, const ae_int_t n, barycentricinterpolant &p); -void polynomialbuildcheb2(const double a, const double b, const real_1d_array &y, barycentricinterpolant &p); - - -/************************************************************************* -Fast equidistant polynomial interpolation function with O(N) complexity - -INPUT PARAMETERS: - A - left boundary of [A,B] - B - right boundary of [A,B] - F - function values, array[0..N-1] - N - number of points on equidistant grid, N>=1 - for N=1 a constant model is constructed. - T - position where P(x) is calculated - -RESULT - value of the Lagrange interpolant at T - -IMPORTANT - this function provides fast interface which is not overflow-safe - nor it is very precise. - the best option is to use PolynomialBuildEqDist()/BarycentricCalc() - subroutines unless you are pretty sure that your data will not result - in overflow. - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -double polynomialcalceqdist(const double a, const double b, const real_1d_array &f, const ae_int_t n, const double t); -double polynomialcalceqdist(const double a, const double b, const real_1d_array &f, const double t); - - -/************************************************************************* -Fast polynomial interpolation function on Chebyshev points (first kind) -with O(N) complexity. - -INPUT PARAMETERS: - A - left boundary of [A,B] - B - right boundary of [A,B] - F - function values, array[0..N-1] - N - number of points on Chebyshev grid (first kind), - X[i] = 0.5*(B+A) + 0.5*(B-A)*Cos(PI*(2*i+1)/(2*n)) - for N=1 a constant model is constructed. - T - position where P(x) is calculated - -RESULT - value of the Lagrange interpolant at T - -IMPORTANT - this function provides fast interface which is not overflow-safe - nor it is very precise. - the best option is to use PolIntBuildCheb1()/BarycentricCalc() - subroutines unless you are pretty sure that your data will not result - in overflow. - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -double polynomialcalccheb1(const double a, const double b, const real_1d_array &f, const ae_int_t n, const double t); -double polynomialcalccheb1(const double a, const double b, const real_1d_array &f, const double t); - - -/************************************************************************* -Fast polynomial interpolation function on Chebyshev points (second kind) -with O(N) complexity. - -INPUT PARAMETERS: - A - left boundary of [A,B] - B - right boundary of [A,B] - F - function values, array[0..N-1] - N - number of points on Chebyshev grid (second kind), - X[i] = 0.5*(B+A) + 0.5*(B-A)*Cos(PI*i/(n-1)) - for N=1 a constant model is constructed. - T - position where P(x) is calculated - -RESULT - value of the Lagrange interpolant at T - -IMPORTANT - this function provides fast interface which is not overflow-safe - nor it is very precise. - the best option is to use PolIntBuildCheb2()/BarycentricCalc() - subroutines unless you are pretty sure that your data will not result - in overflow. - - -- ALGLIB -- - Copyright 02.12.2009 by Bochkanov Sergey -*************************************************************************/ -double polynomialcalccheb2(const double a, const double b, const real_1d_array &f, const ae_int_t n, const double t); -double polynomialcalccheb2(const double a, const double b, const real_1d_array &f, const double t); - -/************************************************************************* -This subroutine builds linear spline interpolant - -INPUT PARAMETERS: - X - spline nodes, array[0..N-1] - Y - function values, array[0..N-1] - N - points count (optional): - * N>=2 - * if given, only first N points are used to build spline - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - -OUTPUT PARAMETERS: - C - spline interpolant - - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. - - -- ALGLIB PROJECT -- - Copyright 24.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline1dbuildlinear(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, spline1dinterpolant &c); -void spline1dbuildlinear(const real_1d_array &x, const real_1d_array &y, spline1dinterpolant &c); - - -/************************************************************************* -This subroutine builds cubic spline interpolant. - -INPUT PARAMETERS: - X - spline nodes, array[0..N-1]. - Y - function values, array[0..N-1]. - -OPTIONAL PARAMETERS: - N - points count: - * N>=2 - * if given, only first N points are used to build spline - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - BoundLType - boundary condition type for the left boundary - BoundL - left boundary condition (first or second derivative, - depending on the BoundLType) - BoundRType - boundary condition type for the right boundary - BoundR - right boundary condition (first or second derivative, - depending on the BoundRType) - -OUTPUT PARAMETERS: - C - spline interpolant - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. - -SETTING BOUNDARY VALUES: - -The BoundLType/BoundRType parameters can have the following values: - * -1, which corresonds to the periodic (cyclic) boundary conditions. - In this case: - * both BoundLType and BoundRType must be equal to -1. - * BoundL/BoundR are ignored - * Y[last] is ignored (it is assumed to be equal to Y[first]). - * 0, which corresponds to the parabolically terminated spline - (BoundL and/or BoundR are ignored). - * 1, which corresponds to the first derivative boundary condition - * 2, which corresponds to the second derivative boundary condition - * by default, BoundType=0 is used - -PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: - -Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. -However, this subroutine doesn't require you to specify equal values for -the first and last points - it automatically forces them to be equal by -copying Y[first_point] (corresponds to the leftmost, minimal X[]) to -Y[last_point]. However it is recommended to pass consistent values of Y[], -i.e. to make Y[first_point]=Y[last_point]. - - -- ALGLIB PROJECT -- - Copyright 23.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline1dbuildcubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t boundltype, const double boundl, const ae_int_t boundrtype, const double boundr, spline1dinterpolant &c); -void spline1dbuildcubic(const real_1d_array &x, const real_1d_array &y, spline1dinterpolant &c); - - -/************************************************************************* -This function solves following problem: given table y[] of function values -at nodes x[], it calculates and returns table of function derivatives d[] -(calculated at the same nodes x[]). - -This function yields same result as Spline1DBuildCubic() call followed by -sequence of Spline1DDiff() calls, but it can be several times faster when -called for ordered X[] and X2[]. - -INPUT PARAMETERS: - X - spline nodes - Y - function values - -OPTIONAL PARAMETERS: - N - points count: - * N>=2 - * if given, only first N points are used - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - BoundLType - boundary condition type for the left boundary - BoundL - left boundary condition (first or second derivative, - depending on the BoundLType) - BoundRType - boundary condition type for the right boundary - BoundR - right boundary condition (first or second derivative, - depending on the BoundRType) - -OUTPUT PARAMETERS: - D - derivative values at X[] - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. -Derivative values are correctly reordered on return, so D[I] is always -equal to S'(X[I]) independently of points order. - -SETTING BOUNDARY VALUES: - -The BoundLType/BoundRType parameters can have the following values: - * -1, which corresonds to the periodic (cyclic) boundary conditions. - In this case: - * both BoundLType and BoundRType must be equal to -1. - * BoundL/BoundR are ignored - * Y[last] is ignored (it is assumed to be equal to Y[first]). - * 0, which corresponds to the parabolically terminated spline - (BoundL and/or BoundR are ignored). - * 1, which corresponds to the first derivative boundary condition - * 2, which corresponds to the second derivative boundary condition - * by default, BoundType=0 is used - -PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: - -Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. -However, this subroutine doesn't require you to specify equal values for -the first and last points - it automatically forces them to be equal by -copying Y[first_point] (corresponds to the leftmost, minimal X[]) to -Y[last_point]. However it is recommended to pass consistent values of Y[], -i.e. to make Y[first_point]=Y[last_point]. - - -- ALGLIB PROJECT -- - Copyright 03.09.2010 by Bochkanov Sergey -*************************************************************************/ -void spline1dgriddiffcubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t boundltype, const double boundl, const ae_int_t boundrtype, const double boundr, real_1d_array &d); -void spline1dgriddiffcubic(const real_1d_array &x, const real_1d_array &y, real_1d_array &d); - - -/************************************************************************* -This function solves following problem: given table y[] of function values -at nodes x[], it calculates and returns tables of first and second -function derivatives d1[] and d2[] (calculated at the same nodes x[]). - -This function yields same result as Spline1DBuildCubic() call followed by -sequence of Spline1DDiff() calls, but it can be several times faster when -called for ordered X[] and X2[]. - -INPUT PARAMETERS: - X - spline nodes - Y - function values - -OPTIONAL PARAMETERS: - N - points count: - * N>=2 - * if given, only first N points are used - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - BoundLType - boundary condition type for the left boundary - BoundL - left boundary condition (first or second derivative, - depending on the BoundLType) - BoundRType - boundary condition type for the right boundary - BoundR - right boundary condition (first or second derivative, - depending on the BoundRType) - -OUTPUT PARAMETERS: - D1 - S' values at X[] - D2 - S'' values at X[] - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. -Derivative values are correctly reordered on return, so D[I] is always -equal to S'(X[I]) independently of points order. - -SETTING BOUNDARY VALUES: - -The BoundLType/BoundRType parameters can have the following values: - * -1, which corresonds to the periodic (cyclic) boundary conditions. - In this case: - * both BoundLType and BoundRType must be equal to -1. - * BoundL/BoundR are ignored - * Y[last] is ignored (it is assumed to be equal to Y[first]). - * 0, which corresponds to the parabolically terminated spline - (BoundL and/or BoundR are ignored). - * 1, which corresponds to the first derivative boundary condition - * 2, which corresponds to the second derivative boundary condition - * by default, BoundType=0 is used - -PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: - -Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. -However, this subroutine doesn't require you to specify equal values for -the first and last points - it automatically forces them to be equal by -copying Y[first_point] (corresponds to the leftmost, minimal X[]) to -Y[last_point]. However it is recommended to pass consistent values of Y[], -i.e. to make Y[first_point]=Y[last_point]. - - -- ALGLIB PROJECT -- - Copyright 03.09.2010 by Bochkanov Sergey -*************************************************************************/ -void spline1dgriddiff2cubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t boundltype, const double boundl, const ae_int_t boundrtype, const double boundr, real_1d_array &d1, real_1d_array &d2); -void spline1dgriddiff2cubic(const real_1d_array &x, const real_1d_array &y, real_1d_array &d1, real_1d_array &d2); - - -/************************************************************************* -This function solves following problem: given table y[] of function values -at old nodes x[] and new nodes x2[], it calculates and returns table of -function values y2[] (calculated at x2[]). - -This function yields same result as Spline1DBuildCubic() call followed by -sequence of Spline1DDiff() calls, but it can be several times faster when -called for ordered X[] and X2[]. - -INPUT PARAMETERS: - X - old spline nodes - Y - function values - X2 - new spline nodes - -OPTIONAL PARAMETERS: - N - points count: - * N>=2 - * if given, only first N points from X/Y are used - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - BoundLType - boundary condition type for the left boundary - BoundL - left boundary condition (first or second derivative, - depending on the BoundLType) - BoundRType - boundary condition type for the right boundary - BoundR - right boundary condition (first or second derivative, - depending on the BoundRType) - N2 - new points count: - * N2>=2 - * if given, only first N2 points from X2 are used - * if not given, automatically detected from X2 size - -OUTPUT PARAMETERS: - F2 - function values at X2[] - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. -Function values are correctly reordered on return, so F2[I] is always -equal to S(X2[I]) independently of points order. - -SETTING BOUNDARY VALUES: - -The BoundLType/BoundRType parameters can have the following values: - * -1, which corresonds to the periodic (cyclic) boundary conditions. - In this case: - * both BoundLType and BoundRType must be equal to -1. - * BoundL/BoundR are ignored - * Y[last] is ignored (it is assumed to be equal to Y[first]). - * 0, which corresponds to the parabolically terminated spline - (BoundL and/or BoundR are ignored). - * 1, which corresponds to the first derivative boundary condition - * 2, which corresponds to the second derivative boundary condition - * by default, BoundType=0 is used - -PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: - -Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. -However, this subroutine doesn't require you to specify equal values for -the first and last points - it automatically forces them to be equal by -copying Y[first_point] (corresponds to the leftmost, minimal X[]) to -Y[last_point]. However it is recommended to pass consistent values of Y[], -i.e. to make Y[first_point]=Y[last_point]. - - -- ALGLIB PROJECT -- - Copyright 03.09.2010 by Bochkanov Sergey -*************************************************************************/ -void spline1dconvcubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t boundltype, const double boundl, const ae_int_t boundrtype, const double boundr, const real_1d_array &x2, const ae_int_t n2, real_1d_array &y2); -void spline1dconvcubic(const real_1d_array &x, const real_1d_array &y, const real_1d_array &x2, real_1d_array &y2); - - -/************************************************************************* -This function solves following problem: given table y[] of function values -at old nodes x[] and new nodes x2[], it calculates and returns table of -function values y2[] and derivatives d2[] (calculated at x2[]). - -This function yields same result as Spline1DBuildCubic() call followed by -sequence of Spline1DDiff() calls, but it can be several times faster when -called for ordered X[] and X2[]. - -INPUT PARAMETERS: - X - old spline nodes - Y - function values - X2 - new spline nodes - -OPTIONAL PARAMETERS: - N - points count: - * N>=2 - * if given, only first N points from X/Y are used - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - BoundLType - boundary condition type for the left boundary - BoundL - left boundary condition (first or second derivative, - depending on the BoundLType) - BoundRType - boundary condition type for the right boundary - BoundR - right boundary condition (first or second derivative, - depending on the BoundRType) - N2 - new points count: - * N2>=2 - * if given, only first N2 points from X2 are used - * if not given, automatically detected from X2 size - -OUTPUT PARAMETERS: - F2 - function values at X2[] - D2 - first derivatives at X2[] - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. -Function values are correctly reordered on return, so F2[I] is always -equal to S(X2[I]) independently of points order. - -SETTING BOUNDARY VALUES: - -The BoundLType/BoundRType parameters can have the following values: - * -1, which corresonds to the periodic (cyclic) boundary conditions. - In this case: - * both BoundLType and BoundRType must be equal to -1. - * BoundL/BoundR are ignored - * Y[last] is ignored (it is assumed to be equal to Y[first]). - * 0, which corresponds to the parabolically terminated spline - (BoundL and/or BoundR are ignored). - * 1, which corresponds to the first derivative boundary condition - * 2, which corresponds to the second derivative boundary condition - * by default, BoundType=0 is used - -PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: - -Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. -However, this subroutine doesn't require you to specify equal values for -the first and last points - it automatically forces them to be equal by -copying Y[first_point] (corresponds to the leftmost, minimal X[]) to -Y[last_point]. However it is recommended to pass consistent values of Y[], -i.e. to make Y[first_point]=Y[last_point]. - - -- ALGLIB PROJECT -- - Copyright 03.09.2010 by Bochkanov Sergey -*************************************************************************/ -void spline1dconvdiffcubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t boundltype, const double boundl, const ae_int_t boundrtype, const double boundr, const real_1d_array &x2, const ae_int_t n2, real_1d_array &y2, real_1d_array &d2); -void spline1dconvdiffcubic(const real_1d_array &x, const real_1d_array &y, const real_1d_array &x2, real_1d_array &y2, real_1d_array &d2); - - -/************************************************************************* -This function solves following problem: given table y[] of function values -at old nodes x[] and new nodes x2[], it calculates and returns table of -function values y2[], first and second derivatives d2[] and dd2[] -(calculated at x2[]). - -This function yields same result as Spline1DBuildCubic() call followed by -sequence of Spline1DDiff() calls, but it can be several times faster when -called for ordered X[] and X2[]. - -INPUT PARAMETERS: - X - old spline nodes - Y - function values - X2 - new spline nodes - -OPTIONAL PARAMETERS: - N - points count: - * N>=2 - * if given, only first N points from X/Y are used - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - BoundLType - boundary condition type for the left boundary - BoundL - left boundary condition (first or second derivative, - depending on the BoundLType) - BoundRType - boundary condition type for the right boundary - BoundR - right boundary condition (first or second derivative, - depending on the BoundRType) - N2 - new points count: - * N2>=2 - * if given, only first N2 points from X2 are used - * if not given, automatically detected from X2 size - -OUTPUT PARAMETERS: - F2 - function values at X2[] - D2 - first derivatives at X2[] - DD2 - second derivatives at X2[] - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. -Function values are correctly reordered on return, so F2[I] is always -equal to S(X2[I]) independently of points order. - -SETTING BOUNDARY VALUES: - -The BoundLType/BoundRType parameters can have the following values: - * -1, which corresonds to the periodic (cyclic) boundary conditions. - In this case: - * both BoundLType and BoundRType must be equal to -1. - * BoundL/BoundR are ignored - * Y[last] is ignored (it is assumed to be equal to Y[first]). - * 0, which corresponds to the parabolically terminated spline - (BoundL and/or BoundR are ignored). - * 1, which corresponds to the first derivative boundary condition - * 2, which corresponds to the second derivative boundary condition - * by default, BoundType=0 is used - -PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: - -Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. -However, this subroutine doesn't require you to specify equal values for -the first and last points - it automatically forces them to be equal by -copying Y[first_point] (corresponds to the leftmost, minimal X[]) to -Y[last_point]. However it is recommended to pass consistent values of Y[], -i.e. to make Y[first_point]=Y[last_point]. - - -- ALGLIB PROJECT -- - Copyright 03.09.2010 by Bochkanov Sergey -*************************************************************************/ -void spline1dconvdiff2cubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t boundltype, const double boundl, const ae_int_t boundrtype, const double boundr, const real_1d_array &x2, const ae_int_t n2, real_1d_array &y2, real_1d_array &d2, real_1d_array &dd2); -void spline1dconvdiff2cubic(const real_1d_array &x, const real_1d_array &y, const real_1d_array &x2, real_1d_array &y2, real_1d_array &d2, real_1d_array &dd2); - - -/************************************************************************* -This subroutine builds Catmull-Rom spline interpolant. - -INPUT PARAMETERS: - X - spline nodes, array[0..N-1]. - Y - function values, array[0..N-1]. - -OPTIONAL PARAMETERS: - N - points count: - * N>=2 - * if given, only first N points are used to build spline - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - BoundType - boundary condition type: - * -1 for periodic boundary condition - * 0 for parabolically terminated spline (default) - Tension - tension parameter: - * tension=0 corresponds to classic Catmull-Rom spline (default) - * 0=2 - * if given, only first N points are used to build spline - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - -OUTPUT PARAMETERS: - C - spline interpolant. - - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. - - -- ALGLIB PROJECT -- - Copyright 23.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline1dbuildhermite(const real_1d_array &x, const real_1d_array &y, const real_1d_array &d, const ae_int_t n, spline1dinterpolant &c); -void spline1dbuildhermite(const real_1d_array &x, const real_1d_array &y, const real_1d_array &d, spline1dinterpolant &c); - - -/************************************************************************* -This subroutine builds Akima spline interpolant - -INPUT PARAMETERS: - X - spline nodes, array[0..N-1] - Y - function values, array[0..N-1] - N - points count (optional): - * N>=2 - * if given, only first N points are used to build spline - * if not given, automatically detected from X/Y sizes - (len(X) must be equal to len(Y)) - -OUTPUT PARAMETERS: - C - spline interpolant - - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. - - -- ALGLIB PROJECT -- - Copyright 24.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline1dbuildakima(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, spline1dinterpolant &c); -void spline1dbuildakima(const real_1d_array &x, const real_1d_array &y, spline1dinterpolant &c); - - -/************************************************************************* -This subroutine calculates the value of the spline at the given point X. - -INPUT PARAMETERS: - C - spline interpolant - X - point - -Result: - S(x) - - -- ALGLIB PROJECT -- - Copyright 23.06.2007 by Bochkanov Sergey -*************************************************************************/ -double spline1dcalc(const spline1dinterpolant &c, const double x); - - -/************************************************************************* -This subroutine differentiates the spline. - -INPUT PARAMETERS: - C - spline interpolant. - X - point - -Result: - S - S(x) - DS - S'(x) - D2S - S''(x) - - -- ALGLIB PROJECT -- - Copyright 24.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline1ddiff(const spline1dinterpolant &c, const double x, double &s, double &ds, double &d2s); - - -/************************************************************************* -This subroutine unpacks the spline into the coefficients table. - -INPUT PARAMETERS: - C - spline interpolant. - X - point - -OUTPUT PARAMETERS: - Tbl - coefficients table, unpacked format, array[0..N-2, 0..5]. - For I = 0...N-2: - Tbl[I,0] = X[i] - Tbl[I,1] = X[i+1] - Tbl[I,2] = C0 - Tbl[I,3] = C1 - Tbl[I,4] = C2 - Tbl[I,5] = C3 - On [x[i], x[i+1]] spline is equals to: - S(x) = C0 + C1*t + C2*t^2 + C3*t^3 - t = x-x[i] - -NOTE: - You can rebuild spline with Spline1DBuildHermite() function, which - accepts as inputs function values and derivatives at nodes, which are - easy to calculate when you have coefficients. - - -- ALGLIB PROJECT -- - Copyright 29.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline1dunpack(const spline1dinterpolant &c, ae_int_t &n, real_2d_array &tbl); - - -/************************************************************************* -This subroutine performs linear transformation of the spline argument. - -INPUT PARAMETERS: - C - spline interpolant. - A, B- transformation coefficients: x = A*t + B -Result: - C - transformed spline - - -- ALGLIB PROJECT -- - Copyright 30.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline1dlintransx(const spline1dinterpolant &c, const double a, const double b); - - -/************************************************************************* -This subroutine performs linear transformation of the spline. - -INPUT PARAMETERS: - C - spline interpolant. - A, B- transformation coefficients: S2(x) = A*S(x) + B -Result: - C - transformed spline - - -- ALGLIB PROJECT -- - Copyright 30.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline1dlintransy(const spline1dinterpolant &c, const double a, const double b); - - -/************************************************************************* -This subroutine integrates the spline. - -INPUT PARAMETERS: - C - spline interpolant. - X - right bound of the integration interval [a, x], - here 'a' denotes min(x[]) -Result: - integral(S(t)dt,a,x) - - -- ALGLIB PROJECT -- - Copyright 23.06.2007 by Bochkanov Sergey -*************************************************************************/ -double spline1dintegrate(const spline1dinterpolant &c, const double x); - - -/************************************************************************* -This function builds monotone cubic Hermite interpolant. This interpolant -is monotonic in [x(0),x(n-1)] and is constant outside of this interval. - -In case y[] form non-monotonic sequence, interpolant is piecewise -monotonic. Say, for x=(0,1,2,3,4) and y=(0,1,2,1,0) interpolant will -monotonically grow at [0..2] and monotonically decrease at [2..4]. - -INPUT PARAMETERS: - X - spline nodes, array[0..N-1]. Subroutine automatically - sorts points, so caller may pass unsorted array. - Y - function values, array[0..N-1] - N - the number of points(N>=2). - -OUTPUT PARAMETERS: - C - spline interpolant. - - -- ALGLIB PROJECT -- - Copyright 21.06.2012 by Bochkanov Sergey -*************************************************************************/ -void spline1dbuildmonotone(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, spline1dinterpolant &c); -void spline1dbuildmonotone(const real_1d_array &x, const real_1d_array &y, spline1dinterpolant &c); - -/************************************************************************* -Fitting by polynomials in barycentric form. This function provides simple -unterface for unconstrained unweighted fitting. See PolynomialFitWC() if -you need constrained fitting. - -Task is linear, so linear least squares solver is used. Complexity of this -computational scheme is O(N*M^2), mostly dominated by least squares solver - -SEE ALSO: - PolynomialFitWC() - -INPUT PARAMETERS: - X - points, array[0..N-1]. - Y - function values, array[0..N-1]. - N - number of points, N>0 - * if given, only leading N elements of X/Y are used - * if not given, automatically determined from sizes of X/Y - M - number of basis functions (= polynomial_degree + 1), M>=1 - -OUTPUT PARAMETERS: - Info- same format as in LSFitLinearW() subroutine: - * Info>0 task is solved - * Info<=0 an error occurred: - -4 means inconvergence of internal SVD - P - interpolant in barycentric form. - Rep - report, same format as in LSFitLinearW() subroutine. - Following fields are set: - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -NOTES: - you can convert P from barycentric form to the power or Chebyshev - basis with PolynomialBar2Pow() or PolynomialBar2Cheb() functions from - POLINT subpackage. - - -- ALGLIB PROJECT -- - Copyright 10.12.2009 by Bochkanov Sergey -*************************************************************************/ -void polynomialfit(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t m, ae_int_t &info, barycentricinterpolant &p, polynomialfitreport &rep); -void polynomialfit(const real_1d_array &x, const real_1d_array &y, const ae_int_t m, ae_int_t &info, barycentricinterpolant &p, polynomialfitreport &rep); - - -/************************************************************************* -Weighted fitting by polynomials in barycentric form, with constraints on -function values or first derivatives. - -Small regularizing term is used when solving constrained tasks (to improve -stability). - -Task is linear, so linear least squares solver is used. Complexity of this -computational scheme is O(N*M^2), mostly dominated by least squares solver - -SEE ALSO: - PolynomialFit() - -INPUT PARAMETERS: - X - points, array[0..N-1]. - Y - function values, array[0..N-1]. - W - weights, array[0..N-1] - Each summand in square sum of approximation deviations from - given values is multiplied by the square of corresponding - weight. Fill it by 1's if you don't want to solve weighted - task. - N - number of points, N>0. - * if given, only leading N elements of X/Y/W are used - * if not given, automatically determined from sizes of X/Y/W - XC - points where polynomial values/derivatives are constrained, - array[0..K-1]. - YC - values of constraints, array[0..K-1] - DC - array[0..K-1], types of constraints: - * DC[i]=0 means that P(XC[i])=YC[i] - * DC[i]=1 means that P'(XC[i])=YC[i] - SEE BELOW FOR IMPORTANT INFORMATION ON CONSTRAINTS - K - number of constraints, 0<=K=1 - -OUTPUT PARAMETERS: - Info- same format as in LSFitLinearW() subroutine: - * Info>0 task is solved - * Info<=0 an error occurred: - -4 means inconvergence of internal SVD - -3 means inconsistent constraints - P - interpolant in barycentric form. - Rep - report, same format as in LSFitLinearW() subroutine. - Following fields are set: - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -IMPORTANT: - this subroitine doesn't calculate task's condition number for K<>0. - -NOTES: - you can convert P from barycentric form to the power or Chebyshev - basis with PolynomialBar2Pow() or PolynomialBar2Cheb() functions from - POLINT subpackage. - -SETTING CONSTRAINTS - DANGERS AND OPPORTUNITIES: - -Setting constraints can lead to undesired results, like ill-conditioned -behavior, or inconsistency being detected. From the other side, it allows -us to improve quality of the fit. Here we summarize our experience with -constrained regression splines: -* even simple constraints can be inconsistent, see Wikipedia article on - this subject: http://en.wikipedia.org/wiki/Birkhoff_interpolation -* the greater is M (given fixed constraints), the more chances that - constraints will be consistent -* in the general case, consistency of constraints is NOT GUARANTEED. -* in the one special cases, however, we can guarantee consistency. This - case is: M>1 and constraints on the function values (NOT DERIVATIVES) - -Our final recommendation is to use constraints WHEN AND ONLY when you -can't solve your task without them. Anything beyond special cases given -above is not guaranteed and may result in inconsistency. - - -- ALGLIB PROJECT -- - Copyright 10.12.2009 by Bochkanov Sergey -*************************************************************************/ -void polynomialfitwc(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const ae_int_t n, const real_1d_array &xc, const real_1d_array &yc, const integer_1d_array &dc, const ae_int_t k, const ae_int_t m, ae_int_t &info, barycentricinterpolant &p, polynomialfitreport &rep); -void polynomialfitwc(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &xc, const real_1d_array &yc, const integer_1d_array &dc, const ae_int_t m, ae_int_t &info, barycentricinterpolant &p, polynomialfitreport &rep); - - -/************************************************************************* -Weghted rational least squares fitting using Floater-Hormann rational -functions with optimal D chosen from [0,9], with constraints and -individual weights. - -Equidistant grid with M node on [min(x),max(x)] is used to build basis -functions. Different values of D are tried, optimal D (least WEIGHTED root -mean square error) is chosen. Task is linear, so linear least squares -solver is used. Complexity of this computational scheme is O(N*M^2) -(mostly dominated by the least squares solver). - -SEE ALSO -* BarycentricFitFloaterHormann(), "lightweight" fitting without invididual - weights and constraints. - -INPUT PARAMETERS: - X - points, array[0..N-1]. - Y - function values, array[0..N-1]. - W - weights, array[0..N-1] - Each summand in square sum of approximation deviations from - given values is multiplied by the square of corresponding - weight. Fill it by 1's if you don't want to solve weighted - task. - N - number of points, N>0. - XC - points where function values/derivatives are constrained, - array[0..K-1]. - YC - values of constraints, array[0..K-1] - DC - array[0..K-1], types of constraints: - * DC[i]=0 means that S(XC[i])=YC[i] - * DC[i]=1 means that S'(XC[i])=YC[i] - SEE BELOW FOR IMPORTANT INFORMATION ON CONSTRAINTS - K - number of constraints, 0<=K=2. - -OUTPUT PARAMETERS: - Info- same format as in LSFitLinearWC() subroutine. - * Info>0 task is solved - * Info<=0 an error occurred: - -4 means inconvergence of internal SVD - -3 means inconsistent constraints - -1 means another errors in parameters passed - (N<=0, for example) - B - barycentric interpolant. - Rep - report, same format as in LSFitLinearWC() subroutine. - Following fields are set: - * DBest best value of the D parameter - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -IMPORTANT: - this subroutine doesn't calculate task's condition number for K<>0. - -SETTING CONSTRAINTS - DANGERS AND OPPORTUNITIES: - -Setting constraints can lead to undesired results, like ill-conditioned -behavior, or inconsistency being detected. From the other side, it allows -us to improve quality of the fit. Here we summarize our experience with -constrained barycentric interpolants: -* excessive constraints can be inconsistent. Floater-Hormann basis - functions aren't as flexible as splines (although they are very smooth). -* the more evenly constraints are spread across [min(x),max(x)], the more - chances that they will be consistent -* the greater is M (given fixed constraints), the more chances that - constraints will be consistent -* in the general case, consistency of constraints IS NOT GUARANTEED. -* in the several special cases, however, we CAN guarantee consistency. -* one of this cases is constraints on the function VALUES at the interval - boundaries. Note that consustency of the constraints on the function - DERIVATIVES is NOT guaranteed (you can use in such cases cubic splines - which are more flexible). -* another special case is ONE constraint on the function value (OR, but - not AND, derivative) anywhere in the interval - -Our final recommendation is to use constraints WHEN AND ONLY WHEN you -can't solve your task without them. Anything beyond special cases given -above is not guaranteed and may result in inconsistency. - - -- ALGLIB PROJECT -- - Copyright 18.08.2009 by Bochkanov Sergey -*************************************************************************/ -void barycentricfitfloaterhormannwc(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const ae_int_t n, const real_1d_array &xc, const real_1d_array &yc, const integer_1d_array &dc, const ae_int_t k, const ae_int_t m, ae_int_t &info, barycentricinterpolant &b, barycentricfitreport &rep); - - -/************************************************************************* -Rational least squares fitting using Floater-Hormann rational functions -with optimal D chosen from [0,9]. - -Equidistant grid with M node on [min(x),max(x)] is used to build basis -functions. Different values of D are tried, optimal D (least root mean -square error) is chosen. Task is linear, so linear least squares solver -is used. Complexity of this computational scheme is O(N*M^2) (mostly -dominated by the least squares solver). - -INPUT PARAMETERS: - X - points, array[0..N-1]. - Y - function values, array[0..N-1]. - N - number of points, N>0. - M - number of basis functions ( = number_of_nodes), M>=2. - -OUTPUT PARAMETERS: - Info- same format as in LSFitLinearWC() subroutine. - * Info>0 task is solved - * Info<=0 an error occurred: - -4 means inconvergence of internal SVD - -3 means inconsistent constraints - B - barycentric interpolant. - Rep - report, same format as in LSFitLinearWC() subroutine. - Following fields are set: - * DBest best value of the D parameter - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - - -- ALGLIB PROJECT -- - Copyright 18.08.2009 by Bochkanov Sergey -*************************************************************************/ -void barycentricfitfloaterhormann(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t m, ae_int_t &info, barycentricinterpolant &b, barycentricfitreport &rep); - - -/************************************************************************* -Rational least squares fitting using Floater-Hormann rational functions -with optimal D chosen from [0,9]. - -Equidistant grid with M node on [min(x),max(x)] is used to build basis -functions. Different values of D are tried, optimal D (least root mean -square error) is chosen. Task is linear, so linear least squares solver -is used. Complexity of this computational scheme is O(N*M^2) (mostly -dominated by the least squares solver). - -INPUT PARAMETERS: - X - points, array[0..N-1]. - Y - function values, array[0..N-1]. - N - number of points, N>0. - M - number of basis functions ( = number_of_nodes), M>=2. - -OUTPUT PARAMETERS: - Info- same format as in LSFitLinearWC() subroutine. - * Info>0 task is solved - * Info<=0 an error occurred: - -4 means inconvergence of internal SVD - -3 means inconsistent constraints - B - barycentric interpolant. - Rep - report, same format as in LSFitLinearWC() subroutine. - Following fields are set: - * DBest best value of the D parameter - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - - -- ALGLIB PROJECT -- - Copyright 18.08.2009 by Bochkanov Sergey -*************************************************************************/ -void spline1dfitpenalized(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t m, const double rho, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep); -void spline1dfitpenalized(const real_1d_array &x, const real_1d_array &y, const ae_int_t m, const double rho, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep); - - -/************************************************************************* -Weighted fitting by penalized cubic spline. - -Equidistant grid with M nodes on [min(x,xc),max(x,xc)] is used to build -basis functions. Basis functions are cubic splines with natural boundary -conditions. Problem is regularized by adding non-linearity penalty to the -usual least squares penalty function: - - S(x) = arg min { LS + P }, where - LS = SUM { w[i]^2*(y[i] - S(x[i]))^2 } - least squares penalty - P = C*10^rho*integral{ S''(x)^2*dx } - non-linearity penalty - rho - tunable constant given by user - C - automatically determined scale parameter, - makes penalty invariant with respect to scaling of X, Y, W. - -INPUT PARAMETERS: - X - points, array[0..N-1]. - Y - function values, array[0..N-1]. - W - weights, array[0..N-1] - Each summand in square sum of approximation deviations from - given values is multiplied by the square of corresponding - weight. Fill it by 1's if you don't want to solve weighted - problem. - N - number of points (optional): - * N>0 - * if given, only first N elements of X/Y/W are processed - * if not given, automatically determined from X/Y/W sizes - M - number of basis functions ( = number_of_nodes), M>=4. - Rho - regularization constant passed by user. It penalizes - nonlinearity in the regression spline. It is logarithmically - scaled, i.e. actual value of regularization constant is - calculated as 10^Rho. It is automatically scaled so that: - * Rho=2.0 corresponds to moderate amount of nonlinearity - * generally, it should be somewhere in the [-8.0,+8.0] - If you do not want to penalize nonlineary, - pass small Rho. Values as low as -15 should work. - -OUTPUT PARAMETERS: - Info- same format as in LSFitLinearWC() subroutine. - * Info>0 task is solved - * Info<=0 an error occurred: - -4 means inconvergence of internal SVD or - Cholesky decomposition; problem may be - too ill-conditioned (very rare) - S - spline interpolant. - Rep - Following fields are set: - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -IMPORTANT: - this subroitine doesn't calculate task's condition number for K<>0. - -NOTE 1: additional nodes are added to the spline outside of the fitting -interval to force linearity when xmax(x,xc). It is done -for consistency - we penalize non-linearity at [min(x,xc),max(x,xc)], so -it is natural to force linearity outside of this interval. - -NOTE 2: function automatically sorts points, so caller may pass unsorted -array. - - -- ALGLIB PROJECT -- - Copyright 19.10.2010 by Bochkanov Sergey -*************************************************************************/ -void spline1dfitpenalizedw(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const ae_int_t n, const ae_int_t m, const double rho, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep); -void spline1dfitpenalizedw(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const ae_int_t m, const double rho, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep); - - -/************************************************************************* -Weighted fitting by cubic spline, with constraints on function values or -derivatives. - -Equidistant grid with M-2 nodes on [min(x,xc),max(x,xc)] is used to build -basis functions. Basis functions are cubic splines with continuous second -derivatives and non-fixed first derivatives at interval ends. Small -regularizing term is used when solving constrained tasks (to improve -stability). - -Task is linear, so linear least squares solver is used. Complexity of this -computational scheme is O(N*M^2), mostly dominated by least squares solver - -SEE ALSO - Spline1DFitHermiteWC() - fitting by Hermite splines (more flexible, - less smooth) - Spline1DFitCubic() - "lightweight" fitting by cubic splines, - without invididual weights and constraints - -INPUT PARAMETERS: - X - points, array[0..N-1]. - Y - function values, array[0..N-1]. - W - weights, array[0..N-1] - Each summand in square sum of approximation deviations from - given values is multiplied by the square of corresponding - weight. Fill it by 1's if you don't want to solve weighted - task. - N - number of points (optional): - * N>0 - * if given, only first N elements of X/Y/W are processed - * if not given, automatically determined from X/Y/W sizes - XC - points where spline values/derivatives are constrained, - array[0..K-1]. - YC - values of constraints, array[0..K-1] - DC - array[0..K-1], types of constraints: - * DC[i]=0 means that S(XC[i])=YC[i] - * DC[i]=1 means that S'(XC[i])=YC[i] - SEE BELOW FOR IMPORTANT INFORMATION ON CONSTRAINTS - K - number of constraints (optional): - * 0<=K=4. - -OUTPUT PARAMETERS: - Info- same format as in LSFitLinearWC() subroutine. - * Info>0 task is solved - * Info<=0 an error occurred: - -4 means inconvergence of internal SVD - -3 means inconsistent constraints - S - spline interpolant. - Rep - report, same format as in LSFitLinearWC() subroutine. - Following fields are set: - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -IMPORTANT: - this subroitine doesn't calculate task's condition number for K<>0. - - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. - -SETTING CONSTRAINTS - DANGERS AND OPPORTUNITIES: - -Setting constraints can lead to undesired results, like ill-conditioned -behavior, or inconsistency being detected. From the other side, it allows -us to improve quality of the fit. Here we summarize our experience with -constrained regression splines: -* excessive constraints can be inconsistent. Splines are piecewise cubic - functions, and it is easy to create an example, where large number of - constraints concentrated in small area will result in inconsistency. - Just because spline is not flexible enough to satisfy all of them. And - same constraints spread across the [min(x),max(x)] will be perfectly - consistent. -* the more evenly constraints are spread across [min(x),max(x)], the more - chances that they will be consistent -* the greater is M (given fixed constraints), the more chances that - constraints will be consistent -* in the general case, consistency of constraints IS NOT GUARANTEED. -* in the several special cases, however, we CAN guarantee consistency. -* one of this cases is constraints on the function values AND/OR its - derivatives at the interval boundaries. -* another special case is ONE constraint on the function value (OR, but - not AND, derivative) anywhere in the interval - -Our final recommendation is to use constraints WHEN AND ONLY WHEN you -can't solve your task without them. Anything beyond special cases given -above is not guaranteed and may result in inconsistency. - - - -- ALGLIB PROJECT -- - Copyright 18.08.2009 by Bochkanov Sergey -*************************************************************************/ -void spline1dfitcubicwc(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const ae_int_t n, const real_1d_array &xc, const real_1d_array &yc, const integer_1d_array &dc, const ae_int_t k, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep); -void spline1dfitcubicwc(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &xc, const real_1d_array &yc, const integer_1d_array &dc, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep); - - -/************************************************************************* -Weighted fitting by Hermite spline, with constraints on function values -or first derivatives. - -Equidistant grid with M nodes on [min(x,xc),max(x,xc)] is used to build -basis functions. Basis functions are Hermite splines. Small regularizing -term is used when solving constrained tasks (to improve stability). - -Task is linear, so linear least squares solver is used. Complexity of this -computational scheme is O(N*M^2), mostly dominated by least squares solver - -SEE ALSO - Spline1DFitCubicWC() - fitting by Cubic splines (less flexible, - more smooth) - Spline1DFitHermite() - "lightweight" Hermite fitting, without - invididual weights and constraints - -INPUT PARAMETERS: - X - points, array[0..N-1]. - Y - function values, array[0..N-1]. - W - weights, array[0..N-1] - Each summand in square sum of approximation deviations from - given values is multiplied by the square of corresponding - weight. Fill it by 1's if you don't want to solve weighted - task. - N - number of points (optional): - * N>0 - * if given, only first N elements of X/Y/W are processed - * if not given, automatically determined from X/Y/W sizes - XC - points where spline values/derivatives are constrained, - array[0..K-1]. - YC - values of constraints, array[0..K-1] - DC - array[0..K-1], types of constraints: - * DC[i]=0 means that S(XC[i])=YC[i] - * DC[i]=1 means that S'(XC[i])=YC[i] - SEE BELOW FOR IMPORTANT INFORMATION ON CONSTRAINTS - K - number of constraints (optional): - * 0<=K=4, - M IS EVEN! - -OUTPUT PARAMETERS: - Info- same format as in LSFitLinearW() subroutine: - * Info>0 task is solved - * Info<=0 an error occurred: - -4 means inconvergence of internal SVD - -3 means inconsistent constraints - -2 means odd M was passed (which is not supported) - -1 means another errors in parameters passed - (N<=0, for example) - S - spline interpolant. - Rep - report, same format as in LSFitLinearW() subroutine. - Following fields are set: - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -IMPORTANT: - this subroitine doesn't calculate task's condition number for K<>0. - -IMPORTANT: - this subroitine supports only even M's - - -ORDER OF POINTS - -Subroutine automatically sorts points, so caller may pass unsorted array. - -SETTING CONSTRAINTS - DANGERS AND OPPORTUNITIES: - -Setting constraints can lead to undesired results, like ill-conditioned -behavior, or inconsistency being detected. From the other side, it allows -us to improve quality of the fit. Here we summarize our experience with -constrained regression splines: -* excessive constraints can be inconsistent. Splines are piecewise cubic - functions, and it is easy to create an example, where large number of - constraints concentrated in small area will result in inconsistency. - Just because spline is not flexible enough to satisfy all of them. And - same constraints spread across the [min(x),max(x)] will be perfectly - consistent. -* the more evenly constraints are spread across [min(x),max(x)], the more - chances that they will be consistent -* the greater is M (given fixed constraints), the more chances that - constraints will be consistent -* in the general case, consistency of constraints is NOT GUARANTEED. -* in the several special cases, however, we can guarantee consistency. -* one of this cases is M>=4 and constraints on the function value - (AND/OR its derivative) at the interval boundaries. -* another special case is M>=4 and ONE constraint on the function value - (OR, BUT NOT AND, derivative) anywhere in [min(x),max(x)] - -Our final recommendation is to use constraints WHEN AND ONLY when you -can't solve your task without them. Anything beyond special cases given -above is not guaranteed and may result in inconsistency. - - -- ALGLIB PROJECT -- - Copyright 18.08.2009 by Bochkanov Sergey -*************************************************************************/ -void spline1dfithermitewc(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const ae_int_t n, const real_1d_array &xc, const real_1d_array &yc, const integer_1d_array &dc, const ae_int_t k, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep); -void spline1dfithermitewc(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &xc, const real_1d_array &yc, const integer_1d_array &dc, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep); - - -/************************************************************************* -Least squares fitting by cubic spline. - -This subroutine is "lightweight" alternative for more complex and feature- -rich Spline1DFitCubicWC(). See Spline1DFitCubicWC() for more information -about subroutine parameters (we don't duplicate it here because of length) - - -- ALGLIB PROJECT -- - Copyright 18.08.2009 by Bochkanov Sergey -*************************************************************************/ -void spline1dfitcubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep); -void spline1dfitcubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep); - - -/************************************************************************* -Least squares fitting by Hermite spline. - -This subroutine is "lightweight" alternative for more complex and feature- -rich Spline1DFitHermiteWC(). See Spline1DFitHermiteWC() description for -more information about subroutine parameters (we don't duplicate it here -because of length). - - -- ALGLIB PROJECT -- - Copyright 18.08.2009 by Bochkanov Sergey -*************************************************************************/ -void spline1dfithermite(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep); -void spline1dfithermite(const real_1d_array &x, const real_1d_array &y, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep); - - -/************************************************************************* -Weighted linear least squares fitting. - -QR decomposition is used to reduce task to MxM, then triangular solver or -SVD-based solver is used depending on condition number of the system. It -allows to maximize speed and retain decent accuracy. - -IMPORTANT: if you want to perform polynomial fitting, it may be more - convenient to use PolynomialFit() function. This function gives - best results on polynomial problems and solves numerical - stability issues which arise when you fit high-degree - polynomials to your data. - -INPUT PARAMETERS: - Y - array[0..N-1] Function values in N points. - W - array[0..N-1] Weights corresponding to function values. - Each summand in square sum of approximation deviations - from given values is multiplied by the square of - corresponding weight. - FMatrix - a table of basis functions values, array[0..N-1, 0..M-1]. - FMatrix[I, J] - value of J-th basis function in I-th point. - N - number of points used. N>=1. - M - number of basis functions, M>=1. - -OUTPUT PARAMETERS: - Info - error code: - * -4 internal SVD decomposition subroutine failed (very - rare and for degenerate systems only) - * -1 incorrect N/M were specified - * 1 task is solved - C - decomposition coefficients, array[0..M-1] - Rep - fitting report. Following fields are set: - * Rep.TaskRCond reciprocal of condition number - * R2 non-adjusted coefficient of determination - (non-weighted) - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -ERRORS IN PARAMETERS - -This solver also calculates different kinds of errors in parameters and -fills corresponding fields of report: -* Rep.CovPar covariance matrix for parameters, array[K,K]. -* Rep.ErrPar errors in parameters, array[K], - errpar = sqrt(diag(CovPar)) -* Rep.ErrCurve vector of fit errors - standard deviations of empirical - best-fit curve from "ideal" best-fit curve built with - infinite number of samples, array[N]. - errcurve = sqrt(diag(F*CovPar*F')), - where F is functions matrix. -* Rep.Noise vector of per-point estimates of noise, array[N] - -NOTE: noise in the data is estimated as follows: - * for fitting without user-supplied weights all points are - assumed to have same level of noise, which is estimated from - the data - * for fitting with user-supplied weights we assume that noise - level in I-th point is inversely proportional to Ith weight. - Coefficient of proportionality is estimated from the data. - -NOTE: we apply small amount of regularization when we invert squared - Jacobian and calculate covariance matrix. It guarantees that - algorithm won't divide by zero during inversion, but skews - error estimates a bit (fractional error is about 10^-9). - - However, we believe that this difference is insignificant for - all practical purposes except for the situation when you want - to compare ALGLIB results with "reference" implementation up - to the last significant digit. - -NOTE: covariance matrix is estimated using correction for degrees - of freedom (covariances are divided by N-M instead of dividing - by N). - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitlinearw(const real_1d_array &y, const real_1d_array &w, const real_2d_array &fmatrix, const ae_int_t n, const ae_int_t m, ae_int_t &info, real_1d_array &c, lsfitreport &rep); -void lsfitlinearw(const real_1d_array &y, const real_1d_array &w, const real_2d_array &fmatrix, ae_int_t &info, real_1d_array &c, lsfitreport &rep); - - -/************************************************************************* -Weighted constained linear least squares fitting. - -This is variation of LSFitLinearW(), which searchs for min|A*x=b| given -that K additional constraints C*x=bc are satisfied. It reduces original -task to modified one: min|B*y-d| WITHOUT constraints, then LSFitLinearW() -is called. - -IMPORTANT: if you want to perform polynomial fitting, it may be more - convenient to use PolynomialFit() function. This function gives - best results on polynomial problems and solves numerical - stability issues which arise when you fit high-degree - polynomials to your data. - -INPUT PARAMETERS: - Y - array[0..N-1] Function values in N points. - W - array[0..N-1] Weights corresponding to function values. - Each summand in square sum of approximation deviations - from given values is multiplied by the square of - corresponding weight. - FMatrix - a table of basis functions values, array[0..N-1, 0..M-1]. - FMatrix[I,J] - value of J-th basis function in I-th point. - CMatrix - a table of constraints, array[0..K-1,0..M]. - I-th row of CMatrix corresponds to I-th linear constraint: - CMatrix[I,0]*C[0] + ... + CMatrix[I,M-1]*C[M-1] = CMatrix[I,M] - N - number of points used. N>=1. - M - number of basis functions, M>=1. - K - number of constraints, 0 <= K < M - K=0 corresponds to absence of constraints. - -OUTPUT PARAMETERS: - Info - error code: - * -4 internal SVD decomposition subroutine failed (very - rare and for degenerate systems only) - * -3 either too many constraints (M or more), - degenerate constraints (some constraints are - repetead twice) or inconsistent constraints were - specified. - * 1 task is solved - C - decomposition coefficients, array[0..M-1] - Rep - fitting report. Following fields are set: - * R2 non-adjusted coefficient of determination - (non-weighted) - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -IMPORTANT: - this subroitine doesn't calculate task's condition number for K<>0. - -ERRORS IN PARAMETERS - -This solver also calculates different kinds of errors in parameters and -fills corresponding fields of report: -* Rep.CovPar covariance matrix for parameters, array[K,K]. -* Rep.ErrPar errors in parameters, array[K], - errpar = sqrt(diag(CovPar)) -* Rep.ErrCurve vector of fit errors - standard deviations of empirical - best-fit curve from "ideal" best-fit curve built with - infinite number of samples, array[N]. - errcurve = sqrt(diag(F*CovPar*F')), - where F is functions matrix. -* Rep.Noise vector of per-point estimates of noise, array[N] - -IMPORTANT: errors in parameters are calculated without taking into - account boundary/linear constraints! Presence of constraints - changes distribution of errors, but there is no easy way to - account for constraints when you calculate covariance matrix. - -NOTE: noise in the data is estimated as follows: - * for fitting without user-supplied weights all points are - assumed to have same level of noise, which is estimated from - the data - * for fitting with user-supplied weights we assume that noise - level in I-th point is inversely proportional to Ith weight. - Coefficient of proportionality is estimated from the data. - -NOTE: we apply small amount of regularization when we invert squared - Jacobian and calculate covariance matrix. It guarantees that - algorithm won't divide by zero during inversion, but skews - error estimates a bit (fractional error is about 10^-9). - - However, we believe that this difference is insignificant for - all practical purposes except for the situation when you want - to compare ALGLIB results with "reference" implementation up - to the last significant digit. - -NOTE: covariance matrix is estimated using correction for degrees - of freedom (covariances are divided by N-M instead of dividing - by N). - - -- ALGLIB -- - Copyright 07.09.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitlinearwc(const real_1d_array &y, const real_1d_array &w, const real_2d_array &fmatrix, const real_2d_array &cmatrix, const ae_int_t n, const ae_int_t m, const ae_int_t k, ae_int_t &info, real_1d_array &c, lsfitreport &rep); -void lsfitlinearwc(const real_1d_array &y, const real_1d_array &w, const real_2d_array &fmatrix, const real_2d_array &cmatrix, ae_int_t &info, real_1d_array &c, lsfitreport &rep); - - -/************************************************************************* -Linear least squares fitting. - -QR decomposition is used to reduce task to MxM, then triangular solver or -SVD-based solver is used depending on condition number of the system. It -allows to maximize speed and retain decent accuracy. - -IMPORTANT: if you want to perform polynomial fitting, it may be more - convenient to use PolynomialFit() function. This function gives - best results on polynomial problems and solves numerical - stability issues which arise when you fit high-degree - polynomials to your data. - -INPUT PARAMETERS: - Y - array[0..N-1] Function values in N points. - FMatrix - a table of basis functions values, array[0..N-1, 0..M-1]. - FMatrix[I, J] - value of J-th basis function in I-th point. - N - number of points used. N>=1. - M - number of basis functions, M>=1. - -OUTPUT PARAMETERS: - Info - error code: - * -4 internal SVD decomposition subroutine failed (very - rare and for degenerate systems only) - * 1 task is solved - C - decomposition coefficients, array[0..M-1] - Rep - fitting report. Following fields are set: - * Rep.TaskRCond reciprocal of condition number - * R2 non-adjusted coefficient of determination - (non-weighted) - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -ERRORS IN PARAMETERS - -This solver also calculates different kinds of errors in parameters and -fills corresponding fields of report: -* Rep.CovPar covariance matrix for parameters, array[K,K]. -* Rep.ErrPar errors in parameters, array[K], - errpar = sqrt(diag(CovPar)) -* Rep.ErrCurve vector of fit errors - standard deviations of empirical - best-fit curve from "ideal" best-fit curve built with - infinite number of samples, array[N]. - errcurve = sqrt(diag(F*CovPar*F')), - where F is functions matrix. -* Rep.Noise vector of per-point estimates of noise, array[N] - -NOTE: noise in the data is estimated as follows: - * for fitting without user-supplied weights all points are - assumed to have same level of noise, which is estimated from - the data - * for fitting with user-supplied weights we assume that noise - level in I-th point is inversely proportional to Ith weight. - Coefficient of proportionality is estimated from the data. - -NOTE: we apply small amount of regularization when we invert squared - Jacobian and calculate covariance matrix. It guarantees that - algorithm won't divide by zero during inversion, but skews - error estimates a bit (fractional error is about 10^-9). - - However, we believe that this difference is insignificant for - all practical purposes except for the situation when you want - to compare ALGLIB results with "reference" implementation up - to the last significant digit. - -NOTE: covariance matrix is estimated using correction for degrees - of freedom (covariances are divided by N-M instead of dividing - by N). - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitlinear(const real_1d_array &y, const real_2d_array &fmatrix, const ae_int_t n, const ae_int_t m, ae_int_t &info, real_1d_array &c, lsfitreport &rep); -void lsfitlinear(const real_1d_array &y, const real_2d_array &fmatrix, ae_int_t &info, real_1d_array &c, lsfitreport &rep); - - -/************************************************************************* -Constained linear least squares fitting. - -This is variation of LSFitLinear(), which searchs for min|A*x=b| given -that K additional constraints C*x=bc are satisfied. It reduces original -task to modified one: min|B*y-d| WITHOUT constraints, then LSFitLinear() -is called. - -IMPORTANT: if you want to perform polynomial fitting, it may be more - convenient to use PolynomialFit() function. This function gives - best results on polynomial problems and solves numerical - stability issues which arise when you fit high-degree - polynomials to your data. - -INPUT PARAMETERS: - Y - array[0..N-1] Function values in N points. - FMatrix - a table of basis functions values, array[0..N-1, 0..M-1]. - FMatrix[I,J] - value of J-th basis function in I-th point. - CMatrix - a table of constraints, array[0..K-1,0..M]. - I-th row of CMatrix corresponds to I-th linear constraint: - CMatrix[I,0]*C[0] + ... + CMatrix[I,M-1]*C[M-1] = CMatrix[I,M] - N - number of points used. N>=1. - M - number of basis functions, M>=1. - K - number of constraints, 0 <= K < M - K=0 corresponds to absence of constraints. - -OUTPUT PARAMETERS: - Info - error code: - * -4 internal SVD decomposition subroutine failed (very - rare and for degenerate systems only) - * -3 either too many constraints (M or more), - degenerate constraints (some constraints are - repetead twice) or inconsistent constraints were - specified. - * 1 task is solved - C - decomposition coefficients, array[0..M-1] - Rep - fitting report. Following fields are set: - * R2 non-adjusted coefficient of determination - (non-weighted) - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - -IMPORTANT: - this subroitine doesn't calculate task's condition number for K<>0. - -ERRORS IN PARAMETERS - -This solver also calculates different kinds of errors in parameters and -fills corresponding fields of report: -* Rep.CovPar covariance matrix for parameters, array[K,K]. -* Rep.ErrPar errors in parameters, array[K], - errpar = sqrt(diag(CovPar)) -* Rep.ErrCurve vector of fit errors - standard deviations of empirical - best-fit curve from "ideal" best-fit curve built with - infinite number of samples, array[N]. - errcurve = sqrt(diag(F*CovPar*F')), - where F is functions matrix. -* Rep.Noise vector of per-point estimates of noise, array[N] - -IMPORTANT: errors in parameters are calculated without taking into - account boundary/linear constraints! Presence of constraints - changes distribution of errors, but there is no easy way to - account for constraints when you calculate covariance matrix. - -NOTE: noise in the data is estimated as follows: - * for fitting without user-supplied weights all points are - assumed to have same level of noise, which is estimated from - the data - * for fitting with user-supplied weights we assume that noise - level in I-th point is inversely proportional to Ith weight. - Coefficient of proportionality is estimated from the data. - -NOTE: we apply small amount of regularization when we invert squared - Jacobian and calculate covariance matrix. It guarantees that - algorithm won't divide by zero during inversion, but skews - error estimates a bit (fractional error is about 10^-9). - - However, we believe that this difference is insignificant for - all practical purposes except for the situation when you want - to compare ALGLIB results with "reference" implementation up - to the last significant digit. - -NOTE: covariance matrix is estimated using correction for degrees - of freedom (covariances are divided by N-M instead of dividing - by N). - - -- ALGLIB -- - Copyright 07.09.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitlinearc(const real_1d_array &y, const real_2d_array &fmatrix, const real_2d_array &cmatrix, const ae_int_t n, const ae_int_t m, const ae_int_t k, ae_int_t &info, real_1d_array &c, lsfitreport &rep); -void lsfitlinearc(const real_1d_array &y, const real_2d_array &fmatrix, const real_2d_array &cmatrix, ae_int_t &info, real_1d_array &c, lsfitreport &rep); - - -/************************************************************************* -Weighted nonlinear least squares fitting using function values only. - -Combination of numerical differentiation and secant updates is used to -obtain function Jacobian. - -Nonlinear task min(F(c)) is solved, where - - F(c) = (w[0]*(f(c,x[0])-y[0]))^2 + ... + (w[n-1]*(f(c,x[n-1])-y[n-1]))^2, - - * N is a number of points, - * M is a dimension of a space points belong to, - * K is a dimension of a space of parameters being fitted, - * w is an N-dimensional vector of weight coefficients, - * x is a set of N points, each of them is an M-dimensional vector, - * c is a K-dimensional vector of parameters being fitted - -This subroutine uses only f(c,x[i]). - -INPUT PARAMETERS: - X - array[0..N-1,0..M-1], points (one row = one point) - Y - array[0..N-1], function values. - W - weights, array[0..N-1] - C - array[0..K-1], initial approximation to the solution, - N - number of points, N>1 - M - dimension of space - K - number of parameters being fitted - DiffStep- numerical differentiation step; - should not be very small or large; - large = loss of accuracy - small = growth of round-off errors - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 18.10.2008 by Bochkanov Sergey -*************************************************************************/ -void lsfitcreatewf(const real_2d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &c, const ae_int_t n, const ae_int_t m, const ae_int_t k, const double diffstep, lsfitstate &state); -void lsfitcreatewf(const real_2d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &c, const double diffstep, lsfitstate &state); - - -/************************************************************************* -Nonlinear least squares fitting using function values only. - -Combination of numerical differentiation and secant updates is used to -obtain function Jacobian. - -Nonlinear task min(F(c)) is solved, where - - F(c) = (f(c,x[0])-y[0])^2 + ... + (f(c,x[n-1])-y[n-1])^2, - - * N is a number of points, - * M is a dimension of a space points belong to, - * K is a dimension of a space of parameters being fitted, - * w is an N-dimensional vector of weight coefficients, - * x is a set of N points, each of them is an M-dimensional vector, - * c is a K-dimensional vector of parameters being fitted - -This subroutine uses only f(c,x[i]). - -INPUT PARAMETERS: - X - array[0..N-1,0..M-1], points (one row = one point) - Y - array[0..N-1], function values. - C - array[0..K-1], initial approximation to the solution, - N - number of points, N>1 - M - dimension of space - K - number of parameters being fitted - DiffStep- numerical differentiation step; - should not be very small or large; - large = loss of accuracy - small = growth of round-off errors - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 18.10.2008 by Bochkanov Sergey -*************************************************************************/ -void lsfitcreatef(const real_2d_array &x, const real_1d_array &y, const real_1d_array &c, const ae_int_t n, const ae_int_t m, const ae_int_t k, const double diffstep, lsfitstate &state); -void lsfitcreatef(const real_2d_array &x, const real_1d_array &y, const real_1d_array &c, const double diffstep, lsfitstate &state); - - -/************************************************************************* -Weighted nonlinear least squares fitting using gradient only. - -Nonlinear task min(F(c)) is solved, where - - F(c) = (w[0]*(f(c,x[0])-y[0]))^2 + ... + (w[n-1]*(f(c,x[n-1])-y[n-1]))^2, - - * N is a number of points, - * M is a dimension of a space points belong to, - * K is a dimension of a space of parameters being fitted, - * w is an N-dimensional vector of weight coefficients, - * x is a set of N points, each of them is an M-dimensional vector, - * c is a K-dimensional vector of parameters being fitted - -This subroutine uses only f(c,x[i]) and its gradient. - -INPUT PARAMETERS: - X - array[0..N-1,0..M-1], points (one row = one point) - Y - array[0..N-1], function values. - W - weights, array[0..N-1] - C - array[0..K-1], initial approximation to the solution, - N - number of points, N>1 - M - dimension of space - K - number of parameters being fitted - CheapFG - boolean flag, which is: - * True if both function and gradient calculation complexity - are less than O(M^2). An improved algorithm can - be used which corresponds to FGJ scheme from - MINLM unit. - * False otherwise. - Standard Jacibian-bases Levenberg-Marquardt algo - will be used (FJ scheme). - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -See also: - LSFitResults - LSFitCreateFG (fitting without weights) - LSFitCreateWFGH (fitting using Hessian) - LSFitCreateFGH (fitting using Hessian, without weights) - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitcreatewfg(const real_2d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &c, const ae_int_t n, const ae_int_t m, const ae_int_t k, const bool cheapfg, lsfitstate &state); -void lsfitcreatewfg(const real_2d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &c, const bool cheapfg, lsfitstate &state); - - -/************************************************************************* -Nonlinear least squares fitting using gradient only, without individual -weights. - -Nonlinear task min(F(c)) is solved, where - - F(c) = ((f(c,x[0])-y[0]))^2 + ... + ((f(c,x[n-1])-y[n-1]))^2, - - * N is a number of points, - * M is a dimension of a space points belong to, - * K is a dimension of a space of parameters being fitted, - * x is a set of N points, each of them is an M-dimensional vector, - * c is a K-dimensional vector of parameters being fitted - -This subroutine uses only f(c,x[i]) and its gradient. - -INPUT PARAMETERS: - X - array[0..N-1,0..M-1], points (one row = one point) - Y - array[0..N-1], function values. - C - array[0..K-1], initial approximation to the solution, - N - number of points, N>1 - M - dimension of space - K - number of parameters being fitted - CheapFG - boolean flag, which is: - * True if both function and gradient calculation complexity - are less than O(M^2). An improved algorithm can - be used which corresponds to FGJ scheme from - MINLM unit. - * False otherwise. - Standard Jacibian-bases Levenberg-Marquardt algo - will be used (FJ scheme). - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitcreatefg(const real_2d_array &x, const real_1d_array &y, const real_1d_array &c, const ae_int_t n, const ae_int_t m, const ae_int_t k, const bool cheapfg, lsfitstate &state); -void lsfitcreatefg(const real_2d_array &x, const real_1d_array &y, const real_1d_array &c, const bool cheapfg, lsfitstate &state); - - -/************************************************************************* -Weighted nonlinear least squares fitting using gradient/Hessian. - -Nonlinear task min(F(c)) is solved, where - - F(c) = (w[0]*(f(c,x[0])-y[0]))^2 + ... + (w[n-1]*(f(c,x[n-1])-y[n-1]))^2, - - * N is a number of points, - * M is a dimension of a space points belong to, - * K is a dimension of a space of parameters being fitted, - * w is an N-dimensional vector of weight coefficients, - * x is a set of N points, each of them is an M-dimensional vector, - * c is a K-dimensional vector of parameters being fitted - -This subroutine uses f(c,x[i]), its gradient and its Hessian. - -INPUT PARAMETERS: - X - array[0..N-1,0..M-1], points (one row = one point) - Y - array[0..N-1], function values. - W - weights, array[0..N-1] - C - array[0..K-1], initial approximation to the solution, - N - number of points, N>1 - M - dimension of space - K - number of parameters being fitted - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitcreatewfgh(const real_2d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &c, const ae_int_t n, const ae_int_t m, const ae_int_t k, lsfitstate &state); -void lsfitcreatewfgh(const real_2d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &c, lsfitstate &state); - - -/************************************************************************* -Nonlinear least squares fitting using gradient/Hessian, without individial -weights. - -Nonlinear task min(F(c)) is solved, where - - F(c) = ((f(c,x[0])-y[0]))^2 + ... + ((f(c,x[n-1])-y[n-1]))^2, - - * N is a number of points, - * M is a dimension of a space points belong to, - * K is a dimension of a space of parameters being fitted, - * x is a set of N points, each of them is an M-dimensional vector, - * c is a K-dimensional vector of parameters being fitted - -This subroutine uses f(c,x[i]), its gradient and its Hessian. - -INPUT PARAMETERS: - X - array[0..N-1,0..M-1], points (one row = one point) - Y - array[0..N-1], function values. - C - array[0..K-1], initial approximation to the solution, - N - number of points, N>1 - M - dimension of space - K - number of parameters being fitted - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitcreatefgh(const real_2d_array &x, const real_1d_array &y, const real_1d_array &c, const ae_int_t n, const ae_int_t m, const ae_int_t k, lsfitstate &state); -void lsfitcreatefgh(const real_2d_array &x, const real_1d_array &y, const real_1d_array &c, lsfitstate &state); - - -/************************************************************************* -Stopping conditions for nonlinear least squares fitting. - -INPUT PARAMETERS: - State - structure which stores algorithm state - EpsF - stopping criterion. Algorithm stops if - |F(k+1)-F(k)| <= EpsF*max{|F(k)|, |F(k+1)|, 1} - EpsX - >=0 - The subroutine finishes its work if on k+1-th iteration - the condition |v|<=EpsX is fulfilled, where: - * |.| means Euclidian norm - * v - scaled step vector, v[i]=dx[i]/s[i] - * dx - ste pvector, dx=X(k+1)-X(k) - * s - scaling coefficients set by LSFitSetScale() - MaxIts - maximum number of iterations. If MaxIts=0, the number of - iterations is unlimited. Only Levenberg-Marquardt - iterations are counted (L-BFGS/CG iterations are NOT - counted because their cost is very low compared to that of - LM). - -NOTE - -Passing EpsF=0, EpsX=0 and MaxIts=0 (simultaneously) will lead to automatic -stopping criterion selection (according to the scheme used by MINLM unit). - - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitsetcond(const lsfitstate &state, const double epsf, const double epsx, const ae_int_t maxits); - - -/************************************************************************* -This function sets maximum step length - -INPUT PARAMETERS: - State - structure which stores algorithm state - StpMax - maximum step length, >=0. Set StpMax to 0.0, if you don't - want to limit step length. - -Use this subroutine when you optimize target function which contains exp() -or other fast growing functions, and optimization algorithm makes too -large steps which leads to overflow. This function allows us to reject -steps that are too large (and therefore expose us to the possible -overflow) without actually calculating function value at the x+stp*d. - -NOTE: non-zero StpMax leads to moderate performance degradation because -intermediate step of preconditioned L-BFGS optimization is incompatible -with limits on step size. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void lsfitsetstpmax(const lsfitstate &state, const double stpmax); - - -/************************************************************************* -This function turns on/off reporting. - -INPUT PARAMETERS: - State - structure which stores algorithm state - NeedXRep- whether iteration reports are needed or not - -When reports are needed, State.C (current parameters) and State.F (current -value of fitting function) are reported. - - - -- ALGLIB -- - Copyright 15.08.2010 by Bochkanov Sergey -*************************************************************************/ -void lsfitsetxrep(const lsfitstate &state, const bool needxrep); - - -/************************************************************************* -This function sets scaling coefficients for underlying optimizer. - -ALGLIB optimizers use scaling matrices to test stopping conditions (step -size and gradient are scaled before comparison with tolerances). Scale of -the I-th variable is a translation invariant measure of: -a) "how large" the variable is -b) how large the step should be to make significant changes in the function - -Generally, scale is NOT considered to be a form of preconditioner. But LM -optimizer is unique in that it uses scaling matrix both in the stopping -condition tests and as Marquardt damping factor. - -Proper scaling is very important for the algorithm performance. It is less -important for the quality of results, but still has some influence (it is -easier to converge when variables are properly scaled, so premature -stopping is possible when very badly scalled variables are combined with -relaxed stopping conditions). - -INPUT PARAMETERS: - State - structure stores algorithm state - S - array[N], non-zero scaling coefficients - S[i] may be negative, sign doesn't matter. - - -- ALGLIB -- - Copyright 14.01.2011 by Bochkanov Sergey -*************************************************************************/ -void lsfitsetscale(const lsfitstate &state, const real_1d_array &s); - - -/************************************************************************* -This function sets boundary constraints for underlying optimizer - -Boundary constraints are inactive by default (after initial creation). -They are preserved until explicitly turned off with another SetBC() call. - -INPUT PARAMETERS: - State - structure stores algorithm state - BndL - lower bounds, array[K]. - If some (all) variables are unbounded, you may specify - very small number or -INF (latter is recommended because - it will allow solver to use better algorithm). - BndU - upper bounds, array[K]. - If some (all) variables are unbounded, you may specify - very large number or +INF (latter is recommended because - it will allow solver to use better algorithm). - -NOTE 1: it is possible to specify BndL[i]=BndU[i]. In this case I-th -variable will be "frozen" at X[i]=BndL[i]=BndU[i]. - -NOTE 2: unlike other constrained optimization algorithms, this solver has -following useful properties: -* bound constraints are always satisfied exactly -* function is evaluated only INSIDE area specified by bound constraints - - -- ALGLIB -- - Copyright 14.01.2011 by Bochkanov Sergey -*************************************************************************/ -void lsfitsetbc(const lsfitstate &state, const real_1d_array &bndl, const real_1d_array &bndu); - - -/************************************************************************* -This function provides reverse communication interface -Reverse communication interface is not documented or recommended to use. -See below for functions which provide better documented API -*************************************************************************/ -bool lsfititeration(const lsfitstate &state); - - -/************************************************************************* -This family of functions is used to launcn iterations of nonlinear fitter - -These functions accept following parameters: - state - algorithm state - func - callback which calculates function (or merit function) - value func at given point x - grad - callback which calculates function (or merit function) - value func and gradient grad at given point x - hess - callback which calculates function (or merit function) - value func, gradient grad and Hessian hess at given point x - rep - optional callback which is called after each iteration - can be NULL - ptr - optional pointer which is passed to func/grad/hess/jac/rep - can be NULL - -NOTES: - -1. this algorithm is somewhat unusual because it works with parameterized - function f(C,X), where X is a function argument (we have many points - which are characterized by different argument values), and C is a - parameter to fit. - - For example, if we want to do linear fit by f(c0,c1,x) = c0*x+c1, then - x will be argument, and {c0,c1} will be parameters. - - It is important to understand that this algorithm finds minimum in the - space of function PARAMETERS (not arguments), so it needs derivatives - of f() with respect to C, not X. - - In the example above it will need f=c0*x+c1 and {df/dc0,df/dc1} = {x,1} - instead of {df/dx} = {c0}. - -2. Callback functions accept C as the first parameter, and X as the second - -3. If state was created with LSFitCreateFG(), algorithm needs just - function and its gradient, but if state was created with - LSFitCreateFGH(), algorithm will need function, gradient and Hessian. - - According to the said above, there ase several versions of this - function, which accept different sets of callbacks. - - This flexibility opens way to subtle errors - you may create state with - LSFitCreateFGH() (optimization using Hessian), but call function which - does not accept Hessian. So when algorithm will request Hessian, there - will be no callback to call. In this case exception will be thrown. - - Be careful to avoid such errors because there is no way to find them at - compile time - you can see them at runtime only. - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey - -*************************************************************************/ -void lsfitfit(lsfitstate &state, - void (*func)(const real_1d_array &c, const real_1d_array &x, double &func, void *ptr), - void (*rep)(const real_1d_array &c, double func, void *ptr) = NULL, - void *ptr = NULL); -void lsfitfit(lsfitstate &state, - void (*func)(const real_1d_array &c, const real_1d_array &x, double &func, void *ptr), - void (*grad)(const real_1d_array &c, const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), - void (*rep)(const real_1d_array &c, double func, void *ptr) = NULL, - void *ptr = NULL); -void lsfitfit(lsfitstate &state, - void (*func)(const real_1d_array &c, const real_1d_array &x, double &func, void *ptr), - void (*grad)(const real_1d_array &c, const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), - void (*hess)(const real_1d_array &c, const real_1d_array &x, double &func, real_1d_array &grad, real_2d_array &hess, void *ptr), - void (*rep)(const real_1d_array &c, double func, void *ptr) = NULL, - void *ptr = NULL); - - -/************************************************************************* -Nonlinear least squares fitting results. - -Called after return from LSFitFit(). - -INPUT PARAMETERS: - State - algorithm state - -OUTPUT PARAMETERS: - Info - completion code: - * -7 gradient verification failed. - See LSFitSetGradientCheck() for more information. - * 1 relative function improvement is no more than - EpsF. - * 2 relative step is no more than EpsX. - * 4 gradient norm is no more than EpsG - * 5 MaxIts steps was taken - * 7 stopping conditions are too stringent, - further improvement is impossible - C - array[0..K-1], solution - Rep - optimization report. On success following fields are set: - * R2 non-adjusted coefficient of determination - (non-weighted) - * RMSError rms error on the (X,Y). - * AvgError average error on the (X,Y). - * AvgRelError average relative error on the non-zero Y - * MaxError maximum error - NON-WEIGHTED ERRORS ARE CALCULATED - * WRMSError weighted rms error on the (X,Y). - -ERRORS IN PARAMETERS - -This solver also calculates different kinds of errors in parameters and -fills corresponding fields of report: -* Rep.CovPar covariance matrix for parameters, array[K,K]. -* Rep.ErrPar errors in parameters, array[K], - errpar = sqrt(diag(CovPar)) -* Rep.ErrCurve vector of fit errors - standard deviations of empirical - best-fit curve from "ideal" best-fit curve built with - infinite number of samples, array[N]. - errcurve = sqrt(diag(J*CovPar*J')), - where J is Jacobian matrix. -* Rep.Noise vector of per-point estimates of noise, array[N] - -IMPORTANT: errors in parameters are calculated without taking into - account boundary/linear constraints! Presence of constraints - changes distribution of errors, but there is no easy way to - account for constraints when you calculate covariance matrix. - -NOTE: noise in the data is estimated as follows: - * for fitting without user-supplied weights all points are - assumed to have same level of noise, which is estimated from - the data - * for fitting with user-supplied weights we assume that noise - level in I-th point is inversely proportional to Ith weight. - Coefficient of proportionality is estimated from the data. - -NOTE: we apply small amount of regularization when we invert squared - Jacobian and calculate covariance matrix. It guarantees that - algorithm won't divide by zero during inversion, but skews - error estimates a bit (fractional error is about 10^-9). - - However, we believe that this difference is insignificant for - all practical purposes except for the situation when you want - to compare ALGLIB results with "reference" implementation up - to the last significant digit. - -NOTE: covariance matrix is estimated using correction for degrees - of freedom (covariances are divided by N-M instead of dividing - by N). - - -- ALGLIB -- - Copyright 17.08.2009 by Bochkanov Sergey -*************************************************************************/ -void lsfitresults(const lsfitstate &state, ae_int_t &info, real_1d_array &c, lsfitreport &rep); - - -/************************************************************************* -This subroutine turns on verification of the user-supplied analytic -gradient: -* user calls this subroutine before fitting begins -* LSFitFit() is called -* prior to actual fitting, for each point in data set X_i and each - component of parameters being fited C_j algorithm performs following - steps: - * two trial steps are made to C_j-TestStep*S[j] and C_j+TestStep*S[j], - where C_j is j-th parameter and S[j] is a scale of j-th parameter - * if needed, steps are bounded with respect to constraints on C[] - * F(X_i|C) is evaluated at these trial points - * we perform one more evaluation in the middle point of the interval - * we build cubic model using function values and derivatives at trial - points and we compare its prediction with actual value in the middle - point - * in case difference between prediction and actual value is higher than - some predetermined threshold, algorithm stops with completion code -7; - Rep.VarIdx is set to index of the parameter with incorrect derivative. -* after verification is over, algorithm proceeds to the actual optimization. - -NOTE 1: verification needs N*K (points count * parameters count) gradient - evaluations. It is very costly and you should use it only for low - dimensional problems, when you want to be sure that you've - correctly calculated analytic derivatives. You should not use it - in the production code (unless you want to check derivatives - provided by some third party). - -NOTE 2: you should carefully choose TestStep. Value which is too large - (so large that function behaviour is significantly non-cubic) will - lead to false alarms. You may use different step for different - parameters by means of setting scale with LSFitSetScale(). - -NOTE 3: this function may lead to false positives. In case it reports that - I-th derivative was calculated incorrectly, you may decrease test - step and try one more time - maybe your function changes too - sharply and your step is too large for such rapidly chanding - function. - -NOTE 4: this function works only for optimizers created with LSFitCreateWFG() - or LSFitCreateFG() constructors. - -INPUT PARAMETERS: - State - structure used to store algorithm state - TestStep - verification step: - * TestStep=0 turns verification off - * TestStep>0 activates verification - - -- ALGLIB -- - Copyright 15.06.2012 by Bochkanov Sergey -*************************************************************************/ -void lsfitsetgradientcheck(const lsfitstate &state, const double teststep); - -/************************************************************************* -This function builds non-periodic 2-dimensional parametric spline which -starts at (X[0],Y[0]) and ends at (X[N-1],Y[N-1]). - -INPUT PARAMETERS: - XY - points, array[0..N-1,0..1]. - XY[I,0:1] corresponds to the Ith point. - Order of points is important! - N - points count, N>=5 for Akima splines, N>=2 for other types of - splines. - ST - spline type: - * 0 Akima spline - * 1 parabolically terminated Catmull-Rom spline (Tension=0) - * 2 parabolically terminated cubic spline - PT - parameterization type: - * 0 uniform - * 1 chord length - * 2 centripetal - -OUTPUT PARAMETERS: - P - parametric spline interpolant - - -NOTES: -* this function assumes that there all consequent points are distinct. - I.e. (x0,y0)<>(x1,y1), (x1,y1)<>(x2,y2), (x2,y2)<>(x3,y3) and so on. - However, non-consequent points may coincide, i.e. we can have (x0,y0)= - =(x2,y2). - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline2build(const real_2d_array &xy, const ae_int_t n, const ae_int_t st, const ae_int_t pt, pspline2interpolant &p); - - -/************************************************************************* -This function builds non-periodic 3-dimensional parametric spline which -starts at (X[0],Y[0],Z[0]) and ends at (X[N-1],Y[N-1],Z[N-1]). - -Same as PSpline2Build() function, but for 3D, so we won't duplicate its -description here. - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline3build(const real_2d_array &xy, const ae_int_t n, const ae_int_t st, const ae_int_t pt, pspline3interpolant &p); - - -/************************************************************************* -This function builds periodic 2-dimensional parametric spline which -starts at (X[0],Y[0]), goes through all points to (X[N-1],Y[N-1]) and then -back to (X[0],Y[0]). - -INPUT PARAMETERS: - XY - points, array[0..N-1,0..1]. - XY[I,0:1] corresponds to the Ith point. - XY[N-1,0:1] must be different from XY[0,0:1]. - Order of points is important! - N - points count, N>=3 for other types of splines. - ST - spline type: - * 1 Catmull-Rom spline (Tension=0) with cyclic boundary conditions - * 2 cubic spline with cyclic boundary conditions - PT - parameterization type: - * 0 uniform - * 1 chord length - * 2 centripetal - -OUTPUT PARAMETERS: - P - parametric spline interpolant - - -NOTES: -* this function assumes that there all consequent points are distinct. - I.e. (x0,y0)<>(x1,y1), (x1,y1)<>(x2,y2), (x2,y2)<>(x3,y3) and so on. - However, non-consequent points may coincide, i.e. we can have (x0,y0)= - =(x2,y2). -* last point of sequence is NOT equal to the first point. You shouldn't - make curve "explicitly periodic" by making them equal. - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline2buildperiodic(const real_2d_array &xy, const ae_int_t n, const ae_int_t st, const ae_int_t pt, pspline2interpolant &p); - - -/************************************************************************* -This function builds periodic 3-dimensional parametric spline which -starts at (X[0],Y[0],Z[0]), goes through all points to (X[N-1],Y[N-1],Z[N-1]) -and then back to (X[0],Y[0],Z[0]). - -Same as PSpline2Build() function, but for 3D, so we won't duplicate its -description here. - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline3buildperiodic(const real_2d_array &xy, const ae_int_t n, const ae_int_t st, const ae_int_t pt, pspline3interpolant &p); - - -/************************************************************************* -This function returns vector of parameter values correspoding to points. - -I.e. for P created from (X[0],Y[0])...(X[N-1],Y[N-1]) and U=TValues(P) we -have - (X[0],Y[0]) = PSpline2Calc(P,U[0]), - (X[1],Y[1]) = PSpline2Calc(P,U[1]), - (X[2],Y[2]) = PSpline2Calc(P,U[2]), - ... - -INPUT PARAMETERS: - P - parametric spline interpolant - -OUTPUT PARAMETERS: - N - array size - T - array[0..N-1] - - -NOTES: -* for non-periodic splines U[0]=0, U[0]1) correspond to parts of - the curve before the first (after the last) point - * for periodic splines T<0 (or T>1) are projected into [0,1] - by making T=T-floor(T). - -OUTPUT PARAMETERS: - X - X-position - Y - Y-position - - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline2calc(const pspline2interpolant &p, const double t, double &x, double &y); - - -/************************************************************************* -This function calculates the value of the parametric spline for a given -value of parameter T. - -INPUT PARAMETERS: - P - parametric spline interpolant - T - point: - * T in [0,1] corresponds to interval spanned by points - * for non-periodic splines T<0 (or T>1) correspond to parts of - the curve before the first (after the last) point - * for periodic splines T<0 (or T>1) are projected into [0,1] - by making T=T-floor(T). - -OUTPUT PARAMETERS: - X - X-position - Y - Y-position - Z - Z-position - - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline3calc(const pspline3interpolant &p, const double t, double &x, double &y, double &z); - - -/************************************************************************* -This function calculates tangent vector for a given value of parameter T - -INPUT PARAMETERS: - P - parametric spline interpolant - T - point: - * T in [0,1] corresponds to interval spanned by points - * for non-periodic splines T<0 (or T>1) correspond to parts of - the curve before the first (after the last) point - * for periodic splines T<0 (or T>1) are projected into [0,1] - by making T=T-floor(T). - -OUTPUT PARAMETERS: - X - X-component of tangent vector (normalized) - Y - Y-component of tangent vector (normalized) - -NOTE: - X^2+Y^2 is either 1 (for non-zero tangent vector) or 0. - - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline2tangent(const pspline2interpolant &p, const double t, double &x, double &y); - - -/************************************************************************* -This function calculates tangent vector for a given value of parameter T - -INPUT PARAMETERS: - P - parametric spline interpolant - T - point: - * T in [0,1] corresponds to interval spanned by points - * for non-periodic splines T<0 (or T>1) correspond to parts of - the curve before the first (after the last) point - * for periodic splines T<0 (or T>1) are projected into [0,1] - by making T=T-floor(T). - -OUTPUT PARAMETERS: - X - X-component of tangent vector (normalized) - Y - Y-component of tangent vector (normalized) - Z - Z-component of tangent vector (normalized) - -NOTE: - X^2+Y^2+Z^2 is either 1 (for non-zero tangent vector) or 0. - - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline3tangent(const pspline3interpolant &p, const double t, double &x, double &y, double &z); - - -/************************************************************************* -This function calculates derivative, i.e. it returns (dX/dT,dY/dT). - -INPUT PARAMETERS: - P - parametric spline interpolant - T - point: - * T in [0,1] corresponds to interval spanned by points - * for non-periodic splines T<0 (or T>1) correspond to parts of - the curve before the first (after the last) point - * for periodic splines T<0 (or T>1) are projected into [0,1] - by making T=T-floor(T). - -OUTPUT PARAMETERS: - X - X-value - DX - X-derivative - Y - Y-value - DY - Y-derivative - - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline2diff(const pspline2interpolant &p, const double t, double &x, double &dx, double &y, double &dy); - - -/************************************************************************* -This function calculates derivative, i.e. it returns (dX/dT,dY/dT,dZ/dT). - -INPUT PARAMETERS: - P - parametric spline interpolant - T - point: - * T in [0,1] corresponds to interval spanned by points - * for non-periodic splines T<0 (or T>1) correspond to parts of - the curve before the first (after the last) point - * for periodic splines T<0 (or T>1) are projected into [0,1] - by making T=T-floor(T). - -OUTPUT PARAMETERS: - X - X-value - DX - X-derivative - Y - Y-value - DY - Y-derivative - Z - Z-value - DZ - Z-derivative - - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline3diff(const pspline3interpolant &p, const double t, double &x, double &dx, double &y, double &dy, double &z, double &dz); - - -/************************************************************************* -This function calculates first and second derivative with respect to T. - -INPUT PARAMETERS: - P - parametric spline interpolant - T - point: - * T in [0,1] corresponds to interval spanned by points - * for non-periodic splines T<0 (or T>1) correspond to parts of - the curve before the first (after the last) point - * for periodic splines T<0 (or T>1) are projected into [0,1] - by making T=T-floor(T). - -OUTPUT PARAMETERS: - X - X-value - DX - derivative - D2X - second derivative - Y - Y-value - DY - derivative - D2Y - second derivative - - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline2diff2(const pspline2interpolant &p, const double t, double &x, double &dx, double &d2x, double &y, double &dy, double &d2y); - - -/************************************************************************* -This function calculates first and second derivative with respect to T. - -INPUT PARAMETERS: - P - parametric spline interpolant - T - point: - * T in [0,1] corresponds to interval spanned by points - * for non-periodic splines T<0 (or T>1) correspond to parts of - the curve before the first (after the last) point - * for periodic splines T<0 (or T>1) are projected into [0,1] - by making T=T-floor(T). - -OUTPUT PARAMETERS: - X - X-value - DX - derivative - D2X - second derivative - Y - Y-value - DY - derivative - D2Y - second derivative - Z - Z-value - DZ - derivative - D2Z - second derivative - - - -- ALGLIB PROJECT -- - Copyright 28.05.2010 by Bochkanov Sergey -*************************************************************************/ -void pspline3diff2(const pspline3interpolant &p, const double t, double &x, double &dx, double &d2x, double &y, double &dy, double &d2y, double &z, double &dz, double &d2z); - - -/************************************************************************* -This function calculates arc length, i.e. length of curve between t=a -and t=b. - -INPUT PARAMETERS: - P - parametric spline interpolant - A,B - parameter values corresponding to arc ends: - * B>A will result in positive length returned - * BA will result in positive length returned - * B1) -function in a NX-dimensional space (NX=2 or NX=3). - -Newly created model is empty. It can be used for interpolation right after -creation, but it just returns zeros. You have to add points to the model, -tune interpolation settings, and then call model construction function -RBFBuildModel() which will update model according to your specification. - -USAGE: -1. User creates model with RBFCreate() -2. User adds dataset with RBFSetPoints() (points do NOT have to be on a - regular grid) -3. (OPTIONAL) User chooses polynomial term by calling: - * RBFLinTerm() to set linear term - * RBFConstTerm() to set constant term - * RBFZeroTerm() to set zero term - By default, linear term is used. -4. User chooses specific RBF algorithm to use: either QNN (RBFSetAlgoQNN) - or ML (RBFSetAlgoMultiLayer). -5. User calls RBFBuildModel() function which rebuilds model according to - the specification -6. User may call RBFCalc() to calculate model value at the specified point, - RBFGridCalc() to calculate model values at the points of the regular - grid. User may extract model coefficients with RBFUnpack() call. - -INPUT PARAMETERS: - NX - dimension of the space, NX=2 or NX=3 - NY - function dimension, NY>=1 - -OUTPUT PARAMETERS: - S - RBF model (initially equals to zero) - -NOTE 1: memory requirements. RBF models require amount of memory which is - proportional to the number of data points. Memory is allocated - during model construction, but most of this memory is freed after - model coefficients are calculated. - - Some approximate estimates for N centers with default settings are - given below: - * about 250*N*(sizeof(double)+2*sizeof(int)) bytes of memory is - needed during model construction stage. - * about 15*N*sizeof(double) bytes is needed after model is built. - For example, for N=100000 we may need 0.6 GB of memory to build - model, but just about 0.012 GB to store it. - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfcreate(const ae_int_t nx, const ae_int_t ny, rbfmodel &s); - - -/************************************************************************* -This function adds dataset. - -This function overrides results of the previous calls, i.e. multiple calls -of this function will result in only the last set being added. - -INPUT PARAMETERS: - S - RBF model, initialized by RBFCreate() call. - XY - points, array[N,NX+NY]. One row corresponds to one point - in the dataset. First NX elements are coordinates, next - NY elements are function values. Array may be larger than - specific, in this case only leading [N,NX+NY] elements - will be used. - N - number of points in the dataset - -After you've added dataset and (optionally) tuned algorithm settings you -should call RBFBuildModel() in order to build a model for you. - -NOTE: this function has some serialization-related subtleties. We - recommend you to study serialization examples from ALGLIB Reference - Manual if you want to perform serialization of your models. - - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfsetpoints(const rbfmodel &s, const real_2d_array &xy, const ae_int_t n); -void rbfsetpoints(const rbfmodel &s, const real_2d_array &xy); - - -/************************************************************************* -This function sets RBF interpolation algorithm. ALGLIB supports several -RBF algorithms with different properties. - -This algorithm is called RBF-QNN and it is good for point sets with -following properties: -a) all points are distinct -b) all points are well separated. -c) points distribution is approximately uniform. There is no "contour - lines", clusters of points, or other small-scale structures. - -Algorithm description: -1) interpolation centers are allocated to data points -2) interpolation radii are calculated as distances to the nearest centers - times Q coefficient (where Q is a value from [0.75,1.50]). -3) after performing (2) radii are transformed in order to avoid situation - when single outlier has very large radius and influences many points - across all dataset. Transformation has following form: - new_r[i] = min(r[i],Z*median(r[])) - where r[i] is I-th radius, median() is a median radius across entire - dataset, Z is user-specified value which controls amount of deviation - from median radius. - -When (a) is violated, we will be unable to build RBF model. When (b) or -(c) are violated, model will be built, but interpolation quality will be -low. See http://www.alglib.net/interpolation/ for more information on this -subject. - -This algorithm is used by default. - -Additional Q parameter controls smoothness properties of the RBF basis: -* Q<0.75 will give perfectly conditioned basis, but terrible smoothness - properties (RBF interpolant will have sharp peaks around function values) -* Q around 1.0 gives good balance between smoothness and condition number -* Q>1.5 will lead to badly conditioned systems and slow convergence of the - underlying linear solver (although smoothness will be very good) -* Q>2.0 will effectively make optimizer useless because it won't converge - within reasonable amount of iterations. It is possible to set such large - Q, but it is advised not to do so. - -INPUT PARAMETERS: - S - RBF model, initialized by RBFCreate() call - Q - Q parameter, Q>0, recommended value - 1.0 - Z - Z parameter, Z>0, recommended value - 5.0 - -NOTE: this function has some serialization-related subtleties. We - recommend you to study serialization examples from ALGLIB Reference - Manual if you want to perform serialization of your models. - - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfsetalgoqnn(const rbfmodel &s, const double q, const double z); -void rbfsetalgoqnn(const rbfmodel &s); - - -/************************************************************************* -This function sets RBF interpolation algorithm. ALGLIB supports several -RBF algorithms with different properties. - -This algorithm is called RBF-ML. It builds multilayer RBF model, i.e. -model with subsequently decreasing radii, which allows us to combine -smoothness (due to large radii of the first layers) with exactness (due -to small radii of the last layers) and fast convergence. - -Internally RBF-ML uses many different means of acceleration, from sparse -matrices to KD-trees, which results in algorithm whose working time is -roughly proportional to N*log(N)*Density*RBase^2*NLayers, where N is a -number of points, Density is an average density if points per unit of the -interpolation space, RBase is an initial radius, NLayers is a number of -layers. - -RBF-ML is good for following kinds of interpolation problems: -1. "exact" problems (perfect fit) with well separated points -2. least squares problems with arbitrary distribution of points (algorithm - gives perfect fit where it is possible, and resorts to least squares - fit in the hard areas). -3. noisy problems where we want to apply some controlled amount of - smoothing. - -INPUT PARAMETERS: - S - RBF model, initialized by RBFCreate() call - RBase - RBase parameter, RBase>0 - NLayers - NLayers parameter, NLayers>0, recommended value to start - with - about 5. - LambdaV - regularization value, can be useful when solving problem - in the least squares sense. Optimal lambda is problem- - dependent and require trial and error. In our experience, - good lambda can be as large as 0.1, and you can use 0.001 - as initial guess. - Default value - 0.01, which is used when LambdaV is not - given. You can specify zero value, but it is not - recommended to do so. - -TUNING ALGORITHM - -In order to use this algorithm you have to choose three parameters: -* initial radius RBase -* number of layers in the model NLayers -* regularization coefficient LambdaV - -Initial radius is easy to choose - you can pick any number several times -larger than the average distance between points. Algorithm won't break -down if you choose radius which is too large (model construction time will -increase, but model will be built correctly). - -Choose such number of layers that RLast=RBase/2^(NLayers-1) (radius used -by the last layer) will be smaller than the typical distance between -points. In case model error is too large, you can increase number of -layers. Having more layers will make model construction and evaluation -proportionally slower, but it will allow you to have model which precisely -fits your data. From the other side, if you want to suppress noise, you -can DECREASE number of layers to make your model less flexible. - -Regularization coefficient LambdaV controls smoothness of the individual -models built for each layer. We recommend you to use default value in case -you don't want to tune this parameter, because having non-zero LambdaV -accelerates and stabilizes internal iterative algorithm. In case you want -to suppress noise you can use LambdaV as additional parameter (larger -value = more smoothness) to tune. - -TYPICAL ERRORS - -1. Using initial radius which is too large. Memory requirements of the - RBF-ML are roughly proportional to N*Density*RBase^2 (where Density is - an average density of points per unit of the interpolation space). In - the extreme case of the very large RBase we will need O(N^2) units of - memory - and many layers in order to decrease radius to some reasonably - small value. - -2. Using too small number of layers - RBF models with large radius are not - flexible enough to reproduce small variations in the target function. - You need many layers with different radii, from large to small, in - order to have good model. - -3. Using initial radius which is too small. You will get model with - "holes" in the areas which are too far away from interpolation centers. - However, algorithm will work correctly (and quickly) in this case. - -4. Using too many layers - you will get too large and too slow model. This - model will perfectly reproduce your function, but maybe you will be - able to achieve similar results with less layers (and less memory). - - -- ALGLIB -- - Copyright 02.03.2012 by Bochkanov Sergey -*************************************************************************/ -void rbfsetalgomultilayer(const rbfmodel &s, const double rbase, const ae_int_t nlayers, const double lambdav); -void rbfsetalgomultilayer(const rbfmodel &s, const double rbase, const ae_int_t nlayers); - - -/************************************************************************* -This function sets linear term (model is a sum of radial basis functions -plus linear polynomial). This function won't have effect until next call -to RBFBuildModel(). - -INPUT PARAMETERS: - S - RBF model, initialized by RBFCreate() call - -NOTE: this function has some serialization-related subtleties. We - recommend you to study serialization examples from ALGLIB Reference - Manual if you want to perform serialization of your models. - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfsetlinterm(const rbfmodel &s); - - -/************************************************************************* -This function sets constant term (model is a sum of radial basis functions -plus constant). This function won't have effect until next call to -RBFBuildModel(). - -INPUT PARAMETERS: - S - RBF model, initialized by RBFCreate() call - -NOTE: this function has some serialization-related subtleties. We - recommend you to study serialization examples from ALGLIB Reference - Manual if you want to perform serialization of your models. - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfsetconstterm(const rbfmodel &s); - - -/************************************************************************* -This function sets zero term (model is a sum of radial basis functions -without polynomial term). This function won't have effect until next call -to RBFBuildModel(). - -INPUT PARAMETERS: - S - RBF model, initialized by RBFCreate() call - -NOTE: this function has some serialization-related subtleties. We - recommend you to study serialization examples from ALGLIB Reference - Manual if you want to perform serialization of your models. - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfsetzeroterm(const rbfmodel &s); - - -/************************************************************************* -This function builds RBF model and returns report (contains some -information which can be used for evaluation of the algorithm properties). - -Call to this function modifies RBF model by calculating its centers/radii/ -weights and saving them into RBFModel structure. Initially RBFModel -contain zero coefficients, but after call to this function we will have -coefficients which were calculated in order to fit our dataset. - -After you called this function you can call RBFCalc(), RBFGridCalc() and -other model calculation functions. - -INPUT PARAMETERS: - S - RBF model, initialized by RBFCreate() call - Rep - report: - * Rep.TerminationType: - * -5 - non-distinct basis function centers were detected, - interpolation aborted - * -4 - nonconvergence of the internal SVD solver - * 1 - successful termination - Fields are used for debugging purposes: - * Rep.IterationsCount - iterations count of the LSQR solver - * Rep.NMV - number of matrix-vector products - * Rep.ARows - rows count for the system matrix - * Rep.ACols - columns count for the system matrix - * Rep.ANNZ - number of significantly non-zero elements - (elements above some algorithm-determined threshold) - -NOTE: failure to build model will leave current state of the structure -unchanged. - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfbuildmodel(const rbfmodel &s, rbfreport &rep); - - -/************************************************************************* -This function calculates values of the RBF model in the given point. - -This function should be used when we have NY=1 (scalar function) and NX=2 -(2-dimensional space). If you have 3-dimensional space, use RBFCalc3(). If -you have general situation (NX-dimensional space, NY-dimensional function) -you should use general, less efficient implementation RBFCalc(). - -If you want to calculate function values many times, consider using -RBFGridCalc2(), which is far more efficient than many subsequent calls to -RBFCalc2(). - -This function returns 0.0 when: -* model is not initialized -* NX<>2 - *NY<>1 - -INPUT PARAMETERS: - S - RBF model - X0 - first coordinate, finite number - X1 - second coordinate, finite number - -RESULT: - value of the model or 0.0 (as defined above) - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -double rbfcalc2(const rbfmodel &s, const double x0, const double x1); - - -/************************************************************************* -This function calculates values of the RBF model in the given point. - -This function should be used when we have NY=1 (scalar function) and NX=3 -(3-dimensional space). If you have 2-dimensional space, use RBFCalc2(). If -you have general situation (NX-dimensional space, NY-dimensional function) -you should use general, less efficient implementation RBFCalc(). - -This function returns 0.0 when: -* model is not initialized -* NX<>3 - *NY<>1 - -INPUT PARAMETERS: - S - RBF model - X0 - first coordinate, finite number - X1 - second coordinate, finite number - X2 - third coordinate, finite number - -RESULT: - value of the model or 0.0 (as defined above) - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -double rbfcalc3(const rbfmodel &s, const double x0, const double x1, const double x2); - - -/************************************************************************* -This function calculates values of the RBF model at the given point. - -This is general function which can be used for arbitrary NX (dimension of -the space of arguments) and NY (dimension of the function itself). However -when you have NY=1 you may find more convenient to use RBFCalc2() or -RBFCalc3(). - -This function returns 0.0 when model is not initialized. - -INPUT PARAMETERS: - S - RBF model - X - coordinates, array[NX]. - X may have more than NX elements, in this case only - leading NX will be used. - -OUTPUT PARAMETERS: - Y - function value, array[NY]. Y is out-parameter and - reallocated after call to this function. In case you want - to reuse previously allocated Y, you may use RBFCalcBuf(), - which reallocates Y only when it is too small. - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfcalc(const rbfmodel &s, const real_1d_array &x, real_1d_array &y); - - -/************************************************************************* -This function calculates values of the RBF model at the given point. - -Same as RBFCalc(), but does not reallocate Y when in is large enough to -store function values. - -INPUT PARAMETERS: - S - RBF model - X - coordinates, array[NX]. - X may have more than NX elements, in this case only - leading NX will be used. - Y - possibly preallocated array - -OUTPUT PARAMETERS: - Y - function value, array[NY]. Y is not reallocated when it - is larger than NY. - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfcalcbuf(const rbfmodel &s, const real_1d_array &x, real_1d_array &y); - - -/************************************************************************* -This function calculates values of the RBF model at the regular grid. - -Grid have N0*N1 points, with Point[I,J] = (X0[I], X1[J]) - -This function returns 0.0 when: -* model is not initialized -* NX<>2 - *NY<>1 - -INPUT PARAMETERS: - S - RBF model - X0 - array of grid nodes, first coordinates, array[N0] - N0 - grid size (number of nodes) in the first dimension - X1 - array of grid nodes, second coordinates, array[N1] - N1 - grid size (number of nodes) in the second dimension - -OUTPUT PARAMETERS: - Y - function values, array[N0,N1]. Y is out-variable and - is reallocated by this function. - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfgridcalc2(const rbfmodel &s, const real_1d_array &x0, const ae_int_t n0, const real_1d_array &x1, const ae_int_t n1, real_2d_array &y); - - -/************************************************************************* -This function "unpacks" RBF model by extracting its coefficients. - -INPUT PARAMETERS: - S - RBF model - -OUTPUT PARAMETERS: - NX - dimensionality of argument - NY - dimensionality of the target function - XWR - model information, array[NC,NX+NY+1]. - One row of the array corresponds to one basis function: - * first NX columns - coordinates of the center - * next NY columns - weights, one per dimension of the - function being modelled - * last column - radius, same for all dimensions of - the function being modelled - NC - number of the centers - V - polynomial term , array[NY,NX+1]. One row per one - dimension of the function being modelled. First NX - elements are linear coefficients, V[NX] is equal to the - constant part. - - -- ALGLIB -- - Copyright 13.12.2011 by Bochkanov Sergey -*************************************************************************/ -void rbfunpack(const rbfmodel &s, ae_int_t &nx, ae_int_t &ny, real_2d_array &xwr, ae_int_t &nc, real_2d_array &v); - -/************************************************************************* -This subroutine calculates the value of the bilinear or bicubic spline at -the given point X. - -Input parameters: - C - coefficients table. - Built by BuildBilinearSpline or BuildBicubicSpline. - X, Y- point - -Result: - S(x,y) - - -- ALGLIB PROJECT -- - Copyright 05.07.2007 by Bochkanov Sergey -*************************************************************************/ -double spline2dcalc(const spline2dinterpolant &c, const double x, const double y); - - -/************************************************************************* -This subroutine calculates the value of the bilinear or bicubic spline at -the given point X and its derivatives. - -Input parameters: - C - spline interpolant. - X, Y- point - -Output parameters: - F - S(x,y) - FX - dS(x,y)/dX - FY - dS(x,y)/dY - FXY - d2S(x,y)/dXdY - - -- ALGLIB PROJECT -- - Copyright 05.07.2007 by Bochkanov Sergey -*************************************************************************/ -void spline2ddiff(const spline2dinterpolant &c, const double x, const double y, double &f, double &fx, double &fy, double &fxy); - - -/************************************************************************* -This subroutine performs linear transformation of the spline argument. - -Input parameters: - C - spline interpolant - AX, BX - transformation coefficients: x = A*t + B - AY, BY - transformation coefficients: y = A*u + B -Result: - C - transformed spline - - -- ALGLIB PROJECT -- - Copyright 30.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline2dlintransxy(const spline2dinterpolant &c, const double ax, const double bx, const double ay, const double by); - - -/************************************************************************* -This subroutine performs linear transformation of the spline. - -Input parameters: - C - spline interpolant. - A, B- transformation coefficients: S2(x,y) = A*S(x,y) + B - -Output parameters: - C - transformed spline - - -- ALGLIB PROJECT -- - Copyright 30.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline2dlintransf(const spline2dinterpolant &c, const double a, const double b); - - -/************************************************************************* -This subroutine makes the copy of the spline model. - -Input parameters: - C - spline interpolant - -Output parameters: - CC - spline copy - - -- ALGLIB PROJECT -- - Copyright 29.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline2dcopy(const spline2dinterpolant &c, spline2dinterpolant &cc); - - -/************************************************************************* -Bicubic spline resampling - -Input parameters: - A - function values at the old grid, - array[0..OldHeight-1, 0..OldWidth-1] - OldHeight - old grid height, OldHeight>1 - OldWidth - old grid width, OldWidth>1 - NewHeight - new grid height, NewHeight>1 - NewWidth - new grid width, NewWidth>1 - -Output parameters: - B - function values at the new grid, - array[0..NewHeight-1, 0..NewWidth-1] - - -- ALGLIB routine -- - 15 May, 2007 - Copyright by Bochkanov Sergey -*************************************************************************/ -void spline2dresamplebicubic(const real_2d_array &a, const ae_int_t oldheight, const ae_int_t oldwidth, real_2d_array &b, const ae_int_t newheight, const ae_int_t newwidth); - - -/************************************************************************* -Bilinear spline resampling - -Input parameters: - A - function values at the old grid, - array[0..OldHeight-1, 0..OldWidth-1] - OldHeight - old grid height, OldHeight>1 - OldWidth - old grid width, OldWidth>1 - NewHeight - new grid height, NewHeight>1 - NewWidth - new grid width, NewWidth>1 - -Output parameters: - B - function values at the new grid, - array[0..NewHeight-1, 0..NewWidth-1] - - -- ALGLIB routine -- - 09.07.2007 - Copyright by Bochkanov Sergey -*************************************************************************/ -void spline2dresamplebilinear(const real_2d_array &a, const ae_int_t oldheight, const ae_int_t oldwidth, real_2d_array &b, const ae_int_t newheight, const ae_int_t newwidth); - - -/************************************************************************* -This subroutine builds bilinear vector-valued spline. - -Input parameters: - X - spline abscissas, array[0..N-1] - Y - spline ordinates, array[0..M-1] - F - function values, array[0..M*N*D-1]: - * first D elements store D values at (X[0],Y[0]) - * next D elements store D values at (X[1],Y[0]) - * general form - D function values at (X[i],Y[j]) are stored - at F[D*(J*N+I)...D*(J*N+I)+D-1]. - M,N - grid size, M>=2, N>=2 - D - vector dimension, D>=1 - -Output parameters: - C - spline interpolant - - -- ALGLIB PROJECT -- - Copyright 16.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline2dbuildbilinearv(const real_1d_array &x, const ae_int_t n, const real_1d_array &y, const ae_int_t m, const real_1d_array &f, const ae_int_t d, spline2dinterpolant &c); - - -/************************************************************************* -This subroutine builds bicubic vector-valued spline. - -Input parameters: - X - spline abscissas, array[0..N-1] - Y - spline ordinates, array[0..M-1] - F - function values, array[0..M*N*D-1]: - * first D elements store D values at (X[0],Y[0]) - * next D elements store D values at (X[1],Y[0]) - * general form - D function values at (X[i],Y[j]) are stored - at F[D*(J*N+I)...D*(J*N+I)+D-1]. - M,N - grid size, M>=2, N>=2 - D - vector dimension, D>=1 - -Output parameters: - C - spline interpolant - - -- ALGLIB PROJECT -- - Copyright 16.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline2dbuildbicubicv(const real_1d_array &x, const ae_int_t n, const real_1d_array &y, const ae_int_t m, const real_1d_array &f, const ae_int_t d, spline2dinterpolant &c); - - -/************************************************************************* -This subroutine calculates bilinear or bicubic vector-valued spline at the -given point (X,Y). - -INPUT PARAMETERS: - C - spline interpolant. - X, Y- point - F - output buffer, possibly preallocated array. In case array size - is large enough to store result, it is not reallocated. Array - which is too short will be reallocated - -OUTPUT PARAMETERS: - F - array[D] (or larger) which stores function values - - -- ALGLIB PROJECT -- - Copyright 16.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline2dcalcvbuf(const spline2dinterpolant &c, const double x, const double y, real_1d_array &f); - - -/************************************************************************* -This subroutine calculates bilinear or bicubic vector-valued spline at the -given point (X,Y). - -INPUT PARAMETERS: - C - spline interpolant. - X, Y- point - -OUTPUT PARAMETERS: - F - array[D] which stores function values. F is out-parameter and - it is reallocated after call to this function. In case you - want to reuse previously allocated F, you may use - Spline2DCalcVBuf(), which reallocates F only when it is too - small. - - -- ALGLIB PROJECT -- - Copyright 16.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline2dcalcv(const spline2dinterpolant &c, const double x, const double y, real_1d_array &f); - - -/************************************************************************* -This subroutine unpacks two-dimensional spline into the coefficients table - -Input parameters: - C - spline interpolant. - -Result: - M, N- grid size (x-axis and y-axis) - D - number of components - Tbl - coefficients table, unpacked format, - D - components: [0..(N-1)*(M-1)*D-1, 0..19]. - For T=0..D-1 (component index), I = 0...N-2 (x index), - J=0..M-2 (y index): - K := T + I*D + J*D*(N-1) - - K-th row stores decomposition for T-th component of the - vector-valued function - - Tbl[K,0] = X[i] - Tbl[K,1] = X[i+1] - Tbl[K,2] = Y[j] - Tbl[K,3] = Y[j+1] - Tbl[K,4] = C00 - Tbl[K,5] = C01 - Tbl[K,6] = C02 - Tbl[K,7] = C03 - Tbl[K,8] = C10 - Tbl[K,9] = C11 - ... - Tbl[K,19] = C33 - On each grid square spline is equals to: - S(x) = SUM(c[i,j]*(t^i)*(u^j), i=0..3, j=0..3) - t = x-x[j] - u = y-y[i] - - -- ALGLIB PROJECT -- - Copyright 16.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline2dunpackv(const spline2dinterpolant &c, ae_int_t &m, ae_int_t &n, ae_int_t &d, real_2d_array &tbl); - - -/************************************************************************* -This subroutine was deprecated in ALGLIB 3.6.0 - -We recommend you to switch to Spline2DBuildBilinearV(), which is more -flexible and accepts its arguments in more convenient order. - - -- ALGLIB PROJECT -- - Copyright 05.07.2007 by Bochkanov Sergey -*************************************************************************/ -void spline2dbuildbilinear(const real_1d_array &x, const real_1d_array &y, const real_2d_array &f, const ae_int_t m, const ae_int_t n, spline2dinterpolant &c); - - -/************************************************************************* -This subroutine was deprecated in ALGLIB 3.6.0 - -We recommend you to switch to Spline2DBuildBicubicV(), which is more -flexible and accepts its arguments in more convenient order. - - -- ALGLIB PROJECT -- - Copyright 05.07.2007 by Bochkanov Sergey -*************************************************************************/ -void spline2dbuildbicubic(const real_1d_array &x, const real_1d_array &y, const real_2d_array &f, const ae_int_t m, const ae_int_t n, spline2dinterpolant &c); - - -/************************************************************************* -This subroutine was deprecated in ALGLIB 3.6.0 - -We recommend you to switch to Spline2DUnpackV(), which is more flexible -and accepts its arguments in more convenient order. - - -- ALGLIB PROJECT -- - Copyright 29.06.2007 by Bochkanov Sergey -*************************************************************************/ -void spline2dunpack(const spline2dinterpolant &c, ae_int_t &m, ae_int_t &n, real_2d_array &tbl); - -/************************************************************************* -This subroutine calculates the value of the trilinear or tricubic spline at -the given point (X,Y,Z). - -INPUT PARAMETERS: - C - coefficients table. - Built by BuildBilinearSpline or BuildBicubicSpline. - X, Y, - Z - point - -Result: - S(x,y,z) - - -- ALGLIB PROJECT -- - Copyright 26.04.2012 by Bochkanov Sergey -*************************************************************************/ -double spline3dcalc(const spline3dinterpolant &c, const double x, const double y, const double z); - - -/************************************************************************* -This subroutine performs linear transformation of the spline argument. - -INPUT PARAMETERS: - C - spline interpolant - AX, BX - transformation coefficients: x = A*u + B - AY, BY - transformation coefficients: y = A*v + B - AZ, BZ - transformation coefficients: z = A*w + B - -OUTPUT PARAMETERS: - C - transformed spline - - -- ALGLIB PROJECT -- - Copyright 26.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline3dlintransxyz(const spline3dinterpolant &c, const double ax, const double bx, const double ay, const double by, const double az, const double bz); - - -/************************************************************************* -This subroutine performs linear transformation of the spline. - -INPUT PARAMETERS: - C - spline interpolant. - A, B- transformation coefficients: S2(x,y) = A*S(x,y,z) + B - -OUTPUT PARAMETERS: - C - transformed spline - - -- ALGLIB PROJECT -- - Copyright 26.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline3dlintransf(const spline3dinterpolant &c, const double a, const double b); - - -/************************************************************************* -Trilinear spline resampling - -INPUT PARAMETERS: - A - array[0..OldXCount*OldYCount*OldZCount-1], function - values at the old grid, : - A[0] x=0,y=0,z=0 - A[1] x=1,y=0,z=0 - A[..] ... - A[..] x=oldxcount-1,y=0,z=0 - A[..] x=0,y=1,z=0 - A[..] ... - ... - OldZCount - old Z-count, OldZCount>1 - OldYCount - old Y-count, OldYCount>1 - OldXCount - old X-count, OldXCount>1 - NewZCount - new Z-count, NewZCount>1 - NewYCount - new Y-count, NewYCount>1 - NewXCount - new X-count, NewXCount>1 - -OUTPUT PARAMETERS: - B - array[0..NewXCount*NewYCount*NewZCount-1], function - values at the new grid: - B[0] x=0,y=0,z=0 - B[1] x=1,y=0,z=0 - B[..] ... - B[..] x=newxcount-1,y=0,z=0 - B[..] x=0,y=1,z=0 - B[..] ... - ... - - -- ALGLIB routine -- - 26.04.2012 - Copyright by Bochkanov Sergey -*************************************************************************/ -void spline3dresampletrilinear(const real_1d_array &a, const ae_int_t oldzcount, const ae_int_t oldycount, const ae_int_t oldxcount, const ae_int_t newzcount, const ae_int_t newycount, const ae_int_t newxcount, real_1d_array &b); - - -/************************************************************************* -This subroutine builds trilinear vector-valued spline. - -INPUT PARAMETERS: - X - spline abscissas, array[0..N-1] - Y - spline ordinates, array[0..M-1] - Z - spline applicates, array[0..L-1] - F - function values, array[0..M*N*L*D-1]: - * first D elements store D values at (X[0],Y[0],Z[0]) - * next D elements store D values at (X[1],Y[0],Z[0]) - * next D elements store D values at (X[2],Y[0],Z[0]) - * ... - * next D elements store D values at (X[0],Y[1],Z[0]) - * next D elements store D values at (X[1],Y[1],Z[0]) - * next D elements store D values at (X[2],Y[1],Z[0]) - * ... - * next D elements store D values at (X[0],Y[0],Z[1]) - * next D elements store D values at (X[1],Y[0],Z[1]) - * next D elements store D values at (X[2],Y[0],Z[1]) - * ... - * general form - D function values at (X[i],Y[j]) are stored - at F[D*(N*(M*K+J)+I)...D*(N*(M*K+J)+I)+D-1]. - M,N, - L - grid size, M>=2, N>=2, L>=2 - D - vector dimension, D>=1 - -OUTPUT PARAMETERS: - C - spline interpolant - - -- ALGLIB PROJECT -- - Copyright 26.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline3dbuildtrilinearv(const real_1d_array &x, const ae_int_t n, const real_1d_array &y, const ae_int_t m, const real_1d_array &z, const ae_int_t l, const real_1d_array &f, const ae_int_t d, spline3dinterpolant &c); - - -/************************************************************************* -This subroutine calculates bilinear or bicubic vector-valued spline at the -given point (X,Y,Z). - -INPUT PARAMETERS: - C - spline interpolant. - X, Y, - Z - point - F - output buffer, possibly preallocated array. In case array size - is large enough to store result, it is not reallocated. Array - which is too short will be reallocated - -OUTPUT PARAMETERS: - F - array[D] (or larger) which stores function values - - -- ALGLIB PROJECT -- - Copyright 26.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline3dcalcvbuf(const spline3dinterpolant &c, const double x, const double y, const double z, real_1d_array &f); - - -/************************************************************************* -This subroutine calculates trilinear or tricubic vector-valued spline at the -given point (X,Y,Z). - -INPUT PARAMETERS: - C - spline interpolant. - X, Y, - Z - point - -OUTPUT PARAMETERS: - F - array[D] which stores function values. F is out-parameter and - it is reallocated after call to this function. In case you - want to reuse previously allocated F, you may use - Spline2DCalcVBuf(), which reallocates F only when it is too - small. - - -- ALGLIB PROJECT -- - Copyright 26.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline3dcalcv(const spline3dinterpolant &c, const double x, const double y, const double z, real_1d_array &f); - - -/************************************************************************* -This subroutine unpacks tri-dimensional spline into the coefficients table - -INPUT PARAMETERS: - C - spline interpolant. - -Result: - N - grid size (X) - M - grid size (Y) - L - grid size (Z) - D - number of components - SType- spline type. Currently, only one spline type is supported: - trilinear spline, as indicated by SType=1. - Tbl - spline coefficients: [0..(N-1)*(M-1)*(L-1)*D-1, 0..13]. - For T=0..D-1 (component index), I = 0...N-2 (x index), - J=0..M-2 (y index), K=0..L-2 (z index): - Q := T + I*D + J*D*(N-1) + K*D*(N-1)*(M-1), - - Q-th row stores decomposition for T-th component of the - vector-valued function - - Tbl[Q,0] = X[i] - Tbl[Q,1] = X[i+1] - Tbl[Q,2] = Y[j] - Tbl[Q,3] = Y[j+1] - Tbl[Q,4] = Z[k] - Tbl[Q,5] = Z[k+1] - - Tbl[Q,6] = C000 - Tbl[Q,7] = C100 - Tbl[Q,8] = C010 - Tbl[Q,9] = C110 - Tbl[Q,10]= C001 - Tbl[Q,11]= C101 - Tbl[Q,12]= C011 - Tbl[Q,13]= C111 - On each grid square spline is equals to: - S(x) = SUM(c[i,j,k]*(x^i)*(y^j)*(z^k), i=0..1, j=0..1, k=0..1) - t = x-x[j] - u = y-y[i] - v = z-z[k] - - NOTE: format of Tbl is given for SType=1. Future versions of - ALGLIB can use different formats for different values of - SType. - - -- ALGLIB PROJECT -- - Copyright 26.04.2012 by Bochkanov Sergey -*************************************************************************/ -void spline3dunpackv(const spline3dinterpolant &c, ae_int_t &n, ae_int_t &m, ae_int_t &l, ae_int_t &d, ae_int_t &stype, real_2d_array &tbl); -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (FUNCTIONS) -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ -double idwcalc(idwinterpolant* z, - /* Real */ ae_vector* x, - ae_state *_state); -void idwbuildmodifiedshepard(/* Real */ ae_matrix* xy, - ae_int_t n, - ae_int_t nx, - ae_int_t d, - ae_int_t nq, - ae_int_t nw, - idwinterpolant* z, - ae_state *_state); -void idwbuildmodifiedshepardr(/* Real */ ae_matrix* xy, - ae_int_t n, - ae_int_t nx, - double r, - idwinterpolant* z, - ae_state *_state); -void idwbuildnoisy(/* Real */ ae_matrix* xy, - ae_int_t n, - ae_int_t nx, - ae_int_t d, - ae_int_t nq, - ae_int_t nw, - idwinterpolant* z, - ae_state *_state); -ae_bool _idwinterpolant_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _idwinterpolant_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _idwinterpolant_clear(void* _p); -void _idwinterpolant_destroy(void* _p); -double barycentriccalc(barycentricinterpolant* b, - double t, - ae_state *_state); -void barycentricdiff1(barycentricinterpolant* b, - double t, - double* f, - double* df, - ae_state *_state); -void barycentricdiff2(barycentricinterpolant* b, - double t, - double* f, - double* df, - double* d2f, - ae_state *_state); -void barycentriclintransx(barycentricinterpolant* b, - double ca, - double cb, - ae_state *_state); -void barycentriclintransy(barycentricinterpolant* b, - double ca, - double cb, - ae_state *_state); -void barycentricunpack(barycentricinterpolant* b, - ae_int_t* n, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* w, - ae_state *_state); -void barycentricbuildxyw(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* w, - ae_int_t n, - barycentricinterpolant* b, - ae_state *_state); -void barycentricbuildfloaterhormann(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_int_t d, - barycentricinterpolant* b, - ae_state *_state); -void barycentriccopy(barycentricinterpolant* b, - barycentricinterpolant* b2, - ae_state *_state); -ae_bool _barycentricinterpolant_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _barycentricinterpolant_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _barycentricinterpolant_clear(void* _p); -void _barycentricinterpolant_destroy(void* _p); -void polynomialbar2cheb(barycentricinterpolant* p, - double a, - double b, - /* Real */ ae_vector* t, - ae_state *_state); -void polynomialcheb2bar(/* Real */ ae_vector* t, - ae_int_t n, - double a, - double b, - barycentricinterpolant* p, - ae_state *_state); -void polynomialbar2pow(barycentricinterpolant* p, - double c, - double s, - /* Real */ ae_vector* a, - ae_state *_state); -void polynomialpow2bar(/* Real */ ae_vector* a, - ae_int_t n, - double c, - double s, - barycentricinterpolant* p, - ae_state *_state); -void polynomialbuild(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - barycentricinterpolant* p, - ae_state *_state); -void polynomialbuildeqdist(double a, - double b, - /* Real */ ae_vector* y, - ae_int_t n, - barycentricinterpolant* p, - ae_state *_state); -void polynomialbuildcheb1(double a, - double b, - /* Real */ ae_vector* y, - ae_int_t n, - barycentricinterpolant* p, - ae_state *_state); -void polynomialbuildcheb2(double a, - double b, - /* Real */ ae_vector* y, - ae_int_t n, - barycentricinterpolant* p, - ae_state *_state); -double polynomialcalceqdist(double a, - double b, - /* Real */ ae_vector* f, - ae_int_t n, - double t, - ae_state *_state); -double polynomialcalccheb1(double a, - double b, - /* Real */ ae_vector* f, - ae_int_t n, - double t, - ae_state *_state); -double polynomialcalccheb2(double a, - double b, - /* Real */ ae_vector* f, - ae_int_t n, - double t, - ae_state *_state); -void spline1dbuildlinear(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - spline1dinterpolant* c, - ae_state *_state); -void spline1dbuildcubic(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_int_t boundltype, - double boundl, - ae_int_t boundrtype, - double boundr, - spline1dinterpolant* c, - ae_state *_state); -void spline1dgriddiffcubic(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_int_t boundltype, - double boundl, - ae_int_t boundrtype, - double boundr, - /* Real */ ae_vector* d, - ae_state *_state); -void spline1dgriddiff2cubic(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_int_t boundltype, - double boundl, - ae_int_t boundrtype, - double boundr, - /* Real */ ae_vector* d1, - /* Real */ ae_vector* d2, - ae_state *_state); -void spline1dconvcubic(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_int_t boundltype, - double boundl, - ae_int_t boundrtype, - double boundr, - /* Real */ ae_vector* x2, - ae_int_t n2, - /* Real */ ae_vector* y2, - ae_state *_state); -void spline1dconvdiffcubic(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_int_t boundltype, - double boundl, - ae_int_t boundrtype, - double boundr, - /* Real */ ae_vector* x2, - ae_int_t n2, - /* Real */ ae_vector* y2, - /* Real */ ae_vector* d2, - ae_state *_state); -void spline1dconvdiff2cubic(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_int_t boundltype, - double boundl, - ae_int_t boundrtype, - double boundr, - /* Real */ ae_vector* x2, - ae_int_t n2, - /* Real */ ae_vector* y2, - /* Real */ ae_vector* d2, - /* Real */ ae_vector* dd2, - ae_state *_state); -void spline1dbuildcatmullrom(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_int_t boundtype, - double tension, - spline1dinterpolant* c, - ae_state *_state); -void spline1dbuildhermite(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* d, - ae_int_t n, - spline1dinterpolant* c, - ae_state *_state); -void spline1dbuildakima(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - spline1dinterpolant* c, - ae_state *_state); -double spline1dcalc(spline1dinterpolant* c, double x, ae_state *_state); -void spline1ddiff(spline1dinterpolant* c, - double x, - double* s, - double* ds, - double* d2s, - ae_state *_state); -void spline1dcopy(spline1dinterpolant* c, - spline1dinterpolant* cc, - ae_state *_state); -void spline1dunpack(spline1dinterpolant* c, - ae_int_t* n, - /* Real */ ae_matrix* tbl, - ae_state *_state); -void spline1dlintransx(spline1dinterpolant* c, - double a, - double b, - ae_state *_state); -void spline1dlintransy(spline1dinterpolant* c, - double a, - double b, - ae_state *_state); -double spline1dintegrate(spline1dinterpolant* c, - double x, - ae_state *_state); -void spline1dconvdiffinternal(/* Real */ ae_vector* xold, - /* Real */ ae_vector* yold, - /* Real */ ae_vector* dold, - ae_int_t n, - /* Real */ ae_vector* x2, - ae_int_t n2, - /* Real */ ae_vector* y, - ae_bool needy, - /* Real */ ae_vector* d1, - ae_bool needd1, - /* Real */ ae_vector* d2, - ae_bool needd2, - ae_state *_state); -void spline1drootsandextrema(spline1dinterpolant* c, - /* Real */ ae_vector* r, - ae_int_t* nr, - ae_bool* dr, - /* Real */ ae_vector* e, - /* Integer */ ae_vector* et, - ae_int_t* ne, - ae_bool* de, - ae_state *_state); -void heapsortdpoints(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* d, - ae_int_t n, - ae_state *_state); -void solvepolinom2(double p0, - double m0, - double p1, - double m1, - double* x0, - double* x1, - ae_int_t* nr, - ae_state *_state); -void solvecubicpolinom(double pa, - double ma, - double pb, - double mb, - double a, - double b, - double* x0, - double* x1, - double* x2, - double* ex0, - double* ex1, - ae_int_t* nr, - ae_int_t* ne, - /* Real */ ae_vector* tempdata, - ae_state *_state); -ae_int_t bisectmethod(double pa, - double ma, - double pb, - double mb, - double a, - double b, - double* x, - ae_state *_state); -void spline1dbuildmonotone(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - spline1dinterpolant* c, - ae_state *_state); -ae_bool _spline1dinterpolant_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _spline1dinterpolant_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _spline1dinterpolant_clear(void* _p); -void _spline1dinterpolant_destroy(void* _p); -void polynomialfit(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_int_t m, - ae_int_t* info, - barycentricinterpolant* p, - polynomialfitreport* rep, - ae_state *_state); -void polynomialfitwc(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* w, - ae_int_t n, - /* Real */ ae_vector* xc, - /* Real */ ae_vector* yc, - /* Integer */ ae_vector* dc, - ae_int_t k, - ae_int_t m, - ae_int_t* info, - barycentricinterpolant* p, - polynomialfitreport* rep, - ae_state *_state); -void barycentricfitfloaterhormannwc(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* w, - ae_int_t n, - /* Real */ ae_vector* xc, - /* Real */ ae_vector* yc, - /* Integer */ ae_vector* dc, - ae_int_t k, - ae_int_t m, - ae_int_t* info, - barycentricinterpolant* b, - barycentricfitreport* rep, - ae_state *_state); -void barycentricfitfloaterhormann(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_int_t m, - ae_int_t* info, - barycentricinterpolant* b, - barycentricfitreport* rep, - ae_state *_state); -void spline1dfitpenalized(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_int_t m, - double rho, - ae_int_t* info, - spline1dinterpolant* s, - spline1dfitreport* rep, - ae_state *_state); -void spline1dfitpenalizedw(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* w, - ae_int_t n, - ae_int_t m, - double rho, - ae_int_t* info, - spline1dinterpolant* s, - spline1dfitreport* rep, - ae_state *_state); -void spline1dfitcubicwc(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* w, - ae_int_t n, - /* Real */ ae_vector* xc, - /* Real */ ae_vector* yc, - /* Integer */ ae_vector* dc, - ae_int_t k, - ae_int_t m, - ae_int_t* info, - spline1dinterpolant* s, - spline1dfitreport* rep, - ae_state *_state); -void spline1dfithermitewc(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* w, - ae_int_t n, - /* Real */ ae_vector* xc, - /* Real */ ae_vector* yc, - /* Integer */ ae_vector* dc, - ae_int_t k, - ae_int_t m, - ae_int_t* info, - spline1dinterpolant* s, - spline1dfitreport* rep, - ae_state *_state); -void spline1dfitcubic(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_int_t m, - ae_int_t* info, - spline1dinterpolant* s, - spline1dfitreport* rep, - ae_state *_state); -void spline1dfithermite(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_int_t m, - ae_int_t* info, - spline1dinterpolant* s, - spline1dfitreport* rep, - ae_state *_state); -void lsfitlinearw(/* Real */ ae_vector* y, - /* Real */ ae_vector* w, - /* Real */ ae_matrix* fmatrix, - ae_int_t n, - ae_int_t m, - ae_int_t* info, - /* Real */ ae_vector* c, - lsfitreport* rep, - ae_state *_state); -void lsfitlinearwc(/* Real */ ae_vector* y, - /* Real */ ae_vector* w, - /* Real */ ae_matrix* fmatrix, - /* Real */ ae_matrix* cmatrix, - ae_int_t n, - ae_int_t m, - ae_int_t k, - ae_int_t* info, - /* Real */ ae_vector* c, - lsfitreport* rep, - ae_state *_state); -void lsfitlinear(/* Real */ ae_vector* y, - /* Real */ ae_matrix* fmatrix, - ae_int_t n, - ae_int_t m, - ae_int_t* info, - /* Real */ ae_vector* c, - lsfitreport* rep, - ae_state *_state); -void lsfitlinearc(/* Real */ ae_vector* y, - /* Real */ ae_matrix* fmatrix, - /* Real */ ae_matrix* cmatrix, - ae_int_t n, - ae_int_t m, - ae_int_t k, - ae_int_t* info, - /* Real */ ae_vector* c, - lsfitreport* rep, - ae_state *_state); -void lsfitcreatewf(/* Real */ ae_matrix* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* w, - /* Real */ ae_vector* c, - ae_int_t n, - ae_int_t m, - ae_int_t k, - double diffstep, - lsfitstate* state, - ae_state *_state); -void lsfitcreatef(/* Real */ ae_matrix* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* c, - ae_int_t n, - ae_int_t m, - ae_int_t k, - double diffstep, - lsfitstate* state, - ae_state *_state); -void lsfitcreatewfg(/* Real */ ae_matrix* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* w, - /* Real */ ae_vector* c, - ae_int_t n, - ae_int_t m, - ae_int_t k, - ae_bool cheapfg, - lsfitstate* state, - ae_state *_state); -void lsfitcreatefg(/* Real */ ae_matrix* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* c, - ae_int_t n, - ae_int_t m, - ae_int_t k, - ae_bool cheapfg, - lsfitstate* state, - ae_state *_state); -void lsfitcreatewfgh(/* Real */ ae_matrix* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* w, - /* Real */ ae_vector* c, - ae_int_t n, - ae_int_t m, - ae_int_t k, - lsfitstate* state, - ae_state *_state); -void lsfitcreatefgh(/* Real */ ae_matrix* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* c, - ae_int_t n, - ae_int_t m, - ae_int_t k, - lsfitstate* state, - ae_state *_state); -void lsfitsetcond(lsfitstate* state, - double epsf, - double epsx, - ae_int_t maxits, - ae_state *_state); -void lsfitsetstpmax(lsfitstate* state, double stpmax, ae_state *_state); -void lsfitsetxrep(lsfitstate* state, ae_bool needxrep, ae_state *_state); -void lsfitsetscale(lsfitstate* state, - /* Real */ ae_vector* s, - ae_state *_state); -void lsfitsetbc(lsfitstate* state, - /* Real */ ae_vector* bndl, - /* Real */ ae_vector* bndu, - ae_state *_state); -ae_bool lsfititeration(lsfitstate* state, ae_state *_state); -void lsfitresults(lsfitstate* state, - ae_int_t* info, - /* Real */ ae_vector* c, - lsfitreport* rep, - ae_state *_state); -void lsfitsetgradientcheck(lsfitstate* state, - double teststep, - ae_state *_state); -void lsfitscalexy(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* w, - ae_int_t n, - /* Real */ ae_vector* xc, - /* Real */ ae_vector* yc, - /* Integer */ ae_vector* dc, - ae_int_t k, - double* xa, - double* xb, - double* sa, - double* sb, - /* Real */ ae_vector* xoriginal, - /* Real */ ae_vector* yoriginal, - ae_state *_state); -ae_bool _polynomialfitreport_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _polynomialfitreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _polynomialfitreport_clear(void* _p); -void _polynomialfitreport_destroy(void* _p); -ae_bool _barycentricfitreport_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _barycentricfitreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _barycentricfitreport_clear(void* _p); -void _barycentricfitreport_destroy(void* _p); -ae_bool _spline1dfitreport_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _spline1dfitreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _spline1dfitreport_clear(void* _p); -void _spline1dfitreport_destroy(void* _p); -ae_bool _lsfitreport_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _lsfitreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _lsfitreport_clear(void* _p); -void _lsfitreport_destroy(void* _p); -ae_bool _lsfitstate_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _lsfitstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _lsfitstate_clear(void* _p); -void _lsfitstate_destroy(void* _p); -void pspline2build(/* Real */ ae_matrix* xy, - ae_int_t n, - ae_int_t st, - ae_int_t pt, - pspline2interpolant* p, - ae_state *_state); -void pspline3build(/* Real */ ae_matrix* xy, - ae_int_t n, - ae_int_t st, - ae_int_t pt, - pspline3interpolant* p, - ae_state *_state); -void pspline2buildperiodic(/* Real */ ae_matrix* xy, - ae_int_t n, - ae_int_t st, - ae_int_t pt, - pspline2interpolant* p, - ae_state *_state); -void pspline3buildperiodic(/* Real */ ae_matrix* xy, - ae_int_t n, - ae_int_t st, - ae_int_t pt, - pspline3interpolant* p, - ae_state *_state); -void pspline2parametervalues(pspline2interpolant* p, - ae_int_t* n, - /* Real */ ae_vector* t, - ae_state *_state); -void pspline3parametervalues(pspline3interpolant* p, - ae_int_t* n, - /* Real */ ae_vector* t, - ae_state *_state); -void pspline2calc(pspline2interpolant* p, - double t, - double* x, - double* y, - ae_state *_state); -void pspline3calc(pspline3interpolant* p, - double t, - double* x, - double* y, - double* z, - ae_state *_state); -void pspline2tangent(pspline2interpolant* p, - double t, - double* x, - double* y, - ae_state *_state); -void pspline3tangent(pspline3interpolant* p, - double t, - double* x, - double* y, - double* z, - ae_state *_state); -void pspline2diff(pspline2interpolant* p, - double t, - double* x, - double* dx, - double* y, - double* dy, - ae_state *_state); -void pspline3diff(pspline3interpolant* p, - double t, - double* x, - double* dx, - double* y, - double* dy, - double* z, - double* dz, - ae_state *_state); -void pspline2diff2(pspline2interpolant* p, - double t, - double* x, - double* dx, - double* d2x, - double* y, - double* dy, - double* d2y, - ae_state *_state); -void pspline3diff2(pspline3interpolant* p, - double t, - double* x, - double* dx, - double* d2x, - double* y, - double* dy, - double* d2y, - double* z, - double* dz, - double* d2z, - ae_state *_state); -double pspline2arclength(pspline2interpolant* p, - double a, - double b, - ae_state *_state); -double pspline3arclength(pspline3interpolant* p, - double a, - double b, - ae_state *_state); -ae_bool _pspline2interpolant_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _pspline2interpolant_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _pspline2interpolant_clear(void* _p); -void _pspline2interpolant_destroy(void* _p); -ae_bool _pspline3interpolant_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _pspline3interpolant_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _pspline3interpolant_clear(void* _p); -void _pspline3interpolant_destroy(void* _p); -void rbfcreate(ae_int_t nx, ae_int_t ny, rbfmodel* s, ae_state *_state); -void rbfsetpoints(rbfmodel* s, - /* Real */ ae_matrix* xy, - ae_int_t n, - ae_state *_state); -void rbfsetalgoqnn(rbfmodel* s, double q, double z, ae_state *_state); -void rbfsetalgomultilayer(rbfmodel* s, - double rbase, - ae_int_t nlayers, - double lambdav, - ae_state *_state); -void rbfsetlinterm(rbfmodel* s, ae_state *_state); -void rbfsetconstterm(rbfmodel* s, ae_state *_state); -void rbfsetzeroterm(rbfmodel* s, ae_state *_state); -void rbfsetcond(rbfmodel* s, - double epsort, - double epserr, - ae_int_t maxits, - ae_state *_state); -void rbfbuildmodel(rbfmodel* s, rbfreport* rep, ae_state *_state); -double rbfcalc2(rbfmodel* s, double x0, double x1, ae_state *_state); -double rbfcalc3(rbfmodel* s, - double x0, - double x1, - double x2, - ae_state *_state); -void rbfcalc(rbfmodel* s, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state); -void rbfcalcbuf(rbfmodel* s, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state); -void rbfgridcalc2(rbfmodel* s, - /* Real */ ae_vector* x0, - ae_int_t n0, - /* Real */ ae_vector* x1, - ae_int_t n1, - /* Real */ ae_matrix* y, - ae_state *_state); -void rbfunpack(rbfmodel* s, - ae_int_t* nx, - ae_int_t* ny, - /* Real */ ae_matrix* xwr, - ae_int_t* nc, - /* Real */ ae_matrix* v, - ae_state *_state); -void rbfalloc(ae_serializer* s, rbfmodel* model, ae_state *_state); -void rbfserialize(ae_serializer* s, rbfmodel* model, ae_state *_state); -void rbfunserialize(ae_serializer* s, rbfmodel* model, ae_state *_state); -ae_bool _rbfmodel_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _rbfmodel_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _rbfmodel_clear(void* _p); -void _rbfmodel_destroy(void* _p); -ae_bool _rbfreport_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _rbfreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _rbfreport_clear(void* _p); -void _rbfreport_destroy(void* _p); -double spline2dcalc(spline2dinterpolant* c, - double x, - double y, - ae_state *_state); -void spline2ddiff(spline2dinterpolant* c, - double x, - double y, - double* f, - double* fx, - double* fy, - double* fxy, - ae_state *_state); -void spline2dlintransxy(spline2dinterpolant* c, - double ax, - double bx, - double ay, - double by, - ae_state *_state); -void spline2dlintransf(spline2dinterpolant* c, - double a, - double b, - ae_state *_state); -void spline2dcopy(spline2dinterpolant* c, - spline2dinterpolant* cc, - ae_state *_state); -void spline2dresamplebicubic(/* Real */ ae_matrix* a, - ae_int_t oldheight, - ae_int_t oldwidth, - /* Real */ ae_matrix* b, - ae_int_t newheight, - ae_int_t newwidth, - ae_state *_state); -void spline2dresamplebilinear(/* Real */ ae_matrix* a, - ae_int_t oldheight, - ae_int_t oldwidth, - /* Real */ ae_matrix* b, - ae_int_t newheight, - ae_int_t newwidth, - ae_state *_state); -void spline2dbuildbilinearv(/* Real */ ae_vector* x, - ae_int_t n, - /* Real */ ae_vector* y, - ae_int_t m, - /* Real */ ae_vector* f, - ae_int_t d, - spline2dinterpolant* c, - ae_state *_state); -void spline2dbuildbicubicv(/* Real */ ae_vector* x, - ae_int_t n, - /* Real */ ae_vector* y, - ae_int_t m, - /* Real */ ae_vector* f, - ae_int_t d, - spline2dinterpolant* c, - ae_state *_state); -void spline2dcalcvbuf(spline2dinterpolant* c, - double x, - double y, - /* Real */ ae_vector* f, - ae_state *_state); -void spline2dcalcv(spline2dinterpolant* c, - double x, - double y, - /* Real */ ae_vector* f, - ae_state *_state); -void spline2dunpackv(spline2dinterpolant* c, - ae_int_t* m, - ae_int_t* n, - ae_int_t* d, - /* Real */ ae_matrix* tbl, - ae_state *_state); -void spline2dbuildbilinear(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_matrix* f, - ae_int_t m, - ae_int_t n, - spline2dinterpolant* c, - ae_state *_state); -void spline2dbuildbicubic(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_matrix* f, - ae_int_t m, - ae_int_t n, - spline2dinterpolant* c, - ae_state *_state); -void spline2dunpack(spline2dinterpolant* c, - ae_int_t* m, - ae_int_t* n, - /* Real */ ae_matrix* tbl, - ae_state *_state); -ae_bool _spline2dinterpolant_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _spline2dinterpolant_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _spline2dinterpolant_clear(void* _p); -void _spline2dinterpolant_destroy(void* _p); -double spline3dcalc(spline3dinterpolant* c, - double x, - double y, - double z, - ae_state *_state); -void spline3dlintransxyz(spline3dinterpolant* c, - double ax, - double bx, - double ay, - double by, - double az, - double bz, - ae_state *_state); -void spline3dlintransf(spline3dinterpolant* c, - double a, - double b, - ae_state *_state); -void spline3dcopy(spline3dinterpolant* c, - spline3dinterpolant* cc, - ae_state *_state); -void spline3dresampletrilinear(/* Real */ ae_vector* a, - ae_int_t oldzcount, - ae_int_t oldycount, - ae_int_t oldxcount, - ae_int_t newzcount, - ae_int_t newycount, - ae_int_t newxcount, - /* Real */ ae_vector* b, - ae_state *_state); -void spline3dbuildtrilinearv(/* Real */ ae_vector* x, - ae_int_t n, - /* Real */ ae_vector* y, - ae_int_t m, - /* Real */ ae_vector* z, - ae_int_t l, - /* Real */ ae_vector* f, - ae_int_t d, - spline3dinterpolant* c, - ae_state *_state); -void spline3dcalcvbuf(spline3dinterpolant* c, - double x, - double y, - double z, - /* Real */ ae_vector* f, - ae_state *_state); -void spline3dcalcv(spline3dinterpolant* c, - double x, - double y, - double z, - /* Real */ ae_vector* f, - ae_state *_state); -void spline3dunpackv(spline3dinterpolant* c, - ae_int_t* n, - ae_int_t* m, - ae_int_t* l, - ae_int_t* d, - ae_int_t* stype, - /* Real */ ae_matrix* tbl, - ae_state *_state); -ae_bool _spline3dinterpolant_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _spline3dinterpolant_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _spline3dinterpolant_clear(void* _p); -void _spline3dinterpolant_destroy(void* _p); - -} -#endif - diff --git a/src/core/alglib/linalg.cpp b/src/core/alglib/linalg.cpp deleted file mode 100644 index f970dc3..0000000 --- a/src/core/alglib/linalg.cpp +++ /dev/null @@ -1,33805 +0,0 @@ -/************************************************************************* -Copyright (c) Sergey Bochkanov (ALGLIB project). - ->>> SOURCE LICENSE >>> -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation (www.fsf.org); either version 2 of the -License, or (at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -A copy of the GNU General Public License is available at -http://www.fsf.org/licensing/licenses ->>> END OF LICENSE >>> -*************************************************************************/ -#include "stdafx.h" -#include "linalg.h" - -// disable some irrelevant warnings -#if (AE_COMPILER==AE_MSVC) -#pragma warning(disable:4100) -#pragma warning(disable:4127) -#pragma warning(disable:4702) -#pragma warning(disable:4996) -#endif -using namespace std; - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS IMPLEMENTATION OF C++ INTERFACE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib -{ - - -/************************************************************************* -Cache-oblivous complex "copy-and-transpose" - -Input parameters: - M - number of rows - N - number of columns - A - source matrix, MxN submatrix is copied and transposed - IA - submatrix offset (row index) - JA - submatrix offset (column index) - B - destination matrix, must be large enough to store result - IB - submatrix offset (row index) - JB - submatrix offset (column index) -*************************************************************************/ -void cmatrixtranspose(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, complex_2d_array &b, const ae_int_t ib, const ae_int_t jb) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::cmatrixtranspose(m, n, const_cast(a.c_ptr()), ia, ja, const_cast(b.c_ptr()), ib, jb, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Cache-oblivous real "copy-and-transpose" - -Input parameters: - M - number of rows - N - number of columns - A - source matrix, MxN submatrix is copied and transposed - IA - submatrix offset (row index) - JA - submatrix offset (column index) - B - destination matrix, must be large enough to store result - IB - submatrix offset (row index) - JB - submatrix offset (column index) -*************************************************************************/ -void rmatrixtranspose(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, real_2d_array &b, const ae_int_t ib, const ae_int_t jb) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixtranspose(m, n, const_cast(a.c_ptr()), ia, ja, const_cast(b.c_ptr()), ib, jb, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This code enforces symmetricy of the matrix by copying Upper part to lower -one (or vice versa). - -INPUT PARAMETERS: - A - matrix - N - number of rows/columns - IsUpper - whether we want to copy upper triangle to lower one (True) - or vice versa (False). -*************************************************************************/ -void rmatrixenforcesymmetricity(const real_2d_array &a, const ae_int_t n, const bool isupper) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixenforcesymmetricity(const_cast(a.c_ptr()), n, isupper, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Copy - -Input parameters: - M - number of rows - N - number of columns - A - source matrix, MxN submatrix is copied and transposed - IA - submatrix offset (row index) - JA - submatrix offset (column index) - B - destination matrix, must be large enough to store result - IB - submatrix offset (row index) - JB - submatrix offset (column index) -*************************************************************************/ -void cmatrixcopy(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, complex_2d_array &b, const ae_int_t ib, const ae_int_t jb) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::cmatrixcopy(m, n, const_cast(a.c_ptr()), ia, ja, const_cast(b.c_ptr()), ib, jb, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Copy - -Input parameters: - M - number of rows - N - number of columns - A - source matrix, MxN submatrix is copied and transposed - IA - submatrix offset (row index) - JA - submatrix offset (column index) - B - destination matrix, must be large enough to store result - IB - submatrix offset (row index) - JB - submatrix offset (column index) -*************************************************************************/ -void rmatrixcopy(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, real_2d_array &b, const ae_int_t ib, const ae_int_t jb) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixcopy(m, n, const_cast(a.c_ptr()), ia, ja, const_cast(b.c_ptr()), ib, jb, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Rank-1 correction: A := A + u*v' - -INPUT PARAMETERS: - M - number of rows - N - number of columns - A - target matrix, MxN submatrix is updated - IA - submatrix offset (row index) - JA - submatrix offset (column index) - U - vector #1 - IU - subvector offset - V - vector #2 - IV - subvector offset -*************************************************************************/ -void cmatrixrank1(const ae_int_t m, const ae_int_t n, complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, complex_1d_array &u, const ae_int_t iu, complex_1d_array &v, const ae_int_t iv) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::cmatrixrank1(m, n, const_cast(a.c_ptr()), ia, ja, const_cast(u.c_ptr()), iu, const_cast(v.c_ptr()), iv, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Rank-1 correction: A := A + u*v' - -INPUT PARAMETERS: - M - number of rows - N - number of columns - A - target matrix, MxN submatrix is updated - IA - submatrix offset (row index) - JA - submatrix offset (column index) - U - vector #1 - IU - subvector offset - V - vector #2 - IV - subvector offset -*************************************************************************/ -void rmatrixrank1(const ae_int_t m, const ae_int_t n, real_2d_array &a, const ae_int_t ia, const ae_int_t ja, real_1d_array &u, const ae_int_t iu, real_1d_array &v, const ae_int_t iv) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixrank1(m, n, const_cast(a.c_ptr()), ia, ja, const_cast(u.c_ptr()), iu, const_cast(v.c_ptr()), iv, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Matrix-vector product: y := op(A)*x - -INPUT PARAMETERS: - M - number of rows of op(A) - M>=0 - N - number of columns of op(A) - N>=0 - A - target matrix - IA - submatrix offset (row index) - JA - submatrix offset (column index) - OpA - operation type: - * OpA=0 => op(A) = A - * OpA=1 => op(A) = A^T - * OpA=2 => op(A) = A^H - X - input vector - IX - subvector offset - IY - subvector offset - Y - preallocated matrix, must be large enough to store result - -OUTPUT PARAMETERS: - Y - vector which stores result - -if M=0, then subroutine does nothing. -if N=0, Y is filled by zeros. - - - -- ALGLIB routine -- - - 28.01.2010 - Bochkanov Sergey -*************************************************************************/ -void cmatrixmv(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t opa, const complex_1d_array &x, const ae_int_t ix, complex_1d_array &y, const ae_int_t iy) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::cmatrixmv(m, n, const_cast(a.c_ptr()), ia, ja, opa, const_cast(x.c_ptr()), ix, const_cast(y.c_ptr()), iy, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Matrix-vector product: y := op(A)*x - -INPUT PARAMETERS: - M - number of rows of op(A) - N - number of columns of op(A) - A - target matrix - IA - submatrix offset (row index) - JA - submatrix offset (column index) - OpA - operation type: - * OpA=0 => op(A) = A - * OpA=1 => op(A) = A^T - X - input vector - IX - subvector offset - IY - subvector offset - Y - preallocated matrix, must be large enough to store result - -OUTPUT PARAMETERS: - Y - vector which stores result - -if M=0, then subroutine does nothing. -if N=0, Y is filled by zeros. - - - -- ALGLIB routine -- - - 28.01.2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixmv(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t opa, const real_1d_array &x, const ae_int_t ix, real_1d_array &y, const ae_int_t iy) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixmv(m, n, const_cast(a.c_ptr()), ia, ja, opa, const_cast(x.c_ptr()), ix, const_cast(y.c_ptr()), iy, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* - -*************************************************************************/ -void cmatrixrighttrsm(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const complex_2d_array &x, const ae_int_t i2, const ae_int_t j2) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::cmatrixrighttrsm(m, n, const_cast(a.c_ptr()), i1, j1, isupper, isunit, optype, const_cast(x.c_ptr()), i2, j2, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_cmatrixrighttrsm(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const complex_2d_array &x, const ae_int_t i2, const ae_int_t j2) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_cmatrixrighttrsm(m, n, const_cast(a.c_ptr()), i1, j1, isupper, isunit, optype, const_cast(x.c_ptr()), i2, j2, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* - -*************************************************************************/ -void cmatrixlefttrsm(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const complex_2d_array &x, const ae_int_t i2, const ae_int_t j2) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::cmatrixlefttrsm(m, n, const_cast(a.c_ptr()), i1, j1, isupper, isunit, optype, const_cast(x.c_ptr()), i2, j2, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_cmatrixlefttrsm(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const complex_2d_array &x, const ae_int_t i2, const ae_int_t j2) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_cmatrixlefttrsm(m, n, const_cast(a.c_ptr()), i1, j1, isupper, isunit, optype, const_cast(x.c_ptr()), i2, j2, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* - -*************************************************************************/ -void rmatrixrighttrsm(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const real_2d_array &x, const ae_int_t i2, const ae_int_t j2) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixrighttrsm(m, n, const_cast(a.c_ptr()), i1, j1, isupper, isunit, optype, const_cast(x.c_ptr()), i2, j2, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_rmatrixrighttrsm(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const real_2d_array &x, const ae_int_t i2, const ae_int_t j2) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_rmatrixrighttrsm(m, n, const_cast(a.c_ptr()), i1, j1, isupper, isunit, optype, const_cast(x.c_ptr()), i2, j2, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* - -*************************************************************************/ -void rmatrixlefttrsm(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const real_2d_array &x, const ae_int_t i2, const ae_int_t j2) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixlefttrsm(m, n, const_cast(a.c_ptr()), i1, j1, isupper, isunit, optype, const_cast(x.c_ptr()), i2, j2, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_rmatrixlefttrsm(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const real_2d_array &x, const ae_int_t i2, const ae_int_t j2) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_rmatrixlefttrsm(m, n, const_cast(a.c_ptr()), i1, j1, isupper, isunit, optype, const_cast(x.c_ptr()), i2, j2, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* - -*************************************************************************/ -void cmatrixsyrk(const ae_int_t n, const ae_int_t k, const double alpha, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const double beta, const complex_2d_array &c, const ae_int_t ic, const ae_int_t jc, const bool isupper) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::cmatrixsyrk(n, k, alpha, const_cast(a.c_ptr()), ia, ja, optypea, beta, const_cast(c.c_ptr()), ic, jc, isupper, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_cmatrixsyrk(const ae_int_t n, const ae_int_t k, const double alpha, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const double beta, const complex_2d_array &c, const ae_int_t ic, const ae_int_t jc, const bool isupper) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_cmatrixsyrk(n, k, alpha, const_cast(a.c_ptr()), ia, ja, optypea, beta, const_cast(c.c_ptr()), ic, jc, isupper, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* - -*************************************************************************/ -void rmatrixsyrk(const ae_int_t n, const ae_int_t k, const double alpha, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const double beta, const real_2d_array &c, const ae_int_t ic, const ae_int_t jc, const bool isupper) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixsyrk(n, k, alpha, const_cast(a.c_ptr()), ia, ja, optypea, beta, const_cast(c.c_ptr()), ic, jc, isupper, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_rmatrixsyrk(const ae_int_t n, const ae_int_t k, const double alpha, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const double beta, const real_2d_array &c, const ae_int_t ic, const ae_int_t jc, const bool isupper) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_rmatrixsyrk(n, k, alpha, const_cast(a.c_ptr()), ia, ja, optypea, beta, const_cast(c.c_ptr()), ic, jc, isupper, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* - -*************************************************************************/ -void cmatrixgemm(const ae_int_t m, const ae_int_t n, const ae_int_t k, const alglib::complex alpha, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const complex_2d_array &b, const ae_int_t ib, const ae_int_t jb, const ae_int_t optypeb, const alglib::complex beta, const complex_2d_array &c, const ae_int_t ic, const ae_int_t jc) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::cmatrixgemm(m, n, k, *alpha.c_ptr(), const_cast(a.c_ptr()), ia, ja, optypea, const_cast(b.c_ptr()), ib, jb, optypeb, *beta.c_ptr(), const_cast(c.c_ptr()), ic, jc, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_cmatrixgemm(const ae_int_t m, const ae_int_t n, const ae_int_t k, const alglib::complex alpha, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const complex_2d_array &b, const ae_int_t ib, const ae_int_t jb, const ae_int_t optypeb, const alglib::complex beta, const complex_2d_array &c, const ae_int_t ic, const ae_int_t jc) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_cmatrixgemm(m, n, k, *alpha.c_ptr(), const_cast(a.c_ptr()), ia, ja, optypea, const_cast(b.c_ptr()), ib, jb, optypeb, *beta.c_ptr(), const_cast(c.c_ptr()), ic, jc, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* - -*************************************************************************/ -void rmatrixgemm(const ae_int_t m, const ae_int_t n, const ae_int_t k, const double alpha, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const real_2d_array &b, const ae_int_t ib, const ae_int_t jb, const ae_int_t optypeb, const double beta, const real_2d_array &c, const ae_int_t ic, const ae_int_t jc) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixgemm(m, n, k, alpha, const_cast(a.c_ptr()), ia, ja, optypea, const_cast(b.c_ptr()), ib, jb, optypeb, beta, const_cast(c.c_ptr()), ic, jc, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_rmatrixgemm(const ae_int_t m, const ae_int_t n, const ae_int_t k, const double alpha, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const real_2d_array &b, const ae_int_t ib, const ae_int_t jb, const ae_int_t optypeb, const double beta, const real_2d_array &c, const ae_int_t ic, const ae_int_t jc) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_rmatrixgemm(m, n, k, alpha, const_cast(a.c_ptr()), ia, ja, optypea, const_cast(b.c_ptr()), ib, jb, optypeb, beta, const_cast(c.c_ptr()), ic, jc, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -QR decomposition of a rectangular matrix of size MxN - -Input parameters: - A - matrix A whose indexes range within [0..M-1, 0..N-1]. - M - number of rows in matrix A. - N - number of columns in matrix A. - -Output parameters: - A - matrices Q and R in compact form (see below). - Tau - array of scalar factors which are used to form - matrix Q. Array whose index ranges within [0.. Min(M-1,N-1)]. - -Matrix A is represented as A = QR, where Q is an orthogonal matrix of size -MxM, R - upper triangular (or upper trapezoid) matrix of size M x N. - -The elements of matrix R are located on and above the main diagonal of -matrix A. The elements which are located in Tau array and below the main -diagonal of matrix A are used to form matrix Q as follows: - -Matrix Q is represented as a product of elementary reflections - -Q = H(0)*H(2)*...*H(k-1), - -where k = min(m,n), and each H(i) is in the form - -H(i) = 1 - tau * v * (v^T) - -where tau is a scalar stored in Tau[I]; v - real vector, -so that v(0:i-1) = 0, v(i) = 1, v(i+1:m-1) stored in A(i+1:m-1,i). - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixqr(real_2d_array &a, const ae_int_t m, const ae_int_t n, real_1d_array &tau) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixqr(const_cast(a.c_ptr()), m, n, const_cast(tau.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -LQ decomposition of a rectangular matrix of size MxN - -Input parameters: - A - matrix A whose indexes range within [0..M-1, 0..N-1]. - M - number of rows in matrix A. - N - number of columns in matrix A. - -Output parameters: - A - matrices L and Q in compact form (see below) - Tau - array of scalar factors which are used to form - matrix Q. Array whose index ranges within [0..Min(M,N)-1]. - -Matrix A is represented as A = LQ, where Q is an orthogonal matrix of size -MxM, L - lower triangular (or lower trapezoid) matrix of size M x N. - -The elements of matrix L are located on and below the main diagonal of -matrix A. The elements which are located in Tau array and above the main -diagonal of matrix A are used to form matrix Q as follows: - -Matrix Q is represented as a product of elementary reflections - -Q = H(k-1)*H(k-2)*...*H(1)*H(0), - -where k = min(m,n), and each H(i) is of the form - -H(i) = 1 - tau * v * (v^T) - -where tau is a scalar stored in Tau[I]; v - real vector, so that v(0:i-1)=0, -v(i) = 1, v(i+1:n-1) stored in A(i,i+1:n-1). - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixlq(real_2d_array &a, const ae_int_t m, const ae_int_t n, real_1d_array &tau) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixlq(const_cast(a.c_ptr()), m, n, const_cast(tau.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -QR decomposition of a rectangular complex matrix of size MxN - -Input parameters: - A - matrix A whose indexes range within [0..M-1, 0..N-1] - M - number of rows in matrix A. - N - number of columns in matrix A. - -Output parameters: - A - matrices Q and R in compact form - Tau - array of scalar factors which are used to form matrix Q. Array - whose indexes range within [0.. Min(M,N)-1] - -Matrix A is represented as A = QR, where Q is an orthogonal matrix of size -MxM, R - upper triangular (or upper trapezoid) matrix of size MxN. - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - September 30, 1994 -*************************************************************************/ -void cmatrixqr(complex_2d_array &a, const ae_int_t m, const ae_int_t n, complex_1d_array &tau) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::cmatrixqr(const_cast(a.c_ptr()), m, n, const_cast(tau.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -LQ decomposition of a rectangular complex matrix of size MxN - -Input parameters: - A - matrix A whose indexes range within [0..M-1, 0..N-1] - M - number of rows in matrix A. - N - number of columns in matrix A. - -Output parameters: - A - matrices Q and L in compact form - Tau - array of scalar factors which are used to form matrix Q. Array - whose indexes range within [0.. Min(M,N)-1] - -Matrix A is represented as A = LQ, where Q is an orthogonal matrix of size -MxM, L - lower triangular (or lower trapezoid) matrix of size MxN. - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - September 30, 1994 -*************************************************************************/ -void cmatrixlq(complex_2d_array &a, const ae_int_t m, const ae_int_t n, complex_1d_array &tau) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::cmatrixlq(const_cast(a.c_ptr()), m, n, const_cast(tau.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Partial unpacking of matrix Q from the QR decomposition of a matrix A - -Input parameters: - A - matrices Q and R in compact form. - Output of RMatrixQR subroutine. - M - number of rows in given matrix A. M>=0. - N - number of columns in given matrix A. N>=0. - Tau - scalar factors which are used to form Q. - Output of the RMatrixQR subroutine. - QColumns - required number of columns of matrix Q. M>=QColumns>=0. - -Output parameters: - Q - first QColumns columns of matrix Q. - Array whose indexes range within [0..M-1, 0..QColumns-1]. - If QColumns=0, the array remains unchanged. - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixqrunpackq(const real_2d_array &a, const ae_int_t m, const ae_int_t n, const real_1d_array &tau, const ae_int_t qcolumns, real_2d_array &q) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixqrunpackq(const_cast(a.c_ptr()), m, n, const_cast(tau.c_ptr()), qcolumns, const_cast(q.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Unpacking of matrix R from the QR decomposition of a matrix A - -Input parameters: - A - matrices Q and R in compact form. - Output of RMatrixQR subroutine. - M - number of rows in given matrix A. M>=0. - N - number of columns in given matrix A. N>=0. - -Output parameters: - R - matrix R, array[0..M-1, 0..N-1]. - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixqrunpackr(const real_2d_array &a, const ae_int_t m, const ae_int_t n, real_2d_array &r) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixqrunpackr(const_cast(a.c_ptr()), m, n, const_cast(r.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Partial unpacking of matrix Q from the LQ decomposition of a matrix A - -Input parameters: - A - matrices L and Q in compact form. - Output of RMatrixLQ subroutine. - M - number of rows in given matrix A. M>=0. - N - number of columns in given matrix A. N>=0. - Tau - scalar factors which are used to form Q. - Output of the RMatrixLQ subroutine. - QRows - required number of rows in matrix Q. N>=QRows>=0. - -Output parameters: - Q - first QRows rows of matrix Q. Array whose indexes range - within [0..QRows-1, 0..N-1]. If QRows=0, the array remains - unchanged. - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixlqunpackq(const real_2d_array &a, const ae_int_t m, const ae_int_t n, const real_1d_array &tau, const ae_int_t qrows, real_2d_array &q) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixlqunpackq(const_cast(a.c_ptr()), m, n, const_cast(tau.c_ptr()), qrows, const_cast(q.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Unpacking of matrix L from the LQ decomposition of a matrix A - -Input parameters: - A - matrices Q and L in compact form. - Output of RMatrixLQ subroutine. - M - number of rows in given matrix A. M>=0. - N - number of columns in given matrix A. N>=0. - -Output parameters: - L - matrix L, array[0..M-1, 0..N-1]. - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixlqunpackl(const real_2d_array &a, const ae_int_t m, const ae_int_t n, real_2d_array &l) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixlqunpackl(const_cast(a.c_ptr()), m, n, const_cast(l.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Partial unpacking of matrix Q from QR decomposition of a complex matrix A. - -Input parameters: - A - matrices Q and R in compact form. - Output of CMatrixQR subroutine . - M - number of rows in matrix A. M>=0. - N - number of columns in matrix A. N>=0. - Tau - scalar factors which are used to form Q. - Output of CMatrixQR subroutine . - QColumns - required number of columns in matrix Q. M>=QColumns>=0. - -Output parameters: - Q - first QColumns columns of matrix Q. - Array whose index ranges within [0..M-1, 0..QColumns-1]. - If QColumns=0, array isn't changed. - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -void cmatrixqrunpackq(const complex_2d_array &a, const ae_int_t m, const ae_int_t n, const complex_1d_array &tau, const ae_int_t qcolumns, complex_2d_array &q) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::cmatrixqrunpackq(const_cast(a.c_ptr()), m, n, const_cast(tau.c_ptr()), qcolumns, const_cast(q.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Unpacking of matrix R from the QR decomposition of a matrix A - -Input parameters: - A - matrices Q and R in compact form. - Output of CMatrixQR subroutine. - M - number of rows in given matrix A. M>=0. - N - number of columns in given matrix A. N>=0. - -Output parameters: - R - matrix R, array[0..M-1, 0..N-1]. - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -void cmatrixqrunpackr(const complex_2d_array &a, const ae_int_t m, const ae_int_t n, complex_2d_array &r) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::cmatrixqrunpackr(const_cast(a.c_ptr()), m, n, const_cast(r.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Partial unpacking of matrix Q from LQ decomposition of a complex matrix A. - -Input parameters: - A - matrices Q and R in compact form. - Output of CMatrixLQ subroutine . - M - number of rows in matrix A. M>=0. - N - number of columns in matrix A. N>=0. - Tau - scalar factors which are used to form Q. - Output of CMatrixLQ subroutine . - QRows - required number of rows in matrix Q. N>=QColumns>=0. - -Output parameters: - Q - first QRows rows of matrix Q. - Array whose index ranges within [0..QRows-1, 0..N-1]. - If QRows=0, array isn't changed. - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -void cmatrixlqunpackq(const complex_2d_array &a, const ae_int_t m, const ae_int_t n, const complex_1d_array &tau, const ae_int_t qrows, complex_2d_array &q) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::cmatrixlqunpackq(const_cast(a.c_ptr()), m, n, const_cast(tau.c_ptr()), qrows, const_cast(q.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Unpacking of matrix L from the LQ decomposition of a matrix A - -Input parameters: - A - matrices Q and L in compact form. - Output of CMatrixLQ subroutine. - M - number of rows in given matrix A. M>=0. - N - number of columns in given matrix A. N>=0. - -Output parameters: - L - matrix L, array[0..M-1, 0..N-1]. - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -void cmatrixlqunpackl(const complex_2d_array &a, const ae_int_t m, const ae_int_t n, complex_2d_array &l) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::cmatrixlqunpackl(const_cast(a.c_ptr()), m, n, const_cast(l.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Reduction of a rectangular matrix to bidiagonal form - -The algorithm reduces the rectangular matrix A to bidiagonal form by -orthogonal transformations P and Q: A = Q*B*P. - -Input parameters: - A - source matrix. array[0..M-1, 0..N-1] - M - number of rows in matrix A. - N - number of columns in matrix A. - -Output parameters: - A - matrices Q, B, P in compact form (see below). - TauQ - scalar factors which are used to form matrix Q. - TauP - scalar factors which are used to form matrix P. - -The main diagonal and one of the secondary diagonals of matrix A are -replaced with bidiagonal matrix B. Other elements contain elementary -reflections which form MxM matrix Q and NxN matrix P, respectively. - -If M>=N, B is the upper bidiagonal MxN matrix and is stored in the -corresponding elements of matrix A. Matrix Q is represented as a -product of elementary reflections Q = H(0)*H(1)*...*H(n-1), where -H(i) = 1-tau*v*v'. Here tau is a scalar which is stored in TauQ[i], and -vector v has the following structure: v(0:i-1)=0, v(i)=1, v(i+1:m-1) is -stored in elements A(i+1:m-1,i). Matrix P is as follows: P = -G(0)*G(1)*...*G(n-2), where G(i) = 1 - tau*u*u'. Tau is stored in TauP[i], -u(0:i)=0, u(i+1)=1, u(i+2:n-1) is stored in elements A(i,i+2:n-1). - -If M n): m=5, n=6 (m < n): - -( d e u1 u1 u1 ) ( d u1 u1 u1 u1 u1 ) -( v1 d e u2 u2 ) ( e d u2 u2 u2 u2 ) -( v1 v2 d e u3 ) ( v1 e d u3 u3 u3 ) -( v1 v2 v3 d e ) ( v1 v2 e d u4 u4 ) -( v1 v2 v3 v4 d ) ( v1 v2 v3 e d u5 ) -( v1 v2 v3 v4 v5 ) - -Here vi and ui are vectors which form H(i) and G(i), and d and e - -are the diagonal and off-diagonal elements of matrix B. - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - September 30, 1994. - Sergey Bochkanov, ALGLIB project, translation from FORTRAN to - pseudocode, 2007-2010. -*************************************************************************/ -void rmatrixbd(real_2d_array &a, const ae_int_t m, const ae_int_t n, real_1d_array &tauq, real_1d_array &taup) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixbd(const_cast(a.c_ptr()), m, n, const_cast(tauq.c_ptr()), const_cast(taup.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Unpacking matrix Q which reduces a matrix to bidiagonal form. - -Input parameters: - QP - matrices Q and P in compact form. - Output of ToBidiagonal subroutine. - M - number of rows in matrix A. - N - number of columns in matrix A. - TAUQ - scalar factors which are used to form Q. - Output of ToBidiagonal subroutine. - QColumns - required number of columns in matrix Q. - M>=QColumns>=0. - -Output parameters: - Q - first QColumns columns of matrix Q. - Array[0..M-1, 0..QColumns-1] - If QColumns=0, the array is not modified. - - -- ALGLIB -- - 2005-2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixbdunpackq(const real_2d_array &qp, const ae_int_t m, const ae_int_t n, const real_1d_array &tauq, const ae_int_t qcolumns, real_2d_array &q) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixbdunpackq(const_cast(qp.c_ptr()), m, n, const_cast(tauq.c_ptr()), qcolumns, const_cast(q.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Multiplication by matrix Q which reduces matrix A to bidiagonal form. - -The algorithm allows pre- or post-multiply by Q or Q'. - -Input parameters: - QP - matrices Q and P in compact form. - Output of ToBidiagonal subroutine. - M - number of rows in matrix A. - N - number of columns in matrix A. - TAUQ - scalar factors which are used to form Q. - Output of ToBidiagonal subroutine. - Z - multiplied matrix. - array[0..ZRows-1,0..ZColumns-1] - ZRows - number of rows in matrix Z. If FromTheRight=False, - ZRows=M, otherwise ZRows can be arbitrary. - ZColumns - number of columns in matrix Z. If FromTheRight=True, - ZColumns=M, otherwise ZColumns can be arbitrary. - FromTheRight - pre- or post-multiply. - DoTranspose - multiply by Q or Q'. - -Output parameters: - Z - product of Z and Q. - Array[0..ZRows-1,0..ZColumns-1] - If ZRows=0 or ZColumns=0, the array is not modified. - - -- ALGLIB -- - 2005-2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixbdmultiplybyq(const real_2d_array &qp, const ae_int_t m, const ae_int_t n, const real_1d_array &tauq, real_2d_array &z, const ae_int_t zrows, const ae_int_t zcolumns, const bool fromtheright, const bool dotranspose) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixbdmultiplybyq(const_cast(qp.c_ptr()), m, n, const_cast(tauq.c_ptr()), const_cast(z.c_ptr()), zrows, zcolumns, fromtheright, dotranspose, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Unpacking matrix P which reduces matrix A to bidiagonal form. -The subroutine returns transposed matrix P. - -Input parameters: - QP - matrices Q and P in compact form. - Output of ToBidiagonal subroutine. - M - number of rows in matrix A. - N - number of columns in matrix A. - TAUP - scalar factors which are used to form P. - Output of ToBidiagonal subroutine. - PTRows - required number of rows of matrix P^T. N >= PTRows >= 0. - -Output parameters: - PT - first PTRows columns of matrix P^T - Array[0..PTRows-1, 0..N-1] - If PTRows=0, the array is not modified. - - -- ALGLIB -- - 2005-2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixbdunpackpt(const real_2d_array &qp, const ae_int_t m, const ae_int_t n, const real_1d_array &taup, const ae_int_t ptrows, real_2d_array &pt) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixbdunpackpt(const_cast(qp.c_ptr()), m, n, const_cast(taup.c_ptr()), ptrows, const_cast(pt.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Multiplication by matrix P which reduces matrix A to bidiagonal form. - -The algorithm allows pre- or post-multiply by P or P'. - -Input parameters: - QP - matrices Q and P in compact form. - Output of RMatrixBD subroutine. - M - number of rows in matrix A. - N - number of columns in matrix A. - TAUP - scalar factors which are used to form P. - Output of RMatrixBD subroutine. - Z - multiplied matrix. - Array whose indexes range within [0..ZRows-1,0..ZColumns-1]. - ZRows - number of rows in matrix Z. If FromTheRight=False, - ZRows=N, otherwise ZRows can be arbitrary. - ZColumns - number of columns in matrix Z. If FromTheRight=True, - ZColumns=N, otherwise ZColumns can be arbitrary. - FromTheRight - pre- or post-multiply. - DoTranspose - multiply by P or P'. - -Output parameters: - Z - product of Z and P. - Array whose indexes range within [0..ZRows-1,0..ZColumns-1]. - If ZRows=0 or ZColumns=0, the array is not modified. - - -- ALGLIB -- - 2005-2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixbdmultiplybyp(const real_2d_array &qp, const ae_int_t m, const ae_int_t n, const real_1d_array &taup, real_2d_array &z, const ae_int_t zrows, const ae_int_t zcolumns, const bool fromtheright, const bool dotranspose) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixbdmultiplybyp(const_cast(qp.c_ptr()), m, n, const_cast(taup.c_ptr()), const_cast(z.c_ptr()), zrows, zcolumns, fromtheright, dotranspose, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Unpacking of the main and secondary diagonals of bidiagonal decomposition -of matrix A. - -Input parameters: - B - output of RMatrixBD subroutine. - M - number of rows in matrix B. - N - number of columns in matrix B. - -Output parameters: - IsUpper - True, if the matrix is upper bidiagonal. - otherwise IsUpper is False. - D - the main diagonal. - Array whose index ranges within [0..Min(M,N)-1]. - E - the secondary diagonal (upper or lower, depending on - the value of IsUpper). - Array index ranges within [0..Min(M,N)-1], the last - element is not used. - - -- ALGLIB -- - 2005-2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixbdunpackdiagonals(const real_2d_array &b, const ae_int_t m, const ae_int_t n, bool &isupper, real_1d_array &d, real_1d_array &e) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixbdunpackdiagonals(const_cast(b.c_ptr()), m, n, &isupper, const_cast(d.c_ptr()), const_cast(e.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Reduction of a square matrix to upper Hessenberg form: Q'*A*Q = H, -where Q is an orthogonal matrix, H - Hessenberg matrix. - -Input parameters: - A - matrix A with elements [0..N-1, 0..N-1] - N - size of matrix A. - -Output parameters: - A - matrices Q and P in compact form (see below). - Tau - array of scalar factors which are used to form matrix Q. - Array whose index ranges within [0..N-2] - -Matrix H is located on the main diagonal, on the lower secondary diagonal -and above the main diagonal of matrix A. The elements which are used to -form matrix Q are situated in array Tau and below the lower secondary -diagonal of matrix A as follows: - -Matrix Q is represented as a product of elementary reflections - -Q = H(0)*H(2)*...*H(n-2), - -where each H(i) is given by - -H(i) = 1 - tau * v * (v^T) - -where tau is a scalar stored in Tau[I]; v - is a real vector, -so that v(0:i) = 0, v(i+1) = 1, v(i+2:n-1) stored in A(i+2:n-1,i). - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - October 31, 1992 -*************************************************************************/ -void rmatrixhessenberg(real_2d_array &a, const ae_int_t n, real_1d_array &tau) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixhessenberg(const_cast(a.c_ptr()), n, const_cast(tau.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Unpacking matrix Q which reduces matrix A to upper Hessenberg form - -Input parameters: - A - output of RMatrixHessenberg subroutine. - N - size of matrix A. - Tau - scalar factors which are used to form Q. - Output of RMatrixHessenberg subroutine. - -Output parameters: - Q - matrix Q. - Array whose indexes range within [0..N-1, 0..N-1]. - - -- ALGLIB -- - 2005-2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixhessenbergunpackq(const real_2d_array &a, const ae_int_t n, const real_1d_array &tau, real_2d_array &q) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixhessenbergunpackq(const_cast(a.c_ptr()), n, const_cast(tau.c_ptr()), const_cast(q.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Unpacking matrix H (the result of matrix A reduction to upper Hessenberg form) - -Input parameters: - A - output of RMatrixHessenberg subroutine. - N - size of matrix A. - -Output parameters: - H - matrix H. Array whose indexes range within [0..N-1, 0..N-1]. - - -- ALGLIB -- - 2005-2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixhessenbergunpackh(const real_2d_array &a, const ae_int_t n, real_2d_array &h) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixhessenbergunpackh(const_cast(a.c_ptr()), n, const_cast(h.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Reduction of a symmetric matrix which is given by its higher or lower -triangular part to a tridiagonal matrix using orthogonal similarity -transformation: Q'*A*Q=T. - -Input parameters: - A - matrix to be transformed - array with elements [0..N-1, 0..N-1]. - N - size of matrix A. - IsUpper - storage format. If IsUpper = True, then matrix A is given - by its upper triangle, and the lower triangle is not used - and not modified by the algorithm, and vice versa - if IsUpper = False. - -Output parameters: - A - matrices T and Q in compact form (see lower) - Tau - array of factors which are forming matrices H(i) - array with elements [0..N-2]. - D - main diagonal of symmetric matrix T. - array with elements [0..N-1]. - E - secondary diagonal of symmetric matrix T. - array with elements [0..N-2]. - - - If IsUpper=True, the matrix Q is represented as a product of elementary - reflectors - - Q = H(n-2) . . . H(2) H(0). - - Each H(i) has the form - - H(i) = I - tau * v * v' - - where tau is a real scalar, and v is a real vector with - v(i+1:n-1) = 0, v(i) = 1, v(0:i-1) is stored on exit in - A(0:i-1,i+1), and tau in TAU(i). - - If IsUpper=False, the matrix Q is represented as a product of elementary - reflectors - - Q = H(0) H(2) . . . H(n-2). - - Each H(i) has the form - - H(i) = I - tau * v * v' - - where tau is a real scalar, and v is a real vector with - v(0:i) = 0, v(i+1) = 1, v(i+2:n-1) is stored on exit in A(i+2:n-1,i), - and tau in TAU(i). - - The contents of A on exit are illustrated by the following examples - with n = 5: - - if UPLO = 'U': if UPLO = 'L': - - ( d e v1 v2 v3 ) ( d ) - ( d e v2 v3 ) ( e d ) - ( d e v3 ) ( v0 e d ) - ( d e ) ( v0 v1 e d ) - ( d ) ( v0 v1 v2 e d ) - - where d and e denote diagonal and off-diagonal elements of T, and vi - denotes an element of the vector defining H(i). - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - October 31, 1992 -*************************************************************************/ -void smatrixtd(real_2d_array &a, const ae_int_t n, const bool isupper, real_1d_array &tau, real_1d_array &d, real_1d_array &e) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::smatrixtd(const_cast(a.c_ptr()), n, isupper, const_cast(tau.c_ptr()), const_cast(d.c_ptr()), const_cast(e.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Unpacking matrix Q which reduces symmetric matrix to a tridiagonal -form. - -Input parameters: - A - the result of a SMatrixTD subroutine - N - size of matrix A. - IsUpper - storage format (a parameter of SMatrixTD subroutine) - Tau - the result of a SMatrixTD subroutine - -Output parameters: - Q - transformation matrix. - array with elements [0..N-1, 0..N-1]. - - -- ALGLIB -- - Copyright 2005-2010 by Bochkanov Sergey -*************************************************************************/ -void smatrixtdunpackq(const real_2d_array &a, const ae_int_t n, const bool isupper, const real_1d_array &tau, real_2d_array &q) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::smatrixtdunpackq(const_cast(a.c_ptr()), n, isupper, const_cast(tau.c_ptr()), const_cast(q.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Reduction of a Hermitian matrix which is given by its higher or lower -triangular part to a real tridiagonal matrix using unitary similarity -transformation: Q'*A*Q = T. - -Input parameters: - A - matrix to be transformed - array with elements [0..N-1, 0..N-1]. - N - size of matrix A. - IsUpper - storage format. If IsUpper = True, then matrix A is given - by its upper triangle, and the lower triangle is not used - and not modified by the algorithm, and vice versa - if IsUpper = False. - -Output parameters: - A - matrices T and Q in compact form (see lower) - Tau - array of factors which are forming matrices H(i) - array with elements [0..N-2]. - D - main diagonal of real symmetric matrix T. - array with elements [0..N-1]. - E - secondary diagonal of real symmetric matrix T. - array with elements [0..N-2]. - - - If IsUpper=True, the matrix Q is represented as a product of elementary - reflectors - - Q = H(n-2) . . . H(2) H(0). - - Each H(i) has the form - - H(i) = I - tau * v * v' - - where tau is a complex scalar, and v is a complex vector with - v(i+1:n-1) = 0, v(i) = 1, v(0:i-1) is stored on exit in - A(0:i-1,i+1), and tau in TAU(i). - - If IsUpper=False, the matrix Q is represented as a product of elementary - reflectors - - Q = H(0) H(2) . . . H(n-2). - - Each H(i) has the form - - H(i) = I - tau * v * v' - - where tau is a complex scalar, and v is a complex vector with - v(0:i) = 0, v(i+1) = 1, v(i+2:n-1) is stored on exit in A(i+2:n-1,i), - and tau in TAU(i). - - The contents of A on exit are illustrated by the following examples - with n = 5: - - if UPLO = 'U': if UPLO = 'L': - - ( d e v1 v2 v3 ) ( d ) - ( d e v2 v3 ) ( e d ) - ( d e v3 ) ( v0 e d ) - ( d e ) ( v0 v1 e d ) - ( d ) ( v0 v1 v2 e d ) - -where d and e denote diagonal and off-diagonal elements of T, and vi -denotes an element of the vector defining H(i). - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - October 31, 1992 -*************************************************************************/ -void hmatrixtd(complex_2d_array &a, const ae_int_t n, const bool isupper, complex_1d_array &tau, real_1d_array &d, real_1d_array &e) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::hmatrixtd(const_cast(a.c_ptr()), n, isupper, const_cast(tau.c_ptr()), const_cast(d.c_ptr()), const_cast(e.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Unpacking matrix Q which reduces a Hermitian matrix to a real tridiagonal -form. - -Input parameters: - A - the result of a HMatrixTD subroutine - N - size of matrix A. - IsUpper - storage format (a parameter of HMatrixTD subroutine) - Tau - the result of a HMatrixTD subroutine - -Output parameters: - Q - transformation matrix. - array with elements [0..N-1, 0..N-1]. - - -- ALGLIB -- - Copyright 2005-2010 by Bochkanov Sergey -*************************************************************************/ -void hmatrixtdunpackq(const complex_2d_array &a, const ae_int_t n, const bool isupper, const complex_1d_array &tau, complex_2d_array &q) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::hmatrixtdunpackq(const_cast(a.c_ptr()), n, isupper, const_cast(tau.c_ptr()), const_cast(q.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Singular value decomposition of a bidiagonal matrix (extended algorithm) - -The algorithm performs the singular value decomposition of a bidiagonal -matrix B (upper or lower) representing it as B = Q*S*P^T, where Q and P - -orthogonal matrices, S - diagonal matrix with non-negative elements on the -main diagonal, in descending order. - -The algorithm finds singular values. In addition, the algorithm can -calculate matrices Q and P (more precisely, not the matrices, but their -product with given matrices U and VT - U*Q and (P^T)*VT)). Of course, -matrices U and VT can be of any type, including identity. Furthermore, the -algorithm can calculate Q'*C (this product is calculated more effectively -than U*Q, because this calculation operates with rows instead of matrix -columns). - -The feature of the algorithm is its ability to find all singular values -including those which are arbitrarily close to 0 with relative accuracy -close to machine precision. If the parameter IsFractionalAccuracyRequired -is set to True, all singular values will have high relative accuracy close -to machine precision. If the parameter is set to False, only the biggest -singular value will have relative accuracy close to machine precision. -The absolute error of other singular values is equal to the absolute error -of the biggest singular value. - -Input parameters: - D - main diagonal of matrix B. - Array whose index ranges within [0..N-1]. - E - superdiagonal (or subdiagonal) of matrix B. - Array whose index ranges within [0..N-2]. - N - size of matrix B. - IsUpper - True, if the matrix is upper bidiagonal. - IsFractionalAccuracyRequired - - THIS PARAMETER IS IGNORED SINCE ALGLIB 3.5.0 - SINGULAR VALUES ARE ALWAYS SEARCHED WITH HIGH ACCURACY. - U - matrix to be multiplied by Q. - Array whose indexes range within [0..NRU-1, 0..N-1]. - The matrix can be bigger, in that case only the submatrix - [0..NRU-1, 0..N-1] will be multiplied by Q. - NRU - number of rows in matrix U. - C - matrix to be multiplied by Q'. - Array whose indexes range within [0..N-1, 0..NCC-1]. - The matrix can be bigger, in that case only the submatrix - [0..N-1, 0..NCC-1] will be multiplied by Q'. - NCC - number of columns in matrix C. - VT - matrix to be multiplied by P^T. - Array whose indexes range within [0..N-1, 0..NCVT-1]. - The matrix can be bigger, in that case only the submatrix - [0..N-1, 0..NCVT-1] will be multiplied by P^T. - NCVT - number of columns in matrix VT. - -Output parameters: - D - singular values of matrix B in descending order. - U - if NRU>0, contains matrix U*Q. - VT - if NCVT>0, contains matrix (P^T)*VT. - C - if NCC>0, contains matrix Q'*C. - -Result: - True, if the algorithm has converged. - False, if the algorithm hasn't converged (rare case). - -Additional information: - The type of convergence is controlled by the internal parameter TOL. - If the parameter is greater than 0, the singular values will have - relative accuracy TOL. If TOL<0, the singular values will have - absolute accuracy ABS(TOL)*norm(B). - By default, |TOL| falls within the range of 10*Epsilon and 100*Epsilon, - where Epsilon is the machine precision. It is not recommended to use - TOL less than 10*Epsilon since this will considerably slow down the - algorithm and may not lead to error decreasing. -History: - * 31 March, 2007. - changed MAXITR from 6 to 12. - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - October 31, 1999. -*************************************************************************/ -bool rmatrixbdsvd(real_1d_array &d, const real_1d_array &e, const ae_int_t n, const bool isupper, const bool isfractionalaccuracyrequired, real_2d_array &u, const ae_int_t nru, real_2d_array &c, const ae_int_t ncc, real_2d_array &vt, const ae_int_t ncvt) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::rmatrixbdsvd(const_cast(d.c_ptr()), const_cast(e.c_ptr()), n, isupper, isfractionalaccuracyrequired, const_cast(u.c_ptr()), nru, const_cast(c.c_ptr()), ncc, const_cast(vt.c_ptr()), ncvt, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Singular value decomposition of a rectangular matrix. - -The algorithm calculates the singular value decomposition of a matrix of -size MxN: A = U * S * V^T - -The algorithm finds the singular values and, optionally, matrices U and V^T. -The algorithm can find both first min(M,N) columns of matrix U and rows of -matrix V^T (singular vectors), and matrices U and V^T wholly (of sizes MxM -and NxN respectively). - -Take into account that the subroutine does not return matrix V but V^T. - -Input parameters: - A - matrix to be decomposed. - Array whose indexes range within [0..M-1, 0..N-1]. - M - number of rows in matrix A. - N - number of columns in matrix A. - UNeeded - 0, 1 or 2. See the description of the parameter U. - VTNeeded - 0, 1 or 2. See the description of the parameter VT. - AdditionalMemory - - If the parameter: - * equals 0, the algorithm doesn’t use additional - memory (lower requirements, lower performance). - * equals 1, the algorithm uses additional - memory of size min(M,N)*min(M,N) of real numbers. - It often speeds up the algorithm. - * equals 2, the algorithm uses additional - memory of size M*min(M,N) of real numbers. - It allows to get a maximum performance. - The recommended value of the parameter is 2. - -Output parameters: - W - contains singular values in descending order. - U - if UNeeded=0, U isn't changed, the left singular vectors - are not calculated. - if Uneeded=1, U contains left singular vectors (first - min(M,N) columns of matrix U). Array whose indexes range - within [0..M-1, 0..Min(M,N)-1]. - if UNeeded=2, U contains matrix U wholly. Array whose - indexes range within [0..M-1, 0..M-1]. - VT - if VTNeeded=0, VT isn’t changed, the right singular vectors - are not calculated. - if VTNeeded=1, VT contains right singular vectors (first - min(M,N) rows of matrix V^T). Array whose indexes range - within [0..min(M,N)-1, 0..N-1]. - if VTNeeded=2, VT contains matrix V^T wholly. Array whose - indexes range within [0..N-1, 0..N-1]. - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -bool rmatrixsvd(const real_2d_array &a, const ae_int_t m, const ae_int_t n, const ae_int_t uneeded, const ae_int_t vtneeded, const ae_int_t additionalmemory, real_1d_array &w, real_2d_array &u, real_2d_array &vt) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::rmatrixsvd(const_cast(a.c_ptr()), m, n, uneeded, vtneeded, additionalmemory, const_cast(w.c_ptr()), const_cast(u.c_ptr()), const_cast(vt.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Finding the eigenvalues and eigenvectors of a symmetric matrix - -The algorithm finds eigen pairs of a symmetric matrix by reducing it to -tridiagonal form and using the QL/QR algorithm. - -Input parameters: - A - symmetric matrix which is given by its upper or lower - triangular part. - Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - ZNeeded - flag controlling whether the eigenvectors are needed or not. - If ZNeeded is equal to: - * 0, the eigenvectors are not returned; - * 1, the eigenvectors are returned. - IsUpper - storage format. - -Output parameters: - D - eigenvalues in ascending order. - Array whose index ranges within [0..N-1]. - Z - if ZNeeded is equal to: - * 0, Z hasn’t changed; - * 1, Z contains the eigenvectors. - Array whose indexes range within [0..N-1, 0..N-1]. - The eigenvectors are stored in the matrix columns. - -Result: - True, if the algorithm has converged. - False, if the algorithm hasn't converged (rare case). - - -- ALGLIB -- - Copyright 2005-2008 by Bochkanov Sergey -*************************************************************************/ -bool smatrixevd(const real_2d_array &a, const ae_int_t n, const ae_int_t zneeded, const bool isupper, real_1d_array &d, real_2d_array &z) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::smatrixevd(const_cast(a.c_ptr()), n, zneeded, isupper, const_cast(d.c_ptr()), const_cast(z.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Subroutine for finding the eigenvalues (and eigenvectors) of a symmetric -matrix in a given half open interval (A, B] by using a bisection and -inverse iteration - -Input parameters: - A - symmetric matrix which is given by its upper or lower - triangular part. Array [0..N-1, 0..N-1]. - N - size of matrix A. - ZNeeded - flag controlling whether the eigenvectors are needed or not. - If ZNeeded is equal to: - * 0, the eigenvectors are not returned; - * 1, the eigenvectors are returned. - IsUpperA - storage format of matrix A. - B1, B2 - half open interval (B1, B2] to search eigenvalues in. - -Output parameters: - M - number of eigenvalues found in a given half-interval (M>=0). - W - array of the eigenvalues found. - Array whose index ranges within [0..M-1]. - Z - if ZNeeded is equal to: - * 0, Z hasn’t changed; - * 1, Z contains eigenvectors. - Array whose indexes range within [0..N-1, 0..M-1]. - The eigenvectors are stored in the matrix columns. - -Result: - True, if successful. M contains the number of eigenvalues in the given - half-interval (could be equal to 0), W contains the eigenvalues, - Z contains the eigenvectors (if needed). - - False, if the bisection method subroutine wasn't able to find the - eigenvalues in the given interval or if the inverse iteration subroutine - wasn't able to find all the corresponding eigenvectors. - In that case, the eigenvalues and eigenvectors are not returned, - M is equal to 0. - - -- ALGLIB -- - Copyright 07.01.2006 by Bochkanov Sergey -*************************************************************************/ -bool smatrixevdr(const real_2d_array &a, const ae_int_t n, const ae_int_t zneeded, const bool isupper, const double b1, const double b2, ae_int_t &m, real_1d_array &w, real_2d_array &z) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::smatrixevdr(const_cast(a.c_ptr()), n, zneeded, isupper, b1, b2, &m, const_cast(w.c_ptr()), const_cast(z.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Subroutine for finding the eigenvalues and eigenvectors of a symmetric -matrix with given indexes by using bisection and inverse iteration methods. - -Input parameters: - A - symmetric matrix which is given by its upper or lower - triangular part. Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - ZNeeded - flag controlling whether the eigenvectors are needed or not. - If ZNeeded is equal to: - * 0, the eigenvectors are not returned; - * 1, the eigenvectors are returned. - IsUpperA - storage format of matrix A. - I1, I2 - index interval for searching (from I1 to I2). - 0 <= I1 <= I2 <= N-1. - -Output parameters: - W - array of the eigenvalues found. - Array whose index ranges within [0..I2-I1]. - Z - if ZNeeded is equal to: - * 0, Z hasn’t changed; - * 1, Z contains eigenvectors. - Array whose indexes range within [0..N-1, 0..I2-I1]. - In that case, the eigenvectors are stored in the matrix columns. - -Result: - True, if successful. W contains the eigenvalues, Z contains the - eigenvectors (if needed). - - False, if the bisection method subroutine wasn't able to find the - eigenvalues in the given interval or if the inverse iteration subroutine - wasn't able to find all the corresponding eigenvectors. - In that case, the eigenvalues and eigenvectors are not returned. - - -- ALGLIB -- - Copyright 07.01.2006 by Bochkanov Sergey -*************************************************************************/ -bool smatrixevdi(const real_2d_array &a, const ae_int_t n, const ae_int_t zneeded, const bool isupper, const ae_int_t i1, const ae_int_t i2, real_1d_array &w, real_2d_array &z) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::smatrixevdi(const_cast(a.c_ptr()), n, zneeded, isupper, i1, i2, const_cast(w.c_ptr()), const_cast(z.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Finding the eigenvalues and eigenvectors of a Hermitian matrix - -The algorithm finds eigen pairs of a Hermitian matrix by reducing it to -real tridiagonal form and using the QL/QR algorithm. - -Input parameters: - A - Hermitian matrix which is given by its upper or lower - triangular part. - Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - IsUpper - storage format. - ZNeeded - flag controlling whether the eigenvectors are needed or - not. If ZNeeded is equal to: - * 0, the eigenvectors are not returned; - * 1, the eigenvectors are returned. - -Output parameters: - D - eigenvalues in ascending order. - Array whose index ranges within [0..N-1]. - Z - if ZNeeded is equal to: - * 0, Z hasn’t changed; - * 1, Z contains the eigenvectors. - Array whose indexes range within [0..N-1, 0..N-1]. - The eigenvectors are stored in the matrix columns. - -Result: - True, if the algorithm has converged. - False, if the algorithm hasn't converged (rare case). - -Note: - eigenvectors of Hermitian matrix are defined up to multiplication by - a complex number L, such that |L|=1. - - -- ALGLIB -- - Copyright 2005, 23 March 2007 by Bochkanov Sergey -*************************************************************************/ -bool hmatrixevd(const complex_2d_array &a, const ae_int_t n, const ae_int_t zneeded, const bool isupper, real_1d_array &d, complex_2d_array &z) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::hmatrixevd(const_cast(a.c_ptr()), n, zneeded, isupper, const_cast(d.c_ptr()), const_cast(z.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Subroutine for finding the eigenvalues (and eigenvectors) of a Hermitian -matrix in a given half-interval (A, B] by using a bisection and inverse -iteration - -Input parameters: - A - Hermitian matrix which is given by its upper or lower - triangular part. Array whose indexes range within - [0..N-1, 0..N-1]. - N - size of matrix A. - ZNeeded - flag controlling whether the eigenvectors are needed or - not. If ZNeeded is equal to: - * 0, the eigenvectors are not returned; - * 1, the eigenvectors are returned. - IsUpperA - storage format of matrix A. - B1, B2 - half-interval (B1, B2] to search eigenvalues in. - -Output parameters: - M - number of eigenvalues found in a given half-interval, M>=0 - W - array of the eigenvalues found. - Array whose index ranges within [0..M-1]. - Z - if ZNeeded is equal to: - * 0, Z hasn’t changed; - * 1, Z contains eigenvectors. - Array whose indexes range within [0..N-1, 0..M-1]. - The eigenvectors are stored in the matrix columns. - -Result: - True, if successful. M contains the number of eigenvalues in the given - half-interval (could be equal to 0), W contains the eigenvalues, - Z contains the eigenvectors (if needed). - - False, if the bisection method subroutine wasn't able to find the - eigenvalues in the given interval or if the inverse iteration - subroutine wasn't able to find all the corresponding eigenvectors. - In that case, the eigenvalues and eigenvectors are not returned, M is - equal to 0. - -Note: - eigen vectors of Hermitian matrix are defined up to multiplication by - a complex number L, such as |L|=1. - - -- ALGLIB -- - Copyright 07.01.2006, 24.03.2007 by Bochkanov Sergey. -*************************************************************************/ -bool hmatrixevdr(const complex_2d_array &a, const ae_int_t n, const ae_int_t zneeded, const bool isupper, const double b1, const double b2, ae_int_t &m, real_1d_array &w, complex_2d_array &z) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::hmatrixevdr(const_cast(a.c_ptr()), n, zneeded, isupper, b1, b2, &m, const_cast(w.c_ptr()), const_cast(z.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Subroutine for finding the eigenvalues and eigenvectors of a Hermitian -matrix with given indexes by using bisection and inverse iteration methods - -Input parameters: - A - Hermitian matrix which is given by its upper or lower - triangular part. - Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - ZNeeded - flag controlling whether the eigenvectors are needed or - not. If ZNeeded is equal to: - * 0, the eigenvectors are not returned; - * 1, the eigenvectors are returned. - IsUpperA - storage format of matrix A. - I1, I2 - index interval for searching (from I1 to I2). - 0 <= I1 <= I2 <= N-1. - -Output parameters: - W - array of the eigenvalues found. - Array whose index ranges within [0..I2-I1]. - Z - if ZNeeded is equal to: - * 0, Z hasn’t changed; - * 1, Z contains eigenvectors. - Array whose indexes range within [0..N-1, 0..I2-I1]. - In that case, the eigenvectors are stored in the matrix - columns. - -Result: - True, if successful. W contains the eigenvalues, Z contains the - eigenvectors (if needed). - - False, if the bisection method subroutine wasn't able to find the - eigenvalues in the given interval or if the inverse iteration - subroutine wasn't able to find all the corresponding eigenvectors. - In that case, the eigenvalues and eigenvectors are not returned. - -Note: - eigen vectors of Hermitian matrix are defined up to multiplication by - a complex number L, such as |L|=1. - - -- ALGLIB -- - Copyright 07.01.2006, 24.03.2007 by Bochkanov Sergey. -*************************************************************************/ -bool hmatrixevdi(const complex_2d_array &a, const ae_int_t n, const ae_int_t zneeded, const bool isupper, const ae_int_t i1, const ae_int_t i2, real_1d_array &w, complex_2d_array &z) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::hmatrixevdi(const_cast(a.c_ptr()), n, zneeded, isupper, i1, i2, const_cast(w.c_ptr()), const_cast(z.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Finding the eigenvalues and eigenvectors of a tridiagonal symmetric matrix - -The algorithm finds the eigen pairs of a tridiagonal symmetric matrix by -using an QL/QR algorithm with implicit shifts. - -Input parameters: - D - the main diagonal of a tridiagonal matrix. - Array whose index ranges within [0..N-1]. - E - the secondary diagonal of a tridiagonal matrix. - Array whose index ranges within [0..N-2]. - N - size of matrix A. - ZNeeded - flag controlling whether the eigenvectors are needed or not. - If ZNeeded is equal to: - * 0, the eigenvectors are not needed; - * 1, the eigenvectors of a tridiagonal matrix - are multiplied by the square matrix Z. It is used if the - tridiagonal matrix is obtained by the similarity - transformation of a symmetric matrix; - * 2, the eigenvectors of a tridiagonal matrix replace the - square matrix Z; - * 3, matrix Z contains the first row of the eigenvectors - matrix. - Z - if ZNeeded=1, Z contains the square matrix by which the - eigenvectors are multiplied. - Array whose indexes range within [0..N-1, 0..N-1]. - -Output parameters: - D - eigenvalues in ascending order. - Array whose index ranges within [0..N-1]. - Z - if ZNeeded is equal to: - * 0, Z hasn’t changed; - * 1, Z contains the product of a given matrix (from the left) - and the eigenvectors matrix (from the right); - * 2, Z contains the eigenvectors. - * 3, Z contains the first row of the eigenvectors matrix. - If ZNeeded<3, Z is the array whose indexes range within [0..N-1, 0..N-1]. - In that case, the eigenvectors are stored in the matrix columns. - If ZNeeded=3, Z is the array whose indexes range within [0..0, 0..N-1]. - -Result: - True, if the algorithm has converged. - False, if the algorithm hasn't converged. - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - September 30, 1994 -*************************************************************************/ -bool smatrixtdevd(real_1d_array &d, const real_1d_array &e, const ae_int_t n, const ae_int_t zneeded, real_2d_array &z) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::smatrixtdevd(const_cast(d.c_ptr()), const_cast(e.c_ptr()), n, zneeded, const_cast(z.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Subroutine for finding the tridiagonal matrix eigenvalues/vectors in a -given half-interval (A, B] by using bisection and inverse iteration. - -Input parameters: - D - the main diagonal of a tridiagonal matrix. - Array whose index ranges within [0..N-1]. - E - the secondary diagonal of a tridiagonal matrix. - Array whose index ranges within [0..N-2]. - N - size of matrix, N>=0. - ZNeeded - flag controlling whether the eigenvectors are needed or not. - If ZNeeded is equal to: - * 0, the eigenvectors are not needed; - * 1, the eigenvectors of a tridiagonal matrix are multiplied - by the square matrix Z. It is used if the tridiagonal - matrix is obtained by the similarity transformation - of a symmetric matrix. - * 2, the eigenvectors of a tridiagonal matrix replace matrix Z. - A, B - half-interval (A, B] to search eigenvalues in. - Z - if ZNeeded is equal to: - * 0, Z isn't used and remains unchanged; - * 1, Z contains the square matrix (array whose indexes range - within [0..N-1, 0..N-1]) which reduces the given symmetric - matrix to tridiagonal form; - * 2, Z isn't used (but changed on the exit). - -Output parameters: - D - array of the eigenvalues found. - Array whose index ranges within [0..M-1]. - M - number of eigenvalues found in the given half-interval (M>=0). - Z - if ZNeeded is equal to: - * 0, doesn't contain any information; - * 1, contains the product of a given NxN matrix Z (from the - left) and NxM matrix of the eigenvectors found (from the - right). Array whose indexes range within [0..N-1, 0..M-1]. - * 2, contains the matrix of the eigenvectors found. - Array whose indexes range within [0..N-1, 0..M-1]. - -Result: - - True, if successful. In that case, M contains the number of eigenvalues - in the given half-interval (could be equal to 0), D contains the eigenvalues, - Z contains the eigenvectors (if needed). - It should be noted that the subroutine changes the size of arrays D and Z. - - False, if the bisection method subroutine wasn't able to find the - eigenvalues in the given interval or if the inverse iteration subroutine - wasn't able to find all the corresponding eigenvectors. In that case, - the eigenvalues and eigenvectors are not returned, M is equal to 0. - - -- ALGLIB -- - Copyright 31.03.2008 by Bochkanov Sergey -*************************************************************************/ -bool smatrixtdevdr(real_1d_array &d, const real_1d_array &e, const ae_int_t n, const ae_int_t zneeded, const double a, const double b, ae_int_t &m, real_2d_array &z) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::smatrixtdevdr(const_cast(d.c_ptr()), const_cast(e.c_ptr()), n, zneeded, a, b, &m, const_cast(z.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Subroutine for finding tridiagonal matrix eigenvalues/vectors with given -indexes (in ascending order) by using the bisection and inverse iteraion. - -Input parameters: - D - the main diagonal of a tridiagonal matrix. - Array whose index ranges within [0..N-1]. - E - the secondary diagonal of a tridiagonal matrix. - Array whose index ranges within [0..N-2]. - N - size of matrix. N>=0. - ZNeeded - flag controlling whether the eigenvectors are needed or not. - If ZNeeded is equal to: - * 0, the eigenvectors are not needed; - * 1, the eigenvectors of a tridiagonal matrix are multiplied - by the square matrix Z. It is used if the - tridiagonal matrix is obtained by the similarity transformation - of a symmetric matrix. - * 2, the eigenvectors of a tridiagonal matrix replace - matrix Z. - I1, I2 - index interval for searching (from I1 to I2). - 0 <= I1 <= I2 <= N-1. - Z - if ZNeeded is equal to: - * 0, Z isn't used and remains unchanged; - * 1, Z contains the square matrix (array whose indexes range within [0..N-1, 0..N-1]) - which reduces the given symmetric matrix to tridiagonal form; - * 2, Z isn't used (but changed on the exit). - -Output parameters: - D - array of the eigenvalues found. - Array whose index ranges within [0..I2-I1]. - Z - if ZNeeded is equal to: - * 0, doesn't contain any information; - * 1, contains the product of a given NxN matrix Z (from the left) and - Nx(I2-I1) matrix of the eigenvectors found (from the right). - Array whose indexes range within [0..N-1, 0..I2-I1]. - * 2, contains the matrix of the eigenvalues found. - Array whose indexes range within [0..N-1, 0..I2-I1]. - - -Result: - - True, if successful. In that case, D contains the eigenvalues, - Z contains the eigenvectors (if needed). - It should be noted that the subroutine changes the size of arrays D and Z. - - False, if the bisection method subroutine wasn't able to find the eigenvalues - in the given interval or if the inverse iteration subroutine wasn't able - to find all the corresponding eigenvectors. In that case, the eigenvalues - and eigenvectors are not returned. - - -- ALGLIB -- - Copyright 25.12.2005 by Bochkanov Sergey -*************************************************************************/ -bool smatrixtdevdi(real_1d_array &d, const real_1d_array &e, const ae_int_t n, const ae_int_t zneeded, const ae_int_t i1, const ae_int_t i2, real_2d_array &z) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::smatrixtdevdi(const_cast(d.c_ptr()), const_cast(e.c_ptr()), n, zneeded, i1, i2, const_cast(z.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Finding eigenvalues and eigenvectors of a general matrix - -The algorithm finds eigenvalues and eigenvectors of a general matrix by -using the QR algorithm with multiple shifts. The algorithm can find -eigenvalues and both left and right eigenvectors. - -The right eigenvector is a vector x such that A*x = w*x, and the left -eigenvector is a vector y such that y'*A = w*y' (here y' implies a complex -conjugate transposition of vector y). - -Input parameters: - A - matrix. Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - VNeeded - flag controlling whether eigenvectors are needed or not. - If VNeeded is equal to: - * 0, eigenvectors are not returned; - * 1, right eigenvectors are returned; - * 2, left eigenvectors are returned; - * 3, both left and right eigenvectors are returned. - -Output parameters: - WR - real parts of eigenvalues. - Array whose index ranges within [0..N-1]. - WR - imaginary parts of eigenvalues. - Array whose index ranges within [0..N-1]. - VL, VR - arrays of left and right eigenvectors (if they are needed). - If WI[i]=0, the respective eigenvalue is a real number, - and it corresponds to the column number I of matrices VL/VR. - If WI[i]>0, we have a pair of complex conjugate numbers with - positive and negative imaginary parts: - the first eigenvalue WR[i] + sqrt(-1)*WI[i]; - the second eigenvalue WR[i+1] + sqrt(-1)*WI[i+1]; - WI[i]>0 - WI[i+1] = -WI[i] < 0 - In that case, the eigenvector corresponding to the first - eigenvalue is located in i and i+1 columns of matrices - VL/VR (the column number i contains the real part, and the - column number i+1 contains the imaginary part), and the vector - corresponding to the second eigenvalue is a complex conjugate to - the first vector. - Arrays whose indexes range within [0..N-1, 0..N-1]. - -Result: - True, if the algorithm has converged. - False, if the algorithm has not converged. - -Note 1: - Some users may ask the following question: what if WI[N-1]>0? - WI[N] must contain an eigenvalue which is complex conjugate to the - N-th eigenvalue, but the array has only size N? - The answer is as follows: such a situation cannot occur because the - algorithm finds a pairs of eigenvalues, therefore, if WI[i]>0, I is - strictly less than N-1. - -Note 2: - The algorithm performance depends on the value of the internal parameter - NS of the InternalSchurDecomposition subroutine which defines the number - of shifts in the QR algorithm (similarly to the block width in block-matrix - algorithms of linear algebra). If you require maximum performance - on your machine, it is recommended to adjust this parameter manually. - - -See also the InternalTREVC subroutine. - -The algorithm is based on the LAPACK 3.0 library. -*************************************************************************/ -bool rmatrixevd(const real_2d_array &a, const ae_int_t n, const ae_int_t vneeded, real_1d_array &wr, real_1d_array &wi, real_2d_array &vl, real_2d_array &vr) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::rmatrixevd(const_cast(a.c_ptr()), n, vneeded, const_cast(wr.c_ptr()), const_cast(wi.c_ptr()), const_cast(vl.c_ptr()), const_cast(vr.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Generation of a random uniformly distributed (Haar) orthogonal matrix - -INPUT PARAMETERS: - N - matrix size, N>=1 - -OUTPUT PARAMETERS: - A - orthogonal NxN matrix, array[0..N-1,0..N-1] - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void rmatrixrndorthogonal(const ae_int_t n, real_2d_array &a) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixrndorthogonal(n, const_cast(a.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Generation of random NxN matrix with given condition number and norm2(A)=1 - -INPUT PARAMETERS: - N - matrix size - C - condition number (in 2-norm) - -OUTPUT PARAMETERS: - A - random matrix with norm2(A)=1 and cond(A)=C - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void rmatrixrndcond(const ae_int_t n, const double c, real_2d_array &a) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixrndcond(n, c, const_cast(a.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Generation of a random Haar distributed orthogonal complex matrix - -INPUT PARAMETERS: - N - matrix size, N>=1 - -OUTPUT PARAMETERS: - A - orthogonal NxN matrix, array[0..N-1,0..N-1] - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void cmatrixrndorthogonal(const ae_int_t n, complex_2d_array &a) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::cmatrixrndorthogonal(n, const_cast(a.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Generation of random NxN complex matrix with given condition number C and -norm2(A)=1 - -INPUT PARAMETERS: - N - matrix size - C - condition number (in 2-norm) - -OUTPUT PARAMETERS: - A - random matrix with norm2(A)=1 and cond(A)=C - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void cmatrixrndcond(const ae_int_t n, const double c, complex_2d_array &a) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::cmatrixrndcond(n, c, const_cast(a.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Generation of random NxN symmetric matrix with given condition number and -norm2(A)=1 - -INPUT PARAMETERS: - N - matrix size - C - condition number (in 2-norm) - -OUTPUT PARAMETERS: - A - random matrix with norm2(A)=1 and cond(A)=C - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void smatrixrndcond(const ae_int_t n, const double c, real_2d_array &a) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::smatrixrndcond(n, c, const_cast(a.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Generation of random NxN symmetric positive definite matrix with given -condition number and norm2(A)=1 - -INPUT PARAMETERS: - N - matrix size - C - condition number (in 2-norm) - -OUTPUT PARAMETERS: - A - random SPD matrix with norm2(A)=1 and cond(A)=C - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void spdmatrixrndcond(const ae_int_t n, const double c, real_2d_array &a) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spdmatrixrndcond(n, c, const_cast(a.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Generation of random NxN Hermitian matrix with given condition number and -norm2(A)=1 - -INPUT PARAMETERS: - N - matrix size - C - condition number (in 2-norm) - -OUTPUT PARAMETERS: - A - random matrix with norm2(A)=1 and cond(A)=C - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void hmatrixrndcond(const ae_int_t n, const double c, complex_2d_array &a) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::hmatrixrndcond(n, c, const_cast(a.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Generation of random NxN Hermitian positive definite matrix with given -condition number and norm2(A)=1 - -INPUT PARAMETERS: - N - matrix size - C - condition number (in 2-norm) - -OUTPUT PARAMETERS: - A - random HPD matrix with norm2(A)=1 and cond(A)=C - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void hpdmatrixrndcond(const ae_int_t n, const double c, complex_2d_array &a) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::hpdmatrixrndcond(n, c, const_cast(a.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Multiplication of MxN matrix by NxN random Haar distributed orthogonal matrix - -INPUT PARAMETERS: - A - matrix, array[0..M-1, 0..N-1] - M, N- matrix size - -OUTPUT PARAMETERS: - A - A*Q, where Q is random NxN orthogonal matrix - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void rmatrixrndorthogonalfromtheright(real_2d_array &a, const ae_int_t m, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixrndorthogonalfromtheright(const_cast(a.c_ptr()), m, n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Multiplication of MxN matrix by MxM random Haar distributed orthogonal matrix - -INPUT PARAMETERS: - A - matrix, array[0..M-1, 0..N-1] - M, N- matrix size - -OUTPUT PARAMETERS: - A - Q*A, where Q is random MxM orthogonal matrix - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void rmatrixrndorthogonalfromtheleft(real_2d_array &a, const ae_int_t m, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixrndorthogonalfromtheleft(const_cast(a.c_ptr()), m, n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Multiplication of MxN complex matrix by NxN random Haar distributed -complex orthogonal matrix - -INPUT PARAMETERS: - A - matrix, array[0..M-1, 0..N-1] - M, N- matrix size - -OUTPUT PARAMETERS: - A - A*Q, where Q is random NxN orthogonal matrix - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void cmatrixrndorthogonalfromtheright(complex_2d_array &a, const ae_int_t m, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::cmatrixrndorthogonalfromtheright(const_cast(a.c_ptr()), m, n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Multiplication of MxN complex matrix by MxM random Haar distributed -complex orthogonal matrix - -INPUT PARAMETERS: - A - matrix, array[0..M-1, 0..N-1] - M, N- matrix size - -OUTPUT PARAMETERS: - A - Q*A, where Q is random MxM orthogonal matrix - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void cmatrixrndorthogonalfromtheleft(complex_2d_array &a, const ae_int_t m, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::cmatrixrndorthogonalfromtheleft(const_cast(a.c_ptr()), m, n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Symmetric multiplication of NxN matrix by random Haar distributed -orthogonal matrix - -INPUT PARAMETERS: - A - matrix, array[0..N-1, 0..N-1] - N - matrix size - -OUTPUT PARAMETERS: - A - Q'*A*Q, where Q is random NxN orthogonal matrix - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void smatrixrndmultiply(real_2d_array &a, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::smatrixrndmultiply(const_cast(a.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Hermitian multiplication of NxN matrix by random Haar distributed -complex orthogonal matrix - -INPUT PARAMETERS: - A - matrix, array[0..N-1, 0..N-1] - N - matrix size - -OUTPUT PARAMETERS: - A - Q^H*A*Q, where Q is random NxN orthogonal matrix - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void hmatrixrndmultiply(complex_2d_array &a, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::hmatrixrndmultiply(const_cast(a.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -LU decomposition of a general real matrix with row pivoting - -A is represented as A = P*L*U, where: -* L is lower unitriangular matrix -* U is upper triangular matrix -* P = P0*P1*...*PK, K=min(M,N)-1, - Pi - permutation matrix for I and Pivots[I] - -This is cache-oblivous implementation of LU decomposition. -It is optimized for square matrices. As for rectangular matrices: -* best case - M>>N -* worst case - N>>M, small M, large N, matrix does not fit in CPU cache - -INPUT PARAMETERS: - A - array[0..M-1, 0..N-1]. - M - number of rows in matrix A. - N - number of columns in matrix A. - - -OUTPUT PARAMETERS: - A - matrices L and U in compact form: - * L is stored under main diagonal - * U is stored on and above main diagonal - Pivots - permutation matrix in compact form. - array[0..Min(M-1,N-1)]. - - -- ALGLIB routine -- - 10.01.2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixlu(real_2d_array &a, const ae_int_t m, const ae_int_t n, integer_1d_array &pivots) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixlu(const_cast(a.c_ptr()), m, n, const_cast(pivots.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -LU decomposition of a general complex matrix with row pivoting - -A is represented as A = P*L*U, where: -* L is lower unitriangular matrix -* U is upper triangular matrix -* P = P0*P1*...*PK, K=min(M,N)-1, - Pi - permutation matrix for I and Pivots[I] - -This is cache-oblivous implementation of LU decomposition. It is optimized -for square matrices. As for rectangular matrices: -* best case - M>>N -* worst case - N>>M, small M, large N, matrix does not fit in CPU cache - -INPUT PARAMETERS: - A - array[0..M-1, 0..N-1]. - M - number of rows in matrix A. - N - number of columns in matrix A. - - -OUTPUT PARAMETERS: - A - matrices L and U in compact form: - * L is stored under main diagonal - * U is stored on and above main diagonal - Pivots - permutation matrix in compact form. - array[0..Min(M-1,N-1)]. - - -- ALGLIB routine -- - 10.01.2010 - Bochkanov Sergey -*************************************************************************/ -void cmatrixlu(complex_2d_array &a, const ae_int_t m, const ae_int_t n, integer_1d_array &pivots) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::cmatrixlu(const_cast(a.c_ptr()), m, n, const_cast(pivots.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Cache-oblivious Cholesky decomposition - -The algorithm computes Cholesky decomposition of a Hermitian positive- -definite matrix. The result of an algorithm is a representation of A as -A=U'*U or A=L*L' (here X' detones conj(X^T)). - -INPUT PARAMETERS: - A - upper or lower triangle of a factorized matrix. - array with elements [0..N-1, 0..N-1]. - N - size of matrix A. - IsUpper - if IsUpper=True, then A contains an upper triangle of - a symmetric matrix, otherwise A contains a lower one. - -OUTPUT PARAMETERS: - A - the result of factorization. If IsUpper=True, then - the upper triangle contains matrix U, so that A = U'*U, - and the elements below the main diagonal are not modified. - Similarly, if IsUpper = False. - -RESULT: - If the matrix is positive-definite, the function returns True. - Otherwise, the function returns False. Contents of A is not determined - in such case. - - -- ALGLIB routine -- - 15.12.2009 - Bochkanov Sergey -*************************************************************************/ -bool hpdmatrixcholesky(complex_2d_array &a, const ae_int_t n, const bool isupper) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::hpdmatrixcholesky(const_cast(a.c_ptr()), n, isupper, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Cache-oblivious Cholesky decomposition - -The algorithm computes Cholesky decomposition of a symmetric positive- -definite matrix. The result of an algorithm is a representation of A as -A=U^T*U or A=L*L^T - -INPUT PARAMETERS: - A - upper or lower triangle of a factorized matrix. - array with elements [0..N-1, 0..N-1]. - N - size of matrix A. - IsUpper - if IsUpper=True, then A contains an upper triangle of - a symmetric matrix, otherwise A contains a lower one. - -OUTPUT PARAMETERS: - A - the result of factorization. If IsUpper=True, then - the upper triangle contains matrix U, so that A = U^T*U, - and the elements below the main diagonal are not modified. - Similarly, if IsUpper = False. - -RESULT: - If the matrix is positive-definite, the function returns True. - Otherwise, the function returns False. Contents of A is not determined - in such case. - - -- ALGLIB routine -- - 15.12.2009 - Bochkanov Sergey -*************************************************************************/ -bool spdmatrixcholesky(real_2d_array &a, const ae_int_t n, const bool isupper) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::spdmatrixcholesky(const_cast(a.c_ptr()), n, isupper, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Estimate of a matrix condition number (1-norm) - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - A - matrix. Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double rmatrixrcond1(const real_2d_array &a, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::rmatrixrcond1(const_cast(a.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Estimate of a matrix condition number (infinity-norm). - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - A - matrix. Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double rmatrixrcondinf(const real_2d_array &a, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::rmatrixrcondinf(const_cast(a.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Condition number estimate of a symmetric positive definite matrix. - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -It should be noted that 1-norm and inf-norm of condition numbers of symmetric -matrices are equal, so the algorithm doesn't take into account the -differences between these types of norms. - -Input parameters: - A - symmetric positive definite matrix which is given by its - upper or lower triangle depending on the value of - IsUpper. Array with elements [0..N-1, 0..N-1]. - N - size of matrix A. - IsUpper - storage format. - -Result: - 1/LowerBound(cond(A)), if matrix A is positive definite, - -1, if matrix A is not positive definite, and its condition number - could not be found by this algorithm. - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double spdmatrixrcond(const real_2d_array &a, const ae_int_t n, const bool isupper) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::spdmatrixrcond(const_cast(a.c_ptr()), n, isupper, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Triangular matrix: estimate of a condition number (1-norm) - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - A - matrix. Array[0..N-1, 0..N-1]. - N - size of A. - IsUpper - True, if the matrix is upper triangular. - IsUnit - True, if the matrix has a unit diagonal. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double rmatrixtrrcond1(const real_2d_array &a, const ae_int_t n, const bool isupper, const bool isunit) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::rmatrixtrrcond1(const_cast(a.c_ptr()), n, isupper, isunit, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Triangular matrix: estimate of a matrix condition number (infinity-norm). - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - A - matrix. Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - IsUpper - True, if the matrix is upper triangular. - IsUnit - True, if the matrix has a unit diagonal. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double rmatrixtrrcondinf(const real_2d_array &a, const ae_int_t n, const bool isupper, const bool isunit) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::rmatrixtrrcondinf(const_cast(a.c_ptr()), n, isupper, isunit, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Condition number estimate of a Hermitian positive definite matrix. - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -It should be noted that 1-norm and inf-norm of condition numbers of symmetric -matrices are equal, so the algorithm doesn't take into account the -differences between these types of norms. - -Input parameters: - A - Hermitian positive definite matrix which is given by its - upper or lower triangle depending on the value of - IsUpper. Array with elements [0..N-1, 0..N-1]. - N - size of matrix A. - IsUpper - storage format. - -Result: - 1/LowerBound(cond(A)), if matrix A is positive definite, - -1, if matrix A is not positive definite, and its condition number - could not be found by this algorithm. - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double hpdmatrixrcond(const complex_2d_array &a, const ae_int_t n, const bool isupper) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::hpdmatrixrcond(const_cast(a.c_ptr()), n, isupper, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Estimate of a matrix condition number (1-norm) - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - A - matrix. Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double cmatrixrcond1(const complex_2d_array &a, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::cmatrixrcond1(const_cast(a.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Estimate of a matrix condition number (infinity-norm). - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - A - matrix. Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double cmatrixrcondinf(const complex_2d_array &a, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::cmatrixrcondinf(const_cast(a.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Estimate of the condition number of a matrix given by its LU decomposition (1-norm) - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - LUA - LU decomposition of a matrix in compact form. Output of - the RMatrixLU subroutine. - N - size of matrix A. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double rmatrixlurcond1(const real_2d_array &lua, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::rmatrixlurcond1(const_cast(lua.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Estimate of the condition number of a matrix given by its LU decomposition -(infinity norm). - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - LUA - LU decomposition of a matrix in compact form. Output of - the RMatrixLU subroutine. - N - size of matrix A. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double rmatrixlurcondinf(const real_2d_array &lua, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::rmatrixlurcondinf(const_cast(lua.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Condition number estimate of a symmetric positive definite matrix given by -Cholesky decomposition. - -The algorithm calculates a lower bound of the condition number. In this -case, the algorithm does not return a lower bound of the condition number, -but an inverse number (to avoid an overflow in case of a singular matrix). - -It should be noted that 1-norm and inf-norm condition numbers of symmetric -matrices are equal, so the algorithm doesn't take into account the -differences between these types of norms. - -Input parameters: - CD - Cholesky decomposition of matrix A, - output of SMatrixCholesky subroutine. - N - size of matrix A. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double spdmatrixcholeskyrcond(const real_2d_array &a, const ae_int_t n, const bool isupper) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::spdmatrixcholeskyrcond(const_cast(a.c_ptr()), n, isupper, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Condition number estimate of a Hermitian positive definite matrix given by -Cholesky decomposition. - -The algorithm calculates a lower bound of the condition number. In this -case, the algorithm does not return a lower bound of the condition number, -but an inverse number (to avoid an overflow in case of a singular matrix). - -It should be noted that 1-norm and inf-norm condition numbers of symmetric -matrices are equal, so the algorithm doesn't take into account the -differences between these types of norms. - -Input parameters: - CD - Cholesky decomposition of matrix A, - output of SMatrixCholesky subroutine. - N - size of matrix A. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double hpdmatrixcholeskyrcond(const complex_2d_array &a, const ae_int_t n, const bool isupper) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::hpdmatrixcholeskyrcond(const_cast(a.c_ptr()), n, isupper, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Estimate of the condition number of a matrix given by its LU decomposition (1-norm) - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - LUA - LU decomposition of a matrix in compact form. Output of - the CMatrixLU subroutine. - N - size of matrix A. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double cmatrixlurcond1(const complex_2d_array &lua, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::cmatrixlurcond1(const_cast(lua.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Estimate of the condition number of a matrix given by its LU decomposition -(infinity norm). - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - LUA - LU decomposition of a matrix in compact form. Output of - the CMatrixLU subroutine. - N - size of matrix A. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double cmatrixlurcondinf(const complex_2d_array &lua, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::cmatrixlurcondinf(const_cast(lua.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Triangular matrix: estimate of a condition number (1-norm) - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - A - matrix. Array[0..N-1, 0..N-1]. - N - size of A. - IsUpper - True, if the matrix is upper triangular. - IsUnit - True, if the matrix has a unit diagonal. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double cmatrixtrrcond1(const complex_2d_array &a, const ae_int_t n, const bool isupper, const bool isunit) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::cmatrixtrrcond1(const_cast(a.c_ptr()), n, isupper, isunit, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Triangular matrix: estimate of a matrix condition number (infinity-norm). - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - A - matrix. Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - IsUpper - True, if the matrix is upper triangular. - IsUnit - True, if the matrix has a unit diagonal. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double cmatrixtrrcondinf(const complex_2d_array &a, const ae_int_t n, const bool isupper, const bool isunit) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::cmatrixtrrcondinf(const_cast(a.c_ptr()), n, isupper, isunit, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Matrix inverse report: -* R1 reciprocal of condition number in 1-norm -* RInf reciprocal of condition number in inf-norm -*************************************************************************/ -_matinvreport_owner::_matinvreport_owner() -{ - p_struct = (alglib_impl::matinvreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::matinvreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_matinvreport_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_matinvreport_owner::_matinvreport_owner(const _matinvreport_owner &rhs) -{ - p_struct = (alglib_impl::matinvreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::matinvreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_matinvreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_matinvreport_owner& _matinvreport_owner::operator=(const _matinvreport_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_matinvreport_clear(p_struct); - if( !alglib_impl::_matinvreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_matinvreport_owner::~_matinvreport_owner() -{ - alglib_impl::_matinvreport_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::matinvreport* _matinvreport_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::matinvreport* _matinvreport_owner::c_ptr() const -{ - return const_cast(p_struct); -} -matinvreport::matinvreport() : _matinvreport_owner() ,r1(p_struct->r1),rinf(p_struct->rinf) -{ -} - -matinvreport::matinvreport(const matinvreport &rhs):_matinvreport_owner(rhs) ,r1(p_struct->r1),rinf(p_struct->rinf) -{ -} - -matinvreport& matinvreport::operator=(const matinvreport &rhs) -{ - if( this==&rhs ) - return *this; - _matinvreport_owner::operator=(rhs); - return *this; -} - -matinvreport::~matinvreport() -{ -} - -/************************************************************************* -Inversion of a matrix given by its LU decomposition. - -INPUT PARAMETERS: - A - LU decomposition of the matrix - (output of RMatrixLU subroutine). - Pivots - table of permutations - (the output of RMatrixLU subroutine). - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - -OUTPUT PARAMETERS: - Info - return code: - * -3 A is singular, or VERY close to singular. - it is filled by zeros in such cases. - * 1 task is solved (but matrix A may be ill-conditioned, - check R1/RInf parameters for condition numbers). - Rep - solver report, see below for more info - A - inverse of matrix A. - Array whose indexes range within [0..N-1, 0..N-1]. - -SOLVER REPORT - -Subroutine sets following fields of the Rep structure: -* R1 reciprocal of condition number: 1/cond(A), 1-norm. -* RInf reciprocal of condition number: 1/cond(A), inf-norm. - - -- ALGLIB routine -- - 05.02.2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixluinverse(real_2d_array &a, const integer_1d_array &pivots, const ae_int_t n, ae_int_t &info, matinvreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixluinverse(const_cast(a.c_ptr()), const_cast(pivots.c_ptr()), n, &info, const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Inversion of a matrix given by its LU decomposition. - -INPUT PARAMETERS: - A - LU decomposition of the matrix - (output of RMatrixLU subroutine). - Pivots - table of permutations - (the output of RMatrixLU subroutine). - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - -OUTPUT PARAMETERS: - Info - return code: - * -3 A is singular, or VERY close to singular. - it is filled by zeros in such cases. - * 1 task is solved (but matrix A may be ill-conditioned, - check R1/RInf parameters for condition numbers). - Rep - solver report, see below for more info - A - inverse of matrix A. - Array whose indexes range within [0..N-1, 0..N-1]. - -SOLVER REPORT - -Subroutine sets following fields of the Rep structure: -* R1 reciprocal of condition number: 1/cond(A), 1-norm. -* RInf reciprocal of condition number: 1/cond(A), inf-norm. - - -- ALGLIB routine -- - 05.02.2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixluinverse(real_2d_array &a, const integer_1d_array &pivots, ae_int_t &info, matinvreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - if( (a.cols()!=a.rows()) || (a.cols()!=pivots.length())) - throw ap_error("Error while calling 'rmatrixluinverse': looks like one of arguments has wrong size"); - n = a.cols(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixluinverse(const_cast(a.c_ptr()), const_cast(pivots.c_ptr()), n, &info, const_cast(rep.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Inversion of a general matrix. - -Input parameters: - A - matrix. - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - -Output parameters: - Info - return code, same as in RMatrixLUInverse - Rep - solver report, same as in RMatrixLUInverse - A - inverse of matrix A, same as in RMatrixLUInverse - -Result: - True, if the matrix is not singular. - False, if the matrix is singular. - - -- ALGLIB -- - Copyright 2005-2010 by Bochkanov Sergey -*************************************************************************/ -void rmatrixinverse(real_2d_array &a, const ae_int_t n, ae_int_t &info, matinvreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixinverse(const_cast(a.c_ptr()), n, &info, const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Inversion of a general matrix. - -Input parameters: - A - matrix. - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - -Output parameters: - Info - return code, same as in RMatrixLUInverse - Rep - solver report, same as in RMatrixLUInverse - A - inverse of matrix A, same as in RMatrixLUInverse - -Result: - True, if the matrix is not singular. - False, if the matrix is singular. - - -- ALGLIB -- - Copyright 2005-2010 by Bochkanov Sergey -*************************************************************************/ -void rmatrixinverse(real_2d_array &a, ae_int_t &info, matinvreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - if( (a.cols()!=a.rows())) - throw ap_error("Error while calling 'rmatrixinverse': looks like one of arguments has wrong size"); - n = a.cols(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixinverse(const_cast(a.c_ptr()), n, &info, const_cast(rep.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Inversion of a matrix given by its LU decomposition. - -INPUT PARAMETERS: - A - LU decomposition of the matrix - (output of CMatrixLU subroutine). - Pivots - table of permutations - (the output of CMatrixLU subroutine). - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - -OUTPUT PARAMETERS: - Info - return code, same as in RMatrixLUInverse - Rep - solver report, same as in RMatrixLUInverse - A - inverse of matrix A, same as in RMatrixLUInverse - - -- ALGLIB routine -- - 05.02.2010 - Bochkanov Sergey -*************************************************************************/ -void cmatrixluinverse(complex_2d_array &a, const integer_1d_array &pivots, const ae_int_t n, ae_int_t &info, matinvreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::cmatrixluinverse(const_cast(a.c_ptr()), const_cast(pivots.c_ptr()), n, &info, const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Inversion of a matrix given by its LU decomposition. - -INPUT PARAMETERS: - A - LU decomposition of the matrix - (output of CMatrixLU subroutine). - Pivots - table of permutations - (the output of CMatrixLU subroutine). - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - -OUTPUT PARAMETERS: - Info - return code, same as in RMatrixLUInverse - Rep - solver report, same as in RMatrixLUInverse - A - inverse of matrix A, same as in RMatrixLUInverse - - -- ALGLIB routine -- - 05.02.2010 - Bochkanov Sergey -*************************************************************************/ -void cmatrixluinverse(complex_2d_array &a, const integer_1d_array &pivots, ae_int_t &info, matinvreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - if( (a.cols()!=a.rows()) || (a.cols()!=pivots.length())) - throw ap_error("Error while calling 'cmatrixluinverse': looks like one of arguments has wrong size"); - n = a.cols(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::cmatrixluinverse(const_cast(a.c_ptr()), const_cast(pivots.c_ptr()), n, &info, const_cast(rep.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Inversion of a general matrix. - -Input parameters: - A - matrix - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - -Output parameters: - Info - return code, same as in RMatrixLUInverse - Rep - solver report, same as in RMatrixLUInverse - A - inverse of matrix A, same as in RMatrixLUInverse - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -void cmatrixinverse(complex_2d_array &a, const ae_int_t n, ae_int_t &info, matinvreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::cmatrixinverse(const_cast(a.c_ptr()), n, &info, const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Inversion of a general matrix. - -Input parameters: - A - matrix - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - -Output parameters: - Info - return code, same as in RMatrixLUInverse - Rep - solver report, same as in RMatrixLUInverse - A - inverse of matrix A, same as in RMatrixLUInverse - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -void cmatrixinverse(complex_2d_array &a, ae_int_t &info, matinvreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - if( (a.cols()!=a.rows())) - throw ap_error("Error while calling 'cmatrixinverse': looks like one of arguments has wrong size"); - n = a.cols(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::cmatrixinverse(const_cast(a.c_ptr()), n, &info, const_cast(rep.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Inversion of a symmetric positive definite matrix which is given -by Cholesky decomposition. - -Input parameters: - A - Cholesky decomposition of the matrix to be inverted: - A=U’*U or A = L*L'. - Output of SPDMatrixCholesky subroutine. - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - IsUpper - storage type (optional): - * if True, symmetric matrix A is given by its upper - triangle, and the lower triangle isn’t used/changed by - function - * if False, symmetric matrix A is given by its lower - triangle, and the upper triangle isn’t used/changed by - function - * if not given, lower half is used. - -Output parameters: - Info - return code, same as in RMatrixLUInverse - Rep - solver report, same as in RMatrixLUInverse - A - inverse of matrix A, same as in RMatrixLUInverse - - -- ALGLIB routine -- - 10.02.2010 - Bochkanov Sergey -*************************************************************************/ -void spdmatrixcholeskyinverse(real_2d_array &a, const ae_int_t n, const bool isupper, ae_int_t &info, matinvreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spdmatrixcholeskyinverse(const_cast(a.c_ptr()), n, isupper, &info, const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Inversion of a symmetric positive definite matrix which is given -by Cholesky decomposition. - -Input parameters: - A - Cholesky decomposition of the matrix to be inverted: - A=U’*U or A = L*L'. - Output of SPDMatrixCholesky subroutine. - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - IsUpper - storage type (optional): - * if True, symmetric matrix A is given by its upper - triangle, and the lower triangle isn’t used/changed by - function - * if False, symmetric matrix A is given by its lower - triangle, and the upper triangle isn’t used/changed by - function - * if not given, lower half is used. - -Output parameters: - Info - return code, same as in RMatrixLUInverse - Rep - solver report, same as in RMatrixLUInverse - A - inverse of matrix A, same as in RMatrixLUInverse - - -- ALGLIB routine -- - 10.02.2010 - Bochkanov Sergey -*************************************************************************/ -void spdmatrixcholeskyinverse(real_2d_array &a, ae_int_t &info, matinvreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - bool isupper; - if( (a.cols()!=a.rows())) - throw ap_error("Error while calling 'spdmatrixcholeskyinverse': looks like one of arguments has wrong size"); - n = a.cols(); - isupper = false; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spdmatrixcholeskyinverse(const_cast(a.c_ptr()), n, isupper, &info, const_cast(rep.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Inversion of a symmetric positive definite matrix. - -Given an upper or lower triangle of a symmetric positive definite matrix, -the algorithm generates matrix A^-1 and saves the upper or lower triangle -depending on the input. - -Input parameters: - A - matrix to be inverted (upper or lower triangle). - Array with elements [0..N-1,0..N-1]. - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - IsUpper - storage type (optional): - * if True, symmetric matrix A is given by its upper - triangle, and the lower triangle isn’t used/changed by - function - * if False, symmetric matrix A is given by its lower - triangle, and the upper triangle isn’t used/changed by - function - * if not given, both lower and upper triangles must be - filled. - -Output parameters: - Info - return code, same as in RMatrixLUInverse - Rep - solver report, same as in RMatrixLUInverse - A - inverse of matrix A, same as in RMatrixLUInverse - - -- ALGLIB routine -- - 10.02.2010 - Bochkanov Sergey -*************************************************************************/ -void spdmatrixinverse(real_2d_array &a, const ae_int_t n, const bool isupper, ae_int_t &info, matinvreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spdmatrixinverse(const_cast(a.c_ptr()), n, isupper, &info, const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Inversion of a symmetric positive definite matrix. - -Given an upper or lower triangle of a symmetric positive definite matrix, -the algorithm generates matrix A^-1 and saves the upper or lower triangle -depending on the input. - -Input parameters: - A - matrix to be inverted (upper or lower triangle). - Array with elements [0..N-1,0..N-1]. - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - IsUpper - storage type (optional): - * if True, symmetric matrix A is given by its upper - triangle, and the lower triangle isn’t used/changed by - function - * if False, symmetric matrix A is given by its lower - triangle, and the upper triangle isn’t used/changed by - function - * if not given, both lower and upper triangles must be - filled. - -Output parameters: - Info - return code, same as in RMatrixLUInverse - Rep - solver report, same as in RMatrixLUInverse - A - inverse of matrix A, same as in RMatrixLUInverse - - -- ALGLIB routine -- - 10.02.2010 - Bochkanov Sergey -*************************************************************************/ -void spdmatrixinverse(real_2d_array &a, ae_int_t &info, matinvreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - bool isupper; - if( (a.cols()!=a.rows())) - throw ap_error("Error while calling 'spdmatrixinverse': looks like one of arguments has wrong size"); - if( !alglib_impl::ae_is_symmetric(const_cast(a.c_ptr())) ) - throw ap_error("'a' parameter is not symmetric matrix"); - n = a.cols(); - isupper = false; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spdmatrixinverse(const_cast(a.c_ptr()), n, isupper, &info, const_cast(rep.c_ptr()), &_alglib_env_state); - if( !alglib_impl::ae_force_symmetric(const_cast(a.c_ptr())) ) - throw ap_error("Internal error while forcing symmetricity of 'a' parameter"); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Inversion of a Hermitian positive definite matrix which is given -by Cholesky decomposition. - -Input parameters: - A - Cholesky decomposition of the matrix to be inverted: - A=U’*U or A = L*L'. - Output of HPDMatrixCholesky subroutine. - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - IsUpper - storage type (optional): - * if True, symmetric matrix A is given by its upper - triangle, and the lower triangle isn’t used/changed by - function - * if False, symmetric matrix A is given by its lower - triangle, and the upper triangle isn’t used/changed by - function - * if not given, lower half is used. - -Output parameters: - Info - return code, same as in RMatrixLUInverse - Rep - solver report, same as in RMatrixLUInverse - A - inverse of matrix A, same as in RMatrixLUInverse - - -- ALGLIB routine -- - 10.02.2010 - Bochkanov Sergey -*************************************************************************/ -void hpdmatrixcholeskyinverse(complex_2d_array &a, const ae_int_t n, const bool isupper, ae_int_t &info, matinvreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::hpdmatrixcholeskyinverse(const_cast(a.c_ptr()), n, isupper, &info, const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Inversion of a Hermitian positive definite matrix which is given -by Cholesky decomposition. - -Input parameters: - A - Cholesky decomposition of the matrix to be inverted: - A=U’*U or A = L*L'. - Output of HPDMatrixCholesky subroutine. - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - IsUpper - storage type (optional): - * if True, symmetric matrix A is given by its upper - triangle, and the lower triangle isn’t used/changed by - function - * if False, symmetric matrix A is given by its lower - triangle, and the upper triangle isn’t used/changed by - function - * if not given, lower half is used. - -Output parameters: - Info - return code, same as in RMatrixLUInverse - Rep - solver report, same as in RMatrixLUInverse - A - inverse of matrix A, same as in RMatrixLUInverse - - -- ALGLIB routine -- - 10.02.2010 - Bochkanov Sergey -*************************************************************************/ -void hpdmatrixcholeskyinverse(complex_2d_array &a, ae_int_t &info, matinvreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - bool isupper; - if( (a.cols()!=a.rows())) - throw ap_error("Error while calling 'hpdmatrixcholeskyinverse': looks like one of arguments has wrong size"); - n = a.cols(); - isupper = false; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::hpdmatrixcholeskyinverse(const_cast(a.c_ptr()), n, isupper, &info, const_cast(rep.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Inversion of a Hermitian positive definite matrix. - -Given an upper or lower triangle of a Hermitian positive definite matrix, -the algorithm generates matrix A^-1 and saves the upper or lower triangle -depending on the input. - -Input parameters: - A - matrix to be inverted (upper or lower triangle). - Array with elements [0..N-1,0..N-1]. - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - IsUpper - storage type (optional): - * if True, symmetric matrix A is given by its upper - triangle, and the lower triangle isn’t used/changed by - function - * if False, symmetric matrix A is given by its lower - triangle, and the upper triangle isn’t used/changed by - function - * if not given, both lower and upper triangles must be - filled. - -Output parameters: - Info - return code, same as in RMatrixLUInverse - Rep - solver report, same as in RMatrixLUInverse - A - inverse of matrix A, same as in RMatrixLUInverse - - -- ALGLIB routine -- - 10.02.2010 - Bochkanov Sergey -*************************************************************************/ -void hpdmatrixinverse(complex_2d_array &a, const ae_int_t n, const bool isupper, ae_int_t &info, matinvreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::hpdmatrixinverse(const_cast(a.c_ptr()), n, isupper, &info, const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Inversion of a Hermitian positive definite matrix. - -Given an upper or lower triangle of a Hermitian positive definite matrix, -the algorithm generates matrix A^-1 and saves the upper or lower triangle -depending on the input. - -Input parameters: - A - matrix to be inverted (upper or lower triangle). - Array with elements [0..N-1,0..N-1]. - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - IsUpper - storage type (optional): - * if True, symmetric matrix A is given by its upper - triangle, and the lower triangle isn’t used/changed by - function - * if False, symmetric matrix A is given by its lower - triangle, and the upper triangle isn’t used/changed by - function - * if not given, both lower and upper triangles must be - filled. - -Output parameters: - Info - return code, same as in RMatrixLUInverse - Rep - solver report, same as in RMatrixLUInverse - A - inverse of matrix A, same as in RMatrixLUInverse - - -- ALGLIB routine -- - 10.02.2010 - Bochkanov Sergey -*************************************************************************/ -void hpdmatrixinverse(complex_2d_array &a, ae_int_t &info, matinvreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - bool isupper; - if( (a.cols()!=a.rows())) - throw ap_error("Error while calling 'hpdmatrixinverse': looks like one of arguments has wrong size"); - if( !alglib_impl::ae_is_hermitian(const_cast(a.c_ptr())) ) - throw ap_error("'a' parameter is not Hermitian matrix"); - n = a.cols(); - isupper = false; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::hpdmatrixinverse(const_cast(a.c_ptr()), n, isupper, &info, const_cast(rep.c_ptr()), &_alglib_env_state); - if( !alglib_impl::ae_force_hermitian(const_cast(a.c_ptr())) ) - throw ap_error("Internal error while forcing Hermitian properties of 'a' parameter"); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Triangular matrix inverse (real) - -The subroutine inverts the following types of matrices: - * upper triangular - * upper triangular with unit diagonal - * lower triangular - * lower triangular with unit diagonal - -In case of an upper (lower) triangular matrix, the inverse matrix will -also be upper (lower) triangular, and after the end of the algorithm, the -inverse matrix replaces the source matrix. The elements below (above) the -main diagonal are not changed by the algorithm. - -If the matrix has a unit diagonal, the inverse matrix also has a unit -diagonal, and the diagonal elements are not passed to the algorithm. - -Input parameters: - A - matrix, array[0..N-1, 0..N-1]. - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - IsUpper - True, if the matrix is upper triangular. - IsUnit - diagonal type (optional): - * if True, matrix has unit diagonal (a[i,i] are NOT used) - * if False, matrix diagonal is arbitrary - * if not given, False is assumed - -Output parameters: - Info - same as for RMatrixLUInverse - Rep - same as for RMatrixLUInverse - A - same as for RMatrixLUInverse. - - -- ALGLIB -- - Copyright 05.02.2010 by Bochkanov Sergey -*************************************************************************/ -void rmatrixtrinverse(real_2d_array &a, const ae_int_t n, const bool isupper, const bool isunit, ae_int_t &info, matinvreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixtrinverse(const_cast(a.c_ptr()), n, isupper, isunit, &info, const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Triangular matrix inverse (real) - -The subroutine inverts the following types of matrices: - * upper triangular - * upper triangular with unit diagonal - * lower triangular - * lower triangular with unit diagonal - -In case of an upper (lower) triangular matrix, the inverse matrix will -also be upper (lower) triangular, and after the end of the algorithm, the -inverse matrix replaces the source matrix. The elements below (above) the -main diagonal are not changed by the algorithm. - -If the matrix has a unit diagonal, the inverse matrix also has a unit -diagonal, and the diagonal elements are not passed to the algorithm. - -Input parameters: - A - matrix, array[0..N-1, 0..N-1]. - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - IsUpper - True, if the matrix is upper triangular. - IsUnit - diagonal type (optional): - * if True, matrix has unit diagonal (a[i,i] are NOT used) - * if False, matrix diagonal is arbitrary - * if not given, False is assumed - -Output parameters: - Info - same as for RMatrixLUInverse - Rep - same as for RMatrixLUInverse - A - same as for RMatrixLUInverse. - - -- ALGLIB -- - Copyright 05.02.2010 by Bochkanov Sergey -*************************************************************************/ -void rmatrixtrinverse(real_2d_array &a, const bool isupper, ae_int_t &info, matinvreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - bool isunit; - if( (a.cols()!=a.rows())) - throw ap_error("Error while calling 'rmatrixtrinverse': looks like one of arguments has wrong size"); - n = a.cols(); - isunit = false; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixtrinverse(const_cast(a.c_ptr()), n, isupper, isunit, &info, const_cast(rep.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Triangular matrix inverse (complex) - -The subroutine inverts the following types of matrices: - * upper triangular - * upper triangular with unit diagonal - * lower triangular - * lower triangular with unit diagonal - -In case of an upper (lower) triangular matrix, the inverse matrix will -also be upper (lower) triangular, and after the end of the algorithm, the -inverse matrix replaces the source matrix. The elements below (above) the -main diagonal are not changed by the algorithm. - -If the matrix has a unit diagonal, the inverse matrix also has a unit -diagonal, and the diagonal elements are not passed to the algorithm. - -Input parameters: - A - matrix, array[0..N-1, 0..N-1]. - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - IsUpper - True, if the matrix is upper triangular. - IsUnit - diagonal type (optional): - * if True, matrix has unit diagonal (a[i,i] are NOT used) - * if False, matrix diagonal is arbitrary - * if not given, False is assumed - -Output parameters: - Info - same as for RMatrixLUInverse - Rep - same as for RMatrixLUInverse - A - same as for RMatrixLUInverse. - - -- ALGLIB -- - Copyright 05.02.2010 by Bochkanov Sergey -*************************************************************************/ -void cmatrixtrinverse(complex_2d_array &a, const ae_int_t n, const bool isupper, const bool isunit, ae_int_t &info, matinvreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::cmatrixtrinverse(const_cast(a.c_ptr()), n, isupper, isunit, &info, const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Triangular matrix inverse (complex) - -The subroutine inverts the following types of matrices: - * upper triangular - * upper triangular with unit diagonal - * lower triangular - * lower triangular with unit diagonal - -In case of an upper (lower) triangular matrix, the inverse matrix will -also be upper (lower) triangular, and after the end of the algorithm, the -inverse matrix replaces the source matrix. The elements below (above) the -main diagonal are not changed by the algorithm. - -If the matrix has a unit diagonal, the inverse matrix also has a unit -diagonal, and the diagonal elements are not passed to the algorithm. - -Input parameters: - A - matrix, array[0..N-1, 0..N-1]. - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - IsUpper - True, if the matrix is upper triangular. - IsUnit - diagonal type (optional): - * if True, matrix has unit diagonal (a[i,i] are NOT used) - * if False, matrix diagonal is arbitrary - * if not given, False is assumed - -Output parameters: - Info - same as for RMatrixLUInverse - Rep - same as for RMatrixLUInverse - A - same as for RMatrixLUInverse. - - -- ALGLIB -- - Copyright 05.02.2010 by Bochkanov Sergey -*************************************************************************/ -void cmatrixtrinverse(complex_2d_array &a, const bool isupper, ae_int_t &info, matinvreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - bool isunit; - if( (a.cols()!=a.rows())) - throw ap_error("Error while calling 'cmatrixtrinverse': looks like one of arguments has wrong size"); - n = a.cols(); - isunit = false; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::cmatrixtrinverse(const_cast(a.c_ptr()), n, isupper, isunit, &info, const_cast(rep.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Sparse matrix - -You should use ALGLIB functions to work with sparse matrix. -Never try to access its fields directly! -*************************************************************************/ -_sparsematrix_owner::_sparsematrix_owner() -{ - p_struct = (alglib_impl::sparsematrix*)alglib_impl::ae_malloc(sizeof(alglib_impl::sparsematrix), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_sparsematrix_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_sparsematrix_owner::_sparsematrix_owner(const _sparsematrix_owner &rhs) -{ - p_struct = (alglib_impl::sparsematrix*)alglib_impl::ae_malloc(sizeof(alglib_impl::sparsematrix), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_sparsematrix_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_sparsematrix_owner& _sparsematrix_owner::operator=(const _sparsematrix_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_sparsematrix_clear(p_struct); - if( !alglib_impl::_sparsematrix_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_sparsematrix_owner::~_sparsematrix_owner() -{ - alglib_impl::_sparsematrix_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::sparsematrix* _sparsematrix_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::sparsematrix* _sparsematrix_owner::c_ptr() const -{ - return const_cast(p_struct); -} -sparsematrix::sparsematrix() : _sparsematrix_owner() -{ -} - -sparsematrix::sparsematrix(const sparsematrix &rhs):_sparsematrix_owner(rhs) -{ -} - -sparsematrix& sparsematrix::operator=(const sparsematrix &rhs) -{ - if( this==&rhs ) - return *this; - _sparsematrix_owner::operator=(rhs); - return *this; -} - -sparsematrix::~sparsematrix() -{ -} - -/************************************************************************* -This function creates sparse matrix in a Hash-Table format. - -This function creates Hast-Table matrix, which can be converted to CRS -format after its initialization is over. Typical usage scenario for a -sparse matrix is: -1. creation in a Hash-Table format -2. insertion of the matrix elements -3. conversion to the CRS representation -4. matrix is passed to some linear algebra algorithm - -Some information about different matrix formats can be found below, in -the "NOTES" section. - -INPUT PARAMETERS - M - number of rows in a matrix, M>=1 - N - number of columns in a matrix, N>=1 - K - K>=0, expected number of non-zero elements in a matrix. - K can be inexact approximation, can be less than actual - number of elements (table will grow when needed) or - even zero). - It is important to understand that although hash-table - may grow automatically, it is better to provide good - estimate of data size. - -OUTPUT PARAMETERS - S - sparse M*N matrix in Hash-Table representation. - All elements of the matrix are zero. - -NOTE 1. - -Sparse matrices can be stored using either Hash-Table representation or -Compressed Row Storage representation. Hast-table is better suited for -querying and dynamic operations (thus, it is used for matrix -initialization), but it is inefficient when you want to make some linear -algebra operations. - -From the other side, CRS is better suited for linear algebra operations, -but initialization is less convenient - you have to tell row sizes at the -initialization, and you can fill matrix only row by row, from left to -right. CRS is also very inefficient when you want to find matrix element -by its index. - -Thus, Hash-Table representation does not support linear algebra -operations, while CRS format does not support modification of the table. -Tables below outline information about these two formats: - - OPERATIONS WITH MATRIX HASH CRS - create + + - read element + + - modify element + - add value to element + - A*x (dense vector) + - A'*x (dense vector) + - A*X (dense matrix) + - A'*X (dense matrix) + - -NOTE 2. - -Hash-tables use memory inefficiently, and they have to keep some amount -of the "spare memory" in order to have good performance. Hash table for -matrix with K non-zero elements will need C*K*(8+2*sizeof(int)) bytes, -where C is a small constant, about 1.5-2 in magnitude. - -CRS storage, from the other side, is more memory-efficient, and needs -just K*(8+sizeof(int))+M*sizeof(int) bytes, where M is a number of rows -in a matrix. - -When you convert from the Hash-Table to CRS representation, all unneeded -memory will be freed. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparsecreate(const ae_int_t m, const ae_int_t n, const ae_int_t k, sparsematrix &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::sparsecreate(m, n, k, const_cast(s.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function creates sparse matrix in a Hash-Table format. - -This function creates Hast-Table matrix, which can be converted to CRS -format after its initialization is over. Typical usage scenario for a -sparse matrix is: -1. creation in a Hash-Table format -2. insertion of the matrix elements -3. conversion to the CRS representation -4. matrix is passed to some linear algebra algorithm - -Some information about different matrix formats can be found below, in -the "NOTES" section. - -INPUT PARAMETERS - M - number of rows in a matrix, M>=1 - N - number of columns in a matrix, N>=1 - K - K>=0, expected number of non-zero elements in a matrix. - K can be inexact approximation, can be less than actual - number of elements (table will grow when needed) or - even zero). - It is important to understand that although hash-table - may grow automatically, it is better to provide good - estimate of data size. - -OUTPUT PARAMETERS - S - sparse M*N matrix in Hash-Table representation. - All elements of the matrix are zero. - -NOTE 1. - -Sparse matrices can be stored using either Hash-Table representation or -Compressed Row Storage representation. Hast-table is better suited for -querying and dynamic operations (thus, it is used for matrix -initialization), but it is inefficient when you want to make some linear -algebra operations. - -From the other side, CRS is better suited for linear algebra operations, -but initialization is less convenient - you have to tell row sizes at the -initialization, and you can fill matrix only row by row, from left to -right. CRS is also very inefficient when you want to find matrix element -by its index. - -Thus, Hash-Table representation does not support linear algebra -operations, while CRS format does not support modification of the table. -Tables below outline information about these two formats: - - OPERATIONS WITH MATRIX HASH CRS - create + + - read element + + - modify element + - add value to element + - A*x (dense vector) + - A'*x (dense vector) + - A*X (dense matrix) + - A'*X (dense matrix) + - -NOTE 2. - -Hash-tables use memory inefficiently, and they have to keep some amount -of the "spare memory" in order to have good performance. Hash table for -matrix with K non-zero elements will need C*K*(8+2*sizeof(int)) bytes, -where C is a small constant, about 1.5-2 in magnitude. - -CRS storage, from the other side, is more memory-efficient, and needs -just K*(8+sizeof(int))+M*sizeof(int) bytes, where M is a number of rows -in a matrix. - -When you convert from the Hash-Table to CRS representation, all unneeded -memory will be freed. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparsecreate(const ae_int_t m, const ae_int_t n, sparsematrix &s) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t k; - - k = 0; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::sparsecreate(m, n, k, const_cast(s.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function creates sparse matrix in a CRS format (expert function for -situations when you are running out of memory). - -This function creates CRS matrix. Typical usage scenario for a CRS matrix -is: -1. creation (you have to tell number of non-zero elements at each row at - this moment) -2. insertion of the matrix elements (row by row, from left to right) -3. matrix is passed to some linear algebra algorithm - -This function is a memory-efficient alternative to SparseCreate(), but it -is more complex because it requires you to know in advance how large your -matrix is. Some information about different matrix formats can be found -below, in the "NOTES" section. - -INPUT PARAMETERS - M - number of rows in a matrix, M>=1 - N - number of columns in a matrix, N>=1 - NER - number of elements at each row, array[M], NER[I]>=0 - -OUTPUT PARAMETERS - S - sparse M*N matrix in CRS representation. - You have to fill ALL non-zero elements by calling - SparseSet() BEFORE you try to use this matrix. - -NOTE 1. - -Sparse matrices can be stored using either Hash-Table representation or -Compressed Row Storage representation. Hast-table is better suited for -querying and dynamic operations (thus, it is used for matrix -initialization), but it is inefficient when you want to make some linear -algebra operations. - -From the other side, CRS is better suited for linear algebra operations, -but initialization is less convenient - you have to tell row sizes at the -initialization, and you can fill matrix only row by row, from left to -right. CRS is also very inefficient when you want to find matrix element -by its index. - -Thus, Hash-Table representation does not support linear algebra -operations, while CRS format does not support modification of the table. -Tables below outline information about these two formats: - - OPERATIONS WITH MATRIX HASH CRS - create + + - read element + + - modify element + - add value to element + - A*x (dense vector) + - A'*x (dense vector) + - A*X (dense matrix) + - A'*X (dense matrix) + - -NOTE 2. - -Hash-tables use memory inefficiently, and they have to keep some amount -of the "spare memory" in order to have good performance. Hash table for -matrix with K non-zero elements will need C*K*(8+2*sizeof(int)) bytes, -where C is a small constant, about 1.5-2 in magnitude. - -CRS storage, from the other side, is more memory-efficient, and needs -just K*(8+sizeof(int))+M*sizeof(int) bytes, where M is a number of rows -in a matrix. - -When you convert from the Hash-Table to CRS representation, all unneeded -memory will be freed. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparsecreatecrs(const ae_int_t m, const ae_int_t n, const integer_1d_array &ner, sparsematrix &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::sparsecreatecrs(m, n, const_cast(ner.c_ptr()), const_cast(s.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function copies S0 to S1. - -NOTE: this function does not verify its arguments, it just copies all -fields of the structure. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparsecopy(const sparsematrix &s0, sparsematrix &s1) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::sparsecopy(const_cast(s0.c_ptr()), const_cast(s1.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function adds value to S[i,j] - element of the sparse matrix. Matrix -must be in a Hash-Table mode. - -In case S[i,j] already exists in the table, V i added to its value. In -case S[i,j] is non-existent, it is inserted in the table. Table -automatically grows when necessary. - -INPUT PARAMETERS - S - sparse M*N matrix in Hash-Table representation. - Exception will be thrown for CRS matrix. - I - row index of the element to modify, 0<=I(s.c_ptr()), i, j, v, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function modifies S[i,j] - element of the sparse matrix. - -For Hash-based storage format: -* new value can be zero or non-zero. In case new value of S[i,j] is zero, - this element is deleted from the table. -* this function has no effect when called with zero V for non-existent - element. - -For CRS-bases storage format: -* new value MUST be non-zero. Exception will be thrown for zero V. -* elements must be initialized in correct order - from top row to bottom, - within row - from left to right. - -INPUT PARAMETERS - S - sparse M*N matrix in Hash-Table or CRS representation. - I - row index of the element to modify, 0<=I(s.c_ptr()), i, j, v, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function returns S[i,j] - element of the sparse matrix. Matrix can -be in any mode (Hash-Table or CRS), but this function is less efficient -for CRS matrices. Hash-Table matrices can find element in O(1) time, -while CRS matrices need O(log(RS)) time, where RS is an number of non- -zero elements in a row. - -INPUT PARAMETERS - S - sparse M*N matrix in Hash-Table representation. - Exception will be thrown for CRS matrix. - I - row index of the element to modify, 0<=I(s.c_ptr()), i, j, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function returns I-th diagonal element of the sparse matrix. - -Matrix can be in any mode (Hash-Table or CRS storage), but this function -is most efficient for CRS matrices - it requires less than 50 CPU cycles -to extract diagonal element. For Hash-Table matrices we still have O(1) -query time, but function is many times slower. - -INPUT PARAMETERS - S - sparse M*N matrix in Hash-Table representation. - Exception will be thrown for CRS matrix. - I - index of the element to modify, 0<=I(s.c_ptr()), i, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function converts matrix to CRS format. - -Some algorithms (linear algebra ones, for example) require matrices in -CRS format. - -INPUT PARAMETERS - S - sparse M*N matrix in any format - -OUTPUT PARAMETERS - S - matrix in CRS format - -NOTE: this function has no effect when called with matrix which is -already in CRS mode. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparseconverttocrs(const sparsematrix &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::sparseconverttocrs(const_cast(s.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function calculates matrix-vector product S*x. Matrix S must be -stored in CRS format (exception will be thrown otherwise). - -INPUT PARAMETERS - S - sparse M*N matrix in CRS format (you MUST convert it - to CRS before calling this function). - X - array[N], input vector. For performance reasons we - make only quick checks - we check that array size is - at least N, but we do not check for NAN's or INF's. - Y - output buffer, possibly preallocated. In case buffer - size is too small to store result, this buffer is - automatically resized. - -OUTPUT PARAMETERS - Y - array[M], S*x - -NOTE: this function throws exception when called for non-CRS matrix. You -must convert your matrix with SparseConvertToCRS() before using this -function. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparsemv(const sparsematrix &s, const real_1d_array &x, real_1d_array &y) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::sparsemv(const_cast(s.c_ptr()), const_cast(x.c_ptr()), const_cast(y.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function calculates matrix-vector product S^T*x. Matrix S must be -stored in CRS format (exception will be thrown otherwise). - -INPUT PARAMETERS - S - sparse M*N matrix in CRS format (you MUST convert it - to CRS before calling this function). - X - array[M], input vector. For performance reasons we - make only quick checks - we check that array size is - at least M, but we do not check for NAN's or INF's. - Y - output buffer, possibly preallocated. In case buffer - size is too small to store result, this buffer is - automatically resized. - -OUTPUT PARAMETERS - Y - array[N], S^T*x - -NOTE: this function throws exception when called for non-CRS matrix. You -must convert your matrix with SparseConvertToCRS() before using this -function. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparsemtv(const sparsematrix &s, const real_1d_array &x, real_1d_array &y) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::sparsemtv(const_cast(s.c_ptr()), const_cast(x.c_ptr()), const_cast(y.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function simultaneously calculates two matrix-vector products: - S*x and S^T*x. -S must be square (non-rectangular) matrix stored in CRS format (exception -will be thrown otherwise). - -INPUT PARAMETERS - S - sparse N*N matrix in CRS format (you MUST convert it - to CRS before calling this function). - X - array[N], input vector. For performance reasons we - make only quick checks - we check that array size is - at least N, but we do not check for NAN's or INF's. - Y0 - output buffer, possibly preallocated. In case buffer - size is too small to store result, this buffer is - automatically resized. - Y1 - output buffer, possibly preallocated. In case buffer - size is too small to store result, this buffer is - automatically resized. - -OUTPUT PARAMETERS - Y0 - array[N], S*x - Y1 - array[N], S^T*x - -NOTE: this function throws exception when called for non-CRS matrix. You -must convert your matrix with SparseConvertToCRS() before using this -function. It also throws exception when S is non-square. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparsemv2(const sparsematrix &s, const real_1d_array &x, real_1d_array &y0, real_1d_array &y1) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::sparsemv2(const_cast(s.c_ptr()), const_cast(x.c_ptr()), const_cast(y0.c_ptr()), const_cast(y1.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function calculates matrix-vector product S*x, when S is symmetric -matrix. Matrix S must be stored in CRS format (exception will be -thrown otherwise). - -INPUT PARAMETERS - S - sparse M*M matrix in CRS format (you MUST convert it - to CRS before calling this function). - IsUpper - whether upper or lower triangle of S is given: - * if upper triangle is given, only S[i,j] for j>=i - are used, and lower triangle is ignored (it can be - empty - these elements are not referenced at all). - * if lower triangle is given, only S[i,j] for j<=i - are used, and upper triangle is ignored. - X - array[N], input vector. For performance reasons we - make only quick checks - we check that array size is - at least N, but we do not check for NAN's or INF's. - Y - output buffer, possibly preallocated. In case buffer - size is too small to store result, this buffer is - automatically resized. - -OUTPUT PARAMETERS - Y - array[M], S*x - -NOTE: this function throws exception when called for non-CRS matrix. You -must convert your matrix with SparseConvertToCRS() before using this -function. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparsesmv(const sparsematrix &s, const bool isupper, const real_1d_array &x, real_1d_array &y) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::sparsesmv(const_cast(s.c_ptr()), isupper, const_cast(x.c_ptr()), const_cast(y.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function calculates matrix-matrix product S*A. Matrix S must be -stored in CRS format (exception will be thrown otherwise). - -INPUT PARAMETERS - S - sparse M*N matrix in CRS format (you MUST convert it - to CRS before calling this function). - A - array[N][K], input dense matrix. For performance reasons - we make only quick checks - we check that array size - is at least N, but we do not check for NAN's or INF's. - K - number of columns of matrix (A). - B - output buffer, possibly preallocated. In case buffer - size is too small to store result, this buffer is - automatically resized. - -OUTPUT PARAMETERS - B - array[M][K], S*A - -NOTE: this function throws exception when called for non-CRS matrix. You -must convert your matrix with SparseConvertToCRS() before using this -function. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparsemm(const sparsematrix &s, const real_2d_array &a, const ae_int_t k, real_2d_array &b) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::sparsemm(const_cast(s.c_ptr()), const_cast(a.c_ptr()), k, const_cast(b.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function calculates matrix-matrix product S^T*A. Matrix S must be -stored in CRS format (exception will be thrown otherwise). - -INPUT PARAMETERS - S - sparse M*N matrix in CRS format (you MUST convert it - to CRS before calling this function). - A - array[M][K], input dense matrix. For performance reasons - we make only quick checks - we check that array size is - at least M, but we do not check for NAN's or INF's. - K - number of columns of matrix (A). - B - output buffer, possibly preallocated. In case buffer - size is too small to store result, this buffer is - automatically resized. - -OUTPUT PARAMETERS - B - array[N][K], S^T*A - -NOTE: this function throws exception when called for non-CRS matrix. You -must convert your matrix with SparseConvertToCRS() before using this -function. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparsemtm(const sparsematrix &s, const real_2d_array &a, const ae_int_t k, real_2d_array &b) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::sparsemtm(const_cast(s.c_ptr()), const_cast(a.c_ptr()), k, const_cast(b.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function simultaneously calculates two matrix-matrix products: - S*A and S^T*A. -S must be square (non-rectangular) matrix stored in CRS format (exception -will be thrown otherwise). - -INPUT PARAMETERS - S - sparse N*N matrix in CRS format (you MUST convert it - to CRS before calling this function). - A - array[N][K], input dense matrix. For performance reasons - we make only quick checks - we check that array size is - at least N, but we do not check for NAN's or INF's. - K - number of columns of matrix (A). - B0 - output buffer, possibly preallocated. In case buffer - size is too small to store result, this buffer is - automatically resized. - B1 - output buffer, possibly preallocated. In case buffer - size is too small to store result, this buffer is - automatically resized. - -OUTPUT PARAMETERS - B0 - array[N][K], S*A - B1 - array[N][K], S^T*A - -NOTE: this function throws exception when called for non-CRS matrix. You -must convert your matrix with SparseConvertToCRS() before using this -function. It also throws exception when S is non-square. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparsemm2(const sparsematrix &s, const real_2d_array &a, const ae_int_t k, real_2d_array &b0, real_2d_array &b1) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::sparsemm2(const_cast(s.c_ptr()), const_cast(a.c_ptr()), k, const_cast(b0.c_ptr()), const_cast(b1.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function calculates matrix-matrix product S*A, when S is symmetric -matrix. Matrix S must be stored in CRS format (exception will be -thrown otherwise). - -INPUT PARAMETERS - S - sparse M*M matrix in CRS format (you MUST convert it - to CRS before calling this function). - IsUpper - whether upper or lower triangle of S is given: - * if upper triangle is given, only S[i,j] for j>=i - are used, and lower triangle is ignored (it can be - empty - these elements are not referenced at all). - * if lower triangle is given, only S[i,j] for j<=i - are used, and upper triangle is ignored. - A - array[N][K], input dense matrix. For performance reasons - we make only quick checks - we check that array size is - at least N, but we do not check for NAN's or INF's. - K - number of columns of matrix (A). - B - output buffer, possibly preallocated. In case buffer - size is too small to store result, this buffer is - automatically resized. - -OUTPUT PARAMETERS - B - array[M][K], S*A - -NOTE: this function throws exception when called for non-CRS matrix. You -must convert your matrix with SparseConvertToCRS() before using this -function. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparsesmm(const sparsematrix &s, const bool isupper, const real_2d_array &a, const ae_int_t k, real_2d_array &b) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::sparsesmm(const_cast(s.c_ptr()), isupper, const_cast(a.c_ptr()), k, const_cast(b.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This procedure resizes Hash-Table matrix. It can be called when you have -deleted too many elements from the matrix, and you want to free unneeded -memory. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparseresizematrix(const sparsematrix &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::sparseresizematrix(const_cast(s.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function is used to enumerate all elements of the sparse matrix. -Before first call user initializes T0 and T1 counters by zero. These -counters are used to remember current position in a matrix; after each -call they are updated by the function. - -Subsequent calls to this function return non-zero elements of the sparse -matrix, one by one. If you enumerate CRS matrix, matrix is traversed from -left to right, from top to bottom. In case you enumerate matrix stored as -Hash table, elements are returned in random order. - -EXAMPLE - > T0=0 - > T1=0 - > while SparseEnumerate(S,T0,T1,I,J,V) do - > ....do something with I,J,V - -INPUT PARAMETERS - S - sparse M*N matrix in Hash-Table or CRS representation. - T0 - internal counter - T1 - internal counter - -OUTPUT PARAMETERS - T0 - new value of the internal counter - T1 - new value of the internal counter - I - row index of non-zero element, 0<=I(s.c_ptr()), &t0, &t1, &i, &j, &v, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function rewrites existing (non-zero) element. It returns True if -element exists or False, when it is called for non-existing (zero) -element. - -The purpose of this function is to provide convenient thread-safe way to -modify sparse matrix. Such modification (already existing element is -rewritten) is guaranteed to be thread-safe without any synchronization, as -long as different threads modify different elements. - -INPUT PARAMETERS - S - sparse M*N matrix in Hash-Table or CRS representation. - I - row index of non-zero element to modify, 0<=I(s.c_ptr()), i, j, v, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function returns I-th row of the sparse matrix stored in CRS format. - -NOTE: when incorrect I (outside of [0,M-1]) or matrix (non-CRS) are - passed, this function throws exception. - -INPUT PARAMETERS: - S - sparse M*N matrix in CRS format - I - row index, 0<=I(s.c_ptr()), i, const_cast(irow.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function performs in-place conversion from CRS format to Hash table -storage. - -INPUT PARAMETERS - S - sparse matrix in CRS format. - -OUTPUT PARAMETERS - S - sparse matrix in Hash table format. - -NOTE: this function has no effect when called with matrix which is -already in Hash table mode. - - -- ALGLIB PROJECT -- - Copyright 20.07.2012 by Bochkanov Sergey -*************************************************************************/ -void sparseconverttohash(const sparsematrix &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::sparseconverttohash(const_cast(s.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function performs out-of-place conversion to Hash table storage -format. S0 is copied to S1 and converted on-the-fly. - -INPUT PARAMETERS - S0 - sparse matrix in any format. - -OUTPUT PARAMETERS - S1 - sparse matrix in Hash table format. - -NOTE: if S0 is stored as Hash-table, it is just copied without conversion. - - -- ALGLIB PROJECT -- - Copyright 20.07.2012 by Bochkanov Sergey -*************************************************************************/ -void sparsecopytohash(const sparsematrix &s0, sparsematrix &s1) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::sparsecopytohash(const_cast(s0.c_ptr()), const_cast(s1.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function performs out-of-place conversion to CRS format. S0 is -copied to S1 and converted on-the-fly. - -INPUT PARAMETERS - S0 - sparse matrix in any format. - -OUTPUT PARAMETERS - S1 - sparse matrix in CRS format. - -NOTE: if S0 is stored as CRS, it is just copied without conversion. - - -- ALGLIB PROJECT -- - Copyright 20.07.2012 by Bochkanov Sergey -*************************************************************************/ -void sparsecopytocrs(const sparsematrix &s0, sparsematrix &s1) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::sparsecopytocrs(const_cast(s0.c_ptr()), const_cast(s1.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function returns type of the matrix storage format. - -INPUT PARAMETERS: - S - sparse matrix. - -RESULT: - sparse storage format used by matrix: - 0 - Hash-table - 1 - CRS-format - -NOTE: future versions of ALGLIB may include additional sparse storage - formats. - - - -- ALGLIB PROJECT -- - Copyright 20.07.2012 by Bochkanov Sergey -*************************************************************************/ -ae_int_t sparsegetmatrixtype(const sparsematrix &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::ae_int_t result = alglib_impl::sparsegetmatrixtype(const_cast(s.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function checks matrix storage format and returns True when matrix is -stored using Hash table representation. - -INPUT PARAMETERS: - S - sparse matrix. - -RESULT: - True if matrix type is Hash table - False if matrix type is not Hash table - - -- ALGLIB PROJECT -- - Copyright 20.07.2012 by Bochkanov Sergey -*************************************************************************/ -bool sparseishash(const sparsematrix &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::sparseishash(const_cast(s.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function checks matrix storage format and returns True when matrix is -stored using CRS representation. - -INPUT PARAMETERS: - S - sparse matrix. - -RESULT: - True if matrix type is CRS - False if matrix type is not CRS - - -- ALGLIB PROJECT -- - Copyright 20.07.2012 by Bochkanov Sergey -*************************************************************************/ -bool sparseiscrs(const sparsematrix &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::sparseiscrs(const_cast(s.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -The function frees all memory occupied by sparse matrix. Sparse matrix -structure becomes unusable after this call. - -OUTPUT PARAMETERS - S - sparse matrix to delete - - -- ALGLIB PROJECT -- - Copyright 24.07.2012 by Bochkanov Sergey -*************************************************************************/ -void sparsefree(sparsematrix &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::sparsefree(const_cast(s.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -The function returns number of rows of a sparse matrix. - -RESULT: number of rows of a sparse matrix. - - -- ALGLIB PROJECT -- - Copyright 23.08.2012 by Bochkanov Sergey -*************************************************************************/ -ae_int_t sparsegetnrows(const sparsematrix &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::ae_int_t result = alglib_impl::sparsegetnrows(const_cast(s.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -The function returns number of columns of a sparse matrix. - -RESULT: number of columns of a sparse matrix. - - -- ALGLIB PROJECT -- - Copyright 23.08.2012 by Bochkanov Sergey -*************************************************************************/ -ae_int_t sparsegetncols(const sparsematrix &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::ae_int_t result = alglib_impl::sparsegetncols(const_cast(s.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - - -/************************************************************************* -This object stores state of the iterative norm estimation algorithm. - -You should use ALGLIB functions to work with this object. -*************************************************************************/ -_normestimatorstate_owner::_normestimatorstate_owner() -{ - p_struct = (alglib_impl::normestimatorstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::normestimatorstate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_normestimatorstate_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_normestimatorstate_owner::_normestimatorstate_owner(const _normestimatorstate_owner &rhs) -{ - p_struct = (alglib_impl::normestimatorstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::normestimatorstate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_normestimatorstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_normestimatorstate_owner& _normestimatorstate_owner::operator=(const _normestimatorstate_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_normestimatorstate_clear(p_struct); - if( !alglib_impl::_normestimatorstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_normestimatorstate_owner::~_normestimatorstate_owner() -{ - alglib_impl::_normestimatorstate_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::normestimatorstate* _normestimatorstate_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::normestimatorstate* _normestimatorstate_owner::c_ptr() const -{ - return const_cast(p_struct); -} -normestimatorstate::normestimatorstate() : _normestimatorstate_owner() -{ -} - -normestimatorstate::normestimatorstate(const normestimatorstate &rhs):_normestimatorstate_owner(rhs) -{ -} - -normestimatorstate& normestimatorstate::operator=(const normestimatorstate &rhs) -{ - if( this==&rhs ) - return *this; - _normestimatorstate_owner::operator=(rhs); - return *this; -} - -normestimatorstate::~normestimatorstate() -{ -} - -/************************************************************************* -This procedure initializes matrix norm estimator. - -USAGE: -1. User initializes algorithm state with NormEstimatorCreate() call -2. User calls NormEstimatorEstimateSparse() (or NormEstimatorIteration()) -3. User calls NormEstimatorResults() to get solution. - -INPUT PARAMETERS: - M - number of rows in the matrix being estimated, M>0 - N - number of columns in the matrix being estimated, N>0 - NStart - number of random starting vectors - recommended value - at least 5. - NIts - number of iterations to do with best starting vector - recommended value - at least 5. - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -NOTE: this algorithm is effectively deterministic, i.e. it always returns -same result when repeatedly called for the same matrix. In fact, algorithm -uses randomized starting vectors, but internal random numbers generator -always generates same sequence of the random values (it is a feature, not -bug). - -Algorithm can be made non-deterministic with NormEstimatorSetSeed(0) call. - - -- ALGLIB -- - Copyright 06.12.2011 by Bochkanov Sergey -*************************************************************************/ -void normestimatorcreate(const ae_int_t m, const ae_int_t n, const ae_int_t nstart, const ae_int_t nits, normestimatorstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::normestimatorcreate(m, n, nstart, nits, const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function changes seed value used by algorithm. In some cases we need -deterministic processing, i.e. subsequent calls must return equal results, -in other cases we need non-deterministic algorithm which returns different -results for the same matrix on every pass. - -Setting zero seed will lead to non-deterministic algorithm, while non-zero -value will make our algorithm deterministic. - -INPUT PARAMETERS: - State - norm estimator state, must be initialized with a call - to NormEstimatorCreate() - SeedVal - seed value, >=0. Zero value = non-deterministic algo. - - -- ALGLIB -- - Copyright 06.12.2011 by Bochkanov Sergey -*************************************************************************/ -void normestimatorsetseed(const normestimatorstate &state, const ae_int_t seedval) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::normestimatorsetseed(const_cast(state.c_ptr()), seedval, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function estimates norm of the sparse M*N matrix A. - -INPUT PARAMETERS: - State - norm estimator state, must be initialized with a call - to NormEstimatorCreate() - A - sparse M*N matrix, must be converted to CRS format - prior to calling this function. - -After this function is over you can call NormEstimatorResults() to get -estimate of the norm(A). - - -- ALGLIB -- - Copyright 06.12.2011 by Bochkanov Sergey -*************************************************************************/ -void normestimatorestimatesparse(const normestimatorstate &state, const sparsematrix &a) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::normestimatorestimatesparse(const_cast(state.c_ptr()), const_cast(a.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Matrix norm estimation results - -INPUT PARAMETERS: - State - algorithm state - -OUTPUT PARAMETERS: - Nrm - estimate of the matrix norm, Nrm>=0 - - -- ALGLIB -- - Copyright 06.12.2011 by Bochkanov Sergey -*************************************************************************/ -void normestimatorresults(const normestimatorstate &state, double &nrm) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::normestimatorresults(const_cast(state.c_ptr()), &nrm, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Determinant calculation of the matrix given by its LU decomposition. - -Input parameters: - A - LU decomposition of the matrix (output of - RMatrixLU subroutine). - Pivots - table of permutations which were made during - the LU decomposition. - Output of RMatrixLU subroutine. - N - (optional) size of matrix A: - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, automatically determined from matrix size - (A must be square matrix) - -Result: matrix determinant. - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -double rmatrixludet(const real_2d_array &a, const integer_1d_array &pivots, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::rmatrixludet(const_cast(a.c_ptr()), const_cast(pivots.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Determinant calculation of the matrix given by its LU decomposition. - -Input parameters: - A - LU decomposition of the matrix (output of - RMatrixLU subroutine). - Pivots - table of permutations which were made during - the LU decomposition. - Output of RMatrixLU subroutine. - N - (optional) size of matrix A: - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, automatically determined from matrix size - (A must be square matrix) - -Result: matrix determinant. - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -double rmatrixludet(const real_2d_array &a, const integer_1d_array &pivots) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - if( (a.rows()!=a.cols()) || (a.rows()!=pivots.length())) - throw ap_error("Error while calling 'rmatrixludet': looks like one of arguments has wrong size"); - n = a.rows(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::rmatrixludet(const_cast(a.c_ptr()), const_cast(pivots.c_ptr()), n, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Calculation of the determinant of a general matrix - -Input parameters: - A - matrix, array[0..N-1, 0..N-1] - N - (optional) size of matrix A: - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, automatically determined from matrix size - (A must be square matrix) - -Result: determinant of matrix A. - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -double rmatrixdet(const real_2d_array &a, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::rmatrixdet(const_cast(a.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Calculation of the determinant of a general matrix - -Input parameters: - A - matrix, array[0..N-1, 0..N-1] - N - (optional) size of matrix A: - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, automatically determined from matrix size - (A must be square matrix) - -Result: determinant of matrix A. - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -double rmatrixdet(const real_2d_array &a) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - if( (a.rows()!=a.cols())) - throw ap_error("Error while calling 'rmatrixdet': looks like one of arguments has wrong size"); - n = a.rows(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::rmatrixdet(const_cast(a.c_ptr()), n, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Determinant calculation of the matrix given by its LU decomposition. - -Input parameters: - A - LU decomposition of the matrix (output of - RMatrixLU subroutine). - Pivots - table of permutations which were made during - the LU decomposition. - Output of RMatrixLU subroutine. - N - (optional) size of matrix A: - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, automatically determined from matrix size - (A must be square matrix) - -Result: matrix determinant. - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -alglib::complex cmatrixludet(const complex_2d_array &a, const integer_1d_array &pivots, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::ae_complex result = alglib_impl::cmatrixludet(const_cast(a.c_ptr()), const_cast(pivots.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Determinant calculation of the matrix given by its LU decomposition. - -Input parameters: - A - LU decomposition of the matrix (output of - RMatrixLU subroutine). - Pivots - table of permutations which were made during - the LU decomposition. - Output of RMatrixLU subroutine. - N - (optional) size of matrix A: - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, automatically determined from matrix size - (A must be square matrix) - -Result: matrix determinant. - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -alglib::complex cmatrixludet(const complex_2d_array &a, const integer_1d_array &pivots) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - if( (a.rows()!=a.cols()) || (a.rows()!=pivots.length())) - throw ap_error("Error while calling 'cmatrixludet': looks like one of arguments has wrong size"); - n = a.rows(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::ae_complex result = alglib_impl::cmatrixludet(const_cast(a.c_ptr()), const_cast(pivots.c_ptr()), n, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Calculation of the determinant of a general matrix - -Input parameters: - A - matrix, array[0..N-1, 0..N-1] - N - (optional) size of matrix A: - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, automatically determined from matrix size - (A must be square matrix) - -Result: determinant of matrix A. - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -alglib::complex cmatrixdet(const complex_2d_array &a, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::ae_complex result = alglib_impl::cmatrixdet(const_cast(a.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Calculation of the determinant of a general matrix - -Input parameters: - A - matrix, array[0..N-1, 0..N-1] - N - (optional) size of matrix A: - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, automatically determined from matrix size - (A must be square matrix) - -Result: determinant of matrix A. - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -alglib::complex cmatrixdet(const complex_2d_array &a) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - if( (a.rows()!=a.cols())) - throw ap_error("Error while calling 'cmatrixdet': looks like one of arguments has wrong size"); - n = a.rows(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::ae_complex result = alglib_impl::cmatrixdet(const_cast(a.c_ptr()), n, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Determinant calculation of the matrix given by the Cholesky decomposition. - -Input parameters: - A - Cholesky decomposition, - output of SMatrixCholesky subroutine. - N - (optional) size of matrix A: - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, automatically determined from matrix size - (A must be square matrix) - -As the determinant is equal to the product of squares of diagonal elements, -it’s not necessary to specify which triangle - lower or upper - the matrix -is stored in. - -Result: - matrix determinant. - - -- ALGLIB -- - Copyright 2005-2008 by Bochkanov Sergey -*************************************************************************/ -double spdmatrixcholeskydet(const real_2d_array &a, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::spdmatrixcholeskydet(const_cast(a.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Determinant calculation of the matrix given by the Cholesky decomposition. - -Input parameters: - A - Cholesky decomposition, - output of SMatrixCholesky subroutine. - N - (optional) size of matrix A: - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, automatically determined from matrix size - (A must be square matrix) - -As the determinant is equal to the product of squares of diagonal elements, -it’s not necessary to specify which triangle - lower or upper - the matrix -is stored in. - -Result: - matrix determinant. - - -- ALGLIB -- - Copyright 2005-2008 by Bochkanov Sergey -*************************************************************************/ -double spdmatrixcholeskydet(const real_2d_array &a) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - if( (a.rows()!=a.cols())) - throw ap_error("Error while calling 'spdmatrixcholeskydet': looks like one of arguments has wrong size"); - n = a.rows(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::spdmatrixcholeskydet(const_cast(a.c_ptr()), n, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Determinant calculation of the symmetric positive definite matrix. - -Input parameters: - A - matrix. Array with elements [0..N-1, 0..N-1]. - N - (optional) size of matrix A: - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, automatically determined from matrix size - (A must be square matrix) - IsUpper - (optional) storage type: - * if True, symmetric matrix A is given by its upper - triangle, and the lower triangle isn’t used/changed by - function - * if False, symmetric matrix A is given by its lower - triangle, and the upper triangle isn’t used/changed by - function - * if not given, both lower and upper triangles must be - filled. - -Result: - determinant of matrix A. - If matrix A is not positive definite, exception is thrown. - - -- ALGLIB -- - Copyright 2005-2008 by Bochkanov Sergey -*************************************************************************/ -double spdmatrixdet(const real_2d_array &a, const ae_int_t n, const bool isupper) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::spdmatrixdet(const_cast(a.c_ptr()), n, isupper, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Determinant calculation of the symmetric positive definite matrix. - -Input parameters: - A - matrix. Array with elements [0..N-1, 0..N-1]. - N - (optional) size of matrix A: - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, automatically determined from matrix size - (A must be square matrix) - IsUpper - (optional) storage type: - * if True, symmetric matrix A is given by its upper - triangle, and the lower triangle isn’t used/changed by - function - * if False, symmetric matrix A is given by its lower - triangle, and the upper triangle isn’t used/changed by - function - * if not given, both lower and upper triangles must be - filled. - -Result: - determinant of matrix A. - If matrix A is not positive definite, exception is thrown. - - -- ALGLIB -- - Copyright 2005-2008 by Bochkanov Sergey -*************************************************************************/ -double spdmatrixdet(const real_2d_array &a) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - bool isupper; - if( (a.rows()!=a.cols())) - throw ap_error("Error while calling 'spdmatrixdet': looks like one of arguments has wrong size"); - if( !alglib_impl::ae_is_symmetric(const_cast(a.c_ptr())) ) - throw ap_error("'a' parameter is not symmetric matrix"); - n = a.rows(); - isupper = false; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::spdmatrixdet(const_cast(a.c_ptr()), n, isupper, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Algorithm for solving the following generalized symmetric positive-definite -eigenproblem: - A*x = lambda*B*x (1) or - A*B*x = lambda*x (2) or - B*A*x = lambda*x (3). -where A is a symmetric matrix, B - symmetric positive-definite matrix. -The problem is solved by reducing it to an ordinary symmetric eigenvalue -problem. - -Input parameters: - A - symmetric matrix which is given by its upper or lower - triangular part. - Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrices A and B. - IsUpperA - storage format of matrix A. - B - symmetric positive-definite matrix which is given by - its upper or lower triangular part. - Array whose indexes range within [0..N-1, 0..N-1]. - IsUpperB - storage format of matrix B. - ZNeeded - if ZNeeded is equal to: - * 0, the eigenvectors are not returned; - * 1, the eigenvectors are returned. - ProblemType - if ProblemType is equal to: - * 1, the following problem is solved: A*x = lambda*B*x; - * 2, the following problem is solved: A*B*x = lambda*x; - * 3, the following problem is solved: B*A*x = lambda*x. - -Output parameters: - D - eigenvalues in ascending order. - Array whose index ranges within [0..N-1]. - Z - if ZNeeded is equal to: - * 0, Z hasn’t changed; - * 1, Z contains eigenvectors. - Array whose indexes range within [0..N-1, 0..N-1]. - The eigenvectors are stored in matrix columns. It should - be noted that the eigenvectors in such problems do not - form an orthogonal system. - -Result: - True, if the problem was solved successfully. - False, if the error occurred during the Cholesky decomposition of matrix - B (the matrix isn’t positive-definite) or during the work of the iterative - algorithm for solving the symmetric eigenproblem. - -See also the GeneralizedSymmetricDefiniteEVDReduce subroutine. - - -- ALGLIB -- - Copyright 1.28.2006 by Bochkanov Sergey -*************************************************************************/ -bool smatrixgevd(const real_2d_array &a, const ae_int_t n, const bool isuppera, const real_2d_array &b, const bool isupperb, const ae_int_t zneeded, const ae_int_t problemtype, real_1d_array &d, real_2d_array &z) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::smatrixgevd(const_cast(a.c_ptr()), n, isuppera, const_cast(b.c_ptr()), isupperb, zneeded, problemtype, const_cast(d.c_ptr()), const_cast(z.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Algorithm for reduction of the following generalized symmetric positive- -definite eigenvalue problem: - A*x = lambda*B*x (1) or - A*B*x = lambda*x (2) or - B*A*x = lambda*x (3) -to the symmetric eigenvalues problem C*y = lambda*y (eigenvalues of this and -the given problems are the same, and the eigenvectors of the given problem -could be obtained by multiplying the obtained eigenvectors by the -transformation matrix x = R*y). - -Here A is a symmetric matrix, B - symmetric positive-definite matrix. - -Input parameters: - A - symmetric matrix which is given by its upper or lower - triangular part. - Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrices A and B. - IsUpperA - storage format of matrix A. - B - symmetric positive-definite matrix which is given by - its upper or lower triangular part. - Array whose indexes range within [0..N-1, 0..N-1]. - IsUpperB - storage format of matrix B. - ProblemType - if ProblemType is equal to: - * 1, the following problem is solved: A*x = lambda*B*x; - * 2, the following problem is solved: A*B*x = lambda*x; - * 3, the following problem is solved: B*A*x = lambda*x. - -Output parameters: - A - symmetric matrix which is given by its upper or lower - triangle depending on IsUpperA. Contains matrix C. - Array whose indexes range within [0..N-1, 0..N-1]. - R - upper triangular or low triangular transformation matrix - which is used to obtain the eigenvectors of a given problem - as the product of eigenvectors of C (from the right) and - matrix R (from the left). If the matrix is upper - triangular, the elements below the main diagonal - are equal to 0 (and vice versa). Thus, we can perform - the multiplication without taking into account the - internal structure (which is an easier though less - effective way). - Array whose indexes range within [0..N-1, 0..N-1]. - IsUpperR - type of matrix R (upper or lower triangular). - -Result: - True, if the problem was reduced successfully. - False, if the error occurred during the Cholesky decomposition of - matrix B (the matrix is not positive-definite). - - -- ALGLIB -- - Copyright 1.28.2006 by Bochkanov Sergey -*************************************************************************/ -bool smatrixgevdreduce(real_2d_array &a, const ae_int_t n, const bool isuppera, const real_2d_array &b, const bool isupperb, const ae_int_t problemtype, real_2d_array &r, bool &isupperr) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::smatrixgevdreduce(const_cast(a.c_ptr()), n, isuppera, const_cast(b.c_ptr()), isupperb, problemtype, const_cast(r.c_ptr()), &isupperr, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Inverse matrix update by the Sherman-Morrison formula - -The algorithm updates matrix A^-1 when adding a number to an element -of matrix A. - -Input parameters: - InvA - inverse of matrix A. - Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - UpdRow - row where the element to be updated is stored. - UpdColumn - column where the element to be updated is stored. - UpdVal - a number to be added to the element. - - -Output parameters: - InvA - inverse of modified matrix A. - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -void rmatrixinvupdatesimple(real_2d_array &inva, const ae_int_t n, const ae_int_t updrow, const ae_int_t updcolumn, const double updval) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixinvupdatesimple(const_cast(inva.c_ptr()), n, updrow, updcolumn, updval, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Inverse matrix update by the Sherman-Morrison formula - -The algorithm updates matrix A^-1 when adding a vector to a row -of matrix A. - -Input parameters: - InvA - inverse of matrix A. - Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - UpdRow - the row of A whose vector V was added. - 0 <= Row <= N-1 - V - the vector to be added to a row. - Array whose index ranges within [0..N-1]. - -Output parameters: - InvA - inverse of modified matrix A. - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -void rmatrixinvupdaterow(real_2d_array &inva, const ae_int_t n, const ae_int_t updrow, const real_1d_array &v) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixinvupdaterow(const_cast(inva.c_ptr()), n, updrow, const_cast(v.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Inverse matrix update by the Sherman-Morrison formula - -The algorithm updates matrix A^-1 when adding a vector to a column -of matrix A. - -Input parameters: - InvA - inverse of matrix A. - Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - UpdColumn - the column of A whose vector U was added. - 0 <= UpdColumn <= N-1 - U - the vector to be added to a column. - Array whose index ranges within [0..N-1]. - -Output parameters: - InvA - inverse of modified matrix A. - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -void rmatrixinvupdatecolumn(real_2d_array &inva, const ae_int_t n, const ae_int_t updcolumn, const real_1d_array &u) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixinvupdatecolumn(const_cast(inva.c_ptr()), n, updcolumn, const_cast(u.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Inverse matrix update by the Sherman-Morrison formula - -The algorithm computes the inverse of matrix A+u*v’ by using the given matrix -A^-1 and the vectors u and v. - -Input parameters: - InvA - inverse of matrix A. - Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - U - the vector modifying the matrix. - Array whose index ranges within [0..N-1]. - V - the vector modifying the matrix. - Array whose index ranges within [0..N-1]. - -Output parameters: - InvA - inverse of matrix A + u*v'. - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -void rmatrixinvupdateuv(real_2d_array &inva, const ae_int_t n, const real_1d_array &u, const real_1d_array &v) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixinvupdateuv(const_cast(inva.c_ptr()), n, const_cast(u.c_ptr()), const_cast(v.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Subroutine performing the Schur decomposition of a general matrix by using -the QR algorithm with multiple shifts. - -The source matrix A is represented as S'*A*S = T, where S is an orthogonal -matrix (Schur vectors), T - upper quasi-triangular matrix (with blocks of -sizes 1x1 and 2x2 on the main diagonal). - -Input parameters: - A - matrix to be decomposed. - Array whose indexes range within [0..N-1, 0..N-1]. - N - size of A, N>=0. - - -Output parameters: - A - contains matrix T. - Array whose indexes range within [0..N-1, 0..N-1]. - S - contains Schur vectors. - Array whose indexes range within [0..N-1, 0..N-1]. - -Note 1: - The block structure of matrix T can be easily recognized: since all - the elements below the blocks are zeros, the elements a[i+1,i] which - are equal to 0 show the block border. - -Note 2: - The algorithm performance depends on the value of the internal parameter - NS of the InternalSchurDecomposition subroutine which defines the number - of shifts in the QR algorithm (similarly to the block width in block-matrix - algorithms in linear algebra). If you require maximum performance on - your machine, it is recommended to adjust this parameter manually. - -Result: - True, - if the algorithm has converged and parameters A and S contain the result. - False, - if the algorithm has not converged. - -Algorithm implemented on the basis of the DHSEQR subroutine (LAPACK 3.0 library). -*************************************************************************/ -bool rmatrixschur(real_2d_array &a, const ae_int_t n, real_2d_array &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::rmatrixschur(const_cast(a.c_ptr()), n, const_cast(s.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS IMPLEMENTATION OF COMPUTATIONAL CORE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ -static ae_int_t ablas_rgemmparallelsize = 64; -static ae_int_t ablas_cgemmparallelsize = 64; -static void ablas_ablasinternalsplitlength(ae_int_t n, - ae_int_t nb, - ae_int_t* n1, - ae_int_t* n2, - ae_state *_state); -static void ablas_cmatrixrighttrsm2(ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Complex */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, - ae_state *_state); -static void ablas_cmatrixlefttrsm2(ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Complex */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, - ae_state *_state); -static void ablas_rmatrixrighttrsm2(ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Real */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, - ae_state *_state); -static void ablas_rmatrixlefttrsm2(ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Real */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, - ae_state *_state); -static void ablas_cmatrixsyrk2(ae_int_t n, - ae_int_t k, - double alpha, - /* Complex */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - double beta, - /* Complex */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_bool isupper, - ae_state *_state); -static void ablas_rmatrixsyrk2(ae_int_t n, - ae_int_t k, - double alpha, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - double beta, - /* Real */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_bool isupper, - ae_state *_state); - - -static void ortfac_cmatrixqrbasecase(/* Complex */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Complex */ ae_vector* work, - /* Complex */ ae_vector* t, - /* Complex */ ae_vector* tau, - ae_state *_state); -static void ortfac_cmatrixlqbasecase(/* Complex */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Complex */ ae_vector* work, - /* Complex */ ae_vector* t, - /* Complex */ ae_vector* tau, - ae_state *_state); -static void ortfac_rmatrixblockreflector(/* Real */ ae_matrix* a, - /* Real */ ae_vector* tau, - ae_bool columnwisea, - ae_int_t lengtha, - ae_int_t blocksize, - /* Real */ ae_matrix* t, - /* Real */ ae_vector* work, - ae_state *_state); -static void ortfac_cmatrixblockreflector(/* Complex */ ae_matrix* a, - /* Complex */ ae_vector* tau, - ae_bool columnwisea, - ae_int_t lengtha, - ae_int_t blocksize, - /* Complex */ ae_matrix* t, - /* Complex */ ae_vector* work, - ae_state *_state); - - -static ae_bool bdsvd_bidiagonalsvddecompositioninternal(/* Real */ ae_vector* d, - /* Real */ ae_vector* e, - ae_int_t n, - ae_bool isupper, - ae_bool isfractionalaccuracyrequired, - /* Real */ ae_matrix* u, - ae_int_t ustart, - ae_int_t nru, - /* Real */ ae_matrix* c, - ae_int_t cstart, - ae_int_t ncc, - /* Real */ ae_matrix* vt, - ae_int_t vstart, - ae_int_t ncvt, - ae_state *_state); -static double bdsvd_extsignbdsqr(double a, double b, ae_state *_state); -static void bdsvd_svd2x2(double f, - double g, - double h, - double* ssmin, - double* ssmax, - ae_state *_state); -static void bdsvd_svdv2x2(double f, - double g, - double h, - double* ssmin, - double* ssmax, - double* snr, - double* csr, - double* snl, - double* csl, - ae_state *_state); - - - - -static ae_bool evd_tridiagonalevd(/* Real */ ae_vector* d, - /* Real */ ae_vector* e, - ae_int_t n, - ae_int_t zneeded, - /* Real */ ae_matrix* z, - ae_state *_state); -static void evd_tdevde2(double a, - double b, - double c, - double* rt1, - double* rt2, - ae_state *_state); -static void evd_tdevdev2(double a, - double b, - double c, - double* rt1, - double* rt2, - double* cs1, - double* sn1, - ae_state *_state); -static double evd_tdevdpythag(double a, double b, ae_state *_state); -static double evd_tdevdextsign(double a, double b, ae_state *_state); -static ae_bool evd_internalbisectioneigenvalues(/* Real */ ae_vector* d, - /* Real */ ae_vector* e, - ae_int_t n, - ae_int_t irange, - ae_int_t iorder, - double vl, - double vu, - ae_int_t il, - ae_int_t iu, - double abstol, - /* Real */ ae_vector* w, - ae_int_t* m, - ae_int_t* nsplit, - /* Integer */ ae_vector* iblock, - /* Integer */ ae_vector* isplit, - ae_int_t* errorcode, - ae_state *_state); -static void evd_internaldstein(ae_int_t n, - /* Real */ ae_vector* d, - /* Real */ ae_vector* e, - ae_int_t m, - /* Real */ ae_vector* w, - /* Integer */ ae_vector* iblock, - /* Integer */ ae_vector* isplit, - /* Real */ ae_matrix* z, - /* Integer */ ae_vector* ifail, - ae_int_t* info, - ae_state *_state); -static void evd_tdininternaldlagtf(ae_int_t n, - /* Real */ ae_vector* a, - double lambdav, - /* Real */ ae_vector* b, - /* Real */ ae_vector* c, - double tol, - /* Real */ ae_vector* d, - /* Integer */ ae_vector* iin, - ae_int_t* info, - ae_state *_state); -static void evd_tdininternaldlagts(ae_int_t n, - /* Real */ ae_vector* a, - /* Real */ ae_vector* b, - /* Real */ ae_vector* c, - /* Real */ ae_vector* d, - /* Integer */ ae_vector* iin, - /* Real */ ae_vector* y, - double* tol, - ae_int_t* info, - ae_state *_state); -static void evd_internaldlaebz(ae_int_t ijob, - ae_int_t nitmax, - ae_int_t n, - ae_int_t mmax, - ae_int_t minp, - double abstol, - double reltol, - double pivmin, - /* Real */ ae_vector* d, - /* Real */ ae_vector* e, - /* Real */ ae_vector* e2, - /* Integer */ ae_vector* nval, - /* Real */ ae_matrix* ab, - /* Real */ ae_vector* c, - ae_int_t* mout, - /* Integer */ ae_matrix* nab, - /* Real */ ae_vector* work, - /* Integer */ ae_vector* iwork, - ae_int_t* info, - ae_state *_state); -static void evd_internaltrevc(/* Real */ ae_matrix* t, - ae_int_t n, - ae_int_t side, - ae_int_t howmny, - /* Boolean */ ae_vector* vselect, - /* Real */ ae_matrix* vl, - /* Real */ ae_matrix* vr, - ae_int_t* m, - ae_int_t* info, - ae_state *_state); -static void evd_internalhsevdlaln2(ae_bool ltrans, - ae_int_t na, - ae_int_t nw, - double smin, - double ca, - /* Real */ ae_matrix* a, - double d1, - double d2, - /* Real */ ae_matrix* b, - double wr, - double wi, - /* Boolean */ ae_vector* rswap4, - /* Boolean */ ae_vector* zswap4, - /* Integer */ ae_matrix* ipivot44, - /* Real */ ae_vector* civ4, - /* Real */ ae_vector* crv4, - /* Real */ ae_matrix* x, - double* scl, - double* xnorm, - ae_int_t* info, - ae_state *_state); -static void evd_internalhsevdladiv(double a, - double b, - double c, - double d, - double* p, - double* q, - ae_state *_state); -static ae_bool evd_nonsymmetricevd(/* Real */ ae_matrix* a, - ae_int_t n, - ae_int_t vneeded, - /* Real */ ae_vector* wr, - /* Real */ ae_vector* wi, - /* Real */ ae_matrix* vl, - /* Real */ ae_matrix* vr, - ae_state *_state); -static void evd_toupperhessenberg(/* Real */ ae_matrix* a, - ae_int_t n, - /* Real */ ae_vector* tau, - ae_state *_state); -static void evd_unpackqfromupperhessenberg(/* Real */ ae_matrix* a, - ae_int_t n, - /* Real */ ae_vector* tau, - /* Real */ ae_matrix* q, - ae_state *_state); - - - - -static void trfac_cmatrixluprec(/* Complex */ ae_matrix* a, - ae_int_t offs, - ae_int_t m, - ae_int_t n, - /* Integer */ ae_vector* pivots, - /* Complex */ ae_vector* tmp, - ae_state *_state); -static void trfac_rmatrixluprec(/* Real */ ae_matrix* a, - ae_int_t offs, - ae_int_t m, - ae_int_t n, - /* Integer */ ae_vector* pivots, - /* Real */ ae_vector* tmp, - ae_state *_state); -static void trfac_cmatrixplurec(/* Complex */ ae_matrix* a, - ae_int_t offs, - ae_int_t m, - ae_int_t n, - /* Integer */ ae_vector* pivots, - /* Complex */ ae_vector* tmp, - ae_state *_state); -static void trfac_rmatrixplurec(/* Real */ ae_matrix* a, - ae_int_t offs, - ae_int_t m, - ae_int_t n, - /* Integer */ ae_vector* pivots, - /* Real */ ae_vector* tmp, - ae_state *_state); -static void trfac_cmatrixlup2(/* Complex */ ae_matrix* a, - ae_int_t offs, - ae_int_t m, - ae_int_t n, - /* Integer */ ae_vector* pivots, - /* Complex */ ae_vector* tmp, - ae_state *_state); -static void trfac_rmatrixlup2(/* Real */ ae_matrix* a, - ae_int_t offs, - ae_int_t m, - ae_int_t n, - /* Integer */ ae_vector* pivots, - /* Real */ ae_vector* tmp, - ae_state *_state); -static void trfac_cmatrixplu2(/* Complex */ ae_matrix* a, - ae_int_t offs, - ae_int_t m, - ae_int_t n, - /* Integer */ ae_vector* pivots, - /* Complex */ ae_vector* tmp, - ae_state *_state); -static void trfac_rmatrixplu2(/* Real */ ae_matrix* a, - ae_int_t offs, - ae_int_t m, - ae_int_t n, - /* Integer */ ae_vector* pivots, - /* Real */ ae_vector* tmp, - ae_state *_state); -static ae_bool trfac_hpdmatrixcholeskyrec(/* Complex */ ae_matrix* a, - ae_int_t offs, - ae_int_t n, - ae_bool isupper, - /* Complex */ ae_vector* tmp, - ae_state *_state); -static ae_bool trfac_hpdmatrixcholesky2(/* Complex */ ae_matrix* aaa, - ae_int_t offs, - ae_int_t n, - ae_bool isupper, - /* Complex */ ae_vector* tmp, - ae_state *_state); -static ae_bool trfac_spdmatrixcholesky2(/* Real */ ae_matrix* aaa, - ae_int_t offs, - ae_int_t n, - ae_bool isupper, - /* Real */ ae_vector* tmp, - ae_state *_state); - - -static void rcond_rmatrixrcondtrinternal(/* Real */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_bool isunit, - ae_bool onenorm, - double anorm, - double* rc, - ae_state *_state); -static void rcond_cmatrixrcondtrinternal(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_bool isunit, - ae_bool onenorm, - double anorm, - double* rc, - ae_state *_state); -static void rcond_spdmatrixrcondcholeskyinternal(/* Real */ ae_matrix* cha, - ae_int_t n, - ae_bool isupper, - ae_bool isnormprovided, - double anorm, - double* rc, - ae_state *_state); -static void rcond_hpdmatrixrcondcholeskyinternal(/* Complex */ ae_matrix* cha, - ae_int_t n, - ae_bool isupper, - ae_bool isnormprovided, - double anorm, - double* rc, - ae_state *_state); -static void rcond_rmatrixrcondluinternal(/* Real */ ae_matrix* lua, - ae_int_t n, - ae_bool onenorm, - ae_bool isanormprovided, - double anorm, - double* rc, - ae_state *_state); -static void rcond_cmatrixrcondluinternal(/* Complex */ ae_matrix* lua, - ae_int_t n, - ae_bool onenorm, - ae_bool isanormprovided, - double anorm, - double* rc, - ae_state *_state); -static void rcond_rmatrixestimatenorm(ae_int_t n, - /* Real */ ae_vector* v, - /* Real */ ae_vector* x, - /* Integer */ ae_vector* isgn, - double* est, - ae_int_t* kase, - ae_state *_state); -static void rcond_cmatrixestimatenorm(ae_int_t n, - /* Complex */ ae_vector* v, - /* Complex */ ae_vector* x, - double* est, - ae_int_t* kase, - /* Integer */ ae_vector* isave, - /* Real */ ae_vector* rsave, - ae_state *_state); -static double rcond_internalcomplexrcondscsum1(/* Complex */ ae_vector* x, - ae_int_t n, - ae_state *_state); -static ae_int_t rcond_internalcomplexrcondicmax1(/* Complex */ ae_vector* x, - ae_int_t n, - ae_state *_state); -static void rcond_internalcomplexrcondsaveall(/* Integer */ ae_vector* isave, - /* Real */ ae_vector* rsave, - ae_int_t* i, - ae_int_t* iter, - ae_int_t* j, - ae_int_t* jlast, - ae_int_t* jump, - double* absxi, - double* altsgn, - double* estold, - double* temp, - ae_state *_state); -static void rcond_internalcomplexrcondloadall(/* Integer */ ae_vector* isave, - /* Real */ ae_vector* rsave, - ae_int_t* i, - ae_int_t* iter, - ae_int_t* j, - ae_int_t* jlast, - ae_int_t* jump, - double* absxi, - double* altsgn, - double* estold, - double* temp, - ae_state *_state); - - -static void matinv_rmatrixtrinverserec(/* Real */ ae_matrix* a, - ae_int_t offs, - ae_int_t n, - ae_bool isupper, - ae_bool isunit, - /* Real */ ae_vector* tmp, - ae_int_t* info, - matinvreport* rep, - ae_state *_state); -static void matinv_cmatrixtrinverserec(/* Complex */ ae_matrix* a, - ae_int_t offs, - ae_int_t n, - ae_bool isupper, - ae_bool isunit, - /* Complex */ ae_vector* tmp, - ae_int_t* info, - matinvreport* rep, - ae_state *_state); -static void matinv_rmatrixluinverserec(/* Real */ ae_matrix* a, - ae_int_t offs, - ae_int_t n, - /* Real */ ae_vector* work, - ae_int_t* info, - matinvreport* rep, - ae_state *_state); -static void matinv_cmatrixluinverserec(/* Complex */ ae_matrix* a, - ae_int_t offs, - ae_int_t n, - /* Complex */ ae_vector* work, - ae_int_t* info, - matinvreport* rep, - ae_state *_state); -static void matinv_spdmatrixcholeskyinverserec(/* Real */ ae_matrix* a, - ae_int_t offs, - ae_int_t n, - ae_bool isupper, - /* Real */ ae_vector* tmp, - ae_state *_state); -static void matinv_hpdmatrixcholeskyinverserec(/* Complex */ ae_matrix* a, - ae_int_t offs, - ae_int_t n, - ae_bool isupper, - /* Complex */ ae_vector* tmp, - ae_state *_state); - - -static double sparse_desiredloadfactor = 0.66; -static double sparse_maxloadfactor = 0.75; -static double sparse_growfactor = 2.00; -static ae_int_t sparse_additional = 10; -static ae_int_t sparse_linalgswitch = 16; -static void sparse_sparseinitduidx(sparsematrix* s, ae_state *_state); -static ae_int_t sparse_hash(ae_int_t i, - ae_int_t j, - ae_int_t tabsize, - ae_state *_state); - - - - - - - - - - - - - - - - - -/************************************************************************* -Splits matrix length in two parts, left part should match ABLAS block size - -INPUT PARAMETERS - A - real matrix, is passed to ensure that we didn't split - complex matrix using real splitting subroutine. - matrix itself is not changed. - N - length, N>0 - -OUTPUT PARAMETERS - N1 - length - N2 - length - -N1+N2=N, N1>=N2, N2 may be zero - - -- ALGLIB routine -- - 15.12.2009 - Bochkanov Sergey -*************************************************************************/ -void ablassplitlength(/* Real */ ae_matrix* a, - ae_int_t n, - ae_int_t* n1, - ae_int_t* n2, - ae_state *_state) -{ - - *n1 = 0; - *n2 = 0; - - if( n>ablasblocksize(a, _state) ) - { - ablas_ablasinternalsplitlength(n, ablasblocksize(a, _state), n1, n2, _state); - } - else - { - ablas_ablasinternalsplitlength(n, ablasmicroblocksize(_state), n1, n2, _state); - } -} - - -/************************************************************************* -Complex ABLASSplitLength - - -- ALGLIB routine -- - 15.12.2009 - Bochkanov Sergey -*************************************************************************/ -void ablascomplexsplitlength(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_int_t* n1, - ae_int_t* n2, - ae_state *_state) -{ - - *n1 = 0; - *n2 = 0; - - if( n>ablascomplexblocksize(a, _state) ) - { - ablas_ablasinternalsplitlength(n, ablascomplexblocksize(a, _state), n1, n2, _state); - } - else - { - ablas_ablasinternalsplitlength(n, ablasmicroblocksize(_state), n1, n2, _state); - } -} - - -/************************************************************************* -Returns block size - subdivision size where cache-oblivious soubroutines -switch to the optimized kernel. - -INPUT PARAMETERS - A - real matrix, is passed to ensure that we didn't split - complex matrix using real splitting subroutine. - matrix itself is not changed. - - -- ALGLIB routine -- - 15.12.2009 - Bochkanov Sergey -*************************************************************************/ -ae_int_t ablasblocksize(/* Real */ ae_matrix* a, ae_state *_state) -{ - ae_int_t result; - - - result = 32; - return result; -} - - -/************************************************************************* -Block size for complex subroutines. - - -- ALGLIB routine -- - 15.12.2009 - Bochkanov Sergey -*************************************************************************/ -ae_int_t ablascomplexblocksize(/* Complex */ ae_matrix* a, - ae_state *_state) -{ - ae_int_t result; - - - result = 24; - return result; -} - - -/************************************************************************* -Microblock size - - -- ALGLIB routine -- - 15.12.2009 - Bochkanov Sergey -*************************************************************************/ -ae_int_t ablasmicroblocksize(ae_state *_state) -{ - ae_int_t result; - - - result = 8; - return result; -} - - -/************************************************************************* -Cache-oblivous complex "copy-and-transpose" - -Input parameters: - M - number of rows - N - number of columns - A - source matrix, MxN submatrix is copied and transposed - IA - submatrix offset (row index) - JA - submatrix offset (column index) - B - destination matrix, must be large enough to store result - IB - submatrix offset (row index) - JB - submatrix offset (column index) -*************************************************************************/ -void cmatrixtranspose(ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - /* Complex */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - ae_state *_state) -{ - ae_int_t i; - ae_int_t s1; - ae_int_t s2; - - - if( m<=2*ablascomplexblocksize(a, _state)&&n<=2*ablascomplexblocksize(a, _state) ) - { - - /* - * base case - */ - for(i=0; i<=m-1; i++) - { - ae_v_cmove(&b->ptr.pp_complex[ib][jb+i], b->stride, &a->ptr.pp_complex[ia+i][ja], 1, "N", ae_v_len(ib,ib+n-1)); - } - } - else - { - - /* - * Cache-oblivious recursion - */ - if( m>n ) - { - ablascomplexsplitlength(a, m, &s1, &s2, _state); - cmatrixtranspose(s1, n, a, ia, ja, b, ib, jb, _state); - cmatrixtranspose(s2, n, a, ia+s1, ja, b, ib, jb+s1, _state); - } - else - { - ablascomplexsplitlength(a, n, &s1, &s2, _state); - cmatrixtranspose(m, s1, a, ia, ja, b, ib, jb, _state); - cmatrixtranspose(m, s2, a, ia, ja+s1, b, ib+s1, jb, _state); - } - } -} - - -/************************************************************************* -Cache-oblivous real "copy-and-transpose" - -Input parameters: - M - number of rows - N - number of columns - A - source matrix, MxN submatrix is copied and transposed - IA - submatrix offset (row index) - JA - submatrix offset (column index) - B - destination matrix, must be large enough to store result - IB - submatrix offset (row index) - JB - submatrix offset (column index) -*************************************************************************/ -void rmatrixtranspose(ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - /* Real */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - ae_state *_state) -{ - ae_int_t i; - ae_int_t s1; - ae_int_t s2; - - - if( m<=2*ablasblocksize(a, _state)&&n<=2*ablasblocksize(a, _state) ) - { - - /* - * base case - */ - for(i=0; i<=m-1; i++) - { - ae_v_move(&b->ptr.pp_double[ib][jb+i], b->stride, &a->ptr.pp_double[ia+i][ja], 1, ae_v_len(ib,ib+n-1)); - } - } - else - { - - /* - * Cache-oblivious recursion - */ - if( m>n ) - { - ablassplitlength(a, m, &s1, &s2, _state); - rmatrixtranspose(s1, n, a, ia, ja, b, ib, jb, _state); - rmatrixtranspose(s2, n, a, ia+s1, ja, b, ib, jb+s1, _state); - } - else - { - ablassplitlength(a, n, &s1, &s2, _state); - rmatrixtranspose(m, s1, a, ia, ja, b, ib, jb, _state); - rmatrixtranspose(m, s2, a, ia, ja+s1, b, ib+s1, jb, _state); - } - } -} - - -/************************************************************************* -This code enforces symmetricy of the matrix by copying Upper part to lower -one (or vice versa). - -INPUT PARAMETERS: - A - matrix - N - number of rows/columns - IsUpper - whether we want to copy upper triangle to lower one (True) - or vice versa (False). -*************************************************************************/ -void rmatrixenforcesymmetricity(/* Real */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - - - if( isupper ) - { - for(i=0; i<=n-1; i++) - { - for(j=i+1; j<=n-1; j++) - { - a->ptr.pp_double[j][i] = a->ptr.pp_double[i][j]; - } - } - } - else - { - for(i=0; i<=n-1; i++) - { - for(j=i+1; j<=n-1; j++) - { - a->ptr.pp_double[i][j] = a->ptr.pp_double[j][i]; - } - } - } -} - - -/************************************************************************* -Copy - -Input parameters: - M - number of rows - N - number of columns - A - source matrix, MxN submatrix is copied and transposed - IA - submatrix offset (row index) - JA - submatrix offset (column index) - B - destination matrix, must be large enough to store result - IB - submatrix offset (row index) - JB - submatrix offset (column index) -*************************************************************************/ -void cmatrixcopy(ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - /* Complex */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - ae_state *_state) -{ - ae_int_t i; - - - if( m==0||n==0 ) - { - return; - } - for(i=0; i<=m-1; i++) - { - ae_v_cmove(&b->ptr.pp_complex[ib+i][jb], 1, &a->ptr.pp_complex[ia+i][ja], 1, "N", ae_v_len(jb,jb+n-1)); - } -} - - -/************************************************************************* -Copy - -Input parameters: - M - number of rows - N - number of columns - A - source matrix, MxN submatrix is copied and transposed - IA - submatrix offset (row index) - JA - submatrix offset (column index) - B - destination matrix, must be large enough to store result - IB - submatrix offset (row index) - JB - submatrix offset (column index) -*************************************************************************/ -void rmatrixcopy(ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - /* Real */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - ae_state *_state) -{ - ae_int_t i; - - - if( m==0||n==0 ) - { - return; - } - for(i=0; i<=m-1; i++) - { - ae_v_move(&b->ptr.pp_double[ib+i][jb], 1, &a->ptr.pp_double[ia+i][ja], 1, ae_v_len(jb,jb+n-1)); - } -} - - -/************************************************************************* -Rank-1 correction: A := A + u*v' - -INPUT PARAMETERS: - M - number of rows - N - number of columns - A - target matrix, MxN submatrix is updated - IA - submatrix offset (row index) - JA - submatrix offset (column index) - U - vector #1 - IU - subvector offset - V - vector #2 - IV - subvector offset -*************************************************************************/ -void cmatrixrank1(ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - /* Complex */ ae_vector* u, - ae_int_t iu, - /* Complex */ ae_vector* v, - ae_int_t iv, - ae_state *_state) -{ - ae_int_t i; - ae_complex s; - - - if( m==0||n==0 ) - { - return; - } - if( cmatrixrank1f(m, n, a, ia, ja, u, iu, v, iv, _state) ) - { - return; - } - for(i=0; i<=m-1; i++) - { - s = u->ptr.p_complex[iu+i]; - ae_v_caddc(&a->ptr.pp_complex[ia+i][ja], 1, &v->ptr.p_complex[iv], 1, "N", ae_v_len(ja,ja+n-1), s); - } -} - - -/************************************************************************* -Rank-1 correction: A := A + u*v' - -INPUT PARAMETERS: - M - number of rows - N - number of columns - A - target matrix, MxN submatrix is updated - IA - submatrix offset (row index) - JA - submatrix offset (column index) - U - vector #1 - IU - subvector offset - V - vector #2 - IV - subvector offset -*************************************************************************/ -void rmatrixrank1(ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - /* Real */ ae_vector* u, - ae_int_t iu, - /* Real */ ae_vector* v, - ae_int_t iv, - ae_state *_state) -{ - ae_int_t i; - double s; - - - if( m==0||n==0 ) - { - return; - } - if( rmatrixrank1f(m, n, a, ia, ja, u, iu, v, iv, _state) ) - { - return; - } - for(i=0; i<=m-1; i++) - { - s = u->ptr.p_double[iu+i]; - ae_v_addd(&a->ptr.pp_double[ia+i][ja], 1, &v->ptr.p_double[iv], 1, ae_v_len(ja,ja+n-1), s); - } -} - - -/************************************************************************* -Matrix-vector product: y := op(A)*x - -INPUT PARAMETERS: - M - number of rows of op(A) - M>=0 - N - number of columns of op(A) - N>=0 - A - target matrix - IA - submatrix offset (row index) - JA - submatrix offset (column index) - OpA - operation type: - * OpA=0 => op(A) = A - * OpA=1 => op(A) = A^T - * OpA=2 => op(A) = A^H - X - input vector - IX - subvector offset - IY - subvector offset - Y - preallocated matrix, must be large enough to store result - -OUTPUT PARAMETERS: - Y - vector which stores result - -if M=0, then subroutine does nothing. -if N=0, Y is filled by zeros. - - - -- ALGLIB routine -- - - 28.01.2010 - Bochkanov Sergey -*************************************************************************/ -void cmatrixmv(ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t opa, - /* Complex */ ae_vector* x, - ae_int_t ix, - /* Complex */ ae_vector* y, - ae_int_t iy, - ae_state *_state) -{ - ae_int_t i; - ae_complex v; - - - if( m==0 ) - { - return; - } - if( n==0 ) - { - for(i=0; i<=m-1; i++) - { - y->ptr.p_complex[iy+i] = ae_complex_from_d(0); - } - return; - } - if( cmatrixmvf(m, n, a, ia, ja, opa, x, ix, y, iy, _state) ) - { - return; - } - if( opa==0 ) - { - - /* - * y = A*x - */ - for(i=0; i<=m-1; i++) - { - v = ae_v_cdotproduct(&a->ptr.pp_complex[ia+i][ja], 1, "N", &x->ptr.p_complex[ix], 1, "N", ae_v_len(ja,ja+n-1)); - y->ptr.p_complex[iy+i] = v; - } - return; - } - if( opa==1 ) - { - - /* - * y = A^T*x - */ - for(i=0; i<=m-1; i++) - { - y->ptr.p_complex[iy+i] = ae_complex_from_d(0); - } - for(i=0; i<=n-1; i++) - { - v = x->ptr.p_complex[ix+i]; - ae_v_caddc(&y->ptr.p_complex[iy], 1, &a->ptr.pp_complex[ia+i][ja], 1, "N", ae_v_len(iy,iy+m-1), v); - } - return; - } - if( opa==2 ) - { - - /* - * y = A^H*x - */ - for(i=0; i<=m-1; i++) - { - y->ptr.p_complex[iy+i] = ae_complex_from_d(0); - } - for(i=0; i<=n-1; i++) - { - v = x->ptr.p_complex[ix+i]; - ae_v_caddc(&y->ptr.p_complex[iy], 1, &a->ptr.pp_complex[ia+i][ja], 1, "Conj", ae_v_len(iy,iy+m-1), v); - } - return; - } -} - - -/************************************************************************* -Matrix-vector product: y := op(A)*x - -INPUT PARAMETERS: - M - number of rows of op(A) - N - number of columns of op(A) - A - target matrix - IA - submatrix offset (row index) - JA - submatrix offset (column index) - OpA - operation type: - * OpA=0 => op(A) = A - * OpA=1 => op(A) = A^T - X - input vector - IX - subvector offset - IY - subvector offset - Y - preallocated matrix, must be large enough to store result - -OUTPUT PARAMETERS: - Y - vector which stores result - -if M=0, then subroutine does nothing. -if N=0, Y is filled by zeros. - - - -- ALGLIB routine -- - - 28.01.2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixmv(ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t opa, - /* Real */ ae_vector* x, - ae_int_t ix, - /* Real */ ae_vector* y, - ae_int_t iy, - ae_state *_state) -{ - ae_int_t i; - double v; - - - if( m==0 ) - { - return; - } - if( n==0 ) - { - for(i=0; i<=m-1; i++) - { - y->ptr.p_double[iy+i] = 0; - } - return; - } - if( rmatrixmvf(m, n, a, ia, ja, opa, x, ix, y, iy, _state) ) - { - return; - } - if( opa==0 ) - { - - /* - * y = A*x - */ - for(i=0; i<=m-1; i++) - { - v = ae_v_dotproduct(&a->ptr.pp_double[ia+i][ja], 1, &x->ptr.p_double[ix], 1, ae_v_len(ja,ja+n-1)); - y->ptr.p_double[iy+i] = v; - } - return; - } - if( opa==1 ) - { - - /* - * y = A^T*x - */ - for(i=0; i<=m-1; i++) - { - y->ptr.p_double[iy+i] = 0; - } - for(i=0; i<=n-1; i++) - { - v = x->ptr.p_double[ix+i]; - ae_v_addd(&y->ptr.p_double[iy], 1, &a->ptr.pp_double[ia+i][ja], 1, ae_v_len(iy,iy+m-1), v); - } - return; - } -} - - -void cmatrixrighttrsm(ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Complex */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, - ae_state *_state) -{ - ae_int_t s1; - ae_int_t s2; - ae_int_t bs; - - - bs = ablascomplexblocksize(a, _state); - if( m<=bs&&n<=bs ) - { - ablas_cmatrixrighttrsm2(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); - return; - } - if( m>=n ) - { - - /* - * Split X: X*A = (X1 X2)^T*A - */ - ablascomplexsplitlength(a, m, &s1, &s2, _state); - cmatrixrighttrsm(s1, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); - cmatrixrighttrsm(s2, n, a, i1, j1, isupper, isunit, optype, x, i2+s1, j2, _state); - return; - } - else - { - - /* - * Split A: - * (A1 A12) - * X*op(A) = X*op( ) - * ( A2) - * - * Different variants depending on - * IsUpper/OpType combinations - */ - ablascomplexsplitlength(a, n, &s1, &s2, _state); - if( isupper&&optype==0 ) - { - - /* - * (A1 A12)-1 - * X*A^-1 = (X1 X2)*( ) - * ( A2) - */ - cmatrixrighttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); - cmatrixgemm(m, s2, s1, ae_complex_from_d(-1.0), x, i2, j2, 0, a, i1, j1+s1, 0, ae_complex_from_d(1.0), x, i2, j2+s1, _state); - cmatrixrighttrsm(m, s2, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2, j2+s1, _state); - return; - } - if( isupper&&optype!=0 ) - { - - /* - * (A1' )-1 - * X*A^-1 = (X1 X2)*( ) - * (A12' A2') - */ - cmatrixrighttrsm(m, s2, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2, j2+s1, _state); - cmatrixgemm(m, s1, s2, ae_complex_from_d(-1.0), x, i2, j2+s1, 0, a, i1, j1+s1, optype, ae_complex_from_d(1.0), x, i2, j2, _state); - cmatrixrighttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); - return; - } - if( !isupper&&optype==0 ) - { - - /* - * (A1 )-1 - * X*A^-1 = (X1 X2)*( ) - * (A21 A2) - */ - cmatrixrighttrsm(m, s2, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2, j2+s1, _state); - cmatrixgemm(m, s1, s2, ae_complex_from_d(-1.0), x, i2, j2+s1, 0, a, i1+s1, j1, 0, ae_complex_from_d(1.0), x, i2, j2, _state); - cmatrixrighttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); - return; - } - if( !isupper&&optype!=0 ) - { - - /* - * (A1' A21')-1 - * X*A^-1 = (X1 X2)*( ) - * ( A2') - */ - cmatrixrighttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); - cmatrixgemm(m, s2, s1, ae_complex_from_d(-1.0), x, i2, j2, 0, a, i1+s1, j1, optype, ae_complex_from_d(1.0), x, i2, j2+s1, _state); - cmatrixrighttrsm(m, s2, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2, j2+s1, _state); - return; - } - } -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -void _pexec_cmatrixrighttrsm(ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Complex */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, ae_state *_state) -{ - cmatrixrighttrsm(m,n,a,i1,j1,isupper,isunit,optype,x,i2,j2, _state); -} - - -void cmatrixlefttrsm(ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Complex */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, - ae_state *_state) -{ - ae_int_t s1; - ae_int_t s2; - ae_int_t bs; - - - bs = ablascomplexblocksize(a, _state); - if( m<=bs&&n<=bs ) - { - ablas_cmatrixlefttrsm2(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); - return; - } - if( n>=m ) - { - - /* - * Split X: op(A)^-1*X = op(A)^-1*(X1 X2) - */ - ablascomplexsplitlength(x, n, &s1, &s2, _state); - cmatrixlefttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); - cmatrixlefttrsm(m, s2, a, i1, j1, isupper, isunit, optype, x, i2, j2+s1, _state); - return; - } - else - { - - /* - * Split A - */ - ablascomplexsplitlength(a, m, &s1, &s2, _state); - if( isupper&&optype==0 ) - { - - /* - * (A1 A12)-1 ( X1 ) - * A^-1*X* = ( ) *( ) - * ( A2) ( X2 ) - */ - cmatrixlefttrsm(s2, n, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2+s1, j2, _state); - cmatrixgemm(s1, n, s2, ae_complex_from_d(-1.0), a, i1, j1+s1, 0, x, i2+s1, j2, 0, ae_complex_from_d(1.0), x, i2, j2, _state); - cmatrixlefttrsm(s1, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); - return; - } - if( isupper&&optype!=0 ) - { - - /* - * (A1' )-1 ( X1 ) - * A^-1*X = ( ) *( ) - * (A12' A2') ( X2 ) - */ - cmatrixlefttrsm(s1, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); - cmatrixgemm(s2, n, s1, ae_complex_from_d(-1.0), a, i1, j1+s1, optype, x, i2, j2, 0, ae_complex_from_d(1.0), x, i2+s1, j2, _state); - cmatrixlefttrsm(s2, n, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2+s1, j2, _state); - return; - } - if( !isupper&&optype==0 ) - { - - /* - * (A1 )-1 ( X1 ) - * A^-1*X = ( ) *( ) - * (A21 A2) ( X2 ) - */ - cmatrixlefttrsm(s1, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); - cmatrixgemm(s2, n, s1, ae_complex_from_d(-1.0), a, i1+s1, j1, 0, x, i2, j2, 0, ae_complex_from_d(1.0), x, i2+s1, j2, _state); - cmatrixlefttrsm(s2, n, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2+s1, j2, _state); - return; - } - if( !isupper&&optype!=0 ) - { - - /* - * (A1' A21')-1 ( X1 ) - * A^-1*X = ( ) *( ) - * ( A2') ( X2 ) - */ - cmatrixlefttrsm(s2, n, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2+s1, j2, _state); - cmatrixgemm(s1, n, s2, ae_complex_from_d(-1.0), a, i1+s1, j1, optype, x, i2+s1, j2, 0, ae_complex_from_d(1.0), x, i2, j2, _state); - cmatrixlefttrsm(s1, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); - return; - } - } -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -void _pexec_cmatrixlefttrsm(ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Complex */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, ae_state *_state) -{ - cmatrixlefttrsm(m,n,a,i1,j1,isupper,isunit,optype,x,i2,j2, _state); -} - - -void rmatrixrighttrsm(ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Real */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, - ae_state *_state) -{ - ae_int_t s1; - ae_int_t s2; - ae_int_t bs; - - - bs = ablasblocksize(a, _state); - if( m<=bs&&n<=bs ) - { - ablas_rmatrixrighttrsm2(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); - return; - } - if( m>=n ) - { - - /* - * Split X: X*A = (X1 X2)^T*A - */ - ablassplitlength(a, m, &s1, &s2, _state); - rmatrixrighttrsm(s1, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); - rmatrixrighttrsm(s2, n, a, i1, j1, isupper, isunit, optype, x, i2+s1, j2, _state); - return; - } - else - { - - /* - * Split A: - * (A1 A12) - * X*op(A) = X*op( ) - * ( A2) - * - * Different variants depending on - * IsUpper/OpType combinations - */ - ablassplitlength(a, n, &s1, &s2, _state); - if( isupper&&optype==0 ) - { - - /* - * (A1 A12)-1 - * X*A^-1 = (X1 X2)*( ) - * ( A2) - */ - rmatrixrighttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); - rmatrixgemm(m, s2, s1, -1.0, x, i2, j2, 0, a, i1, j1+s1, 0, 1.0, x, i2, j2+s1, _state); - rmatrixrighttrsm(m, s2, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2, j2+s1, _state); - return; - } - if( isupper&&optype!=0 ) - { - - /* - * (A1' )-1 - * X*A^-1 = (X1 X2)*( ) - * (A12' A2') - */ - rmatrixrighttrsm(m, s2, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2, j2+s1, _state); - rmatrixgemm(m, s1, s2, -1.0, x, i2, j2+s1, 0, a, i1, j1+s1, optype, 1.0, x, i2, j2, _state); - rmatrixrighttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); - return; - } - if( !isupper&&optype==0 ) - { - - /* - * (A1 )-1 - * X*A^-1 = (X1 X2)*( ) - * (A21 A2) - */ - rmatrixrighttrsm(m, s2, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2, j2+s1, _state); - rmatrixgemm(m, s1, s2, -1.0, x, i2, j2+s1, 0, a, i1+s1, j1, 0, 1.0, x, i2, j2, _state); - rmatrixrighttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); - return; - } - if( !isupper&&optype!=0 ) - { - - /* - * (A1' A21')-1 - * X*A^-1 = (X1 X2)*( ) - * ( A2') - */ - rmatrixrighttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); - rmatrixgemm(m, s2, s1, -1.0, x, i2, j2, 0, a, i1+s1, j1, optype, 1.0, x, i2, j2+s1, _state); - rmatrixrighttrsm(m, s2, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2, j2+s1, _state); - return; - } - } -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -void _pexec_rmatrixrighttrsm(ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Real */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, ae_state *_state) -{ - rmatrixrighttrsm(m,n,a,i1,j1,isupper,isunit,optype,x,i2,j2, _state); -} - - -void rmatrixlefttrsm(ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Real */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, - ae_state *_state) -{ - ae_int_t s1; - ae_int_t s2; - ae_int_t bs; - - - bs = ablasblocksize(a, _state); - if( m<=bs&&n<=bs ) - { - ablas_rmatrixlefttrsm2(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); - return; - } - if( n>=m ) - { - - /* - * Split X: op(A)^-1*X = op(A)^-1*(X1 X2) - */ - ablassplitlength(x, n, &s1, &s2, _state); - rmatrixlefttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); - rmatrixlefttrsm(m, s2, a, i1, j1, isupper, isunit, optype, x, i2, j2+s1, _state); - } - else - { - - /* - * Split A - */ - ablassplitlength(a, m, &s1, &s2, _state); - if( isupper&&optype==0 ) - { - - /* - * (A1 A12)-1 ( X1 ) - * A^-1*X* = ( ) *( ) - * ( A2) ( X2 ) - */ - rmatrixlefttrsm(s2, n, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2+s1, j2, _state); - rmatrixgemm(s1, n, s2, -1.0, a, i1, j1+s1, 0, x, i2+s1, j2, 0, 1.0, x, i2, j2, _state); - rmatrixlefttrsm(s1, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); - return; - } - if( isupper&&optype!=0 ) - { - - /* - * (A1' )-1 ( X1 ) - * A^-1*X = ( ) *( ) - * (A12' A2') ( X2 ) - */ - rmatrixlefttrsm(s1, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); - rmatrixgemm(s2, n, s1, -1.0, a, i1, j1+s1, optype, x, i2, j2, 0, 1.0, x, i2+s1, j2, _state); - rmatrixlefttrsm(s2, n, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2+s1, j2, _state); - return; - } - if( !isupper&&optype==0 ) - { - - /* - * (A1 )-1 ( X1 ) - * A^-1*X = ( ) *( ) - * (A21 A2) ( X2 ) - */ - rmatrixlefttrsm(s1, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); - rmatrixgemm(s2, n, s1, -1.0, a, i1+s1, j1, 0, x, i2, j2, 0, 1.0, x, i2+s1, j2, _state); - rmatrixlefttrsm(s2, n, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2+s1, j2, _state); - return; - } - if( !isupper&&optype!=0 ) - { - - /* - * (A1' A21')-1 ( X1 ) - * A^-1*X = ( ) *( ) - * ( A2') ( X2 ) - */ - rmatrixlefttrsm(s2, n, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2+s1, j2, _state); - rmatrixgemm(s1, n, s2, -1.0, a, i1+s1, j1, optype, x, i2+s1, j2, 0, 1.0, x, i2, j2, _state); - rmatrixlefttrsm(s1, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); - return; - } - } -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -void _pexec_rmatrixlefttrsm(ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Real */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, ae_state *_state) -{ - rmatrixlefttrsm(m,n,a,i1,j1,isupper,isunit,optype,x,i2,j2, _state); -} - - -void cmatrixsyrk(ae_int_t n, - ae_int_t k, - double alpha, - /* Complex */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - double beta, - /* Complex */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_bool isupper, - ae_state *_state) -{ - ae_int_t s1; - ae_int_t s2; - ae_int_t bs; - - - bs = ablascomplexblocksize(a, _state); - if( n<=bs&&k<=bs ) - { - ablas_cmatrixsyrk2(n, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state); - return; - } - if( k>=n ) - { - - /* - * Split K - */ - ablascomplexsplitlength(a, k, &s1, &s2, _state); - if( optypea==0 ) - { - cmatrixsyrk(n, s1, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state); - cmatrixsyrk(n, s2, alpha, a, ia, ja+s1, optypea, 1.0, c, ic, jc, isupper, _state); - } - else - { - cmatrixsyrk(n, s1, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state); - cmatrixsyrk(n, s2, alpha, a, ia+s1, ja, optypea, 1.0, c, ic, jc, isupper, _state); - } - } - else - { - - /* - * Split N - */ - ablascomplexsplitlength(a, n, &s1, &s2, _state); - if( optypea==0&&isupper ) - { - cmatrixsyrk(s1, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state); - cmatrixgemm(s1, s2, k, ae_complex_from_d(alpha), a, ia, ja, 0, a, ia+s1, ja, 2, ae_complex_from_d(beta), c, ic, jc+s1, _state); - cmatrixsyrk(s2, k, alpha, a, ia+s1, ja, optypea, beta, c, ic+s1, jc+s1, isupper, _state); - return; - } - if( optypea==0&&!isupper ) - { - cmatrixsyrk(s1, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state); - cmatrixgemm(s2, s1, k, ae_complex_from_d(alpha), a, ia+s1, ja, 0, a, ia, ja, 2, ae_complex_from_d(beta), c, ic+s1, jc, _state); - cmatrixsyrk(s2, k, alpha, a, ia+s1, ja, optypea, beta, c, ic+s1, jc+s1, isupper, _state); - return; - } - if( optypea!=0&&isupper ) - { - cmatrixsyrk(s1, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state); - cmatrixgemm(s1, s2, k, ae_complex_from_d(alpha), a, ia, ja, 2, a, ia, ja+s1, 0, ae_complex_from_d(beta), c, ic, jc+s1, _state); - cmatrixsyrk(s2, k, alpha, a, ia, ja+s1, optypea, beta, c, ic+s1, jc+s1, isupper, _state); - return; - } - if( optypea!=0&&!isupper ) - { - cmatrixsyrk(s1, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state); - cmatrixgemm(s2, s1, k, ae_complex_from_d(alpha), a, ia, ja+s1, 2, a, ia, ja, 0, ae_complex_from_d(beta), c, ic+s1, jc, _state); - cmatrixsyrk(s2, k, alpha, a, ia, ja+s1, optypea, beta, c, ic+s1, jc+s1, isupper, _state); - return; - } - } -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -void _pexec_cmatrixsyrk(ae_int_t n, - ae_int_t k, - double alpha, - /* Complex */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - double beta, - /* Complex */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_bool isupper, ae_state *_state) -{ - cmatrixsyrk(n,k,alpha,a,ia,ja,optypea,beta,c,ic,jc,isupper, _state); -} - - -void rmatrixsyrk(ae_int_t n, - ae_int_t k, - double alpha, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - double beta, - /* Real */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_bool isupper, - ae_state *_state) -{ - ae_int_t s1; - ae_int_t s2; - ae_int_t bs; - - - bs = ablasblocksize(a, _state); - - /* - * Use MKL or generic basecase code - */ - if( rmatrixsyrkmkl(n, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state) ) - { - return; - } - if( n<=bs&&k<=bs ) - { - ablas_rmatrixsyrk2(n, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state); - return; - } - - /* - * Recursive subdivision of the problem - */ - if( k>=n ) - { - - /* - * Split K - */ - ablassplitlength(a, k, &s1, &s2, _state); - if( optypea==0 ) - { - rmatrixsyrk(n, s1, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state); - rmatrixsyrk(n, s2, alpha, a, ia, ja+s1, optypea, 1.0, c, ic, jc, isupper, _state); - } - else - { - rmatrixsyrk(n, s1, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state); - rmatrixsyrk(n, s2, alpha, a, ia+s1, ja, optypea, 1.0, c, ic, jc, isupper, _state); - } - } - else - { - - /* - * Split N - */ - ablassplitlength(a, n, &s1, &s2, _state); - if( optypea==0&&isupper ) - { - rmatrixsyrk(s1, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state); - rmatrixgemm(s1, s2, k, alpha, a, ia, ja, 0, a, ia+s1, ja, 1, beta, c, ic, jc+s1, _state); - rmatrixsyrk(s2, k, alpha, a, ia+s1, ja, optypea, beta, c, ic+s1, jc+s1, isupper, _state); - return; - } - if( optypea==0&&!isupper ) - { - rmatrixsyrk(s1, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state); - rmatrixgemm(s2, s1, k, alpha, a, ia+s1, ja, 0, a, ia, ja, 1, beta, c, ic+s1, jc, _state); - rmatrixsyrk(s2, k, alpha, a, ia+s1, ja, optypea, beta, c, ic+s1, jc+s1, isupper, _state); - return; - } - if( optypea!=0&&isupper ) - { - rmatrixsyrk(s1, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state); - rmatrixgemm(s1, s2, k, alpha, a, ia, ja, 1, a, ia, ja+s1, 0, beta, c, ic, jc+s1, _state); - rmatrixsyrk(s2, k, alpha, a, ia, ja+s1, optypea, beta, c, ic+s1, jc+s1, isupper, _state); - return; - } - if( optypea!=0&&!isupper ) - { - rmatrixsyrk(s1, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state); - rmatrixgemm(s2, s1, k, alpha, a, ia, ja+s1, 1, a, ia, ja, 0, beta, c, ic+s1, jc, _state); - rmatrixsyrk(s2, k, alpha, a, ia, ja+s1, optypea, beta, c, ic+s1, jc+s1, isupper, _state); - return; - } - } -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -void _pexec_rmatrixsyrk(ae_int_t n, - ae_int_t k, - double alpha, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - double beta, - /* Real */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_bool isupper, ae_state *_state) -{ - rmatrixsyrk(n,k,alpha,a,ia,ja,optypea,beta,c,ic,jc,isupper, _state); -} - - -void cmatrixgemm(ae_int_t m, - ae_int_t n, - ae_int_t k, - ae_complex alpha, - /* Complex */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - /* Complex */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - ae_int_t optypeb, - ae_complex beta, - /* Complex */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_state *_state) -{ - ae_int_t s1; - ae_int_t s2; - ae_int_t bs; - - - bs = ablascomplexblocksize(a, _state); - if( (m<=bs&&n<=bs)&&k<=bs ) - { - cmatrixgemmk(m, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); - return; - } - - /* - * SMP support is turned on when M or N are larger than some boundary value. - * Magnitude of K is not taken into account because splitting on K does not - * allow us to spawn child tasks. - */ - - /* - * Recursive algorithm: parallel splitting on M/N - */ - if( m>=n&&m>=k ) - { - - /* - * A*B = (A1 A2)^T*B - */ - ablascomplexsplitlength(a, m, &s1, &s2, _state); - cmatrixgemm(s1, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); - if( optypea==0 ) - { - cmatrixgemm(s2, n, k, alpha, a, ia+s1, ja, optypea, b, ib, jb, optypeb, beta, c, ic+s1, jc, _state); - } - else - { - cmatrixgemm(s2, n, k, alpha, a, ia, ja+s1, optypea, b, ib, jb, optypeb, beta, c, ic+s1, jc, _state); - } - return; - } - if( n>=m&&n>=k ) - { - - /* - * A*B = A*(B1 B2) - */ - ablascomplexsplitlength(a, n, &s1, &s2, _state); - if( optypeb==0 ) - { - cmatrixgemm(m, s1, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); - cmatrixgemm(m, s2, k, alpha, a, ia, ja, optypea, b, ib, jb+s1, optypeb, beta, c, ic, jc+s1, _state); - } - else - { - cmatrixgemm(m, s1, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); - cmatrixgemm(m, s2, k, alpha, a, ia, ja, optypea, b, ib+s1, jb, optypeb, beta, c, ic, jc+s1, _state); - } - return; - } - - /* - * Recursive algorithm: serial splitting on K - */ - - /* - * A*B = (A1 A2)*(B1 B2)^T - */ - ablascomplexsplitlength(a, k, &s1, &s2, _state); - if( optypea==0&&optypeb==0 ) - { - cmatrixgemm(m, n, s1, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); - cmatrixgemm(m, n, s2, alpha, a, ia, ja+s1, optypea, b, ib+s1, jb, optypeb, ae_complex_from_d(1.0), c, ic, jc, _state); - } - if( optypea==0&&optypeb!=0 ) - { - cmatrixgemm(m, n, s1, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); - cmatrixgemm(m, n, s2, alpha, a, ia, ja+s1, optypea, b, ib, jb+s1, optypeb, ae_complex_from_d(1.0), c, ic, jc, _state); - } - if( optypea!=0&&optypeb==0 ) - { - cmatrixgemm(m, n, s1, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); - cmatrixgemm(m, n, s2, alpha, a, ia+s1, ja, optypea, b, ib+s1, jb, optypeb, ae_complex_from_d(1.0), c, ic, jc, _state); - } - if( optypea!=0&&optypeb!=0 ) - { - cmatrixgemm(m, n, s1, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); - cmatrixgemm(m, n, s2, alpha, a, ia+s1, ja, optypea, b, ib, jb+s1, optypeb, ae_complex_from_d(1.0), c, ic, jc, _state); - } - return; -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -void _pexec_cmatrixgemm(ae_int_t m, - ae_int_t n, - ae_int_t k, - ae_complex alpha, - /* Complex */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - /* Complex */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - ae_int_t optypeb, - ae_complex beta, - /* Complex */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, ae_state *_state) -{ - cmatrixgemm(m,n,k,alpha,a,ia,ja,optypea,b,ib,jb,optypeb,beta,c,ic,jc, _state); -} - - -void rmatrixgemm(ae_int_t m, - ae_int_t n, - ae_int_t k, - double alpha, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - /* Real */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - ae_int_t optypeb, - double beta, - /* Real */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_state *_state) -{ - ae_int_t s1; - ae_int_t s2; - ae_int_t bs; - - - bs = ablasblocksize(a, _state); - - /* - * Check input sizes for correctness - */ - ae_assert(optypea==0||optypea==1, "RMatrixGEMM: incorrect OpTypeA (must be 0 or 1)", _state); - ae_assert(optypeb==0||optypeb==1, "RMatrixGEMM: incorrect OpTypeB (must be 0 or 1)", _state); - ae_assert(ic+m<=c->rows, "RMatrixGEMM: incorect size of output matrix C", _state); - ae_assert(jc+n<=c->cols, "RMatrixGEMM: incorect size of output matrix C", _state); - - /* - * Use MKL or ALGLIB basecase code - */ - if( rmatrixgemmmkl(m, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state) ) - { - return; - } - if( (m<=bs&&n<=bs)&&k<=bs ) - { - rmatrixgemmk(m, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); - return; - } - - /* - * SMP support is turned on when M or N are larger than some boundary value. - * Magnitude of K is not taken into account because splitting on K does not - * allow us to spawn child tasks. - */ - - /* - * Recursive algorithm: split on M or N - */ - if( m>=n&&m>=k ) - { - - /* - * A*B = (A1 A2)^T*B - */ - ablassplitlength(a, m, &s1, &s2, _state); - if( optypea==0 ) - { - rmatrixgemm(s1, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); - rmatrixgemm(s2, n, k, alpha, a, ia+s1, ja, optypea, b, ib, jb, optypeb, beta, c, ic+s1, jc, _state); - } - else - { - rmatrixgemm(s1, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); - rmatrixgemm(s2, n, k, alpha, a, ia, ja+s1, optypea, b, ib, jb, optypeb, beta, c, ic+s1, jc, _state); - } - return; - } - if( n>=m&&n>=k ) - { - - /* - * A*B = A*(B1 B2) - */ - ablassplitlength(a, n, &s1, &s2, _state); - if( optypeb==0 ) - { - rmatrixgemm(m, s1, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); - rmatrixgemm(m, s2, k, alpha, a, ia, ja, optypea, b, ib, jb+s1, optypeb, beta, c, ic, jc+s1, _state); - } - else - { - rmatrixgemm(m, s1, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); - rmatrixgemm(m, s2, k, alpha, a, ia, ja, optypea, b, ib+s1, jb, optypeb, beta, c, ic, jc+s1, _state); - } - return; - } - - /* - * Recursive algorithm: split on K - */ - - /* - * A*B = (A1 A2)*(B1 B2)^T - */ - ablassplitlength(a, k, &s1, &s2, _state); - if( optypea==0&&optypeb==0 ) - { - rmatrixgemm(m, n, s1, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); - rmatrixgemm(m, n, s2, alpha, a, ia, ja+s1, optypea, b, ib+s1, jb, optypeb, 1.0, c, ic, jc, _state); - } - if( optypea==0&&optypeb!=0 ) - { - rmatrixgemm(m, n, s1, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); - rmatrixgemm(m, n, s2, alpha, a, ia, ja+s1, optypea, b, ib, jb+s1, optypeb, 1.0, c, ic, jc, _state); - } - if( optypea!=0&&optypeb==0 ) - { - rmatrixgemm(m, n, s1, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); - rmatrixgemm(m, n, s2, alpha, a, ia+s1, ja, optypea, b, ib+s1, jb, optypeb, 1.0, c, ic, jc, _state); - } - if( optypea!=0&&optypeb!=0 ) - { - rmatrixgemm(m, n, s1, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); - rmatrixgemm(m, n, s2, alpha, a, ia+s1, ja, optypea, b, ib, jb+s1, optypeb, 1.0, c, ic, jc, _state); - } - return; -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -void _pexec_rmatrixgemm(ae_int_t m, - ae_int_t n, - ae_int_t k, - double alpha, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - /* Real */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - ae_int_t optypeb, - double beta, - /* Real */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, ae_state *_state) -{ - rmatrixgemm(m,n,k,alpha,a,ia,ja,optypea,b,ib,jb,optypeb,beta,c,ic,jc, _state); -} - - -/************************************************************************* -Complex ABLASSplitLength - - -- ALGLIB routine -- - 15.12.2009 - Bochkanov Sergey -*************************************************************************/ -static void ablas_ablasinternalsplitlength(ae_int_t n, - ae_int_t nb, - ae_int_t* n1, - ae_int_t* n2, - ae_state *_state) -{ - ae_int_t r; - - *n1 = 0; - *n2 = 0; - - if( n<=nb ) - { - - /* - * Block size, no further splitting - */ - *n1 = n; - *n2 = 0; - } - else - { - - /* - * Greater than block size - */ - if( n%nb!=0 ) - { - - /* - * Split remainder - */ - *n2 = n%nb; - *n1 = n-(*n2); - } - else - { - - /* - * Split on block boundaries - */ - *n2 = n/2; - *n1 = n-(*n2); - if( *n1%nb==0 ) - { - return; - } - r = nb-*n1%nb; - *n1 = *n1+r; - *n2 = *n2-r; - } - } -} - - -/************************************************************************* -Level 2 variant of CMatrixRightTRSM -*************************************************************************/ -static void ablas_cmatrixrighttrsm2(ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Complex */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_complex vc; - ae_complex vd; - - - - /* - * Special case - */ - if( n*m==0 ) - { - return; - } - - /* - * Try to call fast TRSM - */ - if( cmatrixrighttrsmf(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state) ) - { - return; - } - - /* - * General case - */ - if( isupper ) - { - - /* - * Upper triangular matrix - */ - if( optype==0 ) - { - - /* - * X*A^(-1) - */ - for(i=0; i<=m-1; i++) - { - for(j=0; j<=n-1; j++) - { - if( isunit ) - { - vd = ae_complex_from_d(1); - } - else - { - vd = a->ptr.pp_complex[i1+j][j1+j]; - } - x->ptr.pp_complex[i2+i][j2+j] = ae_c_div(x->ptr.pp_complex[i2+i][j2+j],vd); - if( jptr.pp_complex[i2+i][j2+j]; - ae_v_csubc(&x->ptr.pp_complex[i2+i][j2+j+1], 1, &a->ptr.pp_complex[i1+j][j1+j+1], 1, "N", ae_v_len(j2+j+1,j2+n-1), vc); - } - } - } - return; - } - if( optype==1 ) - { - - /* - * X*A^(-T) - */ - for(i=0; i<=m-1; i++) - { - for(j=n-1; j>=0; j--) - { - vc = ae_complex_from_d(0); - vd = ae_complex_from_d(1); - if( jptr.pp_complex[i2+i][j2+j+1], 1, "N", &a->ptr.pp_complex[i1+j][j1+j+1], 1, "N", ae_v_len(j2+j+1,j2+n-1)); - } - if( !isunit ) - { - vd = a->ptr.pp_complex[i1+j][j1+j]; - } - x->ptr.pp_complex[i2+i][j2+j] = ae_c_div(ae_c_sub(x->ptr.pp_complex[i2+i][j2+j],vc),vd); - } - } - return; - } - if( optype==2 ) - { - - /* - * X*A^(-H) - */ - for(i=0; i<=m-1; i++) - { - for(j=n-1; j>=0; j--) - { - vc = ae_complex_from_d(0); - vd = ae_complex_from_d(1); - if( jptr.pp_complex[i2+i][j2+j+1], 1, "N", &a->ptr.pp_complex[i1+j][j1+j+1], 1, "Conj", ae_v_len(j2+j+1,j2+n-1)); - } - if( !isunit ) - { - vd = ae_c_conj(a->ptr.pp_complex[i1+j][j1+j], _state); - } - x->ptr.pp_complex[i2+i][j2+j] = ae_c_div(ae_c_sub(x->ptr.pp_complex[i2+i][j2+j],vc),vd); - } - } - return; - } - } - else - { - - /* - * Lower triangular matrix - */ - if( optype==0 ) - { - - /* - * X*A^(-1) - */ - for(i=0; i<=m-1; i++) - { - for(j=n-1; j>=0; j--) - { - if( isunit ) - { - vd = ae_complex_from_d(1); - } - else - { - vd = a->ptr.pp_complex[i1+j][j1+j]; - } - x->ptr.pp_complex[i2+i][j2+j] = ae_c_div(x->ptr.pp_complex[i2+i][j2+j],vd); - if( j>0 ) - { - vc = x->ptr.pp_complex[i2+i][j2+j]; - ae_v_csubc(&x->ptr.pp_complex[i2+i][j2], 1, &a->ptr.pp_complex[i1+j][j1], 1, "N", ae_v_len(j2,j2+j-1), vc); - } - } - } - return; - } - if( optype==1 ) - { - - /* - * X*A^(-T) - */ - for(i=0; i<=m-1; i++) - { - for(j=0; j<=n-1; j++) - { - vc = ae_complex_from_d(0); - vd = ae_complex_from_d(1); - if( j>0 ) - { - vc = ae_v_cdotproduct(&x->ptr.pp_complex[i2+i][j2], 1, "N", &a->ptr.pp_complex[i1+j][j1], 1, "N", ae_v_len(j2,j2+j-1)); - } - if( !isunit ) - { - vd = a->ptr.pp_complex[i1+j][j1+j]; - } - x->ptr.pp_complex[i2+i][j2+j] = ae_c_div(ae_c_sub(x->ptr.pp_complex[i2+i][j2+j],vc),vd); - } - } - return; - } - if( optype==2 ) - { - - /* - * X*A^(-H) - */ - for(i=0; i<=m-1; i++) - { - for(j=0; j<=n-1; j++) - { - vc = ae_complex_from_d(0); - vd = ae_complex_from_d(1); - if( j>0 ) - { - vc = ae_v_cdotproduct(&x->ptr.pp_complex[i2+i][j2], 1, "N", &a->ptr.pp_complex[i1+j][j1], 1, "Conj", ae_v_len(j2,j2+j-1)); - } - if( !isunit ) - { - vd = ae_c_conj(a->ptr.pp_complex[i1+j][j1+j], _state); - } - x->ptr.pp_complex[i2+i][j2+j] = ae_c_div(ae_c_sub(x->ptr.pp_complex[i2+i][j2+j],vc),vd); - } - } - return; - } - } -} - - -/************************************************************************* -Level-2 subroutine -*************************************************************************/ -static void ablas_cmatrixlefttrsm2(ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Complex */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_complex vc; - ae_complex vd; - - - - /* - * Special case - */ - if( n*m==0 ) - { - return; - } - - /* - * Try to call fast TRSM - */ - if( cmatrixlefttrsmf(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state) ) - { - return; - } - - /* - * General case - */ - if( isupper ) - { - - /* - * Upper triangular matrix - */ - if( optype==0 ) - { - - /* - * A^(-1)*X - */ - for(i=m-1; i>=0; i--) - { - for(j=i+1; j<=m-1; j++) - { - vc = a->ptr.pp_complex[i1+i][j1+j]; - ae_v_csubc(&x->ptr.pp_complex[i2+i][j2], 1, &x->ptr.pp_complex[i2+j][j2], 1, "N", ae_v_len(j2,j2+n-1), vc); - } - if( !isunit ) - { - vd = ae_c_d_div(1,a->ptr.pp_complex[i1+i][j1+i]); - ae_v_cmulc(&x->ptr.pp_complex[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vd); - } - } - return; - } - if( optype==1 ) - { - - /* - * A^(-T)*X - */ - for(i=0; i<=m-1; i++) - { - if( isunit ) - { - vd = ae_complex_from_d(1); - } - else - { - vd = ae_c_d_div(1,a->ptr.pp_complex[i1+i][j1+i]); - } - ae_v_cmulc(&x->ptr.pp_complex[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vd); - for(j=i+1; j<=m-1; j++) - { - vc = a->ptr.pp_complex[i1+i][j1+j]; - ae_v_csubc(&x->ptr.pp_complex[i2+j][j2], 1, &x->ptr.pp_complex[i2+i][j2], 1, "N", ae_v_len(j2,j2+n-1), vc); - } - } - return; - } - if( optype==2 ) - { - - /* - * A^(-H)*X - */ - for(i=0; i<=m-1; i++) - { - if( isunit ) - { - vd = ae_complex_from_d(1); - } - else - { - vd = ae_c_d_div(1,ae_c_conj(a->ptr.pp_complex[i1+i][j1+i], _state)); - } - ae_v_cmulc(&x->ptr.pp_complex[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vd); - for(j=i+1; j<=m-1; j++) - { - vc = ae_c_conj(a->ptr.pp_complex[i1+i][j1+j], _state); - ae_v_csubc(&x->ptr.pp_complex[i2+j][j2], 1, &x->ptr.pp_complex[i2+i][j2], 1, "N", ae_v_len(j2,j2+n-1), vc); - } - } - return; - } - } - else - { - - /* - * Lower triangular matrix - */ - if( optype==0 ) - { - - /* - * A^(-1)*X - */ - for(i=0; i<=m-1; i++) - { - for(j=0; j<=i-1; j++) - { - vc = a->ptr.pp_complex[i1+i][j1+j]; - ae_v_csubc(&x->ptr.pp_complex[i2+i][j2], 1, &x->ptr.pp_complex[i2+j][j2], 1, "N", ae_v_len(j2,j2+n-1), vc); - } - if( isunit ) - { - vd = ae_complex_from_d(1); - } - else - { - vd = ae_c_d_div(1,a->ptr.pp_complex[i1+j][j1+j]); - } - ae_v_cmulc(&x->ptr.pp_complex[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vd); - } - return; - } - if( optype==1 ) - { - - /* - * A^(-T)*X - */ - for(i=m-1; i>=0; i--) - { - if( isunit ) - { - vd = ae_complex_from_d(1); - } - else - { - vd = ae_c_d_div(1,a->ptr.pp_complex[i1+i][j1+i]); - } - ae_v_cmulc(&x->ptr.pp_complex[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vd); - for(j=i-1; j>=0; j--) - { - vc = a->ptr.pp_complex[i1+i][j1+j]; - ae_v_csubc(&x->ptr.pp_complex[i2+j][j2], 1, &x->ptr.pp_complex[i2+i][j2], 1, "N", ae_v_len(j2,j2+n-1), vc); - } - } - return; - } - if( optype==2 ) - { - - /* - * A^(-H)*X - */ - for(i=m-1; i>=0; i--) - { - if( isunit ) - { - vd = ae_complex_from_d(1); - } - else - { - vd = ae_c_d_div(1,ae_c_conj(a->ptr.pp_complex[i1+i][j1+i], _state)); - } - ae_v_cmulc(&x->ptr.pp_complex[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vd); - for(j=i-1; j>=0; j--) - { - vc = ae_c_conj(a->ptr.pp_complex[i1+i][j1+j], _state); - ae_v_csubc(&x->ptr.pp_complex[i2+j][j2], 1, &x->ptr.pp_complex[i2+i][j2], 1, "N", ae_v_len(j2,j2+n-1), vc); - } - } - return; - } - } -} - - -/************************************************************************* -Level 2 subroutine - - -- ALGLIB routine -- - 15.12.2009 - Bochkanov Sergey -*************************************************************************/ -static void ablas_rmatrixrighttrsm2(ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Real */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - double vr; - double vd; - - - - /* - * Special case - */ - if( n*m==0 ) - { - return; - } - - /* - * Try to use "fast" code - */ - if( rmatrixrighttrsmf(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state) ) - { - return; - } - - /* - * General case - */ - if( isupper ) - { - - /* - * Upper triangular matrix - */ - if( optype==0 ) - { - - /* - * X*A^(-1) - */ - for(i=0; i<=m-1; i++) - { - for(j=0; j<=n-1; j++) - { - if( isunit ) - { - vd = 1; - } - else - { - vd = a->ptr.pp_double[i1+j][j1+j]; - } - x->ptr.pp_double[i2+i][j2+j] = x->ptr.pp_double[i2+i][j2+j]/vd; - if( jptr.pp_double[i2+i][j2+j]; - ae_v_subd(&x->ptr.pp_double[i2+i][j2+j+1], 1, &a->ptr.pp_double[i1+j][j1+j+1], 1, ae_v_len(j2+j+1,j2+n-1), vr); - } - } - } - return; - } - if( optype==1 ) - { - - /* - * X*A^(-T) - */ - for(i=0; i<=m-1; i++) - { - for(j=n-1; j>=0; j--) - { - vr = 0; - vd = 1; - if( jptr.pp_double[i2+i][j2+j+1], 1, &a->ptr.pp_double[i1+j][j1+j+1], 1, ae_v_len(j2+j+1,j2+n-1)); - } - if( !isunit ) - { - vd = a->ptr.pp_double[i1+j][j1+j]; - } - x->ptr.pp_double[i2+i][j2+j] = (x->ptr.pp_double[i2+i][j2+j]-vr)/vd; - } - } - return; - } - } - else - { - - /* - * Lower triangular matrix - */ - if( optype==0 ) - { - - /* - * X*A^(-1) - */ - for(i=0; i<=m-1; i++) - { - for(j=n-1; j>=0; j--) - { - if( isunit ) - { - vd = 1; - } - else - { - vd = a->ptr.pp_double[i1+j][j1+j]; - } - x->ptr.pp_double[i2+i][j2+j] = x->ptr.pp_double[i2+i][j2+j]/vd; - if( j>0 ) - { - vr = x->ptr.pp_double[i2+i][j2+j]; - ae_v_subd(&x->ptr.pp_double[i2+i][j2], 1, &a->ptr.pp_double[i1+j][j1], 1, ae_v_len(j2,j2+j-1), vr); - } - } - } - return; - } - if( optype==1 ) - { - - /* - * X*A^(-T) - */ - for(i=0; i<=m-1; i++) - { - for(j=0; j<=n-1; j++) - { - vr = 0; - vd = 1; - if( j>0 ) - { - vr = ae_v_dotproduct(&x->ptr.pp_double[i2+i][j2], 1, &a->ptr.pp_double[i1+j][j1], 1, ae_v_len(j2,j2+j-1)); - } - if( !isunit ) - { - vd = a->ptr.pp_double[i1+j][j1+j]; - } - x->ptr.pp_double[i2+i][j2+j] = (x->ptr.pp_double[i2+i][j2+j]-vr)/vd; - } - } - return; - } - } -} - - -/************************************************************************* -Level 2 subroutine -*************************************************************************/ -static void ablas_rmatrixlefttrsm2(ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Real */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - double vr; - double vd; - - - - /* - * Special case - */ - if( n==0||m==0 ) - { - return; - } - - /* - * Try fast code - */ - if( rmatrixlefttrsmf(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state) ) - { - return; - } - - /* - * General case - */ - if( isupper ) - { - - /* - * Upper triangular matrix - */ - if( optype==0 ) - { - - /* - * A^(-1)*X - */ - for(i=m-1; i>=0; i--) - { - for(j=i+1; j<=m-1; j++) - { - vr = a->ptr.pp_double[i1+i][j1+j]; - ae_v_subd(&x->ptr.pp_double[i2+i][j2], 1, &x->ptr.pp_double[i2+j][j2], 1, ae_v_len(j2,j2+n-1), vr); - } - if( !isunit ) - { - vd = 1/a->ptr.pp_double[i1+i][j1+i]; - ae_v_muld(&x->ptr.pp_double[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vd); - } - } - return; - } - if( optype==1 ) - { - - /* - * A^(-T)*X - */ - for(i=0; i<=m-1; i++) - { - if( isunit ) - { - vd = 1; - } - else - { - vd = 1/a->ptr.pp_double[i1+i][j1+i]; - } - ae_v_muld(&x->ptr.pp_double[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vd); - for(j=i+1; j<=m-1; j++) - { - vr = a->ptr.pp_double[i1+i][j1+j]; - ae_v_subd(&x->ptr.pp_double[i2+j][j2], 1, &x->ptr.pp_double[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vr); - } - } - return; - } - } - else - { - - /* - * Lower triangular matrix - */ - if( optype==0 ) - { - - /* - * A^(-1)*X - */ - for(i=0; i<=m-1; i++) - { - for(j=0; j<=i-1; j++) - { - vr = a->ptr.pp_double[i1+i][j1+j]; - ae_v_subd(&x->ptr.pp_double[i2+i][j2], 1, &x->ptr.pp_double[i2+j][j2], 1, ae_v_len(j2,j2+n-1), vr); - } - if( isunit ) - { - vd = 1; - } - else - { - vd = 1/a->ptr.pp_double[i1+j][j1+j]; - } - ae_v_muld(&x->ptr.pp_double[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vd); - } - return; - } - if( optype==1 ) - { - - /* - * A^(-T)*X - */ - for(i=m-1; i>=0; i--) - { - if( isunit ) - { - vd = 1; - } - else - { - vd = 1/a->ptr.pp_double[i1+i][j1+i]; - } - ae_v_muld(&x->ptr.pp_double[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vd); - for(j=i-1; j>=0; j--) - { - vr = a->ptr.pp_double[i1+i][j1+j]; - ae_v_subd(&x->ptr.pp_double[i2+j][j2], 1, &x->ptr.pp_double[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vr); - } - } - return; - } - } -} - - -/************************************************************************* -Level 2 subroutine -*************************************************************************/ -static void ablas_cmatrixsyrk2(ae_int_t n, - ae_int_t k, - double alpha, - /* Complex */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - double beta, - /* Complex */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_bool isupper, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t j1; - ae_int_t j2; - ae_complex v; - - - - /* - * Fast exit (nothing to be done) - */ - if( (ae_fp_eq(alpha,0)||k==0)&&ae_fp_eq(beta,1) ) - { - return; - } - - /* - * Try to call fast SYRK - */ - if( cmatrixsyrkf(n, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state) ) - { - return; - } - - /* - * SYRK - */ - if( optypea==0 ) - { - - /* - * C=alpha*A*A^H+beta*C - */ - for(i=0; i<=n-1; i++) - { - if( isupper ) - { - j1 = i; - j2 = n-1; - } - else - { - j1 = 0; - j2 = i; - } - for(j=j1; j<=j2; j++) - { - if( ae_fp_neq(alpha,0)&&k>0 ) - { - v = ae_v_cdotproduct(&a->ptr.pp_complex[ia+i][ja], 1, "N", &a->ptr.pp_complex[ia+j][ja], 1, "Conj", ae_v_len(ja,ja+k-1)); - } - else - { - v = ae_complex_from_d(0); - } - if( ae_fp_eq(beta,0) ) - { - c->ptr.pp_complex[ic+i][jc+j] = ae_c_mul_d(v,alpha); - } - else - { - c->ptr.pp_complex[ic+i][jc+j] = ae_c_add(ae_c_mul_d(c->ptr.pp_complex[ic+i][jc+j],beta),ae_c_mul_d(v,alpha)); - } - } - } - return; - } - else - { - - /* - * C=alpha*A^H*A+beta*C - */ - for(i=0; i<=n-1; i++) - { - if( isupper ) - { - j1 = i; - j2 = n-1; - } - else - { - j1 = 0; - j2 = i; - } - if( ae_fp_eq(beta,0) ) - { - for(j=j1; j<=j2; j++) - { - c->ptr.pp_complex[ic+i][jc+j] = ae_complex_from_d(0); - } - } - else - { - ae_v_cmuld(&c->ptr.pp_complex[ic+i][jc+j1], 1, ae_v_len(jc+j1,jc+j2), beta); - } - } - for(i=0; i<=k-1; i++) - { - for(j=0; j<=n-1; j++) - { - if( isupper ) - { - j1 = j; - j2 = n-1; - } - else - { - j1 = 0; - j2 = j; - } - v = ae_c_mul_d(ae_c_conj(a->ptr.pp_complex[ia+i][ja+j], _state),alpha); - ae_v_caddc(&c->ptr.pp_complex[ic+j][jc+j1], 1, &a->ptr.pp_complex[ia+i][ja+j1], 1, "N", ae_v_len(jc+j1,jc+j2), v); - } - } - return; - } -} - - -/************************************************************************* -Level 2 subrotuine -*************************************************************************/ -static void ablas_rmatrixsyrk2(ae_int_t n, - ae_int_t k, - double alpha, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - double beta, - /* Real */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_bool isupper, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t j1; - ae_int_t j2; - double v; - - - - /* - * Fast exit (nothing to be done) - */ - if( (ae_fp_eq(alpha,0)||k==0)&&ae_fp_eq(beta,1) ) - { - return; - } - - /* - * Try to call fast SYRK - */ - if( rmatrixsyrkf(n, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state) ) - { - return; - } - - /* - * SYRK - */ - if( optypea==0 ) - { - - /* - * C=alpha*A*A^H+beta*C - */ - for(i=0; i<=n-1; i++) - { - if( isupper ) - { - j1 = i; - j2 = n-1; - } - else - { - j1 = 0; - j2 = i; - } - for(j=j1; j<=j2; j++) - { - if( ae_fp_neq(alpha,0)&&k>0 ) - { - v = ae_v_dotproduct(&a->ptr.pp_double[ia+i][ja], 1, &a->ptr.pp_double[ia+j][ja], 1, ae_v_len(ja,ja+k-1)); - } - else - { - v = 0; - } - if( ae_fp_eq(beta,0) ) - { - c->ptr.pp_double[ic+i][jc+j] = alpha*v; - } - else - { - c->ptr.pp_double[ic+i][jc+j] = beta*c->ptr.pp_double[ic+i][jc+j]+alpha*v; - } - } - } - return; - } - else - { - - /* - * C=alpha*A^H*A+beta*C - */ - for(i=0; i<=n-1; i++) - { - if( isupper ) - { - j1 = i; - j2 = n-1; - } - else - { - j1 = 0; - j2 = i; - } - if( ae_fp_eq(beta,0) ) - { - for(j=j1; j<=j2; j++) - { - c->ptr.pp_double[ic+i][jc+j] = 0; - } - } - else - { - ae_v_muld(&c->ptr.pp_double[ic+i][jc+j1], 1, ae_v_len(jc+j1,jc+j2), beta); - } - } - for(i=0; i<=k-1; i++) - { - for(j=0; j<=n-1; j++) - { - if( isupper ) - { - j1 = j; - j2 = n-1; - } - else - { - j1 = 0; - j2 = j; - } - v = alpha*a->ptr.pp_double[ia+i][ja+j]; - ae_v_addd(&c->ptr.pp_double[ic+j][jc+j1], 1, &a->ptr.pp_double[ia+i][ja+j1], 1, ae_v_len(jc+j1,jc+j2), v); - } - } - return; - } -} - - - - -/************************************************************************* -QR decomposition of a rectangular matrix of size MxN - -Input parameters: - A - matrix A whose indexes range within [0..M-1, 0..N-1]. - M - number of rows in matrix A. - N - number of columns in matrix A. - -Output parameters: - A - matrices Q and R in compact form (see below). - Tau - array of scalar factors which are used to form - matrix Q. Array whose index ranges within [0.. Min(M-1,N-1)]. - -Matrix A is represented as A = QR, where Q is an orthogonal matrix of size -MxM, R - upper triangular (or upper trapezoid) matrix of size M x N. - -The elements of matrix R are located on and above the main diagonal of -matrix A. The elements which are located in Tau array and below the main -diagonal of matrix A are used to form matrix Q as follows: - -Matrix Q is represented as a product of elementary reflections - -Q = H(0)*H(2)*...*H(k-1), - -where k = min(m,n), and each H(i) is in the form - -H(i) = 1 - tau * v * (v^T) - -where tau is a scalar stored in Tau[I]; v - real vector, -so that v(0:i-1) = 0, v(i) = 1, v(i+1:m-1) stored in A(i+1:m-1,i). - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixqr(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Real */ ae_vector* tau, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector work; - ae_vector t; - ae_vector taubuf; - ae_int_t minmn; - ae_matrix tmpa; - ae_matrix tmpt; - ae_matrix tmpr; - ae_int_t blockstart; - ae_int_t blocksize; - ae_int_t rowscount; - ae_int_t i; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(tau); - ae_vector_init(&work, 0, DT_REAL, _state, ae_true); - ae_vector_init(&t, 0, DT_REAL, _state, ae_true); - ae_vector_init(&taubuf, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&tmpa, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&tmpt, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&tmpr, 0, 0, DT_REAL, _state, ae_true); - - if( m<=0||n<=0 ) - { - ae_frame_leave(_state); - return; - } - minmn = ae_minint(m, n, _state); - ae_vector_set_length(&work, ae_maxint(m, n, _state)+1, _state); - ae_vector_set_length(&t, ae_maxint(m, n, _state)+1, _state); - ae_vector_set_length(tau, minmn, _state); - ae_vector_set_length(&taubuf, minmn, _state); - ae_matrix_set_length(&tmpa, m, ablasblocksize(a, _state), _state); - ae_matrix_set_length(&tmpt, ablasblocksize(a, _state), 2*ablasblocksize(a, _state), _state); - ae_matrix_set_length(&tmpr, 2*ablasblocksize(a, _state), n, _state); - - /* - * Blocked code - */ - blockstart = 0; - while(blockstart!=minmn) - { - - /* - * Determine block size - */ - blocksize = minmn-blockstart; - if( blocksize>ablasblocksize(a, _state) ) - { - blocksize = ablasblocksize(a, _state); - } - rowscount = m-blockstart; - - /* - * QR decomposition of submatrix. - * Matrix is copied to temporary storage to solve - * some TLB issues arising from non-contiguous memory - * access pattern. - */ - rmatrixcopy(rowscount, blocksize, a, blockstart, blockstart, &tmpa, 0, 0, _state); - rmatrixqrbasecase(&tmpa, rowscount, blocksize, &work, &t, &taubuf, _state); - rmatrixcopy(rowscount, blocksize, &tmpa, 0, 0, a, blockstart, blockstart, _state); - ae_v_move(&tau->ptr.p_double[blockstart], 1, &taubuf.ptr.p_double[0], 1, ae_v_len(blockstart,blockstart+blocksize-1)); - - /* - * Update the rest, choose between: - * a) Level 2 algorithm (when the rest of the matrix is small enough) - * b) blocked algorithm, see algorithm 5 from 'A storage efficient WY - * representation for products of Householder transformations', - * by R. Schreiber and C. Van Loan. - */ - if( blockstart+blocksize<=n-1 ) - { - if( n-blockstart-blocksize>=2*ablasblocksize(a, _state)||rowscount>=4*ablasblocksize(a, _state) ) - { - - /* - * Prepare block reflector - */ - ortfac_rmatrixblockreflector(&tmpa, &taubuf, ae_true, rowscount, blocksize, &tmpt, &work, _state); - - /* - * Multiply the rest of A by Q'. - * - * Q = E + Y*T*Y' = E + TmpA*TmpT*TmpA' - * Q' = E + Y*T'*Y' = E + TmpA*TmpT'*TmpA' - */ - rmatrixgemm(blocksize, n-blockstart-blocksize, rowscount, 1.0, &tmpa, 0, 0, 1, a, blockstart, blockstart+blocksize, 0, 0.0, &tmpr, 0, 0, _state); - rmatrixgemm(blocksize, n-blockstart-blocksize, blocksize, 1.0, &tmpt, 0, 0, 1, &tmpr, 0, 0, 0, 0.0, &tmpr, blocksize, 0, _state); - rmatrixgemm(rowscount, n-blockstart-blocksize, blocksize, 1.0, &tmpa, 0, 0, 0, &tmpr, blocksize, 0, 0, 1.0, a, blockstart, blockstart+blocksize, _state); - } - else - { - - /* - * Level 2 algorithm - */ - for(i=0; i<=blocksize-1; i++) - { - ae_v_move(&t.ptr.p_double[1], 1, &tmpa.ptr.pp_double[i][i], tmpa.stride, ae_v_len(1,rowscount-i)); - t.ptr.p_double[1] = 1; - applyreflectionfromtheleft(a, taubuf.ptr.p_double[i], &t, blockstart+i, m-1, blockstart+blocksize, n-1, &work, _state); - } - } - } - - /* - * Advance - */ - blockstart = blockstart+blocksize; - } - ae_frame_leave(_state); -} - - -/************************************************************************* -LQ decomposition of a rectangular matrix of size MxN - -Input parameters: - A - matrix A whose indexes range within [0..M-1, 0..N-1]. - M - number of rows in matrix A. - N - number of columns in matrix A. - -Output parameters: - A - matrices L and Q in compact form (see below) - Tau - array of scalar factors which are used to form - matrix Q. Array whose index ranges within [0..Min(M,N)-1]. - -Matrix A is represented as A = LQ, where Q is an orthogonal matrix of size -MxM, L - lower triangular (or lower trapezoid) matrix of size M x N. - -The elements of matrix L are located on and below the main diagonal of -matrix A. The elements which are located in Tau array and above the main -diagonal of matrix A are used to form matrix Q as follows: - -Matrix Q is represented as a product of elementary reflections - -Q = H(k-1)*H(k-2)*...*H(1)*H(0), - -where k = min(m,n), and each H(i) is of the form - -H(i) = 1 - tau * v * (v^T) - -where tau is a scalar stored in Tau[I]; v - real vector, so that v(0:i-1)=0, -v(i) = 1, v(i+1:n-1) stored in A(i,i+1:n-1). - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixlq(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Real */ ae_vector* tau, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector work; - ae_vector t; - ae_vector taubuf; - ae_int_t minmn; - ae_matrix tmpa; - ae_matrix tmpt; - ae_matrix tmpr; - ae_int_t blockstart; - ae_int_t blocksize; - ae_int_t columnscount; - ae_int_t i; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(tau); - ae_vector_init(&work, 0, DT_REAL, _state, ae_true); - ae_vector_init(&t, 0, DT_REAL, _state, ae_true); - ae_vector_init(&taubuf, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&tmpa, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&tmpt, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&tmpr, 0, 0, DT_REAL, _state, ae_true); - - if( m<=0||n<=0 ) - { - ae_frame_leave(_state); - return; - } - minmn = ae_minint(m, n, _state); - ae_vector_set_length(&work, ae_maxint(m, n, _state)+1, _state); - ae_vector_set_length(&t, ae_maxint(m, n, _state)+1, _state); - ae_vector_set_length(tau, minmn, _state); - ae_vector_set_length(&taubuf, minmn, _state); - ae_matrix_set_length(&tmpa, ablasblocksize(a, _state), n, _state); - ae_matrix_set_length(&tmpt, ablasblocksize(a, _state), 2*ablasblocksize(a, _state), _state); - ae_matrix_set_length(&tmpr, m, 2*ablasblocksize(a, _state), _state); - - /* - * Blocked code - */ - blockstart = 0; - while(blockstart!=minmn) - { - - /* - * Determine block size - */ - blocksize = minmn-blockstart; - if( blocksize>ablasblocksize(a, _state) ) - { - blocksize = ablasblocksize(a, _state); - } - columnscount = n-blockstart; - - /* - * LQ decomposition of submatrix. - * Matrix is copied to temporary storage to solve - * some TLB issues arising from non-contiguous memory - * access pattern. - */ - rmatrixcopy(blocksize, columnscount, a, blockstart, blockstart, &tmpa, 0, 0, _state); - rmatrixlqbasecase(&tmpa, blocksize, columnscount, &work, &t, &taubuf, _state); - rmatrixcopy(blocksize, columnscount, &tmpa, 0, 0, a, blockstart, blockstart, _state); - ae_v_move(&tau->ptr.p_double[blockstart], 1, &taubuf.ptr.p_double[0], 1, ae_v_len(blockstart,blockstart+blocksize-1)); - - /* - * Update the rest, choose between: - * a) Level 2 algorithm (when the rest of the matrix is small enough) - * b) blocked algorithm, see algorithm 5 from 'A storage efficient WY - * representation for products of Householder transformations', - * by R. Schreiber and C. Van Loan. - */ - if( blockstart+blocksize<=m-1 ) - { - if( m-blockstart-blocksize>=2*ablasblocksize(a, _state) ) - { - - /* - * Prepare block reflector - */ - ortfac_rmatrixblockreflector(&tmpa, &taubuf, ae_false, columnscount, blocksize, &tmpt, &work, _state); - - /* - * Multiply the rest of A by Q. - * - * Q = E + Y*T*Y' = E + TmpA'*TmpT*TmpA - */ - rmatrixgemm(m-blockstart-blocksize, blocksize, columnscount, 1.0, a, blockstart+blocksize, blockstart, 0, &tmpa, 0, 0, 1, 0.0, &tmpr, 0, 0, _state); - rmatrixgemm(m-blockstart-blocksize, blocksize, blocksize, 1.0, &tmpr, 0, 0, 0, &tmpt, 0, 0, 0, 0.0, &tmpr, 0, blocksize, _state); - rmatrixgemm(m-blockstart-blocksize, columnscount, blocksize, 1.0, &tmpr, 0, blocksize, 0, &tmpa, 0, 0, 0, 1.0, a, blockstart+blocksize, blockstart, _state); - } - else - { - - /* - * Level 2 algorithm - */ - for(i=0; i<=blocksize-1; i++) - { - ae_v_move(&t.ptr.p_double[1], 1, &tmpa.ptr.pp_double[i][i], 1, ae_v_len(1,columnscount-i)); - t.ptr.p_double[1] = 1; - applyreflectionfromtheright(a, taubuf.ptr.p_double[i], &t, blockstart+blocksize, m-1, blockstart+i, n-1, &work, _state); - } - } - } - - /* - * Advance - */ - blockstart = blockstart+blocksize; - } - ae_frame_leave(_state); -} - - -/************************************************************************* -QR decomposition of a rectangular complex matrix of size MxN - -Input parameters: - A - matrix A whose indexes range within [0..M-1, 0..N-1] - M - number of rows in matrix A. - N - number of columns in matrix A. - -Output parameters: - A - matrices Q and R in compact form - Tau - array of scalar factors which are used to form matrix Q. Array - whose indexes range within [0.. Min(M,N)-1] - -Matrix A is represented as A = QR, where Q is an orthogonal matrix of size -MxM, R - upper triangular (or upper trapezoid) matrix of size MxN. - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - September 30, 1994 -*************************************************************************/ -void cmatrixqr(/* Complex */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Complex */ ae_vector* tau, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector work; - ae_vector t; - ae_vector taubuf; - ae_int_t minmn; - ae_matrix tmpa; - ae_matrix tmpt; - ae_matrix tmpr; - ae_int_t blockstart; - ae_int_t blocksize; - ae_int_t rowscount; - ae_int_t i; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(tau); - ae_vector_init(&work, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&t, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&taubuf, 0, DT_COMPLEX, _state, ae_true); - ae_matrix_init(&tmpa, 0, 0, DT_COMPLEX, _state, ae_true); - ae_matrix_init(&tmpt, 0, 0, DT_COMPLEX, _state, ae_true); - ae_matrix_init(&tmpr, 0, 0, DT_COMPLEX, _state, ae_true); - - if( m<=0||n<=0 ) - { - ae_frame_leave(_state); - return; - } - minmn = ae_minint(m, n, _state); - ae_vector_set_length(&work, ae_maxint(m, n, _state)+1, _state); - ae_vector_set_length(&t, ae_maxint(m, n, _state)+1, _state); - ae_vector_set_length(tau, minmn, _state); - ae_vector_set_length(&taubuf, minmn, _state); - ae_matrix_set_length(&tmpa, m, ablascomplexblocksize(a, _state), _state); - ae_matrix_set_length(&tmpt, ablascomplexblocksize(a, _state), ablascomplexblocksize(a, _state), _state); - ae_matrix_set_length(&tmpr, 2*ablascomplexblocksize(a, _state), n, _state); - - /* - * Blocked code - */ - blockstart = 0; - while(blockstart!=minmn) - { - - /* - * Determine block size - */ - blocksize = minmn-blockstart; - if( blocksize>ablascomplexblocksize(a, _state) ) - { - blocksize = ablascomplexblocksize(a, _state); - } - rowscount = m-blockstart; - - /* - * QR decomposition of submatrix. - * Matrix is copied to temporary storage to solve - * some TLB issues arising from non-contiguous memory - * access pattern. - */ - cmatrixcopy(rowscount, blocksize, a, blockstart, blockstart, &tmpa, 0, 0, _state); - ortfac_cmatrixqrbasecase(&tmpa, rowscount, blocksize, &work, &t, &taubuf, _state); - cmatrixcopy(rowscount, blocksize, &tmpa, 0, 0, a, blockstart, blockstart, _state); - ae_v_cmove(&tau->ptr.p_complex[blockstart], 1, &taubuf.ptr.p_complex[0], 1, "N", ae_v_len(blockstart,blockstart+blocksize-1)); - - /* - * Update the rest, choose between: - * a) Level 2 algorithm (when the rest of the matrix is small enough) - * b) blocked algorithm, see algorithm 5 from 'A storage efficient WY - * representation for products of Householder transformations', - * by R. Schreiber and C. Van Loan. - */ - if( blockstart+blocksize<=n-1 ) - { - if( n-blockstart-blocksize>=2*ablascomplexblocksize(a, _state) ) - { - - /* - * Prepare block reflector - */ - ortfac_cmatrixblockreflector(&tmpa, &taubuf, ae_true, rowscount, blocksize, &tmpt, &work, _state); - - /* - * Multiply the rest of A by Q'. - * - * Q = E + Y*T*Y' = E + TmpA*TmpT*TmpA' - * Q' = E + Y*T'*Y' = E + TmpA*TmpT'*TmpA' - */ - cmatrixgemm(blocksize, n-blockstart-blocksize, rowscount, ae_complex_from_d(1.0), &tmpa, 0, 0, 2, a, blockstart, blockstart+blocksize, 0, ae_complex_from_d(0.0), &tmpr, 0, 0, _state); - cmatrixgemm(blocksize, n-blockstart-blocksize, blocksize, ae_complex_from_d(1.0), &tmpt, 0, 0, 2, &tmpr, 0, 0, 0, ae_complex_from_d(0.0), &tmpr, blocksize, 0, _state); - cmatrixgemm(rowscount, n-blockstart-blocksize, blocksize, ae_complex_from_d(1.0), &tmpa, 0, 0, 0, &tmpr, blocksize, 0, 0, ae_complex_from_d(1.0), a, blockstart, blockstart+blocksize, _state); - } - else - { - - /* - * Level 2 algorithm - */ - for(i=0; i<=blocksize-1; i++) - { - ae_v_cmove(&t.ptr.p_complex[1], 1, &tmpa.ptr.pp_complex[i][i], tmpa.stride, "N", ae_v_len(1,rowscount-i)); - t.ptr.p_complex[1] = ae_complex_from_d(1); - complexapplyreflectionfromtheleft(a, ae_c_conj(taubuf.ptr.p_complex[i], _state), &t, blockstart+i, m-1, blockstart+blocksize, n-1, &work, _state); - } - } - } - - /* - * Advance - */ - blockstart = blockstart+blocksize; - } - ae_frame_leave(_state); -} - - -/************************************************************************* -LQ decomposition of a rectangular complex matrix of size MxN - -Input parameters: - A - matrix A whose indexes range within [0..M-1, 0..N-1] - M - number of rows in matrix A. - N - number of columns in matrix A. - -Output parameters: - A - matrices Q and L in compact form - Tau - array of scalar factors which are used to form matrix Q. Array - whose indexes range within [0.. Min(M,N)-1] - -Matrix A is represented as A = LQ, where Q is an orthogonal matrix of size -MxM, L - lower triangular (or lower trapezoid) matrix of size MxN. - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - September 30, 1994 -*************************************************************************/ -void cmatrixlq(/* Complex */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Complex */ ae_vector* tau, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector work; - ae_vector t; - ae_vector taubuf; - ae_int_t minmn; - ae_matrix tmpa; - ae_matrix tmpt; - ae_matrix tmpr; - ae_int_t blockstart; - ae_int_t blocksize; - ae_int_t columnscount; - ae_int_t i; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(tau); - ae_vector_init(&work, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&t, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&taubuf, 0, DT_COMPLEX, _state, ae_true); - ae_matrix_init(&tmpa, 0, 0, DT_COMPLEX, _state, ae_true); - ae_matrix_init(&tmpt, 0, 0, DT_COMPLEX, _state, ae_true); - ae_matrix_init(&tmpr, 0, 0, DT_COMPLEX, _state, ae_true); - - if( m<=0||n<=0 ) - { - ae_frame_leave(_state); - return; - } - minmn = ae_minint(m, n, _state); - ae_vector_set_length(&work, ae_maxint(m, n, _state)+1, _state); - ae_vector_set_length(&t, ae_maxint(m, n, _state)+1, _state); - ae_vector_set_length(tau, minmn, _state); - ae_vector_set_length(&taubuf, minmn, _state); - ae_matrix_set_length(&tmpa, ablascomplexblocksize(a, _state), n, _state); - ae_matrix_set_length(&tmpt, ablascomplexblocksize(a, _state), ablascomplexblocksize(a, _state), _state); - ae_matrix_set_length(&tmpr, m, 2*ablascomplexblocksize(a, _state), _state); - - /* - * Blocked code - */ - blockstart = 0; - while(blockstart!=minmn) - { - - /* - * Determine block size - */ - blocksize = minmn-blockstart; - if( blocksize>ablascomplexblocksize(a, _state) ) - { - blocksize = ablascomplexblocksize(a, _state); - } - columnscount = n-blockstart; - - /* - * LQ decomposition of submatrix. - * Matrix is copied to temporary storage to solve - * some TLB issues arising from non-contiguous memory - * access pattern. - */ - cmatrixcopy(blocksize, columnscount, a, blockstart, blockstart, &tmpa, 0, 0, _state); - ortfac_cmatrixlqbasecase(&tmpa, blocksize, columnscount, &work, &t, &taubuf, _state); - cmatrixcopy(blocksize, columnscount, &tmpa, 0, 0, a, blockstart, blockstart, _state); - ae_v_cmove(&tau->ptr.p_complex[blockstart], 1, &taubuf.ptr.p_complex[0], 1, "N", ae_v_len(blockstart,blockstart+blocksize-1)); - - /* - * Update the rest, choose between: - * a) Level 2 algorithm (when the rest of the matrix is small enough) - * b) blocked algorithm, see algorithm 5 from 'A storage efficient WY - * representation for products of Householder transformations', - * by R. Schreiber and C. Van Loan. - */ - if( blockstart+blocksize<=m-1 ) - { - if( m-blockstart-blocksize>=2*ablascomplexblocksize(a, _state) ) - { - - /* - * Prepare block reflector - */ - ortfac_cmatrixblockreflector(&tmpa, &taubuf, ae_false, columnscount, blocksize, &tmpt, &work, _state); - - /* - * Multiply the rest of A by Q. - * - * Q = E + Y*T*Y' = E + TmpA'*TmpT*TmpA - */ - cmatrixgemm(m-blockstart-blocksize, blocksize, columnscount, ae_complex_from_d(1.0), a, blockstart+blocksize, blockstart, 0, &tmpa, 0, 0, 2, ae_complex_from_d(0.0), &tmpr, 0, 0, _state); - cmatrixgemm(m-blockstart-blocksize, blocksize, blocksize, ae_complex_from_d(1.0), &tmpr, 0, 0, 0, &tmpt, 0, 0, 0, ae_complex_from_d(0.0), &tmpr, 0, blocksize, _state); - cmatrixgemm(m-blockstart-blocksize, columnscount, blocksize, ae_complex_from_d(1.0), &tmpr, 0, blocksize, 0, &tmpa, 0, 0, 0, ae_complex_from_d(1.0), a, blockstart+blocksize, blockstart, _state); - } - else - { - - /* - * Level 2 algorithm - */ - for(i=0; i<=blocksize-1; i++) - { - ae_v_cmove(&t.ptr.p_complex[1], 1, &tmpa.ptr.pp_complex[i][i], 1, "Conj", ae_v_len(1,columnscount-i)); - t.ptr.p_complex[1] = ae_complex_from_d(1); - complexapplyreflectionfromtheright(a, taubuf.ptr.p_complex[i], &t, blockstart+blocksize, m-1, blockstart+i, n-1, &work, _state); - } - } - } - - /* - * Advance - */ - blockstart = blockstart+blocksize; - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Partial unpacking of matrix Q from the QR decomposition of a matrix A - -Input parameters: - A - matrices Q and R in compact form. - Output of RMatrixQR subroutine. - M - number of rows in given matrix A. M>=0. - N - number of columns in given matrix A. N>=0. - Tau - scalar factors which are used to form Q. - Output of the RMatrixQR subroutine. - QColumns - required number of columns of matrix Q. M>=QColumns>=0. - -Output parameters: - Q - first QColumns columns of matrix Q. - Array whose indexes range within [0..M-1, 0..QColumns-1]. - If QColumns=0, the array remains unchanged. - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixqrunpackq(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Real */ ae_vector* tau, - ae_int_t qcolumns, - /* Real */ ae_matrix* q, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector work; - ae_vector t; - ae_vector taubuf; - ae_int_t minmn; - ae_int_t refcnt; - ae_matrix tmpa; - ae_matrix tmpt; - ae_matrix tmpr; - ae_int_t blockstart; - ae_int_t blocksize; - ae_int_t rowscount; - ae_int_t i; - ae_int_t j; - - ae_frame_make(_state, &_frame_block); - ae_matrix_clear(q); - ae_vector_init(&work, 0, DT_REAL, _state, ae_true); - ae_vector_init(&t, 0, DT_REAL, _state, ae_true); - ae_vector_init(&taubuf, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&tmpa, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&tmpt, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&tmpr, 0, 0, DT_REAL, _state, ae_true); - - ae_assert(qcolumns<=m, "UnpackQFromQR: QColumns>M!", _state); - if( (m<=0||n<=0)||qcolumns<=0 ) - { - ae_frame_leave(_state); - return; - } - - /* - * init - */ - minmn = ae_minint(m, n, _state); - refcnt = ae_minint(minmn, qcolumns, _state); - ae_matrix_set_length(q, m, qcolumns, _state); - for(i=0; i<=m-1; i++) - { - for(j=0; j<=qcolumns-1; j++) - { - if( i==j ) - { - q->ptr.pp_double[i][j] = 1; - } - else - { - q->ptr.pp_double[i][j] = 0; - } - } - } - ae_vector_set_length(&work, ae_maxint(m, qcolumns, _state)+1, _state); - ae_vector_set_length(&t, ae_maxint(m, qcolumns, _state)+1, _state); - ae_vector_set_length(&taubuf, minmn, _state); - ae_matrix_set_length(&tmpa, m, ablasblocksize(a, _state), _state); - ae_matrix_set_length(&tmpt, ablasblocksize(a, _state), 2*ablasblocksize(a, _state), _state); - ae_matrix_set_length(&tmpr, 2*ablasblocksize(a, _state), qcolumns, _state); - - /* - * Blocked code - */ - blockstart = ablasblocksize(a, _state)*(refcnt/ablasblocksize(a, _state)); - blocksize = refcnt-blockstart; - while(blockstart>=0) - { - rowscount = m-blockstart; - if( blocksize>0 ) - { - - /* - * Copy current block - */ - rmatrixcopy(rowscount, blocksize, a, blockstart, blockstart, &tmpa, 0, 0, _state); - ae_v_move(&taubuf.ptr.p_double[0], 1, &tau->ptr.p_double[blockstart], 1, ae_v_len(0,blocksize-1)); - - /* - * Update, choose between: - * a) Level 2 algorithm (when the rest of the matrix is small enough) - * b) blocked algorithm, see algorithm 5 from 'A storage efficient WY - * representation for products of Householder transformations', - * by R. Schreiber and C. Van Loan. - */ - if( qcolumns>=2*ablasblocksize(a, _state) ) - { - - /* - * Prepare block reflector - */ - ortfac_rmatrixblockreflector(&tmpa, &taubuf, ae_true, rowscount, blocksize, &tmpt, &work, _state); - - /* - * Multiply matrix by Q. - * - * Q = E + Y*T*Y' = E + TmpA*TmpT*TmpA' - */ - rmatrixgemm(blocksize, qcolumns, rowscount, 1.0, &tmpa, 0, 0, 1, q, blockstart, 0, 0, 0.0, &tmpr, 0, 0, _state); - rmatrixgemm(blocksize, qcolumns, blocksize, 1.0, &tmpt, 0, 0, 0, &tmpr, 0, 0, 0, 0.0, &tmpr, blocksize, 0, _state); - rmatrixgemm(rowscount, qcolumns, blocksize, 1.0, &tmpa, 0, 0, 0, &tmpr, blocksize, 0, 0, 1.0, q, blockstart, 0, _state); - } - else - { - - /* - * Level 2 algorithm - */ - for(i=blocksize-1; i>=0; i--) - { - ae_v_move(&t.ptr.p_double[1], 1, &tmpa.ptr.pp_double[i][i], tmpa.stride, ae_v_len(1,rowscount-i)); - t.ptr.p_double[1] = 1; - applyreflectionfromtheleft(q, taubuf.ptr.p_double[i], &t, blockstart+i, m-1, 0, qcolumns-1, &work, _state); - } - } - } - - /* - * Advance - */ - blockstart = blockstart-ablasblocksize(a, _state); - blocksize = ablasblocksize(a, _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Unpacking of matrix R from the QR decomposition of a matrix A - -Input parameters: - A - matrices Q and R in compact form. - Output of RMatrixQR subroutine. - M - number of rows in given matrix A. M>=0. - N - number of columns in given matrix A. N>=0. - -Output parameters: - R - matrix R, array[0..M-1, 0..N-1]. - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixqrunpackr(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* r, - ae_state *_state) -{ - ae_int_t i; - ae_int_t k; - - ae_matrix_clear(r); - - if( m<=0||n<=0 ) - { - return; - } - k = ae_minint(m, n, _state); - ae_matrix_set_length(r, m, n, _state); - for(i=0; i<=n-1; i++) - { - r->ptr.pp_double[0][i] = 0; - } - for(i=1; i<=m-1; i++) - { - ae_v_move(&r->ptr.pp_double[i][0], 1, &r->ptr.pp_double[0][0], 1, ae_v_len(0,n-1)); - } - for(i=0; i<=k-1; i++) - { - ae_v_move(&r->ptr.pp_double[i][i], 1, &a->ptr.pp_double[i][i], 1, ae_v_len(i,n-1)); - } -} - - -/************************************************************************* -Partial unpacking of matrix Q from the LQ decomposition of a matrix A - -Input parameters: - A - matrices L and Q in compact form. - Output of RMatrixLQ subroutine. - M - number of rows in given matrix A. M>=0. - N - number of columns in given matrix A. N>=0. - Tau - scalar factors which are used to form Q. - Output of the RMatrixLQ subroutine. - QRows - required number of rows in matrix Q. N>=QRows>=0. - -Output parameters: - Q - first QRows rows of matrix Q. Array whose indexes range - within [0..QRows-1, 0..N-1]. If QRows=0, the array remains - unchanged. - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixlqunpackq(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Real */ ae_vector* tau, - ae_int_t qrows, - /* Real */ ae_matrix* q, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector work; - ae_vector t; - ae_vector taubuf; - ae_int_t minmn; - ae_int_t refcnt; - ae_matrix tmpa; - ae_matrix tmpt; - ae_matrix tmpr; - ae_int_t blockstart; - ae_int_t blocksize; - ae_int_t columnscount; - ae_int_t i; - ae_int_t j; - - ae_frame_make(_state, &_frame_block); - ae_matrix_clear(q); - ae_vector_init(&work, 0, DT_REAL, _state, ae_true); - ae_vector_init(&t, 0, DT_REAL, _state, ae_true); - ae_vector_init(&taubuf, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&tmpa, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&tmpt, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&tmpr, 0, 0, DT_REAL, _state, ae_true); - - ae_assert(qrows<=n, "RMatrixLQUnpackQ: QRows>N!", _state); - if( (m<=0||n<=0)||qrows<=0 ) - { - ae_frame_leave(_state); - return; - } - - /* - * init - */ - minmn = ae_minint(m, n, _state); - refcnt = ae_minint(minmn, qrows, _state); - ae_vector_set_length(&work, ae_maxint(m, n, _state)+1, _state); - ae_vector_set_length(&t, ae_maxint(m, n, _state)+1, _state); - ae_vector_set_length(&taubuf, minmn, _state); - ae_matrix_set_length(&tmpa, ablasblocksize(a, _state), n, _state); - ae_matrix_set_length(&tmpt, ablasblocksize(a, _state), 2*ablasblocksize(a, _state), _state); - ae_matrix_set_length(&tmpr, qrows, 2*ablasblocksize(a, _state), _state); - ae_matrix_set_length(q, qrows, n, _state); - for(i=0; i<=qrows-1; i++) - { - for(j=0; j<=n-1; j++) - { - if( i==j ) - { - q->ptr.pp_double[i][j] = 1; - } - else - { - q->ptr.pp_double[i][j] = 0; - } - } - } - - /* - * Blocked code - */ - blockstart = ablasblocksize(a, _state)*(refcnt/ablasblocksize(a, _state)); - blocksize = refcnt-blockstart; - while(blockstart>=0) - { - columnscount = n-blockstart; - if( blocksize>0 ) - { - - /* - * Copy submatrix - */ - rmatrixcopy(blocksize, columnscount, a, blockstart, blockstart, &tmpa, 0, 0, _state); - ae_v_move(&taubuf.ptr.p_double[0], 1, &tau->ptr.p_double[blockstart], 1, ae_v_len(0,blocksize-1)); - - /* - * Update matrix, choose between: - * a) Level 2 algorithm (when the rest of the matrix is small enough) - * b) blocked algorithm, see algorithm 5 from 'A storage efficient WY - * representation for products of Householder transformations', - * by R. Schreiber and C. Van Loan. - */ - if( qrows>=2*ablasblocksize(a, _state) ) - { - - /* - * Prepare block reflector - */ - ortfac_rmatrixblockreflector(&tmpa, &taubuf, ae_false, columnscount, blocksize, &tmpt, &work, _state); - - /* - * Multiply the rest of A by Q'. - * - * Q' = E + Y*T'*Y' = E + TmpA'*TmpT'*TmpA - */ - rmatrixgemm(qrows, blocksize, columnscount, 1.0, q, 0, blockstart, 0, &tmpa, 0, 0, 1, 0.0, &tmpr, 0, 0, _state); - rmatrixgemm(qrows, blocksize, blocksize, 1.0, &tmpr, 0, 0, 0, &tmpt, 0, 0, 1, 0.0, &tmpr, 0, blocksize, _state); - rmatrixgemm(qrows, columnscount, blocksize, 1.0, &tmpr, 0, blocksize, 0, &tmpa, 0, 0, 0, 1.0, q, 0, blockstart, _state); - } - else - { - - /* - * Level 2 algorithm - */ - for(i=blocksize-1; i>=0; i--) - { - ae_v_move(&t.ptr.p_double[1], 1, &tmpa.ptr.pp_double[i][i], 1, ae_v_len(1,columnscount-i)); - t.ptr.p_double[1] = 1; - applyreflectionfromtheright(q, taubuf.ptr.p_double[i], &t, 0, qrows-1, blockstart+i, n-1, &work, _state); - } - } - } - - /* - * Advance - */ - blockstart = blockstart-ablasblocksize(a, _state); - blocksize = ablasblocksize(a, _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Unpacking of matrix L from the LQ decomposition of a matrix A - -Input parameters: - A - matrices Q and L in compact form. - Output of RMatrixLQ subroutine. - M - number of rows in given matrix A. M>=0. - N - number of columns in given matrix A. N>=0. - -Output parameters: - L - matrix L, array[0..M-1, 0..N-1]. - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixlqunpackl(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* l, - ae_state *_state) -{ - ae_int_t i; - ae_int_t k; - - ae_matrix_clear(l); - - if( m<=0||n<=0 ) - { - return; - } - ae_matrix_set_length(l, m, n, _state); - for(i=0; i<=n-1; i++) - { - l->ptr.pp_double[0][i] = 0; - } - for(i=1; i<=m-1; i++) - { - ae_v_move(&l->ptr.pp_double[i][0], 1, &l->ptr.pp_double[0][0], 1, ae_v_len(0,n-1)); - } - for(i=0; i<=m-1; i++) - { - k = ae_minint(i, n-1, _state); - ae_v_move(&l->ptr.pp_double[i][0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,k)); - } -} - - -/************************************************************************* -Partial unpacking of matrix Q from QR decomposition of a complex matrix A. - -Input parameters: - A - matrices Q and R in compact form. - Output of CMatrixQR subroutine . - M - number of rows in matrix A. M>=0. - N - number of columns in matrix A. N>=0. - Tau - scalar factors which are used to form Q. - Output of CMatrixQR subroutine . - QColumns - required number of columns in matrix Q. M>=QColumns>=0. - -Output parameters: - Q - first QColumns columns of matrix Q. - Array whose index ranges within [0..M-1, 0..QColumns-1]. - If QColumns=0, array isn't changed. - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -void cmatrixqrunpackq(/* Complex */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Complex */ ae_vector* tau, - ae_int_t qcolumns, - /* Complex */ ae_matrix* q, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector work; - ae_vector t; - ae_vector taubuf; - ae_int_t minmn; - ae_int_t refcnt; - ae_matrix tmpa; - ae_matrix tmpt; - ae_matrix tmpr; - ae_int_t blockstart; - ae_int_t blocksize; - ae_int_t rowscount; - ae_int_t i; - ae_int_t j; - - ae_frame_make(_state, &_frame_block); - ae_matrix_clear(q); - ae_vector_init(&work, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&t, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&taubuf, 0, DT_COMPLEX, _state, ae_true); - ae_matrix_init(&tmpa, 0, 0, DT_COMPLEX, _state, ae_true); - ae_matrix_init(&tmpt, 0, 0, DT_COMPLEX, _state, ae_true); - ae_matrix_init(&tmpr, 0, 0, DT_COMPLEX, _state, ae_true); - - ae_assert(qcolumns<=m, "UnpackQFromQR: QColumns>M!", _state); - if( m<=0||n<=0 ) - { - ae_frame_leave(_state); - return; - } - - /* - * init - */ - minmn = ae_minint(m, n, _state); - refcnt = ae_minint(minmn, qcolumns, _state); - ae_vector_set_length(&work, ae_maxint(m, n, _state)+1, _state); - ae_vector_set_length(&t, ae_maxint(m, n, _state)+1, _state); - ae_vector_set_length(&taubuf, minmn, _state); - ae_matrix_set_length(&tmpa, m, ablascomplexblocksize(a, _state), _state); - ae_matrix_set_length(&tmpt, ablascomplexblocksize(a, _state), ablascomplexblocksize(a, _state), _state); - ae_matrix_set_length(&tmpr, 2*ablascomplexblocksize(a, _state), qcolumns, _state); - ae_matrix_set_length(q, m, qcolumns, _state); - for(i=0; i<=m-1; i++) - { - for(j=0; j<=qcolumns-1; j++) - { - if( i==j ) - { - q->ptr.pp_complex[i][j] = ae_complex_from_d(1); - } - else - { - q->ptr.pp_complex[i][j] = ae_complex_from_d(0); - } - } - } - - /* - * Blocked code - */ - blockstart = ablascomplexblocksize(a, _state)*(refcnt/ablascomplexblocksize(a, _state)); - blocksize = refcnt-blockstart; - while(blockstart>=0) - { - rowscount = m-blockstart; - if( blocksize>0 ) - { - - /* - * QR decomposition of submatrix. - * Matrix is copied to temporary storage to solve - * some TLB issues arising from non-contiguous memory - * access pattern. - */ - cmatrixcopy(rowscount, blocksize, a, blockstart, blockstart, &tmpa, 0, 0, _state); - ae_v_cmove(&taubuf.ptr.p_complex[0], 1, &tau->ptr.p_complex[blockstart], 1, "N", ae_v_len(0,blocksize-1)); - - /* - * Update matrix, choose between: - * a) Level 2 algorithm (when the rest of the matrix is small enough) - * b) blocked algorithm, see algorithm 5 from 'A storage efficient WY - * representation for products of Householder transformations', - * by R. Schreiber and C. Van Loan. - */ - if( qcolumns>=2*ablascomplexblocksize(a, _state) ) - { - - /* - * Prepare block reflector - */ - ortfac_cmatrixblockreflector(&tmpa, &taubuf, ae_true, rowscount, blocksize, &tmpt, &work, _state); - - /* - * Multiply the rest of A by Q. - * - * Q = E + Y*T*Y' = E + TmpA*TmpT*TmpA' - */ - cmatrixgemm(blocksize, qcolumns, rowscount, ae_complex_from_d(1.0), &tmpa, 0, 0, 2, q, blockstart, 0, 0, ae_complex_from_d(0.0), &tmpr, 0, 0, _state); - cmatrixgemm(blocksize, qcolumns, blocksize, ae_complex_from_d(1.0), &tmpt, 0, 0, 0, &tmpr, 0, 0, 0, ae_complex_from_d(0.0), &tmpr, blocksize, 0, _state); - cmatrixgemm(rowscount, qcolumns, blocksize, ae_complex_from_d(1.0), &tmpa, 0, 0, 0, &tmpr, blocksize, 0, 0, ae_complex_from_d(1.0), q, blockstart, 0, _state); - } - else - { - - /* - * Level 2 algorithm - */ - for(i=blocksize-1; i>=0; i--) - { - ae_v_cmove(&t.ptr.p_complex[1], 1, &tmpa.ptr.pp_complex[i][i], tmpa.stride, "N", ae_v_len(1,rowscount-i)); - t.ptr.p_complex[1] = ae_complex_from_d(1); - complexapplyreflectionfromtheleft(q, taubuf.ptr.p_complex[i], &t, blockstart+i, m-1, 0, qcolumns-1, &work, _state); - } - } - } - - /* - * Advance - */ - blockstart = blockstart-ablascomplexblocksize(a, _state); - blocksize = ablascomplexblocksize(a, _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Unpacking of matrix R from the QR decomposition of a matrix A - -Input parameters: - A - matrices Q and R in compact form. - Output of CMatrixQR subroutine. - M - number of rows in given matrix A. M>=0. - N - number of columns in given matrix A. N>=0. - -Output parameters: - R - matrix R, array[0..M-1, 0..N-1]. - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -void cmatrixqrunpackr(/* Complex */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* r, - ae_state *_state) -{ - ae_int_t i; - ae_int_t k; - - ae_matrix_clear(r); - - if( m<=0||n<=0 ) - { - return; - } - k = ae_minint(m, n, _state); - ae_matrix_set_length(r, m, n, _state); - for(i=0; i<=n-1; i++) - { - r->ptr.pp_complex[0][i] = ae_complex_from_d(0); - } - for(i=1; i<=m-1; i++) - { - ae_v_cmove(&r->ptr.pp_complex[i][0], 1, &r->ptr.pp_complex[0][0], 1, "N", ae_v_len(0,n-1)); - } - for(i=0; i<=k-1; i++) - { - ae_v_cmove(&r->ptr.pp_complex[i][i], 1, &a->ptr.pp_complex[i][i], 1, "N", ae_v_len(i,n-1)); - } -} - - -/************************************************************************* -Partial unpacking of matrix Q from LQ decomposition of a complex matrix A. - -Input parameters: - A - matrices Q and R in compact form. - Output of CMatrixLQ subroutine . - M - number of rows in matrix A. M>=0. - N - number of columns in matrix A. N>=0. - Tau - scalar factors which are used to form Q. - Output of CMatrixLQ subroutine . - QRows - required number of rows in matrix Q. N>=QColumns>=0. - -Output parameters: - Q - first QRows rows of matrix Q. - Array whose index ranges within [0..QRows-1, 0..N-1]. - If QRows=0, array isn't changed. - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -void cmatrixlqunpackq(/* Complex */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Complex */ ae_vector* tau, - ae_int_t qrows, - /* Complex */ ae_matrix* q, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector work; - ae_vector t; - ae_vector taubuf; - ae_int_t minmn; - ae_int_t refcnt; - ae_matrix tmpa; - ae_matrix tmpt; - ae_matrix tmpr; - ae_int_t blockstart; - ae_int_t blocksize; - ae_int_t columnscount; - ae_int_t i; - ae_int_t j; - - ae_frame_make(_state, &_frame_block); - ae_matrix_clear(q); - ae_vector_init(&work, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&t, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&taubuf, 0, DT_COMPLEX, _state, ae_true); - ae_matrix_init(&tmpa, 0, 0, DT_COMPLEX, _state, ae_true); - ae_matrix_init(&tmpt, 0, 0, DT_COMPLEX, _state, ae_true); - ae_matrix_init(&tmpr, 0, 0, DT_COMPLEX, _state, ae_true); - - if( m<=0||n<=0 ) - { - ae_frame_leave(_state); - return; - } - - /* - * Init - */ - minmn = ae_minint(m, n, _state); - refcnt = ae_minint(minmn, qrows, _state); - ae_vector_set_length(&work, ae_maxint(m, n, _state)+1, _state); - ae_vector_set_length(&t, ae_maxint(m, n, _state)+1, _state); - ae_vector_set_length(&taubuf, minmn, _state); - ae_matrix_set_length(&tmpa, ablascomplexblocksize(a, _state), n, _state); - ae_matrix_set_length(&tmpt, ablascomplexblocksize(a, _state), ablascomplexblocksize(a, _state), _state); - ae_matrix_set_length(&tmpr, qrows, 2*ablascomplexblocksize(a, _state), _state); - ae_matrix_set_length(q, qrows, n, _state); - for(i=0; i<=qrows-1; i++) - { - for(j=0; j<=n-1; j++) - { - if( i==j ) - { - q->ptr.pp_complex[i][j] = ae_complex_from_d(1); - } - else - { - q->ptr.pp_complex[i][j] = ae_complex_from_d(0); - } - } - } - - /* - * Blocked code - */ - blockstart = ablascomplexblocksize(a, _state)*(refcnt/ablascomplexblocksize(a, _state)); - blocksize = refcnt-blockstart; - while(blockstart>=0) - { - columnscount = n-blockstart; - if( blocksize>0 ) - { - - /* - * LQ decomposition of submatrix. - * Matrix is copied to temporary storage to solve - * some TLB issues arising from non-contiguous memory - * access pattern. - */ - cmatrixcopy(blocksize, columnscount, a, blockstart, blockstart, &tmpa, 0, 0, _state); - ae_v_cmove(&taubuf.ptr.p_complex[0], 1, &tau->ptr.p_complex[blockstart], 1, "N", ae_v_len(0,blocksize-1)); - - /* - * Update matrix, choose between: - * a) Level 2 algorithm (when the rest of the matrix is small enough) - * b) blocked algorithm, see algorithm 5 from 'A storage efficient WY - * representation for products of Householder transformations', - * by R. Schreiber and C. Van Loan. - */ - if( qrows>=2*ablascomplexblocksize(a, _state) ) - { - - /* - * Prepare block reflector - */ - ortfac_cmatrixblockreflector(&tmpa, &taubuf, ae_false, columnscount, blocksize, &tmpt, &work, _state); - - /* - * Multiply the rest of A by Q'. - * - * Q' = E + Y*T'*Y' = E + TmpA'*TmpT'*TmpA - */ - cmatrixgemm(qrows, blocksize, columnscount, ae_complex_from_d(1.0), q, 0, blockstart, 0, &tmpa, 0, 0, 2, ae_complex_from_d(0.0), &tmpr, 0, 0, _state); - cmatrixgemm(qrows, blocksize, blocksize, ae_complex_from_d(1.0), &tmpr, 0, 0, 0, &tmpt, 0, 0, 2, ae_complex_from_d(0.0), &tmpr, 0, blocksize, _state); - cmatrixgemm(qrows, columnscount, blocksize, ae_complex_from_d(1.0), &tmpr, 0, blocksize, 0, &tmpa, 0, 0, 0, ae_complex_from_d(1.0), q, 0, blockstart, _state); - } - else - { - - /* - * Level 2 algorithm - */ - for(i=blocksize-1; i>=0; i--) - { - ae_v_cmove(&t.ptr.p_complex[1], 1, &tmpa.ptr.pp_complex[i][i], 1, "Conj", ae_v_len(1,columnscount-i)); - t.ptr.p_complex[1] = ae_complex_from_d(1); - complexapplyreflectionfromtheright(q, ae_c_conj(taubuf.ptr.p_complex[i], _state), &t, 0, qrows-1, blockstart+i, n-1, &work, _state); - } - } - } - - /* - * Advance - */ - blockstart = blockstart-ablascomplexblocksize(a, _state); - blocksize = ablascomplexblocksize(a, _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Unpacking of matrix L from the LQ decomposition of a matrix A - -Input parameters: - A - matrices Q and L in compact form. - Output of CMatrixLQ subroutine. - M - number of rows in given matrix A. M>=0. - N - number of columns in given matrix A. N>=0. - -Output parameters: - L - matrix L, array[0..M-1, 0..N-1]. - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -void cmatrixlqunpackl(/* Complex */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* l, - ae_state *_state) -{ - ae_int_t i; - ae_int_t k; - - ae_matrix_clear(l); - - if( m<=0||n<=0 ) - { - return; - } - ae_matrix_set_length(l, m, n, _state); - for(i=0; i<=n-1; i++) - { - l->ptr.pp_complex[0][i] = ae_complex_from_d(0); - } - for(i=1; i<=m-1; i++) - { - ae_v_cmove(&l->ptr.pp_complex[i][0], 1, &l->ptr.pp_complex[0][0], 1, "N", ae_v_len(0,n-1)); - } - for(i=0; i<=m-1; i++) - { - k = ae_minint(i, n-1, _state); - ae_v_cmove(&l->ptr.pp_complex[i][0], 1, &a->ptr.pp_complex[i][0], 1, "N", ae_v_len(0,k)); - } -} - - -/************************************************************************* -Base case for real QR - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - September 30, 1994. - Sergey Bochkanov, ALGLIB project, translation from FORTRAN to - pseudocode, 2007-2010. -*************************************************************************/ -void rmatrixqrbasecase(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Real */ ae_vector* work, - /* Real */ ae_vector* t, - /* Real */ ae_vector* tau, - ae_state *_state) -{ - ae_int_t i; - ae_int_t k; - ae_int_t minmn; - double tmp; - - - minmn = ae_minint(m, n, _state); - - /* - * Test the input arguments - */ - k = minmn; - for(i=0; i<=k-1; i++) - { - - /* - * Generate elementary reflector H(i) to annihilate A(i+1:m,i) - */ - ae_v_move(&t->ptr.p_double[1], 1, &a->ptr.pp_double[i][i], a->stride, ae_v_len(1,m-i)); - generatereflection(t, m-i, &tmp, _state); - tau->ptr.p_double[i] = tmp; - ae_v_move(&a->ptr.pp_double[i][i], a->stride, &t->ptr.p_double[1], 1, ae_v_len(i,m-1)); - t->ptr.p_double[1] = 1; - if( iptr.p_double[i], t, i, m-1, i+1, n-1, work, _state); - } - } -} - - -/************************************************************************* -Base case for real LQ - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - September 30, 1994. - Sergey Bochkanov, ALGLIB project, translation from FORTRAN to - pseudocode, 2007-2010. -*************************************************************************/ -void rmatrixlqbasecase(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Real */ ae_vector* work, - /* Real */ ae_vector* t, - /* Real */ ae_vector* tau, - ae_state *_state) -{ - ae_int_t i; - ae_int_t k; - double tmp; - - - k = ae_minint(m, n, _state); - for(i=0; i<=k-1; i++) - { - - /* - * Generate elementary reflector H(i) to annihilate A(i,i+1:n-1) - */ - ae_v_move(&t->ptr.p_double[1], 1, &a->ptr.pp_double[i][i], 1, ae_v_len(1,n-i)); - generatereflection(t, n-i, &tmp, _state); - tau->ptr.p_double[i] = tmp; - ae_v_move(&a->ptr.pp_double[i][i], 1, &t->ptr.p_double[1], 1, ae_v_len(i,n-1)); - t->ptr.p_double[1] = 1; - if( iptr.p_double[i], t, i+1, m-1, i, n-1, work, _state); - } - } -} - - -/************************************************************************* -Reduction of a rectangular matrix to bidiagonal form - -The algorithm reduces the rectangular matrix A to bidiagonal form by -orthogonal transformations P and Q: A = Q*B*P. - -Input parameters: - A - source matrix. array[0..M-1, 0..N-1] - M - number of rows in matrix A. - N - number of columns in matrix A. - -Output parameters: - A - matrices Q, B, P in compact form (see below). - TauQ - scalar factors which are used to form matrix Q. - TauP - scalar factors which are used to form matrix P. - -The main diagonal and one of the secondary diagonals of matrix A are -replaced with bidiagonal matrix B. Other elements contain elementary -reflections which form MxM matrix Q and NxN matrix P, respectively. - -If M>=N, B is the upper bidiagonal MxN matrix and is stored in the -corresponding elements of matrix A. Matrix Q is represented as a -product of elementary reflections Q = H(0)*H(1)*...*H(n-1), where -H(i) = 1-tau*v*v'. Here tau is a scalar which is stored in TauQ[i], and -vector v has the following structure: v(0:i-1)=0, v(i)=1, v(i+1:m-1) is -stored in elements A(i+1:m-1,i). Matrix P is as follows: P = -G(0)*G(1)*...*G(n-2), where G(i) = 1 - tau*u*u'. Tau is stored in TauP[i], -u(0:i)=0, u(i+1)=1, u(i+2:n-1) is stored in elements A(i,i+2:n-1). - -If M n): m=5, n=6 (m < n): - -( d e u1 u1 u1 ) ( d u1 u1 u1 u1 u1 ) -( v1 d e u2 u2 ) ( e d u2 u2 u2 u2 ) -( v1 v2 d e u3 ) ( v1 e d u3 u3 u3 ) -( v1 v2 v3 d e ) ( v1 v2 e d u4 u4 ) -( v1 v2 v3 v4 d ) ( v1 v2 v3 e d u5 ) -( v1 v2 v3 v4 v5 ) - -Here vi and ui are vectors which form H(i) and G(i), and d and e - -are the diagonal and off-diagonal elements of matrix B. - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - September 30, 1994. - Sergey Bochkanov, ALGLIB project, translation from FORTRAN to - pseudocode, 2007-2010. -*************************************************************************/ -void rmatrixbd(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Real */ ae_vector* tauq, - /* Real */ ae_vector* taup, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector work; - ae_vector t; - ae_int_t maxmn; - ae_int_t i; - double ltau; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(tauq); - ae_vector_clear(taup); - ae_vector_init(&work, 0, DT_REAL, _state, ae_true); - ae_vector_init(&t, 0, DT_REAL, _state, ae_true); - - - /* - * Prepare - */ - if( n<=0||m<=0 ) - { - ae_frame_leave(_state); - return; - } - maxmn = ae_maxint(m, n, _state); - ae_vector_set_length(&work, maxmn+1, _state); - ae_vector_set_length(&t, maxmn+1, _state); - if( m>=n ) - { - ae_vector_set_length(tauq, n, _state); - ae_vector_set_length(taup, n, _state); - } - else - { - ae_vector_set_length(tauq, m, _state); - ae_vector_set_length(taup, m, _state); - } - if( m>=n ) - { - - /* - * Reduce to upper bidiagonal form - */ - for(i=0; i<=n-1; i++) - { - - /* - * Generate elementary reflector H(i) to annihilate A(i+1:m-1,i) - */ - ae_v_move(&t.ptr.p_double[1], 1, &a->ptr.pp_double[i][i], a->stride, ae_v_len(1,m-i)); - generatereflection(&t, m-i, <au, _state); - tauq->ptr.p_double[i] = ltau; - ae_v_move(&a->ptr.pp_double[i][i], a->stride, &t.ptr.p_double[1], 1, ae_v_len(i,m-1)); - t.ptr.p_double[1] = 1; - - /* - * Apply H(i) to A(i:m-1,i+1:n-1) from the left - */ - applyreflectionfromtheleft(a, ltau, &t, i, m-1, i+1, n-1, &work, _state); - if( iptr.pp_double[i][i+1], 1, ae_v_len(1,n-i-1)); - generatereflection(&t, n-1-i, <au, _state); - taup->ptr.p_double[i] = ltau; - ae_v_move(&a->ptr.pp_double[i][i+1], 1, &t.ptr.p_double[1], 1, ae_v_len(i+1,n-1)); - t.ptr.p_double[1] = 1; - - /* - * Apply G(i) to A(i+1:m-1,i+1:n-1) from the right - */ - applyreflectionfromtheright(a, ltau, &t, i+1, m-1, i+1, n-1, &work, _state); - } - else - { - taup->ptr.p_double[i] = 0; - } - } - } - else - { - - /* - * Reduce to lower bidiagonal form - */ - for(i=0; i<=m-1; i++) - { - - /* - * Generate elementary reflector G(i) to annihilate A(i,i+1:n-1) - */ - ae_v_move(&t.ptr.p_double[1], 1, &a->ptr.pp_double[i][i], 1, ae_v_len(1,n-i)); - generatereflection(&t, n-i, <au, _state); - taup->ptr.p_double[i] = ltau; - ae_v_move(&a->ptr.pp_double[i][i], 1, &t.ptr.p_double[1], 1, ae_v_len(i,n-1)); - t.ptr.p_double[1] = 1; - - /* - * Apply G(i) to A(i+1:m-1,i:n-1) from the right - */ - applyreflectionfromtheright(a, ltau, &t, i+1, m-1, i, n-1, &work, _state); - if( iptr.pp_double[i+1][i], a->stride, ae_v_len(1,m-1-i)); - generatereflection(&t, m-1-i, <au, _state); - tauq->ptr.p_double[i] = ltau; - ae_v_move(&a->ptr.pp_double[i+1][i], a->stride, &t.ptr.p_double[1], 1, ae_v_len(i+1,m-1)); - t.ptr.p_double[1] = 1; - - /* - * Apply H(i) to A(i+1:m-1,i+1:n-1) from the left - */ - applyreflectionfromtheleft(a, ltau, &t, i+1, m-1, i+1, n-1, &work, _state); - } - else - { - tauq->ptr.p_double[i] = 0; - } - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Unpacking matrix Q which reduces a matrix to bidiagonal form. - -Input parameters: - QP - matrices Q and P in compact form. - Output of ToBidiagonal subroutine. - M - number of rows in matrix A. - N - number of columns in matrix A. - TAUQ - scalar factors which are used to form Q. - Output of ToBidiagonal subroutine. - QColumns - required number of columns in matrix Q. - M>=QColumns>=0. - -Output parameters: - Q - first QColumns columns of matrix Q. - Array[0..M-1, 0..QColumns-1] - If QColumns=0, the array is not modified. - - -- ALGLIB -- - 2005-2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixbdunpackq(/* Real */ ae_matrix* qp, - ae_int_t m, - ae_int_t n, - /* Real */ ae_vector* tauq, - ae_int_t qcolumns, - /* Real */ ae_matrix* q, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - - ae_matrix_clear(q); - - ae_assert(qcolumns<=m, "RMatrixBDUnpackQ: QColumns>M!", _state); - ae_assert(qcolumns>=0, "RMatrixBDUnpackQ: QColumns<0!", _state); - if( (m==0||n==0)||qcolumns==0 ) - { - return; - } - - /* - * prepare Q - */ - ae_matrix_set_length(q, m, qcolumns, _state); - for(i=0; i<=m-1; i++) - { - for(j=0; j<=qcolumns-1; j++) - { - if( i==j ) - { - q->ptr.pp_double[i][j] = 1; - } - else - { - q->ptr.pp_double[i][j] = 0; - } - } - } - - /* - * Calculate - */ - rmatrixbdmultiplybyq(qp, m, n, tauq, q, m, qcolumns, ae_false, ae_false, _state); -} - - -/************************************************************************* -Multiplication by matrix Q which reduces matrix A to bidiagonal form. - -The algorithm allows pre- or post-multiply by Q or Q'. - -Input parameters: - QP - matrices Q and P in compact form. - Output of ToBidiagonal subroutine. - M - number of rows in matrix A. - N - number of columns in matrix A. - TAUQ - scalar factors which are used to form Q. - Output of ToBidiagonal subroutine. - Z - multiplied matrix. - array[0..ZRows-1,0..ZColumns-1] - ZRows - number of rows in matrix Z. If FromTheRight=False, - ZRows=M, otherwise ZRows can be arbitrary. - ZColumns - number of columns in matrix Z. If FromTheRight=True, - ZColumns=M, otherwise ZColumns can be arbitrary. - FromTheRight - pre- or post-multiply. - DoTranspose - multiply by Q or Q'. - -Output parameters: - Z - product of Z and Q. - Array[0..ZRows-1,0..ZColumns-1] - If ZRows=0 or ZColumns=0, the array is not modified. - - -- ALGLIB -- - 2005-2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixbdmultiplybyq(/* Real */ ae_matrix* qp, - ae_int_t m, - ae_int_t n, - /* Real */ ae_vector* tauq, - /* Real */ ae_matrix* z, - ae_int_t zrows, - ae_int_t zcolumns, - ae_bool fromtheright, - ae_bool dotranspose, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t i1; - ae_int_t i2; - ae_int_t istep; - ae_vector v; - ae_vector work; - ae_int_t mx; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&v, 0, DT_REAL, _state, ae_true); - ae_vector_init(&work, 0, DT_REAL, _state, ae_true); - - if( ((m<=0||n<=0)||zrows<=0)||zcolumns<=0 ) - { - ae_frame_leave(_state); - return; - } - ae_assert((fromtheright&&zcolumns==m)||(!fromtheright&&zrows==m), "RMatrixBDMultiplyByQ: incorrect Z size!", _state); - - /* - * init - */ - mx = ae_maxint(m, n, _state); - mx = ae_maxint(mx, zrows, _state); - mx = ae_maxint(mx, zcolumns, _state); - ae_vector_set_length(&v, mx+1, _state); - ae_vector_set_length(&work, mx+1, _state); - if( m>=n ) - { - - /* - * setup - */ - if( fromtheright ) - { - i1 = 0; - i2 = n-1; - istep = 1; - } - else - { - i1 = n-1; - i2 = 0; - istep = -1; - } - if( dotranspose ) - { - i = i1; - i1 = i2; - i2 = i; - istep = -istep; - } - - /* - * Process - */ - i = i1; - do - { - ae_v_move(&v.ptr.p_double[1], 1, &qp->ptr.pp_double[i][i], qp->stride, ae_v_len(1,m-i)); - v.ptr.p_double[1] = 1; - if( fromtheright ) - { - applyreflectionfromtheright(z, tauq->ptr.p_double[i], &v, 0, zrows-1, i, m-1, &work, _state); - } - else - { - applyreflectionfromtheleft(z, tauq->ptr.p_double[i], &v, i, m-1, 0, zcolumns-1, &work, _state); - } - i = i+istep; - } - while(i!=i2+istep); - } - else - { - - /* - * setup - */ - if( fromtheright ) - { - i1 = 0; - i2 = m-2; - istep = 1; - } - else - { - i1 = m-2; - i2 = 0; - istep = -1; - } - if( dotranspose ) - { - i = i1; - i1 = i2; - i2 = i; - istep = -istep; - } - - /* - * Process - */ - if( m-1>0 ) - { - i = i1; - do - { - ae_v_move(&v.ptr.p_double[1], 1, &qp->ptr.pp_double[i+1][i], qp->stride, ae_v_len(1,m-i-1)); - v.ptr.p_double[1] = 1; - if( fromtheright ) - { - applyreflectionfromtheright(z, tauq->ptr.p_double[i], &v, 0, zrows-1, i+1, m-1, &work, _state); - } - else - { - applyreflectionfromtheleft(z, tauq->ptr.p_double[i], &v, i+1, m-1, 0, zcolumns-1, &work, _state); - } - i = i+istep; - } - while(i!=i2+istep); - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Unpacking matrix P which reduces matrix A to bidiagonal form. -The subroutine returns transposed matrix P. - -Input parameters: - QP - matrices Q and P in compact form. - Output of ToBidiagonal subroutine. - M - number of rows in matrix A. - N - number of columns in matrix A. - TAUP - scalar factors which are used to form P. - Output of ToBidiagonal subroutine. - PTRows - required number of rows of matrix P^T. N >= PTRows >= 0. - -Output parameters: - PT - first PTRows columns of matrix P^T - Array[0..PTRows-1, 0..N-1] - If PTRows=0, the array is not modified. - - -- ALGLIB -- - 2005-2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixbdunpackpt(/* Real */ ae_matrix* qp, - ae_int_t m, - ae_int_t n, - /* Real */ ae_vector* taup, - ae_int_t ptrows, - /* Real */ ae_matrix* pt, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - - ae_matrix_clear(pt); - - ae_assert(ptrows<=n, "RMatrixBDUnpackPT: PTRows>N!", _state); - ae_assert(ptrows>=0, "RMatrixBDUnpackPT: PTRows<0!", _state); - if( (m==0||n==0)||ptrows==0 ) - { - return; - } - - /* - * prepare PT - */ - ae_matrix_set_length(pt, ptrows, n, _state); - for(i=0; i<=ptrows-1; i++) - { - for(j=0; j<=n-1; j++) - { - if( i==j ) - { - pt->ptr.pp_double[i][j] = 1; - } - else - { - pt->ptr.pp_double[i][j] = 0; - } - } - } - - /* - * Calculate - */ - rmatrixbdmultiplybyp(qp, m, n, taup, pt, ptrows, n, ae_true, ae_true, _state); -} - - -/************************************************************************* -Multiplication by matrix P which reduces matrix A to bidiagonal form. - -The algorithm allows pre- or post-multiply by P or P'. - -Input parameters: - QP - matrices Q and P in compact form. - Output of RMatrixBD subroutine. - M - number of rows in matrix A. - N - number of columns in matrix A. - TAUP - scalar factors which are used to form P. - Output of RMatrixBD subroutine. - Z - multiplied matrix. - Array whose indexes range within [0..ZRows-1,0..ZColumns-1]. - ZRows - number of rows in matrix Z. If FromTheRight=False, - ZRows=N, otherwise ZRows can be arbitrary. - ZColumns - number of columns in matrix Z. If FromTheRight=True, - ZColumns=N, otherwise ZColumns can be arbitrary. - FromTheRight - pre- or post-multiply. - DoTranspose - multiply by P or P'. - -Output parameters: - Z - product of Z and P. - Array whose indexes range within [0..ZRows-1,0..ZColumns-1]. - If ZRows=0 or ZColumns=0, the array is not modified. - - -- ALGLIB -- - 2005-2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixbdmultiplybyp(/* Real */ ae_matrix* qp, - ae_int_t m, - ae_int_t n, - /* Real */ ae_vector* taup, - /* Real */ ae_matrix* z, - ae_int_t zrows, - ae_int_t zcolumns, - ae_bool fromtheright, - ae_bool dotranspose, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_vector v; - ae_vector work; - ae_int_t mx; - ae_int_t i1; - ae_int_t i2; - ae_int_t istep; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&v, 0, DT_REAL, _state, ae_true); - ae_vector_init(&work, 0, DT_REAL, _state, ae_true); - - if( ((m<=0||n<=0)||zrows<=0)||zcolumns<=0 ) - { - ae_frame_leave(_state); - return; - } - ae_assert((fromtheright&&zcolumns==n)||(!fromtheright&&zrows==n), "RMatrixBDMultiplyByP: incorrect Z size!", _state); - - /* - * init - */ - mx = ae_maxint(m, n, _state); - mx = ae_maxint(mx, zrows, _state); - mx = ae_maxint(mx, zcolumns, _state); - ae_vector_set_length(&v, mx+1, _state); - ae_vector_set_length(&work, mx+1, _state); - if( m>=n ) - { - - /* - * setup - */ - if( fromtheright ) - { - i1 = n-2; - i2 = 0; - istep = -1; - } - else - { - i1 = 0; - i2 = n-2; - istep = 1; - } - if( !dotranspose ) - { - i = i1; - i1 = i2; - i2 = i; - istep = -istep; - } - - /* - * Process - */ - if( n-1>0 ) - { - i = i1; - do - { - ae_v_move(&v.ptr.p_double[1], 1, &qp->ptr.pp_double[i][i+1], 1, ae_v_len(1,n-1-i)); - v.ptr.p_double[1] = 1; - if( fromtheright ) - { - applyreflectionfromtheright(z, taup->ptr.p_double[i], &v, 0, zrows-1, i+1, n-1, &work, _state); - } - else - { - applyreflectionfromtheleft(z, taup->ptr.p_double[i], &v, i+1, n-1, 0, zcolumns-1, &work, _state); - } - i = i+istep; - } - while(i!=i2+istep); - } - } - else - { - - /* - * setup - */ - if( fromtheright ) - { - i1 = m-1; - i2 = 0; - istep = -1; - } - else - { - i1 = 0; - i2 = m-1; - istep = 1; - } - if( !dotranspose ) - { - i = i1; - i1 = i2; - i2 = i; - istep = -istep; - } - - /* - * Process - */ - i = i1; - do - { - ae_v_move(&v.ptr.p_double[1], 1, &qp->ptr.pp_double[i][i], 1, ae_v_len(1,n-i)); - v.ptr.p_double[1] = 1; - if( fromtheright ) - { - applyreflectionfromtheright(z, taup->ptr.p_double[i], &v, 0, zrows-1, i, n-1, &work, _state); - } - else - { - applyreflectionfromtheleft(z, taup->ptr.p_double[i], &v, i, n-1, 0, zcolumns-1, &work, _state); - } - i = i+istep; - } - while(i!=i2+istep); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Unpacking of the main and secondary diagonals of bidiagonal decomposition -of matrix A. - -Input parameters: - B - output of RMatrixBD subroutine. - M - number of rows in matrix B. - N - number of columns in matrix B. - -Output parameters: - IsUpper - True, if the matrix is upper bidiagonal. - otherwise IsUpper is False. - D - the main diagonal. - Array whose index ranges within [0..Min(M,N)-1]. - E - the secondary diagonal (upper or lower, depending on - the value of IsUpper). - Array index ranges within [0..Min(M,N)-1], the last - element is not used. - - -- ALGLIB -- - 2005-2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixbdunpackdiagonals(/* Real */ ae_matrix* b, - ae_int_t m, - ae_int_t n, - ae_bool* isupper, - /* Real */ ae_vector* d, - /* Real */ ae_vector* e, - ae_state *_state) -{ - ae_int_t i; - - *isupper = ae_false; - ae_vector_clear(d); - ae_vector_clear(e); - - *isupper = m>=n; - if( m<=0||n<=0 ) - { - return; - } - if( *isupper ) - { - ae_vector_set_length(d, n, _state); - ae_vector_set_length(e, n, _state); - for(i=0; i<=n-2; i++) - { - d->ptr.p_double[i] = b->ptr.pp_double[i][i]; - e->ptr.p_double[i] = b->ptr.pp_double[i][i+1]; - } - d->ptr.p_double[n-1] = b->ptr.pp_double[n-1][n-1]; - } - else - { - ae_vector_set_length(d, m, _state); - ae_vector_set_length(e, m, _state); - for(i=0; i<=m-2; i++) - { - d->ptr.p_double[i] = b->ptr.pp_double[i][i]; - e->ptr.p_double[i] = b->ptr.pp_double[i+1][i]; - } - d->ptr.p_double[m-1] = b->ptr.pp_double[m-1][m-1]; - } -} - - -/************************************************************************* -Reduction of a square matrix to upper Hessenberg form: Q'*A*Q = H, -where Q is an orthogonal matrix, H - Hessenberg matrix. - -Input parameters: - A - matrix A with elements [0..N-1, 0..N-1] - N - size of matrix A. - -Output parameters: - A - matrices Q and P in compact form (see below). - Tau - array of scalar factors which are used to form matrix Q. - Array whose index ranges within [0..N-2] - -Matrix H is located on the main diagonal, on the lower secondary diagonal -and above the main diagonal of matrix A. The elements which are used to -form matrix Q are situated in array Tau and below the lower secondary -diagonal of matrix A as follows: - -Matrix Q is represented as a product of elementary reflections - -Q = H(0)*H(2)*...*H(n-2), - -where each H(i) is given by - -H(i) = 1 - tau * v * (v^T) - -where tau is a scalar stored in Tau[I]; v - is a real vector, -so that v(0:i) = 0, v(i+1) = 1, v(i+2:n-1) stored in A(i+2:n-1,i). - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - October 31, 1992 -*************************************************************************/ -void rmatrixhessenberg(/* Real */ ae_matrix* a, - ae_int_t n, - /* Real */ ae_vector* tau, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - double v; - ae_vector t; - ae_vector work; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(tau); - ae_vector_init(&t, 0, DT_REAL, _state, ae_true); - ae_vector_init(&work, 0, DT_REAL, _state, ae_true); - - ae_assert(n>=0, "RMatrixHessenberg: incorrect N!", _state); - - /* - * Quick return if possible - */ - if( n<=1 ) - { - ae_frame_leave(_state); - return; - } - ae_vector_set_length(tau, n-2+1, _state); - ae_vector_set_length(&t, n+1, _state); - ae_vector_set_length(&work, n-1+1, _state); - for(i=0; i<=n-2; i++) - { - - /* - * Compute elementary reflector H(i) to annihilate A(i+2:ihi,i) - */ - ae_v_move(&t.ptr.p_double[1], 1, &a->ptr.pp_double[i+1][i], a->stride, ae_v_len(1,n-i-1)); - generatereflection(&t, n-i-1, &v, _state); - ae_v_move(&a->ptr.pp_double[i+1][i], a->stride, &t.ptr.p_double[1], 1, ae_v_len(i+1,n-1)); - tau->ptr.p_double[i] = v; - t.ptr.p_double[1] = 1; - - /* - * Apply H(i) to A(1:ihi,i+1:ihi) from the right - */ - applyreflectionfromtheright(a, v, &t, 0, n-1, i+1, n-1, &work, _state); - - /* - * Apply H(i) to A(i+1:ihi,i+1:n) from the left - */ - applyreflectionfromtheleft(a, v, &t, i+1, n-1, i+1, n-1, &work, _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Unpacking matrix Q which reduces matrix A to upper Hessenberg form - -Input parameters: - A - output of RMatrixHessenberg subroutine. - N - size of matrix A. - Tau - scalar factors which are used to form Q. - Output of RMatrixHessenberg subroutine. - -Output parameters: - Q - matrix Q. - Array whose indexes range within [0..N-1, 0..N-1]. - - -- ALGLIB -- - 2005-2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixhessenbergunpackq(/* Real */ ae_matrix* a, - ae_int_t n, - /* Real */ ae_vector* tau, - /* Real */ ae_matrix* q, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - ae_vector v; - ae_vector work; - - ae_frame_make(_state, &_frame_block); - ae_matrix_clear(q); - ae_vector_init(&v, 0, DT_REAL, _state, ae_true); - ae_vector_init(&work, 0, DT_REAL, _state, ae_true); - - if( n==0 ) - { - ae_frame_leave(_state); - return; - } - - /* - * init - */ - ae_matrix_set_length(q, n-1+1, n-1+1, _state); - ae_vector_set_length(&v, n-1+1, _state); - ae_vector_set_length(&work, n-1+1, _state); - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - if( i==j ) - { - q->ptr.pp_double[i][j] = 1; - } - else - { - q->ptr.pp_double[i][j] = 0; - } - } - } - - /* - * unpack Q - */ - for(i=0; i<=n-2; i++) - { - - /* - * Apply H(i) - */ - ae_v_move(&v.ptr.p_double[1], 1, &a->ptr.pp_double[i+1][i], a->stride, ae_v_len(1,n-i-1)); - v.ptr.p_double[1] = 1; - applyreflectionfromtheright(q, tau->ptr.p_double[i], &v, 0, n-1, i+1, n-1, &work, _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Unpacking matrix H (the result of matrix A reduction to upper Hessenberg form) - -Input parameters: - A - output of RMatrixHessenberg subroutine. - N - size of matrix A. - -Output parameters: - H - matrix H. Array whose indexes range within [0..N-1, 0..N-1]. - - -- ALGLIB -- - 2005-2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixhessenbergunpackh(/* Real */ ae_matrix* a, - ae_int_t n, - /* Real */ ae_matrix* h, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - ae_vector v; - ae_vector work; - - ae_frame_make(_state, &_frame_block); - ae_matrix_clear(h); - ae_vector_init(&v, 0, DT_REAL, _state, ae_true); - ae_vector_init(&work, 0, DT_REAL, _state, ae_true); - - if( n==0 ) - { - ae_frame_leave(_state); - return; - } - ae_matrix_set_length(h, n-1+1, n-1+1, _state); - for(i=0; i<=n-1; i++) - { - for(j=0; j<=i-2; j++) - { - h->ptr.pp_double[i][j] = 0; - } - j = ae_maxint(0, i-1, _state); - ae_v_move(&h->ptr.pp_double[i][j], 1, &a->ptr.pp_double[i][j], 1, ae_v_len(j,n-1)); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Reduction of a symmetric matrix which is given by its higher or lower -triangular part to a tridiagonal matrix using orthogonal similarity -transformation: Q'*A*Q=T. - -Input parameters: - A - matrix to be transformed - array with elements [0..N-1, 0..N-1]. - N - size of matrix A. - IsUpper - storage format. If IsUpper = True, then matrix A is given - by its upper triangle, and the lower triangle is not used - and not modified by the algorithm, and vice versa - if IsUpper = False. - -Output parameters: - A - matrices T and Q in compact form (see lower) - Tau - array of factors which are forming matrices H(i) - array with elements [0..N-2]. - D - main diagonal of symmetric matrix T. - array with elements [0..N-1]. - E - secondary diagonal of symmetric matrix T. - array with elements [0..N-2]. - - - If IsUpper=True, the matrix Q is represented as a product of elementary - reflectors - - Q = H(n-2) . . . H(2) H(0). - - Each H(i) has the form - - H(i) = I - tau * v * v' - - where tau is a real scalar, and v is a real vector with - v(i+1:n-1) = 0, v(i) = 1, v(0:i-1) is stored on exit in - A(0:i-1,i+1), and tau in TAU(i). - - If IsUpper=False, the matrix Q is represented as a product of elementary - reflectors - - Q = H(0) H(2) . . . H(n-2). - - Each H(i) has the form - - H(i) = I - tau * v * v' - - where tau is a real scalar, and v is a real vector with - v(0:i) = 0, v(i+1) = 1, v(i+2:n-1) is stored on exit in A(i+2:n-1,i), - and tau in TAU(i). - - The contents of A on exit are illustrated by the following examples - with n = 5: - - if UPLO = 'U': if UPLO = 'L': - - ( d e v1 v2 v3 ) ( d ) - ( d e v2 v3 ) ( e d ) - ( d e v3 ) ( v0 e d ) - ( d e ) ( v0 v1 e d ) - ( d ) ( v0 v1 v2 e d ) - - where d and e denote diagonal and off-diagonal elements of T, and vi - denotes an element of the vector defining H(i). - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - October 31, 1992 -*************************************************************************/ -void smatrixtd(/* Real */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - /* Real */ ae_vector* tau, - /* Real */ ae_vector* d, - /* Real */ ae_vector* e, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - double alpha; - double taui; - double v; - ae_vector t; - ae_vector t2; - ae_vector t3; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(tau); - ae_vector_clear(d); - ae_vector_clear(e); - ae_vector_init(&t, 0, DT_REAL, _state, ae_true); - ae_vector_init(&t2, 0, DT_REAL, _state, ae_true); - ae_vector_init(&t3, 0, DT_REAL, _state, ae_true); - - if( n<=0 ) - { - ae_frame_leave(_state); - return; - } - ae_vector_set_length(&t, n+1, _state); - ae_vector_set_length(&t2, n+1, _state); - ae_vector_set_length(&t3, n+1, _state); - if( n>1 ) - { - ae_vector_set_length(tau, n-2+1, _state); - } - ae_vector_set_length(d, n-1+1, _state); - if( n>1 ) - { - ae_vector_set_length(e, n-2+1, _state); - } - if( isupper ) - { - - /* - * Reduce the upper triangle of A - */ - for(i=n-2; i>=0; i--) - { - - /* - * Generate elementary reflector H() = E - tau * v * v' - */ - if( i>=1 ) - { - ae_v_move(&t.ptr.p_double[2], 1, &a->ptr.pp_double[0][i+1], a->stride, ae_v_len(2,i+1)); - } - t.ptr.p_double[1] = a->ptr.pp_double[i][i+1]; - generatereflection(&t, i+1, &taui, _state); - if( i>=1 ) - { - ae_v_move(&a->ptr.pp_double[0][i+1], a->stride, &t.ptr.p_double[2], 1, ae_v_len(0,i-1)); - } - a->ptr.pp_double[i][i+1] = t.ptr.p_double[1]; - e->ptr.p_double[i] = a->ptr.pp_double[i][i+1]; - if( ae_fp_neq(taui,0) ) - { - - /* - * Apply H from both sides to A - */ - a->ptr.pp_double[i][i+1] = 1; - - /* - * Compute x := tau * A * v storing x in TAU - */ - ae_v_move(&t.ptr.p_double[1], 1, &a->ptr.pp_double[0][i+1], a->stride, ae_v_len(1,i+1)); - symmetricmatrixvectormultiply(a, isupper, 0, i, &t, taui, &t3, _state); - ae_v_move(&tau->ptr.p_double[0], 1, &t3.ptr.p_double[1], 1, ae_v_len(0,i)); - - /* - * Compute w := x - 1/2 * tau * (x'*v) * v - */ - v = ae_v_dotproduct(&tau->ptr.p_double[0], 1, &a->ptr.pp_double[0][i+1], a->stride, ae_v_len(0,i)); - alpha = -0.5*taui*v; - ae_v_addd(&tau->ptr.p_double[0], 1, &a->ptr.pp_double[0][i+1], a->stride, ae_v_len(0,i), alpha); - - /* - * Apply the transformation as a rank-2 update: - * A := A - v * w' - w * v' - */ - ae_v_move(&t.ptr.p_double[1], 1, &a->ptr.pp_double[0][i+1], a->stride, ae_v_len(1,i+1)); - ae_v_move(&t3.ptr.p_double[1], 1, &tau->ptr.p_double[0], 1, ae_v_len(1,i+1)); - symmetricrank2update(a, isupper, 0, i, &t, &t3, &t2, -1, _state); - a->ptr.pp_double[i][i+1] = e->ptr.p_double[i]; - } - d->ptr.p_double[i+1] = a->ptr.pp_double[i+1][i+1]; - tau->ptr.p_double[i] = taui; - } - d->ptr.p_double[0] = a->ptr.pp_double[0][0]; - } - else - { - - /* - * Reduce the lower triangle of A - */ - for(i=0; i<=n-2; i++) - { - - /* - * Generate elementary reflector H = E - tau * v * v' - */ - ae_v_move(&t.ptr.p_double[1], 1, &a->ptr.pp_double[i+1][i], a->stride, ae_v_len(1,n-i-1)); - generatereflection(&t, n-i-1, &taui, _state); - ae_v_move(&a->ptr.pp_double[i+1][i], a->stride, &t.ptr.p_double[1], 1, ae_v_len(i+1,n-1)); - e->ptr.p_double[i] = a->ptr.pp_double[i+1][i]; - if( ae_fp_neq(taui,0) ) - { - - /* - * Apply H from both sides to A - */ - a->ptr.pp_double[i+1][i] = 1; - - /* - * Compute x := tau * A * v storing y in TAU - */ - ae_v_move(&t.ptr.p_double[1], 1, &a->ptr.pp_double[i+1][i], a->stride, ae_v_len(1,n-i-1)); - symmetricmatrixvectormultiply(a, isupper, i+1, n-1, &t, taui, &t2, _state); - ae_v_move(&tau->ptr.p_double[i], 1, &t2.ptr.p_double[1], 1, ae_v_len(i,n-2)); - - /* - * Compute w := x - 1/2 * tau * (x'*v) * v - */ - v = ae_v_dotproduct(&tau->ptr.p_double[i], 1, &a->ptr.pp_double[i+1][i], a->stride, ae_v_len(i,n-2)); - alpha = -0.5*taui*v; - ae_v_addd(&tau->ptr.p_double[i], 1, &a->ptr.pp_double[i+1][i], a->stride, ae_v_len(i,n-2), alpha); - - /* - * Apply the transformation as a rank-2 update: - * A := A - v * w' - w * v' - * - */ - ae_v_move(&t.ptr.p_double[1], 1, &a->ptr.pp_double[i+1][i], a->stride, ae_v_len(1,n-i-1)); - ae_v_move(&t2.ptr.p_double[1], 1, &tau->ptr.p_double[i], 1, ae_v_len(1,n-i-1)); - symmetricrank2update(a, isupper, i+1, n-1, &t, &t2, &t3, -1, _state); - a->ptr.pp_double[i+1][i] = e->ptr.p_double[i]; - } - d->ptr.p_double[i] = a->ptr.pp_double[i][i]; - tau->ptr.p_double[i] = taui; - } - d->ptr.p_double[n-1] = a->ptr.pp_double[n-1][n-1]; - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Unpacking matrix Q which reduces symmetric matrix to a tridiagonal -form. - -Input parameters: - A - the result of a SMatrixTD subroutine - N - size of matrix A. - IsUpper - storage format (a parameter of SMatrixTD subroutine) - Tau - the result of a SMatrixTD subroutine - -Output parameters: - Q - transformation matrix. - array with elements [0..N-1, 0..N-1]. - - -- ALGLIB -- - Copyright 2005-2010 by Bochkanov Sergey -*************************************************************************/ -void smatrixtdunpackq(/* Real */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - /* Real */ ae_vector* tau, - /* Real */ ae_matrix* q, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - ae_vector v; - ae_vector work; - - ae_frame_make(_state, &_frame_block); - ae_matrix_clear(q); - ae_vector_init(&v, 0, DT_REAL, _state, ae_true); - ae_vector_init(&work, 0, DT_REAL, _state, ae_true); - - if( n==0 ) - { - ae_frame_leave(_state); - return; - } - - /* - * init - */ - ae_matrix_set_length(q, n-1+1, n-1+1, _state); - ae_vector_set_length(&v, n+1, _state); - ae_vector_set_length(&work, n-1+1, _state); - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - if( i==j ) - { - q->ptr.pp_double[i][j] = 1; - } - else - { - q->ptr.pp_double[i][j] = 0; - } - } - } - - /* - * unpack Q - */ - if( isupper ) - { - for(i=0; i<=n-2; i++) - { - - /* - * Apply H(i) - */ - ae_v_move(&v.ptr.p_double[1], 1, &a->ptr.pp_double[0][i+1], a->stride, ae_v_len(1,i+1)); - v.ptr.p_double[i+1] = 1; - applyreflectionfromtheleft(q, tau->ptr.p_double[i], &v, 0, i, 0, n-1, &work, _state); - } - } - else - { - for(i=n-2; i>=0; i--) - { - - /* - * Apply H(i) - */ - ae_v_move(&v.ptr.p_double[1], 1, &a->ptr.pp_double[i+1][i], a->stride, ae_v_len(1,n-i-1)); - v.ptr.p_double[1] = 1; - applyreflectionfromtheleft(q, tau->ptr.p_double[i], &v, i+1, n-1, 0, n-1, &work, _state); - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Reduction of a Hermitian matrix which is given by its higher or lower -triangular part to a real tridiagonal matrix using unitary similarity -transformation: Q'*A*Q = T. - -Input parameters: - A - matrix to be transformed - array with elements [0..N-1, 0..N-1]. - N - size of matrix A. - IsUpper - storage format. If IsUpper = True, then matrix A is given - by its upper triangle, and the lower triangle is not used - and not modified by the algorithm, and vice versa - if IsUpper = False. - -Output parameters: - A - matrices T and Q in compact form (see lower) - Tau - array of factors which are forming matrices H(i) - array with elements [0..N-2]. - D - main diagonal of real symmetric matrix T. - array with elements [0..N-1]. - E - secondary diagonal of real symmetric matrix T. - array with elements [0..N-2]. - - - If IsUpper=True, the matrix Q is represented as a product of elementary - reflectors - - Q = H(n-2) . . . H(2) H(0). - - Each H(i) has the form - - H(i) = I - tau * v * v' - - where tau is a complex scalar, and v is a complex vector with - v(i+1:n-1) = 0, v(i) = 1, v(0:i-1) is stored on exit in - A(0:i-1,i+1), and tau in TAU(i). - - If IsUpper=False, the matrix Q is represented as a product of elementary - reflectors - - Q = H(0) H(2) . . . H(n-2). - - Each H(i) has the form - - H(i) = I - tau * v * v' - - where tau is a complex scalar, and v is a complex vector with - v(0:i) = 0, v(i+1) = 1, v(i+2:n-1) is stored on exit in A(i+2:n-1,i), - and tau in TAU(i). - - The contents of A on exit are illustrated by the following examples - with n = 5: - - if UPLO = 'U': if UPLO = 'L': - - ( d e v1 v2 v3 ) ( d ) - ( d e v2 v3 ) ( e d ) - ( d e v3 ) ( v0 e d ) - ( d e ) ( v0 v1 e d ) - ( d ) ( v0 v1 v2 e d ) - -where d and e denote diagonal and off-diagonal elements of T, and vi -denotes an element of the vector defining H(i). - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - October 31, 1992 -*************************************************************************/ -void hmatrixtd(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - /* Complex */ ae_vector* tau, - /* Real */ ae_vector* d, - /* Real */ ae_vector* e, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_complex alpha; - ae_complex taui; - ae_complex v; - ae_vector t; - ae_vector t2; - ae_vector t3; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(tau); - ae_vector_clear(d); - ae_vector_clear(e); - ae_vector_init(&t, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&t2, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&t3, 0, DT_COMPLEX, _state, ae_true); - - if( n<=0 ) - { - ae_frame_leave(_state); - return; - } - for(i=0; i<=n-1; i++) - { - ae_assert(ae_fp_eq(a->ptr.pp_complex[i][i].y,0), "Assertion failed", _state); - } - if( n>1 ) - { - ae_vector_set_length(tau, n-2+1, _state); - ae_vector_set_length(e, n-2+1, _state); - } - ae_vector_set_length(d, n-1+1, _state); - ae_vector_set_length(&t, n-1+1, _state); - ae_vector_set_length(&t2, n-1+1, _state); - ae_vector_set_length(&t3, n-1+1, _state); - if( isupper ) - { - - /* - * Reduce the upper triangle of A - */ - a->ptr.pp_complex[n-1][n-1] = ae_complex_from_d(a->ptr.pp_complex[n-1][n-1].x); - for(i=n-2; i>=0; i--) - { - - /* - * Generate elementary reflector H = I+1 - tau * v * v' - */ - alpha = a->ptr.pp_complex[i][i+1]; - t.ptr.p_complex[1] = alpha; - if( i>=1 ) - { - ae_v_cmove(&t.ptr.p_complex[2], 1, &a->ptr.pp_complex[0][i+1], a->stride, "N", ae_v_len(2,i+1)); - } - complexgeneratereflection(&t, i+1, &taui, _state); - if( i>=1 ) - { - ae_v_cmove(&a->ptr.pp_complex[0][i+1], a->stride, &t.ptr.p_complex[2], 1, "N", ae_v_len(0,i-1)); - } - alpha = t.ptr.p_complex[1]; - e->ptr.p_double[i] = alpha.x; - if( ae_c_neq_d(taui,0) ) - { - - /* - * Apply H(I+1) from both sides to A - */ - a->ptr.pp_complex[i][i+1] = ae_complex_from_d(1); - - /* - * Compute x := tau * A * v storing x in TAU - */ - ae_v_cmove(&t.ptr.p_complex[1], 1, &a->ptr.pp_complex[0][i+1], a->stride, "N", ae_v_len(1,i+1)); - hermitianmatrixvectormultiply(a, isupper, 0, i, &t, taui, &t2, _state); - ae_v_cmove(&tau->ptr.p_complex[0], 1, &t2.ptr.p_complex[1], 1, "N", ae_v_len(0,i)); - - /* - * Compute w := x - 1/2 * tau * (x'*v) * v - */ - v = ae_v_cdotproduct(&tau->ptr.p_complex[0], 1, "Conj", &a->ptr.pp_complex[0][i+1], a->stride, "N", ae_v_len(0,i)); - alpha = ae_c_neg(ae_c_mul(ae_c_mul_d(taui,0.5),v)); - ae_v_caddc(&tau->ptr.p_complex[0], 1, &a->ptr.pp_complex[0][i+1], a->stride, "N", ae_v_len(0,i), alpha); - - /* - * Apply the transformation as a rank-2 update: - * A := A - v * w' - w * v' - */ - ae_v_cmove(&t.ptr.p_complex[1], 1, &a->ptr.pp_complex[0][i+1], a->stride, "N", ae_v_len(1,i+1)); - ae_v_cmove(&t3.ptr.p_complex[1], 1, &tau->ptr.p_complex[0], 1, "N", ae_v_len(1,i+1)); - hermitianrank2update(a, isupper, 0, i, &t, &t3, &t2, ae_complex_from_d(-1), _state); - } - else - { - a->ptr.pp_complex[i][i] = ae_complex_from_d(a->ptr.pp_complex[i][i].x); - } - a->ptr.pp_complex[i][i+1] = ae_complex_from_d(e->ptr.p_double[i]); - d->ptr.p_double[i+1] = a->ptr.pp_complex[i+1][i+1].x; - tau->ptr.p_complex[i] = taui; - } - d->ptr.p_double[0] = a->ptr.pp_complex[0][0].x; - } - else - { - - /* - * Reduce the lower triangle of A - */ - a->ptr.pp_complex[0][0] = ae_complex_from_d(a->ptr.pp_complex[0][0].x); - for(i=0; i<=n-2; i++) - { - - /* - * Generate elementary reflector H = I - tau * v * v' - */ - ae_v_cmove(&t.ptr.p_complex[1], 1, &a->ptr.pp_complex[i+1][i], a->stride, "N", ae_v_len(1,n-i-1)); - complexgeneratereflection(&t, n-i-1, &taui, _state); - ae_v_cmove(&a->ptr.pp_complex[i+1][i], a->stride, &t.ptr.p_complex[1], 1, "N", ae_v_len(i+1,n-1)); - e->ptr.p_double[i] = a->ptr.pp_complex[i+1][i].x; - if( ae_c_neq_d(taui,0) ) - { - - /* - * Apply H(i) from both sides to A(i+1:n,i+1:n) - */ - a->ptr.pp_complex[i+1][i] = ae_complex_from_d(1); - - /* - * Compute x := tau * A * v storing y in TAU - */ - ae_v_cmove(&t.ptr.p_complex[1], 1, &a->ptr.pp_complex[i+1][i], a->stride, "N", ae_v_len(1,n-i-1)); - hermitianmatrixvectormultiply(a, isupper, i+1, n-1, &t, taui, &t2, _state); - ae_v_cmove(&tau->ptr.p_complex[i], 1, &t2.ptr.p_complex[1], 1, "N", ae_v_len(i,n-2)); - - /* - * Compute w := x - 1/2 * tau * (x'*v) * v - */ - v = ae_v_cdotproduct(&tau->ptr.p_complex[i], 1, "Conj", &a->ptr.pp_complex[i+1][i], a->stride, "N", ae_v_len(i,n-2)); - alpha = ae_c_neg(ae_c_mul(ae_c_mul_d(taui,0.5),v)); - ae_v_caddc(&tau->ptr.p_complex[i], 1, &a->ptr.pp_complex[i+1][i], a->stride, "N", ae_v_len(i,n-2), alpha); - - /* - * Apply the transformation as a rank-2 update: - * A := A - v * w' - w * v' - */ - ae_v_cmove(&t.ptr.p_complex[1], 1, &a->ptr.pp_complex[i+1][i], a->stride, "N", ae_v_len(1,n-i-1)); - ae_v_cmove(&t2.ptr.p_complex[1], 1, &tau->ptr.p_complex[i], 1, "N", ae_v_len(1,n-i-1)); - hermitianrank2update(a, isupper, i+1, n-1, &t, &t2, &t3, ae_complex_from_d(-1), _state); - } - else - { - a->ptr.pp_complex[i+1][i+1] = ae_complex_from_d(a->ptr.pp_complex[i+1][i+1].x); - } - a->ptr.pp_complex[i+1][i] = ae_complex_from_d(e->ptr.p_double[i]); - d->ptr.p_double[i] = a->ptr.pp_complex[i][i].x; - tau->ptr.p_complex[i] = taui; - } - d->ptr.p_double[n-1] = a->ptr.pp_complex[n-1][n-1].x; - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Unpacking matrix Q which reduces a Hermitian matrix to a real tridiagonal -form. - -Input parameters: - A - the result of a HMatrixTD subroutine - N - size of matrix A. - IsUpper - storage format (a parameter of HMatrixTD subroutine) - Tau - the result of a HMatrixTD subroutine - -Output parameters: - Q - transformation matrix. - array with elements [0..N-1, 0..N-1]. - - -- ALGLIB -- - Copyright 2005-2010 by Bochkanov Sergey -*************************************************************************/ -void hmatrixtdunpackq(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - /* Complex */ ae_vector* tau, - /* Complex */ ae_matrix* q, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - ae_vector v; - ae_vector work; - - ae_frame_make(_state, &_frame_block); - ae_matrix_clear(q); - ae_vector_init(&v, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&work, 0, DT_COMPLEX, _state, ae_true); - - if( n==0 ) - { - ae_frame_leave(_state); - return; - } - - /* - * init - */ - ae_matrix_set_length(q, n-1+1, n-1+1, _state); - ae_vector_set_length(&v, n+1, _state); - ae_vector_set_length(&work, n-1+1, _state); - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - if( i==j ) - { - q->ptr.pp_complex[i][j] = ae_complex_from_d(1); - } - else - { - q->ptr.pp_complex[i][j] = ae_complex_from_d(0); - } - } - } - - /* - * unpack Q - */ - if( isupper ) - { - for(i=0; i<=n-2; i++) - { - - /* - * Apply H(i) - */ - ae_v_cmove(&v.ptr.p_complex[1], 1, &a->ptr.pp_complex[0][i+1], a->stride, "N", ae_v_len(1,i+1)); - v.ptr.p_complex[i+1] = ae_complex_from_d(1); - complexapplyreflectionfromtheleft(q, tau->ptr.p_complex[i], &v, 0, i, 0, n-1, &work, _state); - } - } - else - { - for(i=n-2; i>=0; i--) - { - - /* - * Apply H(i) - */ - ae_v_cmove(&v.ptr.p_complex[1], 1, &a->ptr.pp_complex[i+1][i], a->stride, "N", ae_v_len(1,n-i-1)); - v.ptr.p_complex[1] = ae_complex_from_d(1); - complexapplyreflectionfromtheleft(q, tau->ptr.p_complex[i], &v, i+1, n-1, 0, n-1, &work, _state); - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Base case for complex QR - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - September 30, 1994. - Sergey Bochkanov, ALGLIB project, translation from FORTRAN to - pseudocode, 2007-2010. -*************************************************************************/ -static void ortfac_cmatrixqrbasecase(/* Complex */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Complex */ ae_vector* work, - /* Complex */ ae_vector* t, - /* Complex */ ae_vector* tau, - ae_state *_state) -{ - ae_int_t i; - ae_int_t k; - ae_int_t mmi; - ae_int_t minmn; - ae_complex tmp; - - - minmn = ae_minint(m, n, _state); - if( minmn<=0 ) - { - return; - } - - /* - * Test the input arguments - */ - k = ae_minint(m, n, _state); - for(i=0; i<=k-1; i++) - { - - /* - * Generate elementary reflector H(i) to annihilate A(i+1:m,i) - */ - mmi = m-i; - ae_v_cmove(&t->ptr.p_complex[1], 1, &a->ptr.pp_complex[i][i], a->stride, "N", ae_v_len(1,mmi)); - complexgeneratereflection(t, mmi, &tmp, _state); - tau->ptr.p_complex[i] = tmp; - ae_v_cmove(&a->ptr.pp_complex[i][i], a->stride, &t->ptr.p_complex[1], 1, "N", ae_v_len(i,m-1)); - t->ptr.p_complex[1] = ae_complex_from_d(1); - if( iptr.p_complex[i], _state), t, i, m-1, i+1, n-1, work, _state); - } - } -} - - -/************************************************************************* -Base case for complex LQ - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - September 30, 1994. - Sergey Bochkanov, ALGLIB project, translation from FORTRAN to - pseudocode, 2007-2010. -*************************************************************************/ -static void ortfac_cmatrixlqbasecase(/* Complex */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Complex */ ae_vector* work, - /* Complex */ ae_vector* t, - /* Complex */ ae_vector* tau, - ae_state *_state) -{ - ae_int_t i; - ae_int_t minmn; - ae_complex tmp; - - - minmn = ae_minint(m, n, _state); - if( minmn<=0 ) - { - return; - } - - /* - * Test the input arguments - */ - for(i=0; i<=minmn-1; i++) - { - - /* - * Generate elementary reflector H(i) - * - * NOTE: ComplexGenerateReflection() generates left reflector, - * i.e. H which reduces x by applyiong from the left, but we - * need RIGHT reflector. So we replace H=E-tau*v*v' by H^H, - * which changes v to conj(v). - */ - ae_v_cmove(&t->ptr.p_complex[1], 1, &a->ptr.pp_complex[i][i], 1, "Conj", ae_v_len(1,n-i)); - complexgeneratereflection(t, n-i, &tmp, _state); - tau->ptr.p_complex[i] = tmp; - ae_v_cmove(&a->ptr.pp_complex[i][i], 1, &t->ptr.p_complex[1], 1, "Conj", ae_v_len(i,n-1)); - t->ptr.p_complex[1] = ae_complex_from_d(1); - if( iptr.p_complex[i], t, i+1, m-1, i, n-1, work, _state); - } - } -} - - -/************************************************************************* -Generate block reflector: -* fill unused parts of reflectors matrix by zeros -* fill diagonal of reflectors matrix by ones -* generate triangular factor T - -PARAMETERS: - A - either LengthA*BlockSize (if ColumnwiseA) or - BlockSize*LengthA (if not ColumnwiseA) matrix of - elementary reflectors. - Modified on exit. - Tau - scalar factors - ColumnwiseA - reflectors are stored in rows or in columns - LengthA - length of largest reflector - BlockSize - number of reflectors - T - array[BlockSize,2*BlockSize]. Left BlockSize*BlockSize - submatrix stores triangular factor on exit. - WORK - array[BlockSize] - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -static void ortfac_rmatrixblockreflector(/* Real */ ae_matrix* a, - /* Real */ ae_vector* tau, - ae_bool columnwisea, - ae_int_t lengtha, - ae_int_t blocksize, - /* Real */ ae_matrix* t, - /* Real */ ae_vector* work, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t k; - double v; - - - - /* - * fill beginning of new column with zeros, - * load 1.0 in the first non-zero element - */ - for(k=0; k<=blocksize-1; k++) - { - if( columnwisea ) - { - for(i=0; i<=k-1; i++) - { - a->ptr.pp_double[i][k] = 0; - } - } - else - { - for(i=0; i<=k-1; i++) - { - a->ptr.pp_double[k][i] = 0; - } - } - a->ptr.pp_double[k][k] = 1; - } - - /* - * Calculate Gram matrix of A - */ - for(i=0; i<=blocksize-1; i++) - { - for(j=0; j<=blocksize-1; j++) - { - t->ptr.pp_double[i][blocksize+j] = 0; - } - } - for(k=0; k<=lengtha-1; k++) - { - for(j=1; j<=blocksize-1; j++) - { - if( columnwisea ) - { - v = a->ptr.pp_double[k][j]; - if( ae_fp_neq(v,0) ) - { - ae_v_addd(&t->ptr.pp_double[j][blocksize], 1, &a->ptr.pp_double[k][0], 1, ae_v_len(blocksize,blocksize+j-1), v); - } - } - else - { - v = a->ptr.pp_double[j][k]; - if( ae_fp_neq(v,0) ) - { - ae_v_addd(&t->ptr.pp_double[j][blocksize], 1, &a->ptr.pp_double[0][k], a->stride, ae_v_len(blocksize,blocksize+j-1), v); - } - } - } - } - - /* - * Prepare Y (stored in TmpA) and T (stored in TmpT) - */ - for(k=0; k<=blocksize-1; k++) - { - - /* - * fill non-zero part of T, use pre-calculated Gram matrix - */ - ae_v_move(&work->ptr.p_double[0], 1, &t->ptr.pp_double[k][blocksize], 1, ae_v_len(0,k-1)); - for(i=0; i<=k-1; i++) - { - v = ae_v_dotproduct(&t->ptr.pp_double[i][i], 1, &work->ptr.p_double[i], 1, ae_v_len(i,k-1)); - t->ptr.pp_double[i][k] = -tau->ptr.p_double[k]*v; - } - t->ptr.pp_double[k][k] = -tau->ptr.p_double[k]; - - /* - * Rest of T is filled by zeros - */ - for(i=k+1; i<=blocksize-1; i++) - { - t->ptr.pp_double[i][k] = 0; - } - } -} - - -/************************************************************************* -Generate block reflector (complex): -* fill unused parts of reflectors matrix by zeros -* fill diagonal of reflectors matrix by ones -* generate triangular factor T - - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -static void ortfac_cmatrixblockreflector(/* Complex */ ae_matrix* a, - /* Complex */ ae_vector* tau, - ae_bool columnwisea, - ae_int_t lengtha, - ae_int_t blocksize, - /* Complex */ ae_matrix* t, - /* Complex */ ae_vector* work, - ae_state *_state) -{ - ae_int_t i; - ae_int_t k; - ae_complex v; - - - - /* - * Prepare Y (stored in TmpA) and T (stored in TmpT) - */ - for(k=0; k<=blocksize-1; k++) - { - - /* - * fill beginning of new column with zeros, - * load 1.0 in the first non-zero element - */ - if( columnwisea ) - { - for(i=0; i<=k-1; i++) - { - a->ptr.pp_complex[i][k] = ae_complex_from_d(0); - } - } - else - { - for(i=0; i<=k-1; i++) - { - a->ptr.pp_complex[k][i] = ae_complex_from_d(0); - } - } - a->ptr.pp_complex[k][k] = ae_complex_from_d(1); - - /* - * fill non-zero part of T, - */ - for(i=0; i<=k-1; i++) - { - if( columnwisea ) - { - v = ae_v_cdotproduct(&a->ptr.pp_complex[k][i], a->stride, "Conj", &a->ptr.pp_complex[k][k], a->stride, "N", ae_v_len(k,lengtha-1)); - } - else - { - v = ae_v_cdotproduct(&a->ptr.pp_complex[i][k], 1, "N", &a->ptr.pp_complex[k][k], 1, "Conj", ae_v_len(k,lengtha-1)); - } - work->ptr.p_complex[i] = v; - } - for(i=0; i<=k-1; i++) - { - v = ae_v_cdotproduct(&t->ptr.pp_complex[i][i], 1, "N", &work->ptr.p_complex[i], 1, "N", ae_v_len(i,k-1)); - t->ptr.pp_complex[i][k] = ae_c_neg(ae_c_mul(tau->ptr.p_complex[k],v)); - } - t->ptr.pp_complex[k][k] = ae_c_neg(tau->ptr.p_complex[k]); - - /* - * Rest of T is filled by zeros - */ - for(i=k+1; i<=blocksize-1; i++) - { - t->ptr.pp_complex[i][k] = ae_complex_from_d(0); - } - } -} - - - - -/************************************************************************* -Singular value decomposition of a bidiagonal matrix (extended algorithm) - -The algorithm performs the singular value decomposition of a bidiagonal -matrix B (upper or lower) representing it as B = Q*S*P^T, where Q and P - -orthogonal matrices, S - diagonal matrix with non-negative elements on the -main diagonal, in descending order. - -The algorithm finds singular values. In addition, the algorithm can -calculate matrices Q and P (more precisely, not the matrices, but their -product with given matrices U and VT - U*Q and (P^T)*VT)). Of course, -matrices U and VT can be of any type, including identity. Furthermore, the -algorithm can calculate Q'*C (this product is calculated more effectively -than U*Q, because this calculation operates with rows instead of matrix -columns). - -The feature of the algorithm is its ability to find all singular values -including those which are arbitrarily close to 0 with relative accuracy -close to machine precision. If the parameter IsFractionalAccuracyRequired -is set to True, all singular values will have high relative accuracy close -to machine precision. If the parameter is set to False, only the biggest -singular value will have relative accuracy close to machine precision. -The absolute error of other singular values is equal to the absolute error -of the biggest singular value. - -Input parameters: - D - main diagonal of matrix B. - Array whose index ranges within [0..N-1]. - E - superdiagonal (or subdiagonal) of matrix B. - Array whose index ranges within [0..N-2]. - N - size of matrix B. - IsUpper - True, if the matrix is upper bidiagonal. - IsFractionalAccuracyRequired - - THIS PARAMETER IS IGNORED SINCE ALGLIB 3.5.0 - SINGULAR VALUES ARE ALWAYS SEARCHED WITH HIGH ACCURACY. - U - matrix to be multiplied by Q. - Array whose indexes range within [0..NRU-1, 0..N-1]. - The matrix can be bigger, in that case only the submatrix - [0..NRU-1, 0..N-1] will be multiplied by Q. - NRU - number of rows in matrix U. - C - matrix to be multiplied by Q'. - Array whose indexes range within [0..N-1, 0..NCC-1]. - The matrix can be bigger, in that case only the submatrix - [0..N-1, 0..NCC-1] will be multiplied by Q'. - NCC - number of columns in matrix C. - VT - matrix to be multiplied by P^T. - Array whose indexes range within [0..N-1, 0..NCVT-1]. - The matrix can be bigger, in that case only the submatrix - [0..N-1, 0..NCVT-1] will be multiplied by P^T. - NCVT - number of columns in matrix VT. - -Output parameters: - D - singular values of matrix B in descending order. - U - if NRU>0, contains matrix U*Q. - VT - if NCVT>0, contains matrix (P^T)*VT. - C - if NCC>0, contains matrix Q'*C. - -Result: - True, if the algorithm has converged. - False, if the algorithm hasn't converged (rare case). - -Additional information: - The type of convergence is controlled by the internal parameter TOL. - If the parameter is greater than 0, the singular values will have - relative accuracy TOL. If TOL<0, the singular values will have - absolute accuracy ABS(TOL)*norm(B). - By default, |TOL| falls within the range of 10*Epsilon and 100*Epsilon, - where Epsilon is the machine precision. It is not recommended to use - TOL less than 10*Epsilon since this will considerably slow down the - algorithm and may not lead to error decreasing. -History: - * 31 March, 2007. - changed MAXITR from 6 to 12. - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - October 31, 1999. -*************************************************************************/ -ae_bool rmatrixbdsvd(/* Real */ ae_vector* d, - /* Real */ ae_vector* e, - ae_int_t n, - ae_bool isupper, - ae_bool isfractionalaccuracyrequired, - /* Real */ ae_matrix* u, - ae_int_t nru, - /* Real */ ae_matrix* c, - ae_int_t ncc, - /* Real */ ae_matrix* vt, - ae_int_t ncvt, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _e; - ae_vector d1; - ae_vector e1; - ae_bool result; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_e, e, _state, ae_true); - e = &_e; - ae_vector_init(&d1, 0, DT_REAL, _state, ae_true); - ae_vector_init(&e1, 0, DT_REAL, _state, ae_true); - - ae_vector_set_length(&d1, n+1, _state); - ae_v_move(&d1.ptr.p_double[1], 1, &d->ptr.p_double[0], 1, ae_v_len(1,n)); - if( n>1 ) - { - ae_vector_set_length(&e1, n-1+1, _state); - ae_v_move(&e1.ptr.p_double[1], 1, &e->ptr.p_double[0], 1, ae_v_len(1,n-1)); - } - result = bdsvd_bidiagonalsvddecompositioninternal(&d1, &e1, n, isupper, isfractionalaccuracyrequired, u, 0, nru, c, 0, ncc, vt, 0, ncvt, _state); - ae_v_move(&d->ptr.p_double[0], 1, &d1.ptr.p_double[1], 1, ae_v_len(0,n-1)); - ae_frame_leave(_state); - return result; -} - - -ae_bool bidiagonalsvddecomposition(/* Real */ ae_vector* d, - /* Real */ ae_vector* e, - ae_int_t n, - ae_bool isupper, - ae_bool isfractionalaccuracyrequired, - /* Real */ ae_matrix* u, - ae_int_t nru, - /* Real */ ae_matrix* c, - ae_int_t ncc, - /* Real */ ae_matrix* vt, - ae_int_t ncvt, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _e; - ae_bool result; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_e, e, _state, ae_true); - e = &_e; - - result = bdsvd_bidiagonalsvddecompositioninternal(d, e, n, isupper, isfractionalaccuracyrequired, u, 1, nru, c, 1, ncc, vt, 1, ncvt, _state); - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Internal working subroutine for bidiagonal decomposition -*************************************************************************/ -static ae_bool bdsvd_bidiagonalsvddecompositioninternal(/* Real */ ae_vector* d, - /* Real */ ae_vector* e, - ae_int_t n, - ae_bool isupper, - ae_bool isfractionalaccuracyrequired, - /* Real */ ae_matrix* u, - ae_int_t ustart, - ae_int_t nru, - /* Real */ ae_matrix* c, - ae_int_t cstart, - ae_int_t ncc, - /* Real */ ae_matrix* vt, - ae_int_t vstart, - ae_int_t ncvt, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _e; - ae_int_t i; - ae_int_t idir; - ae_int_t isub; - ae_int_t iter; - ae_int_t j; - ae_int_t ll; - ae_int_t lll; - ae_int_t m; - ae_int_t maxit; - ae_int_t oldll; - ae_int_t oldm; - double abse; - double abss; - double cosl; - double cosr; - double cs; - double eps; - double f; - double g; - double h; - double mu; - double oldcs; - double oldsn; - double r; - double shift; - double sigmn; - double sigmx; - double sinl; - double sinr; - double sll; - double smax; - double smin; - double sminl; - double sminoa; - double sn; - double thresh; - double tol; - double tolmul; - double unfl; - ae_vector work0; - ae_vector work1; - ae_vector work2; - ae_vector work3; - ae_int_t maxitr; - ae_bool matrixsplitflag; - ae_bool iterflag; - ae_vector utemp; - ae_vector vttemp; - ae_vector ctemp; - ae_vector etemp; - ae_bool fwddir; - double tmp; - ae_int_t mm1; - ae_int_t mm0; - ae_bool bchangedir; - ae_int_t uend; - ae_int_t cend; - ae_int_t vend; - ae_bool result; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_e, e, _state, ae_true); - e = &_e; - ae_vector_init(&work0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&work1, 0, DT_REAL, _state, ae_true); - ae_vector_init(&work2, 0, DT_REAL, _state, ae_true); - ae_vector_init(&work3, 0, DT_REAL, _state, ae_true); - ae_vector_init(&utemp, 0, DT_REAL, _state, ae_true); - ae_vector_init(&vttemp, 0, DT_REAL, _state, ae_true); - ae_vector_init(&ctemp, 0, DT_REAL, _state, ae_true); - ae_vector_init(&etemp, 0, DT_REAL, _state, ae_true); - - result = ae_true; - if( n==0 ) - { - ae_frame_leave(_state); - return result; - } - if( n==1 ) - { - if( ae_fp_less(d->ptr.p_double[1],0) ) - { - d->ptr.p_double[1] = -d->ptr.p_double[1]; - if( ncvt>0 ) - { - ae_v_muld(&vt->ptr.pp_double[vstart][vstart], 1, ae_v_len(vstart,vstart+ncvt-1), -1); - } - } - ae_frame_leave(_state); - return result; - } - - /* - * these initializers are not really necessary, - * but without them compiler complains about uninitialized locals - */ - ll = 0; - oldsn = 0; - - /* - * init - */ - ae_vector_set_length(&work0, n-1+1, _state); - ae_vector_set_length(&work1, n-1+1, _state); - ae_vector_set_length(&work2, n-1+1, _state); - ae_vector_set_length(&work3, n-1+1, _state); - uend = ustart+ae_maxint(nru-1, 0, _state); - vend = vstart+ae_maxint(ncvt-1, 0, _state); - cend = cstart+ae_maxint(ncc-1, 0, _state); - ae_vector_set_length(&utemp, uend+1, _state); - ae_vector_set_length(&vttemp, vend+1, _state); - ae_vector_set_length(&ctemp, cend+1, _state); - maxitr = 12; - fwddir = ae_true; - - /* - * resize E from N-1 to N - */ - ae_vector_set_length(&etemp, n+1, _state); - for(i=1; i<=n-1; i++) - { - etemp.ptr.p_double[i] = e->ptr.p_double[i]; - } - ae_vector_set_length(e, n+1, _state); - for(i=1; i<=n-1; i++) - { - e->ptr.p_double[i] = etemp.ptr.p_double[i]; - } - e->ptr.p_double[n] = 0; - idir = 0; - - /* - * Get machine constants - */ - eps = ae_machineepsilon; - unfl = ae_minrealnumber; - - /* - * If matrix lower bidiagonal, rotate to be upper bidiagonal - * by applying Givens rotations on the left - */ - if( !isupper ) - { - for(i=1; i<=n-1; i++) - { - generaterotation(d->ptr.p_double[i], e->ptr.p_double[i], &cs, &sn, &r, _state); - d->ptr.p_double[i] = r; - e->ptr.p_double[i] = sn*d->ptr.p_double[i+1]; - d->ptr.p_double[i+1] = cs*d->ptr.p_double[i+1]; - work0.ptr.p_double[i] = cs; - work1.ptr.p_double[i] = sn; - } - - /* - * Update singular vectors if desired - */ - if( nru>0 ) - { - applyrotationsfromtheright(fwddir, ustart, uend, 1+ustart-1, n+ustart-1, &work0, &work1, u, &utemp, _state); - } - if( ncc>0 ) - { - applyrotationsfromtheleft(fwddir, 1+cstart-1, n+cstart-1, cstart, cend, &work0, &work1, c, &ctemp, _state); - } - } - - /* - * Compute singular values to relative accuracy TOL - * (By setting TOL to be negative, algorithm will compute - * singular values to absolute accuracy ABS(TOL)*norm(input matrix)) - */ - tolmul = ae_maxreal(10, ae_minreal(100, ae_pow(eps, -0.125, _state), _state), _state); - tol = tolmul*eps; - - /* - * Compute approximate maximum, minimum singular values - */ - smax = 0; - for(i=1; i<=n; i++) - { - smax = ae_maxreal(smax, ae_fabs(d->ptr.p_double[i], _state), _state); - } - for(i=1; i<=n-1; i++) - { - smax = ae_maxreal(smax, ae_fabs(e->ptr.p_double[i], _state), _state); - } - sminl = 0; - if( ae_fp_greater_eq(tol,0) ) - { - - /* - * Relative accuracy desired - */ - sminoa = ae_fabs(d->ptr.p_double[1], _state); - if( ae_fp_neq(sminoa,0) ) - { - mu = sminoa; - for(i=2; i<=n; i++) - { - mu = ae_fabs(d->ptr.p_double[i], _state)*(mu/(mu+ae_fabs(e->ptr.p_double[i-1], _state))); - sminoa = ae_minreal(sminoa, mu, _state); - if( ae_fp_eq(sminoa,0) ) - { - break; - } - } - } - sminoa = sminoa/ae_sqrt(n, _state); - thresh = ae_maxreal(tol*sminoa, maxitr*n*n*unfl, _state); - } - else - { - - /* - * Absolute accuracy desired - */ - thresh = ae_maxreal(ae_fabs(tol, _state)*smax, maxitr*n*n*unfl, _state); - } - - /* - * Prepare for main iteration loop for the singular values - * (MAXIT is the maximum number of passes through the inner - * loop permitted before nonconvergence signalled.) - */ - maxit = maxitr*n*n; - iter = 0; - oldll = -1; - oldm = -1; - - /* - * M points to last element of unconverged part of matrix - */ - m = n; - - /* - * Begin main iteration loop - */ - for(;;) - { - - /* - * Check for convergence or exceeding iteration count - */ - if( m<=1 ) - { - break; - } - if( iter>maxit ) - { - result = ae_false; - ae_frame_leave(_state); - return result; - } - - /* - * Find diagonal block of matrix to work on - */ - if( ae_fp_less(tol,0)&&ae_fp_less_eq(ae_fabs(d->ptr.p_double[m], _state),thresh) ) - { - d->ptr.p_double[m] = 0; - } - smax = ae_fabs(d->ptr.p_double[m], _state); - smin = smax; - matrixsplitflag = ae_false; - for(lll=1; lll<=m-1; lll++) - { - ll = m-lll; - abss = ae_fabs(d->ptr.p_double[ll], _state); - abse = ae_fabs(e->ptr.p_double[ll], _state); - if( ae_fp_less(tol,0)&&ae_fp_less_eq(abss,thresh) ) - { - d->ptr.p_double[ll] = 0; - } - if( ae_fp_less_eq(abse,thresh) ) - { - matrixsplitflag = ae_true; - break; - } - smin = ae_minreal(smin, abss, _state); - smax = ae_maxreal(smax, ae_maxreal(abss, abse, _state), _state); - } - if( !matrixsplitflag ) - { - ll = 0; - } - else - { - - /* - * Matrix splits since E(LL) = 0 - */ - e->ptr.p_double[ll] = 0; - if( ll==m-1 ) - { - - /* - * Convergence of bottom singular value, return to top of loop - */ - m = m-1; - continue; - } - } - ll = ll+1; - - /* - * E(LL) through E(M-1) are nonzero, E(LL-1) is zero - */ - if( ll==m-1 ) - { - - /* - * 2 by 2 block, handle separately - */ - bdsvd_svdv2x2(d->ptr.p_double[m-1], e->ptr.p_double[m-1], d->ptr.p_double[m], &sigmn, &sigmx, &sinr, &cosr, &sinl, &cosl, _state); - d->ptr.p_double[m-1] = sigmx; - e->ptr.p_double[m-1] = 0; - d->ptr.p_double[m] = sigmn; - - /* - * Compute singular vectors, if desired - */ - if( ncvt>0 ) - { - mm0 = m+(vstart-1); - mm1 = m-1+(vstart-1); - ae_v_moved(&vttemp.ptr.p_double[vstart], 1, &vt->ptr.pp_double[mm1][vstart], 1, ae_v_len(vstart,vend), cosr); - ae_v_addd(&vttemp.ptr.p_double[vstart], 1, &vt->ptr.pp_double[mm0][vstart], 1, ae_v_len(vstart,vend), sinr); - ae_v_muld(&vt->ptr.pp_double[mm0][vstart], 1, ae_v_len(vstart,vend), cosr); - ae_v_subd(&vt->ptr.pp_double[mm0][vstart], 1, &vt->ptr.pp_double[mm1][vstart], 1, ae_v_len(vstart,vend), sinr); - ae_v_move(&vt->ptr.pp_double[mm1][vstart], 1, &vttemp.ptr.p_double[vstart], 1, ae_v_len(vstart,vend)); - } - if( nru>0 ) - { - mm0 = m+ustart-1; - mm1 = m-1+ustart-1; - ae_v_moved(&utemp.ptr.p_double[ustart], 1, &u->ptr.pp_double[ustart][mm1], u->stride, ae_v_len(ustart,uend), cosl); - ae_v_addd(&utemp.ptr.p_double[ustart], 1, &u->ptr.pp_double[ustart][mm0], u->stride, ae_v_len(ustart,uend), sinl); - ae_v_muld(&u->ptr.pp_double[ustart][mm0], u->stride, ae_v_len(ustart,uend), cosl); - ae_v_subd(&u->ptr.pp_double[ustart][mm0], u->stride, &u->ptr.pp_double[ustart][mm1], u->stride, ae_v_len(ustart,uend), sinl); - ae_v_move(&u->ptr.pp_double[ustart][mm1], u->stride, &utemp.ptr.p_double[ustart], 1, ae_v_len(ustart,uend)); - } - if( ncc>0 ) - { - mm0 = m+cstart-1; - mm1 = m-1+cstart-1; - ae_v_moved(&ctemp.ptr.p_double[cstart], 1, &c->ptr.pp_double[mm1][cstart], 1, ae_v_len(cstart,cend), cosl); - ae_v_addd(&ctemp.ptr.p_double[cstart], 1, &c->ptr.pp_double[mm0][cstart], 1, ae_v_len(cstart,cend), sinl); - ae_v_muld(&c->ptr.pp_double[mm0][cstart], 1, ae_v_len(cstart,cend), cosl); - ae_v_subd(&c->ptr.pp_double[mm0][cstart], 1, &c->ptr.pp_double[mm1][cstart], 1, ae_v_len(cstart,cend), sinl); - ae_v_move(&c->ptr.pp_double[mm1][cstart], 1, &ctemp.ptr.p_double[cstart], 1, ae_v_len(cstart,cend)); - } - m = m-2; - continue; - } - - /* - * If working on new submatrix, choose shift direction - * (from larger end diagonal element towards smaller) - * - * Previously was - * "if (LL>OLDM) or (M - * Very strange that LAPACK still contains it. - */ - bchangedir = ae_false; - if( idir==1&&ae_fp_less(ae_fabs(d->ptr.p_double[ll], _state),1.0E-3*ae_fabs(d->ptr.p_double[m], _state)) ) - { - bchangedir = ae_true; - } - if( idir==2&&ae_fp_less(ae_fabs(d->ptr.p_double[m], _state),1.0E-3*ae_fabs(d->ptr.p_double[ll], _state)) ) - { - bchangedir = ae_true; - } - if( (ll!=oldll||m!=oldm)||bchangedir ) - { - if( ae_fp_greater_eq(ae_fabs(d->ptr.p_double[ll], _state),ae_fabs(d->ptr.p_double[m], _state)) ) - { - - /* - * Chase bulge from top (big end) to bottom (small end) - */ - idir = 1; - } - else - { - - /* - * Chase bulge from bottom (big end) to top (small end) - */ - idir = 2; - } - } - - /* - * Apply convergence tests - */ - if( idir==1 ) - { - - /* - * Run convergence test in forward direction - * First apply standard test to bottom of matrix - */ - if( ae_fp_less_eq(ae_fabs(e->ptr.p_double[m-1], _state),ae_fabs(tol, _state)*ae_fabs(d->ptr.p_double[m], _state))||(ae_fp_less(tol,0)&&ae_fp_less_eq(ae_fabs(e->ptr.p_double[m-1], _state),thresh)) ) - { - e->ptr.p_double[m-1] = 0; - continue; - } - if( ae_fp_greater_eq(tol,0) ) - { - - /* - * If relative accuracy desired, - * apply convergence criterion forward - */ - mu = ae_fabs(d->ptr.p_double[ll], _state); - sminl = mu; - iterflag = ae_false; - for(lll=ll; lll<=m-1; lll++) - { - if( ae_fp_less_eq(ae_fabs(e->ptr.p_double[lll], _state),tol*mu) ) - { - e->ptr.p_double[lll] = 0; - iterflag = ae_true; - break; - } - mu = ae_fabs(d->ptr.p_double[lll+1], _state)*(mu/(mu+ae_fabs(e->ptr.p_double[lll], _state))); - sminl = ae_minreal(sminl, mu, _state); - } - if( iterflag ) - { - continue; - } - } - } - else - { - - /* - * Run convergence test in backward direction - * First apply standard test to top of matrix - */ - if( ae_fp_less_eq(ae_fabs(e->ptr.p_double[ll], _state),ae_fabs(tol, _state)*ae_fabs(d->ptr.p_double[ll], _state))||(ae_fp_less(tol,0)&&ae_fp_less_eq(ae_fabs(e->ptr.p_double[ll], _state),thresh)) ) - { - e->ptr.p_double[ll] = 0; - continue; - } - if( ae_fp_greater_eq(tol,0) ) - { - - /* - * If relative accuracy desired, - * apply convergence criterion backward - */ - mu = ae_fabs(d->ptr.p_double[m], _state); - sminl = mu; - iterflag = ae_false; - for(lll=m-1; lll>=ll; lll--) - { - if( ae_fp_less_eq(ae_fabs(e->ptr.p_double[lll], _state),tol*mu) ) - { - e->ptr.p_double[lll] = 0; - iterflag = ae_true; - break; - } - mu = ae_fabs(d->ptr.p_double[lll], _state)*(mu/(mu+ae_fabs(e->ptr.p_double[lll], _state))); - sminl = ae_minreal(sminl, mu, _state); - } - if( iterflag ) - { - continue; - } - } - } - oldll = ll; - oldm = m; - - /* - * Compute shift. First, test if shifting would ruin relative - * accuracy, and if so set the shift to zero. - */ - if( ae_fp_greater_eq(tol,0)&&ae_fp_less_eq(n*tol*(sminl/smax),ae_maxreal(eps, 0.01*tol, _state)) ) - { - - /* - * Use a zero shift to avoid loss of relative accuracy - */ - shift = 0; - } - else - { - - /* - * Compute the shift from 2-by-2 block at end of matrix - */ - if( idir==1 ) - { - sll = ae_fabs(d->ptr.p_double[ll], _state); - bdsvd_svd2x2(d->ptr.p_double[m-1], e->ptr.p_double[m-1], d->ptr.p_double[m], &shift, &r, _state); - } - else - { - sll = ae_fabs(d->ptr.p_double[m], _state); - bdsvd_svd2x2(d->ptr.p_double[ll], e->ptr.p_double[ll], d->ptr.p_double[ll+1], &shift, &r, _state); - } - - /* - * Test if shift negligible, and if so set to zero - */ - if( ae_fp_greater(sll,0) ) - { - if( ae_fp_less(ae_sqr(shift/sll, _state),eps) ) - { - shift = 0; - } - } - } - - /* - * Increment iteration count - */ - iter = iter+m-ll; - - /* - * If SHIFT = 0, do simplified QR iteration - */ - if( ae_fp_eq(shift,0) ) - { - if( idir==1 ) - { - - /* - * Chase bulge from top to bottom - * Save cosines and sines for later singular vector updates - */ - cs = 1; - oldcs = 1; - for(i=ll; i<=m-1; i++) - { - generaterotation(d->ptr.p_double[i]*cs, e->ptr.p_double[i], &cs, &sn, &r, _state); - if( i>ll ) - { - e->ptr.p_double[i-1] = oldsn*r; - } - generaterotation(oldcs*r, d->ptr.p_double[i+1]*sn, &oldcs, &oldsn, &tmp, _state); - d->ptr.p_double[i] = tmp; - work0.ptr.p_double[i-ll+1] = cs; - work1.ptr.p_double[i-ll+1] = sn; - work2.ptr.p_double[i-ll+1] = oldcs; - work3.ptr.p_double[i-ll+1] = oldsn; - } - h = d->ptr.p_double[m]*cs; - d->ptr.p_double[m] = h*oldcs; - e->ptr.p_double[m-1] = h*oldsn; - - /* - * Update singular vectors - */ - if( ncvt>0 ) - { - applyrotationsfromtheleft(fwddir, ll+vstart-1, m+vstart-1, vstart, vend, &work0, &work1, vt, &vttemp, _state); - } - if( nru>0 ) - { - applyrotationsfromtheright(fwddir, ustart, uend, ll+ustart-1, m+ustart-1, &work2, &work3, u, &utemp, _state); - } - if( ncc>0 ) - { - applyrotationsfromtheleft(fwddir, ll+cstart-1, m+cstart-1, cstart, cend, &work2, &work3, c, &ctemp, _state); - } - - /* - * Test convergence - */ - if( ae_fp_less_eq(ae_fabs(e->ptr.p_double[m-1], _state),thresh) ) - { - e->ptr.p_double[m-1] = 0; - } - } - else - { - - /* - * Chase bulge from bottom to top - * Save cosines and sines for later singular vector updates - */ - cs = 1; - oldcs = 1; - for(i=m; i>=ll+1; i--) - { - generaterotation(d->ptr.p_double[i]*cs, e->ptr.p_double[i-1], &cs, &sn, &r, _state); - if( iptr.p_double[i] = oldsn*r; - } - generaterotation(oldcs*r, d->ptr.p_double[i-1]*sn, &oldcs, &oldsn, &tmp, _state); - d->ptr.p_double[i] = tmp; - work0.ptr.p_double[i-ll] = cs; - work1.ptr.p_double[i-ll] = -sn; - work2.ptr.p_double[i-ll] = oldcs; - work3.ptr.p_double[i-ll] = -oldsn; - } - h = d->ptr.p_double[ll]*cs; - d->ptr.p_double[ll] = h*oldcs; - e->ptr.p_double[ll] = h*oldsn; - - /* - * Update singular vectors - */ - if( ncvt>0 ) - { - applyrotationsfromtheleft(!fwddir, ll+vstart-1, m+vstart-1, vstart, vend, &work2, &work3, vt, &vttemp, _state); - } - if( nru>0 ) - { - applyrotationsfromtheright(!fwddir, ustart, uend, ll+ustart-1, m+ustart-1, &work0, &work1, u, &utemp, _state); - } - if( ncc>0 ) - { - applyrotationsfromtheleft(!fwddir, ll+cstart-1, m+cstart-1, cstart, cend, &work0, &work1, c, &ctemp, _state); - } - - /* - * Test convergence - */ - if( ae_fp_less_eq(ae_fabs(e->ptr.p_double[ll], _state),thresh) ) - { - e->ptr.p_double[ll] = 0; - } - } - } - else - { - - /* - * Use nonzero shift - */ - if( idir==1 ) - { - - /* - * Chase bulge from top to bottom - * Save cosines and sines for later singular vector updates - */ - f = (ae_fabs(d->ptr.p_double[ll], _state)-shift)*(bdsvd_extsignbdsqr(1, d->ptr.p_double[ll], _state)+shift/d->ptr.p_double[ll]); - g = e->ptr.p_double[ll]; - for(i=ll; i<=m-1; i++) - { - generaterotation(f, g, &cosr, &sinr, &r, _state); - if( i>ll ) - { - e->ptr.p_double[i-1] = r; - } - f = cosr*d->ptr.p_double[i]+sinr*e->ptr.p_double[i]; - e->ptr.p_double[i] = cosr*e->ptr.p_double[i]-sinr*d->ptr.p_double[i]; - g = sinr*d->ptr.p_double[i+1]; - d->ptr.p_double[i+1] = cosr*d->ptr.p_double[i+1]; - generaterotation(f, g, &cosl, &sinl, &r, _state); - d->ptr.p_double[i] = r; - f = cosl*e->ptr.p_double[i]+sinl*d->ptr.p_double[i+1]; - d->ptr.p_double[i+1] = cosl*d->ptr.p_double[i+1]-sinl*e->ptr.p_double[i]; - if( iptr.p_double[i+1]; - e->ptr.p_double[i+1] = cosl*e->ptr.p_double[i+1]; - } - work0.ptr.p_double[i-ll+1] = cosr; - work1.ptr.p_double[i-ll+1] = sinr; - work2.ptr.p_double[i-ll+1] = cosl; - work3.ptr.p_double[i-ll+1] = sinl; - } - e->ptr.p_double[m-1] = f; - - /* - * Update singular vectors - */ - if( ncvt>0 ) - { - applyrotationsfromtheleft(fwddir, ll+vstart-1, m+vstart-1, vstart, vend, &work0, &work1, vt, &vttemp, _state); - } - if( nru>0 ) - { - applyrotationsfromtheright(fwddir, ustart, uend, ll+ustart-1, m+ustart-1, &work2, &work3, u, &utemp, _state); - } - if( ncc>0 ) - { - applyrotationsfromtheleft(fwddir, ll+cstart-1, m+cstart-1, cstart, cend, &work2, &work3, c, &ctemp, _state); - } - - /* - * Test convergence - */ - if( ae_fp_less_eq(ae_fabs(e->ptr.p_double[m-1], _state),thresh) ) - { - e->ptr.p_double[m-1] = 0; - } - } - else - { - - /* - * Chase bulge from bottom to top - * Save cosines and sines for later singular vector updates - */ - f = (ae_fabs(d->ptr.p_double[m], _state)-shift)*(bdsvd_extsignbdsqr(1, d->ptr.p_double[m], _state)+shift/d->ptr.p_double[m]); - g = e->ptr.p_double[m-1]; - for(i=m; i>=ll+1; i--) - { - generaterotation(f, g, &cosr, &sinr, &r, _state); - if( iptr.p_double[i] = r; - } - f = cosr*d->ptr.p_double[i]+sinr*e->ptr.p_double[i-1]; - e->ptr.p_double[i-1] = cosr*e->ptr.p_double[i-1]-sinr*d->ptr.p_double[i]; - g = sinr*d->ptr.p_double[i-1]; - d->ptr.p_double[i-1] = cosr*d->ptr.p_double[i-1]; - generaterotation(f, g, &cosl, &sinl, &r, _state); - d->ptr.p_double[i] = r; - f = cosl*e->ptr.p_double[i-1]+sinl*d->ptr.p_double[i-1]; - d->ptr.p_double[i-1] = cosl*d->ptr.p_double[i-1]-sinl*e->ptr.p_double[i-1]; - if( i>ll+1 ) - { - g = sinl*e->ptr.p_double[i-2]; - e->ptr.p_double[i-2] = cosl*e->ptr.p_double[i-2]; - } - work0.ptr.p_double[i-ll] = cosr; - work1.ptr.p_double[i-ll] = -sinr; - work2.ptr.p_double[i-ll] = cosl; - work3.ptr.p_double[i-ll] = -sinl; - } - e->ptr.p_double[ll] = f; - - /* - * Test convergence - */ - if( ae_fp_less_eq(ae_fabs(e->ptr.p_double[ll], _state),thresh) ) - { - e->ptr.p_double[ll] = 0; - } - - /* - * Update singular vectors if desired - */ - if( ncvt>0 ) - { - applyrotationsfromtheleft(!fwddir, ll+vstart-1, m+vstart-1, vstart, vend, &work2, &work3, vt, &vttemp, _state); - } - if( nru>0 ) - { - applyrotationsfromtheright(!fwddir, ustart, uend, ll+ustart-1, m+ustart-1, &work0, &work1, u, &utemp, _state); - } - if( ncc>0 ) - { - applyrotationsfromtheleft(!fwddir, ll+cstart-1, m+cstart-1, cstart, cend, &work0, &work1, c, &ctemp, _state); - } - } - } - - /* - * QR iteration finished, go back and check convergence - */ - continue; - } - - /* - * All singular values converged, so make them positive - */ - for(i=1; i<=n; i++) - { - if( ae_fp_less(d->ptr.p_double[i],0) ) - { - d->ptr.p_double[i] = -d->ptr.p_double[i]; - - /* - * Change sign of singular vectors, if desired - */ - if( ncvt>0 ) - { - ae_v_muld(&vt->ptr.pp_double[i+vstart-1][vstart], 1, ae_v_len(vstart,vend), -1); - } - } - } - - /* - * Sort the singular values into decreasing order (insertion sort on - * singular values, but only one transposition per singular vector) - */ - for(i=1; i<=n-1; i++) - { - - /* - * Scan for smallest D(I) - */ - isub = 1; - smin = d->ptr.p_double[1]; - for(j=2; j<=n+1-i; j++) - { - if( ae_fp_less_eq(d->ptr.p_double[j],smin) ) - { - isub = j; - smin = d->ptr.p_double[j]; - } - } - if( isub!=n+1-i ) - { - - /* - * Swap singular values and vectors - */ - d->ptr.p_double[isub] = d->ptr.p_double[n+1-i]; - d->ptr.p_double[n+1-i] = smin; - if( ncvt>0 ) - { - j = n+1-i; - ae_v_move(&vttemp.ptr.p_double[vstart], 1, &vt->ptr.pp_double[isub+vstart-1][vstart], 1, ae_v_len(vstart,vend)); - ae_v_move(&vt->ptr.pp_double[isub+vstart-1][vstart], 1, &vt->ptr.pp_double[j+vstart-1][vstart], 1, ae_v_len(vstart,vend)); - ae_v_move(&vt->ptr.pp_double[j+vstart-1][vstart], 1, &vttemp.ptr.p_double[vstart], 1, ae_v_len(vstart,vend)); - } - if( nru>0 ) - { - j = n+1-i; - ae_v_move(&utemp.ptr.p_double[ustart], 1, &u->ptr.pp_double[ustart][isub+ustart-1], u->stride, ae_v_len(ustart,uend)); - ae_v_move(&u->ptr.pp_double[ustart][isub+ustart-1], u->stride, &u->ptr.pp_double[ustart][j+ustart-1], u->stride, ae_v_len(ustart,uend)); - ae_v_move(&u->ptr.pp_double[ustart][j+ustart-1], u->stride, &utemp.ptr.p_double[ustart], 1, ae_v_len(ustart,uend)); - } - if( ncc>0 ) - { - j = n+1-i; - ae_v_move(&ctemp.ptr.p_double[cstart], 1, &c->ptr.pp_double[isub+cstart-1][cstart], 1, ae_v_len(cstart,cend)); - ae_v_move(&c->ptr.pp_double[isub+cstart-1][cstart], 1, &c->ptr.pp_double[j+cstart-1][cstart], 1, ae_v_len(cstart,cend)); - ae_v_move(&c->ptr.pp_double[j+cstart-1][cstart], 1, &ctemp.ptr.p_double[cstart], 1, ae_v_len(cstart,cend)); - } - } - } - ae_frame_leave(_state); - return result; -} - - -static double bdsvd_extsignbdsqr(double a, double b, ae_state *_state) -{ - double result; - - - if( ae_fp_greater_eq(b,0) ) - { - result = ae_fabs(a, _state); - } - else - { - result = -ae_fabs(a, _state); - } - return result; -} - - -static void bdsvd_svd2x2(double f, - double g, - double h, - double* ssmin, - double* ssmax, - ae_state *_state) -{ - double aas; - double at; - double au; - double c; - double fa; - double fhmn; - double fhmx; - double ga; - double ha; - - *ssmin = 0; - *ssmax = 0; - - fa = ae_fabs(f, _state); - ga = ae_fabs(g, _state); - ha = ae_fabs(h, _state); - fhmn = ae_minreal(fa, ha, _state); - fhmx = ae_maxreal(fa, ha, _state); - if( ae_fp_eq(fhmn,0) ) - { - *ssmin = 0; - if( ae_fp_eq(fhmx,0) ) - { - *ssmax = ga; - } - else - { - *ssmax = ae_maxreal(fhmx, ga, _state)*ae_sqrt(1+ae_sqr(ae_minreal(fhmx, ga, _state)/ae_maxreal(fhmx, ga, _state), _state), _state); - } - } - else - { - if( ae_fp_less(ga,fhmx) ) - { - aas = 1+fhmn/fhmx; - at = (fhmx-fhmn)/fhmx; - au = ae_sqr(ga/fhmx, _state); - c = 2/(ae_sqrt(aas*aas+au, _state)+ae_sqrt(at*at+au, _state)); - *ssmin = fhmn*c; - *ssmax = fhmx/c; - } - else - { - au = fhmx/ga; - if( ae_fp_eq(au,0) ) - { - - /* - * Avoid possible harmful underflow if exponent range - * asymmetric (true SSMIN may not underflow even if - * AU underflows) - */ - *ssmin = fhmn*fhmx/ga; - *ssmax = ga; - } - else - { - aas = 1+fhmn/fhmx; - at = (fhmx-fhmn)/fhmx; - c = 1/(ae_sqrt(1+ae_sqr(aas*au, _state), _state)+ae_sqrt(1+ae_sqr(at*au, _state), _state)); - *ssmin = fhmn*c*au; - *ssmin = *ssmin+(*ssmin); - *ssmax = ga/(c+c); - } - } - } -} - - -static void bdsvd_svdv2x2(double f, - double g, - double h, - double* ssmin, - double* ssmax, - double* snr, - double* csr, - double* snl, - double* csl, - ae_state *_state) -{ - ae_bool gasmal; - ae_bool swp; - ae_int_t pmax; - double a; - double clt; - double crt; - double d; - double fa; - double ft; - double ga; - double gt; - double ha; - double ht; - double l; - double m; - double mm; - double r; - double s; - double slt; - double srt; - double t; - double temp; - double tsign; - double tt; - double v; - - *ssmin = 0; - *ssmax = 0; - *snr = 0; - *csr = 0; - *snl = 0; - *csl = 0; - - ft = f; - fa = ae_fabs(ft, _state); - ht = h; - ha = ae_fabs(h, _state); - - /* - * these initializers are not really necessary, - * but without them compiler complains about uninitialized locals - */ - clt = 0; - crt = 0; - slt = 0; - srt = 0; - tsign = 0; - - /* - * PMAX points to the maximum absolute element of matrix - * PMAX = 1 if F largest in absolute values - * PMAX = 2 if G largest in absolute values - * PMAX = 3 if H largest in absolute values - */ - pmax = 1; - swp = ae_fp_greater(ha,fa); - if( swp ) - { - - /* - * Now FA .ge. HA - */ - pmax = 3; - temp = ft; - ft = ht; - ht = temp; - temp = fa; - fa = ha; - ha = temp; - } - gt = g; - ga = ae_fabs(gt, _state); - if( ae_fp_eq(ga,0) ) - { - - /* - * Diagonal matrix - */ - *ssmin = ha; - *ssmax = fa; - clt = 1; - crt = 1; - slt = 0; - srt = 0; - } - else - { - gasmal = ae_true; - if( ae_fp_greater(ga,fa) ) - { - pmax = 2; - if( ae_fp_less(fa/ga,ae_machineepsilon) ) - { - - /* - * Case of very large GA - */ - gasmal = ae_false; - *ssmax = ga; - if( ae_fp_greater(ha,1) ) - { - v = ga/ha; - *ssmin = fa/v; - } - else - { - v = fa/ga; - *ssmin = v*ha; - } - clt = 1; - slt = ht/gt; - srt = 1; - crt = ft/gt; - } - } - if( gasmal ) - { - - /* - * Normal case - */ - d = fa-ha; - if( ae_fp_eq(d,fa) ) - { - l = 1; - } - else - { - l = d/fa; - } - m = gt/ft; - t = 2-l; - mm = m*m; - tt = t*t; - s = ae_sqrt(tt+mm, _state); - if( ae_fp_eq(l,0) ) - { - r = ae_fabs(m, _state); - } - else - { - r = ae_sqrt(l*l+mm, _state); - } - a = 0.5*(s+r); - *ssmin = ha/a; - *ssmax = fa*a; - if( ae_fp_eq(mm,0) ) - { - - /* - * Note that M is very tiny - */ - if( ae_fp_eq(l,0) ) - { - t = bdsvd_extsignbdsqr(2, ft, _state)*bdsvd_extsignbdsqr(1, gt, _state); - } - else - { - t = gt/bdsvd_extsignbdsqr(d, ft, _state)+m/t; - } - } - else - { - t = (m/(s+t)+m/(r+l))*(1+a); - } - l = ae_sqrt(t*t+4, _state); - crt = 2/l; - srt = t/l; - clt = (crt+srt*m)/a; - v = ht/ft; - slt = v*srt/a; - } - } - if( swp ) - { - *csl = srt; - *snl = crt; - *csr = slt; - *snr = clt; - } - else - { - *csl = clt; - *snl = slt; - *csr = crt; - *snr = srt; - } - - /* - * Correct signs of SSMAX and SSMIN - */ - if( pmax==1 ) - { - tsign = bdsvd_extsignbdsqr(1, *csr, _state)*bdsvd_extsignbdsqr(1, *csl, _state)*bdsvd_extsignbdsqr(1, f, _state); - } - if( pmax==2 ) - { - tsign = bdsvd_extsignbdsqr(1, *snr, _state)*bdsvd_extsignbdsqr(1, *csl, _state)*bdsvd_extsignbdsqr(1, g, _state); - } - if( pmax==3 ) - { - tsign = bdsvd_extsignbdsqr(1, *snr, _state)*bdsvd_extsignbdsqr(1, *snl, _state)*bdsvd_extsignbdsqr(1, h, _state); - } - *ssmax = bdsvd_extsignbdsqr(*ssmax, tsign, _state); - *ssmin = bdsvd_extsignbdsqr(*ssmin, tsign*bdsvd_extsignbdsqr(1, f, _state)*bdsvd_extsignbdsqr(1, h, _state), _state); -} - - - - -/************************************************************************* -Singular value decomposition of a rectangular matrix. - -The algorithm calculates the singular value decomposition of a matrix of -size MxN: A = U * S * V^T - -The algorithm finds the singular values and, optionally, matrices U and V^T. -The algorithm can find both first min(M,N) columns of matrix U and rows of -matrix V^T (singular vectors), and matrices U and V^T wholly (of sizes MxM -and NxN respectively). - -Take into account that the subroutine does not return matrix V but V^T. - -Input parameters: - A - matrix to be decomposed. - Array whose indexes range within [0..M-1, 0..N-1]. - M - number of rows in matrix A. - N - number of columns in matrix A. - UNeeded - 0, 1 or 2. See the description of the parameter U. - VTNeeded - 0, 1 or 2. See the description of the parameter VT. - AdditionalMemory - - If the parameter: - * equals 0, the algorithm doesn’t use additional - memory (lower requirements, lower performance). - * equals 1, the algorithm uses additional - memory of size min(M,N)*min(M,N) of real numbers. - It often speeds up the algorithm. - * equals 2, the algorithm uses additional - memory of size M*min(M,N) of real numbers. - It allows to get a maximum performance. - The recommended value of the parameter is 2. - -Output parameters: - W - contains singular values in descending order. - U - if UNeeded=0, U isn't changed, the left singular vectors - are not calculated. - if Uneeded=1, U contains left singular vectors (first - min(M,N) columns of matrix U). Array whose indexes range - within [0..M-1, 0..Min(M,N)-1]. - if UNeeded=2, U contains matrix U wholly. Array whose - indexes range within [0..M-1, 0..M-1]. - VT - if VTNeeded=0, VT isn’t changed, the right singular vectors - are not calculated. - if VTNeeded=1, VT contains right singular vectors (first - min(M,N) rows of matrix V^T). Array whose indexes range - within [0..min(M,N)-1, 0..N-1]. - if VTNeeded=2, VT contains matrix V^T wholly. Array whose - indexes range within [0..N-1, 0..N-1]. - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -ae_bool rmatrixsvd(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - ae_int_t uneeded, - ae_int_t vtneeded, - ae_int_t additionalmemory, - /* Real */ ae_vector* w, - /* Real */ ae_matrix* u, - /* Real */ ae_matrix* vt, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix _a; - ae_vector tauq; - ae_vector taup; - ae_vector tau; - ae_vector e; - ae_vector work; - ae_matrix t2; - ae_bool isupper; - ae_int_t minmn; - ae_int_t ncu; - ae_int_t nrvt; - ae_int_t nru; - ae_int_t ncvt; - ae_int_t i; - ae_int_t j; - ae_bool result; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init_copy(&_a, a, _state, ae_true); - a = &_a; - ae_vector_clear(w); - ae_matrix_clear(u); - ae_matrix_clear(vt); - ae_vector_init(&tauq, 0, DT_REAL, _state, ae_true); - ae_vector_init(&taup, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tau, 0, DT_REAL, _state, ae_true); - ae_vector_init(&e, 0, DT_REAL, _state, ae_true); - ae_vector_init(&work, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&t2, 0, 0, DT_REAL, _state, ae_true); - - result = ae_true; - if( m==0||n==0 ) - { - ae_frame_leave(_state); - return result; - } - ae_assert(uneeded>=0&&uneeded<=2, "SVDDecomposition: wrong parameters!", _state); - ae_assert(vtneeded>=0&&vtneeded<=2, "SVDDecomposition: wrong parameters!", _state); - ae_assert(additionalmemory>=0&&additionalmemory<=2, "SVDDecomposition: wrong parameters!", _state); - - /* - * initialize - */ - minmn = ae_minint(m, n, _state); - ae_vector_set_length(w, minmn+1, _state); - ncu = 0; - nru = 0; - if( uneeded==1 ) - { - nru = m; - ncu = minmn; - ae_matrix_set_length(u, nru-1+1, ncu-1+1, _state); - } - if( uneeded==2 ) - { - nru = m; - ncu = m; - ae_matrix_set_length(u, nru-1+1, ncu-1+1, _state); - } - nrvt = 0; - ncvt = 0; - if( vtneeded==1 ) - { - nrvt = minmn; - ncvt = n; - ae_matrix_set_length(vt, nrvt-1+1, ncvt-1+1, _state); - } - if( vtneeded==2 ) - { - nrvt = n; - ncvt = n; - ae_matrix_set_length(vt, nrvt-1+1, ncvt-1+1, _state); - } - - /* - * M much larger than N - * Use bidiagonal reduction with QR-decomposition - */ - if( ae_fp_greater(m,1.6*n) ) - { - if( uneeded==0 ) - { - - /* - * No left singular vectors to be computed - */ - rmatrixqr(a, m, n, &tau, _state); - for(i=0; i<=n-1; i++) - { - for(j=0; j<=i-1; j++) - { - a->ptr.pp_double[i][j] = 0; - } - } - rmatrixbd(a, n, n, &tauq, &taup, _state); - rmatrixbdunpackpt(a, n, n, &taup, nrvt, vt, _state); - rmatrixbdunpackdiagonals(a, n, n, &isupper, w, &e, _state); - result = rmatrixbdsvd(w, &e, n, isupper, ae_false, u, 0, a, 0, vt, ncvt, _state); - ae_frame_leave(_state); - return result; - } - else - { - - /* - * Left singular vectors (may be full matrix U) to be computed - */ - rmatrixqr(a, m, n, &tau, _state); - rmatrixqrunpackq(a, m, n, &tau, ncu, u, _state); - for(i=0; i<=n-1; i++) - { - for(j=0; j<=i-1; j++) - { - a->ptr.pp_double[i][j] = 0; - } - } - rmatrixbd(a, n, n, &tauq, &taup, _state); - rmatrixbdunpackpt(a, n, n, &taup, nrvt, vt, _state); - rmatrixbdunpackdiagonals(a, n, n, &isupper, w, &e, _state); - if( additionalmemory<1 ) - { - - /* - * No additional memory can be used - */ - rmatrixbdmultiplybyq(a, n, n, &tauq, u, m, n, ae_true, ae_false, _state); - result = rmatrixbdsvd(w, &e, n, isupper, ae_false, u, m, a, 0, vt, ncvt, _state); - } - else - { - - /* - * Large U. Transforming intermediate matrix T2 - */ - ae_vector_set_length(&work, ae_maxint(m, n, _state)+1, _state); - rmatrixbdunpackq(a, n, n, &tauq, n, &t2, _state); - copymatrix(u, 0, m-1, 0, n-1, a, 0, m-1, 0, n-1, _state); - inplacetranspose(&t2, 0, n-1, 0, n-1, &work, _state); - result = rmatrixbdsvd(w, &e, n, isupper, ae_false, u, 0, &t2, n, vt, ncvt, _state); - matrixmatrixmultiply(a, 0, m-1, 0, n-1, ae_false, &t2, 0, n-1, 0, n-1, ae_true, 1.0, u, 0, m-1, 0, n-1, 0.0, &work, _state); - } - ae_frame_leave(_state); - return result; - } - } - - /* - * N much larger than M - * Use bidiagonal reduction with LQ-decomposition - */ - if( ae_fp_greater(n,1.6*m) ) - { - if( vtneeded==0 ) - { - - /* - * No right singular vectors to be computed - */ - rmatrixlq(a, m, n, &tau, _state); - for(i=0; i<=m-1; i++) - { - for(j=i+1; j<=m-1; j++) - { - a->ptr.pp_double[i][j] = 0; - } - } - rmatrixbd(a, m, m, &tauq, &taup, _state); - rmatrixbdunpackq(a, m, m, &tauq, ncu, u, _state); - rmatrixbdunpackdiagonals(a, m, m, &isupper, w, &e, _state); - ae_vector_set_length(&work, m+1, _state); - inplacetranspose(u, 0, nru-1, 0, ncu-1, &work, _state); - result = rmatrixbdsvd(w, &e, m, isupper, ae_false, a, 0, u, nru, vt, 0, _state); - inplacetranspose(u, 0, nru-1, 0, ncu-1, &work, _state); - ae_frame_leave(_state); - return result; - } - else - { - - /* - * Right singular vectors (may be full matrix VT) to be computed - */ - rmatrixlq(a, m, n, &tau, _state); - rmatrixlqunpackq(a, m, n, &tau, nrvt, vt, _state); - for(i=0; i<=m-1; i++) - { - for(j=i+1; j<=m-1; j++) - { - a->ptr.pp_double[i][j] = 0; - } - } - rmatrixbd(a, m, m, &tauq, &taup, _state); - rmatrixbdunpackq(a, m, m, &tauq, ncu, u, _state); - rmatrixbdunpackdiagonals(a, m, m, &isupper, w, &e, _state); - ae_vector_set_length(&work, ae_maxint(m, n, _state)+1, _state); - inplacetranspose(u, 0, nru-1, 0, ncu-1, &work, _state); - if( additionalmemory<1 ) - { - - /* - * No additional memory available - */ - rmatrixbdmultiplybyp(a, m, m, &taup, vt, m, n, ae_false, ae_true, _state); - result = rmatrixbdsvd(w, &e, m, isupper, ae_false, a, 0, u, nru, vt, n, _state); - } - else - { - - /* - * Large VT. Transforming intermediate matrix T2 - */ - rmatrixbdunpackpt(a, m, m, &taup, m, &t2, _state); - result = rmatrixbdsvd(w, &e, m, isupper, ae_false, a, 0, u, nru, &t2, m, _state); - copymatrix(vt, 0, m-1, 0, n-1, a, 0, m-1, 0, n-1, _state); - matrixmatrixmultiply(&t2, 0, m-1, 0, m-1, ae_false, a, 0, m-1, 0, n-1, ae_false, 1.0, vt, 0, m-1, 0, n-1, 0.0, &work, _state); - } - inplacetranspose(u, 0, nru-1, 0, ncu-1, &work, _state); - ae_frame_leave(_state); - return result; - } - } - - /* - * M<=N - * We can use inplace transposition of U to get rid of columnwise operations - */ - if( m<=n ) - { - rmatrixbd(a, m, n, &tauq, &taup, _state); - rmatrixbdunpackq(a, m, n, &tauq, ncu, u, _state); - rmatrixbdunpackpt(a, m, n, &taup, nrvt, vt, _state); - rmatrixbdunpackdiagonals(a, m, n, &isupper, w, &e, _state); - ae_vector_set_length(&work, m+1, _state); - inplacetranspose(u, 0, nru-1, 0, ncu-1, &work, _state); - result = rmatrixbdsvd(w, &e, minmn, isupper, ae_false, a, 0, u, nru, vt, ncvt, _state); - inplacetranspose(u, 0, nru-1, 0, ncu-1, &work, _state); - ae_frame_leave(_state); - return result; - } - - /* - * Simple bidiagonal reduction - */ - rmatrixbd(a, m, n, &tauq, &taup, _state); - rmatrixbdunpackq(a, m, n, &tauq, ncu, u, _state); - rmatrixbdunpackpt(a, m, n, &taup, nrvt, vt, _state); - rmatrixbdunpackdiagonals(a, m, n, &isupper, w, &e, _state); - if( additionalmemory<2||uneeded==0 ) - { - - /* - * We can't use additional memory or there is no need in such operations - */ - result = rmatrixbdsvd(w, &e, minmn, isupper, ae_false, u, nru, a, 0, vt, ncvt, _state); - } - else - { - - /* - * We can use additional memory - */ - ae_matrix_set_length(&t2, minmn-1+1, m-1+1, _state); - copyandtranspose(u, 0, m-1, 0, minmn-1, &t2, 0, minmn-1, 0, m-1, _state); - result = rmatrixbdsvd(w, &e, minmn, isupper, ae_false, u, 0, &t2, m, vt, ncvt, _state); - copyandtranspose(&t2, 0, minmn-1, 0, m-1, u, 0, m-1, 0, minmn-1, _state); - } - ae_frame_leave(_state); - return result; -} - - - - -/************************************************************************* -Finding the eigenvalues and eigenvectors of a symmetric matrix - -The algorithm finds eigen pairs of a symmetric matrix by reducing it to -tridiagonal form and using the QL/QR algorithm. - -Input parameters: - A - symmetric matrix which is given by its upper or lower - triangular part. - Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - ZNeeded - flag controlling whether the eigenvectors are needed or not. - If ZNeeded is equal to: - * 0, the eigenvectors are not returned; - * 1, the eigenvectors are returned. - IsUpper - storage format. - -Output parameters: - D - eigenvalues in ascending order. - Array whose index ranges within [0..N-1]. - Z - if ZNeeded is equal to: - * 0, Z hasn’t changed; - * 1, Z contains the eigenvectors. - Array whose indexes range within [0..N-1, 0..N-1]. - The eigenvectors are stored in the matrix columns. - -Result: - True, if the algorithm has converged. - False, if the algorithm hasn't converged (rare case). - - -- ALGLIB -- - Copyright 2005-2008 by Bochkanov Sergey -*************************************************************************/ -ae_bool smatrixevd(/* Real */ ae_matrix* a, - ae_int_t n, - ae_int_t zneeded, - ae_bool isupper, - /* Real */ ae_vector* d, - /* Real */ ae_matrix* z, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix _a; - ae_vector tau; - ae_vector e; - ae_bool result; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init_copy(&_a, a, _state, ae_true); - a = &_a; - ae_vector_clear(d); - ae_matrix_clear(z); - ae_vector_init(&tau, 0, DT_REAL, _state, ae_true); - ae_vector_init(&e, 0, DT_REAL, _state, ae_true); - - ae_assert(zneeded==0||zneeded==1, "SMatrixEVD: incorrect ZNeeded", _state); - smatrixtd(a, n, isupper, &tau, d, &e, _state); - if( zneeded==1 ) - { - smatrixtdunpackq(a, n, isupper, &tau, z, _state); - } - result = smatrixtdevd(d, &e, n, zneeded, z, _state); - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Subroutine for finding the eigenvalues (and eigenvectors) of a symmetric -matrix in a given half open interval (A, B] by using a bisection and -inverse iteration - -Input parameters: - A - symmetric matrix which is given by its upper or lower - triangular part. Array [0..N-1, 0..N-1]. - N - size of matrix A. - ZNeeded - flag controlling whether the eigenvectors are needed or not. - If ZNeeded is equal to: - * 0, the eigenvectors are not returned; - * 1, the eigenvectors are returned. - IsUpperA - storage format of matrix A. - B1, B2 - half open interval (B1, B2] to search eigenvalues in. - -Output parameters: - M - number of eigenvalues found in a given half-interval (M>=0). - W - array of the eigenvalues found. - Array whose index ranges within [0..M-1]. - Z - if ZNeeded is equal to: - * 0, Z hasn’t changed; - * 1, Z contains eigenvectors. - Array whose indexes range within [0..N-1, 0..M-1]. - The eigenvectors are stored in the matrix columns. - -Result: - True, if successful. M contains the number of eigenvalues in the given - half-interval (could be equal to 0), W contains the eigenvalues, - Z contains the eigenvectors (if needed). - - False, if the bisection method subroutine wasn't able to find the - eigenvalues in the given interval or if the inverse iteration subroutine - wasn't able to find all the corresponding eigenvectors. - In that case, the eigenvalues and eigenvectors are not returned, - M is equal to 0. - - -- ALGLIB -- - Copyright 07.01.2006 by Bochkanov Sergey -*************************************************************************/ -ae_bool smatrixevdr(/* Real */ ae_matrix* a, - ae_int_t n, - ae_int_t zneeded, - ae_bool isupper, - double b1, - double b2, - ae_int_t* m, - /* Real */ ae_vector* w, - /* Real */ ae_matrix* z, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix _a; - ae_vector tau; - ae_vector e; - ae_bool result; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init_copy(&_a, a, _state, ae_true); - a = &_a; - *m = 0; - ae_vector_clear(w); - ae_matrix_clear(z); - ae_vector_init(&tau, 0, DT_REAL, _state, ae_true); - ae_vector_init(&e, 0, DT_REAL, _state, ae_true); - - ae_assert(zneeded==0||zneeded==1, "SMatrixTDEVDR: incorrect ZNeeded", _state); - smatrixtd(a, n, isupper, &tau, w, &e, _state); - if( zneeded==1 ) - { - smatrixtdunpackq(a, n, isupper, &tau, z, _state); - } - result = smatrixtdevdr(w, &e, n, zneeded, b1, b2, m, z, _state); - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Subroutine for finding the eigenvalues and eigenvectors of a symmetric -matrix with given indexes by using bisection and inverse iteration methods. - -Input parameters: - A - symmetric matrix which is given by its upper or lower - triangular part. Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - ZNeeded - flag controlling whether the eigenvectors are needed or not. - If ZNeeded is equal to: - * 0, the eigenvectors are not returned; - * 1, the eigenvectors are returned. - IsUpperA - storage format of matrix A. - I1, I2 - index interval for searching (from I1 to I2). - 0 <= I1 <= I2 <= N-1. - -Output parameters: - W - array of the eigenvalues found. - Array whose index ranges within [0..I2-I1]. - Z - if ZNeeded is equal to: - * 0, Z hasn’t changed; - * 1, Z contains eigenvectors. - Array whose indexes range within [0..N-1, 0..I2-I1]. - In that case, the eigenvectors are stored in the matrix columns. - -Result: - True, if successful. W contains the eigenvalues, Z contains the - eigenvectors (if needed). - - False, if the bisection method subroutine wasn't able to find the - eigenvalues in the given interval or if the inverse iteration subroutine - wasn't able to find all the corresponding eigenvectors. - In that case, the eigenvalues and eigenvectors are not returned. - - -- ALGLIB -- - Copyright 07.01.2006 by Bochkanov Sergey -*************************************************************************/ -ae_bool smatrixevdi(/* Real */ ae_matrix* a, - ae_int_t n, - ae_int_t zneeded, - ae_bool isupper, - ae_int_t i1, - ae_int_t i2, - /* Real */ ae_vector* w, - /* Real */ ae_matrix* z, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix _a; - ae_vector tau; - ae_vector e; - ae_bool result; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init_copy(&_a, a, _state, ae_true); - a = &_a; - ae_vector_clear(w); - ae_matrix_clear(z); - ae_vector_init(&tau, 0, DT_REAL, _state, ae_true); - ae_vector_init(&e, 0, DT_REAL, _state, ae_true); - - ae_assert(zneeded==0||zneeded==1, "SMatrixEVDI: incorrect ZNeeded", _state); - smatrixtd(a, n, isupper, &tau, w, &e, _state); - if( zneeded==1 ) - { - smatrixtdunpackq(a, n, isupper, &tau, z, _state); - } - result = smatrixtdevdi(w, &e, n, zneeded, i1, i2, z, _state); - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Finding the eigenvalues and eigenvectors of a Hermitian matrix - -The algorithm finds eigen pairs of a Hermitian matrix by reducing it to -real tridiagonal form and using the QL/QR algorithm. - -Input parameters: - A - Hermitian matrix which is given by its upper or lower - triangular part. - Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - IsUpper - storage format. - ZNeeded - flag controlling whether the eigenvectors are needed or - not. If ZNeeded is equal to: - * 0, the eigenvectors are not returned; - * 1, the eigenvectors are returned. - -Output parameters: - D - eigenvalues in ascending order. - Array whose index ranges within [0..N-1]. - Z - if ZNeeded is equal to: - * 0, Z hasn’t changed; - * 1, Z contains the eigenvectors. - Array whose indexes range within [0..N-1, 0..N-1]. - The eigenvectors are stored in the matrix columns. - -Result: - True, if the algorithm has converged. - False, if the algorithm hasn't converged (rare case). - -Note: - eigenvectors of Hermitian matrix are defined up to multiplication by - a complex number L, such that |L|=1. - - -- ALGLIB -- - Copyright 2005, 23 March 2007 by Bochkanov Sergey -*************************************************************************/ -ae_bool hmatrixevd(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_int_t zneeded, - ae_bool isupper, - /* Real */ ae_vector* d, - /* Complex */ ae_matrix* z, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix _a; - ae_vector tau; - ae_vector e; - ae_vector work; - ae_matrix t; - ae_matrix q; - ae_int_t i; - ae_int_t k; - double v; - ae_bool result; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init_copy(&_a, a, _state, ae_true); - a = &_a; - ae_vector_clear(d); - ae_matrix_clear(z); - ae_vector_init(&tau, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&e, 0, DT_REAL, _state, ae_true); - ae_vector_init(&work, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&t, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&q, 0, 0, DT_COMPLEX, _state, ae_true); - - ae_assert(zneeded==0||zneeded==1, "HermitianEVD: incorrect ZNeeded", _state); - - /* - * Reduce to tridiagonal form - */ - hmatrixtd(a, n, isupper, &tau, d, &e, _state); - if( zneeded==1 ) - { - hmatrixtdunpackq(a, n, isupper, &tau, &q, _state); - zneeded = 2; - } - - /* - * TDEVD - */ - result = smatrixtdevd(d, &e, n, zneeded, &t, _state); - - /* - * Eigenvectors are needed - * Calculate Z = Q*T = Re(Q)*T + i*Im(Q)*T - */ - if( result&&zneeded!=0 ) - { - ae_vector_set_length(&work, n-1+1, _state); - ae_matrix_set_length(z, n-1+1, n-1+1, _state); - for(i=0; i<=n-1; i++) - { - - /* - * Calculate real part - */ - for(k=0; k<=n-1; k++) - { - work.ptr.p_double[k] = 0; - } - for(k=0; k<=n-1; k++) - { - v = q.ptr.pp_complex[i][k].x; - ae_v_addd(&work.ptr.p_double[0], 1, &t.ptr.pp_double[k][0], 1, ae_v_len(0,n-1), v); - } - for(k=0; k<=n-1; k++) - { - z->ptr.pp_complex[i][k].x = work.ptr.p_double[k]; - } - - /* - * Calculate imaginary part - */ - for(k=0; k<=n-1; k++) - { - work.ptr.p_double[k] = 0; - } - for(k=0; k<=n-1; k++) - { - v = q.ptr.pp_complex[i][k].y; - ae_v_addd(&work.ptr.p_double[0], 1, &t.ptr.pp_double[k][0], 1, ae_v_len(0,n-1), v); - } - for(k=0; k<=n-1; k++) - { - z->ptr.pp_complex[i][k].y = work.ptr.p_double[k]; - } - } - } - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Subroutine for finding the eigenvalues (and eigenvectors) of a Hermitian -matrix in a given half-interval (A, B] by using a bisection and inverse -iteration - -Input parameters: - A - Hermitian matrix which is given by its upper or lower - triangular part. Array whose indexes range within - [0..N-1, 0..N-1]. - N - size of matrix A. - ZNeeded - flag controlling whether the eigenvectors are needed or - not. If ZNeeded is equal to: - * 0, the eigenvectors are not returned; - * 1, the eigenvectors are returned. - IsUpperA - storage format of matrix A. - B1, B2 - half-interval (B1, B2] to search eigenvalues in. - -Output parameters: - M - number of eigenvalues found in a given half-interval, M>=0 - W - array of the eigenvalues found. - Array whose index ranges within [0..M-1]. - Z - if ZNeeded is equal to: - * 0, Z hasn’t changed; - * 1, Z contains eigenvectors. - Array whose indexes range within [0..N-1, 0..M-1]. - The eigenvectors are stored in the matrix columns. - -Result: - True, if successful. M contains the number of eigenvalues in the given - half-interval (could be equal to 0), W contains the eigenvalues, - Z contains the eigenvectors (if needed). - - False, if the bisection method subroutine wasn't able to find the - eigenvalues in the given interval or if the inverse iteration - subroutine wasn't able to find all the corresponding eigenvectors. - In that case, the eigenvalues and eigenvectors are not returned, M is - equal to 0. - -Note: - eigen vectors of Hermitian matrix are defined up to multiplication by - a complex number L, such as |L|=1. - - -- ALGLIB -- - Copyright 07.01.2006, 24.03.2007 by Bochkanov Sergey. -*************************************************************************/ -ae_bool hmatrixevdr(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_int_t zneeded, - ae_bool isupper, - double b1, - double b2, - ae_int_t* m, - /* Real */ ae_vector* w, - /* Complex */ ae_matrix* z, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix _a; - ae_matrix q; - ae_matrix t; - ae_vector tau; - ae_vector e; - ae_vector work; - ae_int_t i; - ae_int_t k; - double v; - ae_bool result; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init_copy(&_a, a, _state, ae_true); - a = &_a; - *m = 0; - ae_vector_clear(w); - ae_matrix_clear(z); - ae_matrix_init(&q, 0, 0, DT_COMPLEX, _state, ae_true); - ae_matrix_init(&t, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tau, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&e, 0, DT_REAL, _state, ae_true); - ae_vector_init(&work, 0, DT_REAL, _state, ae_true); - - ae_assert(zneeded==0||zneeded==1, "HermitianEigenValuesAndVectorsInInterval: incorrect ZNeeded", _state); - - /* - * Reduce to tridiagonal form - */ - hmatrixtd(a, n, isupper, &tau, w, &e, _state); - if( zneeded==1 ) - { - hmatrixtdunpackq(a, n, isupper, &tau, &q, _state); - zneeded = 2; - } - - /* - * Bisection and inverse iteration - */ - result = smatrixtdevdr(w, &e, n, zneeded, b1, b2, m, &t, _state); - - /* - * Eigenvectors are needed - * Calculate Z = Q*T = Re(Q)*T + i*Im(Q)*T - */ - if( (result&&zneeded!=0)&&*m!=0 ) - { - ae_vector_set_length(&work, *m-1+1, _state); - ae_matrix_set_length(z, n-1+1, *m-1+1, _state); - for(i=0; i<=n-1; i++) - { - - /* - * Calculate real part - */ - for(k=0; k<=*m-1; k++) - { - work.ptr.p_double[k] = 0; - } - for(k=0; k<=n-1; k++) - { - v = q.ptr.pp_complex[i][k].x; - ae_v_addd(&work.ptr.p_double[0], 1, &t.ptr.pp_double[k][0], 1, ae_v_len(0,*m-1), v); - } - for(k=0; k<=*m-1; k++) - { - z->ptr.pp_complex[i][k].x = work.ptr.p_double[k]; - } - - /* - * Calculate imaginary part - */ - for(k=0; k<=*m-1; k++) - { - work.ptr.p_double[k] = 0; - } - for(k=0; k<=n-1; k++) - { - v = q.ptr.pp_complex[i][k].y; - ae_v_addd(&work.ptr.p_double[0], 1, &t.ptr.pp_double[k][0], 1, ae_v_len(0,*m-1), v); - } - for(k=0; k<=*m-1; k++) - { - z->ptr.pp_complex[i][k].y = work.ptr.p_double[k]; - } - } - } - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Subroutine for finding the eigenvalues and eigenvectors of a Hermitian -matrix with given indexes by using bisection and inverse iteration methods - -Input parameters: - A - Hermitian matrix which is given by its upper or lower - triangular part. - Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - ZNeeded - flag controlling whether the eigenvectors are needed or - not. If ZNeeded is equal to: - * 0, the eigenvectors are not returned; - * 1, the eigenvectors are returned. - IsUpperA - storage format of matrix A. - I1, I2 - index interval for searching (from I1 to I2). - 0 <= I1 <= I2 <= N-1. - -Output parameters: - W - array of the eigenvalues found. - Array whose index ranges within [0..I2-I1]. - Z - if ZNeeded is equal to: - * 0, Z hasn’t changed; - * 1, Z contains eigenvectors. - Array whose indexes range within [0..N-1, 0..I2-I1]. - In that case, the eigenvectors are stored in the matrix - columns. - -Result: - True, if successful. W contains the eigenvalues, Z contains the - eigenvectors (if needed). - - False, if the bisection method subroutine wasn't able to find the - eigenvalues in the given interval or if the inverse iteration - subroutine wasn't able to find all the corresponding eigenvectors. - In that case, the eigenvalues and eigenvectors are not returned. - -Note: - eigen vectors of Hermitian matrix are defined up to multiplication by - a complex number L, such as |L|=1. - - -- ALGLIB -- - Copyright 07.01.2006, 24.03.2007 by Bochkanov Sergey. -*************************************************************************/ -ae_bool hmatrixevdi(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_int_t zneeded, - ae_bool isupper, - ae_int_t i1, - ae_int_t i2, - /* Real */ ae_vector* w, - /* Complex */ ae_matrix* z, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix _a; - ae_matrix q; - ae_matrix t; - ae_vector tau; - ae_vector e; - ae_vector work; - ae_int_t i; - ae_int_t k; - double v; - ae_int_t m; - ae_bool result; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init_copy(&_a, a, _state, ae_true); - a = &_a; - ae_vector_clear(w); - ae_matrix_clear(z); - ae_matrix_init(&q, 0, 0, DT_COMPLEX, _state, ae_true); - ae_matrix_init(&t, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tau, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&e, 0, DT_REAL, _state, ae_true); - ae_vector_init(&work, 0, DT_REAL, _state, ae_true); - - ae_assert(zneeded==0||zneeded==1, "HermitianEigenValuesAndVectorsByIndexes: incorrect ZNeeded", _state); - - /* - * Reduce to tridiagonal form - */ - hmatrixtd(a, n, isupper, &tau, w, &e, _state); - if( zneeded==1 ) - { - hmatrixtdunpackq(a, n, isupper, &tau, &q, _state); - zneeded = 2; - } - - /* - * Bisection and inverse iteration - */ - result = smatrixtdevdi(w, &e, n, zneeded, i1, i2, &t, _state); - - /* - * Eigenvectors are needed - * Calculate Z = Q*T = Re(Q)*T + i*Im(Q)*T - */ - m = i2-i1+1; - if( result&&zneeded!=0 ) - { - ae_vector_set_length(&work, m-1+1, _state); - ae_matrix_set_length(z, n-1+1, m-1+1, _state); - for(i=0; i<=n-1; i++) - { - - /* - * Calculate real part - */ - for(k=0; k<=m-1; k++) - { - work.ptr.p_double[k] = 0; - } - for(k=0; k<=n-1; k++) - { - v = q.ptr.pp_complex[i][k].x; - ae_v_addd(&work.ptr.p_double[0], 1, &t.ptr.pp_double[k][0], 1, ae_v_len(0,m-1), v); - } - for(k=0; k<=m-1; k++) - { - z->ptr.pp_complex[i][k].x = work.ptr.p_double[k]; - } - - /* - * Calculate imaginary part - */ - for(k=0; k<=m-1; k++) - { - work.ptr.p_double[k] = 0; - } - for(k=0; k<=n-1; k++) - { - v = q.ptr.pp_complex[i][k].y; - ae_v_addd(&work.ptr.p_double[0], 1, &t.ptr.pp_double[k][0], 1, ae_v_len(0,m-1), v); - } - for(k=0; k<=m-1; k++) - { - z->ptr.pp_complex[i][k].y = work.ptr.p_double[k]; - } - } - } - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Finding the eigenvalues and eigenvectors of a tridiagonal symmetric matrix - -The algorithm finds the eigen pairs of a tridiagonal symmetric matrix by -using an QL/QR algorithm with implicit shifts. - -Input parameters: - D - the main diagonal of a tridiagonal matrix. - Array whose index ranges within [0..N-1]. - E - the secondary diagonal of a tridiagonal matrix. - Array whose index ranges within [0..N-2]. - N - size of matrix A. - ZNeeded - flag controlling whether the eigenvectors are needed or not. - If ZNeeded is equal to: - * 0, the eigenvectors are not needed; - * 1, the eigenvectors of a tridiagonal matrix - are multiplied by the square matrix Z. It is used if the - tridiagonal matrix is obtained by the similarity - transformation of a symmetric matrix; - * 2, the eigenvectors of a tridiagonal matrix replace the - square matrix Z; - * 3, matrix Z contains the first row of the eigenvectors - matrix. - Z - if ZNeeded=1, Z contains the square matrix by which the - eigenvectors are multiplied. - Array whose indexes range within [0..N-1, 0..N-1]. - -Output parameters: - D - eigenvalues in ascending order. - Array whose index ranges within [0..N-1]. - Z - if ZNeeded is equal to: - * 0, Z hasn’t changed; - * 1, Z contains the product of a given matrix (from the left) - and the eigenvectors matrix (from the right); - * 2, Z contains the eigenvectors. - * 3, Z contains the first row of the eigenvectors matrix. - If ZNeeded<3, Z is the array whose indexes range within [0..N-1, 0..N-1]. - In that case, the eigenvectors are stored in the matrix columns. - If ZNeeded=3, Z is the array whose indexes range within [0..0, 0..N-1]. - -Result: - True, if the algorithm has converged. - False, if the algorithm hasn't converged. - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - September 30, 1994 -*************************************************************************/ -ae_bool smatrixtdevd(/* Real */ ae_vector* d, - /* Real */ ae_vector* e, - ae_int_t n, - ae_int_t zneeded, - /* Real */ ae_matrix* z, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _e; - ae_vector d1; - ae_vector e1; - ae_matrix z1; - ae_int_t i; - ae_bool result; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_e, e, _state, ae_true); - e = &_e; - ae_vector_init(&d1, 0, DT_REAL, _state, ae_true); - ae_vector_init(&e1, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&z1, 0, 0, DT_REAL, _state, ae_true); - - - /* - * Prepare 1-based task - */ - ae_vector_set_length(&d1, n+1, _state); - ae_vector_set_length(&e1, n+1, _state); - ae_v_move(&d1.ptr.p_double[1], 1, &d->ptr.p_double[0], 1, ae_v_len(1,n)); - if( n>1 ) - { - ae_v_move(&e1.ptr.p_double[1], 1, &e->ptr.p_double[0], 1, ae_v_len(1,n-1)); - } - if( zneeded==1 ) - { - ae_matrix_set_length(&z1, n+1, n+1, _state); - for(i=1; i<=n; i++) - { - ae_v_move(&z1.ptr.pp_double[i][1], 1, &z->ptr.pp_double[i-1][0], 1, ae_v_len(1,n)); - } - } - - /* - * Solve 1-based task - */ - result = evd_tridiagonalevd(&d1, &e1, n, zneeded, &z1, _state); - if( !result ) - { - ae_frame_leave(_state); - return result; - } - - /* - * Convert back to 0-based result - */ - ae_v_move(&d->ptr.p_double[0], 1, &d1.ptr.p_double[1], 1, ae_v_len(0,n-1)); - if( zneeded!=0 ) - { - if( zneeded==1 ) - { - for(i=1; i<=n; i++) - { - ae_v_move(&z->ptr.pp_double[i-1][0], 1, &z1.ptr.pp_double[i][1], 1, ae_v_len(0,n-1)); - } - ae_frame_leave(_state); - return result; - } - if( zneeded==2 ) - { - ae_matrix_set_length(z, n-1+1, n-1+1, _state); - for(i=1; i<=n; i++) - { - ae_v_move(&z->ptr.pp_double[i-1][0], 1, &z1.ptr.pp_double[i][1], 1, ae_v_len(0,n-1)); - } - ae_frame_leave(_state); - return result; - } - if( zneeded==3 ) - { - ae_matrix_set_length(z, 0+1, n-1+1, _state); - ae_v_move(&z->ptr.pp_double[0][0], 1, &z1.ptr.pp_double[1][1], 1, ae_v_len(0,n-1)); - ae_frame_leave(_state); - return result; - } - ae_assert(ae_false, "SMatrixTDEVD: Incorrect ZNeeded!", _state); - } - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Subroutine for finding the tridiagonal matrix eigenvalues/vectors in a -given half-interval (A, B] by using bisection and inverse iteration. - -Input parameters: - D - the main diagonal of a tridiagonal matrix. - Array whose index ranges within [0..N-1]. - E - the secondary diagonal of a tridiagonal matrix. - Array whose index ranges within [0..N-2]. - N - size of matrix, N>=0. - ZNeeded - flag controlling whether the eigenvectors are needed or not. - If ZNeeded is equal to: - * 0, the eigenvectors are not needed; - * 1, the eigenvectors of a tridiagonal matrix are multiplied - by the square matrix Z. It is used if the tridiagonal - matrix is obtained by the similarity transformation - of a symmetric matrix. - * 2, the eigenvectors of a tridiagonal matrix replace matrix Z. - A, B - half-interval (A, B] to search eigenvalues in. - Z - if ZNeeded is equal to: - * 0, Z isn't used and remains unchanged; - * 1, Z contains the square matrix (array whose indexes range - within [0..N-1, 0..N-1]) which reduces the given symmetric - matrix to tridiagonal form; - * 2, Z isn't used (but changed on the exit). - -Output parameters: - D - array of the eigenvalues found. - Array whose index ranges within [0..M-1]. - M - number of eigenvalues found in the given half-interval (M>=0). - Z - if ZNeeded is equal to: - * 0, doesn't contain any information; - * 1, contains the product of a given NxN matrix Z (from the - left) and NxM matrix of the eigenvectors found (from the - right). Array whose indexes range within [0..N-1, 0..M-1]. - * 2, contains the matrix of the eigenvectors found. - Array whose indexes range within [0..N-1, 0..M-1]. - -Result: - - True, if successful. In that case, M contains the number of eigenvalues - in the given half-interval (could be equal to 0), D contains the eigenvalues, - Z contains the eigenvectors (if needed). - It should be noted that the subroutine changes the size of arrays D and Z. - - False, if the bisection method subroutine wasn't able to find the - eigenvalues in the given interval or if the inverse iteration subroutine - wasn't able to find all the corresponding eigenvectors. In that case, - the eigenvalues and eigenvectors are not returned, M is equal to 0. - - -- ALGLIB -- - Copyright 31.03.2008 by Bochkanov Sergey -*************************************************************************/ -ae_bool smatrixtdevdr(/* Real */ ae_vector* d, - /* Real */ ae_vector* e, - ae_int_t n, - ae_int_t zneeded, - double a, - double b, - ae_int_t* m, - /* Real */ ae_matrix* z, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t errorcode; - ae_int_t nsplit; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t cr; - ae_vector iblock; - ae_vector isplit; - ae_vector ifail; - ae_vector d1; - ae_vector e1; - ae_vector w; - ae_matrix z2; - ae_matrix z3; - double v; - ae_bool result; - - ae_frame_make(_state, &_frame_block); - *m = 0; - ae_vector_init(&iblock, 0, DT_INT, _state, ae_true); - ae_vector_init(&isplit, 0, DT_INT, _state, ae_true); - ae_vector_init(&ifail, 0, DT_INT, _state, ae_true); - ae_vector_init(&d1, 0, DT_REAL, _state, ae_true); - ae_vector_init(&e1, 0, DT_REAL, _state, ae_true); - ae_vector_init(&w, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&z2, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&z3, 0, 0, DT_REAL, _state, ae_true); - - ae_assert(zneeded>=0&&zneeded<=2, "SMatrixTDEVDR: incorrect ZNeeded!", _state); - - /* - * Special cases - */ - if( ae_fp_less_eq(b,a) ) - { - *m = 0; - result = ae_true; - ae_frame_leave(_state); - return result; - } - if( n<=0 ) - { - *m = 0; - result = ae_true; - ae_frame_leave(_state); - return result; - } - - /* - * Copy D,E to D1, E1 - */ - ae_vector_set_length(&d1, n+1, _state); - ae_v_move(&d1.ptr.p_double[1], 1, &d->ptr.p_double[0], 1, ae_v_len(1,n)); - if( n>1 ) - { - ae_vector_set_length(&e1, n-1+1, _state); - ae_v_move(&e1.ptr.p_double[1], 1, &e->ptr.p_double[0], 1, ae_v_len(1,n-1)); - } - - /* - * No eigen vectors - */ - if( zneeded==0 ) - { - result = evd_internalbisectioneigenvalues(&d1, &e1, n, 2, 1, a, b, 0, 0, -1, &w, m, &nsplit, &iblock, &isplit, &errorcode, _state); - if( !result||*m==0 ) - { - *m = 0; - ae_frame_leave(_state); - return result; - } - ae_vector_set_length(d, *m-1+1, _state); - ae_v_move(&d->ptr.p_double[0], 1, &w.ptr.p_double[1], 1, ae_v_len(0,*m-1)); - ae_frame_leave(_state); - return result; - } - - /* - * Eigen vectors are multiplied by Z - */ - if( zneeded==1 ) - { - - /* - * Find eigen pairs - */ - result = evd_internalbisectioneigenvalues(&d1, &e1, n, 2, 2, a, b, 0, 0, -1, &w, m, &nsplit, &iblock, &isplit, &errorcode, _state); - if( !result||*m==0 ) - { - *m = 0; - ae_frame_leave(_state); - return result; - } - evd_internaldstein(n, &d1, &e1, *m, &w, &iblock, &isplit, &z2, &ifail, &cr, _state); - if( cr!=0 ) - { - *m = 0; - result = ae_false; - ae_frame_leave(_state); - return result; - } - - /* - * Sort eigen values and vectors - */ - for(i=1; i<=*m; i++) - { - k = i; - for(j=i; j<=*m; j++) - { - if( ae_fp_less(w.ptr.p_double[j],w.ptr.p_double[k]) ) - { - k = j; - } - } - v = w.ptr.p_double[i]; - w.ptr.p_double[i] = w.ptr.p_double[k]; - w.ptr.p_double[k] = v; - for(j=1; j<=n; j++) - { - v = z2.ptr.pp_double[j][i]; - z2.ptr.pp_double[j][i] = z2.ptr.pp_double[j][k]; - z2.ptr.pp_double[j][k] = v; - } - } - - /* - * Transform Z2 and overwrite Z - */ - ae_matrix_set_length(&z3, *m+1, n+1, _state); - for(i=1; i<=*m; i++) - { - ae_v_move(&z3.ptr.pp_double[i][1], 1, &z2.ptr.pp_double[1][i], z2.stride, ae_v_len(1,n)); - } - for(i=1; i<=n; i++) - { - for(j=1; j<=*m; j++) - { - v = ae_v_dotproduct(&z->ptr.pp_double[i-1][0], 1, &z3.ptr.pp_double[j][1], 1, ae_v_len(0,n-1)); - z2.ptr.pp_double[i][j] = v; - } - } - ae_matrix_set_length(z, n-1+1, *m-1+1, _state); - for(i=1; i<=*m; i++) - { - ae_v_move(&z->ptr.pp_double[0][i-1], z->stride, &z2.ptr.pp_double[1][i], z2.stride, ae_v_len(0,n-1)); - } - - /* - * Store W - */ - ae_vector_set_length(d, *m-1+1, _state); - for(i=1; i<=*m; i++) - { - d->ptr.p_double[i-1] = w.ptr.p_double[i]; - } - ae_frame_leave(_state); - return result; - } - - /* - * Eigen vectors are stored in Z - */ - if( zneeded==2 ) - { - - /* - * Find eigen pairs - */ - result = evd_internalbisectioneigenvalues(&d1, &e1, n, 2, 2, a, b, 0, 0, -1, &w, m, &nsplit, &iblock, &isplit, &errorcode, _state); - if( !result||*m==0 ) - { - *m = 0; - ae_frame_leave(_state); - return result; - } - evd_internaldstein(n, &d1, &e1, *m, &w, &iblock, &isplit, &z2, &ifail, &cr, _state); - if( cr!=0 ) - { - *m = 0; - result = ae_false; - ae_frame_leave(_state); - return result; - } - - /* - * Sort eigen values and vectors - */ - for(i=1; i<=*m; i++) - { - k = i; - for(j=i; j<=*m; j++) - { - if( ae_fp_less(w.ptr.p_double[j],w.ptr.p_double[k]) ) - { - k = j; - } - } - v = w.ptr.p_double[i]; - w.ptr.p_double[i] = w.ptr.p_double[k]; - w.ptr.p_double[k] = v; - for(j=1; j<=n; j++) - { - v = z2.ptr.pp_double[j][i]; - z2.ptr.pp_double[j][i] = z2.ptr.pp_double[j][k]; - z2.ptr.pp_double[j][k] = v; - } - } - - /* - * Store W - */ - ae_vector_set_length(d, *m-1+1, _state); - for(i=1; i<=*m; i++) - { - d->ptr.p_double[i-1] = w.ptr.p_double[i]; - } - ae_matrix_set_length(z, n-1+1, *m-1+1, _state); - for(i=1; i<=*m; i++) - { - ae_v_move(&z->ptr.pp_double[0][i-1], z->stride, &z2.ptr.pp_double[1][i], z2.stride, ae_v_len(0,n-1)); - } - ae_frame_leave(_state); - return result; - } - result = ae_false; - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Subroutine for finding tridiagonal matrix eigenvalues/vectors with given -indexes (in ascending order) by using the bisection and inverse iteraion. - -Input parameters: - D - the main diagonal of a tridiagonal matrix. - Array whose index ranges within [0..N-1]. - E - the secondary diagonal of a tridiagonal matrix. - Array whose index ranges within [0..N-2]. - N - size of matrix. N>=0. - ZNeeded - flag controlling whether the eigenvectors are needed or not. - If ZNeeded is equal to: - * 0, the eigenvectors are not needed; - * 1, the eigenvectors of a tridiagonal matrix are multiplied - by the square matrix Z. It is used if the - tridiagonal matrix is obtained by the similarity transformation - of a symmetric matrix. - * 2, the eigenvectors of a tridiagonal matrix replace - matrix Z. - I1, I2 - index interval for searching (from I1 to I2). - 0 <= I1 <= I2 <= N-1. - Z - if ZNeeded is equal to: - * 0, Z isn't used and remains unchanged; - * 1, Z contains the square matrix (array whose indexes range within [0..N-1, 0..N-1]) - which reduces the given symmetric matrix to tridiagonal form; - * 2, Z isn't used (but changed on the exit). - -Output parameters: - D - array of the eigenvalues found. - Array whose index ranges within [0..I2-I1]. - Z - if ZNeeded is equal to: - * 0, doesn't contain any information; - * 1, contains the product of a given NxN matrix Z (from the left) and - Nx(I2-I1) matrix of the eigenvectors found (from the right). - Array whose indexes range within [0..N-1, 0..I2-I1]. - * 2, contains the matrix of the eigenvalues found. - Array whose indexes range within [0..N-1, 0..I2-I1]. - - -Result: - - True, if successful. In that case, D contains the eigenvalues, - Z contains the eigenvectors (if needed). - It should be noted that the subroutine changes the size of arrays D and Z. - - False, if the bisection method subroutine wasn't able to find the eigenvalues - in the given interval or if the inverse iteration subroutine wasn't able - to find all the corresponding eigenvectors. In that case, the eigenvalues - and eigenvectors are not returned. - - -- ALGLIB -- - Copyright 25.12.2005 by Bochkanov Sergey -*************************************************************************/ -ae_bool smatrixtdevdi(/* Real */ ae_vector* d, - /* Real */ ae_vector* e, - ae_int_t n, - ae_int_t zneeded, - ae_int_t i1, - ae_int_t i2, - /* Real */ ae_matrix* z, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t errorcode; - ae_int_t nsplit; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t m; - ae_int_t cr; - ae_vector iblock; - ae_vector isplit; - ae_vector ifail; - ae_vector w; - ae_vector d1; - ae_vector e1; - ae_matrix z2; - ae_matrix z3; - double v; - ae_bool result; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&iblock, 0, DT_INT, _state, ae_true); - ae_vector_init(&isplit, 0, DT_INT, _state, ae_true); - ae_vector_init(&ifail, 0, DT_INT, _state, ae_true); - ae_vector_init(&w, 0, DT_REAL, _state, ae_true); - ae_vector_init(&d1, 0, DT_REAL, _state, ae_true); - ae_vector_init(&e1, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&z2, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&z3, 0, 0, DT_REAL, _state, ae_true); - - ae_assert((0<=i1&&i1<=i2)&&i2ptr.p_double[0], 1, ae_v_len(1,n)); - if( n>1 ) - { - ae_vector_set_length(&e1, n-1+1, _state); - ae_v_move(&e1.ptr.p_double[1], 1, &e->ptr.p_double[0], 1, ae_v_len(1,n-1)); - } - - /* - * No eigen vectors - */ - if( zneeded==0 ) - { - result = evd_internalbisectioneigenvalues(&d1, &e1, n, 3, 1, 0, 0, i1+1, i2+1, -1, &w, &m, &nsplit, &iblock, &isplit, &errorcode, _state); - if( !result ) - { - ae_frame_leave(_state); - return result; - } - if( m!=i2-i1+1 ) - { - result = ae_false; - ae_frame_leave(_state); - return result; - } - ae_vector_set_length(d, m-1+1, _state); - for(i=1; i<=m; i++) - { - d->ptr.p_double[i-1] = w.ptr.p_double[i]; - } - ae_frame_leave(_state); - return result; - } - - /* - * Eigen vectors are multiplied by Z - */ - if( zneeded==1 ) - { - - /* - * Find eigen pairs - */ - result = evd_internalbisectioneigenvalues(&d1, &e1, n, 3, 2, 0, 0, i1+1, i2+1, -1, &w, &m, &nsplit, &iblock, &isplit, &errorcode, _state); - if( !result ) - { - ae_frame_leave(_state); - return result; - } - if( m!=i2-i1+1 ) - { - result = ae_false; - ae_frame_leave(_state); - return result; - } - evd_internaldstein(n, &d1, &e1, m, &w, &iblock, &isplit, &z2, &ifail, &cr, _state); - if( cr!=0 ) - { - result = ae_false; - ae_frame_leave(_state); - return result; - } - - /* - * Sort eigen values and vectors - */ - for(i=1; i<=m; i++) - { - k = i; - for(j=i; j<=m; j++) - { - if( ae_fp_less(w.ptr.p_double[j],w.ptr.p_double[k]) ) - { - k = j; - } - } - v = w.ptr.p_double[i]; - w.ptr.p_double[i] = w.ptr.p_double[k]; - w.ptr.p_double[k] = v; - for(j=1; j<=n; j++) - { - v = z2.ptr.pp_double[j][i]; - z2.ptr.pp_double[j][i] = z2.ptr.pp_double[j][k]; - z2.ptr.pp_double[j][k] = v; - } - } - - /* - * Transform Z2 and overwrite Z - */ - ae_matrix_set_length(&z3, m+1, n+1, _state); - for(i=1; i<=m; i++) - { - ae_v_move(&z3.ptr.pp_double[i][1], 1, &z2.ptr.pp_double[1][i], z2.stride, ae_v_len(1,n)); - } - for(i=1; i<=n; i++) - { - for(j=1; j<=m; j++) - { - v = ae_v_dotproduct(&z->ptr.pp_double[i-1][0], 1, &z3.ptr.pp_double[j][1], 1, ae_v_len(0,n-1)); - z2.ptr.pp_double[i][j] = v; - } - } - ae_matrix_set_length(z, n-1+1, m-1+1, _state); - for(i=1; i<=m; i++) - { - ae_v_move(&z->ptr.pp_double[0][i-1], z->stride, &z2.ptr.pp_double[1][i], z2.stride, ae_v_len(0,n-1)); - } - - /* - * Store W - */ - ae_vector_set_length(d, m-1+1, _state); - for(i=1; i<=m; i++) - { - d->ptr.p_double[i-1] = w.ptr.p_double[i]; - } - ae_frame_leave(_state); - return result; - } - - /* - * Eigen vectors are stored in Z - */ - if( zneeded==2 ) - { - - /* - * Find eigen pairs - */ - result = evd_internalbisectioneigenvalues(&d1, &e1, n, 3, 2, 0, 0, i1+1, i2+1, -1, &w, &m, &nsplit, &iblock, &isplit, &errorcode, _state); - if( !result ) - { - ae_frame_leave(_state); - return result; - } - if( m!=i2-i1+1 ) - { - result = ae_false; - ae_frame_leave(_state); - return result; - } - evd_internaldstein(n, &d1, &e1, m, &w, &iblock, &isplit, &z2, &ifail, &cr, _state); - if( cr!=0 ) - { - result = ae_false; - ae_frame_leave(_state); - return result; - } - - /* - * Sort eigen values and vectors - */ - for(i=1; i<=m; i++) - { - k = i; - for(j=i; j<=m; j++) - { - if( ae_fp_less(w.ptr.p_double[j],w.ptr.p_double[k]) ) - { - k = j; - } - } - v = w.ptr.p_double[i]; - w.ptr.p_double[i] = w.ptr.p_double[k]; - w.ptr.p_double[k] = v; - for(j=1; j<=n; j++) - { - v = z2.ptr.pp_double[j][i]; - z2.ptr.pp_double[j][i] = z2.ptr.pp_double[j][k]; - z2.ptr.pp_double[j][k] = v; - } - } - - /* - * Store Z - */ - ae_matrix_set_length(z, n-1+1, m-1+1, _state); - for(i=1; i<=m; i++) - { - ae_v_move(&z->ptr.pp_double[0][i-1], z->stride, &z2.ptr.pp_double[1][i], z2.stride, ae_v_len(0,n-1)); - } - - /* - * Store W - */ - ae_vector_set_length(d, m-1+1, _state); - for(i=1; i<=m; i++) - { - d->ptr.p_double[i-1] = w.ptr.p_double[i]; - } - ae_frame_leave(_state); - return result; - } - result = ae_false; - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Finding eigenvalues and eigenvectors of a general matrix - -The algorithm finds eigenvalues and eigenvectors of a general matrix by -using the QR algorithm with multiple shifts. The algorithm can find -eigenvalues and both left and right eigenvectors. - -The right eigenvector is a vector x such that A*x = w*x, and the left -eigenvector is a vector y such that y'*A = w*y' (here y' implies a complex -conjugate transposition of vector y). - -Input parameters: - A - matrix. Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - VNeeded - flag controlling whether eigenvectors are needed or not. - If VNeeded is equal to: - * 0, eigenvectors are not returned; - * 1, right eigenvectors are returned; - * 2, left eigenvectors are returned; - * 3, both left and right eigenvectors are returned. - -Output parameters: - WR - real parts of eigenvalues. - Array whose index ranges within [0..N-1]. - WR - imaginary parts of eigenvalues. - Array whose index ranges within [0..N-1]. - VL, VR - arrays of left and right eigenvectors (if they are needed). - If WI[i]=0, the respective eigenvalue is a real number, - and it corresponds to the column number I of matrices VL/VR. - If WI[i]>0, we have a pair of complex conjugate numbers with - positive and negative imaginary parts: - the first eigenvalue WR[i] + sqrt(-1)*WI[i]; - the second eigenvalue WR[i+1] + sqrt(-1)*WI[i+1]; - WI[i]>0 - WI[i+1] = -WI[i] < 0 - In that case, the eigenvector corresponding to the first - eigenvalue is located in i and i+1 columns of matrices - VL/VR (the column number i contains the real part, and the - column number i+1 contains the imaginary part), and the vector - corresponding to the second eigenvalue is a complex conjugate to - the first vector. - Arrays whose indexes range within [0..N-1, 0..N-1]. - -Result: - True, if the algorithm has converged. - False, if the algorithm has not converged. - -Note 1: - Some users may ask the following question: what if WI[N-1]>0? - WI[N] must contain an eigenvalue which is complex conjugate to the - N-th eigenvalue, but the array has only size N? - The answer is as follows: such a situation cannot occur because the - algorithm finds a pairs of eigenvalues, therefore, if WI[i]>0, I is - strictly less than N-1. - -Note 2: - The algorithm performance depends on the value of the internal parameter - NS of the InternalSchurDecomposition subroutine which defines the number - of shifts in the QR algorithm (similarly to the block width in block-matrix - algorithms of linear algebra). If you require maximum performance - on your machine, it is recommended to adjust this parameter manually. - - -See also the InternalTREVC subroutine. - -The algorithm is based on the LAPACK 3.0 library. -*************************************************************************/ -ae_bool rmatrixevd(/* Real */ ae_matrix* a, - ae_int_t n, - ae_int_t vneeded, - /* Real */ ae_vector* wr, - /* Real */ ae_vector* wi, - /* Real */ ae_matrix* vl, - /* Real */ ae_matrix* vr, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix _a; - ae_matrix a1; - ae_matrix vl1; - ae_matrix vr1; - ae_vector wr1; - ae_vector wi1; - ae_int_t i; - ae_bool result; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init_copy(&_a, a, _state, ae_true); - a = &_a; - ae_vector_clear(wr); - ae_vector_clear(wi); - ae_matrix_clear(vl); - ae_matrix_clear(vr); - ae_matrix_init(&a1, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&vl1, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&vr1, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&wr1, 0, DT_REAL, _state, ae_true); - ae_vector_init(&wi1, 0, DT_REAL, _state, ae_true); - - ae_assert(vneeded>=0&&vneeded<=3, "RMatrixEVD: incorrect VNeeded!", _state); - ae_matrix_set_length(&a1, n+1, n+1, _state); - for(i=1; i<=n; i++) - { - ae_v_move(&a1.ptr.pp_double[i][1], 1, &a->ptr.pp_double[i-1][0], 1, ae_v_len(1,n)); - } - result = evd_nonsymmetricevd(&a1, n, vneeded, &wr1, &wi1, &vl1, &vr1, _state); - if( result ) - { - ae_vector_set_length(wr, n-1+1, _state); - ae_vector_set_length(wi, n-1+1, _state); - ae_v_move(&wr->ptr.p_double[0], 1, &wr1.ptr.p_double[1], 1, ae_v_len(0,n-1)); - ae_v_move(&wi->ptr.p_double[0], 1, &wi1.ptr.p_double[1], 1, ae_v_len(0,n-1)); - if( vneeded==2||vneeded==3 ) - { - ae_matrix_set_length(vl, n-1+1, n-1+1, _state); - for(i=0; i<=n-1; i++) - { - ae_v_move(&vl->ptr.pp_double[i][0], 1, &vl1.ptr.pp_double[i+1][1], 1, ae_v_len(0,n-1)); - } - } - if( vneeded==1||vneeded==3 ) - { - ae_matrix_set_length(vr, n-1+1, n-1+1, _state); - for(i=0; i<=n-1; i++) - { - ae_v_move(&vr->ptr.pp_double[i][0], 1, &vr1.ptr.pp_double[i+1][1], 1, ae_v_len(0,n-1)); - } - } - } - ae_frame_leave(_state); - return result; -} - - -static ae_bool evd_tridiagonalevd(/* Real */ ae_vector* d, - /* Real */ ae_vector* e, - ae_int_t n, - ae_int_t zneeded, - /* Real */ ae_matrix* z, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _e; - ae_int_t maxit; - ae_int_t i; - ae_int_t ii; - ae_int_t iscale; - ae_int_t j; - ae_int_t jtot; - ae_int_t k; - ae_int_t t; - ae_int_t l; - ae_int_t l1; - ae_int_t lend; - ae_int_t lendm1; - ae_int_t lendp1; - ae_int_t lendsv; - ae_int_t lm1; - ae_int_t lsv; - ae_int_t m; - ae_int_t mm1; - ae_int_t nm1; - ae_int_t nmaxit; - ae_int_t tmpint; - double anorm; - double b; - double c; - double eps; - double eps2; - double f; - double g; - double p; - double r; - double rt1; - double rt2; - double s; - double safmax; - double safmin; - double ssfmax; - double ssfmin; - double tst; - double tmp; - ae_vector work1; - ae_vector work2; - ae_vector workc; - ae_vector works; - ae_vector wtemp; - ae_bool gotoflag; - ae_int_t zrows; - ae_bool wastranspose; - ae_bool result; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_e, e, _state, ae_true); - e = &_e; - ae_vector_init(&work1, 0, DT_REAL, _state, ae_true); - ae_vector_init(&work2, 0, DT_REAL, _state, ae_true); - ae_vector_init(&workc, 0, DT_REAL, _state, ae_true); - ae_vector_init(&works, 0, DT_REAL, _state, ae_true); - ae_vector_init(&wtemp, 0, DT_REAL, _state, ae_true); - - ae_assert(zneeded>=0&&zneeded<=3, "TridiagonalEVD: Incorrent ZNeeded", _state); - - /* - * Quick return if possible - */ - if( zneeded<0||zneeded>3 ) - { - result = ae_false; - ae_frame_leave(_state); - return result; - } - result = ae_true; - if( n==0 ) - { - ae_frame_leave(_state); - return result; - } - if( n==1 ) - { - if( zneeded==2||zneeded==3 ) - { - ae_matrix_set_length(z, 1+1, 1+1, _state); - z->ptr.pp_double[1][1] = 1; - } - ae_frame_leave(_state); - return result; - } - maxit = 30; - - /* - * Initialize arrays - */ - ae_vector_set_length(&wtemp, n+1, _state); - ae_vector_set_length(&work1, n-1+1, _state); - ae_vector_set_length(&work2, n-1+1, _state); - ae_vector_set_length(&workc, n+1, _state); - ae_vector_set_length(&works, n+1, _state); - - /* - * Determine the unit roundoff and over/underflow thresholds. - */ - eps = ae_machineepsilon; - eps2 = ae_sqr(eps, _state); - safmin = ae_minrealnumber; - safmax = ae_maxrealnumber; - ssfmax = ae_sqrt(safmax, _state)/3; - ssfmin = ae_sqrt(safmin, _state)/eps2; - - /* - * Prepare Z - * - * Here we are using transposition to get rid of column operations - * - */ - wastranspose = ae_false; - zrows = 0; - if( zneeded==1 ) - { - zrows = n; - } - if( zneeded==2 ) - { - zrows = n; - } - if( zneeded==3 ) - { - zrows = 1; - } - if( zneeded==1 ) - { - wastranspose = ae_true; - inplacetranspose(z, 1, n, 1, n, &wtemp, _state); - } - if( zneeded==2 ) - { - wastranspose = ae_true; - ae_matrix_set_length(z, n+1, n+1, _state); - for(i=1; i<=n; i++) - { - for(j=1; j<=n; j++) - { - if( i==j ) - { - z->ptr.pp_double[i][j] = 1; - } - else - { - z->ptr.pp_double[i][j] = 0; - } - } - } - } - if( zneeded==3 ) - { - wastranspose = ae_false; - ae_matrix_set_length(z, 1+1, n+1, _state); - for(j=1; j<=n; j++) - { - if( j==1 ) - { - z->ptr.pp_double[1][j] = 1; - } - else - { - z->ptr.pp_double[1][j] = 0; - } - } - } - nmaxit = n*maxit; - jtot = 0; - - /* - * Determine where the matrix splits and choose QL or QR iteration - * for each block, according to whether top or bottom diagonal - * element is smaller. - */ - l1 = 1; - nm1 = n-1; - for(;;) - { - if( l1>n ) - { - break; - } - if( l1>1 ) - { - e->ptr.p_double[l1-1] = 0; - } - gotoflag = ae_false; - m = l1; - if( l1<=nm1 ) - { - for(m=l1; m<=nm1; m++) - { - tst = ae_fabs(e->ptr.p_double[m], _state); - if( ae_fp_eq(tst,0) ) - { - gotoflag = ae_true; - break; - } - if( ae_fp_less_eq(tst,ae_sqrt(ae_fabs(d->ptr.p_double[m], _state), _state)*ae_sqrt(ae_fabs(d->ptr.p_double[m+1], _state), _state)*eps) ) - { - e->ptr.p_double[m] = 0; - gotoflag = ae_true; - break; - } - } - } - if( !gotoflag ) - { - m = n; - } - - /* - * label 30: - */ - l = l1; - lsv = l; - lend = m; - lendsv = lend; - l1 = m+1; - if( lend==l ) - { - continue; - } - - /* - * Scale submatrix in rows and columns L to LEND - */ - if( l==lend ) - { - anorm = ae_fabs(d->ptr.p_double[l], _state); - } - else - { - anorm = ae_maxreal(ae_fabs(d->ptr.p_double[l], _state)+ae_fabs(e->ptr.p_double[l], _state), ae_fabs(e->ptr.p_double[lend-1], _state)+ae_fabs(d->ptr.p_double[lend], _state), _state); - for(i=l+1; i<=lend-1; i++) - { - anorm = ae_maxreal(anorm, ae_fabs(d->ptr.p_double[i], _state)+ae_fabs(e->ptr.p_double[i], _state)+ae_fabs(e->ptr.p_double[i-1], _state), _state); - } - } - iscale = 0; - if( ae_fp_eq(anorm,0) ) - { - continue; - } - if( ae_fp_greater(anorm,ssfmax) ) - { - iscale = 1; - tmp = ssfmax/anorm; - tmpint = lend-1; - ae_v_muld(&d->ptr.p_double[l], 1, ae_v_len(l,lend), tmp); - ae_v_muld(&e->ptr.p_double[l], 1, ae_v_len(l,tmpint), tmp); - } - if( ae_fp_less(anorm,ssfmin) ) - { - iscale = 2; - tmp = ssfmin/anorm; - tmpint = lend-1; - ae_v_muld(&d->ptr.p_double[l], 1, ae_v_len(l,lend), tmp); - ae_v_muld(&e->ptr.p_double[l], 1, ae_v_len(l,tmpint), tmp); - } - - /* - * Choose between QL and QR iteration - */ - if( ae_fp_less(ae_fabs(d->ptr.p_double[lend], _state),ae_fabs(d->ptr.p_double[l], _state)) ) - { - lend = lsv; - l = lendsv; - } - if( lend>l ) - { - - /* - * QL Iteration - * - * Look for small subdiagonal element. - */ - for(;;) - { - gotoflag = ae_false; - if( l!=lend ) - { - lendm1 = lend-1; - for(m=l; m<=lendm1; m++) - { - tst = ae_sqr(ae_fabs(e->ptr.p_double[m], _state), _state); - if( ae_fp_less_eq(tst,eps2*ae_fabs(d->ptr.p_double[m], _state)*ae_fabs(d->ptr.p_double[m+1], _state)+safmin) ) - { - gotoflag = ae_true; - break; - } - } - } - if( !gotoflag ) - { - m = lend; - } - if( mptr.p_double[m] = 0; - } - p = d->ptr.p_double[l]; - if( m!=l ) - { - - /* - * If remaining matrix is 2-by-2, use DLAE2 or SLAEV2 - * to compute its eigensystem. - */ - if( m==l+1 ) - { - if( zneeded>0 ) - { - evd_tdevdev2(d->ptr.p_double[l], e->ptr.p_double[l], d->ptr.p_double[l+1], &rt1, &rt2, &c, &s, _state); - work1.ptr.p_double[l] = c; - work2.ptr.p_double[l] = s; - workc.ptr.p_double[1] = work1.ptr.p_double[l]; - works.ptr.p_double[1] = work2.ptr.p_double[l]; - if( !wastranspose ) - { - applyrotationsfromtheright(ae_false, 1, zrows, l, l+1, &workc, &works, z, &wtemp, _state); - } - else - { - applyrotationsfromtheleft(ae_false, l, l+1, 1, zrows, &workc, &works, z, &wtemp, _state); - } - } - else - { - evd_tdevde2(d->ptr.p_double[l], e->ptr.p_double[l], d->ptr.p_double[l+1], &rt1, &rt2, _state); - } - d->ptr.p_double[l] = rt1; - d->ptr.p_double[l+1] = rt2; - e->ptr.p_double[l] = 0; - l = l+2; - if( l<=lend ) - { - continue; - } - - /* - * GOTO 140 - */ - break; - } - if( jtot==nmaxit ) - { - - /* - * GOTO 140 - */ - break; - } - jtot = jtot+1; - - /* - * Form shift. - */ - g = (d->ptr.p_double[l+1]-p)/(2*e->ptr.p_double[l]); - r = evd_tdevdpythag(g, 1, _state); - g = d->ptr.p_double[m]-p+e->ptr.p_double[l]/(g+evd_tdevdextsign(r, g, _state)); - s = 1; - c = 1; - p = 0; - - /* - * Inner loop - */ - mm1 = m-1; - for(i=mm1; i>=l; i--) - { - f = s*e->ptr.p_double[i]; - b = c*e->ptr.p_double[i]; - generaterotation(g, f, &c, &s, &r, _state); - if( i!=m-1 ) - { - e->ptr.p_double[i+1] = r; - } - g = d->ptr.p_double[i+1]-p; - r = (d->ptr.p_double[i]-g)*s+2*c*b; - p = s*r; - d->ptr.p_double[i+1] = g+p; - g = c*r-b; - - /* - * If eigenvectors are desired, then save rotations. - */ - if( zneeded>0 ) - { - work1.ptr.p_double[i] = c; - work2.ptr.p_double[i] = -s; - } - } - - /* - * If eigenvectors are desired, then apply saved rotations. - */ - if( zneeded>0 ) - { - for(i=l; i<=m-1; i++) - { - workc.ptr.p_double[i-l+1] = work1.ptr.p_double[i]; - works.ptr.p_double[i-l+1] = work2.ptr.p_double[i]; - } - if( !wastranspose ) - { - applyrotationsfromtheright(ae_false, 1, zrows, l, m, &workc, &works, z, &wtemp, _state); - } - else - { - applyrotationsfromtheleft(ae_false, l, m, 1, zrows, &workc, &works, z, &wtemp, _state); - } - } - d->ptr.p_double[l] = d->ptr.p_double[l]-p; - e->ptr.p_double[l] = g; - continue; - } - - /* - * Eigenvalue found. - */ - d->ptr.p_double[l] = p; - l = l+1; - if( l<=lend ) - { - continue; - } - break; - } - } - else - { - - /* - * QR Iteration - * - * Look for small superdiagonal element. - */ - for(;;) - { - gotoflag = ae_false; - if( l!=lend ) - { - lendp1 = lend+1; - for(m=l; m>=lendp1; m--) - { - tst = ae_sqr(ae_fabs(e->ptr.p_double[m-1], _state), _state); - if( ae_fp_less_eq(tst,eps2*ae_fabs(d->ptr.p_double[m], _state)*ae_fabs(d->ptr.p_double[m-1], _state)+safmin) ) - { - gotoflag = ae_true; - break; - } - } - } - if( !gotoflag ) - { - m = lend; - } - if( m>lend ) - { - e->ptr.p_double[m-1] = 0; - } - p = d->ptr.p_double[l]; - if( m!=l ) - { - - /* - * If remaining matrix is 2-by-2, use DLAE2 or SLAEV2 - * to compute its eigensystem. - */ - if( m==l-1 ) - { - if( zneeded>0 ) - { - evd_tdevdev2(d->ptr.p_double[l-1], e->ptr.p_double[l-1], d->ptr.p_double[l], &rt1, &rt2, &c, &s, _state); - work1.ptr.p_double[m] = c; - work2.ptr.p_double[m] = s; - workc.ptr.p_double[1] = c; - works.ptr.p_double[1] = s; - if( !wastranspose ) - { - applyrotationsfromtheright(ae_true, 1, zrows, l-1, l, &workc, &works, z, &wtemp, _state); - } - else - { - applyrotationsfromtheleft(ae_true, l-1, l, 1, zrows, &workc, &works, z, &wtemp, _state); - } - } - else - { - evd_tdevde2(d->ptr.p_double[l-1], e->ptr.p_double[l-1], d->ptr.p_double[l], &rt1, &rt2, _state); - } - d->ptr.p_double[l-1] = rt1; - d->ptr.p_double[l] = rt2; - e->ptr.p_double[l-1] = 0; - l = l-2; - if( l>=lend ) - { - continue; - } - break; - } - if( jtot==nmaxit ) - { - break; - } - jtot = jtot+1; - - /* - * Form shift. - */ - g = (d->ptr.p_double[l-1]-p)/(2*e->ptr.p_double[l-1]); - r = evd_tdevdpythag(g, 1, _state); - g = d->ptr.p_double[m]-p+e->ptr.p_double[l-1]/(g+evd_tdevdextsign(r, g, _state)); - s = 1; - c = 1; - p = 0; - - /* - * Inner loop - */ - lm1 = l-1; - for(i=m; i<=lm1; i++) - { - f = s*e->ptr.p_double[i]; - b = c*e->ptr.p_double[i]; - generaterotation(g, f, &c, &s, &r, _state); - if( i!=m ) - { - e->ptr.p_double[i-1] = r; - } - g = d->ptr.p_double[i]-p; - r = (d->ptr.p_double[i+1]-g)*s+2*c*b; - p = s*r; - d->ptr.p_double[i] = g+p; - g = c*r-b; - - /* - * If eigenvectors are desired, then save rotations. - */ - if( zneeded>0 ) - { - work1.ptr.p_double[i] = c; - work2.ptr.p_double[i] = s; - } - } - - /* - * If eigenvectors are desired, then apply saved rotations. - */ - if( zneeded>0 ) - { - for(i=m; i<=l-1; i++) - { - workc.ptr.p_double[i-m+1] = work1.ptr.p_double[i]; - works.ptr.p_double[i-m+1] = work2.ptr.p_double[i]; - } - if( !wastranspose ) - { - applyrotationsfromtheright(ae_true, 1, zrows, m, l, &workc, &works, z, &wtemp, _state); - } - else - { - applyrotationsfromtheleft(ae_true, m, l, 1, zrows, &workc, &works, z, &wtemp, _state); - } - } - d->ptr.p_double[l] = d->ptr.p_double[l]-p; - e->ptr.p_double[lm1] = g; - continue; - } - - /* - * Eigenvalue found. - */ - d->ptr.p_double[l] = p; - l = l-1; - if( l>=lend ) - { - continue; - } - break; - } - } - - /* - * Undo scaling if necessary - */ - if( iscale==1 ) - { - tmp = anorm/ssfmax; - tmpint = lendsv-1; - ae_v_muld(&d->ptr.p_double[lsv], 1, ae_v_len(lsv,lendsv), tmp); - ae_v_muld(&e->ptr.p_double[lsv], 1, ae_v_len(lsv,tmpint), tmp); - } - if( iscale==2 ) - { - tmp = anorm/ssfmin; - tmpint = lendsv-1; - ae_v_muld(&d->ptr.p_double[lsv], 1, ae_v_len(lsv,lendsv), tmp); - ae_v_muld(&e->ptr.p_double[lsv], 1, ae_v_len(lsv,tmpint), tmp); - } - - /* - * Check for no convergence to an eigenvalue after a total - * of N*MAXIT iterations. - */ - if( jtot>=nmaxit ) - { - result = ae_false; - if( wastranspose ) - { - inplacetranspose(z, 1, n, 1, n, &wtemp, _state); - } - ae_frame_leave(_state); - return result; - } - } - - /* - * Order eigenvalues and eigenvectors. - */ - if( zneeded==0 ) - { - - /* - * Sort - */ - if( n==1 ) - { - ae_frame_leave(_state); - return result; - } - if( n==2 ) - { - if( ae_fp_greater(d->ptr.p_double[1],d->ptr.p_double[2]) ) - { - tmp = d->ptr.p_double[1]; - d->ptr.p_double[1] = d->ptr.p_double[2]; - d->ptr.p_double[2] = tmp; - } - ae_frame_leave(_state); - return result; - } - i = 2; - do - { - t = i; - while(t!=1) - { - k = t/2; - if( ae_fp_greater_eq(d->ptr.p_double[k],d->ptr.p_double[t]) ) - { - t = 1; - } - else - { - tmp = d->ptr.p_double[k]; - d->ptr.p_double[k] = d->ptr.p_double[t]; - d->ptr.p_double[t] = tmp; - t = k; - } - } - i = i+1; - } - while(i<=n); - i = n-1; - do - { - tmp = d->ptr.p_double[i+1]; - d->ptr.p_double[i+1] = d->ptr.p_double[1]; - d->ptr.p_double[1] = tmp; - t = 1; - while(t!=0) - { - k = 2*t; - if( k>i ) - { - t = 0; - } - else - { - if( kptr.p_double[k+1],d->ptr.p_double[k]) ) - { - k = k+1; - } - } - if( ae_fp_greater_eq(d->ptr.p_double[t],d->ptr.p_double[k]) ) - { - t = 0; - } - else - { - tmp = d->ptr.p_double[k]; - d->ptr.p_double[k] = d->ptr.p_double[t]; - d->ptr.p_double[t] = tmp; - t = k; - } - } - } - i = i-1; - } - while(i>=1); - } - else - { - - /* - * Use Selection Sort to minimize swaps of eigenvectors - */ - for(ii=2; ii<=n; ii++) - { - i = ii-1; - k = i; - p = d->ptr.p_double[i]; - for(j=ii; j<=n; j++) - { - if( ae_fp_less(d->ptr.p_double[j],p) ) - { - k = j; - p = d->ptr.p_double[j]; - } - } - if( k!=i ) - { - d->ptr.p_double[k] = d->ptr.p_double[i]; - d->ptr.p_double[i] = p; - if( wastranspose ) - { - ae_v_move(&wtemp.ptr.p_double[1], 1, &z->ptr.pp_double[i][1], 1, ae_v_len(1,n)); - ae_v_move(&z->ptr.pp_double[i][1], 1, &z->ptr.pp_double[k][1], 1, ae_v_len(1,n)); - ae_v_move(&z->ptr.pp_double[k][1], 1, &wtemp.ptr.p_double[1], 1, ae_v_len(1,n)); - } - else - { - ae_v_move(&wtemp.ptr.p_double[1], 1, &z->ptr.pp_double[1][i], z->stride, ae_v_len(1,zrows)); - ae_v_move(&z->ptr.pp_double[1][i], z->stride, &z->ptr.pp_double[1][k], z->stride, ae_v_len(1,zrows)); - ae_v_move(&z->ptr.pp_double[1][k], z->stride, &wtemp.ptr.p_double[1], 1, ae_v_len(1,zrows)); - } - } - } - if( wastranspose ) - { - inplacetranspose(z, 1, n, 1, n, &wtemp, _state); - } - } - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -DLAE2 computes the eigenvalues of a 2-by-2 symmetric matrix - [ A B ] - [ B C ]. -On return, RT1 is the eigenvalue of larger absolute value, and RT2 -is the eigenvalue of smaller absolute value. - - -- LAPACK auxiliary routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - October 31, 1992 -*************************************************************************/ -static void evd_tdevde2(double a, - double b, - double c, - double* rt1, - double* rt2, - ae_state *_state) -{ - double ab; - double acmn; - double acmx; - double adf; - double df; - double rt; - double sm; - double tb; - - *rt1 = 0; - *rt2 = 0; - - sm = a+c; - df = a-c; - adf = ae_fabs(df, _state); - tb = b+b; - ab = ae_fabs(tb, _state); - if( ae_fp_greater(ae_fabs(a, _state),ae_fabs(c, _state)) ) - { - acmx = a; - acmn = c; - } - else - { - acmx = c; - acmn = a; - } - if( ae_fp_greater(adf,ab) ) - { - rt = adf*ae_sqrt(1+ae_sqr(ab/adf, _state), _state); - } - else - { - if( ae_fp_less(adf,ab) ) - { - rt = ab*ae_sqrt(1+ae_sqr(adf/ab, _state), _state); - } - else - { - - /* - * Includes case AB=ADF=0 - */ - rt = ab*ae_sqrt(2, _state); - } - } - if( ae_fp_less(sm,0) ) - { - *rt1 = 0.5*(sm-rt); - - /* - * Order of execution important. - * To get fully accurate smaller eigenvalue, - * next line needs to be executed in higher precision. - */ - *rt2 = acmx/(*rt1)*acmn-b/(*rt1)*b; - } - else - { - if( ae_fp_greater(sm,0) ) - { - *rt1 = 0.5*(sm+rt); - - /* - * Order of execution important. - * To get fully accurate smaller eigenvalue, - * next line needs to be executed in higher precision. - */ - *rt2 = acmx/(*rt1)*acmn-b/(*rt1)*b; - } - else - { - - /* - * Includes case RT1 = RT2 = 0 - */ - *rt1 = 0.5*rt; - *rt2 = -0.5*rt; - } - } -} - - -/************************************************************************* -DLAEV2 computes the eigendecomposition of a 2-by-2 symmetric matrix - - [ A B ] - [ B C ]. - -On return, RT1 is the eigenvalue of larger absolute value, RT2 is the -eigenvalue of smaller absolute value, and (CS1,SN1) is the unit right -eigenvector for RT1, giving the decomposition - - [ CS1 SN1 ] [ A B ] [ CS1 -SN1 ] = [ RT1 0 ] - [-SN1 CS1 ] [ B C ] [ SN1 CS1 ] [ 0 RT2 ]. - - - -- LAPACK auxiliary routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - October 31, 1992 -*************************************************************************/ -static void evd_tdevdev2(double a, - double b, - double c, - double* rt1, - double* rt2, - double* cs1, - double* sn1, - ae_state *_state) -{ - ae_int_t sgn1; - ae_int_t sgn2; - double ab; - double acmn; - double acmx; - double acs; - double adf; - double cs; - double ct; - double df; - double rt; - double sm; - double tb; - double tn; - - *rt1 = 0; - *rt2 = 0; - *cs1 = 0; - *sn1 = 0; - - - /* - * Compute the eigenvalues - */ - sm = a+c; - df = a-c; - adf = ae_fabs(df, _state); - tb = b+b; - ab = ae_fabs(tb, _state); - if( ae_fp_greater(ae_fabs(a, _state),ae_fabs(c, _state)) ) - { - acmx = a; - acmn = c; - } - else - { - acmx = c; - acmn = a; - } - if( ae_fp_greater(adf,ab) ) - { - rt = adf*ae_sqrt(1+ae_sqr(ab/adf, _state), _state); - } - else - { - if( ae_fp_less(adf,ab) ) - { - rt = ab*ae_sqrt(1+ae_sqr(adf/ab, _state), _state); - } - else - { - - /* - * Includes case AB=ADF=0 - */ - rt = ab*ae_sqrt(2, _state); - } - } - if( ae_fp_less(sm,0) ) - { - *rt1 = 0.5*(sm-rt); - sgn1 = -1; - - /* - * Order of execution important. - * To get fully accurate smaller eigenvalue, - * next line needs to be executed in higher precision. - */ - *rt2 = acmx/(*rt1)*acmn-b/(*rt1)*b; - } - else - { - if( ae_fp_greater(sm,0) ) - { - *rt1 = 0.5*(sm+rt); - sgn1 = 1; - - /* - * Order of execution important. - * To get fully accurate smaller eigenvalue, - * next line needs to be executed in higher precision. - */ - *rt2 = acmx/(*rt1)*acmn-b/(*rt1)*b; - } - else - { - - /* - * Includes case RT1 = RT2 = 0 - */ - *rt1 = 0.5*rt; - *rt2 = -0.5*rt; - sgn1 = 1; - } - } - - /* - * Compute the eigenvector - */ - if( ae_fp_greater_eq(df,0) ) - { - cs = df+rt; - sgn2 = 1; - } - else - { - cs = df-rt; - sgn2 = -1; - } - acs = ae_fabs(cs, _state); - if( ae_fp_greater(acs,ab) ) - { - ct = -tb/cs; - *sn1 = 1/ae_sqrt(1+ct*ct, _state); - *cs1 = ct*(*sn1); - } - else - { - if( ae_fp_eq(ab,0) ) - { - *cs1 = 1; - *sn1 = 0; - } - else - { - tn = -cs/tb; - *cs1 = 1/ae_sqrt(1+tn*tn, _state); - *sn1 = tn*(*cs1); - } - } - if( sgn1==sgn2 ) - { - tn = *cs1; - *cs1 = -*sn1; - *sn1 = tn; - } -} - - -/************************************************************************* -Internal routine -*************************************************************************/ -static double evd_tdevdpythag(double a, double b, ae_state *_state) -{ - double result; - - - if( ae_fp_less(ae_fabs(a, _state),ae_fabs(b, _state)) ) - { - result = ae_fabs(b, _state)*ae_sqrt(1+ae_sqr(a/b, _state), _state); - } - else - { - result = ae_fabs(a, _state)*ae_sqrt(1+ae_sqr(b/a, _state), _state); - } - return result; -} - - -/************************************************************************* -Internal routine -*************************************************************************/ -static double evd_tdevdextsign(double a, double b, ae_state *_state) -{ - double result; - - - if( ae_fp_greater_eq(b,0) ) - { - result = ae_fabs(a, _state); - } - else - { - result = -ae_fabs(a, _state); - } - return result; -} - - -static ae_bool evd_internalbisectioneigenvalues(/* Real */ ae_vector* d, - /* Real */ ae_vector* e, - ae_int_t n, - ae_int_t irange, - ae_int_t iorder, - double vl, - double vu, - ae_int_t il, - ae_int_t iu, - double abstol, - /* Real */ ae_vector* w, - ae_int_t* m, - ae_int_t* nsplit, - /* Integer */ ae_vector* iblock, - /* Integer */ ae_vector* isplit, - ae_int_t* errorcode, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _d; - ae_vector _e; - double fudge; - double relfac; - ae_bool ncnvrg; - ae_bool toofew; - ae_int_t ib; - ae_int_t ibegin; - ae_int_t idiscl; - ae_int_t idiscu; - ae_int_t ie; - ae_int_t iend; - ae_int_t iinfo; - ae_int_t im; - ae_int_t iin; - ae_int_t ioff; - ae_int_t iout; - ae_int_t itmax; - ae_int_t iw; - ae_int_t iwoff; - ae_int_t j; - ae_int_t itmp1; - ae_int_t jb; - ae_int_t jdisc; - ae_int_t je; - ae_int_t nwl; - ae_int_t nwu; - double atoli; - double bnorm; - double gl; - double gu; - double pivmin; - double rtoli; - double safemn; - double tmp1; - double tmp2; - double tnorm; - double ulp; - double wkill; - double wl; - double wlu; - double wu; - double wul; - double scalefactor; - double t; - ae_vector idumma; - ae_vector work; - ae_vector iwork; - ae_vector ia1s2; - ae_vector ra1s2; - ae_matrix ra1s2x2; - ae_matrix ia1s2x2; - ae_vector ra1siin; - ae_vector ra2siin; - ae_vector ra3siin; - ae_vector ra4siin; - ae_matrix ra1siinx2; - ae_matrix ia1siinx2; - ae_vector iworkspace; - ae_vector rworkspace; - ae_int_t tmpi; - ae_bool result; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_d, d, _state, ae_true); - d = &_d; - ae_vector_init_copy(&_e, e, _state, ae_true); - e = &_e; - ae_vector_clear(w); - *m = 0; - *nsplit = 0; - ae_vector_clear(iblock); - ae_vector_clear(isplit); - *errorcode = 0; - ae_vector_init(&idumma, 0, DT_INT, _state, ae_true); - ae_vector_init(&work, 0, DT_REAL, _state, ae_true); - ae_vector_init(&iwork, 0, DT_INT, _state, ae_true); - ae_vector_init(&ia1s2, 0, DT_INT, _state, ae_true); - ae_vector_init(&ra1s2, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&ra1s2x2, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&ia1s2x2, 0, 0, DT_INT, _state, ae_true); - ae_vector_init(&ra1siin, 0, DT_REAL, _state, ae_true); - ae_vector_init(&ra2siin, 0, DT_REAL, _state, ae_true); - ae_vector_init(&ra3siin, 0, DT_REAL, _state, ae_true); - ae_vector_init(&ra4siin, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&ra1siinx2, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&ia1siinx2, 0, 0, DT_INT, _state, ae_true); - ae_vector_init(&iworkspace, 0, DT_INT, _state, ae_true); - ae_vector_init(&rworkspace, 0, DT_REAL, _state, ae_true); - - - /* - * Quick return if possible - */ - *m = 0; - if( n==0 ) - { - result = ae_true; - ae_frame_leave(_state); - return result; - } - - /* - * Get machine constants - * NB is the minimum vector length for vector bisection, or 0 - * if only scalar is to be done. - */ - fudge = 2; - relfac = 2; - safemn = ae_minrealnumber; - ulp = 2*ae_machineepsilon; - rtoli = ulp*relfac; - ae_vector_set_length(&idumma, 1+1, _state); - ae_vector_set_length(&work, 4*n+1, _state); - ae_vector_set_length(&iwork, 3*n+1, _state); - ae_vector_set_length(w, n+1, _state); - ae_vector_set_length(iblock, n+1, _state); - ae_vector_set_length(isplit, n+1, _state); - ae_vector_set_length(&ia1s2, 2+1, _state); - ae_vector_set_length(&ra1s2, 2+1, _state); - ae_matrix_set_length(&ra1s2x2, 2+1, 2+1, _state); - ae_matrix_set_length(&ia1s2x2, 2+1, 2+1, _state); - ae_vector_set_length(&ra1siin, n+1, _state); - ae_vector_set_length(&ra2siin, n+1, _state); - ae_vector_set_length(&ra3siin, n+1, _state); - ae_vector_set_length(&ra4siin, n+1, _state); - ae_matrix_set_length(&ra1siinx2, n+1, 2+1, _state); - ae_matrix_set_length(&ia1siinx2, n+1, 2+1, _state); - ae_vector_set_length(&iworkspace, n+1, _state); - ae_vector_set_length(&rworkspace, n+1, _state); - - /* - * these initializers are not really necessary, - * but without them compiler complains about uninitialized locals - */ - wlu = 0; - wul = 0; - - /* - * Check for Errors - */ - result = ae_false; - *errorcode = 0; - if( irange<=0||irange>=4 ) - { - *errorcode = -4; - } - if( iorder<=0||iorder>=3 ) - { - *errorcode = -5; - } - if( n<0 ) - { - *errorcode = -3; - } - if( irange==2&&ae_fp_greater_eq(vl,vu) ) - { - *errorcode = -6; - } - if( irange==3&&(il<1||il>ae_maxint(1, n, _state)) ) - { - *errorcode = -8; - } - if( irange==3&&(iun) ) - { - *errorcode = -9; - } - if( *errorcode!=0 ) - { - ae_frame_leave(_state); - return result; - } - - /* - * Initialize error flags - */ - ncnvrg = ae_false; - toofew = ae_false; - - /* - * Simplifications: - */ - if( (irange==3&&il==1)&&iu==n ) - { - irange = 1; - } - - /* - * Special Case when N=1 - */ - if( n==1 ) - { - *nsplit = 1; - isplit->ptr.p_int[1] = 1; - if( irange==2&&(ae_fp_greater_eq(vl,d->ptr.p_double[1])||ae_fp_less(vu,d->ptr.p_double[1])) ) - { - *m = 0; - } - else - { - w->ptr.p_double[1] = d->ptr.p_double[1]; - iblock->ptr.p_int[1] = 1; - *m = 1; - } - result = ae_true; - ae_frame_leave(_state); - return result; - } - - /* - * Scaling - */ - t = ae_fabs(d->ptr.p_double[n], _state); - for(j=1; j<=n-1; j++) - { - t = ae_maxreal(t, ae_fabs(d->ptr.p_double[j], _state), _state); - t = ae_maxreal(t, ae_fabs(e->ptr.p_double[j], _state), _state); - } - scalefactor = 1; - if( ae_fp_neq(t,0) ) - { - if( ae_fp_greater(t,ae_sqrt(ae_sqrt(ae_minrealnumber, _state), _state)*ae_sqrt(ae_maxrealnumber, _state)) ) - { - scalefactor = t; - } - if( ae_fp_less(t,ae_sqrt(ae_sqrt(ae_maxrealnumber, _state), _state)*ae_sqrt(ae_minrealnumber, _state)) ) - { - scalefactor = t; - } - for(j=1; j<=n-1; j++) - { - d->ptr.p_double[j] = d->ptr.p_double[j]/scalefactor; - e->ptr.p_double[j] = e->ptr.p_double[j]/scalefactor; - } - d->ptr.p_double[n] = d->ptr.p_double[n]/scalefactor; - } - - /* - * Compute Splitting Points - */ - *nsplit = 1; - work.ptr.p_double[n] = 0; - pivmin = 1; - for(j=2; j<=n; j++) - { - tmp1 = ae_sqr(e->ptr.p_double[j-1], _state); - if( ae_fp_greater(ae_fabs(d->ptr.p_double[j]*d->ptr.p_double[j-1], _state)*ae_sqr(ulp, _state)+safemn,tmp1) ) - { - isplit->ptr.p_int[*nsplit] = j-1; - *nsplit = *nsplit+1; - work.ptr.p_double[j-1] = 0; - } - else - { - work.ptr.p_double[j-1] = tmp1; - pivmin = ae_maxreal(pivmin, tmp1, _state); - } - } - isplit->ptr.p_int[*nsplit] = n; - pivmin = pivmin*safemn; - - /* - * Compute Interval and ATOLI - */ - if( irange==3 ) - { - - /* - * RANGE='I': Compute the interval containing eigenvalues - * IL through IU. - * - * Compute Gershgorin interval for entire (split) matrix - * and use it as the initial interval - */ - gu = d->ptr.p_double[1]; - gl = d->ptr.p_double[1]; - tmp1 = 0; - for(j=1; j<=n-1; j++) - { - tmp2 = ae_sqrt(work.ptr.p_double[j], _state); - gu = ae_maxreal(gu, d->ptr.p_double[j]+tmp1+tmp2, _state); - gl = ae_minreal(gl, d->ptr.p_double[j]-tmp1-tmp2, _state); - tmp1 = tmp2; - } - gu = ae_maxreal(gu, d->ptr.p_double[n]+tmp1, _state); - gl = ae_minreal(gl, d->ptr.p_double[n]-tmp1, _state); - tnorm = ae_maxreal(ae_fabs(gl, _state), ae_fabs(gu, _state), _state); - gl = gl-fudge*tnorm*ulp*n-fudge*2*pivmin; - gu = gu+fudge*tnorm*ulp*n+fudge*pivmin; - - /* - * Compute Iteration parameters - */ - itmax = ae_iceil((ae_log(tnorm+pivmin, _state)-ae_log(pivmin, _state))/ae_log(2, _state), _state)+2; - if( ae_fp_less_eq(abstol,0) ) - { - atoli = ulp*tnorm; - } - else - { - atoli = abstol; - } - work.ptr.p_double[n+1] = gl; - work.ptr.p_double[n+2] = gl; - work.ptr.p_double[n+3] = gu; - work.ptr.p_double[n+4] = gu; - work.ptr.p_double[n+5] = gl; - work.ptr.p_double[n+6] = gu; - iwork.ptr.p_int[1] = -1; - iwork.ptr.p_int[2] = -1; - iwork.ptr.p_int[3] = n+1; - iwork.ptr.p_int[4] = n+1; - iwork.ptr.p_int[5] = il-1; - iwork.ptr.p_int[6] = iu; - - /* - * Calling DLAEBZ - * - * DLAEBZ( 3, ITMAX, N, 2, 2, NB, ATOLI, RTOLI, PIVMIN, D, E, - * WORK, IWORK( 5 ), WORK( N+1 ), WORK( N+5 ), IOUT, - * IWORK, W, IBLOCK, IINFO ) - */ - ia1s2.ptr.p_int[1] = iwork.ptr.p_int[5]; - ia1s2.ptr.p_int[2] = iwork.ptr.p_int[6]; - ra1s2.ptr.p_double[1] = work.ptr.p_double[n+5]; - ra1s2.ptr.p_double[2] = work.ptr.p_double[n+6]; - ra1s2x2.ptr.pp_double[1][1] = work.ptr.p_double[n+1]; - ra1s2x2.ptr.pp_double[2][1] = work.ptr.p_double[n+2]; - ra1s2x2.ptr.pp_double[1][2] = work.ptr.p_double[n+3]; - ra1s2x2.ptr.pp_double[2][2] = work.ptr.p_double[n+4]; - ia1s2x2.ptr.pp_int[1][1] = iwork.ptr.p_int[1]; - ia1s2x2.ptr.pp_int[2][1] = iwork.ptr.p_int[2]; - ia1s2x2.ptr.pp_int[1][2] = iwork.ptr.p_int[3]; - ia1s2x2.ptr.pp_int[2][2] = iwork.ptr.p_int[4]; - evd_internaldlaebz(3, itmax, n, 2, 2, atoli, rtoli, pivmin, d, e, &work, &ia1s2, &ra1s2x2, &ra1s2, &iout, &ia1s2x2, w, iblock, &iinfo, _state); - iwork.ptr.p_int[5] = ia1s2.ptr.p_int[1]; - iwork.ptr.p_int[6] = ia1s2.ptr.p_int[2]; - work.ptr.p_double[n+5] = ra1s2.ptr.p_double[1]; - work.ptr.p_double[n+6] = ra1s2.ptr.p_double[2]; - work.ptr.p_double[n+1] = ra1s2x2.ptr.pp_double[1][1]; - work.ptr.p_double[n+2] = ra1s2x2.ptr.pp_double[2][1]; - work.ptr.p_double[n+3] = ra1s2x2.ptr.pp_double[1][2]; - work.ptr.p_double[n+4] = ra1s2x2.ptr.pp_double[2][2]; - iwork.ptr.p_int[1] = ia1s2x2.ptr.pp_int[1][1]; - iwork.ptr.p_int[2] = ia1s2x2.ptr.pp_int[2][1]; - iwork.ptr.p_int[3] = ia1s2x2.ptr.pp_int[1][2]; - iwork.ptr.p_int[4] = ia1s2x2.ptr.pp_int[2][2]; - if( iwork.ptr.p_int[6]==iu ) - { - wl = work.ptr.p_double[n+1]; - wlu = work.ptr.p_double[n+3]; - nwl = iwork.ptr.p_int[1]; - wu = work.ptr.p_double[n+4]; - wul = work.ptr.p_double[n+2]; - nwu = iwork.ptr.p_int[4]; - } - else - { - wl = work.ptr.p_double[n+2]; - wlu = work.ptr.p_double[n+4]; - nwl = iwork.ptr.p_int[2]; - wu = work.ptr.p_double[n+3]; - wul = work.ptr.p_double[n+1]; - nwu = iwork.ptr.p_int[3]; - } - if( ((nwl<0||nwl>=n)||nwu<1)||nwu>n ) - { - *errorcode = 4; - result = ae_false; - ae_frame_leave(_state); - return result; - } - } - else - { - - /* - * RANGE='A' or 'V' -- Set ATOLI - */ - tnorm = ae_maxreal(ae_fabs(d->ptr.p_double[1], _state)+ae_fabs(e->ptr.p_double[1], _state), ae_fabs(d->ptr.p_double[n], _state)+ae_fabs(e->ptr.p_double[n-1], _state), _state); - for(j=2; j<=n-1; j++) - { - tnorm = ae_maxreal(tnorm, ae_fabs(d->ptr.p_double[j], _state)+ae_fabs(e->ptr.p_double[j-1], _state)+ae_fabs(e->ptr.p_double[j], _state), _state); - } - if( ae_fp_less_eq(abstol,0) ) - { - atoli = ulp*tnorm; - } - else - { - atoli = abstol; - } - if( irange==2 ) - { - wl = vl; - wu = vu; - } - else - { - wl = 0; - wu = 0; - } - } - - /* - * Find Eigenvalues -- Loop Over Blocks and recompute NWL and NWU. - * NWL accumulates the number of eigenvalues .le. WL, - * NWU accumulates the number of eigenvalues .le. WU - */ - *m = 0; - iend = 0; - *errorcode = 0; - nwl = 0; - nwu = 0; - for(jb=1; jb<=*nsplit; jb++) - { - ioff = iend; - ibegin = ioff+1; - iend = isplit->ptr.p_int[jb]; - iin = iend-ioff; - if( iin==1 ) - { - - /* - * Special Case -- IIN=1 - */ - if( irange==1||ae_fp_greater_eq(wl,d->ptr.p_double[ibegin]-pivmin) ) - { - nwl = nwl+1; - } - if( irange==1||ae_fp_greater_eq(wu,d->ptr.p_double[ibegin]-pivmin) ) - { - nwu = nwu+1; - } - if( irange==1||(ae_fp_less(wl,d->ptr.p_double[ibegin]-pivmin)&&ae_fp_greater_eq(wu,d->ptr.p_double[ibegin]-pivmin)) ) - { - *m = *m+1; - w->ptr.p_double[*m] = d->ptr.p_double[ibegin]; - iblock->ptr.p_int[*m] = jb; - } - } - else - { - - /* - * General Case -- IIN > 1 - * - * Compute Gershgorin Interval - * and use it as the initial interval - */ - gu = d->ptr.p_double[ibegin]; - gl = d->ptr.p_double[ibegin]; - tmp1 = 0; - for(j=ibegin; j<=iend-1; j++) - { - tmp2 = ae_fabs(e->ptr.p_double[j], _state); - gu = ae_maxreal(gu, d->ptr.p_double[j]+tmp1+tmp2, _state); - gl = ae_minreal(gl, d->ptr.p_double[j]-tmp1-tmp2, _state); - tmp1 = tmp2; - } - gu = ae_maxreal(gu, d->ptr.p_double[iend]+tmp1, _state); - gl = ae_minreal(gl, d->ptr.p_double[iend]-tmp1, _state); - bnorm = ae_maxreal(ae_fabs(gl, _state), ae_fabs(gu, _state), _state); - gl = gl-fudge*bnorm*ulp*iin-fudge*pivmin; - gu = gu+fudge*bnorm*ulp*iin+fudge*pivmin; - - /* - * Compute ATOLI for the current submatrix - */ - if( ae_fp_less_eq(abstol,0) ) - { - atoli = ulp*ae_maxreal(ae_fabs(gl, _state), ae_fabs(gu, _state), _state); - } - else - { - atoli = abstol; - } - if( irange>1 ) - { - if( ae_fp_less(gu,wl) ) - { - nwl = nwl+iin; - nwu = nwu+iin; - continue; - } - gl = ae_maxreal(gl, wl, _state); - gu = ae_minreal(gu, wu, _state); - if( ae_fp_greater_eq(gl,gu) ) - { - continue; - } - } - - /* - * Set Up Initial Interval - */ - work.ptr.p_double[n+1] = gl; - work.ptr.p_double[n+iin+1] = gu; - - /* - * Calling DLAEBZ - * - * CALL DLAEBZ( 1, 0, IN, IN, 1, NB, ATOLI, RTOLI, PIVMIN, - * D( IBEGIN ), E( IBEGIN ), WORK( IBEGIN ), - * IDUMMA, WORK( N+1 ), WORK( N+2*IN+1 ), IM, - * IWORK, W( M+1 ), IBLOCK( M+1 ), IINFO ) - */ - for(tmpi=1; tmpi<=iin; tmpi++) - { - ra1siin.ptr.p_double[tmpi] = d->ptr.p_double[ibegin-1+tmpi]; - if( ibegin-1+tmpiptr.p_double[ibegin-1+tmpi]; - } - ra3siin.ptr.p_double[tmpi] = work.ptr.p_double[ibegin-1+tmpi]; - ra1siinx2.ptr.pp_double[tmpi][1] = work.ptr.p_double[n+tmpi]; - ra1siinx2.ptr.pp_double[tmpi][2] = work.ptr.p_double[n+tmpi+iin]; - ra4siin.ptr.p_double[tmpi] = work.ptr.p_double[n+2*iin+tmpi]; - rworkspace.ptr.p_double[tmpi] = w->ptr.p_double[*m+tmpi]; - iworkspace.ptr.p_int[tmpi] = iblock->ptr.p_int[*m+tmpi]; - ia1siinx2.ptr.pp_int[tmpi][1] = iwork.ptr.p_int[tmpi]; - ia1siinx2.ptr.pp_int[tmpi][2] = iwork.ptr.p_int[tmpi+iin]; - } - evd_internaldlaebz(1, 0, iin, iin, 1, atoli, rtoli, pivmin, &ra1siin, &ra2siin, &ra3siin, &idumma, &ra1siinx2, &ra4siin, &im, &ia1siinx2, &rworkspace, &iworkspace, &iinfo, _state); - for(tmpi=1; tmpi<=iin; tmpi++) - { - work.ptr.p_double[n+tmpi] = ra1siinx2.ptr.pp_double[tmpi][1]; - work.ptr.p_double[n+tmpi+iin] = ra1siinx2.ptr.pp_double[tmpi][2]; - work.ptr.p_double[n+2*iin+tmpi] = ra4siin.ptr.p_double[tmpi]; - w->ptr.p_double[*m+tmpi] = rworkspace.ptr.p_double[tmpi]; - iblock->ptr.p_int[*m+tmpi] = iworkspace.ptr.p_int[tmpi]; - iwork.ptr.p_int[tmpi] = ia1siinx2.ptr.pp_int[tmpi][1]; - iwork.ptr.p_int[tmpi+iin] = ia1siinx2.ptr.pp_int[tmpi][2]; - } - nwl = nwl+iwork.ptr.p_int[1]; - nwu = nwu+iwork.ptr.p_int[iin+1]; - iwoff = *m-iwork.ptr.p_int[1]; - - /* - * Compute Eigenvalues - */ - itmax = ae_iceil((ae_log(gu-gl+pivmin, _state)-ae_log(pivmin, _state))/ae_log(2, _state), _state)+2; - - /* - * Calling DLAEBZ - * - *CALL DLAEBZ( 2, ITMAX, IN, IN, 1, NB, ATOLI, RTOLI, PIVMIN, - * D( IBEGIN ), E( IBEGIN ), WORK( IBEGIN ), - * IDUMMA, WORK( N+1 ), WORK( N+2*IN+1 ), IOUT, - * IWORK, W( M+1 ), IBLOCK( M+1 ), IINFO ) - */ - for(tmpi=1; tmpi<=iin; tmpi++) - { - ra1siin.ptr.p_double[tmpi] = d->ptr.p_double[ibegin-1+tmpi]; - if( ibegin-1+tmpiptr.p_double[ibegin-1+tmpi]; - } - ra3siin.ptr.p_double[tmpi] = work.ptr.p_double[ibegin-1+tmpi]; - ra1siinx2.ptr.pp_double[tmpi][1] = work.ptr.p_double[n+tmpi]; - ra1siinx2.ptr.pp_double[tmpi][2] = work.ptr.p_double[n+tmpi+iin]; - ra4siin.ptr.p_double[tmpi] = work.ptr.p_double[n+2*iin+tmpi]; - rworkspace.ptr.p_double[tmpi] = w->ptr.p_double[*m+tmpi]; - iworkspace.ptr.p_int[tmpi] = iblock->ptr.p_int[*m+tmpi]; - ia1siinx2.ptr.pp_int[tmpi][1] = iwork.ptr.p_int[tmpi]; - ia1siinx2.ptr.pp_int[tmpi][2] = iwork.ptr.p_int[tmpi+iin]; - } - evd_internaldlaebz(2, itmax, iin, iin, 1, atoli, rtoli, pivmin, &ra1siin, &ra2siin, &ra3siin, &idumma, &ra1siinx2, &ra4siin, &iout, &ia1siinx2, &rworkspace, &iworkspace, &iinfo, _state); - for(tmpi=1; tmpi<=iin; tmpi++) - { - work.ptr.p_double[n+tmpi] = ra1siinx2.ptr.pp_double[tmpi][1]; - work.ptr.p_double[n+tmpi+iin] = ra1siinx2.ptr.pp_double[tmpi][2]; - work.ptr.p_double[n+2*iin+tmpi] = ra4siin.ptr.p_double[tmpi]; - w->ptr.p_double[*m+tmpi] = rworkspace.ptr.p_double[tmpi]; - iblock->ptr.p_int[*m+tmpi] = iworkspace.ptr.p_int[tmpi]; - iwork.ptr.p_int[tmpi] = ia1siinx2.ptr.pp_int[tmpi][1]; - iwork.ptr.p_int[tmpi+iin] = ia1siinx2.ptr.pp_int[tmpi][2]; - } - - /* - * Copy Eigenvalues Into W and IBLOCK - * Use -JB for block number for unconverged eigenvalues. - */ - for(j=1; j<=iout; j++) - { - tmp1 = 0.5*(work.ptr.p_double[j+n]+work.ptr.p_double[j+iin+n]); - - /* - * Flag non-convergence. - */ - if( j>iout-iinfo ) - { - ncnvrg = ae_true; - ib = -jb; - } - else - { - ib = jb; - } - for(je=iwork.ptr.p_int[j]+1+iwoff; je<=iwork.ptr.p_int[j+iin]+iwoff; je++) - { - w->ptr.p_double[je] = tmp1; - iblock->ptr.p_int[je] = ib; - } - } - *m = *m+im; - } - } - - /* - * If RANGE='I', then (WL,WU) contains eigenvalues NWL+1,...,NWU - * If NWL+1 < IL or NWU > IU, discard extra eigenvalues. - */ - if( irange==3 ) - { - im = 0; - idiscl = il-1-nwl; - idiscu = nwu-iu; - if( idiscl>0||idiscu>0 ) - { - for(je=1; je<=*m; je++) - { - if( ae_fp_less_eq(w->ptr.p_double[je],wlu)&&idiscl>0 ) - { - idiscl = idiscl-1; - } - else - { - if( ae_fp_greater_eq(w->ptr.p_double[je],wul)&&idiscu>0 ) - { - idiscu = idiscu-1; - } - else - { - im = im+1; - w->ptr.p_double[im] = w->ptr.p_double[je]; - iblock->ptr.p_int[im] = iblock->ptr.p_int[je]; - } - } - } - *m = im; - } - if( idiscl>0||idiscu>0 ) - { - - /* - * Code to deal with effects of bad arithmetic: - * Some low eigenvalues to be discarded are not in (WL,WLU], - * or high eigenvalues to be discarded are not in (WUL,WU] - * so just kill off the smallest IDISCL/largest IDISCU - * eigenvalues, by simply finding the smallest/largest - * eigenvalue(s). - * - * (If N(w) is monotone non-decreasing, this should never - * happen.) - */ - if( idiscl>0 ) - { - wkill = wu; - for(jdisc=1; jdisc<=idiscl; jdisc++) - { - iw = 0; - for(je=1; je<=*m; je++) - { - if( iblock->ptr.p_int[je]!=0&&(ae_fp_less(w->ptr.p_double[je],wkill)||iw==0) ) - { - iw = je; - wkill = w->ptr.p_double[je]; - } - } - iblock->ptr.p_int[iw] = 0; - } - } - if( idiscu>0 ) - { - wkill = wl; - for(jdisc=1; jdisc<=idiscu; jdisc++) - { - iw = 0; - for(je=1; je<=*m; je++) - { - if( iblock->ptr.p_int[je]!=0&&(ae_fp_greater(w->ptr.p_double[je],wkill)||iw==0) ) - { - iw = je; - wkill = w->ptr.p_double[je]; - } - } - iblock->ptr.p_int[iw] = 0; - } - } - im = 0; - for(je=1; je<=*m; je++) - { - if( iblock->ptr.p_int[je]!=0 ) - { - im = im+1; - w->ptr.p_double[im] = w->ptr.p_double[je]; - iblock->ptr.p_int[im] = iblock->ptr.p_int[je]; - } - } - *m = im; - } - if( idiscl<0||idiscu<0 ) - { - toofew = ae_true; - } - } - - /* - * If ORDER='B', do nothing -- the eigenvalues are already sorted - * by block. - * If ORDER='E', sort the eigenvalues from smallest to largest - */ - if( iorder==1&&*nsplit>1 ) - { - for(je=1; je<=*m-1; je++) - { - ie = 0; - tmp1 = w->ptr.p_double[je]; - for(j=je+1; j<=*m; j++) - { - if( ae_fp_less(w->ptr.p_double[j],tmp1) ) - { - ie = j; - tmp1 = w->ptr.p_double[j]; - } - } - if( ie!=0 ) - { - itmp1 = iblock->ptr.p_int[ie]; - w->ptr.p_double[ie] = w->ptr.p_double[je]; - iblock->ptr.p_int[ie] = iblock->ptr.p_int[je]; - w->ptr.p_double[je] = tmp1; - iblock->ptr.p_int[je] = itmp1; - } - } - } - for(j=1; j<=*m; j++) - { - w->ptr.p_double[j] = w->ptr.p_double[j]*scalefactor; - } - *errorcode = 0; - if( ncnvrg ) - { - *errorcode = *errorcode+1; - } - if( toofew ) - { - *errorcode = *errorcode+2; - } - result = *errorcode==0; - ae_frame_leave(_state); - return result; -} - - -static void evd_internaldstein(ae_int_t n, - /* Real */ ae_vector* d, - /* Real */ ae_vector* e, - ae_int_t m, - /* Real */ ae_vector* w, - /* Integer */ ae_vector* iblock, - /* Integer */ ae_vector* isplit, - /* Real */ ae_matrix* z, - /* Integer */ ae_vector* ifail, - ae_int_t* info, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _e; - ae_vector _w; - ae_int_t maxits; - ae_int_t extra; - ae_int_t b1; - ae_int_t blksiz; - ae_int_t bn; - ae_int_t gpind; - ae_int_t i; - ae_int_t iinfo; - ae_int_t its; - ae_int_t j; - ae_int_t j1; - ae_int_t jblk; - ae_int_t jmax; - ae_int_t nblk; - ae_int_t nrmchk; - double dtpcrt; - double eps; - double eps1; - double nrm; - double onenrm; - double ortol; - double pertol; - double scl; - double sep; - double tol; - double xj; - double xjm; - double ztr; - ae_vector work1; - ae_vector work2; - ae_vector work3; - ae_vector work4; - ae_vector work5; - ae_vector iwork; - ae_bool tmpcriterion; - ae_int_t ti; - ae_int_t i1; - ae_int_t i2; - double v; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_e, e, _state, ae_true); - e = &_e; - ae_vector_init_copy(&_w, w, _state, ae_true); - w = &_w; - ae_matrix_clear(z); - ae_vector_clear(ifail); - *info = 0; - ae_vector_init(&work1, 0, DT_REAL, _state, ae_true); - ae_vector_init(&work2, 0, DT_REAL, _state, ae_true); - ae_vector_init(&work3, 0, DT_REAL, _state, ae_true); - ae_vector_init(&work4, 0, DT_REAL, _state, ae_true); - ae_vector_init(&work5, 0, DT_REAL, _state, ae_true); - ae_vector_init(&iwork, 0, DT_INT, _state, ae_true); - - maxits = 5; - extra = 2; - ae_vector_set_length(&work1, ae_maxint(n, 1, _state)+1, _state); - ae_vector_set_length(&work2, ae_maxint(n-1, 1, _state)+1, _state); - ae_vector_set_length(&work3, ae_maxint(n, 1, _state)+1, _state); - ae_vector_set_length(&work4, ae_maxint(n, 1, _state)+1, _state); - ae_vector_set_length(&work5, ae_maxint(n, 1, _state)+1, _state); - ae_vector_set_length(&iwork, ae_maxint(n, 1, _state)+1, _state); - ae_vector_set_length(ifail, ae_maxint(m, 1, _state)+1, _state); - ae_matrix_set_length(z, ae_maxint(n, 1, _state)+1, ae_maxint(m, 1, _state)+1, _state); - - /* - * these initializers are not really necessary, - * but without them compiler complains about uninitialized locals - */ - gpind = 0; - onenrm = 0; - ortol = 0; - dtpcrt = 0; - xjm = 0; - - /* - * Test the input parameters. - */ - *info = 0; - for(i=1; i<=m; i++) - { - ifail->ptr.p_int[i] = 0; - } - if( n<0 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - if( m<0||m>n ) - { - *info = -4; - ae_frame_leave(_state); - return; - } - for(j=2; j<=m; j++) - { - if( iblock->ptr.p_int[j]ptr.p_int[j-1] ) - { - *info = -6; - break; - } - if( iblock->ptr.p_int[j]==iblock->ptr.p_int[j-1]&&ae_fp_less(w->ptr.p_double[j],w->ptr.p_double[j-1]) ) - { - *info = -5; - break; - } - } - if( *info!=0 ) - { - ae_frame_leave(_state); - return; - } - - /* - * Quick return if possible - */ - if( n==0||m==0 ) - { - ae_frame_leave(_state); - return; - } - if( n==1 ) - { - z->ptr.pp_double[1][1] = 1; - ae_frame_leave(_state); - return; - } - - /* - * Some preparations - */ - ti = n-1; - ae_v_move(&work1.ptr.p_double[1], 1, &e->ptr.p_double[1], 1, ae_v_len(1,ti)); - ae_vector_set_length(e, n+1, _state); - ae_v_move(&e->ptr.p_double[1], 1, &work1.ptr.p_double[1], 1, ae_v_len(1,ti)); - ae_v_move(&work1.ptr.p_double[1], 1, &w->ptr.p_double[1], 1, ae_v_len(1,m)); - ae_vector_set_length(w, n+1, _state); - ae_v_move(&w->ptr.p_double[1], 1, &work1.ptr.p_double[1], 1, ae_v_len(1,m)); - - /* - * Get machine constants. - */ - eps = ae_machineepsilon; - - /* - * Compute eigenvectors of matrix blocks. - */ - j1 = 1; - for(nblk=1; nblk<=iblock->ptr.p_int[m]; nblk++) - { - - /* - * Find starting and ending indices of block nblk. - */ - if( nblk==1 ) - { - b1 = 1; - } - else - { - b1 = isplit->ptr.p_int[nblk-1]+1; - } - bn = isplit->ptr.p_int[nblk]; - blksiz = bn-b1+1; - if( blksiz!=1 ) - { - - /* - * Compute reorthogonalization criterion and stopping criterion. - */ - gpind = b1; - onenrm = ae_fabs(d->ptr.p_double[b1], _state)+ae_fabs(e->ptr.p_double[b1], _state); - onenrm = ae_maxreal(onenrm, ae_fabs(d->ptr.p_double[bn], _state)+ae_fabs(e->ptr.p_double[bn-1], _state), _state); - for(i=b1+1; i<=bn-1; i++) - { - onenrm = ae_maxreal(onenrm, ae_fabs(d->ptr.p_double[i], _state)+ae_fabs(e->ptr.p_double[i-1], _state)+ae_fabs(e->ptr.p_double[i], _state), _state); - } - ortol = 0.001*onenrm; - dtpcrt = ae_sqrt(0.1/blksiz, _state); - } - - /* - * Loop through eigenvalues of block nblk. - */ - jblk = 0; - for(j=j1; j<=m; j++) - { - if( iblock->ptr.p_int[j]!=nblk ) - { - j1 = j; - break; - } - jblk = jblk+1; - xj = w->ptr.p_double[j]; - if( blksiz==1 ) - { - - /* - * Skip all the work if the block size is one. - */ - work1.ptr.p_double[1] = 1; - } - else - { - - /* - * If eigenvalues j and j-1 are too close, add a relatively - * small perturbation. - */ - if( jblk>1 ) - { - eps1 = ae_fabs(eps*xj, _state); - pertol = 10*eps1; - sep = xj-xjm; - if( ae_fp_less(sep,pertol) ) - { - xj = xjm+pertol; - } - } - its = 0; - nrmchk = 0; - - /* - * Get random starting vector. - */ - for(ti=1; ti<=blksiz; ti++) - { - work1.ptr.p_double[ti] = 2*ae_randomreal(_state)-1; - } - - /* - * Copy the matrix T so it won't be destroyed in factorization. - */ - for(ti=1; ti<=blksiz-1; ti++) - { - work2.ptr.p_double[ti] = e->ptr.p_double[b1+ti-1]; - work3.ptr.p_double[ti] = e->ptr.p_double[b1+ti-1]; - work4.ptr.p_double[ti] = d->ptr.p_double[b1+ti-1]; - } - work4.ptr.p_double[blksiz] = d->ptr.p_double[b1+blksiz-1]; - - /* - * Compute LU factors with partial pivoting ( PT = LU ) - */ - tol = 0; - evd_tdininternaldlagtf(blksiz, &work4, xj, &work2, &work3, tol, &work5, &iwork, &iinfo, _state); - - /* - * Update iteration count. - */ - do - { - its = its+1; - if( its>maxits ) - { - - /* - * If stopping criterion was not satisfied, update info and - * store eigenvector number in array ifail. - */ - *info = *info+1; - ifail->ptr.p_int[*info] = j; - break; - } - - /* - * Normalize and scale the righthand side vector Pb. - */ - v = 0; - for(ti=1; ti<=blksiz; ti++) - { - v = v+ae_fabs(work1.ptr.p_double[ti], _state); - } - scl = blksiz*onenrm*ae_maxreal(eps, ae_fabs(work4.ptr.p_double[blksiz], _state), _state)/v; - ae_v_muld(&work1.ptr.p_double[1], 1, ae_v_len(1,blksiz), scl); - - /* - * Solve the system LU = Pb. - */ - evd_tdininternaldlagts(blksiz, &work4, &work2, &work3, &work5, &iwork, &work1, &tol, &iinfo, _state); - - /* - * Reorthogonalize by modified Gram-Schmidt if eigenvalues are - * close enough. - */ - if( jblk!=1 ) - { - if( ae_fp_greater(ae_fabs(xj-xjm, _state),ortol) ) - { - gpind = j; - } - if( gpind!=j ) - { - for(i=gpind; i<=j-1; i++) - { - i1 = b1; - i2 = b1+blksiz-1; - ztr = ae_v_dotproduct(&work1.ptr.p_double[1], 1, &z->ptr.pp_double[i1][i], z->stride, ae_v_len(1,blksiz)); - ae_v_subd(&work1.ptr.p_double[1], 1, &z->ptr.pp_double[i1][i], z->stride, ae_v_len(1,blksiz), ztr); - touchint(&i2, _state); - } - } - } - - /* - * Check the infinity norm of the iterate. - */ - jmax = vectoridxabsmax(&work1, 1, blksiz, _state); - nrm = ae_fabs(work1.ptr.p_double[jmax], _state); - - /* - * Continue for additional iterations after norm reaches - * stopping criterion. - */ - tmpcriterion = ae_false; - if( ae_fp_less(nrm,dtpcrt) ) - { - tmpcriterion = ae_true; - } - else - { - nrmchk = nrmchk+1; - if( nrmchkptr.pp_double[i][j] = 0; - } - for(i=1; i<=blksiz; i++) - { - z->ptr.pp_double[b1+i-1][j] = work1.ptr.p_double[i]; - } - - /* - * Save the shift to check eigenvalue spacing at next - * iteration. - */ - xjm = xj; - } - } - ae_frame_leave(_state); -} - - -static void evd_tdininternaldlagtf(ae_int_t n, - /* Real */ ae_vector* a, - double lambdav, - /* Real */ ae_vector* b, - /* Real */ ae_vector* c, - double tol, - /* Real */ ae_vector* d, - /* Integer */ ae_vector* iin, - ae_int_t* info, - ae_state *_state) -{ - ae_int_t k; - double eps; - double mult; - double piv1; - double piv2; - double scale1; - double scale2; - double temp; - double tl; - - *info = 0; - - *info = 0; - if( n<0 ) - { - *info = -1; - return; - } - if( n==0 ) - { - return; - } - a->ptr.p_double[1] = a->ptr.p_double[1]-lambdav; - iin->ptr.p_int[n] = 0; - if( n==1 ) - { - if( ae_fp_eq(a->ptr.p_double[1],0) ) - { - iin->ptr.p_int[1] = 1; - } - return; - } - eps = ae_machineepsilon; - tl = ae_maxreal(tol, eps, _state); - scale1 = ae_fabs(a->ptr.p_double[1], _state)+ae_fabs(b->ptr.p_double[1], _state); - for(k=1; k<=n-1; k++) - { - a->ptr.p_double[k+1] = a->ptr.p_double[k+1]-lambdav; - scale2 = ae_fabs(c->ptr.p_double[k], _state)+ae_fabs(a->ptr.p_double[k+1], _state); - if( kptr.p_double[k+1], _state); - } - if( ae_fp_eq(a->ptr.p_double[k],0) ) - { - piv1 = 0; - } - else - { - piv1 = ae_fabs(a->ptr.p_double[k], _state)/scale1; - } - if( ae_fp_eq(c->ptr.p_double[k],0) ) - { - iin->ptr.p_int[k] = 0; - piv2 = 0; - scale1 = scale2; - if( kptr.p_double[k] = 0; - } - } - else - { - piv2 = ae_fabs(c->ptr.p_double[k], _state)/scale2; - if( ae_fp_less_eq(piv2,piv1) ) - { - iin->ptr.p_int[k] = 0; - scale1 = scale2; - c->ptr.p_double[k] = c->ptr.p_double[k]/a->ptr.p_double[k]; - a->ptr.p_double[k+1] = a->ptr.p_double[k+1]-c->ptr.p_double[k]*b->ptr.p_double[k]; - if( kptr.p_double[k] = 0; - } - } - else - { - iin->ptr.p_int[k] = 1; - mult = a->ptr.p_double[k]/c->ptr.p_double[k]; - a->ptr.p_double[k] = c->ptr.p_double[k]; - temp = a->ptr.p_double[k+1]; - a->ptr.p_double[k+1] = b->ptr.p_double[k]-mult*temp; - if( kptr.p_double[k] = b->ptr.p_double[k+1]; - b->ptr.p_double[k+1] = -mult*d->ptr.p_double[k]; - } - b->ptr.p_double[k] = temp; - c->ptr.p_double[k] = mult; - } - } - if( ae_fp_less_eq(ae_maxreal(piv1, piv2, _state),tl)&&iin->ptr.p_int[n]==0 ) - { - iin->ptr.p_int[n] = k; - } - } - if( ae_fp_less_eq(ae_fabs(a->ptr.p_double[n], _state),scale1*tl)&&iin->ptr.p_int[n]==0 ) - { - iin->ptr.p_int[n] = n; - } -} - - -static void evd_tdininternaldlagts(ae_int_t n, - /* Real */ ae_vector* a, - /* Real */ ae_vector* b, - /* Real */ ae_vector* c, - /* Real */ ae_vector* d, - /* Integer */ ae_vector* iin, - /* Real */ ae_vector* y, - double* tol, - ae_int_t* info, - ae_state *_state) -{ - ae_int_t k; - double absak; - double ak; - double bignum; - double eps; - double pert; - double sfmin; - double temp; - - *info = 0; - - *info = 0; - if( n<0 ) - { - *info = -1; - return; - } - if( n==0 ) - { - return; - } - eps = ae_machineepsilon; - sfmin = ae_minrealnumber; - bignum = 1/sfmin; - if( ae_fp_less_eq(*tol,0) ) - { - *tol = ae_fabs(a->ptr.p_double[1], _state); - if( n>1 ) - { - *tol = ae_maxreal(*tol, ae_maxreal(ae_fabs(a->ptr.p_double[2], _state), ae_fabs(b->ptr.p_double[1], _state), _state), _state); - } - for(k=3; k<=n; k++) - { - *tol = ae_maxreal(*tol, ae_maxreal(ae_fabs(a->ptr.p_double[k], _state), ae_maxreal(ae_fabs(b->ptr.p_double[k-1], _state), ae_fabs(d->ptr.p_double[k-2], _state), _state), _state), _state); - } - *tol = *tol*eps; - if( ae_fp_eq(*tol,0) ) - { - *tol = eps; - } - } - for(k=2; k<=n; k++) - { - if( iin->ptr.p_int[k-1]==0 ) - { - y->ptr.p_double[k] = y->ptr.p_double[k]-c->ptr.p_double[k-1]*y->ptr.p_double[k-1]; - } - else - { - temp = y->ptr.p_double[k-1]; - y->ptr.p_double[k-1] = y->ptr.p_double[k]; - y->ptr.p_double[k] = temp-c->ptr.p_double[k-1]*y->ptr.p_double[k]; - } - } - for(k=n; k>=1; k--) - { - if( k<=n-2 ) - { - temp = y->ptr.p_double[k]-b->ptr.p_double[k]*y->ptr.p_double[k+1]-d->ptr.p_double[k]*y->ptr.p_double[k+2]; - } - else - { - if( k==n-1 ) - { - temp = y->ptr.p_double[k]-b->ptr.p_double[k]*y->ptr.p_double[k+1]; - } - else - { - temp = y->ptr.p_double[k]; - } - } - ak = a->ptr.p_double[k]; - pert = ae_fabs(*tol, _state); - if( ae_fp_less(ak,0) ) - { - pert = -pert; - } - for(;;) - { - absak = ae_fabs(ak, _state); - if( ae_fp_less(absak,1) ) - { - if( ae_fp_less(absak,sfmin) ) - { - if( ae_fp_eq(absak,0)||ae_fp_greater(ae_fabs(temp, _state)*sfmin,absak) ) - { - ak = ak+pert; - pert = 2*pert; - continue; - } - else - { - temp = temp*bignum; - ak = ak*bignum; - } - } - else - { - if( ae_fp_greater(ae_fabs(temp, _state),absak*bignum) ) - { - ak = ak+pert; - pert = 2*pert; - continue; - } - } - } - break; - } - y->ptr.p_double[k] = temp/ak; - } -} - - -static void evd_internaldlaebz(ae_int_t ijob, - ae_int_t nitmax, - ae_int_t n, - ae_int_t mmax, - ae_int_t minp, - double abstol, - double reltol, - double pivmin, - /* Real */ ae_vector* d, - /* Real */ ae_vector* e, - /* Real */ ae_vector* e2, - /* Integer */ ae_vector* nval, - /* Real */ ae_matrix* ab, - /* Real */ ae_vector* c, - ae_int_t* mout, - /* Integer */ ae_matrix* nab, - /* Real */ ae_vector* work, - /* Integer */ ae_vector* iwork, - ae_int_t* info, - ae_state *_state) -{ - ae_int_t itmp1; - ae_int_t itmp2; - ae_int_t j; - ae_int_t ji; - ae_int_t jit; - ae_int_t jp; - ae_int_t kf; - ae_int_t kfnew; - ae_int_t kl; - ae_int_t klnew; - double tmp1; - double tmp2; - - *mout = 0; - *info = 0; - - *info = 0; - if( ijob<1||ijob>3 ) - { - *info = -1; - return; - } - - /* - * Initialize NAB - */ - if( ijob==1 ) - { - - /* - * Compute the number of eigenvalues in the initial intervals. - */ - *mout = 0; - - /* - *DIR$ NOVECTOR - */ - for(ji=1; ji<=minp; ji++) - { - for(jp=1; jp<=2; jp++) - { - tmp1 = d->ptr.p_double[1]-ab->ptr.pp_double[ji][jp]; - if( ae_fp_less(ae_fabs(tmp1, _state),pivmin) ) - { - tmp1 = -pivmin; - } - nab->ptr.pp_int[ji][jp] = 0; - if( ae_fp_less_eq(tmp1,0) ) - { - nab->ptr.pp_int[ji][jp] = 1; - } - for(j=2; j<=n; j++) - { - tmp1 = d->ptr.p_double[j]-e2->ptr.p_double[j-1]/tmp1-ab->ptr.pp_double[ji][jp]; - if( ae_fp_less(ae_fabs(tmp1, _state),pivmin) ) - { - tmp1 = -pivmin; - } - if( ae_fp_less_eq(tmp1,0) ) - { - nab->ptr.pp_int[ji][jp] = nab->ptr.pp_int[ji][jp]+1; - } - } - } - *mout = *mout+nab->ptr.pp_int[ji][2]-nab->ptr.pp_int[ji][1]; - } - return; - } - - /* - * Initialize for loop - * - * KF and KL have the following meaning: - * Intervals 1,...,KF-1 have converged. - * Intervals KF,...,KL still need to be refined. - */ - kf = 1; - kl = minp; - - /* - * If IJOB=2, initialize C. - * If IJOB=3, use the user-supplied starting point. - */ - if( ijob==2 ) - { - for(ji=1; ji<=minp; ji++) - { - c->ptr.p_double[ji] = 0.5*(ab->ptr.pp_double[ji][1]+ab->ptr.pp_double[ji][2]); - } - } - - /* - * Iteration loop - */ - for(jit=1; jit<=nitmax; jit++) - { - - /* - * Loop over intervals - * - * - * Serial Version of the loop - */ - klnew = kl; - for(ji=kf; ji<=kl; ji++) - { - - /* - * Compute N(w), the number of eigenvalues less than w - */ - tmp1 = c->ptr.p_double[ji]; - tmp2 = d->ptr.p_double[1]-tmp1; - itmp1 = 0; - if( ae_fp_less_eq(tmp2,pivmin) ) - { - itmp1 = 1; - tmp2 = ae_minreal(tmp2, -pivmin, _state); - } - - /* - * A series of compiler directives to defeat vectorization - * for the next loop - * - **$PL$ CMCHAR=' ' - *CDIR$ NEXTSCALAR - *C$DIR SCALAR - *CDIR$ NEXT SCALAR - *CVD$L NOVECTOR - *CDEC$ NOVECTOR - *CVD$ NOVECTOR - **VDIR NOVECTOR - **VOCL LOOP,SCALAR - *CIBM PREFER SCALAR - **$PL$ CMCHAR='*' - */ - for(j=2; j<=n; j++) - { - tmp2 = d->ptr.p_double[j]-e2->ptr.p_double[j-1]/tmp2-tmp1; - if( ae_fp_less_eq(tmp2,pivmin) ) - { - itmp1 = itmp1+1; - tmp2 = ae_minreal(tmp2, -pivmin, _state); - } - } - if( ijob<=2 ) - { - - /* - * IJOB=2: Choose all intervals containing eigenvalues. - * - * Insure that N(w) is monotone - */ - itmp1 = ae_minint(nab->ptr.pp_int[ji][2], ae_maxint(nab->ptr.pp_int[ji][1], itmp1, _state), _state); - - /* - * Update the Queue -- add intervals if both halves - * contain eigenvalues. - */ - if( itmp1==nab->ptr.pp_int[ji][2] ) - { - - /* - * No eigenvalue in the upper interval: - * just use the lower interval. - */ - ab->ptr.pp_double[ji][2] = tmp1; - } - else - { - if( itmp1==nab->ptr.pp_int[ji][1] ) - { - - /* - * No eigenvalue in the lower interval: - * just use the upper interval. - */ - ab->ptr.pp_double[ji][1] = tmp1; - } - else - { - if( klnewptr.pp_double[klnew][2] = ab->ptr.pp_double[ji][2]; - nab->ptr.pp_int[klnew][2] = nab->ptr.pp_int[ji][2]; - ab->ptr.pp_double[klnew][1] = tmp1; - nab->ptr.pp_int[klnew][1] = itmp1; - ab->ptr.pp_double[ji][2] = tmp1; - nab->ptr.pp_int[ji][2] = itmp1; - } - else - { - *info = mmax+1; - return; - } - } - } - } - else - { - - /* - * IJOB=3: Binary search. Keep only the interval - * containing w s.t. N(w) = NVAL - */ - if( itmp1<=nval->ptr.p_int[ji] ) - { - ab->ptr.pp_double[ji][1] = tmp1; - nab->ptr.pp_int[ji][1] = itmp1; - } - if( itmp1>=nval->ptr.p_int[ji] ) - { - ab->ptr.pp_double[ji][2] = tmp1; - nab->ptr.pp_int[ji][2] = itmp1; - } - } - } - kl = klnew; - - /* - * Check for convergence - */ - kfnew = kf; - for(ji=kf; ji<=kl; ji++) - { - tmp1 = ae_fabs(ab->ptr.pp_double[ji][2]-ab->ptr.pp_double[ji][1], _state); - tmp2 = ae_maxreal(ae_fabs(ab->ptr.pp_double[ji][2], _state), ae_fabs(ab->ptr.pp_double[ji][1], _state), _state); - if( ae_fp_less(tmp1,ae_maxreal(abstol, ae_maxreal(pivmin, reltol*tmp2, _state), _state))||nab->ptr.pp_int[ji][1]>=nab->ptr.pp_int[ji][2] ) - { - - /* - * Converged -- Swap with position KFNEW, - * then increment KFNEW - */ - if( ji>kfnew ) - { - tmp1 = ab->ptr.pp_double[ji][1]; - tmp2 = ab->ptr.pp_double[ji][2]; - itmp1 = nab->ptr.pp_int[ji][1]; - itmp2 = nab->ptr.pp_int[ji][2]; - ab->ptr.pp_double[ji][1] = ab->ptr.pp_double[kfnew][1]; - ab->ptr.pp_double[ji][2] = ab->ptr.pp_double[kfnew][2]; - nab->ptr.pp_int[ji][1] = nab->ptr.pp_int[kfnew][1]; - nab->ptr.pp_int[ji][2] = nab->ptr.pp_int[kfnew][2]; - ab->ptr.pp_double[kfnew][1] = tmp1; - ab->ptr.pp_double[kfnew][2] = tmp2; - nab->ptr.pp_int[kfnew][1] = itmp1; - nab->ptr.pp_int[kfnew][2] = itmp2; - if( ijob==3 ) - { - itmp1 = nval->ptr.p_int[ji]; - nval->ptr.p_int[ji] = nval->ptr.p_int[kfnew]; - nval->ptr.p_int[kfnew] = itmp1; - } - } - kfnew = kfnew+1; - } - } - kf = kfnew; - - /* - * Choose Midpoints - */ - for(ji=kf; ji<=kl; ji++) - { - c->ptr.p_double[ji] = 0.5*(ab->ptr.pp_double[ji][1]+ab->ptr.pp_double[ji][2]); - } - - /* - * If no more intervals to refine, quit. - */ - if( kf>kl ) - { - break; - } - } - - /* - * Converged - */ - *info = ae_maxint(kl+1-kf, 0, _state); - *mout = kl; -} - - -/************************************************************************* -Internal subroutine - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - June 30, 1999 -*************************************************************************/ -static void evd_internaltrevc(/* Real */ ae_matrix* t, - ae_int_t n, - ae_int_t side, - ae_int_t howmny, - /* Boolean */ ae_vector* vselect, - /* Real */ ae_matrix* vl, - /* Real */ ae_matrix* vr, - ae_int_t* m, - ae_int_t* info, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _vselect; - ae_bool allv; - ae_bool bothv; - ae_bool leftv; - ae_bool over; - ae_bool pair; - ae_bool rightv; - ae_bool somev; - ae_int_t i; - ae_int_t ierr; - ae_int_t ii; - ae_int_t ip; - ae_int_t iis; - ae_int_t j; - ae_int_t j1; - ae_int_t j2; - ae_int_t jnxt; - ae_int_t k; - ae_int_t ki; - ae_int_t n2; - double beta; - double bignum; - double emax; - double rec; - double remax; - double scl; - double smin; - double smlnum; - double ulp; - double unfl; - double vcrit; - double vmax; - double wi; - double wr; - double xnorm; - ae_matrix x; - ae_vector work; - ae_vector temp; - ae_matrix temp11; - ae_matrix temp22; - ae_matrix temp11b; - ae_matrix temp21b; - ae_matrix temp12b; - ae_matrix temp22b; - ae_bool skipflag; - ae_int_t k1; - ae_int_t k2; - ae_int_t k3; - ae_int_t k4; - double vt; - ae_vector rswap4; - ae_vector zswap4; - ae_matrix ipivot44; - ae_vector civ4; - ae_vector crv4; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_vselect, vselect, _state, ae_true); - vselect = &_vselect; - *m = 0; - *info = 0; - ae_matrix_init(&x, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&work, 0, DT_REAL, _state, ae_true); - ae_vector_init(&temp, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&temp11, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&temp22, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&temp11b, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&temp21b, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&temp12b, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&temp22b, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&rswap4, 0, DT_BOOL, _state, ae_true); - ae_vector_init(&zswap4, 0, DT_BOOL, _state, ae_true); - ae_matrix_init(&ipivot44, 0, 0, DT_INT, _state, ae_true); - ae_vector_init(&civ4, 0, DT_REAL, _state, ae_true); - ae_vector_init(&crv4, 0, DT_REAL, _state, ae_true); - - ae_matrix_set_length(&x, 2+1, 2+1, _state); - ae_matrix_set_length(&temp11, 1+1, 1+1, _state); - ae_matrix_set_length(&temp11b, 1+1, 1+1, _state); - ae_matrix_set_length(&temp21b, 2+1, 1+1, _state); - ae_matrix_set_length(&temp12b, 1+1, 2+1, _state); - ae_matrix_set_length(&temp22b, 2+1, 2+1, _state); - ae_matrix_set_length(&temp22, 2+1, 2+1, _state); - ae_vector_set_length(&work, 3*n+1, _state); - ae_vector_set_length(&temp, n+1, _state); - ae_vector_set_length(&rswap4, 4+1, _state); - ae_vector_set_length(&zswap4, 4+1, _state); - ae_matrix_set_length(&ipivot44, 4+1, 4+1, _state); - ae_vector_set_length(&civ4, 4+1, _state); - ae_vector_set_length(&crv4, 4+1, _state); - if( howmny!=1 ) - { - if( side==1||side==3 ) - { - ae_matrix_set_length(vr, n+1, n+1, _state); - } - if( side==2||side==3 ) - { - ae_matrix_set_length(vl, n+1, n+1, _state); - } - } - - /* - * Decode and test the input parameters - */ - bothv = side==3; - rightv = side==1||bothv; - leftv = side==2||bothv; - allv = howmny==2; - over = howmny==1; - somev = howmny==3; - *info = 0; - if( n<0 ) - { - *info = -2; - ae_frame_leave(_state); - return; - } - if( !rightv&&!leftv ) - { - *info = -3; - ae_frame_leave(_state); - return; - } - if( (!allv&&!over)&&!somev ) - { - *info = -4; - ae_frame_leave(_state); - return; - } - - /* - * Set M to the number of columns required to store the selected - * eigenvectors, standardize the array SELECT if necessary, and - * test MM. - */ - if( somev ) - { - *m = 0; - pair = ae_false; - for(j=1; j<=n; j++) - { - if( pair ) - { - pair = ae_false; - vselect->ptr.p_bool[j] = ae_false; - } - else - { - if( jptr.pp_double[j+1][j],0) ) - { - if( vselect->ptr.p_bool[j] ) - { - *m = *m+1; - } - } - else - { - pair = ae_true; - if( vselect->ptr.p_bool[j]||vselect->ptr.p_bool[j+1] ) - { - vselect->ptr.p_bool[j] = ae_true; - *m = *m+2; - } - } - } - else - { - if( vselect->ptr.p_bool[n] ) - { - *m = *m+1; - } - } - } - } - } - else - { - *m = n; - } - - /* - * Quick return if possible. - */ - if( n==0 ) - { - ae_frame_leave(_state); - return; - } - - /* - * Set the constants to control overflow. - */ - unfl = ae_minrealnumber; - ulp = ae_machineepsilon; - smlnum = unfl*(n/ulp); - bignum = (1-ulp)/smlnum; - - /* - * Compute 1-norm of each column of strictly upper triangular - * part of T to control overflow in triangular solver. - */ - work.ptr.p_double[1] = 0; - for(j=2; j<=n; j++) - { - work.ptr.p_double[j] = 0; - for(i=1; i<=j-1; i++) - { - work.ptr.p_double[j] = work.ptr.p_double[j]+ae_fabs(t->ptr.pp_double[i][j], _state); - } - } - - /* - * Index IP is used to specify the real or complex eigenvalue: - * IP = 0, real eigenvalue, - * 1, first of conjugate complex pair: (wr,wi) - * -1, second of conjugate complex pair: (wr,wi) - */ - n2 = 2*n; - if( rightv ) - { - - /* - * Compute right eigenvectors. - */ - ip = 0; - iis = *m; - for(ki=n; ki>=1; ki--) - { - skipflag = ae_false; - if( ip==1 ) - { - skipflag = ae_true; - } - else - { - if( ki!=1 ) - { - if( ae_fp_neq(t->ptr.pp_double[ki][ki-1],0) ) - { - ip = -1; - } - } - if( somev ) - { - if( ip==0 ) - { - if( !vselect->ptr.p_bool[ki] ) - { - skipflag = ae_true; - } - } - else - { - if( !vselect->ptr.p_bool[ki-1] ) - { - skipflag = ae_true; - } - } - } - } - if( !skipflag ) - { - - /* - * Compute the KI-th eigenvalue (WR,WI). - */ - wr = t->ptr.pp_double[ki][ki]; - wi = 0; - if( ip!=0 ) - { - wi = ae_sqrt(ae_fabs(t->ptr.pp_double[ki][ki-1], _state), _state)*ae_sqrt(ae_fabs(t->ptr.pp_double[ki-1][ki], _state), _state); - } - smin = ae_maxreal(ulp*(ae_fabs(wr, _state)+ae_fabs(wi, _state)), smlnum, _state); - if( ip==0 ) - { - - /* - * Real right eigenvector - */ - work.ptr.p_double[ki+n] = 1; - - /* - * Form right-hand side - */ - for(k=1; k<=ki-1; k++) - { - work.ptr.p_double[k+n] = -t->ptr.pp_double[k][ki]; - } - - /* - * Solve the upper quasi-triangular system: - * (T(1:KI-1,1:KI-1) - WR)*X = SCALE*WORK. - */ - jnxt = ki-1; - for(j=ki-1; j>=1; j--) - { - if( j>jnxt ) - { - continue; - } - j1 = j; - j2 = j; - jnxt = j-1; - if( j>1 ) - { - if( ae_fp_neq(t->ptr.pp_double[j][j-1],0) ) - { - j1 = j-1; - jnxt = j-2; - } - } - if( j1==j2 ) - { - - /* - * 1-by-1 diagonal block - */ - temp11.ptr.pp_double[1][1] = t->ptr.pp_double[j][j]; - temp11b.ptr.pp_double[1][1] = work.ptr.p_double[j+n]; - evd_internalhsevdlaln2(ae_false, 1, 1, smin, 1, &temp11, 1.0, 1.0, &temp11b, wr, 0.0, &rswap4, &zswap4, &ipivot44, &civ4, &crv4, &x, &scl, &xnorm, &ierr, _state); - - /* - * Scale X(1,1) to avoid overflow when updating - * the right-hand side. - */ - if( ae_fp_greater(xnorm,1) ) - { - if( ae_fp_greater(work.ptr.p_double[j],bignum/xnorm) ) - { - x.ptr.pp_double[1][1] = x.ptr.pp_double[1][1]/xnorm; - scl = scl/xnorm; - } - } - - /* - * Scale if necessary - */ - if( ae_fp_neq(scl,1) ) - { - k1 = n+1; - k2 = n+ki; - ae_v_muld(&work.ptr.p_double[k1], 1, ae_v_len(k1,k2), scl); - } - work.ptr.p_double[j+n] = x.ptr.pp_double[1][1]; - - /* - * Update right-hand side - */ - k1 = 1+n; - k2 = j-1+n; - k3 = j-1; - vt = -x.ptr.pp_double[1][1]; - ae_v_addd(&work.ptr.p_double[k1], 1, &t->ptr.pp_double[1][j], t->stride, ae_v_len(k1,k2), vt); - } - else - { - - /* - * 2-by-2 diagonal block - */ - temp22.ptr.pp_double[1][1] = t->ptr.pp_double[j-1][j-1]; - temp22.ptr.pp_double[1][2] = t->ptr.pp_double[j-1][j]; - temp22.ptr.pp_double[2][1] = t->ptr.pp_double[j][j-1]; - temp22.ptr.pp_double[2][2] = t->ptr.pp_double[j][j]; - temp21b.ptr.pp_double[1][1] = work.ptr.p_double[j-1+n]; - temp21b.ptr.pp_double[2][1] = work.ptr.p_double[j+n]; - evd_internalhsevdlaln2(ae_false, 2, 1, smin, 1.0, &temp22, 1.0, 1.0, &temp21b, wr, 0, &rswap4, &zswap4, &ipivot44, &civ4, &crv4, &x, &scl, &xnorm, &ierr, _state); - - /* - * Scale X(1,1) and X(2,1) to avoid overflow when - * updating the right-hand side. - */ - if( ae_fp_greater(xnorm,1) ) - { - beta = ae_maxreal(work.ptr.p_double[j-1], work.ptr.p_double[j], _state); - if( ae_fp_greater(beta,bignum/xnorm) ) - { - x.ptr.pp_double[1][1] = x.ptr.pp_double[1][1]/xnorm; - x.ptr.pp_double[2][1] = x.ptr.pp_double[2][1]/xnorm; - scl = scl/xnorm; - } - } - - /* - * Scale if necessary - */ - if( ae_fp_neq(scl,1) ) - { - k1 = 1+n; - k2 = ki+n; - ae_v_muld(&work.ptr.p_double[k1], 1, ae_v_len(k1,k2), scl); - } - work.ptr.p_double[j-1+n] = x.ptr.pp_double[1][1]; - work.ptr.p_double[j+n] = x.ptr.pp_double[2][1]; - - /* - * Update right-hand side - */ - k1 = 1+n; - k2 = j-2+n; - k3 = j-2; - k4 = j-1; - vt = -x.ptr.pp_double[1][1]; - ae_v_addd(&work.ptr.p_double[k1], 1, &t->ptr.pp_double[1][k4], t->stride, ae_v_len(k1,k2), vt); - vt = -x.ptr.pp_double[2][1]; - ae_v_addd(&work.ptr.p_double[k1], 1, &t->ptr.pp_double[1][j], t->stride, ae_v_len(k1,k2), vt); - } - } - - /* - * Copy the vector x or Q*x to VR and normalize. - */ - if( !over ) - { - k1 = 1+n; - k2 = ki+n; - ae_v_move(&vr->ptr.pp_double[1][iis], vr->stride, &work.ptr.p_double[k1], 1, ae_v_len(1,ki)); - ii = columnidxabsmax(vr, 1, ki, iis, _state); - remax = 1/ae_fabs(vr->ptr.pp_double[ii][iis], _state); - ae_v_muld(&vr->ptr.pp_double[1][iis], vr->stride, ae_v_len(1,ki), remax); - for(k=ki+1; k<=n; k++) - { - vr->ptr.pp_double[k][iis] = 0; - } - } - else - { - if( ki>1 ) - { - ae_v_move(&temp.ptr.p_double[1], 1, &vr->ptr.pp_double[1][ki], vr->stride, ae_v_len(1,n)); - matrixvectormultiply(vr, 1, n, 1, ki-1, ae_false, &work, 1+n, ki-1+n, 1.0, &temp, 1, n, work.ptr.p_double[ki+n], _state); - ae_v_move(&vr->ptr.pp_double[1][ki], vr->stride, &temp.ptr.p_double[1], 1, ae_v_len(1,n)); - } - ii = columnidxabsmax(vr, 1, n, ki, _state); - remax = 1/ae_fabs(vr->ptr.pp_double[ii][ki], _state); - ae_v_muld(&vr->ptr.pp_double[1][ki], vr->stride, ae_v_len(1,n), remax); - } - } - else - { - - /* - * Complex right eigenvector. - * - * Initial solve - * [ (T(KI-1,KI-1) T(KI-1,KI) ) - (WR + I* WI)]*X = 0. - * [ (T(KI,KI-1) T(KI,KI) ) ] - */ - if( ae_fp_greater_eq(ae_fabs(t->ptr.pp_double[ki-1][ki], _state),ae_fabs(t->ptr.pp_double[ki][ki-1], _state)) ) - { - work.ptr.p_double[ki-1+n] = 1; - work.ptr.p_double[ki+n2] = wi/t->ptr.pp_double[ki-1][ki]; - } - else - { - work.ptr.p_double[ki-1+n] = -wi/t->ptr.pp_double[ki][ki-1]; - work.ptr.p_double[ki+n2] = 1; - } - work.ptr.p_double[ki+n] = 0; - work.ptr.p_double[ki-1+n2] = 0; - - /* - * Form right-hand side - */ - for(k=1; k<=ki-2; k++) - { - work.ptr.p_double[k+n] = -work.ptr.p_double[ki-1+n]*t->ptr.pp_double[k][ki-1]; - work.ptr.p_double[k+n2] = -work.ptr.p_double[ki+n2]*t->ptr.pp_double[k][ki]; - } - - /* - * Solve upper quasi-triangular system: - * (T(1:KI-2,1:KI-2) - (WR+i*WI))*X = SCALE*(WORK+i*WORK2) - */ - jnxt = ki-2; - for(j=ki-2; j>=1; j--) - { - if( j>jnxt ) - { - continue; - } - j1 = j; - j2 = j; - jnxt = j-1; - if( j>1 ) - { - if( ae_fp_neq(t->ptr.pp_double[j][j-1],0) ) - { - j1 = j-1; - jnxt = j-2; - } - } - if( j1==j2 ) - { - - /* - * 1-by-1 diagonal block - */ - temp11.ptr.pp_double[1][1] = t->ptr.pp_double[j][j]; - temp12b.ptr.pp_double[1][1] = work.ptr.p_double[j+n]; - temp12b.ptr.pp_double[1][2] = work.ptr.p_double[j+n+n]; - evd_internalhsevdlaln2(ae_false, 1, 2, smin, 1.0, &temp11, 1.0, 1.0, &temp12b, wr, wi, &rswap4, &zswap4, &ipivot44, &civ4, &crv4, &x, &scl, &xnorm, &ierr, _state); - - /* - * Scale X(1,1) and X(1,2) to avoid overflow when - * updating the right-hand side. - */ - if( ae_fp_greater(xnorm,1) ) - { - if( ae_fp_greater(work.ptr.p_double[j],bignum/xnorm) ) - { - x.ptr.pp_double[1][1] = x.ptr.pp_double[1][1]/xnorm; - x.ptr.pp_double[1][2] = x.ptr.pp_double[1][2]/xnorm; - scl = scl/xnorm; - } - } - - /* - * Scale if necessary - */ - if( ae_fp_neq(scl,1) ) - { - k1 = 1+n; - k2 = ki+n; - ae_v_muld(&work.ptr.p_double[k1], 1, ae_v_len(k1,k2), scl); - k1 = 1+n2; - k2 = ki+n2; - ae_v_muld(&work.ptr.p_double[k1], 1, ae_v_len(k1,k2), scl); - } - work.ptr.p_double[j+n] = x.ptr.pp_double[1][1]; - work.ptr.p_double[j+n2] = x.ptr.pp_double[1][2]; - - /* - * Update the right-hand side - */ - k1 = 1+n; - k2 = j-1+n; - k3 = 1; - k4 = j-1; - vt = -x.ptr.pp_double[1][1]; - ae_v_addd(&work.ptr.p_double[k1], 1, &t->ptr.pp_double[k3][j], t->stride, ae_v_len(k1,k2), vt); - k1 = 1+n2; - k2 = j-1+n2; - k3 = 1; - k4 = j-1; - vt = -x.ptr.pp_double[1][2]; - ae_v_addd(&work.ptr.p_double[k1], 1, &t->ptr.pp_double[k3][j], t->stride, ae_v_len(k1,k2), vt); - } - else - { - - /* - * 2-by-2 diagonal block - */ - temp22.ptr.pp_double[1][1] = t->ptr.pp_double[j-1][j-1]; - temp22.ptr.pp_double[1][2] = t->ptr.pp_double[j-1][j]; - temp22.ptr.pp_double[2][1] = t->ptr.pp_double[j][j-1]; - temp22.ptr.pp_double[2][2] = t->ptr.pp_double[j][j]; - temp22b.ptr.pp_double[1][1] = work.ptr.p_double[j-1+n]; - temp22b.ptr.pp_double[1][2] = work.ptr.p_double[j-1+n+n]; - temp22b.ptr.pp_double[2][1] = work.ptr.p_double[j+n]; - temp22b.ptr.pp_double[2][2] = work.ptr.p_double[j+n+n]; - evd_internalhsevdlaln2(ae_false, 2, 2, smin, 1.0, &temp22, 1.0, 1.0, &temp22b, wr, wi, &rswap4, &zswap4, &ipivot44, &civ4, &crv4, &x, &scl, &xnorm, &ierr, _state); - - /* - * Scale X to avoid overflow when updating - * the right-hand side. - */ - if( ae_fp_greater(xnorm,1) ) - { - beta = ae_maxreal(work.ptr.p_double[j-1], work.ptr.p_double[j], _state); - if( ae_fp_greater(beta,bignum/xnorm) ) - { - rec = 1/xnorm; - x.ptr.pp_double[1][1] = x.ptr.pp_double[1][1]*rec; - x.ptr.pp_double[1][2] = x.ptr.pp_double[1][2]*rec; - x.ptr.pp_double[2][1] = x.ptr.pp_double[2][1]*rec; - x.ptr.pp_double[2][2] = x.ptr.pp_double[2][2]*rec; - scl = scl*rec; - } - } - - /* - * Scale if necessary - */ - if( ae_fp_neq(scl,1) ) - { - ae_v_muld(&work.ptr.p_double[1+n], 1, ae_v_len(1+n,ki+n), scl); - ae_v_muld(&work.ptr.p_double[1+n2], 1, ae_v_len(1+n2,ki+n2), scl); - } - work.ptr.p_double[j-1+n] = x.ptr.pp_double[1][1]; - work.ptr.p_double[j+n] = x.ptr.pp_double[2][1]; - work.ptr.p_double[j-1+n2] = x.ptr.pp_double[1][2]; - work.ptr.p_double[j+n2] = x.ptr.pp_double[2][2]; - - /* - * Update the right-hand side - */ - vt = -x.ptr.pp_double[1][1]; - ae_v_addd(&work.ptr.p_double[n+1], 1, &t->ptr.pp_double[1][j-1], t->stride, ae_v_len(n+1,n+j-2), vt); - vt = -x.ptr.pp_double[2][1]; - ae_v_addd(&work.ptr.p_double[n+1], 1, &t->ptr.pp_double[1][j], t->stride, ae_v_len(n+1,n+j-2), vt); - vt = -x.ptr.pp_double[1][2]; - ae_v_addd(&work.ptr.p_double[n2+1], 1, &t->ptr.pp_double[1][j-1], t->stride, ae_v_len(n2+1,n2+j-2), vt); - vt = -x.ptr.pp_double[2][2]; - ae_v_addd(&work.ptr.p_double[n2+1], 1, &t->ptr.pp_double[1][j], t->stride, ae_v_len(n2+1,n2+j-2), vt); - } - } - - /* - * Copy the vector x or Q*x to VR and normalize. - */ - if( !over ) - { - ae_v_move(&vr->ptr.pp_double[1][iis-1], vr->stride, &work.ptr.p_double[n+1], 1, ae_v_len(1,ki)); - ae_v_move(&vr->ptr.pp_double[1][iis], vr->stride, &work.ptr.p_double[n2+1], 1, ae_v_len(1,ki)); - emax = 0; - for(k=1; k<=ki; k++) - { - emax = ae_maxreal(emax, ae_fabs(vr->ptr.pp_double[k][iis-1], _state)+ae_fabs(vr->ptr.pp_double[k][iis], _state), _state); - } - remax = 1/emax; - ae_v_muld(&vr->ptr.pp_double[1][iis-1], vr->stride, ae_v_len(1,ki), remax); - ae_v_muld(&vr->ptr.pp_double[1][iis], vr->stride, ae_v_len(1,ki), remax); - for(k=ki+1; k<=n; k++) - { - vr->ptr.pp_double[k][iis-1] = 0; - vr->ptr.pp_double[k][iis] = 0; - } - } - else - { - if( ki>2 ) - { - ae_v_move(&temp.ptr.p_double[1], 1, &vr->ptr.pp_double[1][ki-1], vr->stride, ae_v_len(1,n)); - matrixvectormultiply(vr, 1, n, 1, ki-2, ae_false, &work, 1+n, ki-2+n, 1.0, &temp, 1, n, work.ptr.p_double[ki-1+n], _state); - ae_v_move(&vr->ptr.pp_double[1][ki-1], vr->stride, &temp.ptr.p_double[1], 1, ae_v_len(1,n)); - ae_v_move(&temp.ptr.p_double[1], 1, &vr->ptr.pp_double[1][ki], vr->stride, ae_v_len(1,n)); - matrixvectormultiply(vr, 1, n, 1, ki-2, ae_false, &work, 1+n2, ki-2+n2, 1.0, &temp, 1, n, work.ptr.p_double[ki+n2], _state); - ae_v_move(&vr->ptr.pp_double[1][ki], vr->stride, &temp.ptr.p_double[1], 1, ae_v_len(1,n)); - } - else - { - vt = work.ptr.p_double[ki-1+n]; - ae_v_muld(&vr->ptr.pp_double[1][ki-1], vr->stride, ae_v_len(1,n), vt); - vt = work.ptr.p_double[ki+n2]; - ae_v_muld(&vr->ptr.pp_double[1][ki], vr->stride, ae_v_len(1,n), vt); - } - emax = 0; - for(k=1; k<=n; k++) - { - emax = ae_maxreal(emax, ae_fabs(vr->ptr.pp_double[k][ki-1], _state)+ae_fabs(vr->ptr.pp_double[k][ki], _state), _state); - } - remax = 1/emax; - ae_v_muld(&vr->ptr.pp_double[1][ki-1], vr->stride, ae_v_len(1,n), remax); - ae_v_muld(&vr->ptr.pp_double[1][ki], vr->stride, ae_v_len(1,n), remax); - } - } - iis = iis-1; - if( ip!=0 ) - { - iis = iis-1; - } - } - if( ip==1 ) - { - ip = 0; - } - if( ip==-1 ) - { - ip = 1; - } - } - } - if( leftv ) - { - - /* - * Compute left eigenvectors. - */ - ip = 0; - iis = 1; - for(ki=1; ki<=n; ki++) - { - skipflag = ae_false; - if( ip==-1 ) - { - skipflag = ae_true; - } - else - { - if( ki!=n ) - { - if( ae_fp_neq(t->ptr.pp_double[ki+1][ki],0) ) - { - ip = 1; - } - } - if( somev ) - { - if( !vselect->ptr.p_bool[ki] ) - { - skipflag = ae_true; - } - } - } - if( !skipflag ) - { - - /* - * Compute the KI-th eigenvalue (WR,WI). - */ - wr = t->ptr.pp_double[ki][ki]; - wi = 0; - if( ip!=0 ) - { - wi = ae_sqrt(ae_fabs(t->ptr.pp_double[ki][ki+1], _state), _state)*ae_sqrt(ae_fabs(t->ptr.pp_double[ki+1][ki], _state), _state); - } - smin = ae_maxreal(ulp*(ae_fabs(wr, _state)+ae_fabs(wi, _state)), smlnum, _state); - if( ip==0 ) - { - - /* - * Real left eigenvector. - */ - work.ptr.p_double[ki+n] = 1; - - /* - * Form right-hand side - */ - for(k=ki+1; k<=n; k++) - { - work.ptr.p_double[k+n] = -t->ptr.pp_double[ki][k]; - } - - /* - * Solve the quasi-triangular system: - * (T(KI+1:N,KI+1:N) - WR)'*X = SCALE*WORK - */ - vmax = 1; - vcrit = bignum; - jnxt = ki+1; - for(j=ki+1; j<=n; j++) - { - if( jptr.pp_double[j+1][j],0) ) - { - j2 = j+1; - jnxt = j+2; - } - } - if( j1==j2 ) - { - - /* - * 1-by-1 diagonal block - * - * Scale if necessary to avoid overflow when forming - * the right-hand side. - */ - if( ae_fp_greater(work.ptr.p_double[j],vcrit) ) - { - rec = 1/vmax; - ae_v_muld(&work.ptr.p_double[ki+n], 1, ae_v_len(ki+n,n+n), rec); - vmax = 1; - vcrit = bignum; - } - vt = ae_v_dotproduct(&t->ptr.pp_double[ki+1][j], t->stride, &work.ptr.p_double[ki+1+n], 1, ae_v_len(ki+1,j-1)); - work.ptr.p_double[j+n] = work.ptr.p_double[j+n]-vt; - - /* - * Solve (T(J,J)-WR)'*X = WORK - */ - temp11.ptr.pp_double[1][1] = t->ptr.pp_double[j][j]; - temp11b.ptr.pp_double[1][1] = work.ptr.p_double[j+n]; - evd_internalhsevdlaln2(ae_false, 1, 1, smin, 1.0, &temp11, 1.0, 1.0, &temp11b, wr, 0, &rswap4, &zswap4, &ipivot44, &civ4, &crv4, &x, &scl, &xnorm, &ierr, _state); - - /* - * Scale if necessary - */ - if( ae_fp_neq(scl,1) ) - { - ae_v_muld(&work.ptr.p_double[ki+n], 1, ae_v_len(ki+n,n+n), scl); - } - work.ptr.p_double[j+n] = x.ptr.pp_double[1][1]; - vmax = ae_maxreal(ae_fabs(work.ptr.p_double[j+n], _state), vmax, _state); - vcrit = bignum/vmax; - } - else - { - - /* - * 2-by-2 diagonal block - * - * Scale if necessary to avoid overflow when forming - * the right-hand side. - */ - beta = ae_maxreal(work.ptr.p_double[j], work.ptr.p_double[j+1], _state); - if( ae_fp_greater(beta,vcrit) ) - { - rec = 1/vmax; - ae_v_muld(&work.ptr.p_double[ki+n], 1, ae_v_len(ki+n,n+n), rec); - vmax = 1; - vcrit = bignum; - } - vt = ae_v_dotproduct(&t->ptr.pp_double[ki+1][j], t->stride, &work.ptr.p_double[ki+1+n], 1, ae_v_len(ki+1,j-1)); - work.ptr.p_double[j+n] = work.ptr.p_double[j+n]-vt; - vt = ae_v_dotproduct(&t->ptr.pp_double[ki+1][j+1], t->stride, &work.ptr.p_double[ki+1+n], 1, ae_v_len(ki+1,j-1)); - work.ptr.p_double[j+1+n] = work.ptr.p_double[j+1+n]-vt; - - /* - * Solve - * [T(J,J)-WR T(J,J+1) ]'* X = SCALE*( WORK1 ) - * [T(J+1,J) T(J+1,J+1)-WR] ( WORK2 ) - */ - temp22.ptr.pp_double[1][1] = t->ptr.pp_double[j][j]; - temp22.ptr.pp_double[1][2] = t->ptr.pp_double[j][j+1]; - temp22.ptr.pp_double[2][1] = t->ptr.pp_double[j+1][j]; - temp22.ptr.pp_double[2][2] = t->ptr.pp_double[j+1][j+1]; - temp21b.ptr.pp_double[1][1] = work.ptr.p_double[j+n]; - temp21b.ptr.pp_double[2][1] = work.ptr.p_double[j+1+n]; - evd_internalhsevdlaln2(ae_true, 2, 1, smin, 1.0, &temp22, 1.0, 1.0, &temp21b, wr, 0, &rswap4, &zswap4, &ipivot44, &civ4, &crv4, &x, &scl, &xnorm, &ierr, _state); - - /* - * Scale if necessary - */ - if( ae_fp_neq(scl,1) ) - { - ae_v_muld(&work.ptr.p_double[ki+n], 1, ae_v_len(ki+n,n+n), scl); - } - work.ptr.p_double[j+n] = x.ptr.pp_double[1][1]; - work.ptr.p_double[j+1+n] = x.ptr.pp_double[2][1]; - vmax = ae_maxreal(ae_fabs(work.ptr.p_double[j+n], _state), ae_maxreal(ae_fabs(work.ptr.p_double[j+1+n], _state), vmax, _state), _state); - vcrit = bignum/vmax; - } - } - - /* - * Copy the vector x or Q*x to VL and normalize. - */ - if( !over ) - { - ae_v_move(&vl->ptr.pp_double[ki][iis], vl->stride, &work.ptr.p_double[ki+n], 1, ae_v_len(ki,n)); - ii = columnidxabsmax(vl, ki, n, iis, _state); - remax = 1/ae_fabs(vl->ptr.pp_double[ii][iis], _state); - ae_v_muld(&vl->ptr.pp_double[ki][iis], vl->stride, ae_v_len(ki,n), remax); - for(k=1; k<=ki-1; k++) - { - vl->ptr.pp_double[k][iis] = 0; - } - } - else - { - if( kiptr.pp_double[1][ki], vl->stride, ae_v_len(1,n)); - matrixvectormultiply(vl, 1, n, ki+1, n, ae_false, &work, ki+1+n, n+n, 1.0, &temp, 1, n, work.ptr.p_double[ki+n], _state); - ae_v_move(&vl->ptr.pp_double[1][ki], vl->stride, &temp.ptr.p_double[1], 1, ae_v_len(1,n)); - } - ii = columnidxabsmax(vl, 1, n, ki, _state); - remax = 1/ae_fabs(vl->ptr.pp_double[ii][ki], _state); - ae_v_muld(&vl->ptr.pp_double[1][ki], vl->stride, ae_v_len(1,n), remax); - } - } - else - { - - /* - * Complex left eigenvector. - * - * Initial solve: - * ((T(KI,KI) T(KI,KI+1) )' - (WR - I* WI))*X = 0. - * ((T(KI+1,KI) T(KI+1,KI+1)) ) - */ - if( ae_fp_greater_eq(ae_fabs(t->ptr.pp_double[ki][ki+1], _state),ae_fabs(t->ptr.pp_double[ki+1][ki], _state)) ) - { - work.ptr.p_double[ki+n] = wi/t->ptr.pp_double[ki][ki+1]; - work.ptr.p_double[ki+1+n2] = 1; - } - else - { - work.ptr.p_double[ki+n] = 1; - work.ptr.p_double[ki+1+n2] = -wi/t->ptr.pp_double[ki+1][ki]; - } - work.ptr.p_double[ki+1+n] = 0; - work.ptr.p_double[ki+n2] = 0; - - /* - * Form right-hand side - */ - for(k=ki+2; k<=n; k++) - { - work.ptr.p_double[k+n] = -work.ptr.p_double[ki+n]*t->ptr.pp_double[ki][k]; - work.ptr.p_double[k+n2] = -work.ptr.p_double[ki+1+n2]*t->ptr.pp_double[ki+1][k]; - } - - /* - * Solve complex quasi-triangular system: - * ( T(KI+2,N:KI+2,N) - (WR-i*WI) )*X = WORK1+i*WORK2 - */ - vmax = 1; - vcrit = bignum; - jnxt = ki+2; - for(j=ki+2; j<=n; j++) - { - if( jptr.pp_double[j+1][j],0) ) - { - j2 = j+1; - jnxt = j+2; - } - } - if( j1==j2 ) - { - - /* - * 1-by-1 diagonal block - * - * Scale if necessary to avoid overflow when - * forming the right-hand side elements. - */ - if( ae_fp_greater(work.ptr.p_double[j],vcrit) ) - { - rec = 1/vmax; - ae_v_muld(&work.ptr.p_double[ki+n], 1, ae_v_len(ki+n,n+n), rec); - ae_v_muld(&work.ptr.p_double[ki+n2], 1, ae_v_len(ki+n2,n+n2), rec); - vmax = 1; - vcrit = bignum; - } - vt = ae_v_dotproduct(&t->ptr.pp_double[ki+2][j], t->stride, &work.ptr.p_double[ki+2+n], 1, ae_v_len(ki+2,j-1)); - work.ptr.p_double[j+n] = work.ptr.p_double[j+n]-vt; - vt = ae_v_dotproduct(&t->ptr.pp_double[ki+2][j], t->stride, &work.ptr.p_double[ki+2+n2], 1, ae_v_len(ki+2,j-1)); - work.ptr.p_double[j+n2] = work.ptr.p_double[j+n2]-vt; - - /* - * Solve (T(J,J)-(WR-i*WI))*(X11+i*X12)= WK+I*WK2 - */ - temp11.ptr.pp_double[1][1] = t->ptr.pp_double[j][j]; - temp12b.ptr.pp_double[1][1] = work.ptr.p_double[j+n]; - temp12b.ptr.pp_double[1][2] = work.ptr.p_double[j+n+n]; - evd_internalhsevdlaln2(ae_false, 1, 2, smin, 1.0, &temp11, 1.0, 1.0, &temp12b, wr, -wi, &rswap4, &zswap4, &ipivot44, &civ4, &crv4, &x, &scl, &xnorm, &ierr, _state); - - /* - * Scale if necessary - */ - if( ae_fp_neq(scl,1) ) - { - ae_v_muld(&work.ptr.p_double[ki+n], 1, ae_v_len(ki+n,n+n), scl); - ae_v_muld(&work.ptr.p_double[ki+n2], 1, ae_v_len(ki+n2,n+n2), scl); - } - work.ptr.p_double[j+n] = x.ptr.pp_double[1][1]; - work.ptr.p_double[j+n2] = x.ptr.pp_double[1][2]; - vmax = ae_maxreal(ae_fabs(work.ptr.p_double[j+n], _state), ae_maxreal(ae_fabs(work.ptr.p_double[j+n2], _state), vmax, _state), _state); - vcrit = bignum/vmax; - } - else - { - - /* - * 2-by-2 diagonal block - * - * Scale if necessary to avoid overflow when forming - * the right-hand side elements. - */ - beta = ae_maxreal(work.ptr.p_double[j], work.ptr.p_double[j+1], _state); - if( ae_fp_greater(beta,vcrit) ) - { - rec = 1/vmax; - ae_v_muld(&work.ptr.p_double[ki+n], 1, ae_v_len(ki+n,n+n), rec); - ae_v_muld(&work.ptr.p_double[ki+n2], 1, ae_v_len(ki+n2,n+n2), rec); - vmax = 1; - vcrit = bignum; - } - vt = ae_v_dotproduct(&t->ptr.pp_double[ki+2][j], t->stride, &work.ptr.p_double[ki+2+n], 1, ae_v_len(ki+2,j-1)); - work.ptr.p_double[j+n] = work.ptr.p_double[j+n]-vt; - vt = ae_v_dotproduct(&t->ptr.pp_double[ki+2][j], t->stride, &work.ptr.p_double[ki+2+n2], 1, ae_v_len(ki+2,j-1)); - work.ptr.p_double[j+n2] = work.ptr.p_double[j+n2]-vt; - vt = ae_v_dotproduct(&t->ptr.pp_double[ki+2][j+1], t->stride, &work.ptr.p_double[ki+2+n], 1, ae_v_len(ki+2,j-1)); - work.ptr.p_double[j+1+n] = work.ptr.p_double[j+1+n]-vt; - vt = ae_v_dotproduct(&t->ptr.pp_double[ki+2][j+1], t->stride, &work.ptr.p_double[ki+2+n2], 1, ae_v_len(ki+2,j-1)); - work.ptr.p_double[j+1+n2] = work.ptr.p_double[j+1+n2]-vt; - - /* - * Solve 2-by-2 complex linear equation - * ([T(j,j) T(j,j+1) ]'-(wr-i*wi)*I)*X = SCALE*B - * ([T(j+1,j) T(j+1,j+1)] ) - */ - temp22.ptr.pp_double[1][1] = t->ptr.pp_double[j][j]; - temp22.ptr.pp_double[1][2] = t->ptr.pp_double[j][j+1]; - temp22.ptr.pp_double[2][1] = t->ptr.pp_double[j+1][j]; - temp22.ptr.pp_double[2][2] = t->ptr.pp_double[j+1][j+1]; - temp22b.ptr.pp_double[1][1] = work.ptr.p_double[j+n]; - temp22b.ptr.pp_double[1][2] = work.ptr.p_double[j+n+n]; - temp22b.ptr.pp_double[2][1] = work.ptr.p_double[j+1+n]; - temp22b.ptr.pp_double[2][2] = work.ptr.p_double[j+1+n+n]; - evd_internalhsevdlaln2(ae_true, 2, 2, smin, 1.0, &temp22, 1.0, 1.0, &temp22b, wr, -wi, &rswap4, &zswap4, &ipivot44, &civ4, &crv4, &x, &scl, &xnorm, &ierr, _state); - - /* - * Scale if necessary - */ - if( ae_fp_neq(scl,1) ) - { - ae_v_muld(&work.ptr.p_double[ki+n], 1, ae_v_len(ki+n,n+n), scl); - ae_v_muld(&work.ptr.p_double[ki+n2], 1, ae_v_len(ki+n2,n+n2), scl); - } - work.ptr.p_double[j+n] = x.ptr.pp_double[1][1]; - work.ptr.p_double[j+n2] = x.ptr.pp_double[1][2]; - work.ptr.p_double[j+1+n] = x.ptr.pp_double[2][1]; - work.ptr.p_double[j+1+n2] = x.ptr.pp_double[2][2]; - vmax = ae_maxreal(ae_fabs(x.ptr.pp_double[1][1], _state), vmax, _state); - vmax = ae_maxreal(ae_fabs(x.ptr.pp_double[1][2], _state), vmax, _state); - vmax = ae_maxreal(ae_fabs(x.ptr.pp_double[2][1], _state), vmax, _state); - vmax = ae_maxreal(ae_fabs(x.ptr.pp_double[2][2], _state), vmax, _state); - vcrit = bignum/vmax; - } - } - - /* - * Copy the vector x or Q*x to VL and normalize. - */ - if( !over ) - { - ae_v_move(&vl->ptr.pp_double[ki][iis], vl->stride, &work.ptr.p_double[ki+n], 1, ae_v_len(ki,n)); - ae_v_move(&vl->ptr.pp_double[ki][iis+1], vl->stride, &work.ptr.p_double[ki+n2], 1, ae_v_len(ki,n)); - emax = 0; - for(k=ki; k<=n; k++) - { - emax = ae_maxreal(emax, ae_fabs(vl->ptr.pp_double[k][iis], _state)+ae_fabs(vl->ptr.pp_double[k][iis+1], _state), _state); - } - remax = 1/emax; - ae_v_muld(&vl->ptr.pp_double[ki][iis], vl->stride, ae_v_len(ki,n), remax); - ae_v_muld(&vl->ptr.pp_double[ki][iis+1], vl->stride, ae_v_len(ki,n), remax); - for(k=1; k<=ki-1; k++) - { - vl->ptr.pp_double[k][iis] = 0; - vl->ptr.pp_double[k][iis+1] = 0; - } - } - else - { - if( kiptr.pp_double[1][ki], vl->stride, ae_v_len(1,n)); - matrixvectormultiply(vl, 1, n, ki+2, n, ae_false, &work, ki+2+n, n+n, 1.0, &temp, 1, n, work.ptr.p_double[ki+n], _state); - ae_v_move(&vl->ptr.pp_double[1][ki], vl->stride, &temp.ptr.p_double[1], 1, ae_v_len(1,n)); - ae_v_move(&temp.ptr.p_double[1], 1, &vl->ptr.pp_double[1][ki+1], vl->stride, ae_v_len(1,n)); - matrixvectormultiply(vl, 1, n, ki+2, n, ae_false, &work, ki+2+n2, n+n2, 1.0, &temp, 1, n, work.ptr.p_double[ki+1+n2], _state); - ae_v_move(&vl->ptr.pp_double[1][ki+1], vl->stride, &temp.ptr.p_double[1], 1, ae_v_len(1,n)); - } - else - { - vt = work.ptr.p_double[ki+n]; - ae_v_muld(&vl->ptr.pp_double[1][ki], vl->stride, ae_v_len(1,n), vt); - vt = work.ptr.p_double[ki+1+n2]; - ae_v_muld(&vl->ptr.pp_double[1][ki+1], vl->stride, ae_v_len(1,n), vt); - } - emax = 0; - for(k=1; k<=n; k++) - { - emax = ae_maxreal(emax, ae_fabs(vl->ptr.pp_double[k][ki], _state)+ae_fabs(vl->ptr.pp_double[k][ki+1], _state), _state); - } - remax = 1/emax; - ae_v_muld(&vl->ptr.pp_double[1][ki], vl->stride, ae_v_len(1,n), remax); - ae_v_muld(&vl->ptr.pp_double[1][ki+1], vl->stride, ae_v_len(1,n), remax); - } - } - iis = iis+1; - if( ip!=0 ) - { - iis = iis+1; - } - } - if( ip==-1 ) - { - ip = 0; - } - if( ip==1 ) - { - ip = -1; - } - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -DLALN2 solves a system of the form (ca A - w D ) X = s B -or (ca A' - w D) X = s B with possible scaling ("s") and -perturbation of A. (A' means A-transpose.) - -A is an NA x NA real matrix, ca is a real scalar, D is an NA x NA -real diagonal matrix, w is a real or complex value, and X and B are -NA x 1 matrices -- real if w is real, complex if w is complex. NA -may be 1 or 2. - -If w is complex, X and B are represented as NA x 2 matrices, -the first column of each being the real part and the second -being the imaginary part. - -"s" is a scaling factor (.LE. 1), computed by DLALN2, which is -so chosen that X can be computed without overflow. X is further -scaled if necessary to assure that norm(ca A - w D)*norm(X) is less -than overflow. - -If both singular values of (ca A - w D) are less than SMIN, -SMIN*identity will be used instead of (ca A - w D). If only one -singular value is less than SMIN, one element of (ca A - w D) will be -perturbed enough to make the smallest singular value roughly SMIN. -If both singular values are at least SMIN, (ca A - w D) will not be -perturbed. In any case, the perturbation will be at most some small -multiple of max( SMIN, ulp*norm(ca A - w D) ). The singular values -are computed by infinity-norm approximations, and thus will only be -correct to a factor of 2 or so. - -Note: all input quantities are assumed to be smaller than overflow -by a reasonable factor. (See BIGNUM.) - - -- LAPACK auxiliary routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - October 31, 1992 -*************************************************************************/ -static void evd_internalhsevdlaln2(ae_bool ltrans, - ae_int_t na, - ae_int_t nw, - double smin, - double ca, - /* Real */ ae_matrix* a, - double d1, - double d2, - /* Real */ ae_matrix* b, - double wr, - double wi, - /* Boolean */ ae_vector* rswap4, - /* Boolean */ ae_vector* zswap4, - /* Integer */ ae_matrix* ipivot44, - /* Real */ ae_vector* civ4, - /* Real */ ae_vector* crv4, - /* Real */ ae_matrix* x, - double* scl, - double* xnorm, - ae_int_t* info, - ae_state *_state) -{ - ae_int_t icmax; - ae_int_t j; - double bbnd; - double bi1; - double bi2; - double bignum; - double bnorm; - double br1; - double br2; - double ci21; - double ci22; - double cmax; - double cnorm; - double cr21; - double cr22; - double csi; - double csr; - double li21; - double lr21; - double smini; - double smlnum; - double temp; - double u22abs; - double ui11; - double ui11r; - double ui12; - double ui12s; - double ui22; - double ur11; - double ur11r; - double ur12; - double ur12s; - double ur22; - double xi1; - double xi2; - double xr1; - double xr2; - double tmp1; - double tmp2; - - *scl = 0; - *xnorm = 0; - *info = 0; - - zswap4->ptr.p_bool[1] = ae_false; - zswap4->ptr.p_bool[2] = ae_false; - zswap4->ptr.p_bool[3] = ae_true; - zswap4->ptr.p_bool[4] = ae_true; - rswap4->ptr.p_bool[1] = ae_false; - rswap4->ptr.p_bool[2] = ae_true; - rswap4->ptr.p_bool[3] = ae_false; - rswap4->ptr.p_bool[4] = ae_true; - ipivot44->ptr.pp_int[1][1] = 1; - ipivot44->ptr.pp_int[2][1] = 2; - ipivot44->ptr.pp_int[3][1] = 3; - ipivot44->ptr.pp_int[4][1] = 4; - ipivot44->ptr.pp_int[1][2] = 2; - ipivot44->ptr.pp_int[2][2] = 1; - ipivot44->ptr.pp_int[3][2] = 4; - ipivot44->ptr.pp_int[4][2] = 3; - ipivot44->ptr.pp_int[1][3] = 3; - ipivot44->ptr.pp_int[2][3] = 4; - ipivot44->ptr.pp_int[3][3] = 1; - ipivot44->ptr.pp_int[4][3] = 2; - ipivot44->ptr.pp_int[1][4] = 4; - ipivot44->ptr.pp_int[2][4] = 3; - ipivot44->ptr.pp_int[3][4] = 2; - ipivot44->ptr.pp_int[4][4] = 1; - smlnum = 2*ae_minrealnumber; - bignum = 1/smlnum; - smini = ae_maxreal(smin, smlnum, _state); - - /* - * Don't check for input errors - */ - *info = 0; - - /* - * Standard Initializations - */ - *scl = 1; - if( na==1 ) - { - - /* - * 1 x 1 (i.e., scalar) system C X = B - */ - if( nw==1 ) - { - - /* - * Real 1x1 system. - * - * C = ca A - w D - */ - csr = ca*a->ptr.pp_double[1][1]-wr*d1; - cnorm = ae_fabs(csr, _state); - - /* - * If | C | < SMINI, use C = SMINI - */ - if( ae_fp_less(cnorm,smini) ) - { - csr = smini; - cnorm = smini; - *info = 1; - } - - /* - * Check scaling for X = B / C - */ - bnorm = ae_fabs(b->ptr.pp_double[1][1], _state); - if( ae_fp_less(cnorm,1)&&ae_fp_greater(bnorm,1) ) - { - if( ae_fp_greater(bnorm,bignum*cnorm) ) - { - *scl = 1/bnorm; - } - } - - /* - * Compute X - */ - x->ptr.pp_double[1][1] = b->ptr.pp_double[1][1]*(*scl)/csr; - *xnorm = ae_fabs(x->ptr.pp_double[1][1], _state); - } - else - { - - /* - * Complex 1x1 system (w is complex) - * - * C = ca A - w D - */ - csr = ca*a->ptr.pp_double[1][1]-wr*d1; - csi = -wi*d1; - cnorm = ae_fabs(csr, _state)+ae_fabs(csi, _state); - - /* - * If | C | < SMINI, use C = SMINI - */ - if( ae_fp_less(cnorm,smini) ) - { - csr = smini; - csi = 0; - cnorm = smini; - *info = 1; - } - - /* - * Check scaling for X = B / C - */ - bnorm = ae_fabs(b->ptr.pp_double[1][1], _state)+ae_fabs(b->ptr.pp_double[1][2], _state); - if( ae_fp_less(cnorm,1)&&ae_fp_greater(bnorm,1) ) - { - if( ae_fp_greater(bnorm,bignum*cnorm) ) - { - *scl = 1/bnorm; - } - } - - /* - * Compute X - */ - evd_internalhsevdladiv(*scl*b->ptr.pp_double[1][1], *scl*b->ptr.pp_double[1][2], csr, csi, &tmp1, &tmp2, _state); - x->ptr.pp_double[1][1] = tmp1; - x->ptr.pp_double[1][2] = tmp2; - *xnorm = ae_fabs(x->ptr.pp_double[1][1], _state)+ae_fabs(x->ptr.pp_double[1][2], _state); - } - } - else - { - - /* - * 2x2 System - * - * Compute the real part of C = ca A - w D (or ca A' - w D ) - */ - crv4->ptr.p_double[1+0] = ca*a->ptr.pp_double[1][1]-wr*d1; - crv4->ptr.p_double[2+2] = ca*a->ptr.pp_double[2][2]-wr*d2; - if( ltrans ) - { - crv4->ptr.p_double[1+2] = ca*a->ptr.pp_double[2][1]; - crv4->ptr.p_double[2+0] = ca*a->ptr.pp_double[1][2]; - } - else - { - crv4->ptr.p_double[2+0] = ca*a->ptr.pp_double[2][1]; - crv4->ptr.p_double[1+2] = ca*a->ptr.pp_double[1][2]; - } - if( nw==1 ) - { - - /* - * Real 2x2 system (w is real) - * - * Find the largest element in C - */ - cmax = 0; - icmax = 0; - for(j=1; j<=4; j++) - { - if( ae_fp_greater(ae_fabs(crv4->ptr.p_double[j], _state),cmax) ) - { - cmax = ae_fabs(crv4->ptr.p_double[j], _state); - icmax = j; - } - } - - /* - * If norm(C) < SMINI, use SMINI*identity. - */ - if( ae_fp_less(cmax,smini) ) - { - bnorm = ae_maxreal(ae_fabs(b->ptr.pp_double[1][1], _state), ae_fabs(b->ptr.pp_double[2][1], _state), _state); - if( ae_fp_less(smini,1)&&ae_fp_greater(bnorm,1) ) - { - if( ae_fp_greater(bnorm,bignum*smini) ) - { - *scl = 1/bnorm; - } - } - temp = *scl/smini; - x->ptr.pp_double[1][1] = temp*b->ptr.pp_double[1][1]; - x->ptr.pp_double[2][1] = temp*b->ptr.pp_double[2][1]; - *xnorm = temp*bnorm; - *info = 1; - return; - } - - /* - * Gaussian elimination with complete pivoting. - */ - ur11 = crv4->ptr.p_double[icmax]; - cr21 = crv4->ptr.p_double[ipivot44->ptr.pp_int[2][icmax]]; - ur12 = crv4->ptr.p_double[ipivot44->ptr.pp_int[3][icmax]]; - cr22 = crv4->ptr.p_double[ipivot44->ptr.pp_int[4][icmax]]; - ur11r = 1/ur11; - lr21 = ur11r*cr21; - ur22 = cr22-ur12*lr21; - - /* - * If smaller pivot < SMINI, use SMINI - */ - if( ae_fp_less(ae_fabs(ur22, _state),smini) ) - { - ur22 = smini; - *info = 1; - } - if( rswap4->ptr.p_bool[icmax] ) - { - br1 = b->ptr.pp_double[2][1]; - br2 = b->ptr.pp_double[1][1]; - } - else - { - br1 = b->ptr.pp_double[1][1]; - br2 = b->ptr.pp_double[2][1]; - } - br2 = br2-lr21*br1; - bbnd = ae_maxreal(ae_fabs(br1*(ur22*ur11r), _state), ae_fabs(br2, _state), _state); - if( ae_fp_greater(bbnd,1)&&ae_fp_less(ae_fabs(ur22, _state),1) ) - { - if( ae_fp_greater_eq(bbnd,bignum*ae_fabs(ur22, _state)) ) - { - *scl = 1/bbnd; - } - } - xr2 = br2*(*scl)/ur22; - xr1 = *scl*br1*ur11r-xr2*(ur11r*ur12); - if( zswap4->ptr.p_bool[icmax] ) - { - x->ptr.pp_double[1][1] = xr2; - x->ptr.pp_double[2][1] = xr1; - } - else - { - x->ptr.pp_double[1][1] = xr1; - x->ptr.pp_double[2][1] = xr2; - } - *xnorm = ae_maxreal(ae_fabs(xr1, _state), ae_fabs(xr2, _state), _state); - - /* - * Further scaling if norm(A) norm(X) > overflow - */ - if( ae_fp_greater(*xnorm,1)&&ae_fp_greater(cmax,1) ) - { - if( ae_fp_greater(*xnorm,bignum/cmax) ) - { - temp = cmax/bignum; - x->ptr.pp_double[1][1] = temp*x->ptr.pp_double[1][1]; - x->ptr.pp_double[2][1] = temp*x->ptr.pp_double[2][1]; - *xnorm = temp*(*xnorm); - *scl = temp*(*scl); - } - } - } - else - { - - /* - * Complex 2x2 system (w is complex) - * - * Find the largest element in C - */ - civ4->ptr.p_double[1+0] = -wi*d1; - civ4->ptr.p_double[2+0] = 0; - civ4->ptr.p_double[1+2] = 0; - civ4->ptr.p_double[2+2] = -wi*d2; - cmax = 0; - icmax = 0; - for(j=1; j<=4; j++) - { - if( ae_fp_greater(ae_fabs(crv4->ptr.p_double[j], _state)+ae_fabs(civ4->ptr.p_double[j], _state),cmax) ) - { - cmax = ae_fabs(crv4->ptr.p_double[j], _state)+ae_fabs(civ4->ptr.p_double[j], _state); - icmax = j; - } - } - - /* - * If norm(C) < SMINI, use SMINI*identity. - */ - if( ae_fp_less(cmax,smini) ) - { - bnorm = ae_maxreal(ae_fabs(b->ptr.pp_double[1][1], _state)+ae_fabs(b->ptr.pp_double[1][2], _state), ae_fabs(b->ptr.pp_double[2][1], _state)+ae_fabs(b->ptr.pp_double[2][2], _state), _state); - if( ae_fp_less(smini,1)&&ae_fp_greater(bnorm,1) ) - { - if( ae_fp_greater(bnorm,bignum*smini) ) - { - *scl = 1/bnorm; - } - } - temp = *scl/smini; - x->ptr.pp_double[1][1] = temp*b->ptr.pp_double[1][1]; - x->ptr.pp_double[2][1] = temp*b->ptr.pp_double[2][1]; - x->ptr.pp_double[1][2] = temp*b->ptr.pp_double[1][2]; - x->ptr.pp_double[2][2] = temp*b->ptr.pp_double[2][2]; - *xnorm = temp*bnorm; - *info = 1; - return; - } - - /* - * Gaussian elimination with complete pivoting. - */ - ur11 = crv4->ptr.p_double[icmax]; - ui11 = civ4->ptr.p_double[icmax]; - cr21 = crv4->ptr.p_double[ipivot44->ptr.pp_int[2][icmax]]; - ci21 = civ4->ptr.p_double[ipivot44->ptr.pp_int[2][icmax]]; - ur12 = crv4->ptr.p_double[ipivot44->ptr.pp_int[3][icmax]]; - ui12 = civ4->ptr.p_double[ipivot44->ptr.pp_int[3][icmax]]; - cr22 = crv4->ptr.p_double[ipivot44->ptr.pp_int[4][icmax]]; - ci22 = civ4->ptr.p_double[ipivot44->ptr.pp_int[4][icmax]]; - if( icmax==1||icmax==4 ) - { - - /* - * Code when off-diagonals of pivoted C are real - */ - if( ae_fp_greater(ae_fabs(ur11, _state),ae_fabs(ui11, _state)) ) - { - temp = ui11/ur11; - ur11r = 1/(ur11*(1+ae_sqr(temp, _state))); - ui11r = -temp*ur11r; - } - else - { - temp = ur11/ui11; - ui11r = -1/(ui11*(1+ae_sqr(temp, _state))); - ur11r = -temp*ui11r; - } - lr21 = cr21*ur11r; - li21 = cr21*ui11r; - ur12s = ur12*ur11r; - ui12s = ur12*ui11r; - ur22 = cr22-ur12*lr21; - ui22 = ci22-ur12*li21; - } - else - { - - /* - * Code when diagonals of pivoted C are real - */ - ur11r = 1/ur11; - ui11r = 0; - lr21 = cr21*ur11r; - li21 = ci21*ur11r; - ur12s = ur12*ur11r; - ui12s = ui12*ur11r; - ur22 = cr22-ur12*lr21+ui12*li21; - ui22 = -ur12*li21-ui12*lr21; - } - u22abs = ae_fabs(ur22, _state)+ae_fabs(ui22, _state); - - /* - * If smaller pivot < SMINI, use SMINI - */ - if( ae_fp_less(u22abs,smini) ) - { - ur22 = smini; - ui22 = 0; - *info = 1; - } - if( rswap4->ptr.p_bool[icmax] ) - { - br2 = b->ptr.pp_double[1][1]; - br1 = b->ptr.pp_double[2][1]; - bi2 = b->ptr.pp_double[1][2]; - bi1 = b->ptr.pp_double[2][2]; - } - else - { - br1 = b->ptr.pp_double[1][1]; - br2 = b->ptr.pp_double[2][1]; - bi1 = b->ptr.pp_double[1][2]; - bi2 = b->ptr.pp_double[2][2]; - } - br2 = br2-lr21*br1+li21*bi1; - bi2 = bi2-li21*br1-lr21*bi1; - bbnd = ae_maxreal((ae_fabs(br1, _state)+ae_fabs(bi1, _state))*(u22abs*(ae_fabs(ur11r, _state)+ae_fabs(ui11r, _state))), ae_fabs(br2, _state)+ae_fabs(bi2, _state), _state); - if( ae_fp_greater(bbnd,1)&&ae_fp_less(u22abs,1) ) - { - if( ae_fp_greater_eq(bbnd,bignum*u22abs) ) - { - *scl = 1/bbnd; - br1 = *scl*br1; - bi1 = *scl*bi1; - br2 = *scl*br2; - bi2 = *scl*bi2; - } - } - evd_internalhsevdladiv(br2, bi2, ur22, ui22, &xr2, &xi2, _state); - xr1 = ur11r*br1-ui11r*bi1-ur12s*xr2+ui12s*xi2; - xi1 = ui11r*br1+ur11r*bi1-ui12s*xr2-ur12s*xi2; - if( zswap4->ptr.p_bool[icmax] ) - { - x->ptr.pp_double[1][1] = xr2; - x->ptr.pp_double[2][1] = xr1; - x->ptr.pp_double[1][2] = xi2; - x->ptr.pp_double[2][2] = xi1; - } - else - { - x->ptr.pp_double[1][1] = xr1; - x->ptr.pp_double[2][1] = xr2; - x->ptr.pp_double[1][2] = xi1; - x->ptr.pp_double[2][2] = xi2; - } - *xnorm = ae_maxreal(ae_fabs(xr1, _state)+ae_fabs(xi1, _state), ae_fabs(xr2, _state)+ae_fabs(xi2, _state), _state); - - /* - * Further scaling if norm(A) norm(X) > overflow - */ - if( ae_fp_greater(*xnorm,1)&&ae_fp_greater(cmax,1) ) - { - if( ae_fp_greater(*xnorm,bignum/cmax) ) - { - temp = cmax/bignum; - x->ptr.pp_double[1][1] = temp*x->ptr.pp_double[1][1]; - x->ptr.pp_double[2][1] = temp*x->ptr.pp_double[2][1]; - x->ptr.pp_double[1][2] = temp*x->ptr.pp_double[1][2]; - x->ptr.pp_double[2][2] = temp*x->ptr.pp_double[2][2]; - *xnorm = temp*(*xnorm); - *scl = temp*(*scl); - } - } - } - } -} - - -/************************************************************************* -performs complex division in real arithmetic - - a + i*b - p + i*q = --------- - c + i*d - -The algorithm is due to Robert L. Smith and can be found -in D. Knuth, The art of Computer Programming, Vol.2, p.195 - - -- LAPACK auxiliary routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - October 31, 1992 -*************************************************************************/ -static void evd_internalhsevdladiv(double a, - double b, - double c, - double d, - double* p, - double* q, - ae_state *_state) -{ - double e; - double f; - - *p = 0; - *q = 0; - - if( ae_fp_less(ae_fabs(d, _state),ae_fabs(c, _state)) ) - { - e = d/c; - f = c+d*e; - *p = (a+b*e)/f; - *q = (b-a*e)/f; - } - else - { - e = c/d; - f = d+c*e; - *p = (b+a*e)/f; - *q = (-a+b*e)/f; - } -} - - -static ae_bool evd_nonsymmetricevd(/* Real */ ae_matrix* a, - ae_int_t n, - ae_int_t vneeded, - /* Real */ ae_vector* wr, - /* Real */ ae_vector* wi, - /* Real */ ae_matrix* vl, - /* Real */ ae_matrix* vr, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix _a; - ae_matrix s; - ae_vector tau; - ae_vector sel; - ae_int_t i; - ae_int_t info; - ae_int_t m; - ae_bool result; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init_copy(&_a, a, _state, ae_true); - a = &_a; - ae_vector_clear(wr); - ae_vector_clear(wi); - ae_matrix_clear(vl); - ae_matrix_clear(vr); - ae_matrix_init(&s, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tau, 0, DT_REAL, _state, ae_true); - ae_vector_init(&sel, 0, DT_BOOL, _state, ae_true); - - ae_assert(vneeded>=0&&vneeded<=3, "NonSymmetricEVD: incorrect VNeeded!", _state); - if( vneeded==0 ) - { - - /* - * Eigen values only - */ - evd_toupperhessenberg(a, n, &tau, _state); - internalschurdecomposition(a, n, 0, 0, wr, wi, &s, &info, _state); - result = info==0; - ae_frame_leave(_state); - return result; - } - - /* - * Eigen values and vectors - */ - evd_toupperhessenberg(a, n, &tau, _state); - evd_unpackqfromupperhessenberg(a, n, &tau, &s, _state); - internalschurdecomposition(a, n, 1, 1, wr, wi, &s, &info, _state); - result = info==0; - if( !result ) - { - ae_frame_leave(_state); - return result; - } - if( vneeded==1||vneeded==3 ) - { - ae_matrix_set_length(vr, n+1, n+1, _state); - for(i=1; i<=n; i++) - { - ae_v_move(&vr->ptr.pp_double[i][1], 1, &s.ptr.pp_double[i][1], 1, ae_v_len(1,n)); - } - } - if( vneeded==2||vneeded==3 ) - { - ae_matrix_set_length(vl, n+1, n+1, _state); - for(i=1; i<=n; i++) - { - ae_v_move(&vl->ptr.pp_double[i][1], 1, &s.ptr.pp_double[i][1], 1, ae_v_len(1,n)); - } - } - evd_internaltrevc(a, n, vneeded, 1, &sel, vl, vr, &m, &info, _state); - result = info==0; - ae_frame_leave(_state); - return result; -} - - -static void evd_toupperhessenberg(/* Real */ ae_matrix* a, - ae_int_t n, - /* Real */ ae_vector* tau, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t ip1; - ae_int_t nmi; - double v; - ae_vector t; - ae_vector work; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(tau); - ae_vector_init(&t, 0, DT_REAL, _state, ae_true); - ae_vector_init(&work, 0, DT_REAL, _state, ae_true); - - ae_assert(n>=0, "ToUpperHessenberg: incorrect N!", _state); - - /* - * Quick return if possible - */ - if( n<=1 ) - { - ae_frame_leave(_state); - return; - } - ae_vector_set_length(tau, n-1+1, _state); - ae_vector_set_length(&t, n+1, _state); - ae_vector_set_length(&work, n+1, _state); - for(i=1; i<=n-1; i++) - { - - /* - * Compute elementary reflector H(i) to annihilate A(i+2:ihi,i) - */ - ip1 = i+1; - nmi = n-i; - ae_v_move(&t.ptr.p_double[1], 1, &a->ptr.pp_double[ip1][i], a->stride, ae_v_len(1,nmi)); - generatereflection(&t, nmi, &v, _state); - ae_v_move(&a->ptr.pp_double[ip1][i], a->stride, &t.ptr.p_double[1], 1, ae_v_len(ip1,n)); - tau->ptr.p_double[i] = v; - t.ptr.p_double[1] = 1; - - /* - * Apply H(i) to A(1:ihi,i+1:ihi) from the right - */ - applyreflectionfromtheright(a, v, &t, 1, n, i+1, n, &work, _state); - - /* - * Apply H(i) to A(i+1:ihi,i+1:n) from the left - */ - applyreflectionfromtheleft(a, v, &t, i+1, n, i+1, n, &work, _state); - } - ae_frame_leave(_state); -} - - -static void evd_unpackqfromupperhessenberg(/* Real */ ae_matrix* a, - ae_int_t n, - /* Real */ ae_vector* tau, - /* Real */ ae_matrix* q, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - ae_vector v; - ae_vector work; - ae_int_t ip1; - ae_int_t nmi; - - ae_frame_make(_state, &_frame_block); - ae_matrix_clear(q); - ae_vector_init(&v, 0, DT_REAL, _state, ae_true); - ae_vector_init(&work, 0, DT_REAL, _state, ae_true); - - if( n==0 ) - { - ae_frame_leave(_state); - return; - } - - /* - * init - */ - ae_matrix_set_length(q, n+1, n+1, _state); - ae_vector_set_length(&v, n+1, _state); - ae_vector_set_length(&work, n+1, _state); - for(i=1; i<=n; i++) - { - for(j=1; j<=n; j++) - { - if( i==j ) - { - q->ptr.pp_double[i][j] = 1; - } - else - { - q->ptr.pp_double[i][j] = 0; - } - } - } - - /* - * unpack Q - */ - for(i=1; i<=n-1; i++) - { - - /* - * Apply H(i) - */ - ip1 = i+1; - nmi = n-i; - ae_v_move(&v.ptr.p_double[1], 1, &a->ptr.pp_double[ip1][i], a->stride, ae_v_len(1,nmi)); - v.ptr.p_double[1] = 1; - applyreflectionfromtheright(q, tau->ptr.p_double[i], &v, 1, n, i+1, n, &work, _state); - } - ae_frame_leave(_state); -} - - - - -/************************************************************************* -Generation of a random uniformly distributed (Haar) orthogonal matrix - -INPUT PARAMETERS: - N - matrix size, N>=1 - -OUTPUT PARAMETERS: - A - orthogonal NxN matrix, array[0..N-1,0..N-1] - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void rmatrixrndorthogonal(ae_int_t n, - /* Real */ ae_matrix* a, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - - ae_matrix_clear(a); - - ae_assert(n>=1, "RMatrixRndOrthogonal: N<1!", _state); - ae_matrix_set_length(a, n, n, _state); - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - if( i==j ) - { - a->ptr.pp_double[i][j] = 1; - } - else - { - a->ptr.pp_double[i][j] = 0; - } - } - } - rmatrixrndorthogonalfromtheright(a, n, n, _state); -} - - -/************************************************************************* -Generation of random NxN matrix with given condition number and norm2(A)=1 - -INPUT PARAMETERS: - N - matrix size - C - condition number (in 2-norm) - -OUTPUT PARAMETERS: - A - random matrix with norm2(A)=1 and cond(A)=C - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void rmatrixrndcond(ae_int_t n, - double c, - /* Real */ ae_matrix* a, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - double l1; - double l2; - hqrndstate rs; - - ae_frame_make(_state, &_frame_block); - ae_matrix_clear(a); - _hqrndstate_init(&rs, _state, ae_true); - - ae_assert(n>=1&&ae_fp_greater_eq(c,1), "RMatrixRndCond: N<1 or C<1!", _state); - ae_matrix_set_length(a, n, n, _state); - if( n==1 ) - { - - /* - * special case - */ - a->ptr.pp_double[0][0] = 2*ae_randominteger(2, _state)-1; - ae_frame_leave(_state); - return; - } - hqrndrandomize(&rs, _state); - l1 = 0; - l2 = ae_log(1/c, _state); - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - a->ptr.pp_double[i][j] = 0; - } - } - a->ptr.pp_double[0][0] = ae_exp(l1, _state); - for(i=1; i<=n-2; i++) - { - a->ptr.pp_double[i][i] = ae_exp(hqrnduniformr(&rs, _state)*(l2-l1)+l1, _state); - } - a->ptr.pp_double[n-1][n-1] = ae_exp(l2, _state); - rmatrixrndorthogonalfromtheleft(a, n, n, _state); - rmatrixrndorthogonalfromtheright(a, n, n, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Generation of a random Haar distributed orthogonal complex matrix - -INPUT PARAMETERS: - N - matrix size, N>=1 - -OUTPUT PARAMETERS: - A - orthogonal NxN matrix, array[0..N-1,0..N-1] - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void cmatrixrndorthogonal(ae_int_t n, - /* Complex */ ae_matrix* a, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - - ae_matrix_clear(a); - - ae_assert(n>=1, "CMatrixRndOrthogonal: N<1!", _state); - ae_matrix_set_length(a, n, n, _state); - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - if( i==j ) - { - a->ptr.pp_complex[i][j] = ae_complex_from_d(1); - } - else - { - a->ptr.pp_complex[i][j] = ae_complex_from_d(0); - } - } - } - cmatrixrndorthogonalfromtheright(a, n, n, _state); -} - - -/************************************************************************* -Generation of random NxN complex matrix with given condition number C and -norm2(A)=1 - -INPUT PARAMETERS: - N - matrix size - C - condition number (in 2-norm) - -OUTPUT PARAMETERS: - A - random matrix with norm2(A)=1 and cond(A)=C - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void cmatrixrndcond(ae_int_t n, - double c, - /* Complex */ ae_matrix* a, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - double l1; - double l2; - hqrndstate state; - ae_complex v; - - ae_frame_make(_state, &_frame_block); - ae_matrix_clear(a); - _hqrndstate_init(&state, _state, ae_true); - - ae_assert(n>=1&&ae_fp_greater_eq(c,1), "CMatrixRndCond: N<1 or C<1!", _state); - ae_matrix_set_length(a, n, n, _state); - if( n==1 ) - { - - /* - * special case - */ - hqrndrandomize(&state, _state); - hqrndunit2(&state, &v.x, &v.y, _state); - a->ptr.pp_complex[0][0] = v; - ae_frame_leave(_state); - return; - } - hqrndrandomize(&state, _state); - l1 = 0; - l2 = ae_log(1/c, _state); - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - a->ptr.pp_complex[i][j] = ae_complex_from_d(0); - } - } - a->ptr.pp_complex[0][0] = ae_complex_from_d(ae_exp(l1, _state)); - for(i=1; i<=n-2; i++) - { - a->ptr.pp_complex[i][i] = ae_complex_from_d(ae_exp(hqrnduniformr(&state, _state)*(l2-l1)+l1, _state)); - } - a->ptr.pp_complex[n-1][n-1] = ae_complex_from_d(ae_exp(l2, _state)); - cmatrixrndorthogonalfromtheleft(a, n, n, _state); - cmatrixrndorthogonalfromtheright(a, n, n, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Generation of random NxN symmetric matrix with given condition number and -norm2(A)=1 - -INPUT PARAMETERS: - N - matrix size - C - condition number (in 2-norm) - -OUTPUT PARAMETERS: - A - random matrix with norm2(A)=1 and cond(A)=C - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void smatrixrndcond(ae_int_t n, - double c, - /* Real */ ae_matrix* a, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - double l1; - double l2; - hqrndstate rs; - - ae_frame_make(_state, &_frame_block); - ae_matrix_clear(a); - _hqrndstate_init(&rs, _state, ae_true); - - ae_assert(n>=1&&ae_fp_greater_eq(c,1), "SMatrixRndCond: N<1 or C<1!", _state); - ae_matrix_set_length(a, n, n, _state); - if( n==1 ) - { - - /* - * special case - */ - a->ptr.pp_double[0][0] = 2*ae_randominteger(2, _state)-1; - ae_frame_leave(_state); - return; - } - - /* - * Prepare matrix - */ - hqrndrandomize(&rs, _state); - l1 = 0; - l2 = ae_log(1/c, _state); - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - a->ptr.pp_double[i][j] = 0; - } - } - a->ptr.pp_double[0][0] = ae_exp(l1, _state); - for(i=1; i<=n-2; i++) - { - a->ptr.pp_double[i][i] = (2*hqrnduniformi(&rs, 2, _state)-1)*ae_exp(hqrnduniformr(&rs, _state)*(l2-l1)+l1, _state); - } - a->ptr.pp_double[n-1][n-1] = ae_exp(l2, _state); - - /* - * Multiply - */ - smatrixrndmultiply(a, n, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Generation of random NxN symmetric positive definite matrix with given -condition number and norm2(A)=1 - -INPUT PARAMETERS: - N - matrix size - C - condition number (in 2-norm) - -OUTPUT PARAMETERS: - A - random SPD matrix with norm2(A)=1 and cond(A)=C - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void spdmatrixrndcond(ae_int_t n, - double c, - /* Real */ ae_matrix* a, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - double l1; - double l2; - hqrndstate rs; - - ae_frame_make(_state, &_frame_block); - ae_matrix_clear(a); - _hqrndstate_init(&rs, _state, ae_true); - - - /* - * Special cases - */ - if( n<=0||ae_fp_less(c,1) ) - { - ae_frame_leave(_state); - return; - } - ae_matrix_set_length(a, n, n, _state); - if( n==1 ) - { - a->ptr.pp_double[0][0] = 1; - ae_frame_leave(_state); - return; - } - - /* - * Prepare matrix - */ - hqrndrandomize(&rs, _state); - l1 = 0; - l2 = ae_log(1/c, _state); - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - a->ptr.pp_double[i][j] = 0; - } - } - a->ptr.pp_double[0][0] = ae_exp(l1, _state); - for(i=1; i<=n-2; i++) - { - a->ptr.pp_double[i][i] = ae_exp(hqrnduniformr(&rs, _state)*(l2-l1)+l1, _state); - } - a->ptr.pp_double[n-1][n-1] = ae_exp(l2, _state); - - /* - * Multiply - */ - smatrixrndmultiply(a, n, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Generation of random NxN Hermitian matrix with given condition number and -norm2(A)=1 - -INPUT PARAMETERS: - N - matrix size - C - condition number (in 2-norm) - -OUTPUT PARAMETERS: - A - random matrix with norm2(A)=1 and cond(A)=C - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void hmatrixrndcond(ae_int_t n, - double c, - /* Complex */ ae_matrix* a, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - double l1; - double l2; - hqrndstate rs; - - ae_frame_make(_state, &_frame_block); - ae_matrix_clear(a); - _hqrndstate_init(&rs, _state, ae_true); - - ae_assert(n>=1&&ae_fp_greater_eq(c,1), "HMatrixRndCond: N<1 or C<1!", _state); - ae_matrix_set_length(a, n, n, _state); - if( n==1 ) - { - - /* - * special case - */ - a->ptr.pp_complex[0][0] = ae_complex_from_d(2*ae_randominteger(2, _state)-1); - ae_frame_leave(_state); - return; - } - - /* - * Prepare matrix - */ - hqrndrandomize(&rs, _state); - l1 = 0; - l2 = ae_log(1/c, _state); - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - a->ptr.pp_complex[i][j] = ae_complex_from_d(0); - } - } - a->ptr.pp_complex[0][0] = ae_complex_from_d(ae_exp(l1, _state)); - for(i=1; i<=n-2; i++) - { - a->ptr.pp_complex[i][i] = ae_complex_from_d((2*hqrnduniformi(&rs, 2, _state)-1)*ae_exp(hqrnduniformr(&rs, _state)*(l2-l1)+l1, _state)); - } - a->ptr.pp_complex[n-1][n-1] = ae_complex_from_d(ae_exp(l2, _state)); - - /* - * Multiply - */ - hmatrixrndmultiply(a, n, _state); - - /* - * post-process to ensure that matrix diagonal is real - */ - for(i=0; i<=n-1; i++) - { - a->ptr.pp_complex[i][i].y = 0; - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Generation of random NxN Hermitian positive definite matrix with given -condition number and norm2(A)=1 - -INPUT PARAMETERS: - N - matrix size - C - condition number (in 2-norm) - -OUTPUT PARAMETERS: - A - random HPD matrix with norm2(A)=1 and cond(A)=C - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void hpdmatrixrndcond(ae_int_t n, - double c, - /* Complex */ ae_matrix* a, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - double l1; - double l2; - hqrndstate rs; - - ae_frame_make(_state, &_frame_block); - ae_matrix_clear(a); - _hqrndstate_init(&rs, _state, ae_true); - - - /* - * Special cases - */ - if( n<=0||ae_fp_less(c,1) ) - { - ae_frame_leave(_state); - return; - } - ae_matrix_set_length(a, n, n, _state); - if( n==1 ) - { - a->ptr.pp_complex[0][0] = ae_complex_from_d(1); - ae_frame_leave(_state); - return; - } - - /* - * Prepare matrix - */ - hqrndrandomize(&rs, _state); - l1 = 0; - l2 = ae_log(1/c, _state); - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - a->ptr.pp_complex[i][j] = ae_complex_from_d(0); - } - } - a->ptr.pp_complex[0][0] = ae_complex_from_d(ae_exp(l1, _state)); - for(i=1; i<=n-2; i++) - { - a->ptr.pp_complex[i][i] = ae_complex_from_d(ae_exp(hqrnduniformr(&rs, _state)*(l2-l1)+l1, _state)); - } - a->ptr.pp_complex[n-1][n-1] = ae_complex_from_d(ae_exp(l2, _state)); - - /* - * Multiply - */ - hmatrixrndmultiply(a, n, _state); - - /* - * post-process to ensure that matrix diagonal is real - */ - for(i=0; i<=n-1; i++) - { - a->ptr.pp_complex[i][i].y = 0; - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Multiplication of MxN matrix by NxN random Haar distributed orthogonal matrix - -INPUT PARAMETERS: - A - matrix, array[0..M-1, 0..N-1] - M, N- matrix size - -OUTPUT PARAMETERS: - A - A*Q, where Q is random NxN orthogonal matrix - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void rmatrixrndorthogonalfromtheright(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - ae_state *_state) -{ - ae_frame _frame_block; - double tau; - double lambdav; - ae_int_t s; - ae_int_t i; - double u1; - double u2; - ae_vector w; - ae_vector v; - hqrndstate state; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&w, 0, DT_REAL, _state, ae_true); - ae_vector_init(&v, 0, DT_REAL, _state, ae_true); - _hqrndstate_init(&state, _state, ae_true); - - ae_assert(n>=1&&m>=1, "RMatrixRndOrthogonalFromTheRight: N<1 or M<1!", _state); - if( n==1 ) - { - - /* - * Special case - */ - tau = 2*ae_randominteger(2, _state)-1; - for(i=0; i<=m-1; i++) - { - a->ptr.pp_double[i][0] = a->ptr.pp_double[i][0]*tau; - } - ae_frame_leave(_state); - return; - } - - /* - * General case. - * First pass. - */ - ae_vector_set_length(&w, m, _state); - ae_vector_set_length(&v, n+1, _state); - hqrndrandomize(&state, _state); - for(s=2; s<=n; s++) - { - - /* - * Prepare random normal v - */ - do - { - i = 1; - while(i<=s) - { - hqrndnormal2(&state, &u1, &u2, _state); - v.ptr.p_double[i] = u1; - if( i+1<=s ) - { - v.ptr.p_double[i+1] = u2; - } - i = i+2; - } - lambdav = ae_v_dotproduct(&v.ptr.p_double[1], 1, &v.ptr.p_double[1], 1, ae_v_len(1,s)); - } - while(ae_fp_eq(lambdav,0)); - - /* - * Prepare and apply reflection - */ - generatereflection(&v, s, &tau, _state); - v.ptr.p_double[1] = 1; - applyreflectionfromtheright(a, tau, &v, 0, m-1, n-s, n-1, &w, _state); - } - - /* - * Second pass. - */ - for(i=0; i<=n-1; i++) - { - tau = 2*hqrnduniformi(&state, 2, _state)-1; - ae_v_muld(&a->ptr.pp_double[0][i], a->stride, ae_v_len(0,m-1), tau); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Multiplication of MxN matrix by MxM random Haar distributed orthogonal matrix - -INPUT PARAMETERS: - A - matrix, array[0..M-1, 0..N-1] - M, N- matrix size - -OUTPUT PARAMETERS: - A - Q*A, where Q is random MxM orthogonal matrix - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void rmatrixrndorthogonalfromtheleft(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - ae_state *_state) -{ - ae_frame _frame_block; - double tau; - double lambdav; - ae_int_t s; - ae_int_t i; - ae_int_t j; - double u1; - double u2; - ae_vector w; - ae_vector v; - hqrndstate state; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&w, 0, DT_REAL, _state, ae_true); - ae_vector_init(&v, 0, DT_REAL, _state, ae_true); - _hqrndstate_init(&state, _state, ae_true); - - ae_assert(n>=1&&m>=1, "RMatrixRndOrthogonalFromTheRight: N<1 or M<1!", _state); - if( m==1 ) - { - - /* - * special case - */ - tau = 2*ae_randominteger(2, _state)-1; - for(j=0; j<=n-1; j++) - { - a->ptr.pp_double[0][j] = a->ptr.pp_double[0][j]*tau; - } - ae_frame_leave(_state); - return; - } - - /* - * General case. - * First pass. - */ - ae_vector_set_length(&w, n, _state); - ae_vector_set_length(&v, m+1, _state); - hqrndrandomize(&state, _state); - for(s=2; s<=m; s++) - { - - /* - * Prepare random normal v - */ - do - { - i = 1; - while(i<=s) - { - hqrndnormal2(&state, &u1, &u2, _state); - v.ptr.p_double[i] = u1; - if( i+1<=s ) - { - v.ptr.p_double[i+1] = u2; - } - i = i+2; - } - lambdav = ae_v_dotproduct(&v.ptr.p_double[1], 1, &v.ptr.p_double[1], 1, ae_v_len(1,s)); - } - while(ae_fp_eq(lambdav,0)); - - /* - * Prepare and apply reflection - */ - generatereflection(&v, s, &tau, _state); - v.ptr.p_double[1] = 1; - applyreflectionfromtheleft(a, tau, &v, m-s, m-1, 0, n-1, &w, _state); - } - - /* - * Second pass. - */ - for(i=0; i<=m-1; i++) - { - tau = 2*hqrnduniformi(&state, 2, _state)-1; - ae_v_muld(&a->ptr.pp_double[i][0], 1, ae_v_len(0,n-1), tau); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Multiplication of MxN complex matrix by NxN random Haar distributed -complex orthogonal matrix - -INPUT PARAMETERS: - A - matrix, array[0..M-1, 0..N-1] - M, N- matrix size - -OUTPUT PARAMETERS: - A - A*Q, where Q is random NxN orthogonal matrix - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void cmatrixrndorthogonalfromtheright(/* Complex */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - ae_state *_state) -{ - ae_frame _frame_block; - ae_complex lambdav; - ae_complex tau; - ae_int_t s; - ae_int_t i; - ae_vector w; - ae_vector v; - hqrndstate state; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&w, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&v, 0, DT_COMPLEX, _state, ae_true); - _hqrndstate_init(&state, _state, ae_true); - - ae_assert(n>=1&&m>=1, "CMatrixRndOrthogonalFromTheRight: N<1 or M<1!", _state); - if( n==1 ) - { - - /* - * Special case - */ - hqrndrandomize(&state, _state); - hqrndunit2(&state, &tau.x, &tau.y, _state); - for(i=0; i<=m-1; i++) - { - a->ptr.pp_complex[i][0] = ae_c_mul(a->ptr.pp_complex[i][0],tau); - } - ae_frame_leave(_state); - return; - } - - /* - * General case. - * First pass. - */ - ae_vector_set_length(&w, m, _state); - ae_vector_set_length(&v, n+1, _state); - hqrndrandomize(&state, _state); - for(s=2; s<=n; s++) - { - - /* - * Prepare random normal v - */ - do - { - for(i=1; i<=s; i++) - { - hqrndnormal2(&state, &tau.x, &tau.y, _state); - v.ptr.p_complex[i] = tau; - } - lambdav = ae_v_cdotproduct(&v.ptr.p_complex[1], 1, "N", &v.ptr.p_complex[1], 1, "Conj", ae_v_len(1,s)); - } - while(ae_c_eq_d(lambdav,0)); - - /* - * Prepare and apply reflection - */ - complexgeneratereflection(&v, s, &tau, _state); - v.ptr.p_complex[1] = ae_complex_from_d(1); - complexapplyreflectionfromtheright(a, tau, &v, 0, m-1, n-s, n-1, &w, _state); - } - - /* - * Second pass. - */ - for(i=0; i<=n-1; i++) - { - hqrndunit2(&state, &tau.x, &tau.y, _state); - ae_v_cmulc(&a->ptr.pp_complex[0][i], a->stride, ae_v_len(0,m-1), tau); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Multiplication of MxN complex matrix by MxM random Haar distributed -complex orthogonal matrix - -INPUT PARAMETERS: - A - matrix, array[0..M-1, 0..N-1] - M, N- matrix size - -OUTPUT PARAMETERS: - A - Q*A, where Q is random MxM orthogonal matrix - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void cmatrixrndorthogonalfromtheleft(/* Complex */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - ae_state *_state) -{ - ae_frame _frame_block; - ae_complex tau; - ae_complex lambdav; - ae_int_t s; - ae_int_t i; - ae_int_t j; - ae_vector w; - ae_vector v; - hqrndstate state; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&w, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&v, 0, DT_COMPLEX, _state, ae_true); - _hqrndstate_init(&state, _state, ae_true); - - ae_assert(n>=1&&m>=1, "CMatrixRndOrthogonalFromTheRight: N<1 or M<1!", _state); - if( m==1 ) - { - - /* - * special case - */ - hqrndrandomize(&state, _state); - hqrndunit2(&state, &tau.x, &tau.y, _state); - for(j=0; j<=n-1; j++) - { - a->ptr.pp_complex[0][j] = ae_c_mul(a->ptr.pp_complex[0][j],tau); - } - ae_frame_leave(_state); - return; - } - - /* - * General case. - * First pass. - */ - ae_vector_set_length(&w, n, _state); - ae_vector_set_length(&v, m+1, _state); - hqrndrandomize(&state, _state); - for(s=2; s<=m; s++) - { - - /* - * Prepare random normal v - */ - do - { - for(i=1; i<=s; i++) - { - hqrndnormal2(&state, &tau.x, &tau.y, _state); - v.ptr.p_complex[i] = tau; - } - lambdav = ae_v_cdotproduct(&v.ptr.p_complex[1], 1, "N", &v.ptr.p_complex[1], 1, "Conj", ae_v_len(1,s)); - } - while(ae_c_eq_d(lambdav,0)); - - /* - * Prepare and apply reflection - */ - complexgeneratereflection(&v, s, &tau, _state); - v.ptr.p_complex[1] = ae_complex_from_d(1); - complexapplyreflectionfromtheleft(a, tau, &v, m-s, m-1, 0, n-1, &w, _state); - } - - /* - * Second pass. - */ - for(i=0; i<=m-1; i++) - { - hqrndunit2(&state, &tau.x, &tau.y, _state); - ae_v_cmulc(&a->ptr.pp_complex[i][0], 1, ae_v_len(0,n-1), tau); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Symmetric multiplication of NxN matrix by random Haar distributed -orthogonal matrix - -INPUT PARAMETERS: - A - matrix, array[0..N-1, 0..N-1] - N - matrix size - -OUTPUT PARAMETERS: - A - Q'*A*Q, where Q is random NxN orthogonal matrix - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void smatrixrndmultiply(/* Real */ ae_matrix* a, - ae_int_t n, - ae_state *_state) -{ - ae_frame _frame_block; - double tau; - double lambdav; - ae_int_t s; - ae_int_t i; - double u1; - double u2; - ae_vector w; - ae_vector v; - hqrndstate state; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&w, 0, DT_REAL, _state, ae_true); - ae_vector_init(&v, 0, DT_REAL, _state, ae_true); - _hqrndstate_init(&state, _state, ae_true); - - - /* - * General case. - */ - ae_vector_set_length(&w, n, _state); - ae_vector_set_length(&v, n+1, _state); - hqrndrandomize(&state, _state); - for(s=2; s<=n; s++) - { - - /* - * Prepare random normal v - */ - do - { - i = 1; - while(i<=s) - { - hqrndnormal2(&state, &u1, &u2, _state); - v.ptr.p_double[i] = u1; - if( i+1<=s ) - { - v.ptr.p_double[i+1] = u2; - } - i = i+2; - } - lambdav = ae_v_dotproduct(&v.ptr.p_double[1], 1, &v.ptr.p_double[1], 1, ae_v_len(1,s)); - } - while(ae_fp_eq(lambdav,0)); - - /* - * Prepare and apply reflection - */ - generatereflection(&v, s, &tau, _state); - v.ptr.p_double[1] = 1; - applyreflectionfromtheright(a, tau, &v, 0, n-1, n-s, n-1, &w, _state); - applyreflectionfromtheleft(a, tau, &v, n-s, n-1, 0, n-1, &w, _state); - } - - /* - * Second pass. - */ - for(i=0; i<=n-1; i++) - { - tau = 2*hqrnduniformi(&state, 2, _state)-1; - ae_v_muld(&a->ptr.pp_double[0][i], a->stride, ae_v_len(0,n-1), tau); - ae_v_muld(&a->ptr.pp_double[i][0], 1, ae_v_len(0,n-1), tau); - } - - /* - * Copy upper triangle to lower - */ - for(i=0; i<=n-2; i++) - { - ae_v_move(&a->ptr.pp_double[i+1][i], a->stride, &a->ptr.pp_double[i][i+1], 1, ae_v_len(i+1,n-1)); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Hermitian multiplication of NxN matrix by random Haar distributed -complex orthogonal matrix - -INPUT PARAMETERS: - A - matrix, array[0..N-1, 0..N-1] - N - matrix size - -OUTPUT PARAMETERS: - A - Q^H*A*Q, where Q is random NxN orthogonal matrix - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void hmatrixrndmultiply(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_state *_state) -{ - ae_frame _frame_block; - ae_complex tau; - ae_complex lambdav; - ae_int_t s; - ae_int_t i; - ae_vector w; - ae_vector v; - hqrndstate state; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&w, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&v, 0, DT_COMPLEX, _state, ae_true); - _hqrndstate_init(&state, _state, ae_true); - - - /* - * General case. - */ - ae_vector_set_length(&w, n, _state); - ae_vector_set_length(&v, n+1, _state); - hqrndrandomize(&state, _state); - for(s=2; s<=n; s++) - { - - /* - * Prepare random normal v - */ - do - { - for(i=1; i<=s; i++) - { - hqrndnormal2(&state, &tau.x, &tau.y, _state); - v.ptr.p_complex[i] = tau; - } - lambdav = ae_v_cdotproduct(&v.ptr.p_complex[1], 1, "N", &v.ptr.p_complex[1], 1, "Conj", ae_v_len(1,s)); - } - while(ae_c_eq_d(lambdav,0)); - - /* - * Prepare and apply reflection - */ - complexgeneratereflection(&v, s, &tau, _state); - v.ptr.p_complex[1] = ae_complex_from_d(1); - complexapplyreflectionfromtheright(a, tau, &v, 0, n-1, n-s, n-1, &w, _state); - complexapplyreflectionfromtheleft(a, ae_c_conj(tau, _state), &v, n-s, n-1, 0, n-1, &w, _state); - } - - /* - * Second pass. - */ - for(i=0; i<=n-1; i++) - { - hqrndunit2(&state, &tau.x, &tau.y, _state); - ae_v_cmulc(&a->ptr.pp_complex[0][i], a->stride, ae_v_len(0,n-1), tau); - tau = ae_c_conj(tau, _state); - ae_v_cmulc(&a->ptr.pp_complex[i][0], 1, ae_v_len(0,n-1), tau); - } - - /* - * Change all values from lower triangle by complex-conjugate values - * from upper one - */ - for(i=0; i<=n-2; i++) - { - ae_v_cmove(&a->ptr.pp_complex[i+1][i], a->stride, &a->ptr.pp_complex[i][i+1], 1, "N", ae_v_len(i+1,n-1)); - } - for(s=0; s<=n-2; s++) - { - for(i=s+1; i<=n-1; i++) - { - a->ptr.pp_complex[i][s].y = -a->ptr.pp_complex[i][s].y; - } - } - ae_frame_leave(_state); -} - - - - -/************************************************************************* -LU decomposition of a general real matrix with row pivoting - -A is represented as A = P*L*U, where: -* L is lower unitriangular matrix -* U is upper triangular matrix -* P = P0*P1*...*PK, K=min(M,N)-1, - Pi - permutation matrix for I and Pivots[I] - -This is cache-oblivous implementation of LU decomposition. -It is optimized for square matrices. As for rectangular matrices: -* best case - M>>N -* worst case - N>>M, small M, large N, matrix does not fit in CPU cache - -INPUT PARAMETERS: - A - array[0..M-1, 0..N-1]. - M - number of rows in matrix A. - N - number of columns in matrix A. - - -OUTPUT PARAMETERS: - A - matrices L and U in compact form: - * L is stored under main diagonal - * U is stored on and above main diagonal - Pivots - permutation matrix in compact form. - array[0..Min(M-1,N-1)]. - - -- ALGLIB routine -- - 10.01.2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixlu(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Integer */ ae_vector* pivots, - ae_state *_state) -{ - - ae_vector_clear(pivots); - - ae_assert(m>0, "RMatrixLU: incorrect M!", _state); - ae_assert(n>0, "RMatrixLU: incorrect N!", _state); - rmatrixplu(a, m, n, pivots, _state); -} - - -/************************************************************************* -LU decomposition of a general complex matrix with row pivoting - -A is represented as A = P*L*U, where: -* L is lower unitriangular matrix -* U is upper triangular matrix -* P = P0*P1*...*PK, K=min(M,N)-1, - Pi - permutation matrix for I and Pivots[I] - -This is cache-oblivous implementation of LU decomposition. It is optimized -for square matrices. As for rectangular matrices: -* best case - M>>N -* worst case - N>>M, small M, large N, matrix does not fit in CPU cache - -INPUT PARAMETERS: - A - array[0..M-1, 0..N-1]. - M - number of rows in matrix A. - N - number of columns in matrix A. - - -OUTPUT PARAMETERS: - A - matrices L and U in compact form: - * L is stored under main diagonal - * U is stored on and above main diagonal - Pivots - permutation matrix in compact form. - array[0..Min(M-1,N-1)]. - - -- ALGLIB routine -- - 10.01.2010 - Bochkanov Sergey -*************************************************************************/ -void cmatrixlu(/* Complex */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Integer */ ae_vector* pivots, - ae_state *_state) -{ - - ae_vector_clear(pivots); - - ae_assert(m>0, "CMatrixLU: incorrect M!", _state); - ae_assert(n>0, "CMatrixLU: incorrect N!", _state); - cmatrixplu(a, m, n, pivots, _state); -} - - -/************************************************************************* -Cache-oblivious Cholesky decomposition - -The algorithm computes Cholesky decomposition of a Hermitian positive- -definite matrix. The result of an algorithm is a representation of A as -A=U'*U or A=L*L' (here X' detones conj(X^T)). - -INPUT PARAMETERS: - A - upper or lower triangle of a factorized matrix. - array with elements [0..N-1, 0..N-1]. - N - size of matrix A. - IsUpper - if IsUpper=True, then A contains an upper triangle of - a symmetric matrix, otherwise A contains a lower one. - -OUTPUT PARAMETERS: - A - the result of factorization. If IsUpper=True, then - the upper triangle contains matrix U, so that A = U'*U, - and the elements below the main diagonal are not modified. - Similarly, if IsUpper = False. - -RESULT: - If the matrix is positive-definite, the function returns True. - Otherwise, the function returns False. Contents of A is not determined - in such case. - - -- ALGLIB routine -- - 15.12.2009 - Bochkanov Sergey -*************************************************************************/ -ae_bool hpdmatrixcholesky(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector tmp; - ae_bool result; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&tmp, 0, DT_COMPLEX, _state, ae_true); - - if( n<1 ) - { - result = ae_false; - ae_frame_leave(_state); - return result; - } - result = trfac_hpdmatrixcholeskyrec(a, 0, n, isupper, &tmp, _state); - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Cache-oblivious Cholesky decomposition - -The algorithm computes Cholesky decomposition of a symmetric positive- -definite matrix. The result of an algorithm is a representation of A as -A=U^T*U or A=L*L^T - -INPUT PARAMETERS: - A - upper or lower triangle of a factorized matrix. - array with elements [0..N-1, 0..N-1]. - N - size of matrix A. - IsUpper - if IsUpper=True, then A contains an upper triangle of - a symmetric matrix, otherwise A contains a lower one. - -OUTPUT PARAMETERS: - A - the result of factorization. If IsUpper=True, then - the upper triangle contains matrix U, so that A = U^T*U, - and the elements below the main diagonal are not modified. - Similarly, if IsUpper = False. - -RESULT: - If the matrix is positive-definite, the function returns True. - Otherwise, the function returns False. Contents of A is not determined - in such case. - - -- ALGLIB routine -- - 15.12.2009 - Bochkanov Sergey -*************************************************************************/ -ae_bool spdmatrixcholesky(/* Real */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector tmp; - ae_bool result; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); - - if( n<1 ) - { - result = ae_false; - ae_frame_leave(_state); - return result; - } - result = spdmatrixcholeskyrec(a, 0, n, isupper, &tmp, _state); - ae_frame_leave(_state); - return result; -} - - -void rmatrixlup(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Integer */ ae_vector* pivots, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector tmp; - ae_int_t i; - ae_int_t j; - double mx; - double v; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(pivots); - ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); - - - /* - * Internal LU decomposition subroutine. - * Never call it directly. - */ - ae_assert(m>0, "RMatrixLUP: incorrect M!", _state); - ae_assert(n>0, "RMatrixLUP: incorrect N!", _state); - - /* - * Scale matrix to avoid overflows, - * decompose it, then scale back. - */ - mx = 0; - for(i=0; i<=m-1; i++) - { - for(j=0; j<=n-1; j++) - { - mx = ae_maxreal(mx, ae_fabs(a->ptr.pp_double[i][j], _state), _state); - } - } - if( ae_fp_neq(mx,0) ) - { - v = 1/mx; - for(i=0; i<=m-1; i++) - { - ae_v_muld(&a->ptr.pp_double[i][0], 1, ae_v_len(0,n-1), v); - } - } - ae_vector_set_length(pivots, ae_minint(m, n, _state), _state); - ae_vector_set_length(&tmp, 2*ae_maxint(m, n, _state), _state); - trfac_rmatrixluprec(a, 0, m, n, pivots, &tmp, _state); - if( ae_fp_neq(mx,0) ) - { - v = mx; - for(i=0; i<=m-1; i++) - { - ae_v_muld(&a->ptr.pp_double[i][0], 1, ae_v_len(0,ae_minint(i, n-1, _state)), v); - } - } - ae_frame_leave(_state); -} - - -void cmatrixlup(/* Complex */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Integer */ ae_vector* pivots, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector tmp; - ae_int_t i; - ae_int_t j; - double mx; - double v; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(pivots); - ae_vector_init(&tmp, 0, DT_COMPLEX, _state, ae_true); - - - /* - * Internal LU decomposition subroutine. - * Never call it directly. - */ - ae_assert(m>0, "CMatrixLUP: incorrect M!", _state); - ae_assert(n>0, "CMatrixLUP: incorrect N!", _state); - - /* - * Scale matrix to avoid overflows, - * decompose it, then scale back. - */ - mx = 0; - for(i=0; i<=m-1; i++) - { - for(j=0; j<=n-1; j++) - { - mx = ae_maxreal(mx, ae_c_abs(a->ptr.pp_complex[i][j], _state), _state); - } - } - if( ae_fp_neq(mx,0) ) - { - v = 1/mx; - for(i=0; i<=m-1; i++) - { - ae_v_cmuld(&a->ptr.pp_complex[i][0], 1, ae_v_len(0,n-1), v); - } - } - ae_vector_set_length(pivots, ae_minint(m, n, _state), _state); - ae_vector_set_length(&tmp, 2*ae_maxint(m, n, _state), _state); - trfac_cmatrixluprec(a, 0, m, n, pivots, &tmp, _state); - if( ae_fp_neq(mx,0) ) - { - v = mx; - for(i=0; i<=m-1; i++) - { - ae_v_cmuld(&a->ptr.pp_complex[i][0], 1, ae_v_len(0,ae_minint(i, n-1, _state)), v); - } - } - ae_frame_leave(_state); -} - - -void rmatrixplu(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Integer */ ae_vector* pivots, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector tmp; - ae_int_t i; - ae_int_t j; - double mx; - double v; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(pivots); - ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); - - - /* - * Internal LU decomposition subroutine. - * Never call it directly. - */ - ae_assert(m>0, "RMatrixPLU: incorrect M!", _state); - ae_assert(n>0, "RMatrixPLU: incorrect N!", _state); - ae_vector_set_length(&tmp, 2*ae_maxint(m, n, _state), _state); - ae_vector_set_length(pivots, ae_minint(m, n, _state), _state); - - /* - * Scale matrix to avoid overflows, - * decompose it, then scale back. - */ - mx = 0; - for(i=0; i<=m-1; i++) - { - for(j=0; j<=n-1; j++) - { - mx = ae_maxreal(mx, ae_fabs(a->ptr.pp_double[i][j], _state), _state); - } - } - if( ae_fp_neq(mx,0) ) - { - v = 1/mx; - for(i=0; i<=m-1; i++) - { - ae_v_muld(&a->ptr.pp_double[i][0], 1, ae_v_len(0,n-1), v); - } - } - trfac_rmatrixplurec(a, 0, m, n, pivots, &tmp, _state); - if( ae_fp_neq(mx,0) ) - { - v = mx; - for(i=0; i<=ae_minint(m, n, _state)-1; i++) - { - ae_v_muld(&a->ptr.pp_double[i][i], 1, ae_v_len(i,n-1), v); - } - } - ae_frame_leave(_state); -} - - -void cmatrixplu(/* Complex */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Integer */ ae_vector* pivots, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector tmp; - ae_int_t i; - ae_int_t j; - double mx; - ae_complex v; - - ae_frame_make(_state, &_frame_block); - ae_vector_clear(pivots); - ae_vector_init(&tmp, 0, DT_COMPLEX, _state, ae_true); - - - /* - * Internal LU decomposition subroutine. - * Never call it directly. - */ - ae_assert(m>0, "CMatrixPLU: incorrect M!", _state); - ae_assert(n>0, "CMatrixPLU: incorrect N!", _state); - ae_vector_set_length(&tmp, 2*ae_maxint(m, n, _state), _state); - ae_vector_set_length(pivots, ae_minint(m, n, _state), _state); - - /* - * Scale matrix to avoid overflows, - * decompose it, then scale back. - */ - mx = 0; - for(i=0; i<=m-1; i++) - { - for(j=0; j<=n-1; j++) - { - mx = ae_maxreal(mx, ae_c_abs(a->ptr.pp_complex[i][j], _state), _state); - } - } - if( ae_fp_neq(mx,0) ) - { - v = ae_complex_from_d(1/mx); - for(i=0; i<=m-1; i++) - { - ae_v_cmulc(&a->ptr.pp_complex[i][0], 1, ae_v_len(0,n-1), v); - } - } - trfac_cmatrixplurec(a, 0, m, n, pivots, &tmp, _state); - if( ae_fp_neq(mx,0) ) - { - v = ae_complex_from_d(mx); - for(i=0; i<=ae_minint(m, n, _state)-1; i++) - { - ae_v_cmulc(&a->ptr.pp_complex[i][i], 1, ae_v_len(i,n-1), v); - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Recursive computational subroutine for SPDMatrixCholesky. - -INPUT PARAMETERS: - A - matrix given by upper or lower triangle - Offs - offset of diagonal block to decompose - N - diagonal block size - IsUpper - what half is given - Tmp - temporary array; allocated by function, if its size is too - small; can be reused on subsequent calls. - -OUTPUT PARAMETERS: - A - upper (or lower) triangle contains Cholesky decomposition - -RESULT: - True, on success - False, on failure - - -- ALGLIB routine -- - 15.12.2009 - Bochkanov Sergey -*************************************************************************/ -ae_bool spdmatrixcholeskyrec(/* Real */ ae_matrix* a, - ae_int_t offs, - ae_int_t n, - ae_bool isupper, - /* Real */ ae_vector* tmp, - ae_state *_state) -{ - ae_int_t n1; - ae_int_t n2; - ae_bool result; - - - - /* - * check N - */ - if( n<1 ) - { - result = ae_false; - return result; - } - - /* - * Prepare buffer - */ - if( tmp->cnt<2*n ) - { - ae_vector_set_length(tmp, 2*n, _state); - } - - /* - * special cases - */ - if( n==1 ) - { - if( ae_fp_greater(a->ptr.pp_double[offs][offs],0) ) - { - a->ptr.pp_double[offs][offs] = ae_sqrt(a->ptr.pp_double[offs][offs], _state); - result = ae_true; - } - else - { - result = ae_false; - } - return result; - } - if( n<=ablasblocksize(a, _state) ) - { - result = trfac_spdmatrixcholesky2(a, offs, n, isupper, tmp, _state); - return result; - } - - /* - * general case: split task in cache-oblivious manner - */ - result = ae_true; - ablassplitlength(a, n, &n1, &n2, _state); - result = spdmatrixcholeskyrec(a, offs, n1, isupper, tmp, _state); - if( !result ) - { - return result; - } - if( n2>0 ) - { - if( isupper ) - { - rmatrixlefttrsm(n1, n2, a, offs, offs, isupper, ae_false, 1, a, offs, offs+n1, _state); - rmatrixsyrk(n2, n1, -1.0, a, offs, offs+n1, 1, 1.0, a, offs+n1, offs+n1, isupper, _state); - } - else - { - rmatrixrighttrsm(n2, n1, a, offs, offs, isupper, ae_false, 1, a, offs+n1, offs, _state); - rmatrixsyrk(n2, n1, -1.0, a, offs+n1, offs, 0, 1.0, a, offs+n1, offs+n1, isupper, _state); - } - result = spdmatrixcholeskyrec(a, offs+n1, n2, isupper, tmp, _state); - if( !result ) - { - return result; - } - } - return result; -} - - -/************************************************************************* -Recurrent complex LU subroutine. -Never call it directly. - - -- ALGLIB routine -- - 04.01.2010 - Bochkanov Sergey -*************************************************************************/ -static void trfac_cmatrixluprec(/* Complex */ ae_matrix* a, - ae_int_t offs, - ae_int_t m, - ae_int_t n, - /* Integer */ ae_vector* pivots, - /* Complex */ ae_vector* tmp, - ae_state *_state) -{ - ae_int_t i; - ae_int_t m1; - ae_int_t m2; - - - - /* - * Kernel case - */ - if( ae_minint(m, n, _state)<=ablascomplexblocksize(a, _state) ) - { - trfac_cmatrixlup2(a, offs, m, n, pivots, tmp, _state); - return; - } - - /* - * Preliminary step, make N>=M - * - * ( A1 ) - * A = ( ), where A1 is square - * ( A2 ) - * - * Factorize A1, update A2 - */ - if( m>n ) - { - trfac_cmatrixluprec(a, offs, n, n, pivots, tmp, _state); - for(i=0; i<=n-1; i++) - { - ae_v_cmove(&tmp->ptr.p_complex[0], 1, &a->ptr.pp_complex[offs+n][offs+i], a->stride, "N", ae_v_len(0,m-n-1)); - ae_v_cmove(&a->ptr.pp_complex[offs+n][offs+i], a->stride, &a->ptr.pp_complex[offs+n][pivots->ptr.p_int[offs+i]], a->stride, "N", ae_v_len(offs+n,offs+m-1)); - ae_v_cmove(&a->ptr.pp_complex[offs+n][pivots->ptr.p_int[offs+i]], a->stride, &tmp->ptr.p_complex[0], 1, "N", ae_v_len(offs+n,offs+m-1)); - } - cmatrixrighttrsm(m-n, n, a, offs, offs, ae_true, ae_true, 0, a, offs+n, offs, _state); - return; - } - - /* - * Non-kernel case - */ - ablascomplexsplitlength(a, m, &m1, &m2, _state); - trfac_cmatrixluprec(a, offs, m1, n, pivots, tmp, _state); - if( m2>0 ) - { - for(i=0; i<=m1-1; i++) - { - if( offs+i!=pivots->ptr.p_int[offs+i] ) - { - ae_v_cmove(&tmp->ptr.p_complex[0], 1, &a->ptr.pp_complex[offs+m1][offs+i], a->stride, "N", ae_v_len(0,m2-1)); - ae_v_cmove(&a->ptr.pp_complex[offs+m1][offs+i], a->stride, &a->ptr.pp_complex[offs+m1][pivots->ptr.p_int[offs+i]], a->stride, "N", ae_v_len(offs+m1,offs+m-1)); - ae_v_cmove(&a->ptr.pp_complex[offs+m1][pivots->ptr.p_int[offs+i]], a->stride, &tmp->ptr.p_complex[0], 1, "N", ae_v_len(offs+m1,offs+m-1)); - } - } - cmatrixrighttrsm(m2, m1, a, offs, offs, ae_true, ae_true, 0, a, offs+m1, offs, _state); - cmatrixgemm(m-m1, n-m1, m1, ae_complex_from_d(-1.0), a, offs+m1, offs, 0, a, offs, offs+m1, 0, ae_complex_from_d(1.0), a, offs+m1, offs+m1, _state); - trfac_cmatrixluprec(a, offs+m1, m-m1, n-m1, pivots, tmp, _state); - for(i=0; i<=m2-1; i++) - { - if( offs+m1+i!=pivots->ptr.p_int[offs+m1+i] ) - { - ae_v_cmove(&tmp->ptr.p_complex[0], 1, &a->ptr.pp_complex[offs][offs+m1+i], a->stride, "N", ae_v_len(0,m1-1)); - ae_v_cmove(&a->ptr.pp_complex[offs][offs+m1+i], a->stride, &a->ptr.pp_complex[offs][pivots->ptr.p_int[offs+m1+i]], a->stride, "N", ae_v_len(offs,offs+m1-1)); - ae_v_cmove(&a->ptr.pp_complex[offs][pivots->ptr.p_int[offs+m1+i]], a->stride, &tmp->ptr.p_complex[0], 1, "N", ae_v_len(offs,offs+m1-1)); - } - } - } -} - - -/************************************************************************* -Recurrent real LU subroutine. -Never call it directly. - - -- ALGLIB routine -- - 04.01.2010 - Bochkanov Sergey -*************************************************************************/ -static void trfac_rmatrixluprec(/* Real */ ae_matrix* a, - ae_int_t offs, - ae_int_t m, - ae_int_t n, - /* Integer */ ae_vector* pivots, - /* Real */ ae_vector* tmp, - ae_state *_state) -{ - ae_int_t i; - ae_int_t m1; - ae_int_t m2; - - - - /* - * Kernel case - */ - if( ae_minint(m, n, _state)<=ablasblocksize(a, _state) ) - { - trfac_rmatrixlup2(a, offs, m, n, pivots, tmp, _state); - return; - } - - /* - * Preliminary step, make N>=M - * - * ( A1 ) - * A = ( ), where A1 is square - * ( A2 ) - * - * Factorize A1, update A2 - */ - if( m>n ) - { - trfac_rmatrixluprec(a, offs, n, n, pivots, tmp, _state); - for(i=0; i<=n-1; i++) - { - if( offs+i!=pivots->ptr.p_int[offs+i] ) - { - ae_v_move(&tmp->ptr.p_double[0], 1, &a->ptr.pp_double[offs+n][offs+i], a->stride, ae_v_len(0,m-n-1)); - ae_v_move(&a->ptr.pp_double[offs+n][offs+i], a->stride, &a->ptr.pp_double[offs+n][pivots->ptr.p_int[offs+i]], a->stride, ae_v_len(offs+n,offs+m-1)); - ae_v_move(&a->ptr.pp_double[offs+n][pivots->ptr.p_int[offs+i]], a->stride, &tmp->ptr.p_double[0], 1, ae_v_len(offs+n,offs+m-1)); - } - } - rmatrixrighttrsm(m-n, n, a, offs, offs, ae_true, ae_true, 0, a, offs+n, offs, _state); - return; - } - - /* - * Non-kernel case - */ - ablassplitlength(a, m, &m1, &m2, _state); - trfac_rmatrixluprec(a, offs, m1, n, pivots, tmp, _state); - if( m2>0 ) - { - for(i=0; i<=m1-1; i++) - { - if( offs+i!=pivots->ptr.p_int[offs+i] ) - { - ae_v_move(&tmp->ptr.p_double[0], 1, &a->ptr.pp_double[offs+m1][offs+i], a->stride, ae_v_len(0,m2-1)); - ae_v_move(&a->ptr.pp_double[offs+m1][offs+i], a->stride, &a->ptr.pp_double[offs+m1][pivots->ptr.p_int[offs+i]], a->stride, ae_v_len(offs+m1,offs+m-1)); - ae_v_move(&a->ptr.pp_double[offs+m1][pivots->ptr.p_int[offs+i]], a->stride, &tmp->ptr.p_double[0], 1, ae_v_len(offs+m1,offs+m-1)); - } - } - rmatrixrighttrsm(m2, m1, a, offs, offs, ae_true, ae_true, 0, a, offs+m1, offs, _state); - rmatrixgemm(m-m1, n-m1, m1, -1.0, a, offs+m1, offs, 0, a, offs, offs+m1, 0, 1.0, a, offs+m1, offs+m1, _state); - trfac_rmatrixluprec(a, offs+m1, m-m1, n-m1, pivots, tmp, _state); - for(i=0; i<=m2-1; i++) - { - if( offs+m1+i!=pivots->ptr.p_int[offs+m1+i] ) - { - ae_v_move(&tmp->ptr.p_double[0], 1, &a->ptr.pp_double[offs][offs+m1+i], a->stride, ae_v_len(0,m1-1)); - ae_v_move(&a->ptr.pp_double[offs][offs+m1+i], a->stride, &a->ptr.pp_double[offs][pivots->ptr.p_int[offs+m1+i]], a->stride, ae_v_len(offs,offs+m1-1)); - ae_v_move(&a->ptr.pp_double[offs][pivots->ptr.p_int[offs+m1+i]], a->stride, &tmp->ptr.p_double[0], 1, ae_v_len(offs,offs+m1-1)); - } - } - } -} - - -/************************************************************************* -Recurrent complex LU subroutine. -Never call it directly. - - -- ALGLIB routine -- - 04.01.2010 - Bochkanov Sergey -*************************************************************************/ -static void trfac_cmatrixplurec(/* Complex */ ae_matrix* a, - ae_int_t offs, - ae_int_t m, - ae_int_t n, - /* Integer */ ae_vector* pivots, - /* Complex */ ae_vector* tmp, - ae_state *_state) -{ - ae_int_t i; - ae_int_t n1; - ae_int_t n2; - - - - /* - * Kernel case - */ - if( ae_minint(m, n, _state)<=ablascomplexblocksize(a, _state) ) - { - trfac_cmatrixplu2(a, offs, m, n, pivots, tmp, _state); - return; - } - - /* - * Preliminary step, make M>=N. - * - * A = (A1 A2), where A1 is square - * Factorize A1, update A2 - */ - if( n>m ) - { - trfac_cmatrixplurec(a, offs, m, m, pivots, tmp, _state); - for(i=0; i<=m-1; i++) - { - ae_v_cmove(&tmp->ptr.p_complex[0], 1, &a->ptr.pp_complex[offs+i][offs+m], 1, "N", ae_v_len(0,n-m-1)); - ae_v_cmove(&a->ptr.pp_complex[offs+i][offs+m], 1, &a->ptr.pp_complex[pivots->ptr.p_int[offs+i]][offs+m], 1, "N", ae_v_len(offs+m,offs+n-1)); - ae_v_cmove(&a->ptr.pp_complex[pivots->ptr.p_int[offs+i]][offs+m], 1, &tmp->ptr.p_complex[0], 1, "N", ae_v_len(offs+m,offs+n-1)); - } - cmatrixlefttrsm(m, n-m, a, offs, offs, ae_false, ae_true, 0, a, offs, offs+m, _state); - return; - } - - /* - * Non-kernel case - */ - ablascomplexsplitlength(a, n, &n1, &n2, _state); - trfac_cmatrixplurec(a, offs, m, n1, pivots, tmp, _state); - if( n2>0 ) - { - for(i=0; i<=n1-1; i++) - { - if( offs+i!=pivots->ptr.p_int[offs+i] ) - { - ae_v_cmove(&tmp->ptr.p_complex[0], 1, &a->ptr.pp_complex[offs+i][offs+n1], 1, "N", ae_v_len(0,n2-1)); - ae_v_cmove(&a->ptr.pp_complex[offs+i][offs+n1], 1, &a->ptr.pp_complex[pivots->ptr.p_int[offs+i]][offs+n1], 1, "N", ae_v_len(offs+n1,offs+n-1)); - ae_v_cmove(&a->ptr.pp_complex[pivots->ptr.p_int[offs+i]][offs+n1], 1, &tmp->ptr.p_complex[0], 1, "N", ae_v_len(offs+n1,offs+n-1)); - } - } - cmatrixlefttrsm(n1, n2, a, offs, offs, ae_false, ae_true, 0, a, offs, offs+n1, _state); - cmatrixgemm(m-n1, n-n1, n1, ae_complex_from_d(-1.0), a, offs+n1, offs, 0, a, offs, offs+n1, 0, ae_complex_from_d(1.0), a, offs+n1, offs+n1, _state); - trfac_cmatrixplurec(a, offs+n1, m-n1, n-n1, pivots, tmp, _state); - for(i=0; i<=n2-1; i++) - { - if( offs+n1+i!=pivots->ptr.p_int[offs+n1+i] ) - { - ae_v_cmove(&tmp->ptr.p_complex[0], 1, &a->ptr.pp_complex[offs+n1+i][offs], 1, "N", ae_v_len(0,n1-1)); - ae_v_cmove(&a->ptr.pp_complex[offs+n1+i][offs], 1, &a->ptr.pp_complex[pivots->ptr.p_int[offs+n1+i]][offs], 1, "N", ae_v_len(offs,offs+n1-1)); - ae_v_cmove(&a->ptr.pp_complex[pivots->ptr.p_int[offs+n1+i]][offs], 1, &tmp->ptr.p_complex[0], 1, "N", ae_v_len(offs,offs+n1-1)); - } - } - } -} - - -/************************************************************************* -Recurrent real LU subroutine. -Never call it directly. - - -- ALGLIB routine -- - 04.01.2010 - Bochkanov Sergey -*************************************************************************/ -static void trfac_rmatrixplurec(/* Real */ ae_matrix* a, - ae_int_t offs, - ae_int_t m, - ae_int_t n, - /* Integer */ ae_vector* pivots, - /* Real */ ae_vector* tmp, - ae_state *_state) -{ - ae_int_t i; - ae_int_t n1; - ae_int_t n2; - - - - /* - * Kernel case - */ - if( ae_minint(m, n, _state)<=ablasblocksize(a, _state) ) - { - trfac_rmatrixplu2(a, offs, m, n, pivots, tmp, _state); - return; - } - - /* - * Preliminary step, make M>=N. - * - * A = (A1 A2), where A1 is square - * Factorize A1, update A2 - */ - if( n>m ) - { - trfac_rmatrixplurec(a, offs, m, m, pivots, tmp, _state); - for(i=0; i<=m-1; i++) - { - ae_v_move(&tmp->ptr.p_double[0], 1, &a->ptr.pp_double[offs+i][offs+m], 1, ae_v_len(0,n-m-1)); - ae_v_move(&a->ptr.pp_double[offs+i][offs+m], 1, &a->ptr.pp_double[pivots->ptr.p_int[offs+i]][offs+m], 1, ae_v_len(offs+m,offs+n-1)); - ae_v_move(&a->ptr.pp_double[pivots->ptr.p_int[offs+i]][offs+m], 1, &tmp->ptr.p_double[0], 1, ae_v_len(offs+m,offs+n-1)); - } - rmatrixlefttrsm(m, n-m, a, offs, offs, ae_false, ae_true, 0, a, offs, offs+m, _state); - return; - } - - /* - * Non-kernel case - */ - ablassplitlength(a, n, &n1, &n2, _state); - trfac_rmatrixplurec(a, offs, m, n1, pivots, tmp, _state); - if( n2>0 ) - { - for(i=0; i<=n1-1; i++) - { - if( offs+i!=pivots->ptr.p_int[offs+i] ) - { - ae_v_move(&tmp->ptr.p_double[0], 1, &a->ptr.pp_double[offs+i][offs+n1], 1, ae_v_len(0,n2-1)); - ae_v_move(&a->ptr.pp_double[offs+i][offs+n1], 1, &a->ptr.pp_double[pivots->ptr.p_int[offs+i]][offs+n1], 1, ae_v_len(offs+n1,offs+n-1)); - ae_v_move(&a->ptr.pp_double[pivots->ptr.p_int[offs+i]][offs+n1], 1, &tmp->ptr.p_double[0], 1, ae_v_len(offs+n1,offs+n-1)); - } - } - rmatrixlefttrsm(n1, n2, a, offs, offs, ae_false, ae_true, 0, a, offs, offs+n1, _state); - rmatrixgemm(m-n1, n-n1, n1, -1.0, a, offs+n1, offs, 0, a, offs, offs+n1, 0, 1.0, a, offs+n1, offs+n1, _state); - trfac_rmatrixplurec(a, offs+n1, m-n1, n-n1, pivots, tmp, _state); - for(i=0; i<=n2-1; i++) - { - if( offs+n1+i!=pivots->ptr.p_int[offs+n1+i] ) - { - ae_v_move(&tmp->ptr.p_double[0], 1, &a->ptr.pp_double[offs+n1+i][offs], 1, ae_v_len(0,n1-1)); - ae_v_move(&a->ptr.pp_double[offs+n1+i][offs], 1, &a->ptr.pp_double[pivots->ptr.p_int[offs+n1+i]][offs], 1, ae_v_len(offs,offs+n1-1)); - ae_v_move(&a->ptr.pp_double[pivots->ptr.p_int[offs+n1+i]][offs], 1, &tmp->ptr.p_double[0], 1, ae_v_len(offs,offs+n1-1)); - } - } - } -} - - -/************************************************************************* -Complex LUP kernel - - -- ALGLIB routine -- - 10.01.2010 - Bochkanov Sergey -*************************************************************************/ -static void trfac_cmatrixlup2(/* Complex */ ae_matrix* a, - ae_int_t offs, - ae_int_t m, - ae_int_t n, - /* Integer */ ae_vector* pivots, - /* Complex */ ae_vector* tmp, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t jp; - ae_complex s; - - - - /* - * Quick return if possible - */ - if( m==0||n==0 ) - { - return; - } - - /* - * main cycle - */ - for(j=0; j<=ae_minint(m-1, n-1, _state); j++) - { - - /* - * Find pivot, swap columns - */ - jp = j; - for(i=j+1; i<=n-1; i++) - { - if( ae_fp_greater(ae_c_abs(a->ptr.pp_complex[offs+j][offs+i], _state),ae_c_abs(a->ptr.pp_complex[offs+j][offs+jp], _state)) ) - { - jp = i; - } - } - pivots->ptr.p_int[offs+j] = offs+jp; - if( jp!=j ) - { - ae_v_cmove(&tmp->ptr.p_complex[0], 1, &a->ptr.pp_complex[offs][offs+j], a->stride, "N", ae_v_len(0,m-1)); - ae_v_cmove(&a->ptr.pp_complex[offs][offs+j], a->stride, &a->ptr.pp_complex[offs][offs+jp], a->stride, "N", ae_v_len(offs,offs+m-1)); - ae_v_cmove(&a->ptr.pp_complex[offs][offs+jp], a->stride, &tmp->ptr.p_complex[0], 1, "N", ae_v_len(offs,offs+m-1)); - } - - /* - * LU decomposition of 1x(N-J) matrix - */ - if( ae_c_neq_d(a->ptr.pp_complex[offs+j][offs+j],0)&&j+1<=n-1 ) - { - s = ae_c_d_div(1,a->ptr.pp_complex[offs+j][offs+j]); - ae_v_cmulc(&a->ptr.pp_complex[offs+j][offs+j+1], 1, ae_v_len(offs+j+1,offs+n-1), s); - } - - /* - * Update trailing (M-J-1)x(N-J-1) matrix - */ - if( jptr.p_complex[0], 1, &a->ptr.pp_complex[offs+j+1][offs+j], a->stride, "N", ae_v_len(0,m-j-2)); - ae_v_cmoveneg(&tmp->ptr.p_complex[m], 1, &a->ptr.pp_complex[offs+j][offs+j+1], 1, "N", ae_v_len(m,m+n-j-2)); - cmatrixrank1(m-j-1, n-j-1, a, offs+j+1, offs+j+1, tmp, 0, tmp, m, _state); - } - } -} - - -/************************************************************************* -Real LUP kernel - - -- ALGLIB routine -- - 10.01.2010 - Bochkanov Sergey -*************************************************************************/ -static void trfac_rmatrixlup2(/* Real */ ae_matrix* a, - ae_int_t offs, - ae_int_t m, - ae_int_t n, - /* Integer */ ae_vector* pivots, - /* Real */ ae_vector* tmp, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t jp; - double s; - - - - /* - * Quick return if possible - */ - if( m==0||n==0 ) - { - return; - } - - /* - * main cycle - */ - for(j=0; j<=ae_minint(m-1, n-1, _state); j++) - { - - /* - * Find pivot, swap columns - */ - jp = j; - for(i=j+1; i<=n-1; i++) - { - if( ae_fp_greater(ae_fabs(a->ptr.pp_double[offs+j][offs+i], _state),ae_fabs(a->ptr.pp_double[offs+j][offs+jp], _state)) ) - { - jp = i; - } - } - pivots->ptr.p_int[offs+j] = offs+jp; - if( jp!=j ) - { - ae_v_move(&tmp->ptr.p_double[0], 1, &a->ptr.pp_double[offs][offs+j], a->stride, ae_v_len(0,m-1)); - ae_v_move(&a->ptr.pp_double[offs][offs+j], a->stride, &a->ptr.pp_double[offs][offs+jp], a->stride, ae_v_len(offs,offs+m-1)); - ae_v_move(&a->ptr.pp_double[offs][offs+jp], a->stride, &tmp->ptr.p_double[0], 1, ae_v_len(offs,offs+m-1)); - } - - /* - * LU decomposition of 1x(N-J) matrix - */ - if( ae_fp_neq(a->ptr.pp_double[offs+j][offs+j],0)&&j+1<=n-1 ) - { - s = 1/a->ptr.pp_double[offs+j][offs+j]; - ae_v_muld(&a->ptr.pp_double[offs+j][offs+j+1], 1, ae_v_len(offs+j+1,offs+n-1), s); - } - - /* - * Update trailing (M-J-1)x(N-J-1) matrix - */ - if( jptr.p_double[0], 1, &a->ptr.pp_double[offs+j+1][offs+j], a->stride, ae_v_len(0,m-j-2)); - ae_v_moveneg(&tmp->ptr.p_double[m], 1, &a->ptr.pp_double[offs+j][offs+j+1], 1, ae_v_len(m,m+n-j-2)); - rmatrixrank1(m-j-1, n-j-1, a, offs+j+1, offs+j+1, tmp, 0, tmp, m, _state); - } - } -} - - -/************************************************************************* -Complex PLU kernel - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - June 30, 1992 -*************************************************************************/ -static void trfac_cmatrixplu2(/* Complex */ ae_matrix* a, - ae_int_t offs, - ae_int_t m, - ae_int_t n, - /* Integer */ ae_vector* pivots, - /* Complex */ ae_vector* tmp, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t jp; - ae_complex s; - - - - /* - * Quick return if possible - */ - if( m==0||n==0 ) - { - return; - } - for(j=0; j<=ae_minint(m-1, n-1, _state); j++) - { - - /* - * Find pivot and test for singularity. - */ - jp = j; - for(i=j+1; i<=m-1; i++) - { - if( ae_fp_greater(ae_c_abs(a->ptr.pp_complex[offs+i][offs+j], _state),ae_c_abs(a->ptr.pp_complex[offs+jp][offs+j], _state)) ) - { - jp = i; - } - } - pivots->ptr.p_int[offs+j] = offs+jp; - if( ae_c_neq_d(a->ptr.pp_complex[offs+jp][offs+j],0) ) - { - - /* - *Apply the interchange to rows - */ - if( jp!=j ) - { - for(i=0; i<=n-1; i++) - { - s = a->ptr.pp_complex[offs+j][offs+i]; - a->ptr.pp_complex[offs+j][offs+i] = a->ptr.pp_complex[offs+jp][offs+i]; - a->ptr.pp_complex[offs+jp][offs+i] = s; - } - } - - /* - *Compute elements J+1:M of J-th column. - */ - if( j+1<=m-1 ) - { - s = ae_c_d_div(1,a->ptr.pp_complex[offs+j][offs+j]); - ae_v_cmulc(&a->ptr.pp_complex[offs+j+1][offs+j], a->stride, ae_v_len(offs+j+1,offs+m-1), s); - } - } - if( jptr.p_complex[0], 1, &a->ptr.pp_complex[offs+j+1][offs+j], a->stride, "N", ae_v_len(0,m-j-2)); - ae_v_cmoveneg(&tmp->ptr.p_complex[m], 1, &a->ptr.pp_complex[offs+j][offs+j+1], 1, "N", ae_v_len(m,m+n-j-2)); - cmatrixrank1(m-j-1, n-j-1, a, offs+j+1, offs+j+1, tmp, 0, tmp, m, _state); - } - } -} - - -/************************************************************************* -Real PLU kernel - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - June 30, 1992 -*************************************************************************/ -static void trfac_rmatrixplu2(/* Real */ ae_matrix* a, - ae_int_t offs, - ae_int_t m, - ae_int_t n, - /* Integer */ ae_vector* pivots, - /* Real */ ae_vector* tmp, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t jp; - double s; - - - - /* - * Quick return if possible - */ - if( m==0||n==0 ) - { - return; - } - for(j=0; j<=ae_minint(m-1, n-1, _state); j++) - { - - /* - * Find pivot and test for singularity. - */ - jp = j; - for(i=j+1; i<=m-1; i++) - { - if( ae_fp_greater(ae_fabs(a->ptr.pp_double[offs+i][offs+j], _state),ae_fabs(a->ptr.pp_double[offs+jp][offs+j], _state)) ) - { - jp = i; - } - } - pivots->ptr.p_int[offs+j] = offs+jp; - if( ae_fp_neq(a->ptr.pp_double[offs+jp][offs+j],0) ) - { - - /* - *Apply the interchange to rows - */ - if( jp!=j ) - { - for(i=0; i<=n-1; i++) - { - s = a->ptr.pp_double[offs+j][offs+i]; - a->ptr.pp_double[offs+j][offs+i] = a->ptr.pp_double[offs+jp][offs+i]; - a->ptr.pp_double[offs+jp][offs+i] = s; - } - } - - /* - *Compute elements J+1:M of J-th column. - */ - if( j+1<=m-1 ) - { - s = 1/a->ptr.pp_double[offs+j][offs+j]; - ae_v_muld(&a->ptr.pp_double[offs+j+1][offs+j], a->stride, ae_v_len(offs+j+1,offs+m-1), s); - } - } - if( jptr.p_double[0], 1, &a->ptr.pp_double[offs+j+1][offs+j], a->stride, ae_v_len(0,m-j-2)); - ae_v_moveneg(&tmp->ptr.p_double[m], 1, &a->ptr.pp_double[offs+j][offs+j+1], 1, ae_v_len(m,m+n-j-2)); - rmatrixrank1(m-j-1, n-j-1, a, offs+j+1, offs+j+1, tmp, 0, tmp, m, _state); - } - } -} - - -/************************************************************************* -Recursive computational subroutine for HPDMatrixCholesky - - -- ALGLIB routine -- - 15.12.2009 - Bochkanov Sergey -*************************************************************************/ -static ae_bool trfac_hpdmatrixcholeskyrec(/* Complex */ ae_matrix* a, - ae_int_t offs, - ae_int_t n, - ae_bool isupper, - /* Complex */ ae_vector* tmp, - ae_state *_state) -{ - ae_int_t n1; - ae_int_t n2; - ae_bool result; - - - - /* - * check N - */ - if( n<1 ) - { - result = ae_false; - return result; - } - - /* - * Prepare buffer - */ - if( tmp->cnt<2*n ) - { - ae_vector_set_length(tmp, 2*n, _state); - } - - /* - * special cases - */ - if( n==1 ) - { - if( ae_fp_greater(a->ptr.pp_complex[offs][offs].x,0) ) - { - a->ptr.pp_complex[offs][offs] = ae_complex_from_d(ae_sqrt(a->ptr.pp_complex[offs][offs].x, _state)); - result = ae_true; - } - else - { - result = ae_false; - } - return result; - } - if( n<=ablascomplexblocksize(a, _state) ) - { - result = trfac_hpdmatrixcholesky2(a, offs, n, isupper, tmp, _state); - return result; - } - - /* - * general case: split task in cache-oblivious manner - */ - result = ae_true; - ablascomplexsplitlength(a, n, &n1, &n2, _state); - result = trfac_hpdmatrixcholeskyrec(a, offs, n1, isupper, tmp, _state); - if( !result ) - { - return result; - } - if( n2>0 ) - { - if( isupper ) - { - cmatrixlefttrsm(n1, n2, a, offs, offs, isupper, ae_false, 2, a, offs, offs+n1, _state); - cmatrixsyrk(n2, n1, -1.0, a, offs, offs+n1, 2, 1.0, a, offs+n1, offs+n1, isupper, _state); - } - else - { - cmatrixrighttrsm(n2, n1, a, offs, offs, isupper, ae_false, 2, a, offs+n1, offs, _state); - cmatrixsyrk(n2, n1, -1.0, a, offs+n1, offs, 0, 1.0, a, offs+n1, offs+n1, isupper, _state); - } - result = trfac_hpdmatrixcholeskyrec(a, offs+n1, n2, isupper, tmp, _state); - if( !result ) - { - return result; - } - } - return result; -} - - -/************************************************************************* -Level-2 Hermitian Cholesky subroutine. - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - February 29, 1992 -*************************************************************************/ -static ae_bool trfac_hpdmatrixcholesky2(/* Complex */ ae_matrix* aaa, - ae_int_t offs, - ae_int_t n, - ae_bool isupper, - /* Complex */ ae_vector* tmp, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - double ajj; - ae_complex v; - double r; - ae_bool result; - - - result = ae_true; - if( n<0 ) - { - result = ae_false; - return result; - } - - /* - * Quick return if possible - */ - if( n==0 ) - { - return result; - } - if( isupper ) - { - - /* - * Compute the Cholesky factorization A = U'*U. - */ - for(j=0; j<=n-1; j++) - { - - /* - * Compute U(J,J) and test for non-positive-definiteness. - */ - v = ae_v_cdotproduct(&aaa->ptr.pp_complex[offs][offs+j], aaa->stride, "Conj", &aaa->ptr.pp_complex[offs][offs+j], aaa->stride, "N", ae_v_len(offs,offs+j-1)); - ajj = ae_c_sub(aaa->ptr.pp_complex[offs+j][offs+j],v).x; - if( ae_fp_less_eq(ajj,0) ) - { - aaa->ptr.pp_complex[offs+j][offs+j] = ae_complex_from_d(ajj); - result = ae_false; - return result; - } - ajj = ae_sqrt(ajj, _state); - aaa->ptr.pp_complex[offs+j][offs+j] = ae_complex_from_d(ajj); - - /* - * Compute elements J+1:N-1 of row J. - */ - if( j0 ) - { - ae_v_cmoveneg(&tmp->ptr.p_complex[0], 1, &aaa->ptr.pp_complex[offs][offs+j], aaa->stride, "Conj", ae_v_len(0,j-1)); - cmatrixmv(n-j-1, j, aaa, offs, offs+j+1, 1, tmp, 0, tmp, n, _state); - ae_v_cadd(&aaa->ptr.pp_complex[offs+j][offs+j+1], 1, &tmp->ptr.p_complex[n], 1, "N", ae_v_len(offs+j+1,offs+n-1)); - } - r = 1/ajj; - ae_v_cmuld(&aaa->ptr.pp_complex[offs+j][offs+j+1], 1, ae_v_len(offs+j+1,offs+n-1), r); - } - } - } - else - { - - /* - * Compute the Cholesky factorization A = L*L'. - */ - for(j=0; j<=n-1; j++) - { - - /* - * Compute L(J+1,J+1) and test for non-positive-definiteness. - */ - v = ae_v_cdotproduct(&aaa->ptr.pp_complex[offs+j][offs], 1, "Conj", &aaa->ptr.pp_complex[offs+j][offs], 1, "N", ae_v_len(offs,offs+j-1)); - ajj = ae_c_sub(aaa->ptr.pp_complex[offs+j][offs+j],v).x; - if( ae_fp_less_eq(ajj,0) ) - { - aaa->ptr.pp_complex[offs+j][offs+j] = ae_complex_from_d(ajj); - result = ae_false; - return result; - } - ajj = ae_sqrt(ajj, _state); - aaa->ptr.pp_complex[offs+j][offs+j] = ae_complex_from_d(ajj); - - /* - * Compute elements J+1:N of column J. - */ - if( j0 ) - { - ae_v_cmove(&tmp->ptr.p_complex[0], 1, &aaa->ptr.pp_complex[offs+j][offs], 1, "Conj", ae_v_len(0,j-1)); - cmatrixmv(n-j-1, j, aaa, offs+j+1, offs, 0, tmp, 0, tmp, n, _state); - for(i=0; i<=n-j-2; i++) - { - aaa->ptr.pp_complex[offs+j+1+i][offs+j] = ae_c_div_d(ae_c_sub(aaa->ptr.pp_complex[offs+j+1+i][offs+j],tmp->ptr.p_complex[n+i]),ajj); - } - } - else - { - for(i=0; i<=n-j-2; i++) - { - aaa->ptr.pp_complex[offs+j+1+i][offs+j] = ae_c_div_d(aaa->ptr.pp_complex[offs+j+1+i][offs+j],ajj); - } - } - } - } - } - return result; -} - - -/************************************************************************* -Level-2 Cholesky subroutine - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - February 29, 1992 -*************************************************************************/ -static ae_bool trfac_spdmatrixcholesky2(/* Real */ ae_matrix* aaa, - ae_int_t offs, - ae_int_t n, - ae_bool isupper, - /* Real */ ae_vector* tmp, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - double ajj; - double v; - double r; - ae_bool result; - - - result = ae_true; - if( n<0 ) - { - result = ae_false; - return result; - } - - /* - * Quick return if possible - */ - if( n==0 ) - { - return result; - } - if( isupper ) - { - - /* - * Compute the Cholesky factorization A = U'*U. - */ - for(j=0; j<=n-1; j++) - { - - /* - * Compute U(J,J) and test for non-positive-definiteness. - */ - v = ae_v_dotproduct(&aaa->ptr.pp_double[offs][offs+j], aaa->stride, &aaa->ptr.pp_double[offs][offs+j], aaa->stride, ae_v_len(offs,offs+j-1)); - ajj = aaa->ptr.pp_double[offs+j][offs+j]-v; - if( ae_fp_less_eq(ajj,0) ) - { - aaa->ptr.pp_double[offs+j][offs+j] = ajj; - result = ae_false; - return result; - } - ajj = ae_sqrt(ajj, _state); - aaa->ptr.pp_double[offs+j][offs+j] = ajj; - - /* - * Compute elements J+1:N-1 of row J. - */ - if( j0 ) - { - ae_v_moveneg(&tmp->ptr.p_double[0], 1, &aaa->ptr.pp_double[offs][offs+j], aaa->stride, ae_v_len(0,j-1)); - rmatrixmv(n-j-1, j, aaa, offs, offs+j+1, 1, tmp, 0, tmp, n, _state); - ae_v_add(&aaa->ptr.pp_double[offs+j][offs+j+1], 1, &tmp->ptr.p_double[n], 1, ae_v_len(offs+j+1,offs+n-1)); - } - r = 1/ajj; - ae_v_muld(&aaa->ptr.pp_double[offs+j][offs+j+1], 1, ae_v_len(offs+j+1,offs+n-1), r); - } - } - } - else - { - - /* - * Compute the Cholesky factorization A = L*L'. - */ - for(j=0; j<=n-1; j++) - { - - /* - * Compute L(J+1,J+1) and test for non-positive-definiteness. - */ - v = ae_v_dotproduct(&aaa->ptr.pp_double[offs+j][offs], 1, &aaa->ptr.pp_double[offs+j][offs], 1, ae_v_len(offs,offs+j-1)); - ajj = aaa->ptr.pp_double[offs+j][offs+j]-v; - if( ae_fp_less_eq(ajj,0) ) - { - aaa->ptr.pp_double[offs+j][offs+j] = ajj; - result = ae_false; - return result; - } - ajj = ae_sqrt(ajj, _state); - aaa->ptr.pp_double[offs+j][offs+j] = ajj; - - /* - * Compute elements J+1:N of column J. - */ - if( j0 ) - { - ae_v_move(&tmp->ptr.p_double[0], 1, &aaa->ptr.pp_double[offs+j][offs], 1, ae_v_len(0,j-1)); - rmatrixmv(n-j-1, j, aaa, offs+j+1, offs, 0, tmp, 0, tmp, n, _state); - for(i=0; i<=n-j-2; i++) - { - aaa->ptr.pp_double[offs+j+1+i][offs+j] = (aaa->ptr.pp_double[offs+j+1+i][offs+j]-tmp->ptr.p_double[n+i])/ajj; - } - } - else - { - for(i=0; i<=n-j-2; i++) - { - aaa->ptr.pp_double[offs+j+1+i][offs+j] = aaa->ptr.pp_double[offs+j+1+i][offs+j]/ajj; - } - } - } - } - } - return result; -} - - - - -/************************************************************************* -Estimate of a matrix condition number (1-norm) - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - A - matrix. Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double rmatrixrcond1(/* Real */ ae_matrix* a, - ae_int_t n, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix _a; - ae_int_t i; - ae_int_t j; - double v; - double nrm; - ae_vector pivots; - ae_vector t; - double result; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init_copy(&_a, a, _state, ae_true); - a = &_a; - ae_vector_init(&pivots, 0, DT_INT, _state, ae_true); - ae_vector_init(&t, 0, DT_REAL, _state, ae_true); - - ae_assert(n>=1, "RMatrixRCond1: N<1!", _state); - ae_vector_set_length(&t, n, _state); - for(i=0; i<=n-1; i++) - { - t.ptr.p_double[i] = 0; - } - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - t.ptr.p_double[j] = t.ptr.p_double[j]+ae_fabs(a->ptr.pp_double[i][j], _state); - } - } - nrm = 0; - for(i=0; i<=n-1; i++) - { - nrm = ae_maxreal(nrm, t.ptr.p_double[i], _state); - } - rmatrixlu(a, n, n, &pivots, _state); - rcond_rmatrixrcondluinternal(a, n, ae_true, ae_true, nrm, &v, _state); - result = v; - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Estimate of a matrix condition number (infinity-norm). - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - A - matrix. Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double rmatrixrcondinf(/* Real */ ae_matrix* a, - ae_int_t n, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix _a; - ae_int_t i; - ae_int_t j; - double v; - double nrm; - ae_vector pivots; - double result; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init_copy(&_a, a, _state, ae_true); - a = &_a; - ae_vector_init(&pivots, 0, DT_INT, _state, ae_true); - - ae_assert(n>=1, "RMatrixRCondInf: N<1!", _state); - nrm = 0; - for(i=0; i<=n-1; i++) - { - v = 0; - for(j=0; j<=n-1; j++) - { - v = v+ae_fabs(a->ptr.pp_double[i][j], _state); - } - nrm = ae_maxreal(nrm, v, _state); - } - rmatrixlu(a, n, n, &pivots, _state); - rcond_rmatrixrcondluinternal(a, n, ae_false, ae_true, nrm, &v, _state); - result = v; - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Condition number estimate of a symmetric positive definite matrix. - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -It should be noted that 1-norm and inf-norm of condition numbers of symmetric -matrices are equal, so the algorithm doesn't take into account the -differences between these types of norms. - -Input parameters: - A - symmetric positive definite matrix which is given by its - upper or lower triangle depending on the value of - IsUpper. Array with elements [0..N-1, 0..N-1]. - N - size of matrix A. - IsUpper - storage format. - -Result: - 1/LowerBound(cond(A)), if matrix A is positive definite, - -1, if matrix A is not positive definite, and its condition number - could not be found by this algorithm. - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double spdmatrixrcond(/* Real */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix _a; - ae_int_t i; - ae_int_t j; - ae_int_t j1; - ae_int_t j2; - double v; - double nrm; - ae_vector t; - double result; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init_copy(&_a, a, _state, ae_true); - a = &_a; - ae_vector_init(&t, 0, DT_REAL, _state, ae_true); - - ae_vector_set_length(&t, n, _state); - for(i=0; i<=n-1; i++) - { - t.ptr.p_double[i] = 0; - } - for(i=0; i<=n-1; i++) - { - if( isupper ) - { - j1 = i; - j2 = n-1; - } - else - { - j1 = 0; - j2 = i; - } - for(j=j1; j<=j2; j++) - { - if( i==j ) - { - t.ptr.p_double[i] = t.ptr.p_double[i]+ae_fabs(a->ptr.pp_double[i][i], _state); - } - else - { - t.ptr.p_double[i] = t.ptr.p_double[i]+ae_fabs(a->ptr.pp_double[i][j], _state); - t.ptr.p_double[j] = t.ptr.p_double[j]+ae_fabs(a->ptr.pp_double[i][j], _state); - } - } - } - nrm = 0; - for(i=0; i<=n-1; i++) - { - nrm = ae_maxreal(nrm, t.ptr.p_double[i], _state); - } - if( spdmatrixcholesky(a, n, isupper, _state) ) - { - rcond_spdmatrixrcondcholeskyinternal(a, n, isupper, ae_true, nrm, &v, _state); - result = v; - } - else - { - result = -1; - } - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Triangular matrix: estimate of a condition number (1-norm) - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - A - matrix. Array[0..N-1, 0..N-1]. - N - size of A. - IsUpper - True, if the matrix is upper triangular. - IsUnit - True, if the matrix has a unit diagonal. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double rmatrixtrrcond1(/* Real */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_bool isunit, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - double v; - double nrm; - ae_vector pivots; - ae_vector t; - ae_int_t j1; - ae_int_t j2; - double result; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&pivots, 0, DT_INT, _state, ae_true); - ae_vector_init(&t, 0, DT_REAL, _state, ae_true); - - ae_assert(n>=1, "RMatrixTRRCond1: N<1!", _state); - ae_vector_set_length(&t, n, _state); - for(i=0; i<=n-1; i++) - { - t.ptr.p_double[i] = 0; - } - for(i=0; i<=n-1; i++) - { - if( isupper ) - { - j1 = i+1; - j2 = n-1; - } - else - { - j1 = 0; - j2 = i-1; - } - for(j=j1; j<=j2; j++) - { - t.ptr.p_double[j] = t.ptr.p_double[j]+ae_fabs(a->ptr.pp_double[i][j], _state); - } - if( isunit ) - { - t.ptr.p_double[i] = t.ptr.p_double[i]+1; - } - else - { - t.ptr.p_double[i] = t.ptr.p_double[i]+ae_fabs(a->ptr.pp_double[i][i], _state); - } - } - nrm = 0; - for(i=0; i<=n-1; i++) - { - nrm = ae_maxreal(nrm, t.ptr.p_double[i], _state); - } - rcond_rmatrixrcondtrinternal(a, n, isupper, isunit, ae_true, nrm, &v, _state); - result = v; - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Triangular matrix: estimate of a matrix condition number (infinity-norm). - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - A - matrix. Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - IsUpper - True, if the matrix is upper triangular. - IsUnit - True, if the matrix has a unit diagonal. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double rmatrixtrrcondinf(/* Real */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_bool isunit, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - double v; - double nrm; - ae_vector pivots; - ae_int_t j1; - ae_int_t j2; - double result; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&pivots, 0, DT_INT, _state, ae_true); - - ae_assert(n>=1, "RMatrixTRRCondInf: N<1!", _state); - nrm = 0; - for(i=0; i<=n-1; i++) - { - if( isupper ) - { - j1 = i+1; - j2 = n-1; - } - else - { - j1 = 0; - j2 = i-1; - } - v = 0; - for(j=j1; j<=j2; j++) - { - v = v+ae_fabs(a->ptr.pp_double[i][j], _state); - } - if( isunit ) - { - v = v+1; - } - else - { - v = v+ae_fabs(a->ptr.pp_double[i][i], _state); - } - nrm = ae_maxreal(nrm, v, _state); - } - rcond_rmatrixrcondtrinternal(a, n, isupper, isunit, ae_false, nrm, &v, _state); - result = v; - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Condition number estimate of a Hermitian positive definite matrix. - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -It should be noted that 1-norm and inf-norm of condition numbers of symmetric -matrices are equal, so the algorithm doesn't take into account the -differences between these types of norms. - -Input parameters: - A - Hermitian positive definite matrix which is given by its - upper or lower triangle depending on the value of - IsUpper. Array with elements [0..N-1, 0..N-1]. - N - size of matrix A. - IsUpper - storage format. - -Result: - 1/LowerBound(cond(A)), if matrix A is positive definite, - -1, if matrix A is not positive definite, and its condition number - could not be found by this algorithm. - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double hpdmatrixrcond(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix _a; - ae_int_t i; - ae_int_t j; - ae_int_t j1; - ae_int_t j2; - double v; - double nrm; - ae_vector t; - double result; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init_copy(&_a, a, _state, ae_true); - a = &_a; - ae_vector_init(&t, 0, DT_REAL, _state, ae_true); - - ae_vector_set_length(&t, n, _state); - for(i=0; i<=n-1; i++) - { - t.ptr.p_double[i] = 0; - } - for(i=0; i<=n-1; i++) - { - if( isupper ) - { - j1 = i; - j2 = n-1; - } - else - { - j1 = 0; - j2 = i; - } - for(j=j1; j<=j2; j++) - { - if( i==j ) - { - t.ptr.p_double[i] = t.ptr.p_double[i]+ae_c_abs(a->ptr.pp_complex[i][i], _state); - } - else - { - t.ptr.p_double[i] = t.ptr.p_double[i]+ae_c_abs(a->ptr.pp_complex[i][j], _state); - t.ptr.p_double[j] = t.ptr.p_double[j]+ae_c_abs(a->ptr.pp_complex[i][j], _state); - } - } - } - nrm = 0; - for(i=0; i<=n-1; i++) - { - nrm = ae_maxreal(nrm, t.ptr.p_double[i], _state); - } - if( hpdmatrixcholesky(a, n, isupper, _state) ) - { - rcond_hpdmatrixrcondcholeskyinternal(a, n, isupper, ae_true, nrm, &v, _state); - result = v; - } - else - { - result = -1; - } - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Estimate of a matrix condition number (1-norm) - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - A - matrix. Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double cmatrixrcond1(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix _a; - ae_int_t i; - ae_int_t j; - double v; - double nrm; - ae_vector pivots; - ae_vector t; - double result; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init_copy(&_a, a, _state, ae_true); - a = &_a; - ae_vector_init(&pivots, 0, DT_INT, _state, ae_true); - ae_vector_init(&t, 0, DT_REAL, _state, ae_true); - - ae_assert(n>=1, "CMatrixRCond1: N<1!", _state); - ae_vector_set_length(&t, n, _state); - for(i=0; i<=n-1; i++) - { - t.ptr.p_double[i] = 0; - } - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - t.ptr.p_double[j] = t.ptr.p_double[j]+ae_c_abs(a->ptr.pp_complex[i][j], _state); - } - } - nrm = 0; - for(i=0; i<=n-1; i++) - { - nrm = ae_maxreal(nrm, t.ptr.p_double[i], _state); - } - cmatrixlu(a, n, n, &pivots, _state); - rcond_cmatrixrcondluinternal(a, n, ae_true, ae_true, nrm, &v, _state); - result = v; - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Estimate of a matrix condition number (infinity-norm). - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - A - matrix. Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double cmatrixrcondinf(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix _a; - ae_int_t i; - ae_int_t j; - double v; - double nrm; - ae_vector pivots; - double result; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init_copy(&_a, a, _state, ae_true); - a = &_a; - ae_vector_init(&pivots, 0, DT_INT, _state, ae_true); - - ae_assert(n>=1, "CMatrixRCondInf: N<1!", _state); - nrm = 0; - for(i=0; i<=n-1; i++) - { - v = 0; - for(j=0; j<=n-1; j++) - { - v = v+ae_c_abs(a->ptr.pp_complex[i][j], _state); - } - nrm = ae_maxreal(nrm, v, _state); - } - cmatrixlu(a, n, n, &pivots, _state); - rcond_cmatrixrcondluinternal(a, n, ae_false, ae_true, nrm, &v, _state); - result = v; - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Estimate of the condition number of a matrix given by its LU decomposition (1-norm) - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - LUA - LU decomposition of a matrix in compact form. Output of - the RMatrixLU subroutine. - N - size of matrix A. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double rmatrixlurcond1(/* Real */ ae_matrix* lua, - ae_int_t n, - ae_state *_state) -{ - double v; - double result; - - - rcond_rmatrixrcondluinternal(lua, n, ae_true, ae_false, 0, &v, _state); - result = v; - return result; -} - - -/************************************************************************* -Estimate of the condition number of a matrix given by its LU decomposition -(infinity norm). - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - LUA - LU decomposition of a matrix in compact form. Output of - the RMatrixLU subroutine. - N - size of matrix A. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double rmatrixlurcondinf(/* Real */ ae_matrix* lua, - ae_int_t n, - ae_state *_state) -{ - double v; - double result; - - - rcond_rmatrixrcondluinternal(lua, n, ae_false, ae_false, 0, &v, _state); - result = v; - return result; -} - - -/************************************************************************* -Condition number estimate of a symmetric positive definite matrix given by -Cholesky decomposition. - -The algorithm calculates a lower bound of the condition number. In this -case, the algorithm does not return a lower bound of the condition number, -but an inverse number (to avoid an overflow in case of a singular matrix). - -It should be noted that 1-norm and inf-norm condition numbers of symmetric -matrices are equal, so the algorithm doesn't take into account the -differences between these types of norms. - -Input parameters: - CD - Cholesky decomposition of matrix A, - output of SMatrixCholesky subroutine. - N - size of matrix A. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double spdmatrixcholeskyrcond(/* Real */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_state *_state) -{ - double v; - double result; - - - rcond_spdmatrixrcondcholeskyinternal(a, n, isupper, ae_false, 0, &v, _state); - result = v; - return result; -} - - -/************************************************************************* -Condition number estimate of a Hermitian positive definite matrix given by -Cholesky decomposition. - -The algorithm calculates a lower bound of the condition number. In this -case, the algorithm does not return a lower bound of the condition number, -but an inverse number (to avoid an overflow in case of a singular matrix). - -It should be noted that 1-norm and inf-norm condition numbers of symmetric -matrices are equal, so the algorithm doesn't take into account the -differences between these types of norms. - -Input parameters: - CD - Cholesky decomposition of matrix A, - output of SMatrixCholesky subroutine. - N - size of matrix A. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double hpdmatrixcholeskyrcond(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_state *_state) -{ - double v; - double result; - - - rcond_hpdmatrixrcondcholeskyinternal(a, n, isupper, ae_false, 0, &v, _state); - result = v; - return result; -} - - -/************************************************************************* -Estimate of the condition number of a matrix given by its LU decomposition (1-norm) - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - LUA - LU decomposition of a matrix in compact form. Output of - the CMatrixLU subroutine. - N - size of matrix A. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double cmatrixlurcond1(/* Complex */ ae_matrix* lua, - ae_int_t n, - ae_state *_state) -{ - double v; - double result; - - - ae_assert(n>=1, "CMatrixLURCond1: N<1!", _state); - rcond_cmatrixrcondluinternal(lua, n, ae_true, ae_false, 0.0, &v, _state); - result = v; - return result; -} - - -/************************************************************************* -Estimate of the condition number of a matrix given by its LU decomposition -(infinity norm). - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - LUA - LU decomposition of a matrix in compact form. Output of - the CMatrixLU subroutine. - N - size of matrix A. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double cmatrixlurcondinf(/* Complex */ ae_matrix* lua, - ae_int_t n, - ae_state *_state) -{ - double v; - double result; - - - ae_assert(n>=1, "CMatrixLURCondInf: N<1!", _state); - rcond_cmatrixrcondluinternal(lua, n, ae_false, ae_false, 0.0, &v, _state); - result = v; - return result; -} - - -/************************************************************************* -Triangular matrix: estimate of a condition number (1-norm) - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - A - matrix. Array[0..N-1, 0..N-1]. - N - size of A. - IsUpper - True, if the matrix is upper triangular. - IsUnit - True, if the matrix has a unit diagonal. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double cmatrixtrrcond1(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_bool isunit, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - double v; - double nrm; - ae_vector pivots; - ae_vector t; - ae_int_t j1; - ae_int_t j2; - double result; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&pivots, 0, DT_INT, _state, ae_true); - ae_vector_init(&t, 0, DT_REAL, _state, ae_true); - - ae_assert(n>=1, "RMatrixTRRCond1: N<1!", _state); - ae_vector_set_length(&t, n, _state); - for(i=0; i<=n-1; i++) - { - t.ptr.p_double[i] = 0; - } - for(i=0; i<=n-1; i++) - { - if( isupper ) - { - j1 = i+1; - j2 = n-1; - } - else - { - j1 = 0; - j2 = i-1; - } - for(j=j1; j<=j2; j++) - { - t.ptr.p_double[j] = t.ptr.p_double[j]+ae_c_abs(a->ptr.pp_complex[i][j], _state); - } - if( isunit ) - { - t.ptr.p_double[i] = t.ptr.p_double[i]+1; - } - else - { - t.ptr.p_double[i] = t.ptr.p_double[i]+ae_c_abs(a->ptr.pp_complex[i][i], _state); - } - } - nrm = 0; - for(i=0; i<=n-1; i++) - { - nrm = ae_maxreal(nrm, t.ptr.p_double[i], _state); - } - rcond_cmatrixrcondtrinternal(a, n, isupper, isunit, ae_true, nrm, &v, _state); - result = v; - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Triangular matrix: estimate of a matrix condition number (infinity-norm). - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - A - matrix. Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - IsUpper - True, if the matrix is upper triangular. - IsUnit - True, if the matrix has a unit diagonal. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double cmatrixtrrcondinf(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_bool isunit, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - double v; - double nrm; - ae_vector pivots; - ae_int_t j1; - ae_int_t j2; - double result; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&pivots, 0, DT_INT, _state, ae_true); - - ae_assert(n>=1, "RMatrixTRRCondInf: N<1!", _state); - nrm = 0; - for(i=0; i<=n-1; i++) - { - if( isupper ) - { - j1 = i+1; - j2 = n-1; - } - else - { - j1 = 0; - j2 = i-1; - } - v = 0; - for(j=j1; j<=j2; j++) - { - v = v+ae_c_abs(a->ptr.pp_complex[i][j], _state); - } - if( isunit ) - { - v = v+1; - } - else - { - v = v+ae_c_abs(a->ptr.pp_complex[i][i], _state); - } - nrm = ae_maxreal(nrm, v, _state); - } - rcond_cmatrixrcondtrinternal(a, n, isupper, isunit, ae_false, nrm, &v, _state); - result = v; - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Threshold for rcond: matrices with condition number beyond this threshold -are considered singular. - -Threshold must be far enough from underflow, at least Sqr(Threshold) must -be greater than underflow. -*************************************************************************/ -double rcondthreshold(ae_state *_state) -{ - double result; - - - result = ae_sqrt(ae_sqrt(ae_minrealnumber, _state), _state); - return result; -} - - -/************************************************************************* -Internal subroutine for condition number estimation - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - February 29, 1992 -*************************************************************************/ -static void rcond_rmatrixrcondtrinternal(/* Real */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_bool isunit, - ae_bool onenorm, - double anorm, - double* rc, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector ex; - ae_vector ev; - ae_vector iwork; - ae_vector tmp; - ae_int_t i; - ae_int_t j; - ae_int_t kase; - ae_int_t kase1; - ae_int_t j1; - ae_int_t j2; - double ainvnm; - double maxgrowth; - double s; - - ae_frame_make(_state, &_frame_block); - *rc = 0; - ae_vector_init(&ex, 0, DT_REAL, _state, ae_true); - ae_vector_init(&ev, 0, DT_REAL, _state, ae_true); - ae_vector_init(&iwork, 0, DT_INT, _state, ae_true); - ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); - - - /* - * RC=0 if something happens - */ - *rc = 0; - - /* - * init - */ - if( onenorm ) - { - kase1 = 1; - } - else - { - kase1 = 2; - } - ae_vector_set_length(&iwork, n+1, _state); - ae_vector_set_length(&tmp, n, _state); - - /* - * prepare parameters for triangular solver - */ - maxgrowth = 1/rcondthreshold(_state); - s = 0; - for(i=0; i<=n-1; i++) - { - if( isupper ) - { - j1 = i+1; - j2 = n-1; - } - else - { - j1 = 0; - j2 = i-1; - } - for(j=j1; j<=j2; j++) - { - s = ae_maxreal(s, ae_fabs(a->ptr.pp_double[i][j], _state), _state); - } - if( isunit ) - { - s = ae_maxreal(s, 1, _state); - } - else - { - s = ae_maxreal(s, ae_fabs(a->ptr.pp_double[i][i], _state), _state); - } - } - if( ae_fp_eq(s,0) ) - { - s = 1; - } - s = 1/s; - - /* - * Scale according to S - */ - anorm = anorm*s; - - /* - * Quick return if possible - * We assume that ANORM<>0 after this block - */ - if( ae_fp_eq(anorm,0) ) - { - ae_frame_leave(_state); - return; - } - if( n==1 ) - { - *rc = 1; - ae_frame_leave(_state); - return; - } - - /* - * Estimate the norm of inv(A). - */ - ainvnm = 0; - kase = 0; - for(;;) - { - rcond_rmatrixestimatenorm(n, &ev, &ex, &iwork, &ainvnm, &kase, _state); - if( kase==0 ) - { - break; - } - - /* - * from 1-based array to 0-based - */ - for(i=0; i<=n-1; i++) - { - ex.ptr.p_double[i] = ex.ptr.p_double[i+1]; - } - - /* - * multiply by inv(A) or inv(A') - */ - if( kase==kase1 ) - { - - /* - * multiply by inv(A) - */ - if( !rmatrixscaledtrsafesolve(a, s, n, &ex, isupper, 0, isunit, maxgrowth, _state) ) - { - ae_frame_leave(_state); - return; - } - } - else - { - - /* - * multiply by inv(A') - */ - if( !rmatrixscaledtrsafesolve(a, s, n, &ex, isupper, 1, isunit, maxgrowth, _state) ) - { - ae_frame_leave(_state); - return; - } - } - - /* - * from 0-based array to 1-based - */ - for(i=n-1; i>=0; i--) - { - ex.ptr.p_double[i+1] = ex.ptr.p_double[i]; - } - } - - /* - * Compute the estimate of the reciprocal condition number. - */ - if( ae_fp_neq(ainvnm,0) ) - { - *rc = 1/ainvnm; - *rc = *rc/anorm; - if( ae_fp_less(*rc,rcondthreshold(_state)) ) - { - *rc = 0; - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Condition number estimation - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - March 31, 1993 -*************************************************************************/ -static void rcond_cmatrixrcondtrinternal(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_bool isunit, - ae_bool onenorm, - double anorm, - double* rc, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector ex; - ae_vector cwork2; - ae_vector cwork3; - ae_vector cwork4; - ae_vector isave; - ae_vector rsave; - ae_int_t kase; - ae_int_t kase1; - double ainvnm; - ae_int_t i; - ae_int_t j; - ae_int_t j1; - ae_int_t j2; - double s; - double maxgrowth; - - ae_frame_make(_state, &_frame_block); - *rc = 0; - ae_vector_init(&ex, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&cwork2, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&cwork3, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&cwork4, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&isave, 0, DT_INT, _state, ae_true); - ae_vector_init(&rsave, 0, DT_REAL, _state, ae_true); - - - /* - * RC=0 if something happens - */ - *rc = 0; - - /* - * init - */ - if( n<=0 ) - { - ae_frame_leave(_state); - return; - } - if( n==0 ) - { - *rc = 1; - ae_frame_leave(_state); - return; - } - ae_vector_set_length(&cwork2, n+1, _state); - - /* - * prepare parameters for triangular solver - */ - maxgrowth = 1/rcondthreshold(_state); - s = 0; - for(i=0; i<=n-1; i++) - { - if( isupper ) - { - j1 = i+1; - j2 = n-1; - } - else - { - j1 = 0; - j2 = i-1; - } - for(j=j1; j<=j2; j++) - { - s = ae_maxreal(s, ae_c_abs(a->ptr.pp_complex[i][j], _state), _state); - } - if( isunit ) - { - s = ae_maxreal(s, 1, _state); - } - else - { - s = ae_maxreal(s, ae_c_abs(a->ptr.pp_complex[i][i], _state), _state); - } - } - if( ae_fp_eq(s,0) ) - { - s = 1; - } - s = 1/s; - - /* - * Scale according to S - */ - anorm = anorm*s; - - /* - * Quick return if possible - */ - if( ae_fp_eq(anorm,0) ) - { - ae_frame_leave(_state); - return; - } - - /* - * Estimate the norm of inv(A). - */ - ainvnm = 0; - if( onenorm ) - { - kase1 = 1; - } - else - { - kase1 = 2; - } - kase = 0; - for(;;) - { - rcond_cmatrixestimatenorm(n, &cwork4, &ex, &ainvnm, &kase, &isave, &rsave, _state); - if( kase==0 ) - { - break; - } - - /* - * From 1-based to 0-based - */ - for(i=0; i<=n-1; i++) - { - ex.ptr.p_complex[i] = ex.ptr.p_complex[i+1]; - } - - /* - * multiply by inv(A) or inv(A') - */ - if( kase==kase1 ) - { - - /* - * multiply by inv(A) - */ - if( !cmatrixscaledtrsafesolve(a, s, n, &ex, isupper, 0, isunit, maxgrowth, _state) ) - { - ae_frame_leave(_state); - return; - } - } - else - { - - /* - * multiply by inv(A') - */ - if( !cmatrixscaledtrsafesolve(a, s, n, &ex, isupper, 2, isunit, maxgrowth, _state) ) - { - ae_frame_leave(_state); - return; - } - } - - /* - * from 0-based to 1-based - */ - for(i=n-1; i>=0; i--) - { - ex.ptr.p_complex[i+1] = ex.ptr.p_complex[i]; - } - } - - /* - * Compute the estimate of the reciprocal condition number. - */ - if( ae_fp_neq(ainvnm,0) ) - { - *rc = 1/ainvnm; - *rc = *rc/anorm; - if( ae_fp_less(*rc,rcondthreshold(_state)) ) - { - *rc = 0; - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Internal subroutine for condition number estimation - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - February 29, 1992 -*************************************************************************/ -static void rcond_spdmatrixrcondcholeskyinternal(/* Real */ ae_matrix* cha, - ae_int_t n, - ae_bool isupper, - ae_bool isnormprovided, - double anorm, - double* rc, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - ae_int_t kase; - double ainvnm; - ae_vector ex; - ae_vector ev; - ae_vector tmp; - ae_vector iwork; - double sa; - double v; - double maxgrowth; - - ae_frame_make(_state, &_frame_block); - *rc = 0; - ae_vector_init(&ex, 0, DT_REAL, _state, ae_true); - ae_vector_init(&ev, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); - ae_vector_init(&iwork, 0, DT_INT, _state, ae_true); - - ae_assert(n>=1, "Assertion failed", _state); - ae_vector_set_length(&tmp, n, _state); - - /* - * RC=0 if something happens - */ - *rc = 0; - - /* - * prepare parameters for triangular solver - */ - maxgrowth = 1/rcondthreshold(_state); - sa = 0; - if( isupper ) - { - for(i=0; i<=n-1; i++) - { - for(j=i; j<=n-1; j++) - { - sa = ae_maxreal(sa, ae_c_abs(ae_complex_from_d(cha->ptr.pp_double[i][j]), _state), _state); - } - } - } - else - { - for(i=0; i<=n-1; i++) - { - for(j=0; j<=i; j++) - { - sa = ae_maxreal(sa, ae_c_abs(ae_complex_from_d(cha->ptr.pp_double[i][j]), _state), _state); - } - } - } - if( ae_fp_eq(sa,0) ) - { - sa = 1; - } - sa = 1/sa; - - /* - * Estimate the norm of A. - */ - if( !isnormprovided ) - { - kase = 0; - anorm = 0; - for(;;) - { - rcond_rmatrixestimatenorm(n, &ev, &ex, &iwork, &anorm, &kase, _state); - if( kase==0 ) - { - break; - } - if( isupper ) - { - - /* - * Multiply by U - */ - for(i=1; i<=n; i++) - { - v = ae_v_dotproduct(&cha->ptr.pp_double[i-1][i-1], 1, &ex.ptr.p_double[i], 1, ae_v_len(i-1,n-1)); - ex.ptr.p_double[i] = v; - } - ae_v_muld(&ex.ptr.p_double[1], 1, ae_v_len(1,n), sa); - - /* - * Multiply by U' - */ - for(i=0; i<=n-1; i++) - { - tmp.ptr.p_double[i] = 0; - } - for(i=0; i<=n-1; i++) - { - v = ex.ptr.p_double[i+1]; - ae_v_addd(&tmp.ptr.p_double[i], 1, &cha->ptr.pp_double[i][i], 1, ae_v_len(i,n-1), v); - } - ae_v_move(&ex.ptr.p_double[1], 1, &tmp.ptr.p_double[0], 1, ae_v_len(1,n)); - ae_v_muld(&ex.ptr.p_double[1], 1, ae_v_len(1,n), sa); - } - else - { - - /* - * Multiply by L' - */ - for(i=0; i<=n-1; i++) - { - tmp.ptr.p_double[i] = 0; - } - for(i=0; i<=n-1; i++) - { - v = ex.ptr.p_double[i+1]; - ae_v_addd(&tmp.ptr.p_double[0], 1, &cha->ptr.pp_double[i][0], 1, ae_v_len(0,i), v); - } - ae_v_move(&ex.ptr.p_double[1], 1, &tmp.ptr.p_double[0], 1, ae_v_len(1,n)); - ae_v_muld(&ex.ptr.p_double[1], 1, ae_v_len(1,n), sa); - - /* - * Multiply by L - */ - for(i=n; i>=1; i--) - { - v = ae_v_dotproduct(&cha->ptr.pp_double[i-1][0], 1, &ex.ptr.p_double[1], 1, ae_v_len(0,i-1)); - ex.ptr.p_double[i] = v; - } - ae_v_muld(&ex.ptr.p_double[1], 1, ae_v_len(1,n), sa); - } - } - } - - /* - * Quick return if possible - */ - if( ae_fp_eq(anorm,0) ) - { - ae_frame_leave(_state); - return; - } - if( n==1 ) - { - *rc = 1; - ae_frame_leave(_state); - return; - } - - /* - * Estimate the 1-norm of inv(A). - */ - kase = 0; - for(;;) - { - rcond_rmatrixestimatenorm(n, &ev, &ex, &iwork, &ainvnm, &kase, _state); - if( kase==0 ) - { - break; - } - for(i=0; i<=n-1; i++) - { - ex.ptr.p_double[i] = ex.ptr.p_double[i+1]; - } - if( isupper ) - { - - /* - * Multiply by inv(U'). - */ - if( !rmatrixscaledtrsafesolve(cha, sa, n, &ex, isupper, 1, ae_false, maxgrowth, _state) ) - { - ae_frame_leave(_state); - return; - } - - /* - * Multiply by inv(U). - */ - if( !rmatrixscaledtrsafesolve(cha, sa, n, &ex, isupper, 0, ae_false, maxgrowth, _state) ) - { - ae_frame_leave(_state); - return; - } - } - else - { - - /* - * Multiply by inv(L). - */ - if( !rmatrixscaledtrsafesolve(cha, sa, n, &ex, isupper, 0, ae_false, maxgrowth, _state) ) - { - ae_frame_leave(_state); - return; - } - - /* - * Multiply by inv(L'). - */ - if( !rmatrixscaledtrsafesolve(cha, sa, n, &ex, isupper, 1, ae_false, maxgrowth, _state) ) - { - ae_frame_leave(_state); - return; - } - } - for(i=n-1; i>=0; i--) - { - ex.ptr.p_double[i+1] = ex.ptr.p_double[i]; - } - } - - /* - * Compute the estimate of the reciprocal condition number. - */ - if( ae_fp_neq(ainvnm,0) ) - { - v = 1/ainvnm; - *rc = v/anorm; - if( ae_fp_less(*rc,rcondthreshold(_state)) ) - { - *rc = 0; - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Internal subroutine for condition number estimation - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - February 29, 1992 -*************************************************************************/ -static void rcond_hpdmatrixrcondcholeskyinternal(/* Complex */ ae_matrix* cha, - ae_int_t n, - ae_bool isupper, - ae_bool isnormprovided, - double anorm, - double* rc, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector isave; - ae_vector rsave; - ae_vector ex; - ae_vector ev; - ae_vector tmp; - ae_int_t kase; - double ainvnm; - ae_complex v; - ae_int_t i; - ae_int_t j; - double sa; - double maxgrowth; - - ae_frame_make(_state, &_frame_block); - *rc = 0; - ae_vector_init(&isave, 0, DT_INT, _state, ae_true); - ae_vector_init(&rsave, 0, DT_REAL, _state, ae_true); - ae_vector_init(&ex, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&ev, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&tmp, 0, DT_COMPLEX, _state, ae_true); - - ae_assert(n>=1, "Assertion failed", _state); - ae_vector_set_length(&tmp, n, _state); - - /* - * RC=0 if something happens - */ - *rc = 0; - - /* - * prepare parameters for triangular solver - */ - maxgrowth = 1/rcondthreshold(_state); - sa = 0; - if( isupper ) - { - for(i=0; i<=n-1; i++) - { - for(j=i; j<=n-1; j++) - { - sa = ae_maxreal(sa, ae_c_abs(cha->ptr.pp_complex[i][j], _state), _state); - } - } - } - else - { - for(i=0; i<=n-1; i++) - { - for(j=0; j<=i; j++) - { - sa = ae_maxreal(sa, ae_c_abs(cha->ptr.pp_complex[i][j], _state), _state); - } - } - } - if( ae_fp_eq(sa,0) ) - { - sa = 1; - } - sa = 1/sa; - - /* - * Estimate the norm of A - */ - if( !isnormprovided ) - { - anorm = 0; - kase = 0; - for(;;) - { - rcond_cmatrixestimatenorm(n, &ev, &ex, &anorm, &kase, &isave, &rsave, _state); - if( kase==0 ) - { - break; - } - if( isupper ) - { - - /* - * Multiply by U - */ - for(i=1; i<=n; i++) - { - v = ae_v_cdotproduct(&cha->ptr.pp_complex[i-1][i-1], 1, "N", &ex.ptr.p_complex[i], 1, "N", ae_v_len(i-1,n-1)); - ex.ptr.p_complex[i] = v; - } - ae_v_cmuld(&ex.ptr.p_complex[1], 1, ae_v_len(1,n), sa); - - /* - * Multiply by U' - */ - for(i=0; i<=n-1; i++) - { - tmp.ptr.p_complex[i] = ae_complex_from_d(0); - } - for(i=0; i<=n-1; i++) - { - v = ex.ptr.p_complex[i+1]; - ae_v_caddc(&tmp.ptr.p_complex[i], 1, &cha->ptr.pp_complex[i][i], 1, "Conj", ae_v_len(i,n-1), v); - } - ae_v_cmove(&ex.ptr.p_complex[1], 1, &tmp.ptr.p_complex[0], 1, "N", ae_v_len(1,n)); - ae_v_cmuld(&ex.ptr.p_complex[1], 1, ae_v_len(1,n), sa); - } - else - { - - /* - * Multiply by L' - */ - for(i=0; i<=n-1; i++) - { - tmp.ptr.p_complex[i] = ae_complex_from_d(0); - } - for(i=0; i<=n-1; i++) - { - v = ex.ptr.p_complex[i+1]; - ae_v_caddc(&tmp.ptr.p_complex[0], 1, &cha->ptr.pp_complex[i][0], 1, "Conj", ae_v_len(0,i), v); - } - ae_v_cmove(&ex.ptr.p_complex[1], 1, &tmp.ptr.p_complex[0], 1, "N", ae_v_len(1,n)); - ae_v_cmuld(&ex.ptr.p_complex[1], 1, ae_v_len(1,n), sa); - - /* - * Multiply by L - */ - for(i=n; i>=1; i--) - { - v = ae_v_cdotproduct(&cha->ptr.pp_complex[i-1][0], 1, "N", &ex.ptr.p_complex[1], 1, "N", ae_v_len(0,i-1)); - ex.ptr.p_complex[i] = v; - } - ae_v_cmuld(&ex.ptr.p_complex[1], 1, ae_v_len(1,n), sa); - } - } - } - - /* - * Quick return if possible - * After this block we assume that ANORM<>0 - */ - if( ae_fp_eq(anorm,0) ) - { - ae_frame_leave(_state); - return; - } - if( n==1 ) - { - *rc = 1; - ae_frame_leave(_state); - return; - } - - /* - * Estimate the norm of inv(A). - */ - ainvnm = 0; - kase = 0; - for(;;) - { - rcond_cmatrixestimatenorm(n, &ev, &ex, &ainvnm, &kase, &isave, &rsave, _state); - if( kase==0 ) - { - break; - } - for(i=0; i<=n-1; i++) - { - ex.ptr.p_complex[i] = ex.ptr.p_complex[i+1]; - } - if( isupper ) - { - - /* - * Multiply by inv(U'). - */ - if( !cmatrixscaledtrsafesolve(cha, sa, n, &ex, isupper, 2, ae_false, maxgrowth, _state) ) - { - ae_frame_leave(_state); - return; - } - - /* - * Multiply by inv(U). - */ - if( !cmatrixscaledtrsafesolve(cha, sa, n, &ex, isupper, 0, ae_false, maxgrowth, _state) ) - { - ae_frame_leave(_state); - return; - } - } - else - { - - /* - * Multiply by inv(L). - */ - if( !cmatrixscaledtrsafesolve(cha, sa, n, &ex, isupper, 0, ae_false, maxgrowth, _state) ) - { - ae_frame_leave(_state); - return; - } - - /* - * Multiply by inv(L'). - */ - if( !cmatrixscaledtrsafesolve(cha, sa, n, &ex, isupper, 2, ae_false, maxgrowth, _state) ) - { - ae_frame_leave(_state); - return; - } - } - for(i=n-1; i>=0; i--) - { - ex.ptr.p_complex[i+1] = ex.ptr.p_complex[i]; - } - } - - /* - * Compute the estimate of the reciprocal condition number. - */ - if( ae_fp_neq(ainvnm,0) ) - { - *rc = 1/ainvnm; - *rc = *rc/anorm; - if( ae_fp_less(*rc,rcondthreshold(_state)) ) - { - *rc = 0; - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Internal subroutine for condition number estimation - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - February 29, 1992 -*************************************************************************/ -static void rcond_rmatrixrcondluinternal(/* Real */ ae_matrix* lua, - ae_int_t n, - ae_bool onenorm, - ae_bool isanormprovided, - double anorm, - double* rc, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector ex; - ae_vector ev; - ae_vector iwork; - ae_vector tmp; - double v; - ae_int_t i; - ae_int_t j; - ae_int_t kase; - ae_int_t kase1; - double ainvnm; - double maxgrowth; - double su; - double sl; - ae_bool mupper; - ae_bool munit; - - ae_frame_make(_state, &_frame_block); - *rc = 0; - ae_vector_init(&ex, 0, DT_REAL, _state, ae_true); - ae_vector_init(&ev, 0, DT_REAL, _state, ae_true); - ae_vector_init(&iwork, 0, DT_INT, _state, ae_true); - ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); - - - /* - * RC=0 if something happens - */ - *rc = 0; - - /* - * init - */ - if( onenorm ) - { - kase1 = 1; - } - else - { - kase1 = 2; - } - mupper = ae_true; - munit = ae_true; - ae_vector_set_length(&iwork, n+1, _state); - ae_vector_set_length(&tmp, n, _state); - - /* - * prepare parameters for triangular solver - */ - maxgrowth = 1/rcondthreshold(_state); - su = 0; - sl = 1; - for(i=0; i<=n-1; i++) - { - for(j=0; j<=i-1; j++) - { - sl = ae_maxreal(sl, ae_fabs(lua->ptr.pp_double[i][j], _state), _state); - } - for(j=i; j<=n-1; j++) - { - su = ae_maxreal(su, ae_fabs(lua->ptr.pp_double[i][j], _state), _state); - } - } - if( ae_fp_eq(su,0) ) - { - su = 1; - } - su = 1/su; - sl = 1/sl; - - /* - * Estimate the norm of A. - */ - if( !isanormprovided ) - { - kase = 0; - anorm = 0; - for(;;) - { - rcond_rmatrixestimatenorm(n, &ev, &ex, &iwork, &anorm, &kase, _state); - if( kase==0 ) - { - break; - } - if( kase==kase1 ) - { - - /* - * Multiply by U - */ - for(i=1; i<=n; i++) - { - v = ae_v_dotproduct(&lua->ptr.pp_double[i-1][i-1], 1, &ex.ptr.p_double[i], 1, ae_v_len(i-1,n-1)); - ex.ptr.p_double[i] = v; - } - - /* - * Multiply by L - */ - for(i=n; i>=1; i--) - { - if( i>1 ) - { - v = ae_v_dotproduct(&lua->ptr.pp_double[i-1][0], 1, &ex.ptr.p_double[1], 1, ae_v_len(0,i-2)); - } - else - { - v = 0; - } - ex.ptr.p_double[i] = ex.ptr.p_double[i]+v; - } - } - else - { - - /* - * Multiply by L' - */ - for(i=0; i<=n-1; i++) - { - tmp.ptr.p_double[i] = 0; - } - for(i=0; i<=n-1; i++) - { - v = ex.ptr.p_double[i+1]; - if( i>=1 ) - { - ae_v_addd(&tmp.ptr.p_double[0], 1, &lua->ptr.pp_double[i][0], 1, ae_v_len(0,i-1), v); - } - tmp.ptr.p_double[i] = tmp.ptr.p_double[i]+v; - } - ae_v_move(&ex.ptr.p_double[1], 1, &tmp.ptr.p_double[0], 1, ae_v_len(1,n)); - - /* - * Multiply by U' - */ - for(i=0; i<=n-1; i++) - { - tmp.ptr.p_double[i] = 0; - } - for(i=0; i<=n-1; i++) - { - v = ex.ptr.p_double[i+1]; - ae_v_addd(&tmp.ptr.p_double[i], 1, &lua->ptr.pp_double[i][i], 1, ae_v_len(i,n-1), v); - } - ae_v_move(&ex.ptr.p_double[1], 1, &tmp.ptr.p_double[0], 1, ae_v_len(1,n)); - } - } - } - - /* - * Scale according to SU/SL - */ - anorm = anorm*su*sl; - - /* - * Quick return if possible - * We assume that ANORM<>0 after this block - */ - if( ae_fp_eq(anorm,0) ) - { - ae_frame_leave(_state); - return; - } - if( n==1 ) - { - *rc = 1; - ae_frame_leave(_state); - return; - } - - /* - * Estimate the norm of inv(A). - */ - ainvnm = 0; - kase = 0; - for(;;) - { - rcond_rmatrixestimatenorm(n, &ev, &ex, &iwork, &ainvnm, &kase, _state); - if( kase==0 ) - { - break; - } - - /* - * from 1-based array to 0-based - */ - for(i=0; i<=n-1; i++) - { - ex.ptr.p_double[i] = ex.ptr.p_double[i+1]; - } - - /* - * multiply by inv(A) or inv(A') - */ - if( kase==kase1 ) - { - - /* - * Multiply by inv(L). - */ - if( !rmatrixscaledtrsafesolve(lua, sl, n, &ex, !mupper, 0, munit, maxgrowth, _state) ) - { - ae_frame_leave(_state); - return; - } - - /* - * Multiply by inv(U). - */ - if( !rmatrixscaledtrsafesolve(lua, su, n, &ex, mupper, 0, !munit, maxgrowth, _state) ) - { - ae_frame_leave(_state); - return; - } - } - else - { - - /* - * Multiply by inv(U'). - */ - if( !rmatrixscaledtrsafesolve(lua, su, n, &ex, mupper, 1, !munit, maxgrowth, _state) ) - { - ae_frame_leave(_state); - return; - } - - /* - * Multiply by inv(L'). - */ - if( !rmatrixscaledtrsafesolve(lua, sl, n, &ex, !mupper, 1, munit, maxgrowth, _state) ) - { - ae_frame_leave(_state); - return; - } - } - - /* - * from 0-based array to 1-based - */ - for(i=n-1; i>=0; i--) - { - ex.ptr.p_double[i+1] = ex.ptr.p_double[i]; - } - } - - /* - * Compute the estimate of the reciprocal condition number. - */ - if( ae_fp_neq(ainvnm,0) ) - { - *rc = 1/ainvnm; - *rc = *rc/anorm; - if( ae_fp_less(*rc,rcondthreshold(_state)) ) - { - *rc = 0; - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Condition number estimation - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - March 31, 1993 -*************************************************************************/ -static void rcond_cmatrixrcondluinternal(/* Complex */ ae_matrix* lua, - ae_int_t n, - ae_bool onenorm, - ae_bool isanormprovided, - double anorm, - double* rc, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector ex; - ae_vector cwork2; - ae_vector cwork3; - ae_vector cwork4; - ae_vector isave; - ae_vector rsave; - ae_int_t kase; - ae_int_t kase1; - double ainvnm; - ae_complex v; - ae_int_t i; - ae_int_t j; - double su; - double sl; - double maxgrowth; - - ae_frame_make(_state, &_frame_block); - *rc = 0; - ae_vector_init(&ex, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&cwork2, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&cwork3, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&cwork4, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&isave, 0, DT_INT, _state, ae_true); - ae_vector_init(&rsave, 0, DT_REAL, _state, ae_true); - - if( n<=0 ) - { - ae_frame_leave(_state); - return; - } - ae_vector_set_length(&cwork2, n+1, _state); - *rc = 0; - if( n==0 ) - { - *rc = 1; - ae_frame_leave(_state); - return; - } - - /* - * prepare parameters for triangular solver - */ - maxgrowth = 1/rcondthreshold(_state); - su = 0; - sl = 1; - for(i=0; i<=n-1; i++) - { - for(j=0; j<=i-1; j++) - { - sl = ae_maxreal(sl, ae_c_abs(lua->ptr.pp_complex[i][j], _state), _state); - } - for(j=i; j<=n-1; j++) - { - su = ae_maxreal(su, ae_c_abs(lua->ptr.pp_complex[i][j], _state), _state); - } - } - if( ae_fp_eq(su,0) ) - { - su = 1; - } - su = 1/su; - sl = 1/sl; - - /* - * Estimate the norm of SU*SL*A. - */ - if( !isanormprovided ) - { - anorm = 0; - if( onenorm ) - { - kase1 = 1; - } - else - { - kase1 = 2; - } - kase = 0; - do - { - rcond_cmatrixestimatenorm(n, &cwork4, &ex, &anorm, &kase, &isave, &rsave, _state); - if( kase!=0 ) - { - if( kase==kase1 ) - { - - /* - * Multiply by U - */ - for(i=1; i<=n; i++) - { - v = ae_v_cdotproduct(&lua->ptr.pp_complex[i-1][i-1], 1, "N", &ex.ptr.p_complex[i], 1, "N", ae_v_len(i-1,n-1)); - ex.ptr.p_complex[i] = v; - } - - /* - * Multiply by L - */ - for(i=n; i>=1; i--) - { - v = ae_complex_from_d(0); - if( i>1 ) - { - v = ae_v_cdotproduct(&lua->ptr.pp_complex[i-1][0], 1, "N", &ex.ptr.p_complex[1], 1, "N", ae_v_len(0,i-2)); - } - ex.ptr.p_complex[i] = ae_c_add(v,ex.ptr.p_complex[i]); - } - } - else - { - - /* - * Multiply by L' - */ - for(i=1; i<=n; i++) - { - cwork2.ptr.p_complex[i] = ae_complex_from_d(0); - } - for(i=1; i<=n; i++) - { - v = ex.ptr.p_complex[i]; - if( i>1 ) - { - ae_v_caddc(&cwork2.ptr.p_complex[1], 1, &lua->ptr.pp_complex[i-1][0], 1, "Conj", ae_v_len(1,i-1), v); - } - cwork2.ptr.p_complex[i] = ae_c_add(cwork2.ptr.p_complex[i],v); - } - - /* - * Multiply by U' - */ - for(i=1; i<=n; i++) - { - ex.ptr.p_complex[i] = ae_complex_from_d(0); - } - for(i=1; i<=n; i++) - { - v = cwork2.ptr.p_complex[i]; - ae_v_caddc(&ex.ptr.p_complex[i], 1, &lua->ptr.pp_complex[i-1][i-1], 1, "Conj", ae_v_len(i,n), v); - } - } - } - } - while(kase!=0); - } - - /* - * Scale according to SU/SL - */ - anorm = anorm*su*sl; - - /* - * Quick return if possible - */ - if( ae_fp_eq(anorm,0) ) - { - ae_frame_leave(_state); - return; - } - - /* - * Estimate the norm of inv(A). - */ - ainvnm = 0; - if( onenorm ) - { - kase1 = 1; - } - else - { - kase1 = 2; - } - kase = 0; - for(;;) - { - rcond_cmatrixestimatenorm(n, &cwork4, &ex, &ainvnm, &kase, &isave, &rsave, _state); - if( kase==0 ) - { - break; - } - - /* - * From 1-based to 0-based - */ - for(i=0; i<=n-1; i++) - { - ex.ptr.p_complex[i] = ex.ptr.p_complex[i+1]; - } - - /* - * multiply by inv(A) or inv(A') - */ - if( kase==kase1 ) - { - - /* - * Multiply by inv(L). - */ - if( !cmatrixscaledtrsafesolve(lua, sl, n, &ex, ae_false, 0, ae_true, maxgrowth, _state) ) - { - *rc = 0; - ae_frame_leave(_state); - return; - } - - /* - * Multiply by inv(U). - */ - if( !cmatrixscaledtrsafesolve(lua, su, n, &ex, ae_true, 0, ae_false, maxgrowth, _state) ) - { - *rc = 0; - ae_frame_leave(_state); - return; - } - } - else - { - - /* - * Multiply by inv(U'). - */ - if( !cmatrixscaledtrsafesolve(lua, su, n, &ex, ae_true, 2, ae_false, maxgrowth, _state) ) - { - *rc = 0; - ae_frame_leave(_state); - return; - } - - /* - * Multiply by inv(L'). - */ - if( !cmatrixscaledtrsafesolve(lua, sl, n, &ex, ae_false, 2, ae_true, maxgrowth, _state) ) - { - *rc = 0; - ae_frame_leave(_state); - return; - } - } - - /* - * from 0-based to 1-based - */ - for(i=n-1; i>=0; i--) - { - ex.ptr.p_complex[i+1] = ex.ptr.p_complex[i]; - } - } - - /* - * Compute the estimate of the reciprocal condition number. - */ - if( ae_fp_neq(ainvnm,0) ) - { - *rc = 1/ainvnm; - *rc = *rc/anorm; - if( ae_fp_less(*rc,rcondthreshold(_state)) ) - { - *rc = 0; - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Internal subroutine for matrix norm estimation - - -- LAPACK auxiliary routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - February 29, 1992 -*************************************************************************/ -static void rcond_rmatrixestimatenorm(ae_int_t n, - /* Real */ ae_vector* v, - /* Real */ ae_vector* x, - /* Integer */ ae_vector* isgn, - double* est, - ae_int_t* kase, - ae_state *_state) -{ - ae_int_t itmax; - ae_int_t i; - double t; - ae_bool flg; - ae_int_t positer; - ae_int_t posj; - ae_int_t posjlast; - ae_int_t posjump; - ae_int_t posaltsgn; - ae_int_t posestold; - ae_int_t postemp; - - - itmax = 5; - posaltsgn = n+1; - posestold = n+2; - postemp = n+3; - positer = n+1; - posj = n+2; - posjlast = n+3; - posjump = n+4; - if( *kase==0 ) - { - ae_vector_set_length(v, n+4, _state); - ae_vector_set_length(x, n+1, _state); - ae_vector_set_length(isgn, n+5, _state); - t = (double)1/(double)n; - for(i=1; i<=n; i++) - { - x->ptr.p_double[i] = t; - } - *kase = 1; - isgn->ptr.p_int[posjump] = 1; - return; - } - - /* - * ................ ENTRY (JUMP = 1) - * FIRST ITERATION. X HAS BEEN OVERWRITTEN BY A*X. - */ - if( isgn->ptr.p_int[posjump]==1 ) - { - if( n==1 ) - { - v->ptr.p_double[1] = x->ptr.p_double[1]; - *est = ae_fabs(v->ptr.p_double[1], _state); - *kase = 0; - return; - } - *est = 0; - for(i=1; i<=n; i++) - { - *est = *est+ae_fabs(x->ptr.p_double[i], _state); - } - for(i=1; i<=n; i++) - { - if( ae_fp_greater_eq(x->ptr.p_double[i],0) ) - { - x->ptr.p_double[i] = 1; - } - else - { - x->ptr.p_double[i] = -1; - } - isgn->ptr.p_int[i] = ae_sign(x->ptr.p_double[i], _state); - } - *kase = 2; - isgn->ptr.p_int[posjump] = 2; - return; - } - - /* - * ................ ENTRY (JUMP = 2) - * FIRST ITERATION. X HAS BEEN OVERWRITTEN BY TRANDPOSE(A)*X. - */ - if( isgn->ptr.p_int[posjump]==2 ) - { - isgn->ptr.p_int[posj] = 1; - for(i=2; i<=n; i++) - { - if( ae_fp_greater(ae_fabs(x->ptr.p_double[i], _state),ae_fabs(x->ptr.p_double[isgn->ptr.p_int[posj]], _state)) ) - { - isgn->ptr.p_int[posj] = i; - } - } - isgn->ptr.p_int[positer] = 2; - - /* - * MAIN LOOP - ITERATIONS 2,3,...,ITMAX. - */ - for(i=1; i<=n; i++) - { - x->ptr.p_double[i] = 0; - } - x->ptr.p_double[isgn->ptr.p_int[posj]] = 1; - *kase = 1; - isgn->ptr.p_int[posjump] = 3; - return; - } - - /* - * ................ ENTRY (JUMP = 3) - * X HAS BEEN OVERWRITTEN BY A*X. - */ - if( isgn->ptr.p_int[posjump]==3 ) - { - ae_v_move(&v->ptr.p_double[1], 1, &x->ptr.p_double[1], 1, ae_v_len(1,n)); - v->ptr.p_double[posestold] = *est; - *est = 0; - for(i=1; i<=n; i++) - { - *est = *est+ae_fabs(v->ptr.p_double[i], _state); - } - flg = ae_false; - for(i=1; i<=n; i++) - { - if( (ae_fp_greater_eq(x->ptr.p_double[i],0)&&isgn->ptr.p_int[i]<0)||(ae_fp_less(x->ptr.p_double[i],0)&&isgn->ptr.p_int[i]>=0) ) - { - flg = ae_true; - } - } - - /* - * REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED. - * OR MAY BE CYCLING. - */ - if( !flg||ae_fp_less_eq(*est,v->ptr.p_double[posestold]) ) - { - v->ptr.p_double[posaltsgn] = 1; - for(i=1; i<=n; i++) - { - x->ptr.p_double[i] = v->ptr.p_double[posaltsgn]*(1+(double)(i-1)/(double)(n-1)); - v->ptr.p_double[posaltsgn] = -v->ptr.p_double[posaltsgn]; - } - *kase = 1; - isgn->ptr.p_int[posjump] = 5; - return; - } - for(i=1; i<=n; i++) - { - if( ae_fp_greater_eq(x->ptr.p_double[i],0) ) - { - x->ptr.p_double[i] = 1; - isgn->ptr.p_int[i] = 1; - } - else - { - x->ptr.p_double[i] = -1; - isgn->ptr.p_int[i] = -1; - } - } - *kase = 2; - isgn->ptr.p_int[posjump] = 4; - return; - } - - /* - * ................ ENTRY (JUMP = 4) - * X HAS BEEN OVERWRITTEN BY TRANDPOSE(A)*X. - */ - if( isgn->ptr.p_int[posjump]==4 ) - { - isgn->ptr.p_int[posjlast] = isgn->ptr.p_int[posj]; - isgn->ptr.p_int[posj] = 1; - for(i=2; i<=n; i++) - { - if( ae_fp_greater(ae_fabs(x->ptr.p_double[i], _state),ae_fabs(x->ptr.p_double[isgn->ptr.p_int[posj]], _state)) ) - { - isgn->ptr.p_int[posj] = i; - } - } - if( ae_fp_neq(x->ptr.p_double[isgn->ptr.p_int[posjlast]],ae_fabs(x->ptr.p_double[isgn->ptr.p_int[posj]], _state))&&isgn->ptr.p_int[positer]ptr.p_int[positer] = isgn->ptr.p_int[positer]+1; - for(i=1; i<=n; i++) - { - x->ptr.p_double[i] = 0; - } - x->ptr.p_double[isgn->ptr.p_int[posj]] = 1; - *kase = 1; - isgn->ptr.p_int[posjump] = 3; - return; - } - - /* - * ITERATION COMPLETE. FINAL STAGE. - */ - v->ptr.p_double[posaltsgn] = 1; - for(i=1; i<=n; i++) - { - x->ptr.p_double[i] = v->ptr.p_double[posaltsgn]*(1+(double)(i-1)/(double)(n-1)); - v->ptr.p_double[posaltsgn] = -v->ptr.p_double[posaltsgn]; - } - *kase = 1; - isgn->ptr.p_int[posjump] = 5; - return; - } - - /* - * ................ ENTRY (JUMP = 5) - * X HAS BEEN OVERWRITTEN BY A*X. - */ - if( isgn->ptr.p_int[posjump]==5 ) - { - v->ptr.p_double[postemp] = 0; - for(i=1; i<=n; i++) - { - v->ptr.p_double[postemp] = v->ptr.p_double[postemp]+ae_fabs(x->ptr.p_double[i], _state); - } - v->ptr.p_double[postemp] = 2*v->ptr.p_double[postemp]/(3*n); - if( ae_fp_greater(v->ptr.p_double[postemp],*est) ) - { - ae_v_move(&v->ptr.p_double[1], 1, &x->ptr.p_double[1], 1, ae_v_len(1,n)); - *est = v->ptr.p_double[postemp]; - } - *kase = 0; - return; - } -} - - -static void rcond_cmatrixestimatenorm(ae_int_t n, - /* Complex */ ae_vector* v, - /* Complex */ ae_vector* x, - double* est, - ae_int_t* kase, - /* Integer */ ae_vector* isave, - /* Real */ ae_vector* rsave, - ae_state *_state) -{ - ae_int_t itmax; - ae_int_t i; - ae_int_t iter; - ae_int_t j; - ae_int_t jlast; - ae_int_t jump; - double absxi; - double altsgn; - double estold; - double safmin; - double temp; - - - - /* - *Executable Statements .. - */ - itmax = 5; - safmin = ae_minrealnumber; - if( *kase==0 ) - { - ae_vector_set_length(v, n+1, _state); - ae_vector_set_length(x, n+1, _state); - ae_vector_set_length(isave, 5, _state); - ae_vector_set_length(rsave, 4, _state); - for(i=1; i<=n; i++) - { - x->ptr.p_complex[i] = ae_complex_from_d((double)1/(double)n); - } - *kase = 1; - jump = 1; - rcond_internalcomplexrcondsaveall(isave, rsave, &i, &iter, &j, &jlast, &jump, &absxi, &altsgn, &estold, &temp, _state); - return; - } - rcond_internalcomplexrcondloadall(isave, rsave, &i, &iter, &j, &jlast, &jump, &absxi, &altsgn, &estold, &temp, _state); - - /* - * ENTRY (JUMP = 1) - * FIRST ITERATION. X HAS BEEN OVERWRITTEN BY A*X. - */ - if( jump==1 ) - { - if( n==1 ) - { - v->ptr.p_complex[1] = x->ptr.p_complex[1]; - *est = ae_c_abs(v->ptr.p_complex[1], _state); - *kase = 0; - rcond_internalcomplexrcondsaveall(isave, rsave, &i, &iter, &j, &jlast, &jump, &absxi, &altsgn, &estold, &temp, _state); - return; - } - *est = rcond_internalcomplexrcondscsum1(x, n, _state); - for(i=1; i<=n; i++) - { - absxi = ae_c_abs(x->ptr.p_complex[i], _state); - if( ae_fp_greater(absxi,safmin) ) - { - x->ptr.p_complex[i] = ae_c_div_d(x->ptr.p_complex[i],absxi); - } - else - { - x->ptr.p_complex[i] = ae_complex_from_d(1); - } - } - *kase = 2; - jump = 2; - rcond_internalcomplexrcondsaveall(isave, rsave, &i, &iter, &j, &jlast, &jump, &absxi, &altsgn, &estold, &temp, _state); - return; - } - - /* - * ENTRY (JUMP = 2) - * FIRST ITERATION. X HAS BEEN OVERWRITTEN BY CTRANS(A)*X. - */ - if( jump==2 ) - { - j = rcond_internalcomplexrcondicmax1(x, n, _state); - iter = 2; - - /* - * MAIN LOOP - ITERATIONS 2,3,...,ITMAX. - */ - for(i=1; i<=n; i++) - { - x->ptr.p_complex[i] = ae_complex_from_d(0); - } - x->ptr.p_complex[j] = ae_complex_from_d(1); - *kase = 1; - jump = 3; - rcond_internalcomplexrcondsaveall(isave, rsave, &i, &iter, &j, &jlast, &jump, &absxi, &altsgn, &estold, &temp, _state); - return; - } - - /* - * ENTRY (JUMP = 3) - * X HAS BEEN OVERWRITTEN BY A*X. - */ - if( jump==3 ) - { - ae_v_cmove(&v->ptr.p_complex[1], 1, &x->ptr.p_complex[1], 1, "N", ae_v_len(1,n)); - estold = *est; - *est = rcond_internalcomplexrcondscsum1(v, n, _state); - - /* - * TEST FOR CYCLING. - */ - if( ae_fp_less_eq(*est,estold) ) - { - - /* - * ITERATION COMPLETE. FINAL STAGE. - */ - altsgn = 1; - for(i=1; i<=n; i++) - { - x->ptr.p_complex[i] = ae_complex_from_d(altsgn*(1+(double)(i-1)/(double)(n-1))); - altsgn = -altsgn; - } - *kase = 1; - jump = 5; - rcond_internalcomplexrcondsaveall(isave, rsave, &i, &iter, &j, &jlast, &jump, &absxi, &altsgn, &estold, &temp, _state); - return; - } - for(i=1; i<=n; i++) - { - absxi = ae_c_abs(x->ptr.p_complex[i], _state); - if( ae_fp_greater(absxi,safmin) ) - { - x->ptr.p_complex[i] = ae_c_div_d(x->ptr.p_complex[i],absxi); - } - else - { - x->ptr.p_complex[i] = ae_complex_from_d(1); - } - } - *kase = 2; - jump = 4; - rcond_internalcomplexrcondsaveall(isave, rsave, &i, &iter, &j, &jlast, &jump, &absxi, &altsgn, &estold, &temp, _state); - return; - } - - /* - * ENTRY (JUMP = 4) - * X HAS BEEN OVERWRITTEN BY CTRANS(A)*X. - */ - if( jump==4 ) - { - jlast = j; - j = rcond_internalcomplexrcondicmax1(x, n, _state); - if( ae_fp_neq(ae_c_abs(x->ptr.p_complex[jlast], _state),ae_c_abs(x->ptr.p_complex[j], _state))&&iterptr.p_complex[i] = ae_complex_from_d(0); - } - x->ptr.p_complex[j] = ae_complex_from_d(1); - *kase = 1; - jump = 3; - rcond_internalcomplexrcondsaveall(isave, rsave, &i, &iter, &j, &jlast, &jump, &absxi, &altsgn, &estold, &temp, _state); - return; - } - - /* - * ITERATION COMPLETE. FINAL STAGE. - */ - altsgn = 1; - for(i=1; i<=n; i++) - { - x->ptr.p_complex[i] = ae_complex_from_d(altsgn*(1+(double)(i-1)/(double)(n-1))); - altsgn = -altsgn; - } - *kase = 1; - jump = 5; - rcond_internalcomplexrcondsaveall(isave, rsave, &i, &iter, &j, &jlast, &jump, &absxi, &altsgn, &estold, &temp, _state); - return; - } - - /* - * ENTRY (JUMP = 5) - * X HAS BEEN OVERWRITTEN BY A*X. - */ - if( jump==5 ) - { - temp = 2*(rcond_internalcomplexrcondscsum1(x, n, _state)/(3*n)); - if( ae_fp_greater(temp,*est) ) - { - ae_v_cmove(&v->ptr.p_complex[1], 1, &x->ptr.p_complex[1], 1, "N", ae_v_len(1,n)); - *est = temp; - } - *kase = 0; - rcond_internalcomplexrcondsaveall(isave, rsave, &i, &iter, &j, &jlast, &jump, &absxi, &altsgn, &estold, &temp, _state); - return; - } -} - - -static double rcond_internalcomplexrcondscsum1(/* Complex */ ae_vector* x, - ae_int_t n, - ae_state *_state) -{ - ae_int_t i; - double result; - - - result = 0; - for(i=1; i<=n; i++) - { - result = result+ae_c_abs(x->ptr.p_complex[i], _state); - } - return result; -} - - -static ae_int_t rcond_internalcomplexrcondicmax1(/* Complex */ ae_vector* x, - ae_int_t n, - ae_state *_state) -{ - ae_int_t i; - double m; - ae_int_t result; - - - result = 1; - m = ae_c_abs(x->ptr.p_complex[1], _state); - for(i=2; i<=n; i++) - { - if( ae_fp_greater(ae_c_abs(x->ptr.p_complex[i], _state),m) ) - { - result = i; - m = ae_c_abs(x->ptr.p_complex[i], _state); - } - } - return result; -} - - -static void rcond_internalcomplexrcondsaveall(/* Integer */ ae_vector* isave, - /* Real */ ae_vector* rsave, - ae_int_t* i, - ae_int_t* iter, - ae_int_t* j, - ae_int_t* jlast, - ae_int_t* jump, - double* absxi, - double* altsgn, - double* estold, - double* temp, - ae_state *_state) -{ - - - isave->ptr.p_int[0] = *i; - isave->ptr.p_int[1] = *iter; - isave->ptr.p_int[2] = *j; - isave->ptr.p_int[3] = *jlast; - isave->ptr.p_int[4] = *jump; - rsave->ptr.p_double[0] = *absxi; - rsave->ptr.p_double[1] = *altsgn; - rsave->ptr.p_double[2] = *estold; - rsave->ptr.p_double[3] = *temp; -} - - -static void rcond_internalcomplexrcondloadall(/* Integer */ ae_vector* isave, - /* Real */ ae_vector* rsave, - ae_int_t* i, - ae_int_t* iter, - ae_int_t* j, - ae_int_t* jlast, - ae_int_t* jump, - double* absxi, - double* altsgn, - double* estold, - double* temp, - ae_state *_state) -{ - - - *i = isave->ptr.p_int[0]; - *iter = isave->ptr.p_int[1]; - *j = isave->ptr.p_int[2]; - *jlast = isave->ptr.p_int[3]; - *jump = isave->ptr.p_int[4]; - *absxi = rsave->ptr.p_double[0]; - *altsgn = rsave->ptr.p_double[1]; - *estold = rsave->ptr.p_double[2]; - *temp = rsave->ptr.p_double[3]; -} - - - - -/************************************************************************* -Inversion of a matrix given by its LU decomposition. - -INPUT PARAMETERS: - A - LU decomposition of the matrix - (output of RMatrixLU subroutine). - Pivots - table of permutations - (the output of RMatrixLU subroutine). - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - -OUTPUT PARAMETERS: - Info - return code: - * -3 A is singular, or VERY close to singular. - it is filled by zeros in such cases. - * 1 task is solved (but matrix A may be ill-conditioned, - check R1/RInf parameters for condition numbers). - Rep - solver report, see below for more info - A - inverse of matrix A. - Array whose indexes range within [0..N-1, 0..N-1]. - -SOLVER REPORT - -Subroutine sets following fields of the Rep structure: -* R1 reciprocal of condition number: 1/cond(A), 1-norm. -* RInf reciprocal of condition number: 1/cond(A), inf-norm. - - -- ALGLIB routine -- - 05.02.2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixluinverse(/* Real */ ae_matrix* a, - /* Integer */ ae_vector* pivots, - ae_int_t n, - ae_int_t* info, - matinvreport* rep, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector work; - ae_int_t i; - ae_int_t j; - ae_int_t k; - double v; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _matinvreport_clear(rep); - ae_vector_init(&work, 0, DT_REAL, _state, ae_true); - - ae_assert(n>0, "RMatrixLUInverse: N<=0!", _state); - ae_assert(a->cols>=n, "RMatrixLUInverse: cols(A)rows>=n, "RMatrixLUInverse: rows(A)cnt>=n, "RMatrixLUInverse: len(Pivots)ptr.p_int[i]>n-1||pivots->ptr.p_int[i]0, "RMatrixLUInverse: incorrect Pivots array!", _state); - - /* - * calculate condition numbers - */ - rep->r1 = rmatrixlurcond1(a, n, _state); - rep->rinf = rmatrixlurcondinf(a, n, _state); - if( ae_fp_less(rep->r1,rcondthreshold(_state))||ae_fp_less(rep->rinf,rcondthreshold(_state)) ) - { - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - a->ptr.pp_double[i][j] = 0; - } - } - rep->r1 = 0; - rep->rinf = 0; - *info = -3; - ae_frame_leave(_state); - return; - } - - /* - * Call cache-oblivious code - */ - ae_vector_set_length(&work, n, _state); - matinv_rmatrixluinverserec(a, 0, n, &work, info, rep, _state); - - /* - * apply permutations - */ - for(i=0; i<=n-1; i++) - { - for(j=n-2; j>=0; j--) - { - k = pivots->ptr.p_int[j]; - v = a->ptr.pp_double[i][j]; - a->ptr.pp_double[i][j] = a->ptr.pp_double[i][k]; - a->ptr.pp_double[i][k] = v; - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Inversion of a general matrix. - -Input parameters: - A - matrix. - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - -Output parameters: - Info - return code, same as in RMatrixLUInverse - Rep - solver report, same as in RMatrixLUInverse - A - inverse of matrix A, same as in RMatrixLUInverse - -Result: - True, if the matrix is not singular. - False, if the matrix is singular. - - -- ALGLIB -- - Copyright 2005-2010 by Bochkanov Sergey -*************************************************************************/ -void rmatrixinverse(/* Real */ ae_matrix* a, - ae_int_t n, - ae_int_t* info, - matinvreport* rep, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector pivots; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _matinvreport_clear(rep); - ae_vector_init(&pivots, 0, DT_INT, _state, ae_true); - - ae_assert(n>0, "RMatrixInverse: N<=0!", _state); - ae_assert(a->cols>=n, "RMatrixInverse: cols(A)rows>=n, "RMatrixInverse: rows(A)0, "CMatrixLUInverse: N<=0!", _state); - ae_assert(a->cols>=n, "CMatrixLUInverse: cols(A)rows>=n, "CMatrixLUInverse: rows(A)cnt>=n, "CMatrixLUInverse: len(Pivots)ptr.p_int[i]>n-1||pivots->ptr.p_int[i]0, "CMatrixLUInverse: incorrect Pivots array!", _state); - - /* - * calculate condition numbers - */ - rep->r1 = cmatrixlurcond1(a, n, _state); - rep->rinf = cmatrixlurcondinf(a, n, _state); - if( ae_fp_less(rep->r1,rcondthreshold(_state))||ae_fp_less(rep->rinf,rcondthreshold(_state)) ) - { - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - a->ptr.pp_complex[i][j] = ae_complex_from_d(0); - } - } - rep->r1 = 0; - rep->rinf = 0; - *info = -3; - ae_frame_leave(_state); - return; - } - - /* - * Call cache-oblivious code - */ - ae_vector_set_length(&work, n, _state); - matinv_cmatrixluinverserec(a, 0, n, &work, info, rep, _state); - - /* - * apply permutations - */ - for(i=0; i<=n-1; i++) - { - for(j=n-2; j>=0; j--) - { - k = pivots->ptr.p_int[j]; - v = a->ptr.pp_complex[i][j]; - a->ptr.pp_complex[i][j] = a->ptr.pp_complex[i][k]; - a->ptr.pp_complex[i][k] = v; - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Inversion of a general matrix. - -Input parameters: - A - matrix - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - -Output parameters: - Info - return code, same as in RMatrixLUInverse - Rep - solver report, same as in RMatrixLUInverse - A - inverse of matrix A, same as in RMatrixLUInverse - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -void cmatrixinverse(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_int_t* info, - matinvreport* rep, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector pivots; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _matinvreport_clear(rep); - ae_vector_init(&pivots, 0, DT_INT, _state, ae_true); - - ae_assert(n>0, "CRMatrixInverse: N<=0!", _state); - ae_assert(a->cols>=n, "CRMatrixInverse: cols(A)rows>=n, "CRMatrixInverse: rows(A)0, "SPDMatrixCholeskyInverse: N<=0!", _state); - ae_assert(a->cols>=n, "SPDMatrixCholeskyInverse: cols(A)rows>=n, "SPDMatrixCholeskyInverse: rows(A)ptr.pp_double[i][i], _state); - } - ae_assert(f, "SPDMatrixCholeskyInverse: A contains infinite or NaN values!", _state); - - /* - * calculate condition numbers - */ - rep->r1 = spdmatrixcholeskyrcond(a, n, isupper, _state); - rep->rinf = rep->r1; - if( ae_fp_less(rep->r1,rcondthreshold(_state))||ae_fp_less(rep->rinf,rcondthreshold(_state)) ) - { - if( isupper ) - { - for(i=0; i<=n-1; i++) - { - for(j=i; j<=n-1; j++) - { - a->ptr.pp_double[i][j] = 0; - } - } - } - else - { - for(i=0; i<=n-1; i++) - { - for(j=0; j<=i; j++) - { - a->ptr.pp_double[i][j] = 0; - } - } - } - rep->r1 = 0; - rep->rinf = 0; - *info = -3; - ae_frame_leave(_state); - return; - } - - /* - * Inverse - */ - ae_vector_set_length(&tmp, n, _state); - matinv_spdmatrixcholeskyinverserec(a, 0, n, isupper, &tmp, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Inversion of a symmetric positive definite matrix. - -Given an upper or lower triangle of a symmetric positive definite matrix, -the algorithm generates matrix A^-1 and saves the upper or lower triangle -depending on the input. - -Input parameters: - A - matrix to be inverted (upper or lower triangle). - Array with elements [0..N-1,0..N-1]. - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - IsUpper - storage type (optional): - * if True, symmetric matrix A is given by its upper - triangle, and the lower triangle isn’t used/changed by - function - * if False, symmetric matrix A is given by its lower - triangle, and the upper triangle isn’t used/changed by - function - * if not given, both lower and upper triangles must be - filled. - -Output parameters: - Info - return code, same as in RMatrixLUInverse - Rep - solver report, same as in RMatrixLUInverse - A - inverse of matrix A, same as in RMatrixLUInverse - - -- ALGLIB routine -- - 10.02.2010 - Bochkanov Sergey -*************************************************************************/ -void spdmatrixinverse(/* Real */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_int_t* info, - matinvreport* rep, - ae_state *_state) -{ - - *info = 0; - _matinvreport_clear(rep); - - ae_assert(n>0, "SPDMatrixInverse: N<=0!", _state); - ae_assert(a->cols>=n, "SPDMatrixInverse: cols(A)rows>=n, "SPDMatrixInverse: rows(A)0, "HPDMatrixCholeskyInverse: N<=0!", _state); - ae_assert(a->cols>=n, "HPDMatrixCholeskyInverse: cols(A)rows>=n, "HPDMatrixCholeskyInverse: rows(A)ptr.pp_complex[i][i].x, _state))&&ae_isfinite(a->ptr.pp_complex[i][i].y, _state); - } - ae_assert(f, "HPDMatrixCholeskyInverse: A contains infinite or NaN values!", _state); - *info = 1; - - /* - * calculate condition numbers - */ - rep->r1 = hpdmatrixcholeskyrcond(a, n, isupper, _state); - rep->rinf = rep->r1; - if( ae_fp_less(rep->r1,rcondthreshold(_state))||ae_fp_less(rep->rinf,rcondthreshold(_state)) ) - { - if( isupper ) - { - for(i=0; i<=n-1; i++) - { - for(j=i; j<=n-1; j++) - { - a->ptr.pp_complex[i][j] = ae_complex_from_d(0); - } - } - } - else - { - for(i=0; i<=n-1; i++) - { - for(j=0; j<=i; j++) - { - a->ptr.pp_complex[i][j] = ae_complex_from_d(0); - } - } - } - rep->r1 = 0; - rep->rinf = 0; - *info = -3; - ae_frame_leave(_state); - return; - } - - /* - * Inverse - */ - ae_vector_set_length(&tmp, n, _state); - matinv_hpdmatrixcholeskyinverserec(a, 0, n, isupper, &tmp, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Inversion of a Hermitian positive definite matrix. - -Given an upper or lower triangle of a Hermitian positive definite matrix, -the algorithm generates matrix A^-1 and saves the upper or lower triangle -depending on the input. - -Input parameters: - A - matrix to be inverted (upper or lower triangle). - Array with elements [0..N-1,0..N-1]. - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - IsUpper - storage type (optional): - * if True, symmetric matrix A is given by its upper - triangle, and the lower triangle isn’t used/changed by - function - * if False, symmetric matrix A is given by its lower - triangle, and the upper triangle isn’t used/changed by - function - * if not given, both lower and upper triangles must be - filled. - -Output parameters: - Info - return code, same as in RMatrixLUInverse - Rep - solver report, same as in RMatrixLUInverse - A - inverse of matrix A, same as in RMatrixLUInverse - - -- ALGLIB routine -- - 10.02.2010 - Bochkanov Sergey -*************************************************************************/ -void hpdmatrixinverse(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_int_t* info, - matinvreport* rep, - ae_state *_state) -{ - - *info = 0; - _matinvreport_clear(rep); - - ae_assert(n>0, "HPDMatrixInverse: N<=0!", _state); - ae_assert(a->cols>=n, "HPDMatrixInverse: cols(A)rows>=n, "HPDMatrixInverse: rows(A)0, "RMatrixTRInverse: N<=0!", _state); - ae_assert(a->cols>=n, "RMatrixTRInverse: cols(A)rows>=n, "RMatrixTRInverse: rows(A)r1 = rmatrixtrrcond1(a, n, isupper, isunit, _state); - rep->rinf = rmatrixtrrcondinf(a, n, isupper, isunit, _state); - if( ae_fp_less(rep->r1,rcondthreshold(_state))||ae_fp_less(rep->rinf,rcondthreshold(_state)) ) - { - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - a->ptr.pp_double[i][j] = 0; - } - } - rep->r1 = 0; - rep->rinf = 0; - *info = -3; - ae_frame_leave(_state); - return; - } - - /* - * Invert - */ - ae_vector_set_length(&tmp, n, _state); - matinv_rmatrixtrinverserec(a, 0, n, isupper, isunit, &tmp, info, rep, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Triangular matrix inverse (complex) - -The subroutine inverts the following types of matrices: - * upper triangular - * upper triangular with unit diagonal - * lower triangular - * lower triangular with unit diagonal - -In case of an upper (lower) triangular matrix, the inverse matrix will -also be upper (lower) triangular, and after the end of the algorithm, the -inverse matrix replaces the source matrix. The elements below (above) the -main diagonal are not changed by the algorithm. - -If the matrix has a unit diagonal, the inverse matrix also has a unit -diagonal, and the diagonal elements are not passed to the algorithm. - -Input parameters: - A - matrix, array[0..N-1, 0..N-1]. - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - IsUpper - True, if the matrix is upper triangular. - IsUnit - diagonal type (optional): - * if True, matrix has unit diagonal (a[i,i] are NOT used) - * if False, matrix diagonal is arbitrary - * if not given, False is assumed - -Output parameters: - Info - same as for RMatrixLUInverse - Rep - same as for RMatrixLUInverse - A - same as for RMatrixLUInverse. - - -- ALGLIB -- - Copyright 05.02.2010 by Bochkanov Sergey -*************************************************************************/ -void cmatrixtrinverse(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_bool isunit, - ae_int_t* info, - matinvreport* rep, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - ae_vector tmp; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _matinvreport_clear(rep); - ae_vector_init(&tmp, 0, DT_COMPLEX, _state, ae_true); - - ae_assert(n>0, "CMatrixTRInverse: N<=0!", _state); - ae_assert(a->cols>=n, "CMatrixTRInverse: cols(A)rows>=n, "CMatrixTRInverse: rows(A)r1 = cmatrixtrrcond1(a, n, isupper, isunit, _state); - rep->rinf = cmatrixtrrcondinf(a, n, isupper, isunit, _state); - if( ae_fp_less(rep->r1,rcondthreshold(_state))||ae_fp_less(rep->rinf,rcondthreshold(_state)) ) - { - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - a->ptr.pp_complex[i][j] = ae_complex_from_d(0); - } - } - rep->r1 = 0; - rep->rinf = 0; - *info = -3; - ae_frame_leave(_state); - return; - } - - /* - * Invert - */ - ae_vector_set_length(&tmp, n, _state); - matinv_cmatrixtrinverserec(a, 0, n, isupper, isunit, &tmp, info, rep, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Triangular matrix inversion, recursive subroutine - - -- ALGLIB -- - 05.02.2010, Bochkanov Sergey. - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - February 29, 1992. -*************************************************************************/ -static void matinv_rmatrixtrinverserec(/* Real */ ae_matrix* a, - ae_int_t offs, - ae_int_t n, - ae_bool isupper, - ae_bool isunit, - /* Real */ ae_vector* tmp, - ae_int_t* info, - matinvreport* rep, - ae_state *_state) -{ - ae_int_t n1; - ae_int_t n2; - ae_int_t i; - ae_int_t j; - double v; - double ajj; - - - if( n<1 ) - { - *info = -1; - return; - } - - /* - * Base case - */ - if( n<=ablasblocksize(a, _state) ) - { - if( isupper ) - { - - /* - * Compute inverse of upper triangular matrix. - */ - for(j=0; j<=n-1; j++) - { - if( !isunit ) - { - if( ae_fp_eq(a->ptr.pp_double[offs+j][offs+j],0) ) - { - *info = -3; - return; - } - a->ptr.pp_double[offs+j][offs+j] = 1/a->ptr.pp_double[offs+j][offs+j]; - ajj = -a->ptr.pp_double[offs+j][offs+j]; - } - else - { - ajj = -1; - } - - /* - * Compute elements 1:j-1 of j-th column. - */ - if( j>0 ) - { - ae_v_move(&tmp->ptr.p_double[0], 1, &a->ptr.pp_double[offs+0][offs+j], a->stride, ae_v_len(0,j-1)); - for(i=0; i<=j-1; i++) - { - if( iptr.pp_double[offs+i][offs+i+1], 1, &tmp->ptr.p_double[i+1], 1, ae_v_len(offs+i+1,offs+j-1)); - } - else - { - v = 0; - } - if( !isunit ) - { - a->ptr.pp_double[offs+i][offs+j] = v+a->ptr.pp_double[offs+i][offs+i]*tmp->ptr.p_double[i]; - } - else - { - a->ptr.pp_double[offs+i][offs+j] = v+tmp->ptr.p_double[i]; - } - } - ae_v_muld(&a->ptr.pp_double[offs+0][offs+j], a->stride, ae_v_len(offs+0,offs+j-1), ajj); - } - } - } - else - { - - /* - * Compute inverse of lower triangular matrix. - */ - for(j=n-1; j>=0; j--) - { - if( !isunit ) - { - if( ae_fp_eq(a->ptr.pp_double[offs+j][offs+j],0) ) - { - *info = -3; - return; - } - a->ptr.pp_double[offs+j][offs+j] = 1/a->ptr.pp_double[offs+j][offs+j]; - ajj = -a->ptr.pp_double[offs+j][offs+j]; - } - else - { - ajj = -1; - } - if( jptr.p_double[j+1], 1, &a->ptr.pp_double[offs+j+1][offs+j], a->stride, ae_v_len(j+1,n-1)); - for(i=j+1; i<=n-1; i++) - { - if( i>j+1 ) - { - v = ae_v_dotproduct(&a->ptr.pp_double[offs+i][offs+j+1], 1, &tmp->ptr.p_double[j+1], 1, ae_v_len(offs+j+1,offs+i-1)); - } - else - { - v = 0; - } - if( !isunit ) - { - a->ptr.pp_double[offs+i][offs+j] = v+a->ptr.pp_double[offs+i][offs+i]*tmp->ptr.p_double[i]; - } - else - { - a->ptr.pp_double[offs+i][offs+j] = v+tmp->ptr.p_double[i]; - } - } - ae_v_muld(&a->ptr.pp_double[offs+j+1][offs+j], a->stride, ae_v_len(offs+j+1,offs+n-1), ajj); - } - } - } - return; - } - - /* - * Recursive case - */ - ablassplitlength(a, n, &n1, &n2, _state); - if( n2>0 ) - { - if( isupper ) - { - for(i=0; i<=n1-1; i++) - { - ae_v_muld(&a->ptr.pp_double[offs+i][offs+n1], 1, ae_v_len(offs+n1,offs+n-1), -1); - } - rmatrixlefttrsm(n1, n2, a, offs, offs, isupper, isunit, 0, a, offs, offs+n1, _state); - rmatrixrighttrsm(n1, n2, a, offs+n1, offs+n1, isupper, isunit, 0, a, offs, offs+n1, _state); - } - else - { - for(i=0; i<=n2-1; i++) - { - ae_v_muld(&a->ptr.pp_double[offs+n1+i][offs], 1, ae_v_len(offs,offs+n1-1), -1); - } - rmatrixrighttrsm(n2, n1, a, offs, offs, isupper, isunit, 0, a, offs+n1, offs, _state); - rmatrixlefttrsm(n2, n1, a, offs+n1, offs+n1, isupper, isunit, 0, a, offs+n1, offs, _state); - } - matinv_rmatrixtrinverserec(a, offs+n1, n2, isupper, isunit, tmp, info, rep, _state); - } - matinv_rmatrixtrinverserec(a, offs, n1, isupper, isunit, tmp, info, rep, _state); -} - - -/************************************************************************* -Triangular matrix inversion, recursive subroutine - - -- ALGLIB -- - 05.02.2010, Bochkanov Sergey. - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - February 29, 1992. -*************************************************************************/ -static void matinv_cmatrixtrinverserec(/* Complex */ ae_matrix* a, - ae_int_t offs, - ae_int_t n, - ae_bool isupper, - ae_bool isunit, - /* Complex */ ae_vector* tmp, - ae_int_t* info, - matinvreport* rep, - ae_state *_state) -{ - ae_int_t n1; - ae_int_t n2; - ae_int_t i; - ae_int_t j; - ae_complex v; - ae_complex ajj; - - - if( n<1 ) - { - *info = -1; - return; - } - - /* - * Base case - */ - if( n<=ablascomplexblocksize(a, _state) ) - { - if( isupper ) - { - - /* - * Compute inverse of upper triangular matrix. - */ - for(j=0; j<=n-1; j++) - { - if( !isunit ) - { - if( ae_c_eq_d(a->ptr.pp_complex[offs+j][offs+j],0) ) - { - *info = -3; - return; - } - a->ptr.pp_complex[offs+j][offs+j] = ae_c_d_div(1,a->ptr.pp_complex[offs+j][offs+j]); - ajj = ae_c_neg(a->ptr.pp_complex[offs+j][offs+j]); - } - else - { - ajj = ae_complex_from_d(-1); - } - - /* - * Compute elements 1:j-1 of j-th column. - */ - if( j>0 ) - { - ae_v_cmove(&tmp->ptr.p_complex[0], 1, &a->ptr.pp_complex[offs+0][offs+j], a->stride, "N", ae_v_len(0,j-1)); - for(i=0; i<=j-1; i++) - { - if( iptr.pp_complex[offs+i][offs+i+1], 1, "N", &tmp->ptr.p_complex[i+1], 1, "N", ae_v_len(offs+i+1,offs+j-1)); - } - else - { - v = ae_complex_from_d(0); - } - if( !isunit ) - { - a->ptr.pp_complex[offs+i][offs+j] = ae_c_add(v,ae_c_mul(a->ptr.pp_complex[offs+i][offs+i],tmp->ptr.p_complex[i])); - } - else - { - a->ptr.pp_complex[offs+i][offs+j] = ae_c_add(v,tmp->ptr.p_complex[i]); - } - } - ae_v_cmulc(&a->ptr.pp_complex[offs+0][offs+j], a->stride, ae_v_len(offs+0,offs+j-1), ajj); - } - } - } - else - { - - /* - * Compute inverse of lower triangular matrix. - */ - for(j=n-1; j>=0; j--) - { - if( !isunit ) - { - if( ae_c_eq_d(a->ptr.pp_complex[offs+j][offs+j],0) ) - { - *info = -3; - return; - } - a->ptr.pp_complex[offs+j][offs+j] = ae_c_d_div(1,a->ptr.pp_complex[offs+j][offs+j]); - ajj = ae_c_neg(a->ptr.pp_complex[offs+j][offs+j]); - } - else - { - ajj = ae_complex_from_d(-1); - } - if( jptr.p_complex[j+1], 1, &a->ptr.pp_complex[offs+j+1][offs+j], a->stride, "N", ae_v_len(j+1,n-1)); - for(i=j+1; i<=n-1; i++) - { - if( i>j+1 ) - { - v = ae_v_cdotproduct(&a->ptr.pp_complex[offs+i][offs+j+1], 1, "N", &tmp->ptr.p_complex[j+1], 1, "N", ae_v_len(offs+j+1,offs+i-1)); - } - else - { - v = ae_complex_from_d(0); - } - if( !isunit ) - { - a->ptr.pp_complex[offs+i][offs+j] = ae_c_add(v,ae_c_mul(a->ptr.pp_complex[offs+i][offs+i],tmp->ptr.p_complex[i])); - } - else - { - a->ptr.pp_complex[offs+i][offs+j] = ae_c_add(v,tmp->ptr.p_complex[i]); - } - } - ae_v_cmulc(&a->ptr.pp_complex[offs+j+1][offs+j], a->stride, ae_v_len(offs+j+1,offs+n-1), ajj); - } - } - } - return; - } - - /* - * Recursive case - */ - ablascomplexsplitlength(a, n, &n1, &n2, _state); - if( n2>0 ) - { - if( isupper ) - { - for(i=0; i<=n1-1; i++) - { - ae_v_cmuld(&a->ptr.pp_complex[offs+i][offs+n1], 1, ae_v_len(offs+n1,offs+n-1), -1); - } - cmatrixlefttrsm(n1, n2, a, offs, offs, isupper, isunit, 0, a, offs, offs+n1, _state); - cmatrixrighttrsm(n1, n2, a, offs+n1, offs+n1, isupper, isunit, 0, a, offs, offs+n1, _state); - } - else - { - for(i=0; i<=n2-1; i++) - { - ae_v_cmuld(&a->ptr.pp_complex[offs+n1+i][offs], 1, ae_v_len(offs,offs+n1-1), -1); - } - cmatrixrighttrsm(n2, n1, a, offs, offs, isupper, isunit, 0, a, offs+n1, offs, _state); - cmatrixlefttrsm(n2, n1, a, offs+n1, offs+n1, isupper, isunit, 0, a, offs+n1, offs, _state); - } - matinv_cmatrixtrinverserec(a, offs+n1, n2, isupper, isunit, tmp, info, rep, _state); - } - matinv_cmatrixtrinverserec(a, offs, n1, isupper, isunit, tmp, info, rep, _state); -} - - -static void matinv_rmatrixluinverserec(/* Real */ ae_matrix* a, - ae_int_t offs, - ae_int_t n, - /* Real */ ae_vector* work, - ae_int_t* info, - matinvreport* rep, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - double v; - ae_int_t n1; - ae_int_t n2; - - - if( n<1 ) - { - *info = -1; - return; - } - - /* - * Base case - */ - if( n<=ablasblocksize(a, _state) ) - { - - /* - * Form inv(U) - */ - matinv_rmatrixtrinverserec(a, offs, n, ae_true, ae_false, work, info, rep, _state); - if( *info<=0 ) - { - return; - } - - /* - * Solve the equation inv(A)*L = inv(U) for inv(A). - */ - for(j=n-1; j>=0; j--) - { - - /* - * Copy current column of L to WORK and replace with zeros. - */ - for(i=j+1; i<=n-1; i++) - { - work->ptr.p_double[i] = a->ptr.pp_double[offs+i][offs+j]; - a->ptr.pp_double[offs+i][offs+j] = 0; - } - - /* - * Compute current column of inv(A). - */ - if( jptr.pp_double[offs+i][offs+j+1], 1, &work->ptr.p_double[j+1], 1, ae_v_len(offs+j+1,offs+n-1)); - a->ptr.pp_double[offs+i][offs+j] = a->ptr.pp_double[offs+i][offs+j]-v; - } - } - } - return; - } - - /* - * Recursive code: - * - * ( L1 ) ( U1 U12 ) - * A = ( ) * ( ) - * ( L12 L2 ) ( U2 ) - * - * ( W X ) - * A^-1 = ( ) - * ( Y Z ) - */ - ablassplitlength(a, n, &n1, &n2, _state); - ae_assert(n2>0, "LUInverseRec: internal error!", _state); - - /* - * X := inv(U1)*U12*inv(U2) - */ - rmatrixlefttrsm(n1, n2, a, offs, offs, ae_true, ae_false, 0, a, offs, offs+n1, _state); - rmatrixrighttrsm(n1, n2, a, offs+n1, offs+n1, ae_true, ae_false, 0, a, offs, offs+n1, _state); - - /* - * Y := inv(L2)*L12*inv(L1) - */ - rmatrixlefttrsm(n2, n1, a, offs+n1, offs+n1, ae_false, ae_true, 0, a, offs+n1, offs, _state); - rmatrixrighttrsm(n2, n1, a, offs, offs, ae_false, ae_true, 0, a, offs+n1, offs, _state); - - /* - * W := inv(L1*U1)+X*Y - */ - matinv_rmatrixluinverserec(a, offs, n1, work, info, rep, _state); - if( *info<=0 ) - { - return; - } - rmatrixgemm(n1, n1, n2, 1.0, a, offs, offs+n1, 0, a, offs+n1, offs, 0, 1.0, a, offs, offs, _state); - - /* - * X := -X*inv(L2) - * Y := -inv(U2)*Y - */ - rmatrixrighttrsm(n1, n2, a, offs+n1, offs+n1, ae_false, ae_true, 0, a, offs, offs+n1, _state); - for(i=0; i<=n1-1; i++) - { - ae_v_muld(&a->ptr.pp_double[offs+i][offs+n1], 1, ae_v_len(offs+n1,offs+n-1), -1); - } - rmatrixlefttrsm(n2, n1, a, offs+n1, offs+n1, ae_true, ae_false, 0, a, offs+n1, offs, _state); - for(i=0; i<=n2-1; i++) - { - ae_v_muld(&a->ptr.pp_double[offs+n1+i][offs], 1, ae_v_len(offs,offs+n1-1), -1); - } - - /* - * Z := inv(L2*U2) - */ - matinv_rmatrixluinverserec(a, offs+n1, n2, work, info, rep, _state); -} - - -static void matinv_cmatrixluinverserec(/* Complex */ ae_matrix* a, - ae_int_t offs, - ae_int_t n, - /* Complex */ ae_vector* work, - ae_int_t* info, - matinvreport* rep, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_complex v; - ae_int_t n1; - ae_int_t n2; - - - if( n<1 ) - { - *info = -1; - return; - } - - /* - * Base case - */ - if( n<=ablascomplexblocksize(a, _state) ) - { - - /* - * Form inv(U) - */ - matinv_cmatrixtrinverserec(a, offs, n, ae_true, ae_false, work, info, rep, _state); - if( *info<=0 ) - { - return; - } - - /* - * Solve the equation inv(A)*L = inv(U) for inv(A). - */ - for(j=n-1; j>=0; j--) - { - - /* - * Copy current column of L to WORK and replace with zeros. - */ - for(i=j+1; i<=n-1; i++) - { - work->ptr.p_complex[i] = a->ptr.pp_complex[offs+i][offs+j]; - a->ptr.pp_complex[offs+i][offs+j] = ae_complex_from_d(0); - } - - /* - * Compute current column of inv(A). - */ - if( jptr.pp_complex[offs+i][offs+j+1], 1, "N", &work->ptr.p_complex[j+1], 1, "N", ae_v_len(offs+j+1,offs+n-1)); - a->ptr.pp_complex[offs+i][offs+j] = ae_c_sub(a->ptr.pp_complex[offs+i][offs+j],v); - } - } - } - return; - } - - /* - * Recursive code: - * - * ( L1 ) ( U1 U12 ) - * A = ( ) * ( ) - * ( L12 L2 ) ( U2 ) - * - * ( W X ) - * A^-1 = ( ) - * ( Y Z ) - */ - ablascomplexsplitlength(a, n, &n1, &n2, _state); - ae_assert(n2>0, "LUInverseRec: internal error!", _state); - - /* - * X := inv(U1)*U12*inv(U2) - */ - cmatrixlefttrsm(n1, n2, a, offs, offs, ae_true, ae_false, 0, a, offs, offs+n1, _state); - cmatrixrighttrsm(n1, n2, a, offs+n1, offs+n1, ae_true, ae_false, 0, a, offs, offs+n1, _state); - - /* - * Y := inv(L2)*L12*inv(L1) - */ - cmatrixlefttrsm(n2, n1, a, offs+n1, offs+n1, ae_false, ae_true, 0, a, offs+n1, offs, _state); - cmatrixrighttrsm(n2, n1, a, offs, offs, ae_false, ae_true, 0, a, offs+n1, offs, _state); - - /* - * W := inv(L1*U1)+X*Y - */ - matinv_cmatrixluinverserec(a, offs, n1, work, info, rep, _state); - if( *info<=0 ) - { - return; - } - cmatrixgemm(n1, n1, n2, ae_complex_from_d(1.0), a, offs, offs+n1, 0, a, offs+n1, offs, 0, ae_complex_from_d(1.0), a, offs, offs, _state); - - /* - * X := -X*inv(L2) - * Y := -inv(U2)*Y - */ - cmatrixrighttrsm(n1, n2, a, offs+n1, offs+n1, ae_false, ae_true, 0, a, offs, offs+n1, _state); - for(i=0; i<=n1-1; i++) - { - ae_v_cmuld(&a->ptr.pp_complex[offs+i][offs+n1], 1, ae_v_len(offs+n1,offs+n-1), -1); - } - cmatrixlefttrsm(n2, n1, a, offs+n1, offs+n1, ae_true, ae_false, 0, a, offs+n1, offs, _state); - for(i=0; i<=n2-1; i++) - { - ae_v_cmuld(&a->ptr.pp_complex[offs+n1+i][offs], 1, ae_v_len(offs,offs+n1-1), -1); - } - - /* - * Z := inv(L2*U2) - */ - matinv_cmatrixluinverserec(a, offs+n1, n2, work, info, rep, _state); -} - - -/************************************************************************* -Recursive subroutine for SPD inversion. - - -- ALGLIB routine -- - 10.02.2010 - Bochkanov Sergey -*************************************************************************/ -static void matinv_spdmatrixcholeskyinverserec(/* Real */ ae_matrix* a, - ae_int_t offs, - ae_int_t n, - ae_bool isupper, - /* Real */ ae_vector* tmp, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - double v; - ae_int_t n1; - ae_int_t n2; - ae_int_t info2; - matinvreport rep2; - - ae_frame_make(_state, &_frame_block); - _matinvreport_init(&rep2, _state, ae_true); - - if( n<1 ) - { - ae_frame_leave(_state); - return; - } - - /* - * Base case - */ - if( n<=ablasblocksize(a, _state) ) - { - matinv_rmatrixtrinverserec(a, offs, n, isupper, ae_false, tmp, &info2, &rep2, _state); - if( isupper ) - { - - /* - * Compute the product U * U'. - * NOTE: we never assume that diagonal of U is real - */ - for(i=0; i<=n-1; i++) - { - if( i==0 ) - { - - /* - * 1x1 matrix - */ - a->ptr.pp_double[offs+i][offs+i] = ae_sqr(a->ptr.pp_double[offs+i][offs+i], _state); - } - else - { - - /* - * (I+1)x(I+1) matrix, - * - * ( A11 A12 ) ( A11^H ) ( A11*A11^H+A12*A12^H A12*A22^H ) - * ( ) * ( ) = ( ) - * ( A22 ) ( A12^H A22^H ) ( A22*A12^H A22*A22^H ) - * - * A11 is IxI, A22 is 1x1. - */ - ae_v_move(&tmp->ptr.p_double[0], 1, &a->ptr.pp_double[offs][offs+i], a->stride, ae_v_len(0,i-1)); - for(j=0; j<=i-1; j++) - { - v = a->ptr.pp_double[offs+j][offs+i]; - ae_v_addd(&a->ptr.pp_double[offs+j][offs+j], 1, &tmp->ptr.p_double[j], 1, ae_v_len(offs+j,offs+i-1), v); - } - v = a->ptr.pp_double[offs+i][offs+i]; - ae_v_muld(&a->ptr.pp_double[offs][offs+i], a->stride, ae_v_len(offs,offs+i-1), v); - a->ptr.pp_double[offs+i][offs+i] = ae_sqr(a->ptr.pp_double[offs+i][offs+i], _state); - } - } - } - else - { - - /* - * Compute the product L' * L - * NOTE: we never assume that diagonal of L is real - */ - for(i=0; i<=n-1; i++) - { - if( i==0 ) - { - - /* - * 1x1 matrix - */ - a->ptr.pp_double[offs+i][offs+i] = ae_sqr(a->ptr.pp_double[offs+i][offs+i], _state); - } - else - { - - /* - * (I+1)x(I+1) matrix, - * - * ( A11^H A21^H ) ( A11 ) ( A11^H*A11+A21^H*A21 A21^H*A22 ) - * ( ) * ( ) = ( ) - * ( A22^H ) ( A21 A22 ) ( A22^H*A21 A22^H*A22 ) - * - * A11 is IxI, A22 is 1x1. - */ - ae_v_move(&tmp->ptr.p_double[0], 1, &a->ptr.pp_double[offs+i][offs], 1, ae_v_len(0,i-1)); - for(j=0; j<=i-1; j++) - { - v = a->ptr.pp_double[offs+i][offs+j]; - ae_v_addd(&a->ptr.pp_double[offs+j][offs], 1, &tmp->ptr.p_double[0], 1, ae_v_len(offs,offs+j), v); - } - v = a->ptr.pp_double[offs+i][offs+i]; - ae_v_muld(&a->ptr.pp_double[offs+i][offs], 1, ae_v_len(offs,offs+i-1), v); - a->ptr.pp_double[offs+i][offs+i] = ae_sqr(a->ptr.pp_double[offs+i][offs+i], _state); - } - } - } - ae_frame_leave(_state); - return; - } - - /* - * Recursive code: triangular factor inversion merged with - * UU' or L'L multiplication - */ - ablassplitlength(a, n, &n1, &n2, _state); - - /* - * form off-diagonal block of trangular inverse - */ - if( isupper ) - { - for(i=0; i<=n1-1; i++) - { - ae_v_muld(&a->ptr.pp_double[offs+i][offs+n1], 1, ae_v_len(offs+n1,offs+n-1), -1); - } - rmatrixlefttrsm(n1, n2, a, offs, offs, isupper, ae_false, 0, a, offs, offs+n1, _state); - rmatrixrighttrsm(n1, n2, a, offs+n1, offs+n1, isupper, ae_false, 0, a, offs, offs+n1, _state); - } - else - { - for(i=0; i<=n2-1; i++) - { - ae_v_muld(&a->ptr.pp_double[offs+n1+i][offs], 1, ae_v_len(offs,offs+n1-1), -1); - } - rmatrixrighttrsm(n2, n1, a, offs, offs, isupper, ae_false, 0, a, offs+n1, offs, _state); - rmatrixlefttrsm(n2, n1, a, offs+n1, offs+n1, isupper, ae_false, 0, a, offs+n1, offs, _state); - } - - /* - * invert first diagonal block - */ - matinv_spdmatrixcholeskyinverserec(a, offs, n1, isupper, tmp, _state); - - /* - * update first diagonal block with off-diagonal block, - * update off-diagonal block - */ - if( isupper ) - { - rmatrixsyrk(n1, n2, 1.0, a, offs, offs+n1, 0, 1.0, a, offs, offs, isupper, _state); - rmatrixrighttrsm(n1, n2, a, offs+n1, offs+n1, isupper, ae_false, 1, a, offs, offs+n1, _state); - } - else - { - rmatrixsyrk(n1, n2, 1.0, a, offs+n1, offs, 1, 1.0, a, offs, offs, isupper, _state); - rmatrixlefttrsm(n2, n1, a, offs+n1, offs+n1, isupper, ae_false, 1, a, offs+n1, offs, _state); - } - - /* - * invert second diagonal block - */ - matinv_spdmatrixcholeskyinverserec(a, offs+n1, n2, isupper, tmp, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Recursive subroutine for HPD inversion. - - -- ALGLIB routine -- - 10.02.2010 - Bochkanov Sergey -*************************************************************************/ -static void matinv_hpdmatrixcholeskyinverserec(/* Complex */ ae_matrix* a, - ae_int_t offs, - ae_int_t n, - ae_bool isupper, - /* Complex */ ae_vector* tmp, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - ae_complex v; - ae_int_t n1; - ae_int_t n2; - ae_int_t info2; - matinvreport rep2; - - ae_frame_make(_state, &_frame_block); - _matinvreport_init(&rep2, _state, ae_true); - - if( n<1 ) - { - ae_frame_leave(_state); - return; - } - - /* - * Base case - */ - if( n<=ablascomplexblocksize(a, _state) ) - { - matinv_cmatrixtrinverserec(a, offs, n, isupper, ae_false, tmp, &info2, &rep2, _state); - if( isupper ) - { - - /* - * Compute the product U * U'. - * NOTE: we never assume that diagonal of U is real - */ - for(i=0; i<=n-1; i++) - { - if( i==0 ) - { - - /* - * 1x1 matrix - */ - a->ptr.pp_complex[offs+i][offs+i] = ae_complex_from_d(ae_sqr(a->ptr.pp_complex[offs+i][offs+i].x, _state)+ae_sqr(a->ptr.pp_complex[offs+i][offs+i].y, _state)); - } - else - { - - /* - * (I+1)x(I+1) matrix, - * - * ( A11 A12 ) ( A11^H ) ( A11*A11^H+A12*A12^H A12*A22^H ) - * ( ) * ( ) = ( ) - * ( A22 ) ( A12^H A22^H ) ( A22*A12^H A22*A22^H ) - * - * A11 is IxI, A22 is 1x1. - */ - ae_v_cmove(&tmp->ptr.p_complex[0], 1, &a->ptr.pp_complex[offs][offs+i], a->stride, "Conj", ae_v_len(0,i-1)); - for(j=0; j<=i-1; j++) - { - v = a->ptr.pp_complex[offs+j][offs+i]; - ae_v_caddc(&a->ptr.pp_complex[offs+j][offs+j], 1, &tmp->ptr.p_complex[j], 1, "N", ae_v_len(offs+j,offs+i-1), v); - } - v = ae_c_conj(a->ptr.pp_complex[offs+i][offs+i], _state); - ae_v_cmulc(&a->ptr.pp_complex[offs][offs+i], a->stride, ae_v_len(offs,offs+i-1), v); - a->ptr.pp_complex[offs+i][offs+i] = ae_complex_from_d(ae_sqr(a->ptr.pp_complex[offs+i][offs+i].x, _state)+ae_sqr(a->ptr.pp_complex[offs+i][offs+i].y, _state)); - } - } - } - else - { - - /* - * Compute the product L' * L - * NOTE: we never assume that diagonal of L is real - */ - for(i=0; i<=n-1; i++) - { - if( i==0 ) - { - - /* - * 1x1 matrix - */ - a->ptr.pp_complex[offs+i][offs+i] = ae_complex_from_d(ae_sqr(a->ptr.pp_complex[offs+i][offs+i].x, _state)+ae_sqr(a->ptr.pp_complex[offs+i][offs+i].y, _state)); - } - else - { - - /* - * (I+1)x(I+1) matrix, - * - * ( A11^H A21^H ) ( A11 ) ( A11^H*A11+A21^H*A21 A21^H*A22 ) - * ( ) * ( ) = ( ) - * ( A22^H ) ( A21 A22 ) ( A22^H*A21 A22^H*A22 ) - * - * A11 is IxI, A22 is 1x1. - */ - ae_v_cmove(&tmp->ptr.p_complex[0], 1, &a->ptr.pp_complex[offs+i][offs], 1, "N", ae_v_len(0,i-1)); - for(j=0; j<=i-1; j++) - { - v = ae_c_conj(a->ptr.pp_complex[offs+i][offs+j], _state); - ae_v_caddc(&a->ptr.pp_complex[offs+j][offs], 1, &tmp->ptr.p_complex[0], 1, "N", ae_v_len(offs,offs+j), v); - } - v = ae_c_conj(a->ptr.pp_complex[offs+i][offs+i], _state); - ae_v_cmulc(&a->ptr.pp_complex[offs+i][offs], 1, ae_v_len(offs,offs+i-1), v); - a->ptr.pp_complex[offs+i][offs+i] = ae_complex_from_d(ae_sqr(a->ptr.pp_complex[offs+i][offs+i].x, _state)+ae_sqr(a->ptr.pp_complex[offs+i][offs+i].y, _state)); - } - } - } - ae_frame_leave(_state); - return; - } - - /* - * Recursive code: triangular factor inversion merged with - * UU' or L'L multiplication - */ - ablascomplexsplitlength(a, n, &n1, &n2, _state); - - /* - * form off-diagonal block of trangular inverse - */ - if( isupper ) - { - for(i=0; i<=n1-1; i++) - { - ae_v_cmuld(&a->ptr.pp_complex[offs+i][offs+n1], 1, ae_v_len(offs+n1,offs+n-1), -1); - } - cmatrixlefttrsm(n1, n2, a, offs, offs, isupper, ae_false, 0, a, offs, offs+n1, _state); - cmatrixrighttrsm(n1, n2, a, offs+n1, offs+n1, isupper, ae_false, 0, a, offs, offs+n1, _state); - } - else - { - for(i=0; i<=n2-1; i++) - { - ae_v_cmuld(&a->ptr.pp_complex[offs+n1+i][offs], 1, ae_v_len(offs,offs+n1-1), -1); - } - cmatrixrighttrsm(n2, n1, a, offs, offs, isupper, ae_false, 0, a, offs+n1, offs, _state); - cmatrixlefttrsm(n2, n1, a, offs+n1, offs+n1, isupper, ae_false, 0, a, offs+n1, offs, _state); - } - - /* - * invert first diagonal block - */ - matinv_hpdmatrixcholeskyinverserec(a, offs, n1, isupper, tmp, _state); - - /* - * update first diagonal block with off-diagonal block, - * update off-diagonal block - */ - if( isupper ) - { - cmatrixsyrk(n1, n2, 1.0, a, offs, offs+n1, 0, 1.0, a, offs, offs, isupper, _state); - cmatrixrighttrsm(n1, n2, a, offs+n1, offs+n1, isupper, ae_false, 2, a, offs, offs+n1, _state); - } - else - { - cmatrixsyrk(n1, n2, 1.0, a, offs+n1, offs, 2, 1.0, a, offs, offs, isupper, _state); - cmatrixlefttrsm(n2, n1, a, offs+n1, offs+n1, isupper, ae_false, 2, a, offs+n1, offs, _state); - } - - /* - * invert second diagonal block - */ - matinv_hpdmatrixcholeskyinverserec(a, offs+n1, n2, isupper, tmp, _state); - ae_frame_leave(_state); -} - - -ae_bool _matinvreport_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - matinvreport *p = (matinvreport*)_p; - ae_touch_ptr((void*)p); - return ae_true; -} - - -ae_bool _matinvreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - matinvreport *dst = (matinvreport*)_dst; - matinvreport *src = (matinvreport*)_src; - dst->r1 = src->r1; - dst->rinf = src->rinf; - return ae_true; -} - - -void _matinvreport_clear(void* _p) -{ - matinvreport *p = (matinvreport*)_p; - ae_touch_ptr((void*)p); -} - - -void _matinvreport_destroy(void* _p) -{ - matinvreport *p = (matinvreport*)_p; - ae_touch_ptr((void*)p); -} - - - - -/************************************************************************* -This function creates sparse matrix in a Hash-Table format. - -This function creates Hast-Table matrix, which can be converted to CRS -format after its initialization is over. Typical usage scenario for a -sparse matrix is: -1. creation in a Hash-Table format -2. insertion of the matrix elements -3. conversion to the CRS representation -4. matrix is passed to some linear algebra algorithm - -Some information about different matrix formats can be found below, in -the "NOTES" section. - -INPUT PARAMETERS - M - number of rows in a matrix, M>=1 - N - number of columns in a matrix, N>=1 - K - K>=0, expected number of non-zero elements in a matrix. - K can be inexact approximation, can be less than actual - number of elements (table will grow when needed) or - even zero). - It is important to understand that although hash-table - may grow automatically, it is better to provide good - estimate of data size. - -OUTPUT PARAMETERS - S - sparse M*N matrix in Hash-Table representation. - All elements of the matrix are zero. - -NOTE 1. - -Sparse matrices can be stored using either Hash-Table representation or -Compressed Row Storage representation. Hast-table is better suited for -querying and dynamic operations (thus, it is used for matrix -initialization), but it is inefficient when you want to make some linear -algebra operations. - -From the other side, CRS is better suited for linear algebra operations, -but initialization is less convenient - you have to tell row sizes at the -initialization, and you can fill matrix only row by row, from left to -right. CRS is also very inefficient when you want to find matrix element -by its index. - -Thus, Hash-Table representation does not support linear algebra -operations, while CRS format does not support modification of the table. -Tables below outline information about these two formats: - - OPERATIONS WITH MATRIX HASH CRS - create + + - read element + + - modify element + - add value to element + - A*x (dense vector) + - A'*x (dense vector) + - A*X (dense matrix) + - A'*X (dense matrix) + - -NOTE 2. - -Hash-tables use memory inefficiently, and they have to keep some amount -of the "spare memory" in order to have good performance. Hash table for -matrix with K non-zero elements will need C*K*(8+2*sizeof(int)) bytes, -where C is a small constant, about 1.5-2 in magnitude. - -CRS storage, from the other side, is more memory-efficient, and needs -just K*(8+sizeof(int))+M*sizeof(int) bytes, where M is a number of rows -in a matrix. - -When you convert from the Hash-Table to CRS representation, all unneeded -memory will be freed. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparsecreate(ae_int_t m, - ae_int_t n, - ae_int_t k, - sparsematrix* s, - ae_state *_state) -{ - ae_int_t i; - ae_int_t sz; - - _sparsematrix_clear(s); - - ae_assert(m>0, "SparseCreate: M<=0", _state); - ae_assert(n>0, "SparseCreate: N<=0", _state); - ae_assert(k>=0, "SparseCreate: K<0", _state); - sz = ae_round(k/sparse_desiredloadfactor+sparse_additional, _state); - s->matrixtype = 0; - s->m = m; - s->n = n; - s->nfree = sz; - ae_vector_set_length(&s->vals, sz, _state); - ae_vector_set_length(&s->idx, 2*sz, _state); - for(i=0; i<=sz-1; i++) - { - s->idx.ptr.p_int[2*i] = -1; - } -} - - -/************************************************************************* -This function creates sparse matrix in a CRS format (expert function for -situations when you are running out of memory). - -This function creates CRS matrix. Typical usage scenario for a CRS matrix -is: -1. creation (you have to tell number of non-zero elements at each row at - this moment) -2. insertion of the matrix elements (row by row, from left to right) -3. matrix is passed to some linear algebra algorithm - -This function is a memory-efficient alternative to SparseCreate(), but it -is more complex because it requires you to know in advance how large your -matrix is. Some information about different matrix formats can be found -below, in the "NOTES" section. - -INPUT PARAMETERS - M - number of rows in a matrix, M>=1 - N - number of columns in a matrix, N>=1 - NER - number of elements at each row, array[M], NER[I]>=0 - -OUTPUT PARAMETERS - S - sparse M*N matrix in CRS representation. - You have to fill ALL non-zero elements by calling - SparseSet() BEFORE you try to use this matrix. - -NOTE 1. - -Sparse matrices can be stored using either Hash-Table representation or -Compressed Row Storage representation. Hast-table is better suited for -querying and dynamic operations (thus, it is used for matrix -initialization), but it is inefficient when you want to make some linear -algebra operations. - -From the other side, CRS is better suited for linear algebra operations, -but initialization is less convenient - you have to tell row sizes at the -initialization, and you can fill matrix only row by row, from left to -right. CRS is also very inefficient when you want to find matrix element -by its index. - -Thus, Hash-Table representation does not support linear algebra -operations, while CRS format does not support modification of the table. -Tables below outline information about these two formats: - - OPERATIONS WITH MATRIX HASH CRS - create + + - read element + + - modify element + - add value to element + - A*x (dense vector) + - A'*x (dense vector) + - A*X (dense matrix) + - A'*X (dense matrix) + - -NOTE 2. - -Hash-tables use memory inefficiently, and they have to keep some amount -of the "spare memory" in order to have good performance. Hash table for -matrix with K non-zero elements will need C*K*(8+2*sizeof(int)) bytes, -where C is a small constant, about 1.5-2 in magnitude. - -CRS storage, from the other side, is more memory-efficient, and needs -just K*(8+sizeof(int))+M*sizeof(int) bytes, where M is a number of rows -in a matrix. - -When you convert from the Hash-Table to CRS representation, all unneeded -memory will be freed. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparsecreatecrs(ae_int_t m, - ae_int_t n, - /* Integer */ ae_vector* ner, - sparsematrix* s, - ae_state *_state) -{ - ae_int_t i; - ae_int_t noe; - - _sparsematrix_clear(s); - - ae_assert(m>0, "SparseCreateCRS: M<=0", _state); - ae_assert(n>0, "SparseCreateCRS: N<=0", _state); - ae_assert(ner->cnt>=m, "SparseCreateCRS: Length(NER)matrixtype = 1; - s->ninitialized = 0; - s->m = m; - s->n = n; - ae_vector_set_length(&s->ridx, s->m+1, _state); - s->ridx.ptr.p_int[0] = 0; - for(i=0; i<=s->m-1; i++) - { - ae_assert(ner->ptr.p_int[i]>=0, "SparseCreateCRS: NER[] contains negative elements", _state); - noe = noe+ner->ptr.p_int[i]; - s->ridx.ptr.p_int[i+1] = s->ridx.ptr.p_int[i]+ner->ptr.p_int[i]; - } - ae_vector_set_length(&s->vals, noe, _state); - ae_vector_set_length(&s->idx, noe, _state); - if( noe==0 ) - { - sparse_sparseinitduidx(s, _state); - } -} - - -/************************************************************************* -This function copies S0 to S1. - -NOTE: this function does not verify its arguments, it just copies all -fields of the structure. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparsecopy(sparsematrix* s0, sparsematrix* s1, ae_state *_state) -{ - ae_int_t l; - ae_int_t i; - - _sparsematrix_clear(s1); - - s1->matrixtype = s0->matrixtype; - s1->m = s0->m; - s1->n = s0->n; - s1->nfree = s0->nfree; - s1->ninitialized = s0->ninitialized; - - /* - * Initialization for arrays - */ - l = s0->vals.cnt; - ae_vector_set_length(&s1->vals, l, _state); - for(i=0; i<=l-1; i++) - { - s1->vals.ptr.p_double[i] = s0->vals.ptr.p_double[i]; - } - l = s0->ridx.cnt; - ae_vector_set_length(&s1->ridx, l, _state); - for(i=0; i<=l-1; i++) - { - s1->ridx.ptr.p_int[i] = s0->ridx.ptr.p_int[i]; - } - l = s0->idx.cnt; - ae_vector_set_length(&s1->idx, l, _state); - for(i=0; i<=l-1; i++) - { - s1->idx.ptr.p_int[i] = s0->idx.ptr.p_int[i]; - } - - /* - * Initialization for CRS-parameters - */ - l = s0->uidx.cnt; - ae_vector_set_length(&s1->uidx, l, _state); - for(i=0; i<=l-1; i++) - { - s1->uidx.ptr.p_int[i] = s0->uidx.ptr.p_int[i]; - } - l = s0->didx.cnt; - ae_vector_set_length(&s1->didx, l, _state); - for(i=0; i<=l-1; i++) - { - s1->didx.ptr.p_int[i] = s0->didx.ptr.p_int[i]; - } -} - - -/************************************************************************* -This function adds value to S[i,j] - element of the sparse matrix. Matrix -must be in a Hash-Table mode. - -In case S[i,j] already exists in the table, V i added to its value. In -case S[i,j] is non-existent, it is inserted in the table. Table -automatically grows when necessary. - -INPUT PARAMETERS - S - sparse M*N matrix in Hash-Table representation. - Exception will be thrown for CRS matrix. - I - row index of the element to modify, 0<=Imatrixtype==0, "SparseAdd: matrix must be in the Hash-Table mode to do this operation", _state); - ae_assert(i>=0, "SparseAdd: I<0", _state); - ae_assert(im, "SparseAdd: I>=M", _state); - ae_assert(j>=0, "SparseAdd: J<0", _state); - ae_assert(jn, "SparseAdd: J>=N", _state); - ae_assert(ae_isfinite(v, _state), "SparseAdd: V is not finite number", _state); - if( ae_fp_eq(v,0) ) - { - return; - } - tcode = -1; - k = s->vals.cnt; - if( ae_fp_greater_eq((1-sparse_maxloadfactor)*k,s->nfree) ) - { - sparseresizematrix(s, _state); - k = s->vals.cnt; - } - hashcode = sparse_hash(i, j, k, _state); - for(;;) - { - if( s->idx.ptr.p_int[2*hashcode]==-1 ) - { - if( tcode!=-1 ) - { - hashcode = tcode; - } - s->vals.ptr.p_double[hashcode] = v; - s->idx.ptr.p_int[2*hashcode] = i; - s->idx.ptr.p_int[2*hashcode+1] = j; - if( tcode==-1 ) - { - s->nfree = s->nfree-1; - } - return; - } - else - { - if( s->idx.ptr.p_int[2*hashcode]==i&&s->idx.ptr.p_int[2*hashcode+1]==j ) - { - s->vals.ptr.p_double[hashcode] = s->vals.ptr.p_double[hashcode]+v; - if( ae_fp_eq(s->vals.ptr.p_double[hashcode],0) ) - { - s->idx.ptr.p_int[2*hashcode] = -2; - } - return; - } - - /* - * Is it deleted element? - */ - if( tcode==-1&&s->idx.ptr.p_int[2*hashcode]==-2 ) - { - tcode = hashcode; - } - - /* - * Next step - */ - hashcode = (hashcode+1)%k; - } - } -} - - -/************************************************************************* -This function modifies S[i,j] - element of the sparse matrix. - -For Hash-based storage format: -* new value can be zero or non-zero. In case new value of S[i,j] is zero, - this element is deleted from the table. -* this function has no effect when called with zero V for non-existent - element. - -For CRS-bases storage format: -* new value MUST be non-zero. Exception will be thrown for zero V. -* elements must be initialized in correct order - from top row to bottom, - within row - from left to right. - -INPUT PARAMETERS - S - sparse M*N matrix in Hash-Table or CRS representation. - I - row index of the element to modify, 0<=I=0, "SparseSet: I<0", _state); - ae_assert(im, "SparseSet: I>=M", _state); - ae_assert(j>=0, "SparseSet: J<0", _state); - ae_assert(jn, "SparseSet: J>=N", _state); - ae_assert(ae_isfinite(v, _state), "SparseSet: V is not finite number", _state); - - /* - * Hash-table matrix - */ - if( s->matrixtype==0 ) - { - tcode = -1; - k = s->vals.cnt; - if( ae_fp_greater_eq((1-sparse_maxloadfactor)*k,s->nfree) ) - { - sparseresizematrix(s, _state); - k = s->vals.cnt; - } - hashcode = sparse_hash(i, j, k, _state); - for(;;) - { - if( s->idx.ptr.p_int[2*hashcode]==-1 ) - { - if( ae_fp_neq(v,0) ) - { - if( tcode!=-1 ) - { - hashcode = tcode; - } - s->vals.ptr.p_double[hashcode] = v; - s->idx.ptr.p_int[2*hashcode] = i; - s->idx.ptr.p_int[2*hashcode+1] = j; - if( tcode==-1 ) - { - s->nfree = s->nfree-1; - } - } - return; - } - else - { - if( s->idx.ptr.p_int[2*hashcode]==i&&s->idx.ptr.p_int[2*hashcode+1]==j ) - { - if( ae_fp_eq(v,0) ) - { - s->idx.ptr.p_int[2*hashcode] = -2; - } - else - { - s->vals.ptr.p_double[hashcode] = v; - } - return; - } - if( tcode==-1&&s->idx.ptr.p_int[2*hashcode]==-2 ) - { - tcode = hashcode; - } - - /* - * Next step - */ - hashcode = (hashcode+1)%k; - } - } - } - - /* - * CRS matrix - */ - if( s->matrixtype==1 ) - { - ae_assert(ae_fp_neq(v,0), "SparseSet: CRS format does not allow you to write zero elements", _state); - ae_assert(s->ridx.ptr.p_int[i]<=s->ninitialized, "SparseSet: too few initialized elements at some row (you have promised more when called SparceCreateCRS)", _state); - ae_assert(s->ridx.ptr.p_int[i+1]>s->ninitialized, "SparseSet: too many initialized elements at some row (you have promised less when called SparceCreateCRS)", _state); - ae_assert(s->ninitialized==s->ridx.ptr.p_int[i]||s->idx.ptr.p_int[s->ninitialized-1]vals.ptr.p_double[s->ninitialized] = v; - s->idx.ptr.p_int[s->ninitialized] = j; - s->ninitialized = s->ninitialized+1; - - /* - * If matrix has been created then - * initiale 'S.UIdx' and 'S.DIdx' - */ - if( s->ninitialized==s->ridx.ptr.p_int[s->m] ) - { - sparse_sparseinitduidx(s, _state); - } - } -} - - -/************************************************************************* -This function returns S[i,j] - element of the sparse matrix. Matrix can -be in any mode (Hash-Table or CRS), but this function is less efficient -for CRS matrices. Hash-Table matrices can find element in O(1) time, -while CRS matrices need O(log(RS)) time, where RS is an number of non- -zero elements in a row. - -INPUT PARAMETERS - S - sparse M*N matrix in Hash-Table representation. - Exception will be thrown for CRS matrix. - I - row index of the element to modify, 0<=I=0, "SparseGet: I<0", _state); - ae_assert(im, "SparseGet: I>=M", _state); - ae_assert(j>=0, "SparseGet: J<0", _state); - ae_assert(jn, "SparseGet: J>=N", _state); - k = s->vals.cnt; - result = 0; - if( s->matrixtype==0 ) - { - hashcode = sparse_hash(i, j, k, _state); - for(;;) - { - if( s->idx.ptr.p_int[2*hashcode]==-1 ) - { - return result; - } - if( s->idx.ptr.p_int[2*hashcode]==i&&s->idx.ptr.p_int[2*hashcode+1]==j ) - { - result = s->vals.ptr.p_double[hashcode]; - return result; - } - hashcode = (hashcode+1)%k; - } - } - if( s->matrixtype==1 ) - { - ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseGet: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state); - k0 = s->ridx.ptr.p_int[i]; - k1 = s->ridx.ptr.p_int[i+1]-1; - while(k0<=k1) - { - k = (k0+k1)/2; - if( s->idx.ptr.p_int[k]==j ) - { - result = s->vals.ptr.p_double[k]; - return result; - } - if( s->idx.ptr.p_int[k]=0, "SparseGetDiagonal: I<0", _state); - ae_assert(im, "SparseGetDiagonal: I>=M", _state); - ae_assert(in, "SparseGetDiagonal: I>=N", _state); - result = 0; - if( s->matrixtype==0 ) - { - result = sparseget(s, i, i, _state); - return result; - } - if( s->matrixtype==1 ) - { - if( s->didx.ptr.p_int[i]!=s->uidx.ptr.p_int[i] ) - { - result = s->vals.ptr.p_double[s->didx.ptr.p_int[i]]; - } - return result; - } - return result; -} - - -/************************************************************************* -This function converts matrix to CRS format. - -Some algorithms (linear algebra ones, for example) require matrices in -CRS format. - -INPUT PARAMETERS - S - sparse M*N matrix in any format - -OUTPUT PARAMETERS - S - matrix in CRS format - -NOTE: this function has no effect when called with matrix which is -already in CRS mode. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparseconverttocrs(sparsematrix* s, ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_vector tvals; - ae_vector tidx; - ae_vector temp; - ae_int_t nonne; - ae_int_t k; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&tvals, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tidx, 0, DT_INT, _state, ae_true); - ae_vector_init(&temp, 0, DT_INT, _state, ae_true); - - ae_assert(s->matrixtype==0||s->matrixtype==1, "SparseConvertToCRS: invalid matrix type", _state); - if( s->matrixtype==1 ) - { - ae_frame_leave(_state); - return; - } - s->matrixtype = 1; - nonne = 0; - k = s->vals.cnt; - ae_swap_vectors(&s->vals, &tvals); - ae_swap_vectors(&s->idx, &tidx); - ae_vector_set_length(&s->ridx, s->m+1, _state); - for(i=0; i<=s->m; i++) - { - s->ridx.ptr.p_int[i] = 0; - } - ae_vector_set_length(&temp, s->m, _state); - for(i=0; i<=s->m-1; i++) - { - temp.ptr.p_int[i] = 0; - } - - /* - * Number of elements per row - */ - for(i=0; i<=k-1; i++) - { - if( tidx.ptr.p_int[2*i]>=0 ) - { - s->ridx.ptr.p_int[tidx.ptr.p_int[2*i]+1] = s->ridx.ptr.p_int[tidx.ptr.p_int[2*i]+1]+1; - nonne = nonne+1; - } - } - - /* - * Fill RIdx (offsets of rows) - */ - for(i=0; i<=s->m-1; i++) - { - s->ridx.ptr.p_int[i+1] = s->ridx.ptr.p_int[i+1]+s->ridx.ptr.p_int[i]; - } - - /* - * Allocate memory - */ - ae_vector_set_length(&s->vals, nonne, _state); - ae_vector_set_length(&s->idx, nonne, _state); - for(i=0; i<=k-1; i++) - { - if( tidx.ptr.p_int[2*i]>=0 ) - { - s->vals.ptr.p_double[s->ridx.ptr.p_int[tidx.ptr.p_int[2*i]]+temp.ptr.p_int[tidx.ptr.p_int[2*i]]] = tvals.ptr.p_double[i]; - s->idx.ptr.p_int[s->ridx.ptr.p_int[tidx.ptr.p_int[2*i]]+temp.ptr.p_int[tidx.ptr.p_int[2*i]]] = tidx.ptr.p_int[2*i+1]; - temp.ptr.p_int[tidx.ptr.p_int[2*i]] = temp.ptr.p_int[tidx.ptr.p_int[2*i]]+1; - } - } - - /* - * Set NInitialized - */ - s->ninitialized = s->ridx.ptr.p_int[s->m]; - - /* - * Sorting of elements - */ - for(i=0; i<=s->m-1; i++) - { - tagsortmiddleir(&s->idx, &s->vals, s->ridx.ptr.p_int[i], s->ridx.ptr.p_int[i+1]-s->ridx.ptr.p_int[i], _state); - } - - /* - * Initialization 'S.UIdx' and 'S.DIdx' - */ - sparse_sparseinitduidx(s, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -This function calculates matrix-vector product S*x. Matrix S must be -stored in CRS format (exception will be thrown otherwise). - -INPUT PARAMETERS - S - sparse M*N matrix in CRS format (you MUST convert it - to CRS before calling this function). - X - array[N], input vector. For performance reasons we - make only quick checks - we check that array size is - at least N, but we do not check for NAN's or INF's. - Y - output buffer, possibly preallocated. In case buffer - size is too small to store result, this buffer is - automatically resized. - -OUTPUT PARAMETERS - Y - array[M], S*x - -NOTE: this function throws exception when called for non-CRS matrix. You -must convert your matrix with SparseConvertToCRS() before using this -function. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparsemv(sparsematrix* s, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state) -{ - double tval; - ae_int_t i; - ae_int_t j; - ae_int_t lt; - ae_int_t rt; - - - ae_assert(s->matrixtype==1, "SparseMV: incorrect matrix type (convert your matrix to CRS)", _state); - ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseMV: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state); - ae_assert(x->cnt>=s->n, "SparseMV: length(X)m, _state); - for(i=0; i<=s->m-1; i++) - { - tval = 0; - lt = s->ridx.ptr.p_int[i]; - rt = s->ridx.ptr.p_int[i+1]; - for(j=lt; j<=rt-1; j++) - { - tval = tval+x->ptr.p_double[s->idx.ptr.p_int[j]]*s->vals.ptr.p_double[j]; - } - y->ptr.p_double[i] = tval; - } -} - - -/************************************************************************* -This function calculates matrix-vector product S^T*x. Matrix S must be -stored in CRS format (exception will be thrown otherwise). - -INPUT PARAMETERS - S - sparse M*N matrix in CRS format (you MUST convert it - to CRS before calling this function). - X - array[M], input vector. For performance reasons we - make only quick checks - we check that array size is - at least M, but we do not check for NAN's or INF's. - Y - output buffer, possibly preallocated. In case buffer - size is too small to store result, this buffer is - automatically resized. - -OUTPUT PARAMETERS - Y - array[N], S^T*x - -NOTE: this function throws exception when called for non-CRS matrix. You -must convert your matrix with SparseConvertToCRS() before using this -function. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparsemtv(sparsematrix* s, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t lt; - ae_int_t rt; - ae_int_t ct; - double v; - - - ae_assert(s->matrixtype==1, "SparseMTV: incorrect matrix type (convert your matrix to CRS)", _state); - ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseMTV: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state); - ae_assert(x->cnt>=s->m, "SparseMTV: Length(X)n, _state); - for(i=0; i<=s->n-1; i++) - { - y->ptr.p_double[i] = 0; - } - for(i=0; i<=s->m-1; i++) - { - lt = s->ridx.ptr.p_int[i]; - rt = s->ridx.ptr.p_int[i+1]; - v = x->ptr.p_double[i]; - for(j=lt; j<=rt-1; j++) - { - ct = s->idx.ptr.p_int[j]; - y->ptr.p_double[ct] = y->ptr.p_double[ct]+v*s->vals.ptr.p_double[j]; - } - } -} - - -/************************************************************************* -This function simultaneously calculates two matrix-vector products: - S*x and S^T*x. -S must be square (non-rectangular) matrix stored in CRS format (exception -will be thrown otherwise). - -INPUT PARAMETERS - S - sparse N*N matrix in CRS format (you MUST convert it - to CRS before calling this function). - X - array[N], input vector. For performance reasons we - make only quick checks - we check that array size is - at least N, but we do not check for NAN's or INF's. - Y0 - output buffer, possibly preallocated. In case buffer - size is too small to store result, this buffer is - automatically resized. - Y1 - output buffer, possibly preallocated. In case buffer - size is too small to store result, this buffer is - automatically resized. - -OUTPUT PARAMETERS - Y0 - array[N], S*x - Y1 - array[N], S^T*x - -NOTE: this function throws exception when called for non-CRS matrix. You -must convert your matrix with SparseConvertToCRS() before using this -function. It also throws exception when S is non-square. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparsemv2(sparsematrix* s, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y0, - /* Real */ ae_vector* y1, - ae_state *_state) -{ - ae_int_t l; - double tval; - ae_int_t i; - ae_int_t j; - double vx; - double vs; - ae_int_t vi; - ae_int_t j0; - ae_int_t j1; - - - ae_assert(s->matrixtype==1, "SparseMV2: incorrect matrix type (convert your matrix to CRS)", _state); - ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseMV: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state); - ae_assert(s->m==s->n, "SparseMV2: matrix is non-square", _state); - l = x->cnt; - ae_assert(l>=s->n, "SparseMV2: Length(X)n-1; i++) - { - y1->ptr.p_double[i] = 0; - } - for(i=0; i<=s->m-1; i++) - { - tval = 0; - vx = x->ptr.p_double[i]; - j0 = s->ridx.ptr.p_int[i]; - j1 = s->ridx.ptr.p_int[i+1]-1; - for(j=j0; j<=j1; j++) - { - vi = s->idx.ptr.p_int[j]; - vs = s->vals.ptr.p_double[j]; - tval = tval+x->ptr.p_double[vi]*vs; - y1->ptr.p_double[vi] = y1->ptr.p_double[vi]+vx*vs; - } - y0->ptr.p_double[i] = tval; - } -} - - -/************************************************************************* -This function calculates matrix-vector product S*x, when S is symmetric -matrix. Matrix S must be stored in CRS format (exception will be -thrown otherwise). - -INPUT PARAMETERS - S - sparse M*M matrix in CRS format (you MUST convert it - to CRS before calling this function). - IsUpper - whether upper or lower triangle of S is given: - * if upper triangle is given, only S[i,j] for j>=i - are used, and lower triangle is ignored (it can be - empty - these elements are not referenced at all). - * if lower triangle is given, only S[i,j] for j<=i - are used, and upper triangle is ignored. - X - array[N], input vector. For performance reasons we - make only quick checks - we check that array size is - at least N, but we do not check for NAN's or INF's. - Y - output buffer, possibly preallocated. In case buffer - size is too small to store result, this buffer is - automatically resized. - -OUTPUT PARAMETERS - Y - array[M], S*x - -NOTE: this function throws exception when called for non-CRS matrix. You -must convert your matrix with SparseConvertToCRS() before using this -function. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparsesmv(sparsematrix* s, - ae_bool isupper, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t id; - ae_int_t lt; - ae_int_t rt; - double v; - double vy; - double vx; - - - ae_assert(s->matrixtype==1, "SparseSMV: incorrect matrix type (convert your matrix to CRS)", _state); - ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseSMV: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state); - ae_assert(x->cnt>=s->n, "SparseSMV: length(X)m==s->n, "SparseSMV: non-square matrix", _state); - rvectorsetlengthatleast(y, s->m, _state); - for(i=0; i<=s->m-1; i++) - { - y->ptr.p_double[i] = 0; - } - for(i=0; i<=s->m-1; i++) - { - if( s->didx.ptr.p_int[i]!=s->uidx.ptr.p_int[i] ) - { - y->ptr.p_double[i] = y->ptr.p_double[i]+s->vals.ptr.p_double[s->didx.ptr.p_int[i]]*x->ptr.p_double[s->idx.ptr.p_int[s->didx.ptr.p_int[i]]]; - } - if( isupper ) - { - lt = s->uidx.ptr.p_int[i]; - rt = s->ridx.ptr.p_int[i+1]; - vy = 0; - vx = x->ptr.p_double[i]; - for(j=lt; j<=rt-1; j++) - { - id = s->idx.ptr.p_int[j]; - v = s->vals.ptr.p_double[j]; - vy = vy+x->ptr.p_double[id]*v; - y->ptr.p_double[id] = y->ptr.p_double[id]+vx*v; - } - y->ptr.p_double[i] = y->ptr.p_double[i]+vy; - } - else - { - lt = s->ridx.ptr.p_int[i]; - rt = s->didx.ptr.p_int[i]; - vy = 0; - vx = x->ptr.p_double[i]; - for(j=lt; j<=rt-1; j++) - { - id = s->idx.ptr.p_int[j]; - v = s->vals.ptr.p_double[j]; - vy = vy+x->ptr.p_double[id]*v; - y->ptr.p_double[id] = y->ptr.p_double[id]+vx*v; - } - y->ptr.p_double[i] = y->ptr.p_double[i]+vy; - } - } -} - - -/************************************************************************* -This function calculates matrix-matrix product S*A. Matrix S must be -stored in CRS format (exception will be thrown otherwise). - -INPUT PARAMETERS - S - sparse M*N matrix in CRS format (you MUST convert it - to CRS before calling this function). - A - array[N][K], input dense matrix. For performance reasons - we make only quick checks - we check that array size - is at least N, but we do not check for NAN's or INF's. - K - number of columns of matrix (A). - B - output buffer, possibly preallocated. In case buffer - size is too small to store result, this buffer is - automatically resized. - -OUTPUT PARAMETERS - B - array[M][K], S*A - -NOTE: this function throws exception when called for non-CRS matrix. You -must convert your matrix with SparseConvertToCRS() before using this -function. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparsemm(sparsematrix* s, - /* Real */ ae_matrix* a, - ae_int_t k, - /* Real */ ae_matrix* b, - ae_state *_state) -{ - double tval; - double v; - ae_int_t id; - ae_int_t i; - ae_int_t j; - ae_int_t k0; - ae_int_t lt; - ae_int_t rt; - - - ae_assert(s->matrixtype==1, "SparseMV: incorrect matrix type (convert your matrix to CRS)", _state); - ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseMV: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state); - ae_assert(a->rows>=s->n, "SparseMV: Rows(A)0, "SparseMV: K<=0", _state); - rmatrixsetlengthatleast(b, s->m, k, _state); - if( km-1; i++) - { - for(j=0; j<=k-1; j++) - { - tval = 0; - lt = s->ridx.ptr.p_int[i]; - rt = s->ridx.ptr.p_int[i+1]; - for(k0=lt; k0<=rt-1; k0++) - { - tval = tval+s->vals.ptr.p_double[k0]*a->ptr.pp_double[s->idx.ptr.p_int[k0]][j]; - } - b->ptr.pp_double[i][j] = tval; - } - } - } - else - { - for(i=0; i<=s->m-1; i++) - { - for(j=0; j<=k-1; j++) - { - b->ptr.pp_double[i][j] = 0; - } - } - for(i=0; i<=s->m-1; i++) - { - lt = s->ridx.ptr.p_int[i]; - rt = s->ridx.ptr.p_int[i+1]; - for(j=lt; j<=rt-1; j++) - { - id = s->idx.ptr.p_int[j]; - v = s->vals.ptr.p_double[j]; - ae_v_addd(&b->ptr.pp_double[i][0], 1, &a->ptr.pp_double[id][0], 1, ae_v_len(0,k-1), v); - } - } - } -} - - -/************************************************************************* -This function calculates matrix-matrix product S^T*A. Matrix S must be -stored in CRS format (exception will be thrown otherwise). - -INPUT PARAMETERS - S - sparse M*N matrix in CRS format (you MUST convert it - to CRS before calling this function). - A - array[M][K], input dense matrix. For performance reasons - we make only quick checks - we check that array size is - at least M, but we do not check for NAN's or INF's. - K - number of columns of matrix (A). - B - output buffer, possibly preallocated. In case buffer - size is too small to store result, this buffer is - automatically resized. - -OUTPUT PARAMETERS - B - array[N][K], S^T*A - -NOTE: this function throws exception when called for non-CRS matrix. You -must convert your matrix with SparseConvertToCRS() before using this -function. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparsemtm(sparsematrix* s, - /* Real */ ae_matrix* a, - ae_int_t k, - /* Real */ ae_matrix* b, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t k0; - ae_int_t lt; - ae_int_t rt; - ae_int_t ct; - double v; - - - ae_assert(s->matrixtype==1, "SparseMTM: incorrect matrix type (convert your matrix to CRS)", _state); - ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseMTM: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state); - ae_assert(a->rows>=s->m, "SparseMTM: Rows(A)0, "SparseMTM: K<=0", _state); - rmatrixsetlengthatleast(b, s->n, k, _state); - for(i=0; i<=s->n-1; i++) - { - for(j=0; j<=k-1; j++) - { - b->ptr.pp_double[i][j] = 0; - } - } - if( km-1; i++) - { - lt = s->ridx.ptr.p_int[i]; - rt = s->ridx.ptr.p_int[i+1]; - for(k0=lt; k0<=rt-1; k0++) - { - v = s->vals.ptr.p_double[k0]; - ct = s->idx.ptr.p_int[k0]; - for(j=0; j<=k-1; j++) - { - b->ptr.pp_double[ct][j] = b->ptr.pp_double[ct][j]+v*a->ptr.pp_double[i][j]; - } - } - } - } - else - { - for(i=0; i<=s->m-1; i++) - { - lt = s->ridx.ptr.p_int[i]; - rt = s->ridx.ptr.p_int[i+1]; - for(j=lt; j<=rt-1; j++) - { - v = s->vals.ptr.p_double[j]; - ct = s->idx.ptr.p_int[j]; - ae_v_addd(&b->ptr.pp_double[ct][0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,k-1), v); - } - } - } -} - - -/************************************************************************* -This function simultaneously calculates two matrix-matrix products: - S*A and S^T*A. -S must be square (non-rectangular) matrix stored in CRS format (exception -will be thrown otherwise). - -INPUT PARAMETERS - S - sparse N*N matrix in CRS format (you MUST convert it - to CRS before calling this function). - A - array[N][K], input dense matrix. For performance reasons - we make only quick checks - we check that array size is - at least N, but we do not check for NAN's or INF's. - K - number of columns of matrix (A). - B0 - output buffer, possibly preallocated. In case buffer - size is too small to store result, this buffer is - automatically resized. - B1 - output buffer, possibly preallocated. In case buffer - size is too small to store result, this buffer is - automatically resized. - -OUTPUT PARAMETERS - B0 - array[N][K], S*A - B1 - array[N][K], S^T*A - -NOTE: this function throws exception when called for non-CRS matrix. You -must convert your matrix with SparseConvertToCRS() before using this -function. It also throws exception when S is non-square. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparsemm2(sparsematrix* s, - /* Real */ ae_matrix* a, - ae_int_t k, - /* Real */ ae_matrix* b0, - /* Real */ ae_matrix* b1, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t k0; - ae_int_t lt; - ae_int_t rt; - ae_int_t ct; - double v; - double tval; - - - ae_assert(s->matrixtype==1, "SparseMM2: incorrect matrix type (convert your matrix to CRS)", _state); - ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseMM2: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state); - ae_assert(s->m==s->n, "SparseMM2: matrix is non-square", _state); - ae_assert(a->rows>=s->n, "SparseMM2: Rows(A)0, "SparseMM2: K<=0", _state); - rmatrixsetlengthatleast(b0, s->m, k, _state); - rmatrixsetlengthatleast(b1, s->n, k, _state); - for(i=0; i<=s->n-1; i++) - { - for(j=0; j<=k-1; j++) - { - b1->ptr.pp_double[i][j] = 0; - } - } - if( km-1; i++) - { - for(j=0; j<=k-1; j++) - { - tval = 0; - lt = s->ridx.ptr.p_int[i]; - rt = s->ridx.ptr.p_int[i+1]; - v = a->ptr.pp_double[i][j]; - for(k0=lt; k0<=rt-1; k0++) - { - ct = s->idx.ptr.p_int[k0]; - b1->ptr.pp_double[ct][j] = b1->ptr.pp_double[ct][j]+s->vals.ptr.p_double[k0]*v; - tval = tval+s->vals.ptr.p_double[k0]*a->ptr.pp_double[ct][j]; - } - b0->ptr.pp_double[i][j] = tval; - } - } - } - else - { - for(i=0; i<=s->m-1; i++) - { - for(j=0; j<=k-1; j++) - { - b0->ptr.pp_double[i][j] = 0; - } - } - for(i=0; i<=s->m-1; i++) - { - lt = s->ridx.ptr.p_int[i]; - rt = s->ridx.ptr.p_int[i+1]; - for(j=lt; j<=rt-1; j++) - { - v = s->vals.ptr.p_double[j]; - ct = s->idx.ptr.p_int[j]; - ae_v_addd(&b0->ptr.pp_double[i][0], 1, &a->ptr.pp_double[ct][0], 1, ae_v_len(0,k-1), v); - ae_v_addd(&b1->ptr.pp_double[ct][0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,k-1), v); - } - } - } -} - - -/************************************************************************* -This function calculates matrix-matrix product S*A, when S is symmetric -matrix. Matrix S must be stored in CRS format (exception will be -thrown otherwise). - -INPUT PARAMETERS - S - sparse M*M matrix in CRS format (you MUST convert it - to CRS before calling this function). - IsUpper - whether upper or lower triangle of S is given: - * if upper triangle is given, only S[i,j] for j>=i - are used, and lower triangle is ignored (it can be - empty - these elements are not referenced at all). - * if lower triangle is given, only S[i,j] for j<=i - are used, and upper triangle is ignored. - A - array[N][K], input dense matrix. For performance reasons - we make only quick checks - we check that array size is - at least N, but we do not check for NAN's or INF's. - K - number of columns of matrix (A). - B - output buffer, possibly preallocated. In case buffer - size is too small to store result, this buffer is - automatically resized. - -OUTPUT PARAMETERS - B - array[M][K], S*A - -NOTE: this function throws exception when called for non-CRS matrix. You -must convert your matrix with SparseConvertToCRS() before using this -function. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparsesmm(sparsematrix* s, - ae_bool isupper, - /* Real */ ae_matrix* a, - ae_int_t k, - /* Real */ ae_matrix* b, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t k0; - ae_int_t id; - ae_int_t lt; - ae_int_t rt; - double v; - double vb; - double va; - - - ae_assert(s->matrixtype==1, "SparseSMM: incorrect matrix type (convert your matrix to CRS)", _state); - ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseSMM: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state); - ae_assert(a->rows>=s->n, "SparseSMM: Rows(X)m==s->n, "SparseSMM: matrix is non-square", _state); - rmatrixsetlengthatleast(b, s->m, k, _state); - for(i=0; i<=s->m-1; i++) - { - for(j=0; j<=k-1; j++) - { - b->ptr.pp_double[i][j] = 0; - } - } - if( k>sparse_linalgswitch ) - { - for(i=0; i<=s->m-1; i++) - { - for(j=0; j<=k-1; j++) - { - if( s->didx.ptr.p_int[i]!=s->uidx.ptr.p_int[i] ) - { - id = s->didx.ptr.p_int[i]; - b->ptr.pp_double[i][j] = b->ptr.pp_double[i][j]+s->vals.ptr.p_double[id]*a->ptr.pp_double[s->idx.ptr.p_int[id]][j]; - } - if( isupper ) - { - lt = s->uidx.ptr.p_int[i]; - rt = s->ridx.ptr.p_int[i+1]; - vb = 0; - va = a->ptr.pp_double[i][j]; - for(k0=lt; k0<=rt-1; k0++) - { - id = s->idx.ptr.p_int[k0]; - v = s->vals.ptr.p_double[k0]; - vb = vb+a->ptr.pp_double[id][j]*v; - b->ptr.pp_double[id][j] = b->ptr.pp_double[id][j]+va*v; - } - b->ptr.pp_double[i][j] = b->ptr.pp_double[i][j]+vb; - } - else - { - lt = s->ridx.ptr.p_int[i]; - rt = s->didx.ptr.p_int[i]; - vb = 0; - va = a->ptr.pp_double[i][j]; - for(k0=lt; k0<=rt-1; k0++) - { - id = s->idx.ptr.p_int[k0]; - v = s->vals.ptr.p_double[k0]; - vb = vb+a->ptr.pp_double[id][j]*v; - b->ptr.pp_double[id][j] = b->ptr.pp_double[id][j]+va*v; - } - b->ptr.pp_double[i][j] = b->ptr.pp_double[i][j]+vb; - } - } - } - } - else - { - for(i=0; i<=s->m-1; i++) - { - if( s->didx.ptr.p_int[i]!=s->uidx.ptr.p_int[i] ) - { - id = s->didx.ptr.p_int[i]; - v = s->vals.ptr.p_double[id]; - ae_v_addd(&b->ptr.pp_double[i][0], 1, &a->ptr.pp_double[s->idx.ptr.p_int[id]][0], 1, ae_v_len(0,k-1), v); - } - if( isupper ) - { - lt = s->uidx.ptr.p_int[i]; - rt = s->ridx.ptr.p_int[i+1]; - for(j=lt; j<=rt-1; j++) - { - id = s->idx.ptr.p_int[j]; - v = s->vals.ptr.p_double[j]; - ae_v_addd(&b->ptr.pp_double[i][0], 1, &a->ptr.pp_double[id][0], 1, ae_v_len(0,k-1), v); - ae_v_addd(&b->ptr.pp_double[id][0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,k-1), v); - } - } - else - { - lt = s->ridx.ptr.p_int[i]; - rt = s->didx.ptr.p_int[i]; - for(j=lt; j<=rt-1; j++) - { - id = s->idx.ptr.p_int[j]; - v = s->vals.ptr.p_double[j]; - ae_v_addd(&b->ptr.pp_double[i][0], 1, &a->ptr.pp_double[id][0], 1, ae_v_len(0,k-1), v); - ae_v_addd(&b->ptr.pp_double[id][0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,k-1), v); - } - } - } - } -} - - -/************************************************************************* -This procedure resizes Hash-Table matrix. It can be called when you have -deleted too many elements from the matrix, and you want to free unneeded -memory. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparseresizematrix(sparsematrix* s, ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t k; - ae_int_t k1; - ae_int_t i; - ae_vector tvals; - ae_vector tidx; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&tvals, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tidx, 0, DT_INT, _state, ae_true); - - ae_assert(s->matrixtype==0, "SparseResizeMatrix: incorrect matrix type", _state); - - /* - * Initialization for length and number of non-null elementd - */ - k = s->vals.cnt; - k1 = 0; - - /* - * Calculating number of non-null elements - */ - for(i=0; i<=k-1; i++) - { - if( s->idx.ptr.p_int[2*i]>=0 ) - { - k1 = k1+1; - } - } - - /* - * Initialization value for free space - */ - s->nfree = ae_round(k1/sparse_desiredloadfactor*sparse_growfactor+sparse_additional, _state)-k1; - ae_vector_set_length(&tvals, s->nfree+k1, _state); - ae_vector_set_length(&tidx, 2*(s->nfree+k1), _state); - ae_swap_vectors(&s->vals, &tvals); - ae_swap_vectors(&s->idx, &tidx); - for(i=0; i<=s->nfree+k1-1; i++) - { - s->idx.ptr.p_int[2*i] = -1; - } - for(i=0; i<=k-1; i++) - { - if( tidx.ptr.p_int[2*i]>=0 ) - { - sparseset(s, tidx.ptr.p_int[2*i], tidx.ptr.p_int[2*i+1], tvals.ptr.p_double[i], _state); - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -This function return average length of chain at hash-table. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -double sparsegetaveragelengthofchain(sparsematrix* s, ae_state *_state) -{ - ae_int_t nchains; - ae_int_t talc; - ae_int_t l; - ae_int_t i; - ae_int_t ind0; - ae_int_t ind1; - ae_int_t hashcode; - double result; - - - - /* - * If matrix represent in CRS then return zero and exit - */ - if( s->matrixtype==1 ) - { - result = 0; - return result; - } - nchains = 0; - talc = 0; - l = s->vals.cnt; - for(i=0; i<=l-1; i++) - { - ind0 = 2*i; - if( s->idx.ptr.p_int[ind0]!=-1 ) - { - nchains = nchains+1; - hashcode = sparse_hash(s->idx.ptr.p_int[ind0], s->idx.ptr.p_int[ind0+1], l, _state); - for(;;) - { - talc = talc+1; - ind1 = 2*hashcode; - if( s->idx.ptr.p_int[ind0]==s->idx.ptr.p_int[ind1]&&s->idx.ptr.p_int[ind0+1]==s->idx.ptr.p_int[ind1+1] ) - { - break; - } - hashcode = (hashcode+1)%l; - } - } - } - if( nchains==0 ) - { - result = 0; - } - else - { - result = (double)talc/(double)nchains; - } - return result; -} - - -/************************************************************************* -This function is used to enumerate all elements of the sparse matrix. -Before first call user initializes T0 and T1 counters by zero. These -counters are used to remember current position in a matrix; after each -call they are updated by the function. - -Subsequent calls to this function return non-zero elements of the sparse -matrix, one by one. If you enumerate CRS matrix, matrix is traversed from -left to right, from top to bottom. In case you enumerate matrix stored as -Hash table, elements are returned in random order. - -EXAMPLE - > T0=0 - > T1=0 - > while SparseEnumerate(S,T0,T1,I,J,V) do - > ....do something with I,J,V - -INPUT PARAMETERS - S - sparse M*N matrix in Hash-Table or CRS representation. - T0 - internal counter - T1 - internal counter - -OUTPUT PARAMETERS - T0 - new value of the internal counter - T1 - new value of the internal counter - I - row index of non-zero element, 0<=Imatrixtype==1&&*t1<0) ) - { - result = ae_false; - return result; - } - - /* - * Hash-table matrix - */ - if( s->matrixtype==0 ) - { - sz = s->vals.cnt; - for(i0=*t0; i0<=sz-1; i0++) - { - if( s->idx.ptr.p_int[2*i0]==-1||s->idx.ptr.p_int[2*i0]==-2 ) - { - continue; - } - else - { - *i = s->idx.ptr.p_int[2*i0]; - *j = s->idx.ptr.p_int[2*i0+1]; - *v = s->vals.ptr.p_double[i0]; - *t0 = i0+1; - result = ae_true; - return result; - } - } - *t0 = 0; - result = ae_false; - return result; - } - - /* - * CRS matrix - */ - if( s->matrixtype==1&&*t0ninitialized ) - { - ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseEnumerate: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state); - while(*t0>s->ridx.ptr.p_int[*t1+1]-1&&*t1m) - { - *t1 = *t1+1; - } - *i = *t1; - *j = s->idx.ptr.p_int[*t0]; - *v = s->vals.ptr.p_double[*t0]; - *t0 = *t0+1; - result = ae_true; - return result; - } - *t0 = 0; - *t1 = 0; - result = ae_false; - return result; -} - - -/************************************************************************* -This function rewrites existing (non-zero) element. It returns True if -element exists or False, when it is called for non-existing (zero) -element. - -The purpose of this function is to provide convenient thread-safe way to -modify sparse matrix. Such modification (already existing element is -rewritten) is guaranteed to be thread-safe without any synchronization, as -long as different threads modify different elements. - -INPUT PARAMETERS - S - sparse M*N matrix in Hash-Table or CRS representation. - I - row index of non-zero element to modify, 0<=Im, "SparseRewriteExisting: invalid argument I(either I<0 or I>=S.M)", _state); - ae_assert(0<=j&&jn, "SparseRewriteExisting: invalid argument J(either J<0 or J>=S.N)", _state); - ae_assert(ae_isfinite(v, _state), "SparseRewriteExisting: invalid argument V(either V is infinite or V is NaN)", _state); - result = ae_false; - - /* - * Hash-table matrix - */ - if( s->matrixtype==0 ) - { - k = s->vals.cnt; - hashcode = sparse_hash(i, j, k, _state); - for(;;) - { - if( s->idx.ptr.p_int[2*hashcode]==-1 ) - { - return result; - } - if( s->idx.ptr.p_int[2*hashcode]==i&&s->idx.ptr.p_int[2*hashcode+1]==j ) - { - s->vals.ptr.p_double[hashcode] = v; - result = ae_true; - return result; - } - hashcode = (hashcode+1)%k; - } - } - - /* - * CRS matrix - */ - if( s->matrixtype==1 ) - { - ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseRewriteExisting: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state); - k0 = s->ridx.ptr.p_int[i]; - k1 = s->ridx.ptr.p_int[i+1]-1; - while(k0<=k1) - { - k = (k0+k1)/2; - if( s->idx.ptr.p_int[k]==j ) - { - s->vals.ptr.p_double[k] = v; - result = ae_true; - return result; - } - if( s->idx.ptr.p_int[k]matrixtype==1, "SparseGetRow: S must be CRS-based matrix", _state); - ae_assert(i>=0&&im, "SparseGetRow: I<0 or I>=M", _state); - rvectorsetlengthatleast(irow, s->n, _state); - for(i0=0; i0<=s->n-1; i0++) - { - irow->ptr.p_double[i0] = 0; - } - for(i0=s->ridx.ptr.p_int[i]; i0<=s->ridx.ptr.p_int[i+1]-1; i0++) - { - irow->ptr.p_double[s->idx.ptr.p_int[i0]] = s->vals.ptr.p_double[i0]; - } -} - - -/************************************************************************* -This function performs in-place conversion from CRS format to Hash table -storage. - -INPUT PARAMETERS - S - sparse matrix in CRS format. - -OUTPUT PARAMETERS - S - sparse matrix in Hash table format. - -NOTE: this function has no effect when called with matrix which is -already in Hash table mode. - - -- ALGLIB PROJECT -- - Copyright 20.07.2012 by Bochkanov Sergey -*************************************************************************/ -void sparseconverttohash(sparsematrix* s, ae_state *_state) -{ - ae_frame _frame_block; - ae_vector tidx; - ae_vector tridx; - ae_vector tvals; - ae_int_t tn; - ae_int_t tm; - ae_int_t i; - ae_int_t j; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&tidx, 0, DT_INT, _state, ae_true); - ae_vector_init(&tridx, 0, DT_INT, _state, ae_true); - ae_vector_init(&tvals, 0, DT_REAL, _state, ae_true); - - ae_assert(s->matrixtype==0||s->matrixtype==1, "SparseConvertToHash: invalid matrix type", _state); - if( s->matrixtype==0 ) - { - ae_frame_leave(_state); - return; - } - s->matrixtype = 0; - tm = s->m; - tn = s->n; - ae_swap_vectors(&s->idx, &tidx); - ae_swap_vectors(&s->ridx, &tridx); - ae_swap_vectors(&s->vals, &tvals); - - /* - * Delete RIdx - */ - ae_vector_set_length(&s->ridx, 0, _state); - sparsecreate(tm, tn, tridx.ptr.p_int[tm], s, _state); - - /* - * Fill the matrix - */ - for(i=0; i<=tm-1; i++) - { - for(j=tridx.ptr.p_int[i]; j<=tridx.ptr.p_int[i+1]-1; j++) - { - sparseset(s, i, tidx.ptr.p_int[j], tvals.ptr.p_double[j], _state); - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -This function performs out-of-place conversion to Hash table storage -format. S0 is copied to S1 and converted on-the-fly. - -INPUT PARAMETERS - S0 - sparse matrix in any format. - -OUTPUT PARAMETERS - S1 - sparse matrix in Hash table format. - -NOTE: if S0 is stored as Hash-table, it is just copied without conversion. - - -- ALGLIB PROJECT -- - Copyright 20.07.2012 by Bochkanov Sergey -*************************************************************************/ -void sparsecopytohash(sparsematrix* s0, - sparsematrix* s1, - ae_state *_state) -{ - double val; - ae_int_t t0; - ae_int_t t1; - ae_int_t i; - ae_int_t j; - - _sparsematrix_clear(s1); - - ae_assert(s0->matrixtype==0||s0->matrixtype==1, "SparseCopyToHash: invalid matrix type", _state); - if( s0->matrixtype==0 ) - { - sparsecopy(s0, s1, _state); - } - else - { - t0 = 0; - t1 = 0; - sparsecreate(s0->m, s0->n, s0->ridx.ptr.p_int[s0->m], s1, _state); - while(sparseenumerate(s0, &t0, &t1, &i, &j, &val, _state)) - { - sparseset(s1, i, j, val, _state); - } - } -} - - -/************************************************************************* -This function performs out-of-place conversion to CRS format. S0 is -copied to S1 and converted on-the-fly. - -INPUT PARAMETERS - S0 - sparse matrix in any format. - -OUTPUT PARAMETERS - S1 - sparse matrix in CRS format. - -NOTE: if S0 is stored as CRS, it is just copied without conversion. - - -- ALGLIB PROJECT -- - Copyright 20.07.2012 by Bochkanov Sergey -*************************************************************************/ -void sparsecopytocrs(sparsematrix* s0, sparsematrix* s1, ae_state *_state) -{ - ae_frame _frame_block; - ae_vector temp; - ae_int_t nonne; - ae_int_t i; - ae_int_t k; - - ae_frame_make(_state, &_frame_block); - _sparsematrix_clear(s1); - ae_vector_init(&temp, 0, DT_INT, _state, ae_true); - - ae_assert(s0->matrixtype==0||s0->matrixtype==1, "SparseCopyToCRS: invalid matrix type", _state); - if( s0->matrixtype==1 ) - { - sparsecopy(s0, s1, _state); - } - else - { - - /* - * Done like ConvertToCRS function - */ - s1->matrixtype = 1; - s1->m = s0->m; - s1->n = s0->n; - s1->nfree = s0->nfree; - nonne = 0; - k = s0->vals.cnt; - ae_vector_set_length(&s1->ridx, s1->m+1, _state); - for(i=0; i<=s1->m; i++) - { - s1->ridx.ptr.p_int[i] = 0; - } - ae_vector_set_length(&temp, s1->m, _state); - for(i=0; i<=s1->m-1; i++) - { - temp.ptr.p_int[i] = 0; - } - - /* - * Number of elements per row - */ - for(i=0; i<=k-1; i++) - { - if( s0->idx.ptr.p_int[2*i]>=0 ) - { - s1->ridx.ptr.p_int[s0->idx.ptr.p_int[2*i]+1] = s1->ridx.ptr.p_int[s0->idx.ptr.p_int[2*i]+1]+1; - nonne = nonne+1; - } - } - - /* - * Fill RIdx (offsets of rows) - */ - for(i=0; i<=s1->m-1; i++) - { - s1->ridx.ptr.p_int[i+1] = s1->ridx.ptr.p_int[i+1]+s1->ridx.ptr.p_int[i]; - } - - /* - * Allocate memory - */ - ae_vector_set_length(&s1->vals, nonne, _state); - ae_vector_set_length(&s1->idx, nonne, _state); - for(i=0; i<=k-1; i++) - { - if( s0->idx.ptr.p_int[2*i]>=0 ) - { - s1->vals.ptr.p_double[s1->ridx.ptr.p_int[s0->idx.ptr.p_int[2*i]]+temp.ptr.p_int[s0->idx.ptr.p_int[2*i]]] = s0->vals.ptr.p_double[i]; - s1->idx.ptr.p_int[s1->ridx.ptr.p_int[s0->idx.ptr.p_int[2*i]]+temp.ptr.p_int[s0->idx.ptr.p_int[2*i]]] = s0->idx.ptr.p_int[2*i+1]; - temp.ptr.p_int[s0->idx.ptr.p_int[2*i]] = temp.ptr.p_int[s0->idx.ptr.p_int[2*i]]+1; - } - } - - /* - * Set NInitialized - */ - s1->ninitialized = s1->ridx.ptr.p_int[s1->m]; - - /* - * Sorting of elements - */ - for(i=0; i<=s1->m-1; i++) - { - tagsortmiddleir(&s1->idx, &s1->vals, s1->ridx.ptr.p_int[i], s1->ridx.ptr.p_int[i+1]-s1->ridx.ptr.p_int[i], _state); - } - - /* - * Initialization 'S.UIdx' and 'S.DIdx' - */ - sparse_sparseinitduidx(s1, _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -This function returns type of the matrix storage format. - -INPUT PARAMETERS: - S - sparse matrix. - -RESULT: - sparse storage format used by matrix: - 0 - Hash-table - 1 - CRS-format - -NOTE: future versions of ALGLIB may include additional sparse storage - formats. - - - -- ALGLIB PROJECT -- - Copyright 20.07.2012 by Bochkanov Sergey -*************************************************************************/ -ae_int_t sparsegetmatrixtype(sparsematrix* s, ae_state *_state) -{ - ae_int_t result; - - - ae_assert(s->matrixtype==0||s->matrixtype==1, "SparseGetMatrixType: invalid matrix type", _state); - result = s->matrixtype; - return result; -} - - -/************************************************************************* -This function checks matrix storage format and returns True when matrix is -stored using Hash table representation. - -INPUT PARAMETERS: - S - sparse matrix. - -RESULT: - True if matrix type is Hash table - False if matrix type is not Hash table - - -- ALGLIB PROJECT -- - Copyright 20.07.2012 by Bochkanov Sergey -*************************************************************************/ -ae_bool sparseishash(sparsematrix* s, ae_state *_state) -{ - ae_bool result; - - - ae_assert(s->matrixtype==0||s->matrixtype==1, "SparseIsHash: invalid matrix type", _state); - result = s->matrixtype==0; - return result; -} - - -/************************************************************************* -This function checks matrix storage format and returns True when matrix is -stored using CRS representation. - -INPUT PARAMETERS: - S - sparse matrix. - -RESULT: - True if matrix type is CRS - False if matrix type is not CRS - - -- ALGLIB PROJECT -- - Copyright 20.07.2012 by Bochkanov Sergey -*************************************************************************/ -ae_bool sparseiscrs(sparsematrix* s, ae_state *_state) -{ - ae_bool result; - - - ae_assert(s->matrixtype==0||s->matrixtype==1, "SparseIsCRS: invalid matrix type", _state); - result = s->matrixtype==1; - return result; -} - - -/************************************************************************* -The function frees all memory occupied by sparse matrix. Sparse matrix -structure becomes unusable after this call. - -OUTPUT PARAMETERS - S - sparse matrix to delete - - -- ALGLIB PROJECT -- - Copyright 24.07.2012 by Bochkanov Sergey -*************************************************************************/ -void sparsefree(sparsematrix* s, ae_state *_state) -{ - - _sparsematrix_clear(s); - - s->matrixtype = -1; - s->m = 0; - s->n = 0; - s->nfree = 0; - s->ninitialized = 0; -} - - -/************************************************************************* -The function returns number of rows of a sparse matrix. - -RESULT: number of rows of a sparse matrix. - - -- ALGLIB PROJECT -- - Copyright 23.08.2012 by Bochkanov Sergey -*************************************************************************/ -ae_int_t sparsegetnrows(sparsematrix* s, ae_state *_state) -{ - ae_int_t result; - - - result = s->m; - return result; -} - - -/************************************************************************* -The function returns number of columns of a sparse matrix. - -RESULT: number of columns of a sparse matrix. - - -- ALGLIB PROJECT -- - Copyright 23.08.2012 by Bochkanov Sergey -*************************************************************************/ -ae_int_t sparsegetncols(sparsematrix* s, ae_state *_state) -{ - ae_int_t result; - - - result = s->n; - return result; -} - - -/************************************************************************* -Procedure for initialization 'S.DIdx' and 'S.UIdx' - - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -static void sparse_sparseinitduidx(sparsematrix* s, ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t lt; - ae_int_t rt; - - - ae_vector_set_length(&s->didx, s->m, _state); - ae_vector_set_length(&s->uidx, s->m, _state); - for(i=0; i<=s->m-1; i++) - { - s->uidx.ptr.p_int[i] = -1; - s->didx.ptr.p_int[i] = -1; - lt = s->ridx.ptr.p_int[i]; - rt = s->ridx.ptr.p_int[i+1]; - for(j=lt; j<=rt-1; j++) - { - if( iidx.ptr.p_int[j]&&s->uidx.ptr.p_int[i]==-1 ) - { - s->uidx.ptr.p_int[i] = j; - break; - } - else - { - if( i==s->idx.ptr.p_int[j] ) - { - s->didx.ptr.p_int[i] = j; - } - } - } - if( s->uidx.ptr.p_int[i]==-1 ) - { - s->uidx.ptr.p_int[i] = s->ridx.ptr.p_int[i+1]; - } - if( s->didx.ptr.p_int[i]==-1 ) - { - s->didx.ptr.p_int[i] = s->uidx.ptr.p_int[i]; - } - } -} - - -/************************************************************************* -This is hash function. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -static ae_int_t sparse_hash(ae_int_t i, - ae_int_t j, - ae_int_t tabsize, - ae_state *_state) -{ - ae_frame _frame_block; - hqrndstate r; - ae_int_t result; - - ae_frame_make(_state, &_frame_block); - _hqrndstate_init(&r, _state, ae_true); - - hqrndseed(i, j, &r, _state); - result = hqrnduniformi(&r, tabsize, _state); - ae_frame_leave(_state); - return result; -} - - -ae_bool _sparsematrix_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - sparsematrix *p = (sparsematrix*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->vals, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->idx, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->ridx, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->didx, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->uidx, 0, DT_INT, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _sparsematrix_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - sparsematrix *dst = (sparsematrix*)_dst; - sparsematrix *src = (sparsematrix*)_src; - if( !ae_vector_init_copy(&dst->vals, &src->vals, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->idx, &src->idx, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->ridx, &src->ridx, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->didx, &src->didx, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->uidx, &src->uidx, _state, make_automatic) ) - return ae_false; - dst->matrixtype = src->matrixtype; - dst->m = src->m; - dst->n = src->n; - dst->nfree = src->nfree; - dst->ninitialized = src->ninitialized; - return ae_true; -} - - -void _sparsematrix_clear(void* _p) -{ - sparsematrix *p = (sparsematrix*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->vals); - ae_vector_clear(&p->idx); - ae_vector_clear(&p->ridx); - ae_vector_clear(&p->didx); - ae_vector_clear(&p->uidx); -} - - -void _sparsematrix_destroy(void* _p) -{ - sparsematrix *p = (sparsematrix*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->vals); - ae_vector_destroy(&p->idx); - ae_vector_destroy(&p->ridx); - ae_vector_destroy(&p->didx); - ae_vector_destroy(&p->uidx); -} - - - - -/************************************************************************* -Basic Cholesky solver for ScaleA*Cholesky(A)'*x = y. - -This subroutine assumes that: -* A*ScaleA is well scaled -* A is well-conditioned, so no zero divisions or overflow may occur - -INPUT PARAMETERS: - CHA - Cholesky decomposition of A - SqrtScaleA- square root of scale factor ScaleA - N - matrix size, N>=0. - IsUpper - storage type - XB - right part - Tmp - buffer; function automatically allocates it, if it is too - small. It can be reused if function is called several - times. - -OUTPUT PARAMETERS: - XB - solution - -NOTE 1: no assertion or tests are done during algorithm operation -NOTE 2: N=0 will force algorithm to silently return - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void fblscholeskysolve(/* Real */ ae_matrix* cha, - double sqrtscalea, - ae_int_t n, - ae_bool isupper, - /* Real */ ae_vector* xb, - /* Real */ ae_vector* tmp, - ae_state *_state) -{ - ae_int_t i; - double v; - - - if( n==0 ) - { - return; - } - if( tmp->cntptr.p_double[i] = xb->ptr.p_double[i]/(sqrtscalea*cha->ptr.pp_double[i][i]); - if( iptr.p_double[i]; - ae_v_moved(&tmp->ptr.p_double[i+1], 1, &cha->ptr.pp_double[i][i+1], 1, ae_v_len(i+1,n-1), sqrtscalea); - ae_v_subd(&xb->ptr.p_double[i+1], 1, &tmp->ptr.p_double[i+1], 1, ae_v_len(i+1,n-1), v); - } - } - - /* - * Solve U*x=y then. - */ - for(i=n-1; i>=0; i--) - { - if( iptr.p_double[i+1], 1, &cha->ptr.pp_double[i][i+1], 1, ae_v_len(i+1,n-1), sqrtscalea); - v = ae_v_dotproduct(&tmp->ptr.p_double[i+1], 1, &xb->ptr.p_double[i+1], 1, ae_v_len(i+1,n-1)); - xb->ptr.p_double[i] = xb->ptr.p_double[i]-v; - } - xb->ptr.p_double[i] = xb->ptr.p_double[i]/(sqrtscalea*cha->ptr.pp_double[i][i]); - } - } - else - { - - /* - * Solve L*y=b first - */ - for(i=0; i<=n-1; i++) - { - if( i>0 ) - { - ae_v_moved(&tmp->ptr.p_double[0], 1, &cha->ptr.pp_double[i][0], 1, ae_v_len(0,i-1), sqrtscalea); - v = ae_v_dotproduct(&tmp->ptr.p_double[0], 1, &xb->ptr.p_double[0], 1, ae_v_len(0,i-1)); - xb->ptr.p_double[i] = xb->ptr.p_double[i]-v; - } - xb->ptr.p_double[i] = xb->ptr.p_double[i]/(sqrtscalea*cha->ptr.pp_double[i][i]); - } - - /* - * Solve L'*x=y then. - */ - for(i=n-1; i>=0; i--) - { - xb->ptr.p_double[i] = xb->ptr.p_double[i]/(sqrtscalea*cha->ptr.pp_double[i][i]); - if( i>0 ) - { - v = xb->ptr.p_double[i]; - ae_v_moved(&tmp->ptr.p_double[0], 1, &cha->ptr.pp_double[i][0], 1, ae_v_len(0,i-1), sqrtscalea); - ae_v_subd(&xb->ptr.p_double[0], 1, &tmp->ptr.p_double[0], 1, ae_v_len(0,i-1), v); - } - } - } -} - - -/************************************************************************* -Fast basic linear solver: linear SPD CG - -Solves (A^T*A + alpha*I)*x = b where: -* A is MxN matrix -* alpha>0 is a scalar -* I is NxN identity matrix -* b is Nx1 vector -* X is Nx1 unknown vector. - -N iterations of linear conjugate gradient are used to solve problem. - -INPUT PARAMETERS: - A - array[M,N], matrix - M - number of rows - N - number of unknowns - B - array[N], right part - X - initial approxumation, array[N] - Buf - buffer; function automatically allocates it, if it is too - small. It can be reused if function is called several times - with same M and N. - -OUTPUT PARAMETERS: - X - improved solution - -NOTES: -* solver checks quality of improved solution. If (because of problem - condition number, numerical noise, etc.) new solution is WORSE than - original approximation, then original approximation is returned. -* solver assumes that both A, B, Alpha are well scaled (i.e. they are - less than sqrt(overflow) and greater than sqrt(underflow)). - - -- ALGLIB -- - Copyright 20.08.2009 by Bochkanov Sergey -*************************************************************************/ -void fblssolvecgx(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - double alpha, - /* Real */ ae_vector* b, - /* Real */ ae_vector* x, - /* Real */ ae_vector* buf, - ae_state *_state) -{ - ae_int_t k; - ae_int_t offsrk; - ae_int_t offsrk1; - ae_int_t offsxk; - ae_int_t offsxk1; - ae_int_t offspk; - ae_int_t offspk1; - ae_int_t offstmp1; - ae_int_t offstmp2; - ae_int_t bs; - double e1; - double e2; - double rk2; - double rk12; - double pap; - double s; - double betak; - double v1; - double v2; - - - - /* - * Test for special case: B=0 - */ - v1 = ae_v_dotproduct(&b->ptr.p_double[0], 1, &b->ptr.p_double[0], 1, ae_v_len(0,n-1)); - if( ae_fp_eq(v1,0) ) - { - for(k=0; k<=n-1; k++) - { - x->ptr.p_double[k] = 0; - } - return; - } - - /* - * Offsets inside Buf for: - * * R[K], R[K+1] - * * X[K], X[K+1] - * * P[K], P[K+1] - * * Tmp1 - array[M], Tmp2 - array[N] - */ - offsrk = 0; - offsrk1 = offsrk+n; - offsxk = offsrk1+n; - offsxk1 = offsxk+n; - offspk = offsxk1+n; - offspk1 = offspk+n; - offstmp1 = offspk1+n; - offstmp2 = offstmp1+m; - bs = offstmp2+n; - if( buf->cntptr.p_double[offsxk], 1, &x->ptr.p_double[0], 1, ae_v_len(offsxk,offsxk+n-1)); - - /* - * r(0) = b-A*x(0) - * RK2 = r(0)'*r(0) - */ - rmatrixmv(m, n, a, 0, 0, 0, buf, offsxk, buf, offstmp1, _state); - rmatrixmv(n, m, a, 0, 0, 1, buf, offstmp1, buf, offstmp2, _state); - ae_v_addd(&buf->ptr.p_double[offstmp2], 1, &buf->ptr.p_double[offsxk], 1, ae_v_len(offstmp2,offstmp2+n-1), alpha); - ae_v_move(&buf->ptr.p_double[offsrk], 1, &b->ptr.p_double[0], 1, ae_v_len(offsrk,offsrk+n-1)); - ae_v_sub(&buf->ptr.p_double[offsrk], 1, &buf->ptr.p_double[offstmp2], 1, ae_v_len(offsrk,offsrk+n-1)); - rk2 = ae_v_dotproduct(&buf->ptr.p_double[offsrk], 1, &buf->ptr.p_double[offsrk], 1, ae_v_len(offsrk,offsrk+n-1)); - ae_v_move(&buf->ptr.p_double[offspk], 1, &buf->ptr.p_double[offsrk], 1, ae_v_len(offspk,offspk+n-1)); - e1 = ae_sqrt(rk2, _state); - - /* - * Cycle - */ - for(k=0; k<=n-1; k++) - { - - /* - * Calculate A*p(k) - store in Buf[OffsTmp2:OffsTmp2+N-1] - * and p(k)'*A*p(k) - store in PAP - * - * If PAP=0, break (iteration is over) - */ - rmatrixmv(m, n, a, 0, 0, 0, buf, offspk, buf, offstmp1, _state); - v1 = ae_v_dotproduct(&buf->ptr.p_double[offstmp1], 1, &buf->ptr.p_double[offstmp1], 1, ae_v_len(offstmp1,offstmp1+m-1)); - v2 = ae_v_dotproduct(&buf->ptr.p_double[offspk], 1, &buf->ptr.p_double[offspk], 1, ae_v_len(offspk,offspk+n-1)); - pap = v1+alpha*v2; - rmatrixmv(n, m, a, 0, 0, 1, buf, offstmp1, buf, offstmp2, _state); - ae_v_addd(&buf->ptr.p_double[offstmp2], 1, &buf->ptr.p_double[offspk], 1, ae_v_len(offstmp2,offstmp2+n-1), alpha); - if( ae_fp_eq(pap,0) ) - { - break; - } - - /* - * S = (r(k)'*r(k))/(p(k)'*A*p(k)) - */ - s = rk2/pap; - - /* - * x(k+1) = x(k) + S*p(k) - */ - ae_v_move(&buf->ptr.p_double[offsxk1], 1, &buf->ptr.p_double[offsxk], 1, ae_v_len(offsxk1,offsxk1+n-1)); - ae_v_addd(&buf->ptr.p_double[offsxk1], 1, &buf->ptr.p_double[offspk], 1, ae_v_len(offsxk1,offsxk1+n-1), s); - - /* - * r(k+1) = r(k) - S*A*p(k) - * RK12 = r(k+1)'*r(k+1) - * - * Break if r(k+1) small enough (when compared to r(k)) - */ - ae_v_move(&buf->ptr.p_double[offsrk1], 1, &buf->ptr.p_double[offsrk], 1, ae_v_len(offsrk1,offsrk1+n-1)); - ae_v_subd(&buf->ptr.p_double[offsrk1], 1, &buf->ptr.p_double[offstmp2], 1, ae_v_len(offsrk1,offsrk1+n-1), s); - rk12 = ae_v_dotproduct(&buf->ptr.p_double[offsrk1], 1, &buf->ptr.p_double[offsrk1], 1, ae_v_len(offsrk1,offsrk1+n-1)); - if( ae_fp_less_eq(ae_sqrt(rk12, _state),100*ae_machineepsilon*ae_sqrt(rk2, _state)) ) - { - - /* - * X(k) = x(k+1) before exit - - * - because we expect to find solution at x(k) - */ - ae_v_move(&buf->ptr.p_double[offsxk], 1, &buf->ptr.p_double[offsxk1], 1, ae_v_len(offsxk,offsxk+n-1)); - break; - } - - /* - * BetaK = RK12/RK2 - * p(k+1) = r(k+1)+betak*p(k) - */ - betak = rk12/rk2; - ae_v_move(&buf->ptr.p_double[offspk1], 1, &buf->ptr.p_double[offsrk1], 1, ae_v_len(offspk1,offspk1+n-1)); - ae_v_addd(&buf->ptr.p_double[offspk1], 1, &buf->ptr.p_double[offspk], 1, ae_v_len(offspk1,offspk1+n-1), betak); - - /* - * r(k) := r(k+1) - * x(k) := x(k+1) - * p(k) := p(k+1) - */ - ae_v_move(&buf->ptr.p_double[offsrk], 1, &buf->ptr.p_double[offsrk1], 1, ae_v_len(offsrk,offsrk+n-1)); - ae_v_move(&buf->ptr.p_double[offsxk], 1, &buf->ptr.p_double[offsxk1], 1, ae_v_len(offsxk,offsxk+n-1)); - ae_v_move(&buf->ptr.p_double[offspk], 1, &buf->ptr.p_double[offspk1], 1, ae_v_len(offspk,offspk+n-1)); - rk2 = rk12; - } - - /* - * Calculate E2 - */ - rmatrixmv(m, n, a, 0, 0, 0, buf, offsxk, buf, offstmp1, _state); - rmatrixmv(n, m, a, 0, 0, 1, buf, offstmp1, buf, offstmp2, _state); - ae_v_addd(&buf->ptr.p_double[offstmp2], 1, &buf->ptr.p_double[offsxk], 1, ae_v_len(offstmp2,offstmp2+n-1), alpha); - ae_v_move(&buf->ptr.p_double[offsrk], 1, &b->ptr.p_double[0], 1, ae_v_len(offsrk,offsrk+n-1)); - ae_v_sub(&buf->ptr.p_double[offsrk], 1, &buf->ptr.p_double[offstmp2], 1, ae_v_len(offsrk,offsrk+n-1)); - v1 = ae_v_dotproduct(&buf->ptr.p_double[offsrk], 1, &buf->ptr.p_double[offsrk], 1, ae_v_len(offsrk,offsrk+n-1)); - e2 = ae_sqrt(v1, _state); - - /* - * Output result (if it was improved) - */ - if( ae_fp_less(e2,e1) ) - { - ae_v_move(&x->ptr.p_double[0], 1, &buf->ptr.p_double[offsxk], 1, ae_v_len(0,n-1)); - } -} - - -/************************************************************************* -Construction of linear conjugate gradient solver. - -State parameter passed using "var" semantics (i.e. previous state is NOT -erased). When it is already initialized, we can reause prevously allocated -memory. - -INPUT PARAMETERS: - X - initial solution - B - right part - N - system size - State - structure; may be preallocated, if we want to reuse memory - -OUTPUT PARAMETERS: - State - structure which is used by FBLSCGIteration() to store - algorithm state between subsequent calls. - -NOTE: no error checking is done; caller must check all parameters, prevent - overflows, and so on. - - -- ALGLIB -- - Copyright 22.10.2009 by Bochkanov Sergey -*************************************************************************/ -void fblscgcreate(/* Real */ ae_vector* x, - /* Real */ ae_vector* b, - ae_int_t n, - fblslincgstate* state, - ae_state *_state) -{ - - - if( state->b.cntb, n, _state); - } - if( state->rk.cntrk, n, _state); - } - if( state->rk1.cntrk1, n, _state); - } - if( state->xk.cntxk, n, _state); - } - if( state->xk1.cntxk1, n, _state); - } - if( state->pk.cntpk, n, _state); - } - if( state->pk1.cntpk1, n, _state); - } - if( state->tmp2.cnttmp2, n, _state); - } - if( state->x.cntx, n, _state); - } - if( state->ax.cntax, n, _state); - } - state->n = n; - ae_v_move(&state->xk.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_move(&state->b.ptr.p_double[0], 1, &b->ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_vector_set_length(&state->rstate.ia, 1+1, _state); - ae_vector_set_length(&state->rstate.ra, 6+1, _state); - state->rstate.stage = -1; -} - - -/************************************************************************* -Linear CG solver, function relying on reverse communication to calculate -matrix-vector products. - -See comments for FBLSLinCGState structure for more info. - - -- ALGLIB -- - Copyright 22.10.2009 by Bochkanov Sergey -*************************************************************************/ -ae_bool fblscgiteration(fblslincgstate* state, ae_state *_state) -{ - ae_int_t n; - ae_int_t k; - double rk2; - double rk12; - double pap; - double s; - double betak; - double v1; - double v2; - ae_bool result; - - - - /* - * Reverse communication preparations - * I know it looks ugly, but it works the same way - * anywhere from C++ to Python. - * - * This code initializes locals by: - * * random values determined during code - * generation - on first subroutine call - * * values from previous call - on subsequent calls - */ - if( state->rstate.stage>=0 ) - { - n = state->rstate.ia.ptr.p_int[0]; - k = state->rstate.ia.ptr.p_int[1]; - rk2 = state->rstate.ra.ptr.p_double[0]; - rk12 = state->rstate.ra.ptr.p_double[1]; - pap = state->rstate.ra.ptr.p_double[2]; - s = state->rstate.ra.ptr.p_double[3]; - betak = state->rstate.ra.ptr.p_double[4]; - v1 = state->rstate.ra.ptr.p_double[5]; - v2 = state->rstate.ra.ptr.p_double[6]; - } - else - { - n = -983; - k = -989; - rk2 = -834; - rk12 = 900; - pap = -287; - s = 364; - betak = 214; - v1 = -338; - v2 = -686; - } - if( state->rstate.stage==0 ) - { - goto lbl_0; - } - if( state->rstate.stage==1 ) - { - goto lbl_1; - } - if( state->rstate.stage==2 ) - { - goto lbl_2; - } - - /* - * Routine body - */ - - /* - * prepare locals - */ - n = state->n; - - /* - * Test for special case: B=0 - */ - v1 = ae_v_dotproduct(&state->b.ptr.p_double[0], 1, &state->b.ptr.p_double[0], 1, ae_v_len(0,n-1)); - if( ae_fp_eq(v1,0) ) - { - for(k=0; k<=n-1; k++) - { - state->xk.ptr.p_double[k] = 0; - } - result = ae_false; - return result; - } - - /* - * r(0) = b-A*x(0) - * RK2 = r(0)'*r(0) - */ - ae_v_move(&state->x.ptr.p_double[0], 1, &state->xk.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->rstate.stage = 0; - goto lbl_rcomm; -lbl_0: - ae_v_move(&state->rk.ptr.p_double[0], 1, &state->b.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_sub(&state->rk.ptr.p_double[0], 1, &state->ax.ptr.p_double[0], 1, ae_v_len(0,n-1)); - rk2 = ae_v_dotproduct(&state->rk.ptr.p_double[0], 1, &state->rk.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_move(&state->pk.ptr.p_double[0], 1, &state->rk.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->e1 = ae_sqrt(rk2, _state); - - /* - * Cycle - */ - k = 0; -lbl_3: - if( k>n-1 ) - { - goto lbl_5; - } - - /* - * Calculate A*p(k) - store in State.Tmp2 - * and p(k)'*A*p(k) - store in PAP - * - * If PAP=0, break (iteration is over) - */ - ae_v_move(&state->x.ptr.p_double[0], 1, &state->pk.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->rstate.stage = 1; - goto lbl_rcomm; -lbl_1: - ae_v_move(&state->tmp2.ptr.p_double[0], 1, &state->ax.ptr.p_double[0], 1, ae_v_len(0,n-1)); - pap = state->xax; - if( !ae_isfinite(pap, _state) ) - { - goto lbl_5; - } - if( ae_fp_less_eq(pap,0) ) - { - goto lbl_5; - } - - /* - * S = (r(k)'*r(k))/(p(k)'*A*p(k)) - */ - s = rk2/pap; - - /* - * x(k+1) = x(k) + S*p(k) - */ - ae_v_move(&state->xk1.ptr.p_double[0], 1, &state->xk.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_addd(&state->xk1.ptr.p_double[0], 1, &state->pk.ptr.p_double[0], 1, ae_v_len(0,n-1), s); - - /* - * r(k+1) = r(k) - S*A*p(k) - * RK12 = r(k+1)'*r(k+1) - * - * Break if r(k+1) small enough (when compared to r(k)) - */ - ae_v_move(&state->rk1.ptr.p_double[0], 1, &state->rk.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_subd(&state->rk1.ptr.p_double[0], 1, &state->tmp2.ptr.p_double[0], 1, ae_v_len(0,n-1), s); - rk12 = ae_v_dotproduct(&state->rk1.ptr.p_double[0], 1, &state->rk1.ptr.p_double[0], 1, ae_v_len(0,n-1)); - if( ae_fp_less_eq(ae_sqrt(rk12, _state),100*ae_machineepsilon*state->e1) ) - { - - /* - * X(k) = x(k+1) before exit - - * - because we expect to find solution at x(k) - */ - ae_v_move(&state->xk.ptr.p_double[0], 1, &state->xk1.ptr.p_double[0], 1, ae_v_len(0,n-1)); - goto lbl_5; - } - - /* - * BetaK = RK12/RK2 - * p(k+1) = r(k+1)+betak*p(k) - * - * NOTE: we expect that BetaK won't overflow because of - * "Sqrt(RK12)<=100*MachineEpsilon*E1" test above. - */ - betak = rk12/rk2; - ae_v_move(&state->pk1.ptr.p_double[0], 1, &state->rk1.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_addd(&state->pk1.ptr.p_double[0], 1, &state->pk.ptr.p_double[0], 1, ae_v_len(0,n-1), betak); - - /* - * r(k) := r(k+1) - * x(k) := x(k+1) - * p(k) := p(k+1) - */ - ae_v_move(&state->rk.ptr.p_double[0], 1, &state->rk1.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_move(&state->xk.ptr.p_double[0], 1, &state->xk1.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_move(&state->pk.ptr.p_double[0], 1, &state->pk1.ptr.p_double[0], 1, ae_v_len(0,n-1)); - rk2 = rk12; - k = k+1; - goto lbl_3; -lbl_5: - - /* - * Calculate E2 - */ - ae_v_move(&state->x.ptr.p_double[0], 1, &state->xk.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->rstate.stage = 2; - goto lbl_rcomm; -lbl_2: - ae_v_move(&state->rk.ptr.p_double[0], 1, &state->b.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_sub(&state->rk.ptr.p_double[0], 1, &state->ax.ptr.p_double[0], 1, ae_v_len(0,n-1)); - v1 = ae_v_dotproduct(&state->rk.ptr.p_double[0], 1, &state->rk.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->e2 = ae_sqrt(v1, _state); - result = ae_false; - return result; - - /* - * Saving state - */ -lbl_rcomm: - result = ae_true; - state->rstate.ia.ptr.p_int[0] = n; - state->rstate.ia.ptr.p_int[1] = k; - state->rstate.ra.ptr.p_double[0] = rk2; - state->rstate.ra.ptr.p_double[1] = rk12; - state->rstate.ra.ptr.p_double[2] = pap; - state->rstate.ra.ptr.p_double[3] = s; - state->rstate.ra.ptr.p_double[4] = betak; - state->rstate.ra.ptr.p_double[5] = v1; - state->rstate.ra.ptr.p_double[6] = v2; - return result; -} - - -/************************************************************************* -Fast least squares solver, solves well conditioned system without -performing any checks for degeneracy, and using user-provided buffers -(which are automatically reallocated if too small). - -This function is intended for solution of moderately sized systems. It -uses factorization algorithms based on Level 2 BLAS operations, thus it -won't work efficiently on large scale systems. - -INPUT PARAMETERS: - A - array[M,N], system matrix. - Contents of A is destroyed during solution. - B - array[M], right part - M - number of equations - N - number of variables, N<=M - Tmp0, Tmp1, Tmp2- - buffers; function automatically allocates them, if they are - too small. They can be reused if function is called - several times. - -OUTPUT PARAMETERS: - B - solution (first N components, next M-N are zero) - - -- ALGLIB -- - Copyright 20.01.2012 by Bochkanov Sergey -*************************************************************************/ -void fblssolvels(/* Real */ ae_matrix* a, - /* Real */ ae_vector* b, - ae_int_t m, - ae_int_t n, - /* Real */ ae_vector* tmp0, - /* Real */ ae_vector* tmp1, - /* Real */ ae_vector* tmp2, - ae_state *_state) -{ - ae_int_t i; - ae_int_t k; - double v; - - - ae_assert(n>0, "FBLSSolveLS: N<=0", _state); - ae_assert(m>=n, "FBLSSolveLS: Mrows>=m, "FBLSSolveLS: Rows(A)cols>=n, "FBLSSolveLS: Cols(A)cnt>=m, "FBLSSolveLS: Length(B)ptr.p_double[i] = 0; - } - ae_v_move(&tmp0->ptr.p_double[k], 1, &a->ptr.pp_double[k][k], a->stride, ae_v_len(k,m-1)); - tmp0->ptr.p_double[k] = 1; - v = ae_v_dotproduct(&tmp0->ptr.p_double[k], 1, &b->ptr.p_double[k], 1, ae_v_len(k,m-1)); - v = v*tmp2->ptr.p_double[k]; - ae_v_subd(&b->ptr.p_double[k], 1, &tmp0->ptr.p_double[k], 1, ae_v_len(k,m-1), v); - } - - /* - * Solve triangular system - */ - b->ptr.p_double[n-1] = b->ptr.p_double[n-1]/a->ptr.pp_double[n-1][n-1]; - for(i=n-2; i>=0; i--) - { - v = ae_v_dotproduct(&a->ptr.pp_double[i][i+1], 1, &b->ptr.p_double[i+1], 1, ae_v_len(i+1,n-1)); - b->ptr.p_double[i] = (b->ptr.p_double[i]-v)/a->ptr.pp_double[i][i]; - } - for(i=n; i<=m-1; i++) - { - b->ptr.p_double[i] = 0.0; - } -} - - -ae_bool _fblslincgstate_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - fblslincgstate *p = (fblslincgstate*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->ax, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->rk, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->rk1, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->xk, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->xk1, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->pk, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->pk1, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->b, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->tmp2, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _fblslincgstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - fblslincgstate *dst = (fblslincgstate*)_dst; - fblslincgstate *src = (fblslincgstate*)_src; - dst->e1 = src->e1; - dst->e2 = src->e2; - if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->ax, &src->ax, _state, make_automatic) ) - return ae_false; - dst->xax = src->xax; - dst->n = src->n; - if( !ae_vector_init_copy(&dst->rk, &src->rk, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->rk1, &src->rk1, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->xk, &src->xk, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->xk1, &src->xk1, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->pk, &src->pk, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->pk1, &src->pk1, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->b, &src->b, _state, make_automatic) ) - return ae_false; - if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->tmp2, &src->tmp2, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _fblslincgstate_clear(void* _p) -{ - fblslincgstate *p = (fblslincgstate*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->x); - ae_vector_clear(&p->ax); - ae_vector_clear(&p->rk); - ae_vector_clear(&p->rk1); - ae_vector_clear(&p->xk); - ae_vector_clear(&p->xk1); - ae_vector_clear(&p->pk); - ae_vector_clear(&p->pk1); - ae_vector_clear(&p->b); - _rcommstate_clear(&p->rstate); - ae_vector_clear(&p->tmp2); -} - - -void _fblslincgstate_destroy(void* _p) -{ - fblslincgstate *p = (fblslincgstate*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->x); - ae_vector_destroy(&p->ax); - ae_vector_destroy(&p->rk); - ae_vector_destroy(&p->rk1); - ae_vector_destroy(&p->xk); - ae_vector_destroy(&p->xk1); - ae_vector_destroy(&p->pk); - ae_vector_destroy(&p->pk1); - ae_vector_destroy(&p->b); - _rcommstate_destroy(&p->rstate); - ae_vector_destroy(&p->tmp2); -} - - - - -/************************************************************************* -This procedure initializes matrix norm estimator. - -USAGE: -1. User initializes algorithm state with NormEstimatorCreate() call -2. User calls NormEstimatorEstimateSparse() (or NormEstimatorIteration()) -3. User calls NormEstimatorResults() to get solution. - -INPUT PARAMETERS: - M - number of rows in the matrix being estimated, M>0 - N - number of columns in the matrix being estimated, N>0 - NStart - number of random starting vectors - recommended value - at least 5. - NIts - number of iterations to do with best starting vector - recommended value - at least 5. - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -NOTE: this algorithm is effectively deterministic, i.e. it always returns -same result when repeatedly called for the same matrix. In fact, algorithm -uses randomized starting vectors, but internal random numbers generator -always generates same sequence of the random values (it is a feature, not -bug). - -Algorithm can be made non-deterministic with NormEstimatorSetSeed(0) call. - - -- ALGLIB -- - Copyright 06.12.2011 by Bochkanov Sergey -*************************************************************************/ -void normestimatorcreate(ae_int_t m, - ae_int_t n, - ae_int_t nstart, - ae_int_t nits, - normestimatorstate* state, - ae_state *_state) -{ - - _normestimatorstate_clear(state); - - ae_assert(m>0, "NormEstimatorCreate: M<=0", _state); - ae_assert(n>0, "NormEstimatorCreate: N<=0", _state); - ae_assert(nstart>0, "NormEstimatorCreate: NStart<=0", _state); - ae_assert(nits>0, "NormEstimatorCreate: NIts<=0", _state); - state->m = m; - state->n = n; - state->nstart = nstart; - state->nits = nits; - state->seedval = 11; - hqrndrandomize(&state->r, _state); - ae_vector_set_length(&state->x0, state->n, _state); - ae_vector_set_length(&state->t, state->m, _state); - ae_vector_set_length(&state->x1, state->n, _state); - ae_vector_set_length(&state->xbest, state->n, _state); - ae_vector_set_length(&state->x, ae_maxint(state->n, state->m, _state), _state); - ae_vector_set_length(&state->mv, state->m, _state); - ae_vector_set_length(&state->mtv, state->n, _state); - ae_vector_set_length(&state->rstate.ia, 3+1, _state); - ae_vector_set_length(&state->rstate.ra, 2+1, _state); - state->rstate.stage = -1; -} - - -/************************************************************************* -This function changes seed value used by algorithm. In some cases we need -deterministic processing, i.e. subsequent calls must return equal results, -in other cases we need non-deterministic algorithm which returns different -results for the same matrix on every pass. - -Setting zero seed will lead to non-deterministic algorithm, while non-zero -value will make our algorithm deterministic. - -INPUT PARAMETERS: - State - norm estimator state, must be initialized with a call - to NormEstimatorCreate() - SeedVal - seed value, >=0. Zero value = non-deterministic algo. - - -- ALGLIB -- - Copyright 06.12.2011 by Bochkanov Sergey -*************************************************************************/ -void normestimatorsetseed(normestimatorstate* state, - ae_int_t seedval, - ae_state *_state) -{ - - - ae_assert(seedval>=0, "NormEstimatorSetSeed: SeedVal<0", _state); - state->seedval = seedval; -} - - -/************************************************************************* - - -- ALGLIB -- - Copyright 06.12.2011 by Bochkanov Sergey -*************************************************************************/ -ae_bool normestimatoriteration(normestimatorstate* state, - ae_state *_state) -{ - ae_int_t n; - ae_int_t m; - ae_int_t i; - ae_int_t itcnt; - double v; - double growth; - double bestgrowth; - ae_bool result; - - - - /* - * Reverse communication preparations - * I know it looks ugly, but it works the same way - * anywhere from C++ to Python. - * - * This code initializes locals by: - * * random values determined during code - * generation - on first subroutine call - * * values from previous call - on subsequent calls - */ - if( state->rstate.stage>=0 ) - { - n = state->rstate.ia.ptr.p_int[0]; - m = state->rstate.ia.ptr.p_int[1]; - i = state->rstate.ia.ptr.p_int[2]; - itcnt = state->rstate.ia.ptr.p_int[3]; - v = state->rstate.ra.ptr.p_double[0]; - growth = state->rstate.ra.ptr.p_double[1]; - bestgrowth = state->rstate.ra.ptr.p_double[2]; - } - else - { - n = -983; - m = -989; - i = -834; - itcnt = 900; - v = -287; - growth = 364; - bestgrowth = 214; - } - if( state->rstate.stage==0 ) - { - goto lbl_0; - } - if( state->rstate.stage==1 ) - { - goto lbl_1; - } - if( state->rstate.stage==2 ) - { - goto lbl_2; - } - if( state->rstate.stage==3 ) - { - goto lbl_3; - } - - /* - * Routine body - */ - n = state->n; - m = state->m; - if( state->seedval>0 ) - { - hqrndseed(state->seedval, state->seedval+2, &state->r, _state); - } - bestgrowth = 0; - state->xbest.ptr.p_double[0] = 1; - for(i=1; i<=n-1; i++) - { - state->xbest.ptr.p_double[i] = 0; - } - itcnt = 0; -lbl_4: - if( itcnt>state->nstart-1 ) - { - goto lbl_6; - } - do - { - v = 0; - for(i=0; i<=n-1; i++) - { - state->x0.ptr.p_double[i] = hqrndnormal(&state->r, _state); - v = v+ae_sqr(state->x0.ptr.p_double[i], _state); - } - } - while(ae_fp_eq(v,0)); - v = 1/ae_sqrt(v, _state); - ae_v_muld(&state->x0.ptr.p_double[0], 1, ae_v_len(0,n-1), v); - ae_v_move(&state->x.ptr.p_double[0], 1, &state->x0.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->needmv = ae_true; - state->needmtv = ae_false; - state->rstate.stage = 0; - goto lbl_rcomm; -lbl_0: - ae_v_move(&state->x.ptr.p_double[0], 1, &state->mv.ptr.p_double[0], 1, ae_v_len(0,m-1)); - state->needmv = ae_false; - state->needmtv = ae_true; - state->rstate.stage = 1; - goto lbl_rcomm; -lbl_1: - ae_v_move(&state->x1.ptr.p_double[0], 1, &state->mtv.ptr.p_double[0], 1, ae_v_len(0,n-1)); - v = 0; - for(i=0; i<=n-1; i++) - { - v = v+ae_sqr(state->x1.ptr.p_double[i], _state); - } - growth = ae_sqrt(ae_sqrt(v, _state), _state); - if( ae_fp_greater(growth,bestgrowth) ) - { - v = 1/ae_sqrt(v, _state); - ae_v_moved(&state->xbest.ptr.p_double[0], 1, &state->x1.ptr.p_double[0], 1, ae_v_len(0,n-1), v); - bestgrowth = growth; - } - itcnt = itcnt+1; - goto lbl_4; -lbl_6: - ae_v_move(&state->x0.ptr.p_double[0], 1, &state->xbest.ptr.p_double[0], 1, ae_v_len(0,n-1)); - itcnt = 0; -lbl_7: - if( itcnt>state->nits-1 ) - { - goto lbl_9; - } - ae_v_move(&state->x.ptr.p_double[0], 1, &state->x0.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->needmv = ae_true; - state->needmtv = ae_false; - state->rstate.stage = 2; - goto lbl_rcomm; -lbl_2: - ae_v_move(&state->x.ptr.p_double[0], 1, &state->mv.ptr.p_double[0], 1, ae_v_len(0,m-1)); - state->needmv = ae_false; - state->needmtv = ae_true; - state->rstate.stage = 3; - goto lbl_rcomm; -lbl_3: - ae_v_move(&state->x1.ptr.p_double[0], 1, &state->mtv.ptr.p_double[0], 1, ae_v_len(0,n-1)); - v = 0; - for(i=0; i<=n-1; i++) - { - v = v+ae_sqr(state->x1.ptr.p_double[i], _state); - } - state->repnorm = ae_sqrt(ae_sqrt(v, _state), _state); - if( ae_fp_neq(v,0) ) - { - v = 1/ae_sqrt(v, _state); - ae_v_moved(&state->x0.ptr.p_double[0], 1, &state->x1.ptr.p_double[0], 1, ae_v_len(0,n-1), v); - } - itcnt = itcnt+1; - goto lbl_7; -lbl_9: - result = ae_false; - return result; - - /* - * Saving state - */ -lbl_rcomm: - result = ae_true; - state->rstate.ia.ptr.p_int[0] = n; - state->rstate.ia.ptr.p_int[1] = m; - state->rstate.ia.ptr.p_int[2] = i; - state->rstate.ia.ptr.p_int[3] = itcnt; - state->rstate.ra.ptr.p_double[0] = v; - state->rstate.ra.ptr.p_double[1] = growth; - state->rstate.ra.ptr.p_double[2] = bestgrowth; - return result; -} - - -/************************************************************************* -This function estimates norm of the sparse M*N matrix A. - -INPUT PARAMETERS: - State - norm estimator state, must be initialized with a call - to NormEstimatorCreate() - A - sparse M*N matrix, must be converted to CRS format - prior to calling this function. - -After this function is over you can call NormEstimatorResults() to get -estimate of the norm(A). - - -- ALGLIB -- - Copyright 06.12.2011 by Bochkanov Sergey -*************************************************************************/ -void normestimatorestimatesparse(normestimatorstate* state, - sparsematrix* a, - ae_state *_state) -{ - - - normestimatorrestart(state, _state); - while(normestimatoriteration(state, _state)) - { - if( state->needmv ) - { - sparsemv(a, &state->x, &state->mv, _state); - continue; - } - if( state->needmtv ) - { - sparsemtv(a, &state->x, &state->mtv, _state); - continue; - } - } -} - - -/************************************************************************* -Matrix norm estimation results - -INPUT PARAMETERS: - State - algorithm state - -OUTPUT PARAMETERS: - Nrm - estimate of the matrix norm, Nrm>=0 - - -- ALGLIB -- - Copyright 06.12.2011 by Bochkanov Sergey -*************************************************************************/ -void normestimatorresults(normestimatorstate* state, - double* nrm, - ae_state *_state) -{ - - *nrm = 0; - - *nrm = state->repnorm; -} - - -/************************************************************************* -This function restarts estimator and prepares it for the next estimation -round. - -INPUT PARAMETERS: - State - algorithm state - -- ALGLIB -- - Copyright 06.12.2011 by Bochkanov Sergey -*************************************************************************/ -void normestimatorrestart(normestimatorstate* state, ae_state *_state) -{ - - - ae_vector_set_length(&state->rstate.ia, 3+1, _state); - ae_vector_set_length(&state->rstate.ra, 2+1, _state); - state->rstate.stage = -1; -} - - -ae_bool _normestimatorstate_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - normestimatorstate *p = (normestimatorstate*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->x0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->x1, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->t, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->xbest, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !_hqrndstate_init(&p->r, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->mv, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->mtv, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _normestimatorstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - normestimatorstate *dst = (normestimatorstate*)_dst; - normestimatorstate *src = (normestimatorstate*)_src; - dst->n = src->n; - dst->m = src->m; - dst->nstart = src->nstart; - dst->nits = src->nits; - dst->seedval = src->seedval; - if( !ae_vector_init_copy(&dst->x0, &src->x0, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->x1, &src->x1, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->t, &src->t, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->xbest, &src->xbest, _state, make_automatic) ) - return ae_false; - if( !_hqrndstate_init_copy(&dst->r, &src->r, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->mv, &src->mv, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->mtv, &src->mtv, _state, make_automatic) ) - return ae_false; - dst->needmv = src->needmv; - dst->needmtv = src->needmtv; - dst->repnorm = src->repnorm; - if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _normestimatorstate_clear(void* _p) -{ - normestimatorstate *p = (normestimatorstate*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->x0); - ae_vector_clear(&p->x1); - ae_vector_clear(&p->t); - ae_vector_clear(&p->xbest); - _hqrndstate_clear(&p->r); - ae_vector_clear(&p->x); - ae_vector_clear(&p->mv); - ae_vector_clear(&p->mtv); - _rcommstate_clear(&p->rstate); -} - - -void _normestimatorstate_destroy(void* _p) -{ - normestimatorstate *p = (normestimatorstate*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->x0); - ae_vector_destroy(&p->x1); - ae_vector_destroy(&p->t); - ae_vector_destroy(&p->xbest); - _hqrndstate_destroy(&p->r); - ae_vector_destroy(&p->x); - ae_vector_destroy(&p->mv); - ae_vector_destroy(&p->mtv); - _rcommstate_destroy(&p->rstate); -} - - - - -/************************************************************************* -Determinant calculation of the matrix given by its LU decomposition. - -Input parameters: - A - LU decomposition of the matrix (output of - RMatrixLU subroutine). - Pivots - table of permutations which were made during - the LU decomposition. - Output of RMatrixLU subroutine. - N - (optional) size of matrix A: - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, automatically determined from matrix size - (A must be square matrix) - -Result: matrix determinant. - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -double rmatrixludet(/* Real */ ae_matrix* a, - /* Integer */ ae_vector* pivots, - ae_int_t n, - ae_state *_state) -{ - ae_int_t i; - ae_int_t s; - double result; - - - ae_assert(n>=1, "RMatrixLUDet: N<1!", _state); - ae_assert(pivots->cnt>=n, "RMatrixLUDet: Pivots array is too short!", _state); - ae_assert(a->rows>=n, "RMatrixLUDet: rows(A)cols>=n, "RMatrixLUDet: cols(A)ptr.pp_double[i][i]; - if( pivots->ptr.p_int[i]!=i ) - { - s = -s; - } - } - result = result*s; - return result; -} - - -/************************************************************************* -Calculation of the determinant of a general matrix - -Input parameters: - A - matrix, array[0..N-1, 0..N-1] - N - (optional) size of matrix A: - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, automatically determined from matrix size - (A must be square matrix) - -Result: determinant of matrix A. - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -double rmatrixdet(/* Real */ ae_matrix* a, - ae_int_t n, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix _a; - ae_vector pivots; - double result; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init_copy(&_a, a, _state, ae_true); - a = &_a; - ae_vector_init(&pivots, 0, DT_INT, _state, ae_true); - - ae_assert(n>=1, "RMatrixDet: N<1!", _state); - ae_assert(a->rows>=n, "RMatrixDet: rows(A)cols>=n, "RMatrixDet: cols(A)=1, "CMatrixLUDet: N<1!", _state); - ae_assert(pivots->cnt>=n, "CMatrixLUDet: Pivots array is too short!", _state); - ae_assert(a->rows>=n, "CMatrixLUDet: rows(A)cols>=n, "CMatrixLUDet: cols(A)ptr.pp_complex[i][i]); - if( pivots->ptr.p_int[i]!=i ) - { - s = -s; - } - } - result = ae_c_mul_d(result,s); - return result; -} - - -/************************************************************************* -Calculation of the determinant of a general matrix - -Input parameters: - A - matrix, array[0..N-1, 0..N-1] - N - (optional) size of matrix A: - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, automatically determined from matrix size - (A must be square matrix) - -Result: determinant of matrix A. - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -ae_complex cmatrixdet(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix _a; - ae_vector pivots; - ae_complex result; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init_copy(&_a, a, _state, ae_true); - a = &_a; - ae_vector_init(&pivots, 0, DT_INT, _state, ae_true); - - ae_assert(n>=1, "CMatrixDet: N<1!", _state); - ae_assert(a->rows>=n, "CMatrixDet: rows(A)cols>=n, "CMatrixDet: cols(A)=1, "SPDMatrixCholeskyDet: N<1!", _state); - ae_assert(a->rows>=n, "SPDMatrixCholeskyDet: rows(A)cols>=n, "SPDMatrixCholeskyDet: cols(A)ptr.pp_double[i][i], _state); - } - ae_assert(f, "SPDMatrixCholeskyDet: A contains infinite or NaN values!", _state); - result = 1; - for(i=0; i<=n-1; i++) - { - result = result*ae_sqr(a->ptr.pp_double[i][i], _state); - } - return result; -} - - -/************************************************************************* -Determinant calculation of the symmetric positive definite matrix. - -Input parameters: - A - matrix. Array with elements [0..N-1, 0..N-1]. - N - (optional) size of matrix A: - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, automatically determined from matrix size - (A must be square matrix) - IsUpper - (optional) storage type: - * if True, symmetric matrix A is given by its upper - triangle, and the lower triangle isn’t used/changed by - function - * if False, symmetric matrix A is given by its lower - triangle, and the upper triangle isn’t used/changed by - function - * if not given, both lower and upper triangles must be - filled. - -Result: - determinant of matrix A. - If matrix A is not positive definite, exception is thrown. - - -- ALGLIB -- - Copyright 2005-2008 by Bochkanov Sergey -*************************************************************************/ -double spdmatrixdet(/* Real */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix _a; - ae_bool b; - double result; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init_copy(&_a, a, _state, ae_true); - a = &_a; - - ae_assert(n>=1, "SPDMatrixDet: N<1!", _state); - ae_assert(a->rows>=n, "SPDMatrixDet: rows(A)cols>=n, "SPDMatrixDet: cols(A)ptr.pp_double[0][j] = 0.0; - } - for(i=1; i<=n-1; i++) - { - ae_v_move(&z->ptr.pp_double[i][0], 1, &z->ptr.pp_double[0][0], 1, ae_v_len(0,n-1)); - } - - /* - * Setup R properties - */ - if( isupperr ) - { - j1 = 0; - j2 = n-1; - j1inc = 1; - j2inc = 0; - } - else - { - j1 = 0; - j2 = 0; - j1inc = 0; - j2inc = 1; - } - - /* - * Calculate R*Z - */ - for(i=0; i<=n-1; i++) - { - for(j=j1; j<=j2; j++) - { - v = r.ptr.pp_double[i][j]; - ae_v_addd(&z->ptr.pp_double[i][0], 1, &t.ptr.pp_double[j][0], 1, ae_v_len(0,n-1), v); - } - j1 = j1+j1inc; - j2 = j2+j2inc; - } - } - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* -Algorithm for reduction of the following generalized symmetric positive- -definite eigenvalue problem: - A*x = lambda*B*x (1) or - A*B*x = lambda*x (2) or - B*A*x = lambda*x (3) -to the symmetric eigenvalues problem C*y = lambda*y (eigenvalues of this and -the given problems are the same, and the eigenvectors of the given problem -could be obtained by multiplying the obtained eigenvectors by the -transformation matrix x = R*y). - -Here A is a symmetric matrix, B - symmetric positive-definite matrix. - -Input parameters: - A - symmetric matrix which is given by its upper or lower - triangular part. - Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrices A and B. - IsUpperA - storage format of matrix A. - B - symmetric positive-definite matrix which is given by - its upper or lower triangular part. - Array whose indexes range within [0..N-1, 0..N-1]. - IsUpperB - storage format of matrix B. - ProblemType - if ProblemType is equal to: - * 1, the following problem is solved: A*x = lambda*B*x; - * 2, the following problem is solved: A*B*x = lambda*x; - * 3, the following problem is solved: B*A*x = lambda*x. - -Output parameters: - A - symmetric matrix which is given by its upper or lower - triangle depending on IsUpperA. Contains matrix C. - Array whose indexes range within [0..N-1, 0..N-1]. - R - upper triangular or low triangular transformation matrix - which is used to obtain the eigenvectors of a given problem - as the product of eigenvectors of C (from the right) and - matrix R (from the left). If the matrix is upper - triangular, the elements below the main diagonal - are equal to 0 (and vice versa). Thus, we can perform - the multiplication without taking into account the - internal structure (which is an easier though less - effective way). - Array whose indexes range within [0..N-1, 0..N-1]. - IsUpperR - type of matrix R (upper or lower triangular). - -Result: - True, if the problem was reduced successfully. - False, if the error occurred during the Cholesky decomposition of - matrix B (the matrix is not positive-definite). - - -- ALGLIB -- - Copyright 1.28.2006 by Bochkanov Sergey -*************************************************************************/ -ae_bool smatrixgevdreduce(/* Real */ ae_matrix* a, - ae_int_t n, - ae_bool isuppera, - /* Real */ ae_matrix* b, - ae_bool isupperb, - ae_int_t problemtype, - /* Real */ ae_matrix* r, - ae_bool* isupperr, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix t; - ae_vector w1; - ae_vector w2; - ae_vector w3; - ae_int_t i; - ae_int_t j; - double v; - matinvreport rep; - ae_int_t info; - ae_bool result; - - ae_frame_make(_state, &_frame_block); - ae_matrix_clear(r); - *isupperr = ae_false; - ae_matrix_init(&t, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&w1, 0, DT_REAL, _state, ae_true); - ae_vector_init(&w2, 0, DT_REAL, _state, ae_true); - ae_vector_init(&w3, 0, DT_REAL, _state, ae_true); - _matinvreport_init(&rep, _state, ae_true); - - ae_assert(n>0, "SMatrixGEVDReduce: N<=0!", _state); - ae_assert((problemtype==1||problemtype==2)||problemtype==3, "SMatrixGEVDReduce: incorrect ProblemType!", _state); - result = ae_true; - - /* - * Problem 1: A*x = lambda*B*x - * - * Reducing to: - * C*y = lambda*y - * C = L^(-1) * A * L^(-T) - * x = L^(-T) * y - */ - if( problemtype==1 ) - { - - /* - * Factorize B in T: B = LL' - */ - ae_matrix_set_length(&t, n-1+1, n-1+1, _state); - if( isupperb ) - { - for(i=0; i<=n-1; i++) - { - ae_v_move(&t.ptr.pp_double[i][i], t.stride, &b->ptr.pp_double[i][i], 1, ae_v_len(i,n-1)); - } - } - else - { - for(i=0; i<=n-1; i++) - { - ae_v_move(&t.ptr.pp_double[i][0], 1, &b->ptr.pp_double[i][0], 1, ae_v_len(0,i)); - } - } - if( !spdmatrixcholesky(&t, n, ae_false, _state) ) - { - result = ae_false; - ae_frame_leave(_state); - return result; - } - - /* - * Invert L in T - */ - rmatrixtrinverse(&t, n, ae_false, ae_false, &info, &rep, _state); - if( info<=0 ) - { - result = ae_false; - ae_frame_leave(_state); - return result; - } - - /* - * Build L^(-1) * A * L^(-T) in R - */ - ae_vector_set_length(&w1, n+1, _state); - ae_vector_set_length(&w2, n+1, _state); - ae_matrix_set_length(r, n-1+1, n-1+1, _state); - for(j=1; j<=n; j++) - { - - /* - * Form w2 = A * l'(j) (here l'(j) is j-th column of L^(-T)) - */ - ae_v_move(&w1.ptr.p_double[1], 1, &t.ptr.pp_double[j-1][0], 1, ae_v_len(1,j)); - symmetricmatrixvectormultiply(a, isuppera, 0, j-1, &w1, 1.0, &w2, _state); - if( isuppera ) - { - matrixvectormultiply(a, 0, j-1, j, n-1, ae_true, &w1, 1, j, 1.0, &w2, j+1, n, 0.0, _state); - } - else - { - matrixvectormultiply(a, j, n-1, 0, j-1, ae_false, &w1, 1, j, 1.0, &w2, j+1, n, 0.0, _state); - } - - /* - * Form l(i)*w2 (here l(i) is i-th row of L^(-1)) - */ - for(i=1; i<=n; i++) - { - v = ae_v_dotproduct(&t.ptr.pp_double[i-1][0], 1, &w2.ptr.p_double[1], 1, ae_v_len(0,i-1)); - r->ptr.pp_double[i-1][j-1] = v; - } - } - - /* - * Copy R to A - */ - for(i=0; i<=n-1; i++) - { - ae_v_move(&a->ptr.pp_double[i][0], 1, &r->ptr.pp_double[i][0], 1, ae_v_len(0,n-1)); - } - - /* - * Copy L^(-1) from T to R and transpose - */ - *isupperr = ae_true; - for(i=0; i<=n-1; i++) - { - for(j=0; j<=i-1; j++) - { - r->ptr.pp_double[i][j] = 0; - } - } - for(i=0; i<=n-1; i++) - { - ae_v_move(&r->ptr.pp_double[i][i], 1, &t.ptr.pp_double[i][i], t.stride, ae_v_len(i,n-1)); - } - ae_frame_leave(_state); - return result; - } - - /* - * Problem 2: A*B*x = lambda*x - * or - * problem 3: B*A*x = lambda*x - * - * Reducing to: - * C*y = lambda*y - * C = U * A * U' - * B = U'* U - */ - if( problemtype==2||problemtype==3 ) - { - - /* - * Factorize B in T: B = U'*U - */ - ae_matrix_set_length(&t, n-1+1, n-1+1, _state); - if( isupperb ) - { - for(i=0; i<=n-1; i++) - { - ae_v_move(&t.ptr.pp_double[i][i], 1, &b->ptr.pp_double[i][i], 1, ae_v_len(i,n-1)); - } - } - else - { - for(i=0; i<=n-1; i++) - { - ae_v_move(&t.ptr.pp_double[i][i], 1, &b->ptr.pp_double[i][i], b->stride, ae_v_len(i,n-1)); - } - } - if( !spdmatrixcholesky(&t, n, ae_true, _state) ) - { - result = ae_false; - ae_frame_leave(_state); - return result; - } - - /* - * Build U * A * U' in R - */ - ae_vector_set_length(&w1, n+1, _state); - ae_vector_set_length(&w2, n+1, _state); - ae_vector_set_length(&w3, n+1, _state); - ae_matrix_set_length(r, n-1+1, n-1+1, _state); - for(j=1; j<=n; j++) - { - - /* - * Form w2 = A * u'(j) (here u'(j) is j-th column of U') - */ - ae_v_move(&w1.ptr.p_double[1], 1, &t.ptr.pp_double[j-1][j-1], 1, ae_v_len(1,n-j+1)); - symmetricmatrixvectormultiply(a, isuppera, j-1, n-1, &w1, 1.0, &w3, _state); - ae_v_move(&w2.ptr.p_double[j], 1, &w3.ptr.p_double[1], 1, ae_v_len(j,n)); - ae_v_move(&w1.ptr.p_double[j], 1, &t.ptr.pp_double[j-1][j-1], 1, ae_v_len(j,n)); - if( isuppera ) - { - matrixvectormultiply(a, 0, j-2, j-1, n-1, ae_false, &w1, j, n, 1.0, &w2, 1, j-1, 0.0, _state); - } - else - { - matrixvectormultiply(a, j-1, n-1, 0, j-2, ae_true, &w1, j, n, 1.0, &w2, 1, j-1, 0.0, _state); - } - - /* - * Form u(i)*w2 (here u(i) is i-th row of U) - */ - for(i=1; i<=n; i++) - { - v = ae_v_dotproduct(&t.ptr.pp_double[i-1][i-1], 1, &w2.ptr.p_double[i], 1, ae_v_len(i-1,n-1)); - r->ptr.pp_double[i-1][j-1] = v; - } - } - - /* - * Copy R to A - */ - for(i=0; i<=n-1; i++) - { - ae_v_move(&a->ptr.pp_double[i][0], 1, &r->ptr.pp_double[i][0], 1, ae_v_len(0,n-1)); - } - if( problemtype==2 ) - { - - /* - * Invert U in T - */ - rmatrixtrinverse(&t, n, ae_true, ae_false, &info, &rep, _state); - if( info<=0 ) - { - result = ae_false; - ae_frame_leave(_state); - return result; - } - - /* - * Copy U^-1 from T to R - */ - *isupperr = ae_true; - for(i=0; i<=n-1; i++) - { - for(j=0; j<=i-1; j++) - { - r->ptr.pp_double[i][j] = 0; - } - } - for(i=0; i<=n-1; i++) - { - ae_v_move(&r->ptr.pp_double[i][i], 1, &t.ptr.pp_double[i][i], 1, ae_v_len(i,n-1)); - } - } - else - { - - /* - * Copy U from T to R and transpose - */ - *isupperr = ae_false; - for(i=0; i<=n-1; i++) - { - for(j=i+1; j<=n-1; j++) - { - r->ptr.pp_double[i][j] = 0; - } - } - for(i=0; i<=n-1; i++) - { - ae_v_move(&r->ptr.pp_double[i][i], r->stride, &t.ptr.pp_double[i][i], 1, ae_v_len(i,n-1)); - } - } - } - ae_frame_leave(_state); - return result; -} - - - - -/************************************************************************* -Inverse matrix update by the Sherman-Morrison formula - -The algorithm updates matrix A^-1 when adding a number to an element -of matrix A. - -Input parameters: - InvA - inverse of matrix A. - Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - UpdRow - row where the element to be updated is stored. - UpdColumn - column where the element to be updated is stored. - UpdVal - a number to be added to the element. - - -Output parameters: - InvA - inverse of modified matrix A. - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -void rmatrixinvupdatesimple(/* Real */ ae_matrix* inva, - ae_int_t n, - ae_int_t updrow, - ae_int_t updcolumn, - double updval, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector t1; - ae_vector t2; - ae_int_t i; - double lambdav; - double vt; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&t1, 0, DT_REAL, _state, ae_true); - ae_vector_init(&t2, 0, DT_REAL, _state, ae_true); - - ae_assert(updrow>=0&&updrow=0&&updcolumnptr.pp_double[0][updrow], inva->stride, ae_v_len(0,n-1)); - - /* - * T2 = v*InvA - */ - ae_v_move(&t2.ptr.p_double[0], 1, &inva->ptr.pp_double[updcolumn][0], 1, ae_v_len(0,n-1)); - - /* - * Lambda = v * InvA * U - */ - lambdav = updval*inva->ptr.pp_double[updcolumn][updrow]; - - /* - * InvA = InvA - correction - */ - for(i=0; i<=n-1; i++) - { - vt = updval*t1.ptr.p_double[i]; - vt = vt/(1+lambdav); - ae_v_subd(&inva->ptr.pp_double[i][0], 1, &t2.ptr.p_double[0], 1, ae_v_len(0,n-1), vt); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Inverse matrix update by the Sherman-Morrison formula - -The algorithm updates matrix A^-1 when adding a vector to a row -of matrix A. - -Input parameters: - InvA - inverse of matrix A. - Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - UpdRow - the row of A whose vector V was added. - 0 <= Row <= N-1 - V - the vector to be added to a row. - Array whose index ranges within [0..N-1]. - -Output parameters: - InvA - inverse of modified matrix A. - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -void rmatrixinvupdaterow(/* Real */ ae_matrix* inva, - ae_int_t n, - ae_int_t updrow, - /* Real */ ae_vector* v, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector t1; - ae_vector t2; - ae_int_t i; - ae_int_t j; - double lambdav; - double vt; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&t1, 0, DT_REAL, _state, ae_true); - ae_vector_init(&t2, 0, DT_REAL, _state, ae_true); - - ae_vector_set_length(&t1, n-1+1, _state); - ae_vector_set_length(&t2, n-1+1, _state); - - /* - * T1 = InvA * U - */ - ae_v_move(&t1.ptr.p_double[0], 1, &inva->ptr.pp_double[0][updrow], inva->stride, ae_v_len(0,n-1)); - - /* - * T2 = v*InvA - * Lambda = v * InvA * U - */ - for(j=0; j<=n-1; j++) - { - vt = ae_v_dotproduct(&v->ptr.p_double[0], 1, &inva->ptr.pp_double[0][j], inva->stride, ae_v_len(0,n-1)); - t2.ptr.p_double[j] = vt; - } - lambdav = t2.ptr.p_double[updrow]; - - /* - * InvA = InvA - correction - */ - for(i=0; i<=n-1; i++) - { - vt = t1.ptr.p_double[i]/(1+lambdav); - ae_v_subd(&inva->ptr.pp_double[i][0], 1, &t2.ptr.p_double[0], 1, ae_v_len(0,n-1), vt); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Inverse matrix update by the Sherman-Morrison formula - -The algorithm updates matrix A^-1 when adding a vector to a column -of matrix A. - -Input parameters: - InvA - inverse of matrix A. - Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - UpdColumn - the column of A whose vector U was added. - 0 <= UpdColumn <= N-1 - U - the vector to be added to a column. - Array whose index ranges within [0..N-1]. - -Output parameters: - InvA - inverse of modified matrix A. - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -void rmatrixinvupdatecolumn(/* Real */ ae_matrix* inva, - ae_int_t n, - ae_int_t updcolumn, - /* Real */ ae_vector* u, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector t1; - ae_vector t2; - ae_int_t i; - double lambdav; - double vt; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&t1, 0, DT_REAL, _state, ae_true); - ae_vector_init(&t2, 0, DT_REAL, _state, ae_true); - - ae_vector_set_length(&t1, n-1+1, _state); - ae_vector_set_length(&t2, n-1+1, _state); - - /* - * T1 = InvA * U - * Lambda = v * InvA * U - */ - for(i=0; i<=n-1; i++) - { - vt = ae_v_dotproduct(&inva->ptr.pp_double[i][0], 1, &u->ptr.p_double[0], 1, ae_v_len(0,n-1)); - t1.ptr.p_double[i] = vt; - } - lambdav = t1.ptr.p_double[updcolumn]; - - /* - * T2 = v*InvA - */ - ae_v_move(&t2.ptr.p_double[0], 1, &inva->ptr.pp_double[updcolumn][0], 1, ae_v_len(0,n-1)); - - /* - * InvA = InvA - correction - */ - for(i=0; i<=n-1; i++) - { - vt = t1.ptr.p_double[i]/(1+lambdav); - ae_v_subd(&inva->ptr.pp_double[i][0], 1, &t2.ptr.p_double[0], 1, ae_v_len(0,n-1), vt); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Inverse matrix update by the Sherman-Morrison formula - -The algorithm computes the inverse of matrix A+u*v’ by using the given matrix -A^-1 and the vectors u and v. - -Input parameters: - InvA - inverse of matrix A. - Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - U - the vector modifying the matrix. - Array whose index ranges within [0..N-1]. - V - the vector modifying the matrix. - Array whose index ranges within [0..N-1]. - -Output parameters: - InvA - inverse of matrix A + u*v'. - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -void rmatrixinvupdateuv(/* Real */ ae_matrix* inva, - ae_int_t n, - /* Real */ ae_vector* u, - /* Real */ ae_vector* v, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector t1; - ae_vector t2; - ae_int_t i; - ae_int_t j; - double lambdav; - double vt; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&t1, 0, DT_REAL, _state, ae_true); - ae_vector_init(&t2, 0, DT_REAL, _state, ae_true); - - ae_vector_set_length(&t1, n-1+1, _state); - ae_vector_set_length(&t2, n-1+1, _state); - - /* - * T1 = InvA * U - * Lambda = v * T1 - */ - for(i=0; i<=n-1; i++) - { - vt = ae_v_dotproduct(&inva->ptr.pp_double[i][0], 1, &u->ptr.p_double[0], 1, ae_v_len(0,n-1)); - t1.ptr.p_double[i] = vt; - } - lambdav = ae_v_dotproduct(&v->ptr.p_double[0], 1, &t1.ptr.p_double[0], 1, ae_v_len(0,n-1)); - - /* - * T2 = v*InvA - */ - for(j=0; j<=n-1; j++) - { - vt = ae_v_dotproduct(&v->ptr.p_double[0], 1, &inva->ptr.pp_double[0][j], inva->stride, ae_v_len(0,n-1)); - t2.ptr.p_double[j] = vt; - } - - /* - * InvA = InvA - correction - */ - for(i=0; i<=n-1; i++) - { - vt = t1.ptr.p_double[i]/(1+lambdav); - ae_v_subd(&inva->ptr.pp_double[i][0], 1, &t2.ptr.p_double[0], 1, ae_v_len(0,n-1), vt); - } - ae_frame_leave(_state); -} - - - - -/************************************************************************* -Subroutine performing the Schur decomposition of a general matrix by using -the QR algorithm with multiple shifts. - -The source matrix A is represented as S'*A*S = T, where S is an orthogonal -matrix (Schur vectors), T - upper quasi-triangular matrix (with blocks of -sizes 1x1 and 2x2 on the main diagonal). - -Input parameters: - A - matrix to be decomposed. - Array whose indexes range within [0..N-1, 0..N-1]. - N - size of A, N>=0. - - -Output parameters: - A - contains matrix T. - Array whose indexes range within [0..N-1, 0..N-1]. - S - contains Schur vectors. - Array whose indexes range within [0..N-1, 0..N-1]. - -Note 1: - The block structure of matrix T can be easily recognized: since all - the elements below the blocks are zeros, the elements a[i+1,i] which - are equal to 0 show the block border. - -Note 2: - The algorithm performance depends on the value of the internal parameter - NS of the InternalSchurDecomposition subroutine which defines the number - of shifts in the QR algorithm (similarly to the block width in block-matrix - algorithms in linear algebra). If you require maximum performance on - your machine, it is recommended to adjust this parameter manually. - -Result: - True, - if the algorithm has converged and parameters A and S contain the result. - False, - if the algorithm has not converged. - -Algorithm implemented on the basis of the DHSEQR subroutine (LAPACK 3.0 library). -*************************************************************************/ -ae_bool rmatrixschur(/* Real */ ae_matrix* a, - ae_int_t n, - /* Real */ ae_matrix* s, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector tau; - ae_vector wi; - ae_vector wr; - ae_matrix a1; - ae_matrix s1; - ae_int_t info; - ae_int_t i; - ae_int_t j; - ae_bool result; - - ae_frame_make(_state, &_frame_block); - ae_matrix_clear(s); - ae_vector_init(&tau, 0, DT_REAL, _state, ae_true); - ae_vector_init(&wi, 0, DT_REAL, _state, ae_true); - ae_vector_init(&wr, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&a1, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&s1, 0, 0, DT_REAL, _state, ae_true); - - - /* - * Upper Hessenberg form of the 0-based matrix - */ - rmatrixhessenberg(a, n, &tau, _state); - rmatrixhessenbergunpackq(a, n, &tau, s, _state); - - /* - * Convert from 0-based arrays to 1-based, - * then call InternalSchurDecomposition - * Awkward, of course, but Schur decompisiton subroutine - * is too complex to fix it. - * - */ - ae_matrix_set_length(&a1, n+1, n+1, _state); - ae_matrix_set_length(&s1, n+1, n+1, _state); - for(i=1; i<=n; i++) - { - for(j=1; j<=n; j++) - { - a1.ptr.pp_double[i][j] = a->ptr.pp_double[i-1][j-1]; - s1.ptr.pp_double[i][j] = s->ptr.pp_double[i-1][j-1]; - } - } - internalschurdecomposition(&a1, n, 1, 1, &wr, &wi, &s1, &info, _state); - result = info==0; - - /* - * convert from 1-based arrays to -based - */ - for(i=1; i<=n; i++) - { - for(j=1; j<=n; j++) - { - a->ptr.pp_double[i-1][j-1] = a1.ptr.pp_double[i][j]; - s->ptr.pp_double[i-1][j-1] = s1.ptr.pp_double[i][j]; - } - } - ae_frame_leave(_state); - return result; -} - - - -} - diff --git a/src/core/alglib/linalg.h b/src/core/alglib/linalg.h deleted file mode 100644 index e6364c1..0000000 --- a/src/core/alglib/linalg.h +++ /dev/null @@ -1,5187 +0,0 @@ -/************************************************************************* -Copyright (c) Sergey Bochkanov (ALGLIB project). - ->>> SOURCE LICENSE >>> -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation (www.fsf.org); either version 2 of the -License, or (at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -A copy of the GNU General Public License is available at -http://www.fsf.org/licensing/licenses ->>> END OF LICENSE >>> -*************************************************************************/ -#ifndef _linalg_pkg_h -#define _linalg_pkg_h -#include "ap.h" -#include "alglibinternal.h" -#include "alglibmisc.h" - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (DATATYPES) -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ -typedef struct -{ - double r1; - double rinf; -} matinvreport; -typedef struct -{ - ae_vector vals; - ae_vector idx; - ae_vector ridx; - ae_vector didx; - ae_vector uidx; - ae_int_t matrixtype; - ae_int_t m; - ae_int_t n; - ae_int_t nfree; - ae_int_t ninitialized; -} sparsematrix; -typedef struct -{ - double e1; - double e2; - ae_vector x; - ae_vector ax; - double xax; - ae_int_t n; - ae_vector rk; - ae_vector rk1; - ae_vector xk; - ae_vector xk1; - ae_vector pk; - ae_vector pk1; - ae_vector b; - rcommstate rstate; - ae_vector tmp2; -} fblslincgstate; -typedef struct -{ - ae_int_t n; - ae_int_t m; - ae_int_t nstart; - ae_int_t nits; - ae_int_t seedval; - ae_vector x0; - ae_vector x1; - ae_vector t; - ae_vector xbest; - hqrndstate r; - ae_vector x; - ae_vector mv; - ae_vector mtv; - ae_bool needmv; - ae_bool needmtv; - double repnorm; - rcommstate rstate; -} normestimatorstate; - -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS C++ INTERFACE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib -{ - - - - - - - - - - - - - - - - - -/************************************************************************* -Matrix inverse report: -* R1 reciprocal of condition number in 1-norm -* RInf reciprocal of condition number in inf-norm -*************************************************************************/ -class _matinvreport_owner -{ -public: - _matinvreport_owner(); - _matinvreport_owner(const _matinvreport_owner &rhs); - _matinvreport_owner& operator=(const _matinvreport_owner &rhs); - virtual ~_matinvreport_owner(); - alglib_impl::matinvreport* c_ptr(); - alglib_impl::matinvreport* c_ptr() const; -protected: - alglib_impl::matinvreport *p_struct; -}; -class matinvreport : public _matinvreport_owner -{ -public: - matinvreport(); - matinvreport(const matinvreport &rhs); - matinvreport& operator=(const matinvreport &rhs); - virtual ~matinvreport(); - double &r1; - double &rinf; - -}; - -/************************************************************************* -Sparse matrix - -You should use ALGLIB functions to work with sparse matrix. -Never try to access its fields directly! -*************************************************************************/ -class _sparsematrix_owner -{ -public: - _sparsematrix_owner(); - _sparsematrix_owner(const _sparsematrix_owner &rhs); - _sparsematrix_owner& operator=(const _sparsematrix_owner &rhs); - virtual ~_sparsematrix_owner(); - alglib_impl::sparsematrix* c_ptr(); - alglib_impl::sparsematrix* c_ptr() const; -protected: - alglib_impl::sparsematrix *p_struct; -}; -class sparsematrix : public _sparsematrix_owner -{ -public: - sparsematrix(); - sparsematrix(const sparsematrix &rhs); - sparsematrix& operator=(const sparsematrix &rhs); - virtual ~sparsematrix(); - -}; - - - -/************************************************************************* -This object stores state of the iterative norm estimation algorithm. - -You should use ALGLIB functions to work with this object. -*************************************************************************/ -class _normestimatorstate_owner -{ -public: - _normestimatorstate_owner(); - _normestimatorstate_owner(const _normestimatorstate_owner &rhs); - _normestimatorstate_owner& operator=(const _normestimatorstate_owner &rhs); - virtual ~_normestimatorstate_owner(); - alglib_impl::normestimatorstate* c_ptr(); - alglib_impl::normestimatorstate* c_ptr() const; -protected: - alglib_impl::normestimatorstate *p_struct; -}; -class normestimatorstate : public _normestimatorstate_owner -{ -public: - normestimatorstate(); - normestimatorstate(const normestimatorstate &rhs); - normestimatorstate& operator=(const normestimatorstate &rhs); - virtual ~normestimatorstate(); - -}; - -/************************************************************************* -Cache-oblivous complex "copy-and-transpose" - -Input parameters: - M - number of rows - N - number of columns - A - source matrix, MxN submatrix is copied and transposed - IA - submatrix offset (row index) - JA - submatrix offset (column index) - B - destination matrix, must be large enough to store result - IB - submatrix offset (row index) - JB - submatrix offset (column index) -*************************************************************************/ -void cmatrixtranspose(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, complex_2d_array &b, const ae_int_t ib, const ae_int_t jb); - - -/************************************************************************* -Cache-oblivous real "copy-and-transpose" - -Input parameters: - M - number of rows - N - number of columns - A - source matrix, MxN submatrix is copied and transposed - IA - submatrix offset (row index) - JA - submatrix offset (column index) - B - destination matrix, must be large enough to store result - IB - submatrix offset (row index) - JB - submatrix offset (column index) -*************************************************************************/ -void rmatrixtranspose(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, real_2d_array &b, const ae_int_t ib, const ae_int_t jb); - - -/************************************************************************* -This code enforces symmetricy of the matrix by copying Upper part to lower -one (or vice versa). - -INPUT PARAMETERS: - A - matrix - N - number of rows/columns - IsUpper - whether we want to copy upper triangle to lower one (True) - or vice versa (False). -*************************************************************************/ -void rmatrixenforcesymmetricity(const real_2d_array &a, const ae_int_t n, const bool isupper); - - -/************************************************************************* -Copy - -Input parameters: - M - number of rows - N - number of columns - A - source matrix, MxN submatrix is copied and transposed - IA - submatrix offset (row index) - JA - submatrix offset (column index) - B - destination matrix, must be large enough to store result - IB - submatrix offset (row index) - JB - submatrix offset (column index) -*************************************************************************/ -void cmatrixcopy(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, complex_2d_array &b, const ae_int_t ib, const ae_int_t jb); - - -/************************************************************************* -Copy - -Input parameters: - M - number of rows - N - number of columns - A - source matrix, MxN submatrix is copied and transposed - IA - submatrix offset (row index) - JA - submatrix offset (column index) - B - destination matrix, must be large enough to store result - IB - submatrix offset (row index) - JB - submatrix offset (column index) -*************************************************************************/ -void rmatrixcopy(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, real_2d_array &b, const ae_int_t ib, const ae_int_t jb); - - -/************************************************************************* -Rank-1 correction: A := A + u*v' - -INPUT PARAMETERS: - M - number of rows - N - number of columns - A - target matrix, MxN submatrix is updated - IA - submatrix offset (row index) - JA - submatrix offset (column index) - U - vector #1 - IU - subvector offset - V - vector #2 - IV - subvector offset -*************************************************************************/ -void cmatrixrank1(const ae_int_t m, const ae_int_t n, complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, complex_1d_array &u, const ae_int_t iu, complex_1d_array &v, const ae_int_t iv); - - -/************************************************************************* -Rank-1 correction: A := A + u*v' - -INPUT PARAMETERS: - M - number of rows - N - number of columns - A - target matrix, MxN submatrix is updated - IA - submatrix offset (row index) - JA - submatrix offset (column index) - U - vector #1 - IU - subvector offset - V - vector #2 - IV - subvector offset -*************************************************************************/ -void rmatrixrank1(const ae_int_t m, const ae_int_t n, real_2d_array &a, const ae_int_t ia, const ae_int_t ja, real_1d_array &u, const ae_int_t iu, real_1d_array &v, const ae_int_t iv); - - -/************************************************************************* -Matrix-vector product: y := op(A)*x - -INPUT PARAMETERS: - M - number of rows of op(A) - M>=0 - N - number of columns of op(A) - N>=0 - A - target matrix - IA - submatrix offset (row index) - JA - submatrix offset (column index) - OpA - operation type: - * OpA=0 => op(A) = A - * OpA=1 => op(A) = A^T - * OpA=2 => op(A) = A^H - X - input vector - IX - subvector offset - IY - subvector offset - Y - preallocated matrix, must be large enough to store result - -OUTPUT PARAMETERS: - Y - vector which stores result - -if M=0, then subroutine does nothing. -if N=0, Y is filled by zeros. - - - -- ALGLIB routine -- - - 28.01.2010 - Bochkanov Sergey -*************************************************************************/ -void cmatrixmv(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t opa, const complex_1d_array &x, const ae_int_t ix, complex_1d_array &y, const ae_int_t iy); - - -/************************************************************************* -Matrix-vector product: y := op(A)*x - -INPUT PARAMETERS: - M - number of rows of op(A) - N - number of columns of op(A) - A - target matrix - IA - submatrix offset (row index) - JA - submatrix offset (column index) - OpA - operation type: - * OpA=0 => op(A) = A - * OpA=1 => op(A) = A^T - X - input vector - IX - subvector offset - IY - subvector offset - Y - preallocated matrix, must be large enough to store result - -OUTPUT PARAMETERS: - Y - vector which stores result - -if M=0, then subroutine does nothing. -if N=0, Y is filled by zeros. - - - -- ALGLIB routine -- - - 28.01.2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixmv(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t opa, const real_1d_array &x, const ae_int_t ix, real_1d_array &y, const ae_int_t iy); - - -/************************************************************************* - -*************************************************************************/ -void cmatrixrighttrsm(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const complex_2d_array &x, const ae_int_t i2, const ae_int_t j2); -void smp_cmatrixrighttrsm(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const complex_2d_array &x, const ae_int_t i2, const ae_int_t j2); - - -/************************************************************************* - -*************************************************************************/ -void cmatrixlefttrsm(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const complex_2d_array &x, const ae_int_t i2, const ae_int_t j2); -void smp_cmatrixlefttrsm(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const complex_2d_array &x, const ae_int_t i2, const ae_int_t j2); - - -/************************************************************************* - -*************************************************************************/ -void rmatrixrighttrsm(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const real_2d_array &x, const ae_int_t i2, const ae_int_t j2); -void smp_rmatrixrighttrsm(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const real_2d_array &x, const ae_int_t i2, const ae_int_t j2); - - -/************************************************************************* - -*************************************************************************/ -void rmatrixlefttrsm(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const real_2d_array &x, const ae_int_t i2, const ae_int_t j2); -void smp_rmatrixlefttrsm(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const real_2d_array &x, const ae_int_t i2, const ae_int_t j2); - - -/************************************************************************* - -*************************************************************************/ -void cmatrixsyrk(const ae_int_t n, const ae_int_t k, const double alpha, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const double beta, const complex_2d_array &c, const ae_int_t ic, const ae_int_t jc, const bool isupper); -void smp_cmatrixsyrk(const ae_int_t n, const ae_int_t k, const double alpha, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const double beta, const complex_2d_array &c, const ae_int_t ic, const ae_int_t jc, const bool isupper); - - -/************************************************************************* - -*************************************************************************/ -void rmatrixsyrk(const ae_int_t n, const ae_int_t k, const double alpha, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const double beta, const real_2d_array &c, const ae_int_t ic, const ae_int_t jc, const bool isupper); -void smp_rmatrixsyrk(const ae_int_t n, const ae_int_t k, const double alpha, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const double beta, const real_2d_array &c, const ae_int_t ic, const ae_int_t jc, const bool isupper); - - -/************************************************************************* - -*************************************************************************/ -void cmatrixgemm(const ae_int_t m, const ae_int_t n, const ae_int_t k, const alglib::complex alpha, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const complex_2d_array &b, const ae_int_t ib, const ae_int_t jb, const ae_int_t optypeb, const alglib::complex beta, const complex_2d_array &c, const ae_int_t ic, const ae_int_t jc); -void smp_cmatrixgemm(const ae_int_t m, const ae_int_t n, const ae_int_t k, const alglib::complex alpha, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const complex_2d_array &b, const ae_int_t ib, const ae_int_t jb, const ae_int_t optypeb, const alglib::complex beta, const complex_2d_array &c, const ae_int_t ic, const ae_int_t jc); - - -/************************************************************************* - -*************************************************************************/ -void rmatrixgemm(const ae_int_t m, const ae_int_t n, const ae_int_t k, const double alpha, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const real_2d_array &b, const ae_int_t ib, const ae_int_t jb, const ae_int_t optypeb, const double beta, const real_2d_array &c, const ae_int_t ic, const ae_int_t jc); -void smp_rmatrixgemm(const ae_int_t m, const ae_int_t n, const ae_int_t k, const double alpha, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const real_2d_array &b, const ae_int_t ib, const ae_int_t jb, const ae_int_t optypeb, const double beta, const real_2d_array &c, const ae_int_t ic, const ae_int_t jc); - -/************************************************************************* -QR decomposition of a rectangular matrix of size MxN - -Input parameters: - A - matrix A whose indexes range within [0..M-1, 0..N-1]. - M - number of rows in matrix A. - N - number of columns in matrix A. - -Output parameters: - A - matrices Q and R in compact form (see below). - Tau - array of scalar factors which are used to form - matrix Q. Array whose index ranges within [0.. Min(M-1,N-1)]. - -Matrix A is represented as A = QR, where Q is an orthogonal matrix of size -MxM, R - upper triangular (or upper trapezoid) matrix of size M x N. - -The elements of matrix R are located on and above the main diagonal of -matrix A. The elements which are located in Tau array and below the main -diagonal of matrix A are used to form matrix Q as follows: - -Matrix Q is represented as a product of elementary reflections - -Q = H(0)*H(2)*...*H(k-1), - -where k = min(m,n), and each H(i) is in the form - -H(i) = 1 - tau * v * (v^T) - -where tau is a scalar stored in Tau[I]; v - real vector, -so that v(0:i-1) = 0, v(i) = 1, v(i+1:m-1) stored in A(i+1:m-1,i). - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixqr(real_2d_array &a, const ae_int_t m, const ae_int_t n, real_1d_array &tau); - - -/************************************************************************* -LQ decomposition of a rectangular matrix of size MxN - -Input parameters: - A - matrix A whose indexes range within [0..M-1, 0..N-1]. - M - number of rows in matrix A. - N - number of columns in matrix A. - -Output parameters: - A - matrices L and Q in compact form (see below) - Tau - array of scalar factors which are used to form - matrix Q. Array whose index ranges within [0..Min(M,N)-1]. - -Matrix A is represented as A = LQ, where Q is an orthogonal matrix of size -MxM, L - lower triangular (or lower trapezoid) matrix of size M x N. - -The elements of matrix L are located on and below the main diagonal of -matrix A. The elements which are located in Tau array and above the main -diagonal of matrix A are used to form matrix Q as follows: - -Matrix Q is represented as a product of elementary reflections - -Q = H(k-1)*H(k-2)*...*H(1)*H(0), - -where k = min(m,n), and each H(i) is of the form - -H(i) = 1 - tau * v * (v^T) - -where tau is a scalar stored in Tau[I]; v - real vector, so that v(0:i-1)=0, -v(i) = 1, v(i+1:n-1) stored in A(i,i+1:n-1). - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixlq(real_2d_array &a, const ae_int_t m, const ae_int_t n, real_1d_array &tau); - - -/************************************************************************* -QR decomposition of a rectangular complex matrix of size MxN - -Input parameters: - A - matrix A whose indexes range within [0..M-1, 0..N-1] - M - number of rows in matrix A. - N - number of columns in matrix A. - -Output parameters: - A - matrices Q and R in compact form - Tau - array of scalar factors which are used to form matrix Q. Array - whose indexes range within [0.. Min(M,N)-1] - -Matrix A is represented as A = QR, where Q is an orthogonal matrix of size -MxM, R - upper triangular (or upper trapezoid) matrix of size MxN. - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - September 30, 1994 -*************************************************************************/ -void cmatrixqr(complex_2d_array &a, const ae_int_t m, const ae_int_t n, complex_1d_array &tau); - - -/************************************************************************* -LQ decomposition of a rectangular complex matrix of size MxN - -Input parameters: - A - matrix A whose indexes range within [0..M-1, 0..N-1] - M - number of rows in matrix A. - N - number of columns in matrix A. - -Output parameters: - A - matrices Q and L in compact form - Tau - array of scalar factors which are used to form matrix Q. Array - whose indexes range within [0.. Min(M,N)-1] - -Matrix A is represented as A = LQ, where Q is an orthogonal matrix of size -MxM, L - lower triangular (or lower trapezoid) matrix of size MxN. - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - September 30, 1994 -*************************************************************************/ -void cmatrixlq(complex_2d_array &a, const ae_int_t m, const ae_int_t n, complex_1d_array &tau); - - -/************************************************************************* -Partial unpacking of matrix Q from the QR decomposition of a matrix A - -Input parameters: - A - matrices Q and R in compact form. - Output of RMatrixQR subroutine. - M - number of rows in given matrix A. M>=0. - N - number of columns in given matrix A. N>=0. - Tau - scalar factors which are used to form Q. - Output of the RMatrixQR subroutine. - QColumns - required number of columns of matrix Q. M>=QColumns>=0. - -Output parameters: - Q - first QColumns columns of matrix Q. - Array whose indexes range within [0..M-1, 0..QColumns-1]. - If QColumns=0, the array remains unchanged. - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixqrunpackq(const real_2d_array &a, const ae_int_t m, const ae_int_t n, const real_1d_array &tau, const ae_int_t qcolumns, real_2d_array &q); - - -/************************************************************************* -Unpacking of matrix R from the QR decomposition of a matrix A - -Input parameters: - A - matrices Q and R in compact form. - Output of RMatrixQR subroutine. - M - number of rows in given matrix A. M>=0. - N - number of columns in given matrix A. N>=0. - -Output parameters: - R - matrix R, array[0..M-1, 0..N-1]. - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixqrunpackr(const real_2d_array &a, const ae_int_t m, const ae_int_t n, real_2d_array &r); - - -/************************************************************************* -Partial unpacking of matrix Q from the LQ decomposition of a matrix A - -Input parameters: - A - matrices L and Q in compact form. - Output of RMatrixLQ subroutine. - M - number of rows in given matrix A. M>=0. - N - number of columns in given matrix A. N>=0. - Tau - scalar factors which are used to form Q. - Output of the RMatrixLQ subroutine. - QRows - required number of rows in matrix Q. N>=QRows>=0. - -Output parameters: - Q - first QRows rows of matrix Q. Array whose indexes range - within [0..QRows-1, 0..N-1]. If QRows=0, the array remains - unchanged. - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixlqunpackq(const real_2d_array &a, const ae_int_t m, const ae_int_t n, const real_1d_array &tau, const ae_int_t qrows, real_2d_array &q); - - -/************************************************************************* -Unpacking of matrix L from the LQ decomposition of a matrix A - -Input parameters: - A - matrices Q and L in compact form. - Output of RMatrixLQ subroutine. - M - number of rows in given matrix A. M>=0. - N - number of columns in given matrix A. N>=0. - -Output parameters: - L - matrix L, array[0..M-1, 0..N-1]. - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixlqunpackl(const real_2d_array &a, const ae_int_t m, const ae_int_t n, real_2d_array &l); - - -/************************************************************************* -Partial unpacking of matrix Q from QR decomposition of a complex matrix A. - -Input parameters: - A - matrices Q and R in compact form. - Output of CMatrixQR subroutine . - M - number of rows in matrix A. M>=0. - N - number of columns in matrix A. N>=0. - Tau - scalar factors which are used to form Q. - Output of CMatrixQR subroutine . - QColumns - required number of columns in matrix Q. M>=QColumns>=0. - -Output parameters: - Q - first QColumns columns of matrix Q. - Array whose index ranges within [0..M-1, 0..QColumns-1]. - If QColumns=0, array isn't changed. - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -void cmatrixqrunpackq(const complex_2d_array &a, const ae_int_t m, const ae_int_t n, const complex_1d_array &tau, const ae_int_t qcolumns, complex_2d_array &q); - - -/************************************************************************* -Unpacking of matrix R from the QR decomposition of a matrix A - -Input parameters: - A - matrices Q and R in compact form. - Output of CMatrixQR subroutine. - M - number of rows in given matrix A. M>=0. - N - number of columns in given matrix A. N>=0. - -Output parameters: - R - matrix R, array[0..M-1, 0..N-1]. - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -void cmatrixqrunpackr(const complex_2d_array &a, const ae_int_t m, const ae_int_t n, complex_2d_array &r); - - -/************************************************************************* -Partial unpacking of matrix Q from LQ decomposition of a complex matrix A. - -Input parameters: - A - matrices Q and R in compact form. - Output of CMatrixLQ subroutine . - M - number of rows in matrix A. M>=0. - N - number of columns in matrix A. N>=0. - Tau - scalar factors which are used to form Q. - Output of CMatrixLQ subroutine . - QRows - required number of rows in matrix Q. N>=QColumns>=0. - -Output parameters: - Q - first QRows rows of matrix Q. - Array whose index ranges within [0..QRows-1, 0..N-1]. - If QRows=0, array isn't changed. - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -void cmatrixlqunpackq(const complex_2d_array &a, const ae_int_t m, const ae_int_t n, const complex_1d_array &tau, const ae_int_t qrows, complex_2d_array &q); - - -/************************************************************************* -Unpacking of matrix L from the LQ decomposition of a matrix A - -Input parameters: - A - matrices Q and L in compact form. - Output of CMatrixLQ subroutine. - M - number of rows in given matrix A. M>=0. - N - number of columns in given matrix A. N>=0. - -Output parameters: - L - matrix L, array[0..M-1, 0..N-1]. - - -- ALGLIB routine -- - 17.02.2010 - Bochkanov Sergey -*************************************************************************/ -void cmatrixlqunpackl(const complex_2d_array &a, const ae_int_t m, const ae_int_t n, complex_2d_array &l); - - -/************************************************************************* -Reduction of a rectangular matrix to bidiagonal form - -The algorithm reduces the rectangular matrix A to bidiagonal form by -orthogonal transformations P and Q: A = Q*B*P. - -Input parameters: - A - source matrix. array[0..M-1, 0..N-1] - M - number of rows in matrix A. - N - number of columns in matrix A. - -Output parameters: - A - matrices Q, B, P in compact form (see below). - TauQ - scalar factors which are used to form matrix Q. - TauP - scalar factors which are used to form matrix P. - -The main diagonal and one of the secondary diagonals of matrix A are -replaced with bidiagonal matrix B. Other elements contain elementary -reflections which form MxM matrix Q and NxN matrix P, respectively. - -If M>=N, B is the upper bidiagonal MxN matrix and is stored in the -corresponding elements of matrix A. Matrix Q is represented as a -product of elementary reflections Q = H(0)*H(1)*...*H(n-1), where -H(i) = 1-tau*v*v'. Here tau is a scalar which is stored in TauQ[i], and -vector v has the following structure: v(0:i-1)=0, v(i)=1, v(i+1:m-1) is -stored in elements A(i+1:m-1,i). Matrix P is as follows: P = -G(0)*G(1)*...*G(n-2), where G(i) = 1 - tau*u*u'. Tau is stored in TauP[i], -u(0:i)=0, u(i+1)=1, u(i+2:n-1) is stored in elements A(i,i+2:n-1). - -If M n): m=5, n=6 (m < n): - -( d e u1 u1 u1 ) ( d u1 u1 u1 u1 u1 ) -( v1 d e u2 u2 ) ( e d u2 u2 u2 u2 ) -( v1 v2 d e u3 ) ( v1 e d u3 u3 u3 ) -( v1 v2 v3 d e ) ( v1 v2 e d u4 u4 ) -( v1 v2 v3 v4 d ) ( v1 v2 v3 e d u5 ) -( v1 v2 v3 v4 v5 ) - -Here vi and ui are vectors which form H(i) and G(i), and d and e - -are the diagonal and off-diagonal elements of matrix B. - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - September 30, 1994. - Sergey Bochkanov, ALGLIB project, translation from FORTRAN to - pseudocode, 2007-2010. -*************************************************************************/ -void rmatrixbd(real_2d_array &a, const ae_int_t m, const ae_int_t n, real_1d_array &tauq, real_1d_array &taup); - - -/************************************************************************* -Unpacking matrix Q which reduces a matrix to bidiagonal form. - -Input parameters: - QP - matrices Q and P in compact form. - Output of ToBidiagonal subroutine. - M - number of rows in matrix A. - N - number of columns in matrix A. - TAUQ - scalar factors which are used to form Q. - Output of ToBidiagonal subroutine. - QColumns - required number of columns in matrix Q. - M>=QColumns>=0. - -Output parameters: - Q - first QColumns columns of matrix Q. - Array[0..M-1, 0..QColumns-1] - If QColumns=0, the array is not modified. - - -- ALGLIB -- - 2005-2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixbdunpackq(const real_2d_array &qp, const ae_int_t m, const ae_int_t n, const real_1d_array &tauq, const ae_int_t qcolumns, real_2d_array &q); - - -/************************************************************************* -Multiplication by matrix Q which reduces matrix A to bidiagonal form. - -The algorithm allows pre- or post-multiply by Q or Q'. - -Input parameters: - QP - matrices Q and P in compact form. - Output of ToBidiagonal subroutine. - M - number of rows in matrix A. - N - number of columns in matrix A. - TAUQ - scalar factors which are used to form Q. - Output of ToBidiagonal subroutine. - Z - multiplied matrix. - array[0..ZRows-1,0..ZColumns-1] - ZRows - number of rows in matrix Z. If FromTheRight=False, - ZRows=M, otherwise ZRows can be arbitrary. - ZColumns - number of columns in matrix Z. If FromTheRight=True, - ZColumns=M, otherwise ZColumns can be arbitrary. - FromTheRight - pre- or post-multiply. - DoTranspose - multiply by Q or Q'. - -Output parameters: - Z - product of Z and Q. - Array[0..ZRows-1,0..ZColumns-1] - If ZRows=0 or ZColumns=0, the array is not modified. - - -- ALGLIB -- - 2005-2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixbdmultiplybyq(const real_2d_array &qp, const ae_int_t m, const ae_int_t n, const real_1d_array &tauq, real_2d_array &z, const ae_int_t zrows, const ae_int_t zcolumns, const bool fromtheright, const bool dotranspose); - - -/************************************************************************* -Unpacking matrix P which reduces matrix A to bidiagonal form. -The subroutine returns transposed matrix P. - -Input parameters: - QP - matrices Q and P in compact form. - Output of ToBidiagonal subroutine. - M - number of rows in matrix A. - N - number of columns in matrix A. - TAUP - scalar factors which are used to form P. - Output of ToBidiagonal subroutine. - PTRows - required number of rows of matrix P^T. N >= PTRows >= 0. - -Output parameters: - PT - first PTRows columns of matrix P^T - Array[0..PTRows-1, 0..N-1] - If PTRows=0, the array is not modified. - - -- ALGLIB -- - 2005-2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixbdunpackpt(const real_2d_array &qp, const ae_int_t m, const ae_int_t n, const real_1d_array &taup, const ae_int_t ptrows, real_2d_array &pt); - - -/************************************************************************* -Multiplication by matrix P which reduces matrix A to bidiagonal form. - -The algorithm allows pre- or post-multiply by P or P'. - -Input parameters: - QP - matrices Q and P in compact form. - Output of RMatrixBD subroutine. - M - number of rows in matrix A. - N - number of columns in matrix A. - TAUP - scalar factors which are used to form P. - Output of RMatrixBD subroutine. - Z - multiplied matrix. - Array whose indexes range within [0..ZRows-1,0..ZColumns-1]. - ZRows - number of rows in matrix Z. If FromTheRight=False, - ZRows=N, otherwise ZRows can be arbitrary. - ZColumns - number of columns in matrix Z. If FromTheRight=True, - ZColumns=N, otherwise ZColumns can be arbitrary. - FromTheRight - pre- or post-multiply. - DoTranspose - multiply by P or P'. - -Output parameters: - Z - product of Z and P. - Array whose indexes range within [0..ZRows-1,0..ZColumns-1]. - If ZRows=0 or ZColumns=0, the array is not modified. - - -- ALGLIB -- - 2005-2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixbdmultiplybyp(const real_2d_array &qp, const ae_int_t m, const ae_int_t n, const real_1d_array &taup, real_2d_array &z, const ae_int_t zrows, const ae_int_t zcolumns, const bool fromtheright, const bool dotranspose); - - -/************************************************************************* -Unpacking of the main and secondary diagonals of bidiagonal decomposition -of matrix A. - -Input parameters: - B - output of RMatrixBD subroutine. - M - number of rows in matrix B. - N - number of columns in matrix B. - -Output parameters: - IsUpper - True, if the matrix is upper bidiagonal. - otherwise IsUpper is False. - D - the main diagonal. - Array whose index ranges within [0..Min(M,N)-1]. - E - the secondary diagonal (upper or lower, depending on - the value of IsUpper). - Array index ranges within [0..Min(M,N)-1], the last - element is not used. - - -- ALGLIB -- - 2005-2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixbdunpackdiagonals(const real_2d_array &b, const ae_int_t m, const ae_int_t n, bool &isupper, real_1d_array &d, real_1d_array &e); - - -/************************************************************************* -Reduction of a square matrix to upper Hessenberg form: Q'*A*Q = H, -where Q is an orthogonal matrix, H - Hessenberg matrix. - -Input parameters: - A - matrix A with elements [0..N-1, 0..N-1] - N - size of matrix A. - -Output parameters: - A - matrices Q and P in compact form (see below). - Tau - array of scalar factors which are used to form matrix Q. - Array whose index ranges within [0..N-2] - -Matrix H is located on the main diagonal, on the lower secondary diagonal -and above the main diagonal of matrix A. The elements which are used to -form matrix Q are situated in array Tau and below the lower secondary -diagonal of matrix A as follows: - -Matrix Q is represented as a product of elementary reflections - -Q = H(0)*H(2)*...*H(n-2), - -where each H(i) is given by - -H(i) = 1 - tau * v * (v^T) - -where tau is a scalar stored in Tau[I]; v - is a real vector, -so that v(0:i) = 0, v(i+1) = 1, v(i+2:n-1) stored in A(i+2:n-1,i). - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - October 31, 1992 -*************************************************************************/ -void rmatrixhessenberg(real_2d_array &a, const ae_int_t n, real_1d_array &tau); - - -/************************************************************************* -Unpacking matrix Q which reduces matrix A to upper Hessenberg form - -Input parameters: - A - output of RMatrixHessenberg subroutine. - N - size of matrix A. - Tau - scalar factors which are used to form Q. - Output of RMatrixHessenberg subroutine. - -Output parameters: - Q - matrix Q. - Array whose indexes range within [0..N-1, 0..N-1]. - - -- ALGLIB -- - 2005-2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixhessenbergunpackq(const real_2d_array &a, const ae_int_t n, const real_1d_array &tau, real_2d_array &q); - - -/************************************************************************* -Unpacking matrix H (the result of matrix A reduction to upper Hessenberg form) - -Input parameters: - A - output of RMatrixHessenberg subroutine. - N - size of matrix A. - -Output parameters: - H - matrix H. Array whose indexes range within [0..N-1, 0..N-1]. - - -- ALGLIB -- - 2005-2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixhessenbergunpackh(const real_2d_array &a, const ae_int_t n, real_2d_array &h); - - -/************************************************************************* -Reduction of a symmetric matrix which is given by its higher or lower -triangular part to a tridiagonal matrix using orthogonal similarity -transformation: Q'*A*Q=T. - -Input parameters: - A - matrix to be transformed - array with elements [0..N-1, 0..N-1]. - N - size of matrix A. - IsUpper - storage format. If IsUpper = True, then matrix A is given - by its upper triangle, and the lower triangle is not used - and not modified by the algorithm, and vice versa - if IsUpper = False. - -Output parameters: - A - matrices T and Q in compact form (see lower) - Tau - array of factors which are forming matrices H(i) - array with elements [0..N-2]. - D - main diagonal of symmetric matrix T. - array with elements [0..N-1]. - E - secondary diagonal of symmetric matrix T. - array with elements [0..N-2]. - - - If IsUpper=True, the matrix Q is represented as a product of elementary - reflectors - - Q = H(n-2) . . . H(2) H(0). - - Each H(i) has the form - - H(i) = I - tau * v * v' - - where tau is a real scalar, and v is a real vector with - v(i+1:n-1) = 0, v(i) = 1, v(0:i-1) is stored on exit in - A(0:i-1,i+1), and tau in TAU(i). - - If IsUpper=False, the matrix Q is represented as a product of elementary - reflectors - - Q = H(0) H(2) . . . H(n-2). - - Each H(i) has the form - - H(i) = I - tau * v * v' - - where tau is a real scalar, and v is a real vector with - v(0:i) = 0, v(i+1) = 1, v(i+2:n-1) is stored on exit in A(i+2:n-1,i), - and tau in TAU(i). - - The contents of A on exit are illustrated by the following examples - with n = 5: - - if UPLO = 'U': if UPLO = 'L': - - ( d e v1 v2 v3 ) ( d ) - ( d e v2 v3 ) ( e d ) - ( d e v3 ) ( v0 e d ) - ( d e ) ( v0 v1 e d ) - ( d ) ( v0 v1 v2 e d ) - - where d and e denote diagonal and off-diagonal elements of T, and vi - denotes an element of the vector defining H(i). - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - October 31, 1992 -*************************************************************************/ -void smatrixtd(real_2d_array &a, const ae_int_t n, const bool isupper, real_1d_array &tau, real_1d_array &d, real_1d_array &e); - - -/************************************************************************* -Unpacking matrix Q which reduces symmetric matrix to a tridiagonal -form. - -Input parameters: - A - the result of a SMatrixTD subroutine - N - size of matrix A. - IsUpper - storage format (a parameter of SMatrixTD subroutine) - Tau - the result of a SMatrixTD subroutine - -Output parameters: - Q - transformation matrix. - array with elements [0..N-1, 0..N-1]. - - -- ALGLIB -- - Copyright 2005-2010 by Bochkanov Sergey -*************************************************************************/ -void smatrixtdunpackq(const real_2d_array &a, const ae_int_t n, const bool isupper, const real_1d_array &tau, real_2d_array &q); - - -/************************************************************************* -Reduction of a Hermitian matrix which is given by its higher or lower -triangular part to a real tridiagonal matrix using unitary similarity -transformation: Q'*A*Q = T. - -Input parameters: - A - matrix to be transformed - array with elements [0..N-1, 0..N-1]. - N - size of matrix A. - IsUpper - storage format. If IsUpper = True, then matrix A is given - by its upper triangle, and the lower triangle is not used - and not modified by the algorithm, and vice versa - if IsUpper = False. - -Output parameters: - A - matrices T and Q in compact form (see lower) - Tau - array of factors which are forming matrices H(i) - array with elements [0..N-2]. - D - main diagonal of real symmetric matrix T. - array with elements [0..N-1]. - E - secondary diagonal of real symmetric matrix T. - array with elements [0..N-2]. - - - If IsUpper=True, the matrix Q is represented as a product of elementary - reflectors - - Q = H(n-2) . . . H(2) H(0). - - Each H(i) has the form - - H(i) = I - tau * v * v' - - where tau is a complex scalar, and v is a complex vector with - v(i+1:n-1) = 0, v(i) = 1, v(0:i-1) is stored on exit in - A(0:i-1,i+1), and tau in TAU(i). - - If IsUpper=False, the matrix Q is represented as a product of elementary - reflectors - - Q = H(0) H(2) . . . H(n-2). - - Each H(i) has the form - - H(i) = I - tau * v * v' - - where tau is a complex scalar, and v is a complex vector with - v(0:i) = 0, v(i+1) = 1, v(i+2:n-1) is stored on exit in A(i+2:n-1,i), - and tau in TAU(i). - - The contents of A on exit are illustrated by the following examples - with n = 5: - - if UPLO = 'U': if UPLO = 'L': - - ( d e v1 v2 v3 ) ( d ) - ( d e v2 v3 ) ( e d ) - ( d e v3 ) ( v0 e d ) - ( d e ) ( v0 v1 e d ) - ( d ) ( v0 v1 v2 e d ) - -where d and e denote diagonal and off-diagonal elements of T, and vi -denotes an element of the vector defining H(i). - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - October 31, 1992 -*************************************************************************/ -void hmatrixtd(complex_2d_array &a, const ae_int_t n, const bool isupper, complex_1d_array &tau, real_1d_array &d, real_1d_array &e); - - -/************************************************************************* -Unpacking matrix Q which reduces a Hermitian matrix to a real tridiagonal -form. - -Input parameters: - A - the result of a HMatrixTD subroutine - N - size of matrix A. - IsUpper - storage format (a parameter of HMatrixTD subroutine) - Tau - the result of a HMatrixTD subroutine - -Output parameters: - Q - transformation matrix. - array with elements [0..N-1, 0..N-1]. - - -- ALGLIB -- - Copyright 2005-2010 by Bochkanov Sergey -*************************************************************************/ -void hmatrixtdunpackq(const complex_2d_array &a, const ae_int_t n, const bool isupper, const complex_1d_array &tau, complex_2d_array &q); - -/************************************************************************* -Singular value decomposition of a bidiagonal matrix (extended algorithm) - -The algorithm performs the singular value decomposition of a bidiagonal -matrix B (upper or lower) representing it as B = Q*S*P^T, where Q and P - -orthogonal matrices, S - diagonal matrix with non-negative elements on the -main diagonal, in descending order. - -The algorithm finds singular values. In addition, the algorithm can -calculate matrices Q and P (more precisely, not the matrices, but their -product with given matrices U and VT - U*Q and (P^T)*VT)). Of course, -matrices U and VT can be of any type, including identity. Furthermore, the -algorithm can calculate Q'*C (this product is calculated more effectively -than U*Q, because this calculation operates with rows instead of matrix -columns). - -The feature of the algorithm is its ability to find all singular values -including those which are arbitrarily close to 0 with relative accuracy -close to machine precision. If the parameter IsFractionalAccuracyRequired -is set to True, all singular values will have high relative accuracy close -to machine precision. If the parameter is set to False, only the biggest -singular value will have relative accuracy close to machine precision. -The absolute error of other singular values is equal to the absolute error -of the biggest singular value. - -Input parameters: - D - main diagonal of matrix B. - Array whose index ranges within [0..N-1]. - E - superdiagonal (or subdiagonal) of matrix B. - Array whose index ranges within [0..N-2]. - N - size of matrix B. - IsUpper - True, if the matrix is upper bidiagonal. - IsFractionalAccuracyRequired - - THIS PARAMETER IS IGNORED SINCE ALGLIB 3.5.0 - SINGULAR VALUES ARE ALWAYS SEARCHED WITH HIGH ACCURACY. - U - matrix to be multiplied by Q. - Array whose indexes range within [0..NRU-1, 0..N-1]. - The matrix can be bigger, in that case only the submatrix - [0..NRU-1, 0..N-1] will be multiplied by Q. - NRU - number of rows in matrix U. - C - matrix to be multiplied by Q'. - Array whose indexes range within [0..N-1, 0..NCC-1]. - The matrix can be bigger, in that case only the submatrix - [0..N-1, 0..NCC-1] will be multiplied by Q'. - NCC - number of columns in matrix C. - VT - matrix to be multiplied by P^T. - Array whose indexes range within [0..N-1, 0..NCVT-1]. - The matrix can be bigger, in that case only the submatrix - [0..N-1, 0..NCVT-1] will be multiplied by P^T. - NCVT - number of columns in matrix VT. - -Output parameters: - D - singular values of matrix B in descending order. - U - if NRU>0, contains matrix U*Q. - VT - if NCVT>0, contains matrix (P^T)*VT. - C - if NCC>0, contains matrix Q'*C. - -Result: - True, if the algorithm has converged. - False, if the algorithm hasn't converged (rare case). - -Additional information: - The type of convergence is controlled by the internal parameter TOL. - If the parameter is greater than 0, the singular values will have - relative accuracy TOL. If TOL<0, the singular values will have - absolute accuracy ABS(TOL)*norm(B). - By default, |TOL| falls within the range of 10*Epsilon and 100*Epsilon, - where Epsilon is the machine precision. It is not recommended to use - TOL less than 10*Epsilon since this will considerably slow down the - algorithm and may not lead to error decreasing. -History: - * 31 March, 2007. - changed MAXITR from 6 to 12. - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - October 31, 1999. -*************************************************************************/ -bool rmatrixbdsvd(real_1d_array &d, const real_1d_array &e, const ae_int_t n, const bool isupper, const bool isfractionalaccuracyrequired, real_2d_array &u, const ae_int_t nru, real_2d_array &c, const ae_int_t ncc, real_2d_array &vt, const ae_int_t ncvt); - -/************************************************************************* -Singular value decomposition of a rectangular matrix. - -The algorithm calculates the singular value decomposition of a matrix of -size MxN: A = U * S * V^T - -The algorithm finds the singular values and, optionally, matrices U and V^T. -The algorithm can find both first min(M,N) columns of matrix U and rows of -matrix V^T (singular vectors), and matrices U and V^T wholly (of sizes MxM -and NxN respectively). - -Take into account that the subroutine does not return matrix V but V^T. - -Input parameters: - A - matrix to be decomposed. - Array whose indexes range within [0..M-1, 0..N-1]. - M - number of rows in matrix A. - N - number of columns in matrix A. - UNeeded - 0, 1 or 2. See the description of the parameter U. - VTNeeded - 0, 1 or 2. See the description of the parameter VT. - AdditionalMemory - - If the parameter: - * equals 0, the algorithm doesn’t use additional - memory (lower requirements, lower performance). - * equals 1, the algorithm uses additional - memory of size min(M,N)*min(M,N) of real numbers. - It often speeds up the algorithm. - * equals 2, the algorithm uses additional - memory of size M*min(M,N) of real numbers. - It allows to get a maximum performance. - The recommended value of the parameter is 2. - -Output parameters: - W - contains singular values in descending order. - U - if UNeeded=0, U isn't changed, the left singular vectors - are not calculated. - if Uneeded=1, U contains left singular vectors (first - min(M,N) columns of matrix U). Array whose indexes range - within [0..M-1, 0..Min(M,N)-1]. - if UNeeded=2, U contains matrix U wholly. Array whose - indexes range within [0..M-1, 0..M-1]. - VT - if VTNeeded=0, VT isn’t changed, the right singular vectors - are not calculated. - if VTNeeded=1, VT contains right singular vectors (first - min(M,N) rows of matrix V^T). Array whose indexes range - within [0..min(M,N)-1, 0..N-1]. - if VTNeeded=2, VT contains matrix V^T wholly. Array whose - indexes range within [0..N-1, 0..N-1]. - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -bool rmatrixsvd(const real_2d_array &a, const ae_int_t m, const ae_int_t n, const ae_int_t uneeded, const ae_int_t vtneeded, const ae_int_t additionalmemory, real_1d_array &w, real_2d_array &u, real_2d_array &vt); - -/************************************************************************* -Finding the eigenvalues and eigenvectors of a symmetric matrix - -The algorithm finds eigen pairs of a symmetric matrix by reducing it to -tridiagonal form and using the QL/QR algorithm. - -Input parameters: - A - symmetric matrix which is given by its upper or lower - triangular part. - Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - ZNeeded - flag controlling whether the eigenvectors are needed or not. - If ZNeeded is equal to: - * 0, the eigenvectors are not returned; - * 1, the eigenvectors are returned. - IsUpper - storage format. - -Output parameters: - D - eigenvalues in ascending order. - Array whose index ranges within [0..N-1]. - Z - if ZNeeded is equal to: - * 0, Z hasn’t changed; - * 1, Z contains the eigenvectors. - Array whose indexes range within [0..N-1, 0..N-1]. - The eigenvectors are stored in the matrix columns. - -Result: - True, if the algorithm has converged. - False, if the algorithm hasn't converged (rare case). - - -- ALGLIB -- - Copyright 2005-2008 by Bochkanov Sergey -*************************************************************************/ -bool smatrixevd(const real_2d_array &a, const ae_int_t n, const ae_int_t zneeded, const bool isupper, real_1d_array &d, real_2d_array &z); - - -/************************************************************************* -Subroutine for finding the eigenvalues (and eigenvectors) of a symmetric -matrix in a given half open interval (A, B] by using a bisection and -inverse iteration - -Input parameters: - A - symmetric matrix which is given by its upper or lower - triangular part. Array [0..N-1, 0..N-1]. - N - size of matrix A. - ZNeeded - flag controlling whether the eigenvectors are needed or not. - If ZNeeded is equal to: - * 0, the eigenvectors are not returned; - * 1, the eigenvectors are returned. - IsUpperA - storage format of matrix A. - B1, B2 - half open interval (B1, B2] to search eigenvalues in. - -Output parameters: - M - number of eigenvalues found in a given half-interval (M>=0). - W - array of the eigenvalues found. - Array whose index ranges within [0..M-1]. - Z - if ZNeeded is equal to: - * 0, Z hasn’t changed; - * 1, Z contains eigenvectors. - Array whose indexes range within [0..N-1, 0..M-1]. - The eigenvectors are stored in the matrix columns. - -Result: - True, if successful. M contains the number of eigenvalues in the given - half-interval (could be equal to 0), W contains the eigenvalues, - Z contains the eigenvectors (if needed). - - False, if the bisection method subroutine wasn't able to find the - eigenvalues in the given interval or if the inverse iteration subroutine - wasn't able to find all the corresponding eigenvectors. - In that case, the eigenvalues and eigenvectors are not returned, - M is equal to 0. - - -- ALGLIB -- - Copyright 07.01.2006 by Bochkanov Sergey -*************************************************************************/ -bool smatrixevdr(const real_2d_array &a, const ae_int_t n, const ae_int_t zneeded, const bool isupper, const double b1, const double b2, ae_int_t &m, real_1d_array &w, real_2d_array &z); - - -/************************************************************************* -Subroutine for finding the eigenvalues and eigenvectors of a symmetric -matrix with given indexes by using bisection and inverse iteration methods. - -Input parameters: - A - symmetric matrix which is given by its upper or lower - triangular part. Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - ZNeeded - flag controlling whether the eigenvectors are needed or not. - If ZNeeded is equal to: - * 0, the eigenvectors are not returned; - * 1, the eigenvectors are returned. - IsUpperA - storage format of matrix A. - I1, I2 - index interval for searching (from I1 to I2). - 0 <= I1 <= I2 <= N-1. - -Output parameters: - W - array of the eigenvalues found. - Array whose index ranges within [0..I2-I1]. - Z - if ZNeeded is equal to: - * 0, Z hasn’t changed; - * 1, Z contains eigenvectors. - Array whose indexes range within [0..N-1, 0..I2-I1]. - In that case, the eigenvectors are stored in the matrix columns. - -Result: - True, if successful. W contains the eigenvalues, Z contains the - eigenvectors (if needed). - - False, if the bisection method subroutine wasn't able to find the - eigenvalues in the given interval or if the inverse iteration subroutine - wasn't able to find all the corresponding eigenvectors. - In that case, the eigenvalues and eigenvectors are not returned. - - -- ALGLIB -- - Copyright 07.01.2006 by Bochkanov Sergey -*************************************************************************/ -bool smatrixevdi(const real_2d_array &a, const ae_int_t n, const ae_int_t zneeded, const bool isupper, const ae_int_t i1, const ae_int_t i2, real_1d_array &w, real_2d_array &z); - - -/************************************************************************* -Finding the eigenvalues and eigenvectors of a Hermitian matrix - -The algorithm finds eigen pairs of a Hermitian matrix by reducing it to -real tridiagonal form and using the QL/QR algorithm. - -Input parameters: - A - Hermitian matrix which is given by its upper or lower - triangular part. - Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - IsUpper - storage format. - ZNeeded - flag controlling whether the eigenvectors are needed or - not. If ZNeeded is equal to: - * 0, the eigenvectors are not returned; - * 1, the eigenvectors are returned. - -Output parameters: - D - eigenvalues in ascending order. - Array whose index ranges within [0..N-1]. - Z - if ZNeeded is equal to: - * 0, Z hasn’t changed; - * 1, Z contains the eigenvectors. - Array whose indexes range within [0..N-1, 0..N-1]. - The eigenvectors are stored in the matrix columns. - -Result: - True, if the algorithm has converged. - False, if the algorithm hasn't converged (rare case). - -Note: - eigenvectors of Hermitian matrix are defined up to multiplication by - a complex number L, such that |L|=1. - - -- ALGLIB -- - Copyright 2005, 23 March 2007 by Bochkanov Sergey -*************************************************************************/ -bool hmatrixevd(const complex_2d_array &a, const ae_int_t n, const ae_int_t zneeded, const bool isupper, real_1d_array &d, complex_2d_array &z); - - -/************************************************************************* -Subroutine for finding the eigenvalues (and eigenvectors) of a Hermitian -matrix in a given half-interval (A, B] by using a bisection and inverse -iteration - -Input parameters: - A - Hermitian matrix which is given by its upper or lower - triangular part. Array whose indexes range within - [0..N-1, 0..N-1]. - N - size of matrix A. - ZNeeded - flag controlling whether the eigenvectors are needed or - not. If ZNeeded is equal to: - * 0, the eigenvectors are not returned; - * 1, the eigenvectors are returned. - IsUpperA - storage format of matrix A. - B1, B2 - half-interval (B1, B2] to search eigenvalues in. - -Output parameters: - M - number of eigenvalues found in a given half-interval, M>=0 - W - array of the eigenvalues found. - Array whose index ranges within [0..M-1]. - Z - if ZNeeded is equal to: - * 0, Z hasn’t changed; - * 1, Z contains eigenvectors. - Array whose indexes range within [0..N-1, 0..M-1]. - The eigenvectors are stored in the matrix columns. - -Result: - True, if successful. M contains the number of eigenvalues in the given - half-interval (could be equal to 0), W contains the eigenvalues, - Z contains the eigenvectors (if needed). - - False, if the bisection method subroutine wasn't able to find the - eigenvalues in the given interval or if the inverse iteration - subroutine wasn't able to find all the corresponding eigenvectors. - In that case, the eigenvalues and eigenvectors are not returned, M is - equal to 0. - -Note: - eigen vectors of Hermitian matrix are defined up to multiplication by - a complex number L, such as |L|=1. - - -- ALGLIB -- - Copyright 07.01.2006, 24.03.2007 by Bochkanov Sergey. -*************************************************************************/ -bool hmatrixevdr(const complex_2d_array &a, const ae_int_t n, const ae_int_t zneeded, const bool isupper, const double b1, const double b2, ae_int_t &m, real_1d_array &w, complex_2d_array &z); - - -/************************************************************************* -Subroutine for finding the eigenvalues and eigenvectors of a Hermitian -matrix with given indexes by using bisection and inverse iteration methods - -Input parameters: - A - Hermitian matrix which is given by its upper or lower - triangular part. - Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - ZNeeded - flag controlling whether the eigenvectors are needed or - not. If ZNeeded is equal to: - * 0, the eigenvectors are not returned; - * 1, the eigenvectors are returned. - IsUpperA - storage format of matrix A. - I1, I2 - index interval for searching (from I1 to I2). - 0 <= I1 <= I2 <= N-1. - -Output parameters: - W - array of the eigenvalues found. - Array whose index ranges within [0..I2-I1]. - Z - if ZNeeded is equal to: - * 0, Z hasn’t changed; - * 1, Z contains eigenvectors. - Array whose indexes range within [0..N-1, 0..I2-I1]. - In that case, the eigenvectors are stored in the matrix - columns. - -Result: - True, if successful. W contains the eigenvalues, Z contains the - eigenvectors (if needed). - - False, if the bisection method subroutine wasn't able to find the - eigenvalues in the given interval or if the inverse iteration - subroutine wasn't able to find all the corresponding eigenvectors. - In that case, the eigenvalues and eigenvectors are not returned. - -Note: - eigen vectors of Hermitian matrix are defined up to multiplication by - a complex number L, such as |L|=1. - - -- ALGLIB -- - Copyright 07.01.2006, 24.03.2007 by Bochkanov Sergey. -*************************************************************************/ -bool hmatrixevdi(const complex_2d_array &a, const ae_int_t n, const ae_int_t zneeded, const bool isupper, const ae_int_t i1, const ae_int_t i2, real_1d_array &w, complex_2d_array &z); - - -/************************************************************************* -Finding the eigenvalues and eigenvectors of a tridiagonal symmetric matrix - -The algorithm finds the eigen pairs of a tridiagonal symmetric matrix by -using an QL/QR algorithm with implicit shifts. - -Input parameters: - D - the main diagonal of a tridiagonal matrix. - Array whose index ranges within [0..N-1]. - E - the secondary diagonal of a tridiagonal matrix. - Array whose index ranges within [0..N-2]. - N - size of matrix A. - ZNeeded - flag controlling whether the eigenvectors are needed or not. - If ZNeeded is equal to: - * 0, the eigenvectors are not needed; - * 1, the eigenvectors of a tridiagonal matrix - are multiplied by the square matrix Z. It is used if the - tridiagonal matrix is obtained by the similarity - transformation of a symmetric matrix; - * 2, the eigenvectors of a tridiagonal matrix replace the - square matrix Z; - * 3, matrix Z contains the first row of the eigenvectors - matrix. - Z - if ZNeeded=1, Z contains the square matrix by which the - eigenvectors are multiplied. - Array whose indexes range within [0..N-1, 0..N-1]. - -Output parameters: - D - eigenvalues in ascending order. - Array whose index ranges within [0..N-1]. - Z - if ZNeeded is equal to: - * 0, Z hasn’t changed; - * 1, Z contains the product of a given matrix (from the left) - and the eigenvectors matrix (from the right); - * 2, Z contains the eigenvectors. - * 3, Z contains the first row of the eigenvectors matrix. - If ZNeeded<3, Z is the array whose indexes range within [0..N-1, 0..N-1]. - In that case, the eigenvectors are stored in the matrix columns. - If ZNeeded=3, Z is the array whose indexes range within [0..0, 0..N-1]. - -Result: - True, if the algorithm has converged. - False, if the algorithm hasn't converged. - - -- LAPACK routine (version 3.0) -- - Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., - Courant Institute, Argonne National Lab, and Rice University - September 30, 1994 -*************************************************************************/ -bool smatrixtdevd(real_1d_array &d, const real_1d_array &e, const ae_int_t n, const ae_int_t zneeded, real_2d_array &z); - - -/************************************************************************* -Subroutine for finding the tridiagonal matrix eigenvalues/vectors in a -given half-interval (A, B] by using bisection and inverse iteration. - -Input parameters: - D - the main diagonal of a tridiagonal matrix. - Array whose index ranges within [0..N-1]. - E - the secondary diagonal of a tridiagonal matrix. - Array whose index ranges within [0..N-2]. - N - size of matrix, N>=0. - ZNeeded - flag controlling whether the eigenvectors are needed or not. - If ZNeeded is equal to: - * 0, the eigenvectors are not needed; - * 1, the eigenvectors of a tridiagonal matrix are multiplied - by the square matrix Z. It is used if the tridiagonal - matrix is obtained by the similarity transformation - of a symmetric matrix. - * 2, the eigenvectors of a tridiagonal matrix replace matrix Z. - A, B - half-interval (A, B] to search eigenvalues in. - Z - if ZNeeded is equal to: - * 0, Z isn't used and remains unchanged; - * 1, Z contains the square matrix (array whose indexes range - within [0..N-1, 0..N-1]) which reduces the given symmetric - matrix to tridiagonal form; - * 2, Z isn't used (but changed on the exit). - -Output parameters: - D - array of the eigenvalues found. - Array whose index ranges within [0..M-1]. - M - number of eigenvalues found in the given half-interval (M>=0). - Z - if ZNeeded is equal to: - * 0, doesn't contain any information; - * 1, contains the product of a given NxN matrix Z (from the - left) and NxM matrix of the eigenvectors found (from the - right). Array whose indexes range within [0..N-1, 0..M-1]. - * 2, contains the matrix of the eigenvectors found. - Array whose indexes range within [0..N-1, 0..M-1]. - -Result: - - True, if successful. In that case, M contains the number of eigenvalues - in the given half-interval (could be equal to 0), D contains the eigenvalues, - Z contains the eigenvectors (if needed). - It should be noted that the subroutine changes the size of arrays D and Z. - - False, if the bisection method subroutine wasn't able to find the - eigenvalues in the given interval or if the inverse iteration subroutine - wasn't able to find all the corresponding eigenvectors. In that case, - the eigenvalues and eigenvectors are not returned, M is equal to 0. - - -- ALGLIB -- - Copyright 31.03.2008 by Bochkanov Sergey -*************************************************************************/ -bool smatrixtdevdr(real_1d_array &d, const real_1d_array &e, const ae_int_t n, const ae_int_t zneeded, const double a, const double b, ae_int_t &m, real_2d_array &z); - - -/************************************************************************* -Subroutine for finding tridiagonal matrix eigenvalues/vectors with given -indexes (in ascending order) by using the bisection and inverse iteraion. - -Input parameters: - D - the main diagonal of a tridiagonal matrix. - Array whose index ranges within [0..N-1]. - E - the secondary diagonal of a tridiagonal matrix. - Array whose index ranges within [0..N-2]. - N - size of matrix. N>=0. - ZNeeded - flag controlling whether the eigenvectors are needed or not. - If ZNeeded is equal to: - * 0, the eigenvectors are not needed; - * 1, the eigenvectors of a tridiagonal matrix are multiplied - by the square matrix Z. It is used if the - tridiagonal matrix is obtained by the similarity transformation - of a symmetric matrix. - * 2, the eigenvectors of a tridiagonal matrix replace - matrix Z. - I1, I2 - index interval for searching (from I1 to I2). - 0 <= I1 <= I2 <= N-1. - Z - if ZNeeded is equal to: - * 0, Z isn't used and remains unchanged; - * 1, Z contains the square matrix (array whose indexes range within [0..N-1, 0..N-1]) - which reduces the given symmetric matrix to tridiagonal form; - * 2, Z isn't used (but changed on the exit). - -Output parameters: - D - array of the eigenvalues found. - Array whose index ranges within [0..I2-I1]. - Z - if ZNeeded is equal to: - * 0, doesn't contain any information; - * 1, contains the product of a given NxN matrix Z (from the left) and - Nx(I2-I1) matrix of the eigenvectors found (from the right). - Array whose indexes range within [0..N-1, 0..I2-I1]. - * 2, contains the matrix of the eigenvalues found. - Array whose indexes range within [0..N-1, 0..I2-I1]. - - -Result: - - True, if successful. In that case, D contains the eigenvalues, - Z contains the eigenvectors (if needed). - It should be noted that the subroutine changes the size of arrays D and Z. - - False, if the bisection method subroutine wasn't able to find the eigenvalues - in the given interval or if the inverse iteration subroutine wasn't able - to find all the corresponding eigenvectors. In that case, the eigenvalues - and eigenvectors are not returned. - - -- ALGLIB -- - Copyright 25.12.2005 by Bochkanov Sergey -*************************************************************************/ -bool smatrixtdevdi(real_1d_array &d, const real_1d_array &e, const ae_int_t n, const ae_int_t zneeded, const ae_int_t i1, const ae_int_t i2, real_2d_array &z); - - -/************************************************************************* -Finding eigenvalues and eigenvectors of a general matrix - -The algorithm finds eigenvalues and eigenvectors of a general matrix by -using the QR algorithm with multiple shifts. The algorithm can find -eigenvalues and both left and right eigenvectors. - -The right eigenvector is a vector x such that A*x = w*x, and the left -eigenvector is a vector y such that y'*A = w*y' (here y' implies a complex -conjugate transposition of vector y). - -Input parameters: - A - matrix. Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - VNeeded - flag controlling whether eigenvectors are needed or not. - If VNeeded is equal to: - * 0, eigenvectors are not returned; - * 1, right eigenvectors are returned; - * 2, left eigenvectors are returned; - * 3, both left and right eigenvectors are returned. - -Output parameters: - WR - real parts of eigenvalues. - Array whose index ranges within [0..N-1]. - WR - imaginary parts of eigenvalues. - Array whose index ranges within [0..N-1]. - VL, VR - arrays of left and right eigenvectors (if they are needed). - If WI[i]=0, the respective eigenvalue is a real number, - and it corresponds to the column number I of matrices VL/VR. - If WI[i]>0, we have a pair of complex conjugate numbers with - positive and negative imaginary parts: - the first eigenvalue WR[i] + sqrt(-1)*WI[i]; - the second eigenvalue WR[i+1] + sqrt(-1)*WI[i+1]; - WI[i]>0 - WI[i+1] = -WI[i] < 0 - In that case, the eigenvector corresponding to the first - eigenvalue is located in i and i+1 columns of matrices - VL/VR (the column number i contains the real part, and the - column number i+1 contains the imaginary part), and the vector - corresponding to the second eigenvalue is a complex conjugate to - the first vector. - Arrays whose indexes range within [0..N-1, 0..N-1]. - -Result: - True, if the algorithm has converged. - False, if the algorithm has not converged. - -Note 1: - Some users may ask the following question: what if WI[N-1]>0? - WI[N] must contain an eigenvalue which is complex conjugate to the - N-th eigenvalue, but the array has only size N? - The answer is as follows: such a situation cannot occur because the - algorithm finds a pairs of eigenvalues, therefore, if WI[i]>0, I is - strictly less than N-1. - -Note 2: - The algorithm performance depends on the value of the internal parameter - NS of the InternalSchurDecomposition subroutine which defines the number - of shifts in the QR algorithm (similarly to the block width in block-matrix - algorithms of linear algebra). If you require maximum performance - on your machine, it is recommended to adjust this parameter manually. - - -See also the InternalTREVC subroutine. - -The algorithm is based on the LAPACK 3.0 library. -*************************************************************************/ -bool rmatrixevd(const real_2d_array &a, const ae_int_t n, const ae_int_t vneeded, real_1d_array &wr, real_1d_array &wi, real_2d_array &vl, real_2d_array &vr); - -/************************************************************************* -Generation of a random uniformly distributed (Haar) orthogonal matrix - -INPUT PARAMETERS: - N - matrix size, N>=1 - -OUTPUT PARAMETERS: - A - orthogonal NxN matrix, array[0..N-1,0..N-1] - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void rmatrixrndorthogonal(const ae_int_t n, real_2d_array &a); - - -/************************************************************************* -Generation of random NxN matrix with given condition number and norm2(A)=1 - -INPUT PARAMETERS: - N - matrix size - C - condition number (in 2-norm) - -OUTPUT PARAMETERS: - A - random matrix with norm2(A)=1 and cond(A)=C - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void rmatrixrndcond(const ae_int_t n, const double c, real_2d_array &a); - - -/************************************************************************* -Generation of a random Haar distributed orthogonal complex matrix - -INPUT PARAMETERS: - N - matrix size, N>=1 - -OUTPUT PARAMETERS: - A - orthogonal NxN matrix, array[0..N-1,0..N-1] - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void cmatrixrndorthogonal(const ae_int_t n, complex_2d_array &a); - - -/************************************************************************* -Generation of random NxN complex matrix with given condition number C and -norm2(A)=1 - -INPUT PARAMETERS: - N - matrix size - C - condition number (in 2-norm) - -OUTPUT PARAMETERS: - A - random matrix with norm2(A)=1 and cond(A)=C - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void cmatrixrndcond(const ae_int_t n, const double c, complex_2d_array &a); - - -/************************************************************************* -Generation of random NxN symmetric matrix with given condition number and -norm2(A)=1 - -INPUT PARAMETERS: - N - matrix size - C - condition number (in 2-norm) - -OUTPUT PARAMETERS: - A - random matrix with norm2(A)=1 and cond(A)=C - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void smatrixrndcond(const ae_int_t n, const double c, real_2d_array &a); - - -/************************************************************************* -Generation of random NxN symmetric positive definite matrix with given -condition number and norm2(A)=1 - -INPUT PARAMETERS: - N - matrix size - C - condition number (in 2-norm) - -OUTPUT PARAMETERS: - A - random SPD matrix with norm2(A)=1 and cond(A)=C - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void spdmatrixrndcond(const ae_int_t n, const double c, real_2d_array &a); - - -/************************************************************************* -Generation of random NxN Hermitian matrix with given condition number and -norm2(A)=1 - -INPUT PARAMETERS: - N - matrix size - C - condition number (in 2-norm) - -OUTPUT PARAMETERS: - A - random matrix with norm2(A)=1 and cond(A)=C - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void hmatrixrndcond(const ae_int_t n, const double c, complex_2d_array &a); - - -/************************************************************************* -Generation of random NxN Hermitian positive definite matrix with given -condition number and norm2(A)=1 - -INPUT PARAMETERS: - N - matrix size - C - condition number (in 2-norm) - -OUTPUT PARAMETERS: - A - random HPD matrix with norm2(A)=1 and cond(A)=C - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void hpdmatrixrndcond(const ae_int_t n, const double c, complex_2d_array &a); - - -/************************************************************************* -Multiplication of MxN matrix by NxN random Haar distributed orthogonal matrix - -INPUT PARAMETERS: - A - matrix, array[0..M-1, 0..N-1] - M, N- matrix size - -OUTPUT PARAMETERS: - A - A*Q, where Q is random NxN orthogonal matrix - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void rmatrixrndorthogonalfromtheright(real_2d_array &a, const ae_int_t m, const ae_int_t n); - - -/************************************************************************* -Multiplication of MxN matrix by MxM random Haar distributed orthogonal matrix - -INPUT PARAMETERS: - A - matrix, array[0..M-1, 0..N-1] - M, N- matrix size - -OUTPUT PARAMETERS: - A - Q*A, where Q is random MxM orthogonal matrix - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void rmatrixrndorthogonalfromtheleft(real_2d_array &a, const ae_int_t m, const ae_int_t n); - - -/************************************************************************* -Multiplication of MxN complex matrix by NxN random Haar distributed -complex orthogonal matrix - -INPUT PARAMETERS: - A - matrix, array[0..M-1, 0..N-1] - M, N- matrix size - -OUTPUT PARAMETERS: - A - A*Q, where Q is random NxN orthogonal matrix - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void cmatrixrndorthogonalfromtheright(complex_2d_array &a, const ae_int_t m, const ae_int_t n); - - -/************************************************************************* -Multiplication of MxN complex matrix by MxM random Haar distributed -complex orthogonal matrix - -INPUT PARAMETERS: - A - matrix, array[0..M-1, 0..N-1] - M, N- matrix size - -OUTPUT PARAMETERS: - A - Q*A, where Q is random MxM orthogonal matrix - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void cmatrixrndorthogonalfromtheleft(complex_2d_array &a, const ae_int_t m, const ae_int_t n); - - -/************************************************************************* -Symmetric multiplication of NxN matrix by random Haar distributed -orthogonal matrix - -INPUT PARAMETERS: - A - matrix, array[0..N-1, 0..N-1] - N - matrix size - -OUTPUT PARAMETERS: - A - Q'*A*Q, where Q is random NxN orthogonal matrix - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void smatrixrndmultiply(real_2d_array &a, const ae_int_t n); - - -/************************************************************************* -Hermitian multiplication of NxN matrix by random Haar distributed -complex orthogonal matrix - -INPUT PARAMETERS: - A - matrix, array[0..N-1, 0..N-1] - N - matrix size - -OUTPUT PARAMETERS: - A - Q^H*A*Q, where Q is random NxN orthogonal matrix - - -- ALGLIB routine -- - 04.12.2009 - Bochkanov Sergey -*************************************************************************/ -void hmatrixrndmultiply(complex_2d_array &a, const ae_int_t n); - -/************************************************************************* -LU decomposition of a general real matrix with row pivoting - -A is represented as A = P*L*U, where: -* L is lower unitriangular matrix -* U is upper triangular matrix -* P = P0*P1*...*PK, K=min(M,N)-1, - Pi - permutation matrix for I and Pivots[I] - -This is cache-oblivous implementation of LU decomposition. -It is optimized for square matrices. As for rectangular matrices: -* best case - M>>N -* worst case - N>>M, small M, large N, matrix does not fit in CPU cache - -INPUT PARAMETERS: - A - array[0..M-1, 0..N-1]. - M - number of rows in matrix A. - N - number of columns in matrix A. - - -OUTPUT PARAMETERS: - A - matrices L and U in compact form: - * L is stored under main diagonal - * U is stored on and above main diagonal - Pivots - permutation matrix in compact form. - array[0..Min(M-1,N-1)]. - - -- ALGLIB routine -- - 10.01.2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixlu(real_2d_array &a, const ae_int_t m, const ae_int_t n, integer_1d_array &pivots); - - -/************************************************************************* -LU decomposition of a general complex matrix with row pivoting - -A is represented as A = P*L*U, where: -* L is lower unitriangular matrix -* U is upper triangular matrix -* P = P0*P1*...*PK, K=min(M,N)-1, - Pi - permutation matrix for I and Pivots[I] - -This is cache-oblivous implementation of LU decomposition. It is optimized -for square matrices. As for rectangular matrices: -* best case - M>>N -* worst case - N>>M, small M, large N, matrix does not fit in CPU cache - -INPUT PARAMETERS: - A - array[0..M-1, 0..N-1]. - M - number of rows in matrix A. - N - number of columns in matrix A. - - -OUTPUT PARAMETERS: - A - matrices L and U in compact form: - * L is stored under main diagonal - * U is stored on and above main diagonal - Pivots - permutation matrix in compact form. - array[0..Min(M-1,N-1)]. - - -- ALGLIB routine -- - 10.01.2010 - Bochkanov Sergey -*************************************************************************/ -void cmatrixlu(complex_2d_array &a, const ae_int_t m, const ae_int_t n, integer_1d_array &pivots); - - -/************************************************************************* -Cache-oblivious Cholesky decomposition - -The algorithm computes Cholesky decomposition of a Hermitian positive- -definite matrix. The result of an algorithm is a representation of A as -A=U'*U or A=L*L' (here X' detones conj(X^T)). - -INPUT PARAMETERS: - A - upper or lower triangle of a factorized matrix. - array with elements [0..N-1, 0..N-1]. - N - size of matrix A. - IsUpper - if IsUpper=True, then A contains an upper triangle of - a symmetric matrix, otherwise A contains a lower one. - -OUTPUT PARAMETERS: - A - the result of factorization. If IsUpper=True, then - the upper triangle contains matrix U, so that A = U'*U, - and the elements below the main diagonal are not modified. - Similarly, if IsUpper = False. - -RESULT: - If the matrix is positive-definite, the function returns True. - Otherwise, the function returns False. Contents of A is not determined - in such case. - - -- ALGLIB routine -- - 15.12.2009 - Bochkanov Sergey -*************************************************************************/ -bool hpdmatrixcholesky(complex_2d_array &a, const ae_int_t n, const bool isupper); - - -/************************************************************************* -Cache-oblivious Cholesky decomposition - -The algorithm computes Cholesky decomposition of a symmetric positive- -definite matrix. The result of an algorithm is a representation of A as -A=U^T*U or A=L*L^T - -INPUT PARAMETERS: - A - upper or lower triangle of a factorized matrix. - array with elements [0..N-1, 0..N-1]. - N - size of matrix A. - IsUpper - if IsUpper=True, then A contains an upper triangle of - a symmetric matrix, otherwise A contains a lower one. - -OUTPUT PARAMETERS: - A - the result of factorization. If IsUpper=True, then - the upper triangle contains matrix U, so that A = U^T*U, - and the elements below the main diagonal are not modified. - Similarly, if IsUpper = False. - -RESULT: - If the matrix is positive-definite, the function returns True. - Otherwise, the function returns False. Contents of A is not determined - in such case. - - -- ALGLIB routine -- - 15.12.2009 - Bochkanov Sergey -*************************************************************************/ -bool spdmatrixcholesky(real_2d_array &a, const ae_int_t n, const bool isupper); - -/************************************************************************* -Estimate of a matrix condition number (1-norm) - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - A - matrix. Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double rmatrixrcond1(const real_2d_array &a, const ae_int_t n); - - -/************************************************************************* -Estimate of a matrix condition number (infinity-norm). - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - A - matrix. Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double rmatrixrcondinf(const real_2d_array &a, const ae_int_t n); - - -/************************************************************************* -Condition number estimate of a symmetric positive definite matrix. - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -It should be noted that 1-norm and inf-norm of condition numbers of symmetric -matrices are equal, so the algorithm doesn't take into account the -differences between these types of norms. - -Input parameters: - A - symmetric positive definite matrix which is given by its - upper or lower triangle depending on the value of - IsUpper. Array with elements [0..N-1, 0..N-1]. - N - size of matrix A. - IsUpper - storage format. - -Result: - 1/LowerBound(cond(A)), if matrix A is positive definite, - -1, if matrix A is not positive definite, and its condition number - could not be found by this algorithm. - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double spdmatrixrcond(const real_2d_array &a, const ae_int_t n, const bool isupper); - - -/************************************************************************* -Triangular matrix: estimate of a condition number (1-norm) - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - A - matrix. Array[0..N-1, 0..N-1]. - N - size of A. - IsUpper - True, if the matrix is upper triangular. - IsUnit - True, if the matrix has a unit diagonal. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double rmatrixtrrcond1(const real_2d_array &a, const ae_int_t n, const bool isupper, const bool isunit); - - -/************************************************************************* -Triangular matrix: estimate of a matrix condition number (infinity-norm). - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - A - matrix. Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - IsUpper - True, if the matrix is upper triangular. - IsUnit - True, if the matrix has a unit diagonal. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double rmatrixtrrcondinf(const real_2d_array &a, const ae_int_t n, const bool isupper, const bool isunit); - - -/************************************************************************* -Condition number estimate of a Hermitian positive definite matrix. - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -It should be noted that 1-norm and inf-norm of condition numbers of symmetric -matrices are equal, so the algorithm doesn't take into account the -differences between these types of norms. - -Input parameters: - A - Hermitian positive definite matrix which is given by its - upper or lower triangle depending on the value of - IsUpper. Array with elements [0..N-1, 0..N-1]. - N - size of matrix A. - IsUpper - storage format. - -Result: - 1/LowerBound(cond(A)), if matrix A is positive definite, - -1, if matrix A is not positive definite, and its condition number - could not be found by this algorithm. - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double hpdmatrixrcond(const complex_2d_array &a, const ae_int_t n, const bool isupper); - - -/************************************************************************* -Estimate of a matrix condition number (1-norm) - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - A - matrix. Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double cmatrixrcond1(const complex_2d_array &a, const ae_int_t n); - - -/************************************************************************* -Estimate of a matrix condition number (infinity-norm). - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - A - matrix. Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double cmatrixrcondinf(const complex_2d_array &a, const ae_int_t n); - - -/************************************************************************* -Estimate of the condition number of a matrix given by its LU decomposition (1-norm) - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - LUA - LU decomposition of a matrix in compact form. Output of - the RMatrixLU subroutine. - N - size of matrix A. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double rmatrixlurcond1(const real_2d_array &lua, const ae_int_t n); - - -/************************************************************************* -Estimate of the condition number of a matrix given by its LU decomposition -(infinity norm). - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - LUA - LU decomposition of a matrix in compact form. Output of - the RMatrixLU subroutine. - N - size of matrix A. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double rmatrixlurcondinf(const real_2d_array &lua, const ae_int_t n); - - -/************************************************************************* -Condition number estimate of a symmetric positive definite matrix given by -Cholesky decomposition. - -The algorithm calculates a lower bound of the condition number. In this -case, the algorithm does not return a lower bound of the condition number, -but an inverse number (to avoid an overflow in case of a singular matrix). - -It should be noted that 1-norm and inf-norm condition numbers of symmetric -matrices are equal, so the algorithm doesn't take into account the -differences between these types of norms. - -Input parameters: - CD - Cholesky decomposition of matrix A, - output of SMatrixCholesky subroutine. - N - size of matrix A. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double spdmatrixcholeskyrcond(const real_2d_array &a, const ae_int_t n, const bool isupper); - - -/************************************************************************* -Condition number estimate of a Hermitian positive definite matrix given by -Cholesky decomposition. - -The algorithm calculates a lower bound of the condition number. In this -case, the algorithm does not return a lower bound of the condition number, -but an inverse number (to avoid an overflow in case of a singular matrix). - -It should be noted that 1-norm and inf-norm condition numbers of symmetric -matrices are equal, so the algorithm doesn't take into account the -differences between these types of norms. - -Input parameters: - CD - Cholesky decomposition of matrix A, - output of SMatrixCholesky subroutine. - N - size of matrix A. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double hpdmatrixcholeskyrcond(const complex_2d_array &a, const ae_int_t n, const bool isupper); - - -/************************************************************************* -Estimate of the condition number of a matrix given by its LU decomposition (1-norm) - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - LUA - LU decomposition of a matrix in compact form. Output of - the CMatrixLU subroutine. - N - size of matrix A. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double cmatrixlurcond1(const complex_2d_array &lua, const ae_int_t n); - - -/************************************************************************* -Estimate of the condition number of a matrix given by its LU decomposition -(infinity norm). - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - LUA - LU decomposition of a matrix in compact form. Output of - the CMatrixLU subroutine. - N - size of matrix A. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double cmatrixlurcondinf(const complex_2d_array &lua, const ae_int_t n); - - -/************************************************************************* -Triangular matrix: estimate of a condition number (1-norm) - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - A - matrix. Array[0..N-1, 0..N-1]. - N - size of A. - IsUpper - True, if the matrix is upper triangular. - IsUnit - True, if the matrix has a unit diagonal. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double cmatrixtrrcond1(const complex_2d_array &a, const ae_int_t n, const bool isupper, const bool isunit); - - -/************************************************************************* -Triangular matrix: estimate of a matrix condition number (infinity-norm). - -The algorithm calculates a lower bound of the condition number. In this case, -the algorithm does not return a lower bound of the condition number, but an -inverse number (to avoid an overflow in case of a singular matrix). - -Input parameters: - A - matrix. Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - IsUpper - True, if the matrix is upper triangular. - IsUnit - True, if the matrix has a unit diagonal. - -Result: 1/LowerBound(cond(A)) - -NOTE: - if k(A) is very large, then matrix is assumed degenerate, k(A)=INF, - 0.0 is returned in such cases. -*************************************************************************/ -double cmatrixtrrcondinf(const complex_2d_array &a, const ae_int_t n, const bool isupper, const bool isunit); - -/************************************************************************* -Inversion of a matrix given by its LU decomposition. - -INPUT PARAMETERS: - A - LU decomposition of the matrix - (output of RMatrixLU subroutine). - Pivots - table of permutations - (the output of RMatrixLU subroutine). - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - -OUTPUT PARAMETERS: - Info - return code: - * -3 A is singular, or VERY close to singular. - it is filled by zeros in such cases. - * 1 task is solved (but matrix A may be ill-conditioned, - check R1/RInf parameters for condition numbers). - Rep - solver report, see below for more info - A - inverse of matrix A. - Array whose indexes range within [0..N-1, 0..N-1]. - -SOLVER REPORT - -Subroutine sets following fields of the Rep structure: -* R1 reciprocal of condition number: 1/cond(A), 1-norm. -* RInf reciprocal of condition number: 1/cond(A), inf-norm. - - -- ALGLIB routine -- - 05.02.2010 - Bochkanov Sergey -*************************************************************************/ -void rmatrixluinverse(real_2d_array &a, const integer_1d_array &pivots, const ae_int_t n, ae_int_t &info, matinvreport &rep); -void rmatrixluinverse(real_2d_array &a, const integer_1d_array &pivots, ae_int_t &info, matinvreport &rep); - - -/************************************************************************* -Inversion of a general matrix. - -Input parameters: - A - matrix. - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - -Output parameters: - Info - return code, same as in RMatrixLUInverse - Rep - solver report, same as in RMatrixLUInverse - A - inverse of matrix A, same as in RMatrixLUInverse - -Result: - True, if the matrix is not singular. - False, if the matrix is singular. - - -- ALGLIB -- - Copyright 2005-2010 by Bochkanov Sergey -*************************************************************************/ -void rmatrixinverse(real_2d_array &a, const ae_int_t n, ae_int_t &info, matinvreport &rep); -void rmatrixinverse(real_2d_array &a, ae_int_t &info, matinvreport &rep); - - -/************************************************************************* -Inversion of a matrix given by its LU decomposition. - -INPUT PARAMETERS: - A - LU decomposition of the matrix - (output of CMatrixLU subroutine). - Pivots - table of permutations - (the output of CMatrixLU subroutine). - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - -OUTPUT PARAMETERS: - Info - return code, same as in RMatrixLUInverse - Rep - solver report, same as in RMatrixLUInverse - A - inverse of matrix A, same as in RMatrixLUInverse - - -- ALGLIB routine -- - 05.02.2010 - Bochkanov Sergey -*************************************************************************/ -void cmatrixluinverse(complex_2d_array &a, const integer_1d_array &pivots, const ae_int_t n, ae_int_t &info, matinvreport &rep); -void cmatrixluinverse(complex_2d_array &a, const integer_1d_array &pivots, ae_int_t &info, matinvreport &rep); - - -/************************************************************************* -Inversion of a general matrix. - -Input parameters: - A - matrix - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - -Output parameters: - Info - return code, same as in RMatrixLUInverse - Rep - solver report, same as in RMatrixLUInverse - A - inverse of matrix A, same as in RMatrixLUInverse - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -void cmatrixinverse(complex_2d_array &a, const ae_int_t n, ae_int_t &info, matinvreport &rep); -void cmatrixinverse(complex_2d_array &a, ae_int_t &info, matinvreport &rep); - - -/************************************************************************* -Inversion of a symmetric positive definite matrix which is given -by Cholesky decomposition. - -Input parameters: - A - Cholesky decomposition of the matrix to be inverted: - A=U’*U or A = L*L'. - Output of SPDMatrixCholesky subroutine. - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - IsUpper - storage type (optional): - * if True, symmetric matrix A is given by its upper - triangle, and the lower triangle isn’t used/changed by - function - * if False, symmetric matrix A is given by its lower - triangle, and the upper triangle isn’t used/changed by - function - * if not given, lower half is used. - -Output parameters: - Info - return code, same as in RMatrixLUInverse - Rep - solver report, same as in RMatrixLUInverse - A - inverse of matrix A, same as in RMatrixLUInverse - - -- ALGLIB routine -- - 10.02.2010 - Bochkanov Sergey -*************************************************************************/ -void spdmatrixcholeskyinverse(real_2d_array &a, const ae_int_t n, const bool isupper, ae_int_t &info, matinvreport &rep); -void spdmatrixcholeskyinverse(real_2d_array &a, ae_int_t &info, matinvreport &rep); - - -/************************************************************************* -Inversion of a symmetric positive definite matrix. - -Given an upper or lower triangle of a symmetric positive definite matrix, -the algorithm generates matrix A^-1 and saves the upper or lower triangle -depending on the input. - -Input parameters: - A - matrix to be inverted (upper or lower triangle). - Array with elements [0..N-1,0..N-1]. - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - IsUpper - storage type (optional): - * if True, symmetric matrix A is given by its upper - triangle, and the lower triangle isn’t used/changed by - function - * if False, symmetric matrix A is given by its lower - triangle, and the upper triangle isn’t used/changed by - function - * if not given, both lower and upper triangles must be - filled. - -Output parameters: - Info - return code, same as in RMatrixLUInverse - Rep - solver report, same as in RMatrixLUInverse - A - inverse of matrix A, same as in RMatrixLUInverse - - -- ALGLIB routine -- - 10.02.2010 - Bochkanov Sergey -*************************************************************************/ -void spdmatrixinverse(real_2d_array &a, const ae_int_t n, const bool isupper, ae_int_t &info, matinvreport &rep); -void spdmatrixinverse(real_2d_array &a, ae_int_t &info, matinvreport &rep); - - -/************************************************************************* -Inversion of a Hermitian positive definite matrix which is given -by Cholesky decomposition. - -Input parameters: - A - Cholesky decomposition of the matrix to be inverted: - A=U’*U or A = L*L'. - Output of HPDMatrixCholesky subroutine. - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - IsUpper - storage type (optional): - * if True, symmetric matrix A is given by its upper - triangle, and the lower triangle isn’t used/changed by - function - * if False, symmetric matrix A is given by its lower - triangle, and the upper triangle isn’t used/changed by - function - * if not given, lower half is used. - -Output parameters: - Info - return code, same as in RMatrixLUInverse - Rep - solver report, same as in RMatrixLUInverse - A - inverse of matrix A, same as in RMatrixLUInverse - - -- ALGLIB routine -- - 10.02.2010 - Bochkanov Sergey -*************************************************************************/ -void hpdmatrixcholeskyinverse(complex_2d_array &a, const ae_int_t n, const bool isupper, ae_int_t &info, matinvreport &rep); -void hpdmatrixcholeskyinverse(complex_2d_array &a, ae_int_t &info, matinvreport &rep); - - -/************************************************************************* -Inversion of a Hermitian positive definite matrix. - -Given an upper or lower triangle of a Hermitian positive definite matrix, -the algorithm generates matrix A^-1 and saves the upper or lower triangle -depending on the input. - -Input parameters: - A - matrix to be inverted (upper or lower triangle). - Array with elements [0..N-1,0..N-1]. - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - IsUpper - storage type (optional): - * if True, symmetric matrix A is given by its upper - triangle, and the lower triangle isn’t used/changed by - function - * if False, symmetric matrix A is given by its lower - triangle, and the upper triangle isn’t used/changed by - function - * if not given, both lower and upper triangles must be - filled. - -Output parameters: - Info - return code, same as in RMatrixLUInverse - Rep - solver report, same as in RMatrixLUInverse - A - inverse of matrix A, same as in RMatrixLUInverse - - -- ALGLIB routine -- - 10.02.2010 - Bochkanov Sergey -*************************************************************************/ -void hpdmatrixinverse(complex_2d_array &a, const ae_int_t n, const bool isupper, ae_int_t &info, matinvreport &rep); -void hpdmatrixinverse(complex_2d_array &a, ae_int_t &info, matinvreport &rep); - - -/************************************************************************* -Triangular matrix inverse (real) - -The subroutine inverts the following types of matrices: - * upper triangular - * upper triangular with unit diagonal - * lower triangular - * lower triangular with unit diagonal - -In case of an upper (lower) triangular matrix, the inverse matrix will -also be upper (lower) triangular, and after the end of the algorithm, the -inverse matrix replaces the source matrix. The elements below (above) the -main diagonal are not changed by the algorithm. - -If the matrix has a unit diagonal, the inverse matrix also has a unit -diagonal, and the diagonal elements are not passed to the algorithm. - -Input parameters: - A - matrix, array[0..N-1, 0..N-1]. - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - IsUpper - True, if the matrix is upper triangular. - IsUnit - diagonal type (optional): - * if True, matrix has unit diagonal (a[i,i] are NOT used) - * if False, matrix diagonal is arbitrary - * if not given, False is assumed - -Output parameters: - Info - same as for RMatrixLUInverse - Rep - same as for RMatrixLUInverse - A - same as for RMatrixLUInverse. - - -- ALGLIB -- - Copyright 05.02.2010 by Bochkanov Sergey -*************************************************************************/ -void rmatrixtrinverse(real_2d_array &a, const ae_int_t n, const bool isupper, const bool isunit, ae_int_t &info, matinvreport &rep); -void rmatrixtrinverse(real_2d_array &a, const bool isupper, ae_int_t &info, matinvreport &rep); - - -/************************************************************************* -Triangular matrix inverse (complex) - -The subroutine inverts the following types of matrices: - * upper triangular - * upper triangular with unit diagonal - * lower triangular - * lower triangular with unit diagonal - -In case of an upper (lower) triangular matrix, the inverse matrix will -also be upper (lower) triangular, and after the end of the algorithm, the -inverse matrix replaces the source matrix. The elements below (above) the -main diagonal are not changed by the algorithm. - -If the matrix has a unit diagonal, the inverse matrix also has a unit -diagonal, and the diagonal elements are not passed to the algorithm. - -Input parameters: - A - matrix, array[0..N-1, 0..N-1]. - N - size of matrix A (optional) : - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, size is automatically determined from - matrix size (A must be square matrix) - IsUpper - True, if the matrix is upper triangular. - IsUnit - diagonal type (optional): - * if True, matrix has unit diagonal (a[i,i] are NOT used) - * if False, matrix diagonal is arbitrary - * if not given, False is assumed - -Output parameters: - Info - same as for RMatrixLUInverse - Rep - same as for RMatrixLUInverse - A - same as for RMatrixLUInverse. - - -- ALGLIB -- - Copyright 05.02.2010 by Bochkanov Sergey -*************************************************************************/ -void cmatrixtrinverse(complex_2d_array &a, const ae_int_t n, const bool isupper, const bool isunit, ae_int_t &info, matinvreport &rep); -void cmatrixtrinverse(complex_2d_array &a, const bool isupper, ae_int_t &info, matinvreport &rep); - -/************************************************************************* -This function creates sparse matrix in a Hash-Table format. - -This function creates Hast-Table matrix, which can be converted to CRS -format after its initialization is over. Typical usage scenario for a -sparse matrix is: -1. creation in a Hash-Table format -2. insertion of the matrix elements -3. conversion to the CRS representation -4. matrix is passed to some linear algebra algorithm - -Some information about different matrix formats can be found below, in -the "NOTES" section. - -INPUT PARAMETERS - M - number of rows in a matrix, M>=1 - N - number of columns in a matrix, N>=1 - K - K>=0, expected number of non-zero elements in a matrix. - K can be inexact approximation, can be less than actual - number of elements (table will grow when needed) or - even zero). - It is important to understand that although hash-table - may grow automatically, it is better to provide good - estimate of data size. - -OUTPUT PARAMETERS - S - sparse M*N matrix in Hash-Table representation. - All elements of the matrix are zero. - -NOTE 1. - -Sparse matrices can be stored using either Hash-Table representation or -Compressed Row Storage representation. Hast-table is better suited for -querying and dynamic operations (thus, it is used for matrix -initialization), but it is inefficient when you want to make some linear -algebra operations. - -From the other side, CRS is better suited for linear algebra operations, -but initialization is less convenient - you have to tell row sizes at the -initialization, and you can fill matrix only row by row, from left to -right. CRS is also very inefficient when you want to find matrix element -by its index. - -Thus, Hash-Table representation does not support linear algebra -operations, while CRS format does not support modification of the table. -Tables below outline information about these two formats: - - OPERATIONS WITH MATRIX HASH CRS - create + + - read element + + - modify element + - add value to element + - A*x (dense vector) + - A'*x (dense vector) + - A*X (dense matrix) + - A'*X (dense matrix) + - -NOTE 2. - -Hash-tables use memory inefficiently, and they have to keep some amount -of the "spare memory" in order to have good performance. Hash table for -matrix with K non-zero elements will need C*K*(8+2*sizeof(int)) bytes, -where C is a small constant, about 1.5-2 in magnitude. - -CRS storage, from the other side, is more memory-efficient, and needs -just K*(8+sizeof(int))+M*sizeof(int) bytes, where M is a number of rows -in a matrix. - -When you convert from the Hash-Table to CRS representation, all unneeded -memory will be freed. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparsecreate(const ae_int_t m, const ae_int_t n, const ae_int_t k, sparsematrix &s); -void sparsecreate(const ae_int_t m, const ae_int_t n, sparsematrix &s); - - -/************************************************************************* -This function creates sparse matrix in a CRS format (expert function for -situations when you are running out of memory). - -This function creates CRS matrix. Typical usage scenario for a CRS matrix -is: -1. creation (you have to tell number of non-zero elements at each row at - this moment) -2. insertion of the matrix elements (row by row, from left to right) -3. matrix is passed to some linear algebra algorithm - -This function is a memory-efficient alternative to SparseCreate(), but it -is more complex because it requires you to know in advance how large your -matrix is. Some information about different matrix formats can be found -below, in the "NOTES" section. - -INPUT PARAMETERS - M - number of rows in a matrix, M>=1 - N - number of columns in a matrix, N>=1 - NER - number of elements at each row, array[M], NER[I]>=0 - -OUTPUT PARAMETERS - S - sparse M*N matrix in CRS representation. - You have to fill ALL non-zero elements by calling - SparseSet() BEFORE you try to use this matrix. - -NOTE 1. - -Sparse matrices can be stored using either Hash-Table representation or -Compressed Row Storage representation. Hast-table is better suited for -querying and dynamic operations (thus, it is used for matrix -initialization), but it is inefficient when you want to make some linear -algebra operations. - -From the other side, CRS is better suited for linear algebra operations, -but initialization is less convenient - you have to tell row sizes at the -initialization, and you can fill matrix only row by row, from left to -right. CRS is also very inefficient when you want to find matrix element -by its index. - -Thus, Hash-Table representation does not support linear algebra -operations, while CRS format does not support modification of the table. -Tables below outline information about these two formats: - - OPERATIONS WITH MATRIX HASH CRS - create + + - read element + + - modify element + - add value to element + - A*x (dense vector) + - A'*x (dense vector) + - A*X (dense matrix) + - A'*X (dense matrix) + - -NOTE 2. - -Hash-tables use memory inefficiently, and they have to keep some amount -of the "spare memory" in order to have good performance. Hash table for -matrix with K non-zero elements will need C*K*(8+2*sizeof(int)) bytes, -where C is a small constant, about 1.5-2 in magnitude. - -CRS storage, from the other side, is more memory-efficient, and needs -just K*(8+sizeof(int))+M*sizeof(int) bytes, where M is a number of rows -in a matrix. - -When you convert from the Hash-Table to CRS representation, all unneeded -memory will be freed. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparsecreatecrs(const ae_int_t m, const ae_int_t n, const integer_1d_array &ner, sparsematrix &s); - - -/************************************************************************* -This function copies S0 to S1. - -NOTE: this function does not verify its arguments, it just copies all -fields of the structure. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparsecopy(const sparsematrix &s0, sparsematrix &s1); - - -/************************************************************************* -This function adds value to S[i,j] - element of the sparse matrix. Matrix -must be in a Hash-Table mode. - -In case S[i,j] already exists in the table, V i added to its value. In -case S[i,j] is non-existent, it is inserted in the table. Table -automatically grows when necessary. - -INPUT PARAMETERS - S - sparse M*N matrix in Hash-Table representation. - Exception will be thrown for CRS matrix. - I - row index of the element to modify, 0<=I=i - are used, and lower triangle is ignored (it can be - empty - these elements are not referenced at all). - * if lower triangle is given, only S[i,j] for j<=i - are used, and upper triangle is ignored. - X - array[N], input vector. For performance reasons we - make only quick checks - we check that array size is - at least N, but we do not check for NAN's or INF's. - Y - output buffer, possibly preallocated. In case buffer - size is too small to store result, this buffer is - automatically resized. - -OUTPUT PARAMETERS - Y - array[M], S*x - -NOTE: this function throws exception when called for non-CRS matrix. You -must convert your matrix with SparseConvertToCRS() before using this -function. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparsesmv(const sparsematrix &s, const bool isupper, const real_1d_array &x, real_1d_array &y); - - -/************************************************************************* -This function calculates matrix-matrix product S*A. Matrix S must be -stored in CRS format (exception will be thrown otherwise). - -INPUT PARAMETERS - S - sparse M*N matrix in CRS format (you MUST convert it - to CRS before calling this function). - A - array[N][K], input dense matrix. For performance reasons - we make only quick checks - we check that array size - is at least N, but we do not check for NAN's or INF's. - K - number of columns of matrix (A). - B - output buffer, possibly preallocated. In case buffer - size is too small to store result, this buffer is - automatically resized. - -OUTPUT PARAMETERS - B - array[M][K], S*A - -NOTE: this function throws exception when called for non-CRS matrix. You -must convert your matrix with SparseConvertToCRS() before using this -function. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparsemm(const sparsematrix &s, const real_2d_array &a, const ae_int_t k, real_2d_array &b); - - -/************************************************************************* -This function calculates matrix-matrix product S^T*A. Matrix S must be -stored in CRS format (exception will be thrown otherwise). - -INPUT PARAMETERS - S - sparse M*N matrix in CRS format (you MUST convert it - to CRS before calling this function). - A - array[M][K], input dense matrix. For performance reasons - we make only quick checks - we check that array size is - at least M, but we do not check for NAN's or INF's. - K - number of columns of matrix (A). - B - output buffer, possibly preallocated. In case buffer - size is too small to store result, this buffer is - automatically resized. - -OUTPUT PARAMETERS - B - array[N][K], S^T*A - -NOTE: this function throws exception when called for non-CRS matrix. You -must convert your matrix with SparseConvertToCRS() before using this -function. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparsemtm(const sparsematrix &s, const real_2d_array &a, const ae_int_t k, real_2d_array &b); - - -/************************************************************************* -This function simultaneously calculates two matrix-matrix products: - S*A and S^T*A. -S must be square (non-rectangular) matrix stored in CRS format (exception -will be thrown otherwise). - -INPUT PARAMETERS - S - sparse N*N matrix in CRS format (you MUST convert it - to CRS before calling this function). - A - array[N][K], input dense matrix. For performance reasons - we make only quick checks - we check that array size is - at least N, but we do not check for NAN's or INF's. - K - number of columns of matrix (A). - B0 - output buffer, possibly preallocated. In case buffer - size is too small to store result, this buffer is - automatically resized. - B1 - output buffer, possibly preallocated. In case buffer - size is too small to store result, this buffer is - automatically resized. - -OUTPUT PARAMETERS - B0 - array[N][K], S*A - B1 - array[N][K], S^T*A - -NOTE: this function throws exception when called for non-CRS matrix. You -must convert your matrix with SparseConvertToCRS() before using this -function. It also throws exception when S is non-square. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparsemm2(const sparsematrix &s, const real_2d_array &a, const ae_int_t k, real_2d_array &b0, real_2d_array &b1); - - -/************************************************************************* -This function calculates matrix-matrix product S*A, when S is symmetric -matrix. Matrix S must be stored in CRS format (exception will be -thrown otherwise). - -INPUT PARAMETERS - S - sparse M*M matrix in CRS format (you MUST convert it - to CRS before calling this function). - IsUpper - whether upper or lower triangle of S is given: - * if upper triangle is given, only S[i,j] for j>=i - are used, and lower triangle is ignored (it can be - empty - these elements are not referenced at all). - * if lower triangle is given, only S[i,j] for j<=i - are used, and upper triangle is ignored. - A - array[N][K], input dense matrix. For performance reasons - we make only quick checks - we check that array size is - at least N, but we do not check for NAN's or INF's. - K - number of columns of matrix (A). - B - output buffer, possibly preallocated. In case buffer - size is too small to store result, this buffer is - automatically resized. - -OUTPUT PARAMETERS - B - array[M][K], S*A - -NOTE: this function throws exception when called for non-CRS matrix. You -must convert your matrix with SparseConvertToCRS() before using this -function. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparsesmm(const sparsematrix &s, const bool isupper, const real_2d_array &a, const ae_int_t k, real_2d_array &b); - - -/************************************************************************* -This procedure resizes Hash-Table matrix. It can be called when you have -deleted too many elements from the matrix, and you want to free unneeded -memory. - - -- ALGLIB PROJECT -- - Copyright 14.10.2011 by Bochkanov Sergey -*************************************************************************/ -void sparseresizematrix(const sparsematrix &s); - - -/************************************************************************* -This function is used to enumerate all elements of the sparse matrix. -Before first call user initializes T0 and T1 counters by zero. These -counters are used to remember current position in a matrix; after each -call they are updated by the function. - -Subsequent calls to this function return non-zero elements of the sparse -matrix, one by one. If you enumerate CRS matrix, matrix is traversed from -left to right, from top to bottom. In case you enumerate matrix stored as -Hash table, elements are returned in random order. - -EXAMPLE - > T0=0 - > T1=0 - > while SparseEnumerate(S,T0,T1,I,J,V) do - > ....do something with I,J,V - -INPUT PARAMETERS - S - sparse M*N matrix in Hash-Table or CRS representation. - T0 - internal counter - T1 - internal counter - -OUTPUT PARAMETERS - T0 - new value of the internal counter - T1 - new value of the internal counter - I - row index of non-zero element, 0<=I0 - N - number of columns in the matrix being estimated, N>0 - NStart - number of random starting vectors - recommended value - at least 5. - NIts - number of iterations to do with best starting vector - recommended value - at least 5. - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -NOTE: this algorithm is effectively deterministic, i.e. it always returns -same result when repeatedly called for the same matrix. In fact, algorithm -uses randomized starting vectors, but internal random numbers generator -always generates same sequence of the random values (it is a feature, not -bug). - -Algorithm can be made non-deterministic with NormEstimatorSetSeed(0) call. - - -- ALGLIB -- - Copyright 06.12.2011 by Bochkanov Sergey -*************************************************************************/ -void normestimatorcreate(const ae_int_t m, const ae_int_t n, const ae_int_t nstart, const ae_int_t nits, normestimatorstate &state); - - -/************************************************************************* -This function changes seed value used by algorithm. In some cases we need -deterministic processing, i.e. subsequent calls must return equal results, -in other cases we need non-deterministic algorithm which returns different -results for the same matrix on every pass. - -Setting zero seed will lead to non-deterministic algorithm, while non-zero -value will make our algorithm deterministic. - -INPUT PARAMETERS: - State - norm estimator state, must be initialized with a call - to NormEstimatorCreate() - SeedVal - seed value, >=0. Zero value = non-deterministic algo. - - -- ALGLIB -- - Copyright 06.12.2011 by Bochkanov Sergey -*************************************************************************/ -void normestimatorsetseed(const normestimatorstate &state, const ae_int_t seedval); - - -/************************************************************************* -This function estimates norm of the sparse M*N matrix A. - -INPUT PARAMETERS: - State - norm estimator state, must be initialized with a call - to NormEstimatorCreate() - A - sparse M*N matrix, must be converted to CRS format - prior to calling this function. - -After this function is over you can call NormEstimatorResults() to get -estimate of the norm(A). - - -- ALGLIB -- - Copyright 06.12.2011 by Bochkanov Sergey -*************************************************************************/ -void normestimatorestimatesparse(const normestimatorstate &state, const sparsematrix &a); - - -/************************************************************************* -Matrix norm estimation results - -INPUT PARAMETERS: - State - algorithm state - -OUTPUT PARAMETERS: - Nrm - estimate of the matrix norm, Nrm>=0 - - -- ALGLIB -- - Copyright 06.12.2011 by Bochkanov Sergey -*************************************************************************/ -void normestimatorresults(const normestimatorstate &state, double &nrm); - -/************************************************************************* -Determinant calculation of the matrix given by its LU decomposition. - -Input parameters: - A - LU decomposition of the matrix (output of - RMatrixLU subroutine). - Pivots - table of permutations which were made during - the LU decomposition. - Output of RMatrixLU subroutine. - N - (optional) size of matrix A: - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, automatically determined from matrix size - (A must be square matrix) - -Result: matrix determinant. - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -double rmatrixludet(const real_2d_array &a, const integer_1d_array &pivots, const ae_int_t n); -double rmatrixludet(const real_2d_array &a, const integer_1d_array &pivots); - - -/************************************************************************* -Calculation of the determinant of a general matrix - -Input parameters: - A - matrix, array[0..N-1, 0..N-1] - N - (optional) size of matrix A: - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, automatically determined from matrix size - (A must be square matrix) - -Result: determinant of matrix A. - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -double rmatrixdet(const real_2d_array &a, const ae_int_t n); -double rmatrixdet(const real_2d_array &a); - - -/************************************************************************* -Determinant calculation of the matrix given by its LU decomposition. - -Input parameters: - A - LU decomposition of the matrix (output of - RMatrixLU subroutine). - Pivots - table of permutations which were made during - the LU decomposition. - Output of RMatrixLU subroutine. - N - (optional) size of matrix A: - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, automatically determined from matrix size - (A must be square matrix) - -Result: matrix determinant. - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -alglib::complex cmatrixludet(const complex_2d_array &a, const integer_1d_array &pivots, const ae_int_t n); -alglib::complex cmatrixludet(const complex_2d_array &a, const integer_1d_array &pivots); - - -/************************************************************************* -Calculation of the determinant of a general matrix - -Input parameters: - A - matrix, array[0..N-1, 0..N-1] - N - (optional) size of matrix A: - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, automatically determined from matrix size - (A must be square matrix) - -Result: determinant of matrix A. - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -alglib::complex cmatrixdet(const complex_2d_array &a, const ae_int_t n); -alglib::complex cmatrixdet(const complex_2d_array &a); - - -/************************************************************************* -Determinant calculation of the matrix given by the Cholesky decomposition. - -Input parameters: - A - Cholesky decomposition, - output of SMatrixCholesky subroutine. - N - (optional) size of matrix A: - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, automatically determined from matrix size - (A must be square matrix) - -As the determinant is equal to the product of squares of diagonal elements, -it’s not necessary to specify which triangle - lower or upper - the matrix -is stored in. - -Result: - matrix determinant. - - -- ALGLIB -- - Copyright 2005-2008 by Bochkanov Sergey -*************************************************************************/ -double spdmatrixcholeskydet(const real_2d_array &a, const ae_int_t n); -double spdmatrixcholeskydet(const real_2d_array &a); - - -/************************************************************************* -Determinant calculation of the symmetric positive definite matrix. - -Input parameters: - A - matrix. Array with elements [0..N-1, 0..N-1]. - N - (optional) size of matrix A: - * if given, only principal NxN submatrix is processed and - overwritten. other elements are unchanged. - * if not given, automatically determined from matrix size - (A must be square matrix) - IsUpper - (optional) storage type: - * if True, symmetric matrix A is given by its upper - triangle, and the lower triangle isn’t used/changed by - function - * if False, symmetric matrix A is given by its lower - triangle, and the upper triangle isn’t used/changed by - function - * if not given, both lower and upper triangles must be - filled. - -Result: - determinant of matrix A. - If matrix A is not positive definite, exception is thrown. - - -- ALGLIB -- - Copyright 2005-2008 by Bochkanov Sergey -*************************************************************************/ -double spdmatrixdet(const real_2d_array &a, const ae_int_t n, const bool isupper); -double spdmatrixdet(const real_2d_array &a); - -/************************************************************************* -Algorithm for solving the following generalized symmetric positive-definite -eigenproblem: - A*x = lambda*B*x (1) or - A*B*x = lambda*x (2) or - B*A*x = lambda*x (3). -where A is a symmetric matrix, B - symmetric positive-definite matrix. -The problem is solved by reducing it to an ordinary symmetric eigenvalue -problem. - -Input parameters: - A - symmetric matrix which is given by its upper or lower - triangular part. - Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrices A and B. - IsUpperA - storage format of matrix A. - B - symmetric positive-definite matrix which is given by - its upper or lower triangular part. - Array whose indexes range within [0..N-1, 0..N-1]. - IsUpperB - storage format of matrix B. - ZNeeded - if ZNeeded is equal to: - * 0, the eigenvectors are not returned; - * 1, the eigenvectors are returned. - ProblemType - if ProblemType is equal to: - * 1, the following problem is solved: A*x = lambda*B*x; - * 2, the following problem is solved: A*B*x = lambda*x; - * 3, the following problem is solved: B*A*x = lambda*x. - -Output parameters: - D - eigenvalues in ascending order. - Array whose index ranges within [0..N-1]. - Z - if ZNeeded is equal to: - * 0, Z hasn’t changed; - * 1, Z contains eigenvectors. - Array whose indexes range within [0..N-1, 0..N-1]. - The eigenvectors are stored in matrix columns. It should - be noted that the eigenvectors in such problems do not - form an orthogonal system. - -Result: - True, if the problem was solved successfully. - False, if the error occurred during the Cholesky decomposition of matrix - B (the matrix isn’t positive-definite) or during the work of the iterative - algorithm for solving the symmetric eigenproblem. - -See also the GeneralizedSymmetricDefiniteEVDReduce subroutine. - - -- ALGLIB -- - Copyright 1.28.2006 by Bochkanov Sergey -*************************************************************************/ -bool smatrixgevd(const real_2d_array &a, const ae_int_t n, const bool isuppera, const real_2d_array &b, const bool isupperb, const ae_int_t zneeded, const ae_int_t problemtype, real_1d_array &d, real_2d_array &z); - - -/************************************************************************* -Algorithm for reduction of the following generalized symmetric positive- -definite eigenvalue problem: - A*x = lambda*B*x (1) or - A*B*x = lambda*x (2) or - B*A*x = lambda*x (3) -to the symmetric eigenvalues problem C*y = lambda*y (eigenvalues of this and -the given problems are the same, and the eigenvectors of the given problem -could be obtained by multiplying the obtained eigenvectors by the -transformation matrix x = R*y). - -Here A is a symmetric matrix, B - symmetric positive-definite matrix. - -Input parameters: - A - symmetric matrix which is given by its upper or lower - triangular part. - Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrices A and B. - IsUpperA - storage format of matrix A. - B - symmetric positive-definite matrix which is given by - its upper or lower triangular part. - Array whose indexes range within [0..N-1, 0..N-1]. - IsUpperB - storage format of matrix B. - ProblemType - if ProblemType is equal to: - * 1, the following problem is solved: A*x = lambda*B*x; - * 2, the following problem is solved: A*B*x = lambda*x; - * 3, the following problem is solved: B*A*x = lambda*x. - -Output parameters: - A - symmetric matrix which is given by its upper or lower - triangle depending on IsUpperA. Contains matrix C. - Array whose indexes range within [0..N-1, 0..N-1]. - R - upper triangular or low triangular transformation matrix - which is used to obtain the eigenvectors of a given problem - as the product of eigenvectors of C (from the right) and - matrix R (from the left). If the matrix is upper - triangular, the elements below the main diagonal - are equal to 0 (and vice versa). Thus, we can perform - the multiplication without taking into account the - internal structure (which is an easier though less - effective way). - Array whose indexes range within [0..N-1, 0..N-1]. - IsUpperR - type of matrix R (upper or lower triangular). - -Result: - True, if the problem was reduced successfully. - False, if the error occurred during the Cholesky decomposition of - matrix B (the matrix is not positive-definite). - - -- ALGLIB -- - Copyright 1.28.2006 by Bochkanov Sergey -*************************************************************************/ -bool smatrixgevdreduce(real_2d_array &a, const ae_int_t n, const bool isuppera, const real_2d_array &b, const bool isupperb, const ae_int_t problemtype, real_2d_array &r, bool &isupperr); - -/************************************************************************* -Inverse matrix update by the Sherman-Morrison formula - -The algorithm updates matrix A^-1 when adding a number to an element -of matrix A. - -Input parameters: - InvA - inverse of matrix A. - Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - UpdRow - row where the element to be updated is stored. - UpdColumn - column where the element to be updated is stored. - UpdVal - a number to be added to the element. - - -Output parameters: - InvA - inverse of modified matrix A. - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -void rmatrixinvupdatesimple(real_2d_array &inva, const ae_int_t n, const ae_int_t updrow, const ae_int_t updcolumn, const double updval); - - -/************************************************************************* -Inverse matrix update by the Sherman-Morrison formula - -The algorithm updates matrix A^-1 when adding a vector to a row -of matrix A. - -Input parameters: - InvA - inverse of matrix A. - Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - UpdRow - the row of A whose vector V was added. - 0 <= Row <= N-1 - V - the vector to be added to a row. - Array whose index ranges within [0..N-1]. - -Output parameters: - InvA - inverse of modified matrix A. - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -void rmatrixinvupdaterow(real_2d_array &inva, const ae_int_t n, const ae_int_t updrow, const real_1d_array &v); - - -/************************************************************************* -Inverse matrix update by the Sherman-Morrison formula - -The algorithm updates matrix A^-1 when adding a vector to a column -of matrix A. - -Input parameters: - InvA - inverse of matrix A. - Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - UpdColumn - the column of A whose vector U was added. - 0 <= UpdColumn <= N-1 - U - the vector to be added to a column. - Array whose index ranges within [0..N-1]. - -Output parameters: - InvA - inverse of modified matrix A. - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -void rmatrixinvupdatecolumn(real_2d_array &inva, const ae_int_t n, const ae_int_t updcolumn, const real_1d_array &u); - - -/************************************************************************* -Inverse matrix update by the Sherman-Morrison formula - -The algorithm computes the inverse of matrix A+u*v’ by using the given matrix -A^-1 and the vectors u and v. - -Input parameters: - InvA - inverse of matrix A. - Array whose indexes range within [0..N-1, 0..N-1]. - N - size of matrix A. - U - the vector modifying the matrix. - Array whose index ranges within [0..N-1]. - V - the vector modifying the matrix. - Array whose index ranges within [0..N-1]. - -Output parameters: - InvA - inverse of matrix A + u*v'. - - -- ALGLIB -- - Copyright 2005 by Bochkanov Sergey -*************************************************************************/ -void rmatrixinvupdateuv(real_2d_array &inva, const ae_int_t n, const real_1d_array &u, const real_1d_array &v); - -/************************************************************************* -Subroutine performing the Schur decomposition of a general matrix by using -the QR algorithm with multiple shifts. - -The source matrix A is represented as S'*A*S = T, where S is an orthogonal -matrix (Schur vectors), T - upper quasi-triangular matrix (with blocks of -sizes 1x1 and 2x2 on the main diagonal). - -Input parameters: - A - matrix to be decomposed. - Array whose indexes range within [0..N-1, 0..N-1]. - N - size of A, N>=0. - - -Output parameters: - A - contains matrix T. - Array whose indexes range within [0..N-1, 0..N-1]. - S - contains Schur vectors. - Array whose indexes range within [0..N-1, 0..N-1]. - -Note 1: - The block structure of matrix T can be easily recognized: since all - the elements below the blocks are zeros, the elements a[i+1,i] which - are equal to 0 show the block border. - -Note 2: - The algorithm performance depends on the value of the internal parameter - NS of the InternalSchurDecomposition subroutine which defines the number - of shifts in the QR algorithm (similarly to the block width in block-matrix - algorithms in linear algebra). If you require maximum performance on - your machine, it is recommended to adjust this parameter manually. - -Result: - True, - if the algorithm has converged and parameters A and S contain the result. - False, - if the algorithm has not converged. - -Algorithm implemented on the basis of the DHSEQR subroutine (LAPACK 3.0 library). -*************************************************************************/ -bool rmatrixschur(real_2d_array &a, const ae_int_t n, real_2d_array &s); -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (FUNCTIONS) -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ -void ablassplitlength(/* Real */ ae_matrix* a, - ae_int_t n, - ae_int_t* n1, - ae_int_t* n2, - ae_state *_state); -void ablascomplexsplitlength(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_int_t* n1, - ae_int_t* n2, - ae_state *_state); -ae_int_t ablasblocksize(/* Real */ ae_matrix* a, ae_state *_state); -ae_int_t ablascomplexblocksize(/* Complex */ ae_matrix* a, - ae_state *_state); -ae_int_t ablasmicroblocksize(ae_state *_state); -void cmatrixtranspose(ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - /* Complex */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - ae_state *_state); -void rmatrixtranspose(ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - /* Real */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - ae_state *_state); -void rmatrixenforcesymmetricity(/* Real */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_state *_state); -void cmatrixcopy(ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - /* Complex */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - ae_state *_state); -void rmatrixcopy(ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - /* Real */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - ae_state *_state); -void cmatrixrank1(ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - /* Complex */ ae_vector* u, - ae_int_t iu, - /* Complex */ ae_vector* v, - ae_int_t iv, - ae_state *_state); -void rmatrixrank1(ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - /* Real */ ae_vector* u, - ae_int_t iu, - /* Real */ ae_vector* v, - ae_int_t iv, - ae_state *_state); -void cmatrixmv(ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t opa, - /* Complex */ ae_vector* x, - ae_int_t ix, - /* Complex */ ae_vector* y, - ae_int_t iy, - ae_state *_state); -void rmatrixmv(ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t opa, - /* Real */ ae_vector* x, - ae_int_t ix, - /* Real */ ae_vector* y, - ae_int_t iy, - ae_state *_state); -void cmatrixrighttrsm(ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Complex */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, - ae_state *_state); -void _pexec_cmatrixrighttrsm(ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Complex */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, ae_state *_state); -void cmatrixlefttrsm(ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Complex */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, - ae_state *_state); -void _pexec_cmatrixlefttrsm(ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Complex */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, ae_state *_state); -void rmatrixrighttrsm(ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Real */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, - ae_state *_state); -void _pexec_rmatrixrighttrsm(ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Real */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, ae_state *_state); -void rmatrixlefttrsm(ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Real */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, - ae_state *_state); -void _pexec_rmatrixlefttrsm(ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* a, - ae_int_t i1, - ae_int_t j1, - ae_bool isupper, - ae_bool isunit, - ae_int_t optype, - /* Real */ ae_matrix* x, - ae_int_t i2, - ae_int_t j2, ae_state *_state); -void cmatrixsyrk(ae_int_t n, - ae_int_t k, - double alpha, - /* Complex */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - double beta, - /* Complex */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_bool isupper, - ae_state *_state); -void _pexec_cmatrixsyrk(ae_int_t n, - ae_int_t k, - double alpha, - /* Complex */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - double beta, - /* Complex */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_bool isupper, ae_state *_state); -void rmatrixsyrk(ae_int_t n, - ae_int_t k, - double alpha, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - double beta, - /* Real */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_bool isupper, - ae_state *_state); -void _pexec_rmatrixsyrk(ae_int_t n, - ae_int_t k, - double alpha, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - double beta, - /* Real */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_bool isupper, ae_state *_state); -void cmatrixgemm(ae_int_t m, - ae_int_t n, - ae_int_t k, - ae_complex alpha, - /* Complex */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - /* Complex */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - ae_int_t optypeb, - ae_complex beta, - /* Complex */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_state *_state); -void _pexec_cmatrixgemm(ae_int_t m, - ae_int_t n, - ae_int_t k, - ae_complex alpha, - /* Complex */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - /* Complex */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - ae_int_t optypeb, - ae_complex beta, - /* Complex */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, ae_state *_state); -void rmatrixgemm(ae_int_t m, - ae_int_t n, - ae_int_t k, - double alpha, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - /* Real */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - ae_int_t optypeb, - double beta, - /* Real */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, - ae_state *_state); -void _pexec_rmatrixgemm(ae_int_t m, - ae_int_t n, - ae_int_t k, - double alpha, - /* Real */ ae_matrix* a, - ae_int_t ia, - ae_int_t ja, - ae_int_t optypea, - /* Real */ ae_matrix* b, - ae_int_t ib, - ae_int_t jb, - ae_int_t optypeb, - double beta, - /* Real */ ae_matrix* c, - ae_int_t ic, - ae_int_t jc, ae_state *_state); -void rmatrixqr(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Real */ ae_vector* tau, - ae_state *_state); -void rmatrixlq(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Real */ ae_vector* tau, - ae_state *_state); -void cmatrixqr(/* Complex */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Complex */ ae_vector* tau, - ae_state *_state); -void cmatrixlq(/* Complex */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Complex */ ae_vector* tau, - ae_state *_state); -void rmatrixqrunpackq(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Real */ ae_vector* tau, - ae_int_t qcolumns, - /* Real */ ae_matrix* q, - ae_state *_state); -void rmatrixqrunpackr(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* r, - ae_state *_state); -void rmatrixlqunpackq(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Real */ ae_vector* tau, - ae_int_t qrows, - /* Real */ ae_matrix* q, - ae_state *_state); -void rmatrixlqunpackl(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Real */ ae_matrix* l, - ae_state *_state); -void cmatrixqrunpackq(/* Complex */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Complex */ ae_vector* tau, - ae_int_t qcolumns, - /* Complex */ ae_matrix* q, - ae_state *_state); -void cmatrixqrunpackr(/* Complex */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* r, - ae_state *_state); -void cmatrixlqunpackq(/* Complex */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Complex */ ae_vector* tau, - ae_int_t qrows, - /* Complex */ ae_matrix* q, - ae_state *_state); -void cmatrixlqunpackl(/* Complex */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Complex */ ae_matrix* l, - ae_state *_state); -void rmatrixqrbasecase(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Real */ ae_vector* work, - /* Real */ ae_vector* t, - /* Real */ ae_vector* tau, - ae_state *_state); -void rmatrixlqbasecase(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Real */ ae_vector* work, - /* Real */ ae_vector* t, - /* Real */ ae_vector* tau, - ae_state *_state); -void rmatrixbd(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Real */ ae_vector* tauq, - /* Real */ ae_vector* taup, - ae_state *_state); -void rmatrixbdunpackq(/* Real */ ae_matrix* qp, - ae_int_t m, - ae_int_t n, - /* Real */ ae_vector* tauq, - ae_int_t qcolumns, - /* Real */ ae_matrix* q, - ae_state *_state); -void rmatrixbdmultiplybyq(/* Real */ ae_matrix* qp, - ae_int_t m, - ae_int_t n, - /* Real */ ae_vector* tauq, - /* Real */ ae_matrix* z, - ae_int_t zrows, - ae_int_t zcolumns, - ae_bool fromtheright, - ae_bool dotranspose, - ae_state *_state); -void rmatrixbdunpackpt(/* Real */ ae_matrix* qp, - ae_int_t m, - ae_int_t n, - /* Real */ ae_vector* taup, - ae_int_t ptrows, - /* Real */ ae_matrix* pt, - ae_state *_state); -void rmatrixbdmultiplybyp(/* Real */ ae_matrix* qp, - ae_int_t m, - ae_int_t n, - /* Real */ ae_vector* taup, - /* Real */ ae_matrix* z, - ae_int_t zrows, - ae_int_t zcolumns, - ae_bool fromtheright, - ae_bool dotranspose, - ae_state *_state); -void rmatrixbdunpackdiagonals(/* Real */ ae_matrix* b, - ae_int_t m, - ae_int_t n, - ae_bool* isupper, - /* Real */ ae_vector* d, - /* Real */ ae_vector* e, - ae_state *_state); -void rmatrixhessenberg(/* Real */ ae_matrix* a, - ae_int_t n, - /* Real */ ae_vector* tau, - ae_state *_state); -void rmatrixhessenbergunpackq(/* Real */ ae_matrix* a, - ae_int_t n, - /* Real */ ae_vector* tau, - /* Real */ ae_matrix* q, - ae_state *_state); -void rmatrixhessenbergunpackh(/* Real */ ae_matrix* a, - ae_int_t n, - /* Real */ ae_matrix* h, - ae_state *_state); -void smatrixtd(/* Real */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - /* Real */ ae_vector* tau, - /* Real */ ae_vector* d, - /* Real */ ae_vector* e, - ae_state *_state); -void smatrixtdunpackq(/* Real */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - /* Real */ ae_vector* tau, - /* Real */ ae_matrix* q, - ae_state *_state); -void hmatrixtd(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - /* Complex */ ae_vector* tau, - /* Real */ ae_vector* d, - /* Real */ ae_vector* e, - ae_state *_state); -void hmatrixtdunpackq(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - /* Complex */ ae_vector* tau, - /* Complex */ ae_matrix* q, - ae_state *_state); -ae_bool rmatrixbdsvd(/* Real */ ae_vector* d, - /* Real */ ae_vector* e, - ae_int_t n, - ae_bool isupper, - ae_bool isfractionalaccuracyrequired, - /* Real */ ae_matrix* u, - ae_int_t nru, - /* Real */ ae_matrix* c, - ae_int_t ncc, - /* Real */ ae_matrix* vt, - ae_int_t ncvt, - ae_state *_state); -ae_bool bidiagonalsvddecomposition(/* Real */ ae_vector* d, - /* Real */ ae_vector* e, - ae_int_t n, - ae_bool isupper, - ae_bool isfractionalaccuracyrequired, - /* Real */ ae_matrix* u, - ae_int_t nru, - /* Real */ ae_matrix* c, - ae_int_t ncc, - /* Real */ ae_matrix* vt, - ae_int_t ncvt, - ae_state *_state); -ae_bool rmatrixsvd(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - ae_int_t uneeded, - ae_int_t vtneeded, - ae_int_t additionalmemory, - /* Real */ ae_vector* w, - /* Real */ ae_matrix* u, - /* Real */ ae_matrix* vt, - ae_state *_state); -ae_bool smatrixevd(/* Real */ ae_matrix* a, - ae_int_t n, - ae_int_t zneeded, - ae_bool isupper, - /* Real */ ae_vector* d, - /* Real */ ae_matrix* z, - ae_state *_state); -ae_bool smatrixevdr(/* Real */ ae_matrix* a, - ae_int_t n, - ae_int_t zneeded, - ae_bool isupper, - double b1, - double b2, - ae_int_t* m, - /* Real */ ae_vector* w, - /* Real */ ae_matrix* z, - ae_state *_state); -ae_bool smatrixevdi(/* Real */ ae_matrix* a, - ae_int_t n, - ae_int_t zneeded, - ae_bool isupper, - ae_int_t i1, - ae_int_t i2, - /* Real */ ae_vector* w, - /* Real */ ae_matrix* z, - ae_state *_state); -ae_bool hmatrixevd(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_int_t zneeded, - ae_bool isupper, - /* Real */ ae_vector* d, - /* Complex */ ae_matrix* z, - ae_state *_state); -ae_bool hmatrixevdr(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_int_t zneeded, - ae_bool isupper, - double b1, - double b2, - ae_int_t* m, - /* Real */ ae_vector* w, - /* Complex */ ae_matrix* z, - ae_state *_state); -ae_bool hmatrixevdi(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_int_t zneeded, - ae_bool isupper, - ae_int_t i1, - ae_int_t i2, - /* Real */ ae_vector* w, - /* Complex */ ae_matrix* z, - ae_state *_state); -ae_bool smatrixtdevd(/* Real */ ae_vector* d, - /* Real */ ae_vector* e, - ae_int_t n, - ae_int_t zneeded, - /* Real */ ae_matrix* z, - ae_state *_state); -ae_bool smatrixtdevdr(/* Real */ ae_vector* d, - /* Real */ ae_vector* e, - ae_int_t n, - ae_int_t zneeded, - double a, - double b, - ae_int_t* m, - /* Real */ ae_matrix* z, - ae_state *_state); -ae_bool smatrixtdevdi(/* Real */ ae_vector* d, - /* Real */ ae_vector* e, - ae_int_t n, - ae_int_t zneeded, - ae_int_t i1, - ae_int_t i2, - /* Real */ ae_matrix* z, - ae_state *_state); -ae_bool rmatrixevd(/* Real */ ae_matrix* a, - ae_int_t n, - ae_int_t vneeded, - /* Real */ ae_vector* wr, - /* Real */ ae_vector* wi, - /* Real */ ae_matrix* vl, - /* Real */ ae_matrix* vr, - ae_state *_state); -void rmatrixrndorthogonal(ae_int_t n, - /* Real */ ae_matrix* a, - ae_state *_state); -void rmatrixrndcond(ae_int_t n, - double c, - /* Real */ ae_matrix* a, - ae_state *_state); -void cmatrixrndorthogonal(ae_int_t n, - /* Complex */ ae_matrix* a, - ae_state *_state); -void cmatrixrndcond(ae_int_t n, - double c, - /* Complex */ ae_matrix* a, - ae_state *_state); -void smatrixrndcond(ae_int_t n, - double c, - /* Real */ ae_matrix* a, - ae_state *_state); -void spdmatrixrndcond(ae_int_t n, - double c, - /* Real */ ae_matrix* a, - ae_state *_state); -void hmatrixrndcond(ae_int_t n, - double c, - /* Complex */ ae_matrix* a, - ae_state *_state); -void hpdmatrixrndcond(ae_int_t n, - double c, - /* Complex */ ae_matrix* a, - ae_state *_state); -void rmatrixrndorthogonalfromtheright(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - ae_state *_state); -void rmatrixrndorthogonalfromtheleft(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - ae_state *_state); -void cmatrixrndorthogonalfromtheright(/* Complex */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - ae_state *_state); -void cmatrixrndorthogonalfromtheleft(/* Complex */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - ae_state *_state); -void smatrixrndmultiply(/* Real */ ae_matrix* a, - ae_int_t n, - ae_state *_state); -void hmatrixrndmultiply(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_state *_state); -void rmatrixlu(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Integer */ ae_vector* pivots, - ae_state *_state); -void cmatrixlu(/* Complex */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Integer */ ae_vector* pivots, - ae_state *_state); -ae_bool hpdmatrixcholesky(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_state *_state); -ae_bool spdmatrixcholesky(/* Real */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_state *_state); -void rmatrixlup(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Integer */ ae_vector* pivots, - ae_state *_state); -void cmatrixlup(/* Complex */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Integer */ ae_vector* pivots, - ae_state *_state); -void rmatrixplu(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Integer */ ae_vector* pivots, - ae_state *_state); -void cmatrixplu(/* Complex */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - /* Integer */ ae_vector* pivots, - ae_state *_state); -ae_bool spdmatrixcholeskyrec(/* Real */ ae_matrix* a, - ae_int_t offs, - ae_int_t n, - ae_bool isupper, - /* Real */ ae_vector* tmp, - ae_state *_state); -double rmatrixrcond1(/* Real */ ae_matrix* a, - ae_int_t n, - ae_state *_state); -double rmatrixrcondinf(/* Real */ ae_matrix* a, - ae_int_t n, - ae_state *_state); -double spdmatrixrcond(/* Real */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_state *_state); -double rmatrixtrrcond1(/* Real */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_bool isunit, - ae_state *_state); -double rmatrixtrrcondinf(/* Real */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_bool isunit, - ae_state *_state); -double hpdmatrixrcond(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_state *_state); -double cmatrixrcond1(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_state *_state); -double cmatrixrcondinf(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_state *_state); -double rmatrixlurcond1(/* Real */ ae_matrix* lua, - ae_int_t n, - ae_state *_state); -double rmatrixlurcondinf(/* Real */ ae_matrix* lua, - ae_int_t n, - ae_state *_state); -double spdmatrixcholeskyrcond(/* Real */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_state *_state); -double hpdmatrixcholeskyrcond(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_state *_state); -double cmatrixlurcond1(/* Complex */ ae_matrix* lua, - ae_int_t n, - ae_state *_state); -double cmatrixlurcondinf(/* Complex */ ae_matrix* lua, - ae_int_t n, - ae_state *_state); -double cmatrixtrrcond1(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_bool isunit, - ae_state *_state); -double cmatrixtrrcondinf(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_bool isunit, - ae_state *_state); -double rcondthreshold(ae_state *_state); -void rmatrixluinverse(/* Real */ ae_matrix* a, - /* Integer */ ae_vector* pivots, - ae_int_t n, - ae_int_t* info, - matinvreport* rep, - ae_state *_state); -void rmatrixinverse(/* Real */ ae_matrix* a, - ae_int_t n, - ae_int_t* info, - matinvreport* rep, - ae_state *_state); -void cmatrixluinverse(/* Complex */ ae_matrix* a, - /* Integer */ ae_vector* pivots, - ae_int_t n, - ae_int_t* info, - matinvreport* rep, - ae_state *_state); -void cmatrixinverse(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_int_t* info, - matinvreport* rep, - ae_state *_state); -void spdmatrixcholeskyinverse(/* Real */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_int_t* info, - matinvreport* rep, - ae_state *_state); -void spdmatrixinverse(/* Real */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_int_t* info, - matinvreport* rep, - ae_state *_state); -void hpdmatrixcholeskyinverse(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_int_t* info, - matinvreport* rep, - ae_state *_state); -void hpdmatrixinverse(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_int_t* info, - matinvreport* rep, - ae_state *_state); -void rmatrixtrinverse(/* Real */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_bool isunit, - ae_int_t* info, - matinvreport* rep, - ae_state *_state); -void cmatrixtrinverse(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_bool isunit, - ae_int_t* info, - matinvreport* rep, - ae_state *_state); -ae_bool _matinvreport_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _matinvreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _matinvreport_clear(void* _p); -void _matinvreport_destroy(void* _p); -void sparsecreate(ae_int_t m, - ae_int_t n, - ae_int_t k, - sparsematrix* s, - ae_state *_state); -void sparsecreatecrs(ae_int_t m, - ae_int_t n, - /* Integer */ ae_vector* ner, - sparsematrix* s, - ae_state *_state); -void sparsecopy(sparsematrix* s0, sparsematrix* s1, ae_state *_state); -void sparseadd(sparsematrix* s, - ae_int_t i, - ae_int_t j, - double v, - ae_state *_state); -void sparseset(sparsematrix* s, - ae_int_t i, - ae_int_t j, - double v, - ae_state *_state); -double sparseget(sparsematrix* s, - ae_int_t i, - ae_int_t j, - ae_state *_state); -double sparsegetdiagonal(sparsematrix* s, ae_int_t i, ae_state *_state); -void sparseconverttocrs(sparsematrix* s, ae_state *_state); -void sparsemv(sparsematrix* s, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state); -void sparsemtv(sparsematrix* s, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state); -void sparsemv2(sparsematrix* s, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y0, - /* Real */ ae_vector* y1, - ae_state *_state); -void sparsesmv(sparsematrix* s, - ae_bool isupper, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state); -void sparsemm(sparsematrix* s, - /* Real */ ae_matrix* a, - ae_int_t k, - /* Real */ ae_matrix* b, - ae_state *_state); -void sparsemtm(sparsematrix* s, - /* Real */ ae_matrix* a, - ae_int_t k, - /* Real */ ae_matrix* b, - ae_state *_state); -void sparsemm2(sparsematrix* s, - /* Real */ ae_matrix* a, - ae_int_t k, - /* Real */ ae_matrix* b0, - /* Real */ ae_matrix* b1, - ae_state *_state); -void sparsesmm(sparsematrix* s, - ae_bool isupper, - /* Real */ ae_matrix* a, - ae_int_t k, - /* Real */ ae_matrix* b, - ae_state *_state); -void sparseresizematrix(sparsematrix* s, ae_state *_state); -double sparsegetaveragelengthofchain(sparsematrix* s, ae_state *_state); -ae_bool sparseenumerate(sparsematrix* s, - ae_int_t* t0, - ae_int_t* t1, - ae_int_t* i, - ae_int_t* j, - double* v, - ae_state *_state); -ae_bool sparserewriteexisting(sparsematrix* s, - ae_int_t i, - ae_int_t j, - double v, - ae_state *_state); -void sparsegetrow(sparsematrix* s, - ae_int_t i, - /* Real */ ae_vector* irow, - ae_state *_state); -void sparseconverttohash(sparsematrix* s, ae_state *_state); -void sparsecopytohash(sparsematrix* s0, - sparsematrix* s1, - ae_state *_state); -void sparsecopytocrs(sparsematrix* s0, sparsematrix* s1, ae_state *_state); -ae_int_t sparsegetmatrixtype(sparsematrix* s, ae_state *_state); -ae_bool sparseishash(sparsematrix* s, ae_state *_state); -ae_bool sparseiscrs(sparsematrix* s, ae_state *_state); -void sparsefree(sparsematrix* s, ae_state *_state); -ae_int_t sparsegetnrows(sparsematrix* s, ae_state *_state); -ae_int_t sparsegetncols(sparsematrix* s, ae_state *_state); -ae_bool _sparsematrix_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _sparsematrix_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _sparsematrix_clear(void* _p); -void _sparsematrix_destroy(void* _p); -void fblscholeskysolve(/* Real */ ae_matrix* cha, - double sqrtscalea, - ae_int_t n, - ae_bool isupper, - /* Real */ ae_vector* xb, - /* Real */ ae_vector* tmp, - ae_state *_state); -void fblssolvecgx(/* Real */ ae_matrix* a, - ae_int_t m, - ae_int_t n, - double alpha, - /* Real */ ae_vector* b, - /* Real */ ae_vector* x, - /* Real */ ae_vector* buf, - ae_state *_state); -void fblscgcreate(/* Real */ ae_vector* x, - /* Real */ ae_vector* b, - ae_int_t n, - fblslincgstate* state, - ae_state *_state); -ae_bool fblscgiteration(fblslincgstate* state, ae_state *_state); -void fblssolvels(/* Real */ ae_matrix* a, - /* Real */ ae_vector* b, - ae_int_t m, - ae_int_t n, - /* Real */ ae_vector* tmp0, - /* Real */ ae_vector* tmp1, - /* Real */ ae_vector* tmp2, - ae_state *_state); -ae_bool _fblslincgstate_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _fblslincgstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _fblslincgstate_clear(void* _p); -void _fblslincgstate_destroy(void* _p); -void normestimatorcreate(ae_int_t m, - ae_int_t n, - ae_int_t nstart, - ae_int_t nits, - normestimatorstate* state, - ae_state *_state); -void normestimatorsetseed(normestimatorstate* state, - ae_int_t seedval, - ae_state *_state); -ae_bool normestimatoriteration(normestimatorstate* state, - ae_state *_state); -void normestimatorestimatesparse(normestimatorstate* state, - sparsematrix* a, - ae_state *_state); -void normestimatorresults(normestimatorstate* state, - double* nrm, - ae_state *_state); -void normestimatorrestart(normestimatorstate* state, ae_state *_state); -ae_bool _normestimatorstate_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _normestimatorstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _normestimatorstate_clear(void* _p); -void _normestimatorstate_destroy(void* _p); -double rmatrixludet(/* Real */ ae_matrix* a, - /* Integer */ ae_vector* pivots, - ae_int_t n, - ae_state *_state); -double rmatrixdet(/* Real */ ae_matrix* a, - ae_int_t n, - ae_state *_state); -ae_complex cmatrixludet(/* Complex */ ae_matrix* a, - /* Integer */ ae_vector* pivots, - ae_int_t n, - ae_state *_state); -ae_complex cmatrixdet(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_state *_state); -double spdmatrixcholeskydet(/* Real */ ae_matrix* a, - ae_int_t n, - ae_state *_state); -double spdmatrixdet(/* Real */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - ae_state *_state); -ae_bool smatrixgevd(/* Real */ ae_matrix* a, - ae_int_t n, - ae_bool isuppera, - /* Real */ ae_matrix* b, - ae_bool isupperb, - ae_int_t zneeded, - ae_int_t problemtype, - /* Real */ ae_vector* d, - /* Real */ ae_matrix* z, - ae_state *_state); -ae_bool smatrixgevdreduce(/* Real */ ae_matrix* a, - ae_int_t n, - ae_bool isuppera, - /* Real */ ae_matrix* b, - ae_bool isupperb, - ae_int_t problemtype, - /* Real */ ae_matrix* r, - ae_bool* isupperr, - ae_state *_state); -void rmatrixinvupdatesimple(/* Real */ ae_matrix* inva, - ae_int_t n, - ae_int_t updrow, - ae_int_t updcolumn, - double updval, - ae_state *_state); -void rmatrixinvupdaterow(/* Real */ ae_matrix* inva, - ae_int_t n, - ae_int_t updrow, - /* Real */ ae_vector* v, - ae_state *_state); -void rmatrixinvupdatecolumn(/* Real */ ae_matrix* inva, - ae_int_t n, - ae_int_t updcolumn, - /* Real */ ae_vector* u, - ae_state *_state); -void rmatrixinvupdateuv(/* Real */ ae_matrix* inva, - ae_int_t n, - /* Real */ ae_vector* u, - /* Real */ ae_vector* v, - ae_state *_state); -ae_bool rmatrixschur(/* Real */ ae_matrix* a, - ae_int_t n, - /* Real */ ae_matrix* s, - ae_state *_state); - -} -#endif - diff --git a/src/core/alglib/optimization.cpp b/src/core/alglib/optimization.cpp deleted file mode 100644 index ebfae73..0000000 --- a/src/core/alglib/optimization.cpp +++ /dev/null @@ -1,25034 +0,0 @@ -/************************************************************************* -Copyright (c) Sergey Bochkanov (ALGLIB project). - ->>> SOURCE LICENSE >>> -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation (www.fsf.org); either version 2 of the -License, or (at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -A copy of the GNU General Public License is available at -http://www.fsf.org/licensing/licenses ->>> END OF LICENSE >>> -*************************************************************************/ -#include "stdafx.h" -#include "optimization.h" - -// disable some irrelevant warnings -#if (AE_COMPILER==AE_MSVC) -#pragma warning(disable:4100) -#pragma warning(disable:4127) -#pragma warning(disable:4702) -#pragma warning(disable:4996) -#endif -using namespace std; - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS IMPLEMENTATION OF C++ INTERFACE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib -{ - - - - - - - - - - -/************************************************************************* -This object stores state of the nonlinear CG optimizer. - -You should use ALGLIB functions to work with this object. -*************************************************************************/ -_mincgstate_owner::_mincgstate_owner() -{ - p_struct = (alglib_impl::mincgstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::mincgstate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_mincgstate_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_mincgstate_owner::_mincgstate_owner(const _mincgstate_owner &rhs) -{ - p_struct = (alglib_impl::mincgstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::mincgstate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_mincgstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_mincgstate_owner& _mincgstate_owner::operator=(const _mincgstate_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_mincgstate_clear(p_struct); - if( !alglib_impl::_mincgstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_mincgstate_owner::~_mincgstate_owner() -{ - alglib_impl::_mincgstate_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::mincgstate* _mincgstate_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::mincgstate* _mincgstate_owner::c_ptr() const -{ - return const_cast(p_struct); -} -mincgstate::mincgstate() : _mincgstate_owner() ,needf(p_struct->needf),needfg(p_struct->needfg),xupdated(p_struct->xupdated),f(p_struct->f),g(&p_struct->g),x(&p_struct->x) -{ -} - -mincgstate::mincgstate(const mincgstate &rhs):_mincgstate_owner(rhs) ,needf(p_struct->needf),needfg(p_struct->needfg),xupdated(p_struct->xupdated),f(p_struct->f),g(&p_struct->g),x(&p_struct->x) -{ -} - -mincgstate& mincgstate::operator=(const mincgstate &rhs) -{ - if( this==&rhs ) - return *this; - _mincgstate_owner::operator=(rhs); - return *this; -} - -mincgstate::~mincgstate() -{ -} - - -/************************************************************************* - -*************************************************************************/ -_mincgreport_owner::_mincgreport_owner() -{ - p_struct = (alglib_impl::mincgreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::mincgreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_mincgreport_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_mincgreport_owner::_mincgreport_owner(const _mincgreport_owner &rhs) -{ - p_struct = (alglib_impl::mincgreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::mincgreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_mincgreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_mincgreport_owner& _mincgreport_owner::operator=(const _mincgreport_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_mincgreport_clear(p_struct); - if( !alglib_impl::_mincgreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_mincgreport_owner::~_mincgreport_owner() -{ - alglib_impl::_mincgreport_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::mincgreport* _mincgreport_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::mincgreport* _mincgreport_owner::c_ptr() const -{ - return const_cast(p_struct); -} -mincgreport::mincgreport() : _mincgreport_owner() ,iterationscount(p_struct->iterationscount),nfev(p_struct->nfev),varidx(p_struct->varidx),terminationtype(p_struct->terminationtype) -{ -} - -mincgreport::mincgreport(const mincgreport &rhs):_mincgreport_owner(rhs) ,iterationscount(p_struct->iterationscount),nfev(p_struct->nfev),varidx(p_struct->varidx),terminationtype(p_struct->terminationtype) -{ -} - -mincgreport& mincgreport::operator=(const mincgreport &rhs) -{ - if( this==&rhs ) - return *this; - _mincgreport_owner::operator=(rhs); - return *this; -} - -mincgreport::~mincgreport() -{ -} - -/************************************************************************* - NONLINEAR CONJUGATE GRADIENT METHOD - -DESCRIPTION: -The subroutine minimizes function F(x) of N arguments by using one of the -nonlinear conjugate gradient methods. - -These CG methods are globally convergent (even on non-convex functions) as -long as grad(f) is Lipschitz continuous in a some neighborhood of the -L = { x : f(x)<=f(x0) }. - - -REQUIREMENTS: -Algorithm will request following information during its operation: -* function value F and its gradient G (simultaneously) at given point X - - -USAGE: -1. User initializes algorithm state with MinCGCreate() call -2. User tunes solver parameters with MinCGSetCond(), MinCGSetStpMax() and - other functions -3. User calls MinCGOptimize() function which takes algorithm state and - pointer (delegate, etc.) to callback function which calculates F/G. -4. User calls MinCGResults() to get solution -5. Optionally, user may call MinCGRestartFrom() to solve another problem - with same N but another starting point and/or another function. - MinCGRestartFrom() allows to reuse already initialized structure. - - -INPUT PARAMETERS: - N - problem dimension, N>0: - * if given, only leading N elements of X are used - * if not given, automatically determined from size of X - X - starting point, array[0..N-1]. - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 25.03.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgcreate(const ae_int_t n, const real_1d_array &x, mincgstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mincgcreate(n, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* - NONLINEAR CONJUGATE GRADIENT METHOD - -DESCRIPTION: -The subroutine minimizes function F(x) of N arguments by using one of the -nonlinear conjugate gradient methods. - -These CG methods are globally convergent (even on non-convex functions) as -long as grad(f) is Lipschitz continuous in a some neighborhood of the -L = { x : f(x)<=f(x0) }. - - -REQUIREMENTS: -Algorithm will request following information during its operation: -* function value F and its gradient G (simultaneously) at given point X - - -USAGE: -1. User initializes algorithm state with MinCGCreate() call -2. User tunes solver parameters with MinCGSetCond(), MinCGSetStpMax() and - other functions -3. User calls MinCGOptimize() function which takes algorithm state and - pointer (delegate, etc.) to callback function which calculates F/G. -4. User calls MinCGResults() to get solution -5. Optionally, user may call MinCGRestartFrom() to solve another problem - with same N but another starting point and/or another function. - MinCGRestartFrom() allows to reuse already initialized structure. - - -INPUT PARAMETERS: - N - problem dimension, N>0: - * if given, only leading N elements of X are used - * if not given, automatically determined from size of X - X - starting point, array[0..N-1]. - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 25.03.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgcreate(const real_1d_array &x, mincgstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mincgcreate(n, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -The subroutine is finite difference variant of MinCGCreate(). It uses -finite differences in order to differentiate target function. - -Description below contains information which is specific to this function -only. We recommend to read comments on MinCGCreate() in order to get more -information about creation of CG optimizer. - -INPUT PARAMETERS: - N - problem dimension, N>0: - * if given, only leading N elements of X are used - * if not given, automatically determined from size of X - X - starting point, array[0..N-1]. - DiffStep- differentiation step, >0 - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -NOTES: -1. algorithm uses 4-point central formula for differentiation. -2. differentiation step along I-th axis is equal to DiffStep*S[I] where - S[] is scaling vector which can be set by MinCGSetScale() call. -3. we recommend you to use moderate values of differentiation step. Too - large step will result in too large truncation errors, while too small - step will result in too large numerical errors. 1.0E-6 can be good - value to start with. -4. Numerical differentiation is very inefficient - one gradient - calculation needs 4*N function evaluations. This function will work for - any N - either small (1...10), moderate (10...100) or large (100...). - However, performance penalty will be too severe for any N's except for - small ones. - We should also say that code which relies on numerical differentiation - is less robust and precise. L-BFGS needs exact gradient values. - Imprecise gradient may slow down convergence, especially on highly - nonlinear problems. - Thus we recommend to use this function for fast prototyping on small- - dimensional problems only, and to implement analytical gradient as soon - as possible. - - -- ALGLIB -- - Copyright 16.05.2011 by Bochkanov Sergey -*************************************************************************/ -void mincgcreatef(const ae_int_t n, const real_1d_array &x, const double diffstep, mincgstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mincgcreatef(n, const_cast(x.c_ptr()), diffstep, const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -The subroutine is finite difference variant of MinCGCreate(). It uses -finite differences in order to differentiate target function. - -Description below contains information which is specific to this function -only. We recommend to read comments on MinCGCreate() in order to get more -information about creation of CG optimizer. - -INPUT PARAMETERS: - N - problem dimension, N>0: - * if given, only leading N elements of X are used - * if not given, automatically determined from size of X - X - starting point, array[0..N-1]. - DiffStep- differentiation step, >0 - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -NOTES: -1. algorithm uses 4-point central formula for differentiation. -2. differentiation step along I-th axis is equal to DiffStep*S[I] where - S[] is scaling vector which can be set by MinCGSetScale() call. -3. we recommend you to use moderate values of differentiation step. Too - large step will result in too large truncation errors, while too small - step will result in too large numerical errors. 1.0E-6 can be good - value to start with. -4. Numerical differentiation is very inefficient - one gradient - calculation needs 4*N function evaluations. This function will work for - any N - either small (1...10), moderate (10...100) or large (100...). - However, performance penalty will be too severe for any N's except for - small ones. - We should also say that code which relies on numerical differentiation - is less robust and precise. L-BFGS needs exact gradient values. - Imprecise gradient may slow down convergence, especially on highly - nonlinear problems. - Thus we recommend to use this function for fast prototyping on small- - dimensional problems only, and to implement analytical gradient as soon - as possible. - - -- ALGLIB -- - Copyright 16.05.2011 by Bochkanov Sergey -*************************************************************************/ -void mincgcreatef(const real_1d_array &x, const double diffstep, mincgstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mincgcreatef(n, const_cast(x.c_ptr()), diffstep, const_cast(state.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets stopping conditions for CG optimization algorithm. - -INPUT PARAMETERS: - State - structure which stores algorithm state - EpsG - >=0 - The subroutine finishes its work if the condition - |v|=0 - The subroutine finishes its work if on k+1-th iteration - the condition |F(k+1)-F(k)|<=EpsF*max{|F(k)|,|F(k+1)|,1} - is satisfied. - EpsX - >=0 - The subroutine finishes its work if on k+1-th iteration - the condition |v|<=EpsX is fulfilled, where: - * |.| means Euclidian norm - * v - scaled step vector, v[i]=dx[i]/s[i] - * dx - ste pvector, dx=X(k+1)-X(k) - * s - scaling coefficients set by MinCGSetScale() - MaxIts - maximum number of iterations. If MaxIts=0, the number of - iterations is unlimited. - -Passing EpsG=0, EpsF=0, EpsX=0 and MaxIts=0 (simultaneously) will lead to -automatic stopping criterion selection (small EpsX). - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgsetcond(const mincgstate &state, const double epsg, const double epsf, const double epsx, const ae_int_t maxits) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mincgsetcond(const_cast(state.c_ptr()), epsg, epsf, epsx, maxits, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets scaling coefficients for CG optimizer. - -ALGLIB optimizers use scaling matrices to test stopping conditions (step -size and gradient are scaled before comparison with tolerances). Scale of -the I-th variable is a translation invariant measure of: -a) "how large" the variable is -b) how large the step should be to make significant changes in the function - -Scaling is also used by finite difference variant of CG optimizer - step -along I-th axis is equal to DiffStep*S[I]. - -In most optimizers (and in the CG too) scaling is NOT a form of -preconditioning. It just affects stopping conditions. You should set -preconditioner by separate call to one of the MinCGSetPrec...() functions. - -There is special preconditioning mode, however, which uses scaling -coefficients to form diagonal preconditioning matrix. You can turn this -mode on, if you want. But you should understand that scaling is not the -same thing as preconditioning - these are two different, although related -forms of tuning solver. - -INPUT PARAMETERS: - State - structure stores algorithm state - S - array[N], non-zero scaling coefficients - S[i] may be negative, sign doesn't matter. - - -- ALGLIB -- - Copyright 14.01.2011 by Bochkanov Sergey -*************************************************************************/ -void mincgsetscale(const mincgstate &state, const real_1d_array &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mincgsetscale(const_cast(state.c_ptr()), const_cast(s.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function turns on/off reporting. - -INPUT PARAMETERS: - State - structure which stores algorithm state - NeedXRep- whether iteration reports are needed or not - -If NeedXRep is True, algorithm will call rep() callback function if it is -provided to MinCGOptimize(). - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgsetxrep(const mincgstate &state, const bool needxrep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mincgsetxrep(const_cast(state.c_ptr()), needxrep, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets CG algorithm. - -INPUT PARAMETERS: - State - structure which stores algorithm state - CGType - algorithm type: - * -1 automatic selection of the best algorithm - * 0 DY (Dai and Yuan) algorithm - * 1 Hybrid DY-HS algorithm - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgsetcgtype(const mincgstate &state, const ae_int_t cgtype) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mincgsetcgtype(const_cast(state.c_ptr()), cgtype, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets maximum step length - -INPUT PARAMETERS: - State - structure which stores algorithm state - StpMax - maximum step length, >=0. Set StpMax to 0.0, if you don't - want to limit step length. - -Use this subroutine when you optimize target function which contains exp() -or other fast growing functions, and optimization algorithm makes too -large steps which leads to overflow. This function allows us to reject -steps that are too large (and therefore expose us to the possible -overflow) without actually calculating function value at the x+stp*d. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgsetstpmax(const mincgstate &state, const double stpmax) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mincgsetstpmax(const_cast(state.c_ptr()), stpmax, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function allows to suggest initial step length to the CG algorithm. - -Suggested step length is used as starting point for the line search. It -can be useful when you have badly scaled problem, i.e. when ||grad|| -(which is used as initial estimate for the first step) is many orders of -magnitude different from the desired step. - -Line search may fail on such problems without good estimate of initial -step length. Imagine, for example, problem with ||grad||=10^50 and desired -step equal to 0.1 Line search function will use 10^50 as initial step, -then it will decrease step length by 2 (up to 20 attempts) and will get -10^44, which is still too large. - -This function allows us to tell than line search should be started from -some moderate step length, like 1.0, so algorithm will be able to detect -desired step length in a several searches. - -Default behavior (when no step is suggested) is to use preconditioner, if -it is available, to generate initial estimate of step length. - -This function influences only first iteration of algorithm. It should be -called between MinCGCreate/MinCGRestartFrom() call and MinCGOptimize call. -Suggested step is ignored if you have preconditioner. - -INPUT PARAMETERS: - State - structure used to store algorithm state. - Stp - initial estimate of the step length. - Can be zero (no estimate). - - -- ALGLIB -- - Copyright 30.07.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgsuggeststep(const mincgstate &state, const double stp) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mincgsuggeststep(const_cast(state.c_ptr()), stp, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Modification of the preconditioner: preconditioning is turned off. - -INPUT PARAMETERS: - State - structure which stores algorithm state - -NOTE: you can change preconditioner "on the fly", during algorithm -iterations. - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgsetprecdefault(const mincgstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mincgsetprecdefault(const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Modification of the preconditioner: diagonal of approximate Hessian is -used. - -INPUT PARAMETERS: - State - structure which stores algorithm state - D - diagonal of the approximate Hessian, array[0..N-1], - (if larger, only leading N elements are used). - -NOTE: you can change preconditioner "on the fly", during algorithm -iterations. - -NOTE 2: D[i] should be positive. Exception will be thrown otherwise. - -NOTE 3: you should pass diagonal of approximate Hessian - NOT ITS INVERSE. - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgsetprecdiag(const mincgstate &state, const real_1d_array &d) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mincgsetprecdiag(const_cast(state.c_ptr()), const_cast(d.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Modification of the preconditioner: scale-based diagonal preconditioning. - -This preconditioning mode can be useful when you don't have approximate -diagonal of Hessian, but you know that your variables are badly scaled -(for example, one variable is in [1,10], and another in [1000,100000]), -and most part of the ill-conditioning comes from different scales of vars. - -In this case simple scale-based preconditioner, with H[i] = 1/(s[i]^2), -can greatly improve convergence. - -IMPRTANT: you should set scale of your variables with MinCGSetScale() call -(before or after MinCGSetPrecScale() call). Without knowledge of the scale -of your variables scale-based preconditioner will be just unit matrix. - -INPUT PARAMETERS: - State - structure which stores algorithm state - -NOTE: you can change preconditioner "on the fly", during algorithm -iterations. - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgsetprecscale(const mincgstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mincgsetprecscale(const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function provides reverse communication interface -Reverse communication interface is not documented or recommended to use. -See below for functions which provide better documented API -*************************************************************************/ -bool mincgiteration(const mincgstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::mincgiteration(const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void mincgoptimize(mincgstate &state, - void (*func)(const real_1d_array &x, double &func, void *ptr), - void (*rep)(const real_1d_array &x, double func, void *ptr), - void *ptr) -{ - alglib_impl::ae_state _alglib_env_state; - if( func==NULL ) - throw ap_error("ALGLIB: error in 'mincgoptimize()' (func is NULL)"); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - while( alglib_impl::mincgiteration(state.c_ptr(), &_alglib_env_state) ) - { - if( state.needf ) - { - func(state.x, state.f, ptr); - continue; - } - if( state.xupdated ) - { - if( rep!=NULL ) - rep(state.x, state.f, ptr); - continue; - } - throw ap_error("ALGLIB: error in 'mincgoptimize' (some derivatives were not provided?)"); - } - alglib_impl::ae_state_clear(&_alglib_env_state); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void mincgoptimize(mincgstate &state, - void (*grad)(const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), - void (*rep)(const real_1d_array &x, double func, void *ptr), - void *ptr) -{ - alglib_impl::ae_state _alglib_env_state; - if( grad==NULL ) - throw ap_error("ALGLIB: error in 'mincgoptimize()' (grad is NULL)"); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - while( alglib_impl::mincgiteration(state.c_ptr(), &_alglib_env_state) ) - { - if( state.needfg ) - { - grad(state.x, state.f, state.g, ptr); - continue; - } - if( state.xupdated ) - { - if( rep!=NULL ) - rep(state.x, state.f, ptr); - continue; - } - throw ap_error("ALGLIB: error in 'mincgoptimize' (some derivatives were not provided?)"); - } - alglib_impl::ae_state_clear(&_alglib_env_state); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - - -/************************************************************************* -Conjugate gradient results - -INPUT PARAMETERS: - State - algorithm state - -OUTPUT PARAMETERS: - X - array[0..N-1], solution - Rep - optimization report: - * Rep.TerminationType completion code: - * -7 gradient verification failed. - See MinCGSetGradientCheck() for more information. - * 1 relative function improvement is no more than - EpsF. - * 2 relative step is no more than EpsX. - * 4 gradient norm is no more than EpsG - * 5 MaxIts steps was taken - * 7 stopping conditions are too stringent, - further improvement is impossible, - we return best X found so far - * 8 terminated by user - * Rep.IterationsCount contains iterations count - * NFEV contains number of function calculations - - -- ALGLIB -- - Copyright 20.04.2009 by Bochkanov Sergey -*************************************************************************/ -void mincgresults(const mincgstate &state, real_1d_array &x, mincgreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mincgresults(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Conjugate gradient results - -Buffered implementation of MinCGResults(), which uses pre-allocated buffer -to store X[]. If buffer size is too small, it resizes buffer. It is -intended to be used in the inner cycles of performance critical algorithms -where array reallocation penalty is too large to be ignored. - - -- ALGLIB -- - Copyright 20.04.2009 by Bochkanov Sergey -*************************************************************************/ -void mincgresultsbuf(const mincgstate &state, real_1d_array &x, mincgreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mincgresultsbuf(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine restarts CG algorithm from new point. All optimization -parameters are left unchanged. - -This function allows to solve multiple optimization problems (which -must have same number of dimensions) without object reallocation penalty. - -INPUT PARAMETERS: - State - structure used to store algorithm state. - X - new starting point. - - -- ALGLIB -- - Copyright 30.07.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgrestartfrom(const mincgstate &state, const real_1d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mincgrestartfrom(const_cast(state.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* - -This subroutine turns on verification of the user-supplied analytic -gradient: -* user calls this subroutine before optimization begins -* MinCGOptimize() is called -* prior to actual optimization, for each component of parameters being - optimized X[i] algorithm performs following steps: - * two trial steps are made to X[i]-TestStep*S[i] and X[i]+TestStep*S[i], - where X[i] is i-th component of the initial point and S[i] is a scale - of i-th parameter - * F(X) is evaluated at these trial points - * we perform one more evaluation in the middle point of the interval - * we build cubic model using function values and derivatives at trial - points and we compare its prediction with actual value in the middle - point - * in case difference between prediction and actual value is higher than - some predetermined threshold, algorithm stops with completion code -7; - Rep.VarIdx is set to index of the parameter with incorrect derivative. -* after verification is over, algorithm proceeds to the actual optimization. - -NOTE 1: verification needs N (parameters count) gradient evaluations. It - is very costly and you should use it only for low dimensional - problems, when you want to be sure that you've correctly - calculated analytic derivatives. You should not use it in the - production code (unless you want to check derivatives provided by - some third party). - -NOTE 2: you should carefully choose TestStep. Value which is too large - (so large that function behaviour is significantly non-cubic) will - lead to false alarms. You may use different step for different - parameters by means of setting scale with MinCGSetScale(). - -NOTE 3: this function may lead to false positives. In case it reports that - I-th derivative was calculated incorrectly, you may decrease test - step and try one more time - maybe your function changes too - sharply and your step is too large for such rapidly chanding - function. - -INPUT PARAMETERS: - State - structure used to store algorithm state - TestStep - verification step: - * TestStep=0 turns verification off - * TestStep>0 activates verification - - -- ALGLIB -- - Copyright 31.05.2012 by Bochkanov Sergey -*************************************************************************/ -void mincgsetgradientcheck(const mincgstate &state, const double teststep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mincgsetgradientcheck(const_cast(state.c_ptr()), teststep, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This object stores nonlinear optimizer state. -You should use functions provided by MinBLEIC subpackage to work with this -object -*************************************************************************/ -_minbleicstate_owner::_minbleicstate_owner() -{ - p_struct = (alglib_impl::minbleicstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::minbleicstate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_minbleicstate_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_minbleicstate_owner::_minbleicstate_owner(const _minbleicstate_owner &rhs) -{ - p_struct = (alglib_impl::minbleicstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::minbleicstate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_minbleicstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_minbleicstate_owner& _minbleicstate_owner::operator=(const _minbleicstate_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_minbleicstate_clear(p_struct); - if( !alglib_impl::_minbleicstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_minbleicstate_owner::~_minbleicstate_owner() -{ - alglib_impl::_minbleicstate_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::minbleicstate* _minbleicstate_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::minbleicstate* _minbleicstate_owner::c_ptr() const -{ - return const_cast(p_struct); -} -minbleicstate::minbleicstate() : _minbleicstate_owner() ,needf(p_struct->needf),needfg(p_struct->needfg),xupdated(p_struct->xupdated),f(p_struct->f),g(&p_struct->g),x(&p_struct->x) -{ -} - -minbleicstate::minbleicstate(const minbleicstate &rhs):_minbleicstate_owner(rhs) ,needf(p_struct->needf),needfg(p_struct->needfg),xupdated(p_struct->xupdated),f(p_struct->f),g(&p_struct->g),x(&p_struct->x) -{ -} - -minbleicstate& minbleicstate::operator=(const minbleicstate &rhs) -{ - if( this==&rhs ) - return *this; - _minbleicstate_owner::operator=(rhs); - return *this; -} - -minbleicstate::~minbleicstate() -{ -} - - -/************************************************************************* -This structure stores optimization report: -* IterationsCount number of iterations -* NFEV number of gradient evaluations -* TerminationType termination type (see below) - -TERMINATION CODES - -TerminationType field contains completion code, which can be: - -7 gradient verification failed. - See MinBLEICSetGradientCheck() for more information. - -3 inconsistent constraints. Feasible point is - either nonexistent or too hard to find. Try to - restart optimizer with better initial approximation - 1 relative function improvement is no more than EpsF. - 2 relative step is no more than EpsX. - 4 gradient norm is no more than EpsG - 5 MaxIts steps was taken - 7 stopping conditions are too stringent, - further improvement is impossible, - X contains best point found so far. - -ADDITIONAL FIELDS - -There are additional fields which can be used for debugging: -* DebugEqErr error in the equality constraints (2-norm) -* DebugFS f, calculated at projection of initial point - to the feasible set -* DebugFF f, calculated at the final point -* DebugDX |X_start-X_final| -*************************************************************************/ -_minbleicreport_owner::_minbleicreport_owner() -{ - p_struct = (alglib_impl::minbleicreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::minbleicreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_minbleicreport_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_minbleicreport_owner::_minbleicreport_owner(const _minbleicreport_owner &rhs) -{ - p_struct = (alglib_impl::minbleicreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::minbleicreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_minbleicreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_minbleicreport_owner& _minbleicreport_owner::operator=(const _minbleicreport_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_minbleicreport_clear(p_struct); - if( !alglib_impl::_minbleicreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_minbleicreport_owner::~_minbleicreport_owner() -{ - alglib_impl::_minbleicreport_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::minbleicreport* _minbleicreport_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::minbleicreport* _minbleicreport_owner::c_ptr() const -{ - return const_cast(p_struct); -} -minbleicreport::minbleicreport() : _minbleicreport_owner() ,iterationscount(p_struct->iterationscount),nfev(p_struct->nfev),varidx(p_struct->varidx),terminationtype(p_struct->terminationtype),debugeqerr(p_struct->debugeqerr),debugfs(p_struct->debugfs),debugff(p_struct->debugff),debugdx(p_struct->debugdx),debugfeasqpits(p_struct->debugfeasqpits),debugfeasgpaits(p_struct->debugfeasgpaits),inneriterationscount(p_struct->inneriterationscount),outeriterationscount(p_struct->outeriterationscount) -{ -} - -minbleicreport::minbleicreport(const minbleicreport &rhs):_minbleicreport_owner(rhs) ,iterationscount(p_struct->iterationscount),nfev(p_struct->nfev),varidx(p_struct->varidx),terminationtype(p_struct->terminationtype),debugeqerr(p_struct->debugeqerr),debugfs(p_struct->debugfs),debugff(p_struct->debugff),debugdx(p_struct->debugdx),debugfeasqpits(p_struct->debugfeasqpits),debugfeasgpaits(p_struct->debugfeasgpaits),inneriterationscount(p_struct->inneriterationscount),outeriterationscount(p_struct->outeriterationscount) -{ -} - -minbleicreport& minbleicreport::operator=(const minbleicreport &rhs) -{ - if( this==&rhs ) - return *this; - _minbleicreport_owner::operator=(rhs); - return *this; -} - -minbleicreport::~minbleicreport() -{ -} - -/************************************************************************* - BOUND CONSTRAINED OPTIMIZATION - WITH ADDITIONAL LINEAR EQUALITY AND INEQUALITY CONSTRAINTS - -DESCRIPTION: -The subroutine minimizes function F(x) of N arguments subject to any -combination of: -* bound constraints -* linear inequality constraints -* linear equality constraints - -REQUIREMENTS: -* user must provide function value and gradient -* starting point X0 must be feasible or - not too far away from the feasible set -* grad(f) must be Lipschitz continuous on a level set: - L = { x : f(x)<=f(x0) } -* function must be defined everywhere on the feasible set F - -USAGE: - -Constrained optimization if far more complex than the unconstrained one. -Here we give very brief outline of the BLEIC optimizer. We strongly recommend -you to read examples in the ALGLIB Reference Manual and to read ALGLIB User Guide -on optimization, which is available at http://www.alglib.net/optimization/ - -1. User initializes algorithm state with MinBLEICCreate() call - -2. USer adds boundary and/or linear constraints by calling - MinBLEICSetBC() and MinBLEICSetLC() functions. - -3. User sets stopping conditions with MinBLEICSetCond(). - -4. User calls MinBLEICOptimize() function which takes algorithm state and - pointer (delegate, etc.) to callback function which calculates F/G. - -5. User calls MinBLEICResults() to get solution - -6. Optionally user may call MinBLEICRestartFrom() to solve another problem - with same N but another starting point. - MinBLEICRestartFrom() allows to reuse already initialized structure. - - -INPUT PARAMETERS: - N - problem dimension, N>0: - * if given, only leading N elements of X are used - * if not given, automatically determined from size ofX - X - starting point, array[N]: - * it is better to set X to a feasible point - * but X can be infeasible, in which case algorithm will try - to find feasible point first, using X as initial - approximation. - -OUTPUT PARAMETERS: - State - structure stores algorithm state - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleiccreate(const ae_int_t n, const real_1d_array &x, minbleicstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minbleiccreate(n, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* - BOUND CONSTRAINED OPTIMIZATION - WITH ADDITIONAL LINEAR EQUALITY AND INEQUALITY CONSTRAINTS - -DESCRIPTION: -The subroutine minimizes function F(x) of N arguments subject to any -combination of: -* bound constraints -* linear inequality constraints -* linear equality constraints - -REQUIREMENTS: -* user must provide function value and gradient -* starting point X0 must be feasible or - not too far away from the feasible set -* grad(f) must be Lipschitz continuous on a level set: - L = { x : f(x)<=f(x0) } -* function must be defined everywhere on the feasible set F - -USAGE: - -Constrained optimization if far more complex than the unconstrained one. -Here we give very brief outline of the BLEIC optimizer. We strongly recommend -you to read examples in the ALGLIB Reference Manual and to read ALGLIB User Guide -on optimization, which is available at http://www.alglib.net/optimization/ - -1. User initializes algorithm state with MinBLEICCreate() call - -2. USer adds boundary and/or linear constraints by calling - MinBLEICSetBC() and MinBLEICSetLC() functions. - -3. User sets stopping conditions with MinBLEICSetCond(). - -4. User calls MinBLEICOptimize() function which takes algorithm state and - pointer (delegate, etc.) to callback function which calculates F/G. - -5. User calls MinBLEICResults() to get solution - -6. Optionally user may call MinBLEICRestartFrom() to solve another problem - with same N but another starting point. - MinBLEICRestartFrom() allows to reuse already initialized structure. - - -INPUT PARAMETERS: - N - problem dimension, N>0: - * if given, only leading N elements of X are used - * if not given, automatically determined from size ofX - X - starting point, array[N]: - * it is better to set X to a feasible point - * but X can be infeasible, in which case algorithm will try - to find feasible point first, using X as initial - approximation. - -OUTPUT PARAMETERS: - State - structure stores algorithm state - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleiccreate(const real_1d_array &x, minbleicstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minbleiccreate(n, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -The subroutine is finite difference variant of MinBLEICCreate(). It uses -finite differences in order to differentiate target function. - -Description below contains information which is specific to this function -only. We recommend to read comments on MinBLEICCreate() in order to get -more information about creation of BLEIC optimizer. - -INPUT PARAMETERS: - N - problem dimension, N>0: - * if given, only leading N elements of X are used - * if not given, automatically determined from size of X - X - starting point, array[0..N-1]. - DiffStep- differentiation step, >0 - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -NOTES: -1. algorithm uses 4-point central formula for differentiation. -2. differentiation step along I-th axis is equal to DiffStep*S[I] where - S[] is scaling vector which can be set by MinBLEICSetScale() call. -3. we recommend you to use moderate values of differentiation step. Too - large step will result in too large truncation errors, while too small - step will result in too large numerical errors. 1.0E-6 can be good - value to start with. -4. Numerical differentiation is very inefficient - one gradient - calculation needs 4*N function evaluations. This function will work for - any N - either small (1...10), moderate (10...100) or large (100...). - However, performance penalty will be too severe for any N's except for - small ones. - We should also say that code which relies on numerical differentiation - is less robust and precise. CG needs exact gradient values. Imprecise - gradient may slow down convergence, especially on highly nonlinear - problems. - Thus we recommend to use this function for fast prototyping on small- - dimensional problems only, and to implement analytical gradient as soon - as possible. - - -- ALGLIB -- - Copyright 16.05.2011 by Bochkanov Sergey -*************************************************************************/ -void minbleiccreatef(const ae_int_t n, const real_1d_array &x, const double diffstep, minbleicstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minbleiccreatef(n, const_cast(x.c_ptr()), diffstep, const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -The subroutine is finite difference variant of MinBLEICCreate(). It uses -finite differences in order to differentiate target function. - -Description below contains information which is specific to this function -only. We recommend to read comments on MinBLEICCreate() in order to get -more information about creation of BLEIC optimizer. - -INPUT PARAMETERS: - N - problem dimension, N>0: - * if given, only leading N elements of X are used - * if not given, automatically determined from size of X - X - starting point, array[0..N-1]. - DiffStep- differentiation step, >0 - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -NOTES: -1. algorithm uses 4-point central formula for differentiation. -2. differentiation step along I-th axis is equal to DiffStep*S[I] where - S[] is scaling vector which can be set by MinBLEICSetScale() call. -3. we recommend you to use moderate values of differentiation step. Too - large step will result in too large truncation errors, while too small - step will result in too large numerical errors. 1.0E-6 can be good - value to start with. -4. Numerical differentiation is very inefficient - one gradient - calculation needs 4*N function evaluations. This function will work for - any N - either small (1...10), moderate (10...100) or large (100...). - However, performance penalty will be too severe for any N's except for - small ones. - We should also say that code which relies on numerical differentiation - is less robust and precise. CG needs exact gradient values. Imprecise - gradient may slow down convergence, especially on highly nonlinear - problems. - Thus we recommend to use this function for fast prototyping on small- - dimensional problems only, and to implement analytical gradient as soon - as possible. - - -- ALGLIB -- - Copyright 16.05.2011 by Bochkanov Sergey -*************************************************************************/ -void minbleiccreatef(const real_1d_array &x, const double diffstep, minbleicstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minbleiccreatef(n, const_cast(x.c_ptr()), diffstep, const_cast(state.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets boundary constraints for BLEIC optimizer. - -Boundary constraints are inactive by default (after initial creation). -They are preserved after algorithm restart with MinBLEICRestartFrom(). - -INPUT PARAMETERS: - State - structure stores algorithm state - BndL - lower bounds, array[N]. - If some (all) variables are unbounded, you may specify - very small number or -INF. - BndU - upper bounds, array[N]. - If some (all) variables are unbounded, you may specify - very large number or +INF. - -NOTE 1: it is possible to specify BndL[i]=BndU[i]. In this case I-th -variable will be "frozen" at X[i]=BndL[i]=BndU[i]. - -NOTE 2: this solver has following useful properties: -* bound constraints are always satisfied exactly -* function is evaluated only INSIDE area specified by bound constraints, - even when numerical differentiation is used (algorithm adjusts nodes - according to boundary constraints) - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetbc(const minbleicstate &state, const real_1d_array &bndl, const real_1d_array &bndu) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minbleicsetbc(const_cast(state.c_ptr()), const_cast(bndl.c_ptr()), const_cast(bndu.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets linear constraints for BLEIC optimizer. - -Linear constraints are inactive by default (after initial creation). -They are preserved after algorithm restart with MinBLEICRestartFrom(). - -INPUT PARAMETERS: - State - structure previously allocated with MinBLEICCreate call. - C - linear constraints, array[K,N+1]. - Each row of C represents one constraint, either equality - or inequality (see below): - * first N elements correspond to coefficients, - * last element corresponds to the right part. - All elements of C (including right part) must be finite. - CT - type of constraints, array[K]: - * if CT[i]>0, then I-th constraint is C[i,*]*x >= C[i,n+1] - * if CT[i]=0, then I-th constraint is C[i,*]*x = C[i,n+1] - * if CT[i]<0, then I-th constraint is C[i,*]*x <= C[i,n+1] - K - number of equality/inequality constraints, K>=0: - * if given, only leading K elements of C/CT are used - * if not given, automatically determined from sizes of C/CT - -NOTE 1: linear (non-bound) constraints are satisfied only approximately: -* there always exists some minor violation (about Epsilon in magnitude) - due to rounding errors -* numerical differentiation, if used, may lead to function evaluations - outside of the feasible area, because algorithm does NOT change - numerical differentiation formula according to linear constraints. -If you want constraints to be satisfied exactly, try to reformulate your -problem in such manner that all constraints will become boundary ones -(this kind of constraints is always satisfied exactly, both in the final -solution and in all intermediate points). - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetlc(const minbleicstate &state, const real_2d_array &c, const integer_1d_array &ct, const ae_int_t k) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minbleicsetlc(const_cast(state.c_ptr()), const_cast(c.c_ptr()), const_cast(ct.c_ptr()), k, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets linear constraints for BLEIC optimizer. - -Linear constraints are inactive by default (after initial creation). -They are preserved after algorithm restart with MinBLEICRestartFrom(). - -INPUT PARAMETERS: - State - structure previously allocated with MinBLEICCreate call. - C - linear constraints, array[K,N+1]. - Each row of C represents one constraint, either equality - or inequality (see below): - * first N elements correspond to coefficients, - * last element corresponds to the right part. - All elements of C (including right part) must be finite. - CT - type of constraints, array[K]: - * if CT[i]>0, then I-th constraint is C[i,*]*x >= C[i,n+1] - * if CT[i]=0, then I-th constraint is C[i,*]*x = C[i,n+1] - * if CT[i]<0, then I-th constraint is C[i,*]*x <= C[i,n+1] - K - number of equality/inequality constraints, K>=0: - * if given, only leading K elements of C/CT are used - * if not given, automatically determined from sizes of C/CT - -NOTE 1: linear (non-bound) constraints are satisfied only approximately: -* there always exists some minor violation (about Epsilon in magnitude) - due to rounding errors -* numerical differentiation, if used, may lead to function evaluations - outside of the feasible area, because algorithm does NOT change - numerical differentiation formula according to linear constraints. -If you want constraints to be satisfied exactly, try to reformulate your -problem in such manner that all constraints will become boundary ones -(this kind of constraints is always satisfied exactly, both in the final -solution and in all intermediate points). - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetlc(const minbleicstate &state, const real_2d_array &c, const integer_1d_array &ct) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t k; - if( (c.rows()!=ct.length())) - throw ap_error("Error while calling 'minbleicsetlc': looks like one of arguments has wrong size"); - k = c.rows(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minbleicsetlc(const_cast(state.c_ptr()), const_cast(c.c_ptr()), const_cast(ct.c_ptr()), k, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets stopping conditions for the optimizer. - -INPUT PARAMETERS: - State - structure which stores algorithm state - EpsG - >=0 - The subroutine finishes its work if the condition - |v|=0 - The subroutine finishes its work if on k+1-th iteration - the condition |F(k+1)-F(k)|<=EpsF*max{|F(k)|,|F(k+1)|,1} - is satisfied. - EpsX - >=0 - The subroutine finishes its work if on k+1-th iteration - the condition |v|<=EpsX is fulfilled, where: - * |.| means Euclidian norm - * v - scaled step vector, v[i]=dx[i]/s[i] - * dx - step vector, dx=X(k+1)-X(k) - * s - scaling coefficients set by MinBLEICSetScale() - MaxIts - maximum number of iterations. If MaxIts=0, the number of - iterations is unlimited. - -Passing EpsG=0, EpsF=0 and EpsX=0 and MaxIts=0 (simultaneously) will lead -to automatic stopping criterion selection. - -NOTE: when SetCond() called with non-zero MaxIts, BLEIC solver may perform - slightly more than MaxIts iterations. I.e., MaxIts sets non-strict - limit on iterations count. - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetcond(const minbleicstate &state, const double epsg, const double epsf, const double epsx, const ae_int_t maxits) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minbleicsetcond(const_cast(state.c_ptr()), epsg, epsf, epsx, maxits, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets scaling coefficients for BLEIC optimizer. - -ALGLIB optimizers use scaling matrices to test stopping conditions (step -size and gradient are scaled before comparison with tolerances). Scale of -the I-th variable is a translation invariant measure of: -a) "how large" the variable is -b) how large the step should be to make significant changes in the function - -Scaling is also used by finite difference variant of the optimizer - step -along I-th axis is equal to DiffStep*S[I]. - -In most optimizers (and in the BLEIC too) scaling is NOT a form of -preconditioning. It just affects stopping conditions. You should set -preconditioner by separate call to one of the MinBLEICSetPrec...() -functions. - -There is a special preconditioning mode, however, which uses scaling -coefficients to form diagonal preconditioning matrix. You can turn this -mode on, if you want. But you should understand that scaling is not the -same thing as preconditioning - these are two different, although related -forms of tuning solver. - -INPUT PARAMETERS: - State - structure stores algorithm state - S - array[N], non-zero scaling coefficients - S[i] may be negative, sign doesn't matter. - - -- ALGLIB -- - Copyright 14.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetscale(const minbleicstate &state, const real_1d_array &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minbleicsetscale(const_cast(state.c_ptr()), const_cast(s.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Modification of the preconditioner: preconditioning is turned off. - -INPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetprecdefault(const minbleicstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minbleicsetprecdefault(const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Modification of the preconditioner: diagonal of approximate Hessian is -used. - -INPUT PARAMETERS: - State - structure which stores algorithm state - D - diagonal of the approximate Hessian, array[0..N-1], - (if larger, only leading N elements are used). - -NOTE 1: D[i] should be positive. Exception will be thrown otherwise. - -NOTE 2: you should pass diagonal of approximate Hessian - NOT ITS INVERSE. - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetprecdiag(const minbleicstate &state, const real_1d_array &d) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minbleicsetprecdiag(const_cast(state.c_ptr()), const_cast(d.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Modification of the preconditioner: scale-based diagonal preconditioning. - -This preconditioning mode can be useful when you don't have approximate -diagonal of Hessian, but you know that your variables are badly scaled -(for example, one variable is in [1,10], and another in [1000,100000]), -and most part of the ill-conditioning comes from different scales of vars. - -In this case simple scale-based preconditioner, with H[i] = 1/(s[i]^2), -can greatly improve convergence. - -IMPRTANT: you should set scale of your variables with MinBLEICSetScale() -call (before or after MinBLEICSetPrecScale() call). Without knowledge of -the scale of your variables scale-based preconditioner will be just unit -matrix. - -INPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetprecscale(const minbleicstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minbleicsetprecscale(const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function turns on/off reporting. - -INPUT PARAMETERS: - State - structure which stores algorithm state - NeedXRep- whether iteration reports are needed or not - -If NeedXRep is True, algorithm will call rep() callback function if it is -provided to MinBLEICOptimize(). - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetxrep(const minbleicstate &state, const bool needxrep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minbleicsetxrep(const_cast(state.c_ptr()), needxrep, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets maximum step length - -IMPORTANT: this feature is hard to combine with preconditioning. You can't -set upper limit on step length, when you solve optimization problem with -linear (non-boundary) constraints AND preconditioner turned on. - -When non-boundary constraints are present, you have to either a) use -preconditioner, or b) use upper limit on step length. YOU CAN'T USE BOTH! -In this case algorithm will terminate with appropriate error code. - -INPUT PARAMETERS: - State - structure which stores algorithm state - StpMax - maximum step length, >=0. Set StpMax to 0.0, if you don't - want to limit step length. - -Use this subroutine when you optimize target function which contains exp() -or other fast growing functions, and optimization algorithm makes too -large steps which lead to overflow. This function allows us to reject -steps that are too large (and therefore expose us to the possible -overflow) without actually calculating function value at the x+stp*d. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetstpmax(const minbleicstate &state, const double stpmax) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minbleicsetstpmax(const_cast(state.c_ptr()), stpmax, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function provides reverse communication interface -Reverse communication interface is not documented or recommended to use. -See below for functions which provide better documented API -*************************************************************************/ -bool minbleiciteration(const minbleicstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::minbleiciteration(const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void minbleicoptimize(minbleicstate &state, - void (*func)(const real_1d_array &x, double &func, void *ptr), - void (*rep)(const real_1d_array &x, double func, void *ptr), - void *ptr) -{ - alglib_impl::ae_state _alglib_env_state; - if( func==NULL ) - throw ap_error("ALGLIB: error in 'minbleicoptimize()' (func is NULL)"); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - while( alglib_impl::minbleiciteration(state.c_ptr(), &_alglib_env_state) ) - { - if( state.needf ) - { - func(state.x, state.f, ptr); - continue; - } - if( state.xupdated ) - { - if( rep!=NULL ) - rep(state.x, state.f, ptr); - continue; - } - throw ap_error("ALGLIB: error in 'minbleicoptimize' (some derivatives were not provided?)"); - } - alglib_impl::ae_state_clear(&_alglib_env_state); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void minbleicoptimize(minbleicstate &state, - void (*grad)(const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), - void (*rep)(const real_1d_array &x, double func, void *ptr), - void *ptr) -{ - alglib_impl::ae_state _alglib_env_state; - if( grad==NULL ) - throw ap_error("ALGLIB: error in 'minbleicoptimize()' (grad is NULL)"); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - while( alglib_impl::minbleiciteration(state.c_ptr(), &_alglib_env_state) ) - { - if( state.needfg ) - { - grad(state.x, state.f, state.g, ptr); - continue; - } - if( state.xupdated ) - { - if( rep!=NULL ) - rep(state.x, state.f, ptr); - continue; - } - throw ap_error("ALGLIB: error in 'minbleicoptimize' (some derivatives were not provided?)"); - } - alglib_impl::ae_state_clear(&_alglib_env_state); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - - -/************************************************************************* -BLEIC results - -INPUT PARAMETERS: - State - algorithm state - -OUTPUT PARAMETERS: - X - array[0..N-1], solution - Rep - optimization report. You should check Rep.TerminationType - in order to distinguish successful termination from - unsuccessful one: - * -7 gradient verification failed. - See MinBLEICSetGradientCheck() for more information. - * -3 inconsistent constraints. Feasible point is - either nonexistent or too hard to find. Try to - restart optimizer with better initial approximation - * 1 relative function improvement is no more than EpsF. - * 2 scaled step is no more than EpsX. - * 4 scaled gradient norm is no more than EpsG. - * 5 MaxIts steps was taken - More information about fields of this structure can be - found in the comments on MinBLEICReport datatype. - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicresults(const minbleicstate &state, real_1d_array &x, minbleicreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minbleicresults(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -BLEIC results - -Buffered implementation of MinBLEICResults() which uses pre-allocated buffer -to store X[]. If buffer size is too small, it resizes buffer. It is -intended to be used in the inner cycles of performance critical algorithms -where array reallocation penalty is too large to be ignored. - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicresultsbuf(const minbleicstate &state, real_1d_array &x, minbleicreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minbleicresultsbuf(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine restarts algorithm from new point. -All optimization parameters (including constraints) are left unchanged. - -This function allows to solve multiple optimization problems (which -must have same number of dimensions) without object reallocation penalty. - -INPUT PARAMETERS: - State - structure previously allocated with MinBLEICCreate call. - X - new starting point. - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicrestartfrom(const minbleicstate &state, const real_1d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minbleicrestartfrom(const_cast(state.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine turns on verification of the user-supplied analytic -gradient: -* user calls this subroutine before optimization begins -* MinBLEICOptimize() is called -* prior to actual optimization, for each component of parameters being - optimized X[i] algorithm performs following steps: - * two trial steps are made to X[i]-TestStep*S[i] and X[i]+TestStep*S[i], - where X[i] is i-th component of the initial point and S[i] is a scale - of i-th parameter - * if needed, steps are bounded with respect to constraints on X[] - * F(X) is evaluated at these trial points - * we perform one more evaluation in the middle point of the interval - * we build cubic model using function values and derivatives at trial - points and we compare its prediction with actual value in the middle - point - * in case difference between prediction and actual value is higher than - some predetermined threshold, algorithm stops with completion code -7; - Rep.VarIdx is set to index of the parameter with incorrect derivative. -* after verification is over, algorithm proceeds to the actual optimization. - -NOTE 1: verification needs N (parameters count) gradient evaluations. It - is very costly and you should use it only for low dimensional - problems, when you want to be sure that you've correctly - calculated analytic derivatives. You should not use it in the - production code (unless you want to check derivatives provided by - some third party). - -NOTE 2: you should carefully choose TestStep. Value which is too large - (so large that function behaviour is significantly non-cubic) will - lead to false alarms. You may use different step for different - parameters by means of setting scale with MinBLEICSetScale(). - -NOTE 3: this function may lead to false positives. In case it reports that - I-th derivative was calculated incorrectly, you may decrease test - step and try one more time - maybe your function changes too - sharply and your step is too large for such rapidly chanding - function. - -INPUT PARAMETERS: - State - structure used to store algorithm state - TestStep - verification step: - * TestStep=0 turns verification off - * TestStep>0 activates verification - - -- ALGLIB -- - Copyright 15.06.2012 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetgradientcheck(const minbleicstate &state, const double teststep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minbleicsetgradientcheck(const_cast(state.c_ptr()), teststep, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* - -*************************************************************************/ -_minlbfgsstate_owner::_minlbfgsstate_owner() -{ - p_struct = (alglib_impl::minlbfgsstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::minlbfgsstate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_minlbfgsstate_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_minlbfgsstate_owner::_minlbfgsstate_owner(const _minlbfgsstate_owner &rhs) -{ - p_struct = (alglib_impl::minlbfgsstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::minlbfgsstate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_minlbfgsstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_minlbfgsstate_owner& _minlbfgsstate_owner::operator=(const _minlbfgsstate_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_minlbfgsstate_clear(p_struct); - if( !alglib_impl::_minlbfgsstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_minlbfgsstate_owner::~_minlbfgsstate_owner() -{ - alglib_impl::_minlbfgsstate_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::minlbfgsstate* _minlbfgsstate_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::minlbfgsstate* _minlbfgsstate_owner::c_ptr() const -{ - return const_cast(p_struct); -} -minlbfgsstate::minlbfgsstate() : _minlbfgsstate_owner() ,needf(p_struct->needf),needfg(p_struct->needfg),xupdated(p_struct->xupdated),f(p_struct->f),g(&p_struct->g),x(&p_struct->x) -{ -} - -minlbfgsstate::minlbfgsstate(const minlbfgsstate &rhs):_minlbfgsstate_owner(rhs) ,needf(p_struct->needf),needfg(p_struct->needfg),xupdated(p_struct->xupdated),f(p_struct->f),g(&p_struct->g),x(&p_struct->x) -{ -} - -minlbfgsstate& minlbfgsstate::operator=(const minlbfgsstate &rhs) -{ - if( this==&rhs ) - return *this; - _minlbfgsstate_owner::operator=(rhs); - return *this; -} - -minlbfgsstate::~minlbfgsstate() -{ -} - - -/************************************************************************* - -*************************************************************************/ -_minlbfgsreport_owner::_minlbfgsreport_owner() -{ - p_struct = (alglib_impl::minlbfgsreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::minlbfgsreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_minlbfgsreport_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_minlbfgsreport_owner::_minlbfgsreport_owner(const _minlbfgsreport_owner &rhs) -{ - p_struct = (alglib_impl::minlbfgsreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::minlbfgsreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_minlbfgsreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_minlbfgsreport_owner& _minlbfgsreport_owner::operator=(const _minlbfgsreport_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_minlbfgsreport_clear(p_struct); - if( !alglib_impl::_minlbfgsreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_minlbfgsreport_owner::~_minlbfgsreport_owner() -{ - alglib_impl::_minlbfgsreport_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::minlbfgsreport* _minlbfgsreport_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::minlbfgsreport* _minlbfgsreport_owner::c_ptr() const -{ - return const_cast(p_struct); -} -minlbfgsreport::minlbfgsreport() : _minlbfgsreport_owner() ,iterationscount(p_struct->iterationscount),nfev(p_struct->nfev),varidx(p_struct->varidx),terminationtype(p_struct->terminationtype) -{ -} - -minlbfgsreport::minlbfgsreport(const minlbfgsreport &rhs):_minlbfgsreport_owner(rhs) ,iterationscount(p_struct->iterationscount),nfev(p_struct->nfev),varidx(p_struct->varidx),terminationtype(p_struct->terminationtype) -{ -} - -minlbfgsreport& minlbfgsreport::operator=(const minlbfgsreport &rhs) -{ - if( this==&rhs ) - return *this; - _minlbfgsreport_owner::operator=(rhs); - return *this; -} - -minlbfgsreport::~minlbfgsreport() -{ -} - -/************************************************************************* - LIMITED MEMORY BFGS METHOD FOR LARGE SCALE OPTIMIZATION - -DESCRIPTION: -The subroutine minimizes function F(x) of N arguments by using a quasi- -Newton method (LBFGS scheme) which is optimized to use a minimum amount -of memory. -The subroutine generates the approximation of an inverse Hessian matrix by -using information about the last M steps of the algorithm (instead of N). -It lessens a required amount of memory from a value of order N^2 to a -value of order 2*N*M. - - -REQUIREMENTS: -Algorithm will request following information during its operation: -* function value F and its gradient G (simultaneously) at given point X - - -USAGE: -1. User initializes algorithm state with MinLBFGSCreate() call -2. User tunes solver parameters with MinLBFGSSetCond() MinLBFGSSetStpMax() - and other functions -3. User calls MinLBFGSOptimize() function which takes algorithm state and - pointer (delegate, etc.) to callback function which calculates F/G. -4. User calls MinLBFGSResults() to get solution -5. Optionally user may call MinLBFGSRestartFrom() to solve another problem - with same N/M but another starting point and/or another function. - MinLBFGSRestartFrom() allows to reuse already initialized structure. - - -INPUT PARAMETERS: - N - problem dimension. N>0 - M - number of corrections in the BFGS scheme of Hessian - approximation update. Recommended value: 3<=M<=7. The smaller - value causes worse convergence, the bigger will not cause a - considerably better convergence, but will cause a fall in the - performance. M<=N. - X - initial solution approximation, array[0..N-1]. - - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -NOTES: -1. you may tune stopping conditions with MinLBFGSSetCond() function -2. if target function contains exp() or other fast growing functions, and - optimization algorithm makes too large steps which leads to overflow, - use MinLBFGSSetStpMax() function to bound algorithm's steps. However, - L-BFGS rarely needs such a tuning. - - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgscreate(const ae_int_t n, const ae_int_t m, const real_1d_array &x, minlbfgsstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlbfgscreate(n, m, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* - LIMITED MEMORY BFGS METHOD FOR LARGE SCALE OPTIMIZATION - -DESCRIPTION: -The subroutine minimizes function F(x) of N arguments by using a quasi- -Newton method (LBFGS scheme) which is optimized to use a minimum amount -of memory. -The subroutine generates the approximation of an inverse Hessian matrix by -using information about the last M steps of the algorithm (instead of N). -It lessens a required amount of memory from a value of order N^2 to a -value of order 2*N*M. - - -REQUIREMENTS: -Algorithm will request following information during its operation: -* function value F and its gradient G (simultaneously) at given point X - - -USAGE: -1. User initializes algorithm state with MinLBFGSCreate() call -2. User tunes solver parameters with MinLBFGSSetCond() MinLBFGSSetStpMax() - and other functions -3. User calls MinLBFGSOptimize() function which takes algorithm state and - pointer (delegate, etc.) to callback function which calculates F/G. -4. User calls MinLBFGSResults() to get solution -5. Optionally user may call MinLBFGSRestartFrom() to solve another problem - with same N/M but another starting point and/or another function. - MinLBFGSRestartFrom() allows to reuse already initialized structure. - - -INPUT PARAMETERS: - N - problem dimension. N>0 - M - number of corrections in the BFGS scheme of Hessian - approximation update. Recommended value: 3<=M<=7. The smaller - value causes worse convergence, the bigger will not cause a - considerably better convergence, but will cause a fall in the - performance. M<=N. - X - initial solution approximation, array[0..N-1]. - - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -NOTES: -1. you may tune stopping conditions with MinLBFGSSetCond() function -2. if target function contains exp() or other fast growing functions, and - optimization algorithm makes too large steps which leads to overflow, - use MinLBFGSSetStpMax() function to bound algorithm's steps. However, - L-BFGS rarely needs such a tuning. - - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgscreate(const ae_int_t m, const real_1d_array &x, minlbfgsstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlbfgscreate(n, m, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -The subroutine is finite difference variant of MinLBFGSCreate(). It uses -finite differences in order to differentiate target function. - -Description below contains information which is specific to this function -only. We recommend to read comments on MinLBFGSCreate() in order to get -more information about creation of LBFGS optimizer. - -INPUT PARAMETERS: - N - problem dimension, N>0: - * if given, only leading N elements of X are used - * if not given, automatically determined from size of X - M - number of corrections in the BFGS scheme of Hessian - approximation update. Recommended value: 3<=M<=7. The smaller - value causes worse convergence, the bigger will not cause a - considerably better convergence, but will cause a fall in the - performance. M<=N. - X - starting point, array[0..N-1]. - DiffStep- differentiation step, >0 - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -NOTES: -1. algorithm uses 4-point central formula for differentiation. -2. differentiation step along I-th axis is equal to DiffStep*S[I] where - S[] is scaling vector which can be set by MinLBFGSSetScale() call. -3. we recommend you to use moderate values of differentiation step. Too - large step will result in too large truncation errors, while too small - step will result in too large numerical errors. 1.0E-6 can be good - value to start with. -4. Numerical differentiation is very inefficient - one gradient - calculation needs 4*N function evaluations. This function will work for - any N - either small (1...10), moderate (10...100) or large (100...). - However, performance penalty will be too severe for any N's except for - small ones. - We should also say that code which relies on numerical differentiation - is less robust and precise. LBFGS needs exact gradient values. - Imprecise gradient may slow down convergence, especially on highly - nonlinear problems. - Thus we recommend to use this function for fast prototyping on small- - dimensional problems only, and to implement analytical gradient as soon - as possible. - - -- ALGLIB -- - Copyright 16.05.2011 by Bochkanov Sergey -*************************************************************************/ -void minlbfgscreatef(const ae_int_t n, const ae_int_t m, const real_1d_array &x, const double diffstep, minlbfgsstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlbfgscreatef(n, m, const_cast(x.c_ptr()), diffstep, const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -The subroutine is finite difference variant of MinLBFGSCreate(). It uses -finite differences in order to differentiate target function. - -Description below contains information which is specific to this function -only. We recommend to read comments on MinLBFGSCreate() in order to get -more information about creation of LBFGS optimizer. - -INPUT PARAMETERS: - N - problem dimension, N>0: - * if given, only leading N elements of X are used - * if not given, automatically determined from size of X - M - number of corrections in the BFGS scheme of Hessian - approximation update. Recommended value: 3<=M<=7. The smaller - value causes worse convergence, the bigger will not cause a - considerably better convergence, but will cause a fall in the - performance. M<=N. - X - starting point, array[0..N-1]. - DiffStep- differentiation step, >0 - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -NOTES: -1. algorithm uses 4-point central formula for differentiation. -2. differentiation step along I-th axis is equal to DiffStep*S[I] where - S[] is scaling vector which can be set by MinLBFGSSetScale() call. -3. we recommend you to use moderate values of differentiation step. Too - large step will result in too large truncation errors, while too small - step will result in too large numerical errors. 1.0E-6 can be good - value to start with. -4. Numerical differentiation is very inefficient - one gradient - calculation needs 4*N function evaluations. This function will work for - any N - either small (1...10), moderate (10...100) or large (100...). - However, performance penalty will be too severe for any N's except for - small ones. - We should also say that code which relies on numerical differentiation - is less robust and precise. LBFGS needs exact gradient values. - Imprecise gradient may slow down convergence, especially on highly - nonlinear problems. - Thus we recommend to use this function for fast prototyping on small- - dimensional problems only, and to implement analytical gradient as soon - as possible. - - -- ALGLIB -- - Copyright 16.05.2011 by Bochkanov Sergey -*************************************************************************/ -void minlbfgscreatef(const ae_int_t m, const real_1d_array &x, const double diffstep, minlbfgsstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlbfgscreatef(n, m, const_cast(x.c_ptr()), diffstep, const_cast(state.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets stopping conditions for L-BFGS optimization algorithm. - -INPUT PARAMETERS: - State - structure which stores algorithm state - EpsG - >=0 - The subroutine finishes its work if the condition - |v|=0 - The subroutine finishes its work if on k+1-th iteration - the condition |F(k+1)-F(k)|<=EpsF*max{|F(k)|,|F(k+1)|,1} - is satisfied. - EpsX - >=0 - The subroutine finishes its work if on k+1-th iteration - the condition |v|<=EpsX is fulfilled, where: - * |.| means Euclidian norm - * v - scaled step vector, v[i]=dx[i]/s[i] - * dx - ste pvector, dx=X(k+1)-X(k) - * s - scaling coefficients set by MinLBFGSSetScale() - MaxIts - maximum number of iterations. If MaxIts=0, the number of - iterations is unlimited. - -Passing EpsG=0, EpsF=0, EpsX=0 and MaxIts=0 (simultaneously) will lead to -automatic stopping criterion selection (small EpsX). - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetcond(const minlbfgsstate &state, const double epsg, const double epsf, const double epsx, const ae_int_t maxits) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlbfgssetcond(const_cast(state.c_ptr()), epsg, epsf, epsx, maxits, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function turns on/off reporting. - -INPUT PARAMETERS: - State - structure which stores algorithm state - NeedXRep- whether iteration reports are needed or not - -If NeedXRep is True, algorithm will call rep() callback function if it is -provided to MinLBFGSOptimize(). - - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetxrep(const minlbfgsstate &state, const bool needxrep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlbfgssetxrep(const_cast(state.c_ptr()), needxrep, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets maximum step length - -INPUT PARAMETERS: - State - structure which stores algorithm state - StpMax - maximum step length, >=0. Set StpMax to 0.0 (default), if - you don't want to limit step length. - -Use this subroutine when you optimize target function which contains exp() -or other fast growing functions, and optimization algorithm makes too -large steps which leads to overflow. This function allows us to reject -steps that are too large (and therefore expose us to the possible -overflow) without actually calculating function value at the x+stp*d. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetstpmax(const minlbfgsstate &state, const double stpmax) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlbfgssetstpmax(const_cast(state.c_ptr()), stpmax, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets scaling coefficients for LBFGS optimizer. - -ALGLIB optimizers use scaling matrices to test stopping conditions (step -size and gradient are scaled before comparison with tolerances). Scale of -the I-th variable is a translation invariant measure of: -a) "how large" the variable is -b) how large the step should be to make significant changes in the function - -Scaling is also used by finite difference variant of the optimizer - step -along I-th axis is equal to DiffStep*S[I]. - -In most optimizers (and in the LBFGS too) scaling is NOT a form of -preconditioning. It just affects stopping conditions. You should set -preconditioner by separate call to one of the MinLBFGSSetPrec...() -functions. - -There is special preconditioning mode, however, which uses scaling -coefficients to form diagonal preconditioning matrix. You can turn this -mode on, if you want. But you should understand that scaling is not the -same thing as preconditioning - these are two different, although related -forms of tuning solver. - -INPUT PARAMETERS: - State - structure stores algorithm state - S - array[N], non-zero scaling coefficients - S[i] may be negative, sign doesn't matter. - - -- ALGLIB -- - Copyright 14.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetscale(const minlbfgsstate &state, const real_1d_array &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlbfgssetscale(const_cast(state.c_ptr()), const_cast(s.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Modification of the preconditioner: default preconditioner (simple -scaling, same for all elements of X) is used. - -INPUT PARAMETERS: - State - structure which stores algorithm state - -NOTE: you can change preconditioner "on the fly", during algorithm -iterations. - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetprecdefault(const minlbfgsstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlbfgssetprecdefault(const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Modification of the preconditioner: Cholesky factorization of approximate -Hessian is used. - -INPUT PARAMETERS: - State - structure which stores algorithm state - P - triangular preconditioner, Cholesky factorization of - the approximate Hessian. array[0..N-1,0..N-1], - (if larger, only leading N elements are used). - IsUpper - whether upper or lower triangle of P is given - (other triangle is not referenced) - -After call to this function preconditioner is changed to P (P is copied -into the internal buffer). - -NOTE: you can change preconditioner "on the fly", during algorithm -iterations. - -NOTE 2: P should be nonsingular. Exception will be thrown otherwise. - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetpreccholesky(const minlbfgsstate &state, const real_2d_array &p, const bool isupper) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlbfgssetpreccholesky(const_cast(state.c_ptr()), const_cast(p.c_ptr()), isupper, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Modification of the preconditioner: diagonal of approximate Hessian is -used. - -INPUT PARAMETERS: - State - structure which stores algorithm state - D - diagonal of the approximate Hessian, array[0..N-1], - (if larger, only leading N elements are used). - -NOTE: you can change preconditioner "on the fly", during algorithm -iterations. - -NOTE 2: D[i] should be positive. Exception will be thrown otherwise. - -NOTE 3: you should pass diagonal of approximate Hessian - NOT ITS INVERSE. - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetprecdiag(const minlbfgsstate &state, const real_1d_array &d) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlbfgssetprecdiag(const_cast(state.c_ptr()), const_cast(d.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Modification of the preconditioner: scale-based diagonal preconditioning. - -This preconditioning mode can be useful when you don't have approximate -diagonal of Hessian, but you know that your variables are badly scaled -(for example, one variable is in [1,10], and another in [1000,100000]), -and most part of the ill-conditioning comes from different scales of vars. - -In this case simple scale-based preconditioner, with H[i] = 1/(s[i]^2), -can greatly improve convergence. - -IMPRTANT: you should set scale of your variables with MinLBFGSSetScale() -call (before or after MinLBFGSSetPrecScale() call). Without knowledge of -the scale of your variables scale-based preconditioner will be just unit -matrix. - -INPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetprecscale(const minlbfgsstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlbfgssetprecscale(const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function provides reverse communication interface -Reverse communication interface is not documented or recommended to use. -See below for functions which provide better documented API -*************************************************************************/ -bool minlbfgsiteration(const minlbfgsstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::minlbfgsiteration(const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void minlbfgsoptimize(minlbfgsstate &state, - void (*func)(const real_1d_array &x, double &func, void *ptr), - void (*rep)(const real_1d_array &x, double func, void *ptr), - void *ptr) -{ - alglib_impl::ae_state _alglib_env_state; - if( func==NULL ) - throw ap_error("ALGLIB: error in 'minlbfgsoptimize()' (func is NULL)"); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - while( alglib_impl::minlbfgsiteration(state.c_ptr(), &_alglib_env_state) ) - { - if( state.needf ) - { - func(state.x, state.f, ptr); - continue; - } - if( state.xupdated ) - { - if( rep!=NULL ) - rep(state.x, state.f, ptr); - continue; - } - throw ap_error("ALGLIB: error in 'minlbfgsoptimize' (some derivatives were not provided?)"); - } - alglib_impl::ae_state_clear(&_alglib_env_state); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void minlbfgsoptimize(minlbfgsstate &state, - void (*grad)(const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), - void (*rep)(const real_1d_array &x, double func, void *ptr), - void *ptr) -{ - alglib_impl::ae_state _alglib_env_state; - if( grad==NULL ) - throw ap_error("ALGLIB: error in 'minlbfgsoptimize()' (grad is NULL)"); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - while( alglib_impl::minlbfgsiteration(state.c_ptr(), &_alglib_env_state) ) - { - if( state.needfg ) - { - grad(state.x, state.f, state.g, ptr); - continue; - } - if( state.xupdated ) - { - if( rep!=NULL ) - rep(state.x, state.f, ptr); - continue; - } - throw ap_error("ALGLIB: error in 'minlbfgsoptimize' (some derivatives were not provided?)"); - } - alglib_impl::ae_state_clear(&_alglib_env_state); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - - -/************************************************************************* -L-BFGS algorithm results - -INPUT PARAMETERS: - State - algorithm state - -OUTPUT PARAMETERS: - X - array[0..N-1], solution - Rep - optimization report: - * Rep.TerminationType completion code: - * -7 gradient verification failed. - See MinLBFGSSetGradientCheck() for more information. - * -2 rounding errors prevent further improvement. - X contains best point found. - * -1 incorrect parameters were specified - * 1 relative function improvement is no more than - EpsF. - * 2 relative step is no more than EpsX. - * 4 gradient norm is no more than EpsG - * 5 MaxIts steps was taken - * 7 stopping conditions are too stringent, - further improvement is impossible - * Rep.IterationsCount contains iterations count - * NFEV contains number of function calculations - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgsresults(const minlbfgsstate &state, real_1d_array &x, minlbfgsreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlbfgsresults(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -L-BFGS algorithm results - -Buffered implementation of MinLBFGSResults which uses pre-allocated buffer -to store X[]. If buffer size is too small, it resizes buffer. It is -intended to be used in the inner cycles of performance critical algorithms -where array reallocation penalty is too large to be ignored. - - -- ALGLIB -- - Copyright 20.08.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgsresultsbuf(const minlbfgsstate &state, real_1d_array &x, minlbfgsreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlbfgsresultsbuf(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine restarts LBFGS algorithm from new point. All optimization -parameters are left unchanged. - -This function allows to solve multiple optimization problems (which -must have same number of dimensions) without object reallocation penalty. - -INPUT PARAMETERS: - State - structure used to store algorithm state - X - new starting point. - - -- ALGLIB -- - Copyright 30.07.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgsrestartfrom(const minlbfgsstate &state, const real_1d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlbfgsrestartfrom(const_cast(state.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine turns on verification of the user-supplied analytic -gradient: -* user calls this subroutine before optimization begins -* MinLBFGSOptimize() is called -* prior to actual optimization, for each component of parameters being - optimized X[i] algorithm performs following steps: - * two trial steps are made to X[i]-TestStep*S[i] and X[i]+TestStep*S[i], - where X[i] is i-th component of the initial point and S[i] is a scale - of i-th parameter - * if needed, steps are bounded with respect to constraints on X[] - * F(X) is evaluated at these trial points - * we perform one more evaluation in the middle point of the interval - * we build cubic model using function values and derivatives at trial - points and we compare its prediction with actual value in the middle - point - * in case difference between prediction and actual value is higher than - some predetermined threshold, algorithm stops with completion code -7; - Rep.VarIdx is set to index of the parameter with incorrect derivative. -* after verification is over, algorithm proceeds to the actual optimization. - -NOTE 1: verification needs N (parameters count) gradient evaluations. It - is very costly and you should use it only for low dimensional - problems, when you want to be sure that you've correctly - calculated analytic derivatives. You should not use it in the - production code (unless you want to check derivatives provided by - some third party). - -NOTE 2: you should carefully choose TestStep. Value which is too large - (so large that function behaviour is significantly non-cubic) will - lead to false alarms. You may use different step for different - parameters by means of setting scale with MinLBFGSSetScale(). - -NOTE 3: this function may lead to false positives. In case it reports that - I-th derivative was calculated incorrectly, you may decrease test - step and try one more time - maybe your function changes too - sharply and your step is too large for such rapidly chanding - function. - -INPUT PARAMETERS: - State - structure used to store algorithm state - TestStep - verification step: - * TestStep=0 turns verification off - * TestStep>0 activates verification - - -- ALGLIB -- - Copyright 24.05.2012 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetgradientcheck(const minlbfgsstate &state, const double teststep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlbfgssetgradientcheck(const_cast(state.c_ptr()), teststep, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This object stores nonlinear optimizer state. -You should use functions provided by MinQP subpackage to work with this -object -*************************************************************************/ -_minqpstate_owner::_minqpstate_owner() -{ - p_struct = (alglib_impl::minqpstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::minqpstate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_minqpstate_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_minqpstate_owner::_minqpstate_owner(const _minqpstate_owner &rhs) -{ - p_struct = (alglib_impl::minqpstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::minqpstate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_minqpstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_minqpstate_owner& _minqpstate_owner::operator=(const _minqpstate_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_minqpstate_clear(p_struct); - if( !alglib_impl::_minqpstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_minqpstate_owner::~_minqpstate_owner() -{ - alglib_impl::_minqpstate_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::minqpstate* _minqpstate_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::minqpstate* _minqpstate_owner::c_ptr() const -{ - return const_cast(p_struct); -} -minqpstate::minqpstate() : _minqpstate_owner() -{ -} - -minqpstate::minqpstate(const minqpstate &rhs):_minqpstate_owner(rhs) -{ -} - -minqpstate& minqpstate::operator=(const minqpstate &rhs) -{ - if( this==&rhs ) - return *this; - _minqpstate_owner::operator=(rhs); - return *this; -} - -minqpstate::~minqpstate() -{ -} - - -/************************************************************************* -This structure stores optimization report: -* InnerIterationsCount number of inner iterations -* OuterIterationsCount number of outer iterations -* NCholesky number of Cholesky decomposition -* NMV number of matrix-vector products - (only products calculated as part of iterative - process are counted) -* TerminationType completion code (see below) - -Completion codes: -* -5 inappropriate solver was used: - * Cholesky solver for semidefinite or indefinite problems - * Cholesky solver for problems with non-boundary constraints -* -4 BLEIC-QP algorithm found unconstrained direction - of negative curvature (function is unbounded from - below even under constraints), no meaningful - minimum can be found. -* -3 inconsistent constraints (or, maybe, feasible point is - too hard to find). If you are sure that constraints are feasible, - try to restart optimizer with better initial approximation. -* -1 solver error -* 4 successful completion -* 5 MaxIts steps was taken -* 7 stopping conditions are too stringent, - further improvement is impossible, - X contains best point found so far. -*************************************************************************/ -_minqpreport_owner::_minqpreport_owner() -{ - p_struct = (alglib_impl::minqpreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::minqpreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_minqpreport_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_minqpreport_owner::_minqpreport_owner(const _minqpreport_owner &rhs) -{ - p_struct = (alglib_impl::minqpreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::minqpreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_minqpreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_minqpreport_owner& _minqpreport_owner::operator=(const _minqpreport_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_minqpreport_clear(p_struct); - if( !alglib_impl::_minqpreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_minqpreport_owner::~_minqpreport_owner() -{ - alglib_impl::_minqpreport_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::minqpreport* _minqpreport_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::minqpreport* _minqpreport_owner::c_ptr() const -{ - return const_cast(p_struct); -} -minqpreport::minqpreport() : _minqpreport_owner() ,inneriterationscount(p_struct->inneriterationscount),outeriterationscount(p_struct->outeriterationscount),nmv(p_struct->nmv),ncholesky(p_struct->ncholesky),terminationtype(p_struct->terminationtype) -{ -} - -minqpreport::minqpreport(const minqpreport &rhs):_minqpreport_owner(rhs) ,inneriterationscount(p_struct->inneriterationscount),outeriterationscount(p_struct->outeriterationscount),nmv(p_struct->nmv),ncholesky(p_struct->ncholesky),terminationtype(p_struct->terminationtype) -{ -} - -minqpreport& minqpreport::operator=(const minqpreport &rhs) -{ - if( this==&rhs ) - return *this; - _minqpreport_owner::operator=(rhs); - return *this; -} - -minqpreport::~minqpreport() -{ -} - -/************************************************************************* - CONSTRAINED QUADRATIC PROGRAMMING - -The subroutine creates QP optimizer. After initial creation, it contains -default optimization problem with zero quadratic and linear terms and no -constraints. You should set quadratic/linear terms with calls to functions -provided by MinQP subpackage. - -INPUT PARAMETERS: - N - problem size - -OUTPUT PARAMETERS: - State - optimizer with zero quadratic/linear terms - and no constraints - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpcreate(const ae_int_t n, minqpstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minqpcreate(n, const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets linear term for QP solver. - -By default, linear term is zero. - -INPUT PARAMETERS: - State - structure which stores algorithm state - B - linear term, array[N]. - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpsetlinearterm(const minqpstate &state, const real_1d_array &b) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minqpsetlinearterm(const_cast(state.c_ptr()), const_cast(b.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets dense quadratic term for QP solver. By default, -quadratic term is zero. - -SUPPORT BY ALGLIB QP ALGORITHMS: - -Dense quadratic term can be handled by any of the QP algorithms supported -by ALGLIB QP Solver. - -IMPORTANT: - -This solver minimizes following function: - f(x) = 0.5*x'*A*x + b'*x. -Note that quadratic term has 0.5 before it. So if you want to minimize - f(x) = x^2 + x -you should rewrite your problem as follows: - f(x) = 0.5*(2*x^2) + x -and your matrix A will be equal to [[2.0]], not to [[1.0]] - -INPUT PARAMETERS: - State - structure which stores algorithm state - A - matrix, array[N,N] - IsUpper - (optional) storage type: - * if True, symmetric matrix A is given by its upper - triangle, and the lower triangle isn’t used - * if False, symmetric matrix A is given by its lower - triangle, and the upper triangle isn’t used - * if not given, both lower and upper triangles must be - filled. - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpsetquadraticterm(const minqpstate &state, const real_2d_array &a, const bool isupper) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minqpsetquadraticterm(const_cast(state.c_ptr()), const_cast(a.c_ptr()), isupper, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets dense quadratic term for QP solver. By default, -quadratic term is zero. - -SUPPORT BY ALGLIB QP ALGORITHMS: - -Dense quadratic term can be handled by any of the QP algorithms supported -by ALGLIB QP Solver. - -IMPORTANT: - -This solver minimizes following function: - f(x) = 0.5*x'*A*x + b'*x. -Note that quadratic term has 0.5 before it. So if you want to minimize - f(x) = x^2 + x -you should rewrite your problem as follows: - f(x) = 0.5*(2*x^2) + x -and your matrix A will be equal to [[2.0]], not to [[1.0]] - -INPUT PARAMETERS: - State - structure which stores algorithm state - A - matrix, array[N,N] - IsUpper - (optional) storage type: - * if True, symmetric matrix A is given by its upper - triangle, and the lower triangle isn’t used - * if False, symmetric matrix A is given by its lower - triangle, and the upper triangle isn’t used - * if not given, both lower and upper triangles must be - filled. - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpsetquadraticterm(const minqpstate &state, const real_2d_array &a) -{ - alglib_impl::ae_state _alglib_env_state; - bool isupper; - if( !alglib_impl::ae_is_symmetric(const_cast(a.c_ptr())) ) - throw ap_error("'a' parameter is not symmetric matrix"); - isupper = false; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minqpsetquadraticterm(const_cast(state.c_ptr()), const_cast(a.c_ptr()), isupper, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets sparse quadratic term for QP solver. By default, -quadratic term is zero. - -SUPPORT BY ALGLIB QP ALGORITHMS: - -Sparse quadratic term is supported only by BLEIC-based QP algorithm (one -which is activated by MinQPSetAlgoBLEIC function). Cholesky-based QP algo -won't be able to deal with sparse quadratic term and will terminate -abnormally. - -IF YOU CALLED THIS FUNCTION, YOU MUST SWITCH TO BLEIC-BASED QP ALGORITHM -BEFORE CALLING MINQPOPTIMIZE() FUNCTION. - -IMPORTANT: - -This solver minimizes following function: - f(x) = 0.5*x'*A*x + b'*x. -Note that quadratic term has 0.5 before it. So if you want to minimize - f(x) = x^2 + x -you should rewrite your problem as follows: - f(x) = 0.5*(2*x^2) + x -and your matrix A will be equal to [[2.0]], not to [[1.0]] - -INPUT PARAMETERS: - State - structure which stores algorithm state - A - matrix, array[N,N] - IsUpper - (optional) storage type: - * if True, symmetric matrix A is given by its upper - triangle, and the lower triangle isn’t used - * if False, symmetric matrix A is given by its lower - triangle, and the upper triangle isn’t used - * if not given, both lower and upper triangles must be - filled. - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpsetquadratictermsparse(const minqpstate &state, const sparsematrix &a, const bool isupper) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minqpsetquadratictermsparse(const_cast(state.c_ptr()), const_cast(a.c_ptr()), isupper, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets starting point for QP solver. It is useful to have -good initial approximation to the solution, because it will increase -speed of convergence and identification of active constraints. - -INPUT PARAMETERS: - State - structure which stores algorithm state - X - starting point, array[N]. - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpsetstartingpoint(const minqpstate &state, const real_1d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minqpsetstartingpoint(const_cast(state.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets origin for QP solver. By default, following QP program -is solved: - - min(0.5*x'*A*x+b'*x) - -This function allows to solve different problem: - - min(0.5*(x-x_origin)'*A*(x-x_origin)+b'*(x-x_origin)) - -INPUT PARAMETERS: - State - structure which stores algorithm state - XOrigin - origin, array[N]. - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpsetorigin(const minqpstate &state, const real_1d_array &xorigin) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minqpsetorigin(const_cast(state.c_ptr()), const_cast(xorigin.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets scaling coefficients. - -ALGLIB optimizers use scaling matrices to test stopping conditions (step -size and gradient are scaled before comparison with tolerances). Scale of -the I-th variable is a translation invariant measure of: -a) "how large" the variable is -b) how large the step should be to make significant changes in the function - -BLEIC-based QP solver uses scale for two purposes: -* to evaluate stopping conditions -* for preconditioning of the underlying BLEIC solver - -INPUT PARAMETERS: - State - structure stores algorithm state - S - array[N], non-zero scaling coefficients - S[i] may be negative, sign doesn't matter. - - -- ALGLIB -- - Copyright 14.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpsetscale(const minqpstate &state, const real_1d_array &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minqpsetscale(const_cast(state.c_ptr()), const_cast(s.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function tells solver to use Cholesky-based algorithm. This algorithm -is active by default. - -DESCRIPTION: - -Cholesky-based algorithm can be used only for problems which: -* have dense quadratic term, set by MinQPSetQuadraticTerm(), sparse or - structured problems are not supported. -* are strictly convex, i.e. quadratic term is symmetric positive definite, - indefinite or semidefinite problems are not supported by this algorithm. - -If anything of what listed above is violated, you may use BLEIC-based QP -algorithm which can be activated by MinQPSetAlgoBLEIC(). - -BENEFITS AND DRAWBACKS: - -This algorithm gives best precision amongst all QP solvers provided by -ALGLIB (Newton iterations have much higher precision than any other -optimization algorithm). This solver also gracefully handles problems with -very large amount of constraints. - -Performance of the algorithm is good because internally it uses Level 3 -Dense BLAS for its performance-critical parts. - - -From the other side, algorithm has O(N^3) complexity for unconstrained -problems and up to orders of magnitude slower on constrained problems -(these additional iterations are needed to identify active constraints). -So, its running time depends on number of constraints active at solution. - -Furthermore, this algorithm can not solve problems with sparse matrices or -problems with semidefinite/indefinite matrices of any kind (dense/sparse). - -INPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpsetalgocholesky(const minqpstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minqpsetalgocholesky(const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function tells solver to use BLEIC-based algorithm and sets stopping -criteria for the algorithm. - -DESCRIPTION: - -BLEIC-based QP algorithm can be used for any kind of QP problems: -* problems with both dense and sparse quadratic terms -* problems with positive definite, semidefinite, indefinite terms - -BLEIC-based algorithm can solve even indefinite problems - as long as they -are bounded from below on the feasible set. Of course, global minimum is -found only for positive definite and semidefinite problems. As for -indefinite ones - only local minimum is found. - -BENEFITS AND DRAWBACKS: - -This algorithm can be used to solve both convex and indefinite QP problems -and it can utilize sparsity of the quadratic term (algorithm calculates -matrix-vector products, which can be performed efficiently in case of -sparse matrix). - -Algorithm has iteration cost, which (assuming fixed amount of non-boundary -linear constraints) linearly depends on problem size. Boundary constraints -does not significantly change iteration cost. - -Thus, it outperforms Cholesky-based QP algorithm (CQP) on high-dimensional -sparse problems with moderate amount of constraints. - - -From the other side, unlike CQP solver, this algorithm does NOT make use -of Level 3 Dense BLAS. Thus, its performance on dense problems is inferior -to that of CQP solver. - -Its precision is also inferior to that of CQP. CQP performs Newton steps -which are know to achieve very good precision. In many cases Newton step -leads us exactly to the solution. BLEIC-QP performs LBFGS steps, which are -good at detecting neighborhood of the solution, buy need many iterations -to find solution with 6 digits of precision. - -INPUT PARAMETERS: - State - structure which stores algorithm state - EpsG - >=0 - The subroutine finishes its work if the condition - |v|=0 - The subroutine finishes its work if exploratory steepest - descent step on k+1-th iteration satisfies following - condition: |F(k+1)-F(k)|<=EpsF*max{|F(k)|,|F(k+1)|,1} - EpsX - >=0 - The subroutine finishes its work if exploratory steepest - descent step on k+1-th iteration satisfies following - condition: - * |.| means Euclidian norm - * v - scaled step vector, v[i]=dx[i]/s[i] - * dx - step vector, dx=X(k+1)-X(k) - * s - scaling coefficients set by MinQPSetScale() - MaxIts - maximum number of iterations. If MaxIts=0, the number of - iterations is unlimited. - -Passing EpsG=0, EpsF=0 and EpsX=0 and MaxIts=0 (simultaneously) will lead -to automatic stopping criterion selection (presently it is small step -length, but it may change in the future versions of ALGLIB). - -IT IS VERY IMPORTANT THAT YOU CALL MinQPSetScale() WHEN YOU USE THIS ALGO! - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpsetalgobleic(const minqpstate &state, const double epsg, const double epsf, const double epsx, const ae_int_t maxits) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minqpsetalgobleic(const_cast(state.c_ptr()), epsg, epsf, epsx, maxits, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets boundary constraints for QP solver - -Boundary constraints are inactive by default (after initial creation). -After being set, they are preserved until explicitly turned off with -another SetBC() call. - -INPUT PARAMETERS: - State - structure stores algorithm state - BndL - lower bounds, array[N]. - If some (all) variables are unbounded, you may specify - very small number or -INF (latter is recommended because - it will allow solver to use better algorithm). - BndU - upper bounds, array[N]. - If some (all) variables are unbounded, you may specify - very large number or +INF (latter is recommended because - it will allow solver to use better algorithm). - -NOTE: it is possible to specify BndL[i]=BndU[i]. In this case I-th -variable will be "frozen" at X[i]=BndL[i]=BndU[i]. - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpsetbc(const minqpstate &state, const real_1d_array &bndl, const real_1d_array &bndu) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minqpsetbc(const_cast(state.c_ptr()), const_cast(bndl.c_ptr()), const_cast(bndu.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets linear constraints for QP optimizer. - -Linear constraints are inactive by default (after initial creation). - -INPUT PARAMETERS: - State - structure previously allocated with MinQPCreate call. - C - linear constraints, array[K,N+1]. - Each row of C represents one constraint, either equality - or inequality (see below): - * first N elements correspond to coefficients, - * last element corresponds to the right part. - All elements of C (including right part) must be finite. - CT - type of constraints, array[K]: - * if CT[i]>0, then I-th constraint is C[i,*]*x >= C[i,n+1] - * if CT[i]=0, then I-th constraint is C[i,*]*x = C[i,n+1] - * if CT[i]<0, then I-th constraint is C[i,*]*x <= C[i,n+1] - K - number of equality/inequality constraints, K>=0: - * if given, only leading K elements of C/CT are used - * if not given, automatically determined from sizes of C/CT - -NOTE 1: linear (non-bound) constraints are satisfied only approximately - - there always exists some minor violation (about 10^-10...10^-13) - due to numerical errors. - - -- ALGLIB -- - Copyright 19.06.2012 by Bochkanov Sergey -*************************************************************************/ -void minqpsetlc(const minqpstate &state, const real_2d_array &c, const integer_1d_array &ct, const ae_int_t k) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minqpsetlc(const_cast(state.c_ptr()), const_cast(c.c_ptr()), const_cast(ct.c_ptr()), k, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets linear constraints for QP optimizer. - -Linear constraints are inactive by default (after initial creation). - -INPUT PARAMETERS: - State - structure previously allocated with MinQPCreate call. - C - linear constraints, array[K,N+1]. - Each row of C represents one constraint, either equality - or inequality (see below): - * first N elements correspond to coefficients, - * last element corresponds to the right part. - All elements of C (including right part) must be finite. - CT - type of constraints, array[K]: - * if CT[i]>0, then I-th constraint is C[i,*]*x >= C[i,n+1] - * if CT[i]=0, then I-th constraint is C[i,*]*x = C[i,n+1] - * if CT[i]<0, then I-th constraint is C[i,*]*x <= C[i,n+1] - K - number of equality/inequality constraints, K>=0: - * if given, only leading K elements of C/CT are used - * if not given, automatically determined from sizes of C/CT - -NOTE 1: linear (non-bound) constraints are satisfied only approximately - - there always exists some minor violation (about 10^-10...10^-13) - due to numerical errors. - - -- ALGLIB -- - Copyright 19.06.2012 by Bochkanov Sergey -*************************************************************************/ -void minqpsetlc(const minqpstate &state, const real_2d_array &c, const integer_1d_array &ct) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t k; - if( (c.rows()!=ct.length())) - throw ap_error("Error while calling 'minqpsetlc': looks like one of arguments has wrong size"); - k = c.rows(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minqpsetlc(const_cast(state.c_ptr()), const_cast(c.c_ptr()), const_cast(ct.c_ptr()), k, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function solves quadratic programming problem. -You should call it after setting solver options with MinQPSet...() calls. - -INPUT PARAMETERS: - State - algorithm state - -You should use MinQPResults() function to access results after calls -to this function. - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey. - Special thanks to Elvira Illarionova for important suggestions on - the linearly constrained QP algorithm. -*************************************************************************/ -void minqpoptimize(const minqpstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minqpoptimize(const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -QP solver results - -INPUT PARAMETERS: - State - algorithm state - -OUTPUT PARAMETERS: - X - array[0..N-1], solution. - This array is allocated and initialized only when - Rep.TerminationType parameter is positive (success). - Rep - optimization report. You should check Rep.TerminationType, - which contains completion code, and you may check another - fields which contain another information about algorithm - functioning. - - Failure codes returned by algorithm are: - * -5 inappropriate solver was used: - * Cholesky solver for (semi)indefinite problems - * Cholesky solver for problems with sparse matrix - * -4 BLEIC-QP algorithm found unconstrained direction - of negative curvature (function is unbounded from - below even under constraints), no meaningful - minimum can be found. - * -3 inconsistent constraints (or maybe feasible point - is too hard to find). If you are sure that - constraints are feasible, try to restart optimizer - with better initial approximation. - - Completion codes specific for Cholesky algorithm: - * 4 successful completion - - Completion codes specific for BLEIC-based algorithm: - * 1 relative function improvement is no more than EpsF. - * 2 scaled step is no more than EpsX. - * 4 scaled gradient norm is no more than EpsG. - * 5 MaxIts steps was taken - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpresults(const minqpstate &state, real_1d_array &x, minqpreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minqpresults(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -QP results - -Buffered implementation of MinQPResults() which uses pre-allocated buffer -to store X[]. If buffer size is too small, it resizes buffer. It is -intended to be used in the inner cycles of performance critical algorithms -where array reallocation penalty is too large to be ignored. - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpresultsbuf(const minqpstate &state, real_1d_array &x, minqpreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minqpresultsbuf(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Levenberg-Marquardt optimizer. - -This structure should be created using one of the MinLMCreate???() -functions. You should not access its fields directly; use ALGLIB functions -to work with it. -*************************************************************************/ -_minlmstate_owner::_minlmstate_owner() -{ - p_struct = (alglib_impl::minlmstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::minlmstate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_minlmstate_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_minlmstate_owner::_minlmstate_owner(const _minlmstate_owner &rhs) -{ - p_struct = (alglib_impl::minlmstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::minlmstate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_minlmstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_minlmstate_owner& _minlmstate_owner::operator=(const _minlmstate_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_minlmstate_clear(p_struct); - if( !alglib_impl::_minlmstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_minlmstate_owner::~_minlmstate_owner() -{ - alglib_impl::_minlmstate_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::minlmstate* _minlmstate_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::minlmstate* _minlmstate_owner::c_ptr() const -{ - return const_cast(p_struct); -} -minlmstate::minlmstate() : _minlmstate_owner() ,needf(p_struct->needf),needfg(p_struct->needfg),needfgh(p_struct->needfgh),needfi(p_struct->needfi),needfij(p_struct->needfij),xupdated(p_struct->xupdated),f(p_struct->f),fi(&p_struct->fi),g(&p_struct->g),h(&p_struct->h),j(&p_struct->j),x(&p_struct->x) -{ -} - -minlmstate::minlmstate(const minlmstate &rhs):_minlmstate_owner(rhs) ,needf(p_struct->needf),needfg(p_struct->needfg),needfgh(p_struct->needfgh),needfi(p_struct->needfi),needfij(p_struct->needfij),xupdated(p_struct->xupdated),f(p_struct->f),fi(&p_struct->fi),g(&p_struct->g),h(&p_struct->h),j(&p_struct->j),x(&p_struct->x) -{ -} - -minlmstate& minlmstate::operator=(const minlmstate &rhs) -{ - if( this==&rhs ) - return *this; - _minlmstate_owner::operator=(rhs); - return *this; -} - -minlmstate::~minlmstate() -{ -} - - -/************************************************************************* -Optimization report, filled by MinLMResults() function - -FIELDS: -* TerminationType, completion code: - * -7 derivative correctness check failed; - see Rep.WrongNum, Rep.WrongI, Rep.WrongJ for - more information. - * 1 relative function improvement is no more than - EpsF. - * 2 relative step is no more than EpsX. - * 4 gradient is no more than EpsG. - * 5 MaxIts steps was taken - * 7 stopping conditions are too stringent, - further improvement is impossible -* IterationsCount, contains iterations count -* NFunc, number of function calculations -* NJac, number of Jacobi matrix calculations -* NGrad, number of gradient calculations -* NHess, number of Hessian calculations -* NCholesky, number of Cholesky decomposition calculations -*************************************************************************/ -_minlmreport_owner::_minlmreport_owner() -{ - p_struct = (alglib_impl::minlmreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::minlmreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_minlmreport_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_minlmreport_owner::_minlmreport_owner(const _minlmreport_owner &rhs) -{ - p_struct = (alglib_impl::minlmreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::minlmreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_minlmreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_minlmreport_owner& _minlmreport_owner::operator=(const _minlmreport_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_minlmreport_clear(p_struct); - if( !alglib_impl::_minlmreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_minlmreport_owner::~_minlmreport_owner() -{ - alglib_impl::_minlmreport_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::minlmreport* _minlmreport_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::minlmreport* _minlmreport_owner::c_ptr() const -{ - return const_cast(p_struct); -} -minlmreport::minlmreport() : _minlmreport_owner() ,iterationscount(p_struct->iterationscount),terminationtype(p_struct->terminationtype),funcidx(p_struct->funcidx),varidx(p_struct->varidx),nfunc(p_struct->nfunc),njac(p_struct->njac),ngrad(p_struct->ngrad),nhess(p_struct->nhess),ncholesky(p_struct->ncholesky) -{ -} - -minlmreport::minlmreport(const minlmreport &rhs):_minlmreport_owner(rhs) ,iterationscount(p_struct->iterationscount),terminationtype(p_struct->terminationtype),funcidx(p_struct->funcidx),varidx(p_struct->varidx),nfunc(p_struct->nfunc),njac(p_struct->njac),ngrad(p_struct->ngrad),nhess(p_struct->nhess),ncholesky(p_struct->ncholesky) -{ -} - -minlmreport& minlmreport::operator=(const minlmreport &rhs) -{ - if( this==&rhs ) - return *this; - _minlmreport_owner::operator=(rhs); - return *this; -} - -minlmreport::~minlmreport() -{ -} - -/************************************************************************* - IMPROVED LEVENBERG-MARQUARDT METHOD FOR - NON-LINEAR LEAST SQUARES OPTIMIZATION - -DESCRIPTION: -This function is used to find minimum of function which is represented as -sum of squares: - F(x) = f[0]^2(x[0],...,x[n-1]) + ... + f[m-1]^2(x[0],...,x[n-1]) -using value of function vector f[] and Jacobian of f[]. - - -REQUIREMENTS: -This algorithm will request following information during its operation: - -* function vector f[] at given point X -* function vector f[] and Jacobian of f[] (simultaneously) at given point - -There are several overloaded versions of MinLMOptimize() function which -correspond to different LM-like optimization algorithms provided by this -unit. You should choose version which accepts fvec() and jac() callbacks. -First one is used to calculate f[] at given point, second one calculates -f[] and Jacobian df[i]/dx[j]. - -You can try to initialize MinLMState structure with VJ function and then -use incorrect version of MinLMOptimize() (for example, version which -works with general form function and does not provide Jacobian), but it -will lead to exception being thrown after first attempt to calculate -Jacobian. - - -USAGE: -1. User initializes algorithm state with MinLMCreateVJ() call -2. User tunes solver parameters with MinLMSetCond(), MinLMSetStpMax() and - other functions -3. User calls MinLMOptimize() function which takes algorithm state and - callback functions. -4. User calls MinLMResults() to get solution -5. Optionally, user may call MinLMRestartFrom() to solve another problem - with same N/M but another starting point and/or another function. - MinLMRestartFrom() allows to reuse already initialized structure. - - -INPUT PARAMETERS: - N - dimension, N>1 - * if given, only leading N elements of X are used - * if not given, automatically determined from size of X - M - number of functions f[i] - X - initial solution, array[0..N-1] - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -NOTES: -1. you may tune stopping conditions with MinLMSetCond() function -2. if target function contains exp() or other fast growing functions, and - optimization algorithm makes too large steps which leads to overflow, - use MinLMSetStpMax() function to bound algorithm's steps. - - -- ALGLIB -- - Copyright 30.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minlmcreatevj(const ae_int_t n, const ae_int_t m, const real_1d_array &x, minlmstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlmcreatevj(n, m, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* - IMPROVED LEVENBERG-MARQUARDT METHOD FOR - NON-LINEAR LEAST SQUARES OPTIMIZATION - -DESCRIPTION: -This function is used to find minimum of function which is represented as -sum of squares: - F(x) = f[0]^2(x[0],...,x[n-1]) + ... + f[m-1]^2(x[0],...,x[n-1]) -using value of function vector f[] and Jacobian of f[]. - - -REQUIREMENTS: -This algorithm will request following information during its operation: - -* function vector f[] at given point X -* function vector f[] and Jacobian of f[] (simultaneously) at given point - -There are several overloaded versions of MinLMOptimize() function which -correspond to different LM-like optimization algorithms provided by this -unit. You should choose version which accepts fvec() and jac() callbacks. -First one is used to calculate f[] at given point, second one calculates -f[] and Jacobian df[i]/dx[j]. - -You can try to initialize MinLMState structure with VJ function and then -use incorrect version of MinLMOptimize() (for example, version which -works with general form function and does not provide Jacobian), but it -will lead to exception being thrown after first attempt to calculate -Jacobian. - - -USAGE: -1. User initializes algorithm state with MinLMCreateVJ() call -2. User tunes solver parameters with MinLMSetCond(), MinLMSetStpMax() and - other functions -3. User calls MinLMOptimize() function which takes algorithm state and - callback functions. -4. User calls MinLMResults() to get solution -5. Optionally, user may call MinLMRestartFrom() to solve another problem - with same N/M but another starting point and/or another function. - MinLMRestartFrom() allows to reuse already initialized structure. - - -INPUT PARAMETERS: - N - dimension, N>1 - * if given, only leading N elements of X are used - * if not given, automatically determined from size of X - M - number of functions f[i] - X - initial solution, array[0..N-1] - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -NOTES: -1. you may tune stopping conditions with MinLMSetCond() function -2. if target function contains exp() or other fast growing functions, and - optimization algorithm makes too large steps which leads to overflow, - use MinLMSetStpMax() function to bound algorithm's steps. - - -- ALGLIB -- - Copyright 30.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minlmcreatevj(const ae_int_t m, const real_1d_array &x, minlmstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlmcreatevj(n, m, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* - IMPROVED LEVENBERG-MARQUARDT METHOD FOR - NON-LINEAR LEAST SQUARES OPTIMIZATION - -DESCRIPTION: -This function is used to find minimum of function which is represented as -sum of squares: - F(x) = f[0]^2(x[0],...,x[n-1]) + ... + f[m-1]^2(x[0],...,x[n-1]) -using value of function vector f[] only. Finite differences are used to -calculate Jacobian. - - -REQUIREMENTS: -This algorithm will request following information during its operation: -* function vector f[] at given point X - -There are several overloaded versions of MinLMOptimize() function which -correspond to different LM-like optimization algorithms provided by this -unit. You should choose version which accepts fvec() callback. - -You can try to initialize MinLMState structure with VJ function and then -use incorrect version of MinLMOptimize() (for example, version which -works with general form function and does not accept function vector), but -it will lead to exception being thrown after first attempt to calculate -Jacobian. - - -USAGE: -1. User initializes algorithm state with MinLMCreateV() call -2. User tunes solver parameters with MinLMSetCond(), MinLMSetStpMax() and - other functions -3. User calls MinLMOptimize() function which takes algorithm state and - callback functions. -4. User calls MinLMResults() to get solution -5. Optionally, user may call MinLMRestartFrom() to solve another problem - with same N/M but another starting point and/or another function. - MinLMRestartFrom() allows to reuse already initialized structure. - - -INPUT PARAMETERS: - N - dimension, N>1 - * if given, only leading N elements of X are used - * if not given, automatically determined from size of X - M - number of functions f[i] - X - initial solution, array[0..N-1] - DiffStep- differentiation step, >0 - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -See also MinLMIteration, MinLMResults. - -NOTES: -1. you may tune stopping conditions with MinLMSetCond() function -2. if target function contains exp() or other fast growing functions, and - optimization algorithm makes too large steps which leads to overflow, - use MinLMSetStpMax() function to bound algorithm's steps. - - -- ALGLIB -- - Copyright 30.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minlmcreatev(const ae_int_t n, const ae_int_t m, const real_1d_array &x, const double diffstep, minlmstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlmcreatev(n, m, const_cast(x.c_ptr()), diffstep, const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* - IMPROVED LEVENBERG-MARQUARDT METHOD FOR - NON-LINEAR LEAST SQUARES OPTIMIZATION - -DESCRIPTION: -This function is used to find minimum of function which is represented as -sum of squares: - F(x) = f[0]^2(x[0],...,x[n-1]) + ... + f[m-1]^2(x[0],...,x[n-1]) -using value of function vector f[] only. Finite differences are used to -calculate Jacobian. - - -REQUIREMENTS: -This algorithm will request following information during its operation: -* function vector f[] at given point X - -There are several overloaded versions of MinLMOptimize() function which -correspond to different LM-like optimization algorithms provided by this -unit. You should choose version which accepts fvec() callback. - -You can try to initialize MinLMState structure with VJ function and then -use incorrect version of MinLMOptimize() (for example, version which -works with general form function and does not accept function vector), but -it will lead to exception being thrown after first attempt to calculate -Jacobian. - - -USAGE: -1. User initializes algorithm state with MinLMCreateV() call -2. User tunes solver parameters with MinLMSetCond(), MinLMSetStpMax() and - other functions -3. User calls MinLMOptimize() function which takes algorithm state and - callback functions. -4. User calls MinLMResults() to get solution -5. Optionally, user may call MinLMRestartFrom() to solve another problem - with same N/M but another starting point and/or another function. - MinLMRestartFrom() allows to reuse already initialized structure. - - -INPUT PARAMETERS: - N - dimension, N>1 - * if given, only leading N elements of X are used - * if not given, automatically determined from size of X - M - number of functions f[i] - X - initial solution, array[0..N-1] - DiffStep- differentiation step, >0 - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -See also MinLMIteration, MinLMResults. - -NOTES: -1. you may tune stopping conditions with MinLMSetCond() function -2. if target function contains exp() or other fast growing functions, and - optimization algorithm makes too large steps which leads to overflow, - use MinLMSetStpMax() function to bound algorithm's steps. - - -- ALGLIB -- - Copyright 30.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minlmcreatev(const ae_int_t m, const real_1d_array &x, const double diffstep, minlmstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlmcreatev(n, m, const_cast(x.c_ptr()), diffstep, const_cast(state.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* - LEVENBERG-MARQUARDT-LIKE METHOD FOR NON-LINEAR OPTIMIZATION - -DESCRIPTION: -This function is used to find minimum of general form (not "sum-of- --squares") function - F = F(x[0], ..., x[n-1]) -using its gradient and Hessian. Levenberg-Marquardt modification with -L-BFGS pre-optimization and internal pre-conditioned L-BFGS optimization -after each Levenberg-Marquardt step is used. - - -REQUIREMENTS: -This algorithm will request following information during its operation: - -* function value F at given point X -* F and gradient G (simultaneously) at given point X -* F, G and Hessian H (simultaneously) at given point X - -There are several overloaded versions of MinLMOptimize() function which -correspond to different LM-like optimization algorithms provided by this -unit. You should choose version which accepts func(), grad() and hess() -function pointers. First pointer is used to calculate F at given point, -second one calculates F(x) and grad F(x), third one calculates F(x), -grad F(x), hess F(x). - -You can try to initialize MinLMState structure with FGH-function and then -use incorrect version of MinLMOptimize() (for example, version which does -not provide Hessian matrix), but it will lead to exception being thrown -after first attempt to calculate Hessian. - - -USAGE: -1. User initializes algorithm state with MinLMCreateFGH() call -2. User tunes solver parameters with MinLMSetCond(), MinLMSetStpMax() and - other functions -3. User calls MinLMOptimize() function which takes algorithm state and - pointers (delegates, etc.) to callback functions. -4. User calls MinLMResults() to get solution -5. Optionally, user may call MinLMRestartFrom() to solve another problem - with same N but another starting point and/or another function. - MinLMRestartFrom() allows to reuse already initialized structure. - - -INPUT PARAMETERS: - N - dimension, N>1 - * if given, only leading N elements of X are used - * if not given, automatically determined from size of X - X - initial solution, array[0..N-1] - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -NOTES: -1. you may tune stopping conditions with MinLMSetCond() function -2. if target function contains exp() or other fast growing functions, and - optimization algorithm makes too large steps which leads to overflow, - use MinLMSetStpMax() function to bound algorithm's steps. - - -- ALGLIB -- - Copyright 30.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minlmcreatefgh(const ae_int_t n, const real_1d_array &x, minlmstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlmcreatefgh(n, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* - LEVENBERG-MARQUARDT-LIKE METHOD FOR NON-LINEAR OPTIMIZATION - -DESCRIPTION: -This function is used to find minimum of general form (not "sum-of- --squares") function - F = F(x[0], ..., x[n-1]) -using its gradient and Hessian. Levenberg-Marquardt modification with -L-BFGS pre-optimization and internal pre-conditioned L-BFGS optimization -after each Levenberg-Marquardt step is used. - - -REQUIREMENTS: -This algorithm will request following information during its operation: - -* function value F at given point X -* F and gradient G (simultaneously) at given point X -* F, G and Hessian H (simultaneously) at given point X - -There are several overloaded versions of MinLMOptimize() function which -correspond to different LM-like optimization algorithms provided by this -unit. You should choose version which accepts func(), grad() and hess() -function pointers. First pointer is used to calculate F at given point, -second one calculates F(x) and grad F(x), third one calculates F(x), -grad F(x), hess F(x). - -You can try to initialize MinLMState structure with FGH-function and then -use incorrect version of MinLMOptimize() (for example, version which does -not provide Hessian matrix), but it will lead to exception being thrown -after first attempt to calculate Hessian. - - -USAGE: -1. User initializes algorithm state with MinLMCreateFGH() call -2. User tunes solver parameters with MinLMSetCond(), MinLMSetStpMax() and - other functions -3. User calls MinLMOptimize() function which takes algorithm state and - pointers (delegates, etc.) to callback functions. -4. User calls MinLMResults() to get solution -5. Optionally, user may call MinLMRestartFrom() to solve another problem - with same N but another starting point and/or another function. - MinLMRestartFrom() allows to reuse already initialized structure. - - -INPUT PARAMETERS: - N - dimension, N>1 - * if given, only leading N elements of X are used - * if not given, automatically determined from size of X - X - initial solution, array[0..N-1] - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -NOTES: -1. you may tune stopping conditions with MinLMSetCond() function -2. if target function contains exp() or other fast growing functions, and - optimization algorithm makes too large steps which leads to overflow, - use MinLMSetStpMax() function to bound algorithm's steps. - - -- ALGLIB -- - Copyright 30.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minlmcreatefgh(const real_1d_array &x, minlmstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlmcreatefgh(n, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets stopping conditions for Levenberg-Marquardt optimization -algorithm. - -INPUT PARAMETERS: - State - structure which stores algorithm state - EpsG - >=0 - The subroutine finishes its work if the condition - |v|=0 - The subroutine finishes its work if on k+1-th iteration - the condition |F(k+1)-F(k)|<=EpsF*max{|F(k)|,|F(k+1)|,1} - is satisfied. - EpsX - >=0 - The subroutine finishes its work if on k+1-th iteration - the condition |v|<=EpsX is fulfilled, where: - * |.| means Euclidian norm - * v - scaled step vector, v[i]=dx[i]/s[i] - * dx - ste pvector, dx=X(k+1)-X(k) - * s - scaling coefficients set by MinLMSetScale() - MaxIts - maximum number of iterations. If MaxIts=0, the number of - iterations is unlimited. Only Levenberg-Marquardt - iterations are counted (L-BFGS/CG iterations are NOT - counted because their cost is very low compared to that of - LM). - -Passing EpsG=0, EpsF=0, EpsX=0 and MaxIts=0 (simultaneously) will lead to -automatic stopping criterion selection (small EpsX). - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minlmsetcond(const minlmstate &state, const double epsg, const double epsf, const double epsx, const ae_int_t maxits) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlmsetcond(const_cast(state.c_ptr()), epsg, epsf, epsx, maxits, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function turns on/off reporting. - -INPUT PARAMETERS: - State - structure which stores algorithm state - NeedXRep- whether iteration reports are needed or not - -If NeedXRep is True, algorithm will call rep() callback function if it is -provided to MinLMOptimize(). Both Levenberg-Marquardt and internal L-BFGS -iterations are reported. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minlmsetxrep(const minlmstate &state, const bool needxrep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlmsetxrep(const_cast(state.c_ptr()), needxrep, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets maximum step length - -INPUT PARAMETERS: - State - structure which stores algorithm state - StpMax - maximum step length, >=0. Set StpMax to 0.0, if you don't - want to limit step length. - -Use this subroutine when you optimize target function which contains exp() -or other fast growing functions, and optimization algorithm makes too -large steps which leads to overflow. This function allows us to reject -steps that are too large (and therefore expose us to the possible -overflow) without actually calculating function value at the x+stp*d. - -NOTE: non-zero StpMax leads to moderate performance degradation because -intermediate step of preconditioned L-BFGS optimization is incompatible -with limits on step size. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minlmsetstpmax(const minlmstate &state, const double stpmax) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlmsetstpmax(const_cast(state.c_ptr()), stpmax, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets scaling coefficients for LM optimizer. - -ALGLIB optimizers use scaling matrices to test stopping conditions (step -size and gradient are scaled before comparison with tolerances). Scale of -the I-th variable is a translation invariant measure of: -a) "how large" the variable is -b) how large the step should be to make significant changes in the function - -Generally, scale is NOT considered to be a form of preconditioner. But LM -optimizer is unique in that it uses scaling matrix both in the stopping -condition tests and as Marquardt damping factor. - -Proper scaling is very important for the algorithm performance. It is less -important for the quality of results, but still has some influence (it is -easier to converge when variables are properly scaled, so premature -stopping is possible when very badly scalled variables are combined with -relaxed stopping conditions). - -INPUT PARAMETERS: - State - structure stores algorithm state - S - array[N], non-zero scaling coefficients - S[i] may be negative, sign doesn't matter. - - -- ALGLIB -- - Copyright 14.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minlmsetscale(const minlmstate &state, const real_1d_array &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlmsetscale(const_cast(state.c_ptr()), const_cast(s.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets boundary constraints for LM optimizer - -Boundary constraints are inactive by default (after initial creation). -They are preserved until explicitly turned off with another SetBC() call. - -INPUT PARAMETERS: - State - structure stores algorithm state - BndL - lower bounds, array[N]. - If some (all) variables are unbounded, you may specify - very small number or -INF (latter is recommended because - it will allow solver to use better algorithm). - BndU - upper bounds, array[N]. - If some (all) variables are unbounded, you may specify - very large number or +INF (latter is recommended because - it will allow solver to use better algorithm). - -NOTE 1: it is possible to specify BndL[i]=BndU[i]. In this case I-th -variable will be "frozen" at X[i]=BndL[i]=BndU[i]. - -NOTE 2: this solver has following useful properties: -* bound constraints are always satisfied exactly -* function is evaluated only INSIDE area specified by bound constraints - or at its boundary - - -- ALGLIB -- - Copyright 14.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minlmsetbc(const minlmstate &state, const real_1d_array &bndl, const real_1d_array &bndu) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlmsetbc(const_cast(state.c_ptr()), const_cast(bndl.c_ptr()), const_cast(bndu.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function is used to change acceleration settings - -You can choose between three acceleration strategies: -* AccType=0, no acceleration. -* AccType=1, secant updates are used to update quadratic model after each - iteration. After fixed number of iterations (or after model breakdown) - we recalculate quadratic model using analytic Jacobian or finite - differences. Number of secant-based iterations depends on optimization - settings: about 3 iterations - when we have analytic Jacobian, up to 2*N - iterations - when we use finite differences to calculate Jacobian. - -AccType=1 is recommended when Jacobian calculation cost is prohibitive -high (several Mx1 function vector calculations followed by several NxN -Cholesky factorizations are faster than calculation of one M*N Jacobian). -It should also be used when we have no Jacobian, because finite difference -approximation takes too much time to compute. - -Table below list optimization protocols (XYZ protocol corresponds to -MinLMCreateXYZ) and acceleration types they support (and use by default). - -ACCELERATION TYPES SUPPORTED BY OPTIMIZATION PROTOCOLS: - -protocol 0 1 comment -V + + -VJ + + -FGH + - -DAFAULT VALUES: - -protocol 0 1 comment -V x without acceleration it is so slooooooooow -VJ x -FGH x - -NOTE: this function should be called before optimization. Attempt to call -it during algorithm iterations may result in unexpected behavior. - -NOTE: attempt to call this function with unsupported protocol/acceleration -combination will result in exception being thrown. - - -- ALGLIB -- - Copyright 14.10.2010 by Bochkanov Sergey -*************************************************************************/ -void minlmsetacctype(const minlmstate &state, const ae_int_t acctype) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlmsetacctype(const_cast(state.c_ptr()), acctype, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function provides reverse communication interface -Reverse communication interface is not documented or recommended to use. -See below for functions which provide better documented API -*************************************************************************/ -bool minlmiteration(const minlmstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::minlmiteration(const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void minlmoptimize(minlmstate &state, - void (*fvec)(const real_1d_array &x, real_1d_array &fi, void *ptr), - void (*rep)(const real_1d_array &x, double func, void *ptr), - void *ptr) -{ - alglib_impl::ae_state _alglib_env_state; - if( fvec==NULL ) - throw ap_error("ALGLIB: error in 'minlmoptimize()' (fvec is NULL)"); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - while( alglib_impl::minlmiteration(state.c_ptr(), &_alglib_env_state) ) - { - if( state.needfi ) - { - fvec(state.x, state.fi, ptr); - continue; - } - if( state.xupdated ) - { - if( rep!=NULL ) - rep(state.x, state.f, ptr); - continue; - } - throw ap_error("ALGLIB: error in 'minlmoptimize' (some derivatives were not provided?)"); - } - alglib_impl::ae_state_clear(&_alglib_env_state); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void minlmoptimize(minlmstate &state, - void (*fvec)(const real_1d_array &x, real_1d_array &fi, void *ptr), - void (*jac)(const real_1d_array &x, real_1d_array &fi, real_2d_array &jac, void *ptr), - void (*rep)(const real_1d_array &x, double func, void *ptr), - void *ptr) -{ - alglib_impl::ae_state _alglib_env_state; - if( fvec==NULL ) - throw ap_error("ALGLIB: error in 'minlmoptimize()' (fvec is NULL)"); - if( jac==NULL ) - throw ap_error("ALGLIB: error in 'minlmoptimize()' (jac is NULL)"); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - while( alglib_impl::minlmiteration(state.c_ptr(), &_alglib_env_state) ) - { - if( state.needfi ) - { - fvec(state.x, state.fi, ptr); - continue; - } - if( state.needfij ) - { - jac(state.x, state.fi, state.j, ptr); - continue; - } - if( state.xupdated ) - { - if( rep!=NULL ) - rep(state.x, state.f, ptr); - continue; - } - throw ap_error("ALGLIB: error in 'minlmoptimize' (some derivatives were not provided?)"); - } - alglib_impl::ae_state_clear(&_alglib_env_state); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void minlmoptimize(minlmstate &state, - void (*func)(const real_1d_array &x, double &func, void *ptr), - void (*grad)(const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), - void (*hess)(const real_1d_array &x, double &func, real_1d_array &grad, real_2d_array &hess, void *ptr), - void (*rep)(const real_1d_array &x, double func, void *ptr), - void *ptr) -{ - alglib_impl::ae_state _alglib_env_state; - if( func==NULL ) - throw ap_error("ALGLIB: error in 'minlmoptimize()' (func is NULL)"); - if( grad==NULL ) - throw ap_error("ALGLIB: error in 'minlmoptimize()' (grad is NULL)"); - if( hess==NULL ) - throw ap_error("ALGLIB: error in 'minlmoptimize()' (hess is NULL)"); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - while( alglib_impl::minlmiteration(state.c_ptr(), &_alglib_env_state) ) - { - if( state.needf ) - { - func(state.x, state.f, ptr); - continue; - } - if( state.needfg ) - { - grad(state.x, state.f, state.g, ptr); - continue; - } - if( state.needfgh ) - { - hess(state.x, state.f, state.g, state.h, ptr); - continue; - } - if( state.xupdated ) - { - if( rep!=NULL ) - rep(state.x, state.f, ptr); - continue; - } - throw ap_error("ALGLIB: error in 'minlmoptimize' (some derivatives were not provided?)"); - } - alglib_impl::ae_state_clear(&_alglib_env_state); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void minlmoptimize(minlmstate &state, - void (*func)(const real_1d_array &x, double &func, void *ptr), - void (*jac)(const real_1d_array &x, real_1d_array &fi, real_2d_array &jac, void *ptr), - void (*rep)(const real_1d_array &x, double func, void *ptr), - void *ptr) -{ - alglib_impl::ae_state _alglib_env_state; - if( func==NULL ) - throw ap_error("ALGLIB: error in 'minlmoptimize()' (func is NULL)"); - if( jac==NULL ) - throw ap_error("ALGLIB: error in 'minlmoptimize()' (jac is NULL)"); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - while( alglib_impl::minlmiteration(state.c_ptr(), &_alglib_env_state) ) - { - if( state.needf ) - { - func(state.x, state.f, ptr); - continue; - } - if( state.needfij ) - { - jac(state.x, state.fi, state.j, ptr); - continue; - } - if( state.xupdated ) - { - if( rep!=NULL ) - rep(state.x, state.f, ptr); - continue; - } - throw ap_error("ALGLIB: error in 'minlmoptimize' (some derivatives were not provided?)"); - } - alglib_impl::ae_state_clear(&_alglib_env_state); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void minlmoptimize(minlmstate &state, - void (*func)(const real_1d_array &x, double &func, void *ptr), - void (*grad)(const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), - void (*jac)(const real_1d_array &x, real_1d_array &fi, real_2d_array &jac, void *ptr), - void (*rep)(const real_1d_array &x, double func, void *ptr), - void *ptr) -{ - alglib_impl::ae_state _alglib_env_state; - if( func==NULL ) - throw ap_error("ALGLIB: error in 'minlmoptimize()' (func is NULL)"); - if( grad==NULL ) - throw ap_error("ALGLIB: error in 'minlmoptimize()' (grad is NULL)"); - if( jac==NULL ) - throw ap_error("ALGLIB: error in 'minlmoptimize()' (jac is NULL)"); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - while( alglib_impl::minlmiteration(state.c_ptr(), &_alglib_env_state) ) - { - if( state.needf ) - { - func(state.x, state.f, ptr); - continue; - } - if( state.needfg ) - { - grad(state.x, state.f, state.g, ptr); - continue; - } - if( state.needfij ) - { - jac(state.x, state.fi, state.j, ptr); - continue; - } - if( state.xupdated ) - { - if( rep!=NULL ) - rep(state.x, state.f, ptr); - continue; - } - throw ap_error("ALGLIB: error in 'minlmoptimize' (some derivatives were not provided?)"); - } - alglib_impl::ae_state_clear(&_alglib_env_state); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - - -/************************************************************************* -Levenberg-Marquardt algorithm results - -INPUT PARAMETERS: - State - algorithm state - -OUTPUT PARAMETERS: - X - array[0..N-1], solution - Rep - optimization report; - see comments for this structure for more info. - - -- ALGLIB -- - Copyright 10.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minlmresults(const minlmstate &state, real_1d_array &x, minlmreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlmresults(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Levenberg-Marquardt algorithm results - -Buffered implementation of MinLMResults(), which uses pre-allocated buffer -to store X[]. If buffer size is too small, it resizes buffer. It is -intended to be used in the inner cycles of performance critical algorithms -where array reallocation penalty is too large to be ignored. - - -- ALGLIB -- - Copyright 10.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minlmresultsbuf(const minlmstate &state, real_1d_array &x, minlmreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlmresultsbuf(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine restarts LM algorithm from new point. All optimization -parameters are left unchanged. - -This function allows to solve multiple optimization problems (which -must have same number of dimensions) without object reallocation penalty. - -INPUT PARAMETERS: - State - structure used for reverse communication previously - allocated with MinLMCreateXXX call. - X - new starting point. - - -- ALGLIB -- - Copyright 30.07.2010 by Bochkanov Sergey -*************************************************************************/ -void minlmrestartfrom(const minlmstate &state, const real_1d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlmrestartfrom(const_cast(state.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This is obsolete function. - -Since ALGLIB 3.3 it is equivalent to MinLMCreateVJ(). - - -- ALGLIB -- - Copyright 30.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minlmcreatevgj(const ae_int_t n, const ae_int_t m, const real_1d_array &x, minlmstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlmcreatevgj(n, m, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This is obsolete function. - -Since ALGLIB 3.3 it is equivalent to MinLMCreateVJ(). - - -- ALGLIB -- - Copyright 30.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minlmcreatevgj(const ae_int_t m, const real_1d_array &x, minlmstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlmcreatevgj(n, m, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This is obsolete function. - -Since ALGLIB 3.3 it is equivalent to MinLMCreateFJ(). - - -- ALGLIB -- - Copyright 30.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minlmcreatefgj(const ae_int_t n, const ae_int_t m, const real_1d_array &x, minlmstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlmcreatefgj(n, m, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This is obsolete function. - -Since ALGLIB 3.3 it is equivalent to MinLMCreateFJ(). - - -- ALGLIB -- - Copyright 30.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minlmcreatefgj(const ae_int_t m, const real_1d_array &x, minlmstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlmcreatefgj(n, m, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function is considered obsolete since ALGLIB 3.1.0 and is present for -backward compatibility only. We recommend to use MinLMCreateVJ, which -provides similar, but more consistent and feature-rich interface. - - -- ALGLIB -- - Copyright 30.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minlmcreatefj(const ae_int_t n, const ae_int_t m, const real_1d_array &x, minlmstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlmcreatefj(n, m, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function is considered obsolete since ALGLIB 3.1.0 and is present for -backward compatibility only. We recommend to use MinLMCreateVJ, which -provides similar, but more consistent and feature-rich interface. - - -- ALGLIB -- - Copyright 30.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minlmcreatefj(const ae_int_t m, const real_1d_array &x, minlmstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlmcreatefj(n, m, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine turns on verification of the user-supplied analytic -gradient: -* user calls this subroutine before optimization begins -* MinLMOptimize() is called -* prior to actual optimization, for each function Fi and each component - of parameters being optimized X[j] algorithm performs following steps: - * two trial steps are made to X[j]-TestStep*S[j] and X[j]+TestStep*S[j], - where X[j] is j-th parameter and S[j] is a scale of j-th parameter - * if needed, steps are bounded with respect to constraints on X[] - * Fi(X) is evaluated at these trial points - * we perform one more evaluation in the middle point of the interval - * we build cubic model using function values and derivatives at trial - points and we compare its prediction with actual value in the middle - point - * in case difference between prediction and actual value is higher than - some predetermined threshold, algorithm stops with completion code -7; - Rep.VarIdx is set to index of the parameter with incorrect derivative, - Rep.FuncIdx is set to index of the function. -* after verification is over, algorithm proceeds to the actual optimization. - -NOTE 1: verification needs N (parameters count) Jacobian evaluations. It - is very costly and you should use it only for low dimensional - problems, when you want to be sure that you've correctly - calculated analytic derivatives. You should not use it in the - production code (unless you want to check derivatives provided - by some third party). - -NOTE 2: you should carefully choose TestStep. Value which is too large - (so large that function behaviour is significantly non-cubic) will - lead to false alarms. You may use different step for different - parameters by means of setting scale with MinLMSetScale(). - -NOTE 3: this function may lead to false positives. In case it reports that - I-th derivative was calculated incorrectly, you may decrease test - step and try one more time - maybe your function changes too - sharply and your step is too large for such rapidly chanding - function. - -INPUT PARAMETERS: - State - structure used to store algorithm state - TestStep - verification step: - * TestStep=0 turns verification off - * TestStep>0 activates verification - - -- ALGLIB -- - Copyright 15.06.2012 by Bochkanov Sergey -*************************************************************************/ -void minlmsetgradientcheck(const minlmstate &state, const double teststep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlmsetgradientcheck(const_cast(state.c_ptr()), teststep, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* - -*************************************************************************/ -_minasastate_owner::_minasastate_owner() -{ - p_struct = (alglib_impl::minasastate*)alglib_impl::ae_malloc(sizeof(alglib_impl::minasastate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_minasastate_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_minasastate_owner::_minasastate_owner(const _minasastate_owner &rhs) -{ - p_struct = (alglib_impl::minasastate*)alglib_impl::ae_malloc(sizeof(alglib_impl::minasastate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_minasastate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_minasastate_owner& _minasastate_owner::operator=(const _minasastate_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_minasastate_clear(p_struct); - if( !alglib_impl::_minasastate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_minasastate_owner::~_minasastate_owner() -{ - alglib_impl::_minasastate_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::minasastate* _minasastate_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::minasastate* _minasastate_owner::c_ptr() const -{ - return const_cast(p_struct); -} -minasastate::minasastate() : _minasastate_owner() ,needfg(p_struct->needfg),xupdated(p_struct->xupdated),f(p_struct->f),g(&p_struct->g),x(&p_struct->x) -{ -} - -minasastate::minasastate(const minasastate &rhs):_minasastate_owner(rhs) ,needfg(p_struct->needfg),xupdated(p_struct->xupdated),f(p_struct->f),g(&p_struct->g),x(&p_struct->x) -{ -} - -minasastate& minasastate::operator=(const minasastate &rhs) -{ - if( this==&rhs ) - return *this; - _minasastate_owner::operator=(rhs); - return *this; -} - -minasastate::~minasastate() -{ -} - - -/************************************************************************* - -*************************************************************************/ -_minasareport_owner::_minasareport_owner() -{ - p_struct = (alglib_impl::minasareport*)alglib_impl::ae_malloc(sizeof(alglib_impl::minasareport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_minasareport_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_minasareport_owner::_minasareport_owner(const _minasareport_owner &rhs) -{ - p_struct = (alglib_impl::minasareport*)alglib_impl::ae_malloc(sizeof(alglib_impl::minasareport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_minasareport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_minasareport_owner& _minasareport_owner::operator=(const _minasareport_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_minasareport_clear(p_struct); - if( !alglib_impl::_minasareport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_minasareport_owner::~_minasareport_owner() -{ - alglib_impl::_minasareport_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::minasareport* _minasareport_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::minasareport* _minasareport_owner::c_ptr() const -{ - return const_cast(p_struct); -} -minasareport::minasareport() : _minasareport_owner() ,iterationscount(p_struct->iterationscount),nfev(p_struct->nfev),terminationtype(p_struct->terminationtype),activeconstraints(p_struct->activeconstraints) -{ -} - -minasareport::minasareport(const minasareport &rhs):_minasareport_owner(rhs) ,iterationscount(p_struct->iterationscount),nfev(p_struct->nfev),terminationtype(p_struct->terminationtype),activeconstraints(p_struct->activeconstraints) -{ -} - -minasareport& minasareport::operator=(const minasareport &rhs) -{ - if( this==&rhs ) - return *this; - _minasareport_owner::operator=(rhs); - return *this; -} - -minasareport::~minasareport() -{ -} - -/************************************************************************* -Obsolete function, use MinLBFGSSetPrecDefault() instead. - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetdefaultpreconditioner(const minlbfgsstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlbfgssetdefaultpreconditioner(const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Obsolete function, use MinLBFGSSetCholeskyPreconditioner() instead. - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetcholeskypreconditioner(const minlbfgsstate &state, const real_2d_array &p, const bool isupper) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minlbfgssetcholeskypreconditioner(const_cast(state.c_ptr()), const_cast(p.c_ptr()), isupper, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This is obsolete function which was used by previous version of the BLEIC -optimizer. It does nothing in the current version of BLEIC. - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetbarrierwidth(const minbleicstate &state, const double mu) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minbleicsetbarrierwidth(const_cast(state.c_ptr()), mu, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This is obsolete function which was used by previous version of the BLEIC -optimizer. It does nothing in the current version of BLEIC. - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetbarrierdecay(const minbleicstate &state, const double mudecay) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minbleicsetbarrierdecay(const_cast(state.c_ptr()), mudecay, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Obsolete optimization algorithm. -Was replaced by MinBLEIC subpackage. - - -- ALGLIB -- - Copyright 25.03.2010 by Bochkanov Sergey -*************************************************************************/ -void minasacreate(const ae_int_t n, const real_1d_array &x, const real_1d_array &bndl, const real_1d_array &bndu, minasastate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minasacreate(n, const_cast(x.c_ptr()), const_cast(bndl.c_ptr()), const_cast(bndu.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Obsolete optimization algorithm. -Was replaced by MinBLEIC subpackage. - - -- ALGLIB -- - Copyright 25.03.2010 by Bochkanov Sergey -*************************************************************************/ -void minasacreate(const real_1d_array &x, const real_1d_array &bndl, const real_1d_array &bndu, minasastate &state) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - if( (x.length()!=bndl.length()) || (x.length()!=bndu.length())) - throw ap_error("Error while calling 'minasacreate': looks like one of arguments has wrong size"); - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minasacreate(n, const_cast(x.c_ptr()), const_cast(bndl.c_ptr()), const_cast(bndu.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Obsolete optimization algorithm. -Was replaced by MinBLEIC subpackage. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minasasetcond(const minasastate &state, const double epsg, const double epsf, const double epsx, const ae_int_t maxits) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minasasetcond(const_cast(state.c_ptr()), epsg, epsf, epsx, maxits, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Obsolete optimization algorithm. -Was replaced by MinBLEIC subpackage. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minasasetxrep(const minasastate &state, const bool needxrep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minasasetxrep(const_cast(state.c_ptr()), needxrep, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Obsolete optimization algorithm. -Was replaced by MinBLEIC subpackage. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minasasetalgorithm(const minasastate &state, const ae_int_t algotype) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minasasetalgorithm(const_cast(state.c_ptr()), algotype, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Obsolete optimization algorithm. -Was replaced by MinBLEIC subpackage. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minasasetstpmax(const minasastate &state, const double stpmax) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minasasetstpmax(const_cast(state.c_ptr()), stpmax, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function provides reverse communication interface -Reverse communication interface is not documented or recommended to use. -See below for functions which provide better documented API -*************************************************************************/ -bool minasaiteration(const minasastate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::minasaiteration(const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void minasaoptimize(minasastate &state, - void (*grad)(const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), - void (*rep)(const real_1d_array &x, double func, void *ptr), - void *ptr) -{ - alglib_impl::ae_state _alglib_env_state; - if( grad==NULL ) - throw ap_error("ALGLIB: error in 'minasaoptimize()' (grad is NULL)"); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - while( alglib_impl::minasaiteration(state.c_ptr(), &_alglib_env_state) ) - { - if( state.needfg ) - { - grad(state.x, state.f, state.g, ptr); - continue; - } - if( state.xupdated ) - { - if( rep!=NULL ) - rep(state.x, state.f, ptr); - continue; - } - throw ap_error("ALGLIB: error in 'minasaoptimize' (some derivatives were not provided?)"); - } - alglib_impl::ae_state_clear(&_alglib_env_state); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - - -/************************************************************************* -Obsolete optimization algorithm. -Was replaced by MinBLEIC subpackage. - - -- ALGLIB -- - Copyright 20.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minasaresults(const minasastate &state, real_1d_array &x, minasareport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minasaresults(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Obsolete optimization algorithm. -Was replaced by MinBLEIC subpackage. - - -- ALGLIB -- - Copyright 20.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minasaresultsbuf(const minasastate &state, real_1d_array &x, minasareport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minasaresultsbuf(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Obsolete optimization algorithm. -Was replaced by MinBLEIC subpackage. - - -- ALGLIB -- - Copyright 30.07.2010 by Bochkanov Sergey -*************************************************************************/ -void minasarestartfrom(const minasastate &state, const real_1d_array &x, const real_1d_array &bndl, const real_1d_array &bndu) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::minasarestartfrom(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(bndl.c_ptr()), const_cast(bndu.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS IMPLEMENTATION OF COMPUTATIONAL CORE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ - - -static ae_int_t cqmodels_newtonrefinementits = 3; -static ae_bool cqmodels_cqmrebuild(convexquadraticmodel* s, - ae_state *_state); -static void cqmodels_cqmsolveea(convexquadraticmodel* s, - /* Real */ ae_vector* x, - /* Real */ ae_vector* tmp, - ae_state *_state); - - -static ae_int_t snnls_iterativerefinementits = 3; -static ae_bool snnls_boundedstepandactivation(/* Real */ ae_vector* xc, - /* Real */ ae_vector* xn, - /* Boolean */ ae_vector* nnc, - ae_int_t n, - ae_state *_state); - - -static void sactivesets_constraineddescent(sactiveset* state, - /* Real */ ae_vector* g, - /* Real */ ae_vector* h, - /* Real */ ae_matrix* ha, - ae_bool normalize, - /* Real */ ae_vector* d, - ae_state *_state); -static void sactivesets_reactivateconstraints(sactiveset* state, - /* Real */ ae_vector* gc, - /* Real */ ae_vector* h, - ae_state *_state); - - -static ae_int_t mincg_rscountdownlen = 10; -static double mincg_gtol = 0.3; -static void mincg_clearrequestfields(mincgstate* state, ae_state *_state); -static void mincg_preconditionedmultiply(mincgstate* state, - /* Real */ ae_vector* x, - /* Real */ ae_vector* work0, - /* Real */ ae_vector* work1, - ae_state *_state); -static double mincg_preconditionedmultiply2(mincgstate* state, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* work0, - /* Real */ ae_vector* work1, - ae_state *_state); -static void mincg_mincginitinternal(ae_int_t n, - double diffstep, - mincgstate* state, - ae_state *_state); - - -static double minbleic_gtol = 0.4; -static double minbleic_maxnonmonotoniclen = 1.0E-5; -static double minbleic_initialdecay = 0.5; -static double minbleic_mindecay = 0.1; -static double minbleic_decaycorrection = 0.8; -static double minbleic_penaltyfactor = 100; -static void minbleic_clearrequestfields(minbleicstate* state, - ae_state *_state); -static void minbleic_minbleicinitinternal(ae_int_t n, - /* Real */ ae_vector* x, - double diffstep, - minbleicstate* state, - ae_state *_state); -static void minbleic_updateestimateofgoodstep(double* estimate, - double newstep, - ae_state *_state); - - -static double minlbfgs_gtol = 0.4; -static void minlbfgs_clearrequestfields(minlbfgsstate* state, - ae_state *_state); - - -static ae_int_t minqp_maxlagrangeits = 10; -static ae_int_t minqp_maxbadnewtonits = 7; -static double minqp_penaltyfactor = 100.0; -static ae_int_t minqp_minqpboundedstepandactivation(minqpstate* state, - /* Real */ ae_vector* xn, - /* Real */ ae_vector* buf, - ae_state *_state); -static double minqp_minqpmodelvalue(convexquadraticmodel* a, - /* Real */ ae_vector* b, - /* Real */ ae_vector* xc, - ae_int_t n, - /* Real */ ae_vector* tmp, - ae_state *_state); -static ae_bool minqp_minqpconstrainedoptimum(minqpstate* state, - convexquadraticmodel* a, - double anorm, - /* Real */ ae_vector* b, - /* Real */ ae_vector* xn, - /* Real */ ae_vector* tmp, - /* Boolean */ ae_vector* tmpb, - /* Real */ ae_vector* lagrangec, - ae_state *_state); - - -static double minlm_lambdaup = 2.0; -static double minlm_lambdadown = 0.33; -static double minlm_suspiciousnu = 16; -static ae_int_t minlm_smallmodelage = 3; -static ae_int_t minlm_additers = 5; -static void minlm_lmprepare(ae_int_t n, - ae_int_t m, - ae_bool havegrad, - minlmstate* state, - ae_state *_state); -static void minlm_clearrequestfields(minlmstate* state, ae_state *_state); -static ae_bool minlm_increaselambda(double* lambdav, - double* nu, - ae_state *_state); -static void minlm_decreaselambda(double* lambdav, - double* nu, - ae_state *_state); -static double minlm_boundedscaledantigradnorm(minlmstate* state, - /* Real */ ae_vector* x, - /* Real */ ae_vector* g, - ae_state *_state); - - -static ae_int_t mincomp_n1 = 2; -static ae_int_t mincomp_n2 = 2; -static double mincomp_stpmin = 1.0E-300; -static double mincomp_gtol = 0.3; -static double mincomp_gpaftol = 0.0001; -static double mincomp_gpadecay = 0.5; -static double mincomp_asarho = 0.5; -static double mincomp_asaboundedantigradnorm(minasastate* state, - ae_state *_state); -static double mincomp_asaginorm(minasastate* state, ae_state *_state); -static double mincomp_asad1norm(minasastate* state, ae_state *_state); -static ae_bool mincomp_asauisempty(minasastate* state, ae_state *_state); -static void mincomp_clearrequestfields(minasastate* state, - ae_state *_state); - - - - - -/************************************************************************* -This subroutine is used to prepare threshold value which will be used for -trimming of the target function (see comments on TrimFunction() for more -information). - -This function accepts only one parameter: function value at the starting -point. It returns threshold which will be used for trimming. - - -- ALGLIB -- - Copyright 10.05.2011 by Bochkanov Sergey -*************************************************************************/ -void trimprepare(double f, double* threshold, ae_state *_state) -{ - - *threshold = 0; - - *threshold = 10*(ae_fabs(f, _state)+1); -} - - -/************************************************************************* -This subroutine is used to "trim" target function, i.e. to do following -transformation: - - { {F,G} if F=Threshold - -Such transformation allows us to solve problems with singularities by -redefining function in such way that it becomes bounded from above. - - -- ALGLIB -- - Copyright 10.05.2011 by Bochkanov Sergey -*************************************************************************/ -void trimfunction(double* f, - /* Real */ ae_vector* g, - ae_int_t n, - double threshold, - ae_state *_state) -{ - ae_int_t i; - - - if( ae_fp_greater_eq(*f,threshold) ) - { - *f = threshold; - for(i=0; i<=n-1; i++) - { - g->ptr.p_double[i] = 0.0; - } - } -} - - -/************************************************************************* -This function enforces boundary constraints in the X. - -This function correctly (although a bit inefficient) handles BL[i] which -are -INF and BU[i] which are +INF. - -We have NMain+NSlack dimensional X, with first NMain components bounded -by BL/BU, and next NSlack ones bounded by non-negativity constraints. - -INPUT PARAMETERS - X - array[NMain+NSlack], point - BL - array[NMain], lower bounds - (may contain -INF, when bound is not present) - HaveBL - array[NMain], if HaveBL[i] is False, - then i-th bound is not present - BU - array[NMain], upper bounds - (may contain +INF, when bound is not present) - HaveBU - array[NMain], if HaveBU[i] is False, - then i-th bound is not present - -OUTPUT PARAMETERS - X - X with all constraints being enforced - -It returns True when constraints are consistent, -False - when constraints are inconsistent. - - -- ALGLIB -- - Copyright 10.01.2012 by Bochkanov Sergey -*************************************************************************/ -ae_bool enforceboundaryconstraints(/* Real */ ae_vector* x, - /* Real */ ae_vector* bl, - /* Boolean */ ae_vector* havebl, - /* Real */ ae_vector* bu, - /* Boolean */ ae_vector* havebu, - ae_int_t nmain, - ae_int_t nslack, - ae_state *_state) -{ - ae_int_t i; - ae_bool result; - - - result = ae_false; - for(i=0; i<=nmain-1; i++) - { - if( (havebl->ptr.p_bool[i]&&havebu->ptr.p_bool[i])&&ae_fp_greater(bl->ptr.p_double[i],bu->ptr.p_double[i]) ) - { - return result; - } - if( havebl->ptr.p_bool[i]&&ae_fp_less(x->ptr.p_double[i],bl->ptr.p_double[i]) ) - { - x->ptr.p_double[i] = bl->ptr.p_double[i]; - } - if( havebu->ptr.p_bool[i]&&ae_fp_greater(x->ptr.p_double[i],bu->ptr.p_double[i]) ) - { - x->ptr.p_double[i] = bu->ptr.p_double[i]; - } - } - for(i=0; i<=nslack-1; i++) - { - if( ae_fp_less(x->ptr.p_double[nmain+i],0) ) - { - x->ptr.p_double[nmain+i] = 0; - } - } - result = ae_true; - return result; -} - - -/************************************************************************* -This function projects gradient into feasible area of boundary constrained -optimization problem. X can be infeasible with respect to boundary -constraints. We have NMain+NSlack dimensional X, with first NMain -components bounded by BL/BU, and next NSlack ones bounded by non-negativity -constraints. - -INPUT PARAMETERS - X - array[NMain+NSlack], point - G - array[NMain+NSlack], gradient - BL - lower bounds (may contain -INF, when bound is not present) - HaveBL - if HaveBL[i] is False, then i-th bound is not present - BU - upper bounds (may contain +INF, when bound is not present) - HaveBU - if HaveBU[i] is False, then i-th bound is not present - -OUTPUT PARAMETERS - G - projection of G. Components of G which satisfy one of the - following - (1) (X[I]<=BndL[I]) and (G[I]>0), OR - (2) (X[I]>=BndU[I]) and (G[I]<0) - are replaced by zeros. - -NOTE 1: this function assumes that constraints are feasible. It throws -exception otherwise. - -NOTE 2: in fact, projection of ANTI-gradient is calculated, because this -function trims components of -G which points outside of the feasible area. -However, working with -G is considered confusing, because all optimization -source work with G. - - -- ALGLIB -- - Copyright 10.01.2012 by Bochkanov Sergey -*************************************************************************/ -void projectgradientintobc(/* Real */ ae_vector* x, - /* Real */ ae_vector* g, - /* Real */ ae_vector* bl, - /* Boolean */ ae_vector* havebl, - /* Real */ ae_vector* bu, - /* Boolean */ ae_vector* havebu, - ae_int_t nmain, - ae_int_t nslack, - ae_state *_state) -{ - ae_int_t i; - - - for(i=0; i<=nmain-1; i++) - { - ae_assert((!havebl->ptr.p_bool[i]||!havebu->ptr.p_bool[i])||ae_fp_less_eq(bl->ptr.p_double[i],bu->ptr.p_double[i]), "ProjectGradientIntoBC: internal error (infeasible constraints)", _state); - if( (havebl->ptr.p_bool[i]&&ae_fp_less_eq(x->ptr.p_double[i],bl->ptr.p_double[i]))&&ae_fp_greater(g->ptr.p_double[i],0) ) - { - g->ptr.p_double[i] = 0; - } - if( (havebu->ptr.p_bool[i]&&ae_fp_greater_eq(x->ptr.p_double[i],bu->ptr.p_double[i]))&&ae_fp_less(g->ptr.p_double[i],0) ) - { - g->ptr.p_double[i] = 0; - } - } - for(i=0; i<=nslack-1; i++) - { - if( ae_fp_less_eq(x->ptr.p_double[nmain+i],0)&&ae_fp_greater(g->ptr.p_double[nmain+i],0) ) - { - g->ptr.p_double[nmain+i] = 0; - } - } -} - - -/************************************************************************* -Given - a) initial point X0[NMain+NSlack] - (feasible with respect to bound constraints) - b) step vector alpha*D[NMain+NSlack] - c) boundary constraints BndL[NMain], BndU[NMain] - d) implicit non-negativity constraints for slack variables -this function calculates bound on the step length subject to boundary -constraints. - -It returns: - * MaxStepLen - such step length that X0+MaxStepLen*alpha*D is exactly - at the boundary given by constraints - * VariableToFreeze - index of the constraint to be activated, - 0 <= VariableToFreeze < NMain+NSlack - * ValueToFreeze - value of the corresponding constraint. - -Notes: - * it is possible that several constraints can be activated by the step - at once. In such cases only one constraint is returned. It is caller - responsibility to check other constraints. This function makes sure - that we activate at least one constraint, and everything else is the - responsibility of the caller. - * steps smaller than MaxStepLen still can activate constraints due to - numerical errors. Thus purpose of this function is not to guard - against accidental activation of the constraints - quite the reverse, - its purpose is to activate at least constraint upon performing step - which is too long. - * in case there is no constraints to activate, we return negative - VariableToFreeze and zero MaxStepLen and ValueToFreeze. - * this function assumes that constraints are consistent; it throws - exception otherwise. - -INPUT PARAMETERS - X - array[NMain+NSlack], point. Must be feasible with respect - to bound constraints (exception will be thrown otherwise) - D - array[NMain+NSlack], step direction - alpha - scalar multiplier before D, alpha<>0 - BndL - lower bounds, array[NMain] - (may contain -INF, when bound is not present) - HaveBndL - array[NMain], if HaveBndL[i] is False, - then i-th bound is not present - BndU - array[NMain], upper bounds - (may contain +INF, when bound is not present) - HaveBndU - array[NMain], if HaveBndU[i] is False, - then i-th bound is not present - NMain - number of main variables - NSlack - number of slack variables - -OUTPUT PARAMETERS - VariableToFreeze: - * negative value = step is unbounded, ValueToFreeze=0, - MaxStepLen=0. - * non-negative value = at least one constraint, given by - this parameter, will be activated - upon performing maximum step. - ValueToFreeze- value of the variable which will be constrained - MaxStepLen - maximum length of the step. Can be zero when step vector - looks outside of the feasible area. - - -- ALGLIB -- - Copyright 10.01.2012 by Bochkanov Sergey -*************************************************************************/ -void calculatestepbound(/* Real */ ae_vector* x, - /* Real */ ae_vector* d, - double alpha, - /* Real */ ae_vector* bndl, - /* Boolean */ ae_vector* havebndl, - /* Real */ ae_vector* bndu, - /* Boolean */ ae_vector* havebndu, - ae_int_t nmain, - ae_int_t nslack, - ae_int_t* variabletofreeze, - double* valuetofreeze, - double* maxsteplen, - ae_state *_state) -{ - ae_int_t i; - double prevmax; - double initval; - - *variabletofreeze = 0; - *valuetofreeze = 0; - *maxsteplen = 0; - - ae_assert(ae_fp_neq(alpha,0), "CalculateStepBound: zero alpha", _state); - *variabletofreeze = -1; - initval = ae_maxrealnumber; - *maxsteplen = initval; - for(i=0; i<=nmain-1; i++) - { - if( havebndl->ptr.p_bool[i]&&ae_fp_less(alpha*d->ptr.p_double[i],0) ) - { - ae_assert(ae_fp_greater_eq(x->ptr.p_double[i],bndl->ptr.p_double[i]), "CalculateStepBound: infeasible X", _state); - prevmax = *maxsteplen; - *maxsteplen = safeminposrv(x->ptr.p_double[i]-bndl->ptr.p_double[i], -alpha*d->ptr.p_double[i], *maxsteplen, _state); - if( ae_fp_less(*maxsteplen,prevmax) ) - { - *variabletofreeze = i; - *valuetofreeze = bndl->ptr.p_double[i]; - } - } - if( havebndu->ptr.p_bool[i]&&ae_fp_greater(alpha*d->ptr.p_double[i],0) ) - { - ae_assert(ae_fp_less_eq(x->ptr.p_double[i],bndu->ptr.p_double[i]), "CalculateStepBound: infeasible X", _state); - prevmax = *maxsteplen; - *maxsteplen = safeminposrv(bndu->ptr.p_double[i]-x->ptr.p_double[i], alpha*d->ptr.p_double[i], *maxsteplen, _state); - if( ae_fp_less(*maxsteplen,prevmax) ) - { - *variabletofreeze = i; - *valuetofreeze = bndu->ptr.p_double[i]; - } - } - } - for(i=0; i<=nslack-1; i++) - { - if( ae_fp_less(alpha*d->ptr.p_double[nmain+i],0) ) - { - ae_assert(ae_fp_greater_eq(x->ptr.p_double[nmain+i],0), "CalculateStepBound: infeasible X", _state); - prevmax = *maxsteplen; - *maxsteplen = safeminposrv(x->ptr.p_double[nmain+i], -alpha*d->ptr.p_double[nmain+i], *maxsteplen, _state); - if( ae_fp_less(*maxsteplen,prevmax) ) - { - *variabletofreeze = nmain+i; - *valuetofreeze = 0; - } - } - } - if( ae_fp_eq(*maxsteplen,initval) ) - { - *valuetofreeze = 0; - *maxsteplen = 0; - } -} - - -/************************************************************************* -This function postprocesses bounded step by: -* analysing step length (whether it is equal to MaxStepLen) and activating - constraint given by VariableToFreeze if needed -* checking for additional bound constraints to activate - -This function uses final point of the step, quantities calculated by the -CalculateStepBound() function. As result, it returns point which is -exactly feasible with respect to boundary constraints. - -NOTE 1: this function does NOT handle and check linear equality constraints -NOTE 2: when StepTaken=MaxStepLen we always activate at least one constraint - -INPUT PARAMETERS - X - array[NMain+NSlack], final point to postprocess - XPrev - array[NMain+NSlack], initial point - BndL - lower bounds, array[NMain] - (may contain -INF, when bound is not present) - HaveBndL - array[NMain], if HaveBndL[i] is False, - then i-th bound is not present - BndU - array[NMain], upper bounds - (may contain +INF, when bound is not present) - HaveBndU - array[NMain], if HaveBndU[i] is False, - then i-th bound is not present - NMain - number of main variables - NSlack - number of slack variables - VariableToFreeze-result of CalculateStepBound() - ValueToFreeze- result of CalculateStepBound() - StepTaken - actual step length (actual step is equal to the possibly - non-unit step direction vector times this parameter). - StepTaken<=MaxStepLen. - MaxStepLen - result of CalculateStepBound() - -OUTPUT PARAMETERS - X - point bounded with respect to constraints. - components corresponding to active constraints are exactly - equal to the boundary values. - -RESULT: - number of constraints activated in addition to previously active ones. - Constraints which were DEACTIVATED are ignored (do not influence - function value). - - -- ALGLIB -- - Copyright 10.01.2012 by Bochkanov Sergey -*************************************************************************/ -ae_int_t postprocessboundedstep(/* Real */ ae_vector* x, - /* Real */ ae_vector* xprev, - /* Real */ ae_vector* bndl, - /* Boolean */ ae_vector* havebndl, - /* Real */ ae_vector* bndu, - /* Boolean */ ae_vector* havebndu, - ae_int_t nmain, - ae_int_t nslack, - ae_int_t variabletofreeze, - double valuetofreeze, - double steptaken, - double maxsteplen, - ae_state *_state) -{ - ae_int_t i; - ae_bool wasactivated; - ae_int_t result; - - - ae_assert(variabletofreeze<0||ae_fp_less_eq(steptaken,maxsteplen), "Assertion failed", _state); - - /* - * Activate constraints - */ - if( variabletofreeze>=0&&ae_fp_eq(steptaken,maxsteplen) ) - { - x->ptr.p_double[variabletofreeze] = valuetofreeze; - } - for(i=0; i<=nmain-1; i++) - { - if( havebndl->ptr.p_bool[i]&&ae_fp_less(x->ptr.p_double[i],bndl->ptr.p_double[i]) ) - { - x->ptr.p_double[i] = bndl->ptr.p_double[i]; - } - if( havebndu->ptr.p_bool[i]&&ae_fp_greater(x->ptr.p_double[i],bndu->ptr.p_double[i]) ) - { - x->ptr.p_double[i] = bndu->ptr.p_double[i]; - } - } - for(i=0; i<=nslack-1; i++) - { - if( ae_fp_less_eq(x->ptr.p_double[nmain+i],0) ) - { - x->ptr.p_double[nmain+i] = 0; - } - } - - /* - * Calculate number of constraints being activated - */ - result = 0; - for(i=0; i<=nmain-1; i++) - { - wasactivated = ae_fp_neq(x->ptr.p_double[i],xprev->ptr.p_double[i])&&((havebndl->ptr.p_bool[i]&&ae_fp_eq(x->ptr.p_double[i],bndl->ptr.p_double[i]))||(havebndu->ptr.p_bool[i]&&ae_fp_eq(x->ptr.p_double[i],bndu->ptr.p_double[i]))); - wasactivated = wasactivated||variabletofreeze==i; - if( wasactivated ) - { - result = result+1; - } - } - for(i=0; i<=nslack-1; i++) - { - wasactivated = ae_fp_neq(x->ptr.p_double[nmain+i],xprev->ptr.p_double[nmain+i])&&ae_fp_eq(x->ptr.p_double[nmain+i],0.0); - wasactivated = wasactivated||variabletofreeze==nmain+i; - if( wasactivated ) - { - result = result+1; - } - } - return result; -} - - -/************************************************************************* -The purpose of this function is to prevent algorithm from "unsticking" -from the active bound constraints because of numerical noise in the -gradient or Hessian. - -It is done by zeroing some components of the search direction D. D[i] is -zeroed when both (a) and (b) are true: -a) corresponding X[i] is exactly at the boundary -b) |D[i]*S[i]| <= DropTol*Sqrt(SUM(D[i]^2*S[I]^2)) - -D can be step direction , antigradient, gradient, or anything similar. -Sign of D does not matter, nor matters step length. - -NOTE 1: boundary constraints are expected to be consistent, as well as X - is expected to be feasible. Exception will be thrown otherwise. - -INPUT PARAMETERS - D - array[NMain+NSlack], direction - X - array[NMain+NSlack], current point - BndL - lower bounds, array[NMain] - (may contain -INF, when bound is not present) - HaveBndL - array[NMain], if HaveBndL[i] is False, - then i-th bound is not present - BndU - array[NMain], upper bounds - (may contain +INF, when bound is not present) - HaveBndU - array[NMain], if HaveBndU[i] is False, - then i-th bound is not present - S - array[NMain+NSlack], scaling of the variables - NMain - number of main variables - NSlack - number of slack variables - DropTol - drop tolerance, >=0 - -OUTPUT PARAMETERS - X - point bounded with respect to constraints. - components corresponding to active constraints are exactly - equal to the boundary values. - - -- ALGLIB -- - Copyright 10.01.2012 by Bochkanov Sergey -*************************************************************************/ -void filterdirection(/* Real */ ae_vector* d, - /* Real */ ae_vector* x, - /* Real */ ae_vector* bndl, - /* Boolean */ ae_vector* havebndl, - /* Real */ ae_vector* bndu, - /* Boolean */ ae_vector* havebndu, - /* Real */ ae_vector* s, - ae_int_t nmain, - ae_int_t nslack, - double droptol, - ae_state *_state) -{ - ae_int_t i; - double scalednorm; - ae_bool isactive; - - - scalednorm = 0.0; - for(i=0; i<=nmain+nslack-1; i++) - { - scalednorm = scalednorm+ae_sqr(d->ptr.p_double[i]*s->ptr.p_double[i], _state); - } - scalednorm = ae_sqrt(scalednorm, _state); - for(i=0; i<=nmain-1; i++) - { - ae_assert(!havebndl->ptr.p_bool[i]||ae_fp_greater_eq(x->ptr.p_double[i],bndl->ptr.p_double[i]), "FilterDirection: infeasible point", _state); - ae_assert(!havebndu->ptr.p_bool[i]||ae_fp_less_eq(x->ptr.p_double[i],bndu->ptr.p_double[i]), "FilterDirection: infeasible point", _state); - isactive = (havebndl->ptr.p_bool[i]&&ae_fp_eq(x->ptr.p_double[i],bndl->ptr.p_double[i]))||(havebndu->ptr.p_bool[i]&&ae_fp_eq(x->ptr.p_double[i],bndu->ptr.p_double[i])); - if( isactive&&ae_fp_less_eq(ae_fabs(d->ptr.p_double[i]*s->ptr.p_double[i], _state),droptol*scalednorm) ) - { - d->ptr.p_double[i] = 0.0; - } - } - for(i=0; i<=nslack-1; i++) - { - ae_assert(ae_fp_greater_eq(x->ptr.p_double[nmain+i],0), "FilterDirection: infeasible point", _state); - if( ae_fp_eq(x->ptr.p_double[nmain+i],0)&&ae_fp_less_eq(ae_fabs(d->ptr.p_double[nmain+i]*s->ptr.p_double[nmain+i], _state),droptol*scalednorm) ) - { - d->ptr.p_double[nmain+i] = 0.0; - } - } -} - - -/************************************************************************* -This function returns number of bound constraints whose state was changed -(either activated or deactivated) when making step from XPrev to X. - -Constraints are considered: -* active - when we are exactly at the boundary -* inactive - when we are not at the boundary - -You should note that antigradient direction is NOT taken into account when -we make decions on the constraint status. - -INPUT PARAMETERS - X - array[NMain+NSlack], final point. - Must be feasible with respect to bound constraints. - XPrev - array[NMain+NSlack], initial point. - Must be feasible with respect to bound constraints. - BndL - lower bounds, array[NMain] - (may contain -INF, when bound is not present) - HaveBndL - array[NMain], if HaveBndL[i] is False, - then i-th bound is not present - BndU - array[NMain], upper bounds - (may contain +INF, when bound is not present) - HaveBndU - array[NMain], if HaveBndU[i] is False, - then i-th bound is not present - NMain - number of main variables - NSlack - number of slack variables - -RESULT: - number of constraints whose state was changed. - - -- ALGLIB -- - Copyright 10.01.2012 by Bochkanov Sergey -*************************************************************************/ -ae_int_t numberofchangedconstraints(/* Real */ ae_vector* x, - /* Real */ ae_vector* xprev, - /* Real */ ae_vector* bndl, - /* Boolean */ ae_vector* havebndl, - /* Real */ ae_vector* bndu, - /* Boolean */ ae_vector* havebndu, - ae_int_t nmain, - ae_int_t nslack, - ae_state *_state) -{ - ae_int_t i; - ae_bool statuschanged; - ae_int_t result; - - - result = 0; - for(i=0; i<=nmain-1; i++) - { - if( ae_fp_neq(x->ptr.p_double[i],xprev->ptr.p_double[i]) ) - { - statuschanged = ae_false; - if( havebndl->ptr.p_bool[i]&&(ae_fp_eq(x->ptr.p_double[i],bndl->ptr.p_double[i])||ae_fp_eq(xprev->ptr.p_double[i],bndl->ptr.p_double[i])) ) - { - statuschanged = ae_true; - } - if( havebndu->ptr.p_bool[i]&&(ae_fp_eq(x->ptr.p_double[i],bndu->ptr.p_double[i])||ae_fp_eq(xprev->ptr.p_double[i],bndu->ptr.p_double[i])) ) - { - statuschanged = ae_true; - } - if( statuschanged ) - { - result = result+1; - } - } - } - for(i=0; i<=nslack-1; i++) - { - if( ae_fp_neq(x->ptr.p_double[nmain+i],xprev->ptr.p_double[nmain+i])&&(ae_fp_eq(x->ptr.p_double[nmain+i],0)||ae_fp_eq(xprev->ptr.p_double[nmain+i],0)) ) - { - result = result+1; - } - } - return result; -} - - -/************************************************************************* -This function finds feasible point of (NMain+NSlack)-dimensional problem -subject to NMain explicit boundary constraints (some constraints can be -omitted), NSlack implicit non-negativity constraints, K linear equality -constraints. - -INPUT PARAMETERS - X - array[NMain+NSlack], initial point. - BndL - lower bounds, array[NMain] - (may contain -INF, when bound is not present) - HaveBndL - array[NMain], if HaveBndL[i] is False, - then i-th bound is not present - BndU - array[NMain], upper bounds - (may contain +INF, when bound is not present) - HaveBndU - array[NMain], if HaveBndU[i] is False, - then i-th bound is not present - NMain - number of main variables - NSlack - number of slack variables - CE - array[K,NMain+NSlack+1], equality constraints CE*x=b. - Rows contain constraints, first NMain+NSlack columns - contain coefficients before X[], last column contain - right part. - K - number of linear constraints - EpsI - infeasibility (error in the right part) allowed in the - solution - -OUTPUT PARAMETERS: - X - feasible point or best infeasible point found before - algorithm termination - QPIts - number of QP iterations (for debug purposes) - GPAIts - number of GPA iterations (for debug purposes) - -RESULT: - True in case X is feasible, False - if it is infeasible. - - -- ALGLIB -- - Copyright 20.01.2012 by Bochkanov Sergey -*************************************************************************/ -ae_bool findfeasiblepoint(/* Real */ ae_vector* x, - /* Real */ ae_vector* bndl, - /* Boolean */ ae_vector* havebndl, - /* Real */ ae_vector* bndu, - /* Boolean */ ae_vector* havebndu, - ae_int_t nmain, - ae_int_t nslack, - /* Real */ ae_matrix* ce, - ae_int_t k, - double epsi, - ae_int_t* qpits, - ae_int_t* gpaits, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix _ce; - ae_int_t i; - ae_int_t j; - ae_int_t idx0; - ae_int_t idx1; - ae_vector permx; - ae_vector xn; - ae_vector xa; - ae_vector newtonstep; - ae_vector g; - ae_vector pg; - ae_matrix a; - double armijostep; - double armijobeststep; - double armijobestfeas; - double v; - double mx; - double feaserr; - double feasold; - double feasnew; - double pgnorm; - double vn; - double vd; - double stp; - ae_int_t vartofreeze; - double valtofreeze; - double maxsteplen; - ae_bool werechangesinconstraints; - ae_bool stage1isover; - ae_bool converged; - ae_vector activeconstraints; - ae_vector tmpk; - ae_vector colnorms; - ae_int_t nactive; - ae_int_t nfree; - ae_int_t nsvd; - ae_vector p1; - ae_vector p2; - apbuffers buf; - ae_vector w; - ae_vector s; - ae_matrix u; - ae_matrix vt; - ae_int_t itscount; - ae_int_t itswithintolerance; - ae_int_t maxitswithintolerance; - ae_int_t gparuns; - ae_int_t maxarmijoruns; - ae_bool result; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init_copy(&_ce, ce, _state, ae_true); - ce = &_ce; - *qpits = 0; - *gpaits = 0; - ae_vector_init(&permx, 0, DT_REAL, _state, ae_true); - ae_vector_init(&xn, 0, DT_REAL, _state, ae_true); - ae_vector_init(&xa, 0, DT_REAL, _state, ae_true); - ae_vector_init(&newtonstep, 0, DT_REAL, _state, ae_true); - ae_vector_init(&g, 0, DT_REAL, _state, ae_true); - ae_vector_init(&pg, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&a, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&activeconstraints, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tmpk, 0, DT_REAL, _state, ae_true); - ae_vector_init(&colnorms, 0, DT_REAL, _state, ae_true); - ae_vector_init(&p1, 0, DT_INT, _state, ae_true); - ae_vector_init(&p2, 0, DT_INT, _state, ae_true); - _apbuffers_init(&buf, _state, ae_true); - ae_vector_init(&w, 0, DT_REAL, _state, ae_true); - ae_vector_init(&s, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&u, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&vt, 0, 0, DT_REAL, _state, ae_true); - - maxitswithintolerance = 3; - maxarmijoruns = 5; - *qpits = 0; - *gpaits = 0; - - /* - * Initial enforcement of the feasibility with respect to boundary constraints - * NOTE: after this block we assume that boundary constraints are consistent. - */ - if( !enforceboundaryconstraints(x, bndl, havebndl, bndu, havebndu, nmain, nslack, _state) ) - { - result = ae_false; - ae_frame_leave(_state); - return result; - } - if( k==0 ) - { - - /* - * No linear constraints, we can exit right now - */ - result = ae_true; - ae_frame_leave(_state); - return result; - } - - /* - * Scale rows of CE in such way that max(CE[i,0..nmain+nslack-1])=1 for any i=0..k-1 - */ - for(i=0; i<=k-1; i++) - { - v = 0.0; - for(j=0; j<=nmain+nslack-1; j++) - { - v = ae_maxreal(v, ae_fabs(ce->ptr.pp_double[i][j], _state), _state); - } - if( ae_fp_neq(v,0) ) - { - v = 1/v; - ae_v_muld(&ce->ptr.pp_double[i][0], 1, ae_v_len(0,nmain+nslack), v); - } - } - - /* - * Allocate temporaries - */ - ae_vector_set_length(&xn, nmain+nslack, _state); - ae_vector_set_length(&xa, nmain+nslack, _state); - ae_vector_set_length(&permx, nmain+nslack, _state); - ae_vector_set_length(&g, nmain+nslack, _state); - ae_vector_set_length(&pg, nmain+nslack, _state); - ae_vector_set_length(&tmpk, k, _state); - ae_matrix_set_length(&a, k, nmain+nslack, _state); - ae_vector_set_length(&activeconstraints, nmain+nslack, _state); - ae_vector_set_length(&newtonstep, nmain+nslack, _state); - ae_vector_set_length(&s, nmain+nslack, _state); - ae_vector_set_length(&colnorms, nmain+nslack, _state); - for(i=0; i<=nmain+nslack-1; i++) - { - s.ptr.p_double[i] = 1.0; - colnorms.ptr.p_double[i] = 0.0; - for(j=0; j<=k-1; j++) - { - colnorms.ptr.p_double[i] = colnorms.ptr.p_double[i]+ae_sqr(ce->ptr.pp_double[j][i], _state); - } - } - - /* - * K>0, we have linear equality constraints combined with bound constraints. - * - * Try to find feasible point as minimizer of the quadratic function - * F(x) = 0.5*||CE*x-b||^2 = 0.5*x'*(CE'*CE)*x - (b'*CE)*x + 0.5*b'*b - * subject to boundary constraints given by BL, BU and non-negativity of - * the slack variables. BTW, we drop constant term because it does not - * actually influences on the solution. - * - * Below we will assume that K>0. - */ - itswithintolerance = 0; - itscount = 0; - for(;;) - { - - /* - * Stage 0: check for exact convergence - */ - converged = ae_true; - feaserr = 0; - for(i=0; i<=k-1; i++) - { - - /* - * Calculate: - * * V - error in the right part - * * MX - maximum term in the left part - * - * Terminate if error in the right part is not greater than 100*Eps*MX. - * - * IMPORTANT: we must perform check for non-strict inequality, i.e. to use <= instead of <. - * it will allow us to easily handle situations with zero rows of CE. - */ - mx = 0; - v = -ce->ptr.pp_double[i][nmain+nslack]; - for(j=0; j<=nmain+nslack-1; j++) - { - mx = ae_maxreal(mx, ae_fabs(ce->ptr.pp_double[i][j]*x->ptr.p_double[j], _state), _state); - v = v+ce->ptr.pp_double[i][j]*x->ptr.p_double[j]; - } - feaserr = feaserr+ae_sqr(v, _state); - converged = converged&&ae_fp_less_eq(ae_fabs(v, _state),100*ae_machineepsilon*mx); - } - feaserr = ae_sqrt(feaserr, _state); - if( converged ) - { - result = ae_fp_less_eq(feaserr,epsi); - ae_frame_leave(_state); - return result; - } - - /* - * Stage 1: equality constrained quadratic programming - * - * * treat active bound constraints as equality ones (constraint is considered - * active when we are at the boundary, independently of the antigradient direction) - * * calculate unrestricted Newton step to point XM (which may be infeasible) - * calculate MaxStepLen = largest step in direction of XM which retains feasibility. - * * perform bounded step from X to XN: - * a) XN=XM (if XM is feasible) - * b) XN=X-MaxStepLen*(XM-X) (otherwise) - * * X := XN - * * if XM (Newton step subject to currently active constraints) was feasible, goto Stage 2 - * * repeat Stage 1 - * - * NOTE 1: in order to solve constrained qudratic subproblem we will have to reorder - * variables in such way that ones corresponding to inactive constraints will - * be first, and active ones will be last in the list. CE and X are now - * [ xi ] - * separated into two parts: CE = [CEi CEa], x = [ ], where CEi/Xi correspond - * [ xa ] - * to INACTIVE constraints, and CEa/Xa correspond to the ACTIVE ones. - * - * Now, instead of F=0.5*x'*(CE'*CE)*x - (b'*CE)*x + 0.5*b'*b, we have - * F(xi) = 0.5*(CEi*xi,CEi*xi) + (CEa*xa-b,CEi*xi) + (0.5*CEa*xa-b,CEa*xa). - * Here xa is considered constant, i.e. we optimize with respect to xi, leaving xa fixed. - * - * We can solve it by performing SVD of CEi and calculating pseudoinverse of the - * Hessian matrix. Of course, we do NOT calculate pseudoinverse explicitly - we - * just use singular vectors to perform implicit multiplication by it. - * - */ - for(;;) - { - - /* - * Calculate G - gradient subject to equality constraints, - * multiply it by inverse of the Hessian diagonal to obtain initial - * step vector. - * - * Bound step subject to constraints which can be activated, - * run Armijo search with increasing step size. - * Search is terminated when feasibility error stops to decrease. - * - * NOTE: it is important to test for "stops to decrease" instead - * of "starts to increase" in order to correctly handle cases with - * zero CE. - */ - armijobeststep = 0.0; - armijobestfeas = 0.0; - for(i=0; i<=nmain+nslack-1; i++) - { - g.ptr.p_double[i] = 0; - } - for(i=0; i<=k-1; i++) - { - v = ae_v_dotproduct(&ce->ptr.pp_double[i][0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); - v = v-ce->ptr.pp_double[i][nmain+nslack]; - armijobestfeas = armijobestfeas+ae_sqr(v, _state); - ae_v_addd(&g.ptr.p_double[0], 1, &ce->ptr.pp_double[i][0], 1, ae_v_len(0,nmain+nslack-1), v); - } - armijobestfeas = ae_sqrt(armijobestfeas, _state); - for(i=0; i<=nmain-1; i++) - { - if( havebndl->ptr.p_bool[i]&&ae_fp_eq(x->ptr.p_double[i],bndl->ptr.p_double[i]) ) - { - g.ptr.p_double[i] = 0.0; - } - if( havebndu->ptr.p_bool[i]&&ae_fp_eq(x->ptr.p_double[i],bndu->ptr.p_double[i]) ) - { - g.ptr.p_double[i] = 0.0; - } - } - for(i=0; i<=nslack-1; i++) - { - if( ae_fp_eq(x->ptr.p_double[nmain+i],0.0) ) - { - g.ptr.p_double[nmain+i] = 0.0; - } - } - v = 0.0; - for(i=0; i<=nmain+nslack-1; i++) - { - if( ae_fp_neq(ae_sqr(colnorms.ptr.p_double[i], _state),0) ) - { - newtonstep.ptr.p_double[i] = -g.ptr.p_double[i]/ae_sqr(colnorms.ptr.p_double[i], _state); - } - else - { - newtonstep.ptr.p_double[i] = 0.0; - } - v = v+ae_sqr(newtonstep.ptr.p_double[i], _state); - } - if( ae_fp_eq(v,0) ) - { - - /* - * Constrained gradient is zero, QP iterations are over - */ - break; - } - calculatestepbound(x, &newtonstep, 1.0, bndl, havebndl, bndu, havebndu, nmain, nslack, &vartofreeze, &valtofreeze, &maxsteplen, _state); - if( vartofreeze>=0&&ae_fp_eq(maxsteplen,0) ) - { - - /* - * Can not perform step, QP iterations are over - */ - break; - } - if( vartofreeze>=0 ) - { - armijostep = ae_minreal(1.0, maxsteplen, _state); - } - else - { - armijostep = 1; - } - for(;;) - { - ae_v_move(&xa.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); - ae_v_addd(&xa.ptr.p_double[0], 1, &newtonstep.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1), armijostep); - enforceboundaryconstraints(&xa, bndl, havebndl, bndu, havebndu, nmain, nslack, _state); - feaserr = 0.0; - for(i=0; i<=k-1; i++) - { - v = ae_v_dotproduct(&ce->ptr.pp_double[i][0], 1, &xa.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); - v = v-ce->ptr.pp_double[i][nmain+nslack]; - feaserr = feaserr+ae_sqr(v, _state); - } - feaserr = ae_sqrt(feaserr, _state); - if( ae_fp_greater_eq(feaserr,armijobestfeas) ) - { - break; - } - armijobestfeas = feaserr; - armijobeststep = armijostep; - armijostep = 2.0*armijostep; - } - ae_v_addd(&x->ptr.p_double[0], 1, &newtonstep.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1), armijobeststep); - enforceboundaryconstraints(x, bndl, havebndl, bndu, havebndu, nmain, nslack, _state); - - /* - * Determine number of active and free constraints - */ - nactive = 0; - for(i=0; i<=nmain-1; i++) - { - activeconstraints.ptr.p_double[i] = 0; - if( havebndl->ptr.p_bool[i]&&ae_fp_eq(x->ptr.p_double[i],bndl->ptr.p_double[i]) ) - { - activeconstraints.ptr.p_double[i] = 1; - } - if( havebndu->ptr.p_bool[i]&&ae_fp_eq(x->ptr.p_double[i],bndu->ptr.p_double[i]) ) - { - activeconstraints.ptr.p_double[i] = 1; - } - if( ae_fp_greater(activeconstraints.ptr.p_double[i],0) ) - { - nactive = nactive+1; - } - } - for(i=0; i<=nslack-1; i++) - { - activeconstraints.ptr.p_double[nmain+i] = 0; - if( ae_fp_eq(x->ptr.p_double[nmain+i],0.0) ) - { - activeconstraints.ptr.p_double[nmain+i] = 1; - } - if( ae_fp_greater(activeconstraints.ptr.p_double[nmain+i],0) ) - { - nactive = nactive+1; - } - } - nfree = nmain+nslack-nactive; - if( nfree==0 ) - { - break; - } - *qpits = *qpits+1; - - /* - * Reorder variables - */ - tagsortbuf(&activeconstraints, nmain+nslack, &p1, &p2, &buf, _state); - for(i=0; i<=k-1; i++) - { - for(j=0; j<=nmain+nslack-1; j++) - { - a.ptr.pp_double[i][j] = ce->ptr.pp_double[i][j]; - } - } - for(j=0; j<=nmain+nslack-1; j++) - { - permx.ptr.p_double[j] = x->ptr.p_double[j]; - } - for(j=0; j<=nmain+nslack-1; j++) - { - if( p2.ptr.p_int[j]!=j ) - { - idx0 = p2.ptr.p_int[j]; - idx1 = j; - for(i=0; i<=k-1; i++) - { - v = a.ptr.pp_double[i][idx0]; - a.ptr.pp_double[i][idx0] = a.ptr.pp_double[i][idx1]; - a.ptr.pp_double[i][idx1] = v; - } - v = permx.ptr.p_double[idx0]; - permx.ptr.p_double[idx0] = permx.ptr.p_double[idx1]; - permx.ptr.p_double[idx1] = v; - } - } - - /* - * Calculate (unprojected) gradient: - * G(xi) = CEi'*(CEi*xi + CEa*xa - b) - */ - for(i=0; i<=nfree-1; i++) - { - g.ptr.p_double[i] = 0; - } - for(i=0; i<=k-1; i++) - { - v = ae_v_dotproduct(&a.ptr.pp_double[i][0], 1, &permx.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); - tmpk.ptr.p_double[i] = v-ce->ptr.pp_double[i][nmain+nslack]; - } - for(i=0; i<=k-1; i++) - { - v = tmpk.ptr.p_double[i]; - ae_v_addd(&g.ptr.p_double[0], 1, &a.ptr.pp_double[i][0], 1, ae_v_len(0,nfree-1), v); - } - - /* - * Calculate Newton step using SVD of CEi: - * F(xi) = 0.5*xi'*H*xi + g'*xi (Taylor decomposition) - * XN = -H^(-1)*g (new point, solution of the QP subproblem) - * H = CEi'*CEi - * CEi = U*W*V' (SVD of CEi) - * H = V*W^2*V' - * H^(-1) = V*W^(-2)*V' - * step = -V*W^(-2)*V'*g (it is better to perform multiplication from right to left) - * - * NOTE 1: we do NOT need left singular vectors to perform Newton step. - */ - nsvd = ae_minint(k, nfree, _state); - if( !rmatrixsvd(&a, k, nfree, 0, 1, 2, &w, &u, &vt, _state) ) - { - result = ae_false; - ae_frame_leave(_state); - return result; - } - for(i=0; i<=nsvd-1; i++) - { - v = ae_v_dotproduct(&vt.ptr.pp_double[i][0], 1, &g.ptr.p_double[0], 1, ae_v_len(0,nfree-1)); - tmpk.ptr.p_double[i] = v; - } - for(i=0; i<=nsvd-1; i++) - { - - /* - * It is important to have strict ">" in order to correctly - * handle zero singular values. - */ - if( ae_fp_greater(ae_sqr(w.ptr.p_double[i], _state),ae_sqr(w.ptr.p_double[0], _state)*(nmain+nslack)*ae_machineepsilon) ) - { - tmpk.ptr.p_double[i] = tmpk.ptr.p_double[i]/ae_sqr(w.ptr.p_double[i], _state); - } - else - { - tmpk.ptr.p_double[i] = 0; - } - } - for(i=0; i<=nmain+nslack-1; i++) - { - newtonstep.ptr.p_double[i] = 0; - } - for(i=0; i<=nsvd-1; i++) - { - v = tmpk.ptr.p_double[i]; - ae_v_subd(&newtonstep.ptr.p_double[0], 1, &vt.ptr.pp_double[i][0], 1, ae_v_len(0,nfree-1), v); - } - for(j=nmain+nslack-1; j>=0; j--) - { - if( p2.ptr.p_int[j]!=j ) - { - idx0 = p2.ptr.p_int[j]; - idx1 = j; - v = newtonstep.ptr.p_double[idx0]; - newtonstep.ptr.p_double[idx0] = newtonstep.ptr.p_double[idx1]; - newtonstep.ptr.p_double[idx1] = v; - } - } - - /* - * NewtonStep contains Newton step subject to active bound constraints. - * - * Such step leads us to the minimizer of the equality constrained F, - * but such minimizer may be infeasible because some constraints which - * are inactive at the initial point can be violated at the solution. - * - * Thus, we perform optimization in two stages: - * a) perform bounded Newton step, i.e. step in the Newton direction - * until activation of the first constraint - * b) in case (MaxStepLen>0)and(MaxStepLen<1), perform additional iteration - * of the Armijo line search in the rest of the Newton direction. - */ - calculatestepbound(x, &newtonstep, 1.0, bndl, havebndl, bndu, havebndu, nmain, nslack, &vartofreeze, &valtofreeze, &maxsteplen, _state); - if( vartofreeze>=0&&ae_fp_eq(maxsteplen,0) ) - { - - /* - * Activation of the constraints prevent us from performing step, - * QP iterations are over - */ - break; - } - if( vartofreeze>=0 ) - { - v = ae_minreal(1.0, maxsteplen, _state); - } - else - { - v = 1.0; - } - ae_v_moved(&xn.ptr.p_double[0], 1, &newtonstep.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1), v); - ae_v_add(&xn.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); - postprocessboundedstep(&xn, x, bndl, havebndl, bndu, havebndu, nmain, nslack, vartofreeze, valtofreeze, v, maxsteplen, _state); - if( ae_fp_greater(maxsteplen,0)&&ae_fp_less(maxsteplen,1) ) - { - - /* - * Newton step was restricted by activation of the constraints, - * perform Armijo iteration. - * - * Initial estimate for best step is zero step. We try different - * step sizes, from the 1-MaxStepLen (residual of the full Newton - * step) to progressively smaller and smaller steps. - */ - armijobeststep = 0.0; - armijobestfeas = 0.0; - for(i=0; i<=k-1; i++) - { - v = ae_v_dotproduct(&ce->ptr.pp_double[i][0], 1, &xn.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); - v = v-ce->ptr.pp_double[i][nmain+nslack]; - armijobestfeas = armijobestfeas+ae_sqr(v, _state); - } - armijobestfeas = ae_sqrt(armijobestfeas, _state); - armijostep = 1-maxsteplen; - for(j=0; j<=maxarmijoruns-1; j++) - { - ae_v_move(&xa.ptr.p_double[0], 1, &xn.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); - ae_v_addd(&xa.ptr.p_double[0], 1, &newtonstep.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1), armijostep); - enforceboundaryconstraints(&xa, bndl, havebndl, bndu, havebndu, nmain, nslack, _state); - feaserr = 0.0; - for(i=0; i<=k-1; i++) - { - v = ae_v_dotproduct(&ce->ptr.pp_double[i][0], 1, &xa.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); - v = v-ce->ptr.pp_double[i][nmain+nslack]; - feaserr = feaserr+ae_sqr(v, _state); - } - feaserr = ae_sqrt(feaserr, _state); - if( ae_fp_less(feaserr,armijobestfeas) ) - { - armijobestfeas = feaserr; - armijobeststep = armijostep; - } - armijostep = 0.5*armijostep; - } - ae_v_move(&xa.ptr.p_double[0], 1, &xn.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); - ae_v_addd(&xa.ptr.p_double[0], 1, &newtonstep.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1), armijobeststep); - enforceboundaryconstraints(&xa, bndl, havebndl, bndu, havebndu, nmain, nslack, _state); - } - else - { - - /* - * Armijo iteration is not performed - */ - ae_v_move(&xa.ptr.p_double[0], 1, &xn.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); - } - stage1isover = ae_fp_greater_eq(maxsteplen,1)||ae_fp_eq(maxsteplen,0); - - /* - * Calculate feasibility errors for old and new X. - * These quantinies are used for debugging purposes only. - * However, we can leave them in release code because performance impact is insignificant. - * - * Update X. Exit if needed. - */ - feasold = 0; - feasnew = 0; - for(i=0; i<=k-1; i++) - { - v = ae_v_dotproduct(&ce->ptr.pp_double[i][0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); - feasold = feasold+ae_sqr(v-ce->ptr.pp_double[i][nmain+nslack], _state); - v = ae_v_dotproduct(&ce->ptr.pp_double[i][0], 1, &xa.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); - feasnew = feasnew+ae_sqr(v-ce->ptr.pp_double[i][nmain+nslack], _state); - } - feasold = ae_sqrt(feasold, _state); - feasnew = ae_sqrt(feasnew, _state); - if( ae_fp_greater_eq(feasnew,feasold) ) - { - break; - } - ae_v_move(&x->ptr.p_double[0], 1, &xa.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); - if( stage1isover ) - { - break; - } - } - - /* - * Stage 2: gradient projection algorithm (GPA) - * - * * calculate feasibility error (with respect to linear equality constraints) - * * calculate gradient G of F, project it into feasible area (G => PG) - * * exit if norm(PG) is exactly zero or feasibility error is smaller than EpsC - * * let XM be exact minimum of F along -PG (XM may be infeasible). - * calculate MaxStepLen = largest step in direction of -PG which retains feasibility. - * * perform bounded step from X to XN: - * a) XN=XM (if XM is feasible) - * b) XN=X-MaxStepLen*PG (otherwise) - * * X := XN - * * stop after specified number of iterations or when no new constraints was activated - * - * NOTES: - * * grad(F) = (CE'*CE)*x - (b'*CE)^T - * * CE[i] denotes I-th row of CE - * * XM = X+stp*(-PG) where stp=(grad(F(X)),PG)/(CE*PG,CE*PG). - * Here PG is a projected gradient, but in fact it can be arbitrary non-zero - * direction vector - formula for minimum of F along PG still will be correct. - */ - werechangesinconstraints = ae_false; - for(gparuns=1; gparuns<=k; gparuns++) - { - - /* - * calculate feasibility error and G - */ - feaserr = 0; - for(i=0; i<=nmain+nslack-1; i++) - { - g.ptr.p_double[i] = 0; - } - for(i=0; i<=k-1; i++) - { - - /* - * G += CE[i]^T * (CE[i]*x-b[i]) - */ - v = ae_v_dotproduct(&ce->ptr.pp_double[i][0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); - v = v-ce->ptr.pp_double[i][nmain+nslack]; - feaserr = feaserr+ae_sqr(v, _state); - ae_v_addd(&g.ptr.p_double[0], 1, &ce->ptr.pp_double[i][0], 1, ae_v_len(0,nmain+nslack-1), v); - } - - /* - * project G, filter it (strip numerical noise) - */ - ae_v_move(&pg.ptr.p_double[0], 1, &g.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); - projectgradientintobc(x, &pg, bndl, havebndl, bndu, havebndu, nmain, nslack, _state); - filterdirection(&pg, x, bndl, havebndl, bndu, havebndu, &s, nmain, nslack, 1.0E-9, _state); - for(i=0; i<=nmain+nslack-1; i++) - { - if( ae_fp_neq(ae_sqr(colnorms.ptr.p_double[i], _state),0) ) - { - pg.ptr.p_double[i] = pg.ptr.p_double[i]/ae_sqr(colnorms.ptr.p_double[i], _state); - } - else - { - pg.ptr.p_double[i] = 0.0; - } - } - - /* - * Check GNorm and feasibility. - * Exit when GNorm is exactly zero. - */ - pgnorm = ae_v_dotproduct(&pg.ptr.p_double[0], 1, &pg.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); - feaserr = ae_sqrt(feaserr, _state); - pgnorm = ae_sqrt(pgnorm, _state); - if( ae_fp_eq(pgnorm,0) ) - { - result = ae_fp_less_eq(feaserr,epsi); - ae_frame_leave(_state); - return result; - } - - /* - * calculate planned step length - */ - vn = ae_v_dotproduct(&g.ptr.p_double[0], 1, &pg.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); - vd = 0; - for(i=0; i<=k-1; i++) - { - v = ae_v_dotproduct(&ce->ptr.pp_double[i][0], 1, &pg.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); - vd = vd+ae_sqr(v, _state); - } - stp = vn/vd; - - /* - * Calculate step bound. - * Perform bounded step and post-process it - */ - calculatestepbound(x, &pg, -1.0, bndl, havebndl, bndu, havebndu, nmain, nslack, &vartofreeze, &valtofreeze, &maxsteplen, _state); - if( vartofreeze>=0&&ae_fp_eq(maxsteplen,0) ) - { - result = ae_false; - ae_frame_leave(_state); - return result; - } - if( vartofreeze>=0 ) - { - v = ae_minreal(stp, maxsteplen, _state); - } - else - { - v = stp; - } - ae_v_move(&xn.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); - ae_v_subd(&xn.ptr.p_double[0], 1, &pg.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1), v); - postprocessboundedstep(&xn, x, bndl, havebndl, bndu, havebndu, nmain, nslack, vartofreeze, valtofreeze, v, maxsteplen, _state); - - /* - * update X - * check stopping criteria - */ - werechangesinconstraints = werechangesinconstraints||numberofchangedconstraints(&xn, x, bndl, havebndl, bndu, havebndu, nmain, nslack, _state)>0; - ae_v_move(&x->ptr.p_double[0], 1, &xn.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); - *gpaits = *gpaits+1; - if( !werechangesinconstraints ) - { - break; - } - } - - /* - * Stage 3: decide to stop algorithm or not to stop - * - * 1. we can stop when last GPA run did NOT changed constraints status. - * It means that we've found final set of the active constraints even - * before GPA made its run. And it means that Newton step moved us to - * the minimum subject to the present constraints. - * Depending on feasibility error, True or False is returned. - */ - feaserr = 0; - for(i=0; i<=k-1; i++) - { - v = ae_v_dotproduct(&ce->ptr.pp_double[i][0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); - v = v-ce->ptr.pp_double[i][nmain+nslack]; - feaserr = feaserr+ae_sqr(v, _state); - } - feaserr = ae_sqrt(feaserr, _state); - if( ae_fp_less_eq(feaserr,epsi) ) - { - itswithintolerance = itswithintolerance+1; - } - else - { - itswithintolerance = 0; - } - if( !werechangesinconstraints||itswithintolerance>=maxitswithintolerance ) - { - result = ae_fp_less_eq(feaserr,epsi); - ae_frame_leave(_state); - return result; - } - itscount = itscount+1; - } - ae_frame_leave(_state); - return result; -} - - -/************************************************************************* - This function check, that input derivatives are right. First it scale -parameters DF0 and DF1 from segment [A;B] to [0;1]. Than it build Hermite -spline and derivative of it in 0,5. Search scale as Max(DF0,DF1, |F0-F1|). -Right derivative has to satisfy condition: - |H-F|/S<=0,01, |H'-F'|/S<=0,01. - -INPUT PARAMETERS: - F0 - function's value in X-TestStep point; - DF0 - derivative's value in X-TestStep point; - F1 - function's value in X+TestStep point; - DF1 - derivative's value in X+TestStep point; - F - testing function's value; - DF - testing derivative's value; - Width- width of verification segment. - -RESULT: - If input derivatives is right then function returns true, else - function returns false. - - -- ALGLIB -- - Copyright 29.05.2012 by Bochkanov Sergey -*************************************************************************/ -ae_bool derivativecheck(double f0, - double df0, - double f1, - double df1, - double f, - double df, - double width, - ae_state *_state) -{ - double s; - double h; - double dh; - ae_bool result; - - - df = width*df; - df0 = width*df0; - df1 = width*df1; - s = ae_maxreal(ae_maxreal(ae_fabs(df0, _state), ae_fabs(df1, _state), _state), ae_fabs(f1-f0, _state), _state); - h = 0.5*f0+0.125*df0+0.5*f1-0.125*df1; - dh = -1.5*f0-0.25*df0+1.5*f1-0.25*df1; - if( ae_fp_neq(s,0) ) - { - if( ae_fp_greater(ae_fabs(h-f, _state)/s,0.001)||ae_fp_greater(ae_fabs(dh-df, _state)/s,0.001) ) - { - result = ae_false; - return result; - } - } - else - { - if( ae_fp_neq(h-f,0.0)||ae_fp_neq(dh-df,0.0) ) - { - result = ae_false; - return result; - } - } - result = ae_true; - return result; -} - - - - -/************************************************************************* -This subroutine is used to initialize CQM. By default, empty NxN model is -generated, with Alpha=Lambda=Theta=0.0 and zero b. - -Previously allocated buffer variables are reused as much as possible. - - -- ALGLIB -- - Copyright 12.06.2012 by Bochkanov Sergey -*************************************************************************/ -void cqminit(ae_int_t n, convexquadraticmodel* s, ae_state *_state) -{ - ae_int_t i; - - - s->n = n; - s->k = 0; - s->nfree = n; - s->ecakind = -1; - s->alpha = 0.0; - s->tau = 0.0; - s->theta = 0.0; - s->ismaintermchanged = ae_true; - s->issecondarytermchanged = ae_true; - s->islineartermchanged = ae_true; - s->isactivesetchanged = ae_true; - bvectorsetlengthatleast(&s->activeset, n, _state); - rvectorsetlengthatleast(&s->xc, n, _state); - rvectorsetlengthatleast(&s->eb, n, _state); - rvectorsetlengthatleast(&s->tq1, n, _state); - rvectorsetlengthatleast(&s->txc, n, _state); - rvectorsetlengthatleast(&s->tb, n, _state); - rvectorsetlengthatleast(&s->b, s->n, _state); - rvectorsetlengthatleast(&s->tk1, s->n, _state); - for(i=0; i<=n-1; i++) - { - s->activeset.ptr.p_bool[i] = ae_false; - s->xc.ptr.p_double[i] = 0.0; - s->b.ptr.p_double[i] = 0.0; - } -} - - -/************************************************************************* -This subroutine changes main quadratic term of the model. - -INPUT PARAMETERS: - S - model - A - NxN matrix, only upper or lower triangle is referenced - IsUpper - True, when matrix is stored in upper triangle - Alpha - multiplier; when Alpha=0, A is not referenced at all - - -- ALGLIB -- - Copyright 12.06.2012 by Bochkanov Sergey -*************************************************************************/ -void cqmseta(convexquadraticmodel* s, - /* Real */ ae_matrix* a, - ae_bool isupper, - double alpha, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - double v; - - - ae_assert(ae_isfinite(alpha, _state)&&ae_fp_greater_eq(alpha,0), "CQMSetA: Alpha<0 or is not finite number", _state); - ae_assert(ae_fp_eq(alpha,0)||isfinitertrmatrix(a, s->n, isupper, _state), "CQMSetA: A is not finite NxN matrix", _state); - s->alpha = alpha; - if( ae_fp_greater(alpha,0) ) - { - rmatrixsetlengthatleast(&s->a, s->n, s->n, _state); - rmatrixsetlengthatleast(&s->ecadense, s->n, s->n, _state); - rmatrixsetlengthatleast(&s->tq2dense, s->n, s->n, _state); - for(i=0; i<=s->n-1; i++) - { - for(j=i; j<=s->n-1; j++) - { - if( isupper ) - { - v = a->ptr.pp_double[i][j]; - } - else - { - v = a->ptr.pp_double[j][i]; - } - s->a.ptr.pp_double[i][j] = v; - s->a.ptr.pp_double[j][i] = v; - } - } - } - s->ismaintermchanged = ae_true; -} - - -/************************************************************************* -This subroutine rewrites diagonal of the main quadratic term of the model -(dense A) by vector Z/Alpha (current value of the Alpha coefficient is -used). - -IMPORTANT: in case model has no dense quadratic term, this function - allocates N*N dense matrix of zeros, and fills its diagonal by - non-zero values. - -INPUT PARAMETERS: - S - model - Z - new diagonal, array[N] - - -- ALGLIB -- - Copyright 12.06.2012 by Bochkanov Sergey -*************************************************************************/ -void cqmrewritedensediagonal(convexquadraticmodel* s, - /* Real */ ae_vector* z, - ae_state *_state) -{ - ae_int_t n; - ae_int_t i; - ae_int_t j; - - - n = s->n; - if( ae_fp_eq(s->alpha,0) ) - { - rmatrixsetlengthatleast(&s->a, s->n, s->n, _state); - rmatrixsetlengthatleast(&s->ecadense, s->n, s->n, _state); - rmatrixsetlengthatleast(&s->tq2dense, s->n, s->n, _state); - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - s->a.ptr.pp_double[i][j] = 0.0; - } - } - s->alpha = 1.0; - } - for(i=0; i<=s->n-1; i++) - { - s->a.ptr.pp_double[i][i] = z->ptr.p_double[i]/s->alpha; - } - s->ismaintermchanged = ae_true; -} - - -/************************************************************************* -This subroutine changes diagonal quadratic term of the model. - -INPUT PARAMETERS: - S - model - D - array[N], semidefinite diagonal matrix - Tau - multiplier; when Tau=0, D is not referenced at all - - -- ALGLIB -- - Copyright 12.06.2012 by Bochkanov Sergey -*************************************************************************/ -void cqmsetd(convexquadraticmodel* s, - /* Real */ ae_vector* d, - double tau, - ae_state *_state) -{ - ae_int_t i; - - - ae_assert(ae_isfinite(tau, _state)&&ae_fp_greater_eq(tau,0), "CQMSetD: Tau<0 or is not finite number", _state); - ae_assert(ae_fp_eq(tau,0)||isfinitevector(d, s->n, _state), "CQMSetD: D is not finite Nx1 vector", _state); - s->tau = tau; - if( ae_fp_greater(tau,0) ) - { - rvectorsetlengthatleast(&s->d, s->n, _state); - rvectorsetlengthatleast(&s->ecadiag, s->n, _state); - rvectorsetlengthatleast(&s->tq2diag, s->n, _state); - for(i=0; i<=s->n-1; i++) - { - ae_assert(ae_fp_greater_eq(d->ptr.p_double[i],0), "CQMSetD: D[i]<0", _state); - s->d.ptr.p_double[i] = d->ptr.p_double[i]; - } - } - s->ismaintermchanged = ae_true; -} - - -/************************************************************************* -This subroutine drops main quadratic term A from the model. It is same as -call to CQMSetA() with zero A, but gives better performance because -algorithm knows that matrix is zero and can optimize subsequent -calculations. - -INPUT PARAMETERS: - S - model - - -- ALGLIB -- - Copyright 12.06.2012 by Bochkanov Sergey -*************************************************************************/ -void cqmdropa(convexquadraticmodel* s, ae_state *_state) -{ - - - s->alpha = 0.0; - s->ismaintermchanged = ae_true; -} - - -/************************************************************************* -This subroutine changes linear term of the model - - -- ALGLIB -- - Copyright 12.06.2012 by Bochkanov Sergey -*************************************************************************/ -void cqmsetb(convexquadraticmodel* s, - /* Real */ ae_vector* b, - ae_state *_state) -{ - ae_int_t i; - - - ae_assert(isfinitevector(b, s->n, _state), "CQMSetB: B is not finite vector", _state); - rvectorsetlengthatleast(&s->b, s->n, _state); - for(i=0; i<=s->n-1; i++) - { - s->b.ptr.p_double[i] = b->ptr.p_double[i]; - } - s->islineartermchanged = ae_true; -} - - -/************************************************************************* -This subroutine changes linear term of the model - - -- ALGLIB -- - Copyright 12.06.2012 by Bochkanov Sergey -*************************************************************************/ -void cqmsetq(convexquadraticmodel* s, - /* Real */ ae_matrix* q, - /* Real */ ae_vector* r, - ae_int_t k, - double theta, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - - - ae_assert(k>=0, "CQMSetQ: K<0", _state); - ae_assert((k==0||ae_fp_eq(theta,0))||apservisfinitematrix(q, k, s->n, _state), "CQMSetQ: Q is not finite matrix", _state); - ae_assert((k==0||ae_fp_eq(theta,0))||isfinitevector(r, k, _state), "CQMSetQ: R is not finite vector", _state); - ae_assert(ae_isfinite(theta, _state)&&ae_fp_greater_eq(theta,0), "CQMSetQ: Theta<0 or is not finite number", _state); - - /* - * degenerate case: K=0 or Theta=0 - */ - if( k==0||ae_fp_eq(theta,0) ) - { - s->k = 0; - s->theta = 0; - s->issecondarytermchanged = ae_true; - return; - } - - /* - * General case: both Theta>0 and K>0 - */ - s->k = k; - s->theta = theta; - rmatrixsetlengthatleast(&s->q, s->k, s->n, _state); - rvectorsetlengthatleast(&s->r, s->k, _state); - rmatrixsetlengthatleast(&s->eq, s->k, s->n, _state); - rmatrixsetlengthatleast(&s->eccm, s->k, s->k, _state); - rmatrixsetlengthatleast(&s->tk2, s->k, s->n, _state); - for(i=0; i<=s->k-1; i++) - { - for(j=0; j<=s->n-1; j++) - { - s->q.ptr.pp_double[i][j] = q->ptr.pp_double[i][j]; - } - s->r.ptr.p_double[i] = r->ptr.p_double[i]; - } - s->issecondarytermchanged = ae_true; -} - - -/************************************************************************* -This subroutine changes active set - -INPUT PARAMETERS - S - model - X - array[N], constraint values - ActiveSet- array[N], active set. If ActiveSet[I]=True, then I-th - variables is constrained to X[I]. - - -- ALGLIB -- - Copyright 12.06.2012 by Bochkanov Sergey -*************************************************************************/ -void cqmsetactiveset(convexquadraticmodel* s, - /* Real */ ae_vector* x, - /* Boolean */ ae_vector* activeset, - ae_state *_state) -{ - ae_int_t i; - - - ae_assert(x->cnt>=s->n, "CQMSetActiveSet: Length(X)cnt>=s->n, "CQMSetActiveSet: Length(ActiveSet)n-1; i++) - { - s->isactivesetchanged = s->isactivesetchanged||(s->activeset.ptr.p_bool[i]&&!activeset->ptr.p_bool[i]); - s->isactivesetchanged = s->isactivesetchanged||(activeset->ptr.p_bool[i]&&!s->activeset.ptr.p_bool[i]); - s->activeset.ptr.p_bool[i] = activeset->ptr.p_bool[i]; - if( activeset->ptr.p_bool[i] ) - { - ae_assert(ae_isfinite(x->ptr.p_double[i], _state), "CQMSetActiveSet: X[] contains infinite constraints", _state); - s->isactivesetchanged = s->isactivesetchanged||ae_fp_neq(s->xc.ptr.p_double[i],x->ptr.p_double[i]); - s->xc.ptr.p_double[i] = x->ptr.p_double[i]; - } - } -} - - -/************************************************************************* -This subroutine evaluates model at X. Active constraints are ignored. - - -- ALGLIB -- - Copyright 12.06.2012 by Bochkanov Sergey -*************************************************************************/ -double cqmeval(convexquadraticmodel* s, - /* Real */ ae_vector* x, - ae_state *_state) -{ - ae_int_t n; - ae_int_t i; - ae_int_t j; - double v; - double result; - - - n = s->n; - ae_assert(isfinitevector(x, n, _state), "CQMEval: X is not finite vector", _state); - result = 0.0; - - /* - * main quadratic term - */ - if( ae_fp_greater(s->alpha,0) ) - { - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - result = result+s->alpha*0.5*x->ptr.p_double[i]*s->a.ptr.pp_double[i][j]*x->ptr.p_double[j]; - } - } - } - if( ae_fp_greater(s->tau,0) ) - { - for(i=0; i<=n-1; i++) - { - result = result+0.5*ae_sqr(x->ptr.p_double[i], _state)*s->tau*s->d.ptr.p_double[i]; - } - } - - /* - * secondary quadratic term - */ - if( ae_fp_greater(s->theta,0) ) - { - for(i=0; i<=s->k-1; i++) - { - v = ae_v_dotproduct(&s->q.ptr.pp_double[i][0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,n-1)); - result = result+0.5*s->theta*ae_sqr(v-s->r.ptr.p_double[i], _state); - } - } - - /* - * linear term - */ - for(i=0; i<=s->n-1; i++) - { - result = result+x->ptr.p_double[i]*s->b.ptr.p_double[i]; - } - return result; -} - - -/************************************************************************* -This subroutine evaluates model at X. Active constraints are ignored. -It returns: - R - model value - Noise- estimate of the numerical noise in data - - -- ALGLIB -- - Copyright 12.06.2012 by Bochkanov Sergey -*************************************************************************/ -void cqmevalx(convexquadraticmodel* s, - /* Real */ ae_vector* x, - double* r, - double* noise, - ae_state *_state) -{ - ae_int_t n; - ae_int_t i; - ae_int_t j; - double v; - double v2; - double mxq; - double eps; - - *r = 0; - *noise = 0; - - n = s->n; - ae_assert(isfinitevector(x, n, _state), "CQMEval: X is not finite vector", _state); - *r = 0.0; - *noise = 0.0; - eps = 2*ae_machineepsilon; - mxq = 0.0; - - /* - * Main quadratic term. - * - * Noise from the main quadratic term is equal to the - * maximum summand in the term. - */ - if( ae_fp_greater(s->alpha,0) ) - { - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - v = s->alpha*0.5*x->ptr.p_double[i]*s->a.ptr.pp_double[i][j]*x->ptr.p_double[j]; - *r = *r+v; - *noise = ae_maxreal(*noise, eps*ae_fabs(v, _state), _state); - } - } - } - if( ae_fp_greater(s->tau,0) ) - { - for(i=0; i<=n-1; i++) - { - v = 0.5*ae_sqr(x->ptr.p_double[i], _state)*s->tau*s->d.ptr.p_double[i]; - *r = *r+v; - *noise = ae_maxreal(*noise, eps*ae_fabs(v, _state), _state); - } - } - - /* - * secondary quadratic term - * - * Noise from the secondary quadratic term is estimated as follows: - * * noise in qi*x-r[i] is estimated as - * Eps*MXQ = Eps*max(|r[i]|, |q[i,j]*x[j]|) - * * noise in (qi*x-r[i])^2 is estimated as - * NOISE = (|qi*x-r[i]|+Eps*MXQ)^2-(|qi*x-r[i]|)^2 - * = Eps*MXQ*(2*|qi*x-r[i]|+Eps*MXQ) - */ - if( ae_fp_greater(s->theta,0) ) - { - for(i=0; i<=s->k-1; i++) - { - v = 0.0; - mxq = ae_fabs(s->r.ptr.p_double[i], _state); - for(j=0; j<=n-1; j++) - { - v2 = s->q.ptr.pp_double[i][j]*x->ptr.p_double[j]; - v = v+v2; - mxq = ae_maxreal(mxq, ae_fabs(v2, _state), _state); - } - *r = *r+0.5*s->theta*ae_sqr(v-s->r.ptr.p_double[i], _state); - *noise = ae_maxreal(*noise, eps*mxq*(2*ae_fabs(v-s->r.ptr.p_double[i], _state)+eps*mxq), _state); - } - } - - /* - * linear term - */ - for(i=0; i<=s->n-1; i++) - { - *r = *r+x->ptr.p_double[i]*s->b.ptr.p_double[i]; - *noise = ae_maxreal(*noise, eps*ae_fabs(x->ptr.p_double[i]*s->b.ptr.p_double[i], _state), _state); - } - - /* - * Final update of the noise - */ - *noise = n*(*noise); -} - - -/************************************************************************* -This subroutine evaluates gradient of the model; active constraints are -ignored. - -INPUT PARAMETERS: - S - convex model - X - point, array[N] - G - possibly preallocated buffer; resized, if too small - - -- ALGLIB -- - Copyright 12.06.2012 by Bochkanov Sergey -*************************************************************************/ -void cqmgradunconstrained(convexquadraticmodel* s, - /* Real */ ae_vector* x, - /* Real */ ae_vector* g, - ae_state *_state) -{ - ae_int_t n; - ae_int_t i; - ae_int_t j; - double v; - - - n = s->n; - ae_assert(isfinitevector(x, n, _state), "CQMEvalGradUnconstrained: X is not finite vector", _state); - rvectorsetlengthatleast(g, n, _state); - for(i=0; i<=n-1; i++) - { - g->ptr.p_double[i] = 0; - } - - /* - * main quadratic term - */ - if( ae_fp_greater(s->alpha,0) ) - { - for(i=0; i<=n-1; i++) - { - v = 0.0; - for(j=0; j<=n-1; j++) - { - v = v+s->alpha*s->a.ptr.pp_double[i][j]*x->ptr.p_double[j]; - } - g->ptr.p_double[i] = g->ptr.p_double[i]+v; - } - } - if( ae_fp_greater(s->tau,0) ) - { - for(i=0; i<=n-1; i++) - { - g->ptr.p_double[i] = g->ptr.p_double[i]+x->ptr.p_double[i]*s->tau*s->d.ptr.p_double[i]; - } - } - - /* - * secondary quadratic term - */ - if( ae_fp_greater(s->theta,0) ) - { - for(i=0; i<=s->k-1; i++) - { - v = ae_v_dotproduct(&s->q.ptr.pp_double[i][0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,n-1)); - v = s->theta*(v-s->r.ptr.p_double[i]); - ae_v_addd(&g->ptr.p_double[0], 1, &s->q.ptr.pp_double[i][0], 1, ae_v_len(0,n-1), v); - } - } - - /* - * linear term - */ - for(i=0; i<=n-1; i++) - { - g->ptr.p_double[i] = g->ptr.p_double[i]+s->b.ptr.p_double[i]; - } -} - - -/************************************************************************* -This subroutine evaluates x'*(0.5*alpha*A+tau*D)*x - - -- ALGLIB -- - Copyright 12.06.2012 by Bochkanov Sergey -*************************************************************************/ -double cqmxtadx2(convexquadraticmodel* s, - /* Real */ ae_vector* x, - ae_state *_state) -{ - ae_int_t n; - ae_int_t i; - ae_int_t j; - double result; - - - n = s->n; - ae_assert(isfinitevector(x, n, _state), "CQMEval: X is not finite vector", _state); - result = 0.0; - - /* - * main quadratic term - */ - if( ae_fp_greater(s->alpha,0) ) - { - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - result = result+s->alpha*0.5*x->ptr.p_double[i]*s->a.ptr.pp_double[i][j]*x->ptr.p_double[j]; - } - } - } - if( ae_fp_greater(s->tau,0) ) - { - for(i=0; i<=n-1; i++) - { - result = result+0.5*ae_sqr(x->ptr.p_double[i], _state)*s->tau*s->d.ptr.p_double[i]; - } - } - return result; -} - - -/************************************************************************* -This subroutine evaluates (0.5*alpha*A+tau*D)*x - -Y is automatically resized if needed - - -- ALGLIB -- - Copyright 12.06.2012 by Bochkanov Sergey -*************************************************************************/ -void cqmadx(convexquadraticmodel* s, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state) -{ - ae_int_t n; - ae_int_t i; - double v; - - - n = s->n; - ae_assert(isfinitevector(x, n, _state), "CQMEval: X is not finite vector", _state); - rvectorsetlengthatleast(y, n, _state); - - /* - * main quadratic term - */ - for(i=0; i<=n-1; i++) - { - y->ptr.p_double[i] = 0; - } - if( ae_fp_greater(s->alpha,0) ) - { - for(i=0; i<=n-1; i++) - { - v = ae_v_dotproduct(&s->a.ptr.pp_double[i][0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,n-1)); - y->ptr.p_double[i] = y->ptr.p_double[i]+s->alpha*v; - } - } - if( ae_fp_greater(s->tau,0) ) - { - for(i=0; i<=n-1; i++) - { - y->ptr.p_double[i] = y->ptr.p_double[i]+x->ptr.p_double[i]*s->tau*s->d.ptr.p_double[i]; - } - } -} - - -/************************************************************************* -This subroutine finds optimum of the model. It returns False on failure -(indefinite/semidefinite matrix). Optimum is found subject to active -constraints. - -INPUT PARAMETERS - S - model - X - possibly preallocated buffer; automatically resized, if - too small enough. - - -- ALGLIB -- - Copyright 12.06.2012 by Bochkanov Sergey -*************************************************************************/ -ae_bool cqmconstrainedoptimum(convexquadraticmodel* s, - /* Real */ ae_vector* x, - ae_state *_state) -{ - ae_int_t n; - ae_int_t nfree; - ae_int_t k; - ae_int_t i; - double v; - ae_int_t cidx0; - ae_int_t itidx; - ae_bool result; - - - - /* - * Rebuild internal structures - */ - if( !cqmodels_cqmrebuild(s, _state) ) - { - result = ae_false; - return result; - } - n = s->n; - k = s->k; - nfree = s->nfree; - result = ae_true; - - /* - * Calculate initial point for the iterative refinement: - * * free components are set to zero - * * constrained components are set to their constrained values - */ - rvectorsetlengthatleast(x, n, _state); - for(i=0; i<=n-1; i++) - { - if( s->activeset.ptr.p_bool[i] ) - { - x->ptr.p_double[i] = s->xc.ptr.p_double[i]; - } - else - { - x->ptr.p_double[i] = 0; - } - } - - /* - * Iterative refinement. - * - * In an ideal world without numerical errors it would be enough - * to make just one Newton step from initial point: - * x_new = -H^(-1)*grad(x=0) - * However, roundoff errors can significantly deteriorate quality - * of the solution. So we have to recalculate gradient and to - * perform Newton steps several times. - * - * Below we perform fixed number of Newton iterations. - */ - for(itidx=0; itidx<=cqmodels_newtonrefinementits-1; itidx++) - { - - /* - * Calculate gradient at the current point. - * Move free components of the gradient in the beginning. - */ - cqmgradunconstrained(s, x, &s->tmpg, _state); - cidx0 = 0; - for(i=0; i<=n-1; i++) - { - if( !s->activeset.ptr.p_bool[i] ) - { - s->tmpg.ptr.p_double[cidx0] = s->tmpg.ptr.p_double[i]; - cidx0 = cidx0+1; - } - } - - /* - * Free components of the extrema are calculated in the first NFree elements of TXC. - * - * First, we have to calculate original Newton step, without rank-K perturbations - */ - ae_v_moveneg(&s->txc.ptr.p_double[0], 1, &s->tmpg.ptr.p_double[0], 1, ae_v_len(0,nfree-1)); - cqmodels_cqmsolveea(s, &s->txc, &s->tmp0, _state); - - /* - * Then, we account for rank-K correction. - * Woodbury matrix identity is used. - */ - if( s->k>0&&ae_fp_greater(s->theta,0) ) - { - rvectorsetlengthatleast(&s->tmp0, ae_maxint(nfree, k, _state), _state); - rvectorsetlengthatleast(&s->tmp1, ae_maxint(nfree, k, _state), _state); - ae_v_moveneg(&s->tmp1.ptr.p_double[0], 1, &s->tmpg.ptr.p_double[0], 1, ae_v_len(0,nfree-1)); - cqmodels_cqmsolveea(s, &s->tmp1, &s->tmp0, _state); - for(i=0; i<=k-1; i++) - { - v = ae_v_dotproduct(&s->eq.ptr.pp_double[i][0], 1, &s->tmp1.ptr.p_double[0], 1, ae_v_len(0,nfree-1)); - s->tmp0.ptr.p_double[i] = v; - } - fblscholeskysolve(&s->eccm, 1.0, k, ae_true, &s->tmp0, &s->tmp1, _state); - for(i=0; i<=nfree-1; i++) - { - s->tmp1.ptr.p_double[i] = 0.0; - } - for(i=0; i<=k-1; i++) - { - v = s->tmp0.ptr.p_double[i]; - ae_v_addd(&s->tmp1.ptr.p_double[0], 1, &s->eq.ptr.pp_double[i][0], 1, ae_v_len(0,nfree-1), v); - } - cqmodels_cqmsolveea(s, &s->tmp1, &s->tmp0, _state); - ae_v_sub(&s->txc.ptr.p_double[0], 1, &s->tmp1.ptr.p_double[0], 1, ae_v_len(0,nfree-1)); - } - - /* - * Unpack components from TXC into X. We pass through all - * free components of X and add our step. - */ - cidx0 = 0; - for(i=0; i<=n-1; i++) - { - if( !s->activeset.ptr.p_bool[i] ) - { - x->ptr.p_double[i] = x->ptr.p_double[i]+s->txc.ptr.p_double[cidx0]; - cidx0 = cidx0+1; - } - } - } - return result; -} - - -/************************************************************************* -This function scales vector by multiplying it by inverse of the diagonal -of the Hessian matrix. It should be used to accelerate steepest descent -phase of the QP solver. - -Although it is called "scale-grad", it can be called for any vector, -whether it is gradient, anti-gradient, or just some vector. - -This function does NOT takes into account current set of constraints, it -just performs matrix-vector multiplication without taking into account -constraints. - -INPUT PARAMETERS: - S - model - X - vector to scale - -OUTPUT PARAMETERS: - X - scaled vector - -NOTE: - when called for non-SPD matrices, it silently skips components of X - which correspond to zero or negative diagonal elements. - -NOTE: - this function uses diagonals of A and D; it ignores Q - rank-K term of - the quadratic model. - - -- ALGLIB -- - Copyright 12.06.2012 by Bochkanov Sergey -*************************************************************************/ -void cqmscalevector(convexquadraticmodel* s, - /* Real */ ae_vector* x, - ae_state *_state) -{ - ae_int_t n; - ae_int_t i; - double v; - - - n = s->n; - for(i=0; i<=n-1; i++) - { - v = 0.0; - if( ae_fp_greater(s->alpha,0) ) - { - v = v+s->a.ptr.pp_double[i][i]; - } - if( ae_fp_greater(s->tau,0) ) - { - v = v+s->d.ptr.p_double[i]; - } - if( ae_fp_greater(v,0) ) - { - x->ptr.p_double[i] = x->ptr.p_double[i]/v; - } - } -} - - -/************************************************************************* -This subroutine calls CQMRebuild() and evaluates model at X subject to -active constraints. - -It is intended for debug purposes only, because it evaluates model by -means of temporaries, which were calculated by CQMRebuild(). The only -purpose of this function is to check correctness of CQMRebuild() by -comparing results of this function with ones obtained by CQMEval(), which -is used as reference point. The idea is that significant deviation in -results of these two functions is evidence of some error in the -CQMRebuild(). - -NOTE: suffix T denotes that temporaries marked by T-prefix are used. There - is one more variant of this function, which uses "effective" model - built by CQMRebuild(). - -NOTE2: in case CQMRebuild() fails (due to model non-convexity), this - function returns NAN. - - -- ALGLIB -- - Copyright 12.06.2012 by Bochkanov Sergey -*************************************************************************/ -double cqmdebugconstrainedevalt(convexquadraticmodel* s, - /* Real */ ae_vector* x, - ae_state *_state) -{ - ae_int_t n; - ae_int_t nfree; - ae_int_t i; - ae_int_t j; - double v; - double result; - - - n = s->n; - ae_assert(isfinitevector(x, n, _state), "CQMDebugConstrainedEvalT: X is not finite vector", _state); - if( !cqmodels_cqmrebuild(s, _state) ) - { - result = _state->v_nan; - return result; - } - result = 0.0; - nfree = s->nfree; - - /* - * Reorder variables - */ - j = 0; - for(i=0; i<=n-1; i++) - { - if( !s->activeset.ptr.p_bool[i] ) - { - ae_assert(jtxc.ptr.p_double[j] = x->ptr.p_double[i]; - j = j+1; - } - } - - /* - * TQ2, TQ1, TQ0 - * - */ - if( ae_fp_greater(s->alpha,0) ) - { - - /* - * Dense TQ2 - */ - for(i=0; i<=nfree-1; i++) - { - for(j=0; j<=nfree-1; j++) - { - result = result+0.5*s->txc.ptr.p_double[i]*s->tq2dense.ptr.pp_double[i][j]*s->txc.ptr.p_double[j]; - } - } - } - else - { - - /* - * Diagonal TQ2 - */ - for(i=0; i<=nfree-1; i++) - { - result = result+0.5*s->tq2diag.ptr.p_double[i]*ae_sqr(s->txc.ptr.p_double[i], _state); - } - } - for(i=0; i<=nfree-1; i++) - { - result = result+s->tq1.ptr.p_double[i]*s->txc.ptr.p_double[i]; - } - result = result+s->tq0; - - /* - * TK2, TK1, TK0 - */ - if( s->k>0&&ae_fp_greater(s->theta,0) ) - { - for(i=0; i<=s->k-1; i++) - { - v = 0; - for(j=0; j<=nfree-1; j++) - { - v = v+s->tk2.ptr.pp_double[i][j]*s->txc.ptr.p_double[j]; - } - result = result+0.5*ae_sqr(v, _state); - } - for(i=0; i<=nfree-1; i++) - { - result = result+s->tk1.ptr.p_double[i]*s->txc.ptr.p_double[i]; - } - result = result+s->tk0; - } - - /* - * TB (Bf and Bc parts) - */ - for(i=0; i<=n-1; i++) - { - result = result+s->tb.ptr.p_double[i]*s->txc.ptr.p_double[i]; - } - return result; -} - - -/************************************************************************* -This subroutine calls CQMRebuild() and evaluates model at X subject to -active constraints. - -It is intended for debug purposes only, because it evaluates model by -means of "effective" matrices built by CQMRebuild(). The only purpose of -this function is to check correctness of CQMRebuild() by comparing results -of this function with ones obtained by CQMEval(), which is used as -reference point. The idea is that significant deviation in results of -these two functions is evidence of some error in the CQMRebuild(). - -NOTE: suffix E denotes that effective matrices. There is one more variant - of this function, which uses temporary matrices built by - CQMRebuild(). - -NOTE2: in case CQMRebuild() fails (due to model non-convexity), this - function returns NAN. - - -- ALGLIB -- - Copyright 12.06.2012 by Bochkanov Sergey -*************************************************************************/ -double cqmdebugconstrainedevale(convexquadraticmodel* s, - /* Real */ ae_vector* x, - ae_state *_state) -{ - ae_int_t n; - ae_int_t nfree; - ae_int_t i; - ae_int_t j; - double v; - double result; - - - n = s->n; - ae_assert(isfinitevector(x, n, _state), "CQMDebugConstrainedEvalE: X is not finite vector", _state); - if( !cqmodels_cqmrebuild(s, _state) ) - { - result = _state->v_nan; - return result; - } - result = 0.0; - nfree = s->nfree; - - /* - * Reorder variables - */ - j = 0; - for(i=0; i<=n-1; i++) - { - if( !s->activeset.ptr.p_bool[i] ) - { - ae_assert(jtxc.ptr.p_double[j] = x->ptr.p_double[i]; - j = j+1; - } - } - - /* - * ECA - */ - ae_assert((s->ecakind==0||s->ecakind==1)||(s->ecakind==-1&&nfree==0), "CQMDebugConstrainedEvalE: unexpected ECAKind", _state); - if( s->ecakind==0 ) - { - - /* - * Dense ECA - */ - for(i=0; i<=nfree-1; i++) - { - v = 0.0; - for(j=i; j<=nfree-1; j++) - { - v = v+s->ecadense.ptr.pp_double[i][j]*s->txc.ptr.p_double[j]; - } - result = result+0.5*ae_sqr(v, _state); - } - } - if( s->ecakind==1 ) - { - - /* - * Diagonal ECA - */ - for(i=0; i<=nfree-1; i++) - { - result = result+0.5*ae_sqr(s->ecadiag.ptr.p_double[i]*s->txc.ptr.p_double[i], _state); - } - } - - /* - * EQ - */ - for(i=0; i<=s->k-1; i++) - { - v = 0.0; - for(j=0; j<=nfree-1; j++) - { - v = v+s->eq.ptr.pp_double[i][j]*s->txc.ptr.p_double[j]; - } - result = result+0.5*ae_sqr(v, _state); - } - - /* - * EB - */ - for(i=0; i<=nfree-1; i++) - { - result = result+s->eb.ptr.p_double[i]*s->txc.ptr.p_double[i]; - } - - /* - * EC - */ - result = result+s->ec; - return result; -} - - -/************************************************************************* -Internal function, rebuilds "effective" model subject to constraints. -Returns False on failure (non-SPD main quadratic term) - - -- ALGLIB -- - Copyright 10.05.2011 by Bochkanov Sergey -*************************************************************************/ -static ae_bool cqmodels_cqmrebuild(convexquadraticmodel* s, - ae_state *_state) -{ - ae_int_t n; - ae_int_t nfree; - ae_int_t k; - ae_int_t i; - ae_int_t j; - ae_int_t ridx0; - ae_int_t ridx1; - ae_int_t cidx0; - ae_int_t cidx1; - double v; - ae_bool result; - - - if( ae_fp_eq(s->alpha,0)&&ae_fp_eq(s->tau,0) ) - { - - /* - * Non-SPD model, quick exit - */ - result = ae_false; - return result; - } - result = ae_true; - n = s->n; - k = s->k; - - /* - * Determine number of free variables. - * Fill TXC - array whose last N-NFree elements store constraints. - */ - if( s->isactivesetchanged ) - { - s->nfree = 0; - for(i=0; i<=n-1; i++) - { - if( !s->activeset.ptr.p_bool[i] ) - { - s->nfree = s->nfree+1; - } - } - j = s->nfree; - for(i=0; i<=n-1; i++) - { - if( s->activeset.ptr.p_bool[i] ) - { - s->txc.ptr.p_double[j] = s->xc.ptr.p_double[i]; - j = j+1; - } - } - } - nfree = s->nfree; - - /* - * Re-evaluate TQ2/TQ1/TQ0, if needed - */ - if( s->isactivesetchanged||s->ismaintermchanged ) - { - - /* - * Handle cases Alpha>0 and Alpha=0 separately: - * * in the first case we have dense matrix - * * in the second one we have diagonal matrix, which can be - * handled more efficiently - */ - if( ae_fp_greater(s->alpha,0) ) - { - - /* - * Alpha>0, dense QP - * - * Split variables into two groups - free (F) and constrained (C). Reorder - * variables in such way that free vars come first, constrained are last: - * x = [xf, xc]. - * - * Main quadratic term x'*(alpha*A+tau*D)*x now splits into quadratic part, - * linear part and constant part: - * ( alpha*Aff+tau*Df alpha*Afc ) ( xf ) - * 0.5*( xf' xc' )*( )*( ) = - * ( alpha*Acf alpha*Acc+tau*Dc ) ( xc ) - * - * = 0.5*xf'*(alpha*Aff+tau*Df)*xf + (alpha*Afc*xc)'*xf + 0.5*xc'(alpha*Acc+tau*Dc)*xc - * - * We store these parts into temporary variables: - * * alpha*Aff+tau*Df, alpha*Afc, alpha*Acc+tau*Dc are stored into upper - * triangle of TQ2 - * * alpha*Afc*xc is stored into TQ1 - * * 0.5*xc'(alpha*Acc+tau*Dc)*xc is stored into TQ0 - * - * Below comes first part of the work - generation of TQ2: - * * we pass through rows of A and copy I-th row into upper block (Aff/Afc) or - * lower one (Acf/Acc) of TQ2, depending on presence of X[i] in the active set. - * RIdx0 variable contains current position for insertion into upper block, - * RIdx1 contains current position for insertion into lower one. - * * within each row, we copy J-th element into left half (Aff/Acf) or right - * one (Afc/Acc), depending on presence of X[j] in the active set. CIdx0 - * contains current position for insertion into left block, CIdx1 contains - * position for insertion into right one. - * * during copying, we multiply elements by alpha and add diagonal matrix D. - */ - ridx0 = 0; - ridx1 = s->nfree; - for(i=0; i<=n-1; i++) - { - cidx0 = 0; - cidx1 = s->nfree; - for(j=0; j<=n-1; j++) - { - if( !s->activeset.ptr.p_bool[i]&&!s->activeset.ptr.p_bool[j] ) - { - - /* - * Element belongs to Aff - */ - v = s->alpha*s->a.ptr.pp_double[i][j]; - if( i==j&&ae_fp_greater(s->tau,0) ) - { - v = v+s->tau*s->d.ptr.p_double[i]; - } - s->tq2dense.ptr.pp_double[ridx0][cidx0] = v; - } - if( !s->activeset.ptr.p_bool[i]&&s->activeset.ptr.p_bool[j] ) - { - - /* - * Element belongs to Afc - */ - s->tq2dense.ptr.pp_double[ridx0][cidx1] = s->alpha*s->a.ptr.pp_double[i][j]; - } - if( s->activeset.ptr.p_bool[i]&&!s->activeset.ptr.p_bool[j] ) - { - - /* - * Element belongs to Acf - */ - s->tq2dense.ptr.pp_double[ridx1][cidx0] = s->alpha*s->a.ptr.pp_double[i][j]; - } - if( s->activeset.ptr.p_bool[i]&&s->activeset.ptr.p_bool[j] ) - { - - /* - * Element belongs to Acc - */ - v = s->alpha*s->a.ptr.pp_double[i][j]; - if( i==j&&ae_fp_greater(s->tau,0) ) - { - v = v+s->tau*s->d.ptr.p_double[i]; - } - s->tq2dense.ptr.pp_double[ridx1][cidx1] = v; - } - if( s->activeset.ptr.p_bool[j] ) - { - cidx1 = cidx1+1; - } - else - { - cidx0 = cidx0+1; - } - } - if( s->activeset.ptr.p_bool[i] ) - { - ridx1 = ridx1+1; - } - else - { - ridx0 = ridx0+1; - } - } - - /* - * Now we have TQ2, and we can evaluate TQ1. - * In the special case when we have Alpha=0, NFree=0 or NFree=N, - * TQ1 is filled by zeros. - */ - for(i=0; i<=n-1; i++) - { - s->tq1.ptr.p_double[i] = 0.0; - } - if( s->nfree>0&&s->nfreenfree, n-s->nfree, &s->tq2dense, 0, s->nfree, 0, &s->txc, s->nfree, &s->tq1, 0, _state); - } - - /* - * And finally, we evaluate TQ0. - */ - v = 0.0; - for(i=s->nfree; i<=n-1; i++) - { - for(j=s->nfree; j<=n-1; j++) - { - v = v+0.5*s->txc.ptr.p_double[i]*s->tq2dense.ptr.pp_double[i][j]*s->txc.ptr.p_double[j]; - } - } - s->tq0 = v; - } - else - { - - /* - * Alpha=0, diagonal QP - * - * Split variables into two groups - free (F) and constrained (C). Reorder - * variables in such way that free vars come first, constrained are last: - * x = [xf, xc]. - * - * Main quadratic term x'*(tau*D)*x now splits into quadratic and constant - * parts: - * ( tau*Df ) ( xf ) - * 0.5*( xf' xc' )*( )*( ) = - * ( tau*Dc ) ( xc ) - * - * = 0.5*xf'*(tau*Df)*xf + 0.5*xc'(tau*Dc)*xc - * - * We store these parts into temporary variables: - * * tau*Df is stored in TQ2Diag - * * 0.5*xc'(tau*Dc)*xc is stored into TQ0 - */ - s->tq0 = 0.0; - ridx0 = 0; - for(i=0; i<=n-1; i++) - { - if( !s->activeset.ptr.p_bool[i] ) - { - s->tq2diag.ptr.p_double[ridx0] = s->tau*s->d.ptr.p_double[i]; - ridx0 = ridx0+1; - } - else - { - s->tq0 = s->tq0+0.5*s->tau*s->d.ptr.p_double[i]*ae_sqr(s->xc.ptr.p_double[i], _state); - } - } - for(i=0; i<=n-1; i++) - { - s->tq1.ptr.p_double[i] = 0.0; - } - } - } - - /* - * Re-evaluate TK2/TK1/TK0, if needed - */ - if( s->isactivesetchanged||s->issecondarytermchanged ) - { - - /* - * Split variables into two groups - free (F) and constrained (C). Reorder - * variables in such way that free vars come first, constrained are last: - * x = [xf, xc]. - * - * Secondary term theta*(Q*x-r)'*(Q*x-r) now splits into quadratic part, - * linear part and constant part: - * ( ( xf ) )' ( ( xf ) ) - * 0.5*theta*( (Qf Qc)'*( ) - r ) * ( (Qf Qc)'*( ) - r ) = - * ( ( xc ) ) ( ( xc ) ) - * - * = 0.5*theta*xf'*(Qf'*Qf)*xf + theta*((Qc*xc-r)'*Qf)*xf + - * + theta*(-r'*(Qc*xc-r)-0.5*r'*r+0.5*xc'*Qc'*Qc*xc) - * - * We store these parts into temporary variables: - * * sqrt(theta)*Qf is stored into TK2 - * * theta*((Qc*xc-r)'*Qf) is stored into TK1 - * * theta*(-r'*(Qc*xc-r)-0.5*r'*r+0.5*xc'*Qc'*Qc*xc) is stored into TK0 - * - * We use several other temporaries to store intermediate results: - * * Tmp0 - to store Qc*xc-r - * * Tmp1 - to store Qc*xc - * - * Generation of TK2/TK1/TK0 is performed as follows: - * * we fill TK2/TK1/TK0 (to handle K=0 or Theta=0) - * * other steps are performed only for K>0 and Theta>0 - * * we pass through columns of Q and copy I-th column into left block (Qf) or - * right one (Qc) of TK2, depending on presence of X[i] in the active set. - * CIdx0 variable contains current position for insertion into upper block, - * CIdx1 contains current position for insertion into lower one. - * * we calculate Qc*xc-r and store it into Tmp0 - * * we calculate TK0 and TK1 - * * we multiply leading part of TK2 which stores Qf by sqrt(theta) - * it is important to perform this step AFTER calculation of TK0 and TK1, - * because we need original (non-modified) Qf to calculate TK0 and TK1. - */ - for(j=0; j<=n-1; j++) - { - for(i=0; i<=k-1; i++) - { - s->tk2.ptr.pp_double[i][j] = 0.0; - } - s->tk1.ptr.p_double[j] = 0.0; - } - s->tk0 = 0.0; - if( s->k>0&&ae_fp_greater(s->theta,0) ) - { - - /* - * Split Q into Qf and Qc - * Calculate Qc*xc-r, store in Tmp0 - */ - rvectorsetlengthatleast(&s->tmp0, k, _state); - rvectorsetlengthatleast(&s->tmp1, k, _state); - cidx0 = 0; - cidx1 = nfree; - for(i=0; i<=k-1; i++) - { - s->tmp1.ptr.p_double[i] = 0.0; - } - for(j=0; j<=n-1; j++) - { - if( s->activeset.ptr.p_bool[j] ) - { - for(i=0; i<=k-1; i++) - { - s->tk2.ptr.pp_double[i][cidx1] = s->q.ptr.pp_double[i][j]; - s->tmp1.ptr.p_double[i] = s->tmp1.ptr.p_double[i]+s->q.ptr.pp_double[i][j]*s->txc.ptr.p_double[cidx1]; - } - cidx1 = cidx1+1; - } - else - { - for(i=0; i<=k-1; i++) - { - s->tk2.ptr.pp_double[i][cidx0] = s->q.ptr.pp_double[i][j]; - } - cidx0 = cidx0+1; - } - } - for(i=0; i<=k-1; i++) - { - s->tmp0.ptr.p_double[i] = s->tmp1.ptr.p_double[i]-s->r.ptr.p_double[i]; - } - - /* - * Calculate TK0 - */ - v = 0.0; - for(i=0; i<=k-1; i++) - { - v = v+s->theta*(0.5*ae_sqr(s->tmp1.ptr.p_double[i], _state)-s->r.ptr.p_double[i]*s->tmp0.ptr.p_double[i]-0.5*ae_sqr(s->r.ptr.p_double[i], _state)); - } - s->tk0 = v; - - /* - * Calculate TK1 - */ - if( nfree>0 ) - { - for(i=0; i<=k-1; i++) - { - v = s->theta*s->tmp0.ptr.p_double[i]; - ae_v_addd(&s->tk1.ptr.p_double[0], 1, &s->tk2.ptr.pp_double[i][0], 1, ae_v_len(0,nfree-1), v); - } - } - - /* - * Calculate TK2 - */ - if( nfree>0 ) - { - v = ae_sqrt(s->theta, _state); - for(i=0; i<=k-1; i++) - { - ae_v_muld(&s->tk2.ptr.pp_double[i][0], 1, ae_v_len(0,nfree-1), v); - } - } - } - } - - /* - * Re-evaluate TB - */ - if( s->isactivesetchanged||s->islineartermchanged ) - { - ridx0 = 0; - ridx1 = nfree; - for(i=0; i<=n-1; i++) - { - if( s->activeset.ptr.p_bool[i] ) - { - s->tb.ptr.p_double[ridx1] = s->b.ptr.p_double[i]; - ridx1 = ridx1+1; - } - else - { - s->tb.ptr.p_double[ridx0] = s->b.ptr.p_double[i]; - ridx0 = ridx0+1; - } - } - } - - /* - * Compose ECA: either dense ECA or diagonal ECA - */ - if( (s->isactivesetchanged||s->ismaintermchanged)&&nfree>0 ) - { - if( ae_fp_greater(s->alpha,0) ) - { - - /* - * Dense ECA - */ - s->ecakind = 0; - for(i=0; i<=nfree-1; i++) - { - for(j=i; j<=nfree-1; j++) - { - s->ecadense.ptr.pp_double[i][j] = s->tq2dense.ptr.pp_double[i][j]; - } - } - if( !spdmatrixcholeskyrec(&s->ecadense, 0, nfree, ae_true, &s->tmp0, _state) ) - { - result = ae_false; - return result; - } - } - else - { - - /* - * Diagonal ECA - */ - s->ecakind = 1; - for(i=0; i<=nfree-1; i++) - { - if( ae_fp_less(s->tq2diag.ptr.p_double[i],0) ) - { - result = ae_false; - return result; - } - s->ecadiag.ptr.p_double[i] = ae_sqrt(s->tq2diag.ptr.p_double[i], _state); - } - } - } - - /* - * Compose EQ - */ - if( s->isactivesetchanged||s->issecondarytermchanged ) - { - for(i=0; i<=k-1; i++) - { - for(j=0; j<=nfree-1; j++) - { - s->eq.ptr.pp_double[i][j] = s->tk2.ptr.pp_double[i][j]; - } - } - } - - /* - * Calculate ECCM - */ - if( ((((s->isactivesetchanged||s->ismaintermchanged)||s->issecondarytermchanged)&&s->k>0)&&ae_fp_greater(s->theta,0))&&nfree>0 ) - { - - /* - * Calculate ECCM - Cholesky factor of the "effective" capacitance - * matrix CM = I + EQ*inv(EffectiveA)*EQ'. - * - * We calculate CM as follows: - * CM = I + EQ*inv(EffectiveA)*EQ' - * = I + EQ*ECA^(-1)*ECA^(-T)*EQ' - * = I + (EQ*ECA^(-1))*(EQ*ECA^(-1))' - * - * Then we perform Cholesky decomposition of CM. - */ - rmatrixsetlengthatleast(&s->tmp2, k, n, _state); - rmatrixcopy(k, nfree, &s->eq, 0, 0, &s->tmp2, 0, 0, _state); - ae_assert(s->ecakind==0||s->ecakind==1, "CQMRebuild: unexpected ECAKind", _state); - if( s->ecakind==0 ) - { - rmatrixrighttrsm(k, nfree, &s->ecadense, 0, 0, ae_true, ae_false, 0, &s->tmp2, 0, 0, _state); - } - if( s->ecakind==1 ) - { - for(i=0; i<=k-1; i++) - { - for(j=0; j<=nfree-1; j++) - { - s->tmp2.ptr.pp_double[i][j] = s->tmp2.ptr.pp_double[i][j]/s->ecadiag.ptr.p_double[j]; - } - } - } - for(i=0; i<=k-1; i++) - { - for(j=0; j<=k-1; j++) - { - s->eccm.ptr.pp_double[i][j] = 0.0; - } - s->eccm.ptr.pp_double[i][i] = 1.0; - } - rmatrixsyrk(k, nfree, 1.0, &s->tmp2, 0, 0, 0, 1.0, &s->eccm, 0, 0, ae_true, _state); - if( !spdmatrixcholeskyrec(&s->eccm, 0, k, ae_true, &s->tmp0, _state) ) - { - result = ae_false; - return result; - } - } - - /* - * Compose EB and EC - * - * NOTE: because these quantities are cheap to compute, we do not - * use caching here. - */ - for(i=0; i<=nfree-1; i++) - { - s->eb.ptr.p_double[i] = s->tq1.ptr.p_double[i]+s->tk1.ptr.p_double[i]+s->tb.ptr.p_double[i]; - } - s->ec = s->tq0+s->tk0; - for(i=nfree; i<=n-1; i++) - { - s->ec = s->ec+s->tb.ptr.p_double[i]*s->txc.ptr.p_double[i]; - } - - /* - * Change cache status - everything is cached - */ - s->ismaintermchanged = ae_false; - s->issecondarytermchanged = ae_false; - s->islineartermchanged = ae_false; - s->isactivesetchanged = ae_false; - return result; -} - - -/************************************************************************* -Internal function, solves system Effective_A*x = b. -It should be called after successful completion of CQMRebuild(). - -INPUT PARAMETERS: - S - quadratic model, after call to CQMRebuild() - X - right part B, array[S.NFree] - Tmp - temporary array, automatically reallocated if needed - -OUTPUT PARAMETERS: - X - solution, array[S.NFree] - -NOTE: when called with zero S.NFree, returns silently -NOTE: this function assumes that EA is non-degenerate - - -- ALGLIB -- - Copyright 10.05.2011 by Bochkanov Sergey -*************************************************************************/ -static void cqmodels_cqmsolveea(convexquadraticmodel* s, - /* Real */ ae_vector* x, - /* Real */ ae_vector* tmp, - ae_state *_state) -{ - ae_int_t i; - - - ae_assert((s->ecakind==0||s->ecakind==1)||(s->ecakind==-1&&s->nfree==0), "CQMSolveEA: unexpected ECAKind", _state); - if( s->ecakind==0 ) - { - - /* - * Dense ECA, use FBLSCholeskySolve() dense solver. - */ - fblscholeskysolve(&s->ecadense, 1.0, s->nfree, ae_true, x, tmp, _state); - } - if( s->ecakind==1 ) - { - - /* - * Diagonal ECA - */ - for(i=0; i<=s->nfree-1; i++) - { - x->ptr.p_double[i] = x->ptr.p_double[i]/ae_sqr(s->ecadiag.ptr.p_double[i], _state); - } - } -} - - -ae_bool _convexquadraticmodel_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - convexquadraticmodel *p = (convexquadraticmodel*)_p; - ae_touch_ptr((void*)p); - if( !ae_matrix_init(&p->a, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->q, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->b, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->r, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->xc, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->d, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->activeset, 0, DT_BOOL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->tq2dense, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->tk2, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->tq2diag, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->tq1, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->tk1, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->txc, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->tb, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->ecadense, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->eq, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->eccm, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->ecadiag, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->eb, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->tmp0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->tmp1, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->tmpg, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->tmp2, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _convexquadraticmodel_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - convexquadraticmodel *dst = (convexquadraticmodel*)_dst; - convexquadraticmodel *src = (convexquadraticmodel*)_src; - dst->n = src->n; - dst->k = src->k; - dst->alpha = src->alpha; - dst->tau = src->tau; - dst->theta = src->theta; - if( !ae_matrix_init_copy(&dst->a, &src->a, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->q, &src->q, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->b, &src->b, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->r, &src->r, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->xc, &src->xc, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->d, &src->d, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->activeset, &src->activeset, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->tq2dense, &src->tq2dense, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->tk2, &src->tk2, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->tq2diag, &src->tq2diag, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->tq1, &src->tq1, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->tk1, &src->tk1, _state, make_automatic) ) - return ae_false; - dst->tq0 = src->tq0; - dst->tk0 = src->tk0; - if( !ae_vector_init_copy(&dst->txc, &src->txc, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->tb, &src->tb, _state, make_automatic) ) - return ae_false; - dst->nfree = src->nfree; - dst->ecakind = src->ecakind; - if( !ae_matrix_init_copy(&dst->ecadense, &src->ecadense, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->eq, &src->eq, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->eccm, &src->eccm, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->ecadiag, &src->ecadiag, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->eb, &src->eb, _state, make_automatic) ) - return ae_false; - dst->ec = src->ec; - if( !ae_vector_init_copy(&dst->tmp0, &src->tmp0, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->tmp1, &src->tmp1, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->tmpg, &src->tmpg, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->tmp2, &src->tmp2, _state, make_automatic) ) - return ae_false; - dst->ismaintermchanged = src->ismaintermchanged; - dst->issecondarytermchanged = src->issecondarytermchanged; - dst->islineartermchanged = src->islineartermchanged; - dst->isactivesetchanged = src->isactivesetchanged; - return ae_true; -} - - -void _convexquadraticmodel_clear(void* _p) -{ - convexquadraticmodel *p = (convexquadraticmodel*)_p; - ae_touch_ptr((void*)p); - ae_matrix_clear(&p->a); - ae_matrix_clear(&p->q); - ae_vector_clear(&p->b); - ae_vector_clear(&p->r); - ae_vector_clear(&p->xc); - ae_vector_clear(&p->d); - ae_vector_clear(&p->activeset); - ae_matrix_clear(&p->tq2dense); - ae_matrix_clear(&p->tk2); - ae_vector_clear(&p->tq2diag); - ae_vector_clear(&p->tq1); - ae_vector_clear(&p->tk1); - ae_vector_clear(&p->txc); - ae_vector_clear(&p->tb); - ae_matrix_clear(&p->ecadense); - ae_matrix_clear(&p->eq); - ae_matrix_clear(&p->eccm); - ae_vector_clear(&p->ecadiag); - ae_vector_clear(&p->eb); - ae_vector_clear(&p->tmp0); - ae_vector_clear(&p->tmp1); - ae_vector_clear(&p->tmpg); - ae_matrix_clear(&p->tmp2); -} - - -void _convexquadraticmodel_destroy(void* _p) -{ - convexquadraticmodel *p = (convexquadraticmodel*)_p; - ae_touch_ptr((void*)p); - ae_matrix_destroy(&p->a); - ae_matrix_destroy(&p->q); - ae_vector_destroy(&p->b); - ae_vector_destroy(&p->r); - ae_vector_destroy(&p->xc); - ae_vector_destroy(&p->d); - ae_vector_destroy(&p->activeset); - ae_matrix_destroy(&p->tq2dense); - ae_matrix_destroy(&p->tk2); - ae_vector_destroy(&p->tq2diag); - ae_vector_destroy(&p->tq1); - ae_vector_destroy(&p->tk1); - ae_vector_destroy(&p->txc); - ae_vector_destroy(&p->tb); - ae_matrix_destroy(&p->ecadense); - ae_matrix_destroy(&p->eq); - ae_matrix_destroy(&p->eccm); - ae_vector_destroy(&p->ecadiag); - ae_vector_destroy(&p->eb); - ae_vector_destroy(&p->tmp0); - ae_vector_destroy(&p->tmp1); - ae_vector_destroy(&p->tmpg); - ae_matrix_destroy(&p->tmp2); -} - - - - -/************************************************************************* -This subroutine is used to initialize SNNLS solver. - -By default, empty NNLS problem is produced, but we allocated enough space -to store problems with NSMax+NDMax columns and NRMax rows. It is good -place to provide algorithm with initial estimate of the space requirements, -although you may underestimate problem size or even pass zero estimates - -in this case buffer variables will be resized automatically when you set -NNLS problem. - -Previously allocated buffer variables are reused as much as possible. This -function does not clear structure completely, it tries to preserve as much -dynamically allocated memory as possible. - - -- ALGLIB -- - Copyright 10.10.2012 by Bochkanov Sergey -*************************************************************************/ -void snnlsinit(ae_int_t nsmax, - ae_int_t ndmax, - ae_int_t nrmax, - snnlssolver* s, - ae_state *_state) -{ - - - s->ns = 0; - s->nd = 0; - s->nr = 0; - rmatrixsetlengthatleast(&s->densea, nrmax, ndmax, _state); - rmatrixsetlengthatleast(&s->tmpca, nrmax, ndmax, _state); - rmatrixsetlengthatleast(&s->tmpz, ndmax, ndmax, _state); - rvectorsetlengthatleast(&s->b, nrmax, _state); - bvectorsetlengthatleast(&s->nnc, nsmax+ndmax, _state); - s->debugflops = 0.0; - s->debugmaxnewton = 0; - s->refinementits = snnls_iterativerefinementits; -} - - -/************************************************************************* -This subroutine is used to set NNLS problem: - - ( [ 1 | ] [ ] [ ] )^2 - ( [ 1 | ] [ ] [ ] ) - min ( [ 1 | Ad ] * [ x ] - [ b ] ) s.t. x>=0 - ( [ | ] [ ] [ ] ) - ( [ | ] [ ] [ ] ) - -where: -* identity matrix has NS*NS size (NS<=NR, NS can be zero) -* dense matrix Ad has NR*ND size -* b is NR*1 vector -* x is (NS+ND)*1 vector -* all elements of x are non-negative (this constraint can be removed later - by calling SNNLSDropNNC() function) - -Previously allocated buffer variables are reused as much as possible. -After you set problem, you can solve it with SNNLSSolve(). - -INPUT PARAMETERS: - S - SNNLS solver, must be initialized with SNNLSInit() call - A - array[NR,ND], dense part of the system - B - array[NR], right part - NS - size of the sparse part of the system, 0<=NS<=NR - ND - size of the dense part of the system, ND>=0 - NR - rows count, NR>0 - -NOTE: - 1. You can have NS+ND=0, solver will correctly accept such combination - and return empty array as problem solution. - - -- ALGLIB -- - Copyright 10.10.2012 by Bochkanov Sergey -*************************************************************************/ -void snnlssetproblem(snnlssolver* s, - /* Real */ ae_matrix* a, - /* Real */ ae_vector* b, - ae_int_t ns, - ae_int_t nd, - ae_int_t nr, - ae_state *_state) -{ - ae_int_t i; - - - ae_assert(nd>=0, "SNNLSSetProblem: ND<0", _state); - ae_assert(ns>=0, "SNNLSSetProblem: NS<0", _state); - ae_assert(nr>0, "SNNLSSetProblem: NR<=0", _state); - ae_assert(ns<=nr, "SNNLSSetProblem: NS>NR", _state); - ae_assert(a->rows>=nr||nd==0, "SNNLSSetProblem: rows(A)cols>=nd, "SNNLSSetProblem: cols(A)cnt>=nr, "SNNLSSetProblem: length(B)ns = ns; - s->nd = nd; - s->nr = nr; - if( nd>0 ) - { - rmatrixsetlengthatleast(&s->densea, nr, nd, _state); - for(i=0; i<=nr-1; i++) - { - ae_v_move(&s->densea.ptr.pp_double[i][0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,nd-1)); - } - } - rvectorsetlengthatleast(&s->b, nr, _state); - ae_v_move(&s->b.ptr.p_double[0], 1, &b->ptr.p_double[0], 1, ae_v_len(0,nr-1)); - bvectorsetlengthatleast(&s->nnc, ns+nd, _state); - for(i=0; i<=ns+nd-1; i++) - { - s->nnc.ptr.p_bool[i] = ae_true; - } -} - - -/************************************************************************* -This subroutine drops non-negativity constraint from the problem set by -SNNLSSetProblem() call. This function must be called AFTER problem is set, -because each SetProblem() call resets constraints to their default state -(all constraints are present). - -INPUT PARAMETERS: - S - SNNLS solver, must be initialized with SNNLSInit() call, - problem must be set with SNNLSSetProblem() call. - Idx - constraint index, 0<=IDX=0, "SNNLSDropNNC: Idx<0", _state); - ae_assert(idxns+s->nd, "SNNLSDropNNC: Idx>=NS+ND", _state); - s->nnc.ptr.p_bool[idx] = ae_false; -} - - -/************************************************************************* -This subroutine is used to solve NNLS problem. - -INPUT PARAMETERS: - S - SNNLS solver, must be initialized with SNNLSInit() call and - problem must be set up with SNNLSSetProblem() call. - X - possibly preallocated buffer, automatically resized if needed - -OUTPUT PARAMETERS: - X - array[NS+ND], solution - -NOTE: - 1. You can have NS+ND=0, solver will correctly accept such combination - and return empty array as problem solution. - - 2. Internal field S.DebugFLOPS contains rough estimate of FLOPs used - to solve problem. It can be used for debugging purposes. This field - is real-valued. - - -- ALGLIB -- - Copyright 10.10.2012 by Bochkanov Sergey -*************************************************************************/ -void snnlssolve(snnlssolver* s, - /* Real */ ae_vector* x, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t ns; - ae_int_t nd; - ae_int_t nr; - ae_int_t nsc; - ae_int_t ndc; - ae_int_t newtoncnt; - ae_bool terminationneeded; - double eps; - double fcur; - double fprev; - double fcand; - double noiselevel; - double noisetolerance; - double stplen; - double d2; - double d1; - double d0; - ae_bool wasactivation; - ae_int_t rfsits; - double lambdav; - double v0; - double v1; - double v; - - - - /* - * Prepare - */ - ns = s->ns; - nd = s->nd; - nr = s->nr; - s->debugflops = 0.0; - - /* - * Handle special cases: - * * NS+ND=0 - * * ND=0 - */ - if( ns+nd==0 ) - { - return; - } - if( nd==0 ) - { - rvectorsetlengthatleast(x, ns, _state); - for(i=0; i<=ns-1; i++) - { - x->ptr.p_double[i] = s->b.ptr.p_double[i]; - if( s->nnc.ptr.p_bool[i] ) - { - x->ptr.p_double[i] = ae_maxreal(x->ptr.p_double[i], 0.0, _state); - } - } - return; - } - - /* - * Main cycle of BLEIC-SNNLS algorithm. - * Below we assume that ND>0. - */ - rvectorsetlengthatleast(x, ns+nd, _state); - rvectorsetlengthatleast(&s->xn, ns+nd, _state); - rvectorsetlengthatleast(&s->g, ns+nd, _state); - rvectorsetlengthatleast(&s->d, ns+nd, _state); - rvectorsetlengthatleast(&s->r, nr, _state); - rvectorsetlengthatleast(&s->diagaa, nd, _state); - rvectorsetlengthatleast(&s->dx, ns+nd, _state); - for(i=0; i<=ns+nd-1; i++) - { - x->ptr.p_double[i] = 0.0; - } - eps = 2*ae_machineepsilon; - noisetolerance = 10.0; - lambdav = 1.0E6*ae_machineepsilon; - newtoncnt = 0; - for(;;) - { - - /* - * Phase 1: perform steepest descent step. - * - * TerminationNeeded control variable is set on exit from this loop: - * * TerminationNeeded=False in case we have to proceed to Phase 2 (Newton step) - * * TerminationNeeded=True in case we found solution (step along projected gradient is small enough) - * - * Temporaries used: - * * R (I|A)*x-b - * - * NOTE 1. It is assumed that initial point X is feasible. This feasibility - * is retained during all iterations. - */ - terminationneeded = ae_false; - for(;;) - { - - /* - * Calculate gradient G and constrained descent direction D - */ - for(i=0; i<=nr-1; i++) - { - v = ae_v_dotproduct(&s->densea.ptr.pp_double[i][0], 1, &x->ptr.p_double[ns], 1, ae_v_len(0,nd-1)); - if( iptr.p_double[i]; - } - s->r.ptr.p_double[i] = v-s->b.ptr.p_double[i]; - } - for(i=0; i<=ns-1; i++) - { - s->g.ptr.p_double[i] = s->r.ptr.p_double[i]; - } - for(i=ns; i<=ns+nd-1; i++) - { - s->g.ptr.p_double[i] = 0.0; - } - for(i=0; i<=nr-1; i++) - { - v = s->r.ptr.p_double[i]; - ae_v_addd(&s->g.ptr.p_double[ns], 1, &s->densea.ptr.pp_double[i][0], 1, ae_v_len(ns,ns+nd-1), v); - } - for(i=0; i<=ns+nd-1; i++) - { - if( (s->nnc.ptr.p_bool[i]&&ae_fp_less_eq(x->ptr.p_double[i],0))&&ae_fp_greater(s->g.ptr.p_double[i],0) ) - { - s->d.ptr.p_double[i] = 0.0; - } - else - { - s->d.ptr.p_double[i] = -s->g.ptr.p_double[i]; - } - } - s->debugflops = s->debugflops+2*2*nr*nd; - - /* - * Build quadratic model of F along descent direction: - * F(x+alpha*d) = D2*alpha^2 + D1*alpha + D0 - * - * Estimate numerical noise in the X (noise level is used - * to classify step as singificant or insignificant). Noise - * comes from two sources: - * * noise when calculating rows of (I|A)*x - * * noise when calculating norm of residual - * - * In case function curvature is negative or product of descent - * direction and gradient is non-negative, iterations are terminated. - * - * NOTE: D0 is not actually used, but we prefer to maintain it. - */ - fprev = ae_v_dotproduct(&s->r.ptr.p_double[0], 1, &s->r.ptr.p_double[0], 1, ae_v_len(0,nr-1)); - fprev = fprev/2; - noiselevel = 0.0; - for(i=0; i<=nr-1; i++) - { - - /* - * Estimate noise introduced by I-th row of (I|A)*x - */ - v = 0.0; - if( iptr.p_double[i]; - } - for(j=0; j<=nd-1; j++) - { - v = ae_maxreal(v, eps*ae_fabs(s->densea.ptr.pp_double[i][j]*x->ptr.p_double[ns+j], _state), _state); - } - v = 2*ae_fabs(s->r.ptr.p_double[i]*v, _state)+v*v; - - /* - * Add to summary noise in the model - */ - noiselevel = noiselevel+v; - } - noiselevel = ae_maxreal(noiselevel, eps*fprev, _state); - d2 = 0.0; - for(i=0; i<=nr-1; i++) - { - v = ae_v_dotproduct(&s->densea.ptr.pp_double[i][0], 1, &s->d.ptr.p_double[ns], 1, ae_v_len(0,nd-1)); - if( id.ptr.p_double[i]; - } - d2 = d2+0.5*ae_sqr(v, _state); - } - v = ae_v_dotproduct(&s->d.ptr.p_double[0], 1, &s->g.ptr.p_double[0], 1, ae_v_len(0,ns+nd-1)); - d1 = v; - d0 = fprev; - if( ae_fp_less_eq(d2,0)||ae_fp_greater_eq(d1,0) ) - { - terminationneeded = ae_true; - break; - } - s->debugflops = s->debugflops+2*nr*nd; - touchreal(&d0, _state); - - /* - * Perform full (unconstrained) step with length StpLen in direction D. - * - * We can terminate iterations in case one of two criteria is met: - * 1. function change is dominated by noise (or function actually increased - * instead of decreasing) - * 2. relative change in X is small enough - * - * First condition is not enough to guarantee algorithm termination because - * sometimes our noise estimate is too optimistic (say, in situations when - * function value at solition is zero). - */ - stplen = -d1/(2*d2); - ae_v_move(&s->xn.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,ns+nd-1)); - ae_v_addd(&s->xn.ptr.p_double[0], 1, &s->d.ptr.p_double[0], 1, ae_v_len(0,ns+nd-1), stplen); - fcand = 0.0; - for(i=0; i<=nr-1; i++) - { - v = ae_v_dotproduct(&s->densea.ptr.pp_double[i][0], 1, &s->xn.ptr.p_double[ns], 1, ae_v_len(0,nd-1)); - if( ixn.ptr.p_double[i]; - } - fcand = fcand+0.5*ae_sqr(v-s->b.ptr.p_double[i], _state); - } - s->debugflops = s->debugflops+2*nr*nd; - if( ae_fp_greater_eq(fcand,fprev-noiselevel*noisetolerance) ) - { - terminationneeded = ae_true; - break; - } - v = 0; - for(i=0; i<=ns+nd-1; i++) - { - v0 = ae_fabs(x->ptr.p_double[i], _state); - v1 = ae_fabs(s->xn.ptr.p_double[i], _state); - if( ae_fp_neq(v0,0)||ae_fp_neq(v1,0) ) - { - v = ae_maxreal(v, ae_fabs(x->ptr.p_double[i]-s->xn.ptr.p_double[i], _state)/ae_maxreal(v0, v1, _state), _state); - } - } - if( ae_fp_less_eq(v,eps*noisetolerance) ) - { - terminationneeded = ae_true; - break; - } - - /* - * Perform step one more time, now with non-negativity constraints. - * - * NOTE: complicated code below which deals with VarIdx temporary makes - * sure that in case unconstrained step leads us outside of feasible - * area, we activate at least one constraint. - */ - wasactivation = snnls_boundedstepandactivation(x, &s->xn, &s->nnc, ns+nd, _state); - fcur = 0.0; - for(i=0; i<=nr-1; i++) - { - v = ae_v_dotproduct(&s->densea.ptr.pp_double[i][0], 1, &x->ptr.p_double[ns], 1, ae_v_len(0,nd-1)); - if( iptr.p_double[i]; - } - fcur = fcur+0.5*ae_sqr(v-s->b.ptr.p_double[i], _state); - } - s->debugflops = s->debugflops+2*nr*nd; - - /* - * Depending on results, decide what to do: - * 1. In case step was performed without activation of constraints, - * we proceed to Newton method - * 2. In case there was activated at least one constraint, we repeat - * steepest descent step. - */ - if( !wasactivation ) - { - - /* - * Step without activation, proceed to Newton - */ - break; - } - } - if( terminationneeded ) - { - break; - } - - /* - * Phase 2: Newton method. - */ - rvectorsetlengthatleast(&s->cx, ns+nd, _state); - ivectorsetlengthatleast(&s->columnmap, ns+nd, _state); - ivectorsetlengthatleast(&s->rowmap, nr, _state); - rmatrixsetlengthatleast(&s->tmpca, nr, nd, _state); - rmatrixsetlengthatleast(&s->tmpz, nd, nd, _state); - rvectorsetlengthatleast(&s->cborg, nr, _state); - rvectorsetlengthatleast(&s->cb, nr, _state); - terminationneeded = ae_false; - for(;;) - { - - /* - * Prepare equality constrained subproblem with NSC<=NS "sparse" - * variables and NDC<=ND "dense" variables. - * - * First, we reorder variables (columns) and move all unconstrained - * variables "to the left", ColumnMap stores this permutation. - * - * Then, we reorder first NS rows of A and first NS elements of B in - * such way that we still have identity matrix in first NSC columns - * of problem. This permutation is stored in RowMap. - */ - nsc = 0; - ndc = 0; - for(i=0; i<=ns-1; i++) - { - if( !(s->nnc.ptr.p_bool[i]&&ae_fp_eq(x->ptr.p_double[i],0)) ) - { - s->columnmap.ptr.p_int[nsc] = i; - nsc = nsc+1; - } - } - for(i=ns; i<=ns+nd-1; i++) - { - if( !(s->nnc.ptr.p_bool[i]&&ae_fp_eq(x->ptr.p_double[i],0)) ) - { - s->columnmap.ptr.p_int[nsc+ndc] = i; - ndc = ndc+1; - } - } - for(i=0; i<=nsc-1; i++) - { - s->rowmap.ptr.p_int[i] = s->columnmap.ptr.p_int[i]; - } - j = nsc; - for(i=0; i<=ns-1; i++) - { - if( s->nnc.ptr.p_bool[i]&&ae_fp_eq(x->ptr.p_double[i],0) ) - { - s->rowmap.ptr.p_int[j] = i; - j = j+1; - } - } - for(i=ns; i<=nr-1; i++) - { - s->rowmap.ptr.p_int[i] = i; - } - - /* - * Now, permutations are ready, and we can copy/reorder - * A, B and X to CA, CB and CX. - */ - for(i=0; i<=nsc+ndc-1; i++) - { - s->cx.ptr.p_double[i] = x->ptr.p_double[s->columnmap.ptr.p_int[i]]; - } - for(i=0; i<=nr-1; i++) - { - for(j=0; j<=ndc-1; j++) - { - s->tmpca.ptr.pp_double[i][j] = s->densea.ptr.pp_double[s->rowmap.ptr.p_int[i]][s->columnmap.ptr.p_int[nsc+j]-ns]; - } - s->cb.ptr.p_double[i] = s->b.ptr.p_double[s->rowmap.ptr.p_int[i]]; - } - - /* - * Solve equality constrained subproblem. - */ - if( ndc>0 ) - { - - /* - * NDC>0. - * - * Solve subproblem using Newton-type algorithm. We have a - * NR*(NSC+NDC) linear least squares subproblem - * - * | ( I AU ) ( XU ) ( BU ) |^2 - * min | ( ) * ( ) - ( ) | - * | ( 0 AL ) ( XL ) ( BL ) | - * - * where: - * * I is a NSC*NSC identity matrix - * * AU is NSC*NDC dense matrix (first NSC rows of CA) - * * AL is (NR-NSC)*NDC dense matrix (next NR-NSC rows of CA) - * * BU and BL are correspondingly sized parts of CB - * - * After conversion to normal equations and small regularization, - * we get: - * - * ( I AU ) ( XU ) ( BU ) - * ( )*( ) = ( ) - * ( AU' Y ) ( XL ) ( AU'*BU+AL'*BL ) - * - * where Y = AU'*AU + AL'*AL + lambda*diag(AU'*AU+AL'*AL). - * - * With Schur Complement Method this system can be solved in - * O(NR*NDC^2+NDC^3) operations. In order to solve it we multiply - * first row by AU' and subtract it from the second one. As result, - * we get system - * - * Z*XL = AL'*BL, where Z=AL'*AL+lambda*diag(AU'*AU+AL'*AL) - * - * We can easily solve it for XL, and we can get XU as XU = BU-AU*XL. - * - * We will start solution from calculating Cholesky decomposition of Z. - */ - for(i=0; i<=nr-1; i++) - { - s->cborg.ptr.p_double[i] = s->cb.ptr.p_double[i]; - } - for(i=0; i<=ndc-1; i++) - { - s->diagaa.ptr.p_double[i] = 0; - } - for(i=0; i<=nr-1; i++) - { - for(j=0; j<=ndc-1; j++) - { - s->diagaa.ptr.p_double[j] = s->diagaa.ptr.p_double[j]+ae_sqr(s->tmpca.ptr.pp_double[i][j], _state); - } - } - for(j=0; j<=ndc-1; j++) - { - if( ae_fp_eq(s->diagaa.ptr.p_double[j],0) ) - { - s->diagaa.ptr.p_double[j] = 1; - } - } - for(;;) - { - - /* - * NOTE: we try to factorize Z. In case of failure we increase - * regularization parameter and try again. - */ - s->debugflops = s->debugflops+2*(nr-nsc)*ae_sqr(ndc, _state)+ae_pow(ndc, 3, _state)/3; - for(i=0; i<=ndc-1; i++) - { - for(j=0; j<=ndc-1; j++) - { - s->tmpz.ptr.pp_double[i][j] = 0.0; - } - } - rmatrixsyrk(ndc, nr-nsc, 1.0, &s->tmpca, nsc, 0, 2, 0.0, &s->tmpz, 0, 0, ae_true, _state); - for(i=0; i<=ndc-1; i++) - { - s->tmpz.ptr.pp_double[i][i] = s->tmpz.ptr.pp_double[i][i]+lambdav*s->diagaa.ptr.p_double[i]; - } - if( spdmatrixcholeskyrec(&s->tmpz, 0, ndc, ae_true, &s->tmpcholesky, _state) ) - { - break; - } - lambdav = lambdav*10; - } - - /* - * We have Cholesky decomposition of Z, now we can solve system: - * * we start from initial point CX - * * we perform several iterations of refinement: - * * BU_new := BU_orig - XU_cur - AU*XL_cur - * * BL_new := BL_orig - AL*XL_cur - * * solve for BU_new/BL_new, obtain solution dx - * * XU_cur := XU_cur + dx_u - * * XL_cur := XL_cur + dx_l - * * BU_new/BL_new are stored in CB, original right part is - * stored in CBOrg, correction to X is stored in DX, current - * X is stored in CX - */ - for(rfsits=1; rfsits<=s->refinementits; rfsits++) - { - for(i=0; i<=nr-1; i++) - { - v = ae_v_dotproduct(&s->tmpca.ptr.pp_double[i][0], 1, &s->cx.ptr.p_double[nsc], 1, ae_v_len(0,ndc-1)); - s->cb.ptr.p_double[i] = s->cborg.ptr.p_double[i]-v; - if( icb.ptr.p_double[i] = s->cb.ptr.p_double[i]-s->cx.ptr.p_double[i]; - } - } - s->debugflops = s->debugflops+2*nr*ndc; - for(i=0; i<=ndc-1; i++) - { - s->dx.ptr.p_double[i] = 0.0; - } - for(i=nsc; i<=nr-1; i++) - { - v = s->cb.ptr.p_double[i]; - ae_v_addd(&s->dx.ptr.p_double[0], 1, &s->tmpca.ptr.pp_double[i][0], 1, ae_v_len(0,ndc-1), v); - } - fblscholeskysolve(&s->tmpz, 1.0, ndc, ae_true, &s->dx, &s->tmpcholesky, _state); - s->debugflops = s->debugflops+2*ndc*ndc; - ae_v_add(&s->cx.ptr.p_double[nsc], 1, &s->dx.ptr.p_double[0], 1, ae_v_len(nsc,nsc+ndc-1)); - for(i=0; i<=nsc-1; i++) - { - v = ae_v_dotproduct(&s->tmpca.ptr.pp_double[i][0], 1, &s->dx.ptr.p_double[0], 1, ae_v_len(0,ndc-1)); - s->cx.ptr.p_double[i] = s->cx.ptr.p_double[i]+s->cb.ptr.p_double[i]-v; - } - s->debugflops = s->debugflops+2*nsc*ndc; - } - } - else - { - - /* - * NDC=0. - * - * We have a NR*NSC linear least squares subproblem - * - * min |XU-BU|^2 - * - * solution is easy to find - it is XU=BU! - */ - for(i=0; i<=nsc-1; i++) - { - s->cx.ptr.p_double[i] = s->cb.ptr.p_double[i]; - } - } - for(i=0; i<=ns+nd-1; i++) - { - s->xn.ptr.p_double[i] = x->ptr.p_double[i]; - } - for(i=0; i<=nsc+ndc-1; i++) - { - s->xn.ptr.p_double[s->columnmap.ptr.p_int[i]] = s->cx.ptr.p_double[i]; - } - newtoncnt = newtoncnt+1; - - /* - * Step to candidate point. - * If no constraints was added, accept candidate point XN and move to next phase. - * Terminate, if number of Newton iterations exceeded DebugMaxNewton counter. - */ - terminationneeded = s->debugmaxnewton>0&&newtoncnt>=s->debugmaxnewton; - if( !snnls_boundedstepandactivation(x, &s->xn, &s->nnc, ns+nd, _state) ) - { - break; - } - if( terminationneeded ) - { - break; - } - } - if( terminationneeded ) - { - break; - } - } -} - - -/************************************************************************* -Having feasible current point XC and possibly infeasible candidate point -XN, this function performs longest step from XC to XN which retains -feasibility. In case XN is found to be infeasible, at least one constraint -is activated. - -For example, if we have: - XC=0.5 - XN=-1.2 - x>=0 -then this function will move us to X=0 and activate constraint "x>=0". - -INPUT PARAMETERS: - XC - current point, must be feasible with respect to - all constraints - XN - candidate point, can be infeasible with respect to some - constraints - NNC - NNC[i] is True when I-th variable is non-negatively - constrained - N - variable count - -OUTPUT PARAMETERS: - XC - new position - -RESULT: - True in case at least one constraint was activated by step - - -- ALGLIB -- - Copyright 19.10.2012 by Bochkanov Sergey -*************************************************************************/ -static ae_bool snnls_boundedstepandactivation(/* Real */ ae_vector* xc, - /* Real */ ae_vector* xn, - /* Boolean */ ae_vector* nnc, - ae_int_t n, - ae_state *_state) -{ - ae_int_t i; - ae_int_t varidx; - double vmax; - double v; - double stplen; - ae_bool result; - - - - /* - * Check constraints. - * - * NOTE: it is important to test for XN[i]ptr.p_bool[i]&&ae_fp_less(xn->ptr.p_double[i],xc->ptr.p_double[i]))&&ae_fp_less_eq(xn->ptr.p_double[i],0.0) ) - { - v = vmax; - vmax = safeminposrv(xc->ptr.p_double[i], xc->ptr.p_double[i]-xn->ptr.p_double[i], vmax, _state); - if( ae_fp_less(vmax,v) ) - { - varidx = i; - } - } - } - stplen = ae_minreal(vmax, 1.0, _state); - - /* - * Perform step with activation. - * - * NOTE: it is important to use (1-StpLen)*XC + StpLen*XN because - * it allows us to step exactly to XN when StpLen=1, even in - * the presence of numerical errors. - */ - for(i=0; i<=n-1; i++) - { - xc->ptr.p_double[i] = (1-stplen)*xc->ptr.p_double[i]+stplen*xn->ptr.p_double[i]; - } - if( varidx>=0 ) - { - xc->ptr.p_double[varidx] = 0.0; - result = ae_true; - } - for(i=0; i<=n-1; i++) - { - if( nnc->ptr.p_bool[i]&&ae_fp_less(xc->ptr.p_double[i],0.0) ) - { - xc->ptr.p_double[i] = 0.0; - result = ae_true; - } - } - return result; -} - - -ae_bool _snnlssolver_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - snnlssolver *p = (snnlssolver*)_p; - ae_touch_ptr((void*)p); - if( !ae_matrix_init(&p->densea, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->b, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->nnc, 0, DT_BOOL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->xn, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->tmpz, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->tmpca, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->g, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->d, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->dx, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->diagaa, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->cb, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->cx, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->cborg, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->columnmap, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->rowmap, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->tmpcholesky, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->r, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _snnlssolver_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - snnlssolver *dst = (snnlssolver*)_dst; - snnlssolver *src = (snnlssolver*)_src; - dst->ns = src->ns; - dst->nd = src->nd; - dst->nr = src->nr; - if( !ae_matrix_init_copy(&dst->densea, &src->densea, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->b, &src->b, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->nnc, &src->nnc, _state, make_automatic) ) - return ae_false; - dst->refinementits = src->refinementits; - dst->debugflops = src->debugflops; - dst->debugmaxnewton = src->debugmaxnewton; - if( !ae_vector_init_copy(&dst->xn, &src->xn, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->tmpz, &src->tmpz, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->tmpca, &src->tmpca, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->g, &src->g, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->d, &src->d, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->dx, &src->dx, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->diagaa, &src->diagaa, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->cb, &src->cb, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->cx, &src->cx, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->cborg, &src->cborg, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->columnmap, &src->columnmap, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->rowmap, &src->rowmap, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->tmpcholesky, &src->tmpcholesky, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->r, &src->r, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _snnlssolver_clear(void* _p) -{ - snnlssolver *p = (snnlssolver*)_p; - ae_touch_ptr((void*)p); - ae_matrix_clear(&p->densea); - ae_vector_clear(&p->b); - ae_vector_clear(&p->nnc); - ae_vector_clear(&p->xn); - ae_matrix_clear(&p->tmpz); - ae_matrix_clear(&p->tmpca); - ae_vector_clear(&p->g); - ae_vector_clear(&p->d); - ae_vector_clear(&p->dx); - ae_vector_clear(&p->diagaa); - ae_vector_clear(&p->cb); - ae_vector_clear(&p->cx); - ae_vector_clear(&p->cborg); - ae_vector_clear(&p->columnmap); - ae_vector_clear(&p->rowmap); - ae_vector_clear(&p->tmpcholesky); - ae_vector_clear(&p->r); -} - - -void _snnlssolver_destroy(void* _p) -{ - snnlssolver *p = (snnlssolver*)_p; - ae_touch_ptr((void*)p); - ae_matrix_destroy(&p->densea); - ae_vector_destroy(&p->b); - ae_vector_destroy(&p->nnc); - ae_vector_destroy(&p->xn); - ae_matrix_destroy(&p->tmpz); - ae_matrix_destroy(&p->tmpca); - ae_vector_destroy(&p->g); - ae_vector_destroy(&p->d); - ae_vector_destroy(&p->dx); - ae_vector_destroy(&p->diagaa); - ae_vector_destroy(&p->cb); - ae_vector_destroy(&p->cx); - ae_vector_destroy(&p->cborg); - ae_vector_destroy(&p->columnmap); - ae_vector_destroy(&p->rowmap); - ae_vector_destroy(&p->tmpcholesky); - ae_vector_destroy(&p->r); -} - - - - -/************************************************************************* -This subroutine is used to initialize active set. By default, empty -N-variable model with no constraints is generated. Previously allocated -buffer variables are reused as much as possible. - -Two use cases for this object are described below. - -CASE 1 - STEEPEST DESCENT: - - SASInit() - repeat: - SASReactivateConstraints() - SASDescentDirection() - SASExploreDirection() - SASMoveTo() - until convergence - -CASE 1 - PRECONDITIONED STEEPEST DESCENT: - - SASInit() - repeat: - SASReactivateConstraintsPrec() - SASDescentDirectionPrec() - SASExploreDirection() - SASMoveTo() - until convergence - - -- ALGLIB -- - Copyright 21.12.2012 by Bochkanov Sergey -*************************************************************************/ -void sasinit(ae_int_t n, sactiveset* s, ae_state *_state) -{ - ae_int_t i; - - - s->n = n; - s->algostate = 0; - - /* - * Constraints - */ - s->constraintschanged = ae_true; - s->nec = 0; - s->nic = 0; - rvectorsetlengthatleast(&s->bndl, n, _state); - bvectorsetlengthatleast(&s->hasbndl, n, _state); - rvectorsetlengthatleast(&s->bndu, n, _state); - bvectorsetlengthatleast(&s->hasbndu, n, _state); - for(i=0; i<=n-1; i++) - { - s->bndl.ptr.p_double[i] = _state->v_neginf; - s->bndu.ptr.p_double[i] = _state->v_posinf; - s->hasbndl.ptr.p_bool[i] = ae_false; - s->hasbndu.ptr.p_bool[i] = ae_false; - } - - /* - * current point, scale - */ - s->hasxc = ae_false; - rvectorsetlengthatleast(&s->xc, n, _state); - rvectorsetlengthatleast(&s->s, n, _state); - rvectorsetlengthatleast(&s->h, n, _state); - for(i=0; i<=n-1; i++) - { - s->xc.ptr.p_double[i] = 0.0; - s->s.ptr.p_double[i] = 1.0; - s->h.ptr.p_double[i] = 1.0; - } - - /* - * Other - */ - rvectorsetlengthatleast(&s->unitdiagonal, n, _state); - for(i=0; i<=n-1; i++) - { - s->unitdiagonal.ptr.p_double[i] = 1.0; - } -} - - -/************************************************************************* -This function sets scaling coefficients for SAS object. - -ALGLIB optimizers use scaling matrices to test stopping conditions (step -size and gradient are scaled before comparison with tolerances). Scale of -the I-th variable is a translation invariant measure of: -a) "how large" the variable is -b) how large the step should be to make significant changes in the function - -During orthogonalization phase, scale is used to calculate drop tolerances -(whether vector is significantly non-zero or not). - -INPUT PARAMETERS: - State - structure stores algorithm state - S - array[N], non-zero scaling coefficients - S[i] may be negative, sign doesn't matter. - - -- ALGLIB -- - Copyright 21.12.2012 by Bochkanov Sergey -*************************************************************************/ -void sassetscale(sactiveset* state, - /* Real */ ae_vector* s, - ae_state *_state) -{ - ae_int_t i; - - - ae_assert(state->algostate==0, "SASSetScale: you may change scale only in modification mode", _state); - ae_assert(s->cnt>=state->n, "SASSetScale: Length(S)n-1; i++) - { - ae_assert(ae_isfinite(s->ptr.p_double[i], _state), "SASSetScale: S contains infinite or NAN elements", _state); - ae_assert(ae_fp_neq(s->ptr.p_double[i],0), "SASSetScale: S contains zero elements", _state); - } - for(i=0; i<=state->n-1; i++) - { - state->s.ptr.p_double[i] = ae_fabs(s->ptr.p_double[i], _state); - } -} - - -/************************************************************************* -Modification of the preconditioner: diagonal of approximate Hessian is -used. - -INPUT PARAMETERS: - State - structure which stores algorithm state - D - diagonal of the approximate Hessian, array[0..N-1], - (if larger, only leading N elements are used). - -NOTE 1: D[i] should be positive. Exception will be thrown otherwise. - -NOTE 2: you should pass diagonal of approximate Hessian - NOT ITS INVERSE. - - -- ALGLIB -- - Copyright 21.12.2012 by Bochkanov Sergey -*************************************************************************/ -void sassetprecdiag(sactiveset* state, - /* Real */ ae_vector* d, - ae_state *_state) -{ - ae_int_t i; - - - ae_assert(state->algostate==0, "SASSetPrecDiag: you may change preconditioner only in modification mode", _state); - ae_assert(d->cnt>=state->n, "SASSetPrecDiag: D is too short", _state); - for(i=0; i<=state->n-1; i++) - { - ae_assert(ae_isfinite(d->ptr.p_double[i], _state), "SASSetPrecDiag: D contains infinite or NAN elements", _state); - ae_assert(ae_fp_greater(d->ptr.p_double[i],0), "SASSetPrecDiag: D contains non-positive elements", _state); - } - for(i=0; i<=state->n-1; i++) - { - state->h.ptr.p_double[i] = d->ptr.p_double[i]; - } -} - - -/************************************************************************* -This function sets/changes boundary constraints. - -INPUT PARAMETERS: - State - structure stores algorithm state - BndL - lower bounds, array[N]. - If some (all) variables are unbounded, you may specify - very small number or -INF. - BndU - upper bounds, array[N]. - If some (all) variables are unbounded, you may specify - very large number or +INF. - -NOTE 1: it is possible to specify BndL[i]=BndU[i]. In this case I-th -variable will be "frozen" at X[i]=BndL[i]=BndU[i]. - - -- ALGLIB -- - Copyright 21.12.2012 by Bochkanov Sergey -*************************************************************************/ -void sassetbc(sactiveset* state, - /* Real */ ae_vector* bndl, - /* Real */ ae_vector* bndu, - ae_state *_state) -{ - ae_int_t i; - ae_int_t n; - - - ae_assert(state->algostate==0, "SASSetBC: you may change constraints only in modification mode", _state); - n = state->n; - ae_assert(bndl->cnt>=n, "SASSetBC: Length(BndL)cnt>=n, "SASSetBC: Length(BndU)ptr.p_double[i], _state)||ae_isneginf(bndl->ptr.p_double[i], _state), "SASSetBC: BndL contains NAN or +INF", _state); - ae_assert(ae_isfinite(bndu->ptr.p_double[i], _state)||ae_isposinf(bndu->ptr.p_double[i], _state), "SASSetBC: BndL contains NAN or -INF", _state); - state->bndl.ptr.p_double[i] = bndl->ptr.p_double[i]; - state->hasbndl.ptr.p_bool[i] = ae_isfinite(bndl->ptr.p_double[i], _state); - state->bndu.ptr.p_double[i] = bndu->ptr.p_double[i]; - state->hasbndu.ptr.p_bool[i] = ae_isfinite(bndu->ptr.p_double[i], _state); - } - state->constraintschanged = ae_true; -} - - -/************************************************************************* -This function sets linear constraints for SAS object. - -Linear constraints are inactive by default (after initial creation). - -INPUT PARAMETERS: - State - SAS structure - C - linear constraints, array[K,N+1]. - Each row of C represents one constraint, either equality - or inequality (see below): - * first N elements correspond to coefficients, - * last element corresponds to the right part. - All elements of C (including right part) must be finite. - CT - type of constraints, array[K]: - * if CT[i]>0, then I-th constraint is C[i,*]*x >= C[i,n+1] - * if CT[i]=0, then I-th constraint is C[i,*]*x = C[i,n+1] - * if CT[i]<0, then I-th constraint is C[i,*]*x <= C[i,n+1] - K - number of equality/inequality constraints, K>=0 - -NOTE 1: linear (non-bound) constraints are satisfied only approximately: -* there always exists some minor violation (about Epsilon in magnitude) - due to rounding errors -* numerical differentiation, if used, may lead to function evaluations - outside of the feasible area, because algorithm does NOT change - numerical differentiation formula according to linear constraints. -If you want constraints to be satisfied exactly, try to reformulate your -problem in such manner that all constraints will become boundary ones -(this kind of constraints is always satisfied exactly, both in the final -solution and in all intermediate points). - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void sassetlc(sactiveset* state, - /* Real */ ae_matrix* c, - /* Integer */ ae_vector* ct, - ae_int_t k, - ae_state *_state) -{ - ae_int_t n; - ae_int_t i; - - - ae_assert(state->algostate==0, "SASSetLC: you may change constraints only in modification mode", _state); - n = state->n; - - /* - * First, check for errors in the inputs - */ - ae_assert(k>=0, "SASSetLC: K<0", _state); - ae_assert(c->cols>=n+1||k==0, "SASSetLC: Cols(C)rows>=k, "SASSetLC: Rows(C)cnt>=k, "SASSetLC: Length(CT)nec = 0; - state->nic = 0; - state->constraintschanged = ae_true; - return; - } - - /* - * Equality constraints are stored first, in the upper - * NEC rows of State.CLEIC matrix. Inequality constraints - * are stored in the next NIC rows. - * - * NOTE: we convert inequality constraints to the form - * A*x<=b before copying them. - */ - rmatrixsetlengthatleast(&state->cleic, k, n+1, _state); - state->nec = 0; - state->nic = 0; - for(i=0; i<=k-1; i++) - { - if( ct->ptr.p_int[i]==0 ) - { - ae_v_move(&state->cleic.ptr.pp_double[state->nec][0], 1, &c->ptr.pp_double[i][0], 1, ae_v_len(0,n)); - state->nec = state->nec+1; - } - } - for(i=0; i<=k-1; i++) - { - if( ct->ptr.p_int[i]!=0 ) - { - if( ct->ptr.p_int[i]>0 ) - { - ae_v_moveneg(&state->cleic.ptr.pp_double[state->nec+state->nic][0], 1, &c->ptr.pp_double[i][0], 1, ae_v_len(0,n)); - } - else - { - ae_v_move(&state->cleic.ptr.pp_double[state->nec+state->nic][0], 1, &c->ptr.pp_double[i][0], 1, ae_v_len(0,n)); - } - state->nic = state->nic+1; - } - } - - /* - * Mark state as changed - */ - state->constraintschanged = ae_true; -} - - -/************************************************************************* -Another variation of SASSetLC(), which accepts linear constraints using -another representation. - -Linear constraints are inactive by default (after initial creation). - -INPUT PARAMETERS: - State - SAS structure - CLEIC - linear constraints, array[NEC+NIC,N+1]. - Each row of C represents one constraint: - * first N elements correspond to coefficients, - * last element corresponds to the right part. - First NEC rows store equality constraints, next NIC - are - inequality ones. - All elements of C (including right part) must be finite. - NEC - number of equality constraints, NEC>=0 - NIC - number of inequality constraints, NIC>=0 - -NOTE 1: linear (non-bound) constraints are satisfied only approximately: -* there always exists some minor violation (about Epsilon in magnitude) - due to rounding errors -* numerical differentiation, if used, may lead to function evaluations - outside of the feasible area, because algorithm does NOT change - numerical differentiation formula according to linear constraints. -If you want constraints to be satisfied exactly, try to reformulate your -problem in such manner that all constraints will become boundary ones -(this kind of constraints is always satisfied exactly, both in the final -solution and in all intermediate points). - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void sassetlcx(sactiveset* state, - /* Real */ ae_matrix* cleic, - ae_int_t nec, - ae_int_t nic, - ae_state *_state) -{ - ae_int_t n; - ae_int_t i; - ae_int_t j; - - - ae_assert(state->algostate==0, "SASSetLCX: you may change constraints only in modification mode", _state); - n = state->n; - - /* - * First, check for errors in the inputs - */ - ae_assert(nec>=0, "SASSetLCX: NEC<0", _state); - ae_assert(nic>=0, "SASSetLCX: NIC<0", _state); - ae_assert(cleic->cols>=n+1||nec+nic==0, "SASSetLCX: Cols(CLEIC)rows>=nec+nic, "SASSetLCX: Rows(CLEIC)cleic, nec+nic, n+1, _state); - state->nec = nec; - state->nic = nic; - for(i=0; i<=nec+nic-1; i++) - { - for(j=0; j<=n; j++) - { - state->cleic.ptr.pp_double[i][j] = cleic->ptr.pp_double[i][j]; - } - } - - /* - * Mark state as changed - */ - state->constraintschanged = ae_true; -} - - -/************************************************************************* -This subroutine turns on optimization mode: -1. feasibility in X is enforced (in case X=S.XC and constraints have not - changed, algorithm just uses X without any modifications at all) -2. constraints are marked as "candidate" or "inactive" - -INPUT PARAMETERS: - S - active set object - X - initial point (candidate), array[N]. It is expected that X - contains only finite values (we do not check it). - -OUTPUT PARAMETERS: - S - state is changed - X - initial point can be changed to enforce feasibility - -RESULT: - True in case feasible point was found (mode was changed to "optimization") - False in case no feasible point was found (mode was not changed) - - -- ALGLIB -- - Copyright 21.12.2012 by Bochkanov Sergey -*************************************************************************/ -ae_bool sasstartoptimization(sactiveset* state, - /* Real */ ae_vector* x, - ae_state *_state) -{ - ae_int_t n; - ae_int_t nec; - ae_int_t nic; - ae_int_t i; - ae_int_t j; - double v; - ae_bool result; - - - ae_assert(state->algostate==0, "SASStartOptimization: already in optimization mode", _state); - result = ae_false; - n = state->n; - nec = state->nec; - nic = state->nic; - - /* - * Enforce feasibility and calculate set of "candidate"/"active" constraints. - * Always active equality constraints are marked as "active", all other constraints - * are marked as "candidate". - */ - ivectorsetlengthatleast(&state->activeset, n+nec+nic, _state); - for(i=0; i<=n-1; i++) - { - if( state->hasbndl.ptr.p_bool[i]&&state->hasbndu.ptr.p_bool[i] ) - { - if( ae_fp_greater(state->bndl.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) - { - return result; - } - } - } - ae_v_move(&state->xc.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,n-1)); - if( state->nec+state->nic>0 ) - { - - /* - * General linear constraints are present; general code is used. - */ - rvectorsetlengthatleast(&state->tmp0, n, _state); - rvectorsetlengthatleast(&state->tmpfeas, n+state->nic, _state); - rmatrixsetlengthatleast(&state->tmpm0, state->nec+state->nic, n+state->nic+1, _state); - for(i=0; i<=state->nec+state->nic-1; i++) - { - ae_v_move(&state->tmpm0.ptr.pp_double[i][0], 1, &state->cleic.ptr.pp_double[i][0], 1, ae_v_len(0,n-1)); - for(j=n; j<=n+state->nic-1; j++) - { - state->tmpm0.ptr.pp_double[i][j] = 0; - } - if( i>=state->nec ) - { - state->tmpm0.ptr.pp_double[i][n+i-state->nec] = 1.0; - } - state->tmpm0.ptr.pp_double[i][n+state->nic] = state->cleic.ptr.pp_double[i][n]; - } - ae_v_move(&state->tmpfeas.ptr.p_double[0], 1, &state->xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - for(i=0; i<=state->nic-1; i++) - { - v = ae_v_dotproduct(&state->cleic.ptr.pp_double[i+state->nec][0], 1, &state->xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->tmpfeas.ptr.p_double[i+n] = ae_maxreal(state->cleic.ptr.pp_double[i+state->nec][n]-v, 0.0, _state); - } - if( !findfeasiblepoint(&state->tmpfeas, &state->bndl, &state->hasbndl, &state->bndu, &state->hasbndu, n, state->nic, &state->tmpm0, state->nec+state->nic, 1.0E-6, &i, &j, _state) ) - { - return result; - } - ae_v_move(&state->xc.ptr.p_double[0], 1, &state->tmpfeas.ptr.p_double[0], 1, ae_v_len(0,n-1)); - for(i=0; i<=n-1; i++) - { - if( (state->hasbndl.ptr.p_bool[i]&&state->hasbndu.ptr.p_bool[i])&&ae_fp_eq(state->bndl.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) - { - state->activeset.ptr.p_int[i] = 1; - continue; - } - if( (state->hasbndl.ptr.p_bool[i]&&ae_fp_eq(state->xc.ptr.p_double[i],state->bndl.ptr.p_double[i]))||(state->hasbndu.ptr.p_bool[i]&&ae_fp_eq(state->xc.ptr.p_double[i],state->bndu.ptr.p_double[i])) ) - { - state->activeset.ptr.p_int[i] = 0; - continue; - } - state->activeset.ptr.p_int[i] = -1; - } - for(i=0; i<=state->nec-1; i++) - { - state->activeset.ptr.p_int[n+i] = 1; - } - for(i=0; i<=state->nic-1; i++) - { - if( ae_fp_eq(state->tmpfeas.ptr.p_double[n+i],0) ) - { - state->activeset.ptr.p_int[n+state->nec+i] = 0; - } - else - { - state->activeset.ptr.p_int[n+state->nec+i] = -1; - } - } - } - else - { - - /* - * Only bound constraints are present, quick code can be used - */ - for(i=0; i<=n-1; i++) - { - state->activeset.ptr.p_int[i] = -1; - if( (state->hasbndl.ptr.p_bool[i]&&state->hasbndu.ptr.p_bool[i])&&ae_fp_eq(state->bndl.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) - { - state->activeset.ptr.p_int[i] = 1; - state->xc.ptr.p_double[i] = state->bndl.ptr.p_double[i]; - continue; - } - if( state->hasbndl.ptr.p_bool[i]&&ae_fp_less_eq(state->xc.ptr.p_double[i],state->bndl.ptr.p_double[i]) ) - { - state->xc.ptr.p_double[i] = state->bndl.ptr.p_double[i]; - state->activeset.ptr.p_int[i] = 0; - continue; - } - if( state->hasbndu.ptr.p_bool[i]&&ae_fp_greater_eq(state->xc.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) - { - state->xc.ptr.p_double[i] = state->bndu.ptr.p_double[i]; - state->activeset.ptr.p_int[i] = 0; - continue; - } - } - } - - /* - * Change state, allocate temporaries - */ - result = ae_true; - state->algostate = 1; - state->basisisready = ae_false; - state->hasxc = ae_true; - rmatrixsetlengthatleast(&state->pbasis, ae_minint(nec+nic, n, _state), n+1, _state); - rmatrixsetlengthatleast(&state->ibasis, ae_minint(nec+nic, n, _state), n+1, _state); - rmatrixsetlengthatleast(&state->sbasis, ae_minint(nec+nic, n, _state), n+1, _state); - return result; -} - - -/************************************************************************* -This function explores search direction and calculates bound for step as -well as information for activation of constraints. - -INPUT PARAMETERS: - State - SAS structure which stores current point and all other - active set related information - D - descent direction to explore - -OUTPUT PARAMETERS: - StpMax - upper limit on step length imposed by yet inactive - constraints. Can be zero in case some constraints - can be activated by zero step. Equal to some large - value in case step is unlimited. - CIdx - -1 for unlimited step, in [0,N+NEC+NIC) in case of - limited step. - VVal - value which is assigned to X[CIdx] during activation. - For CIdx<0 or CIdx>=N some dummy value is assigned to - this parameter. -*************************************************************************/ -void sasexploredirection(sactiveset* state, - /* Real */ ae_vector* d, - double* stpmax, - ae_int_t* cidx, - double* vval, - ae_state *_state) -{ - ae_int_t n; - ae_int_t nec; - ae_int_t nic; - ae_int_t i; - double prevmax; - double vc; - double vd; - - *stpmax = 0; - *cidx = 0; - *vval = 0; - - ae_assert(state->algostate==1, "SASExploreDirection: is not in optimization mode", _state); - n = state->n; - nec = state->nec; - nic = state->nic; - *cidx = -1; - *vval = 0; - *stpmax = 1.0E50; - for(i=0; i<=n-1; i++) - { - if( state->activeset.ptr.p_int[i]<=0 ) - { - ae_assert(!state->hasbndl.ptr.p_bool[i]||ae_fp_greater_eq(state->xc.ptr.p_double[i],state->bndl.ptr.p_double[i]), "SASExploreDirection: internal error - infeasible X", _state); - ae_assert(!state->hasbndu.ptr.p_bool[i]||ae_fp_less_eq(state->xc.ptr.p_double[i],state->bndu.ptr.p_double[i]), "SASExploreDirection: internal error - infeasible X", _state); - if( state->hasbndl.ptr.p_bool[i]&&ae_fp_less(d->ptr.p_double[i],0) ) - { - prevmax = *stpmax; - *stpmax = safeminposrv(state->xc.ptr.p_double[i]-state->bndl.ptr.p_double[i], -d->ptr.p_double[i], *stpmax, _state); - if( ae_fp_less(*stpmax,prevmax) ) - { - *cidx = i; - *vval = state->bndl.ptr.p_double[i]; - } - } - if( state->hasbndu.ptr.p_bool[i]&&ae_fp_greater(d->ptr.p_double[i],0) ) - { - prevmax = *stpmax; - *stpmax = safeminposrv(state->bndu.ptr.p_double[i]-state->xc.ptr.p_double[i], d->ptr.p_double[i], *stpmax, _state); - if( ae_fp_less(*stpmax,prevmax) ) - { - *cidx = i; - *vval = state->bndu.ptr.p_double[i]; - } - } - } - } - for(i=nec; i<=nec+nic-1; i++) - { - if( state->activeset.ptr.p_int[n+i]<=0 ) - { - vc = ae_v_dotproduct(&state->cleic.ptr.pp_double[i][0], 1, &state->xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - vc = vc-state->cleic.ptr.pp_double[i][n]; - vd = ae_v_dotproduct(&state->cleic.ptr.pp_double[i][0], 1, &d->ptr.p_double[0], 1, ae_v_len(0,n-1)); - if( ae_fp_less_eq(vd,0) ) - { - continue; - } - if( ae_fp_less(vc,0) ) - { - - /* - * XC is strictly feasible with respect to I-th constraint, - * we can perform non-zero step because there is non-zero distance - * between XC and bound. - */ - prevmax = *stpmax; - *stpmax = safeminposrv(-vc, vd, *stpmax, _state); - if( ae_fp_less(*stpmax,prevmax) ) - { - *cidx = n+i; - } - } - else - { - - /* - * XC is at the boundary (or slightly beyond it), and step vector - * points beyond the boundary. - * - * The only thing we can do is to perform zero step and activate - * I-th constraint. - */ - *stpmax = 0; - *cidx = n+i; - } - } - } -} - - -/************************************************************************* -This subroutine moves current point to XN, in the direction previously -explored with SASExploreDirection() function. - -Step may activate one constraint. It is assumed than XN is approximately -feasible (small error as large as several ulps is possible). Strict -feasibility with respect to bound constraints is enforced during -activation, feasibility with respect to general linear constraints is not -enforced. - -INPUT PARAMETERS: - S - active set object - XN - new point. - NeedAct - True in case one constraint needs activation - CIdx - index of constraint, in [0,N+NEC+NIC). - Ignored if NeedAct is false. - This value is calculated by SASExploreDirection(). - CVal - for CIdx in [0,N) this field stores value which is - assigned to XC[CIdx] during activation. CVal is ignored in - other cases. - This value is calculated by SASExploreDirection(). - -OUTPUT PARAMETERS: - S - current point and list of active constraints are changed. - -RESULT: - >0, in case at least one inactive non-candidate constraint was activated - =0, in case only "candidate" constraints were activated - <0, in case no constraints were activated by the step - -NOTE: in general case State.XC<>XN because activation of constraints may - slightly change current point (to enforce feasibility). - - -- ALGLIB -- - Copyright 21.12.2012 by Bochkanov Sergey -*************************************************************************/ -ae_int_t sasmoveto(sactiveset* state, - /* Real */ ae_vector* xn, - ae_bool needact, - ae_int_t cidx, - double cval, - ae_state *_state) -{ - ae_int_t n; - ae_int_t nec; - ae_int_t nic; - ae_int_t i; - ae_bool wasactivation; - ae_int_t result; - - - ae_assert(state->algostate==1, "SASMoveTo: is not in optimization mode", _state); - n = state->n; - nec = state->nec; - nic = state->nic; - - /* - * Save previous state, update current point - */ - rvectorsetlengthatleast(&state->mtx, n, _state); - ivectorsetlengthatleast(&state->mtas, n+nec+nic, _state); - for(i=0; i<=n-1; i++) - { - state->mtx.ptr.p_double[i] = state->xc.ptr.p_double[i]; - state->xc.ptr.p_double[i] = xn->ptr.p_double[i]; - } - for(i=0; i<=n+nec+nic-1; i++) - { - state->mtas.ptr.p_int[i] = state->activeset.ptr.p_int[i]; - } - - /* - * Activate constraints - */ - wasactivation = ae_false; - if( needact ) - { - - /* - * Activation - */ - ae_assert(cidx>=0&&cidxxc.ptr.p_double[cidx] = cval; - } - state->activeset.ptr.p_int[cidx] = 1; - wasactivation = ae_true; - } - for(i=0; i<=n-1; i++) - { - - /* - * Post-check (some constraints may be activated because of numerical errors) - */ - if( state->hasbndl.ptr.p_bool[i]&&ae_fp_less(state->xc.ptr.p_double[i],state->bndl.ptr.p_double[i]) ) - { - state->xc.ptr.p_double[i] = state->bndl.ptr.p_double[i]; - state->activeset.ptr.p_int[i] = 1; - wasactivation = ae_true; - } - if( state->hasbndu.ptr.p_bool[i]&&ae_fp_greater(state->xc.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) - { - state->xc.ptr.p_double[i] = state->bndu.ptr.p_double[i]; - state->activeset.ptr.p_int[i] = 1; - wasactivation = ae_true; - } - } - - /* - * Determine return status: - * * -1 in case no constraints were activated - * * 0 in case only "candidate" constraints were activated - * * +1 in case at least one "non-candidate" constraint was activated - */ - if( wasactivation ) - { - - /* - * Step activated one/several constraints, but sometimes it is spurious - * activation - RecalculateConstraints() tells us that constraint is - * inactive (negative Largrange multiplier), but step activates it - * because of numerical noise. - * - * This block of code checks whether step activated truly new constraints - * (ones which were not in the active set at the solution): - * - * * for non-boundary constraint it is enough to check that previous value - * of ActiveSet[i] is negative (=far from boundary), and new one is - * positive (=we are at the boundary, constraint is activated). - * - * * for boundary constraints previous criterion won't work. Each variable - * has two constraints, and simply checking their status is not enough - - * we have to correctly identify cases when we leave one boundary - * (PrevActiveSet[i]=0) and move to another boundary (ActiveSet[i]>0). - * Such cases can be identified if we compare previous X with new X. - * - * In case only "candidate" constraints were activated, result variable - * is set to 0. In case at least one new constraint was activated, result - * is set to 1. - */ - result = 0; - for(i=0; i<=n-1; i++) - { - if( state->activeset.ptr.p_int[i]>0&&ae_fp_neq(state->xc.ptr.p_double[i],state->mtx.ptr.p_double[i]) ) - { - result = 1; - } - } - for(i=n; i<=n+state->nec+state->nic-1; i++) - { - if( state->mtas.ptr.p_int[i]<0&&state->activeset.ptr.p_int[i]>0 ) - { - result = 1; - } - } - } - else - { - - /* - * No activation, return -1 - */ - result = -1; - } - - /* - * Invalidate basis - */ - state->basisisready = ae_false; - return result; -} - - -/************************************************************************* -This subroutine performs immediate activation of one constraint: -* "immediate" means that we do not have to move to activate it -* in case boundary constraint is activated, we enforce current point to be - exactly at the boundary - -INPUT PARAMETERS: - S - active set object - CIdx - index of constraint, in [0,N+NEC+NIC). - This value is calculated by SASExploreDirection(). - CVal - for CIdx in [0,N) this field stores value which is - assigned to XC[CIdx] during activation. CVal is ignored in - other cases. - This value is calculated by SASExploreDirection(). - - -- ALGLIB -- - Copyright 21.12.2012 by Bochkanov Sergey -*************************************************************************/ -void sasimmediateactivation(sactiveset* state, - ae_int_t cidx, - double cval, - ae_state *_state) -{ - - - ae_assert(state->algostate==1, "SASMoveTo: is not in optimization mode", _state); - if( cidxn ) - { - state->xc.ptr.p_double[cidx] = cval; - } - state->activeset.ptr.p_int[cidx] = 1; - state->basisisready = ae_false; -} - - -/************************************************************************* -This subroutine calculates descent direction subject to current active set. - -INPUT PARAMETERS: - S - active set object - G - array[N], gradient - D - possibly prealocated buffer; - automatically resized if needed. - -OUTPUT PARAMETERS: - D - descent direction projected onto current active set. - Components of D which correspond to active boundary - constraints are forced to be exactly zero. - In case D is non-zero, it is normalized to have unit norm. - -NOTE: in case active set has N active constraints (or more), descent - direction is forced to be exactly zero. - - -- ALGLIB -- - Copyright 21.12.2012 by Bochkanov Sergey -*************************************************************************/ -void sasconstraineddescent(sactiveset* state, - /* Real */ ae_vector* g, - /* Real */ ae_vector* d, - ae_state *_state) -{ - - - ae_assert(state->algostate==1, "SASConstrainedDescent: is not in optimization mode", _state); - sasrebuildbasis(state, _state); - sactivesets_constraineddescent(state, g, &state->unitdiagonal, &state->ibasis, ae_true, d, _state); -} - - -/************************************************************************* -This subroutine calculates preconditioned descent direction subject to -current active set. - -INPUT PARAMETERS: - S - active set object - G - array[N], gradient - D - possibly prealocated buffer; - automatically resized if needed. - -OUTPUT PARAMETERS: - D - descent direction projected onto current active set. - Components of D which correspond to active boundary - constraints are forced to be exactly zero. - In case D is non-zero, it is normalized to have unit norm. - -NOTE: in case active set has N active constraints (or more), descent - direction is forced to be exactly zero. - - -- ALGLIB -- - Copyright 21.12.2012 by Bochkanov Sergey -*************************************************************************/ -void sasconstraineddescentprec(sactiveset* state, - /* Real */ ae_vector* g, - /* Real */ ae_vector* d, - ae_state *_state) -{ - - - ae_assert(state->algostate==1, "SASConstrainedDescentPrec: is not in optimization mode", _state); - sasrebuildbasis(state, _state); - sactivesets_constraineddescent(state, g, &state->h, &state->pbasis, ae_true, d, _state); -} - - -/************************************************************************* -This subroutine calculates product of direction vector and preconditioner -multiplied subject to current active set. - -INPUT PARAMETERS: - S - active set object - D - array[N], direction - -OUTPUT PARAMETERS: - D - preconditioned direction projected onto current active set. - Components of D which correspond to active boundary - constraints are forced to be exactly zero. - -NOTE: in case active set has N active constraints (or more), descent - direction is forced to be exactly zero. - - -- ALGLIB -- - Copyright 21.12.2012 by Bochkanov Sergey -*************************************************************************/ -void sasconstraineddirection(sactiveset* state, - /* Real */ ae_vector* d, - ae_state *_state) -{ - ae_int_t i; - - - ae_assert(state->algostate==1, "SASConstrainedAntigradientPrec: is not in optimization mode", _state); - sasrebuildbasis(state, _state); - sactivesets_constraineddescent(state, d, &state->unitdiagonal, &state->ibasis, ae_false, &state->cdtmp, _state); - for(i=0; i<=state->n-1; i++) - { - d->ptr.p_double[i] = -state->cdtmp.ptr.p_double[i]; - } -} - - -/************************************************************************* -This subroutine calculates product of direction vector and preconditioner -multiplied subject to current active set. - -INPUT PARAMETERS: - S - active set object - D - array[N], direction - -OUTPUT PARAMETERS: - D - preconditioned direction projected onto current active set. - Components of D which correspond to active boundary - constraints are forced to be exactly zero. - -NOTE: in case active set has N active constraints (or more), descent - direction is forced to be exactly zero. - - -- ALGLIB -- - Copyright 21.12.2012 by Bochkanov Sergey -*************************************************************************/ -void sasconstraineddirectionprec(sactiveset* state, - /* Real */ ae_vector* d, - ae_state *_state) -{ - ae_int_t i; - - - ae_assert(state->algostate==1, "SASConstrainedAntigradientPrec: is not in optimization mode", _state); - sasrebuildbasis(state, _state); - sactivesets_constraineddescent(state, d, &state->h, &state->pbasis, ae_false, &state->cdtmp, _state); - for(i=0; i<=state->n-1; i++) - { - d->ptr.p_double[i] = -state->cdtmp.ptr.p_double[i]; - } -} - - -/************************************************************************* -This subroutine performs correction of some (possibly infeasible) point -with respect to a) current active set, b) all boundary constraints, both -active and inactive: - -0) we calculate L1 penalty term for violation of active linear constraints - (one which is returned by SASActiveLCPenalty1() function). -1) first, it performs projection (orthogonal with respect to scale matrix - S) of X into current active set: X -> X1. -2) next, we perform projection with respect to ALL boundary constraints - which are violated at X1: X1 -> X2. -3) X is replaced by X2. - -The idea is that this function can preserve and enforce feasibility during -optimization, and additional penalty parameter can be used to prevent algo -from leaving feasible set because of rounding errors. - -INPUT PARAMETERS: - S - active set object - X - array[N], candidate point - -OUTPUT PARAMETERS: - X - "improved" candidate point: - a) feasible with respect to all boundary constraints - b) feasibility with respect to active set is retained at - good level. - Penalty - penalty term, which can be added to function value if user - wants to penalize violation of constraints (recommended). - -NOTE: this function is not intended to find exact projection (i.e. best - approximation) of X into feasible set. It just improves situation a - bit. - Regular use of this function will help you to retain feasibility - - if you already have something to start with and constrain your - steps is such way that the only source of infeasibility are roundoff - errors. - - -- ALGLIB -- - Copyright 21.12.2012 by Bochkanov Sergey -*************************************************************************/ -void sascorrection(sactiveset* state, - /* Real */ ae_vector* x, - double* penalty, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t n; - double v; - - *penalty = 0; - - ae_assert(state->algostate==1, "SASCorrection: is not in optimization mode", _state); - sasrebuildbasis(state, _state); - n = state->n; - rvectorsetlengthatleast(&state->corrtmp, n, _state); - - /* - * Calculate penalty term. - */ - *penalty = sasactivelcpenalty1(state, x, _state); - - /* - * Perform projection 1. - * - * This projecton is given by: - * - * x_proj = x - S*S*As'*(As*x-b) - * - * where x is original x before projection, S is a scale matrix, - * As is a matrix of equality constraints (active set) which were - * orthogonalized with respect to inner product given by S (i.e. we - * have As*S*S'*As'=I), b is a right part of the orthogonalized - * constraints. - * - * NOTE: you can verify that x_proj is strictly feasible w.r.t. - * active set by multiplying it by As - you will get - * As*x_proj = As*x - As*x + b = b. - * - * This formula for projection can be obtained by solving - * following minimization problem. - * - * min ||inv(S)*(x_proj-x)||^2 s.t. As*x_proj=b - * - */ - ae_v_move(&state->corrtmp.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,n-1)); - for(i=0; i<=state->basissize-1; i++) - { - v = -state->sbasis.ptr.pp_double[i][n]; - for(j=0; j<=n-1; j++) - { - v = v+state->sbasis.ptr.pp_double[i][j]*state->corrtmp.ptr.p_double[j]; - } - for(j=0; j<=n-1; j++) - { - state->corrtmp.ptr.p_double[j] = state->corrtmp.ptr.p_double[j]-v*state->sbasis.ptr.pp_double[i][j]*ae_sqr(state->s.ptr.p_double[j], _state); - } - } - for(i=0; i<=n-1; i++) - { - if( state->activeset.ptr.p_int[i]>0 ) - { - state->corrtmp.ptr.p_double[i] = state->xc.ptr.p_double[i]; - } - } - - /* - * Perform projection 2 - */ - for(i=0; i<=n-1; i++) - { - x->ptr.p_double[i] = state->corrtmp.ptr.p_double[i]; - if( state->hasbndl.ptr.p_bool[i]&&ae_fp_less(x->ptr.p_double[i],state->bndl.ptr.p_double[i]) ) - { - x->ptr.p_double[i] = state->bndl.ptr.p_double[i]; - } - if( state->hasbndu.ptr.p_bool[i]&&ae_fp_greater(x->ptr.p_double[i],state->bndu.ptr.p_double[i]) ) - { - x->ptr.p_double[i] = state->bndu.ptr.p_double[i]; - } - } -} - - -/************************************************************************* -This subroutine returns L1 penalty for violation of active general linear -constraints (violation of boundary or inactive linear constraints is not -added to penalty). - -Penalty term is equal to: - - Penalty = SUM( Abs((C_i*x-R_i)/Alpha_i) ) - -Here: -* summation is performed for I=0...NEC+NIC-1, ActiveSet[N+I]>0 - (only for rows of CLEIC which are in active set) -* C_i is I-th row of CLEIC -* R_i is corresponding right part -* S is a scale matrix -* Alpha_i = ||S*C_i|| - is a scaling coefficient which "normalizes" - I-th summation term according to its scale. - -INPUT PARAMETERS: - S - active set object - X - array[N], candidate point - - -- ALGLIB -- - Copyright 21.12.2012 by Bochkanov Sergey -*************************************************************************/ -double sasactivelcpenalty1(sactiveset* state, - /* Real */ ae_vector* x, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t n; - ae_int_t nec; - ae_int_t nic; - double v; - double alpha; - double p; - double result; - - - ae_assert(state->algostate==1, "SASActiveLCPenalty1: is not in optimization mode", _state); - sasrebuildbasis(state, _state); - n = state->n; - nec = state->nec; - nic = state->nic; - - /* - * Calculate penalty term. - */ - result = 0; - for(i=0; i<=nec+nic-1; i++) - { - if( state->activeset.ptr.p_int[n+i]>0 ) - { - alpha = 0; - p = -state->cleic.ptr.pp_double[i][n]; - for(j=0; j<=n-1; j++) - { - v = state->cleic.ptr.pp_double[i][j]; - p = p+v*x->ptr.p_double[j]; - alpha = alpha+ae_sqr(v*state->s.ptr.p_double[j], _state); - } - alpha = ae_sqrt(alpha, _state); - if( ae_fp_neq(alpha,0) ) - { - result = result+ae_fabs(p/alpha, _state); - } - } - } - return result; -} - - -/************************************************************************* -This subroutine calculates scaled norm of vector after projection onto -subspace of active constraints. Most often this function is used to test -stopping conditions. - -INPUT PARAMETERS: - S - active set object - D - vector whose norm is calculated - -RESULT: - Vector norm (after projection and scaling) - -NOTE: projection is performed first, scaling is performed after projection - - -- ALGLIB -- - Copyright 21.12.2012 by Bochkanov Sergey -*************************************************************************/ -double sasscaledconstrainednorm(sactiveset* state, - /* Real */ ae_vector* d, - ae_state *_state) -{ - ae_int_t i; - ae_int_t n; - double v; - double result; - - - ae_assert(state->algostate==1, "SASMoveTo: is not in optimization mode", _state); - n = state->n; - rvectorsetlengthatleast(&state->scntmp, n, _state); - - /* - * Prepare basis (if needed) - */ - sasrebuildbasis(state, _state); - - /* - * Calculate descent direction - */ - for(i=0; i<=n-1; i++) - { - if( state->activeset.ptr.p_int[i]>0 ) - { - state->scntmp.ptr.p_double[i] = 0; - } - else - { - state->scntmp.ptr.p_double[i] = d->ptr.p_double[i]; - } - } - for(i=0; i<=state->basissize-1; i++) - { - v = ae_v_dotproduct(&state->ibasis.ptr.pp_double[i][0], 1, &state->scntmp.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_subd(&state->scntmp.ptr.p_double[0], 1, &state->ibasis.ptr.pp_double[i][0], 1, ae_v_len(0,n-1), v); - } - v = 0.0; - for(i=0; i<=n-1; i++) - { - v = v+ae_sqr(state->s.ptr.p_double[i]*state->scntmp.ptr.p_double[i], _state); - } - result = ae_sqrt(v, _state); - return result; -} - - -/************************************************************************* -This subroutine turns off optimization mode. - -INPUT PARAMETERS: - S - active set object - -OUTPUT PARAMETERS: - S - state is changed - -NOTE: this function can be called many times for optimizer which was - already stopped. - - -- ALGLIB -- - Copyright 21.12.2012 by Bochkanov Sergey -*************************************************************************/ -void sasstopoptimization(sactiveset* state, ae_state *_state) -{ - - - state->algostate = 0; -} - - -/************************************************************************* -This function recalculates constraints - activates and deactivates them -according to gradient value at current point. Algorithm assumes that we -want to make steepest descent step from current point; constraints are -activated and deactivated in such way that we won't violate any constraint -by steepest descent step. - -After call to this function active set is ready to try steepest descent -step (SASDescentDirection-SASExploreDirection-SASMoveTo). - -Only already "active" and "candidate" elements of ActiveSet are examined; -constraints which are not active are not examined. - -INPUT PARAMETERS: - State - active set object - GC - array[N], gradient at XC - -OUTPUT PARAMETERS: - State - active set object, with new set of constraint - - -- ALGLIB -- - Copyright 26.09.2012 by Bochkanov Sergey -*************************************************************************/ -void sasreactivateconstraints(sactiveset* state, - /* Real */ ae_vector* gc, - ae_state *_state) -{ - - - ae_assert(state->algostate==1, "SASReactivateConstraints: must be in optimization mode", _state); - sactivesets_reactivateconstraints(state, gc, &state->unitdiagonal, _state); -} - - -/************************************************************************* -This function recalculates constraints - activates and deactivates them -according to gradient value at current point. - -Algorithm assumes that we want to make Quasi-Newton step from current -point with diagonal Quasi-Newton matrix H. Constraints are activated and -deactivated in such way that we won't violate any constraint by step. - -After call to this function active set is ready to try preconditioned -steepest descent step (SASDescentDirection-SASExploreDirection-SASMoveTo). - -Only already "active" and "candidate" elements of ActiveSet are examined; -constraints which are not active are not examined. - -INPUT PARAMETERS: - State - active set object - GC - array[N], gradient at XC - -OUTPUT PARAMETERS: - State - active set object, with new set of constraint - - -- ALGLIB -- - Copyright 26.09.2012 by Bochkanov Sergey -*************************************************************************/ -void sasreactivateconstraintsprec(sactiveset* state, - /* Real */ ae_vector* gc, - ae_state *_state) -{ - - - ae_assert(state->algostate==1, "SASReactivateConstraintsPrec: must be in optimization mode", _state); - sactivesets_reactivateconstraints(state, gc, &state->h, _state); -} - - -/************************************************************************* -This function builds three orthonormal basises for current active set: -* P-orthogonal one, which is orthogonalized with inner product - (x,y) = x'*P*y, where P=inv(H) is current preconditioner -* S-orthogonal one, which is orthogonalized with inner product - (x,y) = x'*S'*S*y, where S is diagonal scaling matrix -* I-orthogonal one, which is orthogonalized with standard dot product - -NOTE: all sets of orthogonal vectors are guaranteed to have same size. - P-orthogonal basis is built first, I/S-orthogonal basises are forced - to have same number of vectors as P-orthogonal one (padded by zero - vectors if needed). - -NOTE: this function tracks changes in active set; first call will result - in reorthogonalization - -INPUT PARAMETERS: - State - active set object - H - diagonal preconditioner, H[i]>0 - -OUTPUT PARAMETERS: - State - active set object with new basis - - -- ALGLIB -- - Copyright 20.06.2012 by Bochkanov Sergey -*************************************************************************/ -void sasrebuildbasis(sactiveset* state, ae_state *_state) -{ - ae_int_t n; - ae_int_t nec; - ae_int_t nic; - ae_int_t i; - ae_int_t j; - ae_int_t t; - ae_int_t nactivelin; - ae_int_t nactivebnd; - double v; - double vmax; - ae_int_t kmax; - - - if( state->basisisready ) - { - return; - } - n = state->n; - nec = state->nec; - nic = state->nic; - rmatrixsetlengthatleast(&state->tmpbasis, nec+nic, n+1, _state); - state->basissize = 0; - state->basisisready = ae_true; - - /* - * Determine number of active boundary and non-boundary - * constraints, move them to TmpBasis. Quick exit if no - * non-boundary constraints were detected. - */ - nactivelin = 0; - nactivebnd = 0; - for(i=0; i<=nec+nic-1; i++) - { - if( state->activeset.ptr.p_int[n+i]>0 ) - { - nactivelin = nactivelin+1; - } - } - for(j=0; j<=n-1; j++) - { - if( state->activeset.ptr.p_int[j]>0 ) - { - nactivebnd = nactivebnd+1; - } - } - if( nactivelin==0 ) - { - return; - } - - /* - * Orthogonalize linear constraints (inner product is given by preconditioner) - * with respect to each other and boundary ones: - * * normalize all constraints - * * orthogonalize with respect to boundary ones - * * repeat: - * * if basisSize+nactivebnd=n - TERMINATE - * * choose largest row from TmpBasis - * * if row norm is too small - TERMINATE - * * add row to basis, normalize - * * remove from TmpBasis, orthogonalize other constraints with respect to this one - */ - nactivelin = 0; - for(i=0; i<=nec+nic-1; i++) - { - if( state->activeset.ptr.p_int[n+i]>0 ) - { - ae_v_move(&state->tmpbasis.ptr.pp_double[nactivelin][0], 1, &state->cleic.ptr.pp_double[i][0], 1, ae_v_len(0,n)); - nactivelin = nactivelin+1; - } - } - for(i=0; i<=nactivelin-1; i++) - { - v = 0.0; - for(j=0; j<=n-1; j++) - { - v = v+ae_sqr(state->tmpbasis.ptr.pp_double[i][j], _state)/state->h.ptr.p_double[j]; - } - if( ae_fp_greater(v,0) ) - { - v = 1/ae_sqrt(v, _state); - for(j=0; j<=n; j++) - { - state->tmpbasis.ptr.pp_double[i][j] = state->tmpbasis.ptr.pp_double[i][j]*v; - } - } - } - for(j=0; j<=n-1; j++) - { - if( state->activeset.ptr.p_int[j]>0 ) - { - for(i=0; i<=nactivelin-1; i++) - { - state->tmpbasis.ptr.pp_double[i][n] = state->tmpbasis.ptr.pp_double[i][n]-state->tmpbasis.ptr.pp_double[i][j]*state->xc.ptr.p_double[j]; - state->tmpbasis.ptr.pp_double[i][j] = 0.0; - } - } - } - while(state->basissize+nactivebndtmpbasis.ptr.pp_double[i][j], _state)/state->h.ptr.p_double[j]; - } - v = ae_sqrt(v, _state); - if( ae_fp_greater(v,vmax) ) - { - vmax = v; - kmax = i; - } - } - if( ae_fp_less(vmax,1.0E4*ae_machineepsilon) ) - { - break; - } - v = 1/vmax; - ae_v_moved(&state->pbasis.ptr.pp_double[state->basissize][0], 1, &state->tmpbasis.ptr.pp_double[kmax][0], 1, ae_v_len(0,n), v); - state->basissize = state->basissize+1; - - /* - * Reorthogonalize other vectors with respect to chosen one. - * Remove it from the array. - */ - for(i=0; i<=nactivelin-1; i++) - { - if( i!=kmax ) - { - v = 0; - for(j=0; j<=n-1; j++) - { - v = v+state->pbasis.ptr.pp_double[state->basissize-1][j]*state->tmpbasis.ptr.pp_double[i][j]/state->h.ptr.p_double[j]; - } - ae_v_subd(&state->tmpbasis.ptr.pp_double[i][0], 1, &state->pbasis.ptr.pp_double[state->basissize-1][0], 1, ae_v_len(0,n), v); - } - } - for(j=0; j<=n; j++) - { - state->tmpbasis.ptr.pp_double[kmax][j] = 0; - } - } - - /* - * Orthogonalize linear constraints using traditional dot product - * with respect to each other and boundary ones. - * - * NOTE: we force basis size to be equal to one which was computed - * at the previous step, with preconditioner-based inner product. - */ - nactivelin = 0; - for(i=0; i<=nec+nic-1; i++) - { - if( state->activeset.ptr.p_int[n+i]>0 ) - { - ae_v_move(&state->tmpbasis.ptr.pp_double[nactivelin][0], 1, &state->cleic.ptr.pp_double[i][0], 1, ae_v_len(0,n)); - nactivelin = nactivelin+1; - } - } - for(i=0; i<=nactivelin-1; i++) - { - v = 0.0; - for(j=0; j<=n-1; j++) - { - v = v+ae_sqr(state->tmpbasis.ptr.pp_double[i][j], _state); - } - if( ae_fp_greater(v,0) ) - { - v = 1/ae_sqrt(v, _state); - for(j=0; j<=n; j++) - { - state->tmpbasis.ptr.pp_double[i][j] = state->tmpbasis.ptr.pp_double[i][j]*v; - } - } - } - for(j=0; j<=n-1; j++) - { - if( state->activeset.ptr.p_int[j]>0 ) - { - for(i=0; i<=nactivelin-1; i++) - { - state->tmpbasis.ptr.pp_double[i][n] = state->tmpbasis.ptr.pp_double[i][n]-state->tmpbasis.ptr.pp_double[i][j]*state->xc.ptr.p_double[j]; - state->tmpbasis.ptr.pp_double[i][j] = 0.0; - } - } - } - for(t=0; t<=state->basissize-1; t++) - { - - /* - * Find largest vector, add to basis. - */ - vmax = -1; - kmax = -1; - for(i=0; i<=nactivelin-1; i++) - { - v = 0.0; - for(j=0; j<=n-1; j++) - { - v = v+ae_sqr(state->tmpbasis.ptr.pp_double[i][j], _state); - } - v = ae_sqrt(v, _state); - if( ae_fp_greater(v,vmax) ) - { - vmax = v; - kmax = i; - } - } - if( ae_fp_eq(vmax,0) ) - { - for(j=0; j<=n; j++) - { - state->ibasis.ptr.pp_double[t][j] = 0.0; - } - continue; - } - v = 1/vmax; - ae_v_moved(&state->ibasis.ptr.pp_double[t][0], 1, &state->tmpbasis.ptr.pp_double[kmax][0], 1, ae_v_len(0,n), v); - - /* - * Reorthogonalize other vectors with respect to chosen one. - * Remove it from the array. - */ - for(i=0; i<=nactivelin-1; i++) - { - if( i!=kmax ) - { - v = 0; - for(j=0; j<=n-1; j++) - { - v = v+state->ibasis.ptr.pp_double[t][j]*state->tmpbasis.ptr.pp_double[i][j]; - } - ae_v_subd(&state->tmpbasis.ptr.pp_double[i][0], 1, &state->ibasis.ptr.pp_double[t][0], 1, ae_v_len(0,n), v); - } - } - for(j=0; j<=n; j++) - { - state->tmpbasis.ptr.pp_double[kmax][j] = 0; - } - } - - /* - * Orthogonalize linear constraints using inner product given by - * scale matrix. - * - * NOTE: we force basis size to be equal to one which was computed - * with preconditioner-based inner product. - */ - nactivelin = 0; - for(i=0; i<=nec+nic-1; i++) - { - if( state->activeset.ptr.p_int[n+i]>0 ) - { - ae_v_move(&state->tmpbasis.ptr.pp_double[nactivelin][0], 1, &state->cleic.ptr.pp_double[i][0], 1, ae_v_len(0,n)); - nactivelin = nactivelin+1; - } - } - for(i=0; i<=nactivelin-1; i++) - { - v = 0.0; - for(j=0; j<=n-1; j++) - { - v = v+ae_sqr(state->tmpbasis.ptr.pp_double[i][j]*state->s.ptr.p_double[j], _state); - } - if( ae_fp_greater(v,0) ) - { - v = 1/ae_sqrt(v, _state); - for(j=0; j<=n; j++) - { - state->tmpbasis.ptr.pp_double[i][j] = state->tmpbasis.ptr.pp_double[i][j]*v; - } - } - } - for(j=0; j<=n-1; j++) - { - if( state->activeset.ptr.p_int[j]>0 ) - { - for(i=0; i<=nactivelin-1; i++) - { - state->tmpbasis.ptr.pp_double[i][n] = state->tmpbasis.ptr.pp_double[i][n]-state->tmpbasis.ptr.pp_double[i][j]*state->xc.ptr.p_double[j]; - state->tmpbasis.ptr.pp_double[i][j] = 0.0; - } - } - } - for(t=0; t<=state->basissize-1; t++) - { - - /* - * Find largest vector, add to basis. - */ - vmax = -1; - kmax = -1; - for(i=0; i<=nactivelin-1; i++) - { - v = 0.0; - for(j=0; j<=n-1; j++) - { - v = v+ae_sqr(state->tmpbasis.ptr.pp_double[i][j]*state->s.ptr.p_double[j], _state); - } - v = ae_sqrt(v, _state); - if( ae_fp_greater(v,vmax) ) - { - vmax = v; - kmax = i; - } - } - if( ae_fp_eq(vmax,0) ) - { - for(j=0; j<=n; j++) - { - state->sbasis.ptr.pp_double[t][j] = 0.0; - } - continue; - } - v = 1/vmax; - ae_v_moved(&state->sbasis.ptr.pp_double[t][0], 1, &state->tmpbasis.ptr.pp_double[kmax][0], 1, ae_v_len(0,n), v); - - /* - * Reorthogonalize other vectors with respect to chosen one. - * Remove it from the array. - */ - for(i=0; i<=nactivelin-1; i++) - { - if( i!=kmax ) - { - v = 0; - for(j=0; j<=n-1; j++) - { - v = v+state->sbasis.ptr.pp_double[t][j]*state->tmpbasis.ptr.pp_double[i][j]*ae_sqr(state->s.ptr.p_double[j], _state); - } - ae_v_subd(&state->tmpbasis.ptr.pp_double[i][0], 1, &state->sbasis.ptr.pp_double[t][0], 1, ae_v_len(0,n), v); - } - } - for(j=0; j<=n; j++) - { - state->tmpbasis.ptr.pp_double[kmax][j] = 0; - } - } -} - - -/************************************************************************* -This subroutine calculates preconditioned descent direction subject to -current active set. - -INPUT PARAMETERS: - State - active set object - G - array[N], gradient - H - array[N], Hessian matrix - HA - active constraints orthogonalized in such way - that HA*inv(H)*HA'= I. - Normalize- whether we need normalized descent or not - D - possibly preallocated buffer; automatically resized. - -OUTPUT PARAMETERS: - D - descent direction projected onto current active set. - Components of D which correspond to active boundary - constraints are forced to be exactly zero. - In case D is non-zero and Normalize is True, it is - normalized to have unit norm. - - -- ALGLIB -- - Copyright 21.12.2012 by Bochkanov Sergey -*************************************************************************/ -static void sactivesets_constraineddescent(sactiveset* state, - /* Real */ ae_vector* g, - /* Real */ ae_vector* h, - /* Real */ ae_matrix* ha, - ae_bool normalize, - /* Real */ ae_vector* d, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t n; - double v; - ae_int_t nactive; - - - ae_assert(state->algostate==1, "SAS: internal error in ConstrainedDescent() - not in optimization mode", _state); - ae_assert(state->basisisready, "SAS: internal error in ConstrainedDescent() - no basis", _state); - n = state->n; - rvectorsetlengthatleast(d, n, _state); - - /* - * Calculate preconditioned constrained descent direction: - * - * d := -inv(H)*( g - HA'*(HA*inv(H)*g) ) - * - * Formula above always gives direction which is orthogonal to rows of HA. - * You can verify it by multiplication of both sides by HA[i] (I-th row), - * taking into account that HA*inv(H)*HA'= I (by definition of HA - it is - * orthogonal basis with inner product given by inv(H)). - */ - nactive = 0; - for(i=0; i<=n-1; i++) - { - if( state->activeset.ptr.p_int[i]>0 ) - { - d->ptr.p_double[i] = 0; - nactive = nactive+1; - } - else - { - d->ptr.p_double[i] = g->ptr.p_double[i]; - } - } - for(i=0; i<=state->basissize-1; i++) - { - v = 0.0; - for(j=0; j<=n-1; j++) - { - v = v+ha->ptr.pp_double[i][j]*d->ptr.p_double[j]/h->ptr.p_double[j]; - } - ae_v_subd(&d->ptr.p_double[0], 1, &ha->ptr.pp_double[i][0], 1, ae_v_len(0,n-1), v); - nactive = nactive+1; - } - v = 0.0; - for(i=0; i<=n-1; i++) - { - if( state->activeset.ptr.p_int[i]>0 ) - { - d->ptr.p_double[i] = 0; - } - else - { - d->ptr.p_double[i] = -d->ptr.p_double[i]/h->ptr.p_double[i]; - v = v+ae_sqr(d->ptr.p_double[i], _state); - } - } - v = ae_sqrt(v, _state); - if( nactive>=n ) - { - v = 0; - for(i=0; i<=n-1; i++) - { - d->ptr.p_double[i] = 0; - } - } - if( normalize&&ae_fp_greater(v,0) ) - { - for(i=0; i<=n-1; i++) - { - d->ptr.p_double[i] = d->ptr.p_double[i]/v; - } - } -} - - -/************************************************************************* -This function recalculates constraints - activates and deactivates them -according to gradient value at current point. - -Algorithm assumes that we want to make Quasi-Newton step from current -point with diagonal Quasi-Newton matrix H. Constraints are activated and -deactivated in such way that we won't violate any constraint by step. - -Only already "active" and "candidate" elements of ActiveSet are examined; -constraints which are not active are not examined. - -INPUT PARAMETERS: - State - active set object - GC - array[N], gradient at XC - H - array[N], Hessian matrix - -OUTPUT PARAMETERS: - State - active set object, with new set of constraint - - -- ALGLIB -- - Copyright 26.09.2012 by Bochkanov Sergey -*************************************************************************/ -static void sactivesets_reactivateconstraints(sactiveset* state, - /* Real */ ae_vector* gc, - /* Real */ ae_vector* h, - ae_state *_state) -{ - ae_int_t n; - ae_int_t nec; - ae_int_t nic; - ae_int_t i; - ae_int_t j; - ae_int_t idx0; - ae_int_t idx1; - double v; - ae_int_t nactivebnd; - ae_int_t nactivelin; - ae_int_t nactiveconstraints; - double rowscale; - - - ae_assert(state->algostate==1, "SASReactivateConstraintsPrec: must be in optimization mode", _state); - - /* - * Prepare - */ - n = state->n; - nec = state->nec; - nic = state->nic; - state->basisisready = ae_false; - - /* - * Handle important special case - no linear constraints, - * only boundary constraints are present - */ - if( nec+nic==0 ) - { - for(i=0; i<=n-1; i++) - { - if( (state->hasbndl.ptr.p_bool[i]&&state->hasbndu.ptr.p_bool[i])&&ae_fp_eq(state->bndl.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) - { - state->activeset.ptr.p_int[i] = 1; - continue; - } - if( (state->hasbndl.ptr.p_bool[i]&&ae_fp_eq(state->xc.ptr.p_double[i],state->bndl.ptr.p_double[i]))&&ae_fp_greater_eq(gc->ptr.p_double[i],0) ) - { - state->activeset.ptr.p_int[i] = 1; - continue; - } - if( (state->hasbndu.ptr.p_bool[i]&&ae_fp_eq(state->xc.ptr.p_double[i],state->bndu.ptr.p_double[i]))&&ae_fp_less_eq(gc->ptr.p_double[i],0) ) - { - state->activeset.ptr.p_int[i] = 1; - continue; - } - state->activeset.ptr.p_int[i] = -1; - } - return; - } - - /* - * General case. - * Allocate temporaries. - */ - rvectorsetlengthatleast(&state->rctmpg, n, _state); - rvectorsetlengthatleast(&state->rctmprightpart, n, _state); - rvectorsetlengthatleast(&state->rctmps, n, _state); - rmatrixsetlengthatleast(&state->rctmpdense0, n, nec+nic, _state); - rmatrixsetlengthatleast(&state->rctmpdense1, n, nec+nic, _state); - bvectorsetlengthatleast(&state->rctmpisequality, n+nec+nic, _state); - ivectorsetlengthatleast(&state->rctmpconstraintidx, n+nec+nic, _state); - - /* - * Calculate descent direction - */ - ae_v_moveneg(&state->rctmpg.ptr.p_double[0], 1, &gc->ptr.p_double[0], 1, ae_v_len(0,n-1)); - - /* - * Determine candidates to the active set. - * - * After this block constraints become either "inactive" (ActiveSet[i]<0) - * or "candidates" (ActiveSet[i]=0). Previously active constraints always - * become "candidates". - */ - for(i=0; i<=n+nec+nic-1; i++) - { - if( state->activeset.ptr.p_int[i]>0 ) - { - state->activeset.ptr.p_int[i] = 0; - } - else - { - state->activeset.ptr.p_int[i] = -1; - } - } - nactiveconstraints = 0; - nactivebnd = 0; - nactivelin = 0; - for(i=0; i<=n-1; i++) - { - - /* - * Activate boundary constraints: - * * copy constraint index to RCTmpConstraintIdx - * * set corresponding element of ActiveSet[] to "candidate" - * * fill RCTmpS by either +1 (lower bound) or -1 (upper bound) - * * set RCTmpIsEquality to False (BndLhasbndl.ptr.p_bool[i]&&state->hasbndu.ptr.p_bool[i])&&ae_fp_eq(state->bndl.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) - { - - /* - * Equality constraint is activated - */ - state->rctmpconstraintidx.ptr.p_int[nactiveconstraints] = i; - state->activeset.ptr.p_int[i] = 0; - state->rctmps.ptr.p_double[i] = 1.0; - state->rctmpisequality.ptr.p_bool[nactiveconstraints] = ae_true; - nactiveconstraints = nactiveconstraints+1; - nactivebnd = nactivebnd+1; - continue; - } - if( state->hasbndl.ptr.p_bool[i]&&ae_fp_eq(state->xc.ptr.p_double[i],state->bndl.ptr.p_double[i]) ) - { - - /* - * Lower bound is activated - */ - state->rctmpconstraintidx.ptr.p_int[nactiveconstraints] = i; - state->activeset.ptr.p_int[i] = 0; - state->rctmps.ptr.p_double[i] = -1.0; - state->rctmpisequality.ptr.p_bool[nactiveconstraints] = ae_false; - nactiveconstraints = nactiveconstraints+1; - nactivebnd = nactivebnd+1; - continue; - } - if( state->hasbndu.ptr.p_bool[i]&&ae_fp_eq(state->xc.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) - { - - /* - * Upper bound is activated - */ - state->rctmpconstraintidx.ptr.p_int[nactiveconstraints] = i; - state->activeset.ptr.p_int[i] = 0; - state->rctmps.ptr.p_double[i] = 1.0; - state->rctmpisequality.ptr.p_bool[nactiveconstraints] = ae_false; - nactiveconstraints = nactiveconstraints+1; - nactivebnd = nactivebnd+1; - continue; - } - } - for(i=0; i<=nec+nic-1; i++) - { - if( i>=nec ) - { - - /* - * Inequality constraints are skipped if we too far away from - * the boundary. - */ - rowscale = 0.0; - v = -state->cleic.ptr.pp_double[i][n]; - for(j=0; j<=n-1; j++) - { - v = v+state->cleic.ptr.pp_double[i][j]*state->xc.ptr.p_double[j]; - rowscale = ae_maxreal(rowscale, ae_fabs(state->cleic.ptr.pp_double[i][j]*state->s.ptr.p_double[j], _state), _state); - } - if( ae_fp_less_eq(v,-1.0E5*ae_machineepsilon*rowscale) ) - { - - /* - * NOTE: it is important to check for non-strict inequality - * because we have to correctly handle zero constraint - * 0*x<=0 - */ - continue; - } - } - ae_v_move(&state->rctmpdense0.ptr.pp_double[0][nactivelin], state->rctmpdense0.stride, &state->cleic.ptr.pp_double[i][0], 1, ae_v_len(0,n-1)); - state->rctmpconstraintidx.ptr.p_int[nactiveconstraints] = n+i; - state->activeset.ptr.p_int[n+i] = 0; - state->rctmpisequality.ptr.p_bool[nactiveconstraints] = ihasbndl.ptr.p_bool[i]&&state->hasbndu.ptr.p_bool[i])&&ae_fp_eq(state->bndl.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) - { - state->activeset.ptr.p_int[i] = 1; - continue; - } - if( (state->hasbndl.ptr.p_bool[i]&&ae_fp_eq(state->xc.ptr.p_double[i],state->bndl.ptr.p_double[i]))&&ae_fp_greater_eq(gc->ptr.p_double[i],0) ) - { - state->activeset.ptr.p_int[i] = 1; - continue; - } - if( (state->hasbndu.ptr.p_bool[i]&&ae_fp_eq(state->xc.ptr.p_double[i],state->bndu.ptr.p_double[i]))&&ae_fp_less_eq(gc->ptr.p_double[i],0) ) - { - state->activeset.ptr.p_int[i] = 1; - continue; - } - } - return; - } - - /* - * General case. - * - * APPROACH TO CONSTRAINTS ACTIVATION/DEACTIVATION - * - * We have NActiveConstraints "candidates": NActiveBnd boundary candidates, - * NActiveLin linear candidates. Indexes of boundary constraints are stored - * in RCTmpConstraintIdx[0:NActiveBnd-1], indexes of linear ones are stored - * in RCTmpConstraintIdx[NActiveBnd:NActiveBnd+NActiveLin-1]. Some of the - * constraints are equality ones, some are inequality - as specified by - * RCTmpIsEquality[i]. - * - * Now we have to determine active subset of "candidates" set. In order to - * do so we solve following constrained minimization problem: - * ( )^2 - * min ( SUM(lambda[i]*A[i]) + G ) - * ( ) - * Here: - * * G is a gradient (column vector) - * * A[i] is a column vector, linear (left) part of I-th constraint. - * I=0..NActiveConstraints-1, first NActiveBnd elements of A are just - * subset of identity matrix (boundary constraints), next NActiveLin - * elements are subset of rows of the matrix of general linear constraints. - * * lambda[i] is a Lagrange multiplier corresponding to I-th constraint - * - * NOTE: for preconditioned setting A is replaced by A*H^(-0.5), G is - * replaced by G*H^(-0.5). We apply this scaling at the last stage, - * before passing data to NNLS solver. - * - * Minimization is performed subject to non-negativity constraints on - * lambda[i] corresponding to inequality constraints. Inequality constraints - * which correspond to non-zero lambda are activated, equality constraints - * are always considered active. - * - * Informally speaking, we "decompose" descent direction -G and represent - * it as sum of constraint vectors and "residual" part (which is equal to - * the actual descent direction subject to constraints). - * - * SOLUTION OF THE NNLS PROBLEM - * - * We solve this optimization problem with Non-Negative Least Squares solver, - * which can efficiently solve least squares problems of the form - * - * ( [ I | AU ] )^2 - * min ( [ | ]*x-b ) s.t. non-negativity constraints on some x[i] - * ( [ 0 | AL ] ) - * - * In order to use this solver we have to rearrange rows of A[] and G in - * such way that first NActiveBnd columns of A store identity matrix (before - * sorting non-zero elements are randomly distributed in the first NActiveBnd - * columns of A, during sorting we move them to first NActiveBnd rows). - * - * Then we create instance of NNLS solver (we reuse instance left from the - * previous run of the optimization problem) and solve NNLS problem. - */ - idx0 = 0; - idx1 = nactivebnd; - for(i=0; i<=n-1; i++) - { - if( state->activeset.ptr.p_int[i]>=0 ) - { - v = 1/ae_sqrt(h->ptr.p_double[i], _state); - for(j=0; j<=nactivelin-1; j++) - { - state->rctmpdense1.ptr.pp_double[idx0][j] = state->rctmpdense0.ptr.pp_double[i][j]/state->rctmps.ptr.p_double[i]*v; - } - state->rctmprightpart.ptr.p_double[idx0] = state->rctmpg.ptr.p_double[i]/state->rctmps.ptr.p_double[i]*v; - idx0 = idx0+1; - } - else - { - v = 1/ae_sqrt(h->ptr.p_double[i], _state); - for(j=0; j<=nactivelin-1; j++) - { - state->rctmpdense1.ptr.pp_double[idx1][j] = state->rctmpdense0.ptr.pp_double[i][j]*v; - } - state->rctmprightpart.ptr.p_double[idx1] = state->rctmpg.ptr.p_double[i]*v; - idx1 = idx1+1; - } - } - snnlsinit(n, nec+nic, n, &state->solver, _state); - snnlssetproblem(&state->solver, &state->rctmpdense1, &state->rctmprightpart, nactivebnd, nactiveconstraints-nactivebnd, n, _state); - for(i=0; i<=nactiveconstraints-1; i++) - { - if( state->rctmpisequality.ptr.p_bool[i] ) - { - snnlsdropnnc(&state->solver, i, _state); - } - } - snnlssolve(&state->solver, &state->rctmplambdas, _state); - - /* - * After solution of the problem we activate equality constraints (always active) - * and inequality constraints with non-zero Lagrange multipliers. Then we reorthogonalize - * active constraints. - */ - for(i=0; i<=nactiveconstraints-1; i++) - { - if( state->rctmpisequality.ptr.p_bool[i]||ae_fp_greater(state->rctmplambdas.ptr.p_double[i],0) ) - { - state->activeset.ptr.p_int[state->rctmpconstraintidx.ptr.p_int[i]] = 1; - } - else - { - state->activeset.ptr.p_int[state->rctmpconstraintidx.ptr.p_int[i]] = 0; - } - } - sasrebuildbasis(state, _state); -} - - -ae_bool _sactiveset_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - sactiveset *p = (sactiveset*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->xc, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->s, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->h, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->activeset, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->sbasis, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->pbasis, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->ibasis, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->hasbndl, 0, DT_BOOL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->hasbndu, 0, DT_BOOL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->bndl, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->bndu, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->cleic, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->mtx, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->mtas, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->cdtmp, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->corrtmp, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->unitdiagonal, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !_snnlssolver_init(&p->solver, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->scntmp, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->tmp0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->tmpfeas, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->tmpm0, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->rctmps, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->rctmpg, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->rctmprightpart, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->rctmpdense0, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->rctmpdense1, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->rctmpisequality, 0, DT_BOOL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->rctmpconstraintidx, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->rctmplambdas, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->tmpbasis, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _sactiveset_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - sactiveset *dst = (sactiveset*)_dst; - sactiveset *src = (sactiveset*)_src; - dst->n = src->n; - dst->algostate = src->algostate; - if( !ae_vector_init_copy(&dst->xc, &src->xc, _state, make_automatic) ) - return ae_false; - dst->hasxc = src->hasxc; - if( !ae_vector_init_copy(&dst->s, &src->s, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->h, &src->h, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->activeset, &src->activeset, _state, make_automatic) ) - return ae_false; - dst->basisisready = src->basisisready; - if( !ae_matrix_init_copy(&dst->sbasis, &src->sbasis, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->pbasis, &src->pbasis, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->ibasis, &src->ibasis, _state, make_automatic) ) - return ae_false; - dst->basissize = src->basissize; - dst->constraintschanged = src->constraintschanged; - if( !ae_vector_init_copy(&dst->hasbndl, &src->hasbndl, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->hasbndu, &src->hasbndu, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->bndl, &src->bndl, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->bndu, &src->bndu, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->cleic, &src->cleic, _state, make_automatic) ) - return ae_false; - dst->nec = src->nec; - dst->nic = src->nic; - if( !ae_vector_init_copy(&dst->mtx, &src->mtx, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->mtas, &src->mtas, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->cdtmp, &src->cdtmp, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->corrtmp, &src->corrtmp, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->unitdiagonal, &src->unitdiagonal, _state, make_automatic) ) - return ae_false; - if( !_snnlssolver_init_copy(&dst->solver, &src->solver, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->scntmp, &src->scntmp, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->tmp0, &src->tmp0, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->tmpfeas, &src->tmpfeas, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->tmpm0, &src->tmpm0, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->rctmps, &src->rctmps, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->rctmpg, &src->rctmpg, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->rctmprightpart, &src->rctmprightpart, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->rctmpdense0, &src->rctmpdense0, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->rctmpdense1, &src->rctmpdense1, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->rctmpisequality, &src->rctmpisequality, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->rctmpconstraintidx, &src->rctmpconstraintidx, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->rctmplambdas, &src->rctmplambdas, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->tmpbasis, &src->tmpbasis, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _sactiveset_clear(void* _p) -{ - sactiveset *p = (sactiveset*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->xc); - ae_vector_clear(&p->s); - ae_vector_clear(&p->h); - ae_vector_clear(&p->activeset); - ae_matrix_clear(&p->sbasis); - ae_matrix_clear(&p->pbasis); - ae_matrix_clear(&p->ibasis); - ae_vector_clear(&p->hasbndl); - ae_vector_clear(&p->hasbndu); - ae_vector_clear(&p->bndl); - ae_vector_clear(&p->bndu); - ae_matrix_clear(&p->cleic); - ae_vector_clear(&p->mtx); - ae_vector_clear(&p->mtas); - ae_vector_clear(&p->cdtmp); - ae_vector_clear(&p->corrtmp); - ae_vector_clear(&p->unitdiagonal); - _snnlssolver_clear(&p->solver); - ae_vector_clear(&p->scntmp); - ae_vector_clear(&p->tmp0); - ae_vector_clear(&p->tmpfeas); - ae_matrix_clear(&p->tmpm0); - ae_vector_clear(&p->rctmps); - ae_vector_clear(&p->rctmpg); - ae_vector_clear(&p->rctmprightpart); - ae_matrix_clear(&p->rctmpdense0); - ae_matrix_clear(&p->rctmpdense1); - ae_vector_clear(&p->rctmpisequality); - ae_vector_clear(&p->rctmpconstraintidx); - ae_vector_clear(&p->rctmplambdas); - ae_matrix_clear(&p->tmpbasis); -} - - -void _sactiveset_destroy(void* _p) -{ - sactiveset *p = (sactiveset*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->xc); - ae_vector_destroy(&p->s); - ae_vector_destroy(&p->h); - ae_vector_destroy(&p->activeset); - ae_matrix_destroy(&p->sbasis); - ae_matrix_destroy(&p->pbasis); - ae_matrix_destroy(&p->ibasis); - ae_vector_destroy(&p->hasbndl); - ae_vector_destroy(&p->hasbndu); - ae_vector_destroy(&p->bndl); - ae_vector_destroy(&p->bndu); - ae_matrix_destroy(&p->cleic); - ae_vector_destroy(&p->mtx); - ae_vector_destroy(&p->mtas); - ae_vector_destroy(&p->cdtmp); - ae_vector_destroy(&p->corrtmp); - ae_vector_destroy(&p->unitdiagonal); - _snnlssolver_destroy(&p->solver); - ae_vector_destroy(&p->scntmp); - ae_vector_destroy(&p->tmp0); - ae_vector_destroy(&p->tmpfeas); - ae_matrix_destroy(&p->tmpm0); - ae_vector_destroy(&p->rctmps); - ae_vector_destroy(&p->rctmpg); - ae_vector_destroy(&p->rctmprightpart); - ae_matrix_destroy(&p->rctmpdense0); - ae_matrix_destroy(&p->rctmpdense1); - ae_vector_destroy(&p->rctmpisequality); - ae_vector_destroy(&p->rctmpconstraintidx); - ae_vector_destroy(&p->rctmplambdas); - ae_matrix_destroy(&p->tmpbasis); -} - - - - -/************************************************************************* - NONLINEAR CONJUGATE GRADIENT METHOD - -DESCRIPTION: -The subroutine minimizes function F(x) of N arguments by using one of the -nonlinear conjugate gradient methods. - -These CG methods are globally convergent (even on non-convex functions) as -long as grad(f) is Lipschitz continuous in a some neighborhood of the -L = { x : f(x)<=f(x0) }. - - -REQUIREMENTS: -Algorithm will request following information during its operation: -* function value F and its gradient G (simultaneously) at given point X - - -USAGE: -1. User initializes algorithm state with MinCGCreate() call -2. User tunes solver parameters with MinCGSetCond(), MinCGSetStpMax() and - other functions -3. User calls MinCGOptimize() function which takes algorithm state and - pointer (delegate, etc.) to callback function which calculates F/G. -4. User calls MinCGResults() to get solution -5. Optionally, user may call MinCGRestartFrom() to solve another problem - with same N but another starting point and/or another function. - MinCGRestartFrom() allows to reuse already initialized structure. - - -INPUT PARAMETERS: - N - problem dimension, N>0: - * if given, only leading N elements of X are used - * if not given, automatically determined from size of X - X - starting point, array[0..N-1]. - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 25.03.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgcreate(ae_int_t n, - /* Real */ ae_vector* x, - mincgstate* state, - ae_state *_state) -{ - - _mincgstate_clear(state); - - ae_assert(n>=1, "MinCGCreate: N too small!", _state); - ae_assert(x->cnt>=n, "MinCGCreate: Length(X)0: - * if given, only leading N elements of X are used - * if not given, automatically determined from size of X - X - starting point, array[0..N-1]. - DiffStep- differentiation step, >0 - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -NOTES: -1. algorithm uses 4-point central formula for differentiation. -2. differentiation step along I-th axis is equal to DiffStep*S[I] where - S[] is scaling vector which can be set by MinCGSetScale() call. -3. we recommend you to use moderate values of differentiation step. Too - large step will result in too large truncation errors, while too small - step will result in too large numerical errors. 1.0E-6 can be good - value to start with. -4. Numerical differentiation is very inefficient - one gradient - calculation needs 4*N function evaluations. This function will work for - any N - either small (1...10), moderate (10...100) or large (100...). - However, performance penalty will be too severe for any N's except for - small ones. - We should also say that code which relies on numerical differentiation - is less robust and precise. L-BFGS needs exact gradient values. - Imprecise gradient may slow down convergence, especially on highly - nonlinear problems. - Thus we recommend to use this function for fast prototyping on small- - dimensional problems only, and to implement analytical gradient as soon - as possible. - - -- ALGLIB -- - Copyright 16.05.2011 by Bochkanov Sergey -*************************************************************************/ -void mincgcreatef(ae_int_t n, - /* Real */ ae_vector* x, - double diffstep, - mincgstate* state, - ae_state *_state) -{ - - _mincgstate_clear(state); - - ae_assert(n>=1, "MinCGCreateF: N too small!", _state); - ae_assert(x->cnt>=n, "MinCGCreateF: Length(X)=0 - The subroutine finishes its work if the condition - |v|=0 - The subroutine finishes its work if on k+1-th iteration - the condition |F(k+1)-F(k)|<=EpsF*max{|F(k)|,|F(k+1)|,1} - is satisfied. - EpsX - >=0 - The subroutine finishes its work if on k+1-th iteration - the condition |v|<=EpsX is fulfilled, where: - * |.| means Euclidian norm - * v - scaled step vector, v[i]=dx[i]/s[i] - * dx - ste pvector, dx=X(k+1)-X(k) - * s - scaling coefficients set by MinCGSetScale() - MaxIts - maximum number of iterations. If MaxIts=0, the number of - iterations is unlimited. - -Passing EpsG=0, EpsF=0, EpsX=0 and MaxIts=0 (simultaneously) will lead to -automatic stopping criterion selection (small EpsX). - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgsetcond(mincgstate* state, - double epsg, - double epsf, - double epsx, - ae_int_t maxits, - ae_state *_state) -{ - - - ae_assert(ae_isfinite(epsg, _state), "MinCGSetCond: EpsG is not finite number!", _state); - ae_assert(ae_fp_greater_eq(epsg,0), "MinCGSetCond: negative EpsG!", _state); - ae_assert(ae_isfinite(epsf, _state), "MinCGSetCond: EpsF is not finite number!", _state); - ae_assert(ae_fp_greater_eq(epsf,0), "MinCGSetCond: negative EpsF!", _state); - ae_assert(ae_isfinite(epsx, _state), "MinCGSetCond: EpsX is not finite number!", _state); - ae_assert(ae_fp_greater_eq(epsx,0), "MinCGSetCond: negative EpsX!", _state); - ae_assert(maxits>=0, "MinCGSetCond: negative MaxIts!", _state); - if( ((ae_fp_eq(epsg,0)&&ae_fp_eq(epsf,0))&&ae_fp_eq(epsx,0))&&maxits==0 ) - { - epsx = 1.0E-6; - } - state->epsg = epsg; - state->epsf = epsf; - state->epsx = epsx; - state->maxits = maxits; -} - - -/************************************************************************* -This function sets scaling coefficients for CG optimizer. - -ALGLIB optimizers use scaling matrices to test stopping conditions (step -size and gradient are scaled before comparison with tolerances). Scale of -the I-th variable is a translation invariant measure of: -a) "how large" the variable is -b) how large the step should be to make significant changes in the function - -Scaling is also used by finite difference variant of CG optimizer - step -along I-th axis is equal to DiffStep*S[I]. - -In most optimizers (and in the CG too) scaling is NOT a form of -preconditioning. It just affects stopping conditions. You should set -preconditioner by separate call to one of the MinCGSetPrec...() functions. - -There is special preconditioning mode, however, which uses scaling -coefficients to form diagonal preconditioning matrix. You can turn this -mode on, if you want. But you should understand that scaling is not the -same thing as preconditioning - these are two different, although related -forms of tuning solver. - -INPUT PARAMETERS: - State - structure stores algorithm state - S - array[N], non-zero scaling coefficients - S[i] may be negative, sign doesn't matter. - - -- ALGLIB -- - Copyright 14.01.2011 by Bochkanov Sergey -*************************************************************************/ -void mincgsetscale(mincgstate* state, - /* Real */ ae_vector* s, - ae_state *_state) -{ - ae_int_t i; - - - ae_assert(s->cnt>=state->n, "MinCGSetScale: Length(S)n-1; i++) - { - ae_assert(ae_isfinite(s->ptr.p_double[i], _state), "MinCGSetScale: S contains infinite or NAN elements", _state); - ae_assert(ae_fp_neq(s->ptr.p_double[i],0), "MinCGSetScale: S contains zero elements", _state); - state->s.ptr.p_double[i] = ae_fabs(s->ptr.p_double[i], _state); - } -} - - -/************************************************************************* -This function turns on/off reporting. - -INPUT PARAMETERS: - State - structure which stores algorithm state - NeedXRep- whether iteration reports are needed or not - -If NeedXRep is True, algorithm will call rep() callback function if it is -provided to MinCGOptimize(). - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgsetxrep(mincgstate* state, ae_bool needxrep, ae_state *_state) -{ - - - state->xrep = needxrep; -} - - -/************************************************************************* -This function turns on/off line search reports. -These reports are described in more details in developer-only comments on -MinCGState object. - -INPUT PARAMETERS: - State - structure which stores algorithm state - NeedDRep- whether line search reports are needed or not - -This function is intended for private use only. Turning it on artificially -may cause program failure. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgsetdrep(mincgstate* state, ae_bool needdrep, ae_state *_state) -{ - - - state->drep = needdrep; -} - - -/************************************************************************* -This function sets CG algorithm. - -INPUT PARAMETERS: - State - structure which stores algorithm state - CGType - algorithm type: - * -1 automatic selection of the best algorithm - * 0 DY (Dai and Yuan) algorithm - * 1 Hybrid DY-HS algorithm - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgsetcgtype(mincgstate* state, ae_int_t cgtype, ae_state *_state) -{ - - - ae_assert(cgtype>=-1&&cgtype<=1, "MinCGSetCGType: incorrect CGType!", _state); - if( cgtype==-1 ) - { - cgtype = 1; - } - state->cgtype = cgtype; -} - - -/************************************************************************* -This function sets maximum step length - -INPUT PARAMETERS: - State - structure which stores algorithm state - StpMax - maximum step length, >=0. Set StpMax to 0.0, if you don't - want to limit step length. - -Use this subroutine when you optimize target function which contains exp() -or other fast growing functions, and optimization algorithm makes too -large steps which leads to overflow. This function allows us to reject -steps that are too large (and therefore expose us to the possible -overflow) without actually calculating function value at the x+stp*d. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgsetstpmax(mincgstate* state, double stpmax, ae_state *_state) -{ - - - ae_assert(ae_isfinite(stpmax, _state), "MinCGSetStpMax: StpMax is not finite!", _state); - ae_assert(ae_fp_greater_eq(stpmax,0), "MinCGSetStpMax: StpMax<0!", _state); - state->stpmax = stpmax; -} - - -/************************************************************************* -This function allows to suggest initial step length to the CG algorithm. - -Suggested step length is used as starting point for the line search. It -can be useful when you have badly scaled problem, i.e. when ||grad|| -(which is used as initial estimate for the first step) is many orders of -magnitude different from the desired step. - -Line search may fail on such problems without good estimate of initial -step length. Imagine, for example, problem with ||grad||=10^50 and desired -step equal to 0.1 Line search function will use 10^50 as initial step, -then it will decrease step length by 2 (up to 20 attempts) and will get -10^44, which is still too large. - -This function allows us to tell than line search should be started from -some moderate step length, like 1.0, so algorithm will be able to detect -desired step length in a several searches. - -Default behavior (when no step is suggested) is to use preconditioner, if -it is available, to generate initial estimate of step length. - -This function influences only first iteration of algorithm. It should be -called between MinCGCreate/MinCGRestartFrom() call and MinCGOptimize call. -Suggested step is ignored if you have preconditioner. - -INPUT PARAMETERS: - State - structure used to store algorithm state. - Stp - initial estimate of the step length. - Can be zero (no estimate). - - -- ALGLIB -- - Copyright 30.07.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgsuggeststep(mincgstate* state, double stp, ae_state *_state) -{ - - - ae_assert(ae_isfinite(stp, _state), "MinCGSuggestStep: Stp is infinite or NAN", _state); - ae_assert(ae_fp_greater_eq(stp,0), "MinCGSuggestStep: Stp<0", _state); - state->suggestedstep = stp; -} - - -/************************************************************************* -Modification of the preconditioner: preconditioning is turned off. - -INPUT PARAMETERS: - State - structure which stores algorithm state - -NOTE: you can change preconditioner "on the fly", during algorithm -iterations. - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgsetprecdefault(mincgstate* state, ae_state *_state) -{ - - - state->prectype = 0; - state->innerresetneeded = ae_true; -} - - -/************************************************************************* -Modification of the preconditioner: diagonal of approximate Hessian is -used. - -INPUT PARAMETERS: - State - structure which stores algorithm state - D - diagonal of the approximate Hessian, array[0..N-1], - (if larger, only leading N elements are used). - -NOTE: you can change preconditioner "on the fly", during algorithm -iterations. - -NOTE 2: D[i] should be positive. Exception will be thrown otherwise. - -NOTE 3: you should pass diagonal of approximate Hessian - NOT ITS INVERSE. - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgsetprecdiag(mincgstate* state, - /* Real */ ae_vector* d, - ae_state *_state) -{ - ae_int_t i; - - - ae_assert(d->cnt>=state->n, "MinCGSetPrecDiag: D is too short", _state); - for(i=0; i<=state->n-1; i++) - { - ae_assert(ae_isfinite(d->ptr.p_double[i], _state), "MinCGSetPrecDiag: D contains infinite or NAN elements", _state); - ae_assert(ae_fp_greater(d->ptr.p_double[i],0), "MinCGSetPrecDiag: D contains non-positive elements", _state); - } - mincgsetprecdiagfast(state, d, _state); -} - - -/************************************************************************* -Modification of the preconditioner: scale-based diagonal preconditioning. - -This preconditioning mode can be useful when you don't have approximate -diagonal of Hessian, but you know that your variables are badly scaled -(for example, one variable is in [1,10], and another in [1000,100000]), -and most part of the ill-conditioning comes from different scales of vars. - -In this case simple scale-based preconditioner, with H[i] = 1/(s[i]^2), -can greatly improve convergence. - -IMPRTANT: you should set scale of your variables with MinCGSetScale() call -(before or after MinCGSetPrecScale() call). Without knowledge of the scale -of your variables scale-based preconditioner will be just unit matrix. - -INPUT PARAMETERS: - State - structure which stores algorithm state - -NOTE: you can change preconditioner "on the fly", during algorithm -iterations. - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgsetprecscale(mincgstate* state, ae_state *_state) -{ - - - state->prectype = 3; - state->innerresetneeded = ae_true; -} - - -/************************************************************************* -NOTES: - -1. This function has two different implementations: one which uses exact - (analytical) user-supplied gradient, and one which uses function value - only and numerically differentiates function in order to obtain - gradient. - - Depending on the specific function used to create optimizer object - (either MinCGCreate() for analytical gradient or MinCGCreateF() for - numerical differentiation) you should choose appropriate variant of - MinCGOptimize() - one which accepts function AND gradient or one which - accepts function ONLY. - - Be careful to choose variant of MinCGOptimize() which corresponds to - your optimization scheme! Table below lists different combinations of - callback (function/gradient) passed to MinCGOptimize() and specific - function used to create optimizer. - - - | USER PASSED TO MinCGOptimize() - CREATED WITH | function only | function and gradient - ------------------------------------------------------------ - MinCGCreateF() | work FAIL - MinCGCreate() | FAIL work - - Here "FAIL" denotes inappropriate combinations of optimizer creation - function and MinCGOptimize() version. Attemps to use such combination - (for example, to create optimizer with MinCGCreateF() and to pass - gradient information to MinCGOptimize()) will lead to exception being - thrown. Either you did not pass gradient when it WAS needed or you - passed gradient when it was NOT needed. - - -- ALGLIB -- - Copyright 20.04.2009 by Bochkanov Sergey -*************************************************************************/ -ae_bool mincgiteration(mincgstate* state, ae_state *_state) -{ - ae_int_t n; - ae_int_t i; - double betak; - double v; - double vv; - ae_bool result; - - - - /* - * Reverse communication preparations - * I know it looks ugly, but it works the same way - * anywhere from C++ to Python. - * - * This code initializes locals by: - * * random values determined during code - * generation - on first subroutine call - * * values from previous call - on subsequent calls - */ - if( state->rstate.stage>=0 ) - { - n = state->rstate.ia.ptr.p_int[0]; - i = state->rstate.ia.ptr.p_int[1]; - betak = state->rstate.ra.ptr.p_double[0]; - v = state->rstate.ra.ptr.p_double[1]; - vv = state->rstate.ra.ptr.p_double[2]; - } - else - { - n = -983; - i = -989; - betak = -834; - v = 900; - vv = -287; - } - if( state->rstate.stage==0 ) - { - goto lbl_0; - } - if( state->rstate.stage==1 ) - { - goto lbl_1; - } - if( state->rstate.stage==2 ) - { - goto lbl_2; - } - if( state->rstate.stage==3 ) - { - goto lbl_3; - } - if( state->rstate.stage==4 ) - { - goto lbl_4; - } - if( state->rstate.stage==5 ) - { - goto lbl_5; - } - if( state->rstate.stage==6 ) - { - goto lbl_6; - } - if( state->rstate.stage==7 ) - { - goto lbl_7; - } - if( state->rstate.stage==8 ) - { - goto lbl_8; - } - if( state->rstate.stage==9 ) - { - goto lbl_9; - } - if( state->rstate.stage==10 ) - { - goto lbl_10; - } - if( state->rstate.stage==11 ) - { - goto lbl_11; - } - if( state->rstate.stage==12 ) - { - goto lbl_12; - } - if( state->rstate.stage==13 ) - { - goto lbl_13; - } - if( state->rstate.stage==14 ) - { - goto lbl_14; - } - if( state->rstate.stage==15 ) - { - goto lbl_15; - } - if( state->rstate.stage==16 ) - { - goto lbl_16; - } - if( state->rstate.stage==17 ) - { - goto lbl_17; - } - if( state->rstate.stage==18 ) - { - goto lbl_18; - } - if( state->rstate.stage==19 ) - { - goto lbl_19; - } - - /* - * Routine body - */ - - /* - * Prepare - */ - n = state->n; - state->repterminationtype = 0; - state->repiterationscount = 0; - state->repvaridx = -1; - state->repnfev = 0; - state->debugrestartscount = 0; - - /* - * Check, that transferred derivative value is right - */ - mincg_clearrequestfields(state, _state); - if( !(ae_fp_eq(state->diffstep,0)&&ae_fp_greater(state->teststep,0)) ) - { - goto lbl_20; - } - state->needfg = ae_true; - i = 0; -lbl_22: - if( i>n-1 ) - { - goto lbl_24; - } - v = state->x.ptr.p_double[i]; - state->x.ptr.p_double[i] = v-state->teststep*state->s.ptr.p_double[i]; - state->rstate.stage = 0; - goto lbl_rcomm; -lbl_0: - state->fm1 = state->f; - state->fp1 = state->g.ptr.p_double[i]; - state->x.ptr.p_double[i] = v+state->teststep*state->s.ptr.p_double[i]; - state->rstate.stage = 1; - goto lbl_rcomm; -lbl_1: - state->fm2 = state->f; - state->fp2 = state->g.ptr.p_double[i]; - state->x.ptr.p_double[i] = v; - state->rstate.stage = 2; - goto lbl_rcomm; -lbl_2: - - /* - * 2*State.TestStep - scale parameter - * width of segment [Xi-TestStep;Xi+TestStep] - */ - if( !derivativecheck(state->fm1, state->fp1, state->fm2, state->fp2, state->f, state->g.ptr.p_double[i], 2*state->teststep, _state) ) - { - state->repvaridx = i; - state->repterminationtype = -7; - result = ae_false; - return result; - } - i = i+1; - goto lbl_22; -lbl_24: - state->needfg = ae_false; -lbl_20: - - /* - * Preparations continue: - * * set XK - * * calculate F/G - * * set DK to -G - * * powerup algo (it may change preconditioner) - * * apply preconditioner to DK - * * report update of X - * * check stopping conditions for G - */ - ae_v_move(&state->xk.ptr.p_double[0], 1, &state->x.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->terminationneeded = ae_false; - mincg_clearrequestfields(state, _state); - if( ae_fp_neq(state->diffstep,0) ) - { - goto lbl_25; - } - state->needfg = ae_true; - state->rstate.stage = 3; - goto lbl_rcomm; -lbl_3: - state->needfg = ae_false; - goto lbl_26; -lbl_25: - state->needf = ae_true; - state->rstate.stage = 4; - goto lbl_rcomm; -lbl_4: - state->fbase = state->f; - i = 0; -lbl_27: - if( i>n-1 ) - { - goto lbl_29; - } - v = state->x.ptr.p_double[i]; - state->x.ptr.p_double[i] = v-state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 5; - goto lbl_rcomm; -lbl_5: - state->fm2 = state->f; - state->x.ptr.p_double[i] = v-0.5*state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 6; - goto lbl_rcomm; -lbl_6: - state->fm1 = state->f; - state->x.ptr.p_double[i] = v+0.5*state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 7; - goto lbl_rcomm; -lbl_7: - state->fp1 = state->f; - state->x.ptr.p_double[i] = v+state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 8; - goto lbl_rcomm; -lbl_8: - state->fp2 = state->f; - state->x.ptr.p_double[i] = v; - state->g.ptr.p_double[i] = (8*(state->fp1-state->fm1)-(state->fp2-state->fm2))/(6*state->diffstep*state->s.ptr.p_double[i]); - i = i+1; - goto lbl_27; -lbl_29: - state->f = state->fbase; - state->needf = ae_false; -lbl_26: - if( !state->drep ) - { - goto lbl_30; - } - - /* - * Report algorithm powerup (if needed) - */ - mincg_clearrequestfields(state, _state); - state->algpowerup = ae_true; - state->rstate.stage = 9; - goto lbl_rcomm; -lbl_9: - state->algpowerup = ae_false; -lbl_30: - trimprepare(state->f, &state->trimthreshold, _state); - ae_v_moveneg(&state->dk.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); - mincg_preconditionedmultiply(state, &state->dk, &state->work0, &state->work1, _state); - if( !state->xrep ) - { - goto lbl_32; - } - mincg_clearrequestfields(state, _state); - state->xupdated = ae_true; - state->rstate.stage = 10; - goto lbl_rcomm; -lbl_10: - state->xupdated = ae_false; -lbl_32: - if( state->terminationneeded ) - { - ae_v_move(&state->xn.ptr.p_double[0], 1, &state->xk.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->repterminationtype = 8; - result = ae_false; - return result; - } - v = 0; - for(i=0; i<=n-1; i++) - { - v = v+ae_sqr(state->g.ptr.p_double[i]*state->s.ptr.p_double[i], _state); - } - if( ae_fp_less_eq(ae_sqrt(v, _state),state->epsg) ) - { - ae_v_move(&state->xn.ptr.p_double[0], 1, &state->xk.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->repterminationtype = 4; - result = ae_false; - return result; - } - state->repnfev = 1; - state->k = 0; - state->fold = state->f; - - /* - * Choose initial step. - * Apply preconditioner, if we have something other than default. - */ - if( state->prectype==2||state->prectype==3 ) - { - - /* - * because we use preconditioner, step length must be equal - * to the norm of DK - */ - v = ae_v_dotproduct(&state->dk.ptr.p_double[0], 1, &state->dk.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->lastgoodstep = ae_sqrt(v, _state); - } - else - { - - /* - * No preconditioner is used, we try to use suggested step - */ - if( ae_fp_greater(state->suggestedstep,0) ) - { - state->lastgoodstep = state->suggestedstep; - } - else - { - state->lastgoodstep = 1.0; - } - } - - /* - * Main cycle - */ - state->rstimer = mincg_rscountdownlen; -lbl_34: - if( ae_false ) - { - goto lbl_35; - } - - /* - * * clear reset flag - * * clear termination flag - * * store G[k] for later calculation of Y[k] - * * prepare starting point and direction and step length for line search - */ - state->innerresetneeded = ae_false; - state->terminationneeded = ae_false; - ae_v_moveneg(&state->yk.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_move(&state->d.ptr.p_double[0], 1, &state->dk.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_move(&state->x.ptr.p_double[0], 1, &state->xk.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->mcstage = 0; - state->stp = 1.0; - linminnormalized(&state->d, &state->stp, n, _state); - if( ae_fp_neq(state->lastgoodstep,0) ) - { - state->stp = state->lastgoodstep; - } - state->curstpmax = state->stpmax; - - /* - * Report beginning of line search (if needed) - * Terminate algorithm, if user request was detected - */ - if( !state->drep ) - { - goto lbl_36; - } - mincg_clearrequestfields(state, _state); - state->lsstart = ae_true; - state->rstate.stage = 11; - goto lbl_rcomm; -lbl_11: - state->lsstart = ae_false; -lbl_36: - if( state->terminationneeded ) - { - ae_v_move(&state->xn.ptr.p_double[0], 1, &state->x.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->repterminationtype = 8; - result = ae_false; - return result; - } - - /* - * Minimization along D - */ - mcsrch(n, &state->x, &state->f, &state->g, &state->d, &state->stp, state->curstpmax, mincg_gtol, &state->mcinfo, &state->nfev, &state->work0, &state->lstate, &state->mcstage, _state); -lbl_38: - if( state->mcstage==0 ) - { - goto lbl_39; - } - - /* - * Calculate function/gradient using either - * analytical gradient supplied by user - * or finite difference approximation. - * - * "Trim" function in order to handle near-singularity points. - */ - mincg_clearrequestfields(state, _state); - if( ae_fp_neq(state->diffstep,0) ) - { - goto lbl_40; - } - state->needfg = ae_true; - state->rstate.stage = 12; - goto lbl_rcomm; -lbl_12: - state->needfg = ae_false; - goto lbl_41; -lbl_40: - state->needf = ae_true; - state->rstate.stage = 13; - goto lbl_rcomm; -lbl_13: - state->fbase = state->f; - i = 0; -lbl_42: - if( i>n-1 ) - { - goto lbl_44; - } - v = state->x.ptr.p_double[i]; - state->x.ptr.p_double[i] = v-state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 14; - goto lbl_rcomm; -lbl_14: - state->fm2 = state->f; - state->x.ptr.p_double[i] = v-0.5*state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 15; - goto lbl_rcomm; -lbl_15: - state->fm1 = state->f; - state->x.ptr.p_double[i] = v+0.5*state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 16; - goto lbl_rcomm; -lbl_16: - state->fp1 = state->f; - state->x.ptr.p_double[i] = v+state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 17; - goto lbl_rcomm; -lbl_17: - state->fp2 = state->f; - state->x.ptr.p_double[i] = v; - state->g.ptr.p_double[i] = (8*(state->fp1-state->fm1)-(state->fp2-state->fm2))/(6*state->diffstep*state->s.ptr.p_double[i]); - i = i+1; - goto lbl_42; -lbl_44: - state->f = state->fbase; - state->needf = ae_false; -lbl_41: - trimfunction(&state->f, &state->g, n, state->trimthreshold, _state); - - /* - * Call MCSRCH again - */ - mcsrch(n, &state->x, &state->f, &state->g, &state->d, &state->stp, state->curstpmax, mincg_gtol, &state->mcinfo, &state->nfev, &state->work0, &state->lstate, &state->mcstage, _state); - goto lbl_38; -lbl_39: - - /* - * * report end of line search - * * store current point to XN - * * report iteration - * * terminate algorithm if user request was detected - */ - if( !state->drep ) - { - goto lbl_45; - } - - /* - * Report end of line search (if needed) - */ - mincg_clearrequestfields(state, _state); - state->lsend = ae_true; - state->rstate.stage = 18; - goto lbl_rcomm; -lbl_18: - state->lsend = ae_false; -lbl_45: - ae_v_move(&state->xn.ptr.p_double[0], 1, &state->x.ptr.p_double[0], 1, ae_v_len(0,n-1)); - if( !state->xrep ) - { - goto lbl_47; - } - mincg_clearrequestfields(state, _state); - state->xupdated = ae_true; - state->rstate.stage = 19; - goto lbl_rcomm; -lbl_19: - state->xupdated = ae_false; -lbl_47: - if( state->terminationneeded ) - { - ae_v_move(&state->xn.ptr.p_double[0], 1, &state->x.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->repterminationtype = 8; - result = ae_false; - return result; - } - - /* - * Line search is finished. - * * calculate BetaK - * * calculate DN - * * update timers - * * calculate step length: - * * LastScaledStep is ALWAYS calculated because it is used in the stopping criteria - * * LastGoodStep is updated only when MCINFO is equal to 1 (Wolfe conditions hold). - * See below for more explanation. - */ - if( state->mcinfo==1&&!state->innerresetneeded ) - { - - /* - * Standard Wolfe conditions hold - * Calculate Y[K] and D[K]'*Y[K] - */ - ae_v_add(&state->yk.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); - vv = ae_v_dotproduct(&state->yk.ptr.p_double[0], 1, &state->dk.ptr.p_double[0], 1, ae_v_len(0,n-1)); - - /* - * Calculate BetaK according to DY formula - */ - v = mincg_preconditionedmultiply2(state, &state->g, &state->g, &state->work0, &state->work1, _state); - state->betady = v/vv; - - /* - * Calculate BetaK according to HS formula - */ - v = mincg_preconditionedmultiply2(state, &state->g, &state->yk, &state->work0, &state->work1, _state); - state->betahs = v/vv; - - /* - * Choose BetaK - */ - if( state->cgtype==0 ) - { - betak = state->betady; - } - if( state->cgtype==1 ) - { - betak = ae_maxreal(0, ae_minreal(state->betady, state->betahs, _state), _state); - } - } - else - { - - /* - * Something is wrong (may be function is too wild or too flat) - * or we just have to restart algo. - * - * We'll set BetaK=0, which will restart CG algorithm. - * We can stop later (during normal checks) if stopping conditions are met. - */ - betak = 0; - state->debugrestartscount = state->debugrestartscount+1; - } - if( state->repiterationscount>0&&state->repiterationscount%(3+n)==0 ) - { - - /* - * clear Beta every N iterations - */ - betak = 0; - } - if( state->mcinfo==1||state->mcinfo==5 ) - { - state->rstimer = mincg_rscountdownlen; - } - else - { - state->rstimer = state->rstimer-1; - } - ae_v_moveneg(&state->dn.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); - mincg_preconditionedmultiply(state, &state->dn, &state->work0, &state->work1, _state); - ae_v_addd(&state->dn.ptr.p_double[0], 1, &state->dk.ptr.p_double[0], 1, ae_v_len(0,n-1), betak); - state->lastscaledstep = 0.0; - for(i=0; i<=n-1; i++) - { - state->lastscaledstep = state->lastscaledstep+ae_sqr(state->d.ptr.p_double[i]/state->s.ptr.p_double[i], _state); - } - state->lastscaledstep = state->stp*ae_sqrt(state->lastscaledstep, _state); - if( state->mcinfo==1 ) - { - - /* - * Step is good (Wolfe conditions hold), update LastGoodStep. - * - * This check for MCINFO=1 is essential because sometimes in the - * constrained optimization setting we may take very short steps - * (like 1E-15) because we were very close to boundary of the - * feasible area. Such short step does not mean that we've converged - * to the solution - it was so short because we were close to the - * boundary and there was a limit on step length. - * - * So having such short step is quite normal situation. However, we - * should NOT start next iteration from step whose initial length is - * estimated as 1E-15 because it may lead to the failure of the - * linear minimizer (step is too short, function does not changes, - * line search stagnates). - */ - state->lastgoodstep = 0; - for(i=0; i<=n-1; i++) - { - state->lastgoodstep = state->lastgoodstep+ae_sqr(state->d.ptr.p_double[i], _state); - } - state->lastgoodstep = state->stp*ae_sqrt(state->lastgoodstep, _state); - } - - /* - * Update information. - * Check stopping conditions. - */ - state->repnfev = state->repnfev+state->nfev; - state->repiterationscount = state->repiterationscount+1; - if( state->repiterationscount>=state->maxits&&state->maxits>0 ) - { - - /* - * Too many iterations - */ - state->repterminationtype = 5; - result = ae_false; - return result; - } - v = 0; - for(i=0; i<=n-1; i++) - { - v = v+ae_sqr(state->g.ptr.p_double[i]*state->s.ptr.p_double[i], _state); - } - if( ae_fp_less_eq(ae_sqrt(v, _state),state->epsg) ) - { - - /* - * Gradient is small enough - */ - state->repterminationtype = 4; - result = ae_false; - return result; - } - if( !state->innerresetneeded ) - { - - /* - * These conditions are checked only when no inner reset was requested by user - */ - if( ae_fp_less_eq(state->fold-state->f,state->epsf*ae_maxreal(ae_fabs(state->fold, _state), ae_maxreal(ae_fabs(state->f, _state), 1.0, _state), _state)) ) - { - - /* - * F(k+1)-F(k) is small enough - */ - state->repterminationtype = 1; - result = ae_false; - return result; - } - if( ae_fp_less_eq(state->lastscaledstep,state->epsx) ) - { - - /* - * X(k+1)-X(k) is small enough - */ - state->repterminationtype = 2; - result = ae_false; - return result; - } - } - if( state->rstimer<=0 ) - { - - /* - * Too many subsequent restarts - */ - state->repterminationtype = 7; - result = ae_false; - return result; - } - - /* - * Shift Xk/Dk, update other information - */ - ae_v_move(&state->xk.ptr.p_double[0], 1, &state->xn.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_move(&state->dk.ptr.p_double[0], 1, &state->dn.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->fold = state->f; - state->k = state->k+1; - goto lbl_34; -lbl_35: - result = ae_false; - return result; - - /* - * Saving state - */ -lbl_rcomm: - result = ae_true; - state->rstate.ia.ptr.p_int[0] = n; - state->rstate.ia.ptr.p_int[1] = i; - state->rstate.ra.ptr.p_double[0] = betak; - state->rstate.ra.ptr.p_double[1] = v; - state->rstate.ra.ptr.p_double[2] = vv; - return result; -} - - -/************************************************************************* -Conjugate gradient results - -INPUT PARAMETERS: - State - algorithm state - -OUTPUT PARAMETERS: - X - array[0..N-1], solution - Rep - optimization report: - * Rep.TerminationType completion code: - * -7 gradient verification failed. - See MinCGSetGradientCheck() for more information. - * 1 relative function improvement is no more than - EpsF. - * 2 relative step is no more than EpsX. - * 4 gradient norm is no more than EpsG - * 5 MaxIts steps was taken - * 7 stopping conditions are too stringent, - further improvement is impossible, - we return best X found so far - * 8 terminated by user - * Rep.IterationsCount contains iterations count - * NFEV contains number of function calculations - - -- ALGLIB -- - Copyright 20.04.2009 by Bochkanov Sergey -*************************************************************************/ -void mincgresults(mincgstate* state, - /* Real */ ae_vector* x, - mincgreport* rep, - ae_state *_state) -{ - - ae_vector_clear(x); - _mincgreport_clear(rep); - - mincgresultsbuf(state, x, rep, _state); -} - - -/************************************************************************* -Conjugate gradient results - -Buffered implementation of MinCGResults(), which uses pre-allocated buffer -to store X[]. If buffer size is too small, it resizes buffer. It is -intended to be used in the inner cycles of performance critical algorithms -where array reallocation penalty is too large to be ignored. - - -- ALGLIB -- - Copyright 20.04.2009 by Bochkanov Sergey -*************************************************************************/ -void mincgresultsbuf(mincgstate* state, - /* Real */ ae_vector* x, - mincgreport* rep, - ae_state *_state) -{ - - - if( x->cntn ) - { - ae_vector_set_length(x, state->n, _state); - } - ae_v_move(&x->ptr.p_double[0], 1, &state->xn.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - rep->iterationscount = state->repiterationscount; - rep->nfev = state->repnfev; - rep->varidx = state->repvaridx; - rep->terminationtype = state->repterminationtype; -} - - -/************************************************************************* -This subroutine restarts CG algorithm from new point. All optimization -parameters are left unchanged. - -This function allows to solve multiple optimization problems (which -must have same number of dimensions) without object reallocation penalty. - -INPUT PARAMETERS: - State - structure used to store algorithm state. - X - new starting point. - - -- ALGLIB -- - Copyright 30.07.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgrestartfrom(mincgstate* state, - /* Real */ ae_vector* x, - ae_state *_state) -{ - - - ae_assert(x->cnt>=state->n, "MinCGRestartFrom: Length(X)n, _state), "MinCGCreate: X contains infinite or NaN values!", _state); - ae_v_move(&state->x.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - mincgsuggeststep(state, 0.0, _state); - ae_vector_set_length(&state->rstate.ia, 1+1, _state); - ae_vector_set_length(&state->rstate.ra, 2+1, _state); - state->rstate.stage = -1; - mincg_clearrequestfields(state, _state); -} - - -/************************************************************************* -Faster version of MinCGSetPrecDiag(), for time-critical parts of code, -without safety checks. - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgsetprecdiagfast(mincgstate* state, - /* Real */ ae_vector* d, - ae_state *_state) -{ - ae_int_t i; - - - rvectorsetlengthatleast(&state->diagh, state->n, _state); - rvectorsetlengthatleast(&state->diaghl2, state->n, _state); - state->prectype = 2; - state->vcnt = 0; - state->innerresetneeded = ae_true; - for(i=0; i<=state->n-1; i++) - { - state->diagh.ptr.p_double[i] = d->ptr.p_double[i]; - state->diaghl2.ptr.p_double[i] = 0.0; - } -} - - -/************************************************************************* -This function sets low-rank preconditioner for Hessian matrix H=D+V'*C*V, -where: -* H is a Hessian matrix, which is approximated by D/V/C -* D=D1+D2 is a diagonal matrix, which includes two positive definite terms: - * constant term D1 (is not updated or infrequently updated) - * variable term D2 (can be cheaply updated from iteration to iteration) -* V is a low-rank correction -* C is a diagonal factor of low-rank correction - -Preconditioner P is calculated using approximate Woodburry formula: - P = D^(-1) - D^(-1)*V'*(C^(-1)+V*D1^(-1)*V')^(-1)*V*D^(-1) - = D^(-1) - D^(-1)*VC'*VC*D^(-1), -where - VC = sqrt(B)*V - B = (C^(-1)+V*D1^(-1)*V')^(-1) - -Note that B is calculated using constant term (D1) only, which allows us -to update D2 without recalculation of B or VC. Such preconditioner is -exact when D2 is zero. When D2 is non-zero, it is only approximation, but -very good and cheap one. - -This function accepts D1, V, C. -D2 is set to zero by default. - -Cost of this update is O(N*VCnt*VCnt), but D2 can be updated in just O(N) -by MinCGSetPrecVarPart. - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgsetpreclowrankfast(mincgstate* state, - /* Real */ ae_vector* d1, - /* Real */ ae_vector* c, - /* Real */ ae_matrix* v, - ae_int_t vcnt, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t n; - double t; - ae_matrix b; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init(&b, 0, 0, DT_REAL, _state, ae_true); - - if( vcnt==0 ) - { - mincgsetprecdiagfast(state, d1, _state); - ae_frame_leave(_state); - return; - } - n = state->n; - ae_matrix_set_length(&b, vcnt, vcnt, _state); - rvectorsetlengthatleast(&state->diagh, n, _state); - rvectorsetlengthatleast(&state->diaghl2, n, _state); - rmatrixsetlengthatleast(&state->vcorr, vcnt, n, _state); - state->prectype = 2; - state->vcnt = vcnt; - state->innerresetneeded = ae_true; - for(i=0; i<=n-1; i++) - { - state->diagh.ptr.p_double[i] = d1->ptr.p_double[i]; - state->diaghl2.ptr.p_double[i] = 0.0; - } - for(i=0; i<=vcnt-1; i++) - { - for(j=i; j<=vcnt-1; j++) - { - t = 0; - for(k=0; k<=n-1; k++) - { - t = t+v->ptr.pp_double[i][k]*v->ptr.pp_double[j][k]/d1->ptr.p_double[k]; - } - b.ptr.pp_double[i][j] = t; - } - b.ptr.pp_double[i][i] = b.ptr.pp_double[i][i]+1.0/c->ptr.p_double[i]; - } - if( !spdmatrixcholeskyrec(&b, 0, vcnt, ae_true, &state->work0, _state) ) - { - state->vcnt = 0; - ae_frame_leave(_state); - return; - } - for(i=0; i<=vcnt-1; i++) - { - ae_v_move(&state->vcorr.ptr.pp_double[i][0], 1, &v->ptr.pp_double[i][0], 1, ae_v_len(0,n-1)); - for(j=0; j<=i-1; j++) - { - t = b.ptr.pp_double[j][i]; - ae_v_subd(&state->vcorr.ptr.pp_double[i][0], 1, &state->vcorr.ptr.pp_double[j][0], 1, ae_v_len(0,n-1), t); - } - t = 1/b.ptr.pp_double[i][i]; - ae_v_muld(&state->vcorr.ptr.pp_double[i][0], 1, ae_v_len(0,n-1), t); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -This function updates variable part (diagonal matrix D2) -of low-rank preconditioner. - -This update is very cheap and takes just O(N) time. - -It has no effect with default preconditioner. - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgsetprecvarpart(mincgstate* state, - /* Real */ ae_vector* d2, - ae_state *_state) -{ - ae_int_t i; - ae_int_t n; - - - n = state->n; - for(i=0; i<=n-1; i++) - { - state->diaghl2.ptr.p_double[i] = d2->ptr.p_double[i]; - } -} - - -/************************************************************************* - -This subroutine turns on verification of the user-supplied analytic -gradient: -* user calls this subroutine before optimization begins -* MinCGOptimize() is called -* prior to actual optimization, for each component of parameters being - optimized X[i] algorithm performs following steps: - * two trial steps are made to X[i]-TestStep*S[i] and X[i]+TestStep*S[i], - where X[i] is i-th component of the initial point and S[i] is a scale - of i-th parameter - * F(X) is evaluated at these trial points - * we perform one more evaluation in the middle point of the interval - * we build cubic model using function values and derivatives at trial - points and we compare its prediction with actual value in the middle - point - * in case difference between prediction and actual value is higher than - some predetermined threshold, algorithm stops with completion code -7; - Rep.VarIdx is set to index of the parameter with incorrect derivative. -* after verification is over, algorithm proceeds to the actual optimization. - -NOTE 1: verification needs N (parameters count) gradient evaluations. It - is very costly and you should use it only for low dimensional - problems, when you want to be sure that you've correctly - calculated analytic derivatives. You should not use it in the - production code (unless you want to check derivatives provided by - some third party). - -NOTE 2: you should carefully choose TestStep. Value which is too large - (so large that function behaviour is significantly non-cubic) will - lead to false alarms. You may use different step for different - parameters by means of setting scale with MinCGSetScale(). - -NOTE 3: this function may lead to false positives. In case it reports that - I-th derivative was calculated incorrectly, you may decrease test - step and try one more time - maybe your function changes too - sharply and your step is too large for such rapidly chanding - function. - -INPUT PARAMETERS: - State - structure used to store algorithm state - TestStep - verification step: - * TestStep=0 turns verification off - * TestStep>0 activates verification - - -- ALGLIB -- - Copyright 31.05.2012 by Bochkanov Sergey -*************************************************************************/ -void mincgsetgradientcheck(mincgstate* state, - double teststep, - ae_state *_state) -{ - - - ae_assert(ae_isfinite(teststep, _state), "MinCGSetGradientCheck: TestStep contains NaN or Infinite", _state); - ae_assert(ae_fp_greater_eq(teststep,0), "MinCGSetGradientCheck: invalid argument TestStep(TestStep<0)", _state); - state->teststep = teststep; -} - - -/************************************************************************* -Clears request fileds (to be sure that we don't forgot to clear something) -*************************************************************************/ -static void mincg_clearrequestfields(mincgstate* state, ae_state *_state) -{ - - - state->needf = ae_false; - state->needfg = ae_false; - state->xupdated = ae_false; - state->lsstart = ae_false; - state->lsend = ae_false; - state->algpowerup = ae_false; -} - - -/************************************************************************* -This function calculates preconditioned product H^(-1)*x and stores result -back into X. Work0[] and Work1[] are used as temporaries (size must be at -least N; this function doesn't allocate arrays). - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -static void mincg_preconditionedmultiply(mincgstate* state, - /* Real */ ae_vector* x, - /* Real */ ae_vector* work0, - /* Real */ ae_vector* work1, - ae_state *_state) -{ - ae_int_t i; - ae_int_t n; - ae_int_t vcnt; - double v; - - - n = state->n; - vcnt = state->vcnt; - if( state->prectype==0 ) - { - return; - } - if( state->prectype==3 ) - { - for(i=0; i<=n-1; i++) - { - x->ptr.p_double[i] = x->ptr.p_double[i]*state->s.ptr.p_double[i]*state->s.ptr.p_double[i]; - } - return; - } - ae_assert(state->prectype==2, "MinCG: internal error (unexpected PrecType)", _state); - - /* - * handle part common for VCnt=0 and VCnt<>0 - */ - for(i=0; i<=n-1; i++) - { - x->ptr.p_double[i] = x->ptr.p_double[i]/(state->diagh.ptr.p_double[i]+state->diaghl2.ptr.p_double[i]); - } - - /* - * if VCnt>0 - */ - if( vcnt>0 ) - { - for(i=0; i<=vcnt-1; i++) - { - v = ae_v_dotproduct(&state->vcorr.ptr.pp_double[i][0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,n-1)); - work0->ptr.p_double[i] = v; - } - for(i=0; i<=n-1; i++) - { - work1->ptr.p_double[i] = 0; - } - for(i=0; i<=vcnt-1; i++) - { - v = work0->ptr.p_double[i]; - ae_v_addd(&state->work1.ptr.p_double[0], 1, &state->vcorr.ptr.pp_double[i][0], 1, ae_v_len(0,n-1), v); - } - for(i=0; i<=n-1; i++) - { - x->ptr.p_double[i] = x->ptr.p_double[i]-state->work1.ptr.p_double[i]/(state->diagh.ptr.p_double[i]+state->diaghl2.ptr.p_double[i]); - } - } -} - - -/************************************************************************* -This function calculates preconditioned product x'*H^(-1)*y. Work0[] and -Work1[] are used as temporaries (size must be at least N; this function -doesn't allocate arrays). - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -static double mincg_preconditionedmultiply2(mincgstate* state, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - /* Real */ ae_vector* work0, - /* Real */ ae_vector* work1, - ae_state *_state) -{ - ae_int_t i; - ae_int_t n; - ae_int_t vcnt; - double v0; - double v1; - double result; - - - n = state->n; - vcnt = state->vcnt; - - /* - * no preconditioning - */ - if( state->prectype==0 ) - { - v0 = ae_v_dotproduct(&x->ptr.p_double[0], 1, &y->ptr.p_double[0], 1, ae_v_len(0,n-1)); - result = v0; - return result; - } - if( state->prectype==3 ) - { - result = 0; - for(i=0; i<=n-1; i++) - { - result = result+x->ptr.p_double[i]*state->s.ptr.p_double[i]*state->s.ptr.p_double[i]*y->ptr.p_double[i]; - } - return result; - } - ae_assert(state->prectype==2, "MinCG: internal error (unexpected PrecType)", _state); - - /* - * low rank preconditioning - */ - result = 0.0; - for(i=0; i<=n-1; i++) - { - result = result+x->ptr.p_double[i]*y->ptr.p_double[i]/(state->diagh.ptr.p_double[i]+state->diaghl2.ptr.p_double[i]); - } - if( vcnt>0 ) - { - for(i=0; i<=n-1; i++) - { - work0->ptr.p_double[i] = x->ptr.p_double[i]/(state->diagh.ptr.p_double[i]+state->diaghl2.ptr.p_double[i]); - work1->ptr.p_double[i] = y->ptr.p_double[i]/(state->diagh.ptr.p_double[i]+state->diaghl2.ptr.p_double[i]); - } - for(i=0; i<=vcnt-1; i++) - { - v0 = ae_v_dotproduct(&work0->ptr.p_double[0], 1, &state->vcorr.ptr.pp_double[i][0], 1, ae_v_len(0,n-1)); - v1 = ae_v_dotproduct(&work1->ptr.p_double[0], 1, &state->vcorr.ptr.pp_double[i][0], 1, ae_v_len(0,n-1)); - result = result-v0*v1; - } - } - return result; -} - - -/************************************************************************* -Internal initialization subroutine - - -- ALGLIB -- - Copyright 16.05.2011 by Bochkanov Sergey -*************************************************************************/ -static void mincg_mincginitinternal(ae_int_t n, - double diffstep, - mincgstate* state, - ae_state *_state) -{ - ae_int_t i; - - - - /* - * Initialize - */ - state->teststep = 0; - state->n = n; - state->diffstep = diffstep; - mincgsetcond(state, 0, 0, 0, 0, _state); - mincgsetxrep(state, ae_false, _state); - mincgsetdrep(state, ae_false, _state); - mincgsetstpmax(state, 0, _state); - mincgsetcgtype(state, -1, _state); - mincgsetprecdefault(state, _state); - ae_vector_set_length(&state->xk, n, _state); - ae_vector_set_length(&state->dk, n, _state); - ae_vector_set_length(&state->xn, n, _state); - ae_vector_set_length(&state->dn, n, _state); - ae_vector_set_length(&state->x, n, _state); - ae_vector_set_length(&state->d, n, _state); - ae_vector_set_length(&state->g, n, _state); - ae_vector_set_length(&state->work0, n, _state); - ae_vector_set_length(&state->work1, n, _state); - ae_vector_set_length(&state->yk, n, _state); - ae_vector_set_length(&state->s, n, _state); - for(i=0; i<=n-1; i++) - { - state->s.ptr.p_double[i] = 1.0; - } -} - - -ae_bool _mincgstate_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - mincgstate *p = (mincgstate*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->diagh, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->diaghl2, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->vcorr, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->s, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->xk, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->dk, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->xn, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->dn, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->d, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->yk, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->g, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) - return ae_false; - if( !_linminstate_init(&p->lstate, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->work0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->work1, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _mincgstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - mincgstate *dst = (mincgstate*)_dst; - mincgstate *src = (mincgstate*)_src; - dst->n = src->n; - dst->epsg = src->epsg; - dst->epsf = src->epsf; - dst->epsx = src->epsx; - dst->maxits = src->maxits; - dst->stpmax = src->stpmax; - dst->suggestedstep = src->suggestedstep; - dst->xrep = src->xrep; - dst->drep = src->drep; - dst->cgtype = src->cgtype; - dst->prectype = src->prectype; - if( !ae_vector_init_copy(&dst->diagh, &src->diagh, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->diaghl2, &src->diaghl2, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->vcorr, &src->vcorr, _state, make_automatic) ) - return ae_false; - dst->vcnt = src->vcnt; - if( !ae_vector_init_copy(&dst->s, &src->s, _state, make_automatic) ) - return ae_false; - dst->diffstep = src->diffstep; - dst->nfev = src->nfev; - dst->mcstage = src->mcstage; - dst->k = src->k; - if( !ae_vector_init_copy(&dst->xk, &src->xk, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->dk, &src->dk, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->xn, &src->xn, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->dn, &src->dn, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->d, &src->d, _state, make_automatic) ) - return ae_false; - dst->fold = src->fold; - dst->stp = src->stp; - dst->curstpmax = src->curstpmax; - if( !ae_vector_init_copy(&dst->yk, &src->yk, _state, make_automatic) ) - return ae_false; - dst->lastgoodstep = src->lastgoodstep; - dst->lastscaledstep = src->lastscaledstep; - dst->mcinfo = src->mcinfo; - dst->innerresetneeded = src->innerresetneeded; - dst->terminationneeded = src->terminationneeded; - dst->trimthreshold = src->trimthreshold; - dst->rstimer = src->rstimer; - if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) - return ae_false; - dst->f = src->f; - if( !ae_vector_init_copy(&dst->g, &src->g, _state, make_automatic) ) - return ae_false; - dst->needf = src->needf; - dst->needfg = src->needfg; - dst->xupdated = src->xupdated; - dst->algpowerup = src->algpowerup; - dst->lsstart = src->lsstart; - dst->lsend = src->lsend; - dst->teststep = src->teststep; - if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) - return ae_false; - dst->repiterationscount = src->repiterationscount; - dst->repnfev = src->repnfev; - dst->repvaridx = src->repvaridx; - dst->repterminationtype = src->repterminationtype; - dst->debugrestartscount = src->debugrestartscount; - if( !_linminstate_init_copy(&dst->lstate, &src->lstate, _state, make_automatic) ) - return ae_false; - dst->fbase = src->fbase; - dst->fm2 = src->fm2; - dst->fm1 = src->fm1; - dst->fp1 = src->fp1; - dst->fp2 = src->fp2; - dst->betahs = src->betahs; - dst->betady = src->betady; - if( !ae_vector_init_copy(&dst->work0, &src->work0, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->work1, &src->work1, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _mincgstate_clear(void* _p) -{ - mincgstate *p = (mincgstate*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->diagh); - ae_vector_clear(&p->diaghl2); - ae_matrix_clear(&p->vcorr); - ae_vector_clear(&p->s); - ae_vector_clear(&p->xk); - ae_vector_clear(&p->dk); - ae_vector_clear(&p->xn); - ae_vector_clear(&p->dn); - ae_vector_clear(&p->d); - ae_vector_clear(&p->yk); - ae_vector_clear(&p->x); - ae_vector_clear(&p->g); - _rcommstate_clear(&p->rstate); - _linminstate_clear(&p->lstate); - ae_vector_clear(&p->work0); - ae_vector_clear(&p->work1); -} - - -void _mincgstate_destroy(void* _p) -{ - mincgstate *p = (mincgstate*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->diagh); - ae_vector_destroy(&p->diaghl2); - ae_matrix_destroy(&p->vcorr); - ae_vector_destroy(&p->s); - ae_vector_destroy(&p->xk); - ae_vector_destroy(&p->dk); - ae_vector_destroy(&p->xn); - ae_vector_destroy(&p->dn); - ae_vector_destroy(&p->d); - ae_vector_destroy(&p->yk); - ae_vector_destroy(&p->x); - ae_vector_destroy(&p->g); - _rcommstate_destroy(&p->rstate); - _linminstate_destroy(&p->lstate); - ae_vector_destroy(&p->work0); - ae_vector_destroy(&p->work1); -} - - -ae_bool _mincgreport_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - mincgreport *p = (mincgreport*)_p; - ae_touch_ptr((void*)p); - return ae_true; -} - - -ae_bool _mincgreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - mincgreport *dst = (mincgreport*)_dst; - mincgreport *src = (mincgreport*)_src; - dst->iterationscount = src->iterationscount; - dst->nfev = src->nfev; - dst->varidx = src->varidx; - dst->terminationtype = src->terminationtype; - return ae_true; -} - - -void _mincgreport_clear(void* _p) -{ - mincgreport *p = (mincgreport*)_p; - ae_touch_ptr((void*)p); -} - - -void _mincgreport_destroy(void* _p) -{ - mincgreport *p = (mincgreport*)_p; - ae_touch_ptr((void*)p); -} - - - - -/************************************************************************* - BOUND CONSTRAINED OPTIMIZATION - WITH ADDITIONAL LINEAR EQUALITY AND INEQUALITY CONSTRAINTS - -DESCRIPTION: -The subroutine minimizes function F(x) of N arguments subject to any -combination of: -* bound constraints -* linear inequality constraints -* linear equality constraints - -REQUIREMENTS: -* user must provide function value and gradient -* starting point X0 must be feasible or - not too far away from the feasible set -* grad(f) must be Lipschitz continuous on a level set: - L = { x : f(x)<=f(x0) } -* function must be defined everywhere on the feasible set F - -USAGE: - -Constrained optimization if far more complex than the unconstrained one. -Here we give very brief outline of the BLEIC optimizer. We strongly recommend -you to read examples in the ALGLIB Reference Manual and to read ALGLIB User Guide -on optimization, which is available at http://www.alglib.net/optimization/ - -1. User initializes algorithm state with MinBLEICCreate() call - -2. USer adds boundary and/or linear constraints by calling - MinBLEICSetBC() and MinBLEICSetLC() functions. - -3. User sets stopping conditions with MinBLEICSetCond(). - -4. User calls MinBLEICOptimize() function which takes algorithm state and - pointer (delegate, etc.) to callback function which calculates F/G. - -5. User calls MinBLEICResults() to get solution - -6. Optionally user may call MinBLEICRestartFrom() to solve another problem - with same N but another starting point. - MinBLEICRestartFrom() allows to reuse already initialized structure. - - -INPUT PARAMETERS: - N - problem dimension, N>0: - * if given, only leading N elements of X are used - * if not given, automatically determined from size ofX - X - starting point, array[N]: - * it is better to set X to a feasible point - * but X can be infeasible, in which case algorithm will try - to find feasible point first, using X as initial - approximation. - -OUTPUT PARAMETERS: - State - structure stores algorithm state - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleiccreate(ae_int_t n, - /* Real */ ae_vector* x, - minbleicstate* state, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix c; - ae_vector ct; - - ae_frame_make(_state, &_frame_block); - _minbleicstate_clear(state); - ae_matrix_init(&c, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&ct, 0, DT_INT, _state, ae_true); - - ae_assert(n>=1, "MinBLEICCreate: N<1", _state); - ae_assert(x->cnt>=n, "MinBLEICCreate: Length(X)0: - * if given, only leading N elements of X are used - * if not given, automatically determined from size of X - X - starting point, array[0..N-1]. - DiffStep- differentiation step, >0 - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -NOTES: -1. algorithm uses 4-point central formula for differentiation. -2. differentiation step along I-th axis is equal to DiffStep*S[I] where - S[] is scaling vector which can be set by MinBLEICSetScale() call. -3. we recommend you to use moderate values of differentiation step. Too - large step will result in too large truncation errors, while too small - step will result in too large numerical errors. 1.0E-6 can be good - value to start with. -4. Numerical differentiation is very inefficient - one gradient - calculation needs 4*N function evaluations. This function will work for - any N - either small (1...10), moderate (10...100) or large (100...). - However, performance penalty will be too severe for any N's except for - small ones. - We should also say that code which relies on numerical differentiation - is less robust and precise. CG needs exact gradient values. Imprecise - gradient may slow down convergence, especially on highly nonlinear - problems. - Thus we recommend to use this function for fast prototyping on small- - dimensional problems only, and to implement analytical gradient as soon - as possible. - - -- ALGLIB -- - Copyright 16.05.2011 by Bochkanov Sergey -*************************************************************************/ -void minbleiccreatef(ae_int_t n, - /* Real */ ae_vector* x, - double diffstep, - minbleicstate* state, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix c; - ae_vector ct; - - ae_frame_make(_state, &_frame_block); - _minbleicstate_clear(state); - ae_matrix_init(&c, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&ct, 0, DT_INT, _state, ae_true); - - ae_assert(n>=1, "MinBLEICCreateF: N<1", _state); - ae_assert(x->cnt>=n, "MinBLEICCreateF: Length(X)nmain; - ae_assert(bndl->cnt>=n, "MinBLEICSetBC: Length(BndL)cnt>=n, "MinBLEICSetBC: Length(BndU)ptr.p_double[i], _state)||ae_isneginf(bndl->ptr.p_double[i], _state), "MinBLEICSetBC: BndL contains NAN or +INF", _state); - ae_assert(ae_isfinite(bndu->ptr.p_double[i], _state)||ae_isposinf(bndu->ptr.p_double[i], _state), "MinBLEICSetBC: BndL contains NAN or -INF", _state); - state->bndl.ptr.p_double[i] = bndl->ptr.p_double[i]; - state->hasbndl.ptr.p_bool[i] = ae_isfinite(bndl->ptr.p_double[i], _state); - state->bndu.ptr.p_double[i] = bndu->ptr.p_double[i]; - state->hasbndu.ptr.p_bool[i] = ae_isfinite(bndu->ptr.p_double[i], _state); - } - sassetbc(&state->sas, bndl, bndu, _state); -} - - -/************************************************************************* -This function sets linear constraints for BLEIC optimizer. - -Linear constraints are inactive by default (after initial creation). -They are preserved after algorithm restart with MinBLEICRestartFrom(). - -INPUT PARAMETERS: - State - structure previously allocated with MinBLEICCreate call. - C - linear constraints, array[K,N+1]. - Each row of C represents one constraint, either equality - or inequality (see below): - * first N elements correspond to coefficients, - * last element corresponds to the right part. - All elements of C (including right part) must be finite. - CT - type of constraints, array[K]: - * if CT[i]>0, then I-th constraint is C[i,*]*x >= C[i,n+1] - * if CT[i]=0, then I-th constraint is C[i,*]*x = C[i,n+1] - * if CT[i]<0, then I-th constraint is C[i,*]*x <= C[i,n+1] - K - number of equality/inequality constraints, K>=0: - * if given, only leading K elements of C/CT are used - * if not given, automatically determined from sizes of C/CT - -NOTE 1: linear (non-bound) constraints are satisfied only approximately: -* there always exists some minor violation (about Epsilon in magnitude) - due to rounding errors -* numerical differentiation, if used, may lead to function evaluations - outside of the feasible area, because algorithm does NOT change - numerical differentiation formula according to linear constraints. -If you want constraints to be satisfied exactly, try to reformulate your -problem in such manner that all constraints will become boundary ones -(this kind of constraints is always satisfied exactly, both in the final -solution and in all intermediate points). - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetlc(minbleicstate* state, - /* Real */ ae_matrix* c, - /* Integer */ ae_vector* ct, - ae_int_t k, - ae_state *_state) -{ - ae_int_t n; - ae_int_t i; - ae_int_t j; - double v; - - - n = state->nmain; - - /* - * First, check for errors in the inputs - */ - ae_assert(k>=0, "MinBLEICSetLC: K<0", _state); - ae_assert(c->cols>=n+1||k==0, "MinBLEICSetLC: Cols(C)rows>=k, "MinBLEICSetLC: Rows(C)cnt>=k, "MinBLEICSetLC: Length(CT)nec = 0; - state->nic = 0; - return; - } - - /* - * Equality constraints are stored first, in the upper - * NEC rows of State.CLEIC matrix. Inequality constraints - * are stored in the next NIC rows. - * - * NOTE: we convert inequality constraints to the form - * A*x<=b before copying them. - */ - rmatrixsetlengthatleast(&state->cleic, k, n+1, _state); - state->nec = 0; - state->nic = 0; - for(i=0; i<=k-1; i++) - { - if( ct->ptr.p_int[i]==0 ) - { - ae_v_move(&state->cleic.ptr.pp_double[state->nec][0], 1, &c->ptr.pp_double[i][0], 1, ae_v_len(0,n)); - state->nec = state->nec+1; - } - } - for(i=0; i<=k-1; i++) - { - if( ct->ptr.p_int[i]!=0 ) - { - if( ct->ptr.p_int[i]>0 ) - { - ae_v_moveneg(&state->cleic.ptr.pp_double[state->nec+state->nic][0], 1, &c->ptr.pp_double[i][0], 1, ae_v_len(0,n)); - } - else - { - ae_v_move(&state->cleic.ptr.pp_double[state->nec+state->nic][0], 1, &c->ptr.pp_double[i][0], 1, ae_v_len(0,n)); - } - state->nic = state->nic+1; - } - } - - /* - * Normalize rows of State.CLEIC: each row must have unit norm. - * Norm is calculated using first N elements (i.e. right part is - * not counted when we calculate norm). - */ - for(i=0; i<=k-1; i++) - { - v = 0; - for(j=0; j<=n-1; j++) - { - v = v+ae_sqr(state->cleic.ptr.pp_double[i][j], _state); - } - if( ae_fp_eq(v,0) ) - { - continue; - } - v = 1/ae_sqrt(v, _state); - ae_v_muld(&state->cleic.ptr.pp_double[i][0], 1, ae_v_len(0,n), v); - } - sassetlc(&state->sas, c, ct, k, _state); -} - - -/************************************************************************* -This function sets stopping conditions for the optimizer. - -INPUT PARAMETERS: - State - structure which stores algorithm state - EpsG - >=0 - The subroutine finishes its work if the condition - |v|=0 - The subroutine finishes its work if on k+1-th iteration - the condition |F(k+1)-F(k)|<=EpsF*max{|F(k)|,|F(k+1)|,1} - is satisfied. - EpsX - >=0 - The subroutine finishes its work if on k+1-th iteration - the condition |v|<=EpsX is fulfilled, where: - * |.| means Euclidian norm - * v - scaled step vector, v[i]=dx[i]/s[i] - * dx - step vector, dx=X(k+1)-X(k) - * s - scaling coefficients set by MinBLEICSetScale() - MaxIts - maximum number of iterations. If MaxIts=0, the number of - iterations is unlimited. - -Passing EpsG=0, EpsF=0 and EpsX=0 and MaxIts=0 (simultaneously) will lead -to automatic stopping criterion selection. - -NOTE: when SetCond() called with non-zero MaxIts, BLEIC solver may perform - slightly more than MaxIts iterations. I.e., MaxIts sets non-strict - limit on iterations count. - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetcond(minbleicstate* state, - double epsg, - double epsf, - double epsx, - ae_int_t maxits, - ae_state *_state) -{ - - - ae_assert(ae_isfinite(epsg, _state), "MinBLEICSetCond: EpsG is not finite number", _state); - ae_assert(ae_fp_greater_eq(epsg,0), "MinBLEICSetCond: negative EpsG", _state); - ae_assert(ae_isfinite(epsf, _state), "MinBLEICSetCond: EpsF is not finite number", _state); - ae_assert(ae_fp_greater_eq(epsf,0), "MinBLEICSetCond: negative EpsF", _state); - ae_assert(ae_isfinite(epsx, _state), "MinBLEICSetCond: EpsX is not finite number", _state); - ae_assert(ae_fp_greater_eq(epsx,0), "MinBLEICSetCond: negative EpsX", _state); - ae_assert(maxits>=0, "MinBLEICSetCond: negative MaxIts!", _state); - if( ((ae_fp_eq(epsg,0)&&ae_fp_eq(epsf,0))&&ae_fp_eq(epsx,0))&&maxits==0 ) - { - epsx = 1.0E-6; - } - state->epsg = epsg; - state->epsf = epsf; - state->epsx = epsx; - state->maxits = maxits; -} - - -/************************************************************************* -This function sets scaling coefficients for BLEIC optimizer. - -ALGLIB optimizers use scaling matrices to test stopping conditions (step -size and gradient are scaled before comparison with tolerances). Scale of -the I-th variable is a translation invariant measure of: -a) "how large" the variable is -b) how large the step should be to make significant changes in the function - -Scaling is also used by finite difference variant of the optimizer - step -along I-th axis is equal to DiffStep*S[I]. - -In most optimizers (and in the BLEIC too) scaling is NOT a form of -preconditioning. It just affects stopping conditions. You should set -preconditioner by separate call to one of the MinBLEICSetPrec...() -functions. - -There is a special preconditioning mode, however, which uses scaling -coefficients to form diagonal preconditioning matrix. You can turn this -mode on, if you want. But you should understand that scaling is not the -same thing as preconditioning - these are two different, although related -forms of tuning solver. - -INPUT PARAMETERS: - State - structure stores algorithm state - S - array[N], non-zero scaling coefficients - S[i] may be negative, sign doesn't matter. - - -- ALGLIB -- - Copyright 14.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetscale(minbleicstate* state, - /* Real */ ae_vector* s, - ae_state *_state) -{ - ae_int_t i; - - - ae_assert(s->cnt>=state->nmain, "MinBLEICSetScale: Length(S)nmain-1; i++) - { - ae_assert(ae_isfinite(s->ptr.p_double[i], _state), "MinBLEICSetScale: S contains infinite or NAN elements", _state); - ae_assert(ae_fp_neq(s->ptr.p_double[i],0), "MinBLEICSetScale: S contains zero elements", _state); - state->s.ptr.p_double[i] = ae_fabs(s->ptr.p_double[i], _state); - } - sassetscale(&state->sas, s, _state); -} - - -/************************************************************************* -Modification of the preconditioner: preconditioning is turned off. - -INPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetprecdefault(minbleicstate* state, ae_state *_state) -{ - - - state->prectype = 0; -} - - -/************************************************************************* -Modification of the preconditioner: diagonal of approximate Hessian is -used. - -INPUT PARAMETERS: - State - structure which stores algorithm state - D - diagonal of the approximate Hessian, array[0..N-1], - (if larger, only leading N elements are used). - -NOTE 1: D[i] should be positive. Exception will be thrown otherwise. - -NOTE 2: you should pass diagonal of approximate Hessian - NOT ITS INVERSE. - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetprecdiag(minbleicstate* state, - /* Real */ ae_vector* d, - ae_state *_state) -{ - ae_int_t i; - - - ae_assert(d->cnt>=state->nmain, "MinBLEICSetPrecDiag: D is too short", _state); - for(i=0; i<=state->nmain-1; i++) - { - ae_assert(ae_isfinite(d->ptr.p_double[i], _state), "MinBLEICSetPrecDiag: D contains infinite or NAN elements", _state); - ae_assert(ae_fp_greater(d->ptr.p_double[i],0), "MinBLEICSetPrecDiag: D contains non-positive elements", _state); - } - rvectorsetlengthatleast(&state->diagh, state->nmain, _state); - state->prectype = 2; - for(i=0; i<=state->nmain-1; i++) - { - state->diagh.ptr.p_double[i] = d->ptr.p_double[i]; - } -} - - -/************************************************************************* -Modification of the preconditioner: scale-based diagonal preconditioning. - -This preconditioning mode can be useful when you don't have approximate -diagonal of Hessian, but you know that your variables are badly scaled -(for example, one variable is in [1,10], and another in [1000,100000]), -and most part of the ill-conditioning comes from different scales of vars. - -In this case simple scale-based preconditioner, with H[i] = 1/(s[i]^2), -can greatly improve convergence. - -IMPRTANT: you should set scale of your variables with MinBLEICSetScale() -call (before or after MinBLEICSetPrecScale() call). Without knowledge of -the scale of your variables scale-based preconditioner will be just unit -matrix. - -INPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetprecscale(minbleicstate* state, ae_state *_state) -{ - - - state->prectype = 3; -} - - -/************************************************************************* -This function turns on/off reporting. - -INPUT PARAMETERS: - State - structure which stores algorithm state - NeedXRep- whether iteration reports are needed or not - -If NeedXRep is True, algorithm will call rep() callback function if it is -provided to MinBLEICOptimize(). - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetxrep(minbleicstate* state, - ae_bool needxrep, - ae_state *_state) -{ - - - state->xrep = needxrep; -} - - -/************************************************************************* -This function turns on/off line search reports. -These reports are described in more details in developer-only comments on -MinBLEICState object. - -INPUT PARAMETERS: - State - structure which stores algorithm state - NeedDRep- whether line search reports are needed or not - -This function is intended for private use only. Turning it on artificially -may cause program failure. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetdrep(minbleicstate* state, - ae_bool needdrep, - ae_state *_state) -{ - - - state->drep = needdrep; -} - - -/************************************************************************* -This function sets maximum step length - -IMPORTANT: this feature is hard to combine with preconditioning. You can't -set upper limit on step length, when you solve optimization problem with -linear (non-boundary) constraints AND preconditioner turned on. - -When non-boundary constraints are present, you have to either a) use -preconditioner, or b) use upper limit on step length. YOU CAN'T USE BOTH! -In this case algorithm will terminate with appropriate error code. - -INPUT PARAMETERS: - State - structure which stores algorithm state - StpMax - maximum step length, >=0. Set StpMax to 0.0, if you don't - want to limit step length. - -Use this subroutine when you optimize target function which contains exp() -or other fast growing functions, and optimization algorithm makes too -large steps which lead to overflow. This function allows us to reject -steps that are too large (and therefore expose us to the possible -overflow) without actually calculating function value at the x+stp*d. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetstpmax(minbleicstate* state, - double stpmax, - ae_state *_state) -{ - - - ae_assert(ae_isfinite(stpmax, _state), "MinBLEICSetStpMax: StpMax is not finite!", _state); - ae_assert(ae_fp_greater_eq(stpmax,0), "MinBLEICSetStpMax: StpMax<0!", _state); - state->stpmax = stpmax; -} - - -/************************************************************************* -NOTES: - -1. This function has two different implementations: one which uses exact - (analytical) user-supplied gradient, and one which uses function value - only and numerically differentiates function in order to obtain - gradient. - - Depending on the specific function used to create optimizer object - (either MinBLEICCreate() for analytical gradient or MinBLEICCreateF() - for numerical differentiation) you should choose appropriate variant of - MinBLEICOptimize() - one which accepts function AND gradient or one - which accepts function ONLY. - - Be careful to choose variant of MinBLEICOptimize() which corresponds to - your optimization scheme! Table below lists different combinations of - callback (function/gradient) passed to MinBLEICOptimize() and specific - function used to create optimizer. - - - | USER PASSED TO MinBLEICOptimize() - CREATED WITH | function only | function and gradient - ------------------------------------------------------------ - MinBLEICCreateF() | work FAIL - MinBLEICCreate() | FAIL work - - Here "FAIL" denotes inappropriate combinations of optimizer creation - function and MinBLEICOptimize() version. Attemps to use such - combination (for example, to create optimizer with MinBLEICCreateF() - and to pass gradient information to MinCGOptimize()) will lead to - exception being thrown. Either you did not pass gradient when it WAS - needed or you passed gradient when it was NOT needed. - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -ae_bool minbleiciteration(minbleicstate* state, ae_state *_state) -{ - ae_int_t n; - ae_int_t m; - ae_int_t i; - ae_int_t j; - double v; - double vv; - ae_int_t badbfgsits; - ae_bool b; - ae_int_t nextaction; - ae_int_t mcinfo; - ae_int_t actstatus; - ae_int_t ic; - double penalty; - double ginit; - double gdecay; - ae_bool result; - - - - /* - * Reverse communication preparations - * I know it looks ugly, but it works the same way - * anywhere from C++ to Python. - * - * This code initializes locals by: - * * random values determined during code - * generation - on first subroutine call - * * values from previous call - on subsequent calls - */ - if( state->rstate.stage>=0 ) - { - n = state->rstate.ia.ptr.p_int[0]; - m = state->rstate.ia.ptr.p_int[1]; - i = state->rstate.ia.ptr.p_int[2]; - j = state->rstate.ia.ptr.p_int[3]; - badbfgsits = state->rstate.ia.ptr.p_int[4]; - nextaction = state->rstate.ia.ptr.p_int[5]; - mcinfo = state->rstate.ia.ptr.p_int[6]; - actstatus = state->rstate.ia.ptr.p_int[7]; - ic = state->rstate.ia.ptr.p_int[8]; - b = state->rstate.ba.ptr.p_bool[0]; - v = state->rstate.ra.ptr.p_double[0]; - vv = state->rstate.ra.ptr.p_double[1]; - penalty = state->rstate.ra.ptr.p_double[2]; - ginit = state->rstate.ra.ptr.p_double[3]; - gdecay = state->rstate.ra.ptr.p_double[4]; - } - else - { - n = -983; - m = -989; - i = -834; - j = 900; - badbfgsits = -287; - nextaction = 364; - mcinfo = 214; - actstatus = -338; - ic = -686; - b = ae_false; - v = 585; - vv = 497; - penalty = -271; - ginit = -581; - gdecay = 745; - } - if( state->rstate.stage==0 ) - { - goto lbl_0; - } - if( state->rstate.stage==1 ) - { - goto lbl_1; - } - if( state->rstate.stage==2 ) - { - goto lbl_2; - } - if( state->rstate.stage==3 ) - { - goto lbl_3; - } - if( state->rstate.stage==4 ) - { - goto lbl_4; - } - if( state->rstate.stage==5 ) - { - goto lbl_5; - } - if( state->rstate.stage==6 ) - { - goto lbl_6; - } - if( state->rstate.stage==7 ) - { - goto lbl_7; - } - if( state->rstate.stage==8 ) - { - goto lbl_8; - } - if( state->rstate.stage==9 ) - { - goto lbl_9; - } - if( state->rstate.stage==10 ) - { - goto lbl_10; - } - if( state->rstate.stage==11 ) - { - goto lbl_11; - } - if( state->rstate.stage==12 ) - { - goto lbl_12; - } - if( state->rstate.stage==13 ) - { - goto lbl_13; - } - if( state->rstate.stage==14 ) - { - goto lbl_14; - } - if( state->rstate.stage==15 ) - { - goto lbl_15; - } - if( state->rstate.stage==16 ) - { - goto lbl_16; - } - if( state->rstate.stage==17 ) - { - goto lbl_17; - } - if( state->rstate.stage==18 ) - { - goto lbl_18; - } - if( state->rstate.stage==19 ) - { - goto lbl_19; - } - if( state->rstate.stage==20 ) - { - goto lbl_20; - } - if( state->rstate.stage==21 ) - { - goto lbl_21; - } - if( state->rstate.stage==22 ) - { - goto lbl_22; - } - if( state->rstate.stage==23 ) - { - goto lbl_23; - } - if( state->rstate.stage==24 ) - { - goto lbl_24; - } - if( state->rstate.stage==25 ) - { - goto lbl_25; - } - if( state->rstate.stage==26 ) - { - goto lbl_26; - } - if( state->rstate.stage==27 ) - { - goto lbl_27; - } - if( state->rstate.stage==28 ) - { - goto lbl_28; - } - if( state->rstate.stage==29 ) - { - goto lbl_29; - } - if( state->rstate.stage==30 ) - { - goto lbl_30; - } - if( state->rstate.stage==31 ) - { - goto lbl_31; - } - if( state->rstate.stage==32 ) - { - goto lbl_32; - } - if( state->rstate.stage==33 ) - { - goto lbl_33; - } - if( state->rstate.stage==34 ) - { - goto lbl_34; - } - if( state->rstate.stage==35 ) - { - goto lbl_35; - } - if( state->rstate.stage==36 ) - { - goto lbl_36; - } - if( state->rstate.stage==37 ) - { - goto lbl_37; - } - if( state->rstate.stage==38 ) - { - goto lbl_38; - } - if( state->rstate.stage==39 ) - { - goto lbl_39; - } - if( state->rstate.stage==40 ) - { - goto lbl_40; - } - if( state->rstate.stage==41 ) - { - goto lbl_41; - } - - /* - * Routine body - */ - - /* - * Algorithm parameters: - * * M number of L-BFGS corrections. - * This coefficient remains fixed during iterations. - * * GDecay desired decrease of constrained gradient during L-BFGS iterations. - * This coefficient is decreased after each L-BFGS round until - * it reaches minimum decay. - */ - m = ae_minint(5, state->nmain, _state); - gdecay = minbleic_initialdecay; - - /* - * Init - */ - n = state->nmain; - state->repterminationtype = 0; - state->repinneriterationscount = 0; - state->repouteriterationscount = 0; - state->repnfev = 0; - state->repvaridx = -1; - state->repdebugeqerr = 0.0; - state->repdebugfs = _state->v_nan; - state->repdebugff = _state->v_nan; - state->repdebugdx = _state->v_nan; - if( ae_fp_neq(state->stpmax,0)&&state->prectype!=0 ) - { - state->repterminationtype = -10; - result = ae_false; - return result; - } - rvectorsetlengthatleast(&state->rho, m, _state); - rvectorsetlengthatleast(&state->theta, m, _state); - rmatrixsetlengthatleast(&state->yk, m, n, _state); - rmatrixsetlengthatleast(&state->sk, m, n, _state); - - /* - * Fill TmpPrec with current preconditioner - */ - rvectorsetlengthatleast(&state->tmpprec, n, _state); - for(i=0; i<=n-1; i++) - { - if( state->prectype==2 ) - { - state->tmpprec.ptr.p_double[i] = state->diagh.ptr.p_double[i]; - continue; - } - if( state->prectype==3 ) - { - state->tmpprec.ptr.p_double[i] = 1/ae_sqr(state->s.ptr.p_double[i], _state); - continue; - } - state->tmpprec.ptr.p_double[i] = 1; - } - sassetprecdiag(&state->sas, &state->tmpprec, _state); - - /* - * Start optimization - */ - if( !sasstartoptimization(&state->sas, &state->xstart, _state) ) - { - state->repterminationtype = -3; - result = ae_false; - return result; - } - - /* - * Check correctness of user-supplied gradient - */ - if( !(ae_fp_eq(state->diffstep,0)&&ae_fp_greater(state->teststep,0)) ) - { - goto lbl_42; - } - minbleic_clearrequestfields(state, _state); - ae_v_move(&state->x.ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->needfg = ae_true; - i = 0; -lbl_44: - if( i>n-1 ) - { - goto lbl_46; - } - ae_assert(!state->hasbndl.ptr.p_bool[i]||ae_fp_greater_eq(state->sas.xc.ptr.p_double[i],state->bndl.ptr.p_double[i]), "MinBLEICIteration: internal error(State.X is out of bounds)", _state); - ae_assert(!state->hasbndu.ptr.p_bool[i]||ae_fp_less_eq(state->sas.xc.ptr.p_double[i],state->bndu.ptr.p_double[i]), "MinBLEICIteration: internal error(State.X is out of bounds)", _state); - v = state->x.ptr.p_double[i]; - state->x.ptr.p_double[i] = v-state->teststep*state->s.ptr.p_double[i]; - if( state->hasbndl.ptr.p_bool[i] ) - { - state->x.ptr.p_double[i] = ae_maxreal(state->x.ptr.p_double[i], state->bndl.ptr.p_double[i], _state); - } - state->xm1 = state->x.ptr.p_double[i]; - state->rstate.stage = 0; - goto lbl_rcomm; -lbl_0: - state->fm1 = state->f; - state->gm1 = state->g.ptr.p_double[i]; - state->x.ptr.p_double[i] = v+state->teststep*state->s.ptr.p_double[i]; - if( state->hasbndu.ptr.p_bool[i] ) - { - state->x.ptr.p_double[i] = ae_minreal(state->x.ptr.p_double[i], state->bndu.ptr.p_double[i], _state); - } - state->xp1 = state->x.ptr.p_double[i]; - state->rstate.stage = 1; - goto lbl_rcomm; -lbl_1: - state->fp1 = state->f; - state->gp1 = state->g.ptr.p_double[i]; - state->x.ptr.p_double[i] = (state->xm1+state->xp1)/2; - if( state->hasbndl.ptr.p_bool[i] ) - { - state->x.ptr.p_double[i] = ae_maxreal(state->x.ptr.p_double[i], state->bndl.ptr.p_double[i], _state); - } - if( state->hasbndu.ptr.p_bool[i] ) - { - state->x.ptr.p_double[i] = ae_minreal(state->x.ptr.p_double[i], state->bndu.ptr.p_double[i], _state); - } - state->rstate.stage = 2; - goto lbl_rcomm; -lbl_2: - state->x.ptr.p_double[i] = v; - if( !derivativecheck(state->fm1, state->gm1, state->fp1, state->gp1, state->f, state->g.ptr.p_double[i], state->xp1-state->xm1, _state) ) - { - state->repvaridx = i; - state->repterminationtype = -7; - sasstopoptimization(&state->sas, _state); - result = ae_false; - return result; - } - i = i+1; - goto lbl_44; -lbl_46: - state->needfg = ae_false; -lbl_42: - - /* - * Main cycle of BLEIC-PG algorithm - */ - state->repterminationtype = 4; - badbfgsits = 0; - state->lastgoodstep = 0; - state->lastscaledgoodstep = 0; - state->maxscaledgrad = 0; - state->nonmonotoniccnt = n+state->nic; - ae_v_move(&state->x.ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - minbleic_clearrequestfields(state, _state); - if( ae_fp_neq(state->diffstep,0) ) - { - goto lbl_47; - } - state->needfg = ae_true; - state->rstate.stage = 3; - goto lbl_rcomm; -lbl_3: - state->needfg = ae_false; - goto lbl_48; -lbl_47: - state->needf = ae_true; - state->rstate.stage = 4; - goto lbl_rcomm; -lbl_4: - state->needf = ae_false; -lbl_48: - state->fc = state->f; - trimprepare(state->f, &state->trimthreshold, _state); - state->repnfev = state->repnfev+1; - if( !state->xrep ) - { - goto lbl_49; - } - - /* - * Report current point - */ - ae_v_move(&state->x.ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->f = state->fc; - state->xupdated = ae_true; - state->rstate.stage = 5; - goto lbl_rcomm; -lbl_5: - state->xupdated = ae_false; -lbl_49: -lbl_51: - if( ae_false ) - { - goto lbl_52; - } - - /* - * Phase 1 - * - * (a) calculate unconstrained gradient - * (b) determine active set - * (c) update MaxScaledGrad - */ - ae_v_move(&state->x.ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - minbleic_clearrequestfields(state, _state); - if( ae_fp_neq(state->diffstep,0) ) - { - goto lbl_53; - } - - /* - * Analytic gradient - */ - state->needfg = ae_true; - state->rstate.stage = 6; - goto lbl_rcomm; -lbl_6: - state->needfg = ae_false; - goto lbl_54; -lbl_53: - - /* - * Numerical differentiation - */ - state->needf = ae_true; - state->rstate.stage = 7; - goto lbl_rcomm; -lbl_7: - state->fbase = state->f; - i = 0; -lbl_55: - if( i>n-1 ) - { - goto lbl_57; - } - v = state->x.ptr.p_double[i]; - b = ae_false; - if( state->hasbndl.ptr.p_bool[i] ) - { - b = b||ae_fp_less(v-state->diffstep*state->s.ptr.p_double[i],state->bndl.ptr.p_double[i]); - } - if( state->hasbndu.ptr.p_bool[i] ) - { - b = b||ae_fp_greater(v+state->diffstep*state->s.ptr.p_double[i],state->bndu.ptr.p_double[i]); - } - if( b ) - { - goto lbl_58; - } - state->x.ptr.p_double[i] = v-state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 8; - goto lbl_rcomm; -lbl_8: - state->fm2 = state->f; - state->x.ptr.p_double[i] = v-0.5*state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 9; - goto lbl_rcomm; -lbl_9: - state->fm1 = state->f; - state->x.ptr.p_double[i] = v+0.5*state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 10; - goto lbl_rcomm; -lbl_10: - state->fp1 = state->f; - state->x.ptr.p_double[i] = v+state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 11; - goto lbl_rcomm; -lbl_11: - state->fp2 = state->f; - state->g.ptr.p_double[i] = (8*(state->fp1-state->fm1)-(state->fp2-state->fm2))/(6*state->diffstep*state->s.ptr.p_double[i]); - goto lbl_59; -lbl_58: - state->xm1 = v-state->diffstep*state->s.ptr.p_double[i]; - state->xp1 = v+state->diffstep*state->s.ptr.p_double[i]; - if( state->hasbndl.ptr.p_bool[i]&&ae_fp_less(state->xm1,state->bndl.ptr.p_double[i]) ) - { - state->xm1 = state->bndl.ptr.p_double[i]; - } - if( state->hasbndu.ptr.p_bool[i]&&ae_fp_greater(state->xp1,state->bndu.ptr.p_double[i]) ) - { - state->xp1 = state->bndu.ptr.p_double[i]; - } - state->x.ptr.p_double[i] = state->xm1; - state->rstate.stage = 12; - goto lbl_rcomm; -lbl_12: - state->fm1 = state->f; - state->x.ptr.p_double[i] = state->xp1; - state->rstate.stage = 13; - goto lbl_rcomm; -lbl_13: - state->fp1 = state->f; - if( ae_fp_neq(state->xm1,state->xp1) ) - { - state->g.ptr.p_double[i] = (state->fp1-state->fm1)/(state->xp1-state->xm1); - } - else - { - state->g.ptr.p_double[i] = 0; - } -lbl_59: - state->x.ptr.p_double[i] = v; - i = i+1; - goto lbl_55; -lbl_57: - state->f = state->fbase; - state->needf = ae_false; -lbl_54: - state->fc = state->f; - ae_v_move(&state->gc.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); - sasreactivateconstraintsprec(&state->sas, &state->gc, _state); - v = 0.0; - for(i=0; i<=n-1; i++) - { - v = v+ae_sqr(state->gc.ptr.p_double[i]*state->s.ptr.p_double[i], _state); - } - state->maxscaledgrad = ae_maxreal(state->maxscaledgrad, ae_sqrt(v, _state), _state); - - /* - * Phase 2: perform steepest descent step. - * - * NextAction control variable is set on exit from this loop: - * * NextAction>0 in case we have to proceed to Phase 3 (L-BFGS step) - * * NextAction<0 in case we have to proceed to Phase 1 (recalculate active set) - * * NextAction=0 in case we found solution (step size or function change are small enough) - */ - nextaction = 0; -lbl_60: - if( ae_false ) - { - goto lbl_61; - } - - /* - * Check gradient-based stopping criteria - */ - if( ae_fp_less_eq(sasscaledconstrainednorm(&state->sas, &state->gc, _state),state->epsg) ) - { - - /* - * Gradient is small enough, stop iterations - */ - state->repterminationtype = 4; - nextaction = 0; - goto lbl_61; - } - - /* - * Calculate normalized constrained descent direction, store to D. - * Try to use previous scaled step length as initial estimate for new step. - * - * NOTE: D can be exactly zero, in this case Stp is set to 1.0 - */ - sasconstraineddescentprec(&state->sas, &state->gc, &state->d, _state); - v = 0; - for(i=0; i<=n-1; i++) - { - v = v+ae_sqr(state->d.ptr.p_double[i]/state->s.ptr.p_double[i], _state); - } - v = ae_sqrt(v, _state); - if( ae_fp_greater(state->lastscaledgoodstep,0)&&ae_fp_greater(v,0) ) - { - state->stp = state->lastscaledgoodstep/v; - } - else - { - state->stp = 1.0; - } - - /* - * Calculate bound on step length. - * Enforce user-supplied limit on step length. - */ - sasexploredirection(&state->sas, &state->d, &state->curstpmax, &state->cidx, &state->cval, _state); - state->activationstep = state->curstpmax; - if( state->cidx>=0&&ae_fp_eq(state->activationstep,0) ) - { - sasimmediateactivation(&state->sas, state->cidx, state->cval, _state); - goto lbl_60; - } - if( ae_fp_greater(state->stpmax,0) ) - { - state->curstpmax = ae_minreal(state->curstpmax, state->stpmax, _state); - } - - /* - * Report beginning of line search (if requested by caller). - * See description of the MinBLEICState for more information - * about fields accessible to caller. - * - * Caller may do following: - * * change State.Stp and load better initial estimate of - * the step length. - */ - if( !state->drep ) - { - goto lbl_62; - } - minbleic_clearrequestfields(state, _state); - state->lsstart = ae_true; - state->lbfgssearch = ae_false; - state->boundedstep = state->cidx>=0; - ae_v_move(&state->x.ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_move(&state->g.ptr.p_double[0], 1, &state->gc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->f = state->fc; - state->rstate.stage = 14; - goto lbl_rcomm; -lbl_14: - state->lsstart = ae_false; -lbl_62: - - /* - * Perform optimization of F along XC+alpha*D. - */ - state->mcstage = 0; - ae_v_move(&state->xn.ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_move(&state->gn.ptr.p_double[0], 1, &state->gc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->fn = state->fc; - mcsrch(n, &state->xn, &state->fn, &state->gn, &state->d, &state->stp, state->curstpmax, minbleic_gtol, &mcinfo, &state->nfev, &state->work, &state->lstate, &state->mcstage, _state); -lbl_64: - if( state->mcstage==0 ) - { - goto lbl_65; - } - - /* - * Enforce constraints (correction) in XN. - * Copy current point from XN to X. - */ - sascorrection(&state->sas, &state->xn, &penalty, _state); - for(i=0; i<=n-1; i++) - { - state->x.ptr.p_double[i] = state->xn.ptr.p_double[i]; - } - - /* - * Gradient, either user-provided or numerical differentiation - */ - minbleic_clearrequestfields(state, _state); - if( ae_fp_neq(state->diffstep,0) ) - { - goto lbl_66; - } - - /* - * Analytic gradient - */ - state->needfg = ae_true; - state->rstate.stage = 15; - goto lbl_rcomm; -lbl_15: - state->needfg = ae_false; - state->repnfev = state->repnfev+1; - goto lbl_67; -lbl_66: - - /* - * Numerical differentiation - */ - state->needf = ae_true; - state->rstate.stage = 16; - goto lbl_rcomm; -lbl_16: - state->fbase = state->f; - i = 0; -lbl_68: - if( i>n-1 ) - { - goto lbl_70; - } - v = state->x.ptr.p_double[i]; - b = ae_false; - if( state->hasbndl.ptr.p_bool[i] ) - { - b = b||ae_fp_less(v-state->diffstep*state->s.ptr.p_double[i],state->bndl.ptr.p_double[i]); - } - if( state->hasbndu.ptr.p_bool[i] ) - { - b = b||ae_fp_greater(v+state->diffstep*state->s.ptr.p_double[i],state->bndu.ptr.p_double[i]); - } - if( b ) - { - goto lbl_71; - } - state->x.ptr.p_double[i] = v-state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 17; - goto lbl_rcomm; -lbl_17: - state->fm2 = state->f; - state->x.ptr.p_double[i] = v-0.5*state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 18; - goto lbl_rcomm; -lbl_18: - state->fm1 = state->f; - state->x.ptr.p_double[i] = v+0.5*state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 19; - goto lbl_rcomm; -lbl_19: - state->fp1 = state->f; - state->x.ptr.p_double[i] = v+state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 20; - goto lbl_rcomm; -lbl_20: - state->fp2 = state->f; - state->g.ptr.p_double[i] = (8*(state->fp1-state->fm1)-(state->fp2-state->fm2))/(6*state->diffstep*state->s.ptr.p_double[i]); - state->repnfev = state->repnfev+4; - goto lbl_72; -lbl_71: - state->xm1 = v-state->diffstep*state->s.ptr.p_double[i]; - state->xp1 = v+state->diffstep*state->s.ptr.p_double[i]; - if( state->hasbndl.ptr.p_bool[i]&&ae_fp_less(state->xm1,state->bndl.ptr.p_double[i]) ) - { - state->xm1 = state->bndl.ptr.p_double[i]; - } - if( state->hasbndu.ptr.p_bool[i]&&ae_fp_greater(state->xp1,state->bndu.ptr.p_double[i]) ) - { - state->xp1 = state->bndu.ptr.p_double[i]; - } - state->x.ptr.p_double[i] = state->xm1; - state->rstate.stage = 21; - goto lbl_rcomm; -lbl_21: - state->fm1 = state->f; - state->x.ptr.p_double[i] = state->xp1; - state->rstate.stage = 22; - goto lbl_rcomm; -lbl_22: - state->fp1 = state->f; - if( ae_fp_neq(state->xm1,state->xp1) ) - { - state->g.ptr.p_double[i] = (state->fp1-state->fm1)/(state->xp1-state->xm1); - } - else - { - state->g.ptr.p_double[i] = 0; - } - state->repnfev = state->repnfev+2; -lbl_72: - state->x.ptr.p_double[i] = v; - i = i+1; - goto lbl_68; -lbl_70: - state->f = state->fbase; - state->needf = ae_false; -lbl_67: - - /* - * Back to MCSRCH - * - * NOTE: penalty term from correction is added to FN in order - * to penalize increase in infeasibility. - */ - state->fn = state->f+minbleic_penaltyfactor*state->maxscaledgrad*penalty; - ae_v_move(&state->gn.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); - trimfunction(&state->fn, &state->gn, n, state->trimthreshold, _state); - mcsrch(n, &state->xn, &state->fn, &state->gn, &state->d, &state->stp, state->curstpmax, minbleic_gtol, &mcinfo, &state->nfev, &state->work, &state->lstate, &state->mcstage, _state); - goto lbl_64; -lbl_65: - - /* - * Handle possible failure of the line search - */ - if( mcinfo!=1&&mcinfo!=5 ) - { - - /* - * We can not find step which decreases function value. We have - * two possibilities: - * (a) numerical properties of the function do not allow us to - * find good solution. - * (b) we are close to activation of some constraint, and it is - * so close that step which activates it leads to change in - * target function which is smaller than numerical noise. - * - * Optimization algorithm must be able to handle case (b), because - * inability to handle it will cause failure when algorithm - * started very close to boundary of the feasible area. - * - * In order to correctly handle such cases we allow limited amount - * of small steps which increase function value. - */ - v = 0.0; - for(i=0; i<=n-1; i++) - { - v = v+ae_sqr(state->d.ptr.p_double[i]*state->curstpmax/state->s.ptr.p_double[i], _state); - } - v = ae_sqrt(v, _state); - if( (state->cidx>=0&&ae_fp_less_eq(v,minbleic_maxnonmonotoniclen))&&state->nonmonotoniccnt>0 ) - { - - /* - * We enforce non-monotonic step: - * * Stp := CurStpMax - * * MCINFO := 5 - * * XN := XC+CurStpMax*D - * * non-monotonic counter is decreased - */ - state->stp = state->curstpmax; - mcinfo = 5; - v = state->curstpmax; - ae_v_move(&state->xn.ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_addd(&state->xn.ptr.p_double[0], 1, &state->d.ptr.p_double[0], 1, ae_v_len(0,n-1), v); - state->nonmonotoniccnt = state->nonmonotoniccnt-1; - } - else - { - - /* - * Numerical properties of the function does not allow us to solve problem - */ - state->repterminationtype = 7; - nextaction = 0; - goto lbl_61; - } - } - - /* - * Current point is updated. - */ - ae_v_move(&state->xp.ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_move(&state->gp.ptr.p_double[0], 1, &state->gc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->fp = state->fc; - actstatus = sasmoveto(&state->sas, &state->xn, state->cidx>=0&&ae_fp_greater_eq(state->stp,state->activationstep), state->cidx, state->cval, _state); - ae_v_move(&state->gc.ptr.p_double[0], 1, &state->gn.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->fc = state->fn; - state->repinneriterationscount = state->repinneriterationscount+1; - if( !state->xrep ) - { - goto lbl_73; - } - ae_v_move(&state->x.ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - minbleic_clearrequestfields(state, _state); - state->xupdated = ae_true; - state->rstate.stage = 23; - goto lbl_rcomm; -lbl_23: - state->xupdated = ae_false; -lbl_73: - - /* - * Check for stopping. - * - * Step, gradient and function-based stopping criteria are tested only - * for steps which satisfy Wolfe conditions. - * - * MaxIts-based stopping condition is checked for all steps - */ - if( mcinfo==1 ) - { - - /* - * Step is small enough - */ - v = 0; - vv = 0; - for(i=0; i<=n-1; i++) - { - v = v+ae_sqr((state->sas.xc.ptr.p_double[i]-state->xp.ptr.p_double[i])/state->s.ptr.p_double[i], _state); - vv = vv+ae_sqr(state->sas.xc.ptr.p_double[i]-state->xp.ptr.p_double[i], _state); - } - v = ae_sqrt(v, _state); - vv = ae_sqrt(vv, _state); - if( ae_fp_less_eq(v,state->epsx) ) - { - state->repterminationtype = 2; - nextaction = 0; - goto lbl_61; - } - state->lastgoodstep = vv; - minbleic_updateestimateofgoodstep(&state->lastscaledgoodstep, v, _state); - - /* - * Function change is small enough - */ - if( ae_fp_less_eq(ae_fabs(state->fp-state->fc, _state),state->epsf*ae_maxreal(ae_fabs(state->fc, _state), ae_maxreal(ae_fabs(state->fp, _state), 1.0, _state), _state)) ) - { - - /* - * Function change is small enough - */ - state->repterminationtype = 1; - nextaction = 0; - goto lbl_61; - } - } - if( state->maxits>0&&state->repinneriterationscount>=state->maxits ) - { - - /* - * Required number of iterations was performed - */ - state->repterminationtype = 5; - nextaction = 0; - goto lbl_61; - } - - /* - * Decide where to move: - * * in case only "candidate" constraints were activated, repeat stage 2 - * * in case no constraints was activated, move to stage 3 - * * otherwise, move to stage 1 (re-evaluation of the active set) - */ - if( actstatus==0 ) - { - goto lbl_60; - } - if( actstatus<0 ) - { - nextaction = 1; - } - else - { - nextaction = -1; - } - goto lbl_61; - goto lbl_60; -lbl_61: - if( nextaction<0 ) - { - goto lbl_51; - } - if( nextaction==0 ) - { - goto lbl_52; - } - - /* - * Phase 3: L-BFGS step - */ - ae_v_move(&state->x.ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - minbleic_clearrequestfields(state, _state); - if( ae_fp_neq(state->diffstep,0) ) - { - goto lbl_75; - } - - /* - * Analytic gradient - */ - state->needfg = ae_true; - state->rstate.stage = 24; - goto lbl_rcomm; -lbl_24: - state->needfg = ae_false; - state->repnfev = state->repnfev+1; - goto lbl_76; -lbl_75: - - /* - * Numerical differentiation - */ - state->needf = ae_true; - state->rstate.stage = 25; - goto lbl_rcomm; -lbl_25: - state->fbase = state->f; - i = 0; -lbl_77: - if( i>n-1 ) - { - goto lbl_79; - } - v = state->x.ptr.p_double[i]; - b = ae_false; - if( state->hasbndl.ptr.p_bool[i] ) - { - b = b||ae_fp_less(v-state->diffstep*state->s.ptr.p_double[i],state->bndl.ptr.p_double[i]); - } - if( state->hasbndu.ptr.p_bool[i] ) - { - b = b||ae_fp_greater(v+state->diffstep*state->s.ptr.p_double[i],state->bndu.ptr.p_double[i]); - } - if( b ) - { - goto lbl_80; - } - state->x.ptr.p_double[i] = v-state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 26; - goto lbl_rcomm; -lbl_26: - state->fm2 = state->f; - state->x.ptr.p_double[i] = v-0.5*state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 27; - goto lbl_rcomm; -lbl_27: - state->fm1 = state->f; - state->x.ptr.p_double[i] = v+0.5*state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 28; - goto lbl_rcomm; -lbl_28: - state->fp1 = state->f; - state->x.ptr.p_double[i] = v+state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 29; - goto lbl_rcomm; -lbl_29: - state->fp2 = state->f; - state->g.ptr.p_double[i] = (8*(state->fp1-state->fm1)-(state->fp2-state->fm2))/(6*state->diffstep*state->s.ptr.p_double[i]); - state->repnfev = state->repnfev+4; - goto lbl_81; -lbl_80: - state->xm1 = v-state->diffstep*state->s.ptr.p_double[i]; - state->xp1 = v+state->diffstep*state->s.ptr.p_double[i]; - if( state->hasbndl.ptr.p_bool[i]&&ae_fp_less(state->xm1,state->bndl.ptr.p_double[i]) ) - { - state->xm1 = state->bndl.ptr.p_double[i]; - } - if( state->hasbndu.ptr.p_bool[i]&&ae_fp_greater(state->xp1,state->bndu.ptr.p_double[i]) ) - { - state->xp1 = state->bndu.ptr.p_double[i]; - } - state->x.ptr.p_double[i] = state->xm1; - state->rstate.stage = 30; - goto lbl_rcomm; -lbl_30: - state->fm1 = state->f; - state->x.ptr.p_double[i] = state->xp1; - state->rstate.stage = 31; - goto lbl_rcomm; -lbl_31: - state->fp1 = state->f; - if( ae_fp_neq(state->xm1,state->xp1) ) - { - state->g.ptr.p_double[i] = (state->fp1-state->fm1)/(state->xp1-state->xm1); - } - else - { - state->g.ptr.p_double[i] = 0; - } - state->repnfev = state->repnfev+2; -lbl_81: - state->x.ptr.p_double[i] = v; - i = i+1; - goto lbl_77; -lbl_79: - state->f = state->fbase; - state->needf = ae_false; -lbl_76: - state->fc = state->f; - trimprepare(state->fc, &state->trimthreshold, _state); - ae_v_move(&state->gc.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_moveneg(&state->d.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); - sasconstraineddirection(&state->sas, &state->gc, _state); - sasconstraineddirectionprec(&state->sas, &state->d, _state); - ginit = 0.0; - for(i=0; i<=n-1; i++) - { - ginit = ginit+ae_sqr(state->gc.ptr.p_double[i]*state->s.ptr.p_double[i], _state); - } - ginit = ae_sqrt(ginit, _state); - state->k = 0; -lbl_82: - if( state->k>n ) - { - goto lbl_83; - } - - /* - * Main cycle: prepare to 1-D line search - */ - state->p = state->k%m; - state->q = ae_minint(state->k, m-1, _state); - - /* - * Store X[k], G[k] - */ - ae_v_moveneg(&state->sk.ptr.pp_double[state->p][0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_moveneg(&state->yk.ptr.pp_double[state->p][0], 1, &state->gc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - - /* - * Try to use previous scaled step length as initial estimate for new step. - */ - v = 0; - for(i=0; i<=n-1; i++) - { - v = v+ae_sqr(state->d.ptr.p_double[i]/state->s.ptr.p_double[i], _state); - } - v = ae_sqrt(v, _state); - if( ae_fp_greater(state->lastscaledgoodstep,0)&&ae_fp_greater(v,0) ) - { - state->stp = state->lastscaledgoodstep/v; - } - else - { - state->stp = 1.0; - } - - /* - * Calculate bound on step length - */ - sasexploredirection(&state->sas, &state->d, &state->curstpmax, &state->cidx, &state->cval, _state); - state->activationstep = state->curstpmax; - if( state->cidx>=0&&ae_fp_eq(state->activationstep,0) ) - { - goto lbl_83; - } - if( ae_fp_greater(state->stpmax,0) ) - { - v = ae_v_dotproduct(&state->d.ptr.p_double[0], 1, &state->d.ptr.p_double[0], 1, ae_v_len(0,n-1)); - v = ae_sqrt(v, _state); - if( ae_fp_greater(v,0) ) - { - state->curstpmax = ae_minreal(state->curstpmax, state->stpmax/v, _state); - } - } - - /* - * Report beginning of line search (if requested by caller). - * See description of the MinBLEICState for more information - * about fields accessible to caller. - * - * Caller may do following: - * * change State.Stp and load better initial estimate of - * the step length. - * Caller may not terminate algorithm. - */ - if( !state->drep ) - { - goto lbl_84; - } - minbleic_clearrequestfields(state, _state); - state->lsstart = ae_true; - state->lbfgssearch = ae_true; - state->boundedstep = state->cidx>=0; - ae_v_move(&state->x.ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->rstate.stage = 32; - goto lbl_rcomm; -lbl_32: - state->lsstart = ae_false; -lbl_84: - - /* - * Minimize F(x+alpha*d) - */ - ae_v_move(&state->xn.ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_move(&state->gn.ptr.p_double[0], 1, &state->gc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->fn = state->fc; - state->mcstage = 0; - mcsrch(n, &state->xn, &state->fn, &state->gn, &state->d, &state->stp, state->curstpmax, minbleic_gtol, &mcinfo, &state->nfev, &state->work, &state->lstate, &state->mcstage, _state); -lbl_86: - if( state->mcstage==0 ) - { - goto lbl_87; - } - - /* - * Perform correction (constraints are enforced) - * Copy XN to X - */ - sascorrection(&state->sas, &state->xn, &penalty, _state); - for(i=0; i<=n-1; i++) - { - state->x.ptr.p_double[i] = state->xn.ptr.p_double[i]; - } - - /* - * Gradient, either user-provided or numerical differentiation - */ - minbleic_clearrequestfields(state, _state); - if( ae_fp_neq(state->diffstep,0) ) - { - goto lbl_88; - } - - /* - * Analytic gradient - */ - state->needfg = ae_true; - state->rstate.stage = 33; - goto lbl_rcomm; -lbl_33: - state->needfg = ae_false; - state->repnfev = state->repnfev+1; - goto lbl_89; -lbl_88: - - /* - * Numerical differentiation - */ - state->needf = ae_true; - state->rstate.stage = 34; - goto lbl_rcomm; -lbl_34: - state->fbase = state->f; - i = 0; -lbl_90: - if( i>n-1 ) - { - goto lbl_92; - } - v = state->x.ptr.p_double[i]; - b = ae_false; - if( state->hasbndl.ptr.p_bool[i] ) - { - b = b||ae_fp_less(v-state->diffstep*state->s.ptr.p_double[i],state->bndl.ptr.p_double[i]); - } - if( state->hasbndu.ptr.p_bool[i] ) - { - b = b||ae_fp_greater(v+state->diffstep*state->s.ptr.p_double[i],state->bndu.ptr.p_double[i]); - } - if( b ) - { - goto lbl_93; - } - state->x.ptr.p_double[i] = v-state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 35; - goto lbl_rcomm; -lbl_35: - state->fm2 = state->f; - state->x.ptr.p_double[i] = v-0.5*state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 36; - goto lbl_rcomm; -lbl_36: - state->fm1 = state->f; - state->x.ptr.p_double[i] = v+0.5*state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 37; - goto lbl_rcomm; -lbl_37: - state->fp1 = state->f; - state->x.ptr.p_double[i] = v+state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 38; - goto lbl_rcomm; -lbl_38: - state->fp2 = state->f; - state->g.ptr.p_double[i] = (8*(state->fp1-state->fm1)-(state->fp2-state->fm2))/(6*state->diffstep*state->s.ptr.p_double[i]); - state->repnfev = state->repnfev+4; - goto lbl_94; -lbl_93: - state->xm1 = v-state->diffstep*state->s.ptr.p_double[i]; - state->xp1 = v+state->diffstep*state->s.ptr.p_double[i]; - if( state->hasbndl.ptr.p_bool[i]&&ae_fp_less(state->xm1,state->bndl.ptr.p_double[i]) ) - { - state->xm1 = state->bndl.ptr.p_double[i]; - } - if( state->hasbndu.ptr.p_bool[i]&&ae_fp_greater(state->xp1,state->bndu.ptr.p_double[i]) ) - { - state->xp1 = state->bndu.ptr.p_double[i]; - } - state->x.ptr.p_double[i] = state->xm1; - state->rstate.stage = 39; - goto lbl_rcomm; -lbl_39: - state->fm1 = state->f; - state->x.ptr.p_double[i] = state->xp1; - state->rstate.stage = 40; - goto lbl_rcomm; -lbl_40: - state->fp1 = state->f; - if( ae_fp_neq(state->xm1,state->xp1) ) - { - state->g.ptr.p_double[i] = (state->fp1-state->fm1)/(state->xp1-state->xm1); - } - else - { - state->g.ptr.p_double[i] = 0; - } - state->repnfev = state->repnfev+2; -lbl_94: - state->x.ptr.p_double[i] = v; - i = i+1; - goto lbl_90; -lbl_92: - state->f = state->fbase; - state->needf = ae_false; -lbl_89: - - /* - * Back to MCSRCH - * - * NOTE: penalty term from correction is added to FN in order - * to penalize increase in infeasibility. - */ - state->fn = state->f+minbleic_penaltyfactor*state->maxscaledgrad*penalty; - ae_v_move(&state->gn.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); - sasconstraineddirection(&state->sas, &state->gn, _state); - trimfunction(&state->fn, &state->gn, n, state->trimthreshold, _state); - mcsrch(n, &state->xn, &state->fn, &state->gn, &state->d, &state->stp, state->curstpmax, minbleic_gtol, &mcinfo, &state->nfev, &state->work, &state->lstate, &state->mcstage, _state); - goto lbl_86; -lbl_87: - ae_v_add(&state->sk.ptr.pp_double[state->p][0], 1, &state->xn.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_add(&state->yk.ptr.pp_double[state->p][0], 1, &state->gn.ptr.p_double[0], 1, ae_v_len(0,n-1)); - - /* - * Handle possible failure of the line search - */ - if( mcinfo!=1&&mcinfo!=5 ) - { - goto lbl_83; - } - - /* - * Current point is updated. - */ - ae_v_move(&state->xp.ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_move(&state->gp.ptr.p_double[0], 1, &state->gc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->fp = state->fc; - actstatus = sasmoveto(&state->sas, &state->xn, state->cidx>=0&&ae_fp_greater_eq(state->stp,state->activationstep), state->cidx, state->cval, _state); - ae_v_move(&state->gc.ptr.p_double[0], 1, &state->gn.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->fc = state->fn; - if( !state->xrep ) - { - goto lbl_95; - } - ae_v_move(&state->x.ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - minbleic_clearrequestfields(state, _state); - state->xupdated = ae_true; - state->rstate.stage = 41; - goto lbl_rcomm; -lbl_41: - state->xupdated = ae_false; -lbl_95: - state->repinneriterationscount = state->repinneriterationscount+1; - - /* - * Update length of the good step - */ - if( mcinfo==1 ) - { - v = 0; - vv = 0; - for(i=0; i<=n-1; i++) - { - v = v+ae_sqr((state->sas.xc.ptr.p_double[i]-state->xp.ptr.p_double[i])/state->s.ptr.p_double[i], _state); - vv = vv+ae_sqr(state->sas.xc.ptr.p_double[i]-state->xp.ptr.p_double[i], _state); - } - state->lastgoodstep = ae_sqrt(vv, _state); - minbleic_updateestimateofgoodstep(&state->lastscaledgoodstep, ae_sqrt(v, _state), _state); - } - - /* - * Termination of the L-BFGS algorithm: - * a) line search was performed with activation of constraint - * b) scaled gradient decreased below GDecay - * c) iterations counter >= MaxIts - */ - if( actstatus>=0 ) - { - goto lbl_83; - } - v = 0.0; - for(i=0; i<=n-1; i++) - { - v = v+ae_sqr(state->gc.ptr.p_double[i]*state->s.ptr.p_double[i], _state); - } - if( ae_fp_less(ae_sqrt(v, _state),gdecay*ginit) ) - { - goto lbl_83; - } - if( state->maxits>0&&state->repinneriterationscount>=state->maxits ) - { - goto lbl_83; - } - - /* - * Update L-BFGS model: - * * calculate Rho[k] - * * calculate d(k+1) = -H(k+1)*g(k+1) - * (use constrained preconditioner to perform multiplication) - */ - v = ae_v_dotproduct(&state->yk.ptr.pp_double[state->p][0], 1, &state->sk.ptr.pp_double[state->p][0], 1, ae_v_len(0,n-1)); - vv = ae_v_dotproduct(&state->yk.ptr.pp_double[state->p][0], 1, &state->yk.ptr.pp_double[state->p][0], 1, ae_v_len(0,n-1)); - if( ae_fp_eq(v,0)||ae_fp_eq(vv,0) ) - { - goto lbl_83; - } - state->rho.ptr.p_double[state->p] = 1/v; - ae_v_move(&state->work.ptr.p_double[0], 1, &state->gn.ptr.p_double[0], 1, ae_v_len(0,n-1)); - for(i=state->k; i>=state->k-state->q; i--) - { - ic = i%m; - v = ae_v_dotproduct(&state->sk.ptr.pp_double[ic][0], 1, &state->work.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->theta.ptr.p_double[ic] = v; - vv = v*state->rho.ptr.p_double[ic]; - ae_v_subd(&state->work.ptr.p_double[0], 1, &state->yk.ptr.pp_double[ic][0], 1, ae_v_len(0,n-1), vv); - } - sasconstraineddirectionprec(&state->sas, &state->work, _state); - for(i=state->k-state->q; i<=state->k; i++) - { - ic = i%m; - v = ae_v_dotproduct(&state->yk.ptr.pp_double[ic][0], 1, &state->work.ptr.p_double[0], 1, ae_v_len(0,n-1)); - vv = state->rho.ptr.p_double[ic]*(-v+state->theta.ptr.p_double[ic]); - ae_v_addd(&state->work.ptr.p_double[0], 1, &state->sk.ptr.pp_double[ic][0], 1, ae_v_len(0,n-1), vv); - } - ae_v_moveneg(&state->d.ptr.p_double[0], 1, &state->work.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->k = state->k+1; - goto lbl_82; -lbl_83: - - /* - * Decrease decay coefficient. Subsequent L-BFGS stages will - * have more stringent stopping criteria. - */ - gdecay = ae_maxreal(gdecay*minbleic_decaycorrection, minbleic_mindecay, _state); - goto lbl_51; -lbl_52: - sasstopoptimization(&state->sas, _state); - state->repouteriterationscount = 1; - result = ae_false; - return result; - - /* - * Saving state - */ -lbl_rcomm: - result = ae_true; - state->rstate.ia.ptr.p_int[0] = n; - state->rstate.ia.ptr.p_int[1] = m; - state->rstate.ia.ptr.p_int[2] = i; - state->rstate.ia.ptr.p_int[3] = j; - state->rstate.ia.ptr.p_int[4] = badbfgsits; - state->rstate.ia.ptr.p_int[5] = nextaction; - state->rstate.ia.ptr.p_int[6] = mcinfo; - state->rstate.ia.ptr.p_int[7] = actstatus; - state->rstate.ia.ptr.p_int[8] = ic; - state->rstate.ba.ptr.p_bool[0] = b; - state->rstate.ra.ptr.p_double[0] = v; - state->rstate.ra.ptr.p_double[1] = vv; - state->rstate.ra.ptr.p_double[2] = penalty; - state->rstate.ra.ptr.p_double[3] = ginit; - state->rstate.ra.ptr.p_double[4] = gdecay; - return result; -} - - -/************************************************************************* -BLEIC results - -INPUT PARAMETERS: - State - algorithm state - -OUTPUT PARAMETERS: - X - array[0..N-1], solution - Rep - optimization report. You should check Rep.TerminationType - in order to distinguish successful termination from - unsuccessful one: - * -7 gradient verification failed. - See MinBLEICSetGradientCheck() for more information. - * -3 inconsistent constraints. Feasible point is - either nonexistent or too hard to find. Try to - restart optimizer with better initial approximation - * 1 relative function improvement is no more than EpsF. - * 2 scaled step is no more than EpsX. - * 4 scaled gradient norm is no more than EpsG. - * 5 MaxIts steps was taken - More information about fields of this structure can be - found in the comments on MinBLEICReport datatype. - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicresults(minbleicstate* state, - /* Real */ ae_vector* x, - minbleicreport* rep, - ae_state *_state) -{ - - ae_vector_clear(x); - _minbleicreport_clear(rep); - - minbleicresultsbuf(state, x, rep, _state); -} - - -/************************************************************************* -BLEIC results - -Buffered implementation of MinBLEICResults() which uses pre-allocated buffer -to store X[]. If buffer size is too small, it resizes buffer. It is -intended to be used in the inner cycles of performance critical algorithms -where array reallocation penalty is too large to be ignored. - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicresultsbuf(minbleicstate* state, - /* Real */ ae_vector* x, - minbleicreport* rep, - ae_state *_state) -{ - ae_int_t i; - - - if( x->cntnmain ) - { - ae_vector_set_length(x, state->nmain, _state); - } - rep->iterationscount = state->repinneriterationscount; - rep->inneriterationscount = state->repinneriterationscount; - rep->outeriterationscount = state->repouteriterationscount; - rep->nfev = state->repnfev; - rep->varidx = state->repvaridx; - rep->terminationtype = state->repterminationtype; - if( state->repterminationtype>0 ) - { - ae_v_move(&x->ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,state->nmain-1)); - } - else - { - for(i=0; i<=state->nmain-1; i++) - { - x->ptr.p_double[i] = _state->v_nan; - } - } - rep->debugeqerr = state->repdebugeqerr; - rep->debugfs = state->repdebugfs; - rep->debugff = state->repdebugff; - rep->debugdx = state->repdebugdx; - rep->debugfeasqpits = state->repdebugfeasqpits; - rep->debugfeasgpaits = state->repdebugfeasgpaits; -} - - -/************************************************************************* -This subroutine restarts algorithm from new point. -All optimization parameters (including constraints) are left unchanged. - -This function allows to solve multiple optimization problems (which -must have same number of dimensions) without object reallocation penalty. - -INPUT PARAMETERS: - State - structure previously allocated with MinBLEICCreate call. - X - new starting point. - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicrestartfrom(minbleicstate* state, - /* Real */ ae_vector* x, - ae_state *_state) -{ - ae_int_t n; - - - n = state->nmain; - - /* - * First, check for errors in the inputs - */ - ae_assert(x->cnt>=n, "MinBLEICRestartFrom: Length(X)xstart.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,n-1)); - - /* - * prepare RComm facilities - */ - ae_vector_set_length(&state->rstate.ia, 8+1, _state); - ae_vector_set_length(&state->rstate.ba, 0+1, _state); - ae_vector_set_length(&state->rstate.ra, 4+1, _state); - state->rstate.stage = -1; - minbleic_clearrequestfields(state, _state); - sasstopoptimization(&state->sas, _state); -} - - -/************************************************************************* -This subroutine finalizes internal structures after emergency termination -from State.LSStart report (see comments on MinBLEICState for more information). - -INPUT PARAMETERS: - State - structure after exit from LSStart report - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicemergencytermination(minbleicstate* state, ae_state *_state) -{ - - - sasstopoptimization(&state->sas, _state); -} - - -/************************************************************************* -This subroutine turns on verification of the user-supplied analytic -gradient: -* user calls this subroutine before optimization begins -* MinBLEICOptimize() is called -* prior to actual optimization, for each component of parameters being - optimized X[i] algorithm performs following steps: - * two trial steps are made to X[i]-TestStep*S[i] and X[i]+TestStep*S[i], - where X[i] is i-th component of the initial point and S[i] is a scale - of i-th parameter - * if needed, steps are bounded with respect to constraints on X[] - * F(X) is evaluated at these trial points - * we perform one more evaluation in the middle point of the interval - * we build cubic model using function values and derivatives at trial - points and we compare its prediction with actual value in the middle - point - * in case difference between prediction and actual value is higher than - some predetermined threshold, algorithm stops with completion code -7; - Rep.VarIdx is set to index of the parameter with incorrect derivative. -* after verification is over, algorithm proceeds to the actual optimization. - -NOTE 1: verification needs N (parameters count) gradient evaluations. It - is very costly and you should use it only for low dimensional - problems, when you want to be sure that you've correctly - calculated analytic derivatives. You should not use it in the - production code (unless you want to check derivatives provided by - some third party). - -NOTE 2: you should carefully choose TestStep. Value which is too large - (so large that function behaviour is significantly non-cubic) will - lead to false alarms. You may use different step for different - parameters by means of setting scale with MinBLEICSetScale(). - -NOTE 3: this function may lead to false positives. In case it reports that - I-th derivative was calculated incorrectly, you may decrease test - step and try one more time - maybe your function changes too - sharply and your step is too large for such rapidly chanding - function. - -INPUT PARAMETERS: - State - structure used to store algorithm state - TestStep - verification step: - * TestStep=0 turns verification off - * TestStep>0 activates verification - - -- ALGLIB -- - Copyright 15.06.2012 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetgradientcheck(minbleicstate* state, - double teststep, - ae_state *_state) -{ - - - ae_assert(ae_isfinite(teststep, _state), "MinBLEICSetGradientCheck: TestStep contains NaN or Infinite", _state); - ae_assert(ae_fp_greater_eq(teststep,0), "MinBLEICSetGradientCheck: invalid argument TestStep(TestStep<0)", _state); - state->teststep = teststep; -} - - -/************************************************************************* -Clears request fileds (to be sure that we don't forget to clear something) -*************************************************************************/ -static void minbleic_clearrequestfields(minbleicstate* state, - ae_state *_state) -{ - - - state->needf = ae_false; - state->needfg = ae_false; - state->xupdated = ae_false; - state->lsstart = ae_false; -} - - -/************************************************************************* -Internal initialization subroutine -*************************************************************************/ -static void minbleic_minbleicinitinternal(ae_int_t n, - /* Real */ ae_vector* x, - double diffstep, - minbleicstate* state, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_matrix c; - ae_vector ct; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init(&c, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&ct, 0, DT_INT, _state, ae_true); - - - /* - * Initialize - */ - state->teststep = 0; - state->nmain = n; - state->diffstep = diffstep; - sasinit(n, &state->sas, _state); - ae_vector_set_length(&state->bndl, n, _state); - ae_vector_set_length(&state->hasbndl, n, _state); - ae_vector_set_length(&state->bndu, n, _state); - ae_vector_set_length(&state->hasbndu, n, _state); - ae_vector_set_length(&state->xstart, n, _state); - ae_vector_set_length(&state->gc, n, _state); - ae_vector_set_length(&state->xn, n, _state); - ae_vector_set_length(&state->gn, n, _state); - ae_vector_set_length(&state->xp, n, _state); - ae_vector_set_length(&state->gp, n, _state); - ae_vector_set_length(&state->d, n, _state); - ae_vector_set_length(&state->s, n, _state); - ae_vector_set_length(&state->x, n, _state); - ae_vector_set_length(&state->g, n, _state); - ae_vector_set_length(&state->work, n, _state); - for(i=0; i<=n-1; i++) - { - state->bndl.ptr.p_double[i] = _state->v_neginf; - state->hasbndl.ptr.p_bool[i] = ae_false; - state->bndu.ptr.p_double[i] = _state->v_posinf; - state->hasbndu.ptr.p_bool[i] = ae_false; - state->s.ptr.p_double[i] = 1.0; - } - minbleicsetlc(state, &c, &ct, 0, _state); - minbleicsetcond(state, 0.0, 0.0, 0.0, 0, _state); - minbleicsetxrep(state, ae_false, _state); - minbleicsetdrep(state, ae_false, _state); - minbleicsetstpmax(state, 0.0, _state); - minbleicsetprecdefault(state, _state); - minbleicrestartfrom(state, x, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -This subroutine updates estimate of the good step length given: -1) previous estimate -2) new length of the good step - -It makes sure that estimate does not change too rapidly - ratio of new and -old estimates will be at least 0.01, at most 100.0 - -In case previous estimate of good step is zero (no estimate), new estimate -is used unconditionally. - - -- ALGLIB -- - Copyright 16.01.2013 by Bochkanov Sergey -*************************************************************************/ -static void minbleic_updateestimateofgoodstep(double* estimate, - double newstep, - ae_state *_state) -{ - - - if( ae_fp_eq(*estimate,0) ) - { - *estimate = newstep; - return; - } - if( ae_fp_less(newstep,*estimate*0.01) ) - { - *estimate = *estimate*0.01; - return; - } - if( ae_fp_greater(newstep,*estimate*100) ) - { - *estimate = *estimate*100; - return; - } - *estimate = newstep; -} - - -ae_bool _minbleicstate_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - minbleicstate *p = (minbleicstate*)_p; - ae_touch_ptr((void*)p); - if( !_sactiveset_init(&p->sas, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->s, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->diagh, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->g, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->gc, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->xn, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->gn, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->xp, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->gp, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->d, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->cleic, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->hasbndl, 0, DT_BOOL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->hasbndu, 0, DT_BOOL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->bndl, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->bndu, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->xstart, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !_snnlssolver_init(&p->solver, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->tmpprec, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->work, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !_linminstate_init(&p->lstate, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->rho, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->yk, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->sk, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->theta, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _minbleicstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - minbleicstate *dst = (minbleicstate*)_dst; - minbleicstate *src = (minbleicstate*)_src; - dst->nmain = src->nmain; - dst->nslack = src->nslack; - dst->epsg = src->epsg; - dst->epsf = src->epsf; - dst->epsx = src->epsx; - dst->maxits = src->maxits; - dst->xrep = src->xrep; - dst->drep = src->drep; - dst->stpmax = src->stpmax; - dst->diffstep = src->diffstep; - if( !_sactiveset_init_copy(&dst->sas, &src->sas, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->s, &src->s, _state, make_automatic) ) - return ae_false; - dst->prectype = src->prectype; - if( !ae_vector_init_copy(&dst->diagh, &src->diagh, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) - return ae_false; - dst->f = src->f; - if( !ae_vector_init_copy(&dst->g, &src->g, _state, make_automatic) ) - return ae_false; - dst->needf = src->needf; - dst->needfg = src->needfg; - dst->xupdated = src->xupdated; - dst->lsstart = src->lsstart; - dst->lbfgssearch = src->lbfgssearch; - dst->boundedstep = src->boundedstep; - dst->teststep = src->teststep; - if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->gc, &src->gc, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->xn, &src->xn, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->gn, &src->gn, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->xp, &src->xp, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->gp, &src->gp, _state, make_automatic) ) - return ae_false; - dst->fc = src->fc; - dst->fn = src->fn; - dst->fp = src->fp; - if( !ae_vector_init_copy(&dst->d, &src->d, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->cleic, &src->cleic, _state, make_automatic) ) - return ae_false; - dst->nec = src->nec; - dst->nic = src->nic; - dst->lastgoodstep = src->lastgoodstep; - dst->lastscaledgoodstep = src->lastscaledgoodstep; - dst->maxscaledgrad = src->maxscaledgrad; - if( !ae_vector_init_copy(&dst->hasbndl, &src->hasbndl, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->hasbndu, &src->hasbndu, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->bndl, &src->bndl, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->bndu, &src->bndu, _state, make_automatic) ) - return ae_false; - dst->repinneriterationscount = src->repinneriterationscount; - dst->repouteriterationscount = src->repouteriterationscount; - dst->repnfev = src->repnfev; - dst->repvaridx = src->repvaridx; - dst->repterminationtype = src->repterminationtype; - dst->repdebugeqerr = src->repdebugeqerr; - dst->repdebugfs = src->repdebugfs; - dst->repdebugff = src->repdebugff; - dst->repdebugdx = src->repdebugdx; - dst->repdebugfeasqpits = src->repdebugfeasqpits; - dst->repdebugfeasgpaits = src->repdebugfeasgpaits; - if( !ae_vector_init_copy(&dst->xstart, &src->xstart, _state, make_automatic) ) - return ae_false; - if( !_snnlssolver_init_copy(&dst->solver, &src->solver, _state, make_automatic) ) - return ae_false; - dst->fbase = src->fbase; - dst->fm2 = src->fm2; - dst->fm1 = src->fm1; - dst->fp1 = src->fp1; - dst->fp2 = src->fp2; - dst->xm1 = src->xm1; - dst->xp1 = src->xp1; - dst->gm1 = src->gm1; - dst->gp1 = src->gp1; - dst->cidx = src->cidx; - dst->cval = src->cval; - if( !ae_vector_init_copy(&dst->tmpprec, &src->tmpprec, _state, make_automatic) ) - return ae_false; - dst->nfev = src->nfev; - dst->mcstage = src->mcstage; - dst->stp = src->stp; - dst->curstpmax = src->curstpmax; - dst->activationstep = src->activationstep; - if( !ae_vector_init_copy(&dst->work, &src->work, _state, make_automatic) ) - return ae_false; - if( !_linminstate_init_copy(&dst->lstate, &src->lstate, _state, make_automatic) ) - return ae_false; - dst->trimthreshold = src->trimthreshold; - dst->nonmonotoniccnt = src->nonmonotoniccnt; - dst->k = src->k; - dst->q = src->q; - dst->p = src->p; - if( !ae_vector_init_copy(&dst->rho, &src->rho, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->yk, &src->yk, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->sk, &src->sk, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->theta, &src->theta, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _minbleicstate_clear(void* _p) -{ - minbleicstate *p = (minbleicstate*)_p; - ae_touch_ptr((void*)p); - _sactiveset_clear(&p->sas); - ae_vector_clear(&p->s); - ae_vector_clear(&p->diagh); - ae_vector_clear(&p->x); - ae_vector_clear(&p->g); - _rcommstate_clear(&p->rstate); - ae_vector_clear(&p->gc); - ae_vector_clear(&p->xn); - ae_vector_clear(&p->gn); - ae_vector_clear(&p->xp); - ae_vector_clear(&p->gp); - ae_vector_clear(&p->d); - ae_matrix_clear(&p->cleic); - ae_vector_clear(&p->hasbndl); - ae_vector_clear(&p->hasbndu); - ae_vector_clear(&p->bndl); - ae_vector_clear(&p->bndu); - ae_vector_clear(&p->xstart); - _snnlssolver_clear(&p->solver); - ae_vector_clear(&p->tmpprec); - ae_vector_clear(&p->work); - _linminstate_clear(&p->lstate); - ae_vector_clear(&p->rho); - ae_matrix_clear(&p->yk); - ae_matrix_clear(&p->sk); - ae_vector_clear(&p->theta); -} - - -void _minbleicstate_destroy(void* _p) -{ - minbleicstate *p = (minbleicstate*)_p; - ae_touch_ptr((void*)p); - _sactiveset_destroy(&p->sas); - ae_vector_destroy(&p->s); - ae_vector_destroy(&p->diagh); - ae_vector_destroy(&p->x); - ae_vector_destroy(&p->g); - _rcommstate_destroy(&p->rstate); - ae_vector_destroy(&p->gc); - ae_vector_destroy(&p->xn); - ae_vector_destroy(&p->gn); - ae_vector_destroy(&p->xp); - ae_vector_destroy(&p->gp); - ae_vector_destroy(&p->d); - ae_matrix_destroy(&p->cleic); - ae_vector_destroy(&p->hasbndl); - ae_vector_destroy(&p->hasbndu); - ae_vector_destroy(&p->bndl); - ae_vector_destroy(&p->bndu); - ae_vector_destroy(&p->xstart); - _snnlssolver_destroy(&p->solver); - ae_vector_destroy(&p->tmpprec); - ae_vector_destroy(&p->work); - _linminstate_destroy(&p->lstate); - ae_vector_destroy(&p->rho); - ae_matrix_destroy(&p->yk); - ae_matrix_destroy(&p->sk); - ae_vector_destroy(&p->theta); -} - - -ae_bool _minbleicreport_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - minbleicreport *p = (minbleicreport*)_p; - ae_touch_ptr((void*)p); - return ae_true; -} - - -ae_bool _minbleicreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - minbleicreport *dst = (minbleicreport*)_dst; - minbleicreport *src = (minbleicreport*)_src; - dst->iterationscount = src->iterationscount; - dst->nfev = src->nfev; - dst->varidx = src->varidx; - dst->terminationtype = src->terminationtype; - dst->debugeqerr = src->debugeqerr; - dst->debugfs = src->debugfs; - dst->debugff = src->debugff; - dst->debugdx = src->debugdx; - dst->debugfeasqpits = src->debugfeasqpits; - dst->debugfeasgpaits = src->debugfeasgpaits; - dst->inneriterationscount = src->inneriterationscount; - dst->outeriterationscount = src->outeriterationscount; - return ae_true; -} - - -void _minbleicreport_clear(void* _p) -{ - minbleicreport *p = (minbleicreport*)_p; - ae_touch_ptr((void*)p); -} - - -void _minbleicreport_destroy(void* _p) -{ - minbleicreport *p = (minbleicreport*)_p; - ae_touch_ptr((void*)p); -} - - - - -/************************************************************************* - LIMITED MEMORY BFGS METHOD FOR LARGE SCALE OPTIMIZATION - -DESCRIPTION: -The subroutine minimizes function F(x) of N arguments by using a quasi- -Newton method (LBFGS scheme) which is optimized to use a minimum amount -of memory. -The subroutine generates the approximation of an inverse Hessian matrix by -using information about the last M steps of the algorithm (instead of N). -It lessens a required amount of memory from a value of order N^2 to a -value of order 2*N*M. - - -REQUIREMENTS: -Algorithm will request following information during its operation: -* function value F and its gradient G (simultaneously) at given point X - - -USAGE: -1. User initializes algorithm state with MinLBFGSCreate() call -2. User tunes solver parameters with MinLBFGSSetCond() MinLBFGSSetStpMax() - and other functions -3. User calls MinLBFGSOptimize() function which takes algorithm state and - pointer (delegate, etc.) to callback function which calculates F/G. -4. User calls MinLBFGSResults() to get solution -5. Optionally user may call MinLBFGSRestartFrom() to solve another problem - with same N/M but another starting point and/or another function. - MinLBFGSRestartFrom() allows to reuse already initialized structure. - - -INPUT PARAMETERS: - N - problem dimension. N>0 - M - number of corrections in the BFGS scheme of Hessian - approximation update. Recommended value: 3<=M<=7. The smaller - value causes worse convergence, the bigger will not cause a - considerably better convergence, but will cause a fall in the - performance. M<=N. - X - initial solution approximation, array[0..N-1]. - - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -NOTES: -1. you may tune stopping conditions with MinLBFGSSetCond() function -2. if target function contains exp() or other fast growing functions, and - optimization algorithm makes too large steps which leads to overflow, - use MinLBFGSSetStpMax() function to bound algorithm's steps. However, - L-BFGS rarely needs such a tuning. - - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgscreate(ae_int_t n, - ae_int_t m, - /* Real */ ae_vector* x, - minlbfgsstate* state, - ae_state *_state) -{ - - _minlbfgsstate_clear(state); - - ae_assert(n>=1, "MinLBFGSCreate: N<1!", _state); - ae_assert(m>=1, "MinLBFGSCreate: M<1", _state); - ae_assert(m<=n, "MinLBFGSCreate: M>N", _state); - ae_assert(x->cnt>=n, "MinLBFGSCreate: Length(X)0: - * if given, only leading N elements of X are used - * if not given, automatically determined from size of X - M - number of corrections in the BFGS scheme of Hessian - approximation update. Recommended value: 3<=M<=7. The smaller - value causes worse convergence, the bigger will not cause a - considerably better convergence, but will cause a fall in the - performance. M<=N. - X - starting point, array[0..N-1]. - DiffStep- differentiation step, >0 - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -NOTES: -1. algorithm uses 4-point central formula for differentiation. -2. differentiation step along I-th axis is equal to DiffStep*S[I] where - S[] is scaling vector which can be set by MinLBFGSSetScale() call. -3. we recommend you to use moderate values of differentiation step. Too - large step will result in too large truncation errors, while too small - step will result in too large numerical errors. 1.0E-6 can be good - value to start with. -4. Numerical differentiation is very inefficient - one gradient - calculation needs 4*N function evaluations. This function will work for - any N - either small (1...10), moderate (10...100) or large (100...). - However, performance penalty will be too severe for any N's except for - small ones. - We should also say that code which relies on numerical differentiation - is less robust and precise. LBFGS needs exact gradient values. - Imprecise gradient may slow down convergence, especially on highly - nonlinear problems. - Thus we recommend to use this function for fast prototyping on small- - dimensional problems only, and to implement analytical gradient as soon - as possible. - - -- ALGLIB -- - Copyright 16.05.2011 by Bochkanov Sergey -*************************************************************************/ -void minlbfgscreatef(ae_int_t n, - ae_int_t m, - /* Real */ ae_vector* x, - double diffstep, - minlbfgsstate* state, - ae_state *_state) -{ - - _minlbfgsstate_clear(state); - - ae_assert(n>=1, "MinLBFGSCreateF: N too small!", _state); - ae_assert(m>=1, "MinLBFGSCreateF: M<1", _state); - ae_assert(m<=n, "MinLBFGSCreateF: M>N", _state); - ae_assert(x->cnt>=n, "MinLBFGSCreateF: Length(X)=0 - The subroutine finishes its work if the condition - |v|=0 - The subroutine finishes its work if on k+1-th iteration - the condition |F(k+1)-F(k)|<=EpsF*max{|F(k)|,|F(k+1)|,1} - is satisfied. - EpsX - >=0 - The subroutine finishes its work if on k+1-th iteration - the condition |v|<=EpsX is fulfilled, where: - * |.| means Euclidian norm - * v - scaled step vector, v[i]=dx[i]/s[i] - * dx - ste pvector, dx=X(k+1)-X(k) - * s - scaling coefficients set by MinLBFGSSetScale() - MaxIts - maximum number of iterations. If MaxIts=0, the number of - iterations is unlimited. - -Passing EpsG=0, EpsF=0, EpsX=0 and MaxIts=0 (simultaneously) will lead to -automatic stopping criterion selection (small EpsX). - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetcond(minlbfgsstate* state, - double epsg, - double epsf, - double epsx, - ae_int_t maxits, - ae_state *_state) -{ - - - ae_assert(ae_isfinite(epsg, _state), "MinLBFGSSetCond: EpsG is not finite number!", _state); - ae_assert(ae_fp_greater_eq(epsg,0), "MinLBFGSSetCond: negative EpsG!", _state); - ae_assert(ae_isfinite(epsf, _state), "MinLBFGSSetCond: EpsF is not finite number!", _state); - ae_assert(ae_fp_greater_eq(epsf,0), "MinLBFGSSetCond: negative EpsF!", _state); - ae_assert(ae_isfinite(epsx, _state), "MinLBFGSSetCond: EpsX is not finite number!", _state); - ae_assert(ae_fp_greater_eq(epsx,0), "MinLBFGSSetCond: negative EpsX!", _state); - ae_assert(maxits>=0, "MinLBFGSSetCond: negative MaxIts!", _state); - if( ((ae_fp_eq(epsg,0)&&ae_fp_eq(epsf,0))&&ae_fp_eq(epsx,0))&&maxits==0 ) - { - epsx = 1.0E-6; - } - state->epsg = epsg; - state->epsf = epsf; - state->epsx = epsx; - state->maxits = maxits; -} - - -/************************************************************************* -This function turns on/off reporting. - -INPUT PARAMETERS: - State - structure which stores algorithm state - NeedXRep- whether iteration reports are needed or not - -If NeedXRep is True, algorithm will call rep() callback function if it is -provided to MinLBFGSOptimize(). - - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetxrep(minlbfgsstate* state, - ae_bool needxrep, - ae_state *_state) -{ - - - state->xrep = needxrep; -} - - -/************************************************************************* -This function sets maximum step length - -INPUT PARAMETERS: - State - structure which stores algorithm state - StpMax - maximum step length, >=0. Set StpMax to 0.0 (default), if - you don't want to limit step length. - -Use this subroutine when you optimize target function which contains exp() -or other fast growing functions, and optimization algorithm makes too -large steps which leads to overflow. This function allows us to reject -steps that are too large (and therefore expose us to the possible -overflow) without actually calculating function value at the x+stp*d. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetstpmax(minlbfgsstate* state, - double stpmax, - ae_state *_state) -{ - - - ae_assert(ae_isfinite(stpmax, _state), "MinLBFGSSetStpMax: StpMax is not finite!", _state); - ae_assert(ae_fp_greater_eq(stpmax,0), "MinLBFGSSetStpMax: StpMax<0!", _state); - state->stpmax = stpmax; -} - - -/************************************************************************* -This function sets scaling coefficients for LBFGS optimizer. - -ALGLIB optimizers use scaling matrices to test stopping conditions (step -size and gradient are scaled before comparison with tolerances). Scale of -the I-th variable is a translation invariant measure of: -a) "how large" the variable is -b) how large the step should be to make significant changes in the function - -Scaling is also used by finite difference variant of the optimizer - step -along I-th axis is equal to DiffStep*S[I]. - -In most optimizers (and in the LBFGS too) scaling is NOT a form of -preconditioning. It just affects stopping conditions. You should set -preconditioner by separate call to one of the MinLBFGSSetPrec...() -functions. - -There is special preconditioning mode, however, which uses scaling -coefficients to form diagonal preconditioning matrix. You can turn this -mode on, if you want. But you should understand that scaling is not the -same thing as preconditioning - these are two different, although related -forms of tuning solver. - -INPUT PARAMETERS: - State - structure stores algorithm state - S - array[N], non-zero scaling coefficients - S[i] may be negative, sign doesn't matter. - - -- ALGLIB -- - Copyright 14.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetscale(minlbfgsstate* state, - /* Real */ ae_vector* s, - ae_state *_state) -{ - ae_int_t i; - - - ae_assert(s->cnt>=state->n, "MinLBFGSSetScale: Length(S)n-1; i++) - { - ae_assert(ae_isfinite(s->ptr.p_double[i], _state), "MinLBFGSSetScale: S contains infinite or NAN elements", _state); - ae_assert(ae_fp_neq(s->ptr.p_double[i],0), "MinLBFGSSetScale: S contains zero elements", _state); - state->s.ptr.p_double[i] = ae_fabs(s->ptr.p_double[i], _state); - } -} - - -/************************************************************************* -Extended subroutine for internal use only. - -Accepts additional parameters: - - Flags - additional settings: - * Flags = 0 means no additional settings - * Flags = 1 "do not allocate memory". used when solving - a many subsequent tasks with same N/M values. - First call MUST be without this flag bit set, - subsequent calls of MinLBFGS with same - MinLBFGSState structure can set Flags to 1. - DiffStep - numerical differentiation step - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgscreatex(ae_int_t n, - ae_int_t m, - /* Real */ ae_vector* x, - ae_int_t flags, - double diffstep, - minlbfgsstate* state, - ae_state *_state) -{ - ae_bool allocatemem; - ae_int_t i; - - - ae_assert(n>=1, "MinLBFGS: N too small!", _state); - ae_assert(m>=1, "MinLBFGS: M too small!", _state); - ae_assert(m<=n, "MinLBFGS: M too large!", _state); - - /* - * Initialize - */ - state->teststep = 0; - state->diffstep = diffstep; - state->n = n; - state->m = m; - allocatemem = flags%2==0; - flags = flags/2; - if( allocatemem ) - { - ae_vector_set_length(&state->rho, m, _state); - ae_vector_set_length(&state->theta, m, _state); - ae_matrix_set_length(&state->yk, m, n, _state); - ae_matrix_set_length(&state->sk, m, n, _state); - ae_vector_set_length(&state->d, n, _state); - ae_vector_set_length(&state->x, n, _state); - ae_vector_set_length(&state->s, n, _state); - ae_vector_set_length(&state->g, n, _state); - ae_vector_set_length(&state->work, n, _state); - } - minlbfgssetcond(state, 0, 0, 0, 0, _state); - minlbfgssetxrep(state, ae_false, _state); - minlbfgssetstpmax(state, 0, _state); - minlbfgsrestartfrom(state, x, _state); - for(i=0; i<=n-1; i++) - { - state->s.ptr.p_double[i] = 1.0; - } - state->prectype = 0; -} - - -/************************************************************************* -Modification of the preconditioner: default preconditioner (simple -scaling, same for all elements of X) is used. - -INPUT PARAMETERS: - State - structure which stores algorithm state - -NOTE: you can change preconditioner "on the fly", during algorithm -iterations. - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetprecdefault(minlbfgsstate* state, ae_state *_state) -{ - - - state->prectype = 0; -} - - -/************************************************************************* -Modification of the preconditioner: Cholesky factorization of approximate -Hessian is used. - -INPUT PARAMETERS: - State - structure which stores algorithm state - P - triangular preconditioner, Cholesky factorization of - the approximate Hessian. array[0..N-1,0..N-1], - (if larger, only leading N elements are used). - IsUpper - whether upper or lower triangle of P is given - (other triangle is not referenced) - -After call to this function preconditioner is changed to P (P is copied -into the internal buffer). - -NOTE: you can change preconditioner "on the fly", during algorithm -iterations. - -NOTE 2: P should be nonsingular. Exception will be thrown otherwise. - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetpreccholesky(minlbfgsstate* state, - /* Real */ ae_matrix* p, - ae_bool isupper, - ae_state *_state) -{ - ae_int_t i; - double mx; - - - ae_assert(isfinitertrmatrix(p, state->n, isupper, _state), "MinLBFGSSetPrecCholesky: P contains infinite or NAN values!", _state); - mx = 0; - for(i=0; i<=state->n-1; i++) - { - mx = ae_maxreal(mx, ae_fabs(p->ptr.pp_double[i][i], _state), _state); - } - ae_assert(ae_fp_greater(mx,0), "MinLBFGSSetPrecCholesky: P is strictly singular!", _state); - if( state->denseh.rowsn||state->denseh.colsn ) - { - ae_matrix_set_length(&state->denseh, state->n, state->n, _state); - } - state->prectype = 1; - if( isupper ) - { - rmatrixcopy(state->n, state->n, p, 0, 0, &state->denseh, 0, 0, _state); - } - else - { - rmatrixtranspose(state->n, state->n, p, 0, 0, &state->denseh, 0, 0, _state); - } -} - - -/************************************************************************* -Modification of the preconditioner: diagonal of approximate Hessian is -used. - -INPUT PARAMETERS: - State - structure which stores algorithm state - D - diagonal of the approximate Hessian, array[0..N-1], - (if larger, only leading N elements are used). - -NOTE: you can change preconditioner "on the fly", during algorithm -iterations. - -NOTE 2: D[i] should be positive. Exception will be thrown otherwise. - -NOTE 3: you should pass diagonal of approximate Hessian - NOT ITS INVERSE. - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetprecdiag(minlbfgsstate* state, - /* Real */ ae_vector* d, - ae_state *_state) -{ - ae_int_t i; - - - ae_assert(d->cnt>=state->n, "MinLBFGSSetPrecDiag: D is too short", _state); - for(i=0; i<=state->n-1; i++) - { - ae_assert(ae_isfinite(d->ptr.p_double[i], _state), "MinLBFGSSetPrecDiag: D contains infinite or NAN elements", _state); - ae_assert(ae_fp_greater(d->ptr.p_double[i],0), "MinLBFGSSetPrecDiag: D contains non-positive elements", _state); - } - rvectorsetlengthatleast(&state->diagh, state->n, _state); - state->prectype = 2; - for(i=0; i<=state->n-1; i++) - { - state->diagh.ptr.p_double[i] = d->ptr.p_double[i]; - } -} - - -/************************************************************************* -Modification of the preconditioner: scale-based diagonal preconditioning. - -This preconditioning mode can be useful when you don't have approximate -diagonal of Hessian, but you know that your variables are badly scaled -(for example, one variable is in [1,10], and another in [1000,100000]), -and most part of the ill-conditioning comes from different scales of vars. - -In this case simple scale-based preconditioner, with H[i] = 1/(s[i]^2), -can greatly improve convergence. - -IMPRTANT: you should set scale of your variables with MinLBFGSSetScale() -call (before or after MinLBFGSSetPrecScale() call). Without knowledge of -the scale of your variables scale-based preconditioner will be just unit -matrix. - -INPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetprecscale(minlbfgsstate* state, ae_state *_state) -{ - - - state->prectype = 3; -} - - -/************************************************************************* -NOTES: - -1. This function has two different implementations: one which uses exact - (analytical) user-supplied gradient, and one which uses function value - only and numerically differentiates function in order to obtain - gradient. - - Depending on the specific function used to create optimizer object - (either MinLBFGSCreate() for analytical gradient or MinLBFGSCreateF() - for numerical differentiation) you should choose appropriate variant of - MinLBFGSOptimize() - one which accepts function AND gradient or one - which accepts function ONLY. - - Be careful to choose variant of MinLBFGSOptimize() which corresponds to - your optimization scheme! Table below lists different combinations of - callback (function/gradient) passed to MinLBFGSOptimize() and specific - function used to create optimizer. - - - | USER PASSED TO MinLBFGSOptimize() - CREATED WITH | function only | function and gradient - ------------------------------------------------------------ - MinLBFGSCreateF() | work FAIL - MinLBFGSCreate() | FAIL work - - Here "FAIL" denotes inappropriate combinations of optimizer creation - function and MinLBFGSOptimize() version. Attemps to use such - combination (for example, to create optimizer with MinLBFGSCreateF() and - to pass gradient information to MinCGOptimize()) will lead to exception - being thrown. Either you did not pass gradient when it WAS needed or - you passed gradient when it was NOT needed. - - -- ALGLIB -- - Copyright 20.03.2009 by Bochkanov Sergey -*************************************************************************/ -ae_bool minlbfgsiteration(minlbfgsstate* state, ae_state *_state) -{ - ae_int_t n; - ae_int_t m; - ae_int_t i; - ae_int_t j; - ae_int_t ic; - ae_int_t mcinfo; - double v; - double vv; - ae_bool result; - - - - /* - * Reverse communication preparations - * I know it looks ugly, but it works the same way - * anywhere from C++ to Python. - * - * This code initializes locals by: - * * random values determined during code - * generation - on first subroutine call - * * values from previous call - on subsequent calls - */ - if( state->rstate.stage>=0 ) - { - n = state->rstate.ia.ptr.p_int[0]; - m = state->rstate.ia.ptr.p_int[1]; - i = state->rstate.ia.ptr.p_int[2]; - j = state->rstate.ia.ptr.p_int[3]; - ic = state->rstate.ia.ptr.p_int[4]; - mcinfo = state->rstate.ia.ptr.p_int[5]; - v = state->rstate.ra.ptr.p_double[0]; - vv = state->rstate.ra.ptr.p_double[1]; - } - else - { - n = -983; - m = -989; - i = -834; - j = 900; - ic = -287; - mcinfo = 364; - v = 214; - vv = -338; - } - if( state->rstate.stage==0 ) - { - goto lbl_0; - } - if( state->rstate.stage==1 ) - { - goto lbl_1; - } - if( state->rstate.stage==2 ) - { - goto lbl_2; - } - if( state->rstate.stage==3 ) - { - goto lbl_3; - } - if( state->rstate.stage==4 ) - { - goto lbl_4; - } - if( state->rstate.stage==5 ) - { - goto lbl_5; - } - if( state->rstate.stage==6 ) - { - goto lbl_6; - } - if( state->rstate.stage==7 ) - { - goto lbl_7; - } - if( state->rstate.stage==8 ) - { - goto lbl_8; - } - if( state->rstate.stage==9 ) - { - goto lbl_9; - } - if( state->rstate.stage==10 ) - { - goto lbl_10; - } - if( state->rstate.stage==11 ) - { - goto lbl_11; - } - if( state->rstate.stage==12 ) - { - goto lbl_12; - } - if( state->rstate.stage==13 ) - { - goto lbl_13; - } - if( state->rstate.stage==14 ) - { - goto lbl_14; - } - if( state->rstate.stage==15 ) - { - goto lbl_15; - } - if( state->rstate.stage==16 ) - { - goto lbl_16; - } - - /* - * Routine body - */ - - /* - * Unload frequently used variables from State structure - * (just for typing convenience) - */ - n = state->n; - m = state->m; - state->repterminationtype = 0; - state->repiterationscount = 0; - state->repvaridx = -1; - state->repnfev = 0; - - /* - * Check, that transferred derivative value is right - */ - minlbfgs_clearrequestfields(state, _state); - if( !(ae_fp_eq(state->diffstep,0)&&ae_fp_greater(state->teststep,0)) ) - { - goto lbl_17; - } - state->needfg = ae_true; - i = 0; -lbl_19: - if( i>n-1 ) - { - goto lbl_21; - } - v = state->x.ptr.p_double[i]; - state->x.ptr.p_double[i] = v-state->teststep*state->s.ptr.p_double[i]; - state->rstate.stage = 0; - goto lbl_rcomm; -lbl_0: - state->fm1 = state->f; - state->fp1 = state->g.ptr.p_double[i]; - state->x.ptr.p_double[i] = v+state->teststep*state->s.ptr.p_double[i]; - state->rstate.stage = 1; - goto lbl_rcomm; -lbl_1: - state->fm2 = state->f; - state->fp2 = state->g.ptr.p_double[i]; - state->x.ptr.p_double[i] = v; - state->rstate.stage = 2; - goto lbl_rcomm; -lbl_2: - - /* - * 2*State.TestStep - scale parameter - * width of segment [Xi-TestStep;Xi+TestStep] - */ - if( !derivativecheck(state->fm1, state->fp1, state->fm2, state->fp2, state->f, state->g.ptr.p_double[i], 2*state->teststep, _state) ) - { - state->repvaridx = i; - state->repterminationtype = -7; - result = ae_false; - return result; - } - i = i+1; - goto lbl_19; -lbl_21: - state->needfg = ae_false; -lbl_17: - - /* - * Calculate F/G at the initial point - */ - minlbfgs_clearrequestfields(state, _state); - if( ae_fp_neq(state->diffstep,0) ) - { - goto lbl_22; - } - state->needfg = ae_true; - state->rstate.stage = 3; - goto lbl_rcomm; -lbl_3: - state->needfg = ae_false; - goto lbl_23; -lbl_22: - state->needf = ae_true; - state->rstate.stage = 4; - goto lbl_rcomm; -lbl_4: - state->fbase = state->f; - i = 0; -lbl_24: - if( i>n-1 ) - { - goto lbl_26; - } - v = state->x.ptr.p_double[i]; - state->x.ptr.p_double[i] = v-state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 5; - goto lbl_rcomm; -lbl_5: - state->fm2 = state->f; - state->x.ptr.p_double[i] = v-0.5*state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 6; - goto lbl_rcomm; -lbl_6: - state->fm1 = state->f; - state->x.ptr.p_double[i] = v+0.5*state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 7; - goto lbl_rcomm; -lbl_7: - state->fp1 = state->f; - state->x.ptr.p_double[i] = v+state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 8; - goto lbl_rcomm; -lbl_8: - state->fp2 = state->f; - state->x.ptr.p_double[i] = v; - state->g.ptr.p_double[i] = (8*(state->fp1-state->fm1)-(state->fp2-state->fm2))/(6*state->diffstep*state->s.ptr.p_double[i]); - i = i+1; - goto lbl_24; -lbl_26: - state->f = state->fbase; - state->needf = ae_false; -lbl_23: - trimprepare(state->f, &state->trimthreshold, _state); - if( !state->xrep ) - { - goto lbl_27; - } - minlbfgs_clearrequestfields(state, _state); - state->xupdated = ae_true; - state->rstate.stage = 9; - goto lbl_rcomm; -lbl_9: - state->xupdated = ae_false; -lbl_27: - state->repnfev = 1; - state->fold = state->f; - v = 0; - for(i=0; i<=n-1; i++) - { - v = v+ae_sqr(state->g.ptr.p_double[i]*state->s.ptr.p_double[i], _state); - } - if( ae_fp_less_eq(ae_sqrt(v, _state),state->epsg) ) - { - state->repterminationtype = 4; - result = ae_false; - return result; - } - - /* - * Choose initial step and direction. - * Apply preconditioner, if we have something other than default. - */ - ae_v_moveneg(&state->d.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); - if( state->prectype==0 ) - { - - /* - * Default preconditioner is used, but we can't use it before iterations will start - */ - v = ae_v_dotproduct(&state->g.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); - v = ae_sqrt(v, _state); - if( ae_fp_eq(state->stpmax,0) ) - { - state->stp = ae_minreal(1.0/v, 1, _state); - } - else - { - state->stp = ae_minreal(1.0/v, state->stpmax, _state); - } - } - if( state->prectype==1 ) - { - - /* - * Cholesky preconditioner is used - */ - fblscholeskysolve(&state->denseh, 1.0, n, ae_true, &state->d, &state->autobuf, _state); - state->stp = 1; - } - if( state->prectype==2 ) - { - - /* - * diagonal approximation is used - */ - for(i=0; i<=n-1; i++) - { - state->d.ptr.p_double[i] = state->d.ptr.p_double[i]/state->diagh.ptr.p_double[i]; - } - state->stp = 1; - } - if( state->prectype==3 ) - { - - /* - * scale-based preconditioner is used - */ - for(i=0; i<=n-1; i++) - { - state->d.ptr.p_double[i] = state->d.ptr.p_double[i]*state->s.ptr.p_double[i]*state->s.ptr.p_double[i]; - } - state->stp = 1; - } - - /* - * Main cycle - */ - state->k = 0; -lbl_29: - if( ae_false ) - { - goto lbl_30; - } - - /* - * Main cycle: prepare to 1-D line search - */ - state->p = state->k%m; - state->q = ae_minint(state->k, m-1, _state); - - /* - * Store X[k], G[k] - */ - ae_v_moveneg(&state->sk.ptr.pp_double[state->p][0], 1, &state->x.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_moveneg(&state->yk.ptr.pp_double[state->p][0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); - - /* - * Minimize F(x+alpha*d) - * Calculate S[k], Y[k] - */ - state->mcstage = 0; - if( state->k!=0 ) - { - state->stp = 1.0; - } - linminnormalized(&state->d, &state->stp, n, _state); - mcsrch(n, &state->x, &state->f, &state->g, &state->d, &state->stp, state->stpmax, minlbfgs_gtol, &mcinfo, &state->nfev, &state->work, &state->lstate, &state->mcstage, _state); -lbl_31: - if( state->mcstage==0 ) - { - goto lbl_32; - } - minlbfgs_clearrequestfields(state, _state); - if( ae_fp_neq(state->diffstep,0) ) - { - goto lbl_33; - } - state->needfg = ae_true; - state->rstate.stage = 10; - goto lbl_rcomm; -lbl_10: - state->needfg = ae_false; - goto lbl_34; -lbl_33: - state->needf = ae_true; - state->rstate.stage = 11; - goto lbl_rcomm; -lbl_11: - state->fbase = state->f; - i = 0; -lbl_35: - if( i>n-1 ) - { - goto lbl_37; - } - v = state->x.ptr.p_double[i]; - state->x.ptr.p_double[i] = v-state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 12; - goto lbl_rcomm; -lbl_12: - state->fm2 = state->f; - state->x.ptr.p_double[i] = v-0.5*state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 13; - goto lbl_rcomm; -lbl_13: - state->fm1 = state->f; - state->x.ptr.p_double[i] = v+0.5*state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 14; - goto lbl_rcomm; -lbl_14: - state->fp1 = state->f; - state->x.ptr.p_double[i] = v+state->diffstep*state->s.ptr.p_double[i]; - state->rstate.stage = 15; - goto lbl_rcomm; -lbl_15: - state->fp2 = state->f; - state->x.ptr.p_double[i] = v; - state->g.ptr.p_double[i] = (8*(state->fp1-state->fm1)-(state->fp2-state->fm2))/(6*state->diffstep*state->s.ptr.p_double[i]); - i = i+1; - goto lbl_35; -lbl_37: - state->f = state->fbase; - state->needf = ae_false; -lbl_34: - trimfunction(&state->f, &state->g, n, state->trimthreshold, _state); - mcsrch(n, &state->x, &state->f, &state->g, &state->d, &state->stp, state->stpmax, minlbfgs_gtol, &mcinfo, &state->nfev, &state->work, &state->lstate, &state->mcstage, _state); - goto lbl_31; -lbl_32: - if( !state->xrep ) - { - goto lbl_38; - } - - /* - * report - */ - minlbfgs_clearrequestfields(state, _state); - state->xupdated = ae_true; - state->rstate.stage = 16; - goto lbl_rcomm; -lbl_16: - state->xupdated = ae_false; -lbl_38: - state->repnfev = state->repnfev+state->nfev; - state->repiterationscount = state->repiterationscount+1; - ae_v_add(&state->sk.ptr.pp_double[state->p][0], 1, &state->x.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_add(&state->yk.ptr.pp_double[state->p][0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); - - /* - * Stopping conditions - */ - if( state->repiterationscount>=state->maxits&&state->maxits>0 ) - { - - /* - * Too many iterations - */ - state->repterminationtype = 5; - result = ae_false; - return result; - } - v = 0; - for(i=0; i<=n-1; i++) - { - v = v+ae_sqr(state->g.ptr.p_double[i]*state->s.ptr.p_double[i], _state); - } - if( ae_fp_less_eq(ae_sqrt(v, _state),state->epsg) ) - { - - /* - * Gradient is small enough - */ - state->repterminationtype = 4; - result = ae_false; - return result; - } - if( ae_fp_less_eq(state->fold-state->f,state->epsf*ae_maxreal(ae_fabs(state->fold, _state), ae_maxreal(ae_fabs(state->f, _state), 1.0, _state), _state)) ) - { - - /* - * F(k+1)-F(k) is small enough - */ - state->repterminationtype = 1; - result = ae_false; - return result; - } - v = 0; - for(i=0; i<=n-1; i++) - { - v = v+ae_sqr(state->sk.ptr.pp_double[state->p][i]/state->s.ptr.p_double[i], _state); - } - if( ae_fp_less_eq(ae_sqrt(v, _state),state->epsx) ) - { - - /* - * X(k+1)-X(k) is small enough - */ - state->repterminationtype = 2; - result = ae_false; - return result; - } - - /* - * If Wolfe conditions are satisfied, we can update - * limited memory model. - * - * However, if conditions are not satisfied (NFEV limit is met, - * function is too wild, ...), we'll skip L-BFGS update - */ - if( mcinfo!=1 ) - { - - /* - * Skip update. - * - * In such cases we'll initialize search direction by - * antigradient vector, because it leads to more - * transparent code with less number of special cases - */ - state->fold = state->f; - ae_v_moveneg(&state->d.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); - } - else - { - - /* - * Calculate Rho[k], GammaK - */ - v = ae_v_dotproduct(&state->yk.ptr.pp_double[state->p][0], 1, &state->sk.ptr.pp_double[state->p][0], 1, ae_v_len(0,n-1)); - vv = ae_v_dotproduct(&state->yk.ptr.pp_double[state->p][0], 1, &state->yk.ptr.pp_double[state->p][0], 1, ae_v_len(0,n-1)); - if( ae_fp_eq(v,0)||ae_fp_eq(vv,0) ) - { - - /* - * Rounding errors make further iterations impossible. - */ - state->repterminationtype = -2; - result = ae_false; - return result; - } - state->rho.ptr.p_double[state->p] = 1/v; - state->gammak = v/vv; - - /* - * Calculate d(k+1) = -H(k+1)*g(k+1) - * - * for I:=K downto K-Q do - * V = s(i)^T * work(iteration:I) - * theta(i) = V - * work(iteration:I+1) = work(iteration:I) - V*Rho(i)*y(i) - * work(last iteration) = H0*work(last iteration) - preconditioner - * for I:=K-Q to K do - * V = y(i)^T*work(iteration:I) - * work(iteration:I+1) = work(iteration:I) +(-V+theta(i))*Rho(i)*s(i) - * - * NOW WORK CONTAINS d(k+1) - */ - ae_v_move(&state->work.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); - for(i=state->k; i>=state->k-state->q; i--) - { - ic = i%m; - v = ae_v_dotproduct(&state->sk.ptr.pp_double[ic][0], 1, &state->work.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->theta.ptr.p_double[ic] = v; - vv = v*state->rho.ptr.p_double[ic]; - ae_v_subd(&state->work.ptr.p_double[0], 1, &state->yk.ptr.pp_double[ic][0], 1, ae_v_len(0,n-1), vv); - } - if( state->prectype==0 ) - { - - /* - * Simple preconditioner is used - */ - v = state->gammak; - ae_v_muld(&state->work.ptr.p_double[0], 1, ae_v_len(0,n-1), v); - } - if( state->prectype==1 ) - { - - /* - * Cholesky preconditioner is used - */ - fblscholeskysolve(&state->denseh, 1, n, ae_true, &state->work, &state->autobuf, _state); - } - if( state->prectype==2 ) - { - - /* - * diagonal approximation is used - */ - for(i=0; i<=n-1; i++) - { - state->work.ptr.p_double[i] = state->work.ptr.p_double[i]/state->diagh.ptr.p_double[i]; - } - } - if( state->prectype==3 ) - { - - /* - * scale-based preconditioner is used - */ - for(i=0; i<=n-1; i++) - { - state->work.ptr.p_double[i] = state->work.ptr.p_double[i]*state->s.ptr.p_double[i]*state->s.ptr.p_double[i]; - } - } - for(i=state->k-state->q; i<=state->k; i++) - { - ic = i%m; - v = ae_v_dotproduct(&state->yk.ptr.pp_double[ic][0], 1, &state->work.ptr.p_double[0], 1, ae_v_len(0,n-1)); - vv = state->rho.ptr.p_double[ic]*(-v+state->theta.ptr.p_double[ic]); - ae_v_addd(&state->work.ptr.p_double[0], 1, &state->sk.ptr.pp_double[ic][0], 1, ae_v_len(0,n-1), vv); - } - ae_v_moveneg(&state->d.ptr.p_double[0], 1, &state->work.ptr.p_double[0], 1, ae_v_len(0,n-1)); - - /* - * Next step - */ - state->fold = state->f; - state->k = state->k+1; - } - goto lbl_29; -lbl_30: - result = ae_false; - return result; - - /* - * Saving state - */ -lbl_rcomm: - result = ae_true; - state->rstate.ia.ptr.p_int[0] = n; - state->rstate.ia.ptr.p_int[1] = m; - state->rstate.ia.ptr.p_int[2] = i; - state->rstate.ia.ptr.p_int[3] = j; - state->rstate.ia.ptr.p_int[4] = ic; - state->rstate.ia.ptr.p_int[5] = mcinfo; - state->rstate.ra.ptr.p_double[0] = v; - state->rstate.ra.ptr.p_double[1] = vv; - return result; -} - - -/************************************************************************* -L-BFGS algorithm results - -INPUT PARAMETERS: - State - algorithm state - -OUTPUT PARAMETERS: - X - array[0..N-1], solution - Rep - optimization report: - * Rep.TerminationType completion code: - * -7 gradient verification failed. - See MinLBFGSSetGradientCheck() for more information. - * -2 rounding errors prevent further improvement. - X contains best point found. - * -1 incorrect parameters were specified - * 1 relative function improvement is no more than - EpsF. - * 2 relative step is no more than EpsX. - * 4 gradient norm is no more than EpsG - * 5 MaxIts steps was taken - * 7 stopping conditions are too stringent, - further improvement is impossible - * Rep.IterationsCount contains iterations count - * NFEV contains number of function calculations - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgsresults(minlbfgsstate* state, - /* Real */ ae_vector* x, - minlbfgsreport* rep, - ae_state *_state) -{ - - ae_vector_clear(x); - _minlbfgsreport_clear(rep); - - minlbfgsresultsbuf(state, x, rep, _state); -} - - -/************************************************************************* -L-BFGS algorithm results - -Buffered implementation of MinLBFGSResults which uses pre-allocated buffer -to store X[]. If buffer size is too small, it resizes buffer. It is -intended to be used in the inner cycles of performance critical algorithms -where array reallocation penalty is too large to be ignored. - - -- ALGLIB -- - Copyright 20.08.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgsresultsbuf(minlbfgsstate* state, - /* Real */ ae_vector* x, - minlbfgsreport* rep, - ae_state *_state) -{ - - - if( x->cntn ) - { - ae_vector_set_length(x, state->n, _state); - } - ae_v_move(&x->ptr.p_double[0], 1, &state->x.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - rep->iterationscount = state->repiterationscount; - rep->nfev = state->repnfev; - rep->varidx = state->repvaridx; - rep->terminationtype = state->repterminationtype; -} - - -/************************************************************************* -This subroutine restarts LBFGS algorithm from new point. All optimization -parameters are left unchanged. - -This function allows to solve multiple optimization problems (which -must have same number of dimensions) without object reallocation penalty. - -INPUT PARAMETERS: - State - structure used to store algorithm state - X - new starting point. - - -- ALGLIB -- - Copyright 30.07.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgsrestartfrom(minlbfgsstate* state, - /* Real */ ae_vector* x, - ae_state *_state) -{ - - - ae_assert(x->cnt>=state->n, "MinLBFGSRestartFrom: Length(X)n, _state), "MinLBFGSRestartFrom: X contains infinite or NaN values!", _state); - ae_v_move(&state->x.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - ae_vector_set_length(&state->rstate.ia, 5+1, _state); - ae_vector_set_length(&state->rstate.ra, 1+1, _state); - state->rstate.stage = -1; - minlbfgs_clearrequestfields(state, _state); -} - - -/************************************************************************* -This subroutine turns on verification of the user-supplied analytic -gradient: -* user calls this subroutine before optimization begins -* MinLBFGSOptimize() is called -* prior to actual optimization, for each component of parameters being - optimized X[i] algorithm performs following steps: - * two trial steps are made to X[i]-TestStep*S[i] and X[i]+TestStep*S[i], - where X[i] is i-th component of the initial point and S[i] is a scale - of i-th parameter - * if needed, steps are bounded with respect to constraints on X[] - * F(X) is evaluated at these trial points - * we perform one more evaluation in the middle point of the interval - * we build cubic model using function values and derivatives at trial - points and we compare its prediction with actual value in the middle - point - * in case difference between prediction and actual value is higher than - some predetermined threshold, algorithm stops with completion code -7; - Rep.VarIdx is set to index of the parameter with incorrect derivative. -* after verification is over, algorithm proceeds to the actual optimization. - -NOTE 1: verification needs N (parameters count) gradient evaluations. It - is very costly and you should use it only for low dimensional - problems, when you want to be sure that you've correctly - calculated analytic derivatives. You should not use it in the - production code (unless you want to check derivatives provided by - some third party). - -NOTE 2: you should carefully choose TestStep. Value which is too large - (so large that function behaviour is significantly non-cubic) will - lead to false alarms. You may use different step for different - parameters by means of setting scale with MinLBFGSSetScale(). - -NOTE 3: this function may lead to false positives. In case it reports that - I-th derivative was calculated incorrectly, you may decrease test - step and try one more time - maybe your function changes too - sharply and your step is too large for such rapidly chanding - function. - -INPUT PARAMETERS: - State - structure used to store algorithm state - TestStep - verification step: - * TestStep=0 turns verification off - * TestStep>0 activates verification - - -- ALGLIB -- - Copyright 24.05.2012 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetgradientcheck(minlbfgsstate* state, - double teststep, - ae_state *_state) -{ - - - ae_assert(ae_isfinite(teststep, _state), "MinLBFGSSetGradientCheck: TestStep contains NaN or Infinite", _state); - ae_assert(ae_fp_greater_eq(teststep,0), "MinLBFGSSetGradientCheck: invalid argument TestStep(TestStep<0)", _state); - state->teststep = teststep; -} - - -/************************************************************************* -Clears request fileds (to be sure that we don't forgot to clear something) -*************************************************************************/ -static void minlbfgs_clearrequestfields(minlbfgsstate* state, - ae_state *_state) -{ - - - state->needf = ae_false; - state->needfg = ae_false; - state->xupdated = ae_false; -} - - -ae_bool _minlbfgsstate_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - minlbfgsstate *p = (minlbfgsstate*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->s, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->rho, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->yk, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->sk, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->theta, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->d, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->work, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->denseh, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->diagh, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->autobuf, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->g, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) - return ae_false; - if( !_linminstate_init(&p->lstate, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _minlbfgsstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - minlbfgsstate *dst = (minlbfgsstate*)_dst; - minlbfgsstate *src = (minlbfgsstate*)_src; - dst->n = src->n; - dst->m = src->m; - dst->epsg = src->epsg; - dst->epsf = src->epsf; - dst->epsx = src->epsx; - dst->maxits = src->maxits; - dst->xrep = src->xrep; - dst->stpmax = src->stpmax; - if( !ae_vector_init_copy(&dst->s, &src->s, _state, make_automatic) ) - return ae_false; - dst->diffstep = src->diffstep; - dst->nfev = src->nfev; - dst->mcstage = src->mcstage; - dst->k = src->k; - dst->q = src->q; - dst->p = src->p; - if( !ae_vector_init_copy(&dst->rho, &src->rho, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->yk, &src->yk, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->sk, &src->sk, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->theta, &src->theta, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->d, &src->d, _state, make_automatic) ) - return ae_false; - dst->stp = src->stp; - if( !ae_vector_init_copy(&dst->work, &src->work, _state, make_automatic) ) - return ae_false; - dst->fold = src->fold; - dst->trimthreshold = src->trimthreshold; - dst->prectype = src->prectype; - dst->gammak = src->gammak; - if( !ae_matrix_init_copy(&dst->denseh, &src->denseh, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->diagh, &src->diagh, _state, make_automatic) ) - return ae_false; - dst->fbase = src->fbase; - dst->fm2 = src->fm2; - dst->fm1 = src->fm1; - dst->fp1 = src->fp1; - dst->fp2 = src->fp2; - if( !ae_vector_init_copy(&dst->autobuf, &src->autobuf, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) - return ae_false; - dst->f = src->f; - if( !ae_vector_init_copy(&dst->g, &src->g, _state, make_automatic) ) - return ae_false; - dst->needf = src->needf; - dst->needfg = src->needfg; - dst->xupdated = src->xupdated; - dst->teststep = src->teststep; - if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) - return ae_false; - dst->repiterationscount = src->repiterationscount; - dst->repnfev = src->repnfev; - dst->repvaridx = src->repvaridx; - dst->repterminationtype = src->repterminationtype; - if( !_linminstate_init_copy(&dst->lstate, &src->lstate, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _minlbfgsstate_clear(void* _p) -{ - minlbfgsstate *p = (minlbfgsstate*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->s); - ae_vector_clear(&p->rho); - ae_matrix_clear(&p->yk); - ae_matrix_clear(&p->sk); - ae_vector_clear(&p->theta); - ae_vector_clear(&p->d); - ae_vector_clear(&p->work); - ae_matrix_clear(&p->denseh); - ae_vector_clear(&p->diagh); - ae_vector_clear(&p->autobuf); - ae_vector_clear(&p->x); - ae_vector_clear(&p->g); - _rcommstate_clear(&p->rstate); - _linminstate_clear(&p->lstate); -} - - -void _minlbfgsstate_destroy(void* _p) -{ - minlbfgsstate *p = (minlbfgsstate*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->s); - ae_vector_destroy(&p->rho); - ae_matrix_destroy(&p->yk); - ae_matrix_destroy(&p->sk); - ae_vector_destroy(&p->theta); - ae_vector_destroy(&p->d); - ae_vector_destroy(&p->work); - ae_matrix_destroy(&p->denseh); - ae_vector_destroy(&p->diagh); - ae_vector_destroy(&p->autobuf); - ae_vector_destroy(&p->x); - ae_vector_destroy(&p->g); - _rcommstate_destroy(&p->rstate); - _linminstate_destroy(&p->lstate); -} - - -ae_bool _minlbfgsreport_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - minlbfgsreport *p = (minlbfgsreport*)_p; - ae_touch_ptr((void*)p); - return ae_true; -} - - -ae_bool _minlbfgsreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - minlbfgsreport *dst = (minlbfgsreport*)_dst; - minlbfgsreport *src = (minlbfgsreport*)_src; - dst->iterationscount = src->iterationscount; - dst->nfev = src->nfev; - dst->varidx = src->varidx; - dst->terminationtype = src->terminationtype; - return ae_true; -} - - -void _minlbfgsreport_clear(void* _p) -{ - minlbfgsreport *p = (minlbfgsreport*)_p; - ae_touch_ptr((void*)p); -} - - -void _minlbfgsreport_destroy(void* _p) -{ - minlbfgsreport *p = (minlbfgsreport*)_p; - ae_touch_ptr((void*)p); -} - - - - -/************************************************************************* - CONSTRAINED QUADRATIC PROGRAMMING - -The subroutine creates QP optimizer. After initial creation, it contains -default optimization problem with zero quadratic and linear terms and no -constraints. You should set quadratic/linear terms with calls to functions -provided by MinQP subpackage. - -INPUT PARAMETERS: - N - problem size - -OUTPUT PARAMETERS: - State - optimizer with zero quadratic/linear terms - and no constraints - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpcreate(ae_int_t n, minqpstate* state, ae_state *_state) -{ - ae_int_t i; - - _minqpstate_clear(state); - - ae_assert(n>=1, "MinQPCreate: N<1", _state); - - /* - * initialize QP solver - */ - state->n = n; - state->nec = 0; - state->nic = 0; - state->repterminationtype = 0; - state->anorm = 1; - state->akind = 0; - cqminit(n, &state->a, _state); - sasinit(n, &state->sas, _state); - ae_vector_set_length(&state->b, n, _state); - ae_vector_set_length(&state->bndl, n, _state); - ae_vector_set_length(&state->bndu, n, _state); - ae_vector_set_length(&state->workbndl, n, _state); - ae_vector_set_length(&state->workbndu, n, _state); - ae_vector_set_length(&state->havebndl, n, _state); - ae_vector_set_length(&state->havebndu, n, _state); - ae_vector_set_length(&state->s, n, _state); - ae_vector_set_length(&state->startx, n, _state); - ae_vector_set_length(&state->xorigin, n, _state); - ae_vector_set_length(&state->xs, n, _state); - ae_vector_set_length(&state->xn, n, _state); - ae_vector_set_length(&state->gc, n, _state); - ae_vector_set_length(&state->pg, n, _state); - for(i=0; i<=n-1; i++) - { - state->bndl.ptr.p_double[i] = _state->v_neginf; - state->bndu.ptr.p_double[i] = _state->v_posinf; - state->havebndl.ptr.p_bool[i] = ae_false; - state->havebndu.ptr.p_bool[i] = ae_false; - state->b.ptr.p_double[i] = 0.0; - state->startx.ptr.p_double[i] = 0.0; - state->xorigin.ptr.p_double[i] = 0.0; - state->s.ptr.p_double[i] = 1.0; - } - state->havex = ae_false; - minqpsetalgocholesky(state, _state); - normestimatorcreate(n, n, 5, 5, &state->estimator, _state); - minbleiccreate(n, &state->startx, &state->solver, _state); -} - - -/************************************************************************* -This function sets linear term for QP solver. - -By default, linear term is zero. - -INPUT PARAMETERS: - State - structure which stores algorithm state - B - linear term, array[N]. - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpsetlinearterm(minqpstate* state, - /* Real */ ae_vector* b, - ae_state *_state) -{ - ae_int_t n; - - - n = state->n; - ae_assert(b->cnt>=n, "MinQPSetLinearTerm: Length(B)n; - ae_assert(a->rows>=n, "MinQPSetQuadraticTerm: Rows(A)cols>=n, "MinQPSetQuadraticTerm: Cols(A)n; - ae_assert(sparsegetnrows(a, _state)>=n, "MinQPSetQuadraticTermSparse: Rows(A)=n, "MinQPSetQuadraticTermSparse: Cols(A)sparsea, _state); - state->sparseaupper = isupper; - state->akind = 1; -} - - -/************************************************************************* -This function sets starting point for QP solver. It is useful to have -good initial approximation to the solution, because it will increase -speed of convergence and identification of active constraints. - -INPUT PARAMETERS: - State - structure which stores algorithm state - X - starting point, array[N]. - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpsetstartingpoint(minqpstate* state, - /* Real */ ae_vector* x, - ae_state *_state) -{ - ae_int_t n; - - - n = state->n; - ae_assert(x->cnt>=n, "MinQPSetStartingPoint: Length(B)n; - ae_assert(xorigin->cnt>=n, "MinQPSetOrigin: Length(B)cnt>=state->n, "MinQPSetScale: Length(S)n-1; i++) - { - ae_assert(ae_isfinite(s->ptr.p_double[i], _state), "MinQPSetScale: S contains infinite or NAN elements", _state); - ae_assert(ae_fp_neq(s->ptr.p_double[i],0), "MinQPSetScale: S contains zero elements", _state); - state->s.ptr.p_double[i] = ae_fabs(s->ptr.p_double[i], _state); - } -} - - -/************************************************************************* -This function tells solver to use Cholesky-based algorithm. This algorithm -is active by default. - -DESCRIPTION: - -Cholesky-based algorithm can be used only for problems which: -* have dense quadratic term, set by MinQPSetQuadraticTerm(), sparse or - structured problems are not supported. -* are strictly convex, i.e. quadratic term is symmetric positive definite, - indefinite or semidefinite problems are not supported by this algorithm. - -If anything of what listed above is violated, you may use BLEIC-based QP -algorithm which can be activated by MinQPSetAlgoBLEIC(). - -BENEFITS AND DRAWBACKS: - -This algorithm gives best precision amongst all QP solvers provided by -ALGLIB (Newton iterations have much higher precision than any other -optimization algorithm). This solver also gracefully handles problems with -very large amount of constraints. - -Performance of the algorithm is good because internally it uses Level 3 -Dense BLAS for its performance-critical parts. - - -From the other side, algorithm has O(N^3) complexity for unconstrained -problems and up to orders of magnitude slower on constrained problems -(these additional iterations are needed to identify active constraints). -So, its running time depends on number of constraints active at solution. - -Furthermore, this algorithm can not solve problems with sparse matrices or -problems with semidefinite/indefinite matrices of any kind (dense/sparse). - -INPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpsetalgocholesky(minqpstate* state, ae_state *_state) -{ - - - state->algokind = 1; -} - - -/************************************************************************* -This function tells solver to use BLEIC-based algorithm and sets stopping -criteria for the algorithm. - -DESCRIPTION: - -BLEIC-based QP algorithm can be used for any kind of QP problems: -* problems with both dense and sparse quadratic terms -* problems with positive definite, semidefinite, indefinite terms - -BLEIC-based algorithm can solve even indefinite problems - as long as they -are bounded from below on the feasible set. Of course, global minimum is -found only for positive definite and semidefinite problems. As for -indefinite ones - only local minimum is found. - -BENEFITS AND DRAWBACKS: - -This algorithm can be used to solve both convex and indefinite QP problems -and it can utilize sparsity of the quadratic term (algorithm calculates -matrix-vector products, which can be performed efficiently in case of -sparse matrix). - -Algorithm has iteration cost, which (assuming fixed amount of non-boundary -linear constraints) linearly depends on problem size. Boundary constraints -does not significantly change iteration cost. - -Thus, it outperforms Cholesky-based QP algorithm (CQP) on high-dimensional -sparse problems with moderate amount of constraints. - - -From the other side, unlike CQP solver, this algorithm does NOT make use -of Level 3 Dense BLAS. Thus, its performance on dense problems is inferior -to that of CQP solver. - -Its precision is also inferior to that of CQP. CQP performs Newton steps -which are know to achieve very good precision. In many cases Newton step -leads us exactly to the solution. BLEIC-QP performs LBFGS steps, which are -good at detecting neighborhood of the solution, buy need many iterations -to find solution with 6 digits of precision. - -INPUT PARAMETERS: - State - structure which stores algorithm state - EpsG - >=0 - The subroutine finishes its work if the condition - |v|=0 - The subroutine finishes its work if exploratory steepest - descent step on k+1-th iteration satisfies following - condition: |F(k+1)-F(k)|<=EpsF*max{|F(k)|,|F(k+1)|,1} - EpsX - >=0 - The subroutine finishes its work if exploratory steepest - descent step on k+1-th iteration satisfies following - condition: - * |.| means Euclidian norm - * v - scaled step vector, v[i]=dx[i]/s[i] - * dx - step vector, dx=X(k+1)-X(k) - * s - scaling coefficients set by MinQPSetScale() - MaxIts - maximum number of iterations. If MaxIts=0, the number of - iterations is unlimited. - -Passing EpsG=0, EpsF=0 and EpsX=0 and MaxIts=0 (simultaneously) will lead -to automatic stopping criterion selection (presently it is small step -length, but it may change in the future versions of ALGLIB). - -IT IS VERY IMPORTANT THAT YOU CALL MinQPSetScale() WHEN YOU USE THIS ALGO! - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpsetalgobleic(minqpstate* state, - double epsg, - double epsf, - double epsx, - ae_int_t maxits, - ae_state *_state) -{ - - - ae_assert(ae_isfinite(epsg, _state), "MinQPSetAlgoBLEIC: EpsG is not finite number", _state); - ae_assert(ae_fp_greater_eq(epsg,0), "MinQPSetAlgoBLEIC: negative EpsG", _state); - ae_assert(ae_isfinite(epsf, _state), "MinQPSetAlgoBLEIC: EpsF is not finite number", _state); - ae_assert(ae_fp_greater_eq(epsf,0), "MinQPSetAlgoBLEIC: negative EpsF", _state); - ae_assert(ae_isfinite(epsx, _state), "MinQPSetAlgoBLEIC: EpsX is not finite number", _state); - ae_assert(ae_fp_greater_eq(epsx,0), "MinQPSetAlgoBLEIC: negative EpsX", _state); - ae_assert(maxits>=0, "MinQPSetAlgoBLEIC: negative MaxIts!", _state); - state->algokind = 2; - if( ((ae_fp_eq(epsg,0)&&ae_fp_eq(epsf,0))&&ae_fp_eq(epsx,0))&&maxits==0 ) - { - epsx = 1.0E-6; - } - state->bleicepsg = epsg; - state->bleicepsf = epsf; - state->bleicepsx = epsx; - state->bleicmaxits = maxits; -} - - -/************************************************************************* -This function sets boundary constraints for QP solver - -Boundary constraints are inactive by default (after initial creation). -After being set, they are preserved until explicitly turned off with -another SetBC() call. - -INPUT PARAMETERS: - State - structure stores algorithm state - BndL - lower bounds, array[N]. - If some (all) variables are unbounded, you may specify - very small number or -INF (latter is recommended because - it will allow solver to use better algorithm). - BndU - upper bounds, array[N]. - If some (all) variables are unbounded, you may specify - very large number or +INF (latter is recommended because - it will allow solver to use better algorithm). - -NOTE: it is possible to specify BndL[i]=BndU[i]. In this case I-th -variable will be "frozen" at X[i]=BndL[i]=BndU[i]. - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpsetbc(minqpstate* state, - /* Real */ ae_vector* bndl, - /* Real */ ae_vector* bndu, - ae_state *_state) -{ - ae_int_t i; - ae_int_t n; - - - n = state->n; - ae_assert(bndl->cnt>=n, "MinQPSetBC: Length(BndL)cnt>=n, "MinQPSetBC: Length(BndU)ptr.p_double[i], _state)||ae_isneginf(bndl->ptr.p_double[i], _state), "MinQPSetBC: BndL contains NAN or +INF", _state); - ae_assert(ae_isfinite(bndu->ptr.p_double[i], _state)||ae_isposinf(bndu->ptr.p_double[i], _state), "MinQPSetBC: BndU contains NAN or -INF", _state); - state->bndl.ptr.p_double[i] = bndl->ptr.p_double[i]; - state->havebndl.ptr.p_bool[i] = ae_isfinite(bndl->ptr.p_double[i], _state); - state->bndu.ptr.p_double[i] = bndu->ptr.p_double[i]; - state->havebndu.ptr.p_bool[i] = ae_isfinite(bndu->ptr.p_double[i], _state); - } -} - - -/************************************************************************* -This function sets linear constraints for QP optimizer. - -Linear constraints are inactive by default (after initial creation). - -INPUT PARAMETERS: - State - structure previously allocated with MinQPCreate call. - C - linear constraints, array[K,N+1]. - Each row of C represents one constraint, either equality - or inequality (see below): - * first N elements correspond to coefficients, - * last element corresponds to the right part. - All elements of C (including right part) must be finite. - CT - type of constraints, array[K]: - * if CT[i]>0, then I-th constraint is C[i,*]*x >= C[i,n+1] - * if CT[i]=0, then I-th constraint is C[i,*]*x = C[i,n+1] - * if CT[i]<0, then I-th constraint is C[i,*]*x <= C[i,n+1] - K - number of equality/inequality constraints, K>=0: - * if given, only leading K elements of C/CT are used - * if not given, automatically determined from sizes of C/CT - -NOTE 1: linear (non-bound) constraints are satisfied only approximately - - there always exists some minor violation (about 10^-10...10^-13) - due to numerical errors. - - -- ALGLIB -- - Copyright 19.06.2012 by Bochkanov Sergey -*************************************************************************/ -void minqpsetlc(minqpstate* state, - /* Real */ ae_matrix* c, - /* Integer */ ae_vector* ct, - ae_int_t k, - ae_state *_state) -{ - ae_int_t n; - ae_int_t i; - ae_int_t j; - double v; - - - n = state->n; - - /* - * First, check for errors in the inputs - */ - ae_assert(k>=0, "MinQPSetLC: K<0", _state); - ae_assert(c->cols>=n+1||k==0, "MinQPSetLC: Cols(C)rows>=k, "MinQPSetLC: Rows(C)cnt>=k, "MinQPSetLC: Length(CT)nec = 0; - state->nic = 0; - return; - } - - /* - * Equality constraints are stored first, in the upper - * NEC rows of State.CLEIC matrix. Inequality constraints - * are stored in the next NIC rows. - * - * NOTE: we convert inequality constraints to the form - * A*x<=b before copying them. - */ - rmatrixsetlengthatleast(&state->cleic, k, n+1, _state); - state->nec = 0; - state->nic = 0; - for(i=0; i<=k-1; i++) - { - if( ct->ptr.p_int[i]==0 ) - { - ae_v_move(&state->cleic.ptr.pp_double[state->nec][0], 1, &c->ptr.pp_double[i][0], 1, ae_v_len(0,n)); - state->nec = state->nec+1; - } - } - for(i=0; i<=k-1; i++) - { - if( ct->ptr.p_int[i]!=0 ) - { - if( ct->ptr.p_int[i]>0 ) - { - ae_v_moveneg(&state->cleic.ptr.pp_double[state->nec+state->nic][0], 1, &c->ptr.pp_double[i][0], 1, ae_v_len(0,n)); - } - else - { - ae_v_move(&state->cleic.ptr.pp_double[state->nec+state->nic][0], 1, &c->ptr.pp_double[i][0], 1, ae_v_len(0,n)); - } - state->nic = state->nic+1; - } - } - - /* - * Normalize rows of State.CLEIC: each row must have unit norm. - * Norm is calculated using first N elements (i.e. right part is - * not counted when we calculate norm). - */ - for(i=0; i<=k-1; i++) - { - v = 0; - for(j=0; j<=n-1; j++) - { - v = v+ae_sqr(state->cleic.ptr.pp_double[i][j], _state); - } - if( ae_fp_eq(v,0) ) - { - continue; - } - v = 1/ae_sqrt(v, _state); - ae_v_muld(&state->cleic.ptr.pp_double[i][0], 1, ae_v_len(0,n), v); - } -} - - -/************************************************************************* -This function solves quadratic programming problem. -You should call it after setting solver options with MinQPSet...() calls. - -INPUT PARAMETERS: - State - algorithm state - -You should use MinQPResults() function to access results after calls -to this function. - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey. - Special thanks to Elvira Illarionova for important suggestions on - the linearly constrained QP algorithm. -*************************************************************************/ -void minqpoptimize(minqpstate* state, ae_state *_state) -{ - ae_int_t n; - ae_int_t i; - ae_int_t nbc; - double v0; - double v1; - double v; - double d2; - double d1; - double d0; - double noisetolerance; - double fprev; - double fcand; - double fcur; - ae_int_t nextaction; - ae_int_t actstatus; - double noiselevel; - ae_int_t badnewtonits; - double maxscaledgrad; - - - noisetolerance = 10; - n = state->n; - state->repterminationtype = -5; - state->repinneriterationscount = 0; - state->repouteriterationscount = 0; - state->repncholesky = 0; - state->repnmv = 0; - state->debugphase1flops = 0; - state->debugphase2flops = 0; - state->debugphase3flops = 0; - rvectorsetlengthatleast(&state->rctmpg, n, _state); - - /* - * check correctness of constraints - */ - for(i=0; i<=n-1; i++) - { - if( state->havebndl.ptr.p_bool[i]&&state->havebndu.ptr.p_bool[i] ) - { - if( ae_fp_greater(state->bndl.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) - { - state->repterminationtype = -3; - return; - } - } - } - - /* - * count number of bound and linear constraints - */ - nbc = 0; - for(i=0; i<=n-1; i++) - { - if( state->havebndl.ptr.p_bool[i] ) - { - nbc = nbc+1; - } - if( state->havebndu.ptr.p_bool[i] ) - { - nbc = nbc+1; - } - } - - /* - * Initial point: - * * if we have starting point in StartX, we just have to bound it - * * if we do not have StartX, deduce initial point from boundary constraints - */ - if( state->havex ) - { - for(i=0; i<=n-1; i++) - { - state->xs.ptr.p_double[i] = state->startx.ptr.p_double[i]; - if( state->havebndl.ptr.p_bool[i]&&ae_fp_less(state->xs.ptr.p_double[i],state->bndl.ptr.p_double[i]) ) - { - state->xs.ptr.p_double[i] = state->bndl.ptr.p_double[i]; - } - if( state->havebndu.ptr.p_bool[i]&&ae_fp_greater(state->xs.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) - { - state->xs.ptr.p_double[i] = state->bndu.ptr.p_double[i]; - } - } - } - else - { - for(i=0; i<=n-1; i++) - { - if( state->havebndl.ptr.p_bool[i]&&state->havebndu.ptr.p_bool[i] ) - { - state->xs.ptr.p_double[i] = 0.5*(state->bndl.ptr.p_double[i]+state->bndu.ptr.p_double[i]); - continue; - } - if( state->havebndl.ptr.p_bool[i] ) - { - state->xs.ptr.p_double[i] = state->bndl.ptr.p_double[i]; - continue; - } - if( state->havebndu.ptr.p_bool[i] ) - { - state->xs.ptr.p_double[i] = state->bndu.ptr.p_double[i]; - continue; - } - state->xs.ptr.p_double[i] = 0; - } - } - - /* - * Cholesky solver. - */ - if( state->algokind==1 ) - { - - /* - * Check matrix type. - * Cholesky solver supports only dense matrices. - */ - if( state->akind!=0 ) - { - state->repterminationtype = -5; - return; - } - - /* - * Our formulation of quadratic problem includes origin point, - * i.e. we have F(x-x_origin) which is minimized subject to - * constraints on x, instead of having simply F(x). - * - * Here we make transition from non-zero origin to zero one. - * In order to make such transition we have to: - * 1. subtract x_origin from x_start - * 2. modify constraints - * 3. solve problem - * 4. add x_origin to solution - * - * There is alternate solution - to modify quadratic function - * by expansion of multipliers containing (x-x_origin), but - * we prefer to modify constraints, because it is a) more precise - * and b) easier to to. - * - * Parts (1)-(2) are done here. After this block is over, - * we have: - * * XS, which stores shifted XStart (if we don't have XStart, - * value of XS will be ignored later) - * * WorkBndL, WorkBndU, which store modified boundary constraints. - */ - for(i=0; i<=n-1; i++) - { - if( state->havebndl.ptr.p_bool[i] ) - { - state->workbndl.ptr.p_double[i] = state->bndl.ptr.p_double[i]-state->xorigin.ptr.p_double[i]; - } - else - { - state->workbndl.ptr.p_double[i] = _state->v_neginf; - } - if( state->havebndu.ptr.p_bool[i] ) - { - state->workbndu.ptr.p_double[i] = state->bndu.ptr.p_double[i]-state->xorigin.ptr.p_double[i]; - } - else - { - state->workbndu.ptr.p_double[i] = _state->v_posinf; - } - } - rmatrixsetlengthatleast(&state->workcleic, state->nec+state->nic, n+1, _state); - for(i=0; i<=state->nec+state->nic-1; i++) - { - v = ae_v_dotproduct(&state->cleic.ptr.pp_double[i][0], 1, &state->xorigin.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_move(&state->workcleic.ptr.pp_double[i][0], 1, &state->cleic.ptr.pp_double[i][0], 1, ae_v_len(0,n-1)); - state->workcleic.ptr.pp_double[i][n] = state->cleic.ptr.pp_double[i][n]-v; - } - - /* - * Starting point XS - */ - if( state->havex ) - { - - /* - * We have starting point in StartX, so we just have to shift and bound it - */ - for(i=0; i<=n-1; i++) - { - state->xs.ptr.p_double[i] = state->startx.ptr.p_double[i]-state->xorigin.ptr.p_double[i]; - if( state->havebndl.ptr.p_bool[i] ) - { - if( ae_fp_less(state->xs.ptr.p_double[i],state->workbndl.ptr.p_double[i]) ) - { - state->xs.ptr.p_double[i] = state->workbndl.ptr.p_double[i]; - } - } - if( state->havebndu.ptr.p_bool[i] ) - { - if( ae_fp_greater(state->xs.ptr.p_double[i],state->workbndu.ptr.p_double[i]) ) - { - state->xs.ptr.p_double[i] = state->workbndu.ptr.p_double[i]; - } - } - } - } - else - { - - /* - * We don't have starting point, so we deduce it from - * constraints (if they are present). - * - * NOTE: XS contains some meaningless values from previous block - * which are ignored by code below. - */ - for(i=0; i<=n-1; i++) - { - if( state->havebndl.ptr.p_bool[i]&&state->havebndu.ptr.p_bool[i] ) - { - state->xs.ptr.p_double[i] = 0.5*(state->workbndl.ptr.p_double[i]+state->workbndu.ptr.p_double[i]); - if( ae_fp_less(state->xs.ptr.p_double[i],state->workbndl.ptr.p_double[i]) ) - { - state->xs.ptr.p_double[i] = state->workbndl.ptr.p_double[i]; - } - if( ae_fp_greater(state->xs.ptr.p_double[i],state->workbndu.ptr.p_double[i]) ) - { - state->xs.ptr.p_double[i] = state->workbndu.ptr.p_double[i]; - } - continue; - } - if( state->havebndl.ptr.p_bool[i] ) - { - state->xs.ptr.p_double[i] = state->workbndl.ptr.p_double[i]; - continue; - } - if( state->havebndu.ptr.p_bool[i] ) - { - state->xs.ptr.p_double[i] = state->workbndu.ptr.p_double[i]; - continue; - } - state->xs.ptr.p_double[i] = 0; - } - } - - /* - * Handle special case - no constraints - */ - if( nbc==0&&state->nec+state->nic==0 ) - { - - /* - * "Simple" unconstrained Cholesky - */ - bvectorsetlengthatleast(&state->tmpb, n, _state); - for(i=0; i<=n-1; i++) - { - state->tmpb.ptr.p_bool[i] = ae_false; - } - state->repncholesky = state->repncholesky+1; - cqmsetb(&state->a, &state->b, _state); - cqmsetactiveset(&state->a, &state->xs, &state->tmpb, _state); - if( !cqmconstrainedoptimum(&state->a, &state->xn, _state) ) - { - state->repterminationtype = -5; - return; - } - ae_v_move(&state->xs.ptr.p_double[0], 1, &state->xn.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_add(&state->xs.ptr.p_double[0], 1, &state->xorigin.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->repinneriterationscount = 1; - state->repouteriterationscount = 1; - state->repterminationtype = 4; - return; - } - - /* - * Prepare "active set" structure - */ - sassetbc(&state->sas, &state->workbndl, &state->workbndu, _state); - sassetlcx(&state->sas, &state->workcleic, state->nec, state->nic, _state); - sassetscale(&state->sas, &state->s, _state); - if( !sasstartoptimization(&state->sas, &state->xs, _state) ) - { - state->repterminationtype = -3; - return; - } - - /* - * Main cycle of CQP algorithm - */ - state->repterminationtype = 4; - badnewtonits = 0; - maxscaledgrad = 0.0; - for(;;) - { - - /* - * Update iterations count - */ - inc(&state->repouteriterationscount, _state); - inc(&state->repinneriterationscount, _state); - - /* - * Phase 1. - * - * Determine active set. - * Update MaxScaledGrad. - */ - cqmadx(&state->a, &state->sas.xc, &state->rctmpg, _state); - ae_v_add(&state->rctmpg.ptr.p_double[0], 1, &state->b.ptr.p_double[0], 1, ae_v_len(0,n-1)); - sasreactivateconstraints(&state->sas, &state->rctmpg, _state); - v = 0.0; - for(i=0; i<=n-1; i++) - { - v = v+ae_sqr(state->rctmpg.ptr.p_double[i]*state->s.ptr.p_double[i], _state); - } - maxscaledgrad = ae_maxreal(maxscaledgrad, ae_sqrt(v, _state), _state); - - /* - * Phase 2: perform penalized steepest descent step. - * - * NextAction control variable is set on exit from this loop: - * * NextAction>0 in case we have to proceed to Phase 3 (Newton step) - * * NextAction<0 in case we have to proceed to Phase 1 (recalculate active set) - * * NextAction=0 in case we found solution (step along projected gradient is small enough) - */ - for(;;) - { - - /* - * Calculate constrained descent direction, store to PG. - * Successful termination if PG is zero. - */ - cqmadx(&state->a, &state->sas.xc, &state->gc, _state); - ae_v_add(&state->gc.ptr.p_double[0], 1, &state->b.ptr.p_double[0], 1, ae_v_len(0,n-1)); - sasconstraineddescent(&state->sas, &state->gc, &state->pg, _state); - state->debugphase2flops = state->debugphase2flops+4*(state->nec+state->nic)*n; - v0 = ae_v_dotproduct(&state->pg.ptr.p_double[0], 1, &state->pg.ptr.p_double[0], 1, ae_v_len(0,n-1)); - if( ae_fp_eq(v0,0) ) - { - - /* - * Constrained derivative is zero. - * Solution found. - */ - nextaction = 0; - break; - } - - /* - * Build quadratic model of F along descent direction: - * F(xc+alpha*pg) = D2*alpha^2 + D1*alpha + D0 - * Store noise level in the XC (noise level is used to classify - * step as singificant or insignificant). - * - * In case function curvature is negative or product of descent - * direction and gradient is non-negative, iterations are terminated. - * - * NOTE: D0 is not actually used, but we prefer to maintain it. - */ - fprev = minqp_minqpmodelvalue(&state->a, &state->b, &state->sas.xc, n, &state->tmp0, _state); - fprev = fprev+minqp_penaltyfactor*maxscaledgrad*sasactivelcpenalty1(&state->sas, &state->sas.xc, _state); - cqmevalx(&state->a, &state->sas.xc, &v, &noiselevel, _state); - v0 = cqmxtadx2(&state->a, &state->pg, _state); - state->debugphase2flops = state->debugphase2flops+3*2*n*n; - d2 = v0; - v1 = ae_v_dotproduct(&state->pg.ptr.p_double[0], 1, &state->gc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - d1 = v1; - d0 = fprev; - if( ae_fp_less_eq(d2,0) ) - { - - /* - * Second derivative is non-positive, function is non-convex. - */ - state->repterminationtype = -5; - nextaction = 0; - break; - } - if( ae_fp_greater_eq(d1,0) ) - { - - /* - * Second derivative is positive, first derivative is non-negative. - * Solution found. - */ - nextaction = 0; - break; - } - - /* - * Modify quadratic model - add penalty for violation of the active - * constraints. - * - * Boundary constraints are always satisfied exactly, so we do not - * add penalty term for them. General equality constraint of the - * form a'*(xc+alpha*d)=b adds penalty term: - * P(alpha) = (a'*(xc+alpha*d)-b)^2 - * = (alpha*(a'*d) + (a'*xc-b))^2 - * = alpha^2*(a'*d)^2 + alpha*2*(a'*d)*(a'*xc-b) + (a'*xc-b)^2 - * Each penalty term is multiplied by 100*Anorm before adding it to - * the 1-dimensional quadratic model. - * - * Penalization of the quadratic model improves behavior of the - * algorithm in the presence of the multiple degenerate constraints. - * In particular, it prevents algorithm from making large steps in - * directions which violate equality constraints. - */ - for(i=0; i<=state->nec+state->nic-1; i++) - { - if( state->sas.activeset.ptr.p_int[n+i]>0 ) - { - v0 = ae_v_dotproduct(&state->workcleic.ptr.pp_double[i][0], 1, &state->pg.ptr.p_double[0], 1, ae_v_len(0,n-1)); - v1 = ae_v_dotproduct(&state->workcleic.ptr.pp_double[i][0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - v1 = v1-state->workcleic.ptr.pp_double[i][n]; - v = 100*state->anorm; - d2 = d2+v*ae_sqr(v0, _state); - d1 = d1+v*2*v0*v1; - d0 = d0+v*ae_sqr(v1, _state); - } - } - state->debugphase2flops = state->debugphase2flops+2*2*(state->nec+state->nic)*n; - - /* - * Try unbounded step. - * In case function change is dominated by noise or function actually increased - * instead of decreasing, we terminate iterations. - */ - v = -d1/(2*d2); - ae_v_move(&state->xn.ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_addd(&state->xn.ptr.p_double[0], 1, &state->pg.ptr.p_double[0], 1, ae_v_len(0,n-1), v); - fcand = minqp_minqpmodelvalue(&state->a, &state->b, &state->xn, n, &state->tmp0, _state); - fcand = fcand+minqp_penaltyfactor*maxscaledgrad*sasactivelcpenalty1(&state->sas, &state->xn, _state); - state->debugphase2flops = state->debugphase2flops+2*n*n; - if( ae_fp_greater_eq(fcand,fprev-noiselevel*noisetolerance) ) - { - nextaction = 0; - break; - } - - /* - * Save active set - * Perform bounded step with (possible) activation - */ - actstatus = minqp_minqpboundedstepandactivation(state, &state->xn, &state->tmp0, _state); - fcur = minqp_minqpmodelvalue(&state->a, &state->b, &state->sas.xc, n, &state->tmp0, _state); - state->debugphase2flops = state->debugphase2flops+2*n*n; - - /* - * Depending on results, decide what to do: - * 1. In case step was performed without activation of constraints, - * we proceed to Newton method - * 2. In case there was activated at least one constraint with ActiveSet[I]<0, - * we proceed to Phase 1 and re-evaluate active set. - * 3. Otherwise (activation of the constraints with ActiveSet[I]=0) - * we try Phase 2 one more time. - */ - if( actstatus<0 ) - { - - /* - * Step without activation, proceed to Newton - */ - nextaction = 1; - break; - } - if( actstatus==0 ) - { - - /* - * No new constraints added during last activation - only - * ones which were at the boundary (ActiveSet[I]=0), but - * inactive due to numerical noise. - * - * Now, these constraints are added to the active set, and - * we try to perform steepest descent (Phase 2) one more time. - */ - continue; - } - else - { - - /* - * Last step activated at least one significantly new - * constraint (ActiveSet[I]<0), we have to re-evaluate - * active set (Phase 1). - */ - nextaction = -1; - break; - } - } - if( nextaction<0 ) - { - continue; - } - if( nextaction==0 ) - { - break; - } - - /* - * Phase 3: fast equality-constrained solver - * - * NOTE: this solver uses Augmented Lagrangian algorithm to solve - * equality-constrained subproblems. This algorithm may - * perform steps which increase function values instead of - * decreasing it (in hard cases, like overconstrained problems). - * - * Such non-monononic steps may create a loop, when Augmented - * Lagrangian algorithm performs uphill step, and steepest - * descent algorithm (Phase 2) performs downhill step in the - * opposite direction. - * - * In order to prevent iterations to continue forever we - * count iterations when AL algorithm increased function - * value instead of decreasing it. When number of such "bad" - * iterations will increase beyong MaxBadNewtonIts, we will - * terminate algorithm. - */ - fprev = minqp_minqpmodelvalue(&state->a, &state->b, &state->sas.xc, n, &state->tmp0, _state); - for(;;) - { - - /* - * Calculate optimum subject to presently active constraints - */ - state->repncholesky = state->repncholesky+1; - state->debugphase3flops = state->debugphase3flops+ae_pow(n, 3, _state)/3; - if( !minqp_minqpconstrainedoptimum(state, &state->a, state->anorm, &state->b, &state->xn, &state->tmp0, &state->tmpb, &state->tmp1, _state) ) - { - state->repterminationtype = -5; - sasstopoptimization(&state->sas, _state); - return; - } - - /* - * Add constraints. - * If no constraints was added, accept candidate point XN and move to next phase. - */ - if( minqp_minqpboundedstepandactivation(state, &state->xn, &state->tmp0, _state)<0 ) - { - break; - } - } - fcur = minqp_minqpmodelvalue(&state->a, &state->b, &state->sas.xc, n, &state->tmp0, _state); - if( ae_fp_greater_eq(fcur,fprev) ) - { - badnewtonits = badnewtonits+1; - } - if( badnewtonits>=minqp_maxbadnewtonits ) - { - - /* - * Algorithm found solution, but keeps iterating because Newton - * algorithm performs uphill steps (noise in the Augmented Lagrangian - * algorithm). We terminate algorithm; it is considered normal - * termination. - */ - break; - } - } - sasstopoptimization(&state->sas, _state); - - /* - * Post-process: add XOrigin to XC - */ - for(i=0; i<=n-1; i++) - { - if( state->havebndl.ptr.p_bool[i]&&ae_fp_eq(state->sas.xc.ptr.p_double[i],state->workbndl.ptr.p_double[i]) ) - { - state->xs.ptr.p_double[i] = state->bndl.ptr.p_double[i]; - continue; - } - if( state->havebndu.ptr.p_bool[i]&&ae_fp_eq(state->sas.xc.ptr.p_double[i],state->workbndu.ptr.p_double[i]) ) - { - state->xs.ptr.p_double[i] = state->bndu.ptr.p_double[i]; - continue; - } - state->xs.ptr.p_double[i] = boundval(state->sas.xc.ptr.p_double[i]+state->xorigin.ptr.p_double[i], state->bndl.ptr.p_double[i], state->bndu.ptr.p_double[i], _state); - } - return; - } - - /* - * BLEIC solver - */ - if( state->algokind==2 ) - { - ae_assert(state->akind==0||state->akind==1, "MinQPOptimize: unexpected AKind", _state); - ivectorsetlengthatleast(&state->tmpi, state->nec+state->nic, _state); - rvectorsetlengthatleast(&state->tmp0, n, _state); - rvectorsetlengthatleast(&state->tmp1, n, _state); - for(i=0; i<=state->nec-1; i++) - { - state->tmpi.ptr.p_int[i] = 0; - } - for(i=0; i<=state->nic-1; i++) - { - state->tmpi.ptr.p_int[state->nec+i] = -1; - } - minbleicsetlc(&state->solver, &state->cleic, &state->tmpi, state->nec+state->nic, _state); - minbleicsetbc(&state->solver, &state->bndl, &state->bndu, _state); - minbleicsetdrep(&state->solver, ae_true, _state); - minbleicsetcond(&state->solver, ae_minrealnumber, 0.0, 0.0, state->bleicmaxits, _state); - minbleicsetscale(&state->solver, &state->s, _state); - minbleicsetprecscale(&state->solver, _state); - minbleicrestartfrom(&state->solver, &state->xs, _state); - state->repterminationtype = 0; - while(minbleiciteration(&state->solver, _state)) - { - - /* - * Line search started - */ - if( state->solver.lsstart ) - { - - /* - * Iteration counters: - * * inner iterations count is increased on every line search - * * outer iterations count is increased only at steepest descent line search - */ - inc(&state->repinneriterationscount, _state); - if( !state->solver.lbfgssearch ) - { - inc(&state->repouteriterationscount, _state); - } - - /* - * Build quadratic model of F along descent direction: - * F(x+alpha*d) = D2*alpha^2 + D1*alpha + D0 - */ - d0 = state->solver.f; - d1 = ae_v_dotproduct(&state->solver.d.ptr.p_double[0], 1, &state->solver.g.ptr.p_double[0], 1, ae_v_len(0,n-1)); - d2 = 0; - if( state->akind==0 ) - { - d2 = cqmxtadx2(&state->a, &state->solver.d, _state); - } - if( state->akind==1 ) - { - sparsesmv(&state->sparsea, state->sparseaupper, &state->solver.d, &state->tmp0, _state); - d2 = 0.0; - for(i=0; i<=n-1; i++) - { - d2 = d2+state->solver.d.ptr.p_double[i]*state->tmp0.ptr.p_double[i]; - } - d2 = 0.5*d2; - } - - /* - * Suggest new step - */ - if( ae_fp_less(d1,0)&&ae_fp_greater(d2,0) ) - { - state->solver.stp = safeminposrv(-d1, 2*d2, state->solver.curstpmax, _state); - } - - /* - * This line search may be started from steepest descent - * stage (stage 2) or from L-BFGS stage (stage 3) of the - * BLEIC algorithm. Depending on stage type, different - * checks are performed. - * - * Say, L-BFGS stage is an equality-constrained refinement - * stage of BLEIC. This stage refines current iterate - * under "frozen" equality constraints. We can terminate - * iterations at this stage only when we encounter - * unconstrained direction of negative curvature. In all - * other cases (say, when constrained gradient is zero) - * we should not terminate algorithm because everything may - * change after de-activating presently active constraints. - * - * At steepest descent stage of BLEIC we can terminate algorithm - * because it found minimum (steepest descent step is zero - * or too short). We also perform check for direction of - * negative curvature. - */ - if( (ae_fp_less(d2,0)||(ae_fp_eq(d2,0)&&ae_fp_less(d1,0)))&&!state->solver.boundedstep ) - { - - /* - * Function is unbounded from below: - * * function will decrease along D, i.e. either: - * * D2<0 - * * D2=0 and D1<0 - * * step is unconstrained - * - * If these conditions are true, we abnormally terminate QP - * algorithm with return code -4 (we can do so at any stage - * of BLEIC - whether it is L-BFGS or steepest descent one). - */ - state->repterminationtype = -4; - for(i=0; i<=n-1; i++) - { - state->xs.ptr.p_double[i] = state->solver.x.ptr.p_double[i]; - } - break; - } - if( !state->solver.lbfgssearch&&ae_fp_greater_eq(d2,0) ) - { - - /* - * Tests for "normal" convergence. - * - * These tests are performed only at "steepest descent" stage - * of the BLEIC algorithm, and only when function is non-concave - * (D2>=0) along direction D. - * - * NOTE: we do not test iteration count (MaxIts) here, because - * this stopping condition is tested by BLEIC itself. - */ - if( ae_fp_greater_eq(d1,0) ) - { - - /* - * "Emergency" stopping condition: D is non-descent direction. - * Sometimes it is possible because of numerical noise in the - * target function. - */ - state->repterminationtype = 4; - for(i=0; i<=n-1; i++) - { - state->xs.ptr.p_double[i] = state->solver.x.ptr.p_double[i]; - } - break; - } - if( ae_fp_greater(d2,0) ) - { - - /* - * Stopping condition #4 - gradient norm is small: - * - * 1. rescale State.Solver.D and State.Solver.G according to - * current scaling, store results to Tmp0 and Tmp1. - * 2. Normalize Tmp0 (scaled direction vector). - * 3. compute directional derivative (in scaled variables), - * which is equal to DOTPRODUCT(Tmp0,Tmp1). - */ - v = 0; - for(i=0; i<=n-1; i++) - { - state->tmp0.ptr.p_double[i] = state->solver.d.ptr.p_double[i]/state->s.ptr.p_double[i]; - state->tmp1.ptr.p_double[i] = state->solver.g.ptr.p_double[i]*state->s.ptr.p_double[i]; - v = v+ae_sqr(state->tmp0.ptr.p_double[i], _state); - } - ae_assert(ae_fp_greater(v,0), "MinQPOptimize: inernal errror (scaled direction is zero)", _state); - v = 1/ae_sqrt(v, _state); - ae_v_muld(&state->tmp0.ptr.p_double[0], 1, ae_v_len(0,n-1), v); - v = ae_v_dotproduct(&state->tmp0.ptr.p_double[0], 1, &state->tmp1.ptr.p_double[0], 1, ae_v_len(0,n-1)); - if( ae_fp_less_eq(ae_fabs(v, _state),state->bleicepsg) ) - { - state->repterminationtype = 4; - for(i=0; i<=n-1; i++) - { - state->xs.ptr.p_double[i] = state->solver.x.ptr.p_double[i]; - } - break; - } - - /* - * Stopping condition #1 - relative function improvement is small: - * - * 1. calculate steepest descent step: V = -D1/(2*D2) - * 2. calculate function change: V1= D2*V^2 + D1*V - * 3. stop if function change is small enough - */ - v = -d1/(2*d2); - v1 = d2*v*v+d1*v; - if( ae_fp_less_eq(ae_fabs(v1, _state),state->bleicepsf*ae_maxreal(d0, 1.0, _state)) ) - { - state->repterminationtype = 1; - for(i=0; i<=n-1; i++) - { - state->xs.ptr.p_double[i] = state->solver.x.ptr.p_double[i]; - } - break; - } - - /* - * Stopping condition #2 - scaled step is small: - * - * 1. calculate step multiplier V0 (step itself is D*V0) - * 2. calculate scaled step length V - * 3. stop if step is small enough - */ - v0 = -d1/(2*d2); - v = 0; - for(i=0; i<=n-1; i++) - { - v = v+ae_sqr(v0*state->solver.d.ptr.p_double[i]/state->s.ptr.p_double[i], _state); - } - if( ae_fp_less_eq(ae_sqrt(v, _state),state->bleicepsx) ) - { - state->repterminationtype = 2; - for(i=0; i<=n-1; i++) - { - state->xs.ptr.p_double[i] = state->solver.x.ptr.p_double[i]; - } - break; - } - } - } - } - - /* - * Gradient evaluation - */ - if( state->solver.needfg ) - { - for(i=0; i<=n-1; i++) - { - state->tmp0.ptr.p_double[i] = state->solver.x.ptr.p_double[i]-state->xorigin.ptr.p_double[i]; - } - if( state->akind==0 ) - { - cqmadx(&state->a, &state->tmp0, &state->tmp1, _state); - } - if( state->akind==1 ) - { - sparsesmv(&state->sparsea, state->sparseaupper, &state->tmp0, &state->tmp1, _state); - } - v0 = ae_v_dotproduct(&state->tmp0.ptr.p_double[0], 1, &state->tmp1.ptr.p_double[0], 1, ae_v_len(0,n-1)); - v1 = ae_v_dotproduct(&state->tmp0.ptr.p_double[0], 1, &state->b.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->solver.f = 0.5*v0+v1; - ae_v_move(&state->solver.g.ptr.p_double[0], 1, &state->tmp1.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_add(&state->solver.g.ptr.p_double[0], 1, &state->b.ptr.p_double[0], 1, ae_v_len(0,n-1)); - } - } - if( state->repterminationtype==0 ) - { - - /* - * BLEIC optimizer was terminated by one of its inner stopping - * conditions. Usually it is iteration counter (if such - * stopping condition was specified by user). - */ - minbleicresults(&state->solver, &state->xs, &state->solverrep, _state); - state->repterminationtype = state->solverrep.terminationtype; - } - else - { - - /* - * BLEIC optimizer was terminated in "emergency" mode by QP - * solver. - * - * NOTE: such termination is "emergency" only when viewed from - * BLEIC's position. QP solver sees such termination as - * routine one, triggered by QP's stopping criteria. - */ - minbleicemergencytermination(&state->solver, _state); - } - return; - } -} - - -/************************************************************************* -QP solver results - -INPUT PARAMETERS: - State - algorithm state - -OUTPUT PARAMETERS: - X - array[0..N-1], solution. - This array is allocated and initialized only when - Rep.TerminationType parameter is positive (success). - Rep - optimization report. You should check Rep.TerminationType, - which contains completion code, and you may check another - fields which contain another information about algorithm - functioning. - - Failure codes returned by algorithm are: - * -5 inappropriate solver was used: - * Cholesky solver for (semi)indefinite problems - * Cholesky solver for problems with sparse matrix - * -4 BLEIC-QP algorithm found unconstrained direction - of negative curvature (function is unbounded from - below even under constraints), no meaningful - minimum can be found. - * -3 inconsistent constraints (or maybe feasible point - is too hard to find). If you are sure that - constraints are feasible, try to restart optimizer - with better initial approximation. - - Completion codes specific for Cholesky algorithm: - * 4 successful completion - - Completion codes specific for BLEIC-based algorithm: - * 1 relative function improvement is no more than EpsF. - * 2 scaled step is no more than EpsX. - * 4 scaled gradient norm is no more than EpsG. - * 5 MaxIts steps was taken - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpresults(minqpstate* state, - /* Real */ ae_vector* x, - minqpreport* rep, - ae_state *_state) -{ - - ae_vector_clear(x); - _minqpreport_clear(rep); - - minqpresultsbuf(state, x, rep, _state); -} - - -/************************************************************************* -QP results - -Buffered implementation of MinQPResults() which uses pre-allocated buffer -to store X[]. If buffer size is too small, it resizes buffer. It is -intended to be used in the inner cycles of performance critical algorithms -where array reallocation penalty is too large to be ignored. - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpresultsbuf(minqpstate* state, - /* Real */ ae_vector* x, - minqpreport* rep, - ae_state *_state) -{ - - - if( x->cntn ) - { - ae_vector_set_length(x, state->n, _state); - } - ae_v_move(&x->ptr.p_double[0], 1, &state->xs.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - rep->inneriterationscount = state->repinneriterationscount; - rep->outeriterationscount = state->repouteriterationscount; - rep->nmv = state->repnmv; - rep->ncholesky = state->repncholesky; - rep->terminationtype = state->repterminationtype; -} - - -/************************************************************************* -Fast version of MinQPSetLinearTerm(), which doesn't check its arguments. -For internal use only. - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpsetlineartermfast(minqpstate* state, - /* Real */ ae_vector* b, - ae_state *_state) -{ - - - ae_v_move(&state->b.ptr.p_double[0], 1, &b->ptr.p_double[0], 1, ae_v_len(0,state->n-1)); -} - - -/************************************************************************* -Fast version of MinQPSetQuadraticTerm(), which doesn't check its arguments. - -It accepts additional parameter - shift S, which allows to "shift" matrix -A by adding s*I to A. S must be positive (although it is not checked). - -For internal use only. - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpsetquadratictermfast(minqpstate* state, - /* Real */ ae_matrix* a, - ae_bool isupper, - double s, - ae_state *_state) -{ - ae_int_t i; - ae_int_t j; - ae_int_t n; - - - n = state->n; - state->akind = 0; - cqmseta(&state->a, a, isupper, 1.0, _state); - if( ae_fp_greater(s,0) ) - { - rvectorsetlengthatleast(&state->tmp0, n, _state); - for(i=0; i<=n-1; i++) - { - state->tmp0.ptr.p_double[i] = a->ptr.pp_double[i][i]+s; - } - cqmrewritedensediagonal(&state->a, &state->tmp0, _state); - } - - /* - * Estimate norm of A - * (it will be used later in the quadratic penalty function) - */ - state->anorm = 0; - for(i=0; i<=n-1; i++) - { - if( isupper ) - { - for(j=i; j<=n-1; j++) - { - state->anorm = ae_maxreal(state->anorm, ae_fabs(a->ptr.pp_double[i][j], _state), _state); - } - } - else - { - for(j=0; j<=i; j++) - { - state->anorm = ae_maxreal(state->anorm, ae_fabs(a->ptr.pp_double[i][j], _state), _state); - } - } - } - state->anorm = state->anorm*n; -} - - -/************************************************************************* -Internal function which allows to rewrite diagonal of quadratic term. -For internal use only. - -This function can be used only when you have dense A and already made -MinQPSetQuadraticTerm(Fast) call. - - -- ALGLIB -- - Copyright 16.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqprewritediagonal(minqpstate* state, - /* Real */ ae_vector* s, - ae_state *_state) -{ - - - cqmrewritedensediagonal(&state->a, s, _state); -} - - -/************************************************************************* -Fast version of MinQPSetStartingPoint(), which doesn't check its arguments. -For internal use only. - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpsetstartingpointfast(minqpstate* state, - /* Real */ ae_vector* x, - ae_state *_state) -{ - ae_int_t n; - - - n = state->n; - ae_v_move(&state->startx.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->havex = ae_true; -} - - -/************************************************************************* -Fast version of MinQPSetOrigin(), which doesn't check its arguments. -For internal use only. - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpsetoriginfast(minqpstate* state, - /* Real */ ae_vector* xorigin, - ae_state *_state) -{ - ae_int_t n; - - - n = state->n; - ae_v_move(&state->xorigin.ptr.p_double[0], 1, &xorigin->ptr.p_double[0], 1, ae_v_len(0,n-1)); -} - - -/************************************************************************* -Having feasible current point XC and possibly infeasible candidate point -XN, this function performs longest step from XC to XN which retains -feasibility. In case XN is found to be infeasible, at least one constraint -is activated. - -For example, if we have: - XC=0.5 - XN=1.2 - x>=0, x<=1 -then this function will move us to X=1.0 and activate constraint "x<=1". - -INPUT PARAMETERS: - State - MinQP state. - XC - current point, must be feasible with respect to - all constraints - XN - candidate point, can be infeasible with respect to some - constraints. Must be located in the subspace of current - active set, i.e. it is feasible with respect to already - active constraints. - Buf - temporary buffer, automatically resized if needed - -OUTPUT PARAMETERS: - State - this function changes following fields of State: - * State.ActiveSet - * State.ActiveC - active linear constraints - XC - new position - -RESULT: - >0, in case at least one inactive non-candidate constraint was activated - =0, in case only "candidate" constraints were activated - <0, in case no constraints were activated by the step - - - -- ALGLIB -- - Copyright 29.02.2012 by Bochkanov Sergey -*************************************************************************/ -static ae_int_t minqp_minqpboundedstepandactivation(minqpstate* state, - /* Real */ ae_vector* xn, - /* Real */ ae_vector* buf, - ae_state *_state) -{ - ae_int_t n; - double stpmax; - ae_int_t cidx; - double cval; - ae_bool needact; - double v; - ae_int_t result; - - - n = state->n; - rvectorsetlengthatleast(buf, n, _state); - ae_v_move(&buf->ptr.p_double[0], 1, &xn->ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_sub(&buf->ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - sasexploredirection(&state->sas, buf, &stpmax, &cidx, &cval, _state); - needact = ae_fp_less_eq(stpmax,1); - v = ae_minreal(stpmax, 1.0, _state); - ae_v_muld(&buf->ptr.p_double[0], 1, ae_v_len(0,n-1), v); - ae_v_add(&buf->ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - result = sasmoveto(&state->sas, buf, needact, cidx, cval, _state); - return result; -} - - -/************************************************************************* -Model value: f = 0.5*x'*A*x + b'*x - -INPUT PARAMETERS: - A - convex quadratic model; only main quadratic term is used, - other parts of the model (D/Q/linear term) are ignored. - This function does not modify model state. - B - right part - XC - evaluation point - Tmp - temporary buffer, automatically resized if needed - - -- ALGLIB -- - Copyright 20.06.2012 by Bochkanov Sergey -*************************************************************************/ -static double minqp_minqpmodelvalue(convexquadraticmodel* a, - /* Real */ ae_vector* b, - /* Real */ ae_vector* xc, - ae_int_t n, - /* Real */ ae_vector* tmp, - ae_state *_state) -{ - double v0; - double v1; - double result; - - - rvectorsetlengthatleast(tmp, n, _state); - cqmadx(a, xc, tmp, _state); - v0 = ae_v_dotproduct(&xc->ptr.p_double[0], 1, &tmp->ptr.p_double[0], 1, ae_v_len(0,n-1)); - v1 = ae_v_dotproduct(&xc->ptr.p_double[0], 1, &b->ptr.p_double[0], 1, ae_v_len(0,n-1)); - result = 0.5*v0+v1; - return result; -} - - -/************************************************************************* -Optimum of A subject to: -a) active boundary constraints (given by ActiveSet[] and corresponding - elements of XC) -b) active linear constraints (given by C, R, LagrangeC) - -INPUT PARAMETERS: - A - main quadratic term of the model; - although structure may store linear and rank-K terms, - these terms are ignored and rewritten by this function. - ANorm - estimate of ||A|| (2-norm is used) - B - array[N], linear term of the model - XN - possibly preallocated buffer - Tmp - temporary buffer (automatically resized) - Tmp1 - temporary buffer (automatically resized) - -OUTPUT PARAMETERS: - A - modified quadratic model (this function changes rank-K - term and linear term of the model) - LagrangeC- current estimate of the Lagrange coefficients - XN - solution - -RESULT: - True on success, False on failure (non-SPD model) - - -- ALGLIB -- - Copyright 20.06.2012 by Bochkanov Sergey -*************************************************************************/ -static ae_bool minqp_minqpconstrainedoptimum(minqpstate* state, - convexquadraticmodel* a, - double anorm, - /* Real */ ae_vector* b, - /* Real */ ae_vector* xn, - /* Real */ ae_vector* tmp, - /* Boolean */ ae_vector* tmpb, - /* Real */ ae_vector* lagrangec, - ae_state *_state) -{ - ae_int_t itidx; - ae_int_t i; - double v; - double feaserrold; - double feaserrnew; - double theta; - ae_int_t n; - ae_bool result; - - - n = state->n; - - /* - * Rebuild basis accroding to current active set. - * We call SASRebuildBasis() to make sure that fields of SAS - * store up to date values. - */ - sasrebuildbasis(&state->sas, _state); - - /* - * Allocate temporaries. - */ - rvectorsetlengthatleast(tmp, ae_maxint(n, state->sas.basissize, _state), _state); - bvectorsetlengthatleast(tmpb, n, _state); - rvectorsetlengthatleast(lagrangec, state->sas.basissize, _state); - - /* - * Prepare model - */ - for(i=0; i<=state->sas.basissize-1; i++) - { - tmp->ptr.p_double[i] = state->sas.pbasis.ptr.pp_double[i][n]; - } - theta = 100.0*anorm; - for(i=0; i<=n-1; i++) - { - if( state->sas.activeset.ptr.p_int[i]>0 ) - { - tmpb->ptr.p_bool[i] = ae_true; - } - else - { - tmpb->ptr.p_bool[i] = ae_false; - } - } - cqmsetactiveset(a, &state->sas.xc, tmpb, _state); - cqmsetq(a, &state->sas.pbasis, tmp, state->sas.basissize, theta, _state); - - /* - * Iterate until optimal values of Lagrange multipliers are found - */ - for(i=0; i<=state->sas.basissize-1; i++) - { - lagrangec->ptr.p_double[i] = 0; - } - feaserrnew = ae_maxrealnumber; - result = ae_true; - for(itidx=1; itidx<=minqp_maxlagrangeits; itidx++) - { - - /* - * Generate right part B using linear term and current - * estimate of the Lagrange multipliers. - */ - ae_v_move(&tmp->ptr.p_double[0], 1, &b->ptr.p_double[0], 1, ae_v_len(0,n-1)); - for(i=0; i<=state->sas.basissize-1; i++) - { - v = lagrangec->ptr.p_double[i]; - ae_v_subd(&tmp->ptr.p_double[0], 1, &state->sas.pbasis.ptr.pp_double[i][0], 1, ae_v_len(0,n-1), v); - } - cqmsetb(a, tmp, _state); - - /* - * Solve - */ - result = cqmconstrainedoptimum(a, xn, _state); - if( !result ) - { - return result; - } - - /* - * Compare feasibility errors. - * Terminate if error decreased too slowly. - */ - feaserrold = feaserrnew; - feaserrnew = 0; - for(i=0; i<=state->sas.basissize-1; i++) - { - v = ae_v_dotproduct(&state->sas.pbasis.ptr.pp_double[i][0], 1, &xn->ptr.p_double[0], 1, ae_v_len(0,n-1)); - feaserrnew = feaserrnew+ae_sqr(v-state->sas.pbasis.ptr.pp_double[i][n], _state); - } - feaserrnew = ae_sqrt(feaserrnew, _state); - if( ae_fp_greater_eq(feaserrnew,0.2*feaserrold) ) - { - break; - } - - /* - * Update Lagrange multipliers - */ - for(i=0; i<=state->sas.basissize-1; i++) - { - v = ae_v_dotproduct(&state->sas.pbasis.ptr.pp_double[i][0], 1, &xn->ptr.p_double[0], 1, ae_v_len(0,n-1)); - lagrangec->ptr.p_double[i] = lagrangec->ptr.p_double[i]-theta*(v-state->sas.pbasis.ptr.pp_double[i][n]); - } - } - return result; -} - - -ae_bool _minqpstate_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - minqpstate *p = (minqpstate*)_p; - ae_touch_ptr((void*)p); - if( !_convexquadraticmodel_init(&p->a, _state, make_automatic) ) - return ae_false; - if( !_sparsematrix_init(&p->sparsea, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->b, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->bndl, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->bndu, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->s, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->havebndl, 0, DT_BOOL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->havebndu, 0, DT_BOOL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->xorigin, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->startx, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->cleic, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !_sactiveset_init(&p->sas, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->gc, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->xn, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->pg, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->workbndl, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->workbndu, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->workcleic, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->xs, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->tmp0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->tmp1, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->tmpb, 0, DT_BOOL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->rctmpg, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->tmpi, 0, DT_INT, _state, make_automatic) ) - return ae_false; - if( !_normestimatorstate_init(&p->estimator, _state, make_automatic) ) - return ae_false; - if( !_minbleicstate_init(&p->solver, _state, make_automatic) ) - return ae_false; - if( !_minbleicreport_init(&p->solverrep, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _minqpstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - minqpstate *dst = (minqpstate*)_dst; - minqpstate *src = (minqpstate*)_src; - dst->n = src->n; - dst->algokind = src->algokind; - dst->akind = src->akind; - if( !_convexquadraticmodel_init_copy(&dst->a, &src->a, _state, make_automatic) ) - return ae_false; - if( !_sparsematrix_init_copy(&dst->sparsea, &src->sparsea, _state, make_automatic) ) - return ae_false; - dst->sparseaupper = src->sparseaupper; - dst->anorm = src->anorm; - if( !ae_vector_init_copy(&dst->b, &src->b, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->bndl, &src->bndl, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->bndu, &src->bndu, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->s, &src->s, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->havebndl, &src->havebndl, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->havebndu, &src->havebndu, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->xorigin, &src->xorigin, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->startx, &src->startx, _state, make_automatic) ) - return ae_false; - dst->havex = src->havex; - if( !ae_matrix_init_copy(&dst->cleic, &src->cleic, _state, make_automatic) ) - return ae_false; - dst->nec = src->nec; - dst->nic = src->nic; - dst->bleicepsg = src->bleicepsg; - dst->bleicepsf = src->bleicepsf; - dst->bleicepsx = src->bleicepsx; - dst->bleicmaxits = src->bleicmaxits; - if( !_sactiveset_init_copy(&dst->sas, &src->sas, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->gc, &src->gc, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->xn, &src->xn, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->pg, &src->pg, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->workbndl, &src->workbndl, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->workbndu, &src->workbndu, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->workcleic, &src->workcleic, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->xs, &src->xs, _state, make_automatic) ) - return ae_false; - dst->repinneriterationscount = src->repinneriterationscount; - dst->repouteriterationscount = src->repouteriterationscount; - dst->repncholesky = src->repncholesky; - dst->repnmv = src->repnmv; - dst->repterminationtype = src->repterminationtype; - dst->debugphase1flops = src->debugphase1flops; - dst->debugphase2flops = src->debugphase2flops; - dst->debugphase3flops = src->debugphase3flops; - if( !ae_vector_init_copy(&dst->tmp0, &src->tmp0, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->tmp1, &src->tmp1, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->tmpb, &src->tmpb, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->rctmpg, &src->rctmpg, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->tmpi, &src->tmpi, _state, make_automatic) ) - return ae_false; - if( !_normestimatorstate_init_copy(&dst->estimator, &src->estimator, _state, make_automatic) ) - return ae_false; - if( !_minbleicstate_init_copy(&dst->solver, &src->solver, _state, make_automatic) ) - return ae_false; - if( !_minbleicreport_init_copy(&dst->solverrep, &src->solverrep, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _minqpstate_clear(void* _p) -{ - minqpstate *p = (minqpstate*)_p; - ae_touch_ptr((void*)p); - _convexquadraticmodel_clear(&p->a); - _sparsematrix_clear(&p->sparsea); - ae_vector_clear(&p->b); - ae_vector_clear(&p->bndl); - ae_vector_clear(&p->bndu); - ae_vector_clear(&p->s); - ae_vector_clear(&p->havebndl); - ae_vector_clear(&p->havebndu); - ae_vector_clear(&p->xorigin); - ae_vector_clear(&p->startx); - ae_matrix_clear(&p->cleic); - _sactiveset_clear(&p->sas); - ae_vector_clear(&p->gc); - ae_vector_clear(&p->xn); - ae_vector_clear(&p->pg); - ae_vector_clear(&p->workbndl); - ae_vector_clear(&p->workbndu); - ae_matrix_clear(&p->workcleic); - ae_vector_clear(&p->xs); - ae_vector_clear(&p->tmp0); - ae_vector_clear(&p->tmp1); - ae_vector_clear(&p->tmpb); - ae_vector_clear(&p->rctmpg); - ae_vector_clear(&p->tmpi); - _normestimatorstate_clear(&p->estimator); - _minbleicstate_clear(&p->solver); - _minbleicreport_clear(&p->solverrep); -} - - -void _minqpstate_destroy(void* _p) -{ - minqpstate *p = (minqpstate*)_p; - ae_touch_ptr((void*)p); - _convexquadraticmodel_destroy(&p->a); - _sparsematrix_destroy(&p->sparsea); - ae_vector_destroy(&p->b); - ae_vector_destroy(&p->bndl); - ae_vector_destroy(&p->bndu); - ae_vector_destroy(&p->s); - ae_vector_destroy(&p->havebndl); - ae_vector_destroy(&p->havebndu); - ae_vector_destroy(&p->xorigin); - ae_vector_destroy(&p->startx); - ae_matrix_destroy(&p->cleic); - _sactiveset_destroy(&p->sas); - ae_vector_destroy(&p->gc); - ae_vector_destroy(&p->xn); - ae_vector_destroy(&p->pg); - ae_vector_destroy(&p->workbndl); - ae_vector_destroy(&p->workbndu); - ae_matrix_destroy(&p->workcleic); - ae_vector_destroy(&p->xs); - ae_vector_destroy(&p->tmp0); - ae_vector_destroy(&p->tmp1); - ae_vector_destroy(&p->tmpb); - ae_vector_destroy(&p->rctmpg); - ae_vector_destroy(&p->tmpi); - _normestimatorstate_destroy(&p->estimator); - _minbleicstate_destroy(&p->solver); - _minbleicreport_destroy(&p->solverrep); -} - - -ae_bool _minqpreport_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - minqpreport *p = (minqpreport*)_p; - ae_touch_ptr((void*)p); - return ae_true; -} - - -ae_bool _minqpreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - minqpreport *dst = (minqpreport*)_dst; - minqpreport *src = (minqpreport*)_src; - dst->inneriterationscount = src->inneriterationscount; - dst->outeriterationscount = src->outeriterationscount; - dst->nmv = src->nmv; - dst->ncholesky = src->ncholesky; - dst->terminationtype = src->terminationtype; - return ae_true; -} - - -void _minqpreport_clear(void* _p) -{ - minqpreport *p = (minqpreport*)_p; - ae_touch_ptr((void*)p); -} - - -void _minqpreport_destroy(void* _p) -{ - minqpreport *p = (minqpreport*)_p; - ae_touch_ptr((void*)p); -} - - - - -/************************************************************************* - IMPROVED LEVENBERG-MARQUARDT METHOD FOR - NON-LINEAR LEAST SQUARES OPTIMIZATION - -DESCRIPTION: -This function is used to find minimum of function which is represented as -sum of squares: - F(x) = f[0]^2(x[0],...,x[n-1]) + ... + f[m-1]^2(x[0],...,x[n-1]) -using value of function vector f[] and Jacobian of f[]. - - -REQUIREMENTS: -This algorithm will request following information during its operation: - -* function vector f[] at given point X -* function vector f[] and Jacobian of f[] (simultaneously) at given point - -There are several overloaded versions of MinLMOptimize() function which -correspond to different LM-like optimization algorithms provided by this -unit. You should choose version which accepts fvec() and jac() callbacks. -First one is used to calculate f[] at given point, second one calculates -f[] and Jacobian df[i]/dx[j]. - -You can try to initialize MinLMState structure with VJ function and then -use incorrect version of MinLMOptimize() (for example, version which -works with general form function and does not provide Jacobian), but it -will lead to exception being thrown after first attempt to calculate -Jacobian. - - -USAGE: -1. User initializes algorithm state with MinLMCreateVJ() call -2. User tunes solver parameters with MinLMSetCond(), MinLMSetStpMax() and - other functions -3. User calls MinLMOptimize() function which takes algorithm state and - callback functions. -4. User calls MinLMResults() to get solution -5. Optionally, user may call MinLMRestartFrom() to solve another problem - with same N/M but another starting point and/or another function. - MinLMRestartFrom() allows to reuse already initialized structure. - - -INPUT PARAMETERS: - N - dimension, N>1 - * if given, only leading N elements of X are used - * if not given, automatically determined from size of X - M - number of functions f[i] - X - initial solution, array[0..N-1] - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -NOTES: -1. you may tune stopping conditions with MinLMSetCond() function -2. if target function contains exp() or other fast growing functions, and - optimization algorithm makes too large steps which leads to overflow, - use MinLMSetStpMax() function to bound algorithm's steps. - - -- ALGLIB -- - Copyright 30.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minlmcreatevj(ae_int_t n, - ae_int_t m, - /* Real */ ae_vector* x, - minlmstate* state, - ae_state *_state) -{ - - _minlmstate_clear(state); - - ae_assert(n>=1, "MinLMCreateVJ: N<1!", _state); - ae_assert(m>=1, "MinLMCreateVJ: M<1!", _state); - ae_assert(x->cnt>=n, "MinLMCreateVJ: Length(X)teststep = 0; - state->n = n; - state->m = m; - state->algomode = 1; - state->hasf = ae_false; - state->hasfi = ae_true; - state->hasg = ae_false; - - /* - * second stage of initialization - */ - minlm_lmprepare(n, m, ae_false, state, _state); - minlmsetacctype(state, 0, _state); - minlmsetcond(state, 0, 0, 0, 0, _state); - minlmsetxrep(state, ae_false, _state); - minlmsetstpmax(state, 0, _state); - minlmrestartfrom(state, x, _state); -} - - -/************************************************************************* - IMPROVED LEVENBERG-MARQUARDT METHOD FOR - NON-LINEAR LEAST SQUARES OPTIMIZATION - -DESCRIPTION: -This function is used to find minimum of function which is represented as -sum of squares: - F(x) = f[0]^2(x[0],...,x[n-1]) + ... + f[m-1]^2(x[0],...,x[n-1]) -using value of function vector f[] only. Finite differences are used to -calculate Jacobian. - - -REQUIREMENTS: -This algorithm will request following information during its operation: -* function vector f[] at given point X - -There are several overloaded versions of MinLMOptimize() function which -correspond to different LM-like optimization algorithms provided by this -unit. You should choose version which accepts fvec() callback. - -You can try to initialize MinLMState structure with VJ function and then -use incorrect version of MinLMOptimize() (for example, version which -works with general form function and does not accept function vector), but -it will lead to exception being thrown after first attempt to calculate -Jacobian. - - -USAGE: -1. User initializes algorithm state with MinLMCreateV() call -2. User tunes solver parameters with MinLMSetCond(), MinLMSetStpMax() and - other functions -3. User calls MinLMOptimize() function which takes algorithm state and - callback functions. -4. User calls MinLMResults() to get solution -5. Optionally, user may call MinLMRestartFrom() to solve another problem - with same N/M but another starting point and/or another function. - MinLMRestartFrom() allows to reuse already initialized structure. - - -INPUT PARAMETERS: - N - dimension, N>1 - * if given, only leading N elements of X are used - * if not given, automatically determined from size of X - M - number of functions f[i] - X - initial solution, array[0..N-1] - DiffStep- differentiation step, >0 - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -See also MinLMIteration, MinLMResults. - -NOTES: -1. you may tune stopping conditions with MinLMSetCond() function -2. if target function contains exp() or other fast growing functions, and - optimization algorithm makes too large steps which leads to overflow, - use MinLMSetStpMax() function to bound algorithm's steps. - - -- ALGLIB -- - Copyright 30.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minlmcreatev(ae_int_t n, - ae_int_t m, - /* Real */ ae_vector* x, - double diffstep, - minlmstate* state, - ae_state *_state) -{ - - _minlmstate_clear(state); - - ae_assert(ae_isfinite(diffstep, _state), "MinLMCreateV: DiffStep is not finite!", _state); - ae_assert(ae_fp_greater(diffstep,0), "MinLMCreateV: DiffStep<=0!", _state); - ae_assert(n>=1, "MinLMCreateV: N<1!", _state); - ae_assert(m>=1, "MinLMCreateV: M<1!", _state); - ae_assert(x->cnt>=n, "MinLMCreateV: Length(X)teststep = 0; - state->n = n; - state->m = m; - state->algomode = 0; - state->hasf = ae_false; - state->hasfi = ae_true; - state->hasg = ae_false; - state->diffstep = diffstep; - - /* - * Second stage of initialization - */ - minlm_lmprepare(n, m, ae_false, state, _state); - minlmsetacctype(state, 1, _state); - minlmsetcond(state, 0, 0, 0, 0, _state); - minlmsetxrep(state, ae_false, _state); - minlmsetstpmax(state, 0, _state); - minlmrestartfrom(state, x, _state); -} - - -/************************************************************************* - LEVENBERG-MARQUARDT-LIKE METHOD FOR NON-LINEAR OPTIMIZATION - -DESCRIPTION: -This function is used to find minimum of general form (not "sum-of- --squares") function - F = F(x[0], ..., x[n-1]) -using its gradient and Hessian. Levenberg-Marquardt modification with -L-BFGS pre-optimization and internal pre-conditioned L-BFGS optimization -after each Levenberg-Marquardt step is used. - - -REQUIREMENTS: -This algorithm will request following information during its operation: - -* function value F at given point X -* F and gradient G (simultaneously) at given point X -* F, G and Hessian H (simultaneously) at given point X - -There are several overloaded versions of MinLMOptimize() function which -correspond to different LM-like optimization algorithms provided by this -unit. You should choose version which accepts func(), grad() and hess() -function pointers. First pointer is used to calculate F at given point, -second one calculates F(x) and grad F(x), third one calculates F(x), -grad F(x), hess F(x). - -You can try to initialize MinLMState structure with FGH-function and then -use incorrect version of MinLMOptimize() (for example, version which does -not provide Hessian matrix), but it will lead to exception being thrown -after first attempt to calculate Hessian. - - -USAGE: -1. User initializes algorithm state with MinLMCreateFGH() call -2. User tunes solver parameters with MinLMSetCond(), MinLMSetStpMax() and - other functions -3. User calls MinLMOptimize() function which takes algorithm state and - pointers (delegates, etc.) to callback functions. -4. User calls MinLMResults() to get solution -5. Optionally, user may call MinLMRestartFrom() to solve another problem - with same N but another starting point and/or another function. - MinLMRestartFrom() allows to reuse already initialized structure. - - -INPUT PARAMETERS: - N - dimension, N>1 - * if given, only leading N elements of X are used - * if not given, automatically determined from size of X - X - initial solution, array[0..N-1] - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -NOTES: -1. you may tune stopping conditions with MinLMSetCond() function -2. if target function contains exp() or other fast growing functions, and - optimization algorithm makes too large steps which leads to overflow, - use MinLMSetStpMax() function to bound algorithm's steps. - - -- ALGLIB -- - Copyright 30.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minlmcreatefgh(ae_int_t n, - /* Real */ ae_vector* x, - minlmstate* state, - ae_state *_state) -{ - - _minlmstate_clear(state); - - ae_assert(n>=1, "MinLMCreateFGH: N<1!", _state); - ae_assert(x->cnt>=n, "MinLMCreateFGH: Length(X)teststep = 0; - state->n = n; - state->m = 0; - state->algomode = 2; - state->hasf = ae_true; - state->hasfi = ae_false; - state->hasg = ae_true; - - /* - * init2 - */ - minlm_lmprepare(n, 0, ae_true, state, _state); - minlmsetacctype(state, 2, _state); - minlmsetcond(state, 0, 0, 0, 0, _state); - minlmsetxrep(state, ae_false, _state); - minlmsetstpmax(state, 0, _state); - minlmrestartfrom(state, x, _state); -} - - -/************************************************************************* -This function sets stopping conditions for Levenberg-Marquardt optimization -algorithm. - -INPUT PARAMETERS: - State - structure which stores algorithm state - EpsG - >=0 - The subroutine finishes its work if the condition - |v|=0 - The subroutine finishes its work if on k+1-th iteration - the condition |F(k+1)-F(k)|<=EpsF*max{|F(k)|,|F(k+1)|,1} - is satisfied. - EpsX - >=0 - The subroutine finishes its work if on k+1-th iteration - the condition |v|<=EpsX is fulfilled, where: - * |.| means Euclidian norm - * v - scaled step vector, v[i]=dx[i]/s[i] - * dx - ste pvector, dx=X(k+1)-X(k) - * s - scaling coefficients set by MinLMSetScale() - MaxIts - maximum number of iterations. If MaxIts=0, the number of - iterations is unlimited. Only Levenberg-Marquardt - iterations are counted (L-BFGS/CG iterations are NOT - counted because their cost is very low compared to that of - LM). - -Passing EpsG=0, EpsF=0, EpsX=0 and MaxIts=0 (simultaneously) will lead to -automatic stopping criterion selection (small EpsX). - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minlmsetcond(minlmstate* state, - double epsg, - double epsf, - double epsx, - ae_int_t maxits, - ae_state *_state) -{ - - - ae_assert(ae_isfinite(epsg, _state), "MinLMSetCond: EpsG is not finite number!", _state); - ae_assert(ae_fp_greater_eq(epsg,0), "MinLMSetCond: negative EpsG!", _state); - ae_assert(ae_isfinite(epsf, _state), "MinLMSetCond: EpsF is not finite number!", _state); - ae_assert(ae_fp_greater_eq(epsf,0), "MinLMSetCond: negative EpsF!", _state); - ae_assert(ae_isfinite(epsx, _state), "MinLMSetCond: EpsX is not finite number!", _state); - ae_assert(ae_fp_greater_eq(epsx,0), "MinLMSetCond: negative EpsX!", _state); - ae_assert(maxits>=0, "MinLMSetCond: negative MaxIts!", _state); - if( ((ae_fp_eq(epsg,0)&&ae_fp_eq(epsf,0))&&ae_fp_eq(epsx,0))&&maxits==0 ) - { - epsx = 1.0E-6; - } - state->epsg = epsg; - state->epsf = epsf; - state->epsx = epsx; - state->maxits = maxits; -} - - -/************************************************************************* -This function turns on/off reporting. - -INPUT PARAMETERS: - State - structure which stores algorithm state - NeedXRep- whether iteration reports are needed or not - -If NeedXRep is True, algorithm will call rep() callback function if it is -provided to MinLMOptimize(). Both Levenberg-Marquardt and internal L-BFGS -iterations are reported. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minlmsetxrep(minlmstate* state, ae_bool needxrep, ae_state *_state) -{ - - - state->xrep = needxrep; -} - - -/************************************************************************* -This function sets maximum step length - -INPUT PARAMETERS: - State - structure which stores algorithm state - StpMax - maximum step length, >=0. Set StpMax to 0.0, if you don't - want to limit step length. - -Use this subroutine when you optimize target function which contains exp() -or other fast growing functions, and optimization algorithm makes too -large steps which leads to overflow. This function allows us to reject -steps that are too large (and therefore expose us to the possible -overflow) without actually calculating function value at the x+stp*d. - -NOTE: non-zero StpMax leads to moderate performance degradation because -intermediate step of preconditioned L-BFGS optimization is incompatible -with limits on step size. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minlmsetstpmax(minlmstate* state, double stpmax, ae_state *_state) -{ - - - ae_assert(ae_isfinite(stpmax, _state), "MinLMSetStpMax: StpMax is not finite!", _state); - ae_assert(ae_fp_greater_eq(stpmax,0), "MinLMSetStpMax: StpMax<0!", _state); - state->stpmax = stpmax; -} - - -/************************************************************************* -This function sets scaling coefficients for LM optimizer. - -ALGLIB optimizers use scaling matrices to test stopping conditions (step -size and gradient are scaled before comparison with tolerances). Scale of -the I-th variable is a translation invariant measure of: -a) "how large" the variable is -b) how large the step should be to make significant changes in the function - -Generally, scale is NOT considered to be a form of preconditioner. But LM -optimizer is unique in that it uses scaling matrix both in the stopping -condition tests and as Marquardt damping factor. - -Proper scaling is very important for the algorithm performance. It is less -important for the quality of results, but still has some influence (it is -easier to converge when variables are properly scaled, so premature -stopping is possible when very badly scalled variables are combined with -relaxed stopping conditions). - -INPUT PARAMETERS: - State - structure stores algorithm state - S - array[N], non-zero scaling coefficients - S[i] may be negative, sign doesn't matter. - - -- ALGLIB -- - Copyright 14.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minlmsetscale(minlmstate* state, - /* Real */ ae_vector* s, - ae_state *_state) -{ - ae_int_t i; - - - ae_assert(s->cnt>=state->n, "MinLMSetScale: Length(S)n-1; i++) - { - ae_assert(ae_isfinite(s->ptr.p_double[i], _state), "MinLMSetScale: S contains infinite or NAN elements", _state); - ae_assert(ae_fp_neq(s->ptr.p_double[i],0), "MinLMSetScale: S contains zero elements", _state); - state->s.ptr.p_double[i] = ae_fabs(s->ptr.p_double[i], _state); - } -} - - -/************************************************************************* -This function sets boundary constraints for LM optimizer - -Boundary constraints are inactive by default (after initial creation). -They are preserved until explicitly turned off with another SetBC() call. - -INPUT PARAMETERS: - State - structure stores algorithm state - BndL - lower bounds, array[N]. - If some (all) variables are unbounded, you may specify - very small number or -INF (latter is recommended because - it will allow solver to use better algorithm). - BndU - upper bounds, array[N]. - If some (all) variables are unbounded, you may specify - very large number or +INF (latter is recommended because - it will allow solver to use better algorithm). - -NOTE 1: it is possible to specify BndL[i]=BndU[i]. In this case I-th -variable will be "frozen" at X[i]=BndL[i]=BndU[i]. - -NOTE 2: this solver has following useful properties: -* bound constraints are always satisfied exactly -* function is evaluated only INSIDE area specified by bound constraints - or at its boundary - - -- ALGLIB -- - Copyright 14.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minlmsetbc(minlmstate* state, - /* Real */ ae_vector* bndl, - /* Real */ ae_vector* bndu, - ae_state *_state) -{ - ae_int_t i; - ae_int_t n; - - - n = state->n; - ae_assert(bndl->cnt>=n, "MinLMSetBC: Length(BndL)cnt>=n, "MinLMSetBC: Length(BndU)ptr.p_double[i], _state)||ae_isneginf(bndl->ptr.p_double[i], _state), "MinLMSetBC: BndL contains NAN or +INF", _state); - ae_assert(ae_isfinite(bndu->ptr.p_double[i], _state)||ae_isposinf(bndu->ptr.p_double[i], _state), "MinLMSetBC: BndU contains NAN or -INF", _state); - state->bndl.ptr.p_double[i] = bndl->ptr.p_double[i]; - state->havebndl.ptr.p_bool[i] = ae_isfinite(bndl->ptr.p_double[i], _state); - state->bndu.ptr.p_double[i] = bndu->ptr.p_double[i]; - state->havebndu.ptr.p_bool[i] = ae_isfinite(bndu->ptr.p_double[i], _state); - } -} - - -/************************************************************************* -This function is used to change acceleration settings - -You can choose between three acceleration strategies: -* AccType=0, no acceleration. -* AccType=1, secant updates are used to update quadratic model after each - iteration. After fixed number of iterations (or after model breakdown) - we recalculate quadratic model using analytic Jacobian or finite - differences. Number of secant-based iterations depends on optimization - settings: about 3 iterations - when we have analytic Jacobian, up to 2*N - iterations - when we use finite differences to calculate Jacobian. - -AccType=1 is recommended when Jacobian calculation cost is prohibitive -high (several Mx1 function vector calculations followed by several NxN -Cholesky factorizations are faster than calculation of one M*N Jacobian). -It should also be used when we have no Jacobian, because finite difference -approximation takes too much time to compute. - -Table below list optimization protocols (XYZ protocol corresponds to -MinLMCreateXYZ) and acceleration types they support (and use by default). - -ACCELERATION TYPES SUPPORTED BY OPTIMIZATION PROTOCOLS: - -protocol 0 1 comment -V + + -VJ + + -FGH + - -DAFAULT VALUES: - -protocol 0 1 comment -V x without acceleration it is so slooooooooow -VJ x -FGH x - -NOTE: this function should be called before optimization. Attempt to call -it during algorithm iterations may result in unexpected behavior. - -NOTE: attempt to call this function with unsupported protocol/acceleration -combination will result in exception being thrown. - - -- ALGLIB -- - Copyright 14.10.2010 by Bochkanov Sergey -*************************************************************************/ -void minlmsetacctype(minlmstate* state, - ae_int_t acctype, - ae_state *_state) -{ - - - ae_assert((acctype==0||acctype==1)||acctype==2, "MinLMSetAccType: incorrect AccType!", _state); - if( acctype==2 ) - { - acctype = 0; - } - if( acctype==0 ) - { - state->maxmodelage = 0; - state->makeadditers = ae_false; - return; - } - if( acctype==1 ) - { - ae_assert(state->hasfi, "MinLMSetAccType: AccType=1 is incompatible with current protocol!", _state); - if( state->algomode==0 ) - { - state->maxmodelage = 2*state->n; - } - else - { - state->maxmodelage = minlm_smallmodelage; - } - state->makeadditers = ae_false; - return; - } -} - - -/************************************************************************* -NOTES: - -1. Depending on function used to create state structure, this algorithm - may accept Jacobian and/or Hessian and/or gradient. According to the - said above, there ase several versions of this function, which accept - different sets of callbacks. - - This flexibility opens way to subtle errors - you may create state with - MinLMCreateFGH() (optimization using Hessian), but call function which - does not accept Hessian. So when algorithm will request Hessian, there - will be no callback to call. In this case exception will be thrown. - - Be careful to avoid such errors because there is no way to find them at - compile time - you can see them at runtime only. - - -- ALGLIB -- - Copyright 10.03.2009 by Bochkanov Sergey -*************************************************************************/ -ae_bool minlmiteration(minlmstate* state, ae_state *_state) -{ - ae_int_t n; - ae_int_t m; - ae_bool bflag; - ae_int_t iflag; - double v; - double s; - double t; - ae_int_t i; - ae_int_t k; - ae_bool result; - - - - /* - * Reverse communication preparations - * I know it looks ugly, but it works the same way - * anywhere from C++ to Python. - * - * This code initializes locals by: - * * random values determined during code - * generation - on first subroutine call - * * values from previous call - on subsequent calls - */ - if( state->rstate.stage>=0 ) - { - n = state->rstate.ia.ptr.p_int[0]; - m = state->rstate.ia.ptr.p_int[1]; - iflag = state->rstate.ia.ptr.p_int[2]; - i = state->rstate.ia.ptr.p_int[3]; - k = state->rstate.ia.ptr.p_int[4]; - bflag = state->rstate.ba.ptr.p_bool[0]; - v = state->rstate.ra.ptr.p_double[0]; - s = state->rstate.ra.ptr.p_double[1]; - t = state->rstate.ra.ptr.p_double[2]; - } - else - { - n = -983; - m = -989; - iflag = -834; - i = 900; - k = -287; - bflag = ae_false; - v = 214; - s = -338; - t = -686; - } - if( state->rstate.stage==0 ) - { - goto lbl_0; - } - if( state->rstate.stage==1 ) - { - goto lbl_1; - } - if( state->rstate.stage==2 ) - { - goto lbl_2; - } - if( state->rstate.stage==3 ) - { - goto lbl_3; - } - if( state->rstate.stage==4 ) - { - goto lbl_4; - } - if( state->rstate.stage==5 ) - { - goto lbl_5; - } - if( state->rstate.stage==6 ) - { - goto lbl_6; - } - if( state->rstate.stage==7 ) - { - goto lbl_7; - } - if( state->rstate.stage==8 ) - { - goto lbl_8; - } - if( state->rstate.stage==9 ) - { - goto lbl_9; - } - if( state->rstate.stage==10 ) - { - goto lbl_10; - } - if( state->rstate.stage==11 ) - { - goto lbl_11; - } - if( state->rstate.stage==12 ) - { - goto lbl_12; - } - if( state->rstate.stage==13 ) - { - goto lbl_13; - } - if( state->rstate.stage==14 ) - { - goto lbl_14; - } - if( state->rstate.stage==15 ) - { - goto lbl_15; - } - if( state->rstate.stage==16 ) - { - goto lbl_16; - } - if( state->rstate.stage==17 ) - { - goto lbl_17; - } - if( state->rstate.stage==18 ) - { - goto lbl_18; - } - - /* - * Routine body - */ - - /* - * prepare - */ - n = state->n; - m = state->m; - state->repiterationscount = 0; - state->repterminationtype = 0; - state->repfuncidx = -1; - state->repvaridx = -1; - state->repnfunc = 0; - state->repnjac = 0; - state->repngrad = 0; - state->repnhess = 0; - state->repncholesky = 0; - - /* - * check consistency of constraints, - * enforce feasibility of the solution - * set constraints - */ - if( !enforceboundaryconstraints(&state->xbase, &state->bndl, &state->havebndl, &state->bndu, &state->havebndu, n, 0, _state) ) - { - state->repterminationtype = -3; - result = ae_false; - return result; - } - minqpsetbc(&state->qpstate, &state->bndl, &state->bndu, _state); - - /* - * Check, that transferred derivative value is right - */ - minlm_clearrequestfields(state, _state); - if( !(state->algomode==1&&ae_fp_greater(state->teststep,0)) ) - { - goto lbl_19; - } - ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->needfij = ae_true; - i = 0; -lbl_21: - if( i>n-1 ) - { - goto lbl_23; - } - ae_assert((state->havebndl.ptr.p_bool[i]&&ae_fp_less_eq(state->bndl.ptr.p_double[i],state->x.ptr.p_double[i]))||!state->havebndl.ptr.p_bool[i], "MinLM: internal error(State.X is out of bounds)", _state); - ae_assert((state->havebndu.ptr.p_bool[i]&&ae_fp_less_eq(state->x.ptr.p_double[i],state->bndu.ptr.p_double[i]))||!state->havebndu.ptr.p_bool[i], "MinLMIteration: internal error(State.X is out of bounds)", _state); - v = state->x.ptr.p_double[i]; - state->x.ptr.p_double[i] = v-state->teststep*state->s.ptr.p_double[i]; - if( state->havebndl.ptr.p_bool[i] ) - { - state->x.ptr.p_double[i] = ae_maxreal(state->x.ptr.p_double[i], state->bndl.ptr.p_double[i], _state); - } - state->xm1 = state->x.ptr.p_double[i]; - state->rstate.stage = 0; - goto lbl_rcomm; -lbl_0: - ae_v_move(&state->fm1.ptr.p_double[0], 1, &state->fi.ptr.p_double[0], 1, ae_v_len(0,m-1)); - ae_v_move(&state->gm1.ptr.p_double[0], 1, &state->j.ptr.pp_double[0][i], state->j.stride, ae_v_len(0,m-1)); - state->x.ptr.p_double[i] = v+state->teststep*state->s.ptr.p_double[i]; - if( state->havebndu.ptr.p_bool[i] ) - { - state->x.ptr.p_double[i] = ae_minreal(state->x.ptr.p_double[i], state->bndu.ptr.p_double[i], _state); - } - state->xp1 = state->x.ptr.p_double[i]; - state->rstate.stage = 1; - goto lbl_rcomm; -lbl_1: - ae_v_move(&state->fp1.ptr.p_double[0], 1, &state->fi.ptr.p_double[0], 1, ae_v_len(0,m-1)); - ae_v_move(&state->gp1.ptr.p_double[0], 1, &state->j.ptr.pp_double[0][i], state->j.stride, ae_v_len(0,m-1)); - state->x.ptr.p_double[i] = (state->xm1+state->xp1)/2; - if( state->havebndl.ptr.p_bool[i] ) - { - state->x.ptr.p_double[i] = ae_maxreal(state->x.ptr.p_double[i], state->bndl.ptr.p_double[i], _state); - } - if( state->havebndu.ptr.p_bool[i] ) - { - state->x.ptr.p_double[i] = ae_minreal(state->x.ptr.p_double[i], state->bndu.ptr.p_double[i], _state); - } - state->rstate.stage = 2; - goto lbl_rcomm; -lbl_2: - ae_v_move(&state->fc1.ptr.p_double[0], 1, &state->fi.ptr.p_double[0], 1, ae_v_len(0,m-1)); - ae_v_move(&state->gc1.ptr.p_double[0], 1, &state->j.ptr.pp_double[0][i], state->j.stride, ae_v_len(0,m-1)); - state->x.ptr.p_double[i] = v; - for(k=0; k<=m-1; k++) - { - if( !derivativecheck(state->fm1.ptr.p_double[k], state->gm1.ptr.p_double[k], state->fp1.ptr.p_double[k], state->gp1.ptr.p_double[k], state->fc1.ptr.p_double[k], state->gc1.ptr.p_double[k], state->xp1-state->xm1, _state) ) - { - state->repfuncidx = k; - state->repvaridx = i; - state->repterminationtype = -7; - result = ae_false; - return result; - } - } - i = i+1; - goto lbl_21; -lbl_23: - state->needfij = ae_false; -lbl_19: - - /* - * Initial report of current point - * - * Note 1: we rewrite State.X twice because - * user may accidentally change it after first call. - * - * Note 2: we set NeedF or NeedFI depending on what - * information about function we have. - */ - if( !state->xrep ) - { - goto lbl_24; - } - ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); - minlm_clearrequestfields(state, _state); - if( !state->hasf ) - { - goto lbl_26; - } - state->needf = ae_true; - state->rstate.stage = 3; - goto lbl_rcomm; -lbl_3: - state->needf = ae_false; - goto lbl_27; -lbl_26: - ae_assert(state->hasfi, "MinLM: internal error 2!", _state); - state->needfi = ae_true; - state->rstate.stage = 4; - goto lbl_rcomm; -lbl_4: - state->needfi = ae_false; - v = ae_v_dotproduct(&state->fi.ptr.p_double[0], 1, &state->fi.ptr.p_double[0], 1, ae_v_len(0,m-1)); - state->f = v; -lbl_27: - state->repnfunc = state->repnfunc+1; - ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); - minlm_clearrequestfields(state, _state); - state->xupdated = ae_true; - state->rstate.stage = 5; - goto lbl_rcomm; -lbl_5: - state->xupdated = ae_false; -lbl_24: - - /* - * Prepare control variables - */ - state->nu = 1; - state->lambdav = -ae_maxrealnumber; - state->modelage = state->maxmodelage+1; - state->deltaxready = ae_false; - state->deltafready = ae_false; - - /* - * Main cycle. - * - * We move through it until either: - * * one of the stopping conditions is met - * * we decide that stopping conditions are too stringent - * and break from cycle - * - */ -lbl_28: - if( ae_false ) - { - goto lbl_29; - } - - /* - * First, we have to prepare quadratic model for our function. - * We use BFlag to ensure that model is prepared; - * if it is false at the end of this block, something went wrong. - * - * We may either calculate brand new model or update old one. - * - * Before this block we have: - * * State.XBase - current position. - * * State.DeltaX - if DeltaXReady is True - * * State.DeltaF - if DeltaFReady is True - * - * After this block is over, we will have: - * * State.XBase - base point (unchanged) - * * State.FBase - F(XBase) - * * State.GBase - linear term - * * State.QuadraticModel - quadratic term - * * State.LambdaV - current estimate for lambda - * - * We also clear DeltaXReady/DeltaFReady flags - * after initialization is done. - */ - bflag = ae_false; - if( !(state->algomode==0||state->algomode==1) ) - { - goto lbl_30; - } - - /* - * Calculate f[] and Jacobian - */ - if( !(state->modelage>state->maxmodelage||!(state->deltaxready&&state->deltafready)) ) - { - goto lbl_32; - } - - /* - * Refresh model (using either finite differences or analytic Jacobian) - */ - if( state->algomode!=0 ) - { - goto lbl_34; - } - - /* - * Optimization using F values only. - * Use finite differences to estimate Jacobian. - */ - ae_assert(state->hasfi, "MinLMIteration: internal error when estimating Jacobian (no f[])", _state); - k = 0; -lbl_36: - if( k>n-1 ) - { - goto lbl_38; - } - - /* - * We guard X[k] from leaving [BndL,BndU]. - * In case BndL=BndU, we assume that derivative in this direction is zero. - */ - ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->x.ptr.p_double[k] = state->x.ptr.p_double[k]-state->s.ptr.p_double[k]*state->diffstep; - if( state->havebndl.ptr.p_bool[k] ) - { - state->x.ptr.p_double[k] = ae_maxreal(state->x.ptr.p_double[k], state->bndl.ptr.p_double[k], _state); - } - if( state->havebndu.ptr.p_bool[k] ) - { - state->x.ptr.p_double[k] = ae_minreal(state->x.ptr.p_double[k], state->bndu.ptr.p_double[k], _state); - } - state->xm1 = state->x.ptr.p_double[k]; - minlm_clearrequestfields(state, _state); - state->needfi = ae_true; - state->rstate.stage = 6; - goto lbl_rcomm; -lbl_6: - state->repnfunc = state->repnfunc+1; - ae_v_move(&state->fm1.ptr.p_double[0], 1, &state->fi.ptr.p_double[0], 1, ae_v_len(0,m-1)); - ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->x.ptr.p_double[k] = state->x.ptr.p_double[k]+state->s.ptr.p_double[k]*state->diffstep; - if( state->havebndl.ptr.p_bool[k] ) - { - state->x.ptr.p_double[k] = ae_maxreal(state->x.ptr.p_double[k], state->bndl.ptr.p_double[k], _state); - } - if( state->havebndu.ptr.p_bool[k] ) - { - state->x.ptr.p_double[k] = ae_minreal(state->x.ptr.p_double[k], state->bndu.ptr.p_double[k], _state); - } - state->xp1 = state->x.ptr.p_double[k]; - minlm_clearrequestfields(state, _state); - state->needfi = ae_true; - state->rstate.stage = 7; - goto lbl_rcomm; -lbl_7: - state->repnfunc = state->repnfunc+1; - ae_v_move(&state->fp1.ptr.p_double[0], 1, &state->fi.ptr.p_double[0], 1, ae_v_len(0,m-1)); - v = state->xp1-state->xm1; - if( ae_fp_neq(v,0) ) - { - v = 1/v; - ae_v_moved(&state->j.ptr.pp_double[0][k], state->j.stride, &state->fp1.ptr.p_double[0], 1, ae_v_len(0,m-1), v); - ae_v_subd(&state->j.ptr.pp_double[0][k], state->j.stride, &state->fm1.ptr.p_double[0], 1, ae_v_len(0,m-1), v); - } - else - { - for(i=0; i<=m-1; i++) - { - state->j.ptr.pp_double[i][k] = 0; - } - } - k = k+1; - goto lbl_36; -lbl_38: - - /* - * Calculate F(XBase) - */ - ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); - minlm_clearrequestfields(state, _state); - state->needfi = ae_true; - state->rstate.stage = 8; - goto lbl_rcomm; -lbl_8: - state->needfi = ae_false; - state->repnfunc = state->repnfunc+1; - state->repnjac = state->repnjac+1; - - /* - * New model - */ - state->modelage = 0; - goto lbl_35; -lbl_34: - - /* - * Obtain f[] and Jacobian - */ - ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); - minlm_clearrequestfields(state, _state); - state->needfij = ae_true; - state->rstate.stage = 9; - goto lbl_rcomm; -lbl_9: - state->needfij = ae_false; - state->repnfunc = state->repnfunc+1; - state->repnjac = state->repnjac+1; - - /* - * New model - */ - state->modelage = 0; -lbl_35: - goto lbl_33; -lbl_32: - - /* - * State.J contains Jacobian or its current approximation; - * refresh it using secant updates: - * - * f(x0+dx) = f(x0) + J*dx, - * J_new = J_old + u*h' - * h = x_new-x_old - * u = (f_new - f_old - J_old*h)/(h'h) - * - * We can explicitly generate h and u, but it is - * preferential to do in-place calculations. Only - * I-th row of J_old is needed to calculate u[I], - * so we can update J row by row in one pass. - * - * NOTE: we expect that State.XBase contains new point, - * State.FBase contains old point, State.DeltaX and - * State.DeltaY contain updates from last step. - */ - ae_assert(state->deltaxready&&state->deltafready, "MinLMIteration: uninitialized DeltaX/DeltaF", _state); - t = ae_v_dotproduct(&state->deltax.ptr.p_double[0], 1, &state->deltax.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_assert(ae_fp_neq(t,0), "MinLM: internal error (T=0)", _state); - for(i=0; i<=m-1; i++) - { - v = ae_v_dotproduct(&state->j.ptr.pp_double[i][0], 1, &state->deltax.ptr.p_double[0], 1, ae_v_len(0,n-1)); - v = (state->deltaf.ptr.p_double[i]-v)/t; - ae_v_addd(&state->j.ptr.pp_double[i][0], 1, &state->deltax.ptr.p_double[0], 1, ae_v_len(0,n-1), v); - } - ae_v_move(&state->fi.ptr.p_double[0], 1, &state->fibase.ptr.p_double[0], 1, ae_v_len(0,m-1)); - ae_v_add(&state->fi.ptr.p_double[0], 1, &state->deltaf.ptr.p_double[0], 1, ae_v_len(0,m-1)); - - /* - * Increase model age - */ - state->modelage = state->modelage+1; -lbl_33: - - /* - * Generate quadratic model: - * f(xbase+dx) = - * = (f0 + J*dx)'(f0 + J*dx) - * = f0^2 + dx'J'f0 + f0*J*dx + dx'J'J*dx - * = f0^2 + 2*f0*J*dx + dx'J'J*dx - * - * Note that we calculate 2*(J'J) instead of J'J because - * our quadratic model is based on Tailor decomposition, - * i.e. it has 0.5 before quadratic term. - */ - rmatrixgemm(n, n, m, 2.0, &state->j, 0, 0, 1, &state->j, 0, 0, 0, 0.0, &state->quadraticmodel, 0, 0, _state); - rmatrixmv(n, m, &state->j, 0, 0, 1, &state->fi, 0, &state->gbase, 0, _state); - ae_v_muld(&state->gbase.ptr.p_double[0], 1, ae_v_len(0,n-1), 2); - v = ae_v_dotproduct(&state->fi.ptr.p_double[0], 1, &state->fi.ptr.p_double[0], 1, ae_v_len(0,m-1)); - state->fbase = v; - ae_v_move(&state->fibase.ptr.p_double[0], 1, &state->fi.ptr.p_double[0], 1, ae_v_len(0,m-1)); - - /* - * set control variables - */ - bflag = ae_true; -lbl_30: - if( state->algomode!=2 ) - { - goto lbl_39; - } - ae_assert(!state->hasfi, "MinLMIteration: internal error (HasFI is True in Hessian-based mode)", _state); - - /* - * Obtain F, G, H - */ - ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); - minlm_clearrequestfields(state, _state); - state->needfgh = ae_true; - state->rstate.stage = 10; - goto lbl_rcomm; -lbl_10: - state->needfgh = ae_false; - state->repnfunc = state->repnfunc+1; - state->repngrad = state->repngrad+1; - state->repnhess = state->repnhess+1; - rmatrixcopy(n, n, &state->h, 0, 0, &state->quadraticmodel, 0, 0, _state); - ae_v_move(&state->gbase.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->fbase = state->f; - - /* - * set control variables - */ - bflag = ae_true; - state->modelage = 0; -lbl_39: - ae_assert(bflag, "MinLM: internal integrity check failed!", _state); - state->deltaxready = ae_false; - state->deltafready = ae_false; - - /* - * If Lambda is not initialized, initialize it using quadratic model - */ - if( ae_fp_less(state->lambdav,0) ) - { - state->lambdav = 0; - for(i=0; i<=n-1; i++) - { - state->lambdav = ae_maxreal(state->lambdav, ae_fabs(state->quadraticmodel.ptr.pp_double[i][i], _state)*ae_sqr(state->s.ptr.p_double[i], _state), _state); - } - state->lambdav = 0.001*state->lambdav; - if( ae_fp_eq(state->lambdav,0) ) - { - state->lambdav = 1; - } - } - - /* - * Test stopping conditions for function gradient - */ - if( ae_fp_greater(minlm_boundedscaledantigradnorm(state, &state->xbase, &state->gbase, _state),state->epsg) ) - { - goto lbl_41; - } - if( state->modelage!=0 ) - { - goto lbl_43; - } - - /* - * Model is fresh, we can rely on it and terminate algorithm - */ - state->repterminationtype = 4; - if( !state->xrep ) - { - goto lbl_45; - } - ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->f = state->fbase; - minlm_clearrequestfields(state, _state); - state->xupdated = ae_true; - state->rstate.stage = 11; - goto lbl_rcomm; -lbl_11: - state->xupdated = ae_false; -lbl_45: - result = ae_false; - return result; - goto lbl_44; -lbl_43: - - /* - * Model is not fresh, we should refresh it and test - * conditions once more - */ - state->modelage = state->maxmodelage+1; - goto lbl_28; -lbl_44: -lbl_41: - - /* - * Find value of Levenberg-Marquardt damping parameter which: - * * leads to positive definite damped model - * * within bounds specified by StpMax - * * generates step which decreases function value - * - * After this block IFlag is set to: - * * -3, if constraints are infeasible - * * -2, if model update is needed (either Lambda growth is too large - * or step is too short, but we can't rely on model and stop iterations) - * * -1, if model is fresh, Lambda have grown too large, termination is needed - * * 0, if everything is OK, continue iterations - * - * State.Nu can have any value on enter, but after exit it is set to 1.0 - */ - iflag = -99; -lbl_47: - if( ae_false ) - { - goto lbl_48; - } - - /* - * Do we need model update? - */ - if( state->modelage>0&&ae_fp_greater_eq(state->nu,minlm_suspiciousnu) ) - { - iflag = -2; - goto lbl_48; - } - - /* - * Setup quadratic solver and solve quadratic programming problem. - * After problem is solved we'll try to bound step by StpMax - * (Lambda will be increased if step size is too large). - * - * We use BFlag variable to indicate that we have to increase Lambda. - * If it is False, we will try to increase Lambda and move to new iteration. - */ - bflag = ae_true; - minqpsetstartingpointfast(&state->qpstate, &state->xbase, _state); - minqpsetoriginfast(&state->qpstate, &state->xbase, _state); - minqpsetlineartermfast(&state->qpstate, &state->gbase, _state); - minqpsetquadratictermfast(&state->qpstate, &state->quadraticmodel, ae_true, 0.0, _state); - for(i=0; i<=n-1; i++) - { - state->tmp0.ptr.p_double[i] = state->quadraticmodel.ptr.pp_double[i][i]+state->lambdav/ae_sqr(state->s.ptr.p_double[i], _state); - } - minqprewritediagonal(&state->qpstate, &state->tmp0, _state); - minqpoptimize(&state->qpstate, _state); - minqpresultsbuf(&state->qpstate, &state->xdir, &state->qprep, _state); - if( state->qprep.terminationtype>0 ) - { - - /* - * successful solution of QP problem - */ - ae_v_sub(&state->xdir.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); - v = ae_v_dotproduct(&state->xdir.ptr.p_double[0], 1, &state->xdir.ptr.p_double[0], 1, ae_v_len(0,n-1)); - if( ae_isfinite(v, _state) ) - { - v = ae_sqrt(v, _state); - if( ae_fp_greater(state->stpmax,0)&&ae_fp_greater(v,state->stpmax) ) - { - bflag = ae_false; - } - } - else - { - bflag = ae_false; - } - } - else - { - - /* - * Either problem is non-convex (increase LambdaV) or constraints are inconsistent - */ - ae_assert(state->qprep.terminationtype==-3||state->qprep.terminationtype==-5, "MinLM: unexpected completion code from QP solver", _state); - if( state->qprep.terminationtype==-3 ) - { - iflag = -3; - goto lbl_48; - } - bflag = ae_false; - } - if( !bflag ) - { - - /* - * Solution failed: - * try to increase lambda to make matrix positive definite and continue. - */ - if( !minlm_increaselambda(&state->lambdav, &state->nu, _state) ) - { - iflag = -1; - goto lbl_48; - } - goto lbl_47; - } - - /* - * Step in State.XDir and it is bounded by StpMax. - * - * We should check stopping conditions on step size here. - * DeltaX, which is used for secant updates, is initialized here. - * - * This code is a bit tricky because sometimes XDir<>0, but - * it is so small that XDir+XBase==XBase (in finite precision - * arithmetics). So we set DeltaX to XBase, then - * add XDir, and then subtract XBase to get exact value of - * DeltaX. - * - * Step length is estimated using DeltaX. - * - * NOTE: stopping conditions are tested - * for fresh models only (ModelAge=0) - */ - ae_v_move(&state->deltax.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_add(&state->deltax.ptr.p_double[0], 1, &state->xdir.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_sub(&state->deltax.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->deltaxready = ae_true; - v = 0.0; - for(i=0; i<=n-1; i++) - { - v = v+ae_sqr(state->deltax.ptr.p_double[i]/state->s.ptr.p_double[i], _state); - } - v = ae_sqrt(v, _state); - if( ae_fp_greater(v,state->epsx) ) - { - goto lbl_49; - } - if( state->modelage!=0 ) - { - goto lbl_51; - } - - /* - * Step is too short, model is fresh and we can rely on it. - * Terminating. - */ - state->repterminationtype = 2; - if( !state->xrep ) - { - goto lbl_53; - } - ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->f = state->fbase; - minlm_clearrequestfields(state, _state); - state->xupdated = ae_true; - state->rstate.stage = 12; - goto lbl_rcomm; -lbl_12: - state->xupdated = ae_false; -lbl_53: - result = ae_false; - return result; - goto lbl_52; -lbl_51: - - /* - * Step is suspiciously short, but model is not fresh - * and we can't rely on it. - */ - iflag = -2; - goto lbl_48; -lbl_52: -lbl_49: - - /* - * Let's evaluate new step: - * a) if we have Fi vector, we evaluate it using rcomm, and - * then we manually calculate State.F as sum of squares of Fi[] - * b) if we have F value, we just evaluate it through rcomm interface - * - * We prefer (a) because we may need Fi vector for additional - * iterations - */ - ae_assert(state->hasfi||state->hasf, "MinLM: internal error 2!", _state); - ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_add(&state->x.ptr.p_double[0], 1, &state->xdir.ptr.p_double[0], 1, ae_v_len(0,n-1)); - minlm_clearrequestfields(state, _state); - if( !state->hasfi ) - { - goto lbl_55; - } - state->needfi = ae_true; - state->rstate.stage = 13; - goto lbl_rcomm; -lbl_13: - state->needfi = ae_false; - v = ae_v_dotproduct(&state->fi.ptr.p_double[0], 1, &state->fi.ptr.p_double[0], 1, ae_v_len(0,m-1)); - state->f = v; - ae_v_move(&state->deltaf.ptr.p_double[0], 1, &state->fi.ptr.p_double[0], 1, ae_v_len(0,m-1)); - ae_v_sub(&state->deltaf.ptr.p_double[0], 1, &state->fibase.ptr.p_double[0], 1, ae_v_len(0,m-1)); - state->deltafready = ae_true; - goto lbl_56; -lbl_55: - state->needf = ae_true; - state->rstate.stage = 14; - goto lbl_rcomm; -lbl_14: - state->needf = ae_false; -lbl_56: - state->repnfunc = state->repnfunc+1; - if( ae_fp_greater_eq(state->f,state->fbase) ) - { - - /* - * Increase lambda and continue - */ - if( !minlm_increaselambda(&state->lambdav, &state->nu, _state) ) - { - iflag = -1; - goto lbl_48; - } - goto lbl_47; - } - - /* - * We've found our step! - */ - iflag = 0; - goto lbl_48; - goto lbl_47; -lbl_48: - state->nu = 1; - ae_assert(iflag>=-3&&iflag<=0, "MinLM: internal integrity check failed!", _state); - if( iflag==-3 ) - { - state->repterminationtype = -3; - result = ae_false; - return result; - } - if( iflag==-2 ) - { - state->modelage = state->maxmodelage+1; - goto lbl_28; - } - if( iflag==-1 ) - { - goto lbl_29; - } - - /* - * Levenberg-Marquardt step is ready. - * Compare predicted vs. actual decrease and decide what to do with lambda. - * - * NOTE: we expect that State.DeltaX contains direction of step, - * State.F contains function value at new point. - */ - ae_assert(state->deltaxready, "MinLM: deltaX is not ready", _state); - t = 0; - for(i=0; i<=n-1; i++) - { - v = ae_v_dotproduct(&state->quadraticmodel.ptr.pp_double[i][0], 1, &state->deltax.ptr.p_double[0], 1, ae_v_len(0,n-1)); - t = t+state->deltax.ptr.p_double[i]*state->gbase.ptr.p_double[i]+0.5*state->deltax.ptr.p_double[i]*v; - } - state->predicteddecrease = -t; - state->actualdecrease = -(state->f-state->fbase); - if( ae_fp_less_eq(state->predicteddecrease,0) ) - { - goto lbl_29; - } - v = state->actualdecrease/state->predicteddecrease; - if( ae_fp_greater_eq(v,0.1) ) - { - goto lbl_57; - } - if( minlm_increaselambda(&state->lambdav, &state->nu, _state) ) - { - goto lbl_59; - } - - /* - * Lambda is too large, we have to break iterations. - */ - state->repterminationtype = 7; - if( !state->xrep ) - { - goto lbl_61; - } - ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->f = state->fbase; - minlm_clearrequestfields(state, _state); - state->xupdated = ae_true; - state->rstate.stage = 15; - goto lbl_rcomm; -lbl_15: - state->xupdated = ae_false; -lbl_61: - result = ae_false; - return result; -lbl_59: -lbl_57: - if( ae_fp_greater(v,0.5) ) - { - minlm_decreaselambda(&state->lambdav, &state->nu, _state); - } - - /* - * Accept step, report it and - * test stopping conditions on iterations count and function decrease. - * - * NOTE: we expect that State.DeltaX contains direction of step, - * State.F contains function value at new point. - * - * NOTE2: we should update XBase ONLY. In the beginning of the next - * iteration we expect that State.FIBase is NOT updated and - * contains old value of a function vector. - */ - ae_v_add(&state->xbase.ptr.p_double[0], 1, &state->deltax.ptr.p_double[0], 1, ae_v_len(0,n-1)); - if( !state->xrep ) - { - goto lbl_63; - } - ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); - minlm_clearrequestfields(state, _state); - state->xupdated = ae_true; - state->rstate.stage = 16; - goto lbl_rcomm; -lbl_16: - state->xupdated = ae_false; -lbl_63: - state->repiterationscount = state->repiterationscount+1; - if( state->repiterationscount>=state->maxits&&state->maxits>0 ) - { - state->repterminationtype = 5; - } - if( state->modelage==0 ) - { - if( ae_fp_less_eq(ae_fabs(state->f-state->fbase, _state),state->epsf*ae_maxreal(1, ae_maxreal(ae_fabs(state->f, _state), ae_fabs(state->fbase, _state), _state), _state)) ) - { - state->repterminationtype = 1; - } - } - if( state->repterminationtype<=0 ) - { - goto lbl_65; - } - if( !state->xrep ) - { - goto lbl_67; - } - - /* - * Report: XBase contains new point, F contains function value at new point - */ - ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); - minlm_clearrequestfields(state, _state); - state->xupdated = ae_true; - state->rstate.stage = 17; - goto lbl_rcomm; -lbl_17: - state->xupdated = ae_false; -lbl_67: - result = ae_false; - return result; -lbl_65: - state->modelage = state->modelage+1; - goto lbl_28; -lbl_29: - - /* - * Lambda is too large, we have to break iterations. - */ - state->repterminationtype = 7; - if( !state->xrep ) - { - goto lbl_69; - } - ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->f = state->fbase; - minlm_clearrequestfields(state, _state); - state->xupdated = ae_true; - state->rstate.stage = 18; - goto lbl_rcomm; -lbl_18: - state->xupdated = ae_false; -lbl_69: - result = ae_false; - return result; - - /* - * Saving state - */ -lbl_rcomm: - result = ae_true; - state->rstate.ia.ptr.p_int[0] = n; - state->rstate.ia.ptr.p_int[1] = m; - state->rstate.ia.ptr.p_int[2] = iflag; - state->rstate.ia.ptr.p_int[3] = i; - state->rstate.ia.ptr.p_int[4] = k; - state->rstate.ba.ptr.p_bool[0] = bflag; - state->rstate.ra.ptr.p_double[0] = v; - state->rstate.ra.ptr.p_double[1] = s; - state->rstate.ra.ptr.p_double[2] = t; - return result; -} - - -/************************************************************************* -Levenberg-Marquardt algorithm results - -INPUT PARAMETERS: - State - algorithm state - -OUTPUT PARAMETERS: - X - array[0..N-1], solution - Rep - optimization report; - see comments for this structure for more info. - - -- ALGLIB -- - Copyright 10.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minlmresults(minlmstate* state, - /* Real */ ae_vector* x, - minlmreport* rep, - ae_state *_state) -{ - - ae_vector_clear(x); - _minlmreport_clear(rep); - - minlmresultsbuf(state, x, rep, _state); -} - - -/************************************************************************* -Levenberg-Marquardt algorithm results - -Buffered implementation of MinLMResults(), which uses pre-allocated buffer -to store X[]. If buffer size is too small, it resizes buffer. It is -intended to be used in the inner cycles of performance critical algorithms -where array reallocation penalty is too large to be ignored. - - -- ALGLIB -- - Copyright 10.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minlmresultsbuf(minlmstate* state, - /* Real */ ae_vector* x, - minlmreport* rep, - ae_state *_state) -{ - - - if( x->cntn ) - { - ae_vector_set_length(x, state->n, _state); - } - ae_v_move(&x->ptr.p_double[0], 1, &state->x.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - rep->iterationscount = state->repiterationscount; - rep->terminationtype = state->repterminationtype; - rep->funcidx = state->repfuncidx; - rep->varidx = state->repvaridx; - rep->nfunc = state->repnfunc; - rep->njac = state->repnjac; - rep->ngrad = state->repngrad; - rep->nhess = state->repnhess; - rep->ncholesky = state->repncholesky; -} - - -/************************************************************************* -This subroutine restarts LM algorithm from new point. All optimization -parameters are left unchanged. - -This function allows to solve multiple optimization problems (which -must have same number of dimensions) without object reallocation penalty. - -INPUT PARAMETERS: - State - structure used for reverse communication previously - allocated with MinLMCreateXXX call. - X - new starting point. - - -- ALGLIB -- - Copyright 30.07.2010 by Bochkanov Sergey -*************************************************************************/ -void minlmrestartfrom(minlmstate* state, - /* Real */ ae_vector* x, - ae_state *_state) -{ - - - ae_assert(x->cnt>=state->n, "MinLMRestartFrom: Length(X)n, _state), "MinLMRestartFrom: X contains infinite or NaN values!", _state); - ae_v_move(&state->xbase.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - ae_vector_set_length(&state->rstate.ia, 4+1, _state); - ae_vector_set_length(&state->rstate.ba, 0+1, _state); - ae_vector_set_length(&state->rstate.ra, 2+1, _state); - state->rstate.stage = -1; - minlm_clearrequestfields(state, _state); -} - - -/************************************************************************* -This is obsolete function. - -Since ALGLIB 3.3 it is equivalent to MinLMCreateVJ(). - - -- ALGLIB -- - Copyright 30.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minlmcreatevgj(ae_int_t n, - ae_int_t m, - /* Real */ ae_vector* x, - minlmstate* state, - ae_state *_state) -{ - - _minlmstate_clear(state); - - minlmcreatevj(n, m, x, state, _state); -} - - -/************************************************************************* -This is obsolete function. - -Since ALGLIB 3.3 it is equivalent to MinLMCreateFJ(). - - -- ALGLIB -- - Copyright 30.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minlmcreatefgj(ae_int_t n, - ae_int_t m, - /* Real */ ae_vector* x, - minlmstate* state, - ae_state *_state) -{ - - _minlmstate_clear(state); - - minlmcreatefj(n, m, x, state, _state); -} - - -/************************************************************************* -This function is considered obsolete since ALGLIB 3.1.0 and is present for -backward compatibility only. We recommend to use MinLMCreateVJ, which -provides similar, but more consistent and feature-rich interface. - - -- ALGLIB -- - Copyright 30.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minlmcreatefj(ae_int_t n, - ae_int_t m, - /* Real */ ae_vector* x, - minlmstate* state, - ae_state *_state) -{ - - _minlmstate_clear(state); - - ae_assert(n>=1, "MinLMCreateFJ: N<1!", _state); - ae_assert(m>=1, "MinLMCreateFJ: M<1!", _state); - ae_assert(x->cnt>=n, "MinLMCreateFJ: Length(X)teststep = 0; - state->n = n; - state->m = m; - state->algomode = 1; - state->hasf = ae_true; - state->hasfi = ae_false; - state->hasg = ae_false; - - /* - * init 2 - */ - minlm_lmprepare(n, m, ae_true, state, _state); - minlmsetacctype(state, 0, _state); - minlmsetcond(state, 0, 0, 0, 0, _state); - minlmsetxrep(state, ae_false, _state); - minlmsetstpmax(state, 0, _state); - minlmrestartfrom(state, x, _state); -} - - -/************************************************************************* -This subroutine turns on verification of the user-supplied analytic -gradient: -* user calls this subroutine before optimization begins -* MinLMOptimize() is called -* prior to actual optimization, for each function Fi and each component - of parameters being optimized X[j] algorithm performs following steps: - * two trial steps are made to X[j]-TestStep*S[j] and X[j]+TestStep*S[j], - where X[j] is j-th parameter and S[j] is a scale of j-th parameter - * if needed, steps are bounded with respect to constraints on X[] - * Fi(X) is evaluated at these trial points - * we perform one more evaluation in the middle point of the interval - * we build cubic model using function values and derivatives at trial - points and we compare its prediction with actual value in the middle - point - * in case difference between prediction and actual value is higher than - some predetermined threshold, algorithm stops with completion code -7; - Rep.VarIdx is set to index of the parameter with incorrect derivative, - Rep.FuncIdx is set to index of the function. -* after verification is over, algorithm proceeds to the actual optimization. - -NOTE 1: verification needs N (parameters count) Jacobian evaluations. It - is very costly and you should use it only for low dimensional - problems, when you want to be sure that you've correctly - calculated analytic derivatives. You should not use it in the - production code (unless you want to check derivatives provided - by some third party). - -NOTE 2: you should carefully choose TestStep. Value which is too large - (so large that function behaviour is significantly non-cubic) will - lead to false alarms. You may use different step for different - parameters by means of setting scale with MinLMSetScale(). - -NOTE 3: this function may lead to false positives. In case it reports that - I-th derivative was calculated incorrectly, you may decrease test - step and try one more time - maybe your function changes too - sharply and your step is too large for such rapidly chanding - function. - -INPUT PARAMETERS: - State - structure used to store algorithm state - TestStep - verification step: - * TestStep=0 turns verification off - * TestStep>0 activates verification - - -- ALGLIB -- - Copyright 15.06.2012 by Bochkanov Sergey -*************************************************************************/ -void minlmsetgradientcheck(minlmstate* state, - double teststep, - ae_state *_state) -{ - - - ae_assert(ae_isfinite(teststep, _state), "MinLMSetGradientCheck: TestStep contains NaN or Infinite", _state); - ae_assert(ae_fp_greater_eq(teststep,0), "MinLMSetGradientCheck: invalid argument TestStep(TestStep<0)", _state); - state->teststep = teststep; -} - - -/************************************************************************* -Prepare internal structures (except for RComm). - -Note: M must be zero for FGH mode, non-zero for V/VJ/FJ/FGJ mode. -*************************************************************************/ -static void minlm_lmprepare(ae_int_t n, - ae_int_t m, - ae_bool havegrad, - minlmstate* state, - ae_state *_state) -{ - ae_int_t i; - - - if( n<=0||m<0 ) - { - return; - } - if( havegrad ) - { - ae_vector_set_length(&state->g, n, _state); - } - if( m!=0 ) - { - ae_matrix_set_length(&state->j, m, n, _state); - ae_vector_set_length(&state->fi, m, _state); - ae_vector_set_length(&state->fibase, m, _state); - ae_vector_set_length(&state->deltaf, m, _state); - ae_vector_set_length(&state->fm1, m, _state); - ae_vector_set_length(&state->fp1, m, _state); - ae_vector_set_length(&state->fc1, m, _state); - ae_vector_set_length(&state->gm1, m, _state); - ae_vector_set_length(&state->gp1, m, _state); - ae_vector_set_length(&state->gc1, m, _state); - } - else - { - ae_matrix_set_length(&state->h, n, n, _state); - } - ae_vector_set_length(&state->x, n, _state); - ae_vector_set_length(&state->deltax, n, _state); - ae_matrix_set_length(&state->quadraticmodel, n, n, _state); - ae_vector_set_length(&state->xbase, n, _state); - ae_vector_set_length(&state->gbase, n, _state); - ae_vector_set_length(&state->xdir, n, _state); - ae_vector_set_length(&state->tmp0, n, _state); - - /* - * prepare internal L-BFGS - */ - for(i=0; i<=n-1; i++) - { - state->x.ptr.p_double[i] = 0; - } - minlbfgscreate(n, ae_minint(minlm_additers, n, _state), &state->x, &state->internalstate, _state); - minlbfgssetcond(&state->internalstate, 0.0, 0.0, 0.0, ae_minint(minlm_additers, n, _state), _state); - - /* - * Prepare internal QP solver - */ - minqpcreate(n, &state->qpstate, _state); - minqpsetalgocholesky(&state->qpstate, _state); - - /* - * Prepare boundary constraints - */ - ae_vector_set_length(&state->bndl, n, _state); - ae_vector_set_length(&state->bndu, n, _state); - ae_vector_set_length(&state->havebndl, n, _state); - ae_vector_set_length(&state->havebndu, n, _state); - for(i=0; i<=n-1; i++) - { - state->bndl.ptr.p_double[i] = _state->v_neginf; - state->havebndl.ptr.p_bool[i] = ae_false; - state->bndu.ptr.p_double[i] = _state->v_posinf; - state->havebndu.ptr.p_bool[i] = ae_false; - } - - /* - * Prepare scaling matrix - */ - ae_vector_set_length(&state->s, n, _state); - for(i=0; i<=n-1; i++) - { - state->s.ptr.p_double[i] = 1.0; - } -} - - -/************************************************************************* -Clears request fileds (to be sure that we don't forgot to clear something) -*************************************************************************/ -static void minlm_clearrequestfields(minlmstate* state, ae_state *_state) -{ - - - state->needf = ae_false; - state->needfg = ae_false; - state->needfgh = ae_false; - state->needfij = ae_false; - state->needfi = ae_false; - state->xupdated = ae_false; -} - - -/************************************************************************* -Increases lambda, returns False when there is a danger of overflow -*************************************************************************/ -static ae_bool minlm_increaselambda(double* lambdav, - double* nu, - ae_state *_state) -{ - double lnlambda; - double lnnu; - double lnlambdaup; - double lnmax; - ae_bool result; - - - result = ae_false; - lnlambda = ae_log(*lambdav, _state); - lnlambdaup = ae_log(minlm_lambdaup, _state); - lnnu = ae_log(*nu, _state); - lnmax = ae_log(ae_maxrealnumber, _state); - if( ae_fp_greater(lnlambda+lnlambdaup+lnnu,0.25*lnmax) ) - { - return result; - } - if( ae_fp_greater(lnnu+ae_log(2, _state),lnmax) ) - { - return result; - } - *lambdav = *lambdav*minlm_lambdaup*(*nu); - *nu = *nu*2; - result = ae_true; - return result; -} - - -/************************************************************************* -Decreases lambda, but leaves it unchanged when there is danger of underflow. -*************************************************************************/ -static void minlm_decreaselambda(double* lambdav, - double* nu, - ae_state *_state) -{ - - - *nu = 1; - if( ae_fp_less(ae_log(*lambdav, _state)+ae_log(minlm_lambdadown, _state),ae_log(ae_minrealnumber, _state)) ) - { - *lambdav = ae_minrealnumber; - } - else - { - *lambdav = *lambdav*minlm_lambdadown; - } -} - - -/************************************************************************* -Returns norm of bounded scaled anti-gradient. - -Bounded antigradient is a vector obtained from anti-gradient by zeroing -components which point outwards: - result = norm(v) - v[i]=0 if ((-g[i]<0)and(x[i]=bndl[i])) or - ((-g[i]>0)and(x[i]=bndu[i])) - v[i]=-g[i]*s[i] otherwise, where s[i] is a scale for I-th variable - -This function may be used to check a stopping criterion. - - -- ALGLIB -- - Copyright 14.01.2011 by Bochkanov Sergey -*************************************************************************/ -static double minlm_boundedscaledantigradnorm(minlmstate* state, - /* Real */ ae_vector* x, - /* Real */ ae_vector* g, - ae_state *_state) -{ - ae_int_t n; - ae_int_t i; - double v; - double result; - - - result = 0; - n = state->n; - for(i=0; i<=n-1; i++) - { - v = -g->ptr.p_double[i]*state->s.ptr.p_double[i]; - if( state->havebndl.ptr.p_bool[i] ) - { - if( ae_fp_less_eq(x->ptr.p_double[i],state->bndl.ptr.p_double[i])&&ae_fp_less(-g->ptr.p_double[i],0) ) - { - v = 0; - } - } - if( state->havebndu.ptr.p_bool[i] ) - { - if( ae_fp_greater_eq(x->ptr.p_double[i],state->bndu.ptr.p_double[i])&&ae_fp_greater(-g->ptr.p_double[i],0) ) - { - v = 0; - } - } - result = result+ae_sqr(v, _state); - } - result = ae_sqrt(result, _state); - return result; -} - - -ae_bool _minlmstate_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - minlmstate *p = (minlmstate*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->fi, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->j, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->h, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->g, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->xbase, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->fibase, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->gbase, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->quadraticmodel, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->bndl, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->bndu, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->havebndl, 0, DT_BOOL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->havebndu, 0, DT_BOOL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->s, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->xdir, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->deltax, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->deltaf, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->choleskybuf, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->tmp0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->fm1, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->fp1, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->fc1, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->gm1, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->gp1, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->gc1, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !_minlbfgsstate_init(&p->internalstate, _state, make_automatic) ) - return ae_false; - if( !_minlbfgsreport_init(&p->internalrep, _state, make_automatic) ) - return ae_false; - if( !_minqpstate_init(&p->qpstate, _state, make_automatic) ) - return ae_false; - if( !_minqpreport_init(&p->qprep, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _minlmstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - minlmstate *dst = (minlmstate*)_dst; - minlmstate *src = (minlmstate*)_src; - dst->n = src->n; - dst->m = src->m; - dst->diffstep = src->diffstep; - dst->epsg = src->epsg; - dst->epsf = src->epsf; - dst->epsx = src->epsx; - dst->maxits = src->maxits; - dst->xrep = src->xrep; - dst->stpmax = src->stpmax; - dst->maxmodelage = src->maxmodelage; - dst->makeadditers = src->makeadditers; - if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) - return ae_false; - dst->f = src->f; - if( !ae_vector_init_copy(&dst->fi, &src->fi, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->j, &src->j, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->h, &src->h, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->g, &src->g, _state, make_automatic) ) - return ae_false; - dst->needf = src->needf; - dst->needfg = src->needfg; - dst->needfgh = src->needfgh; - dst->needfij = src->needfij; - dst->needfi = src->needfi; - dst->xupdated = src->xupdated; - dst->algomode = src->algomode; - dst->hasf = src->hasf; - dst->hasfi = src->hasfi; - dst->hasg = src->hasg; - if( !ae_vector_init_copy(&dst->xbase, &src->xbase, _state, make_automatic) ) - return ae_false; - dst->fbase = src->fbase; - if( !ae_vector_init_copy(&dst->fibase, &src->fibase, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->gbase, &src->gbase, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->quadraticmodel, &src->quadraticmodel, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->bndl, &src->bndl, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->bndu, &src->bndu, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->havebndl, &src->havebndl, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->havebndu, &src->havebndu, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->s, &src->s, _state, make_automatic) ) - return ae_false; - dst->lambdav = src->lambdav; - dst->nu = src->nu; - dst->modelage = src->modelage; - if( !ae_vector_init_copy(&dst->xdir, &src->xdir, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->deltax, &src->deltax, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->deltaf, &src->deltaf, _state, make_automatic) ) - return ae_false; - dst->deltaxready = src->deltaxready; - dst->deltafready = src->deltafready; - dst->teststep = src->teststep; - dst->repiterationscount = src->repiterationscount; - dst->repterminationtype = src->repterminationtype; - dst->repfuncidx = src->repfuncidx; - dst->repvaridx = src->repvaridx; - dst->repnfunc = src->repnfunc; - dst->repnjac = src->repnjac; - dst->repngrad = src->repngrad; - dst->repnhess = src->repnhess; - dst->repncholesky = src->repncholesky; - if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->choleskybuf, &src->choleskybuf, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->tmp0, &src->tmp0, _state, make_automatic) ) - return ae_false; - dst->actualdecrease = src->actualdecrease; - dst->predicteddecrease = src->predicteddecrease; - dst->xm1 = src->xm1; - dst->xp1 = src->xp1; - if( !ae_vector_init_copy(&dst->fm1, &src->fm1, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->fp1, &src->fp1, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->fc1, &src->fc1, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->gm1, &src->gm1, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->gp1, &src->gp1, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->gc1, &src->gc1, _state, make_automatic) ) - return ae_false; - if( !_minlbfgsstate_init_copy(&dst->internalstate, &src->internalstate, _state, make_automatic) ) - return ae_false; - if( !_minlbfgsreport_init_copy(&dst->internalrep, &src->internalrep, _state, make_automatic) ) - return ae_false; - if( !_minqpstate_init_copy(&dst->qpstate, &src->qpstate, _state, make_automatic) ) - return ae_false; - if( !_minqpreport_init_copy(&dst->qprep, &src->qprep, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _minlmstate_clear(void* _p) -{ - minlmstate *p = (minlmstate*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->x); - ae_vector_clear(&p->fi); - ae_matrix_clear(&p->j); - ae_matrix_clear(&p->h); - ae_vector_clear(&p->g); - ae_vector_clear(&p->xbase); - ae_vector_clear(&p->fibase); - ae_vector_clear(&p->gbase); - ae_matrix_clear(&p->quadraticmodel); - ae_vector_clear(&p->bndl); - ae_vector_clear(&p->bndu); - ae_vector_clear(&p->havebndl); - ae_vector_clear(&p->havebndu); - ae_vector_clear(&p->s); - ae_vector_clear(&p->xdir); - ae_vector_clear(&p->deltax); - ae_vector_clear(&p->deltaf); - _rcommstate_clear(&p->rstate); - ae_vector_clear(&p->choleskybuf); - ae_vector_clear(&p->tmp0); - ae_vector_clear(&p->fm1); - ae_vector_clear(&p->fp1); - ae_vector_clear(&p->fc1); - ae_vector_clear(&p->gm1); - ae_vector_clear(&p->gp1); - ae_vector_clear(&p->gc1); - _minlbfgsstate_clear(&p->internalstate); - _minlbfgsreport_clear(&p->internalrep); - _minqpstate_clear(&p->qpstate); - _minqpreport_clear(&p->qprep); -} - - -void _minlmstate_destroy(void* _p) -{ - minlmstate *p = (minlmstate*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->x); - ae_vector_destroy(&p->fi); - ae_matrix_destroy(&p->j); - ae_matrix_destroy(&p->h); - ae_vector_destroy(&p->g); - ae_vector_destroy(&p->xbase); - ae_vector_destroy(&p->fibase); - ae_vector_destroy(&p->gbase); - ae_matrix_destroy(&p->quadraticmodel); - ae_vector_destroy(&p->bndl); - ae_vector_destroy(&p->bndu); - ae_vector_destroy(&p->havebndl); - ae_vector_destroy(&p->havebndu); - ae_vector_destroy(&p->s); - ae_vector_destroy(&p->xdir); - ae_vector_destroy(&p->deltax); - ae_vector_destroy(&p->deltaf); - _rcommstate_destroy(&p->rstate); - ae_vector_destroy(&p->choleskybuf); - ae_vector_destroy(&p->tmp0); - ae_vector_destroy(&p->fm1); - ae_vector_destroy(&p->fp1); - ae_vector_destroy(&p->fc1); - ae_vector_destroy(&p->gm1); - ae_vector_destroy(&p->gp1); - ae_vector_destroy(&p->gc1); - _minlbfgsstate_destroy(&p->internalstate); - _minlbfgsreport_destroy(&p->internalrep); - _minqpstate_destroy(&p->qpstate); - _minqpreport_destroy(&p->qprep); -} - - -ae_bool _minlmreport_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - minlmreport *p = (minlmreport*)_p; - ae_touch_ptr((void*)p); - return ae_true; -} - - -ae_bool _minlmreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - minlmreport *dst = (minlmreport*)_dst; - minlmreport *src = (minlmreport*)_src; - dst->iterationscount = src->iterationscount; - dst->terminationtype = src->terminationtype; - dst->funcidx = src->funcidx; - dst->varidx = src->varidx; - dst->nfunc = src->nfunc; - dst->njac = src->njac; - dst->ngrad = src->ngrad; - dst->nhess = src->nhess; - dst->ncholesky = src->ncholesky; - return ae_true; -} - - -void _minlmreport_clear(void* _p) -{ - minlmreport *p = (minlmreport*)_p; - ae_touch_ptr((void*)p); -} - - -void _minlmreport_destroy(void* _p) -{ - minlmreport *p = (minlmreport*)_p; - ae_touch_ptr((void*)p); -} - - - - -/************************************************************************* -Obsolete function, use MinLBFGSSetPrecDefault() instead. - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetdefaultpreconditioner(minlbfgsstate* state, - ae_state *_state) -{ - - - minlbfgssetprecdefault(state, _state); -} - - -/************************************************************************* -Obsolete function, use MinLBFGSSetCholeskyPreconditioner() instead. - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetcholeskypreconditioner(minlbfgsstate* state, - /* Real */ ae_matrix* p, - ae_bool isupper, - ae_state *_state) -{ - - - minlbfgssetpreccholesky(state, p, isupper, _state); -} - - -/************************************************************************* -This is obsolete function which was used by previous version of the BLEIC -optimizer. It does nothing in the current version of BLEIC. - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetbarrierwidth(minbleicstate* state, - double mu, - ae_state *_state) -{ - - -} - - -/************************************************************************* -This is obsolete function which was used by previous version of the BLEIC -optimizer. It does nothing in the current version of BLEIC. - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetbarrierdecay(minbleicstate* state, - double mudecay, - ae_state *_state) -{ - - -} - - -/************************************************************************* -Obsolete optimization algorithm. -Was replaced by MinBLEIC subpackage. - - -- ALGLIB -- - Copyright 25.03.2010 by Bochkanov Sergey -*************************************************************************/ -void minasacreate(ae_int_t n, - /* Real */ ae_vector* x, - /* Real */ ae_vector* bndl, - /* Real */ ae_vector* bndu, - minasastate* state, - ae_state *_state) -{ - ae_int_t i; - - _minasastate_clear(state); - - ae_assert(n>=1, "MinASA: N too small!", _state); - ae_assert(x->cnt>=n, "MinCGCreate: Length(X)cnt>=n, "MinCGCreate: Length(BndL)cnt>=n, "MinCGCreate: Length(BndU)ptr.p_double[i],bndu->ptr.p_double[i]), "MinASA: inconsistent bounds!", _state); - ae_assert(ae_fp_less_eq(bndl->ptr.p_double[i],x->ptr.p_double[i]), "MinASA: infeasible X!", _state); - ae_assert(ae_fp_less_eq(x->ptr.p_double[i],bndu->ptr.p_double[i]), "MinASA: infeasible X!", _state); - } - - /* - * Initialize - */ - state->n = n; - minasasetcond(state, 0, 0, 0, 0, _state); - minasasetxrep(state, ae_false, _state); - minasasetstpmax(state, 0, _state); - minasasetalgorithm(state, -1, _state); - ae_vector_set_length(&state->bndl, n, _state); - ae_vector_set_length(&state->bndu, n, _state); - ae_vector_set_length(&state->ak, n, _state); - ae_vector_set_length(&state->xk, n, _state); - ae_vector_set_length(&state->dk, n, _state); - ae_vector_set_length(&state->an, n, _state); - ae_vector_set_length(&state->xn, n, _state); - ae_vector_set_length(&state->dn, n, _state); - ae_vector_set_length(&state->x, n, _state); - ae_vector_set_length(&state->d, n, _state); - ae_vector_set_length(&state->g, n, _state); - ae_vector_set_length(&state->gc, n, _state); - ae_vector_set_length(&state->work, n, _state); - ae_vector_set_length(&state->yk, n, _state); - minasarestartfrom(state, x, bndl, bndu, _state); -} - - -/************************************************************************* -Obsolete optimization algorithm. -Was replaced by MinBLEIC subpackage. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minasasetcond(minasastate* state, - double epsg, - double epsf, - double epsx, - ae_int_t maxits, - ae_state *_state) -{ - - - ae_assert(ae_isfinite(epsg, _state), "MinASASetCond: EpsG is not finite number!", _state); - ae_assert(ae_fp_greater_eq(epsg,0), "MinASASetCond: negative EpsG!", _state); - ae_assert(ae_isfinite(epsf, _state), "MinASASetCond: EpsF is not finite number!", _state); - ae_assert(ae_fp_greater_eq(epsf,0), "MinASASetCond: negative EpsF!", _state); - ae_assert(ae_isfinite(epsx, _state), "MinASASetCond: EpsX is not finite number!", _state); - ae_assert(ae_fp_greater_eq(epsx,0), "MinASASetCond: negative EpsX!", _state); - ae_assert(maxits>=0, "MinASASetCond: negative MaxIts!", _state); - if( ((ae_fp_eq(epsg,0)&&ae_fp_eq(epsf,0))&&ae_fp_eq(epsx,0))&&maxits==0 ) - { - epsx = 1.0E-6; - } - state->epsg = epsg; - state->epsf = epsf; - state->epsx = epsx; - state->maxits = maxits; -} - - -/************************************************************************* -Obsolete optimization algorithm. -Was replaced by MinBLEIC subpackage. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minasasetxrep(minasastate* state, ae_bool needxrep, ae_state *_state) -{ - - - state->xrep = needxrep; -} - - -/************************************************************************* -Obsolete optimization algorithm. -Was replaced by MinBLEIC subpackage. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minasasetalgorithm(minasastate* state, - ae_int_t algotype, - ae_state *_state) -{ - - - ae_assert(algotype>=-1&&algotype<=1, "MinASASetAlgorithm: incorrect AlgoType!", _state); - if( algotype==-1 ) - { - algotype = 1; - } - state->cgtype = algotype; -} - - -/************************************************************************* -Obsolete optimization algorithm. -Was replaced by MinBLEIC subpackage. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minasasetstpmax(minasastate* state, double stpmax, ae_state *_state) -{ - - - ae_assert(ae_isfinite(stpmax, _state), "MinASASetStpMax: StpMax is not finite!", _state); - ae_assert(ae_fp_greater_eq(stpmax,0), "MinASASetStpMax: StpMax<0!", _state); - state->stpmax = stpmax; -} - - -/************************************************************************* - - -- ALGLIB -- - Copyright 20.03.2009 by Bochkanov Sergey -*************************************************************************/ -ae_bool minasaiteration(minasastate* state, ae_state *_state) -{ - ae_int_t n; - ae_int_t i; - double betak; - double v; - double vv; - ae_int_t mcinfo; - ae_bool b; - ae_bool stepfound; - ae_int_t diffcnt; - ae_bool result; - - - - /* - * Reverse communication preparations - * I know it looks ugly, but it works the same way - * anywhere from C++ to Python. - * - * This code initializes locals by: - * * random values determined during code - * generation - on first subroutine call - * * values from previous call - on subsequent calls - */ - if( state->rstate.stage>=0 ) - { - n = state->rstate.ia.ptr.p_int[0]; - i = state->rstate.ia.ptr.p_int[1]; - mcinfo = state->rstate.ia.ptr.p_int[2]; - diffcnt = state->rstate.ia.ptr.p_int[3]; - b = state->rstate.ba.ptr.p_bool[0]; - stepfound = state->rstate.ba.ptr.p_bool[1]; - betak = state->rstate.ra.ptr.p_double[0]; - v = state->rstate.ra.ptr.p_double[1]; - vv = state->rstate.ra.ptr.p_double[2]; - } - else - { - n = -983; - i = -989; - mcinfo = -834; - diffcnt = 900; - b = ae_true; - stepfound = ae_false; - betak = 214; - v = -338; - vv = -686; - } - if( state->rstate.stage==0 ) - { - goto lbl_0; - } - if( state->rstate.stage==1 ) - { - goto lbl_1; - } - if( state->rstate.stage==2 ) - { - goto lbl_2; - } - if( state->rstate.stage==3 ) - { - goto lbl_3; - } - if( state->rstate.stage==4 ) - { - goto lbl_4; - } - if( state->rstate.stage==5 ) - { - goto lbl_5; - } - if( state->rstate.stage==6 ) - { - goto lbl_6; - } - if( state->rstate.stage==7 ) - { - goto lbl_7; - } - if( state->rstate.stage==8 ) - { - goto lbl_8; - } - if( state->rstate.stage==9 ) - { - goto lbl_9; - } - if( state->rstate.stage==10 ) - { - goto lbl_10; - } - if( state->rstate.stage==11 ) - { - goto lbl_11; - } - if( state->rstate.stage==12 ) - { - goto lbl_12; - } - if( state->rstate.stage==13 ) - { - goto lbl_13; - } - if( state->rstate.stage==14 ) - { - goto lbl_14; - } - - /* - * Routine body - */ - - /* - * Prepare - */ - n = state->n; - state->repterminationtype = 0; - state->repiterationscount = 0; - state->repnfev = 0; - state->debugrestartscount = 0; - state->cgtype = 1; - ae_v_move(&state->xk.ptr.p_double[0], 1, &state->x.ptr.p_double[0], 1, ae_v_len(0,n-1)); - for(i=0; i<=n-1; i++) - { - if( ae_fp_eq(state->xk.ptr.p_double[i],state->bndl.ptr.p_double[i])||ae_fp_eq(state->xk.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) - { - state->ak.ptr.p_double[i] = 0; - } - else - { - state->ak.ptr.p_double[i] = 1; - } - } - state->mu = 0.1; - state->curalgo = 0; - - /* - * Calculate F/G, initialize algorithm - */ - mincomp_clearrequestfields(state, _state); - state->needfg = ae_true; - state->rstate.stage = 0; - goto lbl_rcomm; -lbl_0: - state->needfg = ae_false; - if( !state->xrep ) - { - goto lbl_15; - } - - /* - * progress report - */ - mincomp_clearrequestfields(state, _state); - state->xupdated = ae_true; - state->rstate.stage = 1; - goto lbl_rcomm; -lbl_1: - state->xupdated = ae_false; -lbl_15: - if( ae_fp_less_eq(mincomp_asaboundedantigradnorm(state, _state),state->epsg) ) - { - state->repterminationtype = 4; - result = ae_false; - return result; - } - state->repnfev = state->repnfev+1; - - /* - * Main cycle - * - * At the beginning of new iteration: - * * CurAlgo stores current algorithm selector - * * State.XK, State.F and State.G store current X/F/G - * * State.AK stores current set of active constraints - */ -lbl_17: - if( ae_false ) - { - goto lbl_18; - } - - /* - * GPA algorithm - */ - if( state->curalgo!=0 ) - { - goto lbl_19; - } - state->k = 0; - state->acount = 0; -lbl_21: - if( ae_false ) - { - goto lbl_22; - } - - /* - * Determine Dk = proj(xk - gk)-xk - */ - for(i=0; i<=n-1; i++) - { - state->d.ptr.p_double[i] = boundval(state->xk.ptr.p_double[i]-state->g.ptr.p_double[i], state->bndl.ptr.p_double[i], state->bndu.ptr.p_double[i], _state)-state->xk.ptr.p_double[i]; - } - - /* - * Armijo line search. - * * exact search with alpha=1 is tried first, - * 'exact' means that we evaluate f() EXACTLY at - * bound(x-g,bndl,bndu), without intermediate floating - * point operations. - * * alpha<1 are tried if explicit search wasn't successful - * Result is placed into XN. - * - * Two types of search are needed because we can't - * just use second type with alpha=1 because in finite - * precision arithmetics (x1-x0)+x0 may differ from x1. - * So while x1 is correctly bounded (it lie EXACTLY on - * boundary, if it is active), (x1-x0)+x0 may be - * not bounded. - */ - v = ae_v_dotproduct(&state->d.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->dginit = v; - state->finit = state->f; - if( !(ae_fp_less_eq(mincomp_asad1norm(state, _state),state->stpmax)||ae_fp_eq(state->stpmax,0)) ) - { - goto lbl_23; - } - - /* - * Try alpha=1 step first - */ - for(i=0; i<=n-1; i++) - { - state->x.ptr.p_double[i] = boundval(state->xk.ptr.p_double[i]-state->g.ptr.p_double[i], state->bndl.ptr.p_double[i], state->bndu.ptr.p_double[i], _state); - } - mincomp_clearrequestfields(state, _state); - state->needfg = ae_true; - state->rstate.stage = 2; - goto lbl_rcomm; -lbl_2: - state->needfg = ae_false; - state->repnfev = state->repnfev+1; - stepfound = ae_fp_less_eq(state->f,state->finit+mincomp_gpaftol*state->dginit); - goto lbl_24; -lbl_23: - stepfound = ae_false; -lbl_24: - if( !stepfound ) - { - goto lbl_25; - } - - /* - * we are at the boundary(ies) - */ - ae_v_move(&state->xn.ptr.p_double[0], 1, &state->x.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->stp = 1; - goto lbl_26; -lbl_25: - - /* - * alpha=1 is too large, try smaller values - */ - state->stp = 1; - linminnormalized(&state->d, &state->stp, n, _state); - state->dginit = state->dginit/state->stp; - state->stp = mincomp_gpadecay*state->stp; - if( ae_fp_greater(state->stpmax,0) ) - { - state->stp = ae_minreal(state->stp, state->stpmax, _state); - } -lbl_27: - if( ae_false ) - { - goto lbl_28; - } - v = state->stp; - ae_v_move(&state->x.ptr.p_double[0], 1, &state->xk.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_addd(&state->x.ptr.p_double[0], 1, &state->d.ptr.p_double[0], 1, ae_v_len(0,n-1), v); - mincomp_clearrequestfields(state, _state); - state->needfg = ae_true; - state->rstate.stage = 3; - goto lbl_rcomm; -lbl_3: - state->needfg = ae_false; - state->repnfev = state->repnfev+1; - if( ae_fp_less_eq(state->stp,mincomp_stpmin) ) - { - goto lbl_28; - } - if( ae_fp_less_eq(state->f,state->finit+state->stp*mincomp_gpaftol*state->dginit) ) - { - goto lbl_28; - } - state->stp = state->stp*mincomp_gpadecay; - goto lbl_27; -lbl_28: - ae_v_move(&state->xn.ptr.p_double[0], 1, &state->x.ptr.p_double[0], 1, ae_v_len(0,n-1)); -lbl_26: - state->repiterationscount = state->repiterationscount+1; - if( !state->xrep ) - { - goto lbl_29; - } - - /* - * progress report - */ - mincomp_clearrequestfields(state, _state); - state->xupdated = ae_true; - state->rstate.stage = 4; - goto lbl_rcomm; -lbl_4: - state->xupdated = ae_false; -lbl_29: - - /* - * Calculate new set of active constraints. - * Reset counter if active set was changed. - * Prepare for the new iteration - */ - for(i=0; i<=n-1; i++) - { - if( ae_fp_eq(state->xn.ptr.p_double[i],state->bndl.ptr.p_double[i])||ae_fp_eq(state->xn.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) - { - state->an.ptr.p_double[i] = 0; - } - else - { - state->an.ptr.p_double[i] = 1; - } - } - for(i=0; i<=n-1; i++) - { - if( ae_fp_neq(state->ak.ptr.p_double[i],state->an.ptr.p_double[i]) ) - { - state->acount = -1; - break; - } - } - state->acount = state->acount+1; - ae_v_move(&state->xk.ptr.p_double[0], 1, &state->xn.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_move(&state->ak.ptr.p_double[0], 1, &state->an.ptr.p_double[0], 1, ae_v_len(0,n-1)); - - /* - * Stopping conditions - */ - if( !(state->repiterationscount>=state->maxits&&state->maxits>0) ) - { - goto lbl_31; - } - - /* - * Too many iterations - */ - state->repterminationtype = 5; - if( !state->xrep ) - { - goto lbl_33; - } - mincomp_clearrequestfields(state, _state); - state->xupdated = ae_true; - state->rstate.stage = 5; - goto lbl_rcomm; -lbl_5: - state->xupdated = ae_false; -lbl_33: - result = ae_false; - return result; -lbl_31: - if( ae_fp_greater(mincomp_asaboundedantigradnorm(state, _state),state->epsg) ) - { - goto lbl_35; - } - - /* - * Gradient is small enough - */ - state->repterminationtype = 4; - if( !state->xrep ) - { - goto lbl_37; - } - mincomp_clearrequestfields(state, _state); - state->xupdated = ae_true; - state->rstate.stage = 6; - goto lbl_rcomm; -lbl_6: - state->xupdated = ae_false; -lbl_37: - result = ae_false; - return result; -lbl_35: - v = ae_v_dotproduct(&state->d.ptr.p_double[0], 1, &state->d.ptr.p_double[0], 1, ae_v_len(0,n-1)); - if( ae_fp_greater(ae_sqrt(v, _state)*state->stp,state->epsx) ) - { - goto lbl_39; - } - - /* - * Step size is too small, no further improvement is - * possible - */ - state->repterminationtype = 2; - if( !state->xrep ) - { - goto lbl_41; - } - mincomp_clearrequestfields(state, _state); - state->xupdated = ae_true; - state->rstate.stage = 7; - goto lbl_rcomm; -lbl_7: - state->xupdated = ae_false; -lbl_41: - result = ae_false; - return result; -lbl_39: - if( ae_fp_greater(state->finit-state->f,state->epsf*ae_maxreal(ae_fabs(state->finit, _state), ae_maxreal(ae_fabs(state->f, _state), 1.0, _state), _state)) ) - { - goto lbl_43; - } - - /* - * F(k+1)-F(k) is small enough - */ - state->repterminationtype = 1; - if( !state->xrep ) - { - goto lbl_45; - } - mincomp_clearrequestfields(state, _state); - state->xupdated = ae_true; - state->rstate.stage = 8; - goto lbl_rcomm; -lbl_8: - state->xupdated = ae_false; -lbl_45: - result = ae_false; - return result; -lbl_43: - - /* - * Decide - should we switch algorithm or not - */ - if( mincomp_asauisempty(state, _state) ) - { - if( ae_fp_greater_eq(mincomp_asaginorm(state, _state),state->mu*mincomp_asad1norm(state, _state)) ) - { - state->curalgo = 1; - goto lbl_22; - } - else - { - state->mu = state->mu*mincomp_asarho; - } - } - else - { - if( state->acount==mincomp_n1 ) - { - if( ae_fp_greater_eq(mincomp_asaginorm(state, _state),state->mu*mincomp_asad1norm(state, _state)) ) - { - state->curalgo = 1; - goto lbl_22; - } - } - } - - /* - * Next iteration - */ - state->k = state->k+1; - goto lbl_21; -lbl_22: -lbl_19: - - /* - * CG algorithm - */ - if( state->curalgo!=1 ) - { - goto lbl_47; - } - - /* - * first, check that there are non-active constraints. - * move to GPA algorithm, if all constraints are active - */ - b = ae_true; - for(i=0; i<=n-1; i++) - { - if( ae_fp_neq(state->ak.ptr.p_double[i],0) ) - { - b = ae_false; - break; - } - } - if( b ) - { - state->curalgo = 0; - goto lbl_17; - } - - /* - * CG iterations - */ - state->fold = state->f; - ae_v_move(&state->xk.ptr.p_double[0], 1, &state->x.ptr.p_double[0], 1, ae_v_len(0,n-1)); - for(i=0; i<=n-1; i++) - { - state->dk.ptr.p_double[i] = -state->g.ptr.p_double[i]*state->ak.ptr.p_double[i]; - state->gc.ptr.p_double[i] = state->g.ptr.p_double[i]*state->ak.ptr.p_double[i]; - } -lbl_49: - if( ae_false ) - { - goto lbl_50; - } - - /* - * Store G[k] for later calculation of Y[k] - */ - for(i=0; i<=n-1; i++) - { - state->yk.ptr.p_double[i] = -state->gc.ptr.p_double[i]; - } - - /* - * Make a CG step in direction given by DK[]: - * * calculate step. Step projection into feasible set - * is used. It has several benefits: a) step may be - * found with usual line search, b) multiple constraints - * may be activated with one step, c) activated constraints - * are detected in a natural way - just compare x[i] with - * bounds - * * update active set, set B to True, if there - * were changes in the set. - */ - ae_v_move(&state->d.ptr.p_double[0], 1, &state->dk.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_move(&state->xn.ptr.p_double[0], 1, &state->xk.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->mcstage = 0; - state->stp = 1; - linminnormalized(&state->d, &state->stp, n, _state); - if( ae_fp_neq(state->laststep,0) ) - { - state->stp = state->laststep; - } - mcsrch(n, &state->xn, &state->f, &state->gc, &state->d, &state->stp, state->stpmax, mincomp_gtol, &mcinfo, &state->nfev, &state->work, &state->lstate, &state->mcstage, _state); -lbl_51: - if( state->mcstage==0 ) - { - goto lbl_52; - } - - /* - * preprocess data: bound State.XN so it belongs to the - * feasible set and store it in the State.X - */ - for(i=0; i<=n-1; i++) - { - state->x.ptr.p_double[i] = boundval(state->xn.ptr.p_double[i], state->bndl.ptr.p_double[i], state->bndu.ptr.p_double[i], _state); - } - - /* - * RComm - */ - mincomp_clearrequestfields(state, _state); - state->needfg = ae_true; - state->rstate.stage = 9; - goto lbl_rcomm; -lbl_9: - state->needfg = ae_false; - - /* - * postprocess data: zero components of G corresponding to - * the active constraints - */ - for(i=0; i<=n-1; i++) - { - if( ae_fp_eq(state->x.ptr.p_double[i],state->bndl.ptr.p_double[i])||ae_fp_eq(state->x.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) - { - state->gc.ptr.p_double[i] = 0; - } - else - { - state->gc.ptr.p_double[i] = state->g.ptr.p_double[i]; - } - } - mcsrch(n, &state->xn, &state->f, &state->gc, &state->d, &state->stp, state->stpmax, mincomp_gtol, &mcinfo, &state->nfev, &state->work, &state->lstate, &state->mcstage, _state); - goto lbl_51; -lbl_52: - diffcnt = 0; - for(i=0; i<=n-1; i++) - { - - /* - * XN contains unprojected result, project it, - * save copy to X (will be used for progress reporting) - */ - state->xn.ptr.p_double[i] = boundval(state->xn.ptr.p_double[i], state->bndl.ptr.p_double[i], state->bndu.ptr.p_double[i], _state); - - /* - * update active set - */ - if( ae_fp_eq(state->xn.ptr.p_double[i],state->bndl.ptr.p_double[i])||ae_fp_eq(state->xn.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) - { - state->an.ptr.p_double[i] = 0; - } - else - { - state->an.ptr.p_double[i] = 1; - } - if( ae_fp_neq(state->an.ptr.p_double[i],state->ak.ptr.p_double[i]) ) - { - diffcnt = diffcnt+1; - } - state->ak.ptr.p_double[i] = state->an.ptr.p_double[i]; - } - ae_v_move(&state->xk.ptr.p_double[0], 1, &state->xn.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->repnfev = state->repnfev+state->nfev; - state->repiterationscount = state->repiterationscount+1; - if( !state->xrep ) - { - goto lbl_53; - } - - /* - * progress report - */ - mincomp_clearrequestfields(state, _state); - state->xupdated = ae_true; - state->rstate.stage = 10; - goto lbl_rcomm; -lbl_10: - state->xupdated = ae_false; -lbl_53: - - /* - * Update info about step length - */ - v = ae_v_dotproduct(&state->d.ptr.p_double[0], 1, &state->d.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->laststep = ae_sqrt(v, _state)*state->stp; - - /* - * Check stopping conditions. - */ - if( ae_fp_greater(mincomp_asaboundedantigradnorm(state, _state),state->epsg) ) - { - goto lbl_55; - } - - /* - * Gradient is small enough - */ - state->repterminationtype = 4; - if( !state->xrep ) - { - goto lbl_57; - } - mincomp_clearrequestfields(state, _state); - state->xupdated = ae_true; - state->rstate.stage = 11; - goto lbl_rcomm; -lbl_11: - state->xupdated = ae_false; -lbl_57: - result = ae_false; - return result; -lbl_55: - if( !(state->repiterationscount>=state->maxits&&state->maxits>0) ) - { - goto lbl_59; - } - - /* - * Too many iterations - */ - state->repterminationtype = 5; - if( !state->xrep ) - { - goto lbl_61; - } - mincomp_clearrequestfields(state, _state); - state->xupdated = ae_true; - state->rstate.stage = 12; - goto lbl_rcomm; -lbl_12: - state->xupdated = ae_false; -lbl_61: - result = ae_false; - return result; -lbl_59: - if( !(ae_fp_greater_eq(mincomp_asaginorm(state, _state),state->mu*mincomp_asad1norm(state, _state))&&diffcnt==0) ) - { - goto lbl_63; - } - - /* - * These conditions (EpsF/EpsX) are explicitly or implicitly - * related to the current step size and influenced - * by changes in the active constraints. - * - * For these reasons they are checked only when we don't - * want to 'unstick' at the end of the iteration and there - * were no changes in the active set. - * - * NOTE: consition |G|>=Mu*|D1| must be exactly opposite - * to the condition used to switch back to GPA. At least - * one inequality must be strict, otherwise infinite cycle - * may occur when |G|=Mu*|D1| (we DON'T test stopping - * conditions and we DON'T switch to GPA, so we cycle - * indefinitely). - */ - if( ae_fp_greater(state->fold-state->f,state->epsf*ae_maxreal(ae_fabs(state->fold, _state), ae_maxreal(ae_fabs(state->f, _state), 1.0, _state), _state)) ) - { - goto lbl_65; - } - - /* - * F(k+1)-F(k) is small enough - */ - state->repterminationtype = 1; - if( !state->xrep ) - { - goto lbl_67; - } - mincomp_clearrequestfields(state, _state); - state->xupdated = ae_true; - state->rstate.stage = 13; - goto lbl_rcomm; -lbl_13: - state->xupdated = ae_false; -lbl_67: - result = ae_false; - return result; -lbl_65: - if( ae_fp_greater(state->laststep,state->epsx) ) - { - goto lbl_69; - } - - /* - * X(k+1)-X(k) is small enough - */ - state->repterminationtype = 2; - if( !state->xrep ) - { - goto lbl_71; - } - mincomp_clearrequestfields(state, _state); - state->xupdated = ae_true; - state->rstate.stage = 14; - goto lbl_rcomm; -lbl_14: - state->xupdated = ae_false; -lbl_71: - result = ae_false; - return result; -lbl_69: -lbl_63: - - /* - * Check conditions for switching - */ - if( ae_fp_less(mincomp_asaginorm(state, _state),state->mu*mincomp_asad1norm(state, _state)) ) - { - state->curalgo = 0; - goto lbl_50; - } - if( diffcnt>0 ) - { - if( mincomp_asauisempty(state, _state)||diffcnt>=mincomp_n2 ) - { - state->curalgo = 1; - } - else - { - state->curalgo = 0; - } - goto lbl_50; - } - - /* - * Calculate D(k+1) - * - * Line search may result in: - * * maximum feasible step being taken (already processed) - * * point satisfying Wolfe conditions - * * some kind of error (CG is restarted by assigning 0.0 to Beta) - */ - if( mcinfo==1 ) - { - - /* - * Standard Wolfe conditions are satisfied: - * * calculate Y[K] and BetaK - */ - ae_v_add(&state->yk.ptr.p_double[0], 1, &state->gc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - vv = ae_v_dotproduct(&state->yk.ptr.p_double[0], 1, &state->dk.ptr.p_double[0], 1, ae_v_len(0,n-1)); - v = ae_v_dotproduct(&state->gc.ptr.p_double[0], 1, &state->gc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->betady = v/vv; - v = ae_v_dotproduct(&state->gc.ptr.p_double[0], 1, &state->yk.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->betahs = v/vv; - if( state->cgtype==0 ) - { - betak = state->betady; - } - if( state->cgtype==1 ) - { - betak = ae_maxreal(0, ae_minreal(state->betady, state->betahs, _state), _state); - } - } - else - { - - /* - * Something is wrong (may be function is too wild or too flat). - * - * We'll set BetaK=0, which will restart CG algorithm. - * We can stop later (during normal checks) if stopping conditions are met. - */ - betak = 0; - state->debugrestartscount = state->debugrestartscount+1; - } - ae_v_moveneg(&state->dn.ptr.p_double[0], 1, &state->gc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_addd(&state->dn.ptr.p_double[0], 1, &state->dk.ptr.p_double[0], 1, ae_v_len(0,n-1), betak); - ae_v_move(&state->dk.ptr.p_double[0], 1, &state->dn.ptr.p_double[0], 1, ae_v_len(0,n-1)); - - /* - * update other information - */ - state->fold = state->f; - state->k = state->k+1; - goto lbl_49; -lbl_50: -lbl_47: - goto lbl_17; -lbl_18: - result = ae_false; - return result; - - /* - * Saving state - */ -lbl_rcomm: - result = ae_true; - state->rstate.ia.ptr.p_int[0] = n; - state->rstate.ia.ptr.p_int[1] = i; - state->rstate.ia.ptr.p_int[2] = mcinfo; - state->rstate.ia.ptr.p_int[3] = diffcnt; - state->rstate.ba.ptr.p_bool[0] = b; - state->rstate.ba.ptr.p_bool[1] = stepfound; - state->rstate.ra.ptr.p_double[0] = betak; - state->rstate.ra.ptr.p_double[1] = v; - state->rstate.ra.ptr.p_double[2] = vv; - return result; -} - - -/************************************************************************* -Obsolete optimization algorithm. -Was replaced by MinBLEIC subpackage. - - -- ALGLIB -- - Copyright 20.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minasaresults(minasastate* state, - /* Real */ ae_vector* x, - minasareport* rep, - ae_state *_state) -{ - - ae_vector_clear(x); - _minasareport_clear(rep); - - minasaresultsbuf(state, x, rep, _state); -} - - -/************************************************************************* -Obsolete optimization algorithm. -Was replaced by MinBLEIC subpackage. - - -- ALGLIB -- - Copyright 20.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minasaresultsbuf(minasastate* state, - /* Real */ ae_vector* x, - minasareport* rep, - ae_state *_state) -{ - ae_int_t i; - - - if( x->cntn ) - { - ae_vector_set_length(x, state->n, _state); - } - ae_v_move(&x->ptr.p_double[0], 1, &state->x.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - rep->iterationscount = state->repiterationscount; - rep->nfev = state->repnfev; - rep->terminationtype = state->repterminationtype; - rep->activeconstraints = 0; - for(i=0; i<=state->n-1; i++) - { - if( ae_fp_eq(state->ak.ptr.p_double[i],0) ) - { - rep->activeconstraints = rep->activeconstraints+1; - } - } -} - - -/************************************************************************* -Obsolete optimization algorithm. -Was replaced by MinBLEIC subpackage. - - -- ALGLIB -- - Copyright 30.07.2010 by Bochkanov Sergey -*************************************************************************/ -void minasarestartfrom(minasastate* state, - /* Real */ ae_vector* x, - /* Real */ ae_vector* bndl, - /* Real */ ae_vector* bndu, - ae_state *_state) -{ - - - ae_assert(x->cnt>=state->n, "MinASARestartFrom: Length(X)n, _state), "MinASARestartFrom: X contains infinite or NaN values!", _state); - ae_assert(bndl->cnt>=state->n, "MinASARestartFrom: Length(BndL)n, _state), "MinASARestartFrom: BndL contains infinite or NaN values!", _state); - ae_assert(bndu->cnt>=state->n, "MinASARestartFrom: Length(BndU)n, _state), "MinASARestartFrom: BndU contains infinite or NaN values!", _state); - ae_v_move(&state->x.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - ae_v_move(&state->bndl.ptr.p_double[0], 1, &bndl->ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - ae_v_move(&state->bndu.ptr.p_double[0], 1, &bndu->ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - state->laststep = 0; - ae_vector_set_length(&state->rstate.ia, 3+1, _state); - ae_vector_set_length(&state->rstate.ba, 1+1, _state); - ae_vector_set_length(&state->rstate.ra, 2+1, _state); - state->rstate.stage = -1; - mincomp_clearrequestfields(state, _state); -} - - -/************************************************************************* -Returns norm of bounded anti-gradient. - -Bounded antigradient is a vector obtained from anti-gradient by zeroing -components which point outwards: - result = norm(v) - v[i]=0 if ((-g[i]<0)and(x[i]=bndl[i])) or - ((-g[i]>0)and(x[i]=bndu[i])) - v[i]=-g[i] otherwise - -This function may be used to check a stopping criterion. - - -- ALGLIB -- - Copyright 20.03.2009 by Bochkanov Sergey -*************************************************************************/ -static double mincomp_asaboundedantigradnorm(minasastate* state, - ae_state *_state) -{ - ae_int_t i; - double v; - double result; - - - result = 0; - for(i=0; i<=state->n-1; i++) - { - v = -state->g.ptr.p_double[i]; - if( ae_fp_eq(state->x.ptr.p_double[i],state->bndl.ptr.p_double[i])&&ae_fp_less(-state->g.ptr.p_double[i],0) ) - { - v = 0; - } - if( ae_fp_eq(state->x.ptr.p_double[i],state->bndu.ptr.p_double[i])&&ae_fp_greater(-state->g.ptr.p_double[i],0) ) - { - v = 0; - } - result = result+ae_sqr(v, _state); - } - result = ae_sqrt(result, _state); - return result; -} - - -/************************************************************************* -Returns norm of GI(x). - -GI(x) is a gradient vector whose components associated with active -constraints are zeroed. It differs from bounded anti-gradient because -components of GI(x) are zeroed independently of sign(g[i]), and -anti-gradient's components are zeroed with respect to both constraint and -sign. - - -- ALGLIB -- - Copyright 20.03.2009 by Bochkanov Sergey -*************************************************************************/ -static double mincomp_asaginorm(minasastate* state, ae_state *_state) -{ - ae_int_t i; - double result; - - - result = 0; - for(i=0; i<=state->n-1; i++) - { - if( ae_fp_neq(state->x.ptr.p_double[i],state->bndl.ptr.p_double[i])&&ae_fp_neq(state->x.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) - { - result = result+ae_sqr(state->g.ptr.p_double[i], _state); - } - } - result = ae_sqrt(result, _state); - return result; -} - - -/************************************************************************* -Returns norm(D1(State.X)) - -For a meaning of D1 see 'NEW ACTIVE SET ALGORITHM FOR BOX CONSTRAINED -OPTIMIZATION' by WILLIAM W. HAGER AND HONGCHAO ZHANG. - - -- ALGLIB -- - Copyright 20.03.2009 by Bochkanov Sergey -*************************************************************************/ -static double mincomp_asad1norm(minasastate* state, ae_state *_state) -{ - ae_int_t i; - double result; - - - result = 0; - for(i=0; i<=state->n-1; i++) - { - result = result+ae_sqr(boundval(state->x.ptr.p_double[i]-state->g.ptr.p_double[i], state->bndl.ptr.p_double[i], state->bndu.ptr.p_double[i], _state)-state->x.ptr.p_double[i], _state); - } - result = ae_sqrt(result, _state); - return result; -} - - -/************************************************************************* -Returns True, if U set is empty. - -* State.X is used as point, -* State.G - as gradient, -* D is calculated within function (because State.D may have different - meaning depending on current optimization algorithm) - -For a meaning of U see 'NEW ACTIVE SET ALGORITHM FOR BOX CONSTRAINED -OPTIMIZATION' by WILLIAM W. HAGER AND HONGCHAO ZHANG. - - -- ALGLIB -- - Copyright 20.03.2009 by Bochkanov Sergey -*************************************************************************/ -static ae_bool mincomp_asauisempty(minasastate* state, ae_state *_state) -{ - ae_int_t i; - double d; - double d2; - double d32; - ae_bool result; - - - d = mincomp_asad1norm(state, _state); - d2 = ae_sqrt(d, _state); - d32 = d*d2; - result = ae_true; - for(i=0; i<=state->n-1; i++) - { - if( ae_fp_greater_eq(ae_fabs(state->g.ptr.p_double[i], _state),d2)&&ae_fp_greater_eq(ae_minreal(state->x.ptr.p_double[i]-state->bndl.ptr.p_double[i], state->bndu.ptr.p_double[i]-state->x.ptr.p_double[i], _state),d32) ) - { - result = ae_false; - return result; - } - } - return result; -} - - -/************************************************************************* -Clears request fileds (to be sure that we don't forgot to clear something) -*************************************************************************/ -static void mincomp_clearrequestfields(minasastate* state, - ae_state *_state) -{ - - - state->needfg = ae_false; - state->xupdated = ae_false; -} - - -ae_bool _minasastate_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - minasastate *p = (minasastate*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->bndl, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->bndu, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->ak, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->xk, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->dk, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->an, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->xn, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->dn, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->d, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->work, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->yk, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->gc, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->g, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) - return ae_false; - if( !_linminstate_init(&p->lstate, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _minasastate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - minasastate *dst = (minasastate*)_dst; - minasastate *src = (minasastate*)_src; - dst->n = src->n; - dst->epsg = src->epsg; - dst->epsf = src->epsf; - dst->epsx = src->epsx; - dst->maxits = src->maxits; - dst->xrep = src->xrep; - dst->stpmax = src->stpmax; - dst->cgtype = src->cgtype; - dst->k = src->k; - dst->nfev = src->nfev; - dst->mcstage = src->mcstage; - if( !ae_vector_init_copy(&dst->bndl, &src->bndl, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->bndu, &src->bndu, _state, make_automatic) ) - return ae_false; - dst->curalgo = src->curalgo; - dst->acount = src->acount; - dst->mu = src->mu; - dst->finit = src->finit; - dst->dginit = src->dginit; - if( !ae_vector_init_copy(&dst->ak, &src->ak, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->xk, &src->xk, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->dk, &src->dk, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->an, &src->an, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->xn, &src->xn, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->dn, &src->dn, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->d, &src->d, _state, make_automatic) ) - return ae_false; - dst->fold = src->fold; - dst->stp = src->stp; - if( !ae_vector_init_copy(&dst->work, &src->work, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->yk, &src->yk, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->gc, &src->gc, _state, make_automatic) ) - return ae_false; - dst->laststep = src->laststep; - if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) - return ae_false; - dst->f = src->f; - if( !ae_vector_init_copy(&dst->g, &src->g, _state, make_automatic) ) - return ae_false; - dst->needfg = src->needfg; - dst->xupdated = src->xupdated; - if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) - return ae_false; - dst->repiterationscount = src->repiterationscount; - dst->repnfev = src->repnfev; - dst->repterminationtype = src->repterminationtype; - dst->debugrestartscount = src->debugrestartscount; - if( !_linminstate_init_copy(&dst->lstate, &src->lstate, _state, make_automatic) ) - return ae_false; - dst->betahs = src->betahs; - dst->betady = src->betady; - return ae_true; -} - - -void _minasastate_clear(void* _p) -{ - minasastate *p = (minasastate*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->bndl); - ae_vector_clear(&p->bndu); - ae_vector_clear(&p->ak); - ae_vector_clear(&p->xk); - ae_vector_clear(&p->dk); - ae_vector_clear(&p->an); - ae_vector_clear(&p->xn); - ae_vector_clear(&p->dn); - ae_vector_clear(&p->d); - ae_vector_clear(&p->work); - ae_vector_clear(&p->yk); - ae_vector_clear(&p->gc); - ae_vector_clear(&p->x); - ae_vector_clear(&p->g); - _rcommstate_clear(&p->rstate); - _linminstate_clear(&p->lstate); -} - - -void _minasastate_destroy(void* _p) -{ - minasastate *p = (minasastate*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->bndl); - ae_vector_destroy(&p->bndu); - ae_vector_destroy(&p->ak); - ae_vector_destroy(&p->xk); - ae_vector_destroy(&p->dk); - ae_vector_destroy(&p->an); - ae_vector_destroy(&p->xn); - ae_vector_destroy(&p->dn); - ae_vector_destroy(&p->d); - ae_vector_destroy(&p->work); - ae_vector_destroy(&p->yk); - ae_vector_destroy(&p->gc); - ae_vector_destroy(&p->x); - ae_vector_destroy(&p->g); - _rcommstate_destroy(&p->rstate); - _linminstate_destroy(&p->lstate); -} - - -ae_bool _minasareport_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - minasareport *p = (minasareport*)_p; - ae_touch_ptr((void*)p); - return ae_true; -} - - -ae_bool _minasareport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - minasareport *dst = (minasareport*)_dst; - minasareport *src = (minasareport*)_src; - dst->iterationscount = src->iterationscount; - dst->nfev = src->nfev; - dst->terminationtype = src->terminationtype; - dst->activeconstraints = src->activeconstraints; - return ae_true; -} - - -void _minasareport_clear(void* _p) -{ - minasareport *p = (minasareport*)_p; - ae_touch_ptr((void*)p); -} - - -void _minasareport_destroy(void* _p) -{ - minasareport *p = (minasareport*)_p; - ae_touch_ptr((void*)p); -} - - - -} - diff --git a/src/core/alglib/optimization.h b/src/core/alglib/optimization.h deleted file mode 100644 index cc1dba1..0000000 --- a/src/core/alglib/optimization.h +++ /dev/null @@ -1,4379 +0,0 @@ -/************************************************************************* -Copyright (c) Sergey Bochkanov (ALGLIB project). - ->>> SOURCE LICENSE >>> -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation (www.fsf.org); either version 2 of the -License, or (at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -A copy of the GNU General Public License is available at -http://www.fsf.org/licensing/licenses ->>> END OF LICENSE >>> -*************************************************************************/ -#ifndef _optimization_pkg_h -#define _optimization_pkg_h -#include "ap.h" -#include "alglibinternal.h" -#include "linalg.h" -#include "alglibmisc.h" -#include "solvers.h" - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (DATATYPES) -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ -typedef struct -{ - ae_int_t n; - ae_int_t k; - double alpha; - double tau; - double theta; - ae_matrix a; - ae_matrix q; - ae_vector b; - ae_vector r; - ae_vector xc; - ae_vector d; - ae_vector activeset; - ae_matrix tq2dense; - ae_matrix tk2; - ae_vector tq2diag; - ae_vector tq1; - ae_vector tk1; - double tq0; - double tk0; - ae_vector txc; - ae_vector tb; - ae_int_t nfree; - ae_int_t ecakind; - ae_matrix ecadense; - ae_matrix eq; - ae_matrix eccm; - ae_vector ecadiag; - ae_vector eb; - double ec; - ae_vector tmp0; - ae_vector tmp1; - ae_vector tmpg; - ae_matrix tmp2; - ae_bool ismaintermchanged; - ae_bool issecondarytermchanged; - ae_bool islineartermchanged; - ae_bool isactivesetchanged; -} convexquadraticmodel; -typedef struct -{ - ae_int_t ns; - ae_int_t nd; - ae_int_t nr; - ae_matrix densea; - ae_vector b; - ae_vector nnc; - ae_int_t refinementits; - double debugflops; - ae_int_t debugmaxnewton; - ae_vector xn; - ae_matrix tmpz; - ae_matrix tmpca; - ae_vector g; - ae_vector d; - ae_vector dx; - ae_vector diagaa; - ae_vector cb; - ae_vector cx; - ae_vector cborg; - ae_vector columnmap; - ae_vector rowmap; - ae_vector tmpcholesky; - ae_vector r; -} snnlssolver; -typedef struct -{ - ae_int_t n; - ae_int_t algostate; - ae_vector xc; - ae_bool hasxc; - ae_vector s; - ae_vector h; - ae_vector activeset; - ae_bool basisisready; - ae_matrix sbasis; - ae_matrix pbasis; - ae_matrix ibasis; - ae_int_t basissize; - ae_bool constraintschanged; - ae_vector hasbndl; - ae_vector hasbndu; - ae_vector bndl; - ae_vector bndu; - ae_matrix cleic; - ae_int_t nec; - ae_int_t nic; - ae_vector mtx; - ae_vector mtas; - ae_vector cdtmp; - ae_vector corrtmp; - ae_vector unitdiagonal; - snnlssolver solver; - ae_vector scntmp; - ae_vector tmp0; - ae_vector tmpfeas; - ae_matrix tmpm0; - ae_vector rctmps; - ae_vector rctmpg; - ae_vector rctmprightpart; - ae_matrix rctmpdense0; - ae_matrix rctmpdense1; - ae_vector rctmpisequality; - ae_vector rctmpconstraintidx; - ae_vector rctmplambdas; - ae_matrix tmpbasis; -} sactiveset; -typedef struct -{ - ae_int_t n; - double epsg; - double epsf; - double epsx; - ae_int_t maxits; - double stpmax; - double suggestedstep; - ae_bool xrep; - ae_bool drep; - ae_int_t cgtype; - ae_int_t prectype; - ae_vector diagh; - ae_vector diaghl2; - ae_matrix vcorr; - ae_int_t vcnt; - ae_vector s; - double diffstep; - ae_int_t nfev; - ae_int_t mcstage; - ae_int_t k; - ae_vector xk; - ae_vector dk; - ae_vector xn; - ae_vector dn; - ae_vector d; - double fold; - double stp; - double curstpmax; - ae_vector yk; - double lastgoodstep; - double lastscaledstep; - ae_int_t mcinfo; - ae_bool innerresetneeded; - ae_bool terminationneeded; - double trimthreshold; - ae_int_t rstimer; - ae_vector x; - double f; - ae_vector g; - ae_bool needf; - ae_bool needfg; - ae_bool xupdated; - ae_bool algpowerup; - ae_bool lsstart; - ae_bool lsend; - double teststep; - rcommstate rstate; - ae_int_t repiterationscount; - ae_int_t repnfev; - ae_int_t repvaridx; - ae_int_t repterminationtype; - ae_int_t debugrestartscount; - linminstate lstate; - double fbase; - double fm2; - double fm1; - double fp1; - double fp2; - double betahs; - double betady; - ae_vector work0; - ae_vector work1; -} mincgstate; -typedef struct -{ - ae_int_t iterationscount; - ae_int_t nfev; - ae_int_t varidx; - ae_int_t terminationtype; -} mincgreport; -typedef struct -{ - ae_int_t nmain; - ae_int_t nslack; - double epsg; - double epsf; - double epsx; - ae_int_t maxits; - ae_bool xrep; - ae_bool drep; - double stpmax; - double diffstep; - sactiveset sas; - ae_vector s; - ae_int_t prectype; - ae_vector diagh; - ae_vector x; - double f; - ae_vector g; - ae_bool needf; - ae_bool needfg; - ae_bool xupdated; - ae_bool lsstart; - ae_bool lbfgssearch; - ae_bool boundedstep; - double teststep; - rcommstate rstate; - ae_vector gc; - ae_vector xn; - ae_vector gn; - ae_vector xp; - ae_vector gp; - double fc; - double fn; - double fp; - ae_vector d; - ae_matrix cleic; - ae_int_t nec; - ae_int_t nic; - double lastgoodstep; - double lastscaledgoodstep; - double maxscaledgrad; - ae_vector hasbndl; - ae_vector hasbndu; - ae_vector bndl; - ae_vector bndu; - ae_int_t repinneriterationscount; - ae_int_t repouteriterationscount; - ae_int_t repnfev; - ae_int_t repvaridx; - ae_int_t repterminationtype; - double repdebugeqerr; - double repdebugfs; - double repdebugff; - double repdebugdx; - ae_int_t repdebugfeasqpits; - ae_int_t repdebugfeasgpaits; - ae_vector xstart; - snnlssolver solver; - double fbase; - double fm2; - double fm1; - double fp1; - double fp2; - double xm1; - double xp1; - double gm1; - double gp1; - ae_int_t cidx; - double cval; - ae_vector tmpprec; - ae_int_t nfev; - ae_int_t mcstage; - double stp; - double curstpmax; - double activationstep; - ae_vector work; - linminstate lstate; - double trimthreshold; - ae_int_t nonmonotoniccnt; - ae_int_t k; - ae_int_t q; - ae_int_t p; - ae_vector rho; - ae_matrix yk; - ae_matrix sk; - ae_vector theta; -} minbleicstate; -typedef struct -{ - ae_int_t iterationscount; - ae_int_t nfev; - ae_int_t varidx; - ae_int_t terminationtype; - double debugeqerr; - double debugfs; - double debugff; - double debugdx; - ae_int_t debugfeasqpits; - ae_int_t debugfeasgpaits; - ae_int_t inneriterationscount; - ae_int_t outeriterationscount; -} minbleicreport; -typedef struct -{ - ae_int_t n; - ae_int_t m; - double epsg; - double epsf; - double epsx; - ae_int_t maxits; - ae_bool xrep; - double stpmax; - ae_vector s; - double diffstep; - ae_int_t nfev; - ae_int_t mcstage; - ae_int_t k; - ae_int_t q; - ae_int_t p; - ae_vector rho; - ae_matrix yk; - ae_matrix sk; - ae_vector theta; - ae_vector d; - double stp; - ae_vector work; - double fold; - double trimthreshold; - ae_int_t prectype; - double gammak; - ae_matrix denseh; - ae_vector diagh; - double fbase; - double fm2; - double fm1; - double fp1; - double fp2; - ae_vector autobuf; - ae_vector x; - double f; - ae_vector g; - ae_bool needf; - ae_bool needfg; - ae_bool xupdated; - double teststep; - rcommstate rstate; - ae_int_t repiterationscount; - ae_int_t repnfev; - ae_int_t repvaridx; - ae_int_t repterminationtype; - linminstate lstate; -} minlbfgsstate; -typedef struct -{ - ae_int_t iterationscount; - ae_int_t nfev; - ae_int_t varidx; - ae_int_t terminationtype; -} minlbfgsreport; -typedef struct -{ - ae_int_t n; - ae_int_t algokind; - ae_int_t akind; - convexquadraticmodel a; - sparsematrix sparsea; - ae_bool sparseaupper; - double anorm; - ae_vector b; - ae_vector bndl; - ae_vector bndu; - ae_vector s; - ae_vector havebndl; - ae_vector havebndu; - ae_vector xorigin; - ae_vector startx; - ae_bool havex; - ae_matrix cleic; - ae_int_t nec; - ae_int_t nic; - double bleicepsg; - double bleicepsf; - double bleicepsx; - ae_int_t bleicmaxits; - sactiveset sas; - ae_vector gc; - ae_vector xn; - ae_vector pg; - ae_vector workbndl; - ae_vector workbndu; - ae_matrix workcleic; - ae_vector xs; - ae_int_t repinneriterationscount; - ae_int_t repouteriterationscount; - ae_int_t repncholesky; - ae_int_t repnmv; - ae_int_t repterminationtype; - double debugphase1flops; - double debugphase2flops; - double debugphase3flops; - ae_vector tmp0; - ae_vector tmp1; - ae_vector tmpb; - ae_vector rctmpg; - ae_vector tmpi; - normestimatorstate estimator; - minbleicstate solver; - minbleicreport solverrep; -} minqpstate; -typedef struct -{ - ae_int_t inneriterationscount; - ae_int_t outeriterationscount; - ae_int_t nmv; - ae_int_t ncholesky; - ae_int_t terminationtype; -} minqpreport; -typedef struct -{ - ae_int_t n; - ae_int_t m; - double diffstep; - double epsg; - double epsf; - double epsx; - ae_int_t maxits; - ae_bool xrep; - double stpmax; - ae_int_t maxmodelage; - ae_bool makeadditers; - ae_vector x; - double f; - ae_vector fi; - ae_matrix j; - ae_matrix h; - ae_vector g; - ae_bool needf; - ae_bool needfg; - ae_bool needfgh; - ae_bool needfij; - ae_bool needfi; - ae_bool xupdated; - ae_int_t algomode; - ae_bool hasf; - ae_bool hasfi; - ae_bool hasg; - ae_vector xbase; - double fbase; - ae_vector fibase; - ae_vector gbase; - ae_matrix quadraticmodel; - ae_vector bndl; - ae_vector bndu; - ae_vector havebndl; - ae_vector havebndu; - ae_vector s; - double lambdav; - double nu; - ae_int_t modelage; - ae_vector xdir; - ae_vector deltax; - ae_vector deltaf; - ae_bool deltaxready; - ae_bool deltafready; - double teststep; - ae_int_t repiterationscount; - ae_int_t repterminationtype; - ae_int_t repfuncidx; - ae_int_t repvaridx; - ae_int_t repnfunc; - ae_int_t repnjac; - ae_int_t repngrad; - ae_int_t repnhess; - ae_int_t repncholesky; - rcommstate rstate; - ae_vector choleskybuf; - ae_vector tmp0; - double actualdecrease; - double predicteddecrease; - double xm1; - double xp1; - ae_vector fm1; - ae_vector fp1; - ae_vector fc1; - ae_vector gm1; - ae_vector gp1; - ae_vector gc1; - minlbfgsstate internalstate; - minlbfgsreport internalrep; - minqpstate qpstate; - minqpreport qprep; -} minlmstate; -typedef struct -{ - ae_int_t iterationscount; - ae_int_t terminationtype; - ae_int_t funcidx; - ae_int_t varidx; - ae_int_t nfunc; - ae_int_t njac; - ae_int_t ngrad; - ae_int_t nhess; - ae_int_t ncholesky; -} minlmreport; -typedef struct -{ - ae_int_t n; - double epsg; - double epsf; - double epsx; - ae_int_t maxits; - ae_bool xrep; - double stpmax; - ae_int_t cgtype; - ae_int_t k; - ae_int_t nfev; - ae_int_t mcstage; - ae_vector bndl; - ae_vector bndu; - ae_int_t curalgo; - ae_int_t acount; - double mu; - double finit; - double dginit; - ae_vector ak; - ae_vector xk; - ae_vector dk; - ae_vector an; - ae_vector xn; - ae_vector dn; - ae_vector d; - double fold; - double stp; - ae_vector work; - ae_vector yk; - ae_vector gc; - double laststep; - ae_vector x; - double f; - ae_vector g; - ae_bool needfg; - ae_bool xupdated; - rcommstate rstate; - ae_int_t repiterationscount; - ae_int_t repnfev; - ae_int_t repterminationtype; - ae_int_t debugrestartscount; - linminstate lstate; - double betahs; - double betady; -} minasastate; -typedef struct -{ - ae_int_t iterationscount; - ae_int_t nfev; - ae_int_t terminationtype; - ae_int_t activeconstraints; -} minasareport; - -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS C++ INTERFACE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib -{ - - - - - - - - - -/************************************************************************* -This object stores state of the nonlinear CG optimizer. - -You should use ALGLIB functions to work with this object. -*************************************************************************/ -class _mincgstate_owner -{ -public: - _mincgstate_owner(); - _mincgstate_owner(const _mincgstate_owner &rhs); - _mincgstate_owner& operator=(const _mincgstate_owner &rhs); - virtual ~_mincgstate_owner(); - alglib_impl::mincgstate* c_ptr(); - alglib_impl::mincgstate* c_ptr() const; -protected: - alglib_impl::mincgstate *p_struct; -}; -class mincgstate : public _mincgstate_owner -{ -public: - mincgstate(); - mincgstate(const mincgstate &rhs); - mincgstate& operator=(const mincgstate &rhs); - virtual ~mincgstate(); - ae_bool &needf; - ae_bool &needfg; - ae_bool &xupdated; - double &f; - real_1d_array g; - real_1d_array x; - -}; - - -/************************************************************************* - -*************************************************************************/ -class _mincgreport_owner -{ -public: - _mincgreport_owner(); - _mincgreport_owner(const _mincgreport_owner &rhs); - _mincgreport_owner& operator=(const _mincgreport_owner &rhs); - virtual ~_mincgreport_owner(); - alglib_impl::mincgreport* c_ptr(); - alglib_impl::mincgreport* c_ptr() const; -protected: - alglib_impl::mincgreport *p_struct; -}; -class mincgreport : public _mincgreport_owner -{ -public: - mincgreport(); - mincgreport(const mincgreport &rhs); - mincgreport& operator=(const mincgreport &rhs); - virtual ~mincgreport(); - ae_int_t &iterationscount; - ae_int_t &nfev; - ae_int_t &varidx; - ae_int_t &terminationtype; - -}; - -/************************************************************************* -This object stores nonlinear optimizer state. -You should use functions provided by MinBLEIC subpackage to work with this -object -*************************************************************************/ -class _minbleicstate_owner -{ -public: - _minbleicstate_owner(); - _minbleicstate_owner(const _minbleicstate_owner &rhs); - _minbleicstate_owner& operator=(const _minbleicstate_owner &rhs); - virtual ~_minbleicstate_owner(); - alglib_impl::minbleicstate* c_ptr(); - alglib_impl::minbleicstate* c_ptr() const; -protected: - alglib_impl::minbleicstate *p_struct; -}; -class minbleicstate : public _minbleicstate_owner -{ -public: - minbleicstate(); - minbleicstate(const minbleicstate &rhs); - minbleicstate& operator=(const minbleicstate &rhs); - virtual ~minbleicstate(); - ae_bool &needf; - ae_bool &needfg; - ae_bool &xupdated; - double &f; - real_1d_array g; - real_1d_array x; - -}; - - -/************************************************************************* -This structure stores optimization report: -* IterationsCount number of iterations -* NFEV number of gradient evaluations -* TerminationType termination type (see below) - -TERMINATION CODES - -TerminationType field contains completion code, which can be: - -7 gradient verification failed. - See MinBLEICSetGradientCheck() for more information. - -3 inconsistent constraints. Feasible point is - either nonexistent or too hard to find. Try to - restart optimizer with better initial approximation - 1 relative function improvement is no more than EpsF. - 2 relative step is no more than EpsX. - 4 gradient norm is no more than EpsG - 5 MaxIts steps was taken - 7 stopping conditions are too stringent, - further improvement is impossible, - X contains best point found so far. - -ADDITIONAL FIELDS - -There are additional fields which can be used for debugging: -* DebugEqErr error in the equality constraints (2-norm) -* DebugFS f, calculated at projection of initial point - to the feasible set -* DebugFF f, calculated at the final point -* DebugDX |X_start-X_final| -*************************************************************************/ -class _minbleicreport_owner -{ -public: - _minbleicreport_owner(); - _minbleicreport_owner(const _minbleicreport_owner &rhs); - _minbleicreport_owner& operator=(const _minbleicreport_owner &rhs); - virtual ~_minbleicreport_owner(); - alglib_impl::minbleicreport* c_ptr(); - alglib_impl::minbleicreport* c_ptr() const; -protected: - alglib_impl::minbleicreport *p_struct; -}; -class minbleicreport : public _minbleicreport_owner -{ -public: - minbleicreport(); - minbleicreport(const minbleicreport &rhs); - minbleicreport& operator=(const minbleicreport &rhs); - virtual ~minbleicreport(); - ae_int_t &iterationscount; - ae_int_t &nfev; - ae_int_t &varidx; - ae_int_t &terminationtype; - double &debugeqerr; - double &debugfs; - double &debugff; - double &debugdx; - ae_int_t &debugfeasqpits; - ae_int_t &debugfeasgpaits; - ae_int_t &inneriterationscount; - ae_int_t &outeriterationscount; - -}; - -/************************************************************************* - -*************************************************************************/ -class _minlbfgsstate_owner -{ -public: - _minlbfgsstate_owner(); - _minlbfgsstate_owner(const _minlbfgsstate_owner &rhs); - _minlbfgsstate_owner& operator=(const _minlbfgsstate_owner &rhs); - virtual ~_minlbfgsstate_owner(); - alglib_impl::minlbfgsstate* c_ptr(); - alglib_impl::minlbfgsstate* c_ptr() const; -protected: - alglib_impl::minlbfgsstate *p_struct; -}; -class minlbfgsstate : public _minlbfgsstate_owner -{ -public: - minlbfgsstate(); - minlbfgsstate(const minlbfgsstate &rhs); - minlbfgsstate& operator=(const minlbfgsstate &rhs); - virtual ~minlbfgsstate(); - ae_bool &needf; - ae_bool &needfg; - ae_bool &xupdated; - double &f; - real_1d_array g; - real_1d_array x; - -}; - - -/************************************************************************* - -*************************************************************************/ -class _minlbfgsreport_owner -{ -public: - _minlbfgsreport_owner(); - _minlbfgsreport_owner(const _minlbfgsreport_owner &rhs); - _minlbfgsreport_owner& operator=(const _minlbfgsreport_owner &rhs); - virtual ~_minlbfgsreport_owner(); - alglib_impl::minlbfgsreport* c_ptr(); - alglib_impl::minlbfgsreport* c_ptr() const; -protected: - alglib_impl::minlbfgsreport *p_struct; -}; -class minlbfgsreport : public _minlbfgsreport_owner -{ -public: - minlbfgsreport(); - minlbfgsreport(const minlbfgsreport &rhs); - minlbfgsreport& operator=(const minlbfgsreport &rhs); - virtual ~minlbfgsreport(); - ae_int_t &iterationscount; - ae_int_t &nfev; - ae_int_t &varidx; - ae_int_t &terminationtype; - -}; - -/************************************************************************* -This object stores nonlinear optimizer state. -You should use functions provided by MinQP subpackage to work with this -object -*************************************************************************/ -class _minqpstate_owner -{ -public: - _minqpstate_owner(); - _minqpstate_owner(const _minqpstate_owner &rhs); - _minqpstate_owner& operator=(const _minqpstate_owner &rhs); - virtual ~_minqpstate_owner(); - alglib_impl::minqpstate* c_ptr(); - alglib_impl::minqpstate* c_ptr() const; -protected: - alglib_impl::minqpstate *p_struct; -}; -class minqpstate : public _minqpstate_owner -{ -public: - minqpstate(); - minqpstate(const minqpstate &rhs); - minqpstate& operator=(const minqpstate &rhs); - virtual ~minqpstate(); - -}; - - -/************************************************************************* -This structure stores optimization report: -* InnerIterationsCount number of inner iterations -* OuterIterationsCount number of outer iterations -* NCholesky number of Cholesky decomposition -* NMV number of matrix-vector products - (only products calculated as part of iterative - process are counted) -* TerminationType completion code (see below) - -Completion codes: -* -5 inappropriate solver was used: - * Cholesky solver for semidefinite or indefinite problems - * Cholesky solver for problems with non-boundary constraints -* -4 BLEIC-QP algorithm found unconstrained direction - of negative curvature (function is unbounded from - below even under constraints), no meaningful - minimum can be found. -* -3 inconsistent constraints (or, maybe, feasible point is - too hard to find). If you are sure that constraints are feasible, - try to restart optimizer with better initial approximation. -* -1 solver error -* 4 successful completion -* 5 MaxIts steps was taken -* 7 stopping conditions are too stringent, - further improvement is impossible, - X contains best point found so far. -*************************************************************************/ -class _minqpreport_owner -{ -public: - _minqpreport_owner(); - _minqpreport_owner(const _minqpreport_owner &rhs); - _minqpreport_owner& operator=(const _minqpreport_owner &rhs); - virtual ~_minqpreport_owner(); - alglib_impl::minqpreport* c_ptr(); - alglib_impl::minqpreport* c_ptr() const; -protected: - alglib_impl::minqpreport *p_struct; -}; -class minqpreport : public _minqpreport_owner -{ -public: - minqpreport(); - minqpreport(const minqpreport &rhs); - minqpreport& operator=(const minqpreport &rhs); - virtual ~minqpreport(); - ae_int_t &inneriterationscount; - ae_int_t &outeriterationscount; - ae_int_t &nmv; - ae_int_t &ncholesky; - ae_int_t &terminationtype; - -}; - -/************************************************************************* -Levenberg-Marquardt optimizer. - -This structure should be created using one of the MinLMCreate???() -functions. You should not access its fields directly; use ALGLIB functions -to work with it. -*************************************************************************/ -class _minlmstate_owner -{ -public: - _minlmstate_owner(); - _minlmstate_owner(const _minlmstate_owner &rhs); - _minlmstate_owner& operator=(const _minlmstate_owner &rhs); - virtual ~_minlmstate_owner(); - alglib_impl::minlmstate* c_ptr(); - alglib_impl::minlmstate* c_ptr() const; -protected: - alglib_impl::minlmstate *p_struct; -}; -class minlmstate : public _minlmstate_owner -{ -public: - minlmstate(); - minlmstate(const minlmstate &rhs); - minlmstate& operator=(const minlmstate &rhs); - virtual ~minlmstate(); - ae_bool &needf; - ae_bool &needfg; - ae_bool &needfgh; - ae_bool &needfi; - ae_bool &needfij; - ae_bool &xupdated; - double &f; - real_1d_array fi; - real_1d_array g; - real_2d_array h; - real_2d_array j; - real_1d_array x; - -}; - - -/************************************************************************* -Optimization report, filled by MinLMResults() function - -FIELDS: -* TerminationType, completion code: - * -7 derivative correctness check failed; - see Rep.WrongNum, Rep.WrongI, Rep.WrongJ for - more information. - * 1 relative function improvement is no more than - EpsF. - * 2 relative step is no more than EpsX. - * 4 gradient is no more than EpsG. - * 5 MaxIts steps was taken - * 7 stopping conditions are too stringent, - further improvement is impossible -* IterationsCount, contains iterations count -* NFunc, number of function calculations -* NJac, number of Jacobi matrix calculations -* NGrad, number of gradient calculations -* NHess, number of Hessian calculations -* NCholesky, number of Cholesky decomposition calculations -*************************************************************************/ -class _minlmreport_owner -{ -public: - _minlmreport_owner(); - _minlmreport_owner(const _minlmreport_owner &rhs); - _minlmreport_owner& operator=(const _minlmreport_owner &rhs); - virtual ~_minlmreport_owner(); - alglib_impl::minlmreport* c_ptr(); - alglib_impl::minlmreport* c_ptr() const; -protected: - alglib_impl::minlmreport *p_struct; -}; -class minlmreport : public _minlmreport_owner -{ -public: - minlmreport(); - minlmreport(const minlmreport &rhs); - minlmreport& operator=(const minlmreport &rhs); - virtual ~minlmreport(); - ae_int_t &iterationscount; - ae_int_t &terminationtype; - ae_int_t &funcidx; - ae_int_t &varidx; - ae_int_t &nfunc; - ae_int_t &njac; - ae_int_t &ngrad; - ae_int_t &nhess; - ae_int_t &ncholesky; - -}; - -/************************************************************************* - -*************************************************************************/ -class _minasastate_owner -{ -public: - _minasastate_owner(); - _minasastate_owner(const _minasastate_owner &rhs); - _minasastate_owner& operator=(const _minasastate_owner &rhs); - virtual ~_minasastate_owner(); - alglib_impl::minasastate* c_ptr(); - alglib_impl::minasastate* c_ptr() const; -protected: - alglib_impl::minasastate *p_struct; -}; -class minasastate : public _minasastate_owner -{ -public: - minasastate(); - minasastate(const minasastate &rhs); - minasastate& operator=(const minasastate &rhs); - virtual ~minasastate(); - ae_bool &needfg; - ae_bool &xupdated; - double &f; - real_1d_array g; - real_1d_array x; - -}; - - -/************************************************************************* - -*************************************************************************/ -class _minasareport_owner -{ -public: - _minasareport_owner(); - _minasareport_owner(const _minasareport_owner &rhs); - _minasareport_owner& operator=(const _minasareport_owner &rhs); - virtual ~_minasareport_owner(); - alglib_impl::minasareport* c_ptr(); - alglib_impl::minasareport* c_ptr() const; -protected: - alglib_impl::minasareport *p_struct; -}; -class minasareport : public _minasareport_owner -{ -public: - minasareport(); - minasareport(const minasareport &rhs); - minasareport& operator=(const minasareport &rhs); - virtual ~minasareport(); - ae_int_t &iterationscount; - ae_int_t &nfev; - ae_int_t &terminationtype; - ae_int_t &activeconstraints; - -}; - - - - - - - - - -/************************************************************************* - NONLINEAR CONJUGATE GRADIENT METHOD - -DESCRIPTION: -The subroutine minimizes function F(x) of N arguments by using one of the -nonlinear conjugate gradient methods. - -These CG methods are globally convergent (even on non-convex functions) as -long as grad(f) is Lipschitz continuous in a some neighborhood of the -L = { x : f(x)<=f(x0) }. - - -REQUIREMENTS: -Algorithm will request following information during its operation: -* function value F and its gradient G (simultaneously) at given point X - - -USAGE: -1. User initializes algorithm state with MinCGCreate() call -2. User tunes solver parameters with MinCGSetCond(), MinCGSetStpMax() and - other functions -3. User calls MinCGOptimize() function which takes algorithm state and - pointer (delegate, etc.) to callback function which calculates F/G. -4. User calls MinCGResults() to get solution -5. Optionally, user may call MinCGRestartFrom() to solve another problem - with same N but another starting point and/or another function. - MinCGRestartFrom() allows to reuse already initialized structure. - - -INPUT PARAMETERS: - N - problem dimension, N>0: - * if given, only leading N elements of X are used - * if not given, automatically determined from size of X - X - starting point, array[0..N-1]. - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 25.03.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgcreate(const ae_int_t n, const real_1d_array &x, mincgstate &state); -void mincgcreate(const real_1d_array &x, mincgstate &state); - - -/************************************************************************* -The subroutine is finite difference variant of MinCGCreate(). It uses -finite differences in order to differentiate target function. - -Description below contains information which is specific to this function -only. We recommend to read comments on MinCGCreate() in order to get more -information about creation of CG optimizer. - -INPUT PARAMETERS: - N - problem dimension, N>0: - * if given, only leading N elements of X are used - * if not given, automatically determined from size of X - X - starting point, array[0..N-1]. - DiffStep- differentiation step, >0 - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -NOTES: -1. algorithm uses 4-point central formula for differentiation. -2. differentiation step along I-th axis is equal to DiffStep*S[I] where - S[] is scaling vector which can be set by MinCGSetScale() call. -3. we recommend you to use moderate values of differentiation step. Too - large step will result in too large truncation errors, while too small - step will result in too large numerical errors. 1.0E-6 can be good - value to start with. -4. Numerical differentiation is very inefficient - one gradient - calculation needs 4*N function evaluations. This function will work for - any N - either small (1...10), moderate (10...100) or large (100...). - However, performance penalty will be too severe for any N's except for - small ones. - We should also say that code which relies on numerical differentiation - is less robust and precise. L-BFGS needs exact gradient values. - Imprecise gradient may slow down convergence, especially on highly - nonlinear problems. - Thus we recommend to use this function for fast prototyping on small- - dimensional problems only, and to implement analytical gradient as soon - as possible. - - -- ALGLIB -- - Copyright 16.05.2011 by Bochkanov Sergey -*************************************************************************/ -void mincgcreatef(const ae_int_t n, const real_1d_array &x, const double diffstep, mincgstate &state); -void mincgcreatef(const real_1d_array &x, const double diffstep, mincgstate &state); - - -/************************************************************************* -This function sets stopping conditions for CG optimization algorithm. - -INPUT PARAMETERS: - State - structure which stores algorithm state - EpsG - >=0 - The subroutine finishes its work if the condition - |v|=0 - The subroutine finishes its work if on k+1-th iteration - the condition |F(k+1)-F(k)|<=EpsF*max{|F(k)|,|F(k+1)|,1} - is satisfied. - EpsX - >=0 - The subroutine finishes its work if on k+1-th iteration - the condition |v|<=EpsX is fulfilled, where: - * |.| means Euclidian norm - * v - scaled step vector, v[i]=dx[i]/s[i] - * dx - ste pvector, dx=X(k+1)-X(k) - * s - scaling coefficients set by MinCGSetScale() - MaxIts - maximum number of iterations. If MaxIts=0, the number of - iterations is unlimited. - -Passing EpsG=0, EpsF=0, EpsX=0 and MaxIts=0 (simultaneously) will lead to -automatic stopping criterion selection (small EpsX). - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgsetcond(const mincgstate &state, const double epsg, const double epsf, const double epsx, const ae_int_t maxits); - - -/************************************************************************* -This function sets scaling coefficients for CG optimizer. - -ALGLIB optimizers use scaling matrices to test stopping conditions (step -size and gradient are scaled before comparison with tolerances). Scale of -the I-th variable is a translation invariant measure of: -a) "how large" the variable is -b) how large the step should be to make significant changes in the function - -Scaling is also used by finite difference variant of CG optimizer - step -along I-th axis is equal to DiffStep*S[I]. - -In most optimizers (and in the CG too) scaling is NOT a form of -preconditioning. It just affects stopping conditions. You should set -preconditioner by separate call to one of the MinCGSetPrec...() functions. - -There is special preconditioning mode, however, which uses scaling -coefficients to form diagonal preconditioning matrix. You can turn this -mode on, if you want. But you should understand that scaling is not the -same thing as preconditioning - these are two different, although related -forms of tuning solver. - -INPUT PARAMETERS: - State - structure stores algorithm state - S - array[N], non-zero scaling coefficients - S[i] may be negative, sign doesn't matter. - - -- ALGLIB -- - Copyright 14.01.2011 by Bochkanov Sergey -*************************************************************************/ -void mincgsetscale(const mincgstate &state, const real_1d_array &s); - - -/************************************************************************* -This function turns on/off reporting. - -INPUT PARAMETERS: - State - structure which stores algorithm state - NeedXRep- whether iteration reports are needed or not - -If NeedXRep is True, algorithm will call rep() callback function if it is -provided to MinCGOptimize(). - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgsetxrep(const mincgstate &state, const bool needxrep); - - -/************************************************************************* -This function sets CG algorithm. - -INPUT PARAMETERS: - State - structure which stores algorithm state - CGType - algorithm type: - * -1 automatic selection of the best algorithm - * 0 DY (Dai and Yuan) algorithm - * 1 Hybrid DY-HS algorithm - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgsetcgtype(const mincgstate &state, const ae_int_t cgtype); - - -/************************************************************************* -This function sets maximum step length - -INPUT PARAMETERS: - State - structure which stores algorithm state - StpMax - maximum step length, >=0. Set StpMax to 0.0, if you don't - want to limit step length. - -Use this subroutine when you optimize target function which contains exp() -or other fast growing functions, and optimization algorithm makes too -large steps which leads to overflow. This function allows us to reject -steps that are too large (and therefore expose us to the possible -overflow) without actually calculating function value at the x+stp*d. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgsetstpmax(const mincgstate &state, const double stpmax); - - -/************************************************************************* -This function allows to suggest initial step length to the CG algorithm. - -Suggested step length is used as starting point for the line search. It -can be useful when you have badly scaled problem, i.e. when ||grad|| -(which is used as initial estimate for the first step) is many orders of -magnitude different from the desired step. - -Line search may fail on such problems without good estimate of initial -step length. Imagine, for example, problem with ||grad||=10^50 and desired -step equal to 0.1 Line search function will use 10^50 as initial step, -then it will decrease step length by 2 (up to 20 attempts) and will get -10^44, which is still too large. - -This function allows us to tell than line search should be started from -some moderate step length, like 1.0, so algorithm will be able to detect -desired step length in a several searches. - -Default behavior (when no step is suggested) is to use preconditioner, if -it is available, to generate initial estimate of step length. - -This function influences only first iteration of algorithm. It should be -called between MinCGCreate/MinCGRestartFrom() call and MinCGOptimize call. -Suggested step is ignored if you have preconditioner. - -INPUT PARAMETERS: - State - structure used to store algorithm state. - Stp - initial estimate of the step length. - Can be zero (no estimate). - - -- ALGLIB -- - Copyright 30.07.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgsuggeststep(const mincgstate &state, const double stp); - - -/************************************************************************* -Modification of the preconditioner: preconditioning is turned off. - -INPUT PARAMETERS: - State - structure which stores algorithm state - -NOTE: you can change preconditioner "on the fly", during algorithm -iterations. - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgsetprecdefault(const mincgstate &state); - - -/************************************************************************* -Modification of the preconditioner: diagonal of approximate Hessian is -used. - -INPUT PARAMETERS: - State - structure which stores algorithm state - D - diagonal of the approximate Hessian, array[0..N-1], - (if larger, only leading N elements are used). - -NOTE: you can change preconditioner "on the fly", during algorithm -iterations. - -NOTE 2: D[i] should be positive. Exception will be thrown otherwise. - -NOTE 3: you should pass diagonal of approximate Hessian - NOT ITS INVERSE. - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgsetprecdiag(const mincgstate &state, const real_1d_array &d); - - -/************************************************************************* -Modification of the preconditioner: scale-based diagonal preconditioning. - -This preconditioning mode can be useful when you don't have approximate -diagonal of Hessian, but you know that your variables are badly scaled -(for example, one variable is in [1,10], and another in [1000,100000]), -and most part of the ill-conditioning comes from different scales of vars. - -In this case simple scale-based preconditioner, with H[i] = 1/(s[i]^2), -can greatly improve convergence. - -IMPRTANT: you should set scale of your variables with MinCGSetScale() call -(before or after MinCGSetPrecScale() call). Without knowledge of the scale -of your variables scale-based preconditioner will be just unit matrix. - -INPUT PARAMETERS: - State - structure which stores algorithm state - -NOTE: you can change preconditioner "on the fly", during algorithm -iterations. - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgsetprecscale(const mincgstate &state); - - -/************************************************************************* -This function provides reverse communication interface -Reverse communication interface is not documented or recommended to use. -See below for functions which provide better documented API -*************************************************************************/ -bool mincgiteration(const mincgstate &state); - - -/************************************************************************* -This family of functions is used to launcn iterations of nonlinear optimizer - -These functions accept following parameters: - state - algorithm state - func - callback which calculates function (or merit function) - value func at given point x - grad - callback which calculates function (or merit function) - value func and gradient grad at given point x - rep - optional callback which is called after each iteration - can be NULL - ptr - optional pointer which is passed to func/grad/hess/jac/rep - can be NULL - -NOTES: - -1. This function has two different implementations: one which uses exact - (analytical) user-supplied gradient, and one which uses function value - only and numerically differentiates function in order to obtain - gradient. - - Depending on the specific function used to create optimizer object - (either MinCGCreate() for analytical gradient or MinCGCreateF() for - numerical differentiation) you should choose appropriate variant of - MinCGOptimize() - one which accepts function AND gradient or one which - accepts function ONLY. - - Be careful to choose variant of MinCGOptimize() which corresponds to - your optimization scheme! Table below lists different combinations of - callback (function/gradient) passed to MinCGOptimize() and specific - function used to create optimizer. - - - | USER PASSED TO MinCGOptimize() - CREATED WITH | function only | function and gradient - ------------------------------------------------------------ - MinCGCreateF() | work FAIL - MinCGCreate() | FAIL work - - Here "FAIL" denotes inappropriate combinations of optimizer creation - function and MinCGOptimize() version. Attemps to use such combination - (for example, to create optimizer with MinCGCreateF() and to pass - gradient information to MinCGOptimize()) will lead to exception being - thrown. Either you did not pass gradient when it WAS needed or you - passed gradient when it was NOT needed. - - -- ALGLIB -- - Copyright 20.04.2009 by Bochkanov Sergey - -*************************************************************************/ -void mincgoptimize(mincgstate &state, - void (*func)(const real_1d_array &x, double &func, void *ptr), - void (*rep)(const real_1d_array &x, double func, void *ptr) = NULL, - void *ptr = NULL); -void mincgoptimize(mincgstate &state, - void (*grad)(const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), - void (*rep)(const real_1d_array &x, double func, void *ptr) = NULL, - void *ptr = NULL); - - -/************************************************************************* -Conjugate gradient results - -INPUT PARAMETERS: - State - algorithm state - -OUTPUT PARAMETERS: - X - array[0..N-1], solution - Rep - optimization report: - * Rep.TerminationType completion code: - * -7 gradient verification failed. - See MinCGSetGradientCheck() for more information. - * 1 relative function improvement is no more than - EpsF. - * 2 relative step is no more than EpsX. - * 4 gradient norm is no more than EpsG - * 5 MaxIts steps was taken - * 7 stopping conditions are too stringent, - further improvement is impossible, - we return best X found so far - * 8 terminated by user - * Rep.IterationsCount contains iterations count - * NFEV contains number of function calculations - - -- ALGLIB -- - Copyright 20.04.2009 by Bochkanov Sergey -*************************************************************************/ -void mincgresults(const mincgstate &state, real_1d_array &x, mincgreport &rep); - - -/************************************************************************* -Conjugate gradient results - -Buffered implementation of MinCGResults(), which uses pre-allocated buffer -to store X[]. If buffer size is too small, it resizes buffer. It is -intended to be used in the inner cycles of performance critical algorithms -where array reallocation penalty is too large to be ignored. - - -- ALGLIB -- - Copyright 20.04.2009 by Bochkanov Sergey -*************************************************************************/ -void mincgresultsbuf(const mincgstate &state, real_1d_array &x, mincgreport &rep); - - -/************************************************************************* -This subroutine restarts CG algorithm from new point. All optimization -parameters are left unchanged. - -This function allows to solve multiple optimization problems (which -must have same number of dimensions) without object reallocation penalty. - -INPUT PARAMETERS: - State - structure used to store algorithm state. - X - new starting point. - - -- ALGLIB -- - Copyright 30.07.2010 by Bochkanov Sergey -*************************************************************************/ -void mincgrestartfrom(const mincgstate &state, const real_1d_array &x); - - -/************************************************************************* - -This subroutine turns on verification of the user-supplied analytic -gradient: -* user calls this subroutine before optimization begins -* MinCGOptimize() is called -* prior to actual optimization, for each component of parameters being - optimized X[i] algorithm performs following steps: - * two trial steps are made to X[i]-TestStep*S[i] and X[i]+TestStep*S[i], - where X[i] is i-th component of the initial point and S[i] is a scale - of i-th parameter - * F(X) is evaluated at these trial points - * we perform one more evaluation in the middle point of the interval - * we build cubic model using function values and derivatives at trial - points and we compare its prediction with actual value in the middle - point - * in case difference between prediction and actual value is higher than - some predetermined threshold, algorithm stops with completion code -7; - Rep.VarIdx is set to index of the parameter with incorrect derivative. -* after verification is over, algorithm proceeds to the actual optimization. - -NOTE 1: verification needs N (parameters count) gradient evaluations. It - is very costly and you should use it only for low dimensional - problems, when you want to be sure that you've correctly - calculated analytic derivatives. You should not use it in the - production code (unless you want to check derivatives provided by - some third party). - -NOTE 2: you should carefully choose TestStep. Value which is too large - (so large that function behaviour is significantly non-cubic) will - lead to false alarms. You may use different step for different - parameters by means of setting scale with MinCGSetScale(). - -NOTE 3: this function may lead to false positives. In case it reports that - I-th derivative was calculated incorrectly, you may decrease test - step and try one more time - maybe your function changes too - sharply and your step is too large for such rapidly chanding - function. - -INPUT PARAMETERS: - State - structure used to store algorithm state - TestStep - verification step: - * TestStep=0 turns verification off - * TestStep>0 activates verification - - -- ALGLIB -- - Copyright 31.05.2012 by Bochkanov Sergey -*************************************************************************/ -void mincgsetgradientcheck(const mincgstate &state, const double teststep); - -/************************************************************************* - BOUND CONSTRAINED OPTIMIZATION - WITH ADDITIONAL LINEAR EQUALITY AND INEQUALITY CONSTRAINTS - -DESCRIPTION: -The subroutine minimizes function F(x) of N arguments subject to any -combination of: -* bound constraints -* linear inequality constraints -* linear equality constraints - -REQUIREMENTS: -* user must provide function value and gradient -* starting point X0 must be feasible or - not too far away from the feasible set -* grad(f) must be Lipschitz continuous on a level set: - L = { x : f(x)<=f(x0) } -* function must be defined everywhere on the feasible set F - -USAGE: - -Constrained optimization if far more complex than the unconstrained one. -Here we give very brief outline of the BLEIC optimizer. We strongly recommend -you to read examples in the ALGLIB Reference Manual and to read ALGLIB User Guide -on optimization, which is available at http://www.alglib.net/optimization/ - -1. User initializes algorithm state with MinBLEICCreate() call - -2. USer adds boundary and/or linear constraints by calling - MinBLEICSetBC() and MinBLEICSetLC() functions. - -3. User sets stopping conditions with MinBLEICSetCond(). - -4. User calls MinBLEICOptimize() function which takes algorithm state and - pointer (delegate, etc.) to callback function which calculates F/G. - -5. User calls MinBLEICResults() to get solution - -6. Optionally user may call MinBLEICRestartFrom() to solve another problem - with same N but another starting point. - MinBLEICRestartFrom() allows to reuse already initialized structure. - - -INPUT PARAMETERS: - N - problem dimension, N>0: - * if given, only leading N elements of X are used - * if not given, automatically determined from size ofX - X - starting point, array[N]: - * it is better to set X to a feasible point - * but X can be infeasible, in which case algorithm will try - to find feasible point first, using X as initial - approximation. - -OUTPUT PARAMETERS: - State - structure stores algorithm state - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleiccreate(const ae_int_t n, const real_1d_array &x, minbleicstate &state); -void minbleiccreate(const real_1d_array &x, minbleicstate &state); - - -/************************************************************************* -The subroutine is finite difference variant of MinBLEICCreate(). It uses -finite differences in order to differentiate target function. - -Description below contains information which is specific to this function -only. We recommend to read comments on MinBLEICCreate() in order to get -more information about creation of BLEIC optimizer. - -INPUT PARAMETERS: - N - problem dimension, N>0: - * if given, only leading N elements of X are used - * if not given, automatically determined from size of X - X - starting point, array[0..N-1]. - DiffStep- differentiation step, >0 - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -NOTES: -1. algorithm uses 4-point central formula for differentiation. -2. differentiation step along I-th axis is equal to DiffStep*S[I] where - S[] is scaling vector which can be set by MinBLEICSetScale() call. -3. we recommend you to use moderate values of differentiation step. Too - large step will result in too large truncation errors, while too small - step will result in too large numerical errors. 1.0E-6 can be good - value to start with. -4. Numerical differentiation is very inefficient - one gradient - calculation needs 4*N function evaluations. This function will work for - any N - either small (1...10), moderate (10...100) or large (100...). - However, performance penalty will be too severe for any N's except for - small ones. - We should also say that code which relies on numerical differentiation - is less robust and precise. CG needs exact gradient values. Imprecise - gradient may slow down convergence, especially on highly nonlinear - problems. - Thus we recommend to use this function for fast prototyping on small- - dimensional problems only, and to implement analytical gradient as soon - as possible. - - -- ALGLIB -- - Copyright 16.05.2011 by Bochkanov Sergey -*************************************************************************/ -void minbleiccreatef(const ae_int_t n, const real_1d_array &x, const double diffstep, minbleicstate &state); -void minbleiccreatef(const real_1d_array &x, const double diffstep, minbleicstate &state); - - -/************************************************************************* -This function sets boundary constraints for BLEIC optimizer. - -Boundary constraints are inactive by default (after initial creation). -They are preserved after algorithm restart with MinBLEICRestartFrom(). - -INPUT PARAMETERS: - State - structure stores algorithm state - BndL - lower bounds, array[N]. - If some (all) variables are unbounded, you may specify - very small number or -INF. - BndU - upper bounds, array[N]. - If some (all) variables are unbounded, you may specify - very large number or +INF. - -NOTE 1: it is possible to specify BndL[i]=BndU[i]. In this case I-th -variable will be "frozen" at X[i]=BndL[i]=BndU[i]. - -NOTE 2: this solver has following useful properties: -* bound constraints are always satisfied exactly -* function is evaluated only INSIDE area specified by bound constraints, - even when numerical differentiation is used (algorithm adjusts nodes - according to boundary constraints) - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetbc(const minbleicstate &state, const real_1d_array &bndl, const real_1d_array &bndu); - - -/************************************************************************* -This function sets linear constraints for BLEIC optimizer. - -Linear constraints are inactive by default (after initial creation). -They are preserved after algorithm restart with MinBLEICRestartFrom(). - -INPUT PARAMETERS: - State - structure previously allocated with MinBLEICCreate call. - C - linear constraints, array[K,N+1]. - Each row of C represents one constraint, either equality - or inequality (see below): - * first N elements correspond to coefficients, - * last element corresponds to the right part. - All elements of C (including right part) must be finite. - CT - type of constraints, array[K]: - * if CT[i]>0, then I-th constraint is C[i,*]*x >= C[i,n+1] - * if CT[i]=0, then I-th constraint is C[i,*]*x = C[i,n+1] - * if CT[i]<0, then I-th constraint is C[i,*]*x <= C[i,n+1] - K - number of equality/inequality constraints, K>=0: - * if given, only leading K elements of C/CT are used - * if not given, automatically determined from sizes of C/CT - -NOTE 1: linear (non-bound) constraints are satisfied only approximately: -* there always exists some minor violation (about Epsilon in magnitude) - due to rounding errors -* numerical differentiation, if used, may lead to function evaluations - outside of the feasible area, because algorithm does NOT change - numerical differentiation formula according to linear constraints. -If you want constraints to be satisfied exactly, try to reformulate your -problem in such manner that all constraints will become boundary ones -(this kind of constraints is always satisfied exactly, both in the final -solution and in all intermediate points). - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetlc(const minbleicstate &state, const real_2d_array &c, const integer_1d_array &ct, const ae_int_t k); -void minbleicsetlc(const minbleicstate &state, const real_2d_array &c, const integer_1d_array &ct); - - -/************************************************************************* -This function sets stopping conditions for the optimizer. - -INPUT PARAMETERS: - State - structure which stores algorithm state - EpsG - >=0 - The subroutine finishes its work if the condition - |v|=0 - The subroutine finishes its work if on k+1-th iteration - the condition |F(k+1)-F(k)|<=EpsF*max{|F(k)|,|F(k+1)|,1} - is satisfied. - EpsX - >=0 - The subroutine finishes its work if on k+1-th iteration - the condition |v|<=EpsX is fulfilled, where: - * |.| means Euclidian norm - * v - scaled step vector, v[i]=dx[i]/s[i] - * dx - step vector, dx=X(k+1)-X(k) - * s - scaling coefficients set by MinBLEICSetScale() - MaxIts - maximum number of iterations. If MaxIts=0, the number of - iterations is unlimited. - -Passing EpsG=0, EpsF=0 and EpsX=0 and MaxIts=0 (simultaneously) will lead -to automatic stopping criterion selection. - -NOTE: when SetCond() called with non-zero MaxIts, BLEIC solver may perform - slightly more than MaxIts iterations. I.e., MaxIts sets non-strict - limit on iterations count. - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetcond(const minbleicstate &state, const double epsg, const double epsf, const double epsx, const ae_int_t maxits); - - -/************************************************************************* -This function sets scaling coefficients for BLEIC optimizer. - -ALGLIB optimizers use scaling matrices to test stopping conditions (step -size and gradient are scaled before comparison with tolerances). Scale of -the I-th variable is a translation invariant measure of: -a) "how large" the variable is -b) how large the step should be to make significant changes in the function - -Scaling is also used by finite difference variant of the optimizer - step -along I-th axis is equal to DiffStep*S[I]. - -In most optimizers (and in the BLEIC too) scaling is NOT a form of -preconditioning. It just affects stopping conditions. You should set -preconditioner by separate call to one of the MinBLEICSetPrec...() -functions. - -There is a special preconditioning mode, however, which uses scaling -coefficients to form diagonal preconditioning matrix. You can turn this -mode on, if you want. But you should understand that scaling is not the -same thing as preconditioning - these are two different, although related -forms of tuning solver. - -INPUT PARAMETERS: - State - structure stores algorithm state - S - array[N], non-zero scaling coefficients - S[i] may be negative, sign doesn't matter. - - -- ALGLIB -- - Copyright 14.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetscale(const minbleicstate &state, const real_1d_array &s); - - -/************************************************************************* -Modification of the preconditioner: preconditioning is turned off. - -INPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetprecdefault(const minbleicstate &state); - - -/************************************************************************* -Modification of the preconditioner: diagonal of approximate Hessian is -used. - -INPUT PARAMETERS: - State - structure which stores algorithm state - D - diagonal of the approximate Hessian, array[0..N-1], - (if larger, only leading N elements are used). - -NOTE 1: D[i] should be positive. Exception will be thrown otherwise. - -NOTE 2: you should pass diagonal of approximate Hessian - NOT ITS INVERSE. - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetprecdiag(const minbleicstate &state, const real_1d_array &d); - - -/************************************************************************* -Modification of the preconditioner: scale-based diagonal preconditioning. - -This preconditioning mode can be useful when you don't have approximate -diagonal of Hessian, but you know that your variables are badly scaled -(for example, one variable is in [1,10], and another in [1000,100000]), -and most part of the ill-conditioning comes from different scales of vars. - -In this case simple scale-based preconditioner, with H[i] = 1/(s[i]^2), -can greatly improve convergence. - -IMPRTANT: you should set scale of your variables with MinBLEICSetScale() -call (before or after MinBLEICSetPrecScale() call). Without knowledge of -the scale of your variables scale-based preconditioner will be just unit -matrix. - -INPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetprecscale(const minbleicstate &state); - - -/************************************************************************* -This function turns on/off reporting. - -INPUT PARAMETERS: - State - structure which stores algorithm state - NeedXRep- whether iteration reports are needed or not - -If NeedXRep is True, algorithm will call rep() callback function if it is -provided to MinBLEICOptimize(). - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetxrep(const minbleicstate &state, const bool needxrep); - - -/************************************************************************* -This function sets maximum step length - -IMPORTANT: this feature is hard to combine with preconditioning. You can't -set upper limit on step length, when you solve optimization problem with -linear (non-boundary) constraints AND preconditioner turned on. - -When non-boundary constraints are present, you have to either a) use -preconditioner, or b) use upper limit on step length. YOU CAN'T USE BOTH! -In this case algorithm will terminate with appropriate error code. - -INPUT PARAMETERS: - State - structure which stores algorithm state - StpMax - maximum step length, >=0. Set StpMax to 0.0, if you don't - want to limit step length. - -Use this subroutine when you optimize target function which contains exp() -or other fast growing functions, and optimization algorithm makes too -large steps which lead to overflow. This function allows us to reject -steps that are too large (and therefore expose us to the possible -overflow) without actually calculating function value at the x+stp*d. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetstpmax(const minbleicstate &state, const double stpmax); - - -/************************************************************************* -This function provides reverse communication interface -Reverse communication interface is not documented or recommended to use. -See below for functions which provide better documented API -*************************************************************************/ -bool minbleiciteration(const minbleicstate &state); - - -/************************************************************************* -This family of functions is used to launcn iterations of nonlinear optimizer - -These functions accept following parameters: - state - algorithm state - func - callback which calculates function (or merit function) - value func at given point x - grad - callback which calculates function (or merit function) - value func and gradient grad at given point x - rep - optional callback which is called after each iteration - can be NULL - ptr - optional pointer which is passed to func/grad/hess/jac/rep - can be NULL - -NOTES: - -1. This function has two different implementations: one which uses exact - (analytical) user-supplied gradient, and one which uses function value - only and numerically differentiates function in order to obtain - gradient. - - Depending on the specific function used to create optimizer object - (either MinBLEICCreate() for analytical gradient or MinBLEICCreateF() - for numerical differentiation) you should choose appropriate variant of - MinBLEICOptimize() - one which accepts function AND gradient or one - which accepts function ONLY. - - Be careful to choose variant of MinBLEICOptimize() which corresponds to - your optimization scheme! Table below lists different combinations of - callback (function/gradient) passed to MinBLEICOptimize() and specific - function used to create optimizer. - - - | USER PASSED TO MinBLEICOptimize() - CREATED WITH | function only | function and gradient - ------------------------------------------------------------ - MinBLEICCreateF() | work FAIL - MinBLEICCreate() | FAIL work - - Here "FAIL" denotes inappropriate combinations of optimizer creation - function and MinBLEICOptimize() version. Attemps to use such - combination (for example, to create optimizer with MinBLEICCreateF() - and to pass gradient information to MinCGOptimize()) will lead to - exception being thrown. Either you did not pass gradient when it WAS - needed or you passed gradient when it was NOT needed. - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey - -*************************************************************************/ -void minbleicoptimize(minbleicstate &state, - void (*func)(const real_1d_array &x, double &func, void *ptr), - void (*rep)(const real_1d_array &x, double func, void *ptr) = NULL, - void *ptr = NULL); -void minbleicoptimize(minbleicstate &state, - void (*grad)(const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), - void (*rep)(const real_1d_array &x, double func, void *ptr) = NULL, - void *ptr = NULL); - - -/************************************************************************* -BLEIC results - -INPUT PARAMETERS: - State - algorithm state - -OUTPUT PARAMETERS: - X - array[0..N-1], solution - Rep - optimization report. You should check Rep.TerminationType - in order to distinguish successful termination from - unsuccessful one: - * -7 gradient verification failed. - See MinBLEICSetGradientCheck() for more information. - * -3 inconsistent constraints. Feasible point is - either nonexistent or too hard to find. Try to - restart optimizer with better initial approximation - * 1 relative function improvement is no more than EpsF. - * 2 scaled step is no more than EpsX. - * 4 scaled gradient norm is no more than EpsG. - * 5 MaxIts steps was taken - More information about fields of this structure can be - found in the comments on MinBLEICReport datatype. - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicresults(const minbleicstate &state, real_1d_array &x, minbleicreport &rep); - - -/************************************************************************* -BLEIC results - -Buffered implementation of MinBLEICResults() which uses pre-allocated buffer -to store X[]. If buffer size is too small, it resizes buffer. It is -intended to be used in the inner cycles of performance critical algorithms -where array reallocation penalty is too large to be ignored. - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicresultsbuf(const minbleicstate &state, real_1d_array &x, minbleicreport &rep); - - -/************************************************************************* -This subroutine restarts algorithm from new point. -All optimization parameters (including constraints) are left unchanged. - -This function allows to solve multiple optimization problems (which -must have same number of dimensions) without object reallocation penalty. - -INPUT PARAMETERS: - State - structure previously allocated with MinBLEICCreate call. - X - new starting point. - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicrestartfrom(const minbleicstate &state, const real_1d_array &x); - - -/************************************************************************* -This subroutine turns on verification of the user-supplied analytic -gradient: -* user calls this subroutine before optimization begins -* MinBLEICOptimize() is called -* prior to actual optimization, for each component of parameters being - optimized X[i] algorithm performs following steps: - * two trial steps are made to X[i]-TestStep*S[i] and X[i]+TestStep*S[i], - where X[i] is i-th component of the initial point and S[i] is a scale - of i-th parameter - * if needed, steps are bounded with respect to constraints on X[] - * F(X) is evaluated at these trial points - * we perform one more evaluation in the middle point of the interval - * we build cubic model using function values and derivatives at trial - points and we compare its prediction with actual value in the middle - point - * in case difference between prediction and actual value is higher than - some predetermined threshold, algorithm stops with completion code -7; - Rep.VarIdx is set to index of the parameter with incorrect derivative. -* after verification is over, algorithm proceeds to the actual optimization. - -NOTE 1: verification needs N (parameters count) gradient evaluations. It - is very costly and you should use it only for low dimensional - problems, when you want to be sure that you've correctly - calculated analytic derivatives. You should not use it in the - production code (unless you want to check derivatives provided by - some third party). - -NOTE 2: you should carefully choose TestStep. Value which is too large - (so large that function behaviour is significantly non-cubic) will - lead to false alarms. You may use different step for different - parameters by means of setting scale with MinBLEICSetScale(). - -NOTE 3: this function may lead to false positives. In case it reports that - I-th derivative was calculated incorrectly, you may decrease test - step and try one more time - maybe your function changes too - sharply and your step is too large for such rapidly chanding - function. - -INPUT PARAMETERS: - State - structure used to store algorithm state - TestStep - verification step: - * TestStep=0 turns verification off - * TestStep>0 activates verification - - -- ALGLIB -- - Copyright 15.06.2012 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetgradientcheck(const minbleicstate &state, const double teststep); - -/************************************************************************* - LIMITED MEMORY BFGS METHOD FOR LARGE SCALE OPTIMIZATION - -DESCRIPTION: -The subroutine minimizes function F(x) of N arguments by using a quasi- -Newton method (LBFGS scheme) which is optimized to use a minimum amount -of memory. -The subroutine generates the approximation of an inverse Hessian matrix by -using information about the last M steps of the algorithm (instead of N). -It lessens a required amount of memory from a value of order N^2 to a -value of order 2*N*M. - - -REQUIREMENTS: -Algorithm will request following information during its operation: -* function value F and its gradient G (simultaneously) at given point X - - -USAGE: -1. User initializes algorithm state with MinLBFGSCreate() call -2. User tunes solver parameters with MinLBFGSSetCond() MinLBFGSSetStpMax() - and other functions -3. User calls MinLBFGSOptimize() function which takes algorithm state and - pointer (delegate, etc.) to callback function which calculates F/G. -4. User calls MinLBFGSResults() to get solution -5. Optionally user may call MinLBFGSRestartFrom() to solve another problem - with same N/M but another starting point and/or another function. - MinLBFGSRestartFrom() allows to reuse already initialized structure. - - -INPUT PARAMETERS: - N - problem dimension. N>0 - M - number of corrections in the BFGS scheme of Hessian - approximation update. Recommended value: 3<=M<=7. The smaller - value causes worse convergence, the bigger will not cause a - considerably better convergence, but will cause a fall in the - performance. M<=N. - X - initial solution approximation, array[0..N-1]. - - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -NOTES: -1. you may tune stopping conditions with MinLBFGSSetCond() function -2. if target function contains exp() or other fast growing functions, and - optimization algorithm makes too large steps which leads to overflow, - use MinLBFGSSetStpMax() function to bound algorithm's steps. However, - L-BFGS rarely needs such a tuning. - - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgscreate(const ae_int_t n, const ae_int_t m, const real_1d_array &x, minlbfgsstate &state); -void minlbfgscreate(const ae_int_t m, const real_1d_array &x, minlbfgsstate &state); - - -/************************************************************************* -The subroutine is finite difference variant of MinLBFGSCreate(). It uses -finite differences in order to differentiate target function. - -Description below contains information which is specific to this function -only. We recommend to read comments on MinLBFGSCreate() in order to get -more information about creation of LBFGS optimizer. - -INPUT PARAMETERS: - N - problem dimension, N>0: - * if given, only leading N elements of X are used - * if not given, automatically determined from size of X - M - number of corrections in the BFGS scheme of Hessian - approximation update. Recommended value: 3<=M<=7. The smaller - value causes worse convergence, the bigger will not cause a - considerably better convergence, but will cause a fall in the - performance. M<=N. - X - starting point, array[0..N-1]. - DiffStep- differentiation step, >0 - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -NOTES: -1. algorithm uses 4-point central formula for differentiation. -2. differentiation step along I-th axis is equal to DiffStep*S[I] where - S[] is scaling vector which can be set by MinLBFGSSetScale() call. -3. we recommend you to use moderate values of differentiation step. Too - large step will result in too large truncation errors, while too small - step will result in too large numerical errors. 1.0E-6 can be good - value to start with. -4. Numerical differentiation is very inefficient - one gradient - calculation needs 4*N function evaluations. This function will work for - any N - either small (1...10), moderate (10...100) or large (100...). - However, performance penalty will be too severe for any N's except for - small ones. - We should also say that code which relies on numerical differentiation - is less robust and precise. LBFGS needs exact gradient values. - Imprecise gradient may slow down convergence, especially on highly - nonlinear problems. - Thus we recommend to use this function for fast prototyping on small- - dimensional problems only, and to implement analytical gradient as soon - as possible. - - -- ALGLIB -- - Copyright 16.05.2011 by Bochkanov Sergey -*************************************************************************/ -void minlbfgscreatef(const ae_int_t n, const ae_int_t m, const real_1d_array &x, const double diffstep, minlbfgsstate &state); -void minlbfgscreatef(const ae_int_t m, const real_1d_array &x, const double diffstep, minlbfgsstate &state); - - -/************************************************************************* -This function sets stopping conditions for L-BFGS optimization algorithm. - -INPUT PARAMETERS: - State - structure which stores algorithm state - EpsG - >=0 - The subroutine finishes its work if the condition - |v|=0 - The subroutine finishes its work if on k+1-th iteration - the condition |F(k+1)-F(k)|<=EpsF*max{|F(k)|,|F(k+1)|,1} - is satisfied. - EpsX - >=0 - The subroutine finishes its work if on k+1-th iteration - the condition |v|<=EpsX is fulfilled, where: - * |.| means Euclidian norm - * v - scaled step vector, v[i]=dx[i]/s[i] - * dx - ste pvector, dx=X(k+1)-X(k) - * s - scaling coefficients set by MinLBFGSSetScale() - MaxIts - maximum number of iterations. If MaxIts=0, the number of - iterations is unlimited. - -Passing EpsG=0, EpsF=0, EpsX=0 and MaxIts=0 (simultaneously) will lead to -automatic stopping criterion selection (small EpsX). - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetcond(const minlbfgsstate &state, const double epsg, const double epsf, const double epsx, const ae_int_t maxits); - - -/************************************************************************* -This function turns on/off reporting. - -INPUT PARAMETERS: - State - structure which stores algorithm state - NeedXRep- whether iteration reports are needed or not - -If NeedXRep is True, algorithm will call rep() callback function if it is -provided to MinLBFGSOptimize(). - - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetxrep(const minlbfgsstate &state, const bool needxrep); - - -/************************************************************************* -This function sets maximum step length - -INPUT PARAMETERS: - State - structure which stores algorithm state - StpMax - maximum step length, >=0. Set StpMax to 0.0 (default), if - you don't want to limit step length. - -Use this subroutine when you optimize target function which contains exp() -or other fast growing functions, and optimization algorithm makes too -large steps which leads to overflow. This function allows us to reject -steps that are too large (and therefore expose us to the possible -overflow) without actually calculating function value at the x+stp*d. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetstpmax(const minlbfgsstate &state, const double stpmax); - - -/************************************************************************* -This function sets scaling coefficients for LBFGS optimizer. - -ALGLIB optimizers use scaling matrices to test stopping conditions (step -size and gradient are scaled before comparison with tolerances). Scale of -the I-th variable is a translation invariant measure of: -a) "how large" the variable is -b) how large the step should be to make significant changes in the function - -Scaling is also used by finite difference variant of the optimizer - step -along I-th axis is equal to DiffStep*S[I]. - -In most optimizers (and in the LBFGS too) scaling is NOT a form of -preconditioning. It just affects stopping conditions. You should set -preconditioner by separate call to one of the MinLBFGSSetPrec...() -functions. - -There is special preconditioning mode, however, which uses scaling -coefficients to form diagonal preconditioning matrix. You can turn this -mode on, if you want. But you should understand that scaling is not the -same thing as preconditioning - these are two different, although related -forms of tuning solver. - -INPUT PARAMETERS: - State - structure stores algorithm state - S - array[N], non-zero scaling coefficients - S[i] may be negative, sign doesn't matter. - - -- ALGLIB -- - Copyright 14.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetscale(const minlbfgsstate &state, const real_1d_array &s); - - -/************************************************************************* -Modification of the preconditioner: default preconditioner (simple -scaling, same for all elements of X) is used. - -INPUT PARAMETERS: - State - structure which stores algorithm state - -NOTE: you can change preconditioner "on the fly", during algorithm -iterations. - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetprecdefault(const minlbfgsstate &state); - - -/************************************************************************* -Modification of the preconditioner: Cholesky factorization of approximate -Hessian is used. - -INPUT PARAMETERS: - State - structure which stores algorithm state - P - triangular preconditioner, Cholesky factorization of - the approximate Hessian. array[0..N-1,0..N-1], - (if larger, only leading N elements are used). - IsUpper - whether upper or lower triangle of P is given - (other triangle is not referenced) - -After call to this function preconditioner is changed to P (P is copied -into the internal buffer). - -NOTE: you can change preconditioner "on the fly", during algorithm -iterations. - -NOTE 2: P should be nonsingular. Exception will be thrown otherwise. - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetpreccholesky(const minlbfgsstate &state, const real_2d_array &p, const bool isupper); - - -/************************************************************************* -Modification of the preconditioner: diagonal of approximate Hessian is -used. - -INPUT PARAMETERS: - State - structure which stores algorithm state - D - diagonal of the approximate Hessian, array[0..N-1], - (if larger, only leading N elements are used). - -NOTE: you can change preconditioner "on the fly", during algorithm -iterations. - -NOTE 2: D[i] should be positive. Exception will be thrown otherwise. - -NOTE 3: you should pass diagonal of approximate Hessian - NOT ITS INVERSE. - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetprecdiag(const minlbfgsstate &state, const real_1d_array &d); - - -/************************************************************************* -Modification of the preconditioner: scale-based diagonal preconditioning. - -This preconditioning mode can be useful when you don't have approximate -diagonal of Hessian, but you know that your variables are badly scaled -(for example, one variable is in [1,10], and another in [1000,100000]), -and most part of the ill-conditioning comes from different scales of vars. - -In this case simple scale-based preconditioner, with H[i] = 1/(s[i]^2), -can greatly improve convergence. - -IMPRTANT: you should set scale of your variables with MinLBFGSSetScale() -call (before or after MinLBFGSSetPrecScale() call). Without knowledge of -the scale of your variables scale-based preconditioner will be just unit -matrix. - -INPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetprecscale(const minlbfgsstate &state); - - -/************************************************************************* -This function provides reverse communication interface -Reverse communication interface is not documented or recommended to use. -See below for functions which provide better documented API -*************************************************************************/ -bool minlbfgsiteration(const minlbfgsstate &state); - - -/************************************************************************* -This family of functions is used to launcn iterations of nonlinear optimizer - -These functions accept following parameters: - state - algorithm state - func - callback which calculates function (or merit function) - value func at given point x - grad - callback which calculates function (or merit function) - value func and gradient grad at given point x - rep - optional callback which is called after each iteration - can be NULL - ptr - optional pointer which is passed to func/grad/hess/jac/rep - can be NULL - -NOTES: - -1. This function has two different implementations: one which uses exact - (analytical) user-supplied gradient, and one which uses function value - only and numerically differentiates function in order to obtain - gradient. - - Depending on the specific function used to create optimizer object - (either MinLBFGSCreate() for analytical gradient or MinLBFGSCreateF() - for numerical differentiation) you should choose appropriate variant of - MinLBFGSOptimize() - one which accepts function AND gradient or one - which accepts function ONLY. - - Be careful to choose variant of MinLBFGSOptimize() which corresponds to - your optimization scheme! Table below lists different combinations of - callback (function/gradient) passed to MinLBFGSOptimize() and specific - function used to create optimizer. - - - | USER PASSED TO MinLBFGSOptimize() - CREATED WITH | function only | function and gradient - ------------------------------------------------------------ - MinLBFGSCreateF() | work FAIL - MinLBFGSCreate() | FAIL work - - Here "FAIL" denotes inappropriate combinations of optimizer creation - function and MinLBFGSOptimize() version. Attemps to use such - combination (for example, to create optimizer with MinLBFGSCreateF() and - to pass gradient information to MinCGOptimize()) will lead to exception - being thrown. Either you did not pass gradient when it WAS needed or - you passed gradient when it was NOT needed. - - -- ALGLIB -- - Copyright 20.03.2009 by Bochkanov Sergey - -*************************************************************************/ -void minlbfgsoptimize(minlbfgsstate &state, - void (*func)(const real_1d_array &x, double &func, void *ptr), - void (*rep)(const real_1d_array &x, double func, void *ptr) = NULL, - void *ptr = NULL); -void minlbfgsoptimize(minlbfgsstate &state, - void (*grad)(const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), - void (*rep)(const real_1d_array &x, double func, void *ptr) = NULL, - void *ptr = NULL); - - -/************************************************************************* -L-BFGS algorithm results - -INPUT PARAMETERS: - State - algorithm state - -OUTPUT PARAMETERS: - X - array[0..N-1], solution - Rep - optimization report: - * Rep.TerminationType completion code: - * -7 gradient verification failed. - See MinLBFGSSetGradientCheck() for more information. - * -2 rounding errors prevent further improvement. - X contains best point found. - * -1 incorrect parameters were specified - * 1 relative function improvement is no more than - EpsF. - * 2 relative step is no more than EpsX. - * 4 gradient norm is no more than EpsG - * 5 MaxIts steps was taken - * 7 stopping conditions are too stringent, - further improvement is impossible - * Rep.IterationsCount contains iterations count - * NFEV contains number of function calculations - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgsresults(const minlbfgsstate &state, real_1d_array &x, minlbfgsreport &rep); - - -/************************************************************************* -L-BFGS algorithm results - -Buffered implementation of MinLBFGSResults which uses pre-allocated buffer -to store X[]. If buffer size is too small, it resizes buffer. It is -intended to be used in the inner cycles of performance critical algorithms -where array reallocation penalty is too large to be ignored. - - -- ALGLIB -- - Copyright 20.08.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgsresultsbuf(const minlbfgsstate &state, real_1d_array &x, minlbfgsreport &rep); - - -/************************************************************************* -This subroutine restarts LBFGS algorithm from new point. All optimization -parameters are left unchanged. - -This function allows to solve multiple optimization problems (which -must have same number of dimensions) without object reallocation penalty. - -INPUT PARAMETERS: - State - structure used to store algorithm state - X - new starting point. - - -- ALGLIB -- - Copyright 30.07.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgsrestartfrom(const minlbfgsstate &state, const real_1d_array &x); - - -/************************************************************************* -This subroutine turns on verification of the user-supplied analytic -gradient: -* user calls this subroutine before optimization begins -* MinLBFGSOptimize() is called -* prior to actual optimization, for each component of parameters being - optimized X[i] algorithm performs following steps: - * two trial steps are made to X[i]-TestStep*S[i] and X[i]+TestStep*S[i], - where X[i] is i-th component of the initial point and S[i] is a scale - of i-th parameter - * if needed, steps are bounded with respect to constraints on X[] - * F(X) is evaluated at these trial points - * we perform one more evaluation in the middle point of the interval - * we build cubic model using function values and derivatives at trial - points and we compare its prediction with actual value in the middle - point - * in case difference between prediction and actual value is higher than - some predetermined threshold, algorithm stops with completion code -7; - Rep.VarIdx is set to index of the parameter with incorrect derivative. -* after verification is over, algorithm proceeds to the actual optimization. - -NOTE 1: verification needs N (parameters count) gradient evaluations. It - is very costly and you should use it only for low dimensional - problems, when you want to be sure that you've correctly - calculated analytic derivatives. You should not use it in the - production code (unless you want to check derivatives provided by - some third party). - -NOTE 2: you should carefully choose TestStep. Value which is too large - (so large that function behaviour is significantly non-cubic) will - lead to false alarms. You may use different step for different - parameters by means of setting scale with MinLBFGSSetScale(). - -NOTE 3: this function may lead to false positives. In case it reports that - I-th derivative was calculated incorrectly, you may decrease test - step and try one more time - maybe your function changes too - sharply and your step is too large for such rapidly chanding - function. - -INPUT PARAMETERS: - State - structure used to store algorithm state - TestStep - verification step: - * TestStep=0 turns verification off - * TestStep>0 activates verification - - -- ALGLIB -- - Copyright 24.05.2012 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetgradientcheck(const minlbfgsstate &state, const double teststep); - -/************************************************************************* - CONSTRAINED QUADRATIC PROGRAMMING - -The subroutine creates QP optimizer. After initial creation, it contains -default optimization problem with zero quadratic and linear terms and no -constraints. You should set quadratic/linear terms with calls to functions -provided by MinQP subpackage. - -INPUT PARAMETERS: - N - problem size - -OUTPUT PARAMETERS: - State - optimizer with zero quadratic/linear terms - and no constraints - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpcreate(const ae_int_t n, minqpstate &state); - - -/************************************************************************* -This function sets linear term for QP solver. - -By default, linear term is zero. - -INPUT PARAMETERS: - State - structure which stores algorithm state - B - linear term, array[N]. - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpsetlinearterm(const minqpstate &state, const real_1d_array &b); - - -/************************************************************************* -This function sets dense quadratic term for QP solver. By default, -quadratic term is zero. - -SUPPORT BY ALGLIB QP ALGORITHMS: - -Dense quadratic term can be handled by any of the QP algorithms supported -by ALGLIB QP Solver. - -IMPORTANT: - -This solver minimizes following function: - f(x) = 0.5*x'*A*x + b'*x. -Note that quadratic term has 0.5 before it. So if you want to minimize - f(x) = x^2 + x -you should rewrite your problem as follows: - f(x) = 0.5*(2*x^2) + x -and your matrix A will be equal to [[2.0]], not to [[1.0]] - -INPUT PARAMETERS: - State - structure which stores algorithm state - A - matrix, array[N,N] - IsUpper - (optional) storage type: - * if True, symmetric matrix A is given by its upper - triangle, and the lower triangle isn’t used - * if False, symmetric matrix A is given by its lower - triangle, and the upper triangle isn’t used - * if not given, both lower and upper triangles must be - filled. - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpsetquadraticterm(const minqpstate &state, const real_2d_array &a, const bool isupper); -void minqpsetquadraticterm(const minqpstate &state, const real_2d_array &a); - - -/************************************************************************* -This function sets sparse quadratic term for QP solver. By default, -quadratic term is zero. - -SUPPORT BY ALGLIB QP ALGORITHMS: - -Sparse quadratic term is supported only by BLEIC-based QP algorithm (one -which is activated by MinQPSetAlgoBLEIC function). Cholesky-based QP algo -won't be able to deal with sparse quadratic term and will terminate -abnormally. - -IF YOU CALLED THIS FUNCTION, YOU MUST SWITCH TO BLEIC-BASED QP ALGORITHM -BEFORE CALLING MINQPOPTIMIZE() FUNCTION. - -IMPORTANT: - -This solver minimizes following function: - f(x) = 0.5*x'*A*x + b'*x. -Note that quadratic term has 0.5 before it. So if you want to minimize - f(x) = x^2 + x -you should rewrite your problem as follows: - f(x) = 0.5*(2*x^2) + x -and your matrix A will be equal to [[2.0]], not to [[1.0]] - -INPUT PARAMETERS: - State - structure which stores algorithm state - A - matrix, array[N,N] - IsUpper - (optional) storage type: - * if True, symmetric matrix A is given by its upper - triangle, and the lower triangle isn’t used - * if False, symmetric matrix A is given by its lower - triangle, and the upper triangle isn’t used - * if not given, both lower and upper triangles must be - filled. - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpsetquadratictermsparse(const minqpstate &state, const sparsematrix &a, const bool isupper); - - -/************************************************************************* -This function sets starting point for QP solver. It is useful to have -good initial approximation to the solution, because it will increase -speed of convergence and identification of active constraints. - -INPUT PARAMETERS: - State - structure which stores algorithm state - X - starting point, array[N]. - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpsetstartingpoint(const minqpstate &state, const real_1d_array &x); - - -/************************************************************************* -This function sets origin for QP solver. By default, following QP program -is solved: - - min(0.5*x'*A*x+b'*x) - -This function allows to solve different problem: - - min(0.5*(x-x_origin)'*A*(x-x_origin)+b'*(x-x_origin)) - -INPUT PARAMETERS: - State - structure which stores algorithm state - XOrigin - origin, array[N]. - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpsetorigin(const minqpstate &state, const real_1d_array &xorigin); - - -/************************************************************************* -This function sets scaling coefficients. - -ALGLIB optimizers use scaling matrices to test stopping conditions (step -size and gradient are scaled before comparison with tolerances). Scale of -the I-th variable is a translation invariant measure of: -a) "how large" the variable is -b) how large the step should be to make significant changes in the function - -BLEIC-based QP solver uses scale for two purposes: -* to evaluate stopping conditions -* for preconditioning of the underlying BLEIC solver - -INPUT PARAMETERS: - State - structure stores algorithm state - S - array[N], non-zero scaling coefficients - S[i] may be negative, sign doesn't matter. - - -- ALGLIB -- - Copyright 14.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpsetscale(const minqpstate &state, const real_1d_array &s); - - -/************************************************************************* -This function tells solver to use Cholesky-based algorithm. This algorithm -is active by default. - -DESCRIPTION: - -Cholesky-based algorithm can be used only for problems which: -* have dense quadratic term, set by MinQPSetQuadraticTerm(), sparse or - structured problems are not supported. -* are strictly convex, i.e. quadratic term is symmetric positive definite, - indefinite or semidefinite problems are not supported by this algorithm. - -If anything of what listed above is violated, you may use BLEIC-based QP -algorithm which can be activated by MinQPSetAlgoBLEIC(). - -BENEFITS AND DRAWBACKS: - -This algorithm gives best precision amongst all QP solvers provided by -ALGLIB (Newton iterations have much higher precision than any other -optimization algorithm). This solver also gracefully handles problems with -very large amount of constraints. - -Performance of the algorithm is good because internally it uses Level 3 -Dense BLAS for its performance-critical parts. - - -From the other side, algorithm has O(N^3) complexity for unconstrained -problems and up to orders of magnitude slower on constrained problems -(these additional iterations are needed to identify active constraints). -So, its running time depends on number of constraints active at solution. - -Furthermore, this algorithm can not solve problems with sparse matrices or -problems with semidefinite/indefinite matrices of any kind (dense/sparse). - -INPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpsetalgocholesky(const minqpstate &state); - - -/************************************************************************* -This function tells solver to use BLEIC-based algorithm and sets stopping -criteria for the algorithm. - -DESCRIPTION: - -BLEIC-based QP algorithm can be used for any kind of QP problems: -* problems with both dense and sparse quadratic terms -* problems with positive definite, semidefinite, indefinite terms - -BLEIC-based algorithm can solve even indefinite problems - as long as they -are bounded from below on the feasible set. Of course, global minimum is -found only for positive definite and semidefinite problems. As for -indefinite ones - only local minimum is found. - -BENEFITS AND DRAWBACKS: - -This algorithm can be used to solve both convex and indefinite QP problems -and it can utilize sparsity of the quadratic term (algorithm calculates -matrix-vector products, which can be performed efficiently in case of -sparse matrix). - -Algorithm has iteration cost, which (assuming fixed amount of non-boundary -linear constraints) linearly depends on problem size. Boundary constraints -does not significantly change iteration cost. - -Thus, it outperforms Cholesky-based QP algorithm (CQP) on high-dimensional -sparse problems with moderate amount of constraints. - - -From the other side, unlike CQP solver, this algorithm does NOT make use -of Level 3 Dense BLAS. Thus, its performance on dense problems is inferior -to that of CQP solver. - -Its precision is also inferior to that of CQP. CQP performs Newton steps -which are know to achieve very good precision. In many cases Newton step -leads us exactly to the solution. BLEIC-QP performs LBFGS steps, which are -good at detecting neighborhood of the solution, buy need many iterations -to find solution with 6 digits of precision. - -INPUT PARAMETERS: - State - structure which stores algorithm state - EpsG - >=0 - The subroutine finishes its work if the condition - |v|=0 - The subroutine finishes its work if exploratory steepest - descent step on k+1-th iteration satisfies following - condition: |F(k+1)-F(k)|<=EpsF*max{|F(k)|,|F(k+1)|,1} - EpsX - >=0 - The subroutine finishes its work if exploratory steepest - descent step on k+1-th iteration satisfies following - condition: - * |.| means Euclidian norm - * v - scaled step vector, v[i]=dx[i]/s[i] - * dx - step vector, dx=X(k+1)-X(k) - * s - scaling coefficients set by MinQPSetScale() - MaxIts - maximum number of iterations. If MaxIts=0, the number of - iterations is unlimited. - -Passing EpsG=0, EpsF=0 and EpsX=0 and MaxIts=0 (simultaneously) will lead -to automatic stopping criterion selection (presently it is small step -length, but it may change in the future versions of ALGLIB). - -IT IS VERY IMPORTANT THAT YOU CALL MinQPSetScale() WHEN YOU USE THIS ALGO! - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpsetalgobleic(const minqpstate &state, const double epsg, const double epsf, const double epsx, const ae_int_t maxits); - - -/************************************************************************* -This function sets boundary constraints for QP solver - -Boundary constraints are inactive by default (after initial creation). -After being set, they are preserved until explicitly turned off with -another SetBC() call. - -INPUT PARAMETERS: - State - structure stores algorithm state - BndL - lower bounds, array[N]. - If some (all) variables are unbounded, you may specify - very small number or -INF (latter is recommended because - it will allow solver to use better algorithm). - BndU - upper bounds, array[N]. - If some (all) variables are unbounded, you may specify - very large number or +INF (latter is recommended because - it will allow solver to use better algorithm). - -NOTE: it is possible to specify BndL[i]=BndU[i]. In this case I-th -variable will be "frozen" at X[i]=BndL[i]=BndU[i]. - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpsetbc(const minqpstate &state, const real_1d_array &bndl, const real_1d_array &bndu); - - -/************************************************************************* -This function sets linear constraints for QP optimizer. - -Linear constraints are inactive by default (after initial creation). - -INPUT PARAMETERS: - State - structure previously allocated with MinQPCreate call. - C - linear constraints, array[K,N+1]. - Each row of C represents one constraint, either equality - or inequality (see below): - * first N elements correspond to coefficients, - * last element corresponds to the right part. - All elements of C (including right part) must be finite. - CT - type of constraints, array[K]: - * if CT[i]>0, then I-th constraint is C[i,*]*x >= C[i,n+1] - * if CT[i]=0, then I-th constraint is C[i,*]*x = C[i,n+1] - * if CT[i]<0, then I-th constraint is C[i,*]*x <= C[i,n+1] - K - number of equality/inequality constraints, K>=0: - * if given, only leading K elements of C/CT are used - * if not given, automatically determined from sizes of C/CT - -NOTE 1: linear (non-bound) constraints are satisfied only approximately - - there always exists some minor violation (about 10^-10...10^-13) - due to numerical errors. - - -- ALGLIB -- - Copyright 19.06.2012 by Bochkanov Sergey -*************************************************************************/ -void minqpsetlc(const minqpstate &state, const real_2d_array &c, const integer_1d_array &ct, const ae_int_t k); -void minqpsetlc(const minqpstate &state, const real_2d_array &c, const integer_1d_array &ct); - - -/************************************************************************* -This function solves quadratic programming problem. -You should call it after setting solver options with MinQPSet...() calls. - -INPUT PARAMETERS: - State - algorithm state - -You should use MinQPResults() function to access results after calls -to this function. - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey. - Special thanks to Elvira Illarionova for important suggestions on - the linearly constrained QP algorithm. -*************************************************************************/ -void minqpoptimize(const minqpstate &state); - - -/************************************************************************* -QP solver results - -INPUT PARAMETERS: - State - algorithm state - -OUTPUT PARAMETERS: - X - array[0..N-1], solution. - This array is allocated and initialized only when - Rep.TerminationType parameter is positive (success). - Rep - optimization report. You should check Rep.TerminationType, - which contains completion code, and you may check another - fields which contain another information about algorithm - functioning. - - Failure codes returned by algorithm are: - * -5 inappropriate solver was used: - * Cholesky solver for (semi)indefinite problems - * Cholesky solver for problems with sparse matrix - * -4 BLEIC-QP algorithm found unconstrained direction - of negative curvature (function is unbounded from - below even under constraints), no meaningful - minimum can be found. - * -3 inconsistent constraints (or maybe feasible point - is too hard to find). If you are sure that - constraints are feasible, try to restart optimizer - with better initial approximation. - - Completion codes specific for Cholesky algorithm: - * 4 successful completion - - Completion codes specific for BLEIC-based algorithm: - * 1 relative function improvement is no more than EpsF. - * 2 scaled step is no more than EpsX. - * 4 scaled gradient norm is no more than EpsG. - * 5 MaxIts steps was taken - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpresults(const minqpstate &state, real_1d_array &x, minqpreport &rep); - - -/************************************************************************* -QP results - -Buffered implementation of MinQPResults() which uses pre-allocated buffer -to store X[]. If buffer size is too small, it resizes buffer. It is -intended to be used in the inner cycles of performance critical algorithms -where array reallocation penalty is too large to be ignored. - - -- ALGLIB -- - Copyright 11.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minqpresultsbuf(const minqpstate &state, real_1d_array &x, minqpreport &rep); - -/************************************************************************* - IMPROVED LEVENBERG-MARQUARDT METHOD FOR - NON-LINEAR LEAST SQUARES OPTIMIZATION - -DESCRIPTION: -This function is used to find minimum of function which is represented as -sum of squares: - F(x) = f[0]^2(x[0],...,x[n-1]) + ... + f[m-1]^2(x[0],...,x[n-1]) -using value of function vector f[] and Jacobian of f[]. - - -REQUIREMENTS: -This algorithm will request following information during its operation: - -* function vector f[] at given point X -* function vector f[] and Jacobian of f[] (simultaneously) at given point - -There are several overloaded versions of MinLMOptimize() function which -correspond to different LM-like optimization algorithms provided by this -unit. You should choose version which accepts fvec() and jac() callbacks. -First one is used to calculate f[] at given point, second one calculates -f[] and Jacobian df[i]/dx[j]. - -You can try to initialize MinLMState structure with VJ function and then -use incorrect version of MinLMOptimize() (for example, version which -works with general form function and does not provide Jacobian), but it -will lead to exception being thrown after first attempt to calculate -Jacobian. - - -USAGE: -1. User initializes algorithm state with MinLMCreateVJ() call -2. User tunes solver parameters with MinLMSetCond(), MinLMSetStpMax() and - other functions -3. User calls MinLMOptimize() function which takes algorithm state and - callback functions. -4. User calls MinLMResults() to get solution -5. Optionally, user may call MinLMRestartFrom() to solve another problem - with same N/M but another starting point and/or another function. - MinLMRestartFrom() allows to reuse already initialized structure. - - -INPUT PARAMETERS: - N - dimension, N>1 - * if given, only leading N elements of X are used - * if not given, automatically determined from size of X - M - number of functions f[i] - X - initial solution, array[0..N-1] - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -NOTES: -1. you may tune stopping conditions with MinLMSetCond() function -2. if target function contains exp() or other fast growing functions, and - optimization algorithm makes too large steps which leads to overflow, - use MinLMSetStpMax() function to bound algorithm's steps. - - -- ALGLIB -- - Copyright 30.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minlmcreatevj(const ae_int_t n, const ae_int_t m, const real_1d_array &x, minlmstate &state); -void minlmcreatevj(const ae_int_t m, const real_1d_array &x, minlmstate &state); - - -/************************************************************************* - IMPROVED LEVENBERG-MARQUARDT METHOD FOR - NON-LINEAR LEAST SQUARES OPTIMIZATION - -DESCRIPTION: -This function is used to find minimum of function which is represented as -sum of squares: - F(x) = f[0]^2(x[0],...,x[n-1]) + ... + f[m-1]^2(x[0],...,x[n-1]) -using value of function vector f[] only. Finite differences are used to -calculate Jacobian. - - -REQUIREMENTS: -This algorithm will request following information during its operation: -* function vector f[] at given point X - -There are several overloaded versions of MinLMOptimize() function which -correspond to different LM-like optimization algorithms provided by this -unit. You should choose version which accepts fvec() callback. - -You can try to initialize MinLMState structure with VJ function and then -use incorrect version of MinLMOptimize() (for example, version which -works with general form function and does not accept function vector), but -it will lead to exception being thrown after first attempt to calculate -Jacobian. - - -USAGE: -1. User initializes algorithm state with MinLMCreateV() call -2. User tunes solver parameters with MinLMSetCond(), MinLMSetStpMax() and - other functions -3. User calls MinLMOptimize() function which takes algorithm state and - callback functions. -4. User calls MinLMResults() to get solution -5. Optionally, user may call MinLMRestartFrom() to solve another problem - with same N/M but another starting point and/or another function. - MinLMRestartFrom() allows to reuse already initialized structure. - - -INPUT PARAMETERS: - N - dimension, N>1 - * if given, only leading N elements of X are used - * if not given, automatically determined from size of X - M - number of functions f[i] - X - initial solution, array[0..N-1] - DiffStep- differentiation step, >0 - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -See also MinLMIteration, MinLMResults. - -NOTES: -1. you may tune stopping conditions with MinLMSetCond() function -2. if target function contains exp() or other fast growing functions, and - optimization algorithm makes too large steps which leads to overflow, - use MinLMSetStpMax() function to bound algorithm's steps. - - -- ALGLIB -- - Copyright 30.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minlmcreatev(const ae_int_t n, const ae_int_t m, const real_1d_array &x, const double diffstep, minlmstate &state); -void minlmcreatev(const ae_int_t m, const real_1d_array &x, const double diffstep, minlmstate &state); - - -/************************************************************************* - LEVENBERG-MARQUARDT-LIKE METHOD FOR NON-LINEAR OPTIMIZATION - -DESCRIPTION: -This function is used to find minimum of general form (not "sum-of- --squares") function - F = F(x[0], ..., x[n-1]) -using its gradient and Hessian. Levenberg-Marquardt modification with -L-BFGS pre-optimization and internal pre-conditioned L-BFGS optimization -after each Levenberg-Marquardt step is used. - - -REQUIREMENTS: -This algorithm will request following information during its operation: - -* function value F at given point X -* F and gradient G (simultaneously) at given point X -* F, G and Hessian H (simultaneously) at given point X - -There are several overloaded versions of MinLMOptimize() function which -correspond to different LM-like optimization algorithms provided by this -unit. You should choose version which accepts func(), grad() and hess() -function pointers. First pointer is used to calculate F at given point, -second one calculates F(x) and grad F(x), third one calculates F(x), -grad F(x), hess F(x). - -You can try to initialize MinLMState structure with FGH-function and then -use incorrect version of MinLMOptimize() (for example, version which does -not provide Hessian matrix), but it will lead to exception being thrown -after first attempt to calculate Hessian. - - -USAGE: -1. User initializes algorithm state with MinLMCreateFGH() call -2. User tunes solver parameters with MinLMSetCond(), MinLMSetStpMax() and - other functions -3. User calls MinLMOptimize() function which takes algorithm state and - pointers (delegates, etc.) to callback functions. -4. User calls MinLMResults() to get solution -5. Optionally, user may call MinLMRestartFrom() to solve another problem - with same N but another starting point and/or another function. - MinLMRestartFrom() allows to reuse already initialized structure. - - -INPUT PARAMETERS: - N - dimension, N>1 - * if given, only leading N elements of X are used - * if not given, automatically determined from size of X - X - initial solution, array[0..N-1] - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -NOTES: -1. you may tune stopping conditions with MinLMSetCond() function -2. if target function contains exp() or other fast growing functions, and - optimization algorithm makes too large steps which leads to overflow, - use MinLMSetStpMax() function to bound algorithm's steps. - - -- ALGLIB -- - Copyright 30.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minlmcreatefgh(const ae_int_t n, const real_1d_array &x, minlmstate &state); -void minlmcreatefgh(const real_1d_array &x, minlmstate &state); - - -/************************************************************************* -This function sets stopping conditions for Levenberg-Marquardt optimization -algorithm. - -INPUT PARAMETERS: - State - structure which stores algorithm state - EpsG - >=0 - The subroutine finishes its work if the condition - |v|=0 - The subroutine finishes its work if on k+1-th iteration - the condition |F(k+1)-F(k)|<=EpsF*max{|F(k)|,|F(k+1)|,1} - is satisfied. - EpsX - >=0 - The subroutine finishes its work if on k+1-th iteration - the condition |v|<=EpsX is fulfilled, where: - * |.| means Euclidian norm - * v - scaled step vector, v[i]=dx[i]/s[i] - * dx - ste pvector, dx=X(k+1)-X(k) - * s - scaling coefficients set by MinLMSetScale() - MaxIts - maximum number of iterations. If MaxIts=0, the number of - iterations is unlimited. Only Levenberg-Marquardt - iterations are counted (L-BFGS/CG iterations are NOT - counted because their cost is very low compared to that of - LM). - -Passing EpsG=0, EpsF=0, EpsX=0 and MaxIts=0 (simultaneously) will lead to -automatic stopping criterion selection (small EpsX). - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minlmsetcond(const minlmstate &state, const double epsg, const double epsf, const double epsx, const ae_int_t maxits); - - -/************************************************************************* -This function turns on/off reporting. - -INPUT PARAMETERS: - State - structure which stores algorithm state - NeedXRep- whether iteration reports are needed or not - -If NeedXRep is True, algorithm will call rep() callback function if it is -provided to MinLMOptimize(). Both Levenberg-Marquardt and internal L-BFGS -iterations are reported. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minlmsetxrep(const minlmstate &state, const bool needxrep); - - -/************************************************************************* -This function sets maximum step length - -INPUT PARAMETERS: - State - structure which stores algorithm state - StpMax - maximum step length, >=0. Set StpMax to 0.0, if you don't - want to limit step length. - -Use this subroutine when you optimize target function which contains exp() -or other fast growing functions, and optimization algorithm makes too -large steps which leads to overflow. This function allows us to reject -steps that are too large (and therefore expose us to the possible -overflow) without actually calculating function value at the x+stp*d. - -NOTE: non-zero StpMax leads to moderate performance degradation because -intermediate step of preconditioned L-BFGS optimization is incompatible -with limits on step size. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minlmsetstpmax(const minlmstate &state, const double stpmax); - - -/************************************************************************* -This function sets scaling coefficients for LM optimizer. - -ALGLIB optimizers use scaling matrices to test stopping conditions (step -size and gradient are scaled before comparison with tolerances). Scale of -the I-th variable is a translation invariant measure of: -a) "how large" the variable is -b) how large the step should be to make significant changes in the function - -Generally, scale is NOT considered to be a form of preconditioner. But LM -optimizer is unique in that it uses scaling matrix both in the stopping -condition tests and as Marquardt damping factor. - -Proper scaling is very important for the algorithm performance. It is less -important for the quality of results, but still has some influence (it is -easier to converge when variables are properly scaled, so premature -stopping is possible when very badly scalled variables are combined with -relaxed stopping conditions). - -INPUT PARAMETERS: - State - structure stores algorithm state - S - array[N], non-zero scaling coefficients - S[i] may be negative, sign doesn't matter. - - -- ALGLIB -- - Copyright 14.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minlmsetscale(const minlmstate &state, const real_1d_array &s); - - -/************************************************************************* -This function sets boundary constraints for LM optimizer - -Boundary constraints are inactive by default (after initial creation). -They are preserved until explicitly turned off with another SetBC() call. - -INPUT PARAMETERS: - State - structure stores algorithm state - BndL - lower bounds, array[N]. - If some (all) variables are unbounded, you may specify - very small number or -INF (latter is recommended because - it will allow solver to use better algorithm). - BndU - upper bounds, array[N]. - If some (all) variables are unbounded, you may specify - very large number or +INF (latter is recommended because - it will allow solver to use better algorithm). - -NOTE 1: it is possible to specify BndL[i]=BndU[i]. In this case I-th -variable will be "frozen" at X[i]=BndL[i]=BndU[i]. - -NOTE 2: this solver has following useful properties: -* bound constraints are always satisfied exactly -* function is evaluated only INSIDE area specified by bound constraints - or at its boundary - - -- ALGLIB -- - Copyright 14.01.2011 by Bochkanov Sergey -*************************************************************************/ -void minlmsetbc(const minlmstate &state, const real_1d_array &bndl, const real_1d_array &bndu); - - -/************************************************************************* -This function is used to change acceleration settings - -You can choose between three acceleration strategies: -* AccType=0, no acceleration. -* AccType=1, secant updates are used to update quadratic model after each - iteration. After fixed number of iterations (or after model breakdown) - we recalculate quadratic model using analytic Jacobian or finite - differences. Number of secant-based iterations depends on optimization - settings: about 3 iterations - when we have analytic Jacobian, up to 2*N - iterations - when we use finite differences to calculate Jacobian. - -AccType=1 is recommended when Jacobian calculation cost is prohibitive -high (several Mx1 function vector calculations followed by several NxN -Cholesky factorizations are faster than calculation of one M*N Jacobian). -It should also be used when we have no Jacobian, because finite difference -approximation takes too much time to compute. - -Table below list optimization protocols (XYZ protocol corresponds to -MinLMCreateXYZ) and acceleration types they support (and use by default). - -ACCELERATION TYPES SUPPORTED BY OPTIMIZATION PROTOCOLS: - -protocol 0 1 comment -V + + -VJ + + -FGH + - -DAFAULT VALUES: - -protocol 0 1 comment -V x without acceleration it is so slooooooooow -VJ x -FGH x - -NOTE: this function should be called before optimization. Attempt to call -it during algorithm iterations may result in unexpected behavior. - -NOTE: attempt to call this function with unsupported protocol/acceleration -combination will result in exception being thrown. - - -- ALGLIB -- - Copyright 14.10.2010 by Bochkanov Sergey -*************************************************************************/ -void minlmsetacctype(const minlmstate &state, const ae_int_t acctype); - - -/************************************************************************* -This function provides reverse communication interface -Reverse communication interface is not documented or recommended to use. -See below for functions which provide better documented API -*************************************************************************/ -bool minlmiteration(const minlmstate &state); - - -/************************************************************************* -This family of functions is used to launcn iterations of nonlinear optimizer - -These functions accept following parameters: - state - algorithm state - func - callback which calculates function (or merit function) - value func at given point x - grad - callback which calculates function (or merit function) - value func and gradient grad at given point x - hess - callback which calculates function (or merit function) - value func, gradient grad and Hessian hess at given point x - fvec - callback which calculates function vector fi[] - at given point x - jac - callback which calculates function vector fi[] - and Jacobian jac at given point x - rep - optional callback which is called after each iteration - can be NULL - ptr - optional pointer which is passed to func/grad/hess/jac/rep - can be NULL - -NOTES: - -1. Depending on function used to create state structure, this algorithm - may accept Jacobian and/or Hessian and/or gradient. According to the - said above, there ase several versions of this function, which accept - different sets of callbacks. - - This flexibility opens way to subtle errors - you may create state with - MinLMCreateFGH() (optimization using Hessian), but call function which - does not accept Hessian. So when algorithm will request Hessian, there - will be no callback to call. In this case exception will be thrown. - - Be careful to avoid such errors because there is no way to find them at - compile time - you can see them at runtime only. - - -- ALGLIB -- - Copyright 10.03.2009 by Bochkanov Sergey - -*************************************************************************/ -void minlmoptimize(minlmstate &state, - void (*fvec)(const real_1d_array &x, real_1d_array &fi, void *ptr), - void (*rep)(const real_1d_array &x, double func, void *ptr) = NULL, - void *ptr = NULL); -void minlmoptimize(minlmstate &state, - void (*fvec)(const real_1d_array &x, real_1d_array &fi, void *ptr), - void (*jac)(const real_1d_array &x, real_1d_array &fi, real_2d_array &jac, void *ptr), - void (*rep)(const real_1d_array &x, double func, void *ptr) = NULL, - void *ptr = NULL); -void minlmoptimize(minlmstate &state, - void (*func)(const real_1d_array &x, double &func, void *ptr), - void (*grad)(const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), - void (*hess)(const real_1d_array &x, double &func, real_1d_array &grad, real_2d_array &hess, void *ptr), - void (*rep)(const real_1d_array &x, double func, void *ptr) = NULL, - void *ptr = NULL); -void minlmoptimize(minlmstate &state, - void (*func)(const real_1d_array &x, double &func, void *ptr), - void (*jac)(const real_1d_array &x, real_1d_array &fi, real_2d_array &jac, void *ptr), - void (*rep)(const real_1d_array &x, double func, void *ptr) = NULL, - void *ptr = NULL); -void minlmoptimize(minlmstate &state, - void (*func)(const real_1d_array &x, double &func, void *ptr), - void (*grad)(const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), - void (*jac)(const real_1d_array &x, real_1d_array &fi, real_2d_array &jac, void *ptr), - void (*rep)(const real_1d_array &x, double func, void *ptr) = NULL, - void *ptr = NULL); - - -/************************************************************************* -Levenberg-Marquardt algorithm results - -INPUT PARAMETERS: - State - algorithm state - -OUTPUT PARAMETERS: - X - array[0..N-1], solution - Rep - optimization report; - see comments for this structure for more info. - - -- ALGLIB -- - Copyright 10.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minlmresults(const minlmstate &state, real_1d_array &x, minlmreport &rep); - - -/************************************************************************* -Levenberg-Marquardt algorithm results - -Buffered implementation of MinLMResults(), which uses pre-allocated buffer -to store X[]. If buffer size is too small, it resizes buffer. It is -intended to be used in the inner cycles of performance critical algorithms -where array reallocation penalty is too large to be ignored. - - -- ALGLIB -- - Copyright 10.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minlmresultsbuf(const minlmstate &state, real_1d_array &x, minlmreport &rep); - - -/************************************************************************* -This subroutine restarts LM algorithm from new point. All optimization -parameters are left unchanged. - -This function allows to solve multiple optimization problems (which -must have same number of dimensions) without object reallocation penalty. - -INPUT PARAMETERS: - State - structure used for reverse communication previously - allocated with MinLMCreateXXX call. - X - new starting point. - - -- ALGLIB -- - Copyright 30.07.2010 by Bochkanov Sergey -*************************************************************************/ -void minlmrestartfrom(const minlmstate &state, const real_1d_array &x); - - -/************************************************************************* -This is obsolete function. - -Since ALGLIB 3.3 it is equivalent to MinLMCreateVJ(). - - -- ALGLIB -- - Copyright 30.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minlmcreatevgj(const ae_int_t n, const ae_int_t m, const real_1d_array &x, minlmstate &state); -void minlmcreatevgj(const ae_int_t m, const real_1d_array &x, minlmstate &state); - - -/************************************************************************* -This is obsolete function. - -Since ALGLIB 3.3 it is equivalent to MinLMCreateFJ(). - - -- ALGLIB -- - Copyright 30.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minlmcreatefgj(const ae_int_t n, const ae_int_t m, const real_1d_array &x, minlmstate &state); -void minlmcreatefgj(const ae_int_t m, const real_1d_array &x, minlmstate &state); - - -/************************************************************************* -This function is considered obsolete since ALGLIB 3.1.0 and is present for -backward compatibility only. We recommend to use MinLMCreateVJ, which -provides similar, but more consistent and feature-rich interface. - - -- ALGLIB -- - Copyright 30.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minlmcreatefj(const ae_int_t n, const ae_int_t m, const real_1d_array &x, minlmstate &state); -void minlmcreatefj(const ae_int_t m, const real_1d_array &x, minlmstate &state); - - -/************************************************************************* -This subroutine turns on verification of the user-supplied analytic -gradient: -* user calls this subroutine before optimization begins -* MinLMOptimize() is called -* prior to actual optimization, for each function Fi and each component - of parameters being optimized X[j] algorithm performs following steps: - * two trial steps are made to X[j]-TestStep*S[j] and X[j]+TestStep*S[j], - where X[j] is j-th parameter and S[j] is a scale of j-th parameter - * if needed, steps are bounded with respect to constraints on X[] - * Fi(X) is evaluated at these trial points - * we perform one more evaluation in the middle point of the interval - * we build cubic model using function values and derivatives at trial - points and we compare its prediction with actual value in the middle - point - * in case difference between prediction and actual value is higher than - some predetermined threshold, algorithm stops with completion code -7; - Rep.VarIdx is set to index of the parameter with incorrect derivative, - Rep.FuncIdx is set to index of the function. -* after verification is over, algorithm proceeds to the actual optimization. - -NOTE 1: verification needs N (parameters count) Jacobian evaluations. It - is very costly and you should use it only for low dimensional - problems, when you want to be sure that you've correctly - calculated analytic derivatives. You should not use it in the - production code (unless you want to check derivatives provided - by some third party). - -NOTE 2: you should carefully choose TestStep. Value which is too large - (so large that function behaviour is significantly non-cubic) will - lead to false alarms. You may use different step for different - parameters by means of setting scale with MinLMSetScale(). - -NOTE 3: this function may lead to false positives. In case it reports that - I-th derivative was calculated incorrectly, you may decrease test - step and try one more time - maybe your function changes too - sharply and your step is too large for such rapidly chanding - function. - -INPUT PARAMETERS: - State - structure used to store algorithm state - TestStep - verification step: - * TestStep=0 turns verification off - * TestStep>0 activates verification - - -- ALGLIB -- - Copyright 15.06.2012 by Bochkanov Sergey -*************************************************************************/ -void minlmsetgradientcheck(const minlmstate &state, const double teststep); - -/************************************************************************* -Obsolete function, use MinLBFGSSetPrecDefault() instead. - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetdefaultpreconditioner(const minlbfgsstate &state); - - -/************************************************************************* -Obsolete function, use MinLBFGSSetCholeskyPreconditioner() instead. - - -- ALGLIB -- - Copyright 13.10.2010 by Bochkanov Sergey -*************************************************************************/ -void minlbfgssetcholeskypreconditioner(const minlbfgsstate &state, const real_2d_array &p, const bool isupper); - - -/************************************************************************* -This is obsolete function which was used by previous version of the BLEIC -optimizer. It does nothing in the current version of BLEIC. - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetbarrierwidth(const minbleicstate &state, const double mu); - - -/************************************************************************* -This is obsolete function which was used by previous version of the BLEIC -optimizer. It does nothing in the current version of BLEIC. - - -- ALGLIB -- - Copyright 28.11.2010 by Bochkanov Sergey -*************************************************************************/ -void minbleicsetbarrierdecay(const minbleicstate &state, const double mudecay); - - -/************************************************************************* -Obsolete optimization algorithm. -Was replaced by MinBLEIC subpackage. - - -- ALGLIB -- - Copyright 25.03.2010 by Bochkanov Sergey -*************************************************************************/ -void minasacreate(const ae_int_t n, const real_1d_array &x, const real_1d_array &bndl, const real_1d_array &bndu, minasastate &state); -void minasacreate(const real_1d_array &x, const real_1d_array &bndl, const real_1d_array &bndu, minasastate &state); - - -/************************************************************************* -Obsolete optimization algorithm. -Was replaced by MinBLEIC subpackage. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minasasetcond(const minasastate &state, const double epsg, const double epsf, const double epsx, const ae_int_t maxits); - - -/************************************************************************* -Obsolete optimization algorithm. -Was replaced by MinBLEIC subpackage. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minasasetxrep(const minasastate &state, const bool needxrep); - - -/************************************************************************* -Obsolete optimization algorithm. -Was replaced by MinBLEIC subpackage. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minasasetalgorithm(const minasastate &state, const ae_int_t algotype); - - -/************************************************************************* -Obsolete optimization algorithm. -Was replaced by MinBLEIC subpackage. - - -- ALGLIB -- - Copyright 02.04.2010 by Bochkanov Sergey -*************************************************************************/ -void minasasetstpmax(const minasastate &state, const double stpmax); - - -/************************************************************************* -This function provides reverse communication interface -Reverse communication interface is not documented or recommended to use. -See below for functions which provide better documented API -*************************************************************************/ -bool minasaiteration(const minasastate &state); - - -/************************************************************************* -This family of functions is used to launcn iterations of nonlinear optimizer - -These functions accept following parameters: - state - algorithm state - grad - callback which calculates function (or merit function) - value func and gradient grad at given point x - rep - optional callback which is called after each iteration - can be NULL - ptr - optional pointer which is passed to func/grad/hess/jac/rep - can be NULL - - - -- ALGLIB -- - Copyright 20.03.2009 by Bochkanov Sergey - -*************************************************************************/ -void minasaoptimize(minasastate &state, - void (*grad)(const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), - void (*rep)(const real_1d_array &x, double func, void *ptr) = NULL, - void *ptr = NULL); - - -/************************************************************************* -Obsolete optimization algorithm. -Was replaced by MinBLEIC subpackage. - - -- ALGLIB -- - Copyright 20.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minasaresults(const minasastate &state, real_1d_array &x, minasareport &rep); - - -/************************************************************************* -Obsolete optimization algorithm. -Was replaced by MinBLEIC subpackage. - - -- ALGLIB -- - Copyright 20.03.2009 by Bochkanov Sergey -*************************************************************************/ -void minasaresultsbuf(const minasastate &state, real_1d_array &x, minasareport &rep); - - -/************************************************************************* -Obsolete optimization algorithm. -Was replaced by MinBLEIC subpackage. - - -- ALGLIB -- - Copyright 30.07.2010 by Bochkanov Sergey -*************************************************************************/ -void minasarestartfrom(const minasastate &state, const real_1d_array &x, const real_1d_array &bndl, const real_1d_array &bndu); -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (FUNCTIONS) -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ -void trimprepare(double f, double* threshold, ae_state *_state); -void trimfunction(double* f, - /* Real */ ae_vector* g, - ae_int_t n, - double threshold, - ae_state *_state); -ae_bool enforceboundaryconstraints(/* Real */ ae_vector* x, - /* Real */ ae_vector* bl, - /* Boolean */ ae_vector* havebl, - /* Real */ ae_vector* bu, - /* Boolean */ ae_vector* havebu, - ae_int_t nmain, - ae_int_t nslack, - ae_state *_state); -void projectgradientintobc(/* Real */ ae_vector* x, - /* Real */ ae_vector* g, - /* Real */ ae_vector* bl, - /* Boolean */ ae_vector* havebl, - /* Real */ ae_vector* bu, - /* Boolean */ ae_vector* havebu, - ae_int_t nmain, - ae_int_t nslack, - ae_state *_state); -void calculatestepbound(/* Real */ ae_vector* x, - /* Real */ ae_vector* d, - double alpha, - /* Real */ ae_vector* bndl, - /* Boolean */ ae_vector* havebndl, - /* Real */ ae_vector* bndu, - /* Boolean */ ae_vector* havebndu, - ae_int_t nmain, - ae_int_t nslack, - ae_int_t* variabletofreeze, - double* valuetofreeze, - double* maxsteplen, - ae_state *_state); -ae_int_t postprocessboundedstep(/* Real */ ae_vector* x, - /* Real */ ae_vector* xprev, - /* Real */ ae_vector* bndl, - /* Boolean */ ae_vector* havebndl, - /* Real */ ae_vector* bndu, - /* Boolean */ ae_vector* havebndu, - ae_int_t nmain, - ae_int_t nslack, - ae_int_t variabletofreeze, - double valuetofreeze, - double steptaken, - double maxsteplen, - ae_state *_state); -void filterdirection(/* Real */ ae_vector* d, - /* Real */ ae_vector* x, - /* Real */ ae_vector* bndl, - /* Boolean */ ae_vector* havebndl, - /* Real */ ae_vector* bndu, - /* Boolean */ ae_vector* havebndu, - /* Real */ ae_vector* s, - ae_int_t nmain, - ae_int_t nslack, - double droptol, - ae_state *_state); -ae_int_t numberofchangedconstraints(/* Real */ ae_vector* x, - /* Real */ ae_vector* xprev, - /* Real */ ae_vector* bndl, - /* Boolean */ ae_vector* havebndl, - /* Real */ ae_vector* bndu, - /* Boolean */ ae_vector* havebndu, - ae_int_t nmain, - ae_int_t nslack, - ae_state *_state); -ae_bool findfeasiblepoint(/* Real */ ae_vector* x, - /* Real */ ae_vector* bndl, - /* Boolean */ ae_vector* havebndl, - /* Real */ ae_vector* bndu, - /* Boolean */ ae_vector* havebndu, - ae_int_t nmain, - ae_int_t nslack, - /* Real */ ae_matrix* ce, - ae_int_t k, - double epsi, - ae_int_t* qpits, - ae_int_t* gpaits, - ae_state *_state); -ae_bool derivativecheck(double f0, - double df0, - double f1, - double df1, - double f, - double df, - double width, - ae_state *_state); -void cqminit(ae_int_t n, convexquadraticmodel* s, ae_state *_state); -void cqmseta(convexquadraticmodel* s, - /* Real */ ae_matrix* a, - ae_bool isupper, - double alpha, - ae_state *_state); -void cqmrewritedensediagonal(convexquadraticmodel* s, - /* Real */ ae_vector* z, - ae_state *_state); -void cqmsetd(convexquadraticmodel* s, - /* Real */ ae_vector* d, - double tau, - ae_state *_state); -void cqmdropa(convexquadraticmodel* s, ae_state *_state); -void cqmsetb(convexquadraticmodel* s, - /* Real */ ae_vector* b, - ae_state *_state); -void cqmsetq(convexquadraticmodel* s, - /* Real */ ae_matrix* q, - /* Real */ ae_vector* r, - ae_int_t k, - double theta, - ae_state *_state); -void cqmsetactiveset(convexquadraticmodel* s, - /* Real */ ae_vector* x, - /* Boolean */ ae_vector* activeset, - ae_state *_state); -double cqmeval(convexquadraticmodel* s, - /* Real */ ae_vector* x, - ae_state *_state); -void cqmevalx(convexquadraticmodel* s, - /* Real */ ae_vector* x, - double* r, - double* noise, - ae_state *_state); -void cqmgradunconstrained(convexquadraticmodel* s, - /* Real */ ae_vector* x, - /* Real */ ae_vector* g, - ae_state *_state); -double cqmxtadx2(convexquadraticmodel* s, - /* Real */ ae_vector* x, - ae_state *_state); -void cqmadx(convexquadraticmodel* s, - /* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_state *_state); -ae_bool cqmconstrainedoptimum(convexquadraticmodel* s, - /* Real */ ae_vector* x, - ae_state *_state); -void cqmscalevector(convexquadraticmodel* s, - /* Real */ ae_vector* x, - ae_state *_state); -double cqmdebugconstrainedevalt(convexquadraticmodel* s, - /* Real */ ae_vector* x, - ae_state *_state); -double cqmdebugconstrainedevale(convexquadraticmodel* s, - /* Real */ ae_vector* x, - ae_state *_state); -ae_bool _convexquadraticmodel_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _convexquadraticmodel_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _convexquadraticmodel_clear(void* _p); -void _convexquadraticmodel_destroy(void* _p); -void snnlsinit(ae_int_t nsmax, - ae_int_t ndmax, - ae_int_t nrmax, - snnlssolver* s, - ae_state *_state); -void snnlssetproblem(snnlssolver* s, - /* Real */ ae_matrix* a, - /* Real */ ae_vector* b, - ae_int_t ns, - ae_int_t nd, - ae_int_t nr, - ae_state *_state); -void snnlsdropnnc(snnlssolver* s, ae_int_t idx, ae_state *_state); -void snnlssolve(snnlssolver* s, - /* Real */ ae_vector* x, - ae_state *_state); -ae_bool _snnlssolver_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _snnlssolver_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _snnlssolver_clear(void* _p); -void _snnlssolver_destroy(void* _p); -void sasinit(ae_int_t n, sactiveset* s, ae_state *_state); -void sassetscale(sactiveset* state, - /* Real */ ae_vector* s, - ae_state *_state); -void sassetprecdiag(sactiveset* state, - /* Real */ ae_vector* d, - ae_state *_state); -void sassetbc(sactiveset* state, - /* Real */ ae_vector* bndl, - /* Real */ ae_vector* bndu, - ae_state *_state); -void sassetlc(sactiveset* state, - /* Real */ ae_matrix* c, - /* Integer */ ae_vector* ct, - ae_int_t k, - ae_state *_state); -void sassetlcx(sactiveset* state, - /* Real */ ae_matrix* cleic, - ae_int_t nec, - ae_int_t nic, - ae_state *_state); -ae_bool sasstartoptimization(sactiveset* state, - /* Real */ ae_vector* x, - ae_state *_state); -void sasexploredirection(sactiveset* state, - /* Real */ ae_vector* d, - double* stpmax, - ae_int_t* cidx, - double* vval, - ae_state *_state); -ae_int_t sasmoveto(sactiveset* state, - /* Real */ ae_vector* xn, - ae_bool needact, - ae_int_t cidx, - double cval, - ae_state *_state); -void sasimmediateactivation(sactiveset* state, - ae_int_t cidx, - double cval, - ae_state *_state); -void sasconstraineddescent(sactiveset* state, - /* Real */ ae_vector* g, - /* Real */ ae_vector* d, - ae_state *_state); -void sasconstraineddescentprec(sactiveset* state, - /* Real */ ae_vector* g, - /* Real */ ae_vector* d, - ae_state *_state); -void sasconstraineddirection(sactiveset* state, - /* Real */ ae_vector* d, - ae_state *_state); -void sasconstraineddirectionprec(sactiveset* state, - /* Real */ ae_vector* d, - ae_state *_state); -void sascorrection(sactiveset* state, - /* Real */ ae_vector* x, - double* penalty, - ae_state *_state); -double sasactivelcpenalty1(sactiveset* state, - /* Real */ ae_vector* x, - ae_state *_state); -double sasscaledconstrainednorm(sactiveset* state, - /* Real */ ae_vector* d, - ae_state *_state); -void sasstopoptimization(sactiveset* state, ae_state *_state); -void sasreactivateconstraints(sactiveset* state, - /* Real */ ae_vector* gc, - ae_state *_state); -void sasreactivateconstraintsprec(sactiveset* state, - /* Real */ ae_vector* gc, - ae_state *_state); -void sasrebuildbasis(sactiveset* state, ae_state *_state); -ae_bool _sactiveset_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _sactiveset_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _sactiveset_clear(void* _p); -void _sactiveset_destroy(void* _p); -void mincgcreate(ae_int_t n, - /* Real */ ae_vector* x, - mincgstate* state, - ae_state *_state); -void mincgcreatef(ae_int_t n, - /* Real */ ae_vector* x, - double diffstep, - mincgstate* state, - ae_state *_state); -void mincgsetcond(mincgstate* state, - double epsg, - double epsf, - double epsx, - ae_int_t maxits, - ae_state *_state); -void mincgsetscale(mincgstate* state, - /* Real */ ae_vector* s, - ae_state *_state); -void mincgsetxrep(mincgstate* state, ae_bool needxrep, ae_state *_state); -void mincgsetdrep(mincgstate* state, ae_bool needdrep, ae_state *_state); -void mincgsetcgtype(mincgstate* state, ae_int_t cgtype, ae_state *_state); -void mincgsetstpmax(mincgstate* state, double stpmax, ae_state *_state); -void mincgsuggeststep(mincgstate* state, double stp, ae_state *_state); -void mincgsetprecdefault(mincgstate* state, ae_state *_state); -void mincgsetprecdiag(mincgstate* state, - /* Real */ ae_vector* d, - ae_state *_state); -void mincgsetprecscale(mincgstate* state, ae_state *_state); -ae_bool mincgiteration(mincgstate* state, ae_state *_state); -void mincgresults(mincgstate* state, - /* Real */ ae_vector* x, - mincgreport* rep, - ae_state *_state); -void mincgresultsbuf(mincgstate* state, - /* Real */ ae_vector* x, - mincgreport* rep, - ae_state *_state); -void mincgrestartfrom(mincgstate* state, - /* Real */ ae_vector* x, - ae_state *_state); -void mincgsetprecdiagfast(mincgstate* state, - /* Real */ ae_vector* d, - ae_state *_state); -void mincgsetpreclowrankfast(mincgstate* state, - /* Real */ ae_vector* d1, - /* Real */ ae_vector* c, - /* Real */ ae_matrix* v, - ae_int_t vcnt, - ae_state *_state); -void mincgsetprecvarpart(mincgstate* state, - /* Real */ ae_vector* d2, - ae_state *_state); -void mincgsetgradientcheck(mincgstate* state, - double teststep, - ae_state *_state); -ae_bool _mincgstate_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _mincgstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _mincgstate_clear(void* _p); -void _mincgstate_destroy(void* _p); -ae_bool _mincgreport_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _mincgreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _mincgreport_clear(void* _p); -void _mincgreport_destroy(void* _p); -void minbleiccreate(ae_int_t n, - /* Real */ ae_vector* x, - minbleicstate* state, - ae_state *_state); -void minbleiccreatef(ae_int_t n, - /* Real */ ae_vector* x, - double diffstep, - minbleicstate* state, - ae_state *_state); -void minbleicsetbc(minbleicstate* state, - /* Real */ ae_vector* bndl, - /* Real */ ae_vector* bndu, - ae_state *_state); -void minbleicsetlc(minbleicstate* state, - /* Real */ ae_matrix* c, - /* Integer */ ae_vector* ct, - ae_int_t k, - ae_state *_state); -void minbleicsetcond(minbleicstate* state, - double epsg, - double epsf, - double epsx, - ae_int_t maxits, - ae_state *_state); -void minbleicsetscale(minbleicstate* state, - /* Real */ ae_vector* s, - ae_state *_state); -void minbleicsetprecdefault(minbleicstate* state, ae_state *_state); -void minbleicsetprecdiag(minbleicstate* state, - /* Real */ ae_vector* d, - ae_state *_state); -void minbleicsetprecscale(minbleicstate* state, ae_state *_state); -void minbleicsetxrep(minbleicstate* state, - ae_bool needxrep, - ae_state *_state); -void minbleicsetdrep(minbleicstate* state, - ae_bool needdrep, - ae_state *_state); -void minbleicsetstpmax(minbleicstate* state, - double stpmax, - ae_state *_state); -ae_bool minbleiciteration(minbleicstate* state, ae_state *_state); -void minbleicresults(minbleicstate* state, - /* Real */ ae_vector* x, - minbleicreport* rep, - ae_state *_state); -void minbleicresultsbuf(minbleicstate* state, - /* Real */ ae_vector* x, - minbleicreport* rep, - ae_state *_state); -void minbleicrestartfrom(minbleicstate* state, - /* Real */ ae_vector* x, - ae_state *_state); -void minbleicemergencytermination(minbleicstate* state, ae_state *_state); -void minbleicsetgradientcheck(minbleicstate* state, - double teststep, - ae_state *_state); -ae_bool _minbleicstate_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _minbleicstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _minbleicstate_clear(void* _p); -void _minbleicstate_destroy(void* _p); -ae_bool _minbleicreport_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _minbleicreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _minbleicreport_clear(void* _p); -void _minbleicreport_destroy(void* _p); -void minlbfgscreate(ae_int_t n, - ae_int_t m, - /* Real */ ae_vector* x, - minlbfgsstate* state, - ae_state *_state); -void minlbfgscreatef(ae_int_t n, - ae_int_t m, - /* Real */ ae_vector* x, - double diffstep, - minlbfgsstate* state, - ae_state *_state); -void minlbfgssetcond(minlbfgsstate* state, - double epsg, - double epsf, - double epsx, - ae_int_t maxits, - ae_state *_state); -void minlbfgssetxrep(minlbfgsstate* state, - ae_bool needxrep, - ae_state *_state); -void minlbfgssetstpmax(minlbfgsstate* state, - double stpmax, - ae_state *_state); -void minlbfgssetscale(minlbfgsstate* state, - /* Real */ ae_vector* s, - ae_state *_state); -void minlbfgscreatex(ae_int_t n, - ae_int_t m, - /* Real */ ae_vector* x, - ae_int_t flags, - double diffstep, - minlbfgsstate* state, - ae_state *_state); -void minlbfgssetprecdefault(minlbfgsstate* state, ae_state *_state); -void minlbfgssetpreccholesky(minlbfgsstate* state, - /* Real */ ae_matrix* p, - ae_bool isupper, - ae_state *_state); -void minlbfgssetprecdiag(minlbfgsstate* state, - /* Real */ ae_vector* d, - ae_state *_state); -void minlbfgssetprecscale(minlbfgsstate* state, ae_state *_state); -ae_bool minlbfgsiteration(minlbfgsstate* state, ae_state *_state); -void minlbfgsresults(minlbfgsstate* state, - /* Real */ ae_vector* x, - minlbfgsreport* rep, - ae_state *_state); -void minlbfgsresultsbuf(minlbfgsstate* state, - /* Real */ ae_vector* x, - minlbfgsreport* rep, - ae_state *_state); -void minlbfgsrestartfrom(minlbfgsstate* state, - /* Real */ ae_vector* x, - ae_state *_state); -void minlbfgssetgradientcheck(minlbfgsstate* state, - double teststep, - ae_state *_state); -ae_bool _minlbfgsstate_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _minlbfgsstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _minlbfgsstate_clear(void* _p); -void _minlbfgsstate_destroy(void* _p); -ae_bool _minlbfgsreport_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _minlbfgsreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _minlbfgsreport_clear(void* _p); -void _minlbfgsreport_destroy(void* _p); -void minqpcreate(ae_int_t n, minqpstate* state, ae_state *_state); -void minqpsetlinearterm(minqpstate* state, - /* Real */ ae_vector* b, - ae_state *_state); -void minqpsetquadraticterm(minqpstate* state, - /* Real */ ae_matrix* a, - ae_bool isupper, - ae_state *_state); -void minqpsetquadratictermsparse(minqpstate* state, - sparsematrix* a, - ae_bool isupper, - ae_state *_state); -void minqpsetstartingpoint(minqpstate* state, - /* Real */ ae_vector* x, - ae_state *_state); -void minqpsetorigin(minqpstate* state, - /* Real */ ae_vector* xorigin, - ae_state *_state); -void minqpsetscale(minqpstate* state, - /* Real */ ae_vector* s, - ae_state *_state); -void minqpsetalgocholesky(minqpstate* state, ae_state *_state); -void minqpsetalgobleic(minqpstate* state, - double epsg, - double epsf, - double epsx, - ae_int_t maxits, - ae_state *_state); -void minqpsetbc(minqpstate* state, - /* Real */ ae_vector* bndl, - /* Real */ ae_vector* bndu, - ae_state *_state); -void minqpsetlc(minqpstate* state, - /* Real */ ae_matrix* c, - /* Integer */ ae_vector* ct, - ae_int_t k, - ae_state *_state); -void minqpoptimize(minqpstate* state, ae_state *_state); -void minqpresults(minqpstate* state, - /* Real */ ae_vector* x, - minqpreport* rep, - ae_state *_state); -void minqpresultsbuf(minqpstate* state, - /* Real */ ae_vector* x, - minqpreport* rep, - ae_state *_state); -void minqpsetlineartermfast(minqpstate* state, - /* Real */ ae_vector* b, - ae_state *_state); -void minqpsetquadratictermfast(minqpstate* state, - /* Real */ ae_matrix* a, - ae_bool isupper, - double s, - ae_state *_state); -void minqprewritediagonal(minqpstate* state, - /* Real */ ae_vector* s, - ae_state *_state); -void minqpsetstartingpointfast(minqpstate* state, - /* Real */ ae_vector* x, - ae_state *_state); -void minqpsetoriginfast(minqpstate* state, - /* Real */ ae_vector* xorigin, - ae_state *_state); -ae_bool _minqpstate_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _minqpstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _minqpstate_clear(void* _p); -void _minqpstate_destroy(void* _p); -ae_bool _minqpreport_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _minqpreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _minqpreport_clear(void* _p); -void _minqpreport_destroy(void* _p); -void minlmcreatevj(ae_int_t n, - ae_int_t m, - /* Real */ ae_vector* x, - minlmstate* state, - ae_state *_state); -void minlmcreatev(ae_int_t n, - ae_int_t m, - /* Real */ ae_vector* x, - double diffstep, - minlmstate* state, - ae_state *_state); -void minlmcreatefgh(ae_int_t n, - /* Real */ ae_vector* x, - minlmstate* state, - ae_state *_state); -void minlmsetcond(minlmstate* state, - double epsg, - double epsf, - double epsx, - ae_int_t maxits, - ae_state *_state); -void minlmsetxrep(minlmstate* state, ae_bool needxrep, ae_state *_state); -void minlmsetstpmax(minlmstate* state, double stpmax, ae_state *_state); -void minlmsetscale(minlmstate* state, - /* Real */ ae_vector* s, - ae_state *_state); -void minlmsetbc(minlmstate* state, - /* Real */ ae_vector* bndl, - /* Real */ ae_vector* bndu, - ae_state *_state); -void minlmsetacctype(minlmstate* state, - ae_int_t acctype, - ae_state *_state); -ae_bool minlmiteration(minlmstate* state, ae_state *_state); -void minlmresults(minlmstate* state, - /* Real */ ae_vector* x, - minlmreport* rep, - ae_state *_state); -void minlmresultsbuf(minlmstate* state, - /* Real */ ae_vector* x, - minlmreport* rep, - ae_state *_state); -void minlmrestartfrom(minlmstate* state, - /* Real */ ae_vector* x, - ae_state *_state); -void minlmcreatevgj(ae_int_t n, - ae_int_t m, - /* Real */ ae_vector* x, - minlmstate* state, - ae_state *_state); -void minlmcreatefgj(ae_int_t n, - ae_int_t m, - /* Real */ ae_vector* x, - minlmstate* state, - ae_state *_state); -void minlmcreatefj(ae_int_t n, - ae_int_t m, - /* Real */ ae_vector* x, - minlmstate* state, - ae_state *_state); -void minlmsetgradientcheck(minlmstate* state, - double teststep, - ae_state *_state); -ae_bool _minlmstate_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _minlmstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _minlmstate_clear(void* _p); -void _minlmstate_destroy(void* _p); -ae_bool _minlmreport_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _minlmreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _minlmreport_clear(void* _p); -void _minlmreport_destroy(void* _p); -void minlbfgssetdefaultpreconditioner(minlbfgsstate* state, - ae_state *_state); -void minlbfgssetcholeskypreconditioner(minlbfgsstate* state, - /* Real */ ae_matrix* p, - ae_bool isupper, - ae_state *_state); -void minbleicsetbarrierwidth(minbleicstate* state, - double mu, - ae_state *_state); -void minbleicsetbarrierdecay(minbleicstate* state, - double mudecay, - ae_state *_state); -void minasacreate(ae_int_t n, - /* Real */ ae_vector* x, - /* Real */ ae_vector* bndl, - /* Real */ ae_vector* bndu, - minasastate* state, - ae_state *_state); -void minasasetcond(minasastate* state, - double epsg, - double epsf, - double epsx, - ae_int_t maxits, - ae_state *_state); -void minasasetxrep(minasastate* state, ae_bool needxrep, ae_state *_state); -void minasasetalgorithm(minasastate* state, - ae_int_t algotype, - ae_state *_state); -void minasasetstpmax(minasastate* state, double stpmax, ae_state *_state); -ae_bool minasaiteration(minasastate* state, ae_state *_state); -void minasaresults(minasastate* state, - /* Real */ ae_vector* x, - minasareport* rep, - ae_state *_state); -void minasaresultsbuf(minasastate* state, - /* Real */ ae_vector* x, - minasareport* rep, - ae_state *_state); -void minasarestartfrom(minasastate* state, - /* Real */ ae_vector* x, - /* Real */ ae_vector* bndl, - /* Real */ ae_vector* bndu, - ae_state *_state); -ae_bool _minasastate_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _minasastate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _minasastate_clear(void* _p); -void _minasastate_destroy(void* _p); -ae_bool _minasareport_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _minasareport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _minasareport_clear(void* _p); -void _minasareport_destroy(void* _p); - -} -#endif - diff --git a/src/core/alglib/solvers.cpp b/src/core/alglib/solvers.cpp deleted file mode 100644 index 77f9ca0..0000000 --- a/src/core/alglib/solvers.cpp +++ /dev/null @@ -1,8709 +0,0 @@ -/************************************************************************* -Copyright (c) Sergey Bochkanov (ALGLIB project). - ->>> SOURCE LICENSE >>> -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation (www.fsf.org); either version 2 of the -License, or (at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -A copy of the GNU General Public License is available at -http://www.fsf.org/licensing/licenses ->>> END OF LICENSE >>> -*************************************************************************/ -#include "stdafx.h" -#include "solvers.h" - -// disable some irrelevant warnings -#if (AE_COMPILER==AE_MSVC) -#pragma warning(disable:4100) -#pragma warning(disable:4127) -#pragma warning(disable:4702) -#pragma warning(disable:4996) -#endif -using namespace std; - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS IMPLEMENTATION OF C++ INTERFACE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib -{ - - -/************************************************************************* - -*************************************************************************/ -_densesolverreport_owner::_densesolverreport_owner() -{ - p_struct = (alglib_impl::densesolverreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::densesolverreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_densesolverreport_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_densesolverreport_owner::_densesolverreport_owner(const _densesolverreport_owner &rhs) -{ - p_struct = (alglib_impl::densesolverreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::densesolverreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_densesolverreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_densesolverreport_owner& _densesolverreport_owner::operator=(const _densesolverreport_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_densesolverreport_clear(p_struct); - if( !alglib_impl::_densesolverreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_densesolverreport_owner::~_densesolverreport_owner() -{ - alglib_impl::_densesolverreport_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::densesolverreport* _densesolverreport_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::densesolverreport* _densesolverreport_owner::c_ptr() const -{ - return const_cast(p_struct); -} -densesolverreport::densesolverreport() : _densesolverreport_owner() ,r1(p_struct->r1),rinf(p_struct->rinf) -{ -} - -densesolverreport::densesolverreport(const densesolverreport &rhs):_densesolverreport_owner(rhs) ,r1(p_struct->r1),rinf(p_struct->rinf) -{ -} - -densesolverreport& densesolverreport::operator=(const densesolverreport &rhs) -{ - if( this==&rhs ) - return *this; - _densesolverreport_owner::operator=(rhs); - return *this; -} - -densesolverreport::~densesolverreport() -{ -} - - -/************************************************************************* - -*************************************************************************/ -_densesolverlsreport_owner::_densesolverlsreport_owner() -{ - p_struct = (alglib_impl::densesolverlsreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::densesolverlsreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_densesolverlsreport_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_densesolverlsreport_owner::_densesolverlsreport_owner(const _densesolverlsreport_owner &rhs) -{ - p_struct = (alglib_impl::densesolverlsreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::densesolverlsreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_densesolverlsreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_densesolverlsreport_owner& _densesolverlsreport_owner::operator=(const _densesolverlsreport_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_densesolverlsreport_clear(p_struct); - if( !alglib_impl::_densesolverlsreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_densesolverlsreport_owner::~_densesolverlsreport_owner() -{ - alglib_impl::_densesolverlsreport_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::densesolverlsreport* _densesolverlsreport_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::densesolverlsreport* _densesolverlsreport_owner::c_ptr() const -{ - return const_cast(p_struct); -} -densesolverlsreport::densesolverlsreport() : _densesolverlsreport_owner() ,r2(p_struct->r2),cx(&p_struct->cx),n(p_struct->n),k(p_struct->k) -{ -} - -densesolverlsreport::densesolverlsreport(const densesolverlsreport &rhs):_densesolverlsreport_owner(rhs) ,r2(p_struct->r2),cx(&p_struct->cx),n(p_struct->n),k(p_struct->k) -{ -} - -densesolverlsreport& densesolverlsreport::operator=(const densesolverlsreport &rhs) -{ - if( this==&rhs ) - return *this; - _densesolverlsreport_owner::operator=(rhs); - return *this; -} - -densesolverlsreport::~densesolverlsreport() -{ -} - -/************************************************************************* -Dense solver. - -This subroutine solves a system A*x=b, where A is NxN non-denegerate -real matrix, x and b are vectors. - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* iterative refinement -* O(N^3) complexity - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - N - size of A - B - array[0..N-1], right part - -OUTPUT PARAMETERS - Info - return code: - * -3 A is singular, or VERY close to singular. - X is filled by zeros in such cases. - * -1 N<=0 was passed - * 1 task is solved (but matrix A may be ill-conditioned, - check R1/RInf parameters for condition numbers). - Rep - solver report, see below for more info - X - array[0..N-1], it contains: - * solution of A*x=b if A is non-singular (well-conditioned - or ill-conditioned, but not very close to singular) - * zeros, if A is singular or VERY close to singular - (in this case Info=-3). - -SOLVER REPORT - -Subroutine sets following fields of the Rep structure: -* R1 reciprocal of condition number: 1/cond(A), 1-norm. -* RInf reciprocal of condition number: 1/cond(A), inf-norm. - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void rmatrixsolve(const real_2d_array &a, const ae_int_t n, const real_1d_array &b, ae_int_t &info, densesolverreport &rep, real_1d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixsolve(const_cast(a.c_ptr()), n, const_cast(b.c_ptr()), &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Dense solver. - -Similar to RMatrixSolve() but solves task with multiple right parts (where -b and x are NxM matrices). - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* optional iterative refinement -* O(N^3+M*N^2) complexity - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - N - size of A - B - array[0..N-1,0..M-1], right part - M - right part size - RFS - iterative refinement switch: - * True - refinement is used. - Less performance, more precision. - * False - refinement is not used. - More performance, less precision. - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void rmatrixsolvem(const real_2d_array &a, const ae_int_t n, const real_2d_array &b, const ae_int_t m, const bool rfs, ae_int_t &info, densesolverreport &rep, real_2d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixsolvem(const_cast(a.c_ptr()), n, const_cast(b.c_ptr()), m, rfs, &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Dense solver. - -This subroutine solves a system A*X=B, where A is NxN non-denegerate -real matrix given by its LU decomposition, X and B are NxM real matrices. - -Algorithm features: -* automatic detection of degenerate cases -* O(N^2) complexity -* condition number estimation - -No iterative refinement is provided because exact form of original matrix -is not known to subroutine. Use RMatrixSolve or RMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - LUA - array[0..N-1,0..N-1], LU decomposition, RMatrixLU result - P - array[0..N-1], pivots array, RMatrixLU result - N - size of A - B - array[0..N-1], right part - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void rmatrixlusolve(const real_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const real_1d_array &b, ae_int_t &info, densesolverreport &rep, real_1d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixlusolve(const_cast(lua.c_ptr()), const_cast(p.c_ptr()), n, const_cast(b.c_ptr()), &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Dense solver. - -Similar to RMatrixLUSolve() but solves task with multiple right parts -(where b and x are NxM matrices). - -Algorithm features: -* automatic detection of degenerate cases -* O(M*N^2) complexity -* condition number estimation - -No iterative refinement is provided because exact form of original matrix -is not known to subroutine. Use RMatrixSolve or RMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - LUA - array[0..N-1,0..N-1], LU decomposition, RMatrixLU result - P - array[0..N-1], pivots array, RMatrixLU result - N - size of A - B - array[0..N-1,0..M-1], right part - M - right part size - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void rmatrixlusolvem(const real_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const real_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, real_2d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixlusolvem(const_cast(lua.c_ptr()), const_cast(p.c_ptr()), n, const_cast(b.c_ptr()), m, &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Dense solver. - -This subroutine solves a system A*x=b, where BOTH ORIGINAL A AND ITS -LU DECOMPOSITION ARE KNOWN. You can use it if for some reasons you have -both A and its LU decomposition. - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* iterative refinement -* O(N^2) complexity - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - LUA - array[0..N-1,0..N-1], LU decomposition, RMatrixLU result - P - array[0..N-1], pivots array, RMatrixLU result - N - size of A - B - array[0..N-1], right part - -OUTPUT PARAMETERS - Info - same as in RMatrixSolveM - Rep - same as in RMatrixSolveM - X - same as in RMatrixSolveM - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void rmatrixmixedsolve(const real_2d_array &a, const real_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const real_1d_array &b, ae_int_t &info, densesolverreport &rep, real_1d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixmixedsolve(const_cast(a.c_ptr()), const_cast(lua.c_ptr()), const_cast(p.c_ptr()), n, const_cast(b.c_ptr()), &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Dense solver. - -Similar to RMatrixMixedSolve() but solves task with multiple right parts -(where b and x are NxM matrices). - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* iterative refinement -* O(M*N^2) complexity - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - LUA - array[0..N-1,0..N-1], LU decomposition, RMatrixLU result - P - array[0..N-1], pivots array, RMatrixLU result - N - size of A - B - array[0..N-1,0..M-1], right part - M - right part size - -OUTPUT PARAMETERS - Info - same as in RMatrixSolveM - Rep - same as in RMatrixSolveM - X - same as in RMatrixSolveM - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void rmatrixmixedsolvem(const real_2d_array &a, const real_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const real_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, real_2d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixmixedsolvem(const_cast(a.c_ptr()), const_cast(lua.c_ptr()), const_cast(p.c_ptr()), n, const_cast(b.c_ptr()), m, &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Dense solver. Same as RMatrixSolveM(), but for complex matrices. - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* iterative refinement -* O(N^3+M*N^2) complexity - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - N - size of A - B - array[0..N-1,0..M-1], right part - M - right part size - RFS - iterative refinement switch: - * True - refinement is used. - Less performance, more precision. - * False - refinement is not used. - More performance, less precision. - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void cmatrixsolvem(const complex_2d_array &a, const ae_int_t n, const complex_2d_array &b, const ae_int_t m, const bool rfs, ae_int_t &info, densesolverreport &rep, complex_2d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::cmatrixsolvem(const_cast(a.c_ptr()), n, const_cast(b.c_ptr()), m, rfs, &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Dense solver. Same as RMatrixSolve(), but for complex matrices. - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* iterative refinement -* O(N^3) complexity - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - N - size of A - B - array[0..N-1], right part - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void cmatrixsolve(const complex_2d_array &a, const ae_int_t n, const complex_1d_array &b, ae_int_t &info, densesolverreport &rep, complex_1d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::cmatrixsolve(const_cast(a.c_ptr()), n, const_cast(b.c_ptr()), &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Dense solver. Same as RMatrixLUSolveM(), but for complex matrices. - -Algorithm features: -* automatic detection of degenerate cases -* O(M*N^2) complexity -* condition number estimation - -No iterative refinement is provided because exact form of original matrix -is not known to subroutine. Use CMatrixSolve or CMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - LUA - array[0..N-1,0..N-1], LU decomposition, RMatrixLU result - P - array[0..N-1], pivots array, RMatrixLU result - N - size of A - B - array[0..N-1,0..M-1], right part - M - right part size - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void cmatrixlusolvem(const complex_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const complex_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, complex_2d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::cmatrixlusolvem(const_cast(lua.c_ptr()), const_cast(p.c_ptr()), n, const_cast(b.c_ptr()), m, &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Dense solver. Same as RMatrixLUSolve(), but for complex matrices. - -Algorithm features: -* automatic detection of degenerate cases -* O(N^2) complexity -* condition number estimation - -No iterative refinement is provided because exact form of original matrix -is not known to subroutine. Use CMatrixSolve or CMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - LUA - array[0..N-1,0..N-1], LU decomposition, CMatrixLU result - P - array[0..N-1], pivots array, CMatrixLU result - N - size of A - B - array[0..N-1], right part - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void cmatrixlusolve(const complex_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const complex_1d_array &b, ae_int_t &info, densesolverreport &rep, complex_1d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::cmatrixlusolve(const_cast(lua.c_ptr()), const_cast(p.c_ptr()), n, const_cast(b.c_ptr()), &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Dense solver. Same as RMatrixMixedSolveM(), but for complex matrices. - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* iterative refinement -* O(M*N^2) complexity - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - LUA - array[0..N-1,0..N-1], LU decomposition, CMatrixLU result - P - array[0..N-1], pivots array, CMatrixLU result - N - size of A - B - array[0..N-1,0..M-1], right part - M - right part size - -OUTPUT PARAMETERS - Info - same as in RMatrixSolveM - Rep - same as in RMatrixSolveM - X - same as in RMatrixSolveM - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void cmatrixmixedsolvem(const complex_2d_array &a, const complex_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const complex_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, complex_2d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::cmatrixmixedsolvem(const_cast(a.c_ptr()), const_cast(lua.c_ptr()), const_cast(p.c_ptr()), n, const_cast(b.c_ptr()), m, &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Dense solver. Same as RMatrixMixedSolve(), but for complex matrices. - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* iterative refinement -* O(N^2) complexity - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - LUA - array[0..N-1,0..N-1], LU decomposition, CMatrixLU result - P - array[0..N-1], pivots array, CMatrixLU result - N - size of A - B - array[0..N-1], right part - -OUTPUT PARAMETERS - Info - same as in RMatrixSolveM - Rep - same as in RMatrixSolveM - X - same as in RMatrixSolveM - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void cmatrixmixedsolve(const complex_2d_array &a, const complex_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const complex_1d_array &b, ae_int_t &info, densesolverreport &rep, complex_1d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::cmatrixmixedsolve(const_cast(a.c_ptr()), const_cast(lua.c_ptr()), const_cast(p.c_ptr()), n, const_cast(b.c_ptr()), &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Dense solver. Same as RMatrixSolveM(), but for symmetric positive definite -matrices. - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* O(N^3+M*N^2) complexity -* matrix is represented by its upper or lower triangle - -No iterative refinement is provided because such partial representation of -matrix does not allow efficient calculation of extra-precise matrix-vector -products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - N - size of A - IsUpper - what half of A is provided - B - array[0..N-1,0..M-1], right part - M - right part size - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve. - Returns -3 for non-SPD matrices. - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void spdmatrixsolvem(const real_2d_array &a, const ae_int_t n, const bool isupper, const real_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, real_2d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spdmatrixsolvem(const_cast(a.c_ptr()), n, isupper, const_cast(b.c_ptr()), m, &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Dense solver. Same as RMatrixSolve(), but for SPD matrices. - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* O(N^3) complexity -* matrix is represented by its upper or lower triangle - -No iterative refinement is provided because such partial representation of -matrix does not allow efficient calculation of extra-precise matrix-vector -products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - N - size of A - IsUpper - what half of A is provided - B - array[0..N-1], right part - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Returns -3 for non-SPD matrices. - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void spdmatrixsolve(const real_2d_array &a, const ae_int_t n, const bool isupper, const real_1d_array &b, ae_int_t &info, densesolverreport &rep, real_1d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spdmatrixsolve(const_cast(a.c_ptr()), n, isupper, const_cast(b.c_ptr()), &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Dense solver. Same as RMatrixLUSolveM(), but for SPD matrices represented -by their Cholesky decomposition. - -Algorithm features: -* automatic detection of degenerate cases -* O(M*N^2) complexity -* condition number estimation -* matrix is represented by its upper or lower triangle - -No iterative refinement is provided because such partial representation of -matrix does not allow efficient calculation of extra-precise matrix-vector -products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - CHA - array[0..N-1,0..N-1], Cholesky decomposition, - SPDMatrixCholesky result - N - size of CHA - IsUpper - what half of CHA is provided - B - array[0..N-1,0..M-1], right part - M - right part size - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void spdmatrixcholeskysolvem(const real_2d_array &cha, const ae_int_t n, const bool isupper, const real_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, real_2d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spdmatrixcholeskysolvem(const_cast(cha.c_ptr()), n, isupper, const_cast(b.c_ptr()), m, &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Dense solver. Same as RMatrixLUSolve(), but for SPD matrices represented -by their Cholesky decomposition. - -Algorithm features: -* automatic detection of degenerate cases -* O(N^2) complexity -* condition number estimation -* matrix is represented by its upper or lower triangle - -No iterative refinement is provided because such partial representation of -matrix does not allow efficient calculation of extra-precise matrix-vector -products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - CHA - array[0..N-1,0..N-1], Cholesky decomposition, - SPDMatrixCholesky result - N - size of A - IsUpper - what half of CHA is provided - B - array[0..N-1], right part - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void spdmatrixcholeskysolve(const real_2d_array &cha, const ae_int_t n, const bool isupper, const real_1d_array &b, ae_int_t &info, densesolverreport &rep, real_1d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spdmatrixcholeskysolve(const_cast(cha.c_ptr()), n, isupper, const_cast(b.c_ptr()), &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Dense solver. Same as RMatrixSolveM(), but for Hermitian positive definite -matrices. - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* O(N^3+M*N^2) complexity -* matrix is represented by its upper or lower triangle - -No iterative refinement is provided because such partial representation of -matrix does not allow efficient calculation of extra-precise matrix-vector -products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - N - size of A - IsUpper - what half of A is provided - B - array[0..N-1,0..M-1], right part - M - right part size - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve. - Returns -3 for non-HPD matrices. - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void hpdmatrixsolvem(const complex_2d_array &a, const ae_int_t n, const bool isupper, const complex_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, complex_2d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::hpdmatrixsolvem(const_cast(a.c_ptr()), n, isupper, const_cast(b.c_ptr()), m, &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Dense solver. Same as RMatrixSolve(), but for Hermitian positive definite -matrices. - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* O(N^3) complexity -* matrix is represented by its upper or lower triangle - -No iterative refinement is provided because such partial representation of -matrix does not allow efficient calculation of extra-precise matrix-vector -products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - N - size of A - IsUpper - what half of A is provided - B - array[0..N-1], right part - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Returns -3 for non-HPD matrices. - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void hpdmatrixsolve(const complex_2d_array &a, const ae_int_t n, const bool isupper, const complex_1d_array &b, ae_int_t &info, densesolverreport &rep, complex_1d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::hpdmatrixsolve(const_cast(a.c_ptr()), n, isupper, const_cast(b.c_ptr()), &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Dense solver. Same as RMatrixLUSolveM(), but for HPD matrices represented -by their Cholesky decomposition. - -Algorithm features: -* automatic detection of degenerate cases -* O(M*N^2) complexity -* condition number estimation -* matrix is represented by its upper or lower triangle - -No iterative refinement is provided because such partial representation of -matrix does not allow efficient calculation of extra-precise matrix-vector -products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - CHA - array[0..N-1,0..N-1], Cholesky decomposition, - HPDMatrixCholesky result - N - size of CHA - IsUpper - what half of CHA is provided - B - array[0..N-1,0..M-1], right part - M - right part size - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void hpdmatrixcholeskysolvem(const complex_2d_array &cha, const ae_int_t n, const bool isupper, const complex_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, complex_2d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::hpdmatrixcholeskysolvem(const_cast(cha.c_ptr()), n, isupper, const_cast(b.c_ptr()), m, &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Dense solver. Same as RMatrixLUSolve(), but for HPD matrices represented -by their Cholesky decomposition. - -Algorithm features: -* automatic detection of degenerate cases -* O(N^2) complexity -* condition number estimation -* matrix is represented by its upper or lower triangle - -No iterative refinement is provided because such partial representation of -matrix does not allow efficient calculation of extra-precise matrix-vector -products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - CHA - array[0..N-1,0..N-1], Cholesky decomposition, - SPDMatrixCholesky result - N - size of A - IsUpper - what half of CHA is provided - B - array[0..N-1], right part - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void hpdmatrixcholeskysolve(const complex_2d_array &cha, const ae_int_t n, const bool isupper, const complex_1d_array &b, ae_int_t &info, densesolverreport &rep, complex_1d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::hpdmatrixcholeskysolve(const_cast(cha.c_ptr()), n, isupper, const_cast(b.c_ptr()), &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Dense solver. - -This subroutine finds solution of the linear system A*X=B with non-square, -possibly degenerate A. System is solved in the least squares sense, and -general least squares solution X = X0 + CX*y which minimizes |A*X-B| is -returned. If A is non-degenerate, solution in the usual sense is returned. - -Algorithm features: -* automatic detection (and correct handling!) of degenerate cases -* iterative refinement -* O(N^3) complexity - -INPUT PARAMETERS - A - array[0..NRows-1,0..NCols-1], system matrix - NRows - vertical size of A - NCols - horizontal size of A - B - array[0..NCols-1], right part - Threshold- a number in [0,1]. Singular values beyond Threshold are - considered zero. Set it to 0.0, if you don't understand - what it means, so the solver will choose good value on its - own. - -OUTPUT PARAMETERS - Info - return code: - * -4 SVD subroutine failed - * -1 if NRows<=0 or NCols<=0 or Threshold<0 was passed - * 1 if task is solved - Rep - solver report, see below for more info - X - array[0..N-1,0..M-1], it contains: - * solution of A*X=B (even for singular A) - * zeros, if SVD subroutine failed - -SOLVER REPORT - -Subroutine sets following fields of the Rep structure: -* R2 reciprocal of condition number: 1/cond(A), 2-norm. -* N = NCols -* K dim(Null(A)) -* CX array[0..N-1,0..K-1], kernel of A. - Columns of CX store such vectors that A*CX[i]=0. - - -- ALGLIB -- - Copyright 24.08.2009 by Bochkanov Sergey -*************************************************************************/ -void rmatrixsolvels(const real_2d_array &a, const ae_int_t nrows, const ae_int_t ncols, const real_1d_array &b, const double threshold, ae_int_t &info, densesolverlsreport &rep, real_1d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rmatrixsolvels(const_cast(a.c_ptr()), nrows, ncols, const_cast(b.c_ptr()), threshold, &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This object stores state of the LinLSQR method. - -You should use ALGLIB functions to work with this object. -*************************************************************************/ -_linlsqrstate_owner::_linlsqrstate_owner() -{ - p_struct = (alglib_impl::linlsqrstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::linlsqrstate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_linlsqrstate_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_linlsqrstate_owner::_linlsqrstate_owner(const _linlsqrstate_owner &rhs) -{ - p_struct = (alglib_impl::linlsqrstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::linlsqrstate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_linlsqrstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_linlsqrstate_owner& _linlsqrstate_owner::operator=(const _linlsqrstate_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_linlsqrstate_clear(p_struct); - if( !alglib_impl::_linlsqrstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_linlsqrstate_owner::~_linlsqrstate_owner() -{ - alglib_impl::_linlsqrstate_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::linlsqrstate* _linlsqrstate_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::linlsqrstate* _linlsqrstate_owner::c_ptr() const -{ - return const_cast(p_struct); -} -linlsqrstate::linlsqrstate() : _linlsqrstate_owner() -{ -} - -linlsqrstate::linlsqrstate(const linlsqrstate &rhs):_linlsqrstate_owner(rhs) -{ -} - -linlsqrstate& linlsqrstate::operator=(const linlsqrstate &rhs) -{ - if( this==&rhs ) - return *this; - _linlsqrstate_owner::operator=(rhs); - return *this; -} - -linlsqrstate::~linlsqrstate() -{ -} - - -/************************************************************************* - -*************************************************************************/ -_linlsqrreport_owner::_linlsqrreport_owner() -{ - p_struct = (alglib_impl::linlsqrreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::linlsqrreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_linlsqrreport_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_linlsqrreport_owner::_linlsqrreport_owner(const _linlsqrreport_owner &rhs) -{ - p_struct = (alglib_impl::linlsqrreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::linlsqrreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_linlsqrreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_linlsqrreport_owner& _linlsqrreport_owner::operator=(const _linlsqrreport_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_linlsqrreport_clear(p_struct); - if( !alglib_impl::_linlsqrreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_linlsqrreport_owner::~_linlsqrreport_owner() -{ - alglib_impl::_linlsqrreport_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::linlsqrreport* _linlsqrreport_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::linlsqrreport* _linlsqrreport_owner::c_ptr() const -{ - return const_cast(p_struct); -} -linlsqrreport::linlsqrreport() : _linlsqrreport_owner() ,iterationscount(p_struct->iterationscount),nmv(p_struct->nmv),terminationtype(p_struct->terminationtype) -{ -} - -linlsqrreport::linlsqrreport(const linlsqrreport &rhs):_linlsqrreport_owner(rhs) ,iterationscount(p_struct->iterationscount),nmv(p_struct->nmv),terminationtype(p_struct->terminationtype) -{ -} - -linlsqrreport& linlsqrreport::operator=(const linlsqrreport &rhs) -{ - if( this==&rhs ) - return *this; - _linlsqrreport_owner::operator=(rhs); - return *this; -} - -linlsqrreport::~linlsqrreport() -{ -} - -/************************************************************************* -This function initializes linear LSQR Solver. This solver is used to solve -non-symmetric (and, possibly, non-square) problems. Least squares solution -is returned for non-compatible systems. - -USAGE: -1. User initializes algorithm state with LinLSQRCreate() call -2. User tunes solver parameters with LinLSQRSetCond() and other functions -3. User calls LinLSQRSolveSparse() function which takes algorithm state - and SparseMatrix object. -4. User calls LinLSQRResults() to get solution -5. Optionally, user may call LinLSQRSolveSparse() again to solve another - problem with different matrix and/or right part without reinitializing - LinLSQRState structure. - -INPUT PARAMETERS: - M - number of rows in A - N - number of variables, N>0 - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 30.11.2011 by Bochkanov Sergey -*************************************************************************/ -void linlsqrcreate(const ae_int_t m, const ae_int_t n, linlsqrstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::linlsqrcreate(m, n, const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function changes preconditioning settings of LinLSQQSolveSparse() -function. By default, SolveSparse() uses diagonal preconditioner, but if -you want to use solver without preconditioning, you can call this function -which forces solver to use unit matrix for preconditioning. - -INPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 19.11.2012 by Bochkanov Sergey -*************************************************************************/ -void linlsqrsetprecunit(const linlsqrstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::linlsqrsetprecunit(const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function changes preconditioning settings of LinCGSolveSparse() -function. LinCGSolveSparse() will use diagonal of the system matrix as -preconditioner. This preconditioning mode is active by default. - -INPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 19.11.2012 by Bochkanov Sergey -*************************************************************************/ -void linlsqrsetprecdiag(const linlsqrstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::linlsqrsetprecdiag(const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets optional Tikhonov regularization coefficient. -It is zero by default. - -INPUT PARAMETERS: - LambdaI - regularization factor, LambdaI>=0 - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 30.11.2011 by Bochkanov Sergey -*************************************************************************/ -void linlsqrsetlambdai(const linlsqrstate &state, const double lambdai) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::linlsqrsetlambdai(const_cast(state.c_ptr()), lambdai, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Procedure for solution of A*x=b with sparse A. - -INPUT PARAMETERS: - State - algorithm state - A - sparse M*N matrix in the CRS format (you MUST contvert it - to CRS format by calling SparseConvertToCRS() function - BEFORE you pass it to this function). - B - right part, array[M] - -RESULT: - This function returns no result. - You can get solution by calling LinCGResults() - -NOTE: this function uses lightweight preconditioning - multiplication by - inverse of diag(A). If you want, you can turn preconditioning off by - calling LinLSQRSetPrecUnit(). However, preconditioning cost is low - and preconditioner is very important for solution of badly scaled - problems. - - -- ALGLIB -- - Copyright 30.11.2011 by Bochkanov Sergey -*************************************************************************/ -void linlsqrsolvesparse(const linlsqrstate &state, const sparsematrix &a, const real_1d_array &b) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::linlsqrsolvesparse(const_cast(state.c_ptr()), const_cast(a.c_ptr()), const_cast(b.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets stopping criteria. - -INPUT PARAMETERS: - EpsA - algorithm will be stopped if ||A^T*Rk||/(||A||*||Rk||)<=EpsA. - EpsB - algorithm will be stopped if ||Rk||<=EpsB*||B|| - MaxIts - algorithm will be stopped if number of iterations - more than MaxIts. - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -NOTE: if EpsA,EpsB,EpsC and MaxIts are zero then these variables will -be setted as default values. - - -- ALGLIB -- - Copyright 30.11.2011 by Bochkanov Sergey -*************************************************************************/ -void linlsqrsetcond(const linlsqrstate &state, const double epsa, const double epsb, const ae_int_t maxits) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::linlsqrsetcond(const_cast(state.c_ptr()), epsa, epsb, maxits, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -LSQR solver: results. - -This function must be called after LinLSQRSolve - -INPUT PARAMETERS: - State - algorithm state - -OUTPUT PARAMETERS: - X - array[N], solution - Rep - optimization report: - * Rep.TerminationType completion code: - * 1 ||Rk||<=EpsB*||B|| - * 4 ||A^T*Rk||/(||A||*||Rk||)<=EpsA - * 5 MaxIts steps was taken - * 7 rounding errors prevent further progress, - X contains best point found so far. - (sometimes returned on singular systems) - * Rep.IterationsCount contains iterations count - * NMV contains number of matrix-vector calculations - - -- ALGLIB -- - Copyright 30.11.2011 by Bochkanov Sergey -*************************************************************************/ -void linlsqrresults(const linlsqrstate &state, real_1d_array &x, linlsqrreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::linlsqrresults(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function turns on/off reporting. - -INPUT PARAMETERS: - State - structure which stores algorithm state - NeedXRep- whether iteration reports are needed or not - -If NeedXRep is True, algorithm will call rep() callback function if it is -provided to MinCGOptimize(). - - -- ALGLIB -- - Copyright 30.11.2011 by Bochkanov Sergey -*************************************************************************/ -void linlsqrsetxrep(const linlsqrstate &state, const bool needxrep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::linlsqrsetxrep(const_cast(state.c_ptr()), needxrep, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This object stores state of the linear CG method. - -You should use ALGLIB functions to work with this object. -Never try to access its fields directly! -*************************************************************************/ -_lincgstate_owner::_lincgstate_owner() -{ - p_struct = (alglib_impl::lincgstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::lincgstate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_lincgstate_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_lincgstate_owner::_lincgstate_owner(const _lincgstate_owner &rhs) -{ - p_struct = (alglib_impl::lincgstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::lincgstate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_lincgstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_lincgstate_owner& _lincgstate_owner::operator=(const _lincgstate_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_lincgstate_clear(p_struct); - if( !alglib_impl::_lincgstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_lincgstate_owner::~_lincgstate_owner() -{ - alglib_impl::_lincgstate_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::lincgstate* _lincgstate_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::lincgstate* _lincgstate_owner::c_ptr() const -{ - return const_cast(p_struct); -} -lincgstate::lincgstate() : _lincgstate_owner() -{ -} - -lincgstate::lincgstate(const lincgstate &rhs):_lincgstate_owner(rhs) -{ -} - -lincgstate& lincgstate::operator=(const lincgstate &rhs) -{ - if( this==&rhs ) - return *this; - _lincgstate_owner::operator=(rhs); - return *this; -} - -lincgstate::~lincgstate() -{ -} - - -/************************************************************************* - -*************************************************************************/ -_lincgreport_owner::_lincgreport_owner() -{ - p_struct = (alglib_impl::lincgreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::lincgreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_lincgreport_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_lincgreport_owner::_lincgreport_owner(const _lincgreport_owner &rhs) -{ - p_struct = (alglib_impl::lincgreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::lincgreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_lincgreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_lincgreport_owner& _lincgreport_owner::operator=(const _lincgreport_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_lincgreport_clear(p_struct); - if( !alglib_impl::_lincgreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_lincgreport_owner::~_lincgreport_owner() -{ - alglib_impl::_lincgreport_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::lincgreport* _lincgreport_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::lincgreport* _lincgreport_owner::c_ptr() const -{ - return const_cast(p_struct); -} -lincgreport::lincgreport() : _lincgreport_owner() ,iterationscount(p_struct->iterationscount),nmv(p_struct->nmv),terminationtype(p_struct->terminationtype),r2(p_struct->r2) -{ -} - -lincgreport::lincgreport(const lincgreport &rhs):_lincgreport_owner(rhs) ,iterationscount(p_struct->iterationscount),nmv(p_struct->nmv),terminationtype(p_struct->terminationtype),r2(p_struct->r2) -{ -} - -lincgreport& lincgreport::operator=(const lincgreport &rhs) -{ - if( this==&rhs ) - return *this; - _lincgreport_owner::operator=(rhs); - return *this; -} - -lincgreport::~lincgreport() -{ -} - -/************************************************************************* -This function initializes linear CG Solver. This solver is used to solve -symmetric positive definite problems. If you want to solve nonsymmetric -(or non-positive definite) problem you may use LinLSQR solver provided by -ALGLIB. - -USAGE: -1. User initializes algorithm state with LinCGCreate() call -2. User tunes solver parameters with LinCGSetCond() and other functions -3. Optionally, user sets starting point with LinCGSetStartingPoint() -4. User calls LinCGSolveSparse() function which takes algorithm state and - SparseMatrix object. -5. User calls LinCGResults() to get solution -6. Optionally, user may call LinCGSolveSparse() again to solve another - problem with different matrix and/or right part without reinitializing - LinCGState structure. - -INPUT PARAMETERS: - N - problem dimension, N>0 - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 14.11.2011 by Bochkanov Sergey -*************************************************************************/ -void lincgcreate(const ae_int_t n, lincgstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lincgcreate(n, const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets starting point. -By default, zero starting point is used. - -INPUT PARAMETERS: - X - starting point, array[N] - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 14.11.2011 by Bochkanov Sergey -*************************************************************************/ -void lincgsetstartingpoint(const lincgstate &state, const real_1d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lincgsetstartingpoint(const_cast(state.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function changes preconditioning settings of LinCGSolveSparse() -function. By default, SolveSparse() uses diagonal preconditioner, but if -you want to use solver without preconditioning, you can call this function -which forces solver to use unit matrix for preconditioning. - -INPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 19.11.2012 by Bochkanov Sergey -*************************************************************************/ -void lincgsetprecunit(const lincgstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lincgsetprecunit(const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function changes preconditioning settings of LinCGSolveSparse() -function. LinCGSolveSparse() will use diagonal of the system matrix as -preconditioner. This preconditioning mode is active by default. - -INPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 19.11.2012 by Bochkanov Sergey -*************************************************************************/ -void lincgsetprecdiag(const lincgstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lincgsetprecdiag(const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets stopping criteria. - -INPUT PARAMETERS: - EpsF - algorithm will be stopped if norm of residual is less than - EpsF*||b||. - MaxIts - algorithm will be stopped if number of iterations is more - than MaxIts. - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -NOTES: -If both EpsF and MaxIts are zero then small EpsF will be set to small -value. - - -- ALGLIB -- - Copyright 14.11.2011 by Bochkanov Sergey -*************************************************************************/ -void lincgsetcond(const lincgstate &state, const double epsf, const ae_int_t maxits) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lincgsetcond(const_cast(state.c_ptr()), epsf, maxits, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Procedure for solution of A*x=b with sparse A. - -INPUT PARAMETERS: - State - algorithm state - A - sparse matrix in the CRS format (you MUST contvert it to - CRS format by calling SparseConvertToCRS() function). - IsUpper - whether upper or lower triangle of A is used: - * IsUpper=True => only upper triangle is used and lower - triangle is not referenced at all - * IsUpper=False => only lower triangle is used and upper - triangle is not referenced at all - B - right part, array[N] - -RESULT: - This function returns no result. - You can get solution by calling LinCGResults() - -NOTE: this function uses lightweight preconditioning - multiplication by - inverse of diag(A). If you want, you can turn preconditioning off by - calling LinCGSetPrecUnit(). However, preconditioning cost is low and - preconditioner is very important for solution of badly scaled - problems. - - -- ALGLIB -- - Copyright 14.11.2011 by Bochkanov Sergey -*************************************************************************/ -void lincgsolvesparse(const lincgstate &state, const sparsematrix &a, const bool isupper, const real_1d_array &b) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lincgsolvesparse(const_cast(state.c_ptr()), const_cast(a.c_ptr()), isupper, const_cast(b.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -CG-solver: results. - -This function must be called after LinCGSolve - -INPUT PARAMETERS: - State - algorithm state - -OUTPUT PARAMETERS: - X - array[N], solution - Rep - optimization report: - * Rep.TerminationType completion code: - * -5 input matrix is either not positive definite, - too large or too small - * -4 overflow/underflow during solution - (ill conditioned problem) - * 1 ||residual||<=EpsF*||b|| - * 5 MaxIts steps was taken - * 7 rounding errors prevent further progress, - best point found is returned - * Rep.IterationsCount contains iterations count - * NMV contains number of matrix-vector calculations - - -- ALGLIB -- - Copyright 14.11.2011 by Bochkanov Sergey -*************************************************************************/ -void lincgresults(const lincgstate &state, real_1d_array &x, lincgreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lincgresults(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets restart frequency. By default, algorithm is restarted -after N subsequent iterations. - - -- ALGLIB -- - Copyright 14.11.2011 by Bochkanov Sergey -*************************************************************************/ -void lincgsetrestartfreq(const lincgstate &state, const ae_int_t srf) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lincgsetrestartfreq(const_cast(state.c_ptr()), srf, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets frequency of residual recalculations. - -Algorithm updates residual r_k using iterative formula, but recalculates -it from scratch after each 10 iterations. It is done to avoid accumulation -of numerical errors and to stop algorithm when r_k starts to grow. - -Such low update frequence (1/10) gives very little overhead, but makes -algorithm a bit more robust against numerical errors. However, you may -change it - -INPUT PARAMETERS: - Freq - desired update frequency, Freq>=0. - Zero value means that no updates will be done. - - -- ALGLIB -- - Copyright 14.11.2011 by Bochkanov Sergey -*************************************************************************/ -void lincgsetrupdatefreq(const lincgstate &state, const ae_int_t freq) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lincgsetrupdatefreq(const_cast(state.c_ptr()), freq, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function turns on/off reporting. - -INPUT PARAMETERS: - State - structure which stores algorithm state - NeedXRep- whether iteration reports are needed or not - -If NeedXRep is True, algorithm will call rep() callback function if it is -provided to MinCGOptimize(). - - -- ALGLIB -- - Copyright 14.11.2011 by Bochkanov Sergey -*************************************************************************/ -void lincgsetxrep(const lincgstate &state, const bool needxrep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::lincgsetxrep(const_cast(state.c_ptr()), needxrep, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* - -*************************************************************************/ -_nleqstate_owner::_nleqstate_owner() -{ - p_struct = (alglib_impl::nleqstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::nleqstate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_nleqstate_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_nleqstate_owner::_nleqstate_owner(const _nleqstate_owner &rhs) -{ - p_struct = (alglib_impl::nleqstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::nleqstate), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_nleqstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_nleqstate_owner& _nleqstate_owner::operator=(const _nleqstate_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_nleqstate_clear(p_struct); - if( !alglib_impl::_nleqstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_nleqstate_owner::~_nleqstate_owner() -{ - alglib_impl::_nleqstate_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::nleqstate* _nleqstate_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::nleqstate* _nleqstate_owner::c_ptr() const -{ - return const_cast(p_struct); -} -nleqstate::nleqstate() : _nleqstate_owner() ,needf(p_struct->needf),needfij(p_struct->needfij),xupdated(p_struct->xupdated),f(p_struct->f),fi(&p_struct->fi),j(&p_struct->j),x(&p_struct->x) -{ -} - -nleqstate::nleqstate(const nleqstate &rhs):_nleqstate_owner(rhs) ,needf(p_struct->needf),needfij(p_struct->needfij),xupdated(p_struct->xupdated),f(p_struct->f),fi(&p_struct->fi),j(&p_struct->j),x(&p_struct->x) -{ -} - -nleqstate& nleqstate::operator=(const nleqstate &rhs) -{ - if( this==&rhs ) - return *this; - _nleqstate_owner::operator=(rhs); - return *this; -} - -nleqstate::~nleqstate() -{ -} - - -/************************************************************************* - -*************************************************************************/ -_nleqreport_owner::_nleqreport_owner() -{ - p_struct = (alglib_impl::nleqreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::nleqreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_nleqreport_init(p_struct, NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_nleqreport_owner::_nleqreport_owner(const _nleqreport_owner &rhs) -{ - p_struct = (alglib_impl::nleqreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::nleqreport), NULL); - if( p_struct==NULL ) - throw ap_error("ALGLIB: malloc error"); - if( !alglib_impl::_nleqreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); -} - -_nleqreport_owner& _nleqreport_owner::operator=(const _nleqreport_owner &rhs) -{ - if( this==&rhs ) - return *this; - alglib_impl::_nleqreport_clear(p_struct); - if( !alglib_impl::_nleqreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) - throw ap_error("ALGLIB: malloc error"); - return *this; -} - -_nleqreport_owner::~_nleqreport_owner() -{ - alglib_impl::_nleqreport_clear(p_struct); - ae_free(p_struct); -} - -alglib_impl::nleqreport* _nleqreport_owner::c_ptr() -{ - return p_struct; -} - -alglib_impl::nleqreport* _nleqreport_owner::c_ptr() const -{ - return const_cast(p_struct); -} -nleqreport::nleqreport() : _nleqreport_owner() ,iterationscount(p_struct->iterationscount),nfunc(p_struct->nfunc),njac(p_struct->njac),terminationtype(p_struct->terminationtype) -{ -} - -nleqreport::nleqreport(const nleqreport &rhs):_nleqreport_owner(rhs) ,iterationscount(p_struct->iterationscount),nfunc(p_struct->nfunc),njac(p_struct->njac),terminationtype(p_struct->terminationtype) -{ -} - -nleqreport& nleqreport::operator=(const nleqreport &rhs) -{ - if( this==&rhs ) - return *this; - _nleqreport_owner::operator=(rhs); - return *this; -} - -nleqreport::~nleqreport() -{ -} - -/************************************************************************* - LEVENBERG-MARQUARDT-LIKE NONLINEAR SOLVER - -DESCRIPTION: -This algorithm solves system of nonlinear equations - F[0](x[0], ..., x[n-1]) = 0 - F[1](x[0], ..., x[n-1]) = 0 - ... - F[M-1](x[0], ..., x[n-1]) = 0 -with M/N do not necessarily coincide. Algorithm converges quadratically -under following conditions: - * the solution set XS is nonempty - * for some xs in XS there exist such neighbourhood N(xs) that: - * vector function F(x) and its Jacobian J(x) are continuously - differentiable on N - * ||F(x)|| provides local error bound on N, i.e. there exists such - c1, that ||F(x)||>c1*distance(x,XS) -Note that these conditions are much more weaker than usual non-singularity -conditions. For example, algorithm will converge for any affine function -F (whether its Jacobian singular or not). - - -REQUIREMENTS: -Algorithm will request following information during its operation: -* function vector F[] and Jacobian matrix at given point X -* value of merit function f(x)=F[0]^2(x)+...+F[M-1]^2(x) at given point X - - -USAGE: -1. User initializes algorithm state with NLEQCreateLM() call -2. User tunes solver parameters with NLEQSetCond(), NLEQSetStpMax() and - other functions -3. User calls NLEQSolve() function which takes algorithm state and - pointers (delegates, etc.) to callback functions which calculate merit - function value and Jacobian. -4. User calls NLEQResults() to get solution -5. Optionally, user may call NLEQRestartFrom() to solve another problem - with same parameters (N/M) but another starting point and/or another - function vector. NLEQRestartFrom() allows to reuse already initialized - structure. - - -INPUT PARAMETERS: - N - space dimension, N>1: - * if provided, only leading N elements of X are used - * if not provided, determined automatically from size of X - M - system size - X - starting point - - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -NOTES: -1. you may tune stopping conditions with NLEQSetCond() function -2. if target function contains exp() or other fast growing functions, and - optimization algorithm makes too large steps which leads to overflow, - use NLEQSetStpMax() function to bound algorithm's steps. -3. this algorithm is a slightly modified implementation of the method - described in 'Levenberg-Marquardt method for constrained nonlinear - equations with strong local convergence properties' by Christian Kanzow - Nobuo Yamashita and Masao Fukushima and further developed in 'On the - convergence of a New Levenberg-Marquardt Method' by Jin-yan Fan and - Ya-Xiang Yuan. - - - -- ALGLIB -- - Copyright 20.08.2009 by Bochkanov Sergey -*************************************************************************/ -void nleqcreatelm(const ae_int_t n, const ae_int_t m, const real_1d_array &x, nleqstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::nleqcreatelm(n, m, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* - LEVENBERG-MARQUARDT-LIKE NONLINEAR SOLVER - -DESCRIPTION: -This algorithm solves system of nonlinear equations - F[0](x[0], ..., x[n-1]) = 0 - F[1](x[0], ..., x[n-1]) = 0 - ... - F[M-1](x[0], ..., x[n-1]) = 0 -with M/N do not necessarily coincide. Algorithm converges quadratically -under following conditions: - * the solution set XS is nonempty - * for some xs in XS there exist such neighbourhood N(xs) that: - * vector function F(x) and its Jacobian J(x) are continuously - differentiable on N - * ||F(x)|| provides local error bound on N, i.e. there exists such - c1, that ||F(x)||>c1*distance(x,XS) -Note that these conditions are much more weaker than usual non-singularity -conditions. For example, algorithm will converge for any affine function -F (whether its Jacobian singular or not). - - -REQUIREMENTS: -Algorithm will request following information during its operation: -* function vector F[] and Jacobian matrix at given point X -* value of merit function f(x)=F[0]^2(x)+...+F[M-1]^2(x) at given point X - - -USAGE: -1. User initializes algorithm state with NLEQCreateLM() call -2. User tunes solver parameters with NLEQSetCond(), NLEQSetStpMax() and - other functions -3. User calls NLEQSolve() function which takes algorithm state and - pointers (delegates, etc.) to callback functions which calculate merit - function value and Jacobian. -4. User calls NLEQResults() to get solution -5. Optionally, user may call NLEQRestartFrom() to solve another problem - with same parameters (N/M) but another starting point and/or another - function vector. NLEQRestartFrom() allows to reuse already initialized - structure. - - -INPUT PARAMETERS: - N - space dimension, N>1: - * if provided, only leading N elements of X are used - * if not provided, determined automatically from size of X - M - system size - X - starting point - - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -NOTES: -1. you may tune stopping conditions with NLEQSetCond() function -2. if target function contains exp() or other fast growing functions, and - optimization algorithm makes too large steps which leads to overflow, - use NLEQSetStpMax() function to bound algorithm's steps. -3. this algorithm is a slightly modified implementation of the method - described in 'Levenberg-Marquardt method for constrained nonlinear - equations with strong local convergence properties' by Christian Kanzow - Nobuo Yamashita and Masao Fukushima and further developed in 'On the - convergence of a New Levenberg-Marquardt Method' by Jin-yan Fan and - Ya-Xiang Yuan. - - - -- ALGLIB -- - Copyright 20.08.2009 by Bochkanov Sergey -*************************************************************************/ -void nleqcreatelm(const ae_int_t m, const real_1d_array &x, nleqstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::nleqcreatelm(n, m, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets stopping conditions for the nonlinear solver - -INPUT PARAMETERS: - State - structure which stores algorithm state - EpsF - >=0 - The subroutine finishes its work if on k+1-th iteration - the condition ||F||<=EpsF is satisfied - MaxIts - maximum number of iterations. If MaxIts=0, the number of - iterations is unlimited. - -Passing EpsF=0 and MaxIts=0 simultaneously will lead to automatic -stopping criterion selection (small EpsF). - -NOTES: - - -- ALGLIB -- - Copyright 20.08.2010 by Bochkanov Sergey -*************************************************************************/ -void nleqsetcond(const nleqstate &state, const double epsf, const ae_int_t maxits) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::nleqsetcond(const_cast(state.c_ptr()), epsf, maxits, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function turns on/off reporting. - -INPUT PARAMETERS: - State - structure which stores algorithm state - NeedXRep- whether iteration reports are needed or not - -If NeedXRep is True, algorithm will call rep() callback function if it is -provided to NLEQSolve(). - - -- ALGLIB -- - Copyright 20.08.2010 by Bochkanov Sergey -*************************************************************************/ -void nleqsetxrep(const nleqstate &state, const bool needxrep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::nleqsetxrep(const_cast(state.c_ptr()), needxrep, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function sets maximum step length - -INPUT PARAMETERS: - State - structure which stores algorithm state - StpMax - maximum step length, >=0. Set StpMax to 0.0, if you don't - want to limit step length. - -Use this subroutine when target function contains exp() or other fast -growing functions, and algorithm makes too large steps which lead to -overflow. This function allows us to reject steps that are too large (and -therefore expose us to the possible overflow) without actually calculating -function value at the x+stp*d. - - -- ALGLIB -- - Copyright 20.08.2010 by Bochkanov Sergey -*************************************************************************/ -void nleqsetstpmax(const nleqstate &state, const double stpmax) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::nleqsetstpmax(const_cast(state.c_ptr()), stpmax, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This function provides reverse communication interface -Reverse communication interface is not documented or recommended to use. -See below for functions which provide better documented API -*************************************************************************/ -bool nleqiteration(const nleqstate &state) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - ae_bool result = alglib_impl::nleqiteration(const_cast(state.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void nleqsolve(nleqstate &state, - void (*func)(const real_1d_array &x, double &func, void *ptr), - void (*jac)(const real_1d_array &x, real_1d_array &fi, real_2d_array &jac, void *ptr), - void (*rep)(const real_1d_array &x, double func, void *ptr), - void *ptr) -{ - alglib_impl::ae_state _alglib_env_state; - if( func==NULL ) - throw ap_error("ALGLIB: error in 'nleqsolve()' (func is NULL)"); - if( jac==NULL ) - throw ap_error("ALGLIB: error in 'nleqsolve()' (jac is NULL)"); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - while( alglib_impl::nleqiteration(state.c_ptr(), &_alglib_env_state) ) - { - if( state.needf ) - { - func(state.x, state.f, ptr); - continue; - } - if( state.needfij ) - { - jac(state.x, state.fi, state.j, ptr); - continue; - } - if( state.xupdated ) - { - if( rep!=NULL ) - rep(state.x, state.f, ptr); - continue; - } - throw ap_error("ALGLIB: error in 'nleqsolve' (some derivatives were not provided?)"); - } - alglib_impl::ae_state_clear(&_alglib_env_state); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - - -/************************************************************************* -NLEQ solver results - -INPUT PARAMETERS: - State - algorithm state. - -OUTPUT PARAMETERS: - X - array[0..N-1], solution - Rep - optimization report: - * Rep.TerminationType completion code: - * -4 ERROR: algorithm has converged to the - stationary point Xf which is local minimum of - f=F[0]^2+...+F[m-1]^2, but is not solution of - nonlinear system. - * 1 sqrt(f)<=EpsF. - * 5 MaxIts steps was taken - * 7 stopping conditions are too stringent, - further improvement is impossible - * Rep.IterationsCount contains iterations count - * NFEV contains number of function calculations - * ActiveConstraints contains number of active constraints - - -- ALGLIB -- - Copyright 20.08.2009 by Bochkanov Sergey -*************************************************************************/ -void nleqresults(const nleqstate &state, real_1d_array &x, nleqreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::nleqresults(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -NLEQ solver results - -Buffered implementation of NLEQResults(), which uses pre-allocated buffer -to store X[]. If buffer size is too small, it resizes buffer. It is -intended to be used in the inner cycles of performance critical algorithms -where array reallocation penalty is too large to be ignored. - - -- ALGLIB -- - Copyright 20.08.2009 by Bochkanov Sergey -*************************************************************************/ -void nleqresultsbuf(const nleqstate &state, real_1d_array &x, nleqreport &rep) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::nleqresultsbuf(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -This subroutine restarts CG algorithm from new point. All optimization -parameters are left unchanged. - -This function allows to solve multiple optimization problems (which -must have same number of dimensions) without object reallocation penalty. - -INPUT PARAMETERS: - State - structure used for reverse communication previously - allocated with MinCGCreate call. - X - new starting point. - BndL - new lower bounds - BndU - new upper bounds - - -- ALGLIB -- - Copyright 30.07.2010 by Bochkanov Sergey -*************************************************************************/ -void nleqrestartfrom(const nleqstate &state, const real_1d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::nleqrestartfrom(const_cast(state.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS IMPLEMENTATION OF COMPUTATIONAL CORE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ -static void densesolver_rmatrixlusolveinternal(/* Real */ ae_matrix* lua, - /* Integer */ ae_vector* p, - double scalea, - ae_int_t n, - /* Real */ ae_matrix* a, - ae_bool havea, - /* Real */ ae_matrix* b, - ae_int_t m, - ae_int_t* info, - densesolverreport* rep, - /* Real */ ae_matrix* x, - ae_state *_state); -static void densesolver_spdmatrixcholeskysolveinternal(/* Real */ ae_matrix* cha, - double sqrtscalea, - ae_int_t n, - ae_bool isupper, - /* Real */ ae_matrix* a, - ae_bool havea, - /* Real */ ae_matrix* b, - ae_int_t m, - ae_int_t* info, - densesolverreport* rep, - /* Real */ ae_matrix* x, - ae_state *_state); -static void densesolver_cmatrixlusolveinternal(/* Complex */ ae_matrix* lua, - /* Integer */ ae_vector* p, - double scalea, - ae_int_t n, - /* Complex */ ae_matrix* a, - ae_bool havea, - /* Complex */ ae_matrix* b, - ae_int_t m, - ae_int_t* info, - densesolverreport* rep, - /* Complex */ ae_matrix* x, - ae_state *_state); -static void densesolver_hpdmatrixcholeskysolveinternal(/* Complex */ ae_matrix* cha, - double sqrtscalea, - ae_int_t n, - ae_bool isupper, - /* Complex */ ae_matrix* a, - ae_bool havea, - /* Complex */ ae_matrix* b, - ae_int_t m, - ae_int_t* info, - densesolverreport* rep, - /* Complex */ ae_matrix* x, - ae_state *_state); -static ae_int_t densesolver_densesolverrfsmax(ae_int_t n, - double r1, - double rinf, - ae_state *_state); -static ae_int_t densesolver_densesolverrfsmaxv2(ae_int_t n, - double r2, - ae_state *_state); -static void densesolver_rbasiclusolve(/* Real */ ae_matrix* lua, - /* Integer */ ae_vector* p, - double scalea, - ae_int_t n, - /* Real */ ae_vector* xb, - /* Real */ ae_vector* tmp, - ae_state *_state); -static void densesolver_spdbasiccholeskysolve(/* Real */ ae_matrix* cha, - double sqrtscalea, - ae_int_t n, - ae_bool isupper, - /* Real */ ae_vector* xb, - /* Real */ ae_vector* tmp, - ae_state *_state); -static void densesolver_cbasiclusolve(/* Complex */ ae_matrix* lua, - /* Integer */ ae_vector* p, - double scalea, - ae_int_t n, - /* Complex */ ae_vector* xb, - /* Complex */ ae_vector* tmp, - ae_state *_state); -static void densesolver_hpdbasiccholeskysolve(/* Complex */ ae_matrix* cha, - double sqrtscalea, - ae_int_t n, - ae_bool isupper, - /* Complex */ ae_vector* xb, - /* Complex */ ae_vector* tmp, - ae_state *_state); - - -static double linlsqr_atol = 1.0E-6; -static double linlsqr_btol = 1.0E-6; -static void linlsqr_clearrfields(linlsqrstate* state, ae_state *_state); - - -static double lincg_defaultprecision = 1.0E-6; -static void lincg_clearrfields(lincgstate* state, ae_state *_state); -static void lincg_updateitersdata(lincgstate* state, ae_state *_state); - - -static void nleq_clearrequestfields(nleqstate* state, ae_state *_state); -static ae_bool nleq_increaselambda(double* lambdav, - double* nu, - double lambdaup, - ae_state *_state); -static void nleq_decreaselambda(double* lambdav, - double* nu, - double lambdadown, - ae_state *_state); - - - - - -/************************************************************************* -Dense solver. - -This subroutine solves a system A*x=b, where A is NxN non-denegerate -real matrix, x and b are vectors. - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* iterative refinement -* O(N^3) complexity - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - N - size of A - B - array[0..N-1], right part - -OUTPUT PARAMETERS - Info - return code: - * -3 A is singular, or VERY close to singular. - X is filled by zeros in such cases. - * -1 N<=0 was passed - * 1 task is solved (but matrix A may be ill-conditioned, - check R1/RInf parameters for condition numbers). - Rep - solver report, see below for more info - X - array[0..N-1], it contains: - * solution of A*x=b if A is non-singular (well-conditioned - or ill-conditioned, but not very close to singular) - * zeros, if A is singular or VERY close to singular - (in this case Info=-3). - -SOLVER REPORT - -Subroutine sets following fields of the Rep structure: -* R1 reciprocal of condition number: 1/cond(A), 1-norm. -* RInf reciprocal of condition number: 1/cond(A), inf-norm. - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void rmatrixsolve(/* Real */ ae_matrix* a, - ae_int_t n, - /* Real */ ae_vector* b, - ae_int_t* info, - densesolverreport* rep, - /* Real */ ae_vector* x, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix bm; - ae_matrix xm; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _densesolverreport_clear(rep); - ae_vector_clear(x); - ae_matrix_init(&bm, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&xm, 0, 0, DT_REAL, _state, ae_true); - - if( n<=0 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - ae_matrix_set_length(&bm, n, 1, _state); - ae_v_move(&bm.ptr.pp_double[0][0], bm.stride, &b->ptr.p_double[0], 1, ae_v_len(0,n-1)); - rmatrixsolvem(a, n, &bm, 1, ae_true, info, rep, &xm, _state); - ae_vector_set_length(x, n, _state); - ae_v_move(&x->ptr.p_double[0], 1, &xm.ptr.pp_double[0][0], xm.stride, ae_v_len(0,n-1)); - ae_frame_leave(_state); -} - - -/************************************************************************* -Dense solver. - -Similar to RMatrixSolve() but solves task with multiple right parts (where -b and x are NxM matrices). - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* optional iterative refinement -* O(N^3+M*N^2) complexity - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - N - size of A - B - array[0..N-1,0..M-1], right part - M - right part size - RFS - iterative refinement switch: - * True - refinement is used. - Less performance, more precision. - * False - refinement is not used. - More performance, less precision. - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void rmatrixsolvem(/* Real */ ae_matrix* a, - ae_int_t n, - /* Real */ ae_matrix* b, - ae_int_t m, - ae_bool rfs, - ae_int_t* info, - densesolverreport* rep, - /* Real */ ae_matrix* x, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix da; - ae_matrix emptya; - ae_vector p; - double scalea; - ae_int_t i; - ae_int_t j; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _densesolverreport_clear(rep); - ae_matrix_clear(x); - ae_matrix_init(&da, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&emptya, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&p, 0, DT_INT, _state, ae_true); - - - /* - * prepare: check inputs, allocate space... - */ - if( n<=0||m<=0 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - ae_matrix_set_length(&da, n, n, _state); - - /* - * 1. scale matrix, max(|A[i,j]|) - * 2. factorize scaled matrix - * 3. solve - */ - scalea = 0; - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - scalea = ae_maxreal(scalea, ae_fabs(a->ptr.pp_double[i][j], _state), _state); - } - } - if( ae_fp_eq(scalea,0) ) - { - scalea = 1; - } - scalea = 1/scalea; - for(i=0; i<=n-1; i++) - { - ae_v_move(&da.ptr.pp_double[i][0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,n-1)); - } - rmatrixlu(&da, n, n, &p, _state); - if( rfs ) - { - densesolver_rmatrixlusolveinternal(&da, &p, scalea, n, a, ae_true, b, m, info, rep, x, _state); - } - else - { - densesolver_rmatrixlusolveinternal(&da, &p, scalea, n, &emptya, ae_false, b, m, info, rep, x, _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Dense solver. - -This subroutine solves a system A*X=B, where A is NxN non-denegerate -real matrix given by its LU decomposition, X and B are NxM real matrices. - -Algorithm features: -* automatic detection of degenerate cases -* O(N^2) complexity -* condition number estimation - -No iterative refinement is provided because exact form of original matrix -is not known to subroutine. Use RMatrixSolve or RMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - LUA - array[0..N-1,0..N-1], LU decomposition, RMatrixLU result - P - array[0..N-1], pivots array, RMatrixLU result - N - size of A - B - array[0..N-1], right part - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void rmatrixlusolve(/* Real */ ae_matrix* lua, - /* Integer */ ae_vector* p, - ae_int_t n, - /* Real */ ae_vector* b, - ae_int_t* info, - densesolverreport* rep, - /* Real */ ae_vector* x, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix bm; - ae_matrix xm; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _densesolverreport_clear(rep); - ae_vector_clear(x); - ae_matrix_init(&bm, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&xm, 0, 0, DT_REAL, _state, ae_true); - - if( n<=0 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - ae_matrix_set_length(&bm, n, 1, _state); - ae_v_move(&bm.ptr.pp_double[0][0], bm.stride, &b->ptr.p_double[0], 1, ae_v_len(0,n-1)); - rmatrixlusolvem(lua, p, n, &bm, 1, info, rep, &xm, _state); - ae_vector_set_length(x, n, _state); - ae_v_move(&x->ptr.p_double[0], 1, &xm.ptr.pp_double[0][0], xm.stride, ae_v_len(0,n-1)); - ae_frame_leave(_state); -} - - -/************************************************************************* -Dense solver. - -Similar to RMatrixLUSolve() but solves task with multiple right parts -(where b and x are NxM matrices). - -Algorithm features: -* automatic detection of degenerate cases -* O(M*N^2) complexity -* condition number estimation - -No iterative refinement is provided because exact form of original matrix -is not known to subroutine. Use RMatrixSolve or RMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - LUA - array[0..N-1,0..N-1], LU decomposition, RMatrixLU result - P - array[0..N-1], pivots array, RMatrixLU result - N - size of A - B - array[0..N-1,0..M-1], right part - M - right part size - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void rmatrixlusolvem(/* Real */ ae_matrix* lua, - /* Integer */ ae_vector* p, - ae_int_t n, - /* Real */ ae_matrix* b, - ae_int_t m, - ae_int_t* info, - densesolverreport* rep, - /* Real */ ae_matrix* x, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix emptya; - ae_int_t i; - ae_int_t j; - double scalea; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _densesolverreport_clear(rep); - ae_matrix_clear(x); - ae_matrix_init(&emptya, 0, 0, DT_REAL, _state, ae_true); - - - /* - * prepare: check inputs, allocate space... - */ - if( n<=0||m<=0 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - - /* - * 1. scale matrix, max(|U[i,j]|) - * we assume that LU is in its normal form, i.e. |L[i,j]|<=1 - * 2. solve - */ - scalea = 0; - for(i=0; i<=n-1; i++) - { - for(j=i; j<=n-1; j++) - { - scalea = ae_maxreal(scalea, ae_fabs(lua->ptr.pp_double[i][j], _state), _state); - } - } - if( ae_fp_eq(scalea,0) ) - { - scalea = 1; - } - scalea = 1/scalea; - densesolver_rmatrixlusolveinternal(lua, p, scalea, n, &emptya, ae_false, b, m, info, rep, x, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Dense solver. - -This subroutine solves a system A*x=b, where BOTH ORIGINAL A AND ITS -LU DECOMPOSITION ARE KNOWN. You can use it if for some reasons you have -both A and its LU decomposition. - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* iterative refinement -* O(N^2) complexity - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - LUA - array[0..N-1,0..N-1], LU decomposition, RMatrixLU result - P - array[0..N-1], pivots array, RMatrixLU result - N - size of A - B - array[0..N-1], right part - -OUTPUT PARAMETERS - Info - same as in RMatrixSolveM - Rep - same as in RMatrixSolveM - X - same as in RMatrixSolveM - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void rmatrixmixedsolve(/* Real */ ae_matrix* a, - /* Real */ ae_matrix* lua, - /* Integer */ ae_vector* p, - ae_int_t n, - /* Real */ ae_vector* b, - ae_int_t* info, - densesolverreport* rep, - /* Real */ ae_vector* x, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix bm; - ae_matrix xm; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _densesolverreport_clear(rep); - ae_vector_clear(x); - ae_matrix_init(&bm, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&xm, 0, 0, DT_REAL, _state, ae_true); - - if( n<=0 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - ae_matrix_set_length(&bm, n, 1, _state); - ae_v_move(&bm.ptr.pp_double[0][0], bm.stride, &b->ptr.p_double[0], 1, ae_v_len(0,n-1)); - rmatrixmixedsolvem(a, lua, p, n, &bm, 1, info, rep, &xm, _state); - ae_vector_set_length(x, n, _state); - ae_v_move(&x->ptr.p_double[0], 1, &xm.ptr.pp_double[0][0], xm.stride, ae_v_len(0,n-1)); - ae_frame_leave(_state); -} - - -/************************************************************************* -Dense solver. - -Similar to RMatrixMixedSolve() but solves task with multiple right parts -(where b and x are NxM matrices). - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* iterative refinement -* O(M*N^2) complexity - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - LUA - array[0..N-1,0..N-1], LU decomposition, RMatrixLU result - P - array[0..N-1], pivots array, RMatrixLU result - N - size of A - B - array[0..N-1,0..M-1], right part - M - right part size - -OUTPUT PARAMETERS - Info - same as in RMatrixSolveM - Rep - same as in RMatrixSolveM - X - same as in RMatrixSolveM - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void rmatrixmixedsolvem(/* Real */ ae_matrix* a, - /* Real */ ae_matrix* lua, - /* Integer */ ae_vector* p, - ae_int_t n, - /* Real */ ae_matrix* b, - ae_int_t m, - ae_int_t* info, - densesolverreport* rep, - /* Real */ ae_matrix* x, - ae_state *_state) -{ - double scalea; - ae_int_t i; - ae_int_t j; - - *info = 0; - _densesolverreport_clear(rep); - ae_matrix_clear(x); - - - /* - * prepare: check inputs, allocate space... - */ - if( n<=0||m<=0 ) - { - *info = -1; - return; - } - - /* - * 1. scale matrix, max(|A[i,j]|) - * 2. factorize scaled matrix - * 3. solve - */ - scalea = 0; - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - scalea = ae_maxreal(scalea, ae_fabs(a->ptr.pp_double[i][j], _state), _state); - } - } - if( ae_fp_eq(scalea,0) ) - { - scalea = 1; - } - scalea = 1/scalea; - densesolver_rmatrixlusolveinternal(lua, p, scalea, n, a, ae_true, b, m, info, rep, x, _state); -} - - -/************************************************************************* -Dense solver. Same as RMatrixSolveM(), but for complex matrices. - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* iterative refinement -* O(N^3+M*N^2) complexity - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - N - size of A - B - array[0..N-1,0..M-1], right part - M - right part size - RFS - iterative refinement switch: - * True - refinement is used. - Less performance, more precision. - * False - refinement is not used. - More performance, less precision. - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void cmatrixsolvem(/* Complex */ ae_matrix* a, - ae_int_t n, - /* Complex */ ae_matrix* b, - ae_int_t m, - ae_bool rfs, - ae_int_t* info, - densesolverreport* rep, - /* Complex */ ae_matrix* x, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix da; - ae_matrix emptya; - ae_vector p; - double scalea; - ae_int_t i; - ae_int_t j; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _densesolverreport_clear(rep); - ae_matrix_clear(x); - ae_matrix_init(&da, 0, 0, DT_COMPLEX, _state, ae_true); - ae_matrix_init(&emptya, 0, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&p, 0, DT_INT, _state, ae_true); - - - /* - * prepare: check inputs, allocate space... - */ - if( n<=0||m<=0 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - ae_matrix_set_length(&da, n, n, _state); - - /* - * 1. scale matrix, max(|A[i,j]|) - * 2. factorize scaled matrix - * 3. solve - */ - scalea = 0; - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - scalea = ae_maxreal(scalea, ae_c_abs(a->ptr.pp_complex[i][j], _state), _state); - } - } - if( ae_fp_eq(scalea,0) ) - { - scalea = 1; - } - scalea = 1/scalea; - for(i=0; i<=n-1; i++) - { - ae_v_cmove(&da.ptr.pp_complex[i][0], 1, &a->ptr.pp_complex[i][0], 1, "N", ae_v_len(0,n-1)); - } - cmatrixlu(&da, n, n, &p, _state); - if( rfs ) - { - densesolver_cmatrixlusolveinternal(&da, &p, scalea, n, a, ae_true, b, m, info, rep, x, _state); - } - else - { - densesolver_cmatrixlusolveinternal(&da, &p, scalea, n, &emptya, ae_false, b, m, info, rep, x, _state); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Dense solver. Same as RMatrixSolve(), but for complex matrices. - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* iterative refinement -* O(N^3) complexity - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - N - size of A - B - array[0..N-1], right part - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void cmatrixsolve(/* Complex */ ae_matrix* a, - ae_int_t n, - /* Complex */ ae_vector* b, - ae_int_t* info, - densesolverreport* rep, - /* Complex */ ae_vector* x, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix bm; - ae_matrix xm; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _densesolverreport_clear(rep); - ae_vector_clear(x); - ae_matrix_init(&bm, 0, 0, DT_COMPLEX, _state, ae_true); - ae_matrix_init(&xm, 0, 0, DT_COMPLEX, _state, ae_true); - - if( n<=0 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - ae_matrix_set_length(&bm, n, 1, _state); - ae_v_cmove(&bm.ptr.pp_complex[0][0], bm.stride, &b->ptr.p_complex[0], 1, "N", ae_v_len(0,n-1)); - cmatrixsolvem(a, n, &bm, 1, ae_true, info, rep, &xm, _state); - ae_vector_set_length(x, n, _state); - ae_v_cmove(&x->ptr.p_complex[0], 1, &xm.ptr.pp_complex[0][0], xm.stride, "N", ae_v_len(0,n-1)); - ae_frame_leave(_state); -} - - -/************************************************************************* -Dense solver. Same as RMatrixLUSolveM(), but for complex matrices. - -Algorithm features: -* automatic detection of degenerate cases -* O(M*N^2) complexity -* condition number estimation - -No iterative refinement is provided because exact form of original matrix -is not known to subroutine. Use CMatrixSolve or CMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - LUA - array[0..N-1,0..N-1], LU decomposition, RMatrixLU result - P - array[0..N-1], pivots array, RMatrixLU result - N - size of A - B - array[0..N-1,0..M-1], right part - M - right part size - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void cmatrixlusolvem(/* Complex */ ae_matrix* lua, - /* Integer */ ae_vector* p, - ae_int_t n, - /* Complex */ ae_matrix* b, - ae_int_t m, - ae_int_t* info, - densesolverreport* rep, - /* Complex */ ae_matrix* x, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix emptya; - ae_int_t i; - ae_int_t j; - double scalea; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _densesolverreport_clear(rep); - ae_matrix_clear(x); - ae_matrix_init(&emptya, 0, 0, DT_COMPLEX, _state, ae_true); - - - /* - * prepare: check inputs, allocate space... - */ - if( n<=0||m<=0 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - - /* - * 1. scale matrix, max(|U[i,j]|) - * we assume that LU is in its normal form, i.e. |L[i,j]|<=1 - * 2. solve - */ - scalea = 0; - for(i=0; i<=n-1; i++) - { - for(j=i; j<=n-1; j++) - { - scalea = ae_maxreal(scalea, ae_c_abs(lua->ptr.pp_complex[i][j], _state), _state); - } - } - if( ae_fp_eq(scalea,0) ) - { - scalea = 1; - } - scalea = 1/scalea; - densesolver_cmatrixlusolveinternal(lua, p, scalea, n, &emptya, ae_false, b, m, info, rep, x, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Dense solver. Same as RMatrixLUSolve(), but for complex matrices. - -Algorithm features: -* automatic detection of degenerate cases -* O(N^2) complexity -* condition number estimation - -No iterative refinement is provided because exact form of original matrix -is not known to subroutine. Use CMatrixSolve or CMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - LUA - array[0..N-1,0..N-1], LU decomposition, CMatrixLU result - P - array[0..N-1], pivots array, CMatrixLU result - N - size of A - B - array[0..N-1], right part - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void cmatrixlusolve(/* Complex */ ae_matrix* lua, - /* Integer */ ae_vector* p, - ae_int_t n, - /* Complex */ ae_vector* b, - ae_int_t* info, - densesolverreport* rep, - /* Complex */ ae_vector* x, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix bm; - ae_matrix xm; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _densesolverreport_clear(rep); - ae_vector_clear(x); - ae_matrix_init(&bm, 0, 0, DT_COMPLEX, _state, ae_true); - ae_matrix_init(&xm, 0, 0, DT_COMPLEX, _state, ae_true); - - if( n<=0 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - ae_matrix_set_length(&bm, n, 1, _state); - ae_v_cmove(&bm.ptr.pp_complex[0][0], bm.stride, &b->ptr.p_complex[0], 1, "N", ae_v_len(0,n-1)); - cmatrixlusolvem(lua, p, n, &bm, 1, info, rep, &xm, _state); - ae_vector_set_length(x, n, _state); - ae_v_cmove(&x->ptr.p_complex[0], 1, &xm.ptr.pp_complex[0][0], xm.stride, "N", ae_v_len(0,n-1)); - ae_frame_leave(_state); -} - - -/************************************************************************* -Dense solver. Same as RMatrixMixedSolveM(), but for complex matrices. - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* iterative refinement -* O(M*N^2) complexity - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - LUA - array[0..N-1,0..N-1], LU decomposition, CMatrixLU result - P - array[0..N-1], pivots array, CMatrixLU result - N - size of A - B - array[0..N-1,0..M-1], right part - M - right part size - -OUTPUT PARAMETERS - Info - same as in RMatrixSolveM - Rep - same as in RMatrixSolveM - X - same as in RMatrixSolveM - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void cmatrixmixedsolvem(/* Complex */ ae_matrix* a, - /* Complex */ ae_matrix* lua, - /* Integer */ ae_vector* p, - ae_int_t n, - /* Complex */ ae_matrix* b, - ae_int_t m, - ae_int_t* info, - densesolverreport* rep, - /* Complex */ ae_matrix* x, - ae_state *_state) -{ - double scalea; - ae_int_t i; - ae_int_t j; - - *info = 0; - _densesolverreport_clear(rep); - ae_matrix_clear(x); - - - /* - * prepare: check inputs, allocate space... - */ - if( n<=0||m<=0 ) - { - *info = -1; - return; - } - - /* - * 1. scale matrix, max(|A[i,j]|) - * 2. factorize scaled matrix - * 3. solve - */ - scalea = 0; - for(i=0; i<=n-1; i++) - { - for(j=0; j<=n-1; j++) - { - scalea = ae_maxreal(scalea, ae_c_abs(a->ptr.pp_complex[i][j], _state), _state); - } - } - if( ae_fp_eq(scalea,0) ) - { - scalea = 1; - } - scalea = 1/scalea; - densesolver_cmatrixlusolveinternal(lua, p, scalea, n, a, ae_true, b, m, info, rep, x, _state); -} - - -/************************************************************************* -Dense solver. Same as RMatrixMixedSolve(), but for complex matrices. - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* iterative refinement -* O(N^2) complexity - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - LUA - array[0..N-1,0..N-1], LU decomposition, CMatrixLU result - P - array[0..N-1], pivots array, CMatrixLU result - N - size of A - B - array[0..N-1], right part - -OUTPUT PARAMETERS - Info - same as in RMatrixSolveM - Rep - same as in RMatrixSolveM - X - same as in RMatrixSolveM - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void cmatrixmixedsolve(/* Complex */ ae_matrix* a, - /* Complex */ ae_matrix* lua, - /* Integer */ ae_vector* p, - ae_int_t n, - /* Complex */ ae_vector* b, - ae_int_t* info, - densesolverreport* rep, - /* Complex */ ae_vector* x, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix bm; - ae_matrix xm; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _densesolverreport_clear(rep); - ae_vector_clear(x); - ae_matrix_init(&bm, 0, 0, DT_COMPLEX, _state, ae_true); - ae_matrix_init(&xm, 0, 0, DT_COMPLEX, _state, ae_true); - - if( n<=0 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - ae_matrix_set_length(&bm, n, 1, _state); - ae_v_cmove(&bm.ptr.pp_complex[0][0], bm.stride, &b->ptr.p_complex[0], 1, "N", ae_v_len(0,n-1)); - cmatrixmixedsolvem(a, lua, p, n, &bm, 1, info, rep, &xm, _state); - ae_vector_set_length(x, n, _state); - ae_v_cmove(&x->ptr.p_complex[0], 1, &xm.ptr.pp_complex[0][0], xm.stride, "N", ae_v_len(0,n-1)); - ae_frame_leave(_state); -} - - -/************************************************************************* -Dense solver. Same as RMatrixSolveM(), but for symmetric positive definite -matrices. - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* O(N^3+M*N^2) complexity -* matrix is represented by its upper or lower triangle - -No iterative refinement is provided because such partial representation of -matrix does not allow efficient calculation of extra-precise matrix-vector -products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - N - size of A - IsUpper - what half of A is provided - B - array[0..N-1,0..M-1], right part - M - right part size - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve. - Returns -3 for non-SPD matrices. - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void spdmatrixsolvem(/* Real */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - /* Real */ ae_matrix* b, - ae_int_t m, - ae_int_t* info, - densesolverreport* rep, - /* Real */ ae_matrix* x, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix da; - double sqrtscalea; - ae_int_t i; - ae_int_t j; - ae_int_t j1; - ae_int_t j2; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _densesolverreport_clear(rep); - ae_matrix_clear(x); - ae_matrix_init(&da, 0, 0, DT_REAL, _state, ae_true); - - - /* - * prepare: check inputs, allocate space... - */ - if( n<=0||m<=0 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - ae_matrix_set_length(&da, n, n, _state); - - /* - * 1. scale matrix, max(|A[i,j]|) - * 2. factorize scaled matrix - * 3. solve - */ - sqrtscalea = 0; - for(i=0; i<=n-1; i++) - { - if( isupper ) - { - j1 = i; - j2 = n-1; - } - else - { - j1 = 0; - j2 = i; - } - for(j=j1; j<=j2; j++) - { - sqrtscalea = ae_maxreal(sqrtscalea, ae_fabs(a->ptr.pp_double[i][j], _state), _state); - } - } - if( ae_fp_eq(sqrtscalea,0) ) - { - sqrtscalea = 1; - } - sqrtscalea = 1/sqrtscalea; - sqrtscalea = ae_sqrt(sqrtscalea, _state); - for(i=0; i<=n-1; i++) - { - if( isupper ) - { - j1 = i; - j2 = n-1; - } - else - { - j1 = 0; - j2 = i; - } - ae_v_move(&da.ptr.pp_double[i][j1], 1, &a->ptr.pp_double[i][j1], 1, ae_v_len(j1,j2)); - } - if( !spdmatrixcholesky(&da, n, isupper, _state) ) - { - ae_matrix_set_length(x, n, m, _state); - for(i=0; i<=n-1; i++) - { - for(j=0; j<=m-1; j++) - { - x->ptr.pp_double[i][j] = 0; - } - } - rep->r1 = 0; - rep->rinf = 0; - *info = -3; - ae_frame_leave(_state); - return; - } - *info = 1; - densesolver_spdmatrixcholeskysolveinternal(&da, sqrtscalea, n, isupper, a, ae_true, b, m, info, rep, x, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Dense solver. Same as RMatrixSolve(), but for SPD matrices. - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* O(N^3) complexity -* matrix is represented by its upper or lower triangle - -No iterative refinement is provided because such partial representation of -matrix does not allow efficient calculation of extra-precise matrix-vector -products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - N - size of A - IsUpper - what half of A is provided - B - array[0..N-1], right part - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Returns -3 for non-SPD matrices. - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void spdmatrixsolve(/* Real */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - /* Real */ ae_vector* b, - ae_int_t* info, - densesolverreport* rep, - /* Real */ ae_vector* x, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix bm; - ae_matrix xm; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _densesolverreport_clear(rep); - ae_vector_clear(x); - ae_matrix_init(&bm, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&xm, 0, 0, DT_REAL, _state, ae_true); - - if( n<=0 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - ae_matrix_set_length(&bm, n, 1, _state); - ae_v_move(&bm.ptr.pp_double[0][0], bm.stride, &b->ptr.p_double[0], 1, ae_v_len(0,n-1)); - spdmatrixsolvem(a, n, isupper, &bm, 1, info, rep, &xm, _state); - ae_vector_set_length(x, n, _state); - ae_v_move(&x->ptr.p_double[0], 1, &xm.ptr.pp_double[0][0], xm.stride, ae_v_len(0,n-1)); - ae_frame_leave(_state); -} - - -/************************************************************************* -Dense solver. Same as RMatrixLUSolveM(), but for SPD matrices represented -by their Cholesky decomposition. - -Algorithm features: -* automatic detection of degenerate cases -* O(M*N^2) complexity -* condition number estimation -* matrix is represented by its upper or lower triangle - -No iterative refinement is provided because such partial representation of -matrix does not allow efficient calculation of extra-precise matrix-vector -products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - CHA - array[0..N-1,0..N-1], Cholesky decomposition, - SPDMatrixCholesky result - N - size of CHA - IsUpper - what half of CHA is provided - B - array[0..N-1,0..M-1], right part - M - right part size - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void spdmatrixcholeskysolvem(/* Real */ ae_matrix* cha, - ae_int_t n, - ae_bool isupper, - /* Real */ ae_matrix* b, - ae_int_t m, - ae_int_t* info, - densesolverreport* rep, - /* Real */ ae_matrix* x, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix emptya; - double sqrtscalea; - ae_int_t i; - ae_int_t j; - ae_int_t j1; - ae_int_t j2; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _densesolverreport_clear(rep); - ae_matrix_clear(x); - ae_matrix_init(&emptya, 0, 0, DT_REAL, _state, ae_true); - - - /* - * prepare: check inputs, allocate space... - */ - if( n<=0||m<=0 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - - /* - * 1. scale matrix, max(|U[i,j]|) - * 2. factorize scaled matrix - * 3. solve - */ - sqrtscalea = 0; - for(i=0; i<=n-1; i++) - { - if( isupper ) - { - j1 = i; - j2 = n-1; - } - else - { - j1 = 0; - j2 = i; - } - for(j=j1; j<=j2; j++) - { - sqrtscalea = ae_maxreal(sqrtscalea, ae_fabs(cha->ptr.pp_double[i][j], _state), _state); - } - } - if( ae_fp_eq(sqrtscalea,0) ) - { - sqrtscalea = 1; - } - sqrtscalea = 1/sqrtscalea; - densesolver_spdmatrixcholeskysolveinternal(cha, sqrtscalea, n, isupper, &emptya, ae_false, b, m, info, rep, x, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Dense solver. Same as RMatrixLUSolve(), but for SPD matrices represented -by their Cholesky decomposition. - -Algorithm features: -* automatic detection of degenerate cases -* O(N^2) complexity -* condition number estimation -* matrix is represented by its upper or lower triangle - -No iterative refinement is provided because such partial representation of -matrix does not allow efficient calculation of extra-precise matrix-vector -products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - CHA - array[0..N-1,0..N-1], Cholesky decomposition, - SPDMatrixCholesky result - N - size of A - IsUpper - what half of CHA is provided - B - array[0..N-1], right part - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void spdmatrixcholeskysolve(/* Real */ ae_matrix* cha, - ae_int_t n, - ae_bool isupper, - /* Real */ ae_vector* b, - ae_int_t* info, - densesolverreport* rep, - /* Real */ ae_vector* x, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix bm; - ae_matrix xm; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _densesolverreport_clear(rep); - ae_vector_clear(x); - ae_matrix_init(&bm, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&xm, 0, 0, DT_REAL, _state, ae_true); - - if( n<=0 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - ae_matrix_set_length(&bm, n, 1, _state); - ae_v_move(&bm.ptr.pp_double[0][0], bm.stride, &b->ptr.p_double[0], 1, ae_v_len(0,n-1)); - spdmatrixcholeskysolvem(cha, n, isupper, &bm, 1, info, rep, &xm, _state); - ae_vector_set_length(x, n, _state); - ae_v_move(&x->ptr.p_double[0], 1, &xm.ptr.pp_double[0][0], xm.stride, ae_v_len(0,n-1)); - ae_frame_leave(_state); -} - - -/************************************************************************* -Dense solver. Same as RMatrixSolveM(), but for Hermitian positive definite -matrices. - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* O(N^3+M*N^2) complexity -* matrix is represented by its upper or lower triangle - -No iterative refinement is provided because such partial representation of -matrix does not allow efficient calculation of extra-precise matrix-vector -products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - N - size of A - IsUpper - what half of A is provided - B - array[0..N-1,0..M-1], right part - M - right part size - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve. - Returns -3 for non-HPD matrices. - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void hpdmatrixsolvem(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - /* Complex */ ae_matrix* b, - ae_int_t m, - ae_int_t* info, - densesolverreport* rep, - /* Complex */ ae_matrix* x, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix da; - double sqrtscalea; - ae_int_t i; - ae_int_t j; - ae_int_t j1; - ae_int_t j2; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _densesolverreport_clear(rep); - ae_matrix_clear(x); - ae_matrix_init(&da, 0, 0, DT_COMPLEX, _state, ae_true); - - - /* - * prepare: check inputs, allocate space... - */ - if( n<=0||m<=0 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - ae_matrix_set_length(&da, n, n, _state); - - /* - * 1. scale matrix, max(|A[i,j]|) - * 2. factorize scaled matrix - * 3. solve - */ - sqrtscalea = 0; - for(i=0; i<=n-1; i++) - { - if( isupper ) - { - j1 = i; - j2 = n-1; - } - else - { - j1 = 0; - j2 = i; - } - for(j=j1; j<=j2; j++) - { - sqrtscalea = ae_maxreal(sqrtscalea, ae_c_abs(a->ptr.pp_complex[i][j], _state), _state); - } - } - if( ae_fp_eq(sqrtscalea,0) ) - { - sqrtscalea = 1; - } - sqrtscalea = 1/sqrtscalea; - sqrtscalea = ae_sqrt(sqrtscalea, _state); - for(i=0; i<=n-1; i++) - { - if( isupper ) - { - j1 = i; - j2 = n-1; - } - else - { - j1 = 0; - j2 = i; - } - ae_v_cmove(&da.ptr.pp_complex[i][j1], 1, &a->ptr.pp_complex[i][j1], 1, "N", ae_v_len(j1,j2)); - } - if( !hpdmatrixcholesky(&da, n, isupper, _state) ) - { - ae_matrix_set_length(x, n, m, _state); - for(i=0; i<=n-1; i++) - { - for(j=0; j<=m-1; j++) - { - x->ptr.pp_complex[i][j] = ae_complex_from_d(0); - } - } - rep->r1 = 0; - rep->rinf = 0; - *info = -3; - ae_frame_leave(_state); - return; - } - *info = 1; - densesolver_hpdmatrixcholeskysolveinternal(&da, sqrtscalea, n, isupper, a, ae_true, b, m, info, rep, x, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Dense solver. Same as RMatrixSolve(), but for Hermitian positive definite -matrices. - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* O(N^3) complexity -* matrix is represented by its upper or lower triangle - -No iterative refinement is provided because such partial representation of -matrix does not allow efficient calculation of extra-precise matrix-vector -products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - N - size of A - IsUpper - what half of A is provided - B - array[0..N-1], right part - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Returns -3 for non-HPD matrices. - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void hpdmatrixsolve(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - /* Complex */ ae_vector* b, - ae_int_t* info, - densesolverreport* rep, - /* Complex */ ae_vector* x, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix bm; - ae_matrix xm; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _densesolverreport_clear(rep); - ae_vector_clear(x); - ae_matrix_init(&bm, 0, 0, DT_COMPLEX, _state, ae_true); - ae_matrix_init(&xm, 0, 0, DT_COMPLEX, _state, ae_true); - - if( n<=0 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - ae_matrix_set_length(&bm, n, 1, _state); - ae_v_cmove(&bm.ptr.pp_complex[0][0], bm.stride, &b->ptr.p_complex[0], 1, "N", ae_v_len(0,n-1)); - hpdmatrixsolvem(a, n, isupper, &bm, 1, info, rep, &xm, _state); - ae_vector_set_length(x, n, _state); - ae_v_cmove(&x->ptr.p_complex[0], 1, &xm.ptr.pp_complex[0][0], xm.stride, "N", ae_v_len(0,n-1)); - ae_frame_leave(_state); -} - - -/************************************************************************* -Dense solver. Same as RMatrixLUSolveM(), but for HPD matrices represented -by their Cholesky decomposition. - -Algorithm features: -* automatic detection of degenerate cases -* O(M*N^2) complexity -* condition number estimation -* matrix is represented by its upper or lower triangle - -No iterative refinement is provided because such partial representation of -matrix does not allow efficient calculation of extra-precise matrix-vector -products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - CHA - array[0..N-1,0..N-1], Cholesky decomposition, - HPDMatrixCholesky result - N - size of CHA - IsUpper - what half of CHA is provided - B - array[0..N-1,0..M-1], right part - M - right part size - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void hpdmatrixcholeskysolvem(/* Complex */ ae_matrix* cha, - ae_int_t n, - ae_bool isupper, - /* Complex */ ae_matrix* b, - ae_int_t m, - ae_int_t* info, - densesolverreport* rep, - /* Complex */ ae_matrix* x, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix emptya; - double sqrtscalea; - ae_int_t i; - ae_int_t j; - ae_int_t j1; - ae_int_t j2; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _densesolverreport_clear(rep); - ae_matrix_clear(x); - ae_matrix_init(&emptya, 0, 0, DT_COMPLEX, _state, ae_true); - - - /* - * prepare: check inputs, allocate space... - */ - if( n<=0||m<=0 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - - /* - * 1. scale matrix, max(|U[i,j]|) - * 2. factorize scaled matrix - * 3. solve - */ - sqrtscalea = 0; - for(i=0; i<=n-1; i++) - { - if( isupper ) - { - j1 = i; - j2 = n-1; - } - else - { - j1 = 0; - j2 = i; - } - for(j=j1; j<=j2; j++) - { - sqrtscalea = ae_maxreal(sqrtscalea, ae_c_abs(cha->ptr.pp_complex[i][j], _state), _state); - } - } - if( ae_fp_eq(sqrtscalea,0) ) - { - sqrtscalea = 1; - } - sqrtscalea = 1/sqrtscalea; - densesolver_hpdmatrixcholeskysolveinternal(cha, sqrtscalea, n, isupper, &emptya, ae_false, b, m, info, rep, x, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Dense solver. Same as RMatrixLUSolve(), but for HPD matrices represented -by their Cholesky decomposition. - -Algorithm features: -* automatic detection of degenerate cases -* O(N^2) complexity -* condition number estimation -* matrix is represented by its upper or lower triangle - -No iterative refinement is provided because such partial representation of -matrix does not allow efficient calculation of extra-precise matrix-vector -products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - CHA - array[0..N-1,0..N-1], Cholesky decomposition, - SPDMatrixCholesky result - N - size of A - IsUpper - what half of CHA is provided - B - array[0..N-1], right part - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void hpdmatrixcholeskysolve(/* Complex */ ae_matrix* cha, - ae_int_t n, - ae_bool isupper, - /* Complex */ ae_vector* b, - ae_int_t* info, - densesolverreport* rep, - /* Complex */ ae_vector* x, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix bm; - ae_matrix xm; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _densesolverreport_clear(rep); - ae_vector_clear(x); - ae_matrix_init(&bm, 0, 0, DT_COMPLEX, _state, ae_true); - ae_matrix_init(&xm, 0, 0, DT_COMPLEX, _state, ae_true); - - if( n<=0 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - ae_matrix_set_length(&bm, n, 1, _state); - ae_v_cmove(&bm.ptr.pp_complex[0][0], bm.stride, &b->ptr.p_complex[0], 1, "N", ae_v_len(0,n-1)); - hpdmatrixcholeskysolvem(cha, n, isupper, &bm, 1, info, rep, &xm, _state); - ae_vector_set_length(x, n, _state); - ae_v_cmove(&x->ptr.p_complex[0], 1, &xm.ptr.pp_complex[0][0], xm.stride, "N", ae_v_len(0,n-1)); - ae_frame_leave(_state); -} - - -/************************************************************************* -Dense solver. - -This subroutine finds solution of the linear system A*X=B with non-square, -possibly degenerate A. System is solved in the least squares sense, and -general least squares solution X = X0 + CX*y which minimizes |A*X-B| is -returned. If A is non-degenerate, solution in the usual sense is returned. - -Algorithm features: -* automatic detection (and correct handling!) of degenerate cases -* iterative refinement -* O(N^3) complexity - -INPUT PARAMETERS - A - array[0..NRows-1,0..NCols-1], system matrix - NRows - vertical size of A - NCols - horizontal size of A - B - array[0..NCols-1], right part - Threshold- a number in [0,1]. Singular values beyond Threshold are - considered zero. Set it to 0.0, if you don't understand - what it means, so the solver will choose good value on its - own. - -OUTPUT PARAMETERS - Info - return code: - * -4 SVD subroutine failed - * -1 if NRows<=0 or NCols<=0 or Threshold<0 was passed - * 1 if task is solved - Rep - solver report, see below for more info - X - array[0..N-1,0..M-1], it contains: - * solution of A*X=B (even for singular A) - * zeros, if SVD subroutine failed - -SOLVER REPORT - -Subroutine sets following fields of the Rep structure: -* R2 reciprocal of condition number: 1/cond(A), 2-norm. -* N = NCols -* K dim(Null(A)) -* CX array[0..N-1,0..K-1], kernel of A. - Columns of CX store such vectors that A*CX[i]=0. - - -- ALGLIB -- - Copyright 24.08.2009 by Bochkanov Sergey -*************************************************************************/ -void rmatrixsolvels(/* Real */ ae_matrix* a, - ae_int_t nrows, - ae_int_t ncols, - /* Real */ ae_vector* b, - double threshold, - ae_int_t* info, - densesolverlsreport* rep, - /* Real */ ae_vector* x, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector sv; - ae_matrix u; - ae_matrix vt; - ae_vector rp; - ae_vector utb; - ae_vector sutb; - ae_vector tmp; - ae_vector ta; - ae_vector tx; - ae_vector buf; - ae_vector w; - ae_int_t i; - ae_int_t j; - ae_int_t nsv; - ae_int_t kernelidx; - double v; - double verr; - ae_bool svdfailed; - ae_bool zeroa; - ae_int_t rfs; - ae_int_t nrfs; - ae_bool terminatenexttime; - ae_bool smallerr; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _densesolverlsreport_clear(rep); - ae_vector_clear(x); - ae_vector_init(&sv, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&u, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&vt, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&rp, 0, DT_REAL, _state, ae_true); - ae_vector_init(&utb, 0, DT_REAL, _state, ae_true); - ae_vector_init(&sutb, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); - ae_vector_init(&ta, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tx, 0, DT_REAL, _state, ae_true); - ae_vector_init(&buf, 0, DT_REAL, _state, ae_true); - ae_vector_init(&w, 0, DT_REAL, _state, ae_true); - - if( (nrows<=0||ncols<=0)||ae_fp_less(threshold,0) ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - if( ae_fp_eq(threshold,0) ) - { - threshold = 1000*ae_machineepsilon; - } - - /* - * Factorize A first - */ - svdfailed = !rmatrixsvd(a, nrows, ncols, 1, 2, 2, &sv, &u, &vt, _state); - zeroa = ae_fp_eq(sv.ptr.p_double[0],0); - if( svdfailed||zeroa ) - { - if( svdfailed ) - { - *info = -4; - } - else - { - *info = 1; - } - ae_vector_set_length(x, ncols, _state); - for(i=0; i<=ncols-1; i++) - { - x->ptr.p_double[i] = 0; - } - rep->n = ncols; - rep->k = ncols; - ae_matrix_set_length(&rep->cx, ncols, ncols, _state); - for(i=0; i<=ncols-1; i++) - { - for(j=0; j<=ncols-1; j++) - { - if( i==j ) - { - rep->cx.ptr.pp_double[i][j] = 1; - } - else - { - rep->cx.ptr.pp_double[i][j] = 0; - } - } - } - rep->r2 = 0; - ae_frame_leave(_state); - return; - } - nsv = ae_minint(ncols, nrows, _state); - if( nsv==ncols ) - { - rep->r2 = sv.ptr.p_double[nsv-1]/sv.ptr.p_double[0]; - } - else - { - rep->r2 = 0; - } - rep->n = ncols; - *info = 1; - - /* - * Iterative refinement of xc combined with solution: - * 1. xc = 0 - * 2. calculate r = bc-A*xc using extra-precise dot product - * 3. solve A*y = r - * 4. update x:=x+r - * 5. goto 2 - * - * This cycle is executed until one of two things happens: - * 1. maximum number of iterations reached - * 2. last iteration decreased error to the lower limit - */ - ae_vector_set_length(&utb, nsv, _state); - ae_vector_set_length(&sutb, nsv, _state); - ae_vector_set_length(x, ncols, _state); - ae_vector_set_length(&tmp, ncols, _state); - ae_vector_set_length(&ta, ncols+1, _state); - ae_vector_set_length(&tx, ncols+1, _state); - ae_vector_set_length(&buf, ncols+1, _state); - for(i=0; i<=ncols-1; i++) - { - x->ptr.p_double[i] = 0; - } - kernelidx = nsv; - for(i=0; i<=nsv-1; i++) - { - if( ae_fp_less_eq(sv.ptr.p_double[i],threshold*sv.ptr.p_double[0]) ) - { - kernelidx = i; - break; - } - } - rep->k = ncols-kernelidx; - nrfs = densesolver_densesolverrfsmaxv2(ncols, rep->r2, _state); - terminatenexttime = ae_false; - ae_vector_set_length(&rp, nrows, _state); - for(rfs=0; rfs<=nrfs; rfs++) - { - if( terminatenexttime ) - { - break; - } - - /* - * calculate right part - */ - if( rfs==0 ) - { - ae_v_move(&rp.ptr.p_double[0], 1, &b->ptr.p_double[0], 1, ae_v_len(0,nrows-1)); - } - else - { - smallerr = ae_true; - for(i=0; i<=nrows-1; i++) - { - ae_v_move(&ta.ptr.p_double[0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,ncols-1)); - ta.ptr.p_double[ncols] = -1; - ae_v_move(&tx.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,ncols-1)); - tx.ptr.p_double[ncols] = b->ptr.p_double[i]; - xdot(&ta, &tx, ncols+1, &buf, &v, &verr, _state); - rp.ptr.p_double[i] = -v; - smallerr = smallerr&&ae_fp_less(ae_fabs(v, _state),4*verr); - } - if( smallerr ) - { - terminatenexttime = ae_true; - } - } - - /* - * solve A*dx = rp - */ - for(i=0; i<=ncols-1; i++) - { - tmp.ptr.p_double[i] = 0; - } - for(i=0; i<=nsv-1; i++) - { - utb.ptr.p_double[i] = 0; - } - for(i=0; i<=nrows-1; i++) - { - v = rp.ptr.p_double[i]; - ae_v_addd(&utb.ptr.p_double[0], 1, &u.ptr.pp_double[i][0], 1, ae_v_len(0,nsv-1), v); - } - for(i=0; i<=nsv-1; i++) - { - if( iptr.p_double[0], 1, &tmp.ptr.p_double[0], 1, ae_v_len(0,ncols-1)); - } - - /* - * fill CX - */ - if( rep->k>0 ) - { - ae_matrix_set_length(&rep->cx, ncols, rep->k, _state); - for(i=0; i<=rep->k-1; i++) - { - ae_v_move(&rep->cx.ptr.pp_double[0][i], rep->cx.stride, &vt.ptr.pp_double[kernelidx+i][0], 1, ae_v_len(0,ncols-1)); - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Internal LU solver - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -static void densesolver_rmatrixlusolveinternal(/* Real */ ae_matrix* lua, - /* Integer */ ae_vector* p, - double scalea, - ae_int_t n, - /* Real */ ae_matrix* a, - ae_bool havea, - /* Real */ ae_matrix* b, - ae_int_t m, - ae_int_t* info, - densesolverreport* rep, - /* Real */ ae_matrix* x, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t rfs; - ae_int_t nrfs; - ae_vector xc; - ae_vector y; - ae_vector bc; - ae_vector xa; - ae_vector xb; - ae_vector tx; - double v; - double verr; - double mxb; - double scaleright; - ae_bool smallerr; - ae_bool terminatenexttime; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _densesolverreport_clear(rep); - ae_matrix_clear(x); - ae_vector_init(&xc, 0, DT_REAL, _state, ae_true); - ae_vector_init(&y, 0, DT_REAL, _state, ae_true); - ae_vector_init(&bc, 0, DT_REAL, _state, ae_true); - ae_vector_init(&xa, 0, DT_REAL, _state, ae_true); - ae_vector_init(&xb, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tx, 0, DT_REAL, _state, ae_true); - - ae_assert(ae_fp_greater(scalea,0), "Assertion failed", _state); - - /* - * prepare: check inputs, allocate space... - */ - if( n<=0||m<=0 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - for(i=0; i<=n-1; i++) - { - if( p->ptr.p_int[i]>n-1||p->ptr.p_int[i]r1 = rmatrixlurcond1(lua, n, _state); - rep->rinf = rmatrixlurcondinf(lua, n, _state); - if( ae_fp_less(rep->r1,rcondthreshold(_state))||ae_fp_less(rep->rinf,rcondthreshold(_state)) ) - { - for(i=0; i<=n-1; i++) - { - for(j=0; j<=m-1; j++) - { - x->ptr.pp_double[i][j] = 0; - } - } - rep->r1 = 0; - rep->rinf = 0; - *info = -3; - ae_frame_leave(_state); - return; - } - *info = 1; - - /* - * solve - */ - for(k=0; k<=m-1; k++) - { - - /* - * copy B to contiguous storage - */ - ae_v_move(&bc.ptr.p_double[0], 1, &b->ptr.pp_double[0][k], b->stride, ae_v_len(0,n-1)); - - /* - * Scale right part: - * * MX stores max(|Bi|) - * * ScaleRight stores actual scaling applied to B when solving systems - * it is chosen to make |scaleRight*b| close to 1. - */ - mxb = 0; - for(i=0; i<=n-1; i++) - { - mxb = ae_maxreal(mxb, ae_fabs(bc.ptr.p_double[i], _state), _state); - } - if( ae_fp_eq(mxb,0) ) - { - mxb = 1; - } - scaleright = 1/mxb; - - /* - * First, non-iterative part of solution process. - * We use separate code for this task because - * XDot is quite slow and we want to save time. - */ - ae_v_moved(&xc.ptr.p_double[0], 1, &bc.ptr.p_double[0], 1, ae_v_len(0,n-1), scaleright); - densesolver_rbasiclusolve(lua, p, scalea, n, &xc, &tx, _state); - - /* - * Iterative refinement of xc: - * * calculate r = bc-A*xc using extra-precise dot product - * * solve A*y = r - * * update x:=x+r - * - * This cycle is executed until one of two things happens: - * 1. maximum number of iterations reached - * 2. last iteration decreased error to the lower limit - */ - if( havea ) - { - nrfs = densesolver_densesolverrfsmax(n, rep->r1, rep->rinf, _state); - terminatenexttime = ae_false; - for(rfs=0; rfs<=nrfs-1; rfs++) - { - if( terminatenexttime ) - { - break; - } - - /* - * generate right part - */ - smallerr = ae_true; - ae_v_move(&xb.ptr.p_double[0], 1, &xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); - for(i=0; i<=n-1; i++) - { - ae_v_moved(&xa.ptr.p_double[0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,n-1), scalea); - xa.ptr.p_double[n] = -1; - xb.ptr.p_double[n] = scaleright*bc.ptr.p_double[i]; - xdot(&xa, &xb, n+1, &tx, &v, &verr, _state); - y.ptr.p_double[i] = -v; - smallerr = smallerr&&ae_fp_less(ae_fabs(v, _state),4*verr); - } - if( smallerr ) - { - terminatenexttime = ae_true; - } - - /* - * solve and update - */ - densesolver_rbasiclusolve(lua, p, scalea, n, &y, &tx, _state); - ae_v_add(&xc.ptr.p_double[0], 1, &y.ptr.p_double[0], 1, ae_v_len(0,n-1)); - } - } - - /* - * Store xc. - * Post-scale result. - */ - v = scalea*mxb; - ae_v_moved(&x->ptr.pp_double[0][k], x->stride, &xc.ptr.p_double[0], 1, ae_v_len(0,n-1), v); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Internal Cholesky solver - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -static void densesolver_spdmatrixcholeskysolveinternal(/* Real */ ae_matrix* cha, - double sqrtscalea, - ae_int_t n, - ae_bool isupper, - /* Real */ ae_matrix* a, - ae_bool havea, - /* Real */ ae_matrix* b, - ae_int_t m, - ae_int_t* info, - densesolverreport* rep, - /* Real */ ae_matrix* x, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_vector xc; - ae_vector y; - ae_vector bc; - ae_vector xa; - ae_vector xb; - ae_vector tx; - double v; - double mxb; - double scaleright; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _densesolverreport_clear(rep); - ae_matrix_clear(x); - ae_vector_init(&xc, 0, DT_REAL, _state, ae_true); - ae_vector_init(&y, 0, DT_REAL, _state, ae_true); - ae_vector_init(&bc, 0, DT_REAL, _state, ae_true); - ae_vector_init(&xa, 0, DT_REAL, _state, ae_true); - ae_vector_init(&xb, 0, DT_REAL, _state, ae_true); - ae_vector_init(&tx, 0, DT_REAL, _state, ae_true); - - ae_assert(ae_fp_greater(sqrtscalea,0), "Assertion failed", _state); - - /* - * prepare: check inputs, allocate space... - */ - if( n<=0||m<=0 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - ae_matrix_set_length(x, n, m, _state); - ae_vector_set_length(&y, n, _state); - ae_vector_set_length(&xc, n, _state); - ae_vector_set_length(&bc, n, _state); - ae_vector_set_length(&tx, n+1, _state); - ae_vector_set_length(&xa, n+1, _state); - ae_vector_set_length(&xb, n+1, _state); - - /* - * estimate condition number, test for near singularity - */ - rep->r1 = spdmatrixcholeskyrcond(cha, n, isupper, _state); - rep->rinf = rep->r1; - if( ae_fp_less(rep->r1,rcondthreshold(_state)) ) - { - for(i=0; i<=n-1; i++) - { - for(j=0; j<=m-1; j++) - { - x->ptr.pp_double[i][j] = 0; - } - } - rep->r1 = 0; - rep->rinf = 0; - *info = -3; - ae_frame_leave(_state); - return; - } - *info = 1; - - /* - * solve - */ - for(k=0; k<=m-1; k++) - { - - /* - * copy B to contiguous storage - */ - ae_v_move(&bc.ptr.p_double[0], 1, &b->ptr.pp_double[0][k], b->stride, ae_v_len(0,n-1)); - - /* - * Scale right part: - * * MX stores max(|Bi|) - * * ScaleRight stores actual scaling applied to B when solving systems - * it is chosen to make |scaleRight*b| close to 1. - */ - mxb = 0; - for(i=0; i<=n-1; i++) - { - mxb = ae_maxreal(mxb, ae_fabs(bc.ptr.p_double[i], _state), _state); - } - if( ae_fp_eq(mxb,0) ) - { - mxb = 1; - } - scaleright = 1/mxb; - - /* - * First, non-iterative part of solution process. - * We use separate code for this task because - * XDot is quite slow and we want to save time. - */ - ae_v_moved(&xc.ptr.p_double[0], 1, &bc.ptr.p_double[0], 1, ae_v_len(0,n-1), scaleright); - densesolver_spdbasiccholeskysolve(cha, sqrtscalea, n, isupper, &xc, &tx, _state); - - /* - * Store xc. - * Post-scale result. - */ - v = ae_sqr(sqrtscalea, _state)*mxb; - ae_v_moved(&x->ptr.pp_double[0][k], x->stride, &xc.ptr.p_double[0], 1, ae_v_len(0,n-1), v); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Internal LU solver - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -static void densesolver_cmatrixlusolveinternal(/* Complex */ ae_matrix* lua, - /* Integer */ ae_vector* p, - double scalea, - ae_int_t n, - /* Complex */ ae_matrix* a, - ae_bool havea, - /* Complex */ ae_matrix* b, - ae_int_t m, - ae_int_t* info, - densesolverreport* rep, - /* Complex */ ae_matrix* x, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t rfs; - ae_int_t nrfs; - ae_vector xc; - ae_vector y; - ae_vector bc; - ae_vector xa; - ae_vector xb; - ae_vector tx; - ae_vector tmpbuf; - ae_complex v; - double verr; - double mxb; - double scaleright; - ae_bool smallerr; - ae_bool terminatenexttime; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _densesolverreport_clear(rep); - ae_matrix_clear(x); - ae_vector_init(&xc, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&y, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&bc, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&xa, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&xb, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&tx, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&tmpbuf, 0, DT_REAL, _state, ae_true); - - ae_assert(ae_fp_greater(scalea,0), "Assertion failed", _state); - - /* - * prepare: check inputs, allocate space... - */ - if( n<=0||m<=0 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - for(i=0; i<=n-1; i++) - { - if( p->ptr.p_int[i]>n-1||p->ptr.p_int[i]r1 = cmatrixlurcond1(lua, n, _state); - rep->rinf = cmatrixlurcondinf(lua, n, _state); - if( ae_fp_less(rep->r1,rcondthreshold(_state))||ae_fp_less(rep->rinf,rcondthreshold(_state)) ) - { - for(i=0; i<=n-1; i++) - { - for(j=0; j<=m-1; j++) - { - x->ptr.pp_complex[i][j] = ae_complex_from_d(0); - } - } - rep->r1 = 0; - rep->rinf = 0; - *info = -3; - ae_frame_leave(_state); - return; - } - *info = 1; - - /* - * solve - */ - for(k=0; k<=m-1; k++) - { - - /* - * copy B to contiguous storage - */ - ae_v_cmove(&bc.ptr.p_complex[0], 1, &b->ptr.pp_complex[0][k], b->stride, "N", ae_v_len(0,n-1)); - - /* - * Scale right part: - * * MX stores max(|Bi|) - * * ScaleRight stores actual scaling applied to B when solving systems - * it is chosen to make |scaleRight*b| close to 1. - */ - mxb = 0; - for(i=0; i<=n-1; i++) - { - mxb = ae_maxreal(mxb, ae_c_abs(bc.ptr.p_complex[i], _state), _state); - } - if( ae_fp_eq(mxb,0) ) - { - mxb = 1; - } - scaleright = 1/mxb; - - /* - * First, non-iterative part of solution process. - * We use separate code for this task because - * XDot is quite slow and we want to save time. - */ - ae_v_cmoved(&xc.ptr.p_complex[0], 1, &bc.ptr.p_complex[0], 1, "N", ae_v_len(0,n-1), scaleright); - densesolver_cbasiclusolve(lua, p, scalea, n, &xc, &tx, _state); - - /* - * Iterative refinement of xc: - * * calculate r = bc-A*xc using extra-precise dot product - * * solve A*y = r - * * update x:=x+r - * - * This cycle is executed until one of two things happens: - * 1. maximum number of iterations reached - * 2. last iteration decreased error to the lower limit - */ - if( havea ) - { - nrfs = densesolver_densesolverrfsmax(n, rep->r1, rep->rinf, _state); - terminatenexttime = ae_false; - for(rfs=0; rfs<=nrfs-1; rfs++) - { - if( terminatenexttime ) - { - break; - } - - /* - * generate right part - */ - smallerr = ae_true; - ae_v_cmove(&xb.ptr.p_complex[0], 1, &xc.ptr.p_complex[0], 1, "N", ae_v_len(0,n-1)); - for(i=0; i<=n-1; i++) - { - ae_v_cmoved(&xa.ptr.p_complex[0], 1, &a->ptr.pp_complex[i][0], 1, "N", ae_v_len(0,n-1), scalea); - xa.ptr.p_complex[n] = ae_complex_from_d(-1); - xb.ptr.p_complex[n] = ae_c_mul_d(bc.ptr.p_complex[i],scaleright); - xcdot(&xa, &xb, n+1, &tmpbuf, &v, &verr, _state); - y.ptr.p_complex[i] = ae_c_neg(v); - smallerr = smallerr&&ae_fp_less(ae_c_abs(v, _state),4*verr); - } - if( smallerr ) - { - terminatenexttime = ae_true; - } - - /* - * solve and update - */ - densesolver_cbasiclusolve(lua, p, scalea, n, &y, &tx, _state); - ae_v_cadd(&xc.ptr.p_complex[0], 1, &y.ptr.p_complex[0], 1, "N", ae_v_len(0,n-1)); - } - } - - /* - * Store xc. - * Post-scale result. - */ - v = ae_complex_from_d(scalea*mxb); - ae_v_cmovec(&x->ptr.pp_complex[0][k], x->stride, &xc.ptr.p_complex[0], 1, "N", ae_v_len(0,n-1), v); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Internal Cholesky solver - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -static void densesolver_hpdmatrixcholeskysolveinternal(/* Complex */ ae_matrix* cha, - double sqrtscalea, - ae_int_t n, - ae_bool isupper, - /* Complex */ ae_matrix* a, - ae_bool havea, - /* Complex */ ae_matrix* b, - ae_int_t m, - ae_int_t* info, - densesolverreport* rep, - /* Complex */ ae_matrix* x, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_vector xc; - ae_vector y; - ae_vector bc; - ae_vector xa; - ae_vector xb; - ae_vector tx; - double v; - double mxb; - double scaleright; - - ae_frame_make(_state, &_frame_block); - *info = 0; - _densesolverreport_clear(rep); - ae_matrix_clear(x); - ae_vector_init(&xc, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&y, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&bc, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&xa, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&xb, 0, DT_COMPLEX, _state, ae_true); - ae_vector_init(&tx, 0, DT_COMPLEX, _state, ae_true); - - ae_assert(ae_fp_greater(sqrtscalea,0), "Assertion failed", _state); - - /* - * prepare: check inputs, allocate space... - */ - if( n<=0||m<=0 ) - { - *info = -1; - ae_frame_leave(_state); - return; - } - ae_matrix_set_length(x, n, m, _state); - ae_vector_set_length(&y, n, _state); - ae_vector_set_length(&xc, n, _state); - ae_vector_set_length(&bc, n, _state); - ae_vector_set_length(&tx, n+1, _state); - ae_vector_set_length(&xa, n+1, _state); - ae_vector_set_length(&xb, n+1, _state); - - /* - * estimate condition number, test for near singularity - */ - rep->r1 = hpdmatrixcholeskyrcond(cha, n, isupper, _state); - rep->rinf = rep->r1; - if( ae_fp_less(rep->r1,rcondthreshold(_state)) ) - { - for(i=0; i<=n-1; i++) - { - for(j=0; j<=m-1; j++) - { - x->ptr.pp_complex[i][j] = ae_complex_from_d(0); - } - } - rep->r1 = 0; - rep->rinf = 0; - *info = -3; - ae_frame_leave(_state); - return; - } - *info = 1; - - /* - * solve - */ - for(k=0; k<=m-1; k++) - { - - /* - * copy B to contiguous storage - */ - ae_v_cmove(&bc.ptr.p_complex[0], 1, &b->ptr.pp_complex[0][k], b->stride, "N", ae_v_len(0,n-1)); - - /* - * Scale right part: - * * MX stores max(|Bi|) - * * ScaleRight stores actual scaling applied to B when solving systems - * it is chosen to make |scaleRight*b| close to 1. - */ - mxb = 0; - for(i=0; i<=n-1; i++) - { - mxb = ae_maxreal(mxb, ae_c_abs(bc.ptr.p_complex[i], _state), _state); - } - if( ae_fp_eq(mxb,0) ) - { - mxb = 1; - } - scaleright = 1/mxb; - - /* - * First, non-iterative part of solution process. - * We use separate code for this task because - * XDot is quite slow and we want to save time. - */ - ae_v_cmoved(&xc.ptr.p_complex[0], 1, &bc.ptr.p_complex[0], 1, "N", ae_v_len(0,n-1), scaleright); - densesolver_hpdbasiccholeskysolve(cha, sqrtscalea, n, isupper, &xc, &tx, _state); - - /* - * Store xc. - * Post-scale result. - */ - v = ae_sqr(sqrtscalea, _state)*mxb; - ae_v_cmoved(&x->ptr.pp_complex[0][k], x->stride, &xc.ptr.p_complex[0], 1, "N", ae_v_len(0,n-1), v); - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Internal subroutine. -Returns maximum count of RFS iterations as function of: -1. machine epsilon -2. task size. -3. condition number - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -static ae_int_t densesolver_densesolverrfsmax(ae_int_t n, - double r1, - double rinf, - ae_state *_state) -{ - ae_int_t result; - - - result = 5; - return result; -} - - -/************************************************************************* -Internal subroutine. -Returns maximum count of RFS iterations as function of: -1. machine epsilon -2. task size. -3. norm-2 condition number - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -static ae_int_t densesolver_densesolverrfsmaxv2(ae_int_t n, - double r2, - ae_state *_state) -{ - ae_int_t result; - - - result = densesolver_densesolverrfsmax(n, 0, 0, _state); - return result; -} - - -/************************************************************************* -Basic LU solver for ScaleA*PLU*x = y. - -This subroutine assumes that: -* L is well-scaled, and it is U which needs scaling by ScaleA. -* A=PLU is well-conditioned, so no zero divisions or overflow may occur - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -static void densesolver_rbasiclusolve(/* Real */ ae_matrix* lua, - /* Integer */ ae_vector* p, - double scalea, - ae_int_t n, - /* Real */ ae_vector* xb, - /* Real */ ae_vector* tmp, - ae_state *_state) -{ - ae_int_t i; - double v; - - - for(i=0; i<=n-1; i++) - { - if( p->ptr.p_int[i]!=i ) - { - v = xb->ptr.p_double[i]; - xb->ptr.p_double[i] = xb->ptr.p_double[p->ptr.p_int[i]]; - xb->ptr.p_double[p->ptr.p_int[i]] = v; - } - } - for(i=1; i<=n-1; i++) - { - v = ae_v_dotproduct(&lua->ptr.pp_double[i][0], 1, &xb->ptr.p_double[0], 1, ae_v_len(0,i-1)); - xb->ptr.p_double[i] = xb->ptr.p_double[i]-v; - } - xb->ptr.p_double[n-1] = xb->ptr.p_double[n-1]/(scalea*lua->ptr.pp_double[n-1][n-1]); - for(i=n-2; i>=0; i--) - { - ae_v_moved(&tmp->ptr.p_double[i+1], 1, &lua->ptr.pp_double[i][i+1], 1, ae_v_len(i+1,n-1), scalea); - v = ae_v_dotproduct(&tmp->ptr.p_double[i+1], 1, &xb->ptr.p_double[i+1], 1, ae_v_len(i+1,n-1)); - xb->ptr.p_double[i] = (xb->ptr.p_double[i]-v)/(scalea*lua->ptr.pp_double[i][i]); - } -} - - -/************************************************************************* -Basic Cholesky solver for ScaleA*Cholesky(A)'*x = y. - -This subroutine assumes that: -* A*ScaleA is well scaled -* A is well-conditioned, so no zero divisions or overflow may occur - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -static void densesolver_spdbasiccholeskysolve(/* Real */ ae_matrix* cha, - double sqrtscalea, - ae_int_t n, - ae_bool isupper, - /* Real */ ae_vector* xb, - /* Real */ ae_vector* tmp, - ae_state *_state) -{ - ae_int_t i; - double v; - - - - /* - * A = L*L' or A=U'*U - */ - if( isupper ) - { - - /* - * Solve U'*y=b first. - */ - for(i=0; i<=n-1; i++) - { - xb->ptr.p_double[i] = xb->ptr.p_double[i]/(sqrtscalea*cha->ptr.pp_double[i][i]); - if( iptr.p_double[i]; - ae_v_moved(&tmp->ptr.p_double[i+1], 1, &cha->ptr.pp_double[i][i+1], 1, ae_v_len(i+1,n-1), sqrtscalea); - ae_v_subd(&xb->ptr.p_double[i+1], 1, &tmp->ptr.p_double[i+1], 1, ae_v_len(i+1,n-1), v); - } - } - - /* - * Solve U*x=y then. - */ - for(i=n-1; i>=0; i--) - { - if( iptr.p_double[i+1], 1, &cha->ptr.pp_double[i][i+1], 1, ae_v_len(i+1,n-1), sqrtscalea); - v = ae_v_dotproduct(&tmp->ptr.p_double[i+1], 1, &xb->ptr.p_double[i+1], 1, ae_v_len(i+1,n-1)); - xb->ptr.p_double[i] = xb->ptr.p_double[i]-v; - } - xb->ptr.p_double[i] = xb->ptr.p_double[i]/(sqrtscalea*cha->ptr.pp_double[i][i]); - } - } - else - { - - /* - * Solve L*y=b first - */ - for(i=0; i<=n-1; i++) - { - if( i>0 ) - { - ae_v_moved(&tmp->ptr.p_double[0], 1, &cha->ptr.pp_double[i][0], 1, ae_v_len(0,i-1), sqrtscalea); - v = ae_v_dotproduct(&tmp->ptr.p_double[0], 1, &xb->ptr.p_double[0], 1, ae_v_len(0,i-1)); - xb->ptr.p_double[i] = xb->ptr.p_double[i]-v; - } - xb->ptr.p_double[i] = xb->ptr.p_double[i]/(sqrtscalea*cha->ptr.pp_double[i][i]); - } - - /* - * Solve L'*x=y then. - */ - for(i=n-1; i>=0; i--) - { - xb->ptr.p_double[i] = xb->ptr.p_double[i]/(sqrtscalea*cha->ptr.pp_double[i][i]); - if( i>0 ) - { - v = xb->ptr.p_double[i]; - ae_v_moved(&tmp->ptr.p_double[0], 1, &cha->ptr.pp_double[i][0], 1, ae_v_len(0,i-1), sqrtscalea); - ae_v_subd(&xb->ptr.p_double[0], 1, &tmp->ptr.p_double[0], 1, ae_v_len(0,i-1), v); - } - } - } -} - - -/************************************************************************* -Basic LU solver for ScaleA*PLU*x = y. - -This subroutine assumes that: -* L is well-scaled, and it is U which needs scaling by ScaleA. -* A=PLU is well-conditioned, so no zero divisions or overflow may occur - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -static void densesolver_cbasiclusolve(/* Complex */ ae_matrix* lua, - /* Integer */ ae_vector* p, - double scalea, - ae_int_t n, - /* Complex */ ae_vector* xb, - /* Complex */ ae_vector* tmp, - ae_state *_state) -{ - ae_int_t i; - ae_complex v; - - - for(i=0; i<=n-1; i++) - { - if( p->ptr.p_int[i]!=i ) - { - v = xb->ptr.p_complex[i]; - xb->ptr.p_complex[i] = xb->ptr.p_complex[p->ptr.p_int[i]]; - xb->ptr.p_complex[p->ptr.p_int[i]] = v; - } - } - for(i=1; i<=n-1; i++) - { - v = ae_v_cdotproduct(&lua->ptr.pp_complex[i][0], 1, "N", &xb->ptr.p_complex[0], 1, "N", ae_v_len(0,i-1)); - xb->ptr.p_complex[i] = ae_c_sub(xb->ptr.p_complex[i],v); - } - xb->ptr.p_complex[n-1] = ae_c_div(xb->ptr.p_complex[n-1],ae_c_mul_d(lua->ptr.pp_complex[n-1][n-1],scalea)); - for(i=n-2; i>=0; i--) - { - ae_v_cmoved(&tmp->ptr.p_complex[i+1], 1, &lua->ptr.pp_complex[i][i+1], 1, "N", ae_v_len(i+1,n-1), scalea); - v = ae_v_cdotproduct(&tmp->ptr.p_complex[i+1], 1, "N", &xb->ptr.p_complex[i+1], 1, "N", ae_v_len(i+1,n-1)); - xb->ptr.p_complex[i] = ae_c_div(ae_c_sub(xb->ptr.p_complex[i],v),ae_c_mul_d(lua->ptr.pp_complex[i][i],scalea)); - } -} - - -/************************************************************************* -Basic Cholesky solver for ScaleA*Cholesky(A)'*x = y. - -This subroutine assumes that: -* A*ScaleA is well scaled -* A is well-conditioned, so no zero divisions or overflow may occur - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -static void densesolver_hpdbasiccholeskysolve(/* Complex */ ae_matrix* cha, - double sqrtscalea, - ae_int_t n, - ae_bool isupper, - /* Complex */ ae_vector* xb, - /* Complex */ ae_vector* tmp, - ae_state *_state) -{ - ae_int_t i; - ae_complex v; - - - - /* - * A = L*L' or A=U'*U - */ - if( isupper ) - { - - /* - * Solve U'*y=b first. - */ - for(i=0; i<=n-1; i++) - { - xb->ptr.p_complex[i] = ae_c_div(xb->ptr.p_complex[i],ae_c_mul_d(ae_c_conj(cha->ptr.pp_complex[i][i], _state),sqrtscalea)); - if( iptr.p_complex[i]; - ae_v_cmoved(&tmp->ptr.p_complex[i+1], 1, &cha->ptr.pp_complex[i][i+1], 1, "Conj", ae_v_len(i+1,n-1), sqrtscalea); - ae_v_csubc(&xb->ptr.p_complex[i+1], 1, &tmp->ptr.p_complex[i+1], 1, "N", ae_v_len(i+1,n-1), v); - } - } - - /* - * Solve U*x=y then. - */ - for(i=n-1; i>=0; i--) - { - if( iptr.p_complex[i+1], 1, &cha->ptr.pp_complex[i][i+1], 1, "N", ae_v_len(i+1,n-1), sqrtscalea); - v = ae_v_cdotproduct(&tmp->ptr.p_complex[i+1], 1, "N", &xb->ptr.p_complex[i+1], 1, "N", ae_v_len(i+1,n-1)); - xb->ptr.p_complex[i] = ae_c_sub(xb->ptr.p_complex[i],v); - } - xb->ptr.p_complex[i] = ae_c_div(xb->ptr.p_complex[i],ae_c_mul_d(cha->ptr.pp_complex[i][i],sqrtscalea)); - } - } - else - { - - /* - * Solve L*y=b first - */ - for(i=0; i<=n-1; i++) - { - if( i>0 ) - { - ae_v_cmoved(&tmp->ptr.p_complex[0], 1, &cha->ptr.pp_complex[i][0], 1, "N", ae_v_len(0,i-1), sqrtscalea); - v = ae_v_cdotproduct(&tmp->ptr.p_complex[0], 1, "N", &xb->ptr.p_complex[0], 1, "N", ae_v_len(0,i-1)); - xb->ptr.p_complex[i] = ae_c_sub(xb->ptr.p_complex[i],v); - } - xb->ptr.p_complex[i] = ae_c_div(xb->ptr.p_complex[i],ae_c_mul_d(cha->ptr.pp_complex[i][i],sqrtscalea)); - } - - /* - * Solve L'*x=y then. - */ - for(i=n-1; i>=0; i--) - { - xb->ptr.p_complex[i] = ae_c_div(xb->ptr.p_complex[i],ae_c_mul_d(ae_c_conj(cha->ptr.pp_complex[i][i], _state),sqrtscalea)); - if( i>0 ) - { - v = xb->ptr.p_complex[i]; - ae_v_cmoved(&tmp->ptr.p_complex[0], 1, &cha->ptr.pp_complex[i][0], 1, "Conj", ae_v_len(0,i-1), sqrtscalea); - ae_v_csubc(&xb->ptr.p_complex[0], 1, &tmp->ptr.p_complex[0], 1, "N", ae_v_len(0,i-1), v); - } - } - } -} - - -ae_bool _densesolverreport_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - densesolverreport *p = (densesolverreport*)_p; - ae_touch_ptr((void*)p); - return ae_true; -} - - -ae_bool _densesolverreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - densesolverreport *dst = (densesolverreport*)_dst; - densesolverreport *src = (densesolverreport*)_src; - dst->r1 = src->r1; - dst->rinf = src->rinf; - return ae_true; -} - - -void _densesolverreport_clear(void* _p) -{ - densesolverreport *p = (densesolverreport*)_p; - ae_touch_ptr((void*)p); -} - - -void _densesolverreport_destroy(void* _p) -{ - densesolverreport *p = (densesolverreport*)_p; - ae_touch_ptr((void*)p); -} - - -ae_bool _densesolverlsreport_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - densesolverlsreport *p = (densesolverlsreport*)_p; - ae_touch_ptr((void*)p); - if( !ae_matrix_init(&p->cx, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _densesolverlsreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - densesolverlsreport *dst = (densesolverlsreport*)_dst; - densesolverlsreport *src = (densesolverlsreport*)_src; - dst->r2 = src->r2; - if( !ae_matrix_init_copy(&dst->cx, &src->cx, _state, make_automatic) ) - return ae_false; - dst->n = src->n; - dst->k = src->k; - return ae_true; -} - - -void _densesolverlsreport_clear(void* _p) -{ - densesolverlsreport *p = (densesolverlsreport*)_p; - ae_touch_ptr((void*)p); - ae_matrix_clear(&p->cx); -} - - -void _densesolverlsreport_destroy(void* _p) -{ - densesolverlsreport *p = (densesolverlsreport*)_p; - ae_touch_ptr((void*)p); - ae_matrix_destroy(&p->cx); -} - - - - -/************************************************************************* -This function initializes linear LSQR Solver. This solver is used to solve -non-symmetric (and, possibly, non-square) problems. Least squares solution -is returned for non-compatible systems. - -USAGE: -1. User initializes algorithm state with LinLSQRCreate() call -2. User tunes solver parameters with LinLSQRSetCond() and other functions -3. User calls LinLSQRSolveSparse() function which takes algorithm state - and SparseMatrix object. -4. User calls LinLSQRResults() to get solution -5. Optionally, user may call LinLSQRSolveSparse() again to solve another - problem with different matrix and/or right part without reinitializing - LinLSQRState structure. - -INPUT PARAMETERS: - M - number of rows in A - N - number of variables, N>0 - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 30.11.2011 by Bochkanov Sergey -*************************************************************************/ -void linlsqrcreate(ae_int_t m, - ae_int_t n, - linlsqrstate* state, - ae_state *_state) -{ - ae_int_t i; - - _linlsqrstate_clear(state); - - ae_assert(m>0, "LinLSQRCreate: M<=0", _state); - ae_assert(n>0, "LinLSQRCreate: N<=0", _state); - state->m = m; - state->n = n; - state->prectype = 0; - state->epsa = linlsqr_atol; - state->epsb = linlsqr_btol; - state->epsc = 1/ae_sqrt(ae_machineepsilon, _state); - state->maxits = 0; - state->lambdai = 0; - state->xrep = ae_false; - state->running = ae_false; - - /* - * * allocate arrays - * * set RX to NAN (just for the case user calls Results() without - * calling SolveSparse() - * * set B to zero - */ - normestimatorcreate(m, n, 2, 2, &state->nes, _state); - ae_vector_set_length(&state->rx, state->n, _state); - ae_vector_set_length(&state->ui, state->m+state->n, _state); - ae_vector_set_length(&state->uip1, state->m+state->n, _state); - ae_vector_set_length(&state->vip1, state->n, _state); - ae_vector_set_length(&state->vi, state->n, _state); - ae_vector_set_length(&state->omegai, state->n, _state); - ae_vector_set_length(&state->omegaip1, state->n, _state); - ae_vector_set_length(&state->d, state->n, _state); - ae_vector_set_length(&state->x, state->m+state->n, _state); - ae_vector_set_length(&state->mv, state->m+state->n, _state); - ae_vector_set_length(&state->mtv, state->n, _state); - ae_vector_set_length(&state->b, state->m, _state); - for(i=0; i<=n-1; i++) - { - state->rx.ptr.p_double[i] = _state->v_nan; - } - for(i=0; i<=m-1; i++) - { - state->b.ptr.p_double[i] = 0; - } - ae_vector_set_length(&state->rstate.ia, 1+1, _state); - ae_vector_set_length(&state->rstate.ra, 0+1, _state); - state->rstate.stage = -1; -} - - -/************************************************************************* -This function sets right part. By default, right part is zero. - -INPUT PARAMETERS: - B - right part, array[N]. - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 30.11.2011 by Bochkanov Sergey -*************************************************************************/ -void linlsqrsetb(linlsqrstate* state, - /* Real */ ae_vector* b, - ae_state *_state) -{ - ae_int_t i; - - - ae_assert(!state->running, "LinLSQRSetB: you can not change B when LinLSQRIteration is running", _state); - ae_assert(state->m<=b->cnt, "LinLSQRSetB: Length(B)m, _state), "LinLSQRSetB: B contains infinite or NaN values", _state); - state->bnorm2 = 0; - for(i=0; i<=state->m-1; i++) - { - state->b.ptr.p_double[i] = b->ptr.p_double[i]; - state->bnorm2 = state->bnorm2+b->ptr.p_double[i]*b->ptr.p_double[i]; - } -} - - -/************************************************************************* -This function changes preconditioning settings of LinLSQQSolveSparse() -function. By default, SolveSparse() uses diagonal preconditioner, but if -you want to use solver without preconditioning, you can call this function -which forces solver to use unit matrix for preconditioning. - -INPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 19.11.2012 by Bochkanov Sergey -*************************************************************************/ -void linlsqrsetprecunit(linlsqrstate* state, ae_state *_state) -{ - - - ae_assert(!state->running, "LinLSQRSetPrecUnit: you can not change preconditioner, because function LinLSQRIteration is running!", _state); - state->prectype = -1; -} - - -/************************************************************************* -This function changes preconditioning settings of LinCGSolveSparse() -function. LinCGSolveSparse() will use diagonal of the system matrix as -preconditioner. This preconditioning mode is active by default. - -INPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 19.11.2012 by Bochkanov Sergey -*************************************************************************/ -void linlsqrsetprecdiag(linlsqrstate* state, ae_state *_state) -{ - - - ae_assert(!state->running, "LinLSQRSetPrecDiag: you can not change preconditioner, because function LinCGIteration is running!", _state); - state->prectype = 0; -} - - -/************************************************************************* -This function sets optional Tikhonov regularization coefficient. -It is zero by default. - -INPUT PARAMETERS: - LambdaI - regularization factor, LambdaI>=0 - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 30.11.2011 by Bochkanov Sergey -*************************************************************************/ -void linlsqrsetlambdai(linlsqrstate* state, - double lambdai, - ae_state *_state) -{ - - - ae_assert(!state->running, "LinLSQRSetLambdaI: you can not set LambdaI, because function LinLSQRIteration is running", _state); - ae_assert(ae_isfinite(lambdai, _state)&&ae_fp_greater_eq(lambdai,0), "LinLSQRSetLambdaI: LambdaI is infinite or NaN", _state); - state->lambdai = lambdai; -} - - -/************************************************************************* - - -- ALGLIB -- - Copyright 30.11.2011 by Bochkanov Sergey -*************************************************************************/ -ae_bool linlsqriteration(linlsqrstate* state, ae_state *_state) -{ - ae_int_t summn; - double bnorm; - ae_int_t i; - ae_bool result; - - - - /* - * Reverse communication preparations - * I know it looks ugly, but it works the same way - * anywhere from C++ to Python. - * - * This code initializes locals by: - * * random values determined during code - * generation - on first subroutine call - * * values from previous call - on subsequent calls - */ - if( state->rstate.stage>=0 ) - { - summn = state->rstate.ia.ptr.p_int[0]; - i = state->rstate.ia.ptr.p_int[1]; - bnorm = state->rstate.ra.ptr.p_double[0]; - } - else - { - summn = -983; - i = -989; - bnorm = -834; - } - if( state->rstate.stage==0 ) - { - goto lbl_0; - } - if( state->rstate.stage==1 ) - { - goto lbl_1; - } - if( state->rstate.stage==2 ) - { - goto lbl_2; - } - if( state->rstate.stage==3 ) - { - goto lbl_3; - } - if( state->rstate.stage==4 ) - { - goto lbl_4; - } - if( state->rstate.stage==5 ) - { - goto lbl_5; - } - if( state->rstate.stage==6 ) - { - goto lbl_6; - } - - /* - * Routine body - */ - ae_assert(state->b.cnt>0, "LinLSQRIteration: using non-allocated array B", _state); - bnorm = ae_sqrt(state->bnorm2, _state); - state->running = ae_true; - state->repnmv = 0; - linlsqr_clearrfields(state, _state); - state->repiterationscount = 0; - summn = state->m+state->n; - state->r2 = state->bnorm2; - - /* - *estimate for ANorm - */ - normestimatorrestart(&state->nes, _state); -lbl_7: - if( !normestimatoriteration(&state->nes, _state) ) - { - goto lbl_8; - } - if( !state->nes.needmv ) - { - goto lbl_9; - } - ae_v_move(&state->x.ptr.p_double[0], 1, &state->nes.x.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - state->repnmv = state->repnmv+1; - linlsqr_clearrfields(state, _state); - state->needmv = ae_true; - state->rstate.stage = 0; - goto lbl_rcomm; -lbl_0: - state->needmv = ae_false; - ae_v_move(&state->nes.mv.ptr.p_double[0], 1, &state->mv.ptr.p_double[0], 1, ae_v_len(0,state->m-1)); - goto lbl_7; -lbl_9: - if( !state->nes.needmtv ) - { - goto lbl_11; - } - ae_v_move(&state->x.ptr.p_double[0], 1, &state->nes.x.ptr.p_double[0], 1, ae_v_len(0,state->m-1)); - - /* - *matrix-vector multiplication - */ - state->repnmv = state->repnmv+1; - linlsqr_clearrfields(state, _state); - state->needmtv = ae_true; - state->rstate.stage = 1; - goto lbl_rcomm; -lbl_1: - state->needmtv = ae_false; - ae_v_move(&state->nes.mtv.ptr.p_double[0], 1, &state->mtv.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - goto lbl_7; -lbl_11: - goto lbl_7; -lbl_8: - normestimatorresults(&state->nes, &state->anorm, _state); - - /* - *initialize .RX by zeros - */ - for(i=0; i<=state->n-1; i++) - { - state->rx.ptr.p_double[i] = 0; - } - - /* - *output first report - */ - if( !state->xrep ) - { - goto lbl_13; - } - ae_v_move(&state->x.ptr.p_double[0], 1, &state->rx.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - linlsqr_clearrfields(state, _state); - state->xupdated = ae_true; - state->rstate.stage = 2; - goto lbl_rcomm; -lbl_2: - state->xupdated = ae_false; -lbl_13: - - /* - * LSQR, Step 0. - * - * Algorithm outline corresponds to one which was described at p.50 of - * "LSQR - an algorithm for sparse linear equations and sparse least - * squares" by C.Paige and M.Saunders with one small addition - we - * explicitly extend system matrix by additional N lines in order - * to handle non-zero lambda, i.e. original A is replaced by - * [ A ] - * A_mod = [ ] - * [ lambda*I ]. - * - * Step 0: - * x[0] = 0 - * beta[1]*u[1] = b - * alpha[1]*v[1] = A_mod'*u[1] - * w[1] = v[1] - * phiBar[1] = beta[1] - * rhoBar[1] = alpha[1] - * d[0] = 0 - * - * NOTE: - * There are three criteria for stopping: - * (S0) maximum number of iterations - * (S1) ||Rk||<=EpsB*||B||; - * (S2) ||A^T*Rk||/(||A||*||Rk||)<=EpsA. - * It is very important that S2 always checked AFTER S1. It is necessary - * to avoid division by zero when Rk=0. - */ - state->betai = bnorm; - if( ae_fp_eq(state->betai,0) ) - { - - /* - * Zero right part - */ - state->running = ae_false; - state->repterminationtype = 1; - result = ae_false; - return result; - } - for(i=0; i<=summn-1; i++) - { - if( im ) - { - state->ui.ptr.p_double[i] = state->b.ptr.p_double[i]/state->betai; - } - else - { - state->ui.ptr.p_double[i] = 0; - } - state->x.ptr.p_double[i] = state->ui.ptr.p_double[i]; - } - state->repnmv = state->repnmv+1; - linlsqr_clearrfields(state, _state); - state->needmtv = ae_true; - state->rstate.stage = 3; - goto lbl_rcomm; -lbl_3: - state->needmtv = ae_false; - for(i=0; i<=state->n-1; i++) - { - state->mtv.ptr.p_double[i] = state->mtv.ptr.p_double[i]+state->lambdai*state->ui.ptr.p_double[state->m+i]; - } - state->alphai = 0; - for(i=0; i<=state->n-1; i++) - { - state->alphai = state->alphai+state->mtv.ptr.p_double[i]*state->mtv.ptr.p_double[i]; - } - state->alphai = ae_sqrt(state->alphai, _state); - if( ae_fp_eq(state->alphai,0) ) - { - - /* - * Orthogonality stopping criterion is met - */ - state->running = ae_false; - state->repterminationtype = 4; - result = ae_false; - return result; - } - for(i=0; i<=state->n-1; i++) - { - state->vi.ptr.p_double[i] = state->mtv.ptr.p_double[i]/state->alphai; - state->omegai.ptr.p_double[i] = state->vi.ptr.p_double[i]; - } - state->phibari = state->betai; - state->rhobari = state->alphai; - for(i=0; i<=state->n-1; i++) - { - state->d.ptr.p_double[i] = 0; - } - state->dnorm = 0; - - /* - * Steps I=1, 2, ... - */ -lbl_15: - if( ae_false ) - { - goto lbl_16; - } - - /* - * At I-th step State.RepIterationsCount=I. - */ - state->repiterationscount = state->repiterationscount+1; - - /* - * Bidiagonalization part: - * beta[i+1]*u[i+1] = A_mod*v[i]-alpha[i]*u[i] - * alpha[i+1]*v[i+1] = A_mod'*u[i+1] - beta[i+1]*v[i] - * - * NOTE: beta[i+1]=0 or alpha[i+1]=0 will lead to successful termination - * in the end of the current iteration. In this case u/v are zero. - * NOTE2: algorithm won't fail on zero alpha or beta (there will be no - * division by zero because it will be stopped BEFORE division - * occurs). However, near-zero alpha and beta won't stop algorithm - * and, although no division by zero will happen, orthogonality - * in U and V will be lost. - */ - ae_v_move(&state->x.ptr.p_double[0], 1, &state->vi.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - state->repnmv = state->repnmv+1; - linlsqr_clearrfields(state, _state); - state->needmv = ae_true; - state->rstate.stage = 4; - goto lbl_rcomm; -lbl_4: - state->needmv = ae_false; - for(i=0; i<=state->n-1; i++) - { - state->mv.ptr.p_double[state->m+i] = state->lambdai*state->vi.ptr.p_double[i]; - } - state->betaip1 = 0; - for(i=0; i<=summn-1; i++) - { - state->uip1.ptr.p_double[i] = state->mv.ptr.p_double[i]-state->alphai*state->ui.ptr.p_double[i]; - state->betaip1 = state->betaip1+state->uip1.ptr.p_double[i]*state->uip1.ptr.p_double[i]; - } - if( ae_fp_neq(state->betaip1,0) ) - { - state->betaip1 = ae_sqrt(state->betaip1, _state); - for(i=0; i<=summn-1; i++) - { - state->uip1.ptr.p_double[i] = state->uip1.ptr.p_double[i]/state->betaip1; - } - } - ae_v_move(&state->x.ptr.p_double[0], 1, &state->uip1.ptr.p_double[0], 1, ae_v_len(0,state->m-1)); - state->repnmv = state->repnmv+1; - linlsqr_clearrfields(state, _state); - state->needmtv = ae_true; - state->rstate.stage = 5; - goto lbl_rcomm; -lbl_5: - state->needmtv = ae_false; - for(i=0; i<=state->n-1; i++) - { - state->mtv.ptr.p_double[i] = state->mtv.ptr.p_double[i]+state->lambdai*state->uip1.ptr.p_double[state->m+i]; - } - state->alphaip1 = 0; - for(i=0; i<=state->n-1; i++) - { - state->vip1.ptr.p_double[i] = state->mtv.ptr.p_double[i]-state->betaip1*state->vi.ptr.p_double[i]; - state->alphaip1 = state->alphaip1+state->vip1.ptr.p_double[i]*state->vip1.ptr.p_double[i]; - } - if( ae_fp_neq(state->alphaip1,0) ) - { - state->alphaip1 = ae_sqrt(state->alphaip1, _state); - for(i=0; i<=state->n-1; i++) - { - state->vip1.ptr.p_double[i] = state->vip1.ptr.p_double[i]/state->alphaip1; - } - } - - /* - * Build next orthogonal transformation - */ - state->rhoi = safepythag2(state->rhobari, state->betaip1, _state); - state->ci = state->rhobari/state->rhoi; - state->si = state->betaip1/state->rhoi; - state->theta = state->si*state->alphaip1; - state->rhobarip1 = -state->ci*state->alphaip1; - state->phii = state->ci*state->phibari; - state->phibarip1 = state->si*state->phibari; - - /* - * Update .RNorm - * - * This tricky formula is necessary because simply writing - * State.R2:=State.PhiBarIP1*State.PhiBarIP1 does NOT guarantees - * monotonic decrease of R2. Roundoff error combined with 80-bit - * precision used internally by Intel chips allows R2 to increase - * slightly in some rare, but possible cases. This property is - * undesirable, so we prefer to guard against R increase. - */ - state->r2 = ae_minreal(state->r2, state->phibarip1*state->phibarip1, _state); - - /* - * Update d and DNorm, check condition-related stopping criteria - */ - for(i=0; i<=state->n-1; i++) - { - state->d.ptr.p_double[i] = 1/state->rhoi*(state->vi.ptr.p_double[i]-state->theta*state->d.ptr.p_double[i]); - state->dnorm = state->dnorm+state->d.ptr.p_double[i]*state->d.ptr.p_double[i]; - } - if( ae_fp_greater_eq(ae_sqrt(state->dnorm, _state)*state->anorm,state->epsc) ) - { - state->running = ae_false; - state->repterminationtype = 7; - result = ae_false; - return result; - } - - /* - * Update x, output report - */ - for(i=0; i<=state->n-1; i++) - { - state->rx.ptr.p_double[i] = state->rx.ptr.p_double[i]+state->phii/state->rhoi*state->omegai.ptr.p_double[i]; - } - if( !state->xrep ) - { - goto lbl_17; - } - ae_v_move(&state->x.ptr.p_double[0], 1, &state->rx.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - linlsqr_clearrfields(state, _state); - state->xupdated = ae_true; - state->rstate.stage = 6; - goto lbl_rcomm; -lbl_6: - state->xupdated = ae_false; -lbl_17: - - /* - * Check stopping criteria - * 1. achieved required number of iterations; - * 2. ||Rk||<=EpsB*||B||; - * 3. ||A^T*Rk||/(||A||*||Rk||)<=EpsA; - */ - if( state->maxits>0&&state->repiterationscount>=state->maxits ) - { - - /* - * Achieved required number of iterations - */ - state->running = ae_false; - state->repterminationtype = 5; - result = ae_false; - return result; - } - if( ae_fp_less_eq(state->phibarip1,state->epsb*bnorm) ) - { - - /* - * ||Rk||<=EpsB*||B||, here ||Rk||=PhiBar - */ - state->running = ae_false; - state->repterminationtype = 1; - result = ae_false; - return result; - } - if( ae_fp_less_eq(state->alphaip1*ae_fabs(state->ci, _state)/state->anorm,state->epsa) ) - { - - /* - * ||A^T*Rk||/(||A||*||Rk||)<=EpsA, here ||A^T*Rk||=PhiBar*Alpha[i+1]*|.C| - */ - state->running = ae_false; - state->repterminationtype = 4; - result = ae_false; - return result; - } - - /* - * Update omega - */ - for(i=0; i<=state->n-1; i++) - { - state->omegaip1.ptr.p_double[i] = state->vip1.ptr.p_double[i]-state->theta/state->rhoi*state->omegai.ptr.p_double[i]; - } - - /* - * Prepare for the next iteration - rename variables: - * u[i] := u[i+1] - * v[i] := v[i+1] - * rho[i] := rho[i+1] - * ... - */ - ae_v_move(&state->ui.ptr.p_double[0], 1, &state->uip1.ptr.p_double[0], 1, ae_v_len(0,summn-1)); - ae_v_move(&state->vi.ptr.p_double[0], 1, &state->vip1.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - ae_v_move(&state->omegai.ptr.p_double[0], 1, &state->omegaip1.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - state->alphai = state->alphaip1; - state->betai = state->betaip1; - state->phibari = state->phibarip1; - state->rhobari = state->rhobarip1; - goto lbl_15; -lbl_16: - result = ae_false; - return result; - - /* - * Saving state - */ -lbl_rcomm: - result = ae_true; - state->rstate.ia.ptr.p_int[0] = summn; - state->rstate.ia.ptr.p_int[1] = i; - state->rstate.ra.ptr.p_double[0] = bnorm; - return result; -} - - -/************************************************************************* -Procedure for solution of A*x=b with sparse A. - -INPUT PARAMETERS: - State - algorithm state - A - sparse M*N matrix in the CRS format (you MUST contvert it - to CRS format by calling SparseConvertToCRS() function - BEFORE you pass it to this function). - B - right part, array[M] - -RESULT: - This function returns no result. - You can get solution by calling LinCGResults() - -NOTE: this function uses lightweight preconditioning - multiplication by - inverse of diag(A). If you want, you can turn preconditioning off by - calling LinLSQRSetPrecUnit(). However, preconditioning cost is low - and preconditioner is very important for solution of badly scaled - problems. - - -- ALGLIB -- - Copyright 30.11.2011 by Bochkanov Sergey -*************************************************************************/ -void linlsqrsolvesparse(linlsqrstate* state, - sparsematrix* a, - /* Real */ ae_vector* b, - ae_state *_state) -{ - ae_int_t n; - ae_int_t i; - ae_int_t j; - ae_int_t t0; - ae_int_t t1; - double v; - - - n = state->n; - ae_assert(!state->running, "LinLSQRSolveSparse: you can not call this function when LinLSQRIteration is running", _state); - ae_assert(b->cnt>=state->m, "LinLSQRSolveSparse: Length(B)m, _state), "LinLSQRSolveSparse: B contains infinite or NaN values", _state); - - /* - * Allocate temporaries - */ - rvectorsetlengthatleast(&state->tmpd, n, _state); - rvectorsetlengthatleast(&state->tmpx, n, _state); - - /* - * Compute diagonal scaling matrix D - */ - if( state->prectype==0 ) - { - - /* - * Default preconditioner - inverse of column norms - */ - for(i=0; i<=n-1; i++) - { - state->tmpd.ptr.p_double[i] = 0; - } - t0 = 0; - t1 = 0; - while(sparseenumerate(a, &t0, &t1, &i, &j, &v, _state)) - { - state->tmpd.ptr.p_double[j] = state->tmpd.ptr.p_double[j]+ae_sqr(v, _state); - } - for(i=0; i<=n-1; i++) - { - if( ae_fp_greater(state->tmpd.ptr.p_double[i],0) ) - { - state->tmpd.ptr.p_double[i] = 1/ae_sqrt(state->tmpd.ptr.p_double[i], _state); - } - else - { - state->tmpd.ptr.p_double[i] = 1; - } - } - } - else - { - - /* - * No diagonal scaling - */ - for(i=0; i<=n-1; i++) - { - state->tmpd.ptr.p_double[i] = 1; - } - } - - /* - * Solve. - * - * Instead of solving A*x=b we solve preconditioned system (A*D)*(inv(D)*x)=b. - * Transformed A is not calculated explicitly, we just modify multiplication - * by A or A'. After solution we modify State.RX so it will store untransformed - * variables - */ - linlsqrsetb(state, b, _state); - linlsqrrestart(state, _state); - while(linlsqriteration(state, _state)) - { - if( state->needmv ) - { - for(i=0; i<=n-1; i++) - { - state->tmpx.ptr.p_double[i] = state->tmpd.ptr.p_double[i]*state->x.ptr.p_double[i]; - } - sparsemv(a, &state->tmpx, &state->mv, _state); - } - if( state->needmtv ) - { - sparsemtv(a, &state->x, &state->mtv, _state); - for(i=0; i<=n-1; i++) - { - state->mtv.ptr.p_double[i] = state->tmpd.ptr.p_double[i]*state->mtv.ptr.p_double[i]; - } - } - } - for(i=0; i<=n-1; i++) - { - state->rx.ptr.p_double[i] = state->tmpd.ptr.p_double[i]*state->rx.ptr.p_double[i]; - } -} - - -/************************************************************************* -This function sets stopping criteria. - -INPUT PARAMETERS: - EpsA - algorithm will be stopped if ||A^T*Rk||/(||A||*||Rk||)<=EpsA. - EpsB - algorithm will be stopped if ||Rk||<=EpsB*||B|| - MaxIts - algorithm will be stopped if number of iterations - more than MaxIts. - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -NOTE: if EpsA,EpsB,EpsC and MaxIts are zero then these variables will -be setted as default values. - - -- ALGLIB -- - Copyright 30.11.2011 by Bochkanov Sergey -*************************************************************************/ -void linlsqrsetcond(linlsqrstate* state, - double epsa, - double epsb, - ae_int_t maxits, - ae_state *_state) -{ - - - ae_assert(!state->running, "LinLSQRSetCond: you can not call this function when LinLSQRIteration is running", _state); - ae_assert(ae_isfinite(epsa, _state)&&ae_fp_greater_eq(epsa,0), "LinLSQRSetCond: EpsA is negative, INF or NAN", _state); - ae_assert(ae_isfinite(epsb, _state)&&ae_fp_greater_eq(epsb,0), "LinLSQRSetCond: EpsB is negative, INF or NAN", _state); - ae_assert(maxits>=0, "LinLSQRSetCond: MaxIts is negative", _state); - if( (ae_fp_eq(epsa,0)&&ae_fp_eq(epsb,0))&&maxits==0 ) - { - state->epsa = linlsqr_atol; - state->epsb = linlsqr_btol; - state->maxits = state->n; - } - else - { - state->epsa = epsa; - state->epsb = epsb; - state->maxits = maxits; - } -} - - -/************************************************************************* -LSQR solver: results. - -This function must be called after LinLSQRSolve - -INPUT PARAMETERS: - State - algorithm state - -OUTPUT PARAMETERS: - X - array[N], solution - Rep - optimization report: - * Rep.TerminationType completion code: - * 1 ||Rk||<=EpsB*||B|| - * 4 ||A^T*Rk||/(||A||*||Rk||)<=EpsA - * 5 MaxIts steps was taken - * 7 rounding errors prevent further progress, - X contains best point found so far. - (sometimes returned on singular systems) - * Rep.IterationsCount contains iterations count - * NMV contains number of matrix-vector calculations - - -- ALGLIB -- - Copyright 30.11.2011 by Bochkanov Sergey -*************************************************************************/ -void linlsqrresults(linlsqrstate* state, - /* Real */ ae_vector* x, - linlsqrreport* rep, - ae_state *_state) -{ - - ae_vector_clear(x); - _linlsqrreport_clear(rep); - - ae_assert(!state->running, "LinLSQRResult: you can not call this function when LinLSQRIteration is running", _state); - if( x->cntn ) - { - ae_vector_set_length(x, state->n, _state); - } - ae_v_move(&x->ptr.p_double[0], 1, &state->rx.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - rep->iterationscount = state->repiterationscount; - rep->nmv = state->repnmv; - rep->terminationtype = state->repterminationtype; -} - - -/************************************************************************* -This function turns on/off reporting. - -INPUT PARAMETERS: - State - structure which stores algorithm state - NeedXRep- whether iteration reports are needed or not - -If NeedXRep is True, algorithm will call rep() callback function if it is -provided to MinCGOptimize(). - - -- ALGLIB -- - Copyright 30.11.2011 by Bochkanov Sergey -*************************************************************************/ -void linlsqrsetxrep(linlsqrstate* state, - ae_bool needxrep, - ae_state *_state) -{ - - - state->xrep = needxrep; -} - - -/************************************************************************* -This function restarts LinLSQRIteration - - -- ALGLIB -- - Copyright 30.11.2011 by Bochkanov Sergey -*************************************************************************/ -void linlsqrrestart(linlsqrstate* state, ae_state *_state) -{ - - - ae_vector_set_length(&state->rstate.ia, 1+1, _state); - ae_vector_set_length(&state->rstate.ra, 0+1, _state); - state->rstate.stage = -1; - linlsqr_clearrfields(state, _state); -} - - -/************************************************************************* -Clears request fileds (to be sure that we don't forgot to clear something) -*************************************************************************/ -static void linlsqr_clearrfields(linlsqrstate* state, ae_state *_state) -{ - - - state->xupdated = ae_false; - state->needmv = ae_false; - state->needmtv = ae_false; - state->needmv2 = ae_false; - state->needvmv = ae_false; - state->needprec = ae_false; -} - - -ae_bool _linlsqrstate_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - linlsqrstate *p = (linlsqrstate*)_p; - ae_touch_ptr((void*)p); - if( !_normestimatorstate_init(&p->nes, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->rx, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->b, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->ui, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->uip1, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->vi, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->vip1, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->omegai, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->omegaip1, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->d, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->mv, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->mtv, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->tmpd, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->tmpx, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _linlsqrstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - linlsqrstate *dst = (linlsqrstate*)_dst; - linlsqrstate *src = (linlsqrstate*)_src; - if( !_normestimatorstate_init_copy(&dst->nes, &src->nes, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->rx, &src->rx, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->b, &src->b, _state, make_automatic) ) - return ae_false; - dst->n = src->n; - dst->m = src->m; - dst->prectype = src->prectype; - if( !ae_vector_init_copy(&dst->ui, &src->ui, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->uip1, &src->uip1, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->vi, &src->vi, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->vip1, &src->vip1, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->omegai, &src->omegai, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->omegaip1, &src->omegaip1, _state, make_automatic) ) - return ae_false; - dst->alphai = src->alphai; - dst->alphaip1 = src->alphaip1; - dst->betai = src->betai; - dst->betaip1 = src->betaip1; - dst->phibari = src->phibari; - dst->phibarip1 = src->phibarip1; - dst->phii = src->phii; - dst->rhobari = src->rhobari; - dst->rhobarip1 = src->rhobarip1; - dst->rhoi = src->rhoi; - dst->ci = src->ci; - dst->si = src->si; - dst->theta = src->theta; - dst->lambdai = src->lambdai; - if( !ae_vector_init_copy(&dst->d, &src->d, _state, make_automatic) ) - return ae_false; - dst->anorm = src->anorm; - dst->bnorm2 = src->bnorm2; - dst->dnorm = src->dnorm; - dst->r2 = src->r2; - if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->mv, &src->mv, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->mtv, &src->mtv, _state, make_automatic) ) - return ae_false; - dst->epsa = src->epsa; - dst->epsb = src->epsb; - dst->epsc = src->epsc; - dst->maxits = src->maxits; - dst->xrep = src->xrep; - dst->xupdated = src->xupdated; - dst->needmv = src->needmv; - dst->needmtv = src->needmtv; - dst->needmv2 = src->needmv2; - dst->needvmv = src->needvmv; - dst->needprec = src->needprec; - dst->repiterationscount = src->repiterationscount; - dst->repnmv = src->repnmv; - dst->repterminationtype = src->repterminationtype; - dst->running = src->running; - if( !ae_vector_init_copy(&dst->tmpd, &src->tmpd, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->tmpx, &src->tmpx, _state, make_automatic) ) - return ae_false; - if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _linlsqrstate_clear(void* _p) -{ - linlsqrstate *p = (linlsqrstate*)_p; - ae_touch_ptr((void*)p); - _normestimatorstate_clear(&p->nes); - ae_vector_clear(&p->rx); - ae_vector_clear(&p->b); - ae_vector_clear(&p->ui); - ae_vector_clear(&p->uip1); - ae_vector_clear(&p->vi); - ae_vector_clear(&p->vip1); - ae_vector_clear(&p->omegai); - ae_vector_clear(&p->omegaip1); - ae_vector_clear(&p->d); - ae_vector_clear(&p->x); - ae_vector_clear(&p->mv); - ae_vector_clear(&p->mtv); - ae_vector_clear(&p->tmpd); - ae_vector_clear(&p->tmpx); - _rcommstate_clear(&p->rstate); -} - - -void _linlsqrstate_destroy(void* _p) -{ - linlsqrstate *p = (linlsqrstate*)_p; - ae_touch_ptr((void*)p); - _normestimatorstate_destroy(&p->nes); - ae_vector_destroy(&p->rx); - ae_vector_destroy(&p->b); - ae_vector_destroy(&p->ui); - ae_vector_destroy(&p->uip1); - ae_vector_destroy(&p->vi); - ae_vector_destroy(&p->vip1); - ae_vector_destroy(&p->omegai); - ae_vector_destroy(&p->omegaip1); - ae_vector_destroy(&p->d); - ae_vector_destroy(&p->x); - ae_vector_destroy(&p->mv); - ae_vector_destroy(&p->mtv); - ae_vector_destroy(&p->tmpd); - ae_vector_destroy(&p->tmpx); - _rcommstate_destroy(&p->rstate); -} - - -ae_bool _linlsqrreport_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - linlsqrreport *p = (linlsqrreport*)_p; - ae_touch_ptr((void*)p); - return ae_true; -} - - -ae_bool _linlsqrreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - linlsqrreport *dst = (linlsqrreport*)_dst; - linlsqrreport *src = (linlsqrreport*)_src; - dst->iterationscount = src->iterationscount; - dst->nmv = src->nmv; - dst->terminationtype = src->terminationtype; - return ae_true; -} - - -void _linlsqrreport_clear(void* _p) -{ - linlsqrreport *p = (linlsqrreport*)_p; - ae_touch_ptr((void*)p); -} - - -void _linlsqrreport_destroy(void* _p) -{ - linlsqrreport *p = (linlsqrreport*)_p; - ae_touch_ptr((void*)p); -} - - - - -/************************************************************************* -This function initializes linear CG Solver. This solver is used to solve -symmetric positive definite problems. If you want to solve nonsymmetric -(or non-positive definite) problem you may use LinLSQR solver provided by -ALGLIB. - -USAGE: -1. User initializes algorithm state with LinCGCreate() call -2. User tunes solver parameters with LinCGSetCond() and other functions -3. Optionally, user sets starting point with LinCGSetStartingPoint() -4. User calls LinCGSolveSparse() function which takes algorithm state and - SparseMatrix object. -5. User calls LinCGResults() to get solution -6. Optionally, user may call LinCGSolveSparse() again to solve another - problem with different matrix and/or right part without reinitializing - LinCGState structure. - -INPUT PARAMETERS: - N - problem dimension, N>0 - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 14.11.2011 by Bochkanov Sergey -*************************************************************************/ -void lincgcreate(ae_int_t n, lincgstate* state, ae_state *_state) -{ - ae_int_t i; - - _lincgstate_clear(state); - - ae_assert(n>0, "LinCGCreate: N<=0", _state); - state->n = n; - state->prectype = 0; - state->itsbeforerestart = n; - state->itsbeforerupdate = 10; - state->epsf = lincg_defaultprecision; - state->maxits = 0; - state->xrep = ae_false; - state->running = ae_false; - - /* - * * allocate arrays - * * set RX to NAN (just for the case user calls Results() without - * calling SolveSparse() - * * set starting point to zero - * * we do NOT initialize B here because we assume that user should - * initializate it using LinCGSetB() function. In case he forgets - * to do so, exception will be thrown in the LinCGIteration(). - */ - ae_vector_set_length(&state->rx, state->n, _state); - ae_vector_set_length(&state->startx, state->n, _state); - ae_vector_set_length(&state->b, state->n, _state); - for(i=0; i<=state->n-1; i++) - { - state->rx.ptr.p_double[i] = _state->v_nan; - state->startx.ptr.p_double[i] = 0.0; - state->b.ptr.p_double[i] = 0; - } - ae_vector_set_length(&state->cx, state->n, _state); - ae_vector_set_length(&state->p, state->n, _state); - ae_vector_set_length(&state->r, state->n, _state); - ae_vector_set_length(&state->cr, state->n, _state); - ae_vector_set_length(&state->z, state->n, _state); - ae_vector_set_length(&state->cz, state->n, _state); - ae_vector_set_length(&state->x, state->n, _state); - ae_vector_set_length(&state->mv, state->n, _state); - ae_vector_set_length(&state->pv, state->n, _state); - lincg_updateitersdata(state, _state); - ae_vector_set_length(&state->rstate.ia, 0+1, _state); - ae_vector_set_length(&state->rstate.ra, 2+1, _state); - state->rstate.stage = -1; -} - - -/************************************************************************* -This function sets starting point. -By default, zero starting point is used. - -INPUT PARAMETERS: - X - starting point, array[N] - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 14.11.2011 by Bochkanov Sergey -*************************************************************************/ -void lincgsetstartingpoint(lincgstate* state, - /* Real */ ae_vector* x, - ae_state *_state) -{ - - - ae_assert(!state->running, "LinCGSetStartingPoint: you can not change starting point because LinCGIteration() function is running", _state); - ae_assert(state->n<=x->cnt, "LinCGSetStartingPoint: Length(X)n, _state), "LinCGSetStartingPoint: X contains infinite or NaN values!", _state); - ae_v_move(&state->startx.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,state->n-1)); -} - - -/************************************************************************* -This function sets right part. By default, right part is zero. - -INPUT PARAMETERS: - B - right part, array[N]. - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 14.11.2011 by Bochkanov Sergey -*************************************************************************/ -void lincgsetb(lincgstate* state, - /* Real */ ae_vector* b, - ae_state *_state) -{ - - - ae_assert(!state->running, "LinCGSetB: you can not set B, because function LinCGIteration is running!", _state); - ae_assert(b->cnt>=state->n, "LinCGSetB: Length(B)n, _state), "LinCGSetB: B contains infinite or NaN values!", _state); - ae_v_move(&state->b.ptr.p_double[0], 1, &b->ptr.p_double[0], 1, ae_v_len(0,state->n-1)); -} - - -/************************************************************************* -This function changes preconditioning settings of LinCGSolveSparse() -function. By default, SolveSparse() uses diagonal preconditioner, but if -you want to use solver without preconditioning, you can call this function -which forces solver to use unit matrix for preconditioning. - -INPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 19.11.2012 by Bochkanov Sergey -*************************************************************************/ -void lincgsetprecunit(lincgstate* state, ae_state *_state) -{ - - - ae_assert(!state->running, "LinCGSetPrecUnit: you can not change preconditioner, because function LinCGIteration is running!", _state); - state->prectype = -1; -} - - -/************************************************************************* -This function changes preconditioning settings of LinCGSolveSparse() -function. LinCGSolveSparse() will use diagonal of the system matrix as -preconditioner. This preconditioning mode is active by default. - -INPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 19.11.2012 by Bochkanov Sergey -*************************************************************************/ -void lincgsetprecdiag(lincgstate* state, ae_state *_state) -{ - - - ae_assert(!state->running, "LinCGSetPrecDiag: you can not change preconditioner, because function LinCGIteration is running!", _state); - state->prectype = 0; -} - - -/************************************************************************* -This function sets stopping criteria. - -INPUT PARAMETERS: - EpsF - algorithm will be stopped if norm of residual is less than - EpsF*||b||. - MaxIts - algorithm will be stopped if number of iterations is more - than MaxIts. - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -NOTES: -If both EpsF and MaxIts are zero then small EpsF will be set to small -value. - - -- ALGLIB -- - Copyright 14.11.2011 by Bochkanov Sergey -*************************************************************************/ -void lincgsetcond(lincgstate* state, - double epsf, - ae_int_t maxits, - ae_state *_state) -{ - - - ae_assert(!state->running, "LinCGSetCond: you can not change stopping criteria when LinCGIteration() is running", _state); - ae_assert(ae_isfinite(epsf, _state)&&ae_fp_greater_eq(epsf,0), "LinCGSetCond: EpsF is negative or contains infinite or NaN values", _state); - ae_assert(maxits>=0, "LinCGSetCond: MaxIts is negative", _state); - if( ae_fp_eq(epsf,0)&&maxits==0 ) - { - state->epsf = lincg_defaultprecision; - state->maxits = maxits; - } - else - { - state->epsf = epsf; - state->maxits = maxits; - } -} - - -/************************************************************************* -Reverse communication version of linear CG. - - -- ALGLIB -- - Copyright 14.11.2011 by Bochkanov Sergey -*************************************************************************/ -ae_bool lincgiteration(lincgstate* state, ae_state *_state) -{ - ae_int_t i; - double uvar; - double bnorm; - double v; - ae_bool result; - - - - /* - * Reverse communication preparations - * I know it looks ugly, but it works the same way - * anywhere from C++ to Python. - * - * This code initializes locals by: - * * random values determined during code - * generation - on first subroutine call - * * values from previous call - on subsequent calls - */ - if( state->rstate.stage>=0 ) - { - i = state->rstate.ia.ptr.p_int[0]; - uvar = state->rstate.ra.ptr.p_double[0]; - bnorm = state->rstate.ra.ptr.p_double[1]; - v = state->rstate.ra.ptr.p_double[2]; - } - else - { - i = -983; - uvar = -989; - bnorm = -834; - v = 900; - } - if( state->rstate.stage==0 ) - { - goto lbl_0; - } - if( state->rstate.stage==1 ) - { - goto lbl_1; - } - if( state->rstate.stage==2 ) - { - goto lbl_2; - } - if( state->rstate.stage==3 ) - { - goto lbl_3; - } - if( state->rstate.stage==4 ) - { - goto lbl_4; - } - if( state->rstate.stage==5 ) - { - goto lbl_5; - } - if( state->rstate.stage==6 ) - { - goto lbl_6; - } - if( state->rstate.stage==7 ) - { - goto lbl_7; - } - - /* - * Routine body - */ - ae_assert(state->b.cnt>0, "LinCGIteration: B is not initialized (you must initialize B by LinCGSetB() call", _state); - state->running = ae_true; - state->repnmv = 0; - lincg_clearrfields(state, _state); - lincg_updateitersdata(state, _state); - - /* - * Start 0-th iteration - */ - ae_v_move(&state->rx.ptr.p_double[0], 1, &state->startx.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - ae_v_move(&state->x.ptr.p_double[0], 1, &state->rx.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - state->repnmv = state->repnmv+1; - lincg_clearrfields(state, _state); - state->needvmv = ae_true; - state->rstate.stage = 0; - goto lbl_rcomm; -lbl_0: - state->needvmv = ae_false; - bnorm = 0; - state->r2 = 0; - state->meritfunction = 0; - for(i=0; i<=state->n-1; i++) - { - state->r.ptr.p_double[i] = state->b.ptr.p_double[i]-state->mv.ptr.p_double[i]; - state->r2 = state->r2+state->r.ptr.p_double[i]*state->r.ptr.p_double[i]; - state->meritfunction = state->meritfunction+state->mv.ptr.p_double[i]*state->rx.ptr.p_double[i]-2*state->b.ptr.p_double[i]*state->rx.ptr.p_double[i]; - bnorm = bnorm+state->b.ptr.p_double[i]*state->b.ptr.p_double[i]; - } - bnorm = ae_sqrt(bnorm, _state); - - /* - * Output first report - */ - if( !state->xrep ) - { - goto lbl_8; - } - ae_v_move(&state->x.ptr.p_double[0], 1, &state->rx.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - lincg_clearrfields(state, _state); - state->xupdated = ae_true; - state->rstate.stage = 1; - goto lbl_rcomm; -lbl_1: - state->xupdated = ae_false; -lbl_8: - - /* - * Is x0 a solution? - */ - if( !ae_isfinite(state->r2, _state)||ae_fp_less_eq(ae_sqrt(state->r2, _state),state->epsf*bnorm) ) - { - state->running = ae_false; - if( ae_isfinite(state->r2, _state) ) - { - state->repterminationtype = 1; - } - else - { - state->repterminationtype = -4; - } - result = ae_false; - return result; - } - - /* - * Calculate Z and P - */ - ae_v_move(&state->x.ptr.p_double[0], 1, &state->r.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - state->repnmv = state->repnmv+1; - lincg_clearrfields(state, _state); - state->needprec = ae_true; - state->rstate.stage = 2; - goto lbl_rcomm; -lbl_2: - state->needprec = ae_false; - for(i=0; i<=state->n-1; i++) - { - state->z.ptr.p_double[i] = state->pv.ptr.p_double[i]; - state->p.ptr.p_double[i] = state->z.ptr.p_double[i]; - } - - /* - * Other iterations(1..N) - */ - state->repiterationscount = 0; -lbl_10: - if( ae_false ) - { - goto lbl_11; - } - state->repiterationscount = state->repiterationscount+1; - - /* - * Calculate Alpha - */ - ae_v_move(&state->x.ptr.p_double[0], 1, &state->p.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - state->repnmv = state->repnmv+1; - lincg_clearrfields(state, _state); - state->needvmv = ae_true; - state->rstate.stage = 3; - goto lbl_rcomm; -lbl_3: - state->needvmv = ae_false; - if( !ae_isfinite(state->vmv, _state)||ae_fp_less_eq(state->vmv,0) ) - { - - /* - * a) Overflow when calculating VMV - * b) non-positive VMV (non-SPD matrix) - */ - state->running = ae_false; - if( ae_isfinite(state->vmv, _state) ) - { - state->repterminationtype = -5; - } - else - { - state->repterminationtype = -4; - } - result = ae_false; - return result; - } - state->alpha = 0; - for(i=0; i<=state->n-1; i++) - { - state->alpha = state->alpha+state->r.ptr.p_double[i]*state->z.ptr.p_double[i]; - } - state->alpha = state->alpha/state->vmv; - if( !ae_isfinite(state->alpha, _state) ) - { - - /* - * Overflow when calculating Alpha - */ - state->running = ae_false; - state->repterminationtype = -4; - result = ae_false; - return result; - } - - /* - * Next step toward solution - */ - for(i=0; i<=state->n-1; i++) - { - state->cx.ptr.p_double[i] = state->rx.ptr.p_double[i]+state->alpha*state->p.ptr.p_double[i]; - } - - /* - * Calculate R: - * * use recurrent relation to update R - * * at every ItsBeforeRUpdate-th iteration recalculate it from scratch, using matrix-vector product - * in case R grows instead of decreasing, algorithm is terminated with positive completion code - */ - if( !(state->itsbeforerupdate==0||state->repiterationscount%state->itsbeforerupdate!=0) ) - { - goto lbl_12; - } - - /* - * Calculate R using recurrent formula - */ - for(i=0; i<=state->n-1; i++) - { - state->cr.ptr.p_double[i] = state->r.ptr.p_double[i]-state->alpha*state->mv.ptr.p_double[i]; - state->x.ptr.p_double[i] = state->cr.ptr.p_double[i]; - } - goto lbl_13; -lbl_12: - - /* - * Calculate R using matrix-vector multiplication - */ - ae_v_move(&state->x.ptr.p_double[0], 1, &state->cx.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - state->repnmv = state->repnmv+1; - lincg_clearrfields(state, _state); - state->needmv = ae_true; - state->rstate.stage = 4; - goto lbl_rcomm; -lbl_4: - state->needmv = ae_false; - for(i=0; i<=state->n-1; i++) - { - state->cr.ptr.p_double[i] = state->b.ptr.p_double[i]-state->mv.ptr.p_double[i]; - state->x.ptr.p_double[i] = state->cr.ptr.p_double[i]; - } - - /* - * Calculating merit function - * Check emergency stopping criterion - */ - v = 0; - for(i=0; i<=state->n-1; i++) - { - v = v+state->mv.ptr.p_double[i]*state->cx.ptr.p_double[i]-2*state->b.ptr.p_double[i]*state->cx.ptr.p_double[i]; - } - if( ae_fp_less(v,state->meritfunction) ) - { - goto lbl_14; - } - for(i=0; i<=state->n-1; i++) - { - if( !ae_isfinite(state->rx.ptr.p_double[i], _state) ) - { - state->running = ae_false; - state->repterminationtype = -4; - result = ae_false; - return result; - } - } - - /* - *output last report - */ - if( !state->xrep ) - { - goto lbl_16; - } - ae_v_move(&state->x.ptr.p_double[0], 1, &state->rx.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - lincg_clearrfields(state, _state); - state->xupdated = ae_true; - state->rstate.stage = 5; - goto lbl_rcomm; -lbl_5: - state->xupdated = ae_false; -lbl_16: - state->running = ae_false; - state->repterminationtype = 7; - result = ae_false; - return result; -lbl_14: - state->meritfunction = v; -lbl_13: - ae_v_move(&state->rx.ptr.p_double[0], 1, &state->cx.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - - /* - * calculating RNorm - * - * NOTE: monotonic decrease of R2 is not guaranteed by algorithm. - */ - state->r2 = 0; - for(i=0; i<=state->n-1; i++) - { - state->r2 = state->r2+state->cr.ptr.p_double[i]*state->cr.ptr.p_double[i]; - } - - /* - *output report - */ - if( !state->xrep ) - { - goto lbl_18; - } - ae_v_move(&state->x.ptr.p_double[0], 1, &state->rx.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - lincg_clearrfields(state, _state); - state->xupdated = ae_true; - state->rstate.stage = 6; - goto lbl_rcomm; -lbl_6: - state->xupdated = ae_false; -lbl_18: - - /* - *stopping criterion - *achieved the required precision - */ - if( !ae_isfinite(state->r2, _state)||ae_fp_less_eq(ae_sqrt(state->r2, _state),state->epsf*bnorm) ) - { - state->running = ae_false; - if( ae_isfinite(state->r2, _state) ) - { - state->repterminationtype = 1; - } - else - { - state->repterminationtype = -4; - } - result = ae_false; - return result; - } - if( state->repiterationscount>=state->maxits&&state->maxits>0 ) - { - for(i=0; i<=state->n-1; i++) - { - if( !ae_isfinite(state->rx.ptr.p_double[i], _state) ) - { - state->running = ae_false; - state->repterminationtype = -4; - result = ae_false; - return result; - } - } - - /* - *if X is finite number - */ - state->running = ae_false; - state->repterminationtype = 5; - result = ae_false; - return result; - } - ae_v_move(&state->x.ptr.p_double[0], 1, &state->cr.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - - /* - *prepere of parameters for next iteration - */ - state->repnmv = state->repnmv+1; - lincg_clearrfields(state, _state); - state->needprec = ae_true; - state->rstate.stage = 7; - goto lbl_rcomm; -lbl_7: - state->needprec = ae_false; - ae_v_move(&state->cz.ptr.p_double[0], 1, &state->pv.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - if( state->repiterationscount%state->itsbeforerestart!=0 ) - { - state->beta = 0; - uvar = 0; - for(i=0; i<=state->n-1; i++) - { - state->beta = state->beta+state->cz.ptr.p_double[i]*state->cr.ptr.p_double[i]; - uvar = uvar+state->z.ptr.p_double[i]*state->r.ptr.p_double[i]; - } - - /* - *check that UVar is't INF or is't zero - */ - if( !ae_isfinite(uvar, _state)||ae_fp_eq(uvar,0) ) - { - state->running = ae_false; - state->repterminationtype = -4; - result = ae_false; - return result; - } - - /* - *calculate .BETA - */ - state->beta = state->beta/uvar; - - /* - *check that .BETA neither INF nor NaN - */ - if( !ae_isfinite(state->beta, _state) ) - { - state->running = ae_false; - state->repterminationtype = -1; - result = ae_false; - return result; - } - for(i=0; i<=state->n-1; i++) - { - state->p.ptr.p_double[i] = state->cz.ptr.p_double[i]+state->beta*state->p.ptr.p_double[i]; - } - } - else - { - ae_v_move(&state->p.ptr.p_double[0], 1, &state->cz.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - } - - /* - *prepere data for next iteration - */ - for(i=0; i<=state->n-1; i++) - { - - /* - *write (k+1)th iteration to (k )th iteration - */ - state->r.ptr.p_double[i] = state->cr.ptr.p_double[i]; - state->z.ptr.p_double[i] = state->cz.ptr.p_double[i]; - } - goto lbl_10; -lbl_11: - result = ae_false; - return result; - - /* - * Saving state - */ -lbl_rcomm: - result = ae_true; - state->rstate.ia.ptr.p_int[0] = i; - state->rstate.ra.ptr.p_double[0] = uvar; - state->rstate.ra.ptr.p_double[1] = bnorm; - state->rstate.ra.ptr.p_double[2] = v; - return result; -} - - -/************************************************************************* -Procedure for solution of A*x=b with sparse A. - -INPUT PARAMETERS: - State - algorithm state - A - sparse matrix in the CRS format (you MUST contvert it to - CRS format by calling SparseConvertToCRS() function). - IsUpper - whether upper or lower triangle of A is used: - * IsUpper=True => only upper triangle is used and lower - triangle is not referenced at all - * IsUpper=False => only lower triangle is used and upper - triangle is not referenced at all - B - right part, array[N] - -RESULT: - This function returns no result. - You can get solution by calling LinCGResults() - -NOTE: this function uses lightweight preconditioning - multiplication by - inverse of diag(A). If you want, you can turn preconditioning off by - calling LinCGSetPrecUnit(). However, preconditioning cost is low and - preconditioner is very important for solution of badly scaled - problems. - - -- ALGLIB -- - Copyright 14.11.2011 by Bochkanov Sergey -*************************************************************************/ -void lincgsolvesparse(lincgstate* state, - sparsematrix* a, - ae_bool isupper, - /* Real */ ae_vector* b, - ae_state *_state) -{ - ae_int_t n; - ae_int_t i; - double v; - double vmv; - - - n = state->n; - ae_assert(b->cnt>=state->n, "LinCGSetB: Length(B)n, _state), "LinCGSetB: B contains infinite or NaN values!", _state); - - /* - * Allocate temporaries - */ - rvectorsetlengthatleast(&state->tmpd, n, _state); - - /* - * Compute diagonal scaling matrix D - */ - if( state->prectype==0 ) - { - - /* - * Default preconditioner - inverse of matrix diagonal - */ - for(i=0; i<=n-1; i++) - { - v = sparsegetdiagonal(a, i, _state); - if( ae_fp_greater(v,0) ) - { - state->tmpd.ptr.p_double[i] = 1/ae_sqrt(v, _state); - } - else - { - state->tmpd.ptr.p_double[i] = 1; - } - } - } - else - { - - /* - * No diagonal scaling - */ - for(i=0; i<=n-1; i++) - { - state->tmpd.ptr.p_double[i] = 1; - } - } - - /* - * Solve - */ - lincgrestart(state, _state); - lincgsetb(state, b, _state); - while(lincgiteration(state, _state)) - { - - /* - * Process different requests from optimizer - */ - if( state->needmv ) - { - sparsesmv(a, isupper, &state->x, &state->mv, _state); - } - if( state->needvmv ) - { - sparsesmv(a, isupper, &state->x, &state->mv, _state); - vmv = ae_v_dotproduct(&state->x.ptr.p_double[0], 1, &state->mv.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - state->vmv = vmv; - } - if( state->needprec ) - { - for(i=0; i<=n-1; i++) - { - state->pv.ptr.p_double[i] = state->x.ptr.p_double[i]*ae_sqr(state->tmpd.ptr.p_double[i], _state); - } - } - } -} - - -/************************************************************************* -CG-solver: results. - -This function must be called after LinCGSolve - -INPUT PARAMETERS: - State - algorithm state - -OUTPUT PARAMETERS: - X - array[N], solution - Rep - optimization report: - * Rep.TerminationType completion code: - * -5 input matrix is either not positive definite, - too large or too small - * -4 overflow/underflow during solution - (ill conditioned problem) - * 1 ||residual||<=EpsF*||b|| - * 5 MaxIts steps was taken - * 7 rounding errors prevent further progress, - best point found is returned - * Rep.IterationsCount contains iterations count - * NMV contains number of matrix-vector calculations - - -- ALGLIB -- - Copyright 14.11.2011 by Bochkanov Sergey -*************************************************************************/ -void lincgresults(lincgstate* state, - /* Real */ ae_vector* x, - lincgreport* rep, - ae_state *_state) -{ - - ae_vector_clear(x); - _lincgreport_clear(rep); - - ae_assert(!state->running, "LinCGResult: you can not get result, because function LinCGIteration has been launched!", _state); - if( x->cntn ) - { - ae_vector_set_length(x, state->n, _state); - } - ae_v_move(&x->ptr.p_double[0], 1, &state->rx.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - rep->iterationscount = state->repiterationscount; - rep->nmv = state->repnmv; - rep->terminationtype = state->repterminationtype; - rep->r2 = state->r2; -} - - -/************************************************************************* -This function sets restart frequency. By default, algorithm is restarted -after N subsequent iterations. - - -- ALGLIB -- - Copyright 14.11.2011 by Bochkanov Sergey -*************************************************************************/ -void lincgsetrestartfreq(lincgstate* state, - ae_int_t srf, - ae_state *_state) -{ - - - ae_assert(!state->running, "LinCGSetRestartFreq: you can not change restart frequency when LinCGIteration() is running", _state); - ae_assert(srf>0, "LinCGSetRestartFreq: non-positive SRF", _state); - state->itsbeforerestart = srf; -} - - -/************************************************************************* -This function sets frequency of residual recalculations. - -Algorithm updates residual r_k using iterative formula, but recalculates -it from scratch after each 10 iterations. It is done to avoid accumulation -of numerical errors and to stop algorithm when r_k starts to grow. - -Such low update frequence (1/10) gives very little overhead, but makes -algorithm a bit more robust against numerical errors. However, you may -change it - -INPUT PARAMETERS: - Freq - desired update frequency, Freq>=0. - Zero value means that no updates will be done. - - -- ALGLIB -- - Copyright 14.11.2011 by Bochkanov Sergey -*************************************************************************/ -void lincgsetrupdatefreq(lincgstate* state, - ae_int_t freq, - ae_state *_state) -{ - - - ae_assert(!state->running, "LinCGSetRUpdateFreq: you can not change update frequency when LinCGIteration() is running", _state); - ae_assert(freq>=0, "LinCGSetRUpdateFreq: non-positive Freq", _state); - state->itsbeforerupdate = freq; -} - - -/************************************************************************* -This function turns on/off reporting. - -INPUT PARAMETERS: - State - structure which stores algorithm state - NeedXRep- whether iteration reports are needed or not - -If NeedXRep is True, algorithm will call rep() callback function if it is -provided to MinCGOptimize(). - - -- ALGLIB -- - Copyright 14.11.2011 by Bochkanov Sergey -*************************************************************************/ -void lincgsetxrep(lincgstate* state, ae_bool needxrep, ae_state *_state) -{ - - - state->xrep = needxrep; -} - - -/************************************************************************* -Procedure for restart function LinCGIteration - - -- ALGLIB -- - Copyright 14.11.2011 by Bochkanov Sergey -*************************************************************************/ -void lincgrestart(lincgstate* state, ae_state *_state) -{ - - - ae_vector_set_length(&state->rstate.ia, 0+1, _state); - ae_vector_set_length(&state->rstate.ra, 2+1, _state); - state->rstate.stage = -1; - lincg_clearrfields(state, _state); -} - - -/************************************************************************* -Clears request fileds (to be sure that we don't forgot to clear something) -*************************************************************************/ -static void lincg_clearrfields(lincgstate* state, ae_state *_state) -{ - - - state->xupdated = ae_false; - state->needmv = ae_false; - state->needmtv = ae_false; - state->needmv2 = ae_false; - state->needvmv = ae_false; - state->needprec = ae_false; -} - - -/************************************************************************* -Clears request fileds (to be sure that we don't forgot to clear something) -*************************************************************************/ -static void lincg_updateitersdata(lincgstate* state, ae_state *_state) -{ - - - state->repiterationscount = 0; - state->repnmv = 0; - state->repterminationtype = 0; -} - - -ae_bool _lincgstate_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - lincgstate *p = (lincgstate*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->rx, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->b, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->cx, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->cr, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->cz, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->p, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->r, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->z, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->mv, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->pv, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->startx, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->tmpd, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _lincgstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - lincgstate *dst = (lincgstate*)_dst; - lincgstate *src = (lincgstate*)_src; - if( !ae_vector_init_copy(&dst->rx, &src->rx, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->b, &src->b, _state, make_automatic) ) - return ae_false; - dst->n = src->n; - dst->prectype = src->prectype; - if( !ae_vector_init_copy(&dst->cx, &src->cx, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->cr, &src->cr, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->cz, &src->cz, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->p, &src->p, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->r, &src->r, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->z, &src->z, _state, make_automatic) ) - return ae_false; - dst->alpha = src->alpha; - dst->beta = src->beta; - dst->r2 = src->r2; - dst->meritfunction = src->meritfunction; - if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->mv, &src->mv, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->pv, &src->pv, _state, make_automatic) ) - return ae_false; - dst->vmv = src->vmv; - if( !ae_vector_init_copy(&dst->startx, &src->startx, _state, make_automatic) ) - return ae_false; - dst->epsf = src->epsf; - dst->maxits = src->maxits; - dst->itsbeforerestart = src->itsbeforerestart; - dst->itsbeforerupdate = src->itsbeforerupdate; - dst->xrep = src->xrep; - dst->xupdated = src->xupdated; - dst->needmv = src->needmv; - dst->needmtv = src->needmtv; - dst->needmv2 = src->needmv2; - dst->needvmv = src->needvmv; - dst->needprec = src->needprec; - dst->repiterationscount = src->repiterationscount; - dst->repnmv = src->repnmv; - dst->repterminationtype = src->repterminationtype; - dst->running = src->running; - if( !ae_vector_init_copy(&dst->tmpd, &src->tmpd, _state, make_automatic) ) - return ae_false; - if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _lincgstate_clear(void* _p) -{ - lincgstate *p = (lincgstate*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->rx); - ae_vector_clear(&p->b); - ae_vector_clear(&p->cx); - ae_vector_clear(&p->cr); - ae_vector_clear(&p->cz); - ae_vector_clear(&p->p); - ae_vector_clear(&p->r); - ae_vector_clear(&p->z); - ae_vector_clear(&p->x); - ae_vector_clear(&p->mv); - ae_vector_clear(&p->pv); - ae_vector_clear(&p->startx); - ae_vector_clear(&p->tmpd); - _rcommstate_clear(&p->rstate); -} - - -void _lincgstate_destroy(void* _p) -{ - lincgstate *p = (lincgstate*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->rx); - ae_vector_destroy(&p->b); - ae_vector_destroy(&p->cx); - ae_vector_destroy(&p->cr); - ae_vector_destroy(&p->cz); - ae_vector_destroy(&p->p); - ae_vector_destroy(&p->r); - ae_vector_destroy(&p->z); - ae_vector_destroy(&p->x); - ae_vector_destroy(&p->mv); - ae_vector_destroy(&p->pv); - ae_vector_destroy(&p->startx); - ae_vector_destroy(&p->tmpd); - _rcommstate_destroy(&p->rstate); -} - - -ae_bool _lincgreport_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - lincgreport *p = (lincgreport*)_p; - ae_touch_ptr((void*)p); - return ae_true; -} - - -ae_bool _lincgreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - lincgreport *dst = (lincgreport*)_dst; - lincgreport *src = (lincgreport*)_src; - dst->iterationscount = src->iterationscount; - dst->nmv = src->nmv; - dst->terminationtype = src->terminationtype; - dst->r2 = src->r2; - return ae_true; -} - - -void _lincgreport_clear(void* _p) -{ - lincgreport *p = (lincgreport*)_p; - ae_touch_ptr((void*)p); -} - - -void _lincgreport_destroy(void* _p) -{ - lincgreport *p = (lincgreport*)_p; - ae_touch_ptr((void*)p); -} - - - - -/************************************************************************* - LEVENBERG-MARQUARDT-LIKE NONLINEAR SOLVER - -DESCRIPTION: -This algorithm solves system of nonlinear equations - F[0](x[0], ..., x[n-1]) = 0 - F[1](x[0], ..., x[n-1]) = 0 - ... - F[M-1](x[0], ..., x[n-1]) = 0 -with M/N do not necessarily coincide. Algorithm converges quadratically -under following conditions: - * the solution set XS is nonempty - * for some xs in XS there exist such neighbourhood N(xs) that: - * vector function F(x) and its Jacobian J(x) are continuously - differentiable on N - * ||F(x)|| provides local error bound on N, i.e. there exists such - c1, that ||F(x)||>c1*distance(x,XS) -Note that these conditions are much more weaker than usual non-singularity -conditions. For example, algorithm will converge for any affine function -F (whether its Jacobian singular or not). - - -REQUIREMENTS: -Algorithm will request following information during its operation: -* function vector F[] and Jacobian matrix at given point X -* value of merit function f(x)=F[0]^2(x)+...+F[M-1]^2(x) at given point X - - -USAGE: -1. User initializes algorithm state with NLEQCreateLM() call -2. User tunes solver parameters with NLEQSetCond(), NLEQSetStpMax() and - other functions -3. User calls NLEQSolve() function which takes algorithm state and - pointers (delegates, etc.) to callback functions which calculate merit - function value and Jacobian. -4. User calls NLEQResults() to get solution -5. Optionally, user may call NLEQRestartFrom() to solve another problem - with same parameters (N/M) but another starting point and/or another - function vector. NLEQRestartFrom() allows to reuse already initialized - structure. - - -INPUT PARAMETERS: - N - space dimension, N>1: - * if provided, only leading N elements of X are used - * if not provided, determined automatically from size of X - M - system size - X - starting point - - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -NOTES: -1. you may tune stopping conditions with NLEQSetCond() function -2. if target function contains exp() or other fast growing functions, and - optimization algorithm makes too large steps which leads to overflow, - use NLEQSetStpMax() function to bound algorithm's steps. -3. this algorithm is a slightly modified implementation of the method - described in 'Levenberg-Marquardt method for constrained nonlinear - equations with strong local convergence properties' by Christian Kanzow - Nobuo Yamashita and Masao Fukushima and further developed in 'On the - convergence of a New Levenberg-Marquardt Method' by Jin-yan Fan and - Ya-Xiang Yuan. - - - -- ALGLIB -- - Copyright 20.08.2009 by Bochkanov Sergey -*************************************************************************/ -void nleqcreatelm(ae_int_t n, - ae_int_t m, - /* Real */ ae_vector* x, - nleqstate* state, - ae_state *_state) -{ - - _nleqstate_clear(state); - - ae_assert(n>=1, "NLEQCreateLM: N<1!", _state); - ae_assert(m>=1, "NLEQCreateLM: M<1!", _state); - ae_assert(x->cnt>=n, "NLEQCreateLM: Length(X)n = n; - state->m = m; - nleqsetcond(state, 0, 0, _state); - nleqsetxrep(state, ae_false, _state); - nleqsetstpmax(state, 0, _state); - ae_vector_set_length(&state->x, n, _state); - ae_vector_set_length(&state->xbase, n, _state); - ae_matrix_set_length(&state->j, m, n, _state); - ae_vector_set_length(&state->fi, m, _state); - ae_vector_set_length(&state->rightpart, n, _state); - ae_vector_set_length(&state->candstep, n, _state); - nleqrestartfrom(state, x, _state); -} - - -/************************************************************************* -This function sets stopping conditions for the nonlinear solver - -INPUT PARAMETERS: - State - structure which stores algorithm state - EpsF - >=0 - The subroutine finishes its work if on k+1-th iteration - the condition ||F||<=EpsF is satisfied - MaxIts - maximum number of iterations. If MaxIts=0, the number of - iterations is unlimited. - -Passing EpsF=0 and MaxIts=0 simultaneously will lead to automatic -stopping criterion selection (small EpsF). - -NOTES: - - -- ALGLIB -- - Copyright 20.08.2010 by Bochkanov Sergey -*************************************************************************/ -void nleqsetcond(nleqstate* state, - double epsf, - ae_int_t maxits, - ae_state *_state) -{ - - - ae_assert(ae_isfinite(epsf, _state), "NLEQSetCond: EpsF is not finite number!", _state); - ae_assert(ae_fp_greater_eq(epsf,0), "NLEQSetCond: negative EpsF!", _state); - ae_assert(maxits>=0, "NLEQSetCond: negative MaxIts!", _state); - if( ae_fp_eq(epsf,0)&&maxits==0 ) - { - epsf = 1.0E-6; - } - state->epsf = epsf; - state->maxits = maxits; -} - - -/************************************************************************* -This function turns on/off reporting. - -INPUT PARAMETERS: - State - structure which stores algorithm state - NeedXRep- whether iteration reports are needed or not - -If NeedXRep is True, algorithm will call rep() callback function if it is -provided to NLEQSolve(). - - -- ALGLIB -- - Copyright 20.08.2010 by Bochkanov Sergey -*************************************************************************/ -void nleqsetxrep(nleqstate* state, ae_bool needxrep, ae_state *_state) -{ - - - state->xrep = needxrep; -} - - -/************************************************************************* -This function sets maximum step length - -INPUT PARAMETERS: - State - structure which stores algorithm state - StpMax - maximum step length, >=0. Set StpMax to 0.0, if you don't - want to limit step length. - -Use this subroutine when target function contains exp() or other fast -growing functions, and algorithm makes too large steps which lead to -overflow. This function allows us to reject steps that are too large (and -therefore expose us to the possible overflow) without actually calculating -function value at the x+stp*d. - - -- ALGLIB -- - Copyright 20.08.2010 by Bochkanov Sergey -*************************************************************************/ -void nleqsetstpmax(nleqstate* state, double stpmax, ae_state *_state) -{ - - - ae_assert(ae_isfinite(stpmax, _state), "NLEQSetStpMax: StpMax is not finite!", _state); - ae_assert(ae_fp_greater_eq(stpmax,0), "NLEQSetStpMax: StpMax<0!", _state); - state->stpmax = stpmax; -} - - -/************************************************************************* - - -- ALGLIB -- - Copyright 20.03.2009 by Bochkanov Sergey -*************************************************************************/ -ae_bool nleqiteration(nleqstate* state, ae_state *_state) -{ - ae_int_t n; - ae_int_t m; - ae_int_t i; - double lambdaup; - double lambdadown; - double lambdav; - double rho; - double mu; - double stepnorm; - ae_bool b; - ae_bool result; - - - - /* - * Reverse communication preparations - * I know it looks ugly, but it works the same way - * anywhere from C++ to Python. - * - * This code initializes locals by: - * * random values determined during code - * generation - on first subroutine call - * * values from previous call - on subsequent calls - */ - if( state->rstate.stage>=0 ) - { - n = state->rstate.ia.ptr.p_int[0]; - m = state->rstate.ia.ptr.p_int[1]; - i = state->rstate.ia.ptr.p_int[2]; - b = state->rstate.ba.ptr.p_bool[0]; - lambdaup = state->rstate.ra.ptr.p_double[0]; - lambdadown = state->rstate.ra.ptr.p_double[1]; - lambdav = state->rstate.ra.ptr.p_double[2]; - rho = state->rstate.ra.ptr.p_double[3]; - mu = state->rstate.ra.ptr.p_double[4]; - stepnorm = state->rstate.ra.ptr.p_double[5]; - } - else - { - n = -983; - m = -989; - i = -834; - b = ae_false; - lambdaup = -287; - lambdadown = 364; - lambdav = 214; - rho = -338; - mu = -686; - stepnorm = 912; - } - if( state->rstate.stage==0 ) - { - goto lbl_0; - } - if( state->rstate.stage==1 ) - { - goto lbl_1; - } - if( state->rstate.stage==2 ) - { - goto lbl_2; - } - if( state->rstate.stage==3 ) - { - goto lbl_3; - } - if( state->rstate.stage==4 ) - { - goto lbl_4; - } - - /* - * Routine body - */ - - /* - * Prepare - */ - n = state->n; - m = state->m; - state->repterminationtype = 0; - state->repiterationscount = 0; - state->repnfunc = 0; - state->repnjac = 0; - - /* - * Calculate F/G, initialize algorithm - */ - nleq_clearrequestfields(state, _state); - state->needf = ae_true; - state->rstate.stage = 0; - goto lbl_rcomm; -lbl_0: - state->needf = ae_false; - state->repnfunc = state->repnfunc+1; - ae_v_move(&state->xbase.ptr.p_double[0], 1, &state->x.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->fbase = state->f; - state->fprev = ae_maxrealnumber; - if( !state->xrep ) - { - goto lbl_5; - } - - /* - * progress report - */ - nleq_clearrequestfields(state, _state); - state->xupdated = ae_true; - state->rstate.stage = 1; - goto lbl_rcomm; -lbl_1: - state->xupdated = ae_false; -lbl_5: - if( ae_fp_less_eq(state->f,ae_sqr(state->epsf, _state)) ) - { - state->repterminationtype = 1; - result = ae_false; - return result; - } - - /* - * Main cycle - */ - lambdaup = 10; - lambdadown = 0.3; - lambdav = 0.001; - rho = 1; -lbl_7: - if( ae_false ) - { - goto lbl_8; - } - - /* - * Get Jacobian; - * before we get to this point we already have State.XBase filled - * with current point and State.FBase filled with function value - * at XBase - */ - nleq_clearrequestfields(state, _state); - state->needfij = ae_true; - ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->rstate.stage = 2; - goto lbl_rcomm; -lbl_2: - state->needfij = ae_false; - state->repnfunc = state->repnfunc+1; - state->repnjac = state->repnjac+1; - rmatrixmv(n, m, &state->j, 0, 0, 1, &state->fi, 0, &state->rightpart, 0, _state); - ae_v_muld(&state->rightpart.ptr.p_double[0], 1, ae_v_len(0,n-1), -1); - - /* - * Inner cycle: find good lambda - */ -lbl_9: - if( ae_false ) - { - goto lbl_10; - } - - /* - * Solve (J^T*J + (Lambda+Mu)*I)*y = J^T*F - * to get step d=-y where: - * * Mu=||F|| - is damping parameter for nonlinear system - * * Lambda - is additional Levenberg-Marquardt parameter - * for better convergence when far away from minimum - */ - for(i=0; i<=n-1; i++) - { - state->candstep.ptr.p_double[i] = 0; - } - fblssolvecgx(&state->j, m, n, lambdav, &state->rightpart, &state->candstep, &state->cgbuf, _state); - - /* - * Normalize step (it must be no more than StpMax) - */ - stepnorm = 0; - for(i=0; i<=n-1; i++) - { - if( ae_fp_neq(state->candstep.ptr.p_double[i],0) ) - { - stepnorm = 1; - break; - } - } - linminnormalized(&state->candstep, &stepnorm, n, _state); - if( ae_fp_neq(state->stpmax,0) ) - { - stepnorm = ae_minreal(stepnorm, state->stpmax, _state); - } - - /* - * Test new step - is it good enough? - * * if not, Lambda is increased and we try again. - * * if step is good, we decrease Lambda and move on. - * - * We can break this cycle on two occasions: - * * step is so small that x+step==x (in floating point arithmetics) - * * lambda is so large - */ - ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); - ae_v_addd(&state->x.ptr.p_double[0], 1, &state->candstep.ptr.p_double[0], 1, ae_v_len(0,n-1), stepnorm); - b = ae_true; - for(i=0; i<=n-1; i++) - { - if( ae_fp_neq(state->x.ptr.p_double[i],state->xbase.ptr.p_double[i]) ) - { - b = ae_false; - break; - } - } - if( b ) - { - - /* - * Step is too small, force zero step and break - */ - stepnorm = 0; - ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->f = state->fbase; - goto lbl_10; - } - nleq_clearrequestfields(state, _state); - state->needf = ae_true; - state->rstate.stage = 3; - goto lbl_rcomm; -lbl_3: - state->needf = ae_false; - state->repnfunc = state->repnfunc+1; - if( ae_fp_less(state->f,state->fbase) ) - { - - /* - * function value decreased, move on - */ - nleq_decreaselambda(&lambdav, &rho, lambdadown, _state); - goto lbl_10; - } - if( !nleq_increaselambda(&lambdav, &rho, lambdaup, _state) ) - { - - /* - * Lambda is too large (near overflow), force zero step and break - */ - stepnorm = 0; - ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->f = state->fbase; - goto lbl_10; - } - goto lbl_9; -lbl_10: - - /* - * Accept step: - * * new position - * * new function value - */ - state->fbase = state->f; - ae_v_addd(&state->xbase.ptr.p_double[0], 1, &state->candstep.ptr.p_double[0], 1, ae_v_len(0,n-1), stepnorm); - state->repiterationscount = state->repiterationscount+1; - - /* - * Report new iteration - */ - if( !state->xrep ) - { - goto lbl_11; - } - nleq_clearrequestfields(state, _state); - state->xupdated = ae_true; - state->f = state->fbase; - ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); - state->rstate.stage = 4; - goto lbl_rcomm; -lbl_4: - state->xupdated = ae_false; -lbl_11: - - /* - * Test stopping conditions on F, step (zero/non-zero) and MaxIts; - * If one of the conditions is met, RepTerminationType is changed. - */ - if( ae_fp_less_eq(ae_sqrt(state->f, _state),state->epsf) ) - { - state->repterminationtype = 1; - } - if( ae_fp_eq(stepnorm,0)&&state->repterminationtype==0 ) - { - state->repterminationtype = -4; - } - if( state->repiterationscount>=state->maxits&&state->maxits>0 ) - { - state->repterminationtype = 5; - } - if( state->repterminationtype!=0 ) - { - goto lbl_8; - } - - /* - * Now, iteration is finally over - */ - goto lbl_7; -lbl_8: - result = ae_false; - return result; - - /* - * Saving state - */ -lbl_rcomm: - result = ae_true; - state->rstate.ia.ptr.p_int[0] = n; - state->rstate.ia.ptr.p_int[1] = m; - state->rstate.ia.ptr.p_int[2] = i; - state->rstate.ba.ptr.p_bool[0] = b; - state->rstate.ra.ptr.p_double[0] = lambdaup; - state->rstate.ra.ptr.p_double[1] = lambdadown; - state->rstate.ra.ptr.p_double[2] = lambdav; - state->rstate.ra.ptr.p_double[3] = rho; - state->rstate.ra.ptr.p_double[4] = mu; - state->rstate.ra.ptr.p_double[5] = stepnorm; - return result; -} - - -/************************************************************************* -NLEQ solver results - -INPUT PARAMETERS: - State - algorithm state. - -OUTPUT PARAMETERS: - X - array[0..N-1], solution - Rep - optimization report: - * Rep.TerminationType completion code: - * -4 ERROR: algorithm has converged to the - stationary point Xf which is local minimum of - f=F[0]^2+...+F[m-1]^2, but is not solution of - nonlinear system. - * 1 sqrt(f)<=EpsF. - * 5 MaxIts steps was taken - * 7 stopping conditions are too stringent, - further improvement is impossible - * Rep.IterationsCount contains iterations count - * NFEV contains number of function calculations - * ActiveConstraints contains number of active constraints - - -- ALGLIB -- - Copyright 20.08.2009 by Bochkanov Sergey -*************************************************************************/ -void nleqresults(nleqstate* state, - /* Real */ ae_vector* x, - nleqreport* rep, - ae_state *_state) -{ - - ae_vector_clear(x); - _nleqreport_clear(rep); - - nleqresultsbuf(state, x, rep, _state); -} - - -/************************************************************************* -NLEQ solver results - -Buffered implementation of NLEQResults(), which uses pre-allocated buffer -to store X[]. If buffer size is too small, it resizes buffer. It is -intended to be used in the inner cycles of performance critical algorithms -where array reallocation penalty is too large to be ignored. - - -- ALGLIB -- - Copyright 20.08.2009 by Bochkanov Sergey -*************************************************************************/ -void nleqresultsbuf(nleqstate* state, - /* Real */ ae_vector* x, - nleqreport* rep, - ae_state *_state) -{ - - - if( x->cntn ) - { - ae_vector_set_length(x, state->n, _state); - } - ae_v_move(&x->ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - rep->iterationscount = state->repiterationscount; - rep->nfunc = state->repnfunc; - rep->njac = state->repnjac; - rep->terminationtype = state->repterminationtype; -} - - -/************************************************************************* -This subroutine restarts CG algorithm from new point. All optimization -parameters are left unchanged. - -This function allows to solve multiple optimization problems (which -must have same number of dimensions) without object reallocation penalty. - -INPUT PARAMETERS: - State - structure used for reverse communication previously - allocated with MinCGCreate call. - X - new starting point. - BndL - new lower bounds - BndU - new upper bounds - - -- ALGLIB -- - Copyright 30.07.2010 by Bochkanov Sergey -*************************************************************************/ -void nleqrestartfrom(nleqstate* state, - /* Real */ ae_vector* x, - ae_state *_state) -{ - - - ae_assert(x->cnt>=state->n, "NLEQRestartFrom: Length(X)n, _state), "NLEQRestartFrom: X contains infinite or NaN values!", _state); - ae_v_move(&state->x.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,state->n-1)); - ae_vector_set_length(&state->rstate.ia, 2+1, _state); - ae_vector_set_length(&state->rstate.ba, 0+1, _state); - ae_vector_set_length(&state->rstate.ra, 5+1, _state); - state->rstate.stage = -1; - nleq_clearrequestfields(state, _state); -} - - -/************************************************************************* -Clears request fileds (to be sure that we don't forgot to clear something) -*************************************************************************/ -static void nleq_clearrequestfields(nleqstate* state, ae_state *_state) -{ - - - state->needf = ae_false; - state->needfij = ae_false; - state->xupdated = ae_false; -} - - -/************************************************************************* -Increases lambda, returns False when there is a danger of overflow -*************************************************************************/ -static ae_bool nleq_increaselambda(double* lambdav, - double* nu, - double lambdaup, - ae_state *_state) -{ - double lnlambda; - double lnnu; - double lnlambdaup; - double lnmax; - ae_bool result; - - - result = ae_false; - lnlambda = ae_log(*lambdav, _state); - lnlambdaup = ae_log(lambdaup, _state); - lnnu = ae_log(*nu, _state); - lnmax = 0.5*ae_log(ae_maxrealnumber, _state); - if( ae_fp_greater(lnlambda+lnlambdaup+lnnu,lnmax) ) - { - return result; - } - if( ae_fp_greater(lnnu+ae_log(2, _state),lnmax) ) - { - return result; - } - *lambdav = *lambdav*lambdaup*(*nu); - *nu = *nu*2; - result = ae_true; - return result; -} - - -/************************************************************************* -Decreases lambda, but leaves it unchanged when there is danger of underflow. -*************************************************************************/ -static void nleq_decreaselambda(double* lambdav, - double* nu, - double lambdadown, - ae_state *_state) -{ - - - *nu = 1; - if( ae_fp_less(ae_log(*lambdav, _state)+ae_log(lambdadown, _state),ae_log(ae_minrealnumber, _state)) ) - { - *lambdav = ae_minrealnumber; - } - else - { - *lambdav = *lambdav*lambdadown; - } -} - - -ae_bool _nleqstate_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - nleqstate *p = (nleqstate*)_p; - ae_touch_ptr((void*)p); - if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->fi, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init(&p->j, 0, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->xbase, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->candstep, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->rightpart, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init(&p->cgbuf, 0, DT_REAL, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -ae_bool _nleqstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - nleqstate *dst = (nleqstate*)_dst; - nleqstate *src = (nleqstate*)_src; - dst->n = src->n; - dst->m = src->m; - dst->epsf = src->epsf; - dst->maxits = src->maxits; - dst->xrep = src->xrep; - dst->stpmax = src->stpmax; - if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) - return ae_false; - dst->f = src->f; - if( !ae_vector_init_copy(&dst->fi, &src->fi, _state, make_automatic) ) - return ae_false; - if( !ae_matrix_init_copy(&dst->j, &src->j, _state, make_automatic) ) - return ae_false; - dst->needf = src->needf; - dst->needfij = src->needfij; - dst->xupdated = src->xupdated; - if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) - return ae_false; - dst->repiterationscount = src->repiterationscount; - dst->repnfunc = src->repnfunc; - dst->repnjac = src->repnjac; - dst->repterminationtype = src->repterminationtype; - if( !ae_vector_init_copy(&dst->xbase, &src->xbase, _state, make_automatic) ) - return ae_false; - dst->fbase = src->fbase; - dst->fprev = src->fprev; - if( !ae_vector_init_copy(&dst->candstep, &src->candstep, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->rightpart, &src->rightpart, _state, make_automatic) ) - return ae_false; - if( !ae_vector_init_copy(&dst->cgbuf, &src->cgbuf, _state, make_automatic) ) - return ae_false; - return ae_true; -} - - -void _nleqstate_clear(void* _p) -{ - nleqstate *p = (nleqstate*)_p; - ae_touch_ptr((void*)p); - ae_vector_clear(&p->x); - ae_vector_clear(&p->fi); - ae_matrix_clear(&p->j); - _rcommstate_clear(&p->rstate); - ae_vector_clear(&p->xbase); - ae_vector_clear(&p->candstep); - ae_vector_clear(&p->rightpart); - ae_vector_clear(&p->cgbuf); -} - - -void _nleqstate_destroy(void* _p) -{ - nleqstate *p = (nleqstate*)_p; - ae_touch_ptr((void*)p); - ae_vector_destroy(&p->x); - ae_vector_destroy(&p->fi); - ae_matrix_destroy(&p->j); - _rcommstate_destroy(&p->rstate); - ae_vector_destroy(&p->xbase); - ae_vector_destroy(&p->candstep); - ae_vector_destroy(&p->rightpart); - ae_vector_destroy(&p->cgbuf); -} - - -ae_bool _nleqreport_init(void* _p, ae_state *_state, ae_bool make_automatic) -{ - nleqreport *p = (nleqreport*)_p; - ae_touch_ptr((void*)p); - return ae_true; -} - - -ae_bool _nleqreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) -{ - nleqreport *dst = (nleqreport*)_dst; - nleqreport *src = (nleqreport*)_src; - dst->iterationscount = src->iterationscount; - dst->nfunc = src->nfunc; - dst->njac = src->njac; - dst->terminationtype = src->terminationtype; - return ae_true; -} - - -void _nleqreport_clear(void* _p) -{ - nleqreport *p = (nleqreport*)_p; - ae_touch_ptr((void*)p); -} - - -void _nleqreport_destroy(void* _p) -{ - nleqreport *p = (nleqreport*)_p; - ae_touch_ptr((void*)p); -} - - - -} - diff --git a/src/core/alglib/solvers.h b/src/core/alglib/solvers.h deleted file mode 100644 index ab9fb14..0000000 --- a/src/core/alglib/solvers.h +++ /dev/null @@ -1,2016 +0,0 @@ -/************************************************************************* -Copyright (c) Sergey Bochkanov (ALGLIB project). - ->>> SOURCE LICENSE >>> -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation (www.fsf.org); either version 2 of the -License, or (at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -A copy of the GNU General Public License is available at -http://www.fsf.org/licensing/licenses ->>> END OF LICENSE >>> -*************************************************************************/ -#ifndef _solvers_pkg_h -#define _solvers_pkg_h -#include "ap.h" -#include "alglibinternal.h" -#include "linalg.h" -#include "alglibmisc.h" - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (DATATYPES) -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ -typedef struct -{ - double r1; - double rinf; -} densesolverreport; -typedef struct -{ - double r2; - ae_matrix cx; - ae_int_t n; - ae_int_t k; -} densesolverlsreport; -typedef struct -{ - normestimatorstate nes; - ae_vector rx; - ae_vector b; - ae_int_t n; - ae_int_t m; - ae_int_t prectype; - ae_vector ui; - ae_vector uip1; - ae_vector vi; - ae_vector vip1; - ae_vector omegai; - ae_vector omegaip1; - double alphai; - double alphaip1; - double betai; - double betaip1; - double phibari; - double phibarip1; - double phii; - double rhobari; - double rhobarip1; - double rhoi; - double ci; - double si; - double theta; - double lambdai; - ae_vector d; - double anorm; - double bnorm2; - double dnorm; - double r2; - ae_vector x; - ae_vector mv; - ae_vector mtv; - double epsa; - double epsb; - double epsc; - ae_int_t maxits; - ae_bool xrep; - ae_bool xupdated; - ae_bool needmv; - ae_bool needmtv; - ae_bool needmv2; - ae_bool needvmv; - ae_bool needprec; - ae_int_t repiterationscount; - ae_int_t repnmv; - ae_int_t repterminationtype; - ae_bool running; - ae_vector tmpd; - ae_vector tmpx; - rcommstate rstate; -} linlsqrstate; -typedef struct -{ - ae_int_t iterationscount; - ae_int_t nmv; - ae_int_t terminationtype; -} linlsqrreport; -typedef struct -{ - ae_vector rx; - ae_vector b; - ae_int_t n; - ae_int_t prectype; - ae_vector cx; - ae_vector cr; - ae_vector cz; - ae_vector p; - ae_vector r; - ae_vector z; - double alpha; - double beta; - double r2; - double meritfunction; - ae_vector x; - ae_vector mv; - ae_vector pv; - double vmv; - ae_vector startx; - double epsf; - ae_int_t maxits; - ae_int_t itsbeforerestart; - ae_int_t itsbeforerupdate; - ae_bool xrep; - ae_bool xupdated; - ae_bool needmv; - ae_bool needmtv; - ae_bool needmv2; - ae_bool needvmv; - ae_bool needprec; - ae_int_t repiterationscount; - ae_int_t repnmv; - ae_int_t repterminationtype; - ae_bool running; - ae_vector tmpd; - rcommstate rstate; -} lincgstate; -typedef struct -{ - ae_int_t iterationscount; - ae_int_t nmv; - ae_int_t terminationtype; - double r2; -} lincgreport; -typedef struct -{ - ae_int_t n; - ae_int_t m; - double epsf; - ae_int_t maxits; - ae_bool xrep; - double stpmax; - ae_vector x; - double f; - ae_vector fi; - ae_matrix j; - ae_bool needf; - ae_bool needfij; - ae_bool xupdated; - rcommstate rstate; - ae_int_t repiterationscount; - ae_int_t repnfunc; - ae_int_t repnjac; - ae_int_t repterminationtype; - ae_vector xbase; - double fbase; - double fprev; - ae_vector candstep; - ae_vector rightpart; - ae_vector cgbuf; -} nleqstate; -typedef struct -{ - ae_int_t iterationscount; - ae_int_t nfunc; - ae_int_t njac; - ae_int_t terminationtype; -} nleqreport; - -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS C++ INTERFACE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib -{ - -/************************************************************************* - -*************************************************************************/ -class _densesolverreport_owner -{ -public: - _densesolverreport_owner(); - _densesolverreport_owner(const _densesolverreport_owner &rhs); - _densesolverreport_owner& operator=(const _densesolverreport_owner &rhs); - virtual ~_densesolverreport_owner(); - alglib_impl::densesolverreport* c_ptr(); - alglib_impl::densesolverreport* c_ptr() const; -protected: - alglib_impl::densesolverreport *p_struct; -}; -class densesolverreport : public _densesolverreport_owner -{ -public: - densesolverreport(); - densesolverreport(const densesolverreport &rhs); - densesolverreport& operator=(const densesolverreport &rhs); - virtual ~densesolverreport(); - double &r1; - double &rinf; - -}; - - -/************************************************************************* - -*************************************************************************/ -class _densesolverlsreport_owner -{ -public: - _densesolverlsreport_owner(); - _densesolverlsreport_owner(const _densesolverlsreport_owner &rhs); - _densesolverlsreport_owner& operator=(const _densesolverlsreport_owner &rhs); - virtual ~_densesolverlsreport_owner(); - alglib_impl::densesolverlsreport* c_ptr(); - alglib_impl::densesolverlsreport* c_ptr() const; -protected: - alglib_impl::densesolverlsreport *p_struct; -}; -class densesolverlsreport : public _densesolverlsreport_owner -{ -public: - densesolverlsreport(); - densesolverlsreport(const densesolverlsreport &rhs); - densesolverlsreport& operator=(const densesolverlsreport &rhs); - virtual ~densesolverlsreport(); - double &r2; - real_2d_array cx; - ae_int_t &n; - ae_int_t &k; - -}; - -/************************************************************************* -This object stores state of the LinLSQR method. - -You should use ALGLIB functions to work with this object. -*************************************************************************/ -class _linlsqrstate_owner -{ -public: - _linlsqrstate_owner(); - _linlsqrstate_owner(const _linlsqrstate_owner &rhs); - _linlsqrstate_owner& operator=(const _linlsqrstate_owner &rhs); - virtual ~_linlsqrstate_owner(); - alglib_impl::linlsqrstate* c_ptr(); - alglib_impl::linlsqrstate* c_ptr() const; -protected: - alglib_impl::linlsqrstate *p_struct; -}; -class linlsqrstate : public _linlsqrstate_owner -{ -public: - linlsqrstate(); - linlsqrstate(const linlsqrstate &rhs); - linlsqrstate& operator=(const linlsqrstate &rhs); - virtual ~linlsqrstate(); - -}; - - -/************************************************************************* - -*************************************************************************/ -class _linlsqrreport_owner -{ -public: - _linlsqrreport_owner(); - _linlsqrreport_owner(const _linlsqrreport_owner &rhs); - _linlsqrreport_owner& operator=(const _linlsqrreport_owner &rhs); - virtual ~_linlsqrreport_owner(); - alglib_impl::linlsqrreport* c_ptr(); - alglib_impl::linlsqrreport* c_ptr() const; -protected: - alglib_impl::linlsqrreport *p_struct; -}; -class linlsqrreport : public _linlsqrreport_owner -{ -public: - linlsqrreport(); - linlsqrreport(const linlsqrreport &rhs); - linlsqrreport& operator=(const linlsqrreport &rhs); - virtual ~linlsqrreport(); - ae_int_t &iterationscount; - ae_int_t &nmv; - ae_int_t &terminationtype; - -}; - -/************************************************************************* -This object stores state of the linear CG method. - -You should use ALGLIB functions to work with this object. -Never try to access its fields directly! -*************************************************************************/ -class _lincgstate_owner -{ -public: - _lincgstate_owner(); - _lincgstate_owner(const _lincgstate_owner &rhs); - _lincgstate_owner& operator=(const _lincgstate_owner &rhs); - virtual ~_lincgstate_owner(); - alglib_impl::lincgstate* c_ptr(); - alglib_impl::lincgstate* c_ptr() const; -protected: - alglib_impl::lincgstate *p_struct; -}; -class lincgstate : public _lincgstate_owner -{ -public: - lincgstate(); - lincgstate(const lincgstate &rhs); - lincgstate& operator=(const lincgstate &rhs); - virtual ~lincgstate(); - -}; - - -/************************************************************************* - -*************************************************************************/ -class _lincgreport_owner -{ -public: - _lincgreport_owner(); - _lincgreport_owner(const _lincgreport_owner &rhs); - _lincgreport_owner& operator=(const _lincgreport_owner &rhs); - virtual ~_lincgreport_owner(); - alglib_impl::lincgreport* c_ptr(); - alglib_impl::lincgreport* c_ptr() const; -protected: - alglib_impl::lincgreport *p_struct; -}; -class lincgreport : public _lincgreport_owner -{ -public: - lincgreport(); - lincgreport(const lincgreport &rhs); - lincgreport& operator=(const lincgreport &rhs); - virtual ~lincgreport(); - ae_int_t &iterationscount; - ae_int_t &nmv; - ae_int_t &terminationtype; - double &r2; - -}; - -/************************************************************************* - -*************************************************************************/ -class _nleqstate_owner -{ -public: - _nleqstate_owner(); - _nleqstate_owner(const _nleqstate_owner &rhs); - _nleqstate_owner& operator=(const _nleqstate_owner &rhs); - virtual ~_nleqstate_owner(); - alglib_impl::nleqstate* c_ptr(); - alglib_impl::nleqstate* c_ptr() const; -protected: - alglib_impl::nleqstate *p_struct; -}; -class nleqstate : public _nleqstate_owner -{ -public: - nleqstate(); - nleqstate(const nleqstate &rhs); - nleqstate& operator=(const nleqstate &rhs); - virtual ~nleqstate(); - ae_bool &needf; - ae_bool &needfij; - ae_bool &xupdated; - double &f; - real_1d_array fi; - real_2d_array j; - real_1d_array x; - -}; - - -/************************************************************************* - -*************************************************************************/ -class _nleqreport_owner -{ -public: - _nleqreport_owner(); - _nleqreport_owner(const _nleqreport_owner &rhs); - _nleqreport_owner& operator=(const _nleqreport_owner &rhs); - virtual ~_nleqreport_owner(); - alglib_impl::nleqreport* c_ptr(); - alglib_impl::nleqreport* c_ptr() const; -protected: - alglib_impl::nleqreport *p_struct; -}; -class nleqreport : public _nleqreport_owner -{ -public: - nleqreport(); - nleqreport(const nleqreport &rhs); - nleqreport& operator=(const nleqreport &rhs); - virtual ~nleqreport(); - ae_int_t &iterationscount; - ae_int_t &nfunc; - ae_int_t &njac; - ae_int_t &terminationtype; - -}; - -/************************************************************************* -Dense solver. - -This subroutine solves a system A*x=b, where A is NxN non-denegerate -real matrix, x and b are vectors. - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* iterative refinement -* O(N^3) complexity - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - N - size of A - B - array[0..N-1], right part - -OUTPUT PARAMETERS - Info - return code: - * -3 A is singular, or VERY close to singular. - X is filled by zeros in such cases. - * -1 N<=0 was passed - * 1 task is solved (but matrix A may be ill-conditioned, - check R1/RInf parameters for condition numbers). - Rep - solver report, see below for more info - X - array[0..N-1], it contains: - * solution of A*x=b if A is non-singular (well-conditioned - or ill-conditioned, but not very close to singular) - * zeros, if A is singular or VERY close to singular - (in this case Info=-3). - -SOLVER REPORT - -Subroutine sets following fields of the Rep structure: -* R1 reciprocal of condition number: 1/cond(A), 1-norm. -* RInf reciprocal of condition number: 1/cond(A), inf-norm. - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void rmatrixsolve(const real_2d_array &a, const ae_int_t n, const real_1d_array &b, ae_int_t &info, densesolverreport &rep, real_1d_array &x); - - -/************************************************************************* -Dense solver. - -Similar to RMatrixSolve() but solves task with multiple right parts (where -b and x are NxM matrices). - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* optional iterative refinement -* O(N^3+M*N^2) complexity - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - N - size of A - B - array[0..N-1,0..M-1], right part - M - right part size - RFS - iterative refinement switch: - * True - refinement is used. - Less performance, more precision. - * False - refinement is not used. - More performance, less precision. - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void rmatrixsolvem(const real_2d_array &a, const ae_int_t n, const real_2d_array &b, const ae_int_t m, const bool rfs, ae_int_t &info, densesolverreport &rep, real_2d_array &x); - - -/************************************************************************* -Dense solver. - -This subroutine solves a system A*X=B, where A is NxN non-denegerate -real matrix given by its LU decomposition, X and B are NxM real matrices. - -Algorithm features: -* automatic detection of degenerate cases -* O(N^2) complexity -* condition number estimation - -No iterative refinement is provided because exact form of original matrix -is not known to subroutine. Use RMatrixSolve or RMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - LUA - array[0..N-1,0..N-1], LU decomposition, RMatrixLU result - P - array[0..N-1], pivots array, RMatrixLU result - N - size of A - B - array[0..N-1], right part - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void rmatrixlusolve(const real_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const real_1d_array &b, ae_int_t &info, densesolverreport &rep, real_1d_array &x); - - -/************************************************************************* -Dense solver. - -Similar to RMatrixLUSolve() but solves task with multiple right parts -(where b and x are NxM matrices). - -Algorithm features: -* automatic detection of degenerate cases -* O(M*N^2) complexity -* condition number estimation - -No iterative refinement is provided because exact form of original matrix -is not known to subroutine. Use RMatrixSolve or RMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - LUA - array[0..N-1,0..N-1], LU decomposition, RMatrixLU result - P - array[0..N-1], pivots array, RMatrixLU result - N - size of A - B - array[0..N-1,0..M-1], right part - M - right part size - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void rmatrixlusolvem(const real_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const real_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, real_2d_array &x); - - -/************************************************************************* -Dense solver. - -This subroutine solves a system A*x=b, where BOTH ORIGINAL A AND ITS -LU DECOMPOSITION ARE KNOWN. You can use it if for some reasons you have -both A and its LU decomposition. - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* iterative refinement -* O(N^2) complexity - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - LUA - array[0..N-1,0..N-1], LU decomposition, RMatrixLU result - P - array[0..N-1], pivots array, RMatrixLU result - N - size of A - B - array[0..N-1], right part - -OUTPUT PARAMETERS - Info - same as in RMatrixSolveM - Rep - same as in RMatrixSolveM - X - same as in RMatrixSolveM - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void rmatrixmixedsolve(const real_2d_array &a, const real_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const real_1d_array &b, ae_int_t &info, densesolverreport &rep, real_1d_array &x); - - -/************************************************************************* -Dense solver. - -Similar to RMatrixMixedSolve() but solves task with multiple right parts -(where b and x are NxM matrices). - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* iterative refinement -* O(M*N^2) complexity - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - LUA - array[0..N-1,0..N-1], LU decomposition, RMatrixLU result - P - array[0..N-1], pivots array, RMatrixLU result - N - size of A - B - array[0..N-1,0..M-1], right part - M - right part size - -OUTPUT PARAMETERS - Info - same as in RMatrixSolveM - Rep - same as in RMatrixSolveM - X - same as in RMatrixSolveM - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void rmatrixmixedsolvem(const real_2d_array &a, const real_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const real_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, real_2d_array &x); - - -/************************************************************************* -Dense solver. Same as RMatrixSolveM(), but for complex matrices. - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* iterative refinement -* O(N^3+M*N^2) complexity - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - N - size of A - B - array[0..N-1,0..M-1], right part - M - right part size - RFS - iterative refinement switch: - * True - refinement is used. - Less performance, more precision. - * False - refinement is not used. - More performance, less precision. - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void cmatrixsolvem(const complex_2d_array &a, const ae_int_t n, const complex_2d_array &b, const ae_int_t m, const bool rfs, ae_int_t &info, densesolverreport &rep, complex_2d_array &x); - - -/************************************************************************* -Dense solver. Same as RMatrixSolve(), but for complex matrices. - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* iterative refinement -* O(N^3) complexity - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - N - size of A - B - array[0..N-1], right part - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void cmatrixsolve(const complex_2d_array &a, const ae_int_t n, const complex_1d_array &b, ae_int_t &info, densesolverreport &rep, complex_1d_array &x); - - -/************************************************************************* -Dense solver. Same as RMatrixLUSolveM(), but for complex matrices. - -Algorithm features: -* automatic detection of degenerate cases -* O(M*N^2) complexity -* condition number estimation - -No iterative refinement is provided because exact form of original matrix -is not known to subroutine. Use CMatrixSolve or CMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - LUA - array[0..N-1,0..N-1], LU decomposition, RMatrixLU result - P - array[0..N-1], pivots array, RMatrixLU result - N - size of A - B - array[0..N-1,0..M-1], right part - M - right part size - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void cmatrixlusolvem(const complex_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const complex_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, complex_2d_array &x); - - -/************************************************************************* -Dense solver. Same as RMatrixLUSolve(), but for complex matrices. - -Algorithm features: -* automatic detection of degenerate cases -* O(N^2) complexity -* condition number estimation - -No iterative refinement is provided because exact form of original matrix -is not known to subroutine. Use CMatrixSolve or CMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - LUA - array[0..N-1,0..N-1], LU decomposition, CMatrixLU result - P - array[0..N-1], pivots array, CMatrixLU result - N - size of A - B - array[0..N-1], right part - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void cmatrixlusolve(const complex_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const complex_1d_array &b, ae_int_t &info, densesolverreport &rep, complex_1d_array &x); - - -/************************************************************************* -Dense solver. Same as RMatrixMixedSolveM(), but for complex matrices. - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* iterative refinement -* O(M*N^2) complexity - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - LUA - array[0..N-1,0..N-1], LU decomposition, CMatrixLU result - P - array[0..N-1], pivots array, CMatrixLU result - N - size of A - B - array[0..N-1,0..M-1], right part - M - right part size - -OUTPUT PARAMETERS - Info - same as in RMatrixSolveM - Rep - same as in RMatrixSolveM - X - same as in RMatrixSolveM - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void cmatrixmixedsolvem(const complex_2d_array &a, const complex_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const complex_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, complex_2d_array &x); - - -/************************************************************************* -Dense solver. Same as RMatrixMixedSolve(), but for complex matrices. - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* iterative refinement -* O(N^2) complexity - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - LUA - array[0..N-1,0..N-1], LU decomposition, CMatrixLU result - P - array[0..N-1], pivots array, CMatrixLU result - N - size of A - B - array[0..N-1], right part - -OUTPUT PARAMETERS - Info - same as in RMatrixSolveM - Rep - same as in RMatrixSolveM - X - same as in RMatrixSolveM - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void cmatrixmixedsolve(const complex_2d_array &a, const complex_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const complex_1d_array &b, ae_int_t &info, densesolverreport &rep, complex_1d_array &x); - - -/************************************************************************* -Dense solver. Same as RMatrixSolveM(), but for symmetric positive definite -matrices. - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* O(N^3+M*N^2) complexity -* matrix is represented by its upper or lower triangle - -No iterative refinement is provided because such partial representation of -matrix does not allow efficient calculation of extra-precise matrix-vector -products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - N - size of A - IsUpper - what half of A is provided - B - array[0..N-1,0..M-1], right part - M - right part size - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve. - Returns -3 for non-SPD matrices. - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void spdmatrixsolvem(const real_2d_array &a, const ae_int_t n, const bool isupper, const real_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, real_2d_array &x); - - -/************************************************************************* -Dense solver. Same as RMatrixSolve(), but for SPD matrices. - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* O(N^3) complexity -* matrix is represented by its upper or lower triangle - -No iterative refinement is provided because such partial representation of -matrix does not allow efficient calculation of extra-precise matrix-vector -products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - N - size of A - IsUpper - what half of A is provided - B - array[0..N-1], right part - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Returns -3 for non-SPD matrices. - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void spdmatrixsolve(const real_2d_array &a, const ae_int_t n, const bool isupper, const real_1d_array &b, ae_int_t &info, densesolverreport &rep, real_1d_array &x); - - -/************************************************************************* -Dense solver. Same as RMatrixLUSolveM(), but for SPD matrices represented -by their Cholesky decomposition. - -Algorithm features: -* automatic detection of degenerate cases -* O(M*N^2) complexity -* condition number estimation -* matrix is represented by its upper or lower triangle - -No iterative refinement is provided because such partial representation of -matrix does not allow efficient calculation of extra-precise matrix-vector -products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - CHA - array[0..N-1,0..N-1], Cholesky decomposition, - SPDMatrixCholesky result - N - size of CHA - IsUpper - what half of CHA is provided - B - array[0..N-1,0..M-1], right part - M - right part size - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void spdmatrixcholeskysolvem(const real_2d_array &cha, const ae_int_t n, const bool isupper, const real_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, real_2d_array &x); - - -/************************************************************************* -Dense solver. Same as RMatrixLUSolve(), but for SPD matrices represented -by their Cholesky decomposition. - -Algorithm features: -* automatic detection of degenerate cases -* O(N^2) complexity -* condition number estimation -* matrix is represented by its upper or lower triangle - -No iterative refinement is provided because such partial representation of -matrix does not allow efficient calculation of extra-precise matrix-vector -products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - CHA - array[0..N-1,0..N-1], Cholesky decomposition, - SPDMatrixCholesky result - N - size of A - IsUpper - what half of CHA is provided - B - array[0..N-1], right part - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void spdmatrixcholeskysolve(const real_2d_array &cha, const ae_int_t n, const bool isupper, const real_1d_array &b, ae_int_t &info, densesolverreport &rep, real_1d_array &x); - - -/************************************************************************* -Dense solver. Same as RMatrixSolveM(), but for Hermitian positive definite -matrices. - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* O(N^3+M*N^2) complexity -* matrix is represented by its upper or lower triangle - -No iterative refinement is provided because such partial representation of -matrix does not allow efficient calculation of extra-precise matrix-vector -products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - N - size of A - IsUpper - what half of A is provided - B - array[0..N-1,0..M-1], right part - M - right part size - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve. - Returns -3 for non-HPD matrices. - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void hpdmatrixsolvem(const complex_2d_array &a, const ae_int_t n, const bool isupper, const complex_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, complex_2d_array &x); - - -/************************************************************************* -Dense solver. Same as RMatrixSolve(), but for Hermitian positive definite -matrices. - -Algorithm features: -* automatic detection of degenerate cases -* condition number estimation -* O(N^3) complexity -* matrix is represented by its upper or lower triangle - -No iterative refinement is provided because such partial representation of -matrix does not allow efficient calculation of extra-precise matrix-vector -products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - A - array[0..N-1,0..N-1], system matrix - N - size of A - IsUpper - what half of A is provided - B - array[0..N-1], right part - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Returns -3 for non-HPD matrices. - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void hpdmatrixsolve(const complex_2d_array &a, const ae_int_t n, const bool isupper, const complex_1d_array &b, ae_int_t &info, densesolverreport &rep, complex_1d_array &x); - - -/************************************************************************* -Dense solver. Same as RMatrixLUSolveM(), but for HPD matrices represented -by their Cholesky decomposition. - -Algorithm features: -* automatic detection of degenerate cases -* O(M*N^2) complexity -* condition number estimation -* matrix is represented by its upper or lower triangle - -No iterative refinement is provided because such partial representation of -matrix does not allow efficient calculation of extra-precise matrix-vector -products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - CHA - array[0..N-1,0..N-1], Cholesky decomposition, - HPDMatrixCholesky result - N - size of CHA - IsUpper - what half of CHA is provided - B - array[0..N-1,0..M-1], right part - M - right part size - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void hpdmatrixcholeskysolvem(const complex_2d_array &cha, const ae_int_t n, const bool isupper, const complex_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, complex_2d_array &x); - - -/************************************************************************* -Dense solver. Same as RMatrixLUSolve(), but for HPD matrices represented -by their Cholesky decomposition. - -Algorithm features: -* automatic detection of degenerate cases -* O(N^2) complexity -* condition number estimation -* matrix is represented by its upper or lower triangle - -No iterative refinement is provided because such partial representation of -matrix does not allow efficient calculation of extra-precise matrix-vector -products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you -need iterative refinement. - -INPUT PARAMETERS - CHA - array[0..N-1,0..N-1], Cholesky decomposition, - SPDMatrixCholesky result - N - size of A - IsUpper - what half of CHA is provided - B - array[0..N-1], right part - -OUTPUT PARAMETERS - Info - same as in RMatrixSolve - Rep - same as in RMatrixSolve - X - same as in RMatrixSolve - - -- ALGLIB -- - Copyright 27.01.2010 by Bochkanov Sergey -*************************************************************************/ -void hpdmatrixcholeskysolve(const complex_2d_array &cha, const ae_int_t n, const bool isupper, const complex_1d_array &b, ae_int_t &info, densesolverreport &rep, complex_1d_array &x); - - -/************************************************************************* -Dense solver. - -This subroutine finds solution of the linear system A*X=B with non-square, -possibly degenerate A. System is solved in the least squares sense, and -general least squares solution X = X0 + CX*y which minimizes |A*X-B| is -returned. If A is non-degenerate, solution in the usual sense is returned. - -Algorithm features: -* automatic detection (and correct handling!) of degenerate cases -* iterative refinement -* O(N^3) complexity - -INPUT PARAMETERS - A - array[0..NRows-1,0..NCols-1], system matrix - NRows - vertical size of A - NCols - horizontal size of A - B - array[0..NCols-1], right part - Threshold- a number in [0,1]. Singular values beyond Threshold are - considered zero. Set it to 0.0, if you don't understand - what it means, so the solver will choose good value on its - own. - -OUTPUT PARAMETERS - Info - return code: - * -4 SVD subroutine failed - * -1 if NRows<=0 or NCols<=0 or Threshold<0 was passed - * 1 if task is solved - Rep - solver report, see below for more info - X - array[0..N-1,0..M-1], it contains: - * solution of A*X=B (even for singular A) - * zeros, if SVD subroutine failed - -SOLVER REPORT - -Subroutine sets following fields of the Rep structure: -* R2 reciprocal of condition number: 1/cond(A), 2-norm. -* N = NCols -* K dim(Null(A)) -* CX array[0..N-1,0..K-1], kernel of A. - Columns of CX store such vectors that A*CX[i]=0. - - -- ALGLIB -- - Copyright 24.08.2009 by Bochkanov Sergey -*************************************************************************/ -void rmatrixsolvels(const real_2d_array &a, const ae_int_t nrows, const ae_int_t ncols, const real_1d_array &b, const double threshold, ae_int_t &info, densesolverlsreport &rep, real_1d_array &x); - -/************************************************************************* -This function initializes linear LSQR Solver. This solver is used to solve -non-symmetric (and, possibly, non-square) problems. Least squares solution -is returned for non-compatible systems. - -USAGE: -1. User initializes algorithm state with LinLSQRCreate() call -2. User tunes solver parameters with LinLSQRSetCond() and other functions -3. User calls LinLSQRSolveSparse() function which takes algorithm state - and SparseMatrix object. -4. User calls LinLSQRResults() to get solution -5. Optionally, user may call LinLSQRSolveSparse() again to solve another - problem with different matrix and/or right part without reinitializing - LinLSQRState structure. - -INPUT PARAMETERS: - M - number of rows in A - N - number of variables, N>0 - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 30.11.2011 by Bochkanov Sergey -*************************************************************************/ -void linlsqrcreate(const ae_int_t m, const ae_int_t n, linlsqrstate &state); - - -/************************************************************************* -This function changes preconditioning settings of LinLSQQSolveSparse() -function. By default, SolveSparse() uses diagonal preconditioner, but if -you want to use solver without preconditioning, you can call this function -which forces solver to use unit matrix for preconditioning. - -INPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 19.11.2012 by Bochkanov Sergey -*************************************************************************/ -void linlsqrsetprecunit(const linlsqrstate &state); - - -/************************************************************************* -This function changes preconditioning settings of LinCGSolveSparse() -function. LinCGSolveSparse() will use diagonal of the system matrix as -preconditioner. This preconditioning mode is active by default. - -INPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 19.11.2012 by Bochkanov Sergey -*************************************************************************/ -void linlsqrsetprecdiag(const linlsqrstate &state); - - -/************************************************************************* -This function sets optional Tikhonov regularization coefficient. -It is zero by default. - -INPUT PARAMETERS: - LambdaI - regularization factor, LambdaI>=0 - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 30.11.2011 by Bochkanov Sergey -*************************************************************************/ -void linlsqrsetlambdai(const linlsqrstate &state, const double lambdai); - - -/************************************************************************* -Procedure for solution of A*x=b with sparse A. - -INPUT PARAMETERS: - State - algorithm state - A - sparse M*N matrix in the CRS format (you MUST contvert it - to CRS format by calling SparseConvertToCRS() function - BEFORE you pass it to this function). - B - right part, array[M] - -RESULT: - This function returns no result. - You can get solution by calling LinCGResults() - -NOTE: this function uses lightweight preconditioning - multiplication by - inverse of diag(A). If you want, you can turn preconditioning off by - calling LinLSQRSetPrecUnit(). However, preconditioning cost is low - and preconditioner is very important for solution of badly scaled - problems. - - -- ALGLIB -- - Copyright 30.11.2011 by Bochkanov Sergey -*************************************************************************/ -void linlsqrsolvesparse(const linlsqrstate &state, const sparsematrix &a, const real_1d_array &b); - - -/************************************************************************* -This function sets stopping criteria. - -INPUT PARAMETERS: - EpsA - algorithm will be stopped if ||A^T*Rk||/(||A||*||Rk||)<=EpsA. - EpsB - algorithm will be stopped if ||Rk||<=EpsB*||B|| - MaxIts - algorithm will be stopped if number of iterations - more than MaxIts. - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -NOTE: if EpsA,EpsB,EpsC and MaxIts are zero then these variables will -be setted as default values. - - -- ALGLIB -- - Copyright 30.11.2011 by Bochkanov Sergey -*************************************************************************/ -void linlsqrsetcond(const linlsqrstate &state, const double epsa, const double epsb, const ae_int_t maxits); - - -/************************************************************************* -LSQR solver: results. - -This function must be called after LinLSQRSolve - -INPUT PARAMETERS: - State - algorithm state - -OUTPUT PARAMETERS: - X - array[N], solution - Rep - optimization report: - * Rep.TerminationType completion code: - * 1 ||Rk||<=EpsB*||B|| - * 4 ||A^T*Rk||/(||A||*||Rk||)<=EpsA - * 5 MaxIts steps was taken - * 7 rounding errors prevent further progress, - X contains best point found so far. - (sometimes returned on singular systems) - * Rep.IterationsCount contains iterations count - * NMV contains number of matrix-vector calculations - - -- ALGLIB -- - Copyright 30.11.2011 by Bochkanov Sergey -*************************************************************************/ -void linlsqrresults(const linlsqrstate &state, real_1d_array &x, linlsqrreport &rep); - - -/************************************************************************* -This function turns on/off reporting. - -INPUT PARAMETERS: - State - structure which stores algorithm state - NeedXRep- whether iteration reports are needed or not - -If NeedXRep is True, algorithm will call rep() callback function if it is -provided to MinCGOptimize(). - - -- ALGLIB -- - Copyright 30.11.2011 by Bochkanov Sergey -*************************************************************************/ -void linlsqrsetxrep(const linlsqrstate &state, const bool needxrep); - -/************************************************************************* -This function initializes linear CG Solver. This solver is used to solve -symmetric positive definite problems. If you want to solve nonsymmetric -(or non-positive definite) problem you may use LinLSQR solver provided by -ALGLIB. - -USAGE: -1. User initializes algorithm state with LinCGCreate() call -2. User tunes solver parameters with LinCGSetCond() and other functions -3. Optionally, user sets starting point with LinCGSetStartingPoint() -4. User calls LinCGSolveSparse() function which takes algorithm state and - SparseMatrix object. -5. User calls LinCGResults() to get solution -6. Optionally, user may call LinCGSolveSparse() again to solve another - problem with different matrix and/or right part without reinitializing - LinCGState structure. - -INPUT PARAMETERS: - N - problem dimension, N>0 - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 14.11.2011 by Bochkanov Sergey -*************************************************************************/ -void lincgcreate(const ae_int_t n, lincgstate &state); - - -/************************************************************************* -This function sets starting point. -By default, zero starting point is used. - -INPUT PARAMETERS: - X - starting point, array[N] - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 14.11.2011 by Bochkanov Sergey -*************************************************************************/ -void lincgsetstartingpoint(const lincgstate &state, const real_1d_array &x); - - -/************************************************************************* -This function changes preconditioning settings of LinCGSolveSparse() -function. By default, SolveSparse() uses diagonal preconditioner, but if -you want to use solver without preconditioning, you can call this function -which forces solver to use unit matrix for preconditioning. - -INPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 19.11.2012 by Bochkanov Sergey -*************************************************************************/ -void lincgsetprecunit(const lincgstate &state); - - -/************************************************************************* -This function changes preconditioning settings of LinCGSolveSparse() -function. LinCGSolveSparse() will use diagonal of the system matrix as -preconditioner. This preconditioning mode is active by default. - -INPUT PARAMETERS: - State - structure which stores algorithm state - - -- ALGLIB -- - Copyright 19.11.2012 by Bochkanov Sergey -*************************************************************************/ -void lincgsetprecdiag(const lincgstate &state); - - -/************************************************************************* -This function sets stopping criteria. - -INPUT PARAMETERS: - EpsF - algorithm will be stopped if norm of residual is less than - EpsF*||b||. - MaxIts - algorithm will be stopped if number of iterations is more - than MaxIts. - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - -NOTES: -If both EpsF and MaxIts are zero then small EpsF will be set to small -value. - - -- ALGLIB -- - Copyright 14.11.2011 by Bochkanov Sergey -*************************************************************************/ -void lincgsetcond(const lincgstate &state, const double epsf, const ae_int_t maxits); - - -/************************************************************************* -Procedure for solution of A*x=b with sparse A. - -INPUT PARAMETERS: - State - algorithm state - A - sparse matrix in the CRS format (you MUST contvert it to - CRS format by calling SparseConvertToCRS() function). - IsUpper - whether upper or lower triangle of A is used: - * IsUpper=True => only upper triangle is used and lower - triangle is not referenced at all - * IsUpper=False => only lower triangle is used and upper - triangle is not referenced at all - B - right part, array[N] - -RESULT: - This function returns no result. - You can get solution by calling LinCGResults() - -NOTE: this function uses lightweight preconditioning - multiplication by - inverse of diag(A). If you want, you can turn preconditioning off by - calling LinCGSetPrecUnit(). However, preconditioning cost is low and - preconditioner is very important for solution of badly scaled - problems. - - -- ALGLIB -- - Copyright 14.11.2011 by Bochkanov Sergey -*************************************************************************/ -void lincgsolvesparse(const lincgstate &state, const sparsematrix &a, const bool isupper, const real_1d_array &b); - - -/************************************************************************* -CG-solver: results. - -This function must be called after LinCGSolve - -INPUT PARAMETERS: - State - algorithm state - -OUTPUT PARAMETERS: - X - array[N], solution - Rep - optimization report: - * Rep.TerminationType completion code: - * -5 input matrix is either not positive definite, - too large or too small - * -4 overflow/underflow during solution - (ill conditioned problem) - * 1 ||residual||<=EpsF*||b|| - * 5 MaxIts steps was taken - * 7 rounding errors prevent further progress, - best point found is returned - * Rep.IterationsCount contains iterations count - * NMV contains number of matrix-vector calculations - - -- ALGLIB -- - Copyright 14.11.2011 by Bochkanov Sergey -*************************************************************************/ -void lincgresults(const lincgstate &state, real_1d_array &x, lincgreport &rep); - - -/************************************************************************* -This function sets restart frequency. By default, algorithm is restarted -after N subsequent iterations. - - -- ALGLIB -- - Copyright 14.11.2011 by Bochkanov Sergey -*************************************************************************/ -void lincgsetrestartfreq(const lincgstate &state, const ae_int_t srf); - - -/************************************************************************* -This function sets frequency of residual recalculations. - -Algorithm updates residual r_k using iterative formula, but recalculates -it from scratch after each 10 iterations. It is done to avoid accumulation -of numerical errors and to stop algorithm when r_k starts to grow. - -Such low update frequence (1/10) gives very little overhead, but makes -algorithm a bit more robust against numerical errors. However, you may -change it - -INPUT PARAMETERS: - Freq - desired update frequency, Freq>=0. - Zero value means that no updates will be done. - - -- ALGLIB -- - Copyright 14.11.2011 by Bochkanov Sergey -*************************************************************************/ -void lincgsetrupdatefreq(const lincgstate &state, const ae_int_t freq); - - -/************************************************************************* -This function turns on/off reporting. - -INPUT PARAMETERS: - State - structure which stores algorithm state - NeedXRep- whether iteration reports are needed or not - -If NeedXRep is True, algorithm will call rep() callback function if it is -provided to MinCGOptimize(). - - -- ALGLIB -- - Copyright 14.11.2011 by Bochkanov Sergey -*************************************************************************/ -void lincgsetxrep(const lincgstate &state, const bool needxrep); - -/************************************************************************* - LEVENBERG-MARQUARDT-LIKE NONLINEAR SOLVER - -DESCRIPTION: -This algorithm solves system of nonlinear equations - F[0](x[0], ..., x[n-1]) = 0 - F[1](x[0], ..., x[n-1]) = 0 - ... - F[M-1](x[0], ..., x[n-1]) = 0 -with M/N do not necessarily coincide. Algorithm converges quadratically -under following conditions: - * the solution set XS is nonempty - * for some xs in XS there exist such neighbourhood N(xs) that: - * vector function F(x) and its Jacobian J(x) are continuously - differentiable on N - * ||F(x)|| provides local error bound on N, i.e. there exists such - c1, that ||F(x)||>c1*distance(x,XS) -Note that these conditions are much more weaker than usual non-singularity -conditions. For example, algorithm will converge for any affine function -F (whether its Jacobian singular or not). - - -REQUIREMENTS: -Algorithm will request following information during its operation: -* function vector F[] and Jacobian matrix at given point X -* value of merit function f(x)=F[0]^2(x)+...+F[M-1]^2(x) at given point X - - -USAGE: -1. User initializes algorithm state with NLEQCreateLM() call -2. User tunes solver parameters with NLEQSetCond(), NLEQSetStpMax() and - other functions -3. User calls NLEQSolve() function which takes algorithm state and - pointers (delegates, etc.) to callback functions which calculate merit - function value and Jacobian. -4. User calls NLEQResults() to get solution -5. Optionally, user may call NLEQRestartFrom() to solve another problem - with same parameters (N/M) but another starting point and/or another - function vector. NLEQRestartFrom() allows to reuse already initialized - structure. - - -INPUT PARAMETERS: - N - space dimension, N>1: - * if provided, only leading N elements of X are used - * if not provided, determined automatically from size of X - M - system size - X - starting point - - -OUTPUT PARAMETERS: - State - structure which stores algorithm state - - -NOTES: -1. you may tune stopping conditions with NLEQSetCond() function -2. if target function contains exp() or other fast growing functions, and - optimization algorithm makes too large steps which leads to overflow, - use NLEQSetStpMax() function to bound algorithm's steps. -3. this algorithm is a slightly modified implementation of the method - described in 'Levenberg-Marquardt method for constrained nonlinear - equations with strong local convergence properties' by Christian Kanzow - Nobuo Yamashita and Masao Fukushima and further developed in 'On the - convergence of a New Levenberg-Marquardt Method' by Jin-yan Fan and - Ya-Xiang Yuan. - - - -- ALGLIB -- - Copyright 20.08.2009 by Bochkanov Sergey -*************************************************************************/ -void nleqcreatelm(const ae_int_t n, const ae_int_t m, const real_1d_array &x, nleqstate &state); -void nleqcreatelm(const ae_int_t m, const real_1d_array &x, nleqstate &state); - - -/************************************************************************* -This function sets stopping conditions for the nonlinear solver - -INPUT PARAMETERS: - State - structure which stores algorithm state - EpsF - >=0 - The subroutine finishes its work if on k+1-th iteration - the condition ||F||<=EpsF is satisfied - MaxIts - maximum number of iterations. If MaxIts=0, the number of - iterations is unlimited. - -Passing EpsF=0 and MaxIts=0 simultaneously will lead to automatic -stopping criterion selection (small EpsF). - -NOTES: - - -- ALGLIB -- - Copyright 20.08.2010 by Bochkanov Sergey -*************************************************************************/ -void nleqsetcond(const nleqstate &state, const double epsf, const ae_int_t maxits); - - -/************************************************************************* -This function turns on/off reporting. - -INPUT PARAMETERS: - State - structure which stores algorithm state - NeedXRep- whether iteration reports are needed or not - -If NeedXRep is True, algorithm will call rep() callback function if it is -provided to NLEQSolve(). - - -- ALGLIB -- - Copyright 20.08.2010 by Bochkanov Sergey -*************************************************************************/ -void nleqsetxrep(const nleqstate &state, const bool needxrep); - - -/************************************************************************* -This function sets maximum step length - -INPUT PARAMETERS: - State - structure which stores algorithm state - StpMax - maximum step length, >=0. Set StpMax to 0.0, if you don't - want to limit step length. - -Use this subroutine when target function contains exp() or other fast -growing functions, and algorithm makes too large steps which lead to -overflow. This function allows us to reject steps that are too large (and -therefore expose us to the possible overflow) without actually calculating -function value at the x+stp*d. - - -- ALGLIB -- - Copyright 20.08.2010 by Bochkanov Sergey -*************************************************************************/ -void nleqsetstpmax(const nleqstate &state, const double stpmax); - - -/************************************************************************* -This function provides reverse communication interface -Reverse communication interface is not documented or recommended to use. -See below for functions which provide better documented API -*************************************************************************/ -bool nleqiteration(const nleqstate &state); - - -/************************************************************************* -This family of functions is used to launcn iterations of nonlinear solver - -These functions accept following parameters: - state - algorithm state - func - callback which calculates function (or merit function) - value func at given point x - jac - callback which calculates function vector fi[] - and Jacobian jac at given point x - rep - optional callback which is called after each iteration - can be NULL - ptr - optional pointer which is passed to func/grad/hess/jac/rep - can be NULL - - - -- ALGLIB -- - Copyright 20.03.2009 by Bochkanov Sergey - -*************************************************************************/ -void nleqsolve(nleqstate &state, - void (*func)(const real_1d_array &x, double &func, void *ptr), - void (*jac)(const real_1d_array &x, real_1d_array &fi, real_2d_array &jac, void *ptr), - void (*rep)(const real_1d_array &x, double func, void *ptr) = NULL, - void *ptr = NULL); - - -/************************************************************************* -NLEQ solver results - -INPUT PARAMETERS: - State - algorithm state. - -OUTPUT PARAMETERS: - X - array[0..N-1], solution - Rep - optimization report: - * Rep.TerminationType completion code: - * -4 ERROR: algorithm has converged to the - stationary point Xf which is local minimum of - f=F[0]^2+...+F[m-1]^2, but is not solution of - nonlinear system. - * 1 sqrt(f)<=EpsF. - * 5 MaxIts steps was taken - * 7 stopping conditions are too stringent, - further improvement is impossible - * Rep.IterationsCount contains iterations count - * NFEV contains number of function calculations - * ActiveConstraints contains number of active constraints - - -- ALGLIB -- - Copyright 20.08.2009 by Bochkanov Sergey -*************************************************************************/ -void nleqresults(const nleqstate &state, real_1d_array &x, nleqreport &rep); - - -/************************************************************************* -NLEQ solver results - -Buffered implementation of NLEQResults(), which uses pre-allocated buffer -to store X[]. If buffer size is too small, it resizes buffer. It is -intended to be used in the inner cycles of performance critical algorithms -where array reallocation penalty is too large to be ignored. - - -- ALGLIB -- - Copyright 20.08.2009 by Bochkanov Sergey -*************************************************************************/ -void nleqresultsbuf(const nleqstate &state, real_1d_array &x, nleqreport &rep); - - -/************************************************************************* -This subroutine restarts CG algorithm from new point. All optimization -parameters are left unchanged. - -This function allows to solve multiple optimization problems (which -must have same number of dimensions) without object reallocation penalty. - -INPUT PARAMETERS: - State - structure used for reverse communication previously - allocated with MinCGCreate call. - X - new starting point. - BndL - new lower bounds - BndU - new upper bounds - - -- ALGLIB -- - Copyright 30.07.2010 by Bochkanov Sergey -*************************************************************************/ -void nleqrestartfrom(const nleqstate &state, const real_1d_array &x); -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (FUNCTIONS) -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ -void rmatrixsolve(/* Real */ ae_matrix* a, - ae_int_t n, - /* Real */ ae_vector* b, - ae_int_t* info, - densesolverreport* rep, - /* Real */ ae_vector* x, - ae_state *_state); -void rmatrixsolvem(/* Real */ ae_matrix* a, - ae_int_t n, - /* Real */ ae_matrix* b, - ae_int_t m, - ae_bool rfs, - ae_int_t* info, - densesolverreport* rep, - /* Real */ ae_matrix* x, - ae_state *_state); -void rmatrixlusolve(/* Real */ ae_matrix* lua, - /* Integer */ ae_vector* p, - ae_int_t n, - /* Real */ ae_vector* b, - ae_int_t* info, - densesolverreport* rep, - /* Real */ ae_vector* x, - ae_state *_state); -void rmatrixlusolvem(/* Real */ ae_matrix* lua, - /* Integer */ ae_vector* p, - ae_int_t n, - /* Real */ ae_matrix* b, - ae_int_t m, - ae_int_t* info, - densesolverreport* rep, - /* Real */ ae_matrix* x, - ae_state *_state); -void rmatrixmixedsolve(/* Real */ ae_matrix* a, - /* Real */ ae_matrix* lua, - /* Integer */ ae_vector* p, - ae_int_t n, - /* Real */ ae_vector* b, - ae_int_t* info, - densesolverreport* rep, - /* Real */ ae_vector* x, - ae_state *_state); -void rmatrixmixedsolvem(/* Real */ ae_matrix* a, - /* Real */ ae_matrix* lua, - /* Integer */ ae_vector* p, - ae_int_t n, - /* Real */ ae_matrix* b, - ae_int_t m, - ae_int_t* info, - densesolverreport* rep, - /* Real */ ae_matrix* x, - ae_state *_state); -void cmatrixsolvem(/* Complex */ ae_matrix* a, - ae_int_t n, - /* Complex */ ae_matrix* b, - ae_int_t m, - ae_bool rfs, - ae_int_t* info, - densesolverreport* rep, - /* Complex */ ae_matrix* x, - ae_state *_state); -void cmatrixsolve(/* Complex */ ae_matrix* a, - ae_int_t n, - /* Complex */ ae_vector* b, - ae_int_t* info, - densesolverreport* rep, - /* Complex */ ae_vector* x, - ae_state *_state); -void cmatrixlusolvem(/* Complex */ ae_matrix* lua, - /* Integer */ ae_vector* p, - ae_int_t n, - /* Complex */ ae_matrix* b, - ae_int_t m, - ae_int_t* info, - densesolverreport* rep, - /* Complex */ ae_matrix* x, - ae_state *_state); -void cmatrixlusolve(/* Complex */ ae_matrix* lua, - /* Integer */ ae_vector* p, - ae_int_t n, - /* Complex */ ae_vector* b, - ae_int_t* info, - densesolverreport* rep, - /* Complex */ ae_vector* x, - ae_state *_state); -void cmatrixmixedsolvem(/* Complex */ ae_matrix* a, - /* Complex */ ae_matrix* lua, - /* Integer */ ae_vector* p, - ae_int_t n, - /* Complex */ ae_matrix* b, - ae_int_t m, - ae_int_t* info, - densesolverreport* rep, - /* Complex */ ae_matrix* x, - ae_state *_state); -void cmatrixmixedsolve(/* Complex */ ae_matrix* a, - /* Complex */ ae_matrix* lua, - /* Integer */ ae_vector* p, - ae_int_t n, - /* Complex */ ae_vector* b, - ae_int_t* info, - densesolverreport* rep, - /* Complex */ ae_vector* x, - ae_state *_state); -void spdmatrixsolvem(/* Real */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - /* Real */ ae_matrix* b, - ae_int_t m, - ae_int_t* info, - densesolverreport* rep, - /* Real */ ae_matrix* x, - ae_state *_state); -void spdmatrixsolve(/* Real */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - /* Real */ ae_vector* b, - ae_int_t* info, - densesolverreport* rep, - /* Real */ ae_vector* x, - ae_state *_state); -void spdmatrixcholeskysolvem(/* Real */ ae_matrix* cha, - ae_int_t n, - ae_bool isupper, - /* Real */ ae_matrix* b, - ae_int_t m, - ae_int_t* info, - densesolverreport* rep, - /* Real */ ae_matrix* x, - ae_state *_state); -void spdmatrixcholeskysolve(/* Real */ ae_matrix* cha, - ae_int_t n, - ae_bool isupper, - /* Real */ ae_vector* b, - ae_int_t* info, - densesolverreport* rep, - /* Real */ ae_vector* x, - ae_state *_state); -void hpdmatrixsolvem(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - /* Complex */ ae_matrix* b, - ae_int_t m, - ae_int_t* info, - densesolverreport* rep, - /* Complex */ ae_matrix* x, - ae_state *_state); -void hpdmatrixsolve(/* Complex */ ae_matrix* a, - ae_int_t n, - ae_bool isupper, - /* Complex */ ae_vector* b, - ae_int_t* info, - densesolverreport* rep, - /* Complex */ ae_vector* x, - ae_state *_state); -void hpdmatrixcholeskysolvem(/* Complex */ ae_matrix* cha, - ae_int_t n, - ae_bool isupper, - /* Complex */ ae_matrix* b, - ae_int_t m, - ae_int_t* info, - densesolverreport* rep, - /* Complex */ ae_matrix* x, - ae_state *_state); -void hpdmatrixcholeskysolve(/* Complex */ ae_matrix* cha, - ae_int_t n, - ae_bool isupper, - /* Complex */ ae_vector* b, - ae_int_t* info, - densesolverreport* rep, - /* Complex */ ae_vector* x, - ae_state *_state); -void rmatrixsolvels(/* Real */ ae_matrix* a, - ae_int_t nrows, - ae_int_t ncols, - /* Real */ ae_vector* b, - double threshold, - ae_int_t* info, - densesolverlsreport* rep, - /* Real */ ae_vector* x, - ae_state *_state); -ae_bool _densesolverreport_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _densesolverreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _densesolverreport_clear(void* _p); -void _densesolverreport_destroy(void* _p); -ae_bool _densesolverlsreport_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _densesolverlsreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _densesolverlsreport_clear(void* _p); -void _densesolverlsreport_destroy(void* _p); -void linlsqrcreate(ae_int_t m, - ae_int_t n, - linlsqrstate* state, - ae_state *_state); -void linlsqrsetb(linlsqrstate* state, - /* Real */ ae_vector* b, - ae_state *_state); -void linlsqrsetprecunit(linlsqrstate* state, ae_state *_state); -void linlsqrsetprecdiag(linlsqrstate* state, ae_state *_state); -void linlsqrsetlambdai(linlsqrstate* state, - double lambdai, - ae_state *_state); -ae_bool linlsqriteration(linlsqrstate* state, ae_state *_state); -void linlsqrsolvesparse(linlsqrstate* state, - sparsematrix* a, - /* Real */ ae_vector* b, - ae_state *_state); -void linlsqrsetcond(linlsqrstate* state, - double epsa, - double epsb, - ae_int_t maxits, - ae_state *_state); -void linlsqrresults(linlsqrstate* state, - /* Real */ ae_vector* x, - linlsqrreport* rep, - ae_state *_state); -void linlsqrsetxrep(linlsqrstate* state, - ae_bool needxrep, - ae_state *_state); -void linlsqrrestart(linlsqrstate* state, ae_state *_state); -ae_bool _linlsqrstate_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _linlsqrstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _linlsqrstate_clear(void* _p); -void _linlsqrstate_destroy(void* _p); -ae_bool _linlsqrreport_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _linlsqrreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _linlsqrreport_clear(void* _p); -void _linlsqrreport_destroy(void* _p); -void lincgcreate(ae_int_t n, lincgstate* state, ae_state *_state); -void lincgsetstartingpoint(lincgstate* state, - /* Real */ ae_vector* x, - ae_state *_state); -void lincgsetb(lincgstate* state, - /* Real */ ae_vector* b, - ae_state *_state); -void lincgsetprecunit(lincgstate* state, ae_state *_state); -void lincgsetprecdiag(lincgstate* state, ae_state *_state); -void lincgsetcond(lincgstate* state, - double epsf, - ae_int_t maxits, - ae_state *_state); -ae_bool lincgiteration(lincgstate* state, ae_state *_state); -void lincgsolvesparse(lincgstate* state, - sparsematrix* a, - ae_bool isupper, - /* Real */ ae_vector* b, - ae_state *_state); -void lincgresults(lincgstate* state, - /* Real */ ae_vector* x, - lincgreport* rep, - ae_state *_state); -void lincgsetrestartfreq(lincgstate* state, - ae_int_t srf, - ae_state *_state); -void lincgsetrupdatefreq(lincgstate* state, - ae_int_t freq, - ae_state *_state); -void lincgsetxrep(lincgstate* state, ae_bool needxrep, ae_state *_state); -void lincgrestart(lincgstate* state, ae_state *_state); -ae_bool _lincgstate_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _lincgstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _lincgstate_clear(void* _p); -void _lincgstate_destroy(void* _p); -ae_bool _lincgreport_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _lincgreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _lincgreport_clear(void* _p); -void _lincgreport_destroy(void* _p); -void nleqcreatelm(ae_int_t n, - ae_int_t m, - /* Real */ ae_vector* x, - nleqstate* state, - ae_state *_state); -void nleqsetcond(nleqstate* state, - double epsf, - ae_int_t maxits, - ae_state *_state); -void nleqsetxrep(nleqstate* state, ae_bool needxrep, ae_state *_state); -void nleqsetstpmax(nleqstate* state, double stpmax, ae_state *_state); -ae_bool nleqiteration(nleqstate* state, ae_state *_state); -void nleqresults(nleqstate* state, - /* Real */ ae_vector* x, - nleqreport* rep, - ae_state *_state); -void nleqresultsbuf(nleqstate* state, - /* Real */ ae_vector* x, - nleqreport* rep, - ae_state *_state); -void nleqrestartfrom(nleqstate* state, - /* Real */ ae_vector* x, - ae_state *_state); -ae_bool _nleqstate_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _nleqstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _nleqstate_clear(void* _p); -void _nleqstate_destroy(void* _p); -ae_bool _nleqreport_init(void* _p, ae_state *_state, ae_bool make_automatic); -ae_bool _nleqreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); -void _nleqreport_clear(void* _p); -void _nleqreport_destroy(void* _p); - -} -#endif - diff --git a/src/core/alglib/specialfunctions.cpp b/src/core/alglib/specialfunctions.cpp deleted file mode 100644 index f88f8a8..0000000 --- a/src/core/alglib/specialfunctions.cpp +++ /dev/null @@ -1,9637 +0,0 @@ -/************************************************************************* -Copyright (c) Sergey Bochkanov (ALGLIB project). - ->>> SOURCE LICENSE >>> -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation (www.fsf.org); either version 2 of the -License, or (at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -A copy of the GNU General Public License is available at -http://www.fsf.org/licensing/licenses ->>> END OF LICENSE >>> -*************************************************************************/ -#include "stdafx.h" -#include "specialfunctions.h" - -// disable some irrelevant warnings -#if (AE_COMPILER==AE_MSVC) -#pragma warning(disable:4100) -#pragma warning(disable:4127) -#pragma warning(disable:4702) -#pragma warning(disable:4996) -#endif -using namespace std; - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS IMPLEMENTATION OF C++ INTERFACE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib -{ - - -/************************************************************************* -Gamma function - -Input parameters: - X - argument - -Domain: - 0 < X < 171.6 - -170 < X < 0, X is not an integer. - -Relative error: - arithmetic domain # trials peak rms - IEEE -170,-33 20000 2.3e-15 3.3e-16 - IEEE -33, 33 20000 9.4e-16 2.2e-16 - IEEE 33, 171.6 20000 2.3e-15 3.2e-16 - -Cephes Math Library Release 2.8: June, 2000 -Original copyright 1984, 1987, 1989, 1992, 2000 by Stephen L. Moshier -Translated to AlgoPascal by Bochkanov Sergey (2005, 2006, 2007). -*************************************************************************/ -double gammafunction(const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::gammafunction(x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Natural logarithm of gamma function - -Input parameters: - X - argument - -Result: - logarithm of the absolute value of the Gamma(X). - -Output parameters: - SgnGam - sign(Gamma(X)) - -Domain: - 0 < X < 2.55e305 - -2.55e305 < X < 0, X is not an integer. - -ACCURACY: -arithmetic domain # trials peak rms - IEEE 0, 3 28000 5.4e-16 1.1e-16 - IEEE 2.718, 2.556e305 40000 3.5e-16 8.3e-17 -The error criterion was relative when the function magnitude -was greater than one but absolute when it was less than one. - -The following test used the relative error criterion, though -at certain points the relative error could be much higher than -indicated. - IEEE -200, -4 10000 4.8e-16 1.3e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1989, 1992, 2000 by Stephen L. Moshier -Translated to AlgoPascal by Bochkanov Sergey (2005, 2006, 2007). -*************************************************************************/ -double lngamma(const double x, double &sgngam) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::lngamma(x, &sgngam, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Error function - -The integral is - - x - - - 2 | | 2 - erf(x) = -------- | exp( - t ) dt. - sqrt(pi) | | - - - 0 - -For 0 <= |x| < 1, erf(x) = x * P4(x**2)/Q5(x**2); otherwise -erf(x) = 1 - erfc(x). - - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0,1 30000 3.7e-16 1.0e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier -*************************************************************************/ -double errorfunction(const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::errorfunction(x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Complementary error function - - 1 - erf(x) = - - inf. - - - 2 | | 2 - erfc(x) = -------- | exp( - t ) dt - sqrt(pi) | | - - - x - - -For small x, erfc(x) = 1 - erf(x); otherwise rational -approximations are computed. - - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0,26.6417 30000 5.7e-14 1.5e-14 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier -*************************************************************************/ -double errorfunctionc(const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::errorfunctionc(x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Normal distribution function - -Returns the area under the Gaussian probability density -function, integrated from minus infinity to x: - - x - - - 1 | | 2 - ndtr(x) = --------- | exp( - t /2 ) dt - sqrt(2pi) | | - - - -inf. - - = ( 1 + erf(z) ) / 2 - = erfc(z) / 2 - -where z = x/sqrt(2). Computation is via the functions -erf and erfc. - - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE -13,0 30000 3.4e-14 6.7e-15 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier -*************************************************************************/ -double normaldistribution(const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::normaldistribution(x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Inverse of the error function - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier -*************************************************************************/ -double inverf(const double e) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::inverf(e, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Inverse of Normal distribution function - -Returns the argument, x, for which the area under the -Gaussian probability density function (integrated from -minus infinity to x) is equal to y. - - -For small arguments 0 < y < exp(-2), the program computes -z = sqrt( -2.0 * log(y) ); then the approximation is -x = z - log(z)/z - (1/z) P(1/z) / Q(1/z). -There are two rational functions P/Q, one for 0 < y < exp(-32) -and the other for y up to exp(-2). For larger arguments, -w = y - 0.5, and x/sqrt(2pi) = w + w**3 R(w**2)/S(w**2)). - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0.125, 1 20000 7.2e-16 1.3e-16 - IEEE 3e-308, 0.135 50000 4.6e-16 9.8e-17 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier -*************************************************************************/ -double invnormaldistribution(const double y0) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::invnormaldistribution(y0, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Incomplete gamma integral - -The function is defined by - - x - - - 1 | | -t a-1 - igam(a,x) = ----- | e t dt. - - | | - | (a) - - 0 - - -In this implementation both arguments must be positive. -The integral is evaluated by either a power series or -continued fraction expansion, depending on the relative -values of a and x. - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0,30 200000 3.6e-14 2.9e-15 - IEEE 0,100 300000 9.9e-14 1.5e-14 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1985, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double incompletegamma(const double a, const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::incompletegamma(a, x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Complemented incomplete gamma integral - -The function is defined by - - - igamc(a,x) = 1 - igam(a,x) - - inf. - - - 1 | | -t a-1 - = ----- | e t dt. - - | | - | (a) - - x - - -In this implementation both arguments must be positive. -The integral is evaluated by either a power series or -continued fraction expansion, depending on the relative -values of a and x. - -ACCURACY: - -Tested at random a, x. - a x Relative error: -arithmetic domain domain # trials peak rms - IEEE 0.5,100 0,100 200000 1.9e-14 1.7e-15 - IEEE 0.01,0.5 0,100 200000 1.4e-13 1.6e-15 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1985, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double incompletegammac(const double a, const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::incompletegammac(a, x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Inverse of complemented incomplete gamma integral - -Given p, the function finds x such that - - igamc( a, x ) = p. - -Starting with the approximate value - - 3 - x = a t - - where - - t = 1 - d - ndtri(p) sqrt(d) - -and - - d = 1/9a, - -the routine performs up to 10 Newton iterations to find the -root of igamc(a,x) - p = 0. - -ACCURACY: - -Tested at random a, p in the intervals indicated. - - a p Relative error: -arithmetic domain domain # trials peak rms - IEEE 0.5,100 0,0.5 100000 1.0e-14 1.7e-15 - IEEE 0.01,0.5 0,0.5 100000 9.0e-14 3.4e-15 - IEEE 0.5,10000 0,0.5 20000 2.3e-13 3.8e-14 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double invincompletegammac(const double a, const double y0) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::invincompletegammac(a, y0, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Airy function - -Solution of the differential equation - -y"(x) = xy. - -The function returns the two independent solutions Ai, Bi -and their first derivatives Ai'(x), Bi'(x). - -Evaluation is by power series summation for small x, -by rational minimax approximations for large x. - - - -ACCURACY: -Error criterion is absolute when function <= 1, relative -when function > 1, except * denotes relative error criterion. -For large negative x, the absolute error increases as x^1.5. -For large positive x, the relative error increases as x^1.5. - -Arithmetic domain function # trials peak rms -IEEE -10, 0 Ai 10000 1.6e-15 2.7e-16 -IEEE 0, 10 Ai 10000 2.3e-14* 1.8e-15* -IEEE -10, 0 Ai' 10000 4.6e-15 7.6e-16 -IEEE 0, 10 Ai' 10000 1.8e-14* 1.5e-15* -IEEE -10, 10 Bi 30000 4.2e-15 5.3e-16 -IEEE -10, 10 Bi' 30000 4.9e-15 7.3e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier -*************************************************************************/ -void airy(const double x, double &ai, double &aip, double &bi, double &bip) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::airy(x, &ai, &aip, &bi, &bip, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Bessel function of order zero - -Returns Bessel function of order zero of the argument. - -The domain is divided into the intervals [0, 5] and -(5, infinity). In the first interval the following rational -approximation is used: - - - 2 2 -(w - r ) (w - r ) P (w) / Q (w) - 1 2 3 8 - - 2 -where w = x and the two r's are zeros of the function. - -In the second interval, the Hankel asymptotic expansion -is employed with two rational functions of degree 6/6 -and 7/7. - -ACCURACY: - - Absolute error: -arithmetic domain # trials peak rms - IEEE 0, 30 60000 4.2e-16 1.1e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier -*************************************************************************/ -double besselj0(const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::besselj0(x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Bessel function of order one - -Returns Bessel function of order one of the argument. - -The domain is divided into the intervals [0, 8] and -(8, infinity). In the first interval a 24 term Chebyshev -expansion is used. In the second, the asymptotic -trigonometric representation is employed using two -rational functions of degree 5/5. - -ACCURACY: - - Absolute error: -arithmetic domain # trials peak rms - IEEE 0, 30 30000 2.6e-16 1.1e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier -*************************************************************************/ -double besselj1(const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::besselj1(x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Bessel function of integer order - -Returns Bessel function of order n, where n is a -(possibly negative) integer. - -The ratio of jn(x) to j0(x) is computed by backward -recurrence. First the ratio jn/jn-1 is found by a -continued fraction expansion. Then the recurrence -relating successive orders is applied until j0 or j1 is -reached. - -If n = 0 or 1 the routine for j0 or j1 is called -directly. - -ACCURACY: - - Absolute error: -arithmetic range # trials peak rms - IEEE 0, 30 5000 4.4e-16 7.9e-17 - - -Not suitable for large n or x. Use jv() (fractional order) instead. - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double besseljn(const ae_int_t n, const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::besseljn(n, x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Bessel function of the second kind, order zero - -Returns Bessel function of the second kind, of order -zero, of the argument. - -The domain is divided into the intervals [0, 5] and -(5, infinity). In the first interval a rational approximation -R(x) is employed to compute - y0(x) = R(x) + 2 * log(x) * j0(x) / PI. -Thus a call to j0() is required. - -In the second interval, the Hankel asymptotic expansion -is employed with two rational functions of degree 6/6 -and 7/7. - - - -ACCURACY: - - Absolute error, when y0(x) < 1; else relative error: - -arithmetic domain # trials peak rms - IEEE 0, 30 30000 1.3e-15 1.6e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier -*************************************************************************/ -double bessely0(const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::bessely0(x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Bessel function of second kind of order one - -Returns Bessel function of the second kind of order one -of the argument. - -The domain is divided into the intervals [0, 8] and -(8, infinity). In the first interval a 25 term Chebyshev -expansion is used, and a call to j1() is required. -In the second, the asymptotic trigonometric representation -is employed using two rational functions of degree 5/5. - -ACCURACY: - - Absolute error: -arithmetic domain # trials peak rms - IEEE 0, 30 30000 1.0e-15 1.3e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier -*************************************************************************/ -double bessely1(const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::bessely1(x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Bessel function of second kind of integer order - -Returns Bessel function of order n, where n is a -(possibly negative) integer. - -The function is evaluated by forward recurrence on -n, starting with values computed by the routines -y0() and y1(). - -If n = 0 or 1 the routine for y0 or y1 is called -directly. - -ACCURACY: - Absolute error, except relative - when y > 1: -arithmetic domain # trials peak rms - IEEE 0, 30 30000 3.4e-15 4.3e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double besselyn(const ae_int_t n, const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::besselyn(n, x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Modified Bessel function of order zero - -Returns modified Bessel function of order zero of the -argument. - -The function is defined as i0(x) = j0( ix ). - -The range is partitioned into the two intervals [0,8] and -(8, infinity). Chebyshev polynomial expansions are employed -in each interval. - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0,30 30000 5.8e-16 1.4e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double besseli0(const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::besseli0(x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Modified Bessel function of order one - -Returns modified Bessel function of order one of the -argument. - -The function is defined as i1(x) = -i j1( ix ). - -The range is partitioned into the two intervals [0,8] and -(8, infinity). Chebyshev polynomial expansions are employed -in each interval. - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0, 30 30000 1.9e-15 2.1e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1985, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double besseli1(const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::besseli1(x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Modified Bessel function, second kind, order zero - -Returns modified Bessel function of the second kind -of order zero of the argument. - -The range is partitioned into the two intervals [0,8] and -(8, infinity). Chebyshev polynomial expansions are employed -in each interval. - -ACCURACY: - -Tested at 2000 random points between 0 and 8. Peak absolute -error (relative when K0 > 1) was 1.46e-14; rms, 4.26e-15. - Relative error: -arithmetic domain # trials peak rms - IEEE 0, 30 30000 1.2e-15 1.6e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double besselk0(const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::besselk0(x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Modified Bessel function, second kind, order one - -Computes the modified Bessel function of the second kind -of order one of the argument. - -The range is partitioned into the two intervals [0,2] and -(2, infinity). Chebyshev polynomial expansions are employed -in each interval. - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0, 30 30000 1.2e-15 1.6e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double besselk1(const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::besselk1(x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Modified Bessel function, second kind, integer order - -Returns modified Bessel function of the second kind -of order n of the argument. - -The range is partitioned into the two intervals [0,9.55] and -(9.55, infinity). An ascending power series is used in the -low range, and an asymptotic expansion in the high range. - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0,30 90000 1.8e-8 3.0e-10 - -Error is high only near the crossover point x = 9.55 -between the two expansions used. - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1988, 2000 by Stephen L. Moshier -*************************************************************************/ -double besselkn(const ae_int_t nn, const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::besselkn(nn, x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Beta function - - - - - - | (a) | (b) -beta( a, b ) = -----------. - - - | (a+b) - -For large arguments the logarithm of the function is -evaluated using lgam(), then exponentiated. - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0,30 30000 8.1e-14 1.1e-14 - -Cephes Math Library Release 2.0: April, 1987 -Copyright 1984, 1987 by Stephen L. Moshier -*************************************************************************/ -double beta(const double a, const double b) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::beta(a, b, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Incomplete beta integral - -Returns incomplete beta integral of the arguments, evaluated -from zero to x. The function is defined as - - x - - - - | (a+b) | | a-1 b-1 - ----------- | t (1-t) dt. - - - | | - | (a) | (b) - - 0 - -The domain of definition is 0 <= x <= 1. In this -implementation a and b are restricted to positive values. -The integral from x to 1 may be obtained by the symmetry -relation - - 1 - incbet( a, b, x ) = incbet( b, a, 1-x ). - -The integral is evaluated by a continued fraction expansion -or, when b*x is small, by a power series. - -ACCURACY: - -Tested at uniformly distributed random points (a,b,x) with a and b -in "domain" and x between 0 and 1. - Relative error -arithmetic domain # trials peak rms - IEEE 0,5 10000 6.9e-15 4.5e-16 - IEEE 0,85 250000 2.2e-13 1.7e-14 - IEEE 0,1000 30000 5.3e-12 6.3e-13 - IEEE 0,10000 250000 9.3e-11 7.1e-12 - IEEE 0,100000 10000 8.7e-10 4.8e-11 -Outputs smaller than the IEEE gradual underflow threshold -were excluded from these statistics. - -Cephes Math Library, Release 2.8: June, 2000 -Copyright 1984, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double incompletebeta(const double a, const double b, const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::incompletebeta(a, b, x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Inverse of incomplete beta integral - -Given y, the function finds x such that - - incbet( a, b, x ) = y . - -The routine performs interval halving or Newton iterations to find the -root of incbet(a,b,x) - y = 0. - - -ACCURACY: - - Relative error: - x a,b -arithmetic domain domain # trials peak rms - IEEE 0,1 .5,10000 50000 5.8e-12 1.3e-13 - IEEE 0,1 .25,100 100000 1.8e-13 3.9e-15 - IEEE 0,1 0,5 50000 1.1e-12 5.5e-15 -With a and b constrained to half-integer or integer values: - IEEE 0,1 .5,10000 50000 5.8e-12 1.1e-13 - IEEE 0,1 .5,100 100000 1.7e-14 7.9e-16 -With a = .5, b constrained to half-integer or integer values: - IEEE 0,1 .5,10000 10000 8.3e-11 1.0e-11 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1996, 2000 by Stephen L. Moshier -*************************************************************************/ -double invincompletebeta(const double a, const double b, const double y) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::invincompletebeta(a, b, y, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Binomial distribution - -Returns the sum of the terms 0 through k of the Binomial -probability density: - - k - -- ( n ) j n-j - > ( ) p (1-p) - -- ( j ) - j=0 - -The terms are not summed directly; instead the incomplete -beta integral is employed, according to the formula - -y = bdtr( k, n, p ) = incbet( n-k, k+1, 1-p ). - -The arguments must be positive, with p ranging from 0 to 1. - -ACCURACY: - -Tested at random points (a,b,p), with p between 0 and 1. - - a,b Relative error: -arithmetic domain # trials peak rms - For p between 0.001 and 1: - IEEE 0,100 100000 4.3e-15 2.6e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double binomialdistribution(const ae_int_t k, const ae_int_t n, const double p) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::binomialdistribution(k, n, p, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Complemented binomial distribution - -Returns the sum of the terms k+1 through n of the Binomial -probability density: - - n - -- ( n ) j n-j - > ( ) p (1-p) - -- ( j ) - j=k+1 - -The terms are not summed directly; instead the incomplete -beta integral is employed, according to the formula - -y = bdtrc( k, n, p ) = incbet( k+1, n-k, p ). - -The arguments must be positive, with p ranging from 0 to 1. - -ACCURACY: - -Tested at random points (a,b,p). - - a,b Relative error: -arithmetic domain # trials peak rms - For p between 0.001 and 1: - IEEE 0,100 100000 6.7e-15 8.2e-16 - For p between 0 and .001: - IEEE 0,100 100000 1.5e-13 2.7e-15 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double binomialcdistribution(const ae_int_t k, const ae_int_t n, const double p) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::binomialcdistribution(k, n, p, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Inverse binomial distribution - -Finds the event probability p such that the sum of the -terms 0 through k of the Binomial probability density -is equal to the given cumulative probability y. - -This is accomplished using the inverse beta integral -function and the relation - -1 - p = incbi( n-k, k+1, y ). - -ACCURACY: - -Tested at random points (a,b,p). - - a,b Relative error: -arithmetic domain # trials peak rms - For p between 0.001 and 1: - IEEE 0,100 100000 2.3e-14 6.4e-16 - IEEE 0,10000 100000 6.6e-12 1.2e-13 - For p between 10^-6 and 0.001: - IEEE 0,100 100000 2.0e-12 1.3e-14 - IEEE 0,10000 100000 1.5e-12 3.2e-14 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double invbinomialdistribution(const ae_int_t k, const ae_int_t n, const double y) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::invbinomialdistribution(k, n, y, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Calculation of the value of the Chebyshev polynomials of the -first and second kinds. - -Parameters: - r - polynomial kind, either 1 or 2. - n - degree, n>=0 - x - argument, -1 <= x <= 1 - -Result: - the value of the Chebyshev polynomial at x -*************************************************************************/ -double chebyshevcalculate(const ae_int_t r, const ae_int_t n, const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::chebyshevcalculate(r, n, x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Summation of Chebyshev polynomials using Clenshaw’s recurrence formula. - -This routine calculates - c[0]*T0(x) + c[1]*T1(x) + ... + c[N]*TN(x) -or - c[0]*U0(x) + c[1]*U1(x) + ... + c[N]*UN(x) -depending on the R. - -Parameters: - r - polynomial kind, either 1 or 2. - n - degree, n>=0 - x - argument - -Result: - the value of the Chebyshev polynomial at x -*************************************************************************/ -double chebyshevsum(const real_1d_array &c, const ae_int_t r, const ae_int_t n, const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::chebyshevsum(const_cast(c.c_ptr()), r, n, x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Representation of Tn as C[0] + C[1]*X + ... + C[N]*X^N - -Input parameters: - N - polynomial degree, n>=0 - -Output parameters: - C - coefficients -*************************************************************************/ -void chebyshevcoefficients(const ae_int_t n, real_1d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::chebyshevcoefficients(n, const_cast(c.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Conversion of a series of Chebyshev polynomials to a power series. - -Represents A[0]*T0(x) + A[1]*T1(x) + ... + A[N]*Tn(x) as -B[0] + B[1]*X + ... + B[N]*X^N. - -Input parameters: - A - Chebyshev series coefficients - N - degree, N>=0 - -Output parameters - B - power series coefficients -*************************************************************************/ -void fromchebyshev(const real_1d_array &a, const ae_int_t n, real_1d_array &b) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::fromchebyshev(const_cast(a.c_ptr()), n, const_cast(b.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Chi-square distribution - -Returns the area under the left hand tail (from 0 to x) -of the Chi square probability density function with -v degrees of freedom. - - - x - - - 1 | | v/2-1 -t/2 - P( x | v ) = ----------- | t e dt - v/2 - | | - 2 | (v/2) - - 0 - -where x is the Chi-square variable. - -The incomplete gamma integral is used, according to the -formula - -y = chdtr( v, x ) = igam( v/2.0, x/2.0 ). - -The arguments must both be positive. - -ACCURACY: - -See incomplete gamma function - - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double chisquaredistribution(const double v, const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::chisquaredistribution(v, x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Complemented Chi-square distribution - -Returns the area under the right hand tail (from x to -infinity) of the Chi square probability density function -with v degrees of freedom: - - inf. - - - 1 | | v/2-1 -t/2 - P( x | v ) = ----------- | t e dt - v/2 - | | - 2 | (v/2) - - x - -where x is the Chi-square variable. - -The incomplete gamma integral is used, according to the -formula - -y = chdtr( v, x ) = igamc( v/2.0, x/2.0 ). - -The arguments must both be positive. - -ACCURACY: - -See incomplete gamma function - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double chisquarecdistribution(const double v, const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::chisquarecdistribution(v, x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Inverse of complemented Chi-square distribution - -Finds the Chi-square argument x such that the integral -from x to infinity of the Chi-square density is equal -to the given cumulative probability y. - -This is accomplished using the inverse gamma integral -function and the relation - - x/2 = igami( df/2, y ); - -ACCURACY: - -See inverse incomplete gamma function - - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double invchisquaredistribution(const double v, const double y) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::invchisquaredistribution(v, y, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Dawson's Integral - -Approximates the integral - - x - - - 2 | | 2 - dawsn(x) = exp( -x ) | exp( t ) dt - | | - - - 0 - -Three different rational approximations are employed, for -the intervals 0 to 3.25; 3.25 to 6.25; and 6.25 up. - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0,10 10000 6.9e-16 1.0e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier -*************************************************************************/ -double dawsonintegral(const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::dawsonintegral(x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Complete elliptic integral of the first kind - -Approximates the integral - - - - pi/2 - - - | | - | dt -K(m) = | ------------------ - | 2 - | | sqrt( 1 - m sin t ) - - - 0 - -using the approximation - - P(x) - log x Q(x). - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0,1 30000 2.5e-16 6.8e-17 - -Cephes Math Library, Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double ellipticintegralk(const double m) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::ellipticintegralk(m, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Complete elliptic integral of the first kind - -Approximates the integral - - - - pi/2 - - - | | - | dt -K(m) = | ------------------ - | 2 - | | sqrt( 1 - m sin t ) - - - 0 - -where m = 1 - m1, using the approximation - - P(x) - log x Q(x). - -The argument m1 is used rather than m so that the logarithmic -singularity at m = 1 will be shifted to the origin; this -preserves maximum accuracy. - -K(0) = pi/2. - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0,1 30000 2.5e-16 6.8e-17 - -Àëãîðèòì âçÿò èç áèáëèîòåêè Cephes -*************************************************************************/ -double ellipticintegralkhighprecision(const double m1) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::ellipticintegralkhighprecision(m1, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Incomplete elliptic integral of the first kind F(phi|m) - -Approximates the integral - - - - phi - - - | | - | dt -F(phi_\m) = | ------------------ - | 2 - | | sqrt( 1 - m sin t ) - - - 0 - -of amplitude phi and modulus m, using the arithmetic - -geometric mean algorithm. - - - - -ACCURACY: - -Tested at random points with m in [0, 1] and phi as indicated. - - Relative error: -arithmetic domain # trials peak rms - IEEE -10,10 200000 7.4e-16 1.0e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double incompleteellipticintegralk(const double phi, const double m) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::incompleteellipticintegralk(phi, m, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Complete elliptic integral of the second kind - -Approximates the integral - - - pi/2 - - - | | 2 -E(m) = | sqrt( 1 - m sin t ) dt - | | - - - 0 - -using the approximation - - P(x) - x log x Q(x). - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0, 1 10000 2.1e-16 7.3e-17 - -Cephes Math Library, Release 2.8: June, 2000 -Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier -*************************************************************************/ -double ellipticintegrale(const double m) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::ellipticintegrale(m, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Incomplete elliptic integral of the second kind - -Approximates the integral - - - phi - - - | | - | 2 -E(phi_\m) = | sqrt( 1 - m sin t ) dt - | - | | - - - 0 - -of amplitude phi and modulus m, using the arithmetic - -geometric mean algorithm. - -ACCURACY: - -Tested at random arguments with phi in [-10, 10] and m in -[0, 1]. - Relative error: -arithmetic domain # trials peak rms - IEEE -10,10 150000 3.3e-15 1.4e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1993, 2000 by Stephen L. Moshier -*************************************************************************/ -double incompleteellipticintegrale(const double phi, const double m) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::incompleteellipticintegrale(phi, m, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Exponential integral Ei(x) - - x - - t - | | e - Ei(x) = -|- --- dt . - | | t - - - -inf - -Not defined for x <= 0. -See also expn.c. - - - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0,100 50000 8.6e-16 1.3e-16 - -Cephes Math Library Release 2.8: May, 1999 -Copyright 1999 by Stephen L. Moshier -*************************************************************************/ -double exponentialintegralei(const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::exponentialintegralei(x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Exponential integral En(x) - -Evaluates the exponential integral - - inf. - - - | | -xt - | e - E (x) = | ---- dt. - n | n - | | t - - - 1 - - -Both n and x must be nonnegative. - -The routine employs either a power series, a continued -fraction, or an asymptotic formula depending on the -relative values of n and x. - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0, 30 10000 1.7e-15 3.6e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1985, 2000 by Stephen L. Moshier -*************************************************************************/ -double exponentialintegralen(const double x, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::exponentialintegralen(x, n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -F distribution - -Returns the area from zero to x under the F density -function (also known as Snedcor's density or the -variance ratio density). This is the density -of x = (u1/df1)/(u2/df2), where u1 and u2 are random -variables having Chi square distributions with df1 -and df2 degrees of freedom, respectively. -The incomplete beta integral is used, according to the -formula - -P(x) = incbet( df1/2, df2/2, (df1*x/(df2 + df1*x) ). - - -The arguments a and b are greater than zero, and x is -nonnegative. - -ACCURACY: - -Tested at random points (a,b,x). - - x a,b Relative error: -arithmetic domain domain # trials peak rms - IEEE 0,1 0,100 100000 9.8e-15 1.7e-15 - IEEE 1,5 0,100 100000 6.5e-15 3.5e-16 - IEEE 0,1 1,10000 100000 2.2e-11 3.3e-12 - IEEE 1,5 1,10000 100000 1.1e-11 1.7e-13 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double fdistribution(const ae_int_t a, const ae_int_t b, const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::fdistribution(a, b, x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Complemented F distribution - -Returns the area from x to infinity under the F density -function (also known as Snedcor's density or the -variance ratio density). - - - inf. - - - 1 | | a-1 b-1 -1-P(x) = ------ | t (1-t) dt - B(a,b) | | - - - x - - -The incomplete beta integral is used, according to the -formula - -P(x) = incbet( df2/2, df1/2, (df2/(df2 + df1*x) ). - - -ACCURACY: - -Tested at random points (a,b,x) in the indicated intervals. - x a,b Relative error: -arithmetic domain domain # trials peak rms - IEEE 0,1 1,100 100000 3.7e-14 5.9e-16 - IEEE 1,5 1,100 100000 8.0e-15 1.6e-15 - IEEE 0,1 1,10000 100000 1.8e-11 3.5e-13 - IEEE 1,5 1,10000 100000 2.0e-11 3.0e-12 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double fcdistribution(const ae_int_t a, const ae_int_t b, const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::fcdistribution(a, b, x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Inverse of complemented F distribution - -Finds the F density argument x such that the integral -from x to infinity of the F density is equal to the -given probability p. - -This is accomplished using the inverse beta integral -function and the relations - - z = incbi( df2/2, df1/2, p ) - x = df2 (1-z) / (df1 z). - -Note: the following relations hold for the inverse of -the uncomplemented F distribution: - - z = incbi( df1/2, df2/2, p ) - x = df2 z / (df1 (1-z)). - -ACCURACY: - -Tested at random points (a,b,p). - - a,b Relative error: -arithmetic domain # trials peak rms - For p between .001 and 1: - IEEE 1,100 100000 8.3e-15 4.7e-16 - IEEE 1,10000 100000 2.1e-11 1.4e-13 - For p between 10^-6 and 10^-3: - IEEE 1,100 50000 1.3e-12 8.4e-15 - IEEE 1,10000 50000 3.0e-12 4.8e-14 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double invfdistribution(const ae_int_t a, const ae_int_t b, const double y) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::invfdistribution(a, b, y, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Fresnel integral - -Evaluates the Fresnel integrals - - x - - - | | -C(x) = | cos(pi/2 t**2) dt, - | | - - - 0 - - x - - - | | -S(x) = | sin(pi/2 t**2) dt. - | | - - - 0 - - -The integrals are evaluated by a power series for x < 1. -For x >= 1 auxiliary functions f(x) and g(x) are employed -such that - -C(x) = 0.5 + f(x) sin( pi/2 x**2 ) - g(x) cos( pi/2 x**2 ) -S(x) = 0.5 - f(x) cos( pi/2 x**2 ) - g(x) sin( pi/2 x**2 ) - - - -ACCURACY: - - Relative error. - -Arithmetic function domain # trials peak rms - IEEE S(x) 0, 10 10000 2.0e-15 3.2e-16 - IEEE C(x) 0, 10 10000 1.8e-15 3.3e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier -*************************************************************************/ -void fresnelintegral(const double x, double &c, double &s) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::fresnelintegral(x, &c, &s, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Calculation of the value of the Hermite polynomial. - -Parameters: - n - degree, n>=0 - x - argument - -Result: - the value of the Hermite polynomial Hn at x -*************************************************************************/ -double hermitecalculate(const ae_int_t n, const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::hermitecalculate(n, x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Summation of Hermite polynomials using Clenshaw’s recurrence formula. - -This routine calculates - c[0]*H0(x) + c[1]*H1(x) + ... + c[N]*HN(x) - -Parameters: - n - degree, n>=0 - x - argument - -Result: - the value of the Hermite polynomial at x -*************************************************************************/ -double hermitesum(const real_1d_array &c, const ae_int_t n, const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::hermitesum(const_cast(c.c_ptr()), n, x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Representation of Hn as C[0] + C[1]*X + ... + C[N]*X^N - -Input parameters: - N - polynomial degree, n>=0 - -Output parameters: - C - coefficients -*************************************************************************/ -void hermitecoefficients(const ae_int_t n, real_1d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::hermitecoefficients(n, const_cast(c.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Jacobian Elliptic Functions - -Evaluates the Jacobian elliptic functions sn(u|m), cn(u|m), -and dn(u|m) of parameter m between 0 and 1, and real -argument u. - -These functions are periodic, with quarter-period on the -real axis equal to the complete elliptic integral -ellpk(1.0-m). - -Relation to incomplete elliptic integral: -If u = ellik(phi,m), then sn(u|m) = sin(phi), -and cn(u|m) = cos(phi). Phi is called the amplitude of u. - -Computation is by means of the arithmetic-geometric mean -algorithm, except when m is within 1e-9 of 0 or 1. In the -latter case with m close to 1, the approximation applies -only for phi < pi/2. - -ACCURACY: - -Tested at random points with u between 0 and 10, m between -0 and 1. - - Absolute error (* = relative error): -arithmetic function # trials peak rms - IEEE phi 10000 9.2e-16* 1.4e-16* - IEEE sn 50000 4.1e-15 4.6e-16 - IEEE cn 40000 3.6e-15 4.4e-16 - IEEE dn 10000 1.3e-12 1.8e-14 - - Peak error observed in consistency check using addition -theorem for sn(u+v) was 4e-16 (absolute). Also tested by -the above relation to the incomplete elliptic integral. -Accuracy deteriorates when u is large. - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -void jacobianellipticfunctions(const double u, const double m, double &sn, double &cn, double &dn, double &ph) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::jacobianellipticfunctions(u, m, &sn, &cn, &dn, &ph, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Calculation of the value of the Laguerre polynomial. - -Parameters: - n - degree, n>=0 - x - argument - -Result: - the value of the Laguerre polynomial Ln at x -*************************************************************************/ -double laguerrecalculate(const ae_int_t n, const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::laguerrecalculate(n, x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Summation of Laguerre polynomials using Clenshaw’s recurrence formula. - -This routine calculates c[0]*L0(x) + c[1]*L1(x) + ... + c[N]*LN(x) - -Parameters: - n - degree, n>=0 - x - argument - -Result: - the value of the Laguerre polynomial at x -*************************************************************************/ -double laguerresum(const real_1d_array &c, const ae_int_t n, const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::laguerresum(const_cast(c.c_ptr()), n, x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Representation of Ln as C[0] + C[1]*X + ... + C[N]*X^N - -Input parameters: - N - polynomial degree, n>=0 - -Output parameters: - C - coefficients -*************************************************************************/ -void laguerrecoefficients(const ae_int_t n, real_1d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::laguerrecoefficients(n, const_cast(c.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Calculation of the value of the Legendre polynomial Pn. - -Parameters: - n - degree, n>=0 - x - argument - -Result: - the value of the Legendre polynomial Pn at x -*************************************************************************/ -double legendrecalculate(const ae_int_t n, const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::legendrecalculate(n, x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Summation of Legendre polynomials using Clenshaw’s recurrence formula. - -This routine calculates - c[0]*P0(x) + c[1]*P1(x) + ... + c[N]*PN(x) - -Parameters: - n - degree, n>=0 - x - argument - -Result: - the value of the Legendre polynomial at x -*************************************************************************/ -double legendresum(const real_1d_array &c, const ae_int_t n, const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::legendresum(const_cast(c.c_ptr()), n, x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Representation of Pn as C[0] + C[1]*X + ... + C[N]*X^N - -Input parameters: - N - polynomial degree, n>=0 - -Output parameters: - C - coefficients -*************************************************************************/ -void legendrecoefficients(const ae_int_t n, real_1d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::legendrecoefficients(n, const_cast(c.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Poisson distribution - -Returns the sum of the first k+1 terms of the Poisson -distribution: - - k j - -- -m m - > e -- - -- j! - j=0 - -The terms are not summed directly; instead the incomplete -gamma integral is employed, according to the relation - -y = pdtr( k, m ) = igamc( k+1, m ). - -The arguments must both be positive. -ACCURACY: - -See incomplete gamma function - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double poissondistribution(const ae_int_t k, const double m) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::poissondistribution(k, m, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Complemented Poisson distribution - -Returns the sum of the terms k+1 to infinity of the Poisson -distribution: - - inf. j - -- -m m - > e -- - -- j! - j=k+1 - -The terms are not summed directly; instead the incomplete -gamma integral is employed, according to the formula - -y = pdtrc( k, m ) = igam( k+1, m ). - -The arguments must both be positive. - -ACCURACY: - -See incomplete gamma function - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double poissoncdistribution(const ae_int_t k, const double m) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::poissoncdistribution(k, m, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Inverse Poisson distribution - -Finds the Poisson variable x such that the integral -from 0 to x of the Poisson density is equal to the -given probability y. - -This is accomplished using the inverse gamma integral -function and the relation - - m = igami( k+1, y ). - -ACCURACY: - -See inverse incomplete gamma function - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double invpoissondistribution(const ae_int_t k, const double y) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::invpoissondistribution(k, y, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Psi (digamma) function - - d - - psi(x) = -- ln | (x) - dx - -is the logarithmic derivative of the gamma function. -For integer x, - n-1 - - -psi(n) = -EUL + > 1/k. - - - k=1 - -This formula is used for 0 < n <= 10. If x is negative, it -is transformed to a positive argument by the reflection -formula psi(1-x) = psi(x) + pi cot(pi x). -For general positive x, the argument is made greater than 10 -using the recurrence psi(x+1) = psi(x) + 1/x. -Then the following asymptotic expansion is applied: - - inf. B - - 2k -psi(x) = log(x) - 1/2x - > ------- - - 2k - k=1 2k x - -where the B2k are Bernoulli numbers. - -ACCURACY: - Relative error (except absolute when |psi| < 1): -arithmetic domain # trials peak rms - IEEE 0,30 30000 1.3e-15 1.4e-16 - IEEE -30,0 40000 1.5e-15 2.2e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1992, 2000 by Stephen L. Moshier -*************************************************************************/ -double psi(const double x) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::psi(x, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Student's t distribution - -Computes the integral from minus infinity to t of the Student -t distribution with integer k > 0 degrees of freedom: - - t - - - | | - - | 2 -(k+1)/2 - | ( (k+1)/2 ) | ( x ) - ---------------------- | ( 1 + --- ) dx - - | ( k ) - sqrt( k pi ) | ( k/2 ) | - | | - - - -inf. - -Relation to incomplete beta integral: - - 1 - stdtr(k,t) = 0.5 * incbet( k/2, 1/2, z ) -where - z = k/(k + t**2). - -For t < -2, this is the method of computation. For higher t, -a direct method is derived from integration by parts. -Since the function is symmetric about t=0, the area under the -right tail of the density is found by calling the function -with -t instead of t. - -ACCURACY: - -Tested at random 1 <= k <= 25. The "domain" refers to t. - Relative error: -arithmetic domain # trials peak rms - IEEE -100,-2 50000 5.9e-15 1.4e-15 - IEEE -2,100 500000 2.7e-15 4.9e-17 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double studenttdistribution(const ae_int_t k, const double t) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::studenttdistribution(k, t, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Functional inverse of Student's t distribution - -Given probability p, finds the argument t such that stdtr(k,t) -is equal to p. - -ACCURACY: - -Tested at random 1 <= k <= 100. The "domain" refers to p: - Relative error: -arithmetic domain # trials peak rms - IEEE .001,.999 25000 5.7e-15 8.0e-16 - IEEE 10^-6,.001 25000 2.0e-12 2.9e-14 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double invstudenttdistribution(const ae_int_t k, const double p) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::invstudenttdistribution(k, p, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Sine and cosine integrals - -Evaluates the integrals - - x - - - | cos t - 1 - Ci(x) = eul + ln x + | --------- dt, - | t - - - 0 - x - - - | sin t - Si(x) = | ----- dt - | t - - - 0 - -where eul = 0.57721566490153286061 is Euler's constant. -The integrals are approximated by rational functions. -For x > 8 auxiliary functions f(x) and g(x) are employed -such that - -Ci(x) = f(x) sin(x) - g(x) cos(x) -Si(x) = pi/2 - f(x) cos(x) - g(x) sin(x) - - -ACCURACY: - Test interval = [0,50]. -Absolute error, except relative when > 1: -arithmetic function # trials peak rms - IEEE Si 30000 4.4e-16 7.3e-17 - IEEE Ci 30000 6.9e-16 5.1e-17 - -Cephes Math Library Release 2.1: January, 1989 -Copyright 1984, 1987, 1989 by Stephen L. Moshier -*************************************************************************/ -void sinecosineintegrals(const double x, double &si, double &ci) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::sinecosineintegrals(x, &si, &ci, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Hyperbolic sine and cosine integrals - -Approximates the integrals - - x - - - | | cosh t - 1 - Chi(x) = eul + ln x + | ----------- dt, - | | t - - - 0 - - x - - - | | sinh t - Shi(x) = | ------ dt - | | t - - - 0 - -where eul = 0.57721566490153286061 is Euler's constant. -The integrals are evaluated by power series for x < 8 -and by Chebyshev expansions for x between 8 and 88. -For large x, both functions approach exp(x)/2x. -Arguments greater than 88 in magnitude return MAXNUM. - - -ACCURACY: - -Test interval 0 to 88. - Relative error: -arithmetic function # trials peak rms - IEEE Shi 30000 6.9e-16 1.6e-16 - Absolute error, except relative when |Chi| > 1: - IEEE Chi 30000 8.4e-16 1.4e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -void hyperbolicsinecosineintegrals(const double x, double &shi, double &chi) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::hyperbolicsinecosineintegrals(x, &shi, &chi, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS IMPLEMENTATION OF COMPUTATIONAL CORE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ -static double gammafunc_gammastirf(double x, ae_state *_state); - - - - - - - - -static void bessel_besselmfirstcheb(double c, - double* b0, - double* b1, - double* b2, - ae_state *_state); -static void bessel_besselmnextcheb(double x, - double c, - double* b0, - double* b1, - double* b2, - ae_state *_state); -static void bessel_besselm1firstcheb(double c, - double* b0, - double* b1, - double* b2, - ae_state *_state); -static void bessel_besselm1nextcheb(double x, - double c, - double* b0, - double* b1, - double* b2, - ae_state *_state); -static void bessel_besselasympt0(double x, - double* pzero, - double* qzero, - ae_state *_state); -static void bessel_besselasympt1(double x, - double* pzero, - double* qzero, - ae_state *_state); - - - - -static double ibetaf_incompletebetafe(double a, - double b, - double x, - double big, - double biginv, - ae_state *_state); -static double ibetaf_incompletebetafe2(double a, - double b, - double x, - double big, - double biginv, - ae_state *_state); -static double ibetaf_incompletebetaps(double a, - double b, - double x, - double maxgam, - ae_state *_state); - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -static void trigintegrals_chebiterationshichi(double x, - double c, - double* b0, - double* b1, - double* b2, - ae_state *_state); - - - - - -/************************************************************************* -Gamma function - -Input parameters: - X - argument - -Domain: - 0 < X < 171.6 - -170 < X < 0, X is not an integer. - -Relative error: - arithmetic domain # trials peak rms - IEEE -170,-33 20000 2.3e-15 3.3e-16 - IEEE -33, 33 20000 9.4e-16 2.2e-16 - IEEE 33, 171.6 20000 2.3e-15 3.2e-16 - -Cephes Math Library Release 2.8: June, 2000 -Original copyright 1984, 1987, 1989, 1992, 2000 by Stephen L. Moshier -Translated to AlgoPascal by Bochkanov Sergey (2005, 2006, 2007). -*************************************************************************/ -double gammafunction(double x, ae_state *_state) -{ -#ifndef ALGLIB_INTERCEPTS_SPECFUNCS - double p; - double pp; - double q; - double qq; - double z; - ae_int_t i; - double sgngam; - double result; - - - sgngam = 1; - q = ae_fabs(x, _state); - if( ae_fp_greater(q,33.0) ) - { - if( ae_fp_less(x,0.0) ) - { - p = ae_ifloor(q, _state); - i = ae_round(p, _state); - if( i%2==0 ) - { - sgngam = -1; - } - z = q-p; - if( ae_fp_greater(z,0.5) ) - { - p = p+1; - z = q-p; - } - z = q*ae_sin(ae_pi*z, _state); - z = ae_fabs(z, _state); - z = ae_pi/(z*gammafunc_gammastirf(q, _state)); - } - else - { - z = gammafunc_gammastirf(x, _state); - } - result = sgngam*z; - return result; - } - z = 1; - while(ae_fp_greater_eq(x,3)) - { - x = x-1; - z = z*x; - } - while(ae_fp_less(x,0)) - { - if( ae_fp_greater(x,-0.000000001) ) - { - result = z/((1+0.5772156649015329*x)*x); - return result; - } - z = z/x; - x = x+1; - } - while(ae_fp_less(x,2)) - { - if( ae_fp_less(x,0.000000001) ) - { - result = z/((1+0.5772156649015329*x)*x); - return result; - } - z = z/x; - x = x+1.0; - } - if( ae_fp_eq(x,2) ) - { - result = z; - return result; - } - x = x-2.0; - pp = 1.60119522476751861407E-4; - pp = 1.19135147006586384913E-3+x*pp; - pp = 1.04213797561761569935E-2+x*pp; - pp = 4.76367800457137231464E-2+x*pp; - pp = 2.07448227648435975150E-1+x*pp; - pp = 4.94214826801497100753E-1+x*pp; - pp = 9.99999999999999996796E-1+x*pp; - qq = -2.31581873324120129819E-5; - qq = 5.39605580493303397842E-4+x*qq; - qq = -4.45641913851797240494E-3+x*qq; - qq = 1.18139785222060435552E-2+x*qq; - qq = 3.58236398605498653373E-2+x*qq; - qq = -2.34591795718243348568E-1+x*qq; - qq = 7.14304917030273074085E-2+x*qq; - qq = 1.00000000000000000320+x*qq; - result = z*pp/qq; - return result; -#else - return _ialglib_i_gammafunction(x); -#endif -} - - -/************************************************************************* -Natural logarithm of gamma function - -Input parameters: - X - argument - -Result: - logarithm of the absolute value of the Gamma(X). - -Output parameters: - SgnGam - sign(Gamma(X)) - -Domain: - 0 < X < 2.55e305 - -2.55e305 < X < 0, X is not an integer. - -ACCURACY: -arithmetic domain # trials peak rms - IEEE 0, 3 28000 5.4e-16 1.1e-16 - IEEE 2.718, 2.556e305 40000 3.5e-16 8.3e-17 -The error criterion was relative when the function magnitude -was greater than one but absolute when it was less than one. - -The following test used the relative error criterion, though -at certain points the relative error could be much higher than -indicated. - IEEE -200, -4 10000 4.8e-16 1.3e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1989, 1992, 2000 by Stephen L. Moshier -Translated to AlgoPascal by Bochkanov Sergey (2005, 2006, 2007). -*************************************************************************/ -double lngamma(double x, double* sgngam, ae_state *_state) -{ -#ifndef ALGLIB_INTERCEPTS_SPECFUNCS - double a; - double b; - double c; - double p; - double q; - double u; - double w; - double z; - ae_int_t i; - double logpi; - double ls2pi; - double tmp; - double result; - - *sgngam = 0; - - *sgngam = 1; - logpi = 1.14472988584940017414; - ls2pi = 0.91893853320467274178; - if( ae_fp_less(x,-34.0) ) - { - q = -x; - w = lngamma(q, &tmp, _state); - p = ae_ifloor(q, _state); - i = ae_round(p, _state); - if( i%2==0 ) - { - *sgngam = -1; - } - else - { - *sgngam = 1; - } - z = q-p; - if( ae_fp_greater(z,0.5) ) - { - p = p+1; - z = p-q; - } - z = q*ae_sin(ae_pi*z, _state); - result = logpi-ae_log(z, _state)-w; - return result; - } - if( ae_fp_less(x,13) ) - { - z = 1; - p = 0; - u = x; - while(ae_fp_greater_eq(u,3)) - { - p = p-1; - u = x+p; - z = z*u; - } - while(ae_fp_less(u,2)) - { - z = z/u; - p = p+1; - u = x+p; - } - if( ae_fp_less(z,0) ) - { - *sgngam = -1; - z = -z; - } - else - { - *sgngam = 1; - } - if( ae_fp_eq(u,2) ) - { - result = ae_log(z, _state); - return result; - } - p = p-2; - x = x+p; - b = -1378.25152569120859100; - b = -38801.6315134637840924+x*b; - b = -331612.992738871184744+x*b; - b = -1162370.97492762307383+x*b; - b = -1721737.00820839662146+x*b; - b = -853555.664245765465627+x*b; - c = 1; - c = -351.815701436523470549+x*c; - c = -17064.2106651881159223+x*c; - c = -220528.590553854454839+x*c; - c = -1139334.44367982507207+x*c; - c = -2532523.07177582951285+x*c; - c = -2018891.41433532773231+x*c; - p = x*b/c; - result = ae_log(z, _state)+p; - return result; - } - q = (x-0.5)*ae_log(x, _state)-x+ls2pi; - if( ae_fp_greater(x,100000000) ) - { - result = q; - return result; - } - p = 1/(x*x); - if( ae_fp_greater_eq(x,1000.0) ) - { - q = q+((7.9365079365079365079365*0.0001*p-2.7777777777777777777778*0.001)*p+0.0833333333333333333333)/x; - } - else - { - a = 8.11614167470508450300*0.0001; - a = -5.95061904284301438324*0.0001+p*a; - a = 7.93650340457716943945*0.0001+p*a; - a = -2.77777777730099687205*0.001+p*a; - a = 8.33333333333331927722*0.01+p*a; - q = q+a/x; - } - result = q; - return result; -#else - return _ialglib_i_lngamma(x, sgngam); -#endif -} - - -static double gammafunc_gammastirf(double x, ae_state *_state) -{ - double y; - double w; - double v; - double stir; - double result; - - - w = 1/x; - stir = 7.87311395793093628397E-4; - stir = -2.29549961613378126380E-4+w*stir; - stir = -2.68132617805781232825E-3+w*stir; - stir = 3.47222221605458667310E-3+w*stir; - stir = 8.33333333333482257126E-2+w*stir; - w = 1+w*stir; - y = ae_exp(x, _state); - if( ae_fp_greater(x,143.01608) ) - { - v = ae_pow(x, 0.5*x-0.25, _state); - y = v*(v/y); - } - else - { - y = ae_pow(x, x-0.5, _state)/y; - } - result = 2.50662827463100050242*y*w; - return result; -} - - - - -/************************************************************************* -Error function - -The integral is - - x - - - 2 | | 2 - erf(x) = -------- | exp( - t ) dt. - sqrt(pi) | | - - - 0 - -For 0 <= |x| < 1, erf(x) = x * P4(x**2)/Q5(x**2); otherwise -erf(x) = 1 - erfc(x). - - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0,1 30000 3.7e-16 1.0e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier -*************************************************************************/ -double errorfunction(double x, ae_state *_state) -{ - double xsq; - double s; - double p; - double q; - double result; - - - s = ae_sign(x, _state); - x = ae_fabs(x, _state); - if( ae_fp_less(x,0.5) ) - { - xsq = x*x; - p = 0.007547728033418631287834; - p = -0.288805137207594084924010+xsq*p; - p = 14.3383842191748205576712+xsq*p; - p = 38.0140318123903008244444+xsq*p; - p = 3017.82788536507577809226+xsq*p; - p = 7404.07142710151470082064+xsq*p; - p = 80437.3630960840172832162+xsq*p; - q = 0.0; - q = 1.00000000000000000000000+xsq*q; - q = 38.0190713951939403753468+xsq*q; - q = 658.070155459240506326937+xsq*q; - q = 6379.60017324428279487120+xsq*q; - q = 34216.5257924628539769006+xsq*q; - q = 80437.3630960840172826266+xsq*q; - result = s*1.1283791670955125738961589031*x*p/q; - return result; - } - if( ae_fp_greater_eq(x,10) ) - { - result = s; - return result; - } - result = s*(1-errorfunctionc(x, _state)); - return result; -} - - -/************************************************************************* -Complementary error function - - 1 - erf(x) = - - inf. - - - 2 | | 2 - erfc(x) = -------- | exp( - t ) dt - sqrt(pi) | | - - - x - - -For small x, erfc(x) = 1 - erf(x); otherwise rational -approximations are computed. - - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0,26.6417 30000 5.7e-14 1.5e-14 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier -*************************************************************************/ -double errorfunctionc(double x, ae_state *_state) -{ - double p; - double q; - double result; - - - if( ae_fp_less(x,0) ) - { - result = 2-errorfunctionc(-x, _state); - return result; - } - if( ae_fp_less(x,0.5) ) - { - result = 1.0-errorfunction(x, _state); - return result; - } - if( ae_fp_greater_eq(x,10) ) - { - result = 0; - return result; - } - p = 0.0; - p = 0.5641877825507397413087057563+x*p; - p = 9.675807882987265400604202961+x*p; - p = 77.08161730368428609781633646+x*p; - p = 368.5196154710010637133875746+x*p; - p = 1143.262070703886173606073338+x*p; - p = 2320.439590251635247384768711+x*p; - p = 2898.0293292167655611275846+x*p; - p = 1826.3348842295112592168999+x*p; - q = 1.0; - q = 17.14980943627607849376131193+x*q; - q = 137.1255960500622202878443578+x*q; - q = 661.7361207107653469211984771+x*q; - q = 2094.384367789539593790281779+x*q; - q = 4429.612803883682726711528526+x*q; - q = 6089.5424232724435504633068+x*q; - q = 4958.82756472114071495438422+x*q; - q = 1826.3348842295112595576438+x*q; - result = ae_exp(-ae_sqr(x, _state), _state)*p/q; - return result; -} - - -/************************************************************************* -Normal distribution function - -Returns the area under the Gaussian probability density -function, integrated from minus infinity to x: - - x - - - 1 | | 2 - ndtr(x) = --------- | exp( - t /2 ) dt - sqrt(2pi) | | - - - -inf. - - = ( 1 + erf(z) ) / 2 - = erfc(z) / 2 - -where z = x/sqrt(2). Computation is via the functions -erf and erfc. - - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE -13,0 30000 3.4e-14 6.7e-15 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier -*************************************************************************/ -double normaldistribution(double x, ae_state *_state) -{ - double result; - - - result = 0.5*(errorfunction(x/1.41421356237309504880, _state)+1); - return result; -} - - -/************************************************************************* -Inverse of the error function - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier -*************************************************************************/ -double inverf(double e, ae_state *_state) -{ - double result; - - - result = invnormaldistribution(0.5*(e+1), _state)/ae_sqrt(2, _state); - return result; -} - - -/************************************************************************* -Inverse of Normal distribution function - -Returns the argument, x, for which the area under the -Gaussian probability density function (integrated from -minus infinity to x) is equal to y. - - -For small arguments 0 < y < exp(-2), the program computes -z = sqrt( -2.0 * log(y) ); then the approximation is -x = z - log(z)/z - (1/z) P(1/z) / Q(1/z). -There are two rational functions P/Q, one for 0 < y < exp(-32) -and the other for y up to exp(-2). For larger arguments, -w = y - 0.5, and x/sqrt(2pi) = w + w**3 R(w**2)/S(w**2)). - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0.125, 1 20000 7.2e-16 1.3e-16 - IEEE 3e-308, 0.135 50000 4.6e-16 9.8e-17 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier -*************************************************************************/ -double invnormaldistribution(double y0, ae_state *_state) -{ - double expm2; - double s2pi; - double x; - double y; - double z; - double y2; - double x0; - double x1; - ae_int_t code; - double p0; - double q0; - double p1; - double q1; - double p2; - double q2; - double result; - - - expm2 = 0.13533528323661269189; - s2pi = 2.50662827463100050242; - if( ae_fp_less_eq(y0,0) ) - { - result = -ae_maxrealnumber; - return result; - } - if( ae_fp_greater_eq(y0,1) ) - { - result = ae_maxrealnumber; - return result; - } - code = 1; - y = y0; - if( ae_fp_greater(y,1.0-expm2) ) - { - y = 1.0-y; - code = 0; - } - if( ae_fp_greater(y,expm2) ) - { - y = y-0.5; - y2 = y*y; - p0 = -59.9633501014107895267; - p0 = 98.0010754185999661536+y2*p0; - p0 = -56.6762857469070293439+y2*p0; - p0 = 13.9312609387279679503+y2*p0; - p0 = -1.23916583867381258016+y2*p0; - q0 = 1; - q0 = 1.95448858338141759834+y2*q0; - q0 = 4.67627912898881538453+y2*q0; - q0 = 86.3602421390890590575+y2*q0; - q0 = -225.462687854119370527+y2*q0; - q0 = 200.260212380060660359+y2*q0; - q0 = -82.0372256168333339912+y2*q0; - q0 = 15.9056225126211695515+y2*q0; - q0 = -1.18331621121330003142+y2*q0; - x = y+y*y2*p0/q0; - x = x*s2pi; - result = x; - return result; - } - x = ae_sqrt(-2.0*ae_log(y, _state), _state); - x0 = x-ae_log(x, _state)/x; - z = 1.0/x; - if( ae_fp_less(x,8.0) ) - { - p1 = 4.05544892305962419923; - p1 = 31.5251094599893866154+z*p1; - p1 = 57.1628192246421288162+z*p1; - p1 = 44.0805073893200834700+z*p1; - p1 = 14.6849561928858024014+z*p1; - p1 = 2.18663306850790267539+z*p1; - p1 = -1.40256079171354495875*0.1+z*p1; - p1 = -3.50424626827848203418*0.01+z*p1; - p1 = -8.57456785154685413611*0.0001+z*p1; - q1 = 1; - q1 = 15.7799883256466749731+z*q1; - q1 = 45.3907635128879210584+z*q1; - q1 = 41.3172038254672030440+z*q1; - q1 = 15.0425385692907503408+z*q1; - q1 = 2.50464946208309415979+z*q1; - q1 = -1.42182922854787788574*0.1+z*q1; - q1 = -3.80806407691578277194*0.01+z*q1; - q1 = -9.33259480895457427372*0.0001+z*q1; - x1 = z*p1/q1; - } - else - { - p2 = 3.23774891776946035970; - p2 = 6.91522889068984211695+z*p2; - p2 = 3.93881025292474443415+z*p2; - p2 = 1.33303460815807542389+z*p2; - p2 = 2.01485389549179081538*0.1+z*p2; - p2 = 1.23716634817820021358*0.01+z*p2; - p2 = 3.01581553508235416007*0.0001+z*p2; - p2 = 2.65806974686737550832*0.000001+z*p2; - p2 = 6.23974539184983293730*0.000000001+z*p2; - q2 = 1; - q2 = 6.02427039364742014255+z*q2; - q2 = 3.67983563856160859403+z*q2; - q2 = 1.37702099489081330271+z*q2; - q2 = 2.16236993594496635890*0.1+z*q2; - q2 = 1.34204006088543189037*0.01+z*q2; - q2 = 3.28014464682127739104*0.0001+z*q2; - q2 = 2.89247864745380683936*0.000001+z*q2; - q2 = 6.79019408009981274425*0.000000001+z*q2; - x1 = z*p2/q2; - } - x = x0-x1; - if( code!=0 ) - { - x = -x; - } - result = x; - return result; -} - - - - -/************************************************************************* -Incomplete gamma integral - -The function is defined by - - x - - - 1 | | -t a-1 - igam(a,x) = ----- | e t dt. - - | | - | (a) - - 0 - - -In this implementation both arguments must be positive. -The integral is evaluated by either a power series or -continued fraction expansion, depending on the relative -values of a and x. - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0,30 200000 3.6e-14 2.9e-15 - IEEE 0,100 300000 9.9e-14 1.5e-14 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1985, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double incompletegamma(double a, double x, ae_state *_state) -{ - double igammaepsilon; - double ans; - double ax; - double c; - double r; - double tmp; - double result; - - - igammaepsilon = 0.000000000000001; - if( ae_fp_less_eq(x,0)||ae_fp_less_eq(a,0) ) - { - result = 0; - return result; - } - if( ae_fp_greater(x,1)&&ae_fp_greater(x,a) ) - { - result = 1-incompletegammac(a, x, _state); - return result; - } - ax = a*ae_log(x, _state)-x-lngamma(a, &tmp, _state); - if( ae_fp_less(ax,-709.78271289338399) ) - { - result = 0; - return result; - } - ax = ae_exp(ax, _state); - r = a; - c = 1; - ans = 1; - do - { - r = r+1; - c = c*x/r; - ans = ans+c; - } - while(ae_fp_greater(c/ans,igammaepsilon)); - result = ans*ax/a; - return result; -} - - -/************************************************************************* -Complemented incomplete gamma integral - -The function is defined by - - - igamc(a,x) = 1 - igam(a,x) - - inf. - - - 1 | | -t a-1 - = ----- | e t dt. - - | | - | (a) - - x - - -In this implementation both arguments must be positive. -The integral is evaluated by either a power series or -continued fraction expansion, depending on the relative -values of a and x. - -ACCURACY: - -Tested at random a, x. - a x Relative error: -arithmetic domain domain # trials peak rms - IEEE 0.5,100 0,100 200000 1.9e-14 1.7e-15 - IEEE 0.01,0.5 0,100 200000 1.4e-13 1.6e-15 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1985, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double incompletegammac(double a, double x, ae_state *_state) -{ - double igammaepsilon; - double igammabignumber; - double igammabignumberinv; - double ans; - double ax; - double c; - double yc; - double r; - double t; - double y; - double z; - double pk; - double pkm1; - double pkm2; - double qk; - double qkm1; - double qkm2; - double tmp; - double result; - - - igammaepsilon = 0.000000000000001; - igammabignumber = 4503599627370496.0; - igammabignumberinv = 2.22044604925031308085*0.0000000000000001; - if( ae_fp_less_eq(x,0)||ae_fp_less_eq(a,0) ) - { - result = 1; - return result; - } - if( ae_fp_less(x,1)||ae_fp_less(x,a) ) - { - result = 1-incompletegamma(a, x, _state); - return result; - } - ax = a*ae_log(x, _state)-x-lngamma(a, &tmp, _state); - if( ae_fp_less(ax,-709.78271289338399) ) - { - result = 0; - return result; - } - ax = ae_exp(ax, _state); - y = 1-a; - z = x+y+1; - c = 0; - pkm2 = 1; - qkm2 = x; - pkm1 = x+1; - qkm1 = z*x; - ans = pkm1/qkm1; - do - { - c = c+1; - y = y+1; - z = z+2; - yc = y*c; - pk = pkm1*z-pkm2*yc; - qk = qkm1*z-qkm2*yc; - if( ae_fp_neq(qk,0) ) - { - r = pk/qk; - t = ae_fabs((ans-r)/r, _state); - ans = r; - } - else - { - t = 1; - } - pkm2 = pkm1; - pkm1 = pk; - qkm2 = qkm1; - qkm1 = qk; - if( ae_fp_greater(ae_fabs(pk, _state),igammabignumber) ) - { - pkm2 = pkm2*igammabignumberinv; - pkm1 = pkm1*igammabignumberinv; - qkm2 = qkm2*igammabignumberinv; - qkm1 = qkm1*igammabignumberinv; - } - } - while(ae_fp_greater(t,igammaepsilon)); - result = ans*ax; - return result; -} - - -/************************************************************************* -Inverse of complemented incomplete gamma integral - -Given p, the function finds x such that - - igamc( a, x ) = p. - -Starting with the approximate value - - 3 - x = a t - - where - - t = 1 - d - ndtri(p) sqrt(d) - -and - - d = 1/9a, - -the routine performs up to 10 Newton iterations to find the -root of igamc(a,x) - p = 0. - -ACCURACY: - -Tested at random a, p in the intervals indicated. - - a p Relative error: -arithmetic domain domain # trials peak rms - IEEE 0.5,100 0,0.5 100000 1.0e-14 1.7e-15 - IEEE 0.01,0.5 0,0.5 100000 9.0e-14 3.4e-15 - IEEE 0.5,10000 0,0.5 20000 2.3e-13 3.8e-14 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double invincompletegammac(double a, double y0, ae_state *_state) -{ - double igammaepsilon; - double iinvgammabignumber; - double x0; - double x1; - double x; - double yl; - double yh; - double y; - double d; - double lgm; - double dithresh; - ae_int_t i; - ae_int_t dir; - double tmp; - double result; - - - igammaepsilon = 0.000000000000001; - iinvgammabignumber = 4503599627370496.0; - x0 = iinvgammabignumber; - yl = 0; - x1 = 0; - yh = 1; - dithresh = 5*igammaepsilon; - d = 1/(9*a); - y = 1-d-invnormaldistribution(y0, _state)*ae_sqrt(d, _state); - x = a*y*y*y; - lgm = lngamma(a, &tmp, _state); - i = 0; - while(i<10) - { - if( ae_fp_greater(x,x0)||ae_fp_less(x,x1) ) - { - d = 0.0625; - break; - } - y = incompletegammac(a, x, _state); - if( ae_fp_less(y,yl)||ae_fp_greater(y,yh) ) - { - d = 0.0625; - break; - } - if( ae_fp_less(y,y0) ) - { - x0 = x; - yl = y; - } - else - { - x1 = x; - yh = y; - } - d = (a-1)*ae_log(x, _state)-x-lgm; - if( ae_fp_less(d,-709.78271289338399) ) - { - d = 0.0625; - break; - } - d = -ae_exp(d, _state); - d = (y-y0)/d; - if( ae_fp_less(ae_fabs(d/x, _state),igammaepsilon) ) - { - result = x; - return result; - } - x = x-d; - i = i+1; - } - if( ae_fp_eq(x0,iinvgammabignumber) ) - { - if( ae_fp_less_eq(x,0) ) - { - x = 1; - } - while(ae_fp_eq(x0,iinvgammabignumber)) - { - x = (1+d)*x; - y = incompletegammac(a, x, _state); - if( ae_fp_less(y,y0) ) - { - x0 = x; - yl = y; - break; - } - d = d+d; - } - } - d = 0.5; - dir = 0; - i = 0; - while(i<400) - { - x = x1+d*(x0-x1); - y = incompletegammac(a, x, _state); - lgm = (x0-x1)/(x1+x0); - if( ae_fp_less(ae_fabs(lgm, _state),dithresh) ) - { - break; - } - lgm = (y-y0)/y0; - if( ae_fp_less(ae_fabs(lgm, _state),dithresh) ) - { - break; - } - if( ae_fp_less_eq(x,0.0) ) - { - break; - } - if( ae_fp_greater_eq(y,y0) ) - { - x1 = x; - yh = y; - if( dir<0 ) - { - dir = 0; - d = 0.5; - } - else - { - if( dir>1 ) - { - d = 0.5*d+0.5; - } - else - { - d = (y0-yl)/(yh-yl); - } - } - dir = dir+1; - } - else - { - x0 = x; - yl = y; - if( dir>0 ) - { - dir = 0; - d = 0.5; - } - else - { - if( dir<-1 ) - { - d = 0.5*d; - } - else - { - d = (y0-yl)/(yh-yl); - } - } - dir = dir-1; - } - i = i+1; - } - result = x; - return result; -} - - - - -/************************************************************************* -Airy function - -Solution of the differential equation - -y"(x) = xy. - -The function returns the two independent solutions Ai, Bi -and their first derivatives Ai'(x), Bi'(x). - -Evaluation is by power series summation for small x, -by rational minimax approximations for large x. - - - -ACCURACY: -Error criterion is absolute when function <= 1, relative -when function > 1, except * denotes relative error criterion. -For large negative x, the absolute error increases as x^1.5. -For large positive x, the relative error increases as x^1.5. - -Arithmetic domain function # trials peak rms -IEEE -10, 0 Ai 10000 1.6e-15 2.7e-16 -IEEE 0, 10 Ai 10000 2.3e-14* 1.8e-15* -IEEE -10, 0 Ai' 10000 4.6e-15 7.6e-16 -IEEE 0, 10 Ai' 10000 1.8e-14* 1.5e-15* -IEEE -10, 10 Bi 30000 4.2e-15 5.3e-16 -IEEE -10, 10 Bi' 30000 4.9e-15 7.3e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier -*************************************************************************/ -void airy(double x, - double* ai, - double* aip, - double* bi, - double* bip, - ae_state *_state) -{ - double z; - double zz; - double t; - double f; - double g; - double uf; - double ug; - double k; - double zeta; - double theta; - ae_int_t domflg; - double c1; - double c2; - double sqrt3; - double sqpii; - double afn; - double afd; - double agn; - double agd; - double apfn; - double apfd; - double apgn; - double apgd; - double an; - double ad; - double apn; - double apd; - double bn16; - double bd16; - double bppn; - double bppd; - - *ai = 0; - *aip = 0; - *bi = 0; - *bip = 0; - - sqpii = 5.64189583547756286948E-1; - c1 = 0.35502805388781723926; - c2 = 0.258819403792806798405; - sqrt3 = 1.732050807568877293527; - domflg = 0; - if( ae_fp_greater(x,25.77) ) - { - *ai = 0; - *aip = 0; - *bi = ae_maxrealnumber; - *bip = ae_maxrealnumber; - return; - } - if( ae_fp_less(x,-2.09) ) - { - domflg = 15; - t = ae_sqrt(-x, _state); - zeta = -2.0*x*t/3.0; - t = ae_sqrt(t, _state); - k = sqpii/t; - z = 1.0/zeta; - zz = z*z; - afn = -1.31696323418331795333E-1; - afn = afn*zz-6.26456544431912369773E-1; - afn = afn*zz-6.93158036036933542233E-1; - afn = afn*zz-2.79779981545119124951E-1; - afn = afn*zz-4.91900132609500318020E-2; - afn = afn*zz-4.06265923594885404393E-3; - afn = afn*zz-1.59276496239262096340E-4; - afn = afn*zz-2.77649108155232920844E-6; - afn = afn*zz-1.67787698489114633780E-8; - afd = 1.00000000000000000000E0; - afd = afd*zz+1.33560420706553243746E1; - afd = afd*zz+3.26825032795224613948E1; - afd = afd*zz+2.67367040941499554804E1; - afd = afd*zz+9.18707402907259625840E0; - afd = afd*zz+1.47529146771666414581E0; - afd = afd*zz+1.15687173795188044134E-1; - afd = afd*zz+4.40291641615211203805E-3; - afd = afd*zz+7.54720348287414296618E-5; - afd = afd*zz+4.51850092970580378464E-7; - uf = 1.0+zz*afn/afd; - agn = 1.97339932091685679179E-2; - agn = agn*zz+3.91103029615688277255E-1; - agn = agn*zz+1.06579897599595591108E0; - agn = agn*zz+9.39169229816650230044E-1; - agn = agn*zz+3.51465656105547619242E-1; - agn = agn*zz+6.33888919628925490927E-2; - agn = agn*zz+5.85804113048388458567E-3; - agn = agn*zz+2.82851600836737019778E-4; - agn = agn*zz+6.98793669997260967291E-6; - agn = agn*zz+8.11789239554389293311E-8; - agn = agn*zz+3.41551784765923618484E-10; - agd = 1.00000000000000000000E0; - agd = agd*zz+9.30892908077441974853E0; - agd = agd*zz+1.98352928718312140417E1; - agd = agd*zz+1.55646628932864612953E1; - agd = agd*zz+5.47686069422975497931E0; - agd = agd*zz+9.54293611618961883998E-1; - agd = agd*zz+8.64580826352392193095E-2; - agd = agd*zz+4.12656523824222607191E-3; - agd = agd*zz+1.01259085116509135510E-4; - agd = agd*zz+1.17166733214413521882E-6; - agd = agd*zz+4.91834570062930015649E-9; - ug = z*agn/agd; - theta = zeta+0.25*ae_pi; - f = ae_sin(theta, _state); - g = ae_cos(theta, _state); - *ai = k*(f*uf-g*ug); - *bi = k*(g*uf+f*ug); - apfn = 1.85365624022535566142E-1; - apfn = apfn*zz+8.86712188052584095637E-1; - apfn = apfn*zz+9.87391981747398547272E-1; - apfn = apfn*zz+4.01241082318003734092E-1; - apfn = apfn*zz+7.10304926289631174579E-2; - apfn = apfn*zz+5.90618657995661810071E-3; - apfn = apfn*zz+2.33051409401776799569E-4; - apfn = apfn*zz+4.08718778289035454598E-6; - apfn = apfn*zz+2.48379932900442457853E-8; - apfd = 1.00000000000000000000E0; - apfd = apfd*zz+1.47345854687502542552E1; - apfd = apfd*zz+3.75423933435489594466E1; - apfd = apfd*zz+3.14657751203046424330E1; - apfd = apfd*zz+1.09969125207298778536E1; - apfd = apfd*zz+1.78885054766999417817E0; - apfd = apfd*zz+1.41733275753662636873E-1; - apfd = apfd*zz+5.44066067017226003627E-3; - apfd = apfd*zz+9.39421290654511171663E-5; - apfd = apfd*zz+5.65978713036027009243E-7; - uf = 1.0+zz*apfn/apfd; - apgn = -3.55615429033082288335E-2; - apgn = apgn*zz-6.37311518129435504426E-1; - apgn = apgn*zz-1.70856738884312371053E0; - apgn = apgn*zz-1.50221872117316635393E0; - apgn = apgn*zz-5.63606665822102676611E-1; - apgn = apgn*zz-1.02101031120216891789E-1; - apgn = apgn*zz-9.48396695961445269093E-3; - apgn = apgn*zz-4.60325307486780994357E-4; - apgn = apgn*zz-1.14300836484517375919E-5; - apgn = apgn*zz-1.33415518685547420648E-7; - apgn = apgn*zz-5.63803833958893494476E-10; - apgd = 1.00000000000000000000E0; - apgd = apgd*zz+9.85865801696130355144E0; - apgd = apgd*zz+2.16401867356585941885E1; - apgd = apgd*zz+1.73130776389749389525E1; - apgd = apgd*zz+6.17872175280828766327E0; - apgd = apgd*zz+1.08848694396321495475E0; - apgd = apgd*zz+9.95005543440888479402E-2; - apgd = apgd*zz+4.78468199683886610842E-3; - apgd = apgd*zz+1.18159633322838625562E-4; - apgd = apgd*zz+1.37480673554219441465E-6; - apgd = apgd*zz+5.79912514929147598821E-9; - ug = z*apgn/apgd; - k = sqpii*t; - *aip = -k*(g*uf+f*ug); - *bip = k*(f*uf-g*ug); - return; - } - if( ae_fp_greater_eq(x,2.09) ) - { - domflg = 5; - t = ae_sqrt(x, _state); - zeta = 2.0*x*t/3.0; - g = ae_exp(zeta, _state); - t = ae_sqrt(t, _state); - k = 2.0*t*g; - z = 1.0/zeta; - an = 3.46538101525629032477E-1; - an = an*z+1.20075952739645805542E1; - an = an*z+7.62796053615234516538E1; - an = an*z+1.68089224934630576269E2; - an = an*z+1.59756391350164413639E2; - an = an*z+7.05360906840444183113E1; - an = an*z+1.40264691163389668864E1; - an = an*z+9.99999999999999995305E-1; - ad = 5.67594532638770212846E-1; - ad = ad*z+1.47562562584847203173E1; - ad = ad*z+8.45138970141474626562E1; - ad = ad*z+1.77318088145400459522E2; - ad = ad*z+1.64234692871529701831E2; - ad = ad*z+7.14778400825575695274E1; - ad = ad*z+1.40959135607834029598E1; - ad = ad*z+1.00000000000000000470E0; - f = an/ad; - *ai = sqpii*f/k; - k = -0.5*sqpii*t/g; - apn = 6.13759184814035759225E-1; - apn = apn*z+1.47454670787755323881E1; - apn = apn*z+8.20584123476060982430E1; - apn = apn*z+1.71184781360976385540E2; - apn = apn*z+1.59317847137141783523E2; - apn = apn*z+6.99778599330103016170E1; - apn = apn*z+1.39470856980481566958E1; - apn = apn*z+1.00000000000000000550E0; - apd = 3.34203677749736953049E-1; - apd = apd*z+1.11810297306158156705E1; - apd = apd*z+7.11727352147859965283E1; - apd = apd*z+1.58778084372838313640E2; - apd = apd*z+1.53206427475809220834E2; - apd = apd*z+6.86752304592780337944E1; - apd = apd*z+1.38498634758259442477E1; - apd = apd*z+9.99999999999999994502E-1; - f = apn/apd; - *aip = f*k; - if( ae_fp_greater(x,8.3203353) ) - { - bn16 = -2.53240795869364152689E-1; - bn16 = bn16*z+5.75285167332467384228E-1; - bn16 = bn16*z-3.29907036873225371650E-1; - bn16 = bn16*z+6.44404068948199951727E-2; - bn16 = bn16*z-3.82519546641336734394E-3; - bd16 = 1.00000000000000000000E0; - bd16 = bd16*z-7.15685095054035237902E0; - bd16 = bd16*z+1.06039580715664694291E1; - bd16 = bd16*z-5.23246636471251500874E0; - bd16 = bd16*z+9.57395864378383833152E-1; - bd16 = bd16*z-5.50828147163549611107E-2; - f = z*bn16/bd16; - k = sqpii*g; - *bi = k*(1.0+f)/t; - bppn = 4.65461162774651610328E-1; - bppn = bppn*z-1.08992173800493920734E0; - bppn = bppn*z+6.38800117371827987759E-1; - bppn = bppn*z-1.26844349553102907034E-1; - bppn = bppn*z+7.62487844342109852105E-3; - bppd = 1.00000000000000000000E0; - bppd = bppd*z-8.70622787633159124240E0; - bppd = bppd*z+1.38993162704553213172E1; - bppd = bppd*z-7.14116144616431159572E0; - bppd = bppd*z+1.34008595960680518666E0; - bppd = bppd*z-7.84273211323341930448E-2; - f = z*bppn/bppd; - *bip = k*t*(1.0+f); - return; - } - } - f = 1.0; - g = x; - t = 1.0; - uf = 1.0; - ug = x; - k = 1.0; - z = x*x*x; - while(ae_fp_greater(t,ae_machineepsilon)) - { - uf = uf*z; - k = k+1.0; - uf = uf/k; - ug = ug*z; - k = k+1.0; - ug = ug/k; - uf = uf/k; - f = f+uf; - k = k+1.0; - ug = ug/k; - g = g+ug; - t = ae_fabs(uf/f, _state); - } - uf = c1*f; - ug = c2*g; - if( domflg%2==0 ) - { - *ai = uf-ug; - } - if( domflg/2%2==0 ) - { - *bi = sqrt3*(uf+ug); - } - k = 4.0; - uf = x*x/2.0; - ug = z/3.0; - f = uf; - g = 1.0+ug; - uf = uf/3.0; - t = 1.0; - while(ae_fp_greater(t,ae_machineepsilon)) - { - uf = uf*z; - ug = ug/k; - k = k+1.0; - ug = ug*z; - uf = uf/k; - f = f+uf; - k = k+1.0; - ug = ug/k; - uf = uf/k; - g = g+ug; - k = k+1.0; - t = ae_fabs(ug/g, _state); - } - uf = c1*f; - ug = c2*g; - if( domflg/4%2==0 ) - { - *aip = uf-ug; - } - if( domflg/8%2==0 ) - { - *bip = sqrt3*(uf+ug); - } -} - - - - -/************************************************************************* -Bessel function of order zero - -Returns Bessel function of order zero of the argument. - -The domain is divided into the intervals [0, 5] and -(5, infinity). In the first interval the following rational -approximation is used: - - - 2 2 -(w - r ) (w - r ) P (w) / Q (w) - 1 2 3 8 - - 2 -where w = x and the two r's are zeros of the function. - -In the second interval, the Hankel asymptotic expansion -is employed with two rational functions of degree 6/6 -and 7/7. - -ACCURACY: - - Absolute error: -arithmetic domain # trials peak rms - IEEE 0, 30 60000 4.2e-16 1.1e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier -*************************************************************************/ -double besselj0(double x, ae_state *_state) -{ - double xsq; - double nn; - double pzero; - double qzero; - double p1; - double q1; - double result; - - - if( ae_fp_less(x,0) ) - { - x = -x; - } - if( ae_fp_greater(x,8.0) ) - { - bessel_besselasympt0(x, &pzero, &qzero, _state); - nn = x-ae_pi/4; - result = ae_sqrt(2/ae_pi/x, _state)*(pzero*ae_cos(nn, _state)-qzero*ae_sin(nn, _state)); - return result; - } - xsq = ae_sqr(x, _state); - p1 = 26857.86856980014981415848441; - p1 = -40504123.71833132706360663322+xsq*p1; - p1 = 25071582855.36881945555156435+xsq*p1; - p1 = -8085222034853.793871199468171+xsq*p1; - p1 = 1434354939140344.111664316553+xsq*p1; - p1 = -136762035308817138.6865416609+xsq*p1; - p1 = 6382059341072356562.289432465+xsq*p1; - p1 = -117915762910761053603.8440800+xsq*p1; - p1 = 493378725179413356181.6813446+xsq*p1; - q1 = 1.0; - q1 = 1363.063652328970604442810507+xsq*q1; - q1 = 1114636.098462985378182402543+xsq*q1; - q1 = 669998767.2982239671814028660+xsq*q1; - q1 = 312304311494.1213172572469442+xsq*q1; - q1 = 112775673967979.8507056031594+xsq*q1; - q1 = 30246356167094626.98627330784+xsq*q1; - q1 = 5428918384092285160.200195092+xsq*q1; - q1 = 493378725179413356211.3278438+xsq*q1; - result = p1/q1; - return result; -} - - -/************************************************************************* -Bessel function of order one - -Returns Bessel function of order one of the argument. - -The domain is divided into the intervals [0, 8] and -(8, infinity). In the first interval a 24 term Chebyshev -expansion is used. In the second, the asymptotic -trigonometric representation is employed using two -rational functions of degree 5/5. - -ACCURACY: - - Absolute error: -arithmetic domain # trials peak rms - IEEE 0, 30 30000 2.6e-16 1.1e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier -*************************************************************************/ -double besselj1(double x, ae_state *_state) -{ - double s; - double xsq; - double nn; - double pzero; - double qzero; - double p1; - double q1; - double result; - - - s = ae_sign(x, _state); - if( ae_fp_less(x,0) ) - { - x = -x; - } - if( ae_fp_greater(x,8.0) ) - { - bessel_besselasympt1(x, &pzero, &qzero, _state); - nn = x-3*ae_pi/4; - result = ae_sqrt(2/ae_pi/x, _state)*(pzero*ae_cos(nn, _state)-qzero*ae_sin(nn, _state)); - if( ae_fp_less(s,0) ) - { - result = -result; - } - return result; - } - xsq = ae_sqr(x, _state); - p1 = 2701.122710892323414856790990; - p1 = -4695753.530642995859767162166+xsq*p1; - p1 = 3413234182.301700539091292655+xsq*p1; - p1 = -1322983480332.126453125473247+xsq*p1; - p1 = 290879526383477.5409737601689+xsq*p1; - p1 = -35888175699101060.50743641413+xsq*p1; - p1 = 2316433580634002297.931815435+xsq*p1; - p1 = -66721065689249162980.20941484+xsq*p1; - p1 = 581199354001606143928.050809+xsq*p1; - q1 = 1.0; - q1 = 1606.931573481487801970916749+xsq*q1; - q1 = 1501793.594998585505921097578+xsq*q1; - q1 = 1013863514.358673989967045588+xsq*q1; - q1 = 524371026216.7649715406728642+xsq*q1; - q1 = 208166122130760.7351240184229+xsq*q1; - q1 = 60920613989175217.46105196863+xsq*q1; - q1 = 11857707121903209998.37113348+xsq*q1; - q1 = 1162398708003212287858.529400+xsq*q1; - result = s*x*p1/q1; - return result; -} - - -/************************************************************************* -Bessel function of integer order - -Returns Bessel function of order n, where n is a -(possibly negative) integer. - -The ratio of jn(x) to j0(x) is computed by backward -recurrence. First the ratio jn/jn-1 is found by a -continued fraction expansion. Then the recurrence -relating successive orders is applied until j0 or j1 is -reached. - -If n = 0 or 1 the routine for j0 or j1 is called -directly. - -ACCURACY: - - Absolute error: -arithmetic range # trials peak rms - IEEE 0, 30 5000 4.4e-16 7.9e-17 - - -Not suitable for large n or x. Use jv() (fractional order) instead. - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double besseljn(ae_int_t n, double x, ae_state *_state) -{ - double pkm2; - double pkm1; - double pk; - double xk; - double r; - double ans; - ae_int_t k; - ae_int_t sg; - double result; - - - if( n<0 ) - { - n = -n; - if( n%2==0 ) - { - sg = 1; - } - else - { - sg = -1; - } - } - else - { - sg = 1; - } - if( ae_fp_less(x,0) ) - { - if( n%2!=0 ) - { - sg = -sg; - } - x = -x; - } - if( n==0 ) - { - result = sg*besselj0(x, _state); - return result; - } - if( n==1 ) - { - result = sg*besselj1(x, _state); - return result; - } - if( n==2 ) - { - if( ae_fp_eq(x,0) ) - { - result = 0; - } - else - { - result = sg*(2.0*besselj1(x, _state)/x-besselj0(x, _state)); - } - return result; - } - if( ae_fp_less(x,ae_machineepsilon) ) - { - result = 0; - return result; - } - k = 53; - pk = 2*(n+k); - ans = pk; - xk = x*x; - do - { - pk = pk-2.0; - ans = pk-xk/ans; - k = k-1; - } - while(k!=0); - ans = x/ans; - pk = 1.0; - pkm1 = 1.0/ans; - k = n-1; - r = 2*k; - do - { - pkm2 = (pkm1*r-pk*x)/x; - pk = pkm1; - pkm1 = pkm2; - r = r-2.0; - k = k-1; - } - while(k!=0); - if( ae_fp_greater(ae_fabs(pk, _state),ae_fabs(pkm1, _state)) ) - { - ans = besselj1(x, _state)/pk; - } - else - { - ans = besselj0(x, _state)/pkm1; - } - result = sg*ans; - return result; -} - - -/************************************************************************* -Bessel function of the second kind, order zero - -Returns Bessel function of the second kind, of order -zero, of the argument. - -The domain is divided into the intervals [0, 5] and -(5, infinity). In the first interval a rational approximation -R(x) is employed to compute - y0(x) = R(x) + 2 * log(x) * j0(x) / PI. -Thus a call to j0() is required. - -In the second interval, the Hankel asymptotic expansion -is employed with two rational functions of degree 6/6 -and 7/7. - - - -ACCURACY: - - Absolute error, when y0(x) < 1; else relative error: - -arithmetic domain # trials peak rms - IEEE 0, 30 30000 1.3e-15 1.6e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier -*************************************************************************/ -double bessely0(double x, ae_state *_state) -{ - double nn; - double xsq; - double pzero; - double qzero; - double p4; - double q4; - double result; - - - if( ae_fp_greater(x,8.0) ) - { - bessel_besselasympt0(x, &pzero, &qzero, _state); - nn = x-ae_pi/4; - result = ae_sqrt(2/ae_pi/x, _state)*(pzero*ae_sin(nn, _state)+qzero*ae_cos(nn, _state)); - return result; - } - xsq = ae_sqr(x, _state); - p4 = -41370.35497933148554125235152; - p4 = 59152134.65686889654273830069+xsq*p4; - p4 = -34363712229.79040378171030138+xsq*p4; - p4 = 10255208596863.94284509167421+xsq*p4; - p4 = -1648605817185729.473122082537+xsq*p4; - p4 = 137562431639934407.8571335453+xsq*p4; - p4 = -5247065581112764941.297350814+xsq*p4; - p4 = 65874732757195549259.99402049+xsq*p4; - p4 = -27502866786291095837.01933175+xsq*p4; - q4 = 1.0; - q4 = 1282.452772478993804176329391+xsq*q4; - q4 = 1001702.641288906265666651753+xsq*q4; - q4 = 579512264.0700729537480087915+xsq*q4; - q4 = 261306575504.1081249568482092+xsq*q4; - q4 = 91620380340751.85262489147968+xsq*q4; - q4 = 23928830434997818.57439356652+xsq*q4; - q4 = 4192417043410839973.904769661+xsq*q4; - q4 = 372645883898616588198.9980+xsq*q4; - result = p4/q4+2/ae_pi*besselj0(x, _state)*ae_log(x, _state); - return result; -} - - -/************************************************************************* -Bessel function of second kind of order one - -Returns Bessel function of the second kind of order one -of the argument. - -The domain is divided into the intervals [0, 8] and -(8, infinity). In the first interval a 25 term Chebyshev -expansion is used, and a call to j1() is required. -In the second, the asymptotic trigonometric representation -is employed using two rational functions of degree 5/5. - -ACCURACY: - - Absolute error: -arithmetic domain # trials peak rms - IEEE 0, 30 30000 1.0e-15 1.3e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier -*************************************************************************/ -double bessely1(double x, ae_state *_state) -{ - double nn; - double xsq; - double pzero; - double qzero; - double p4; - double q4; - double result; - - - if( ae_fp_greater(x,8.0) ) - { - bessel_besselasympt1(x, &pzero, &qzero, _state); - nn = x-3*ae_pi/4; - result = ae_sqrt(2/ae_pi/x, _state)*(pzero*ae_sin(nn, _state)+qzero*ae_cos(nn, _state)); - return result; - } - xsq = ae_sqr(x, _state); - p4 = -2108847.540133123652824139923; - p4 = 3639488548.124002058278999428+xsq*p4; - p4 = -2580681702194.450950541426399+xsq*p4; - p4 = 956993023992168.3481121552788+xsq*p4; - p4 = -196588746272214065.8820322248+xsq*p4; - p4 = 21931073399177975921.11427556+xsq*p4; - p4 = -1212297555414509577913.561535+xsq*p4; - p4 = 26554738314348543268942.48968+xsq*p4; - p4 = -99637534243069222259967.44354+xsq*p4; - q4 = 1.0; - q4 = 1612.361029677000859332072312+xsq*q4; - q4 = 1563282.754899580604737366452+xsq*q4; - q4 = 1128686837.169442121732366891+xsq*q4; - q4 = 646534088126.5275571961681500+xsq*q4; - q4 = 297663212564727.6729292742282+xsq*q4; - q4 = 108225825940881955.2553850180+xsq*q4; - q4 = 29549879358971486742.90758119+xsq*q4; - q4 = 5435310377188854170800.653097+xsq*q4; - q4 = 508206736694124324531442.4152+xsq*q4; - result = x*p4/q4+2/ae_pi*(besselj1(x, _state)*ae_log(x, _state)-1/x); - return result; -} - - -/************************************************************************* -Bessel function of second kind of integer order - -Returns Bessel function of order n, where n is a -(possibly negative) integer. - -The function is evaluated by forward recurrence on -n, starting with values computed by the routines -y0() and y1(). - -If n = 0 or 1 the routine for y0 or y1 is called -directly. - -ACCURACY: - Absolute error, except relative - when y > 1: -arithmetic domain # trials peak rms - IEEE 0, 30 30000 3.4e-15 4.3e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double besselyn(ae_int_t n, double x, ae_state *_state) -{ - ae_int_t i; - double a; - double b; - double tmp; - double s; - double result; - - - s = 1; - if( n<0 ) - { - n = -n; - if( n%2!=0 ) - { - s = -1; - } - } - if( n==0 ) - { - result = bessely0(x, _state); - return result; - } - if( n==1 ) - { - result = s*bessely1(x, _state); - return result; - } - a = bessely0(x, _state); - b = bessely1(x, _state); - for(i=1; i<=n-1; i++) - { - tmp = b; - b = 2*i/x*b-a; - a = tmp; - } - result = s*b; - return result; -} - - -/************************************************************************* -Modified Bessel function of order zero - -Returns modified Bessel function of order zero of the -argument. - -The function is defined as i0(x) = j0( ix ). - -The range is partitioned into the two intervals [0,8] and -(8, infinity). Chebyshev polynomial expansions are employed -in each interval. - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0,30 30000 5.8e-16 1.4e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double besseli0(double x, ae_state *_state) -{ - double y; - double v; - double z; - double b0; - double b1; - double b2; - double result; - - - if( ae_fp_less(x,0) ) - { - x = -x; - } - if( ae_fp_less_eq(x,8.0) ) - { - y = x/2.0-2.0; - bessel_besselmfirstcheb(-4.41534164647933937950E-18, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, 3.33079451882223809783E-17, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, -2.43127984654795469359E-16, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, 1.71539128555513303061E-15, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, -1.16853328779934516808E-14, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, 7.67618549860493561688E-14, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, -4.85644678311192946090E-13, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, 2.95505266312963983461E-12, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, -1.72682629144155570723E-11, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, 9.67580903537323691224E-11, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, -5.18979560163526290666E-10, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, 2.65982372468238665035E-9, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, -1.30002500998624804212E-8, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, 6.04699502254191894932E-8, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, -2.67079385394061173391E-7, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, 1.11738753912010371815E-6, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, -4.41673835845875056359E-6, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, 1.64484480707288970893E-5, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, -5.75419501008210370398E-5, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, 1.88502885095841655729E-4, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, -5.76375574538582365885E-4, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, 1.63947561694133579842E-3, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, -4.32430999505057594430E-3, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, 1.05464603945949983183E-2, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, -2.37374148058994688156E-2, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, 4.93052842396707084878E-2, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, -9.49010970480476444210E-2, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, 1.71620901522208775349E-1, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, -3.04682672343198398683E-1, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, 6.76795274409476084995E-1, &b0, &b1, &b2, _state); - v = 0.5*(b0-b2); - result = ae_exp(x, _state)*v; - return result; - } - z = 32.0/x-2.0; - bessel_besselmfirstcheb(-7.23318048787475395456E-18, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, -4.83050448594418207126E-18, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, 4.46562142029675999901E-17, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, 3.46122286769746109310E-17, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, -2.82762398051658348494E-16, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, -3.42548561967721913462E-16, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, 1.77256013305652638360E-15, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, 3.81168066935262242075E-15, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, -9.55484669882830764870E-15, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, -4.15056934728722208663E-14, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, 1.54008621752140982691E-14, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, 3.85277838274214270114E-13, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, 7.18012445138366623367E-13, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, -1.79417853150680611778E-12, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, -1.32158118404477131188E-11, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, -3.14991652796324136454E-11, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, 1.18891471078464383424E-11, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, 4.94060238822496958910E-10, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, 3.39623202570838634515E-9, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, 2.26666899049817806459E-8, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, 2.04891858946906374183E-7, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, 2.89137052083475648297E-6, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, 6.88975834691682398426E-5, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, 3.36911647825569408990E-3, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, 8.04490411014108831608E-1, &b0, &b1, &b2, _state); - v = 0.5*(b0-b2); - result = ae_exp(x, _state)*v/ae_sqrt(x, _state); - return result; -} - - -/************************************************************************* -Modified Bessel function of order one - -Returns modified Bessel function of order one of the -argument. - -The function is defined as i1(x) = -i j1( ix ). - -The range is partitioned into the two intervals [0,8] and -(8, infinity). Chebyshev polynomial expansions are employed -in each interval. - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0, 30 30000 1.9e-15 2.1e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1985, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double besseli1(double x, ae_state *_state) -{ - double y; - double z; - double v; - double b0; - double b1; - double b2; - double result; - - - z = ae_fabs(x, _state); - if( ae_fp_less_eq(z,8.0) ) - { - y = z/2.0-2.0; - bessel_besselm1firstcheb(2.77791411276104639959E-18, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -2.11142121435816608115E-17, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 1.55363195773620046921E-16, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -1.10559694773538630805E-15, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 7.60068429473540693410E-15, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -5.04218550472791168711E-14, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 3.22379336594557470981E-13, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -1.98397439776494371520E-12, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 1.17361862988909016308E-11, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -6.66348972350202774223E-11, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 3.62559028155211703701E-10, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -1.88724975172282928790E-9, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 9.38153738649577178388E-9, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -4.44505912879632808065E-8, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 2.00329475355213526229E-7, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -8.56872026469545474066E-7, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 3.47025130813767847674E-6, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -1.32731636560394358279E-5, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 4.78156510755005422638E-5, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -1.61760815825896745588E-4, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 5.12285956168575772895E-4, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -1.51357245063125314899E-3, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 4.15642294431288815669E-3, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -1.05640848946261981558E-2, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 2.47264490306265168283E-2, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -5.29459812080949914269E-2, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 1.02643658689847095384E-1, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -1.76416518357834055153E-1, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 2.52587186443633654823E-1, &b0, &b1, &b2, _state); - v = 0.5*(b0-b2); - z = v*z*ae_exp(z, _state); - } - else - { - y = 32.0/z-2.0; - bessel_besselm1firstcheb(7.51729631084210481353E-18, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 4.41434832307170791151E-18, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -4.65030536848935832153E-17, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -3.20952592199342395980E-17, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 2.96262899764595013876E-16, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 3.30820231092092828324E-16, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -1.88035477551078244854E-15, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -3.81440307243700780478E-15, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 1.04202769841288027642E-14, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 4.27244001671195135429E-14, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -2.10154184277266431302E-14, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -4.08355111109219731823E-13, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -7.19855177624590851209E-13, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 2.03562854414708950722E-12, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 1.41258074366137813316E-11, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 3.25260358301548823856E-11, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -1.89749581235054123450E-11, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -5.58974346219658380687E-10, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -3.83538038596423702205E-9, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -2.63146884688951950684E-8, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -2.51223623787020892529E-7, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -3.88256480887769039346E-6, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -1.10588938762623716291E-4, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -9.76109749136146840777E-3, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 7.78576235018280120474E-1, &b0, &b1, &b2, _state); - v = 0.5*(b0-b2); - z = v*ae_exp(z, _state)/ae_sqrt(z, _state); - } - if( ae_fp_less(x,0) ) - { - z = -z; - } - result = z; - return result; -} - - -/************************************************************************* -Modified Bessel function, second kind, order zero - -Returns modified Bessel function of the second kind -of order zero of the argument. - -The range is partitioned into the two intervals [0,8] and -(8, infinity). Chebyshev polynomial expansions are employed -in each interval. - -ACCURACY: - -Tested at 2000 random points between 0 and 8. Peak absolute -error (relative when K0 > 1) was 1.46e-14; rms, 4.26e-15. - Relative error: -arithmetic domain # trials peak rms - IEEE 0, 30 30000 1.2e-15 1.6e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double besselk0(double x, ae_state *_state) -{ - double y; - double z; - double v; - double b0; - double b1; - double b2; - double result; - - - ae_assert(ae_fp_greater(x,0), "Domain error in BesselK0: x<=0", _state); - if( ae_fp_less_eq(x,2) ) - { - y = x*x-2.0; - bessel_besselmfirstcheb(1.37446543561352307156E-16, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, 4.25981614279661018399E-14, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, 1.03496952576338420167E-11, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, 1.90451637722020886025E-9, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, 2.53479107902614945675E-7, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, 2.28621210311945178607E-5, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, 1.26461541144692592338E-3, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, 3.59799365153615016266E-2, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, 3.44289899924628486886E-1, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(y, -5.35327393233902768720E-1, &b0, &b1, &b2, _state); - v = 0.5*(b0-b2); - v = v-ae_log(0.5*x, _state)*besseli0(x, _state); - } - else - { - z = 8.0/x-2.0; - bessel_besselmfirstcheb(5.30043377268626276149E-18, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, -1.64758043015242134646E-17, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, 5.21039150503902756861E-17, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, -1.67823109680541210385E-16, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, 5.51205597852431940784E-16, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, -1.84859337734377901440E-15, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, 6.34007647740507060557E-15, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, -2.22751332699166985548E-14, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, 8.03289077536357521100E-14, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, -2.98009692317273043925E-13, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, 1.14034058820847496303E-12, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, -4.51459788337394416547E-12, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, 1.85594911495471785253E-11, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, -7.95748924447710747776E-11, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, 3.57739728140030116597E-10, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, -1.69753450938905987466E-9, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, 8.57403401741422608519E-9, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, -4.66048989768794782956E-8, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, 2.76681363944501510342E-7, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, -1.83175552271911948767E-6, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, 1.39498137188764993662E-5, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, -1.28495495816278026384E-4, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, 1.56988388573005337491E-3, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, -3.14481013119645005427E-2, &b0, &b1, &b2, _state); - bessel_besselmnextcheb(z, 2.44030308206595545468E0, &b0, &b1, &b2, _state); - v = 0.5*(b0-b2); - v = v*ae_exp(-x, _state)/ae_sqrt(x, _state); - } - result = v; - return result; -} - - -/************************************************************************* -Modified Bessel function, second kind, order one - -Computes the modified Bessel function of the second kind -of order one of the argument. - -The range is partitioned into the two intervals [0,2] and -(2, infinity). Chebyshev polynomial expansions are employed -in each interval. - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0, 30 30000 1.2e-15 1.6e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double besselk1(double x, ae_state *_state) -{ - double y; - double z; - double v; - double b0; - double b1; - double b2; - double result; - - - z = 0.5*x; - ae_assert(ae_fp_greater(z,0), "Domain error in K1", _state); - if( ae_fp_less_eq(x,2) ) - { - y = x*x-2.0; - bessel_besselm1firstcheb(-7.02386347938628759343E-18, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -2.42744985051936593393E-15, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -6.66690169419932900609E-13, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -1.41148839263352776110E-10, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -2.21338763073472585583E-8, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -2.43340614156596823496E-6, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -1.73028895751305206302E-4, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -6.97572385963986435018E-3, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -1.22611180822657148235E-1, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -3.53155960776544875667E-1, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 1.52530022733894777053E0, &b0, &b1, &b2, _state); - v = 0.5*(b0-b2); - result = ae_log(z, _state)*besseli1(x, _state)+v/x; - } - else - { - y = 8.0/x-2.0; - bessel_besselm1firstcheb(-5.75674448366501715755E-18, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 1.79405087314755922667E-17, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -5.68946255844285935196E-17, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 1.83809354436663880070E-16, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -6.05704724837331885336E-16, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 2.03870316562433424052E-15, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -7.01983709041831346144E-15, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 2.47715442448130437068E-14, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -8.97670518232499435011E-14, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 3.34841966607842919884E-13, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -1.28917396095102890680E-12, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 5.13963967348173025100E-12, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -2.12996783842756842877E-11, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 9.21831518760500529508E-11, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -4.19035475934189648750E-10, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 2.01504975519703286596E-9, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -1.03457624656780970260E-8, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 5.74108412545004946722E-8, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -3.50196060308781257119E-7, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 2.40648494783721712015E-6, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -1.93619797416608296024E-5, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 1.95215518471351631108E-4, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, -2.85781685962277938680E-3, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 1.03923736576817238437E-1, &b0, &b1, &b2, _state); - bessel_besselm1nextcheb(y, 2.72062619048444266945E0, &b0, &b1, &b2, _state); - v = 0.5*(b0-b2); - result = ae_exp(-x, _state)*v/ae_sqrt(x, _state); - } - return result; -} - - -/************************************************************************* -Modified Bessel function, second kind, integer order - -Returns modified Bessel function of the second kind -of order n of the argument. - -The range is partitioned into the two intervals [0,9.55] and -(9.55, infinity). An ascending power series is used in the -low range, and an asymptotic expansion in the high range. - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0,30 90000 1.8e-8 3.0e-10 - -Error is high only near the crossover point x = 9.55 -between the two expansions used. - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1988, 2000 by Stephen L. Moshier -*************************************************************************/ -double besselkn(ae_int_t nn, double x, ae_state *_state) -{ - double k; - double kf; - double nk1f; - double nkf; - double zn; - double t; - double s; - double z0; - double z; - double ans; - double fn; - double pn; - double pk; - double zmn; - double tlg; - double tox; - ae_int_t i; - ae_int_t n; - double eul; - double result; - - - eul = 5.772156649015328606065e-1; - if( nn<0 ) - { - n = -nn; - } - else - { - n = nn; - } - ae_assert(n<=31, "Overflow in BesselKN", _state); - ae_assert(ae_fp_greater(x,0), "Domain error in BesselKN", _state); - if( ae_fp_less_eq(x,9.55) ) - { - ans = 0.0; - z0 = 0.25*x*x; - fn = 1.0; - pn = 0.0; - zmn = 1.0; - tox = 2.0/x; - if( n>0 ) - { - pn = -eul; - k = 1.0; - for(i=1; i<=n-1; i++) - { - pn = pn+1.0/k; - k = k+1.0; - fn = fn*k; - } - zmn = tox; - if( n==1 ) - { - ans = 1.0/x; - } - else - { - nk1f = fn/n; - kf = 1.0; - s = nk1f; - z = -z0; - zn = 1.0; - for(i=1; i<=n-1; i++) - { - nk1f = nk1f/(n-i); - kf = kf*i; - zn = zn*z; - t = nk1f*zn/kf; - s = s+t; - ae_assert(ae_fp_greater(ae_maxrealnumber-ae_fabs(t, _state),ae_fabs(s, _state)), "Overflow in BesselKN", _state); - ae_assert(!(ae_fp_greater(tox,1.0)&&ae_fp_less(ae_maxrealnumber/tox,zmn)), "Overflow in BesselKN", _state); - zmn = zmn*tox; - } - s = s*0.5; - t = ae_fabs(s, _state); - ae_assert(!(ae_fp_greater(zmn,1.0)&&ae_fp_less(ae_maxrealnumber/zmn,t)), "Overflow in BesselKN", _state); - ae_assert(!(ae_fp_greater(t,1.0)&&ae_fp_less(ae_maxrealnumber/t,zmn)), "Overflow in BesselKN", _state); - ans = s*zmn; - } - } - tlg = 2.0*ae_log(0.5*x, _state); - pk = -eul; - if( n==0 ) - { - pn = pk; - t = 1.0; - } - else - { - pn = pn+1.0/n; - t = 1.0/fn; - } - s = (pk+pn-tlg)*t; - k = 1.0; - do - { - t = t*(z0/(k*(k+n))); - pk = pk+1.0/k; - pn = pn+1.0/(k+n); - s = s+(pk+pn-tlg)*t; - k = k+1.0; - } - while(ae_fp_greater(ae_fabs(t/s, _state),ae_machineepsilon)); - s = 0.5*s/zmn; - if( n%2!=0 ) - { - s = -s; - } - ans = ans+s; - result = ans; - return result; - } - if( ae_fp_greater(x,ae_log(ae_maxrealnumber, _state)) ) - { - result = 0; - return result; - } - k = n; - pn = 4.0*k*k; - pk = 1.0; - z0 = 8.0*x; - fn = 1.0; - t = 1.0; - s = t; - nkf = ae_maxrealnumber; - i = 0; - do - { - z = pn-pk*pk; - t = t*z/(fn*z0); - nk1f = ae_fabs(t, _state); - if( i>=n&&ae_fp_greater(nk1f,nkf) ) - { - break; - } - nkf = nk1f; - s = s+t; - fn = fn+1.0; - pk = pk+2.0; - i = i+1; - } - while(ae_fp_greater(ae_fabs(t/s, _state),ae_machineepsilon)); - result = ae_exp(-x, _state)*ae_sqrt(ae_pi/(2.0*x), _state)*s; - return result; -} - - -/************************************************************************* -Internal subroutine - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -static void bessel_besselmfirstcheb(double c, - double* b0, - double* b1, - double* b2, - ae_state *_state) -{ - - - *b0 = c; - *b1 = 0.0; - *b2 = 0.0; -} - - -/************************************************************************* -Internal subroutine - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -static void bessel_besselmnextcheb(double x, - double c, - double* b0, - double* b1, - double* b2, - ae_state *_state) -{ - - - *b2 = *b1; - *b1 = *b0; - *b0 = x*(*b1)-(*b2)+c; -} - - -/************************************************************************* -Internal subroutine - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -static void bessel_besselm1firstcheb(double c, - double* b0, - double* b1, - double* b2, - ae_state *_state) -{ - - - *b0 = c; - *b1 = 0.0; - *b2 = 0.0; -} - - -/************************************************************************* -Internal subroutine - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -static void bessel_besselm1nextcheb(double x, - double c, - double* b0, - double* b1, - double* b2, - ae_state *_state) -{ - - - *b2 = *b1; - *b1 = *b0; - *b0 = x*(*b1)-(*b2)+c; -} - - -static void bessel_besselasympt0(double x, - double* pzero, - double* qzero, - ae_state *_state) -{ - double xsq; - double p2; - double q2; - double p3; - double q3; - - *pzero = 0; - *qzero = 0; - - xsq = 64.0/(x*x); - p2 = 0.0; - p2 = 2485.271928957404011288128951+xsq*p2; - p2 = 153982.6532623911470917825993+xsq*p2; - p2 = 2016135.283049983642487182349+xsq*p2; - p2 = 8413041.456550439208464315611+xsq*p2; - p2 = 12332384.76817638145232406055+xsq*p2; - p2 = 5393485.083869438325262122897+xsq*p2; - q2 = 1.0; - q2 = 2615.700736920839685159081813+xsq*q2; - q2 = 156001.7276940030940592769933+xsq*q2; - q2 = 2025066.801570134013891035236+xsq*q2; - q2 = 8426449.050629797331554404810+xsq*q2; - q2 = 12338310.22786324960844856182+xsq*q2; - q2 = 5393485.083869438325560444960+xsq*q2; - p3 = -0.0; - p3 = -4.887199395841261531199129300+xsq*p3; - p3 = -226.2630641933704113967255053+xsq*p3; - p3 = -2365.956170779108192723612816+xsq*p3; - p3 = -8239.066313485606568803548860+xsq*p3; - p3 = -10381.41698748464093880530341+xsq*p3; - p3 = -3984.617357595222463506790588+xsq*p3; - q3 = 1.0; - q3 = 408.7714673983499223402830260+xsq*q3; - q3 = 15704.89191515395519392882766+xsq*q3; - q3 = 156021.3206679291652539287109+xsq*q3; - q3 = 533291.3634216897168722255057+xsq*q3; - q3 = 666745.4239319826986004038103+xsq*q3; - q3 = 255015.5108860942382983170882+xsq*q3; - *pzero = p2/q2; - *qzero = 8*p3/q3/x; -} - - -static void bessel_besselasympt1(double x, - double* pzero, - double* qzero, - ae_state *_state) -{ - double xsq; - double p2; - double q2; - double p3; - double q3; - - *pzero = 0; - *qzero = 0; - - xsq = 64.0/(x*x); - p2 = -1611.616644324610116477412898; - p2 = -109824.0554345934672737413139+xsq*p2; - p2 = -1523529.351181137383255105722+xsq*p2; - p2 = -6603373.248364939109255245434+xsq*p2; - p2 = -9942246.505077641195658377899+xsq*p2; - p2 = -4435757.816794127857114720794+xsq*p2; - q2 = 1.0; - q2 = -1455.009440190496182453565068+xsq*q2; - q2 = -107263.8599110382011903063867+xsq*q2; - q2 = -1511809.506634160881644546358+xsq*q2; - q2 = -6585339.479723087072826915069+xsq*q2; - q2 = -9934124.389934585658967556309+xsq*q2; - q2 = -4435757.816794127856828016962+xsq*q2; - p3 = 35.26513384663603218592175580; - p3 = 1706.375429020768002061283546+xsq*p3; - p3 = 18494.26287322386679652009819+xsq*p3; - p3 = 66178.83658127083517939992166+xsq*p3; - p3 = 85145.16067533570196555001171+xsq*p3; - p3 = 33220.91340985722351859704442+xsq*p3; - q3 = 1.0; - q3 = 863.8367769604990967475517183+xsq*q3; - q3 = 37890.22974577220264142952256+xsq*q3; - q3 = 400294.4358226697511708610813+xsq*q3; - q3 = 1419460.669603720892855755253+xsq*q3; - q3 = 1819458.042243997298924553839+xsq*q3; - q3 = 708712.8194102874357377502472+xsq*q3; - *pzero = p2/q2; - *qzero = 8*p3/q3/x; -} - - - - -/************************************************************************* -Beta function - - - - - - | (a) | (b) -beta( a, b ) = -----------. - - - | (a+b) - -For large arguments the logarithm of the function is -evaluated using lgam(), then exponentiated. - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0,30 30000 8.1e-14 1.1e-14 - -Cephes Math Library Release 2.0: April, 1987 -Copyright 1984, 1987 by Stephen L. Moshier -*************************************************************************/ -double beta(double a, double b, ae_state *_state) -{ - double y; - double sg; - double s; - double result; - - - sg = 1; - ae_assert(ae_fp_greater(a,0)||ae_fp_neq(a,ae_ifloor(a, _state)), "Overflow in Beta", _state); - ae_assert(ae_fp_greater(b,0)||ae_fp_neq(b,ae_ifloor(b, _state)), "Overflow in Beta", _state); - y = a+b; - if( ae_fp_greater(ae_fabs(y, _state),171.624376956302725) ) - { - y = lngamma(y, &s, _state); - sg = sg*s; - y = lngamma(b, &s, _state)-y; - sg = sg*s; - y = lngamma(a, &s, _state)+y; - sg = sg*s; - ae_assert(ae_fp_less_eq(y,ae_log(ae_maxrealnumber, _state)), "Overflow in Beta", _state); - result = sg*ae_exp(y, _state); - return result; - } - y = gammafunction(y, _state); - ae_assert(ae_fp_neq(y,0), "Overflow in Beta", _state); - if( ae_fp_greater(a,b) ) - { - y = gammafunction(a, _state)/y; - y = y*gammafunction(b, _state); - } - else - { - y = gammafunction(b, _state)/y; - y = y*gammafunction(a, _state); - } - result = y; - return result; -} - - - - -/************************************************************************* -Incomplete beta integral - -Returns incomplete beta integral of the arguments, evaluated -from zero to x. The function is defined as - - x - - - - | (a+b) | | a-1 b-1 - ----------- | t (1-t) dt. - - - | | - | (a) | (b) - - 0 - -The domain of definition is 0 <= x <= 1. In this -implementation a and b are restricted to positive values. -The integral from x to 1 may be obtained by the symmetry -relation - - 1 - incbet( a, b, x ) = incbet( b, a, 1-x ). - -The integral is evaluated by a continued fraction expansion -or, when b*x is small, by a power series. - -ACCURACY: - -Tested at uniformly distributed random points (a,b,x) with a and b -in "domain" and x between 0 and 1. - Relative error -arithmetic domain # trials peak rms - IEEE 0,5 10000 6.9e-15 4.5e-16 - IEEE 0,85 250000 2.2e-13 1.7e-14 - IEEE 0,1000 30000 5.3e-12 6.3e-13 - IEEE 0,10000 250000 9.3e-11 7.1e-12 - IEEE 0,100000 10000 8.7e-10 4.8e-11 -Outputs smaller than the IEEE gradual underflow threshold -were excluded from these statistics. - -Cephes Math Library, Release 2.8: June, 2000 -Copyright 1984, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double incompletebeta(double a, double b, double x, ae_state *_state) -{ - double t; - double xc; - double w; - double y; - ae_int_t flag; - double sg; - double big; - double biginv; - double maxgam; - double minlog; - double maxlog; - double result; - - - big = 4.503599627370496e15; - biginv = 2.22044604925031308085e-16; - maxgam = 171.624376956302725; - minlog = ae_log(ae_minrealnumber, _state); - maxlog = ae_log(ae_maxrealnumber, _state); - ae_assert(ae_fp_greater(a,0)&&ae_fp_greater(b,0), "Domain error in IncompleteBeta", _state); - ae_assert(ae_fp_greater_eq(x,0)&&ae_fp_less_eq(x,1), "Domain error in IncompleteBeta", _state); - if( ae_fp_eq(x,0) ) - { - result = 0; - return result; - } - if( ae_fp_eq(x,1) ) - { - result = 1; - return result; - } - flag = 0; - if( ae_fp_less_eq(b*x,1.0)&&ae_fp_less_eq(x,0.95) ) - { - result = ibetaf_incompletebetaps(a, b, x, maxgam, _state); - return result; - } - w = 1.0-x; - if( ae_fp_greater(x,a/(a+b)) ) - { - flag = 1; - t = a; - a = b; - b = t; - xc = x; - x = w; - } - else - { - xc = w; - } - if( (flag==1&&ae_fp_less_eq(b*x,1.0))&&ae_fp_less_eq(x,0.95) ) - { - t = ibetaf_incompletebetaps(a, b, x, maxgam, _state); - if( ae_fp_less_eq(t,ae_machineepsilon) ) - { - result = 1.0-ae_machineepsilon; - } - else - { - result = 1.0-t; - } - return result; - } - y = x*(a+b-2.0)-(a-1.0); - if( ae_fp_less(y,0.0) ) - { - w = ibetaf_incompletebetafe(a, b, x, big, biginv, _state); - } - else - { - w = ibetaf_incompletebetafe2(a, b, x, big, biginv, _state)/xc; - } - y = a*ae_log(x, _state); - t = b*ae_log(xc, _state); - if( (ae_fp_less(a+b,maxgam)&&ae_fp_less(ae_fabs(y, _state),maxlog))&&ae_fp_less(ae_fabs(t, _state),maxlog) ) - { - t = ae_pow(xc, b, _state); - t = t*ae_pow(x, a, _state); - t = t/a; - t = t*w; - t = t*(gammafunction(a+b, _state)/(gammafunction(a, _state)*gammafunction(b, _state))); - if( flag==1 ) - { - if( ae_fp_less_eq(t,ae_machineepsilon) ) - { - result = 1.0-ae_machineepsilon; - } - else - { - result = 1.0-t; - } - } - else - { - result = t; - } - return result; - } - y = y+t+lngamma(a+b, &sg, _state)-lngamma(a, &sg, _state)-lngamma(b, &sg, _state); - y = y+ae_log(w/a, _state); - if( ae_fp_less(y,minlog) ) - { - t = 0.0; - } - else - { - t = ae_exp(y, _state); - } - if( flag==1 ) - { - if( ae_fp_less_eq(t,ae_machineepsilon) ) - { - t = 1.0-ae_machineepsilon; - } - else - { - t = 1.0-t; - } - } - result = t; - return result; -} - - -/************************************************************************* -Inverse of incomplete beta integral - -Given y, the function finds x such that - - incbet( a, b, x ) = y . - -The routine performs interval halving or Newton iterations to find the -root of incbet(a,b,x) - y = 0. - - -ACCURACY: - - Relative error: - x a,b -arithmetic domain domain # trials peak rms - IEEE 0,1 .5,10000 50000 5.8e-12 1.3e-13 - IEEE 0,1 .25,100 100000 1.8e-13 3.9e-15 - IEEE 0,1 0,5 50000 1.1e-12 5.5e-15 -With a and b constrained to half-integer or integer values: - IEEE 0,1 .5,10000 50000 5.8e-12 1.1e-13 - IEEE 0,1 .5,100 100000 1.7e-14 7.9e-16 -With a = .5, b constrained to half-integer or integer values: - IEEE 0,1 .5,10000 10000 8.3e-11 1.0e-11 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1996, 2000 by Stephen L. Moshier -*************************************************************************/ -double invincompletebeta(double a, double b, double y, ae_state *_state) -{ - double aaa; - double bbb; - double y0; - double d; - double yyy; - double x; - double x0; - double x1; - double lgm; - double yp; - double di; - double dithresh; - double yl; - double yh; - double xt; - ae_int_t i; - ae_int_t rflg; - ae_int_t dir; - ae_int_t nflg; - double s; - ae_int_t mainlooppos; - ae_int_t ihalve; - ae_int_t ihalvecycle; - ae_int_t newt; - ae_int_t newtcycle; - ae_int_t breaknewtcycle; - ae_int_t breakihalvecycle; - double result; - - - i = 0; - ae_assert(ae_fp_greater_eq(y,0)&&ae_fp_less_eq(y,1), "Domain error in InvIncompleteBeta", _state); - - /* - * special cases - */ - if( ae_fp_eq(y,0) ) - { - result = 0; - return result; - } - if( ae_fp_eq(y,1.0) ) - { - result = 1; - return result; - } - - /* - * these initializations are not really necessary, - * but without them compiler complains about 'possibly uninitialized variables'. - */ - dithresh = 0; - rflg = 0; - aaa = 0; - bbb = 0; - y0 = 0; - x = 0; - yyy = 0; - lgm = 0; - dir = 0; - di = 0; - - /* - * normal initializations - */ - x0 = 0.0; - yl = 0.0; - x1 = 1.0; - yh = 1.0; - nflg = 0; - mainlooppos = 0; - ihalve = 1; - ihalvecycle = 2; - newt = 3; - newtcycle = 4; - breaknewtcycle = 5; - breakihalvecycle = 6; - - /* - * main loop - */ - for(;;) - { - - /* - * start - */ - if( mainlooppos==0 ) - { - if( ae_fp_less_eq(a,1.0)||ae_fp_less_eq(b,1.0) ) - { - dithresh = 1.0e-6; - rflg = 0; - aaa = a; - bbb = b; - y0 = y; - x = aaa/(aaa+bbb); - yyy = incompletebeta(aaa, bbb, x, _state); - mainlooppos = ihalve; - continue; - } - else - { - dithresh = 1.0e-4; - } - yp = -invnormaldistribution(y, _state); - if( ae_fp_greater(y,0.5) ) - { - rflg = 1; - aaa = b; - bbb = a; - y0 = 1.0-y; - yp = -yp; - } - else - { - rflg = 0; - aaa = a; - bbb = b; - y0 = y; - } - lgm = (yp*yp-3.0)/6.0; - x = 2.0/(1.0/(2.0*aaa-1.0)+1.0/(2.0*bbb-1.0)); - d = yp*ae_sqrt(x+lgm, _state)/x-(1.0/(2.0*bbb-1.0)-1.0/(2.0*aaa-1.0))*(lgm+5.0/6.0-2.0/(3.0*x)); - d = 2.0*d; - if( ae_fp_less(d,ae_log(ae_minrealnumber, _state)) ) - { - x = 0; - break; - } - x = aaa/(aaa+bbb*ae_exp(d, _state)); - yyy = incompletebeta(aaa, bbb, x, _state); - yp = (yyy-y0)/y0; - if( ae_fp_less(ae_fabs(yp, _state),0.2) ) - { - mainlooppos = newt; - continue; - } - mainlooppos = ihalve; - continue; - } - - /* - * ihalve - */ - if( mainlooppos==ihalve ) - { - dir = 0; - di = 0.5; - i = 0; - mainlooppos = ihalvecycle; - continue; - } - - /* - * ihalvecycle - */ - if( mainlooppos==ihalvecycle ) - { - if( i<=99 ) - { - if( i!=0 ) - { - x = x0+di*(x1-x0); - if( ae_fp_eq(x,1.0) ) - { - x = 1.0-ae_machineepsilon; - } - if( ae_fp_eq(x,0.0) ) - { - di = 0.5; - x = x0+di*(x1-x0); - if( ae_fp_eq(x,0.0) ) - { - break; - } - } - yyy = incompletebeta(aaa, bbb, x, _state); - yp = (x1-x0)/(x1+x0); - if( ae_fp_less(ae_fabs(yp, _state),dithresh) ) - { - mainlooppos = newt; - continue; - } - yp = (yyy-y0)/y0; - if( ae_fp_less(ae_fabs(yp, _state),dithresh) ) - { - mainlooppos = newt; - continue; - } - } - if( ae_fp_less(yyy,y0) ) - { - x0 = x; - yl = yyy; - if( dir<0 ) - { - dir = 0; - di = 0.5; - } - else - { - if( dir>3 ) - { - di = 1.0-(1.0-di)*(1.0-di); - } - else - { - if( dir>1 ) - { - di = 0.5*di+0.5; - } - else - { - di = (y0-yyy)/(yh-yl); - } - } - } - dir = dir+1; - if( ae_fp_greater(x0,0.75) ) - { - if( rflg==1 ) - { - rflg = 0; - aaa = a; - bbb = b; - y0 = y; - } - else - { - rflg = 1; - aaa = b; - bbb = a; - y0 = 1.0-y; - } - x = 1.0-x; - yyy = incompletebeta(aaa, bbb, x, _state); - x0 = 0.0; - yl = 0.0; - x1 = 1.0; - yh = 1.0; - mainlooppos = ihalve; - continue; - } - } - else - { - x1 = x; - if( rflg==1&&ae_fp_less(x1,ae_machineepsilon) ) - { - x = 0.0; - break; - } - yh = yyy; - if( dir>0 ) - { - dir = 0; - di = 0.5; - } - else - { - if( dir<-3 ) - { - di = di*di; - } - else - { - if( dir<-1 ) - { - di = 0.5*di; - } - else - { - di = (yyy-y0)/(yh-yl); - } - } - } - dir = dir-1; - } - i = i+1; - mainlooppos = ihalvecycle; - continue; - } - else - { - mainlooppos = breakihalvecycle; - continue; - } - } - - /* - * breakihalvecycle - */ - if( mainlooppos==breakihalvecycle ) - { - if( ae_fp_greater_eq(x0,1.0) ) - { - x = 1.0-ae_machineepsilon; - break; - } - if( ae_fp_less_eq(x,0.0) ) - { - x = 0.0; - break; - } - mainlooppos = newt; - continue; - } - - /* - * newt - */ - if( mainlooppos==newt ) - { - if( nflg!=0 ) - { - break; - } - nflg = 1; - lgm = lngamma(aaa+bbb, &s, _state)-lngamma(aaa, &s, _state)-lngamma(bbb, &s, _state); - i = 0; - mainlooppos = newtcycle; - continue; - } - - /* - * newtcycle - */ - if( mainlooppos==newtcycle ) - { - if( i<=7 ) - { - if( i!=0 ) - { - yyy = incompletebeta(aaa, bbb, x, _state); - } - if( ae_fp_less(yyy,yl) ) - { - x = x0; - yyy = yl; - } - else - { - if( ae_fp_greater(yyy,yh) ) - { - x = x1; - yyy = yh; - } - else - { - if( ae_fp_less(yyy,y0) ) - { - x0 = x; - yl = yyy; - } - else - { - x1 = x; - yh = yyy; - } - } - } - if( ae_fp_eq(x,1.0)||ae_fp_eq(x,0.0) ) - { - mainlooppos = breaknewtcycle; - continue; - } - d = (aaa-1.0)*ae_log(x, _state)+(bbb-1.0)*ae_log(1.0-x, _state)+lgm; - if( ae_fp_less(d,ae_log(ae_minrealnumber, _state)) ) - { - break; - } - if( ae_fp_greater(d,ae_log(ae_maxrealnumber, _state)) ) - { - mainlooppos = breaknewtcycle; - continue; - } - d = ae_exp(d, _state); - d = (yyy-y0)/d; - xt = x-d; - if( ae_fp_less_eq(xt,x0) ) - { - yyy = (x-x0)/(x1-x0); - xt = x0+0.5*yyy*(x-x0); - if( ae_fp_less_eq(xt,0.0) ) - { - mainlooppos = breaknewtcycle; - continue; - } - } - if( ae_fp_greater_eq(xt,x1) ) - { - yyy = (x1-x)/(x1-x0); - xt = x1-0.5*yyy*(x1-x); - if( ae_fp_greater_eq(xt,1.0) ) - { - mainlooppos = breaknewtcycle; - continue; - } - } - x = xt; - if( ae_fp_less(ae_fabs(d/x, _state),128.0*ae_machineepsilon) ) - { - break; - } - i = i+1; - mainlooppos = newtcycle; - continue; - } - else - { - mainlooppos = breaknewtcycle; - continue; - } - } - - /* - * breaknewtcycle - */ - if( mainlooppos==breaknewtcycle ) - { - dithresh = 256.0*ae_machineepsilon; - mainlooppos = ihalve; - continue; - } - } - - /* - * done - */ - if( rflg!=0 ) - { - if( ae_fp_less_eq(x,ae_machineepsilon) ) - { - x = 1.0-ae_machineepsilon; - } - else - { - x = 1.0-x; - } - } - result = x; - return result; -} - - -/************************************************************************* -Continued fraction expansion #1 for incomplete beta integral - -Cephes Math Library, Release 2.8: June, 2000 -Copyright 1984, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -static double ibetaf_incompletebetafe(double a, - double b, - double x, - double big, - double biginv, - ae_state *_state) -{ - double xk; - double pk; - double pkm1; - double pkm2; - double qk; - double qkm1; - double qkm2; - double k1; - double k2; - double k3; - double k4; - double k5; - double k6; - double k7; - double k8; - double r; - double t; - double ans; - double thresh; - ae_int_t n; - double result; - - - k1 = a; - k2 = a+b; - k3 = a; - k4 = a+1.0; - k5 = 1.0; - k6 = b-1.0; - k7 = k4; - k8 = a+2.0; - pkm2 = 0.0; - qkm2 = 1.0; - pkm1 = 1.0; - qkm1 = 1.0; - ans = 1.0; - r = 1.0; - n = 0; - thresh = 3.0*ae_machineepsilon; - do - { - xk = -x*k1*k2/(k3*k4); - pk = pkm1+pkm2*xk; - qk = qkm1+qkm2*xk; - pkm2 = pkm1; - pkm1 = pk; - qkm2 = qkm1; - qkm1 = qk; - xk = x*k5*k6/(k7*k8); - pk = pkm1+pkm2*xk; - qk = qkm1+qkm2*xk; - pkm2 = pkm1; - pkm1 = pk; - qkm2 = qkm1; - qkm1 = qk; - if( ae_fp_neq(qk,0) ) - { - r = pk/qk; - } - if( ae_fp_neq(r,0) ) - { - t = ae_fabs((ans-r)/r, _state); - ans = r; - } - else - { - t = 1.0; - } - if( ae_fp_less(t,thresh) ) - { - break; - } - k1 = k1+1.0; - k2 = k2+1.0; - k3 = k3+2.0; - k4 = k4+2.0; - k5 = k5+1.0; - k6 = k6-1.0; - k7 = k7+2.0; - k8 = k8+2.0; - if( ae_fp_greater(ae_fabs(qk, _state)+ae_fabs(pk, _state),big) ) - { - pkm2 = pkm2*biginv; - pkm1 = pkm1*biginv; - qkm2 = qkm2*biginv; - qkm1 = qkm1*biginv; - } - if( ae_fp_less(ae_fabs(qk, _state),biginv)||ae_fp_less(ae_fabs(pk, _state),biginv) ) - { - pkm2 = pkm2*big; - pkm1 = pkm1*big; - qkm2 = qkm2*big; - qkm1 = qkm1*big; - } - n = n+1; - } - while(n!=300); - result = ans; - return result; -} - - -/************************************************************************* -Continued fraction expansion #2 -for incomplete beta integral - -Cephes Math Library, Release 2.8: June, 2000 -Copyright 1984, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -static double ibetaf_incompletebetafe2(double a, - double b, - double x, - double big, - double biginv, - ae_state *_state) -{ - double xk; - double pk; - double pkm1; - double pkm2; - double qk; - double qkm1; - double qkm2; - double k1; - double k2; - double k3; - double k4; - double k5; - double k6; - double k7; - double k8; - double r; - double t; - double ans; - double z; - double thresh; - ae_int_t n; - double result; - - - k1 = a; - k2 = b-1.0; - k3 = a; - k4 = a+1.0; - k5 = 1.0; - k6 = a+b; - k7 = a+1.0; - k8 = a+2.0; - pkm2 = 0.0; - qkm2 = 1.0; - pkm1 = 1.0; - qkm1 = 1.0; - z = x/(1.0-x); - ans = 1.0; - r = 1.0; - n = 0; - thresh = 3.0*ae_machineepsilon; - do - { - xk = -z*k1*k2/(k3*k4); - pk = pkm1+pkm2*xk; - qk = qkm1+qkm2*xk; - pkm2 = pkm1; - pkm1 = pk; - qkm2 = qkm1; - qkm1 = qk; - xk = z*k5*k6/(k7*k8); - pk = pkm1+pkm2*xk; - qk = qkm1+qkm2*xk; - pkm2 = pkm1; - pkm1 = pk; - qkm2 = qkm1; - qkm1 = qk; - if( ae_fp_neq(qk,0) ) - { - r = pk/qk; - } - if( ae_fp_neq(r,0) ) - { - t = ae_fabs((ans-r)/r, _state); - ans = r; - } - else - { - t = 1.0; - } - if( ae_fp_less(t,thresh) ) - { - break; - } - k1 = k1+1.0; - k2 = k2-1.0; - k3 = k3+2.0; - k4 = k4+2.0; - k5 = k5+1.0; - k6 = k6+1.0; - k7 = k7+2.0; - k8 = k8+2.0; - if( ae_fp_greater(ae_fabs(qk, _state)+ae_fabs(pk, _state),big) ) - { - pkm2 = pkm2*biginv; - pkm1 = pkm1*biginv; - qkm2 = qkm2*biginv; - qkm1 = qkm1*biginv; - } - if( ae_fp_less(ae_fabs(qk, _state),biginv)||ae_fp_less(ae_fabs(pk, _state),biginv) ) - { - pkm2 = pkm2*big; - pkm1 = pkm1*big; - qkm2 = qkm2*big; - qkm1 = qkm1*big; - } - n = n+1; - } - while(n!=300); - result = ans; - return result; -} - - -/************************************************************************* -Power series for incomplete beta integral. -Use when b*x is small and x not too close to 1. - -Cephes Math Library, Release 2.8: June, 2000 -Copyright 1984, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -static double ibetaf_incompletebetaps(double a, - double b, - double x, - double maxgam, - ae_state *_state) -{ - double s; - double t; - double u; - double v; - double n; - double t1; - double z; - double ai; - double sg; - double result; - - - ai = 1.0/a; - u = (1.0-b)*x; - v = u/(a+1.0); - t1 = v; - t = u; - n = 2.0; - s = 0.0; - z = ae_machineepsilon*ai; - while(ae_fp_greater(ae_fabs(v, _state),z)) - { - u = (n-b)*x/n; - t = t*u; - v = t/(a+n); - s = s+v; - n = n+1.0; - } - s = s+t1; - s = s+ai; - u = a*ae_log(x, _state); - if( ae_fp_less(a+b,maxgam)&&ae_fp_less(ae_fabs(u, _state),ae_log(ae_maxrealnumber, _state)) ) - { - t = gammafunction(a+b, _state)/(gammafunction(a, _state)*gammafunction(b, _state)); - s = s*t*ae_pow(x, a, _state); - } - else - { - t = lngamma(a+b, &sg, _state)-lngamma(a, &sg, _state)-lngamma(b, &sg, _state)+u+ae_log(s, _state); - if( ae_fp_less(t,ae_log(ae_minrealnumber, _state)) ) - { - s = 0.0; - } - else - { - s = ae_exp(t, _state); - } - } - result = s; - return result; -} - - - - -/************************************************************************* -Binomial distribution - -Returns the sum of the terms 0 through k of the Binomial -probability density: - - k - -- ( n ) j n-j - > ( ) p (1-p) - -- ( j ) - j=0 - -The terms are not summed directly; instead the incomplete -beta integral is employed, according to the formula - -y = bdtr( k, n, p ) = incbet( n-k, k+1, 1-p ). - -The arguments must be positive, with p ranging from 0 to 1. - -ACCURACY: - -Tested at random points (a,b,p), with p between 0 and 1. - - a,b Relative error: -arithmetic domain # trials peak rms - For p between 0.001 and 1: - IEEE 0,100 100000 4.3e-15 2.6e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double binomialdistribution(ae_int_t k, - ae_int_t n, - double p, - ae_state *_state) -{ - double dk; - double dn; - double result; - - - ae_assert(ae_fp_greater_eq(p,0)&&ae_fp_less_eq(p,1), "Domain error in BinomialDistribution", _state); - ae_assert(k>=-1&&k<=n, "Domain error in BinomialDistribution", _state); - if( k==-1 ) - { - result = 0; - return result; - } - if( k==n ) - { - result = 1; - return result; - } - dn = n-k; - if( k==0 ) - { - dk = ae_pow(1.0-p, dn, _state); - } - else - { - dk = k+1; - dk = incompletebeta(dn, dk, 1.0-p, _state); - } - result = dk; - return result; -} - - -/************************************************************************* -Complemented binomial distribution - -Returns the sum of the terms k+1 through n of the Binomial -probability density: - - n - -- ( n ) j n-j - > ( ) p (1-p) - -- ( j ) - j=k+1 - -The terms are not summed directly; instead the incomplete -beta integral is employed, according to the formula - -y = bdtrc( k, n, p ) = incbet( k+1, n-k, p ). - -The arguments must be positive, with p ranging from 0 to 1. - -ACCURACY: - -Tested at random points (a,b,p). - - a,b Relative error: -arithmetic domain # trials peak rms - For p between 0.001 and 1: - IEEE 0,100 100000 6.7e-15 8.2e-16 - For p between 0 and .001: - IEEE 0,100 100000 1.5e-13 2.7e-15 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double binomialcdistribution(ae_int_t k, - ae_int_t n, - double p, - ae_state *_state) -{ - double dk; - double dn; - double result; - - - ae_assert(ae_fp_greater_eq(p,0)&&ae_fp_less_eq(p,1), "Domain error in BinomialDistributionC", _state); - ae_assert(k>=-1&&k<=n, "Domain error in BinomialDistributionC", _state); - if( k==-1 ) - { - result = 1; - return result; - } - if( k==n ) - { - result = 0; - return result; - } - dn = n-k; - if( k==0 ) - { - if( ae_fp_less(p,0.01) ) - { - dk = -nuexpm1(dn*nulog1p(-p, _state), _state); - } - else - { - dk = 1.0-ae_pow(1.0-p, dn, _state); - } - } - else - { - dk = k+1; - dk = incompletebeta(dk, dn, p, _state); - } - result = dk; - return result; -} - - -/************************************************************************* -Inverse binomial distribution - -Finds the event probability p such that the sum of the -terms 0 through k of the Binomial probability density -is equal to the given cumulative probability y. - -This is accomplished using the inverse beta integral -function and the relation - -1 - p = incbi( n-k, k+1, y ). - -ACCURACY: - -Tested at random points (a,b,p). - - a,b Relative error: -arithmetic domain # trials peak rms - For p between 0.001 and 1: - IEEE 0,100 100000 2.3e-14 6.4e-16 - IEEE 0,10000 100000 6.6e-12 1.2e-13 - For p between 10^-6 and 0.001: - IEEE 0,100 100000 2.0e-12 1.3e-14 - IEEE 0,10000 100000 1.5e-12 3.2e-14 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double invbinomialdistribution(ae_int_t k, - ae_int_t n, - double y, - ae_state *_state) -{ - double dk; - double dn; - double p; - double result; - - - ae_assert(k>=0&&k=0 - x - argument, -1 <= x <= 1 - -Result: - the value of the Chebyshev polynomial at x -*************************************************************************/ -double chebyshevcalculate(ae_int_t r, - ae_int_t n, - double x, - ae_state *_state) -{ - ae_int_t i; - double a; - double b; - double result; - - - result = 0; - - /* - * Prepare A and B - */ - if( r==1 ) - { - a = 1; - b = x; - } - else - { - a = 1; - b = 2*x; - } - - /* - * Special cases: N=0 or N=1 - */ - if( n==0 ) - { - result = a; - return result; - } - if( n==1 ) - { - result = b; - return result; - } - - /* - * General case: N>=2 - */ - for(i=2; i<=n; i++) - { - result = 2*x*b-a; - a = b; - b = result; - } - return result; -} - - -/************************************************************************* -Summation of Chebyshev polynomials using Clenshaw’s recurrence formula. - -This routine calculates - c[0]*T0(x) + c[1]*T1(x) + ... + c[N]*TN(x) -or - c[0]*U0(x) + c[1]*U1(x) + ... + c[N]*UN(x) -depending on the R. - -Parameters: - r - polynomial kind, either 1 or 2. - n - degree, n>=0 - x - argument - -Result: - the value of the Chebyshev polynomial at x -*************************************************************************/ -double chebyshevsum(/* Real */ ae_vector* c, - ae_int_t r, - ae_int_t n, - double x, - ae_state *_state) -{ - double b1; - double b2; - ae_int_t i; - double result; - - - b1 = 0; - b2 = 0; - for(i=n; i>=1; i--) - { - result = 2*x*b1-b2+c->ptr.p_double[i]; - b2 = b1; - b1 = result; - } - if( r==1 ) - { - result = -b2+x*b1+c->ptr.p_double[0]; - } - else - { - result = -b2+2*x*b1+c->ptr.p_double[0]; - } - return result; -} - - -/************************************************************************* -Representation of Tn as C[0] + C[1]*X + ... + C[N]*X^N - -Input parameters: - N - polynomial degree, n>=0 - -Output parameters: - C - coefficients -*************************************************************************/ -void chebyshevcoefficients(ae_int_t n, - /* Real */ ae_vector* c, - ae_state *_state) -{ - ae_int_t i; - - ae_vector_clear(c); - - ae_vector_set_length(c, n+1, _state); - for(i=0; i<=n; i++) - { - c->ptr.p_double[i] = 0; - } - if( n==0||n==1 ) - { - c->ptr.p_double[n] = 1; - } - else - { - c->ptr.p_double[n] = ae_exp((n-1)*ae_log(2, _state), _state); - for(i=0; i<=n/2-1; i++) - { - c->ptr.p_double[n-2*(i+1)] = -c->ptr.p_double[n-2*i]*(n-2*i)*(n-2*i-1)/4/(i+1)/(n-i-1); - } - } -} - - -/************************************************************************* -Conversion of a series of Chebyshev polynomials to a power series. - -Represents A[0]*T0(x) + A[1]*T1(x) + ... + A[N]*Tn(x) as -B[0] + B[1]*X + ... + B[N]*X^N. - -Input parameters: - A - Chebyshev series coefficients - N - degree, N>=0 - -Output parameters - B - power series coefficients -*************************************************************************/ -void fromchebyshev(/* Real */ ae_vector* a, - ae_int_t n, - /* Real */ ae_vector* b, - ae_state *_state) -{ - ae_int_t i; - ae_int_t k; - double e; - double d; - - ae_vector_clear(b); - - ae_vector_set_length(b, n+1, _state); - for(i=0; i<=n; i++) - { - b->ptr.p_double[i] = 0; - } - d = 0; - i = 0; - do - { - k = i; - do - { - e = b->ptr.p_double[k]; - b->ptr.p_double[k] = 0; - if( i<=1&&k==i ) - { - b->ptr.p_double[k] = 1; - } - else - { - if( i!=0 ) - { - b->ptr.p_double[k] = 2*d; - } - if( k>i+1 ) - { - b->ptr.p_double[k] = b->ptr.p_double[k]-b->ptr.p_double[k-2]; - } - } - d = e; - k = k+1; - } - while(k<=n); - d = b->ptr.p_double[i]; - e = 0; - k = i; - while(k<=n) - { - e = e+b->ptr.p_double[k]*a->ptr.p_double[k]; - k = k+2; - } - b->ptr.p_double[i] = e; - i = i+1; - } - while(i<=n); -} - - - - -/************************************************************************* -Chi-square distribution - -Returns the area under the left hand tail (from 0 to x) -of the Chi square probability density function with -v degrees of freedom. - - - x - - - 1 | | v/2-1 -t/2 - P( x | v ) = ----------- | t e dt - v/2 - | | - 2 | (v/2) - - 0 - -where x is the Chi-square variable. - -The incomplete gamma integral is used, according to the -formula - -y = chdtr( v, x ) = igam( v/2.0, x/2.0 ). - -The arguments must both be positive. - -ACCURACY: - -See incomplete gamma function - - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double chisquaredistribution(double v, double x, ae_state *_state) -{ - double result; - - - ae_assert(ae_fp_greater_eq(x,0)&&ae_fp_greater_eq(v,1), "Domain error in ChiSquareDistribution", _state); - result = incompletegamma(v/2.0, x/2.0, _state); - return result; -} - - -/************************************************************************* -Complemented Chi-square distribution - -Returns the area under the right hand tail (from x to -infinity) of the Chi square probability density function -with v degrees of freedom: - - inf. - - - 1 | | v/2-1 -t/2 - P( x | v ) = ----------- | t e dt - v/2 - | | - 2 | (v/2) - - x - -where x is the Chi-square variable. - -The incomplete gamma integral is used, according to the -formula - -y = chdtr( v, x ) = igamc( v/2.0, x/2.0 ). - -The arguments must both be positive. - -ACCURACY: - -See incomplete gamma function - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double chisquarecdistribution(double v, double x, ae_state *_state) -{ - double result; - - - ae_assert(ae_fp_greater_eq(x,0)&&ae_fp_greater_eq(v,1), "Domain error in ChiSquareDistributionC", _state); - result = incompletegammac(v/2.0, x/2.0, _state); - return result; -} - - -/************************************************************************* -Inverse of complemented Chi-square distribution - -Finds the Chi-square argument x such that the integral -from x to infinity of the Chi-square density is equal -to the given cumulative probability y. - -This is accomplished using the inverse gamma integral -function and the relation - - x/2 = igami( df/2, y ); - -ACCURACY: - -See inverse incomplete gamma function - - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double invchisquaredistribution(double v, double y, ae_state *_state) -{ - double result; - - - ae_assert((ae_fp_greater_eq(y,0)&&ae_fp_less_eq(y,1))&&ae_fp_greater_eq(v,1), "Domain error in InvChiSquareDistribution", _state); - result = 2*invincompletegammac(0.5*v, y, _state); - return result; -} - - - - -/************************************************************************* -Dawson's Integral - -Approximates the integral - - x - - - 2 | | 2 - dawsn(x) = exp( -x ) | exp( t ) dt - | | - - - 0 - -Three different rational approximations are employed, for -the intervals 0 to 3.25; 3.25 to 6.25; and 6.25 up. - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0,10 10000 6.9e-16 1.0e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier -*************************************************************************/ -double dawsonintegral(double x, ae_state *_state) -{ - double x2; - double y; - ae_int_t sg; - double an; - double ad; - double bn; - double bd; - double cn; - double cd; - double result; - - - sg = 1; - if( ae_fp_less(x,0) ) - { - sg = -1; - x = -x; - } - if( ae_fp_less(x,3.25) ) - { - x2 = x*x; - an = 1.13681498971755972054E-11; - an = an*x2+8.49262267667473811108E-10; - an = an*x2+1.94434204175553054283E-8; - an = an*x2+9.53151741254484363489E-7; - an = an*x2+3.07828309874913200438E-6; - an = an*x2+3.52513368520288738649E-4; - an = an*x2+(-8.50149846724410912031E-4); - an = an*x2+4.22618223005546594270E-2; - an = an*x2+(-9.17480371773452345351E-2); - an = an*x2+9.99999999999999994612E-1; - ad = 2.40372073066762605484E-11; - ad = ad*x2+1.48864681368493396752E-9; - ad = ad*x2+5.21265281010541664570E-8; - ad = ad*x2+1.27258478273186970203E-6; - ad = ad*x2+2.32490249820789513991E-5; - ad = ad*x2+3.25524741826057911661E-4; - ad = ad*x2+3.48805814657162590916E-3; - ad = ad*x2+2.79448531198828973716E-2; - ad = ad*x2+1.58874241960120565368E-1; - ad = ad*x2+5.74918629489320327824E-1; - ad = ad*x2+1.00000000000000000539E0; - y = x*an/ad; - result = sg*y; - return result; - } - x2 = 1.0/(x*x); - if( ae_fp_less(x,6.25) ) - { - bn = 5.08955156417900903354E-1; - bn = bn*x2-2.44754418142697847934E-1; - bn = bn*x2+9.41512335303534411857E-2; - bn = bn*x2-2.18711255142039025206E-2; - bn = bn*x2+3.66207612329569181322E-3; - bn = bn*x2-4.23209114460388756528E-4; - bn = bn*x2+3.59641304793896631888E-5; - bn = bn*x2-2.14640351719968974225E-6; - bn = bn*x2+9.10010780076391431042E-8; - bn = bn*x2-2.40274520828250956942E-9; - bn = bn*x2+3.59233385440928410398E-11; - bd = 1.00000000000000000000E0; - bd = bd*x2-6.31839869873368190192E-1; - bd = bd*x2+2.36706788228248691528E-1; - bd = bd*x2-5.31806367003223277662E-2; - bd = bd*x2+8.48041718586295374409E-3; - bd = bd*x2-9.47996768486665330168E-4; - bd = bd*x2+7.81025592944552338085E-5; - bd = bd*x2-4.55875153252442634831E-6; - bd = bd*x2+1.89100358111421846170E-7; - bd = bd*x2-4.91324691331920606875E-9; - bd = bd*x2+7.18466403235734541950E-11; - y = 1.0/x+x2*bn/(bd*x); - result = sg*0.5*y; - return result; - } - if( ae_fp_greater(x,1.0E9) ) - { - result = sg*0.5/x; - return result; - } - cn = -5.90592860534773254987E-1; - cn = cn*x2+6.29235242724368800674E-1; - cn = cn*x2-1.72858975380388136411E-1; - cn = cn*x2+1.64837047825189632310E-2; - cn = cn*x2-4.86827613020462700845E-4; - cd = 1.00000000000000000000E0; - cd = cd*x2-2.69820057197544900361E0; - cd = cd*x2+1.73270799045947845857E0; - cd = cd*x2-3.93708582281939493482E-1; - cd = cd*x2+3.44278924041233391079E-2; - cd = cd*x2-9.73655226040941223894E-4; - y = 1.0/x+x2*cn/(cd*x); - result = sg*0.5*y; - return result; -} - - - - -/************************************************************************* -Complete elliptic integral of the first kind - -Approximates the integral - - - - pi/2 - - - | | - | dt -K(m) = | ------------------ - | 2 - | | sqrt( 1 - m sin t ) - - - 0 - -using the approximation - - P(x) - log x Q(x). - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0,1 30000 2.5e-16 6.8e-17 - -Cephes Math Library, Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double ellipticintegralk(double m, ae_state *_state) -{ - double result; - - - result = ellipticintegralkhighprecision(1.0-m, _state); - return result; -} - - -/************************************************************************* -Complete elliptic integral of the first kind - -Approximates the integral - - - - pi/2 - - - | | - | dt -K(m) = | ------------------ - | 2 - | | sqrt( 1 - m sin t ) - - - 0 - -where m = 1 - m1, using the approximation - - P(x) - log x Q(x). - -The argument m1 is used rather than m so that the logarithmic -singularity at m = 1 will be shifted to the origin; this -preserves maximum accuracy. - -K(0) = pi/2. - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0,1 30000 2.5e-16 6.8e-17 - -Àëãîðèòì âçÿò èç áèáëèîòåêè Cephes -*************************************************************************/ -double ellipticintegralkhighprecision(double m1, ae_state *_state) -{ - double p; - double q; - double result; - - - if( ae_fp_less_eq(m1,ae_machineepsilon) ) - { - result = 1.3862943611198906188E0-0.5*ae_log(m1, _state); - } - else - { - p = 1.37982864606273237150E-4; - p = p*m1+2.28025724005875567385E-3; - p = p*m1+7.97404013220415179367E-3; - p = p*m1+9.85821379021226008714E-3; - p = p*m1+6.87489687449949877925E-3; - p = p*m1+6.18901033637687613229E-3; - p = p*m1+8.79078273952743772254E-3; - p = p*m1+1.49380448916805252718E-2; - p = p*m1+3.08851465246711995998E-2; - p = p*m1+9.65735902811690126535E-2; - p = p*m1+1.38629436111989062502E0; - q = 2.94078955048598507511E-5; - q = q*m1+9.14184723865917226571E-4; - q = q*m1+5.94058303753167793257E-3; - q = q*m1+1.54850516649762399335E-2; - q = q*m1+2.39089602715924892727E-2; - q = q*m1+3.01204715227604046988E-2; - q = q*m1+3.73774314173823228969E-2; - q = q*m1+4.88280347570998239232E-2; - q = q*m1+7.03124996963957469739E-2; - q = q*m1+1.24999999999870820058E-1; - q = q*m1+4.99999999999999999821E-1; - result = p-q*ae_log(m1, _state); - } - return result; -} - - -/************************************************************************* -Incomplete elliptic integral of the first kind F(phi|m) - -Approximates the integral - - - - phi - - - | | - | dt -F(phi_\m) = | ------------------ - | 2 - | | sqrt( 1 - m sin t ) - - - 0 - -of amplitude phi and modulus m, using the arithmetic - -geometric mean algorithm. - - - - -ACCURACY: - -Tested at random points with m in [0, 1] and phi as indicated. - - Relative error: -arithmetic domain # trials peak rms - IEEE -10,10 200000 7.4e-16 1.0e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double incompleteellipticintegralk(double phi, double m, ae_state *_state) -{ - double a; - double b; - double c; - double e; - double temp; - double pio2; - double t; - double k; - ae_int_t d; - ae_int_t md; - ae_int_t s; - ae_int_t npio2; - double result; - - - pio2 = 1.57079632679489661923; - if( ae_fp_eq(m,0) ) - { - result = phi; - return result; - } - a = 1-m; - if( ae_fp_eq(a,0) ) - { - result = ae_log(ae_tan(0.5*(pio2+phi), _state), _state); - return result; - } - npio2 = ae_ifloor(phi/pio2, _state); - if( npio2%2!=0 ) - { - npio2 = npio2+1; - } - if( npio2!=0 ) - { - k = ellipticintegralk(1-a, _state); - phi = phi-npio2*pio2; - } - else - { - k = 0; - } - if( ae_fp_less(phi,0) ) - { - phi = -phi; - s = -1; - } - else - { - s = 0; - } - b = ae_sqrt(a, _state); - t = ae_tan(phi, _state); - if( ae_fp_greater(ae_fabs(t, _state),10) ) - { - e = 1.0/(b*t); - if( ae_fp_less(ae_fabs(e, _state),10) ) - { - e = ae_atan(e, _state); - if( npio2==0 ) - { - k = ellipticintegralk(1-a, _state); - } - temp = k-incompleteellipticintegralk(e, m, _state); - if( s<0 ) - { - temp = -temp; - } - result = temp+npio2*k; - return result; - } - } - a = 1.0; - c = ae_sqrt(m, _state); - d = 1; - md = 0; - while(ae_fp_greater(ae_fabs(c/a, _state),ae_machineepsilon)) - { - temp = b/a; - phi = phi+ae_atan(t*temp, _state)+md*ae_pi; - md = ae_trunc((phi+pio2)/ae_pi, _state); - t = t*(1.0+temp)/(1.0-temp*t*t); - c = 0.5*(a-b); - temp = ae_sqrt(a*b, _state); - a = 0.5*(a+b); - b = temp; - d = d+d; - } - temp = (ae_atan(t, _state)+md*ae_pi)/(d*a); - if( s<0 ) - { - temp = -temp; - } - result = temp+npio2*k; - return result; -} - - -/************************************************************************* -Complete elliptic integral of the second kind - -Approximates the integral - - - pi/2 - - - | | 2 -E(m) = | sqrt( 1 - m sin t ) dt - | | - - - 0 - -using the approximation - - P(x) - x log x Q(x). - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0, 1 10000 2.1e-16 7.3e-17 - -Cephes Math Library, Release 2.8: June, 2000 -Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier -*************************************************************************/ -double ellipticintegrale(double m, ae_state *_state) -{ - double p; - double q; - double result; - - - ae_assert(ae_fp_greater_eq(m,0)&&ae_fp_less_eq(m,1), "Domain error in EllipticIntegralE: m<0 or m>1", _state); - m = 1-m; - if( ae_fp_eq(m,0) ) - { - result = 1; - return result; - } - p = 1.53552577301013293365E-4; - p = p*m+2.50888492163602060990E-3; - p = p*m+8.68786816565889628429E-3; - p = p*m+1.07350949056076193403E-2; - p = p*m+7.77395492516787092951E-3; - p = p*m+7.58395289413514708519E-3; - p = p*m+1.15688436810574127319E-2; - p = p*m+2.18317996015557253103E-2; - p = p*m+5.68051945617860553470E-2; - p = p*m+4.43147180560990850618E-1; - p = p*m+1.00000000000000000299E0; - q = 3.27954898576485872656E-5; - q = q*m+1.00962792679356715133E-3; - q = q*m+6.50609489976927491433E-3; - q = q*m+1.68862163993311317300E-2; - q = q*m+2.61769742454493659583E-2; - q = q*m+3.34833904888224918614E-2; - q = q*m+4.27180926518931511717E-2; - q = q*m+5.85936634471101055642E-2; - q = q*m+9.37499997197644278445E-2; - q = q*m+2.49999999999888314361E-1; - result = p-q*m*ae_log(m, _state); - return result; -} - - -/************************************************************************* -Incomplete elliptic integral of the second kind - -Approximates the integral - - - phi - - - | | - | 2 -E(phi_\m) = | sqrt( 1 - m sin t ) dt - | - | | - - - 0 - -of amplitude phi and modulus m, using the arithmetic - -geometric mean algorithm. - -ACCURACY: - -Tested at random arguments with phi in [-10, 10] and m in -[0, 1]. - Relative error: -arithmetic domain # trials peak rms - IEEE -10,10 150000 3.3e-15 1.4e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1993, 2000 by Stephen L. Moshier -*************************************************************************/ -double incompleteellipticintegrale(double phi, double m, ae_state *_state) -{ - double pio2; - double a; - double b; - double c; - double e; - double temp; - double lphi; - double t; - double ebig; - ae_int_t d; - ae_int_t md; - ae_int_t npio2; - ae_int_t s; - double result; - - - pio2 = 1.57079632679489661923; - if( ae_fp_eq(m,0) ) - { - result = phi; - return result; - } - lphi = phi; - npio2 = ae_ifloor(lphi/pio2, _state); - if( npio2%2!=0 ) - { - npio2 = npio2+1; - } - lphi = lphi-npio2*pio2; - if( ae_fp_less(lphi,0) ) - { - lphi = -lphi; - s = -1; - } - else - { - s = 1; - } - a = 1.0-m; - ebig = ellipticintegrale(m, _state); - if( ae_fp_eq(a,0) ) - { - temp = ae_sin(lphi, _state); - if( s<0 ) - { - temp = -temp; - } - result = temp+npio2*ebig; - return result; - } - t = ae_tan(lphi, _state); - b = ae_sqrt(a, _state); - - /* - * Thanks to Brian Fitzgerald - * for pointing out an instability near odd multiples of pi/2 - */ - if( ae_fp_greater(ae_fabs(t, _state),10) ) - { - - /* - * Transform the amplitude - */ - e = 1.0/(b*t); - - /* - * ... but avoid multiple recursions. - */ - if( ae_fp_less(ae_fabs(e, _state),10) ) - { - e = ae_atan(e, _state); - temp = ebig+m*ae_sin(lphi, _state)*ae_sin(e, _state)-incompleteellipticintegrale(e, m, _state); - if( s<0 ) - { - temp = -temp; - } - result = temp+npio2*ebig; - return result; - } - } - c = ae_sqrt(m, _state); - a = 1.0; - d = 1; - e = 0.0; - md = 0; - while(ae_fp_greater(ae_fabs(c/a, _state),ae_machineepsilon)) - { - temp = b/a; - lphi = lphi+ae_atan(t*temp, _state)+md*ae_pi; - md = ae_trunc((lphi+pio2)/ae_pi, _state); - t = t*(1.0+temp)/(1.0-temp*t*t); - c = 0.5*(a-b); - temp = ae_sqrt(a*b, _state); - a = 0.5*(a+b); - b = temp; - d = d+d; - e = e+c*ae_sin(lphi, _state); - } - temp = ebig/ellipticintegralk(m, _state); - temp = temp*((ae_atan(t, _state)+md*ae_pi)/(d*a)); - temp = temp+e; - if( s<0 ) - { - temp = -temp; - } - result = temp+npio2*ebig; - return result; -} - - - - -/************************************************************************* -Exponential integral Ei(x) - - x - - t - | | e - Ei(x) = -|- --- dt . - | | t - - - -inf - -Not defined for x <= 0. -See also expn.c. - - - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0,100 50000 8.6e-16 1.3e-16 - -Cephes Math Library Release 2.8: May, 1999 -Copyright 1999 by Stephen L. Moshier -*************************************************************************/ -double exponentialintegralei(double x, ae_state *_state) -{ - double eul; - double f; - double f1; - double f2; - double w; - double result; - - - eul = 0.5772156649015328606065; - if( ae_fp_less_eq(x,0) ) - { - result = 0; - return result; - } - if( ae_fp_less(x,2) ) - { - f1 = -5.350447357812542947283; - f1 = f1*x+218.5049168816613393830; - f1 = f1*x-4176.572384826693777058; - f1 = f1*x+55411.76756393557601232; - f1 = f1*x-331338.1331178144034309; - f1 = f1*x+1592627.163384945414220; - f2 = 1.000000000000000000000; - f2 = f2*x-52.50547959112862969197; - f2 = f2*x+1259.616186786790571525; - f2 = f2*x-17565.49581973534652631; - f2 = f2*x+149306.2117002725991967; - f2 = f2*x-729494.9239640527645655; - f2 = f2*x+1592627.163384945429726; - f = f1/f2; - result = eul+ae_log(x, _state)+x*f; - return result; - } - if( ae_fp_less(x,4) ) - { - w = 1/x; - f1 = 1.981808503259689673238E-2; - f1 = f1*w-1.271645625984917501326; - f1 = f1*w-2.088160335681228318920; - f1 = f1*w+2.755544509187936721172; - f1 = f1*w-4.409507048701600257171E-1; - f1 = f1*w+4.665623805935891391017E-2; - f1 = f1*w-1.545042679673485262580E-3; - f1 = f1*w+7.059980605299617478514E-5; - f2 = 1.000000000000000000000; - f2 = f2*w+1.476498670914921440652; - f2 = f2*w+5.629177174822436244827E-1; - f2 = f2*w+1.699017897879307263248E-1; - f2 = f2*w+2.291647179034212017463E-2; - f2 = f2*w+4.450150439728752875043E-3; - f2 = f2*w+1.727439612206521482874E-4; - f2 = f2*w+3.953167195549672482304E-5; - f = f1/f2; - result = ae_exp(x, _state)*w*(1+w*f); - return result; - } - if( ae_fp_less(x,8) ) - { - w = 1/x; - f1 = -1.373215375871208729803; - f1 = f1*w-7.084559133740838761406E-1; - f1 = f1*w+1.580806855547941010501; - f1 = f1*w-2.601500427425622944234E-1; - f1 = f1*w+2.994674694113713763365E-2; - f1 = f1*w-1.038086040188744005513E-3; - f1 = f1*w+4.371064420753005429514E-5; - f1 = f1*w+2.141783679522602903795E-6; - f2 = 1.000000000000000000000; - f2 = f2*w+8.585231423622028380768E-1; - f2 = f2*w+4.483285822873995129957E-1; - f2 = f2*w+7.687932158124475434091E-2; - f2 = f2*w+2.449868241021887685904E-2; - f2 = f2*w+8.832165941927796567926E-4; - f2 = f2*w+4.590952299511353531215E-4; - f2 = f2*w+(-4.729848351866523044863E-6); - f2 = f2*w+2.665195537390710170105E-6; - f = f1/f2; - result = ae_exp(x, _state)*w*(1+w*f); - return result; - } - if( ae_fp_less(x,16) ) - { - w = 1/x; - f1 = -2.106934601691916512584; - f1 = f1*w+1.732733869664688041885; - f1 = f1*w-2.423619178935841904839E-1; - f1 = f1*w+2.322724180937565842585E-2; - f1 = f1*w+2.372880440493179832059E-4; - f1 = f1*w-8.343219561192552752335E-5; - f1 = f1*w+1.363408795605250394881E-5; - f1 = f1*w-3.655412321999253963714E-7; - f1 = f1*w+1.464941733975961318456E-8; - f1 = f1*w+6.176407863710360207074E-10; - f2 = 1.000000000000000000000; - f2 = f2*w-2.298062239901678075778E-1; - f2 = f2*w+1.105077041474037862347E-1; - f2 = f2*w-1.566542966630792353556E-2; - f2 = f2*w+2.761106850817352773874E-3; - f2 = f2*w-2.089148012284048449115E-4; - f2 = f2*w+1.708528938807675304186E-5; - f2 = f2*w-4.459311796356686423199E-7; - f2 = f2*w+1.394634930353847498145E-8; - f2 = f2*w+6.150865933977338354138E-10; - f = f1/f2; - result = ae_exp(x, _state)*w*(1+w*f); - return result; - } - if( ae_fp_less(x,32) ) - { - w = 1/x; - f1 = -2.458119367674020323359E-1; - f1 = f1*w-1.483382253322077687183E-1; - f1 = f1*w+7.248291795735551591813E-2; - f1 = f1*w-1.348315687380940523823E-2; - f1 = f1*w+1.342775069788636972294E-3; - f1 = f1*w-7.942465637159712264564E-5; - f1 = f1*w+2.644179518984235952241E-6; - f1 = f1*w-4.239473659313765177195E-8; - f2 = 1.000000000000000000000; - f2 = f2*w-1.044225908443871106315E-1; - f2 = f2*w-2.676453128101402655055E-1; - f2 = f2*w+9.695000254621984627876E-2; - f2 = f2*w-1.601745692712991078208E-2; - f2 = f2*w+1.496414899205908021882E-3; - f2 = f2*w-8.462452563778485013756E-5; - f2 = f2*w+2.728938403476726394024E-6; - f2 = f2*w-4.239462431819542051337E-8; - f = f1/f2; - result = ae_exp(x, _state)*w*(1+w*f); - return result; - } - if( ae_fp_less(x,64) ) - { - w = 1/x; - f1 = 1.212561118105456670844E-1; - f1 = f1*w-5.823133179043894485122E-1; - f1 = f1*w+2.348887314557016779211E-1; - f1 = f1*w-3.040034318113248237280E-2; - f1 = f1*w+1.510082146865190661777E-3; - f1 = f1*w-2.523137095499571377122E-5; - f2 = 1.000000000000000000000; - f2 = f2*w-1.002252150365854016662; - f2 = f2*w+2.928709694872224144953E-1; - f2 = f2*w-3.337004338674007801307E-2; - f2 = f2*w+1.560544881127388842819E-3; - f2 = f2*w-2.523137093603234562648E-5; - f = f1/f2; - result = ae_exp(x, _state)*w*(1+w*f); - return result; - } - w = 1/x; - f1 = -7.657847078286127362028E-1; - f1 = f1*w+6.886192415566705051750E-1; - f1 = f1*w-2.132598113545206124553E-1; - f1 = f1*w+3.346107552384193813594E-2; - f1 = f1*w-3.076541477344756050249E-3; - f1 = f1*w+1.747119316454907477380E-4; - f1 = f1*w-6.103711682274170530369E-6; - f1 = f1*w+1.218032765428652199087E-7; - f1 = f1*w-1.086076102793290233007E-9; - f2 = 1.000000000000000000000; - f2 = f2*w-1.888802868662308731041; - f2 = f2*w+1.066691687211408896850; - f2 = f2*w-2.751915982306380647738E-1; - f2 = f2*w+3.930852688233823569726E-2; - f2 = f2*w-3.414684558602365085394E-3; - f2 = f2*w+1.866844370703555398195E-4; - f2 = f2*w-6.345146083130515357861E-6; - f2 = f2*w+1.239754287483206878024E-7; - f2 = f2*w-1.086076102793126632978E-9; - f = f1/f2; - result = ae_exp(x, _state)*w*(1+w*f); - return result; -} - - -/************************************************************************* -Exponential integral En(x) - -Evaluates the exponential integral - - inf. - - - | | -xt - | e - E (x) = | ---- dt. - n | n - | | t - - - 1 - - -Both n and x must be nonnegative. - -The routine employs either a power series, a continued -fraction, or an asymptotic formula depending on the -relative values of n and x. - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0, 30 10000 1.7e-15 3.6e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1985, 2000 by Stephen L. Moshier -*************************************************************************/ -double exponentialintegralen(double x, ae_int_t n, ae_state *_state) -{ - double r; - double t; - double yk; - double xk; - double pk; - double pkm1; - double pkm2; - double qk; - double qkm1; - double qkm2; - double psi; - double z; - ae_int_t i; - ae_int_t k; - double big; - double eul; - double result; - - - eul = 0.57721566490153286060; - big = 1.44115188075855872*ae_pow(10, 17, _state); - if( ((n<0||ae_fp_less(x,0))||ae_fp_greater(x,170))||(ae_fp_eq(x,0)&&n<2) ) - { - result = -1; - return result; - } - if( ae_fp_eq(x,0) ) - { - result = (double)1/(double)(n-1); - return result; - } - if( n==0 ) - { - result = ae_exp(-x, _state)/x; - return result; - } - if( n>5000 ) - { - xk = x+n; - yk = 1/(xk*xk); - t = n; - result = yk*t*(6*x*x-8*t*x+t*t); - result = yk*(result+t*(t-2.0*x)); - result = yk*(result+t); - result = (result+1)*ae_exp(-x, _state)/xk; - return result; - } - if( ae_fp_less_eq(x,1) ) - { - psi = -eul-ae_log(x, _state); - for(i=1; i<=n-1; i++) - { - psi = psi+(double)1/(double)i; - } - z = -x; - xk = 0; - yk = 1; - pk = 1-n; - if( n==1 ) - { - result = 0.0; - } - else - { - result = 1.0/pk; - } - do - { - xk = xk+1; - yk = yk*z/xk; - pk = pk+1; - if( ae_fp_neq(pk,0) ) - { - result = result+yk/pk; - } - if( ae_fp_neq(result,0) ) - { - t = ae_fabs(yk/result, _state); - } - else - { - t = 1; - } - } - while(ae_fp_greater_eq(t,ae_machineepsilon)); - t = 1; - for(i=1; i<=n-1; i++) - { - t = t*z/i; - } - result = psi*t-result; - return result; - } - else - { - k = 1; - pkm2 = 1; - qkm2 = x; - pkm1 = 1.0; - qkm1 = x+n; - result = pkm1/qkm1; - do - { - k = k+1; - if( k%2==1 ) - { - yk = 1; - xk = n+(double)(k-1)/(double)2; - } - else - { - yk = x; - xk = (double)k/(double)2; - } - pk = pkm1*yk+pkm2*xk; - qk = qkm1*yk+qkm2*xk; - if( ae_fp_neq(qk,0) ) - { - r = pk/qk; - t = ae_fabs((result-r)/r, _state); - result = r; - } - else - { - t = 1; - } - pkm2 = pkm1; - pkm1 = pk; - qkm2 = qkm1; - qkm1 = qk; - if( ae_fp_greater(ae_fabs(pk, _state),big) ) - { - pkm2 = pkm2/big; - pkm1 = pkm1/big; - qkm2 = qkm2/big; - qkm1 = qkm1/big; - } - } - while(ae_fp_greater_eq(t,ae_machineepsilon)); - result = result*ae_exp(-x, _state); - } - return result; -} - - - - -/************************************************************************* -F distribution - -Returns the area from zero to x under the F density -function (also known as Snedcor's density or the -variance ratio density). This is the density -of x = (u1/df1)/(u2/df2), where u1 and u2 are random -variables having Chi square distributions with df1 -and df2 degrees of freedom, respectively. -The incomplete beta integral is used, according to the -formula - -P(x) = incbet( df1/2, df2/2, (df1*x/(df2 + df1*x) ). - - -The arguments a and b are greater than zero, and x is -nonnegative. - -ACCURACY: - -Tested at random points (a,b,x). - - x a,b Relative error: -arithmetic domain domain # trials peak rms - IEEE 0,1 0,100 100000 9.8e-15 1.7e-15 - IEEE 1,5 0,100 100000 6.5e-15 3.5e-16 - IEEE 0,1 1,10000 100000 2.2e-11 3.3e-12 - IEEE 1,5 1,10000 100000 1.1e-11 1.7e-13 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double fdistribution(ae_int_t a, ae_int_t b, double x, ae_state *_state) -{ - double w; - double result; - - - ae_assert((a>=1&&b>=1)&&ae_fp_greater_eq(x,0), "Domain error in FDistribution", _state); - w = a*x; - w = w/(b+w); - result = incompletebeta(0.5*a, 0.5*b, w, _state); - return result; -} - - -/************************************************************************* -Complemented F distribution - -Returns the area from x to infinity under the F density -function (also known as Snedcor's density or the -variance ratio density). - - - inf. - - - 1 | | a-1 b-1 -1-P(x) = ------ | t (1-t) dt - B(a,b) | | - - - x - - -The incomplete beta integral is used, according to the -formula - -P(x) = incbet( df2/2, df1/2, (df2/(df2 + df1*x) ). - - -ACCURACY: - -Tested at random points (a,b,x) in the indicated intervals. - x a,b Relative error: -arithmetic domain domain # trials peak rms - IEEE 0,1 1,100 100000 3.7e-14 5.9e-16 - IEEE 1,5 1,100 100000 8.0e-15 1.6e-15 - IEEE 0,1 1,10000 100000 1.8e-11 3.5e-13 - IEEE 1,5 1,10000 100000 2.0e-11 3.0e-12 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double fcdistribution(ae_int_t a, ae_int_t b, double x, ae_state *_state) -{ - double w; - double result; - - - ae_assert((a>=1&&b>=1)&&ae_fp_greater_eq(x,0), "Domain error in FCDistribution", _state); - w = b/(b+a*x); - result = incompletebeta(0.5*b, 0.5*a, w, _state); - return result; -} - - -/************************************************************************* -Inverse of complemented F distribution - -Finds the F density argument x such that the integral -from x to infinity of the F density is equal to the -given probability p. - -This is accomplished using the inverse beta integral -function and the relations - - z = incbi( df2/2, df1/2, p ) - x = df2 (1-z) / (df1 z). - -Note: the following relations hold for the inverse of -the uncomplemented F distribution: - - z = incbi( df1/2, df2/2, p ) - x = df2 z / (df1 (1-z)). - -ACCURACY: - -Tested at random points (a,b,p). - - a,b Relative error: -arithmetic domain # trials peak rms - For p between .001 and 1: - IEEE 1,100 100000 8.3e-15 4.7e-16 - IEEE 1,10000 100000 2.1e-11 1.4e-13 - For p between 10^-6 and 10^-3: - IEEE 1,100 50000 1.3e-12 8.4e-15 - IEEE 1,10000 50000 3.0e-12 4.8e-14 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double invfdistribution(ae_int_t a, - ae_int_t b, - double y, - ae_state *_state) -{ - double w; - double result; - - - ae_assert(((a>=1&&b>=1)&&ae_fp_greater(y,0))&&ae_fp_less_eq(y,1), "Domain error in InvFDistribution", _state); - - /* - * Compute probability for x = 0.5 - */ - w = incompletebeta(0.5*b, 0.5*a, 0.5, _state); - - /* - * If that is greater than y, then the solution w < .5 - * Otherwise, solve at 1-y to remove cancellation in (b - b*w) - */ - if( ae_fp_greater(w,y)||ae_fp_less(y,0.001) ) - { - w = invincompletebeta(0.5*b, 0.5*a, y, _state); - result = (b-b*w)/(a*w); - } - else - { - w = invincompletebeta(0.5*a, 0.5*b, 1.0-y, _state); - result = b*w/(a*(1.0-w)); - } - return result; -} - - - - -/************************************************************************* -Fresnel integral - -Evaluates the Fresnel integrals - - x - - - | | -C(x) = | cos(pi/2 t**2) dt, - | | - - - 0 - - x - - - | | -S(x) = | sin(pi/2 t**2) dt. - | | - - - 0 - - -The integrals are evaluated by a power series for x < 1. -For x >= 1 auxiliary functions f(x) and g(x) are employed -such that - -C(x) = 0.5 + f(x) sin( pi/2 x**2 ) - g(x) cos( pi/2 x**2 ) -S(x) = 0.5 - f(x) cos( pi/2 x**2 ) - g(x) sin( pi/2 x**2 ) - - - -ACCURACY: - - Relative error. - -Arithmetic function domain # trials peak rms - IEEE S(x) 0, 10 10000 2.0e-15 3.2e-16 - IEEE C(x) 0, 10 10000 1.8e-15 3.3e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier -*************************************************************************/ -void fresnelintegral(double x, double* c, double* s, ae_state *_state) -{ - double xxa; - double f; - double g; - double cc; - double ss; - double t; - double u; - double x2; - double sn; - double sd; - double cn; - double cd; - double fn; - double fd; - double gn; - double gd; - double mpi; - double mpio2; - - - mpi = 3.14159265358979323846; - mpio2 = 1.57079632679489661923; - xxa = x; - x = ae_fabs(xxa, _state); - x2 = x*x; - if( ae_fp_less(x2,2.5625) ) - { - t = x2*x2; - sn = -2.99181919401019853726E3; - sn = sn*t+7.08840045257738576863E5; - sn = sn*t-6.29741486205862506537E7; - sn = sn*t+2.54890880573376359104E9; - sn = sn*t-4.42979518059697779103E10; - sn = sn*t+3.18016297876567817986E11; - sd = 1.00000000000000000000E0; - sd = sd*t+2.81376268889994315696E2; - sd = sd*t+4.55847810806532581675E4; - sd = sd*t+5.17343888770096400730E6; - sd = sd*t+4.19320245898111231129E8; - sd = sd*t+2.24411795645340920940E10; - sd = sd*t+6.07366389490084639049E11; - cn = -4.98843114573573548651E-8; - cn = cn*t+9.50428062829859605134E-6; - cn = cn*t-6.45191435683965050962E-4; - cn = cn*t+1.88843319396703850064E-2; - cn = cn*t-2.05525900955013891793E-1; - cn = cn*t+9.99999999999999998822E-1; - cd = 3.99982968972495980367E-12; - cd = cd*t+9.15439215774657478799E-10; - cd = cd*t+1.25001862479598821474E-7; - cd = cd*t+1.22262789024179030997E-5; - cd = cd*t+8.68029542941784300606E-4; - cd = cd*t+4.12142090722199792936E-2; - cd = cd*t+1.00000000000000000118E0; - *s = ae_sign(xxa, _state)*x*x2*sn/sd; - *c = ae_sign(xxa, _state)*x*cn/cd; - return; - } - if( ae_fp_greater(x,36974.0) ) - { - *c = ae_sign(xxa, _state)*0.5; - *s = ae_sign(xxa, _state)*0.5; - return; - } - x2 = x*x; - t = mpi*x2; - u = 1/(t*t); - t = 1/t; - fn = 4.21543555043677546506E-1; - fn = fn*u+1.43407919780758885261E-1; - fn = fn*u+1.15220955073585758835E-2; - fn = fn*u+3.45017939782574027900E-4; - fn = fn*u+4.63613749287867322088E-6; - fn = fn*u+3.05568983790257605827E-8; - fn = fn*u+1.02304514164907233465E-10; - fn = fn*u+1.72010743268161828879E-13; - fn = fn*u+1.34283276233062758925E-16; - fn = fn*u+3.76329711269987889006E-20; - fd = 1.00000000000000000000E0; - fd = fd*u+7.51586398353378947175E-1; - fd = fd*u+1.16888925859191382142E-1; - fd = fd*u+6.44051526508858611005E-3; - fd = fd*u+1.55934409164153020873E-4; - fd = fd*u+1.84627567348930545870E-6; - fd = fd*u+1.12699224763999035261E-8; - fd = fd*u+3.60140029589371370404E-11; - fd = fd*u+5.88754533621578410010E-14; - fd = fd*u+4.52001434074129701496E-17; - fd = fd*u+1.25443237090011264384E-20; - gn = 5.04442073643383265887E-1; - gn = gn*u+1.97102833525523411709E-1; - gn = gn*u+1.87648584092575249293E-2; - gn = gn*u+6.84079380915393090172E-4; - gn = gn*u+1.15138826111884280931E-5; - gn = gn*u+9.82852443688422223854E-8; - gn = gn*u+4.45344415861750144738E-10; - gn = gn*u+1.08268041139020870318E-12; - gn = gn*u+1.37555460633261799868E-15; - gn = gn*u+8.36354435630677421531E-19; - gn = gn*u+1.86958710162783235106E-22; - gd = 1.00000000000000000000E0; - gd = gd*u+1.47495759925128324529E0; - gd = gd*u+3.37748989120019970451E-1; - gd = gd*u+2.53603741420338795122E-2; - gd = gd*u+8.14679107184306179049E-4; - gd = gd*u+1.27545075667729118702E-5; - gd = gd*u+1.04314589657571990585E-7; - gd = gd*u+4.60680728146520428211E-10; - gd = gd*u+1.10273215066240270757E-12; - gd = gd*u+1.38796531259578871258E-15; - gd = gd*u+8.39158816283118707363E-19; - gd = gd*u+1.86958710162783236342E-22; - f = 1-u*fn/fd; - g = t*gn/gd; - t = mpio2*x2; - cc = ae_cos(t, _state); - ss = ae_sin(t, _state); - t = mpi*x; - *c = 0.5+(f*ss-g*cc)/t; - *s = 0.5-(f*cc+g*ss)/t; - *c = *c*ae_sign(xxa, _state); - *s = *s*ae_sign(xxa, _state); -} - - - - -/************************************************************************* -Calculation of the value of the Hermite polynomial. - -Parameters: - n - degree, n>=0 - x - argument - -Result: - the value of the Hermite polynomial Hn at x -*************************************************************************/ -double hermitecalculate(ae_int_t n, double x, ae_state *_state) -{ - ae_int_t i; - double a; - double b; - double result; - - - result = 0; - - /* - * Prepare A and B - */ - a = 1; - b = 2*x; - - /* - * Special cases: N=0 or N=1 - */ - if( n==0 ) - { - result = a; - return result; - } - if( n==1 ) - { - result = b; - return result; - } - - /* - * General case: N>=2 - */ - for(i=2; i<=n; i++) - { - result = 2*x*b-2*(i-1)*a; - a = b; - b = result; - } - return result; -} - - -/************************************************************************* -Summation of Hermite polynomials using Clenshaw’s recurrence formula. - -This routine calculates - c[0]*H0(x) + c[1]*H1(x) + ... + c[N]*HN(x) - -Parameters: - n - degree, n>=0 - x - argument - -Result: - the value of the Hermite polynomial at x -*************************************************************************/ -double hermitesum(/* Real */ ae_vector* c, - ae_int_t n, - double x, - ae_state *_state) -{ - double b1; - double b2; - ae_int_t i; - double result; - - - b1 = 0; - b2 = 0; - result = 0; - for(i=n; i>=0; i--) - { - result = 2*(x*b1-(i+1)*b2)+c->ptr.p_double[i]; - b2 = b1; - b1 = result; - } - return result; -} - - -/************************************************************************* -Representation of Hn as C[0] + C[1]*X + ... + C[N]*X^N - -Input parameters: - N - polynomial degree, n>=0 - -Output parameters: - C - coefficients -*************************************************************************/ -void hermitecoefficients(ae_int_t n, - /* Real */ ae_vector* c, - ae_state *_state) -{ - ae_int_t i; - - ae_vector_clear(c); - - ae_vector_set_length(c, n+1, _state); - for(i=0; i<=n; i++) - { - c->ptr.p_double[i] = 0; - } - c->ptr.p_double[n] = ae_exp(n*ae_log(2, _state), _state); - for(i=0; i<=n/2-1; i++) - { - c->ptr.p_double[n-2*(i+1)] = -c->ptr.p_double[n-2*i]*(n-2*i)*(n-2*i-1)/4/(i+1); - } -} - - - - -/************************************************************************* -Jacobian Elliptic Functions - -Evaluates the Jacobian elliptic functions sn(u|m), cn(u|m), -and dn(u|m) of parameter m between 0 and 1, and real -argument u. - -These functions are periodic, with quarter-period on the -real axis equal to the complete elliptic integral -ellpk(1.0-m). - -Relation to incomplete elliptic integral: -If u = ellik(phi,m), then sn(u|m) = sin(phi), -and cn(u|m) = cos(phi). Phi is called the amplitude of u. - -Computation is by means of the arithmetic-geometric mean -algorithm, except when m is within 1e-9 of 0 or 1. In the -latter case with m close to 1, the approximation applies -only for phi < pi/2. - -ACCURACY: - -Tested at random points with u between 0 and 10, m between -0 and 1. - - Absolute error (* = relative error): -arithmetic function # trials peak rms - IEEE phi 10000 9.2e-16* 1.4e-16* - IEEE sn 50000 4.1e-15 4.6e-16 - IEEE cn 40000 3.6e-15 4.4e-16 - IEEE dn 10000 1.3e-12 1.8e-14 - - Peak error observed in consistency check using addition -theorem for sn(u+v) was 4e-16 (absolute). Also tested by -the above relation to the incomplete elliptic integral. -Accuracy deteriorates when u is large. - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -void jacobianellipticfunctions(double u, - double m, - double* sn, - double* cn, - double* dn, - double* ph, - ae_state *_state) -{ - ae_frame _frame_block; - double ai; - double b; - double phi; - double t; - double twon; - ae_vector a; - ae_vector c; - ae_int_t i; - - ae_frame_make(_state, &_frame_block); - *sn = 0; - *cn = 0; - *dn = 0; - *ph = 0; - ae_vector_init(&a, 0, DT_REAL, _state, ae_true); - ae_vector_init(&c, 0, DT_REAL, _state, ae_true); - - ae_assert(ae_fp_greater_eq(m,0)&&ae_fp_less_eq(m,1), "Domain error in JacobianEllipticFunctions: m<0 or m>1", _state); - ae_vector_set_length(&a, 8+1, _state); - ae_vector_set_length(&c, 8+1, _state); - if( ae_fp_less(m,1.0e-9) ) - { - t = ae_sin(u, _state); - b = ae_cos(u, _state); - ai = 0.25*m*(u-t*b); - *sn = t-ai*b; - *cn = b+ai*t; - *ph = u-ai; - *dn = 1.0-0.5*m*t*t; - ae_frame_leave(_state); - return; - } - if( ae_fp_greater_eq(m,0.9999999999) ) - { - ai = 0.25*(1.0-m); - b = ae_cosh(u, _state); - t = ae_tanh(u, _state); - phi = 1.0/b; - twon = b*ae_sinh(u, _state); - *sn = t+ai*(twon-u)/(b*b); - *ph = 2.0*ae_atan(ae_exp(u, _state), _state)-1.57079632679489661923+ai*(twon-u)/b; - ai = ai*t*phi; - *cn = phi-ai*(twon-u); - *dn = phi+ai*(twon+u); - ae_frame_leave(_state); - return; - } - a.ptr.p_double[0] = 1.0; - b = ae_sqrt(1.0-m, _state); - c.ptr.p_double[0] = ae_sqrt(m, _state); - twon = 1.0; - i = 0; - while(ae_fp_greater(ae_fabs(c.ptr.p_double[i]/a.ptr.p_double[i], _state),ae_machineepsilon)) - { - if( i>7 ) - { - ae_assert(ae_false, "Overflow in JacobianEllipticFunctions", _state); - break; - } - ai = a.ptr.p_double[i]; - i = i+1; - c.ptr.p_double[i] = 0.5*(ai-b); - t = ae_sqrt(ai*b, _state); - a.ptr.p_double[i] = 0.5*(ai+b); - b = t; - twon = twon*2.0; - } - phi = twon*a.ptr.p_double[i]*u; - do - { - t = c.ptr.p_double[i]*ae_sin(phi, _state)/a.ptr.p_double[i]; - b = phi; - phi = (ae_asin(t, _state)+phi)/2.0; - i = i-1; - } - while(i!=0); - *sn = ae_sin(phi, _state); - t = ae_cos(phi, _state); - *cn = t; - *dn = t/ae_cos(phi-b, _state); - *ph = phi; - ae_frame_leave(_state); -} - - - - -/************************************************************************* -Calculation of the value of the Laguerre polynomial. - -Parameters: - n - degree, n>=0 - x - argument - -Result: - the value of the Laguerre polynomial Ln at x -*************************************************************************/ -double laguerrecalculate(ae_int_t n, double x, ae_state *_state) -{ - double a; - double b; - double i; - double result; - - - result = 1; - a = 1; - b = 1-x; - if( n==1 ) - { - result = b; - } - i = 2; - while(ae_fp_less_eq(i,n)) - { - result = ((2*i-1-x)*b-(i-1)*a)/i; - a = b; - b = result; - i = i+1; - } - return result; -} - - -/************************************************************************* -Summation of Laguerre polynomials using Clenshaw’s recurrence formula. - -This routine calculates c[0]*L0(x) + c[1]*L1(x) + ... + c[N]*LN(x) - -Parameters: - n - degree, n>=0 - x - argument - -Result: - the value of the Laguerre polynomial at x -*************************************************************************/ -double laguerresum(/* Real */ ae_vector* c, - ae_int_t n, - double x, - ae_state *_state) -{ - double b1; - double b2; - ae_int_t i; - double result; - - - b1 = 0; - b2 = 0; - result = 0; - for(i=n; i>=0; i--) - { - result = (2*i+1-x)*b1/(i+1)-(i+1)*b2/(i+2)+c->ptr.p_double[i]; - b2 = b1; - b1 = result; - } - return result; -} - - -/************************************************************************* -Representation of Ln as C[0] + C[1]*X + ... + C[N]*X^N - -Input parameters: - N - polynomial degree, n>=0 - -Output parameters: - C - coefficients -*************************************************************************/ -void laguerrecoefficients(ae_int_t n, - /* Real */ ae_vector* c, - ae_state *_state) -{ - ae_int_t i; - - ae_vector_clear(c); - - ae_vector_set_length(c, n+1, _state); - c->ptr.p_double[0] = 1; - for(i=0; i<=n-1; i++) - { - c->ptr.p_double[i+1] = -c->ptr.p_double[i]*(n-i)/(i+1)/(i+1); - } -} - - - - -/************************************************************************* -Calculation of the value of the Legendre polynomial Pn. - -Parameters: - n - degree, n>=0 - x - argument - -Result: - the value of the Legendre polynomial Pn at x -*************************************************************************/ -double legendrecalculate(ae_int_t n, double x, ae_state *_state) -{ - double a; - double b; - ae_int_t i; - double result; - - - result = 1; - a = 1; - b = x; - if( n==0 ) - { - result = a; - return result; - } - if( n==1 ) - { - result = b; - return result; - } - for(i=2; i<=n; i++) - { - result = ((2*i-1)*x*b-(i-1)*a)/i; - a = b; - b = result; - } - return result; -} - - -/************************************************************************* -Summation of Legendre polynomials using Clenshaw’s recurrence formula. - -This routine calculates - c[0]*P0(x) + c[1]*P1(x) + ... + c[N]*PN(x) - -Parameters: - n - degree, n>=0 - x - argument - -Result: - the value of the Legendre polynomial at x -*************************************************************************/ -double legendresum(/* Real */ ae_vector* c, - ae_int_t n, - double x, - ae_state *_state) -{ - double b1; - double b2; - ae_int_t i; - double result; - - - b1 = 0; - b2 = 0; - result = 0; - for(i=n; i>=0; i--) - { - result = (2*i+1)*x*b1/(i+1)-(i+1)*b2/(i+2)+c->ptr.p_double[i]; - b2 = b1; - b1 = result; - } - return result; -} - - -/************************************************************************* -Representation of Pn as C[0] + C[1]*X + ... + C[N]*X^N - -Input parameters: - N - polynomial degree, n>=0 - -Output parameters: - C - coefficients -*************************************************************************/ -void legendrecoefficients(ae_int_t n, - /* Real */ ae_vector* c, - ae_state *_state) -{ - ae_int_t i; - - ae_vector_clear(c); - - ae_vector_set_length(c, n+1, _state); - for(i=0; i<=n; i++) - { - c->ptr.p_double[i] = 0; - } - c->ptr.p_double[n] = 1; - for(i=1; i<=n; i++) - { - c->ptr.p_double[n] = c->ptr.p_double[n]*(n+i)/2/i; - } - for(i=0; i<=n/2-1; i++) - { - c->ptr.p_double[n-2*(i+1)] = -c->ptr.p_double[n-2*i]*(n-2*i)*(n-2*i-1)/2/(i+1)/(2*(n-i)-1); - } -} - - - - -/************************************************************************* -Poisson distribution - -Returns the sum of the first k+1 terms of the Poisson -distribution: - - k j - -- -m m - > e -- - -- j! - j=0 - -The terms are not summed directly; instead the incomplete -gamma integral is employed, according to the relation - -y = pdtr( k, m ) = igamc( k+1, m ). - -The arguments must both be positive. -ACCURACY: - -See incomplete gamma function - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double poissondistribution(ae_int_t k, double m, ae_state *_state) -{ - double result; - - - ae_assert(k>=0&&ae_fp_greater(m,0), "Domain error in PoissonDistribution", _state); - result = incompletegammac(k+1, m, _state); - return result; -} - - -/************************************************************************* -Complemented Poisson distribution - -Returns the sum of the terms k+1 to infinity of the Poisson -distribution: - - inf. j - -- -m m - > e -- - -- j! - j=k+1 - -The terms are not summed directly; instead the incomplete -gamma integral is employed, according to the formula - -y = pdtrc( k, m ) = igam( k+1, m ). - -The arguments must both be positive. - -ACCURACY: - -See incomplete gamma function - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double poissoncdistribution(ae_int_t k, double m, ae_state *_state) -{ - double result; - - - ae_assert(k>=0&&ae_fp_greater(m,0), "Domain error in PoissonDistributionC", _state); - result = incompletegamma(k+1, m, _state); - return result; -} - - -/************************************************************************* -Inverse Poisson distribution - -Finds the Poisson variable x such that the integral -from 0 to x of the Poisson density is equal to the -given probability y. - -This is accomplished using the inverse gamma integral -function and the relation - - m = igami( k+1, y ). - -ACCURACY: - -See inverse incomplete gamma function - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double invpoissondistribution(ae_int_t k, double y, ae_state *_state) -{ - double result; - - - ae_assert((k>=0&&ae_fp_greater_eq(y,0))&&ae_fp_less(y,1), "Domain error in InvPoissonDistribution", _state); - result = invincompletegammac(k+1, y, _state); - return result; -} - - - - -/************************************************************************* -Psi (digamma) function - - d - - psi(x) = -- ln | (x) - dx - -is the logarithmic derivative of the gamma function. -For integer x, - n-1 - - -psi(n) = -EUL + > 1/k. - - - k=1 - -This formula is used for 0 < n <= 10. If x is negative, it -is transformed to a positive argument by the reflection -formula psi(1-x) = psi(x) + pi cot(pi x). -For general positive x, the argument is made greater than 10 -using the recurrence psi(x+1) = psi(x) + 1/x. -Then the following asymptotic expansion is applied: - - inf. B - - 2k -psi(x) = log(x) - 1/2x - > ------- - - 2k - k=1 2k x - -where the B2k are Bernoulli numbers. - -ACCURACY: - Relative error (except absolute when |psi| < 1): -arithmetic domain # trials peak rms - IEEE 0,30 30000 1.3e-15 1.4e-16 - IEEE -30,0 40000 1.5e-15 2.2e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1992, 2000 by Stephen L. Moshier -*************************************************************************/ -double psi(double x, ae_state *_state) -{ - double p; - double q; - double nz; - double s; - double w; - double y; - double z; - double polv; - ae_int_t i; - ae_int_t n; - ae_int_t negative; - double result; - - - negative = 0; - nz = 0.0; - if( ae_fp_less_eq(x,0) ) - { - negative = 1; - q = x; - p = ae_ifloor(q, _state); - if( ae_fp_eq(p,q) ) - { - ae_assert(ae_false, "Singularity in Psi(x)", _state); - result = ae_maxrealnumber; - return result; - } - nz = q-p; - if( ae_fp_neq(nz,0.5) ) - { - if( ae_fp_greater(nz,0.5) ) - { - p = p+1.0; - nz = q-p; - } - nz = ae_pi/ae_tan(ae_pi*nz, _state); - } - else - { - nz = 0.0; - } - x = 1.0-x; - } - if( ae_fp_less_eq(x,10.0)&&ae_fp_eq(x,ae_ifloor(x, _state)) ) - { - y = 0.0; - n = ae_ifloor(x, _state); - for(i=1; i<=n-1; i++) - { - w = i; - y = y+1.0/w; - } - y = y-0.57721566490153286061; - } - else - { - s = x; - w = 0.0; - while(ae_fp_less(s,10.0)) - { - w = w+1.0/s; - s = s+1.0; - } - if( ae_fp_less(s,1.0E17) ) - { - z = 1.0/(s*s); - polv = 8.33333333333333333333E-2; - polv = polv*z-2.10927960927960927961E-2; - polv = polv*z+7.57575757575757575758E-3; - polv = polv*z-4.16666666666666666667E-3; - polv = polv*z+3.96825396825396825397E-3; - polv = polv*z-8.33333333333333333333E-3; - polv = polv*z+8.33333333333333333333E-2; - y = z*polv; - } - else - { - y = 0.0; - } - y = ae_log(s, _state)-0.5/s-y-w; - } - if( negative!=0 ) - { - y = y-nz; - } - result = y; - return result; -} - - - - -/************************************************************************* -Student's t distribution - -Computes the integral from minus infinity to t of the Student -t distribution with integer k > 0 degrees of freedom: - - t - - - | | - - | 2 -(k+1)/2 - | ( (k+1)/2 ) | ( x ) - ---------------------- | ( 1 + --- ) dx - - | ( k ) - sqrt( k pi ) | ( k/2 ) | - | | - - - -inf. - -Relation to incomplete beta integral: - - 1 - stdtr(k,t) = 0.5 * incbet( k/2, 1/2, z ) -where - z = k/(k + t**2). - -For t < -2, this is the method of computation. For higher t, -a direct method is derived from integration by parts. -Since the function is symmetric about t=0, the area under the -right tail of the density is found by calling the function -with -t instead of t. - -ACCURACY: - -Tested at random 1 <= k <= 25. The "domain" refers to t. - Relative error: -arithmetic domain # trials peak rms - IEEE -100,-2 50000 5.9e-15 1.4e-15 - IEEE -2,100 500000 2.7e-15 4.9e-17 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double studenttdistribution(ae_int_t k, double t, ae_state *_state) -{ - double x; - double rk; - double z; - double f; - double tz; - double p; - double xsqk; - ae_int_t j; - double result; - - - ae_assert(k>0, "Domain error in StudentTDistribution", _state); - if( ae_fp_eq(t,0) ) - { - result = 0.5; - return result; - } - if( ae_fp_less(t,-2.0) ) - { - rk = k; - z = rk/(rk+t*t); - result = 0.5*incompletebeta(0.5*rk, 0.5, z, _state); - return result; - } - if( ae_fp_less(t,0) ) - { - x = -t; - } - else - { - x = t; - } - rk = k; - z = 1.0+x*x/rk; - if( k%2!=0 ) - { - xsqk = x/ae_sqrt(rk, _state); - p = ae_atan(xsqk, _state); - if( k>1 ) - { - f = 1.0; - tz = 1.0; - j = 3; - while(j<=k-2&&ae_fp_greater(tz/f,ae_machineepsilon)) - { - tz = tz*((j-1)/(z*j)); - f = f+tz; - j = j+2; - } - p = p+f*xsqk/z; - } - p = p*2.0/ae_pi; - } - else - { - f = 1.0; - tz = 1.0; - j = 2; - while(j<=k-2&&ae_fp_greater(tz/f,ae_machineepsilon)) - { - tz = tz*((j-1)/(z*j)); - f = f+tz; - j = j+2; - } - p = f*x/ae_sqrt(z*rk, _state); - } - if( ae_fp_less(t,0) ) - { - p = -p; - } - result = 0.5+0.5*p; - return result; -} - - -/************************************************************************* -Functional inverse of Student's t distribution - -Given probability p, finds the argument t such that stdtr(k,t) -is equal to p. - -ACCURACY: - -Tested at random 1 <= k <= 100. The "domain" refers to p: - Relative error: -arithmetic domain # trials peak rms - IEEE .001,.999 25000 5.7e-15 8.0e-16 - IEEE 10^-6,.001 25000 2.0e-12 2.9e-14 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double invstudenttdistribution(ae_int_t k, double p, ae_state *_state) -{ - double t; - double rk; - double z; - ae_int_t rflg; - double result; - - - ae_assert((k>0&&ae_fp_greater(p,0))&&ae_fp_less(p,1), "Domain error in InvStudentTDistribution", _state); - rk = k; - if( ae_fp_greater(p,0.25)&&ae_fp_less(p,0.75) ) - { - if( ae_fp_eq(p,0.5) ) - { - result = 0; - return result; - } - z = 1.0-2.0*p; - z = invincompletebeta(0.5, 0.5*rk, ae_fabs(z, _state), _state); - t = ae_sqrt(rk*z/(1.0-z), _state); - if( ae_fp_less(p,0.5) ) - { - t = -t; - } - result = t; - return result; - } - rflg = -1; - if( ae_fp_greater_eq(p,0.5) ) - { - p = 1.0-p; - rflg = 1; - } - z = invincompletebeta(0.5*rk, 0.5, 2.0*p, _state); - if( ae_fp_less(ae_maxrealnumber*z,rk) ) - { - result = rflg*ae_maxrealnumber; - return result; - } - t = ae_sqrt(rk/z-rk, _state); - result = rflg*t; - return result; -} - - - - -/************************************************************************* -Sine and cosine integrals - -Evaluates the integrals - - x - - - | cos t - 1 - Ci(x) = eul + ln x + | --------- dt, - | t - - - 0 - x - - - | sin t - Si(x) = | ----- dt - | t - - - 0 - -where eul = 0.57721566490153286061 is Euler's constant. -The integrals are approximated by rational functions. -For x > 8 auxiliary functions f(x) and g(x) are employed -such that - -Ci(x) = f(x) sin(x) - g(x) cos(x) -Si(x) = pi/2 - f(x) cos(x) - g(x) sin(x) - - -ACCURACY: - Test interval = [0,50]. -Absolute error, except relative when > 1: -arithmetic function # trials peak rms - IEEE Si 30000 4.4e-16 7.3e-17 - IEEE Ci 30000 6.9e-16 5.1e-17 - -Cephes Math Library Release 2.1: January, 1989 -Copyright 1984, 1987, 1989 by Stephen L. Moshier -*************************************************************************/ -void sinecosineintegrals(double x, - double* si, - double* ci, - ae_state *_state) -{ - double z; - double c; - double s; - double f; - double g; - ae_int_t sg; - double sn; - double sd; - double cn; - double cd; - double fn; - double fd; - double gn; - double gd; - - *si = 0; - *ci = 0; - - if( ae_fp_less(x,0) ) - { - sg = -1; - x = -x; - } - else - { - sg = 0; - } - if( ae_fp_eq(x,0) ) - { - *si = 0; - *ci = -ae_maxrealnumber; - return; - } - if( ae_fp_greater(x,1.0E9) ) - { - *si = 1.570796326794896619-ae_cos(x, _state)/x; - *ci = ae_sin(x, _state)/x; - return; - } - if( ae_fp_less_eq(x,4) ) - { - z = x*x; - sn = -8.39167827910303881427E-11; - sn = sn*z+4.62591714427012837309E-8; - sn = sn*z-9.75759303843632795789E-6; - sn = sn*z+9.76945438170435310816E-4; - sn = sn*z-4.13470316229406538752E-2; - sn = sn*z+1.00000000000000000302E0; - sd = 2.03269266195951942049E-12; - sd = sd*z+1.27997891179943299903E-9; - sd = sd*z+4.41827842801218905784E-7; - sd = sd*z+9.96412122043875552487E-5; - sd = sd*z+1.42085239326149893930E-2; - sd = sd*z+9.99999999999999996984E-1; - s = x*sn/sd; - cn = 2.02524002389102268789E-11; - cn = cn*z-1.35249504915790756375E-8; - cn = cn*z+3.59325051419993077021E-6; - cn = cn*z-4.74007206873407909465E-4; - cn = cn*z+2.89159652607555242092E-2; - cn = cn*z-1.00000000000000000080E0; - cd = 4.07746040061880559506E-12; - cd = cd*z+3.06780997581887812692E-9; - cd = cd*z+1.23210355685883423679E-6; - cd = cd*z+3.17442024775032769882E-4; - cd = cd*z+5.10028056236446052392E-2; - cd = cd*z+4.00000000000000000080E0; - c = z*cn/cd; - if( sg!=0 ) - { - s = -s; - } - *si = s; - *ci = 0.57721566490153286061+ae_log(x, _state)+c; - return; - } - s = ae_sin(x, _state); - c = ae_cos(x, _state); - z = 1.0/(x*x); - if( ae_fp_less(x,8) ) - { - fn = 4.23612862892216586994E0; - fn = fn*z+5.45937717161812843388E0; - fn = fn*z+1.62083287701538329132E0; - fn = fn*z+1.67006611831323023771E-1; - fn = fn*z+6.81020132472518137426E-3; - fn = fn*z+1.08936580650328664411E-4; - fn = fn*z+5.48900223421373614008E-7; - fd = 1.00000000000000000000E0; - fd = fd*z+8.16496634205391016773E0; - fd = fd*z+7.30828822505564552187E0; - fd = fd*z+1.86792257950184183883E0; - fd = fd*z+1.78792052963149907262E-1; - fd = fd*z+7.01710668322789753610E-3; - fd = fd*z+1.10034357153915731354E-4; - fd = fd*z+5.48900252756255700982E-7; - f = fn/(x*fd); - gn = 8.71001698973114191777E-2; - gn = gn*z+6.11379109952219284151E-1; - gn = gn*z+3.97180296392337498885E-1; - gn = gn*z+7.48527737628469092119E-2; - gn = gn*z+5.38868681462177273157E-3; - gn = gn*z+1.61999794598934024525E-4; - gn = gn*z+1.97963874140963632189E-6; - gn = gn*z+7.82579040744090311069E-9; - gd = 1.00000000000000000000E0; - gd = gd*z+1.64402202413355338886E0; - gd = gd*z+6.66296701268987968381E-1; - gd = gd*z+9.88771761277688796203E-2; - gd = gd*z+6.22396345441768420760E-3; - gd = gd*z+1.73221081474177119497E-4; - gd = gd*z+2.02659182086343991969E-6; - gd = gd*z+7.82579218933534490868E-9; - g = z*gn/gd; - } - else - { - fn = 4.55880873470465315206E-1; - fn = fn*z+7.13715274100146711374E-1; - fn = fn*z+1.60300158222319456320E-1; - fn = fn*z+1.16064229408124407915E-2; - fn = fn*z+3.49556442447859055605E-4; - fn = fn*z+4.86215430826454749482E-6; - fn = fn*z+3.20092790091004902806E-8; - fn = fn*z+9.41779576128512936592E-11; - fn = fn*z+9.70507110881952024631E-14; - fd = 1.00000000000000000000E0; - fd = fd*z+9.17463611873684053703E-1; - fd = fd*z+1.78685545332074536321E-1; - fd = fd*z+1.22253594771971293032E-2; - fd = fd*z+3.58696481881851580297E-4; - fd = fd*z+4.92435064317881464393E-6; - fd = fd*z+3.21956939101046018377E-8; - fd = fd*z+9.43720590350276732376E-11; - fd = fd*z+9.70507110881952025725E-14; - f = fn/(x*fd); - gn = 6.97359953443276214934E-1; - gn = gn*z+3.30410979305632063225E-1; - gn = gn*z+3.84878767649974295920E-2; - gn = gn*z+1.71718239052347903558E-3; - gn = gn*z+3.48941165502279436777E-5; - gn = gn*z+3.47131167084116673800E-7; - gn = gn*z+1.70404452782044526189E-9; - gn = gn*z+3.85945925430276600453E-12; - gn = gn*z+3.14040098946363334640E-15; - gd = 1.00000000000000000000E0; - gd = gd*z+1.68548898811011640017E0; - gd = gd*z+4.87852258695304967486E-1; - gd = gd*z+4.67913194259625806320E-2; - gd = gd*z+1.90284426674399523638E-3; - gd = gd*z+3.68475504442561108162E-5; - gd = gd*z+3.57043223443740838771E-7; - gd = gd*z+1.72693748966316146736E-9; - gd = gd*z+3.87830166023954706752E-12; - gd = gd*z+3.14040098946363335242E-15; - g = z*gn/gd; - } - *si = 1.570796326794896619-f*c-g*s; - if( sg!=0 ) - { - *si = -*si; - } - *ci = f*s-g*c; -} - - -/************************************************************************* -Hyperbolic sine and cosine integrals - -Approximates the integrals - - x - - - | | cosh t - 1 - Chi(x) = eul + ln x + | ----------- dt, - | | t - - - 0 - - x - - - | | sinh t - Shi(x) = | ------ dt - | | t - - - 0 - -where eul = 0.57721566490153286061 is Euler's constant. -The integrals are evaluated by power series for x < 8 -and by Chebyshev expansions for x between 8 and 88. -For large x, both functions approach exp(x)/2x. -Arguments greater than 88 in magnitude return MAXNUM. - - -ACCURACY: - -Test interval 0 to 88. - Relative error: -arithmetic function # trials peak rms - IEEE Shi 30000 6.9e-16 1.6e-16 - Absolute error, except relative when |Chi| > 1: - IEEE Chi 30000 8.4e-16 1.4e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -void hyperbolicsinecosineintegrals(double x, - double* shi, - double* chi, - ae_state *_state) -{ - double k; - double z; - double c; - double s; - double a; - ae_int_t sg; - double b0; - double b1; - double b2; - - *shi = 0; - *chi = 0; - - if( ae_fp_less(x,0) ) - { - sg = -1; - x = -x; - } - else - { - sg = 0; - } - if( ae_fp_eq(x,0) ) - { - *shi = 0; - *chi = -ae_maxrealnumber; - return; - } - if( ae_fp_less(x,8.0) ) - { - z = x*x; - a = 1.0; - s = 1.0; - c = 0.0; - k = 2.0; - do - { - a = a*z/k; - c = c+a/k; - k = k+1.0; - a = a/k; - s = s+a/k; - k = k+1.0; - } - while(ae_fp_greater_eq(ae_fabs(a/s, _state),ae_machineepsilon)); - s = s*x; - } - else - { - if( ae_fp_less(x,18.0) ) - { - a = (576.0/x-52.0)/10.0; - k = ae_exp(x, _state)/x; - b0 = 1.83889230173399459482E-17; - b1 = 0.0; - trigintegrals_chebiterationshichi(a, -9.55485532279655569575E-17, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 2.04326105980879882648E-16, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 1.09896949074905343022E-15, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -1.31313534344092599234E-14, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 5.93976226264314278932E-14, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -3.47197010497749154755E-14, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -1.40059764613117131000E-12, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 9.49044626224223543299E-12, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -1.61596181145435454033E-11, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -1.77899784436430310321E-10, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 1.35455469767246947469E-9, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -1.03257121792819495123E-9, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -3.56699611114982536845E-8, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 1.44818877384267342057E-7, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 7.82018215184051295296E-7, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -5.39919118403805073710E-6, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -3.12458202168959833422E-5, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 8.90136741950727517826E-5, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 2.02558474743846862168E-3, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 2.96064440855633256972E-2, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 1.11847751047257036625E0, &b0, &b1, &b2, _state); - s = k*0.5*(b0-b2); - b0 = -8.12435385225864036372E-18; - b1 = 0.0; - trigintegrals_chebiterationshichi(a, 2.17586413290339214377E-17, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 5.22624394924072204667E-17, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -9.48812110591690559363E-16, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 5.35546311647465209166E-15, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -1.21009970113732918701E-14, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -6.00865178553447437951E-14, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 7.16339649156028587775E-13, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -2.93496072607599856104E-12, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -1.40359438136491256904E-12, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 8.76302288609054966081E-11, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -4.40092476213282340617E-10, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -1.87992075640569295479E-10, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 1.31458150989474594064E-8, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -4.75513930924765465590E-8, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -2.21775018801848880741E-7, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 1.94635531373272490962E-6, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 4.33505889257316408893E-6, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -6.13387001076494349496E-5, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -3.13085477492997465138E-4, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 4.97164789823116062801E-4, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 2.64347496031374526641E-2, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 1.11446150876699213025E0, &b0, &b1, &b2, _state); - c = k*0.5*(b0-b2); - } - else - { - if( ae_fp_less_eq(x,88.0) ) - { - a = (6336.0/x-212.0)/70.0; - k = ae_exp(x, _state)/x; - b0 = -1.05311574154850938805E-17; - b1 = 0.0; - trigintegrals_chebiterationshichi(a, 2.62446095596355225821E-17, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 8.82090135625368160657E-17, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -3.38459811878103047136E-16, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -8.30608026366935789136E-16, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 3.93397875437050071776E-15, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 1.01765565969729044505E-14, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -4.21128170307640802703E-14, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -1.60818204519802480035E-13, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 3.34714954175994481761E-13, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 2.72600352129153073807E-12, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 1.66894954752839083608E-12, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -3.49278141024730899554E-11, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -1.58580661666482709598E-10, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -1.79289437183355633342E-10, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 1.76281629144264523277E-9, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 1.69050228879421288846E-8, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 1.25391771228487041649E-7, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 1.16229947068677338732E-6, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 1.61038260117376323993E-5, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 3.49810375601053973070E-4, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 1.28478065259647610779E-2, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 1.03665722588798326712E0, &b0, &b1, &b2, _state); - s = k*0.5*(b0-b2); - b0 = 8.06913408255155572081E-18; - b1 = 0.0; - trigintegrals_chebiterationshichi(a, -2.08074168180148170312E-17, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -5.98111329658272336816E-17, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 2.68533951085945765591E-16, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 4.52313941698904694774E-16, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -3.10734917335299464535E-15, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -4.42823207332531972288E-15, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 3.49639695410806959872E-14, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 6.63406731718911586609E-14, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -3.71902448093119218395E-13, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -1.27135418132338309016E-12, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 2.74851141935315395333E-12, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 2.33781843985453438400E-11, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 2.71436006377612442764E-11, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -2.56600180000355990529E-10, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -1.61021375163803438552E-9, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -4.72543064876271773512E-9, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, -3.00095178028681682282E-9, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 7.79387474390914922337E-8, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 1.06942765566401507066E-6, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 1.59503164802313196374E-5, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 3.49592575153777996871E-4, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 1.28475387530065247392E-2, &b0, &b1, &b2, _state); - trigintegrals_chebiterationshichi(a, 1.03665693917934275131E0, &b0, &b1, &b2, _state); - c = k*0.5*(b0-b2); - } - else - { - if( sg!=0 ) - { - *shi = -ae_maxrealnumber; - } - else - { - *shi = ae_maxrealnumber; - } - *chi = ae_maxrealnumber; - return; - } - } - } - if( sg!=0 ) - { - s = -s; - } - *shi = s; - *chi = 0.57721566490153286061+ae_log(x, _state)+c; -} - - -static void trigintegrals_chebiterationshichi(double x, - double c, - double* b0, - double* b1, - double* b2, - ae_state *_state) -{ - - - *b2 = *b1; - *b1 = *b0; - *b0 = x*(*b1)-(*b2)+c; -} - - - -} - diff --git a/src/core/alglib/specialfunctions.h b/src/core/alglib/specialfunctions.h deleted file mode 100644 index f09393b..0000000 --- a/src/core/alglib/specialfunctions.h +++ /dev/null @@ -1,1976 +0,0 @@ -/************************************************************************* -Copyright (c) Sergey Bochkanov (ALGLIB project). - ->>> SOURCE LICENSE >>> -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation (www.fsf.org); either version 2 of the -License, or (at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -A copy of the GNU General Public License is available at -http://www.fsf.org/licensing/licenses ->>> END OF LICENSE >>> -*************************************************************************/ -#ifndef _specialfunctions_pkg_h -#define _specialfunctions_pkg_h -#include "ap.h" -#include "alglibinternal.h" - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (DATATYPES) -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ - -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS C++ INTERFACE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib -{ - - -/************************************************************************* -Gamma function - -Input parameters: - X - argument - -Domain: - 0 < X < 171.6 - -170 < X < 0, X is not an integer. - -Relative error: - arithmetic domain # trials peak rms - IEEE -170,-33 20000 2.3e-15 3.3e-16 - IEEE -33, 33 20000 9.4e-16 2.2e-16 - IEEE 33, 171.6 20000 2.3e-15 3.2e-16 - -Cephes Math Library Release 2.8: June, 2000 -Original copyright 1984, 1987, 1989, 1992, 2000 by Stephen L. Moshier -Translated to AlgoPascal by Bochkanov Sergey (2005, 2006, 2007). -*************************************************************************/ -double gammafunction(const double x); - - -/************************************************************************* -Natural logarithm of gamma function - -Input parameters: - X - argument - -Result: - logarithm of the absolute value of the Gamma(X). - -Output parameters: - SgnGam - sign(Gamma(X)) - -Domain: - 0 < X < 2.55e305 - -2.55e305 < X < 0, X is not an integer. - -ACCURACY: -arithmetic domain # trials peak rms - IEEE 0, 3 28000 5.4e-16 1.1e-16 - IEEE 2.718, 2.556e305 40000 3.5e-16 8.3e-17 -The error criterion was relative when the function magnitude -was greater than one but absolute when it was less than one. - -The following test used the relative error criterion, though -at certain points the relative error could be much higher than -indicated. - IEEE -200, -4 10000 4.8e-16 1.3e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1989, 1992, 2000 by Stephen L. Moshier -Translated to AlgoPascal by Bochkanov Sergey (2005, 2006, 2007). -*************************************************************************/ -double lngamma(const double x, double &sgngam); - -/************************************************************************* -Error function - -The integral is - - x - - - 2 | | 2 - erf(x) = -------- | exp( - t ) dt. - sqrt(pi) | | - - - 0 - -For 0 <= |x| < 1, erf(x) = x * P4(x**2)/Q5(x**2); otherwise -erf(x) = 1 - erfc(x). - - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0,1 30000 3.7e-16 1.0e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier -*************************************************************************/ -double errorfunction(const double x); - - -/************************************************************************* -Complementary error function - - 1 - erf(x) = - - inf. - - - 2 | | 2 - erfc(x) = -------- | exp( - t ) dt - sqrt(pi) | | - - - x - - -For small x, erfc(x) = 1 - erf(x); otherwise rational -approximations are computed. - - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0,26.6417 30000 5.7e-14 1.5e-14 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier -*************************************************************************/ -double errorfunctionc(const double x); - - -/************************************************************************* -Normal distribution function - -Returns the area under the Gaussian probability density -function, integrated from minus infinity to x: - - x - - - 1 | | 2 - ndtr(x) = --------- | exp( - t /2 ) dt - sqrt(2pi) | | - - - -inf. - - = ( 1 + erf(z) ) / 2 - = erfc(z) / 2 - -where z = x/sqrt(2). Computation is via the functions -erf and erfc. - - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE -13,0 30000 3.4e-14 6.7e-15 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier -*************************************************************************/ -double normaldistribution(const double x); - - -/************************************************************************* -Inverse of the error function - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier -*************************************************************************/ -double inverf(const double e); - - -/************************************************************************* -Inverse of Normal distribution function - -Returns the argument, x, for which the area under the -Gaussian probability density function (integrated from -minus infinity to x) is equal to y. - - -For small arguments 0 < y < exp(-2), the program computes -z = sqrt( -2.0 * log(y) ); then the approximation is -x = z - log(z)/z - (1/z) P(1/z) / Q(1/z). -There are two rational functions P/Q, one for 0 < y < exp(-32) -and the other for y up to exp(-2). For larger arguments, -w = y - 0.5, and x/sqrt(2pi) = w + w**3 R(w**2)/S(w**2)). - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0.125, 1 20000 7.2e-16 1.3e-16 - IEEE 3e-308, 0.135 50000 4.6e-16 9.8e-17 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier -*************************************************************************/ -double invnormaldistribution(const double y0); - -/************************************************************************* -Incomplete gamma integral - -The function is defined by - - x - - - 1 | | -t a-1 - igam(a,x) = ----- | e t dt. - - | | - | (a) - - 0 - - -In this implementation both arguments must be positive. -The integral is evaluated by either a power series or -continued fraction expansion, depending on the relative -values of a and x. - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0,30 200000 3.6e-14 2.9e-15 - IEEE 0,100 300000 9.9e-14 1.5e-14 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1985, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double incompletegamma(const double a, const double x); - - -/************************************************************************* -Complemented incomplete gamma integral - -The function is defined by - - - igamc(a,x) = 1 - igam(a,x) - - inf. - - - 1 | | -t a-1 - = ----- | e t dt. - - | | - | (a) - - x - - -In this implementation both arguments must be positive. -The integral is evaluated by either a power series or -continued fraction expansion, depending on the relative -values of a and x. - -ACCURACY: - -Tested at random a, x. - a x Relative error: -arithmetic domain domain # trials peak rms - IEEE 0.5,100 0,100 200000 1.9e-14 1.7e-15 - IEEE 0.01,0.5 0,100 200000 1.4e-13 1.6e-15 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1985, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double incompletegammac(const double a, const double x); - - -/************************************************************************* -Inverse of complemented incomplete gamma integral - -Given p, the function finds x such that - - igamc( a, x ) = p. - -Starting with the approximate value - - 3 - x = a t - - where - - t = 1 - d - ndtri(p) sqrt(d) - -and - - d = 1/9a, - -the routine performs up to 10 Newton iterations to find the -root of igamc(a,x) - p = 0. - -ACCURACY: - -Tested at random a, p in the intervals indicated. - - a p Relative error: -arithmetic domain domain # trials peak rms - IEEE 0.5,100 0,0.5 100000 1.0e-14 1.7e-15 - IEEE 0.01,0.5 0,0.5 100000 9.0e-14 3.4e-15 - IEEE 0.5,10000 0,0.5 20000 2.3e-13 3.8e-14 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double invincompletegammac(const double a, const double y0); - -/************************************************************************* -Airy function - -Solution of the differential equation - -y"(x) = xy. - -The function returns the two independent solutions Ai, Bi -and their first derivatives Ai'(x), Bi'(x). - -Evaluation is by power series summation for small x, -by rational minimax approximations for large x. - - - -ACCURACY: -Error criterion is absolute when function <= 1, relative -when function > 1, except * denotes relative error criterion. -For large negative x, the absolute error increases as x^1.5. -For large positive x, the relative error increases as x^1.5. - -Arithmetic domain function # trials peak rms -IEEE -10, 0 Ai 10000 1.6e-15 2.7e-16 -IEEE 0, 10 Ai 10000 2.3e-14* 1.8e-15* -IEEE -10, 0 Ai' 10000 4.6e-15 7.6e-16 -IEEE 0, 10 Ai' 10000 1.8e-14* 1.5e-15* -IEEE -10, 10 Bi 30000 4.2e-15 5.3e-16 -IEEE -10, 10 Bi' 30000 4.9e-15 7.3e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier -*************************************************************************/ -void airy(const double x, double &ai, double &aip, double &bi, double &bip); - -/************************************************************************* -Bessel function of order zero - -Returns Bessel function of order zero of the argument. - -The domain is divided into the intervals [0, 5] and -(5, infinity). In the first interval the following rational -approximation is used: - - - 2 2 -(w - r ) (w - r ) P (w) / Q (w) - 1 2 3 8 - - 2 -where w = x and the two r's are zeros of the function. - -In the second interval, the Hankel asymptotic expansion -is employed with two rational functions of degree 6/6 -and 7/7. - -ACCURACY: - - Absolute error: -arithmetic domain # trials peak rms - IEEE 0, 30 60000 4.2e-16 1.1e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier -*************************************************************************/ -double besselj0(const double x); - - -/************************************************************************* -Bessel function of order one - -Returns Bessel function of order one of the argument. - -The domain is divided into the intervals [0, 8] and -(8, infinity). In the first interval a 24 term Chebyshev -expansion is used. In the second, the asymptotic -trigonometric representation is employed using two -rational functions of degree 5/5. - -ACCURACY: - - Absolute error: -arithmetic domain # trials peak rms - IEEE 0, 30 30000 2.6e-16 1.1e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier -*************************************************************************/ -double besselj1(const double x); - - -/************************************************************************* -Bessel function of integer order - -Returns Bessel function of order n, where n is a -(possibly negative) integer. - -The ratio of jn(x) to j0(x) is computed by backward -recurrence. First the ratio jn/jn-1 is found by a -continued fraction expansion. Then the recurrence -relating successive orders is applied until j0 or j1 is -reached. - -If n = 0 or 1 the routine for j0 or j1 is called -directly. - -ACCURACY: - - Absolute error: -arithmetic range # trials peak rms - IEEE 0, 30 5000 4.4e-16 7.9e-17 - - -Not suitable for large n or x. Use jv() (fractional order) instead. - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double besseljn(const ae_int_t n, const double x); - - -/************************************************************************* -Bessel function of the second kind, order zero - -Returns Bessel function of the second kind, of order -zero, of the argument. - -The domain is divided into the intervals [0, 5] and -(5, infinity). In the first interval a rational approximation -R(x) is employed to compute - y0(x) = R(x) + 2 * log(x) * j0(x) / PI. -Thus a call to j0() is required. - -In the second interval, the Hankel asymptotic expansion -is employed with two rational functions of degree 6/6 -and 7/7. - - - -ACCURACY: - - Absolute error, when y0(x) < 1; else relative error: - -arithmetic domain # trials peak rms - IEEE 0, 30 30000 1.3e-15 1.6e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier -*************************************************************************/ -double bessely0(const double x); - - -/************************************************************************* -Bessel function of second kind of order one - -Returns Bessel function of the second kind of order one -of the argument. - -The domain is divided into the intervals [0, 8] and -(8, infinity). In the first interval a 25 term Chebyshev -expansion is used, and a call to j1() is required. -In the second, the asymptotic trigonometric representation -is employed using two rational functions of degree 5/5. - -ACCURACY: - - Absolute error: -arithmetic domain # trials peak rms - IEEE 0, 30 30000 1.0e-15 1.3e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier -*************************************************************************/ -double bessely1(const double x); - - -/************************************************************************* -Bessel function of second kind of integer order - -Returns Bessel function of order n, where n is a -(possibly negative) integer. - -The function is evaluated by forward recurrence on -n, starting with values computed by the routines -y0() and y1(). - -If n = 0 or 1 the routine for y0 or y1 is called -directly. - -ACCURACY: - Absolute error, except relative - when y > 1: -arithmetic domain # trials peak rms - IEEE 0, 30 30000 3.4e-15 4.3e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double besselyn(const ae_int_t n, const double x); - - -/************************************************************************* -Modified Bessel function of order zero - -Returns modified Bessel function of order zero of the -argument. - -The function is defined as i0(x) = j0( ix ). - -The range is partitioned into the two intervals [0,8] and -(8, infinity). Chebyshev polynomial expansions are employed -in each interval. - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0,30 30000 5.8e-16 1.4e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double besseli0(const double x); - - -/************************************************************************* -Modified Bessel function of order one - -Returns modified Bessel function of order one of the -argument. - -The function is defined as i1(x) = -i j1( ix ). - -The range is partitioned into the two intervals [0,8] and -(8, infinity). Chebyshev polynomial expansions are employed -in each interval. - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0, 30 30000 1.9e-15 2.1e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1985, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double besseli1(const double x); - - -/************************************************************************* -Modified Bessel function, second kind, order zero - -Returns modified Bessel function of the second kind -of order zero of the argument. - -The range is partitioned into the two intervals [0,8] and -(8, infinity). Chebyshev polynomial expansions are employed -in each interval. - -ACCURACY: - -Tested at 2000 random points between 0 and 8. Peak absolute -error (relative when K0 > 1) was 1.46e-14; rms, 4.26e-15. - Relative error: -arithmetic domain # trials peak rms - IEEE 0, 30 30000 1.2e-15 1.6e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double besselk0(const double x); - - -/************************************************************************* -Modified Bessel function, second kind, order one - -Computes the modified Bessel function of the second kind -of order one of the argument. - -The range is partitioned into the two intervals [0,2] and -(2, infinity). Chebyshev polynomial expansions are employed -in each interval. - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0, 30 30000 1.2e-15 1.6e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double besselk1(const double x); - - -/************************************************************************* -Modified Bessel function, second kind, integer order - -Returns modified Bessel function of the second kind -of order n of the argument. - -The range is partitioned into the two intervals [0,9.55] and -(9.55, infinity). An ascending power series is used in the -low range, and an asymptotic expansion in the high range. - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0,30 90000 1.8e-8 3.0e-10 - -Error is high only near the crossover point x = 9.55 -between the two expansions used. - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1988, 2000 by Stephen L. Moshier -*************************************************************************/ -double besselkn(const ae_int_t nn, const double x); - -/************************************************************************* -Beta function - - - - - - | (a) | (b) -beta( a, b ) = -----------. - - - | (a+b) - -For large arguments the logarithm of the function is -evaluated using lgam(), then exponentiated. - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0,30 30000 8.1e-14 1.1e-14 - -Cephes Math Library Release 2.0: April, 1987 -Copyright 1984, 1987 by Stephen L. Moshier -*************************************************************************/ -double beta(const double a, const double b); - -/************************************************************************* -Incomplete beta integral - -Returns incomplete beta integral of the arguments, evaluated -from zero to x. The function is defined as - - x - - - - | (a+b) | | a-1 b-1 - ----------- | t (1-t) dt. - - - | | - | (a) | (b) - - 0 - -The domain of definition is 0 <= x <= 1. In this -implementation a and b are restricted to positive values. -The integral from x to 1 may be obtained by the symmetry -relation - - 1 - incbet( a, b, x ) = incbet( b, a, 1-x ). - -The integral is evaluated by a continued fraction expansion -or, when b*x is small, by a power series. - -ACCURACY: - -Tested at uniformly distributed random points (a,b,x) with a and b -in "domain" and x between 0 and 1. - Relative error -arithmetic domain # trials peak rms - IEEE 0,5 10000 6.9e-15 4.5e-16 - IEEE 0,85 250000 2.2e-13 1.7e-14 - IEEE 0,1000 30000 5.3e-12 6.3e-13 - IEEE 0,10000 250000 9.3e-11 7.1e-12 - IEEE 0,100000 10000 8.7e-10 4.8e-11 -Outputs smaller than the IEEE gradual underflow threshold -were excluded from these statistics. - -Cephes Math Library, Release 2.8: June, 2000 -Copyright 1984, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double incompletebeta(const double a, const double b, const double x); - - -/************************************************************************* -Inverse of incomplete beta integral - -Given y, the function finds x such that - - incbet( a, b, x ) = y . - -The routine performs interval halving or Newton iterations to find the -root of incbet(a,b,x) - y = 0. - - -ACCURACY: - - Relative error: - x a,b -arithmetic domain domain # trials peak rms - IEEE 0,1 .5,10000 50000 5.8e-12 1.3e-13 - IEEE 0,1 .25,100 100000 1.8e-13 3.9e-15 - IEEE 0,1 0,5 50000 1.1e-12 5.5e-15 -With a and b constrained to half-integer or integer values: - IEEE 0,1 .5,10000 50000 5.8e-12 1.1e-13 - IEEE 0,1 .5,100 100000 1.7e-14 7.9e-16 -With a = .5, b constrained to half-integer or integer values: - IEEE 0,1 .5,10000 10000 8.3e-11 1.0e-11 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1996, 2000 by Stephen L. Moshier -*************************************************************************/ -double invincompletebeta(const double a, const double b, const double y); - -/************************************************************************* -Binomial distribution - -Returns the sum of the terms 0 through k of the Binomial -probability density: - - k - -- ( n ) j n-j - > ( ) p (1-p) - -- ( j ) - j=0 - -The terms are not summed directly; instead the incomplete -beta integral is employed, according to the formula - -y = bdtr( k, n, p ) = incbet( n-k, k+1, 1-p ). - -The arguments must be positive, with p ranging from 0 to 1. - -ACCURACY: - -Tested at random points (a,b,p), with p between 0 and 1. - - a,b Relative error: -arithmetic domain # trials peak rms - For p between 0.001 and 1: - IEEE 0,100 100000 4.3e-15 2.6e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double binomialdistribution(const ae_int_t k, const ae_int_t n, const double p); - - -/************************************************************************* -Complemented binomial distribution - -Returns the sum of the terms k+1 through n of the Binomial -probability density: - - n - -- ( n ) j n-j - > ( ) p (1-p) - -- ( j ) - j=k+1 - -The terms are not summed directly; instead the incomplete -beta integral is employed, according to the formula - -y = bdtrc( k, n, p ) = incbet( k+1, n-k, p ). - -The arguments must be positive, with p ranging from 0 to 1. - -ACCURACY: - -Tested at random points (a,b,p). - - a,b Relative error: -arithmetic domain # trials peak rms - For p between 0.001 and 1: - IEEE 0,100 100000 6.7e-15 8.2e-16 - For p between 0 and .001: - IEEE 0,100 100000 1.5e-13 2.7e-15 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double binomialcdistribution(const ae_int_t k, const ae_int_t n, const double p); - - -/************************************************************************* -Inverse binomial distribution - -Finds the event probability p such that the sum of the -terms 0 through k of the Binomial probability density -is equal to the given cumulative probability y. - -This is accomplished using the inverse beta integral -function and the relation - -1 - p = incbi( n-k, k+1, y ). - -ACCURACY: - -Tested at random points (a,b,p). - - a,b Relative error: -arithmetic domain # trials peak rms - For p between 0.001 and 1: - IEEE 0,100 100000 2.3e-14 6.4e-16 - IEEE 0,10000 100000 6.6e-12 1.2e-13 - For p between 10^-6 and 0.001: - IEEE 0,100 100000 2.0e-12 1.3e-14 - IEEE 0,10000 100000 1.5e-12 3.2e-14 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double invbinomialdistribution(const ae_int_t k, const ae_int_t n, const double y); - -/************************************************************************* -Calculation of the value of the Chebyshev polynomials of the -first and second kinds. - -Parameters: - r - polynomial kind, either 1 or 2. - n - degree, n>=0 - x - argument, -1 <= x <= 1 - -Result: - the value of the Chebyshev polynomial at x -*************************************************************************/ -double chebyshevcalculate(const ae_int_t r, const ae_int_t n, const double x); - - -/************************************************************************* -Summation of Chebyshev polynomials using Clenshaw’s recurrence formula. - -This routine calculates - c[0]*T0(x) + c[1]*T1(x) + ... + c[N]*TN(x) -or - c[0]*U0(x) + c[1]*U1(x) + ... + c[N]*UN(x) -depending on the R. - -Parameters: - r - polynomial kind, either 1 or 2. - n - degree, n>=0 - x - argument - -Result: - the value of the Chebyshev polynomial at x -*************************************************************************/ -double chebyshevsum(const real_1d_array &c, const ae_int_t r, const ae_int_t n, const double x); - - -/************************************************************************* -Representation of Tn as C[0] + C[1]*X + ... + C[N]*X^N - -Input parameters: - N - polynomial degree, n>=0 - -Output parameters: - C - coefficients -*************************************************************************/ -void chebyshevcoefficients(const ae_int_t n, real_1d_array &c); - - -/************************************************************************* -Conversion of a series of Chebyshev polynomials to a power series. - -Represents A[0]*T0(x) + A[1]*T1(x) + ... + A[N]*Tn(x) as -B[0] + B[1]*X + ... + B[N]*X^N. - -Input parameters: - A - Chebyshev series coefficients - N - degree, N>=0 - -Output parameters - B - power series coefficients -*************************************************************************/ -void fromchebyshev(const real_1d_array &a, const ae_int_t n, real_1d_array &b); - -/************************************************************************* -Chi-square distribution - -Returns the area under the left hand tail (from 0 to x) -of the Chi square probability density function with -v degrees of freedom. - - - x - - - 1 | | v/2-1 -t/2 - P( x | v ) = ----------- | t e dt - v/2 - | | - 2 | (v/2) - - 0 - -where x is the Chi-square variable. - -The incomplete gamma integral is used, according to the -formula - -y = chdtr( v, x ) = igam( v/2.0, x/2.0 ). - -The arguments must both be positive. - -ACCURACY: - -See incomplete gamma function - - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double chisquaredistribution(const double v, const double x); - - -/************************************************************************* -Complemented Chi-square distribution - -Returns the area under the right hand tail (from x to -infinity) of the Chi square probability density function -with v degrees of freedom: - - inf. - - - 1 | | v/2-1 -t/2 - P( x | v ) = ----------- | t e dt - v/2 - | | - 2 | (v/2) - - x - -where x is the Chi-square variable. - -The incomplete gamma integral is used, according to the -formula - -y = chdtr( v, x ) = igamc( v/2.0, x/2.0 ). - -The arguments must both be positive. - -ACCURACY: - -See incomplete gamma function - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double chisquarecdistribution(const double v, const double x); - - -/************************************************************************* -Inverse of complemented Chi-square distribution - -Finds the Chi-square argument x such that the integral -from x to infinity of the Chi-square density is equal -to the given cumulative probability y. - -This is accomplished using the inverse gamma integral -function and the relation - - x/2 = igami( df/2, y ); - -ACCURACY: - -See inverse incomplete gamma function - - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double invchisquaredistribution(const double v, const double y); - -/************************************************************************* -Dawson's Integral - -Approximates the integral - - x - - - 2 | | 2 - dawsn(x) = exp( -x ) | exp( t ) dt - | | - - - 0 - -Three different rational approximations are employed, for -the intervals 0 to 3.25; 3.25 to 6.25; and 6.25 up. - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0,10 10000 6.9e-16 1.0e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier -*************************************************************************/ -double dawsonintegral(const double x); - -/************************************************************************* -Complete elliptic integral of the first kind - -Approximates the integral - - - - pi/2 - - - | | - | dt -K(m) = | ------------------ - | 2 - | | sqrt( 1 - m sin t ) - - - 0 - -using the approximation - - P(x) - log x Q(x). - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0,1 30000 2.5e-16 6.8e-17 - -Cephes Math Library, Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double ellipticintegralk(const double m); - - -/************************************************************************* -Complete elliptic integral of the first kind - -Approximates the integral - - - - pi/2 - - - | | - | dt -K(m) = | ------------------ - | 2 - | | sqrt( 1 - m sin t ) - - - 0 - -where m = 1 - m1, using the approximation - - P(x) - log x Q(x). - -The argument m1 is used rather than m so that the logarithmic -singularity at m = 1 will be shifted to the origin; this -preserves maximum accuracy. - -K(0) = pi/2. - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0,1 30000 2.5e-16 6.8e-17 - -Àëãîðèòì âçÿò èç áèáëèîòåêè Cephes -*************************************************************************/ -double ellipticintegralkhighprecision(const double m1); - - -/************************************************************************* -Incomplete elliptic integral of the first kind F(phi|m) - -Approximates the integral - - - - phi - - - | | - | dt -F(phi_\m) = | ------------------ - | 2 - | | sqrt( 1 - m sin t ) - - - 0 - -of amplitude phi and modulus m, using the arithmetic - -geometric mean algorithm. - - - - -ACCURACY: - -Tested at random points with m in [0, 1] and phi as indicated. - - Relative error: -arithmetic domain # trials peak rms - IEEE -10,10 200000 7.4e-16 1.0e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -double incompleteellipticintegralk(const double phi, const double m); - - -/************************************************************************* -Complete elliptic integral of the second kind - -Approximates the integral - - - pi/2 - - - | | 2 -E(m) = | sqrt( 1 - m sin t ) dt - | | - - - 0 - -using the approximation - - P(x) - x log x Q(x). - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0, 1 10000 2.1e-16 7.3e-17 - -Cephes Math Library, Release 2.8: June, 2000 -Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier -*************************************************************************/ -double ellipticintegrale(const double m); - - -/************************************************************************* -Incomplete elliptic integral of the second kind - -Approximates the integral - - - phi - - - | | - | 2 -E(phi_\m) = | sqrt( 1 - m sin t ) dt - | - | | - - - 0 - -of amplitude phi and modulus m, using the arithmetic - -geometric mean algorithm. - -ACCURACY: - -Tested at random arguments with phi in [-10, 10] and m in -[0, 1]. - Relative error: -arithmetic domain # trials peak rms - IEEE -10,10 150000 3.3e-15 1.4e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1993, 2000 by Stephen L. Moshier -*************************************************************************/ -double incompleteellipticintegrale(const double phi, const double m); - -/************************************************************************* -Exponential integral Ei(x) - - x - - t - | | e - Ei(x) = -|- --- dt . - | | t - - - -inf - -Not defined for x <= 0. -See also expn.c. - - - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0,100 50000 8.6e-16 1.3e-16 - -Cephes Math Library Release 2.8: May, 1999 -Copyright 1999 by Stephen L. Moshier -*************************************************************************/ -double exponentialintegralei(const double x); - - -/************************************************************************* -Exponential integral En(x) - -Evaluates the exponential integral - - inf. - - - | | -xt - | e - E (x) = | ---- dt. - n | n - | | t - - - 1 - - -Both n and x must be nonnegative. - -The routine employs either a power series, a continued -fraction, or an asymptotic formula depending on the -relative values of n and x. - -ACCURACY: - - Relative error: -arithmetic domain # trials peak rms - IEEE 0, 30 10000 1.7e-15 3.6e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1985, 2000 by Stephen L. Moshier -*************************************************************************/ -double exponentialintegralen(const double x, const ae_int_t n); - -/************************************************************************* -F distribution - -Returns the area from zero to x under the F density -function (also known as Snedcor's density or the -variance ratio density). This is the density -of x = (u1/df1)/(u2/df2), where u1 and u2 are random -variables having Chi square distributions with df1 -and df2 degrees of freedom, respectively. -The incomplete beta integral is used, according to the -formula - -P(x) = incbet( df1/2, df2/2, (df1*x/(df2 + df1*x) ). - - -The arguments a and b are greater than zero, and x is -nonnegative. - -ACCURACY: - -Tested at random points (a,b,x). - - x a,b Relative error: -arithmetic domain domain # trials peak rms - IEEE 0,1 0,100 100000 9.8e-15 1.7e-15 - IEEE 1,5 0,100 100000 6.5e-15 3.5e-16 - IEEE 0,1 1,10000 100000 2.2e-11 3.3e-12 - IEEE 1,5 1,10000 100000 1.1e-11 1.7e-13 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double fdistribution(const ae_int_t a, const ae_int_t b, const double x); - - -/************************************************************************* -Complemented F distribution - -Returns the area from x to infinity under the F density -function (also known as Snedcor's density or the -variance ratio density). - - - inf. - - - 1 | | a-1 b-1 -1-P(x) = ------ | t (1-t) dt - B(a,b) | | - - - x - - -The incomplete beta integral is used, according to the -formula - -P(x) = incbet( df2/2, df1/2, (df2/(df2 + df1*x) ). - - -ACCURACY: - -Tested at random points (a,b,x) in the indicated intervals. - x a,b Relative error: -arithmetic domain domain # trials peak rms - IEEE 0,1 1,100 100000 3.7e-14 5.9e-16 - IEEE 1,5 1,100 100000 8.0e-15 1.6e-15 - IEEE 0,1 1,10000 100000 1.8e-11 3.5e-13 - IEEE 1,5 1,10000 100000 2.0e-11 3.0e-12 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double fcdistribution(const ae_int_t a, const ae_int_t b, const double x); - - -/************************************************************************* -Inverse of complemented F distribution - -Finds the F density argument x such that the integral -from x to infinity of the F density is equal to the -given probability p. - -This is accomplished using the inverse beta integral -function and the relations - - z = incbi( df2/2, df1/2, p ) - x = df2 (1-z) / (df1 z). - -Note: the following relations hold for the inverse of -the uncomplemented F distribution: - - z = incbi( df1/2, df2/2, p ) - x = df2 z / (df1 (1-z)). - -ACCURACY: - -Tested at random points (a,b,p). - - a,b Relative error: -arithmetic domain # trials peak rms - For p between .001 and 1: - IEEE 1,100 100000 8.3e-15 4.7e-16 - IEEE 1,10000 100000 2.1e-11 1.4e-13 - For p between 10^-6 and 10^-3: - IEEE 1,100 50000 1.3e-12 8.4e-15 - IEEE 1,10000 50000 3.0e-12 4.8e-14 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double invfdistribution(const ae_int_t a, const ae_int_t b, const double y); - -/************************************************************************* -Fresnel integral - -Evaluates the Fresnel integrals - - x - - - | | -C(x) = | cos(pi/2 t**2) dt, - | | - - - 0 - - x - - - | | -S(x) = | sin(pi/2 t**2) dt. - | | - - - 0 - - -The integrals are evaluated by a power series for x < 1. -For x >= 1 auxiliary functions f(x) and g(x) are employed -such that - -C(x) = 0.5 + f(x) sin( pi/2 x**2 ) - g(x) cos( pi/2 x**2 ) -S(x) = 0.5 - f(x) cos( pi/2 x**2 ) - g(x) sin( pi/2 x**2 ) - - - -ACCURACY: - - Relative error. - -Arithmetic function domain # trials peak rms - IEEE S(x) 0, 10 10000 2.0e-15 3.2e-16 - IEEE C(x) 0, 10 10000 1.8e-15 3.3e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier -*************************************************************************/ -void fresnelintegral(const double x, double &c, double &s); - -/************************************************************************* -Calculation of the value of the Hermite polynomial. - -Parameters: - n - degree, n>=0 - x - argument - -Result: - the value of the Hermite polynomial Hn at x -*************************************************************************/ -double hermitecalculate(const ae_int_t n, const double x); - - -/************************************************************************* -Summation of Hermite polynomials using Clenshaw’s recurrence formula. - -This routine calculates - c[0]*H0(x) + c[1]*H1(x) + ... + c[N]*HN(x) - -Parameters: - n - degree, n>=0 - x - argument - -Result: - the value of the Hermite polynomial at x -*************************************************************************/ -double hermitesum(const real_1d_array &c, const ae_int_t n, const double x); - - -/************************************************************************* -Representation of Hn as C[0] + C[1]*X + ... + C[N]*X^N - -Input parameters: - N - polynomial degree, n>=0 - -Output parameters: - C - coefficients -*************************************************************************/ -void hermitecoefficients(const ae_int_t n, real_1d_array &c); - -/************************************************************************* -Jacobian Elliptic Functions - -Evaluates the Jacobian elliptic functions sn(u|m), cn(u|m), -and dn(u|m) of parameter m between 0 and 1, and real -argument u. - -These functions are periodic, with quarter-period on the -real axis equal to the complete elliptic integral -ellpk(1.0-m). - -Relation to incomplete elliptic integral: -If u = ellik(phi,m), then sn(u|m) = sin(phi), -and cn(u|m) = cos(phi). Phi is called the amplitude of u. - -Computation is by means of the arithmetic-geometric mean -algorithm, except when m is within 1e-9 of 0 or 1. In the -latter case with m close to 1, the approximation applies -only for phi < pi/2. - -ACCURACY: - -Tested at random points with u between 0 and 10, m between -0 and 1. - - Absolute error (* = relative error): -arithmetic function # trials peak rms - IEEE phi 10000 9.2e-16* 1.4e-16* - IEEE sn 50000 4.1e-15 4.6e-16 - IEEE cn 40000 3.6e-15 4.4e-16 - IEEE dn 10000 1.3e-12 1.8e-14 - - Peak error observed in consistency check using addition -theorem for sn(u+v) was 4e-16 (absolute). Also tested by -the above relation to the incomplete elliptic integral. -Accuracy deteriorates when u is large. - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -void jacobianellipticfunctions(const double u, const double m, double &sn, double &cn, double &dn, double &ph); - -/************************************************************************* -Calculation of the value of the Laguerre polynomial. - -Parameters: - n - degree, n>=0 - x - argument - -Result: - the value of the Laguerre polynomial Ln at x -*************************************************************************/ -double laguerrecalculate(const ae_int_t n, const double x); - - -/************************************************************************* -Summation of Laguerre polynomials using Clenshaw’s recurrence formula. - -This routine calculates c[0]*L0(x) + c[1]*L1(x) + ... + c[N]*LN(x) - -Parameters: - n - degree, n>=0 - x - argument - -Result: - the value of the Laguerre polynomial at x -*************************************************************************/ -double laguerresum(const real_1d_array &c, const ae_int_t n, const double x); - - -/************************************************************************* -Representation of Ln as C[0] + C[1]*X + ... + C[N]*X^N - -Input parameters: - N - polynomial degree, n>=0 - -Output parameters: - C - coefficients -*************************************************************************/ -void laguerrecoefficients(const ae_int_t n, real_1d_array &c); - -/************************************************************************* -Calculation of the value of the Legendre polynomial Pn. - -Parameters: - n - degree, n>=0 - x - argument - -Result: - the value of the Legendre polynomial Pn at x -*************************************************************************/ -double legendrecalculate(const ae_int_t n, const double x); - - -/************************************************************************* -Summation of Legendre polynomials using Clenshaw’s recurrence formula. - -This routine calculates - c[0]*P0(x) + c[1]*P1(x) + ... + c[N]*PN(x) - -Parameters: - n - degree, n>=0 - x - argument - -Result: - the value of the Legendre polynomial at x -*************************************************************************/ -double legendresum(const real_1d_array &c, const ae_int_t n, const double x); - - -/************************************************************************* -Representation of Pn as C[0] + C[1]*X + ... + C[N]*X^N - -Input parameters: - N - polynomial degree, n>=0 - -Output parameters: - C - coefficients -*************************************************************************/ -void legendrecoefficients(const ae_int_t n, real_1d_array &c); - -/************************************************************************* -Poisson distribution - -Returns the sum of the first k+1 terms of the Poisson -distribution: - - k j - -- -m m - > e -- - -- j! - j=0 - -The terms are not summed directly; instead the incomplete -gamma integral is employed, according to the relation - -y = pdtr( k, m ) = igamc( k+1, m ). - -The arguments must both be positive. -ACCURACY: - -See incomplete gamma function - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double poissondistribution(const ae_int_t k, const double m); - - -/************************************************************************* -Complemented Poisson distribution - -Returns the sum of the terms k+1 to infinity of the Poisson -distribution: - - inf. j - -- -m m - > e -- - -- j! - j=k+1 - -The terms are not summed directly; instead the incomplete -gamma integral is employed, according to the formula - -y = pdtrc( k, m ) = igam( k+1, m ). - -The arguments must both be positive. - -ACCURACY: - -See incomplete gamma function - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double poissoncdistribution(const ae_int_t k, const double m); - - -/************************************************************************* -Inverse Poisson distribution - -Finds the Poisson variable x such that the integral -from 0 to x of the Poisson density is equal to the -given probability y. - -This is accomplished using the inverse gamma integral -function and the relation - - m = igami( k+1, y ). - -ACCURACY: - -See inverse incomplete gamma function - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double invpoissondistribution(const ae_int_t k, const double y); - -/************************************************************************* -Psi (digamma) function - - d - - psi(x) = -- ln | (x) - dx - -is the logarithmic derivative of the gamma function. -For integer x, - n-1 - - -psi(n) = -EUL + > 1/k. - - - k=1 - -This formula is used for 0 < n <= 10. If x is negative, it -is transformed to a positive argument by the reflection -formula psi(1-x) = psi(x) + pi cot(pi x). -For general positive x, the argument is made greater than 10 -using the recurrence psi(x+1) = psi(x) + 1/x. -Then the following asymptotic expansion is applied: - - inf. B - - 2k -psi(x) = log(x) - 1/2x - > ------- - - 2k - k=1 2k x - -where the B2k are Bernoulli numbers. - -ACCURACY: - Relative error (except absolute when |psi| < 1): -arithmetic domain # trials peak rms - IEEE 0,30 30000 1.3e-15 1.4e-16 - IEEE -30,0 40000 1.5e-15 2.2e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1992, 2000 by Stephen L. Moshier -*************************************************************************/ -double psi(const double x); - -/************************************************************************* -Student's t distribution - -Computes the integral from minus infinity to t of the Student -t distribution with integer k > 0 degrees of freedom: - - t - - - | | - - | 2 -(k+1)/2 - | ( (k+1)/2 ) | ( x ) - ---------------------- | ( 1 + --- ) dx - - | ( k ) - sqrt( k pi ) | ( k/2 ) | - | | - - - -inf. - -Relation to incomplete beta integral: - - 1 - stdtr(k,t) = 0.5 * incbet( k/2, 1/2, z ) -where - z = k/(k + t**2). - -For t < -2, this is the method of computation. For higher t, -a direct method is derived from integration by parts. -Since the function is symmetric about t=0, the area under the -right tail of the density is found by calling the function -with -t instead of t. - -ACCURACY: - -Tested at random 1 <= k <= 25. The "domain" refers to t. - Relative error: -arithmetic domain # trials peak rms - IEEE -100,-2 50000 5.9e-15 1.4e-15 - IEEE -2,100 500000 2.7e-15 4.9e-17 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double studenttdistribution(const ae_int_t k, const double t); - - -/************************************************************************* -Functional inverse of Student's t distribution - -Given probability p, finds the argument t such that stdtr(k,t) -is equal to p. - -ACCURACY: - -Tested at random 1 <= k <= 100. The "domain" refers to p: - Relative error: -arithmetic domain # trials peak rms - IEEE .001,.999 25000 5.7e-15 8.0e-16 - IEEE 10^-6,.001 25000 2.0e-12 2.9e-14 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double invstudenttdistribution(const ae_int_t k, const double p); - -/************************************************************************* -Sine and cosine integrals - -Evaluates the integrals - - x - - - | cos t - 1 - Ci(x) = eul + ln x + | --------- dt, - | t - - - 0 - x - - - | sin t - Si(x) = | ----- dt - | t - - - 0 - -where eul = 0.57721566490153286061 is Euler's constant. -The integrals are approximated by rational functions. -For x > 8 auxiliary functions f(x) and g(x) are employed -such that - -Ci(x) = f(x) sin(x) - g(x) cos(x) -Si(x) = pi/2 - f(x) cos(x) - g(x) sin(x) - - -ACCURACY: - Test interval = [0,50]. -Absolute error, except relative when > 1: -arithmetic function # trials peak rms - IEEE Si 30000 4.4e-16 7.3e-17 - IEEE Ci 30000 6.9e-16 5.1e-17 - -Cephes Math Library Release 2.1: January, 1989 -Copyright 1984, 1987, 1989 by Stephen L. Moshier -*************************************************************************/ -void sinecosineintegrals(const double x, double &si, double &ci); - - -/************************************************************************* -Hyperbolic sine and cosine integrals - -Approximates the integrals - - x - - - | | cosh t - 1 - Chi(x) = eul + ln x + | ----------- dt, - | | t - - - 0 - - x - - - | | sinh t - Shi(x) = | ------ dt - | | t - - - 0 - -where eul = 0.57721566490153286061 is Euler's constant. -The integrals are evaluated by power series for x < 8 -and by Chebyshev expansions for x between 8 and 88. -For large x, both functions approach exp(x)/2x. -Arguments greater than 88 in magnitude return MAXNUM. - - -ACCURACY: - -Test interval 0 to 88. - Relative error: -arithmetic function # trials peak rms - IEEE Shi 30000 6.9e-16 1.6e-16 - Absolute error, except relative when |Chi| > 1: - IEEE Chi 30000 8.4e-16 1.4e-16 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 2000 by Stephen L. Moshier -*************************************************************************/ -void hyperbolicsinecosineintegrals(const double x, double &shi, double &chi); -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (FUNCTIONS) -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ -double gammafunction(double x, ae_state *_state); -double lngamma(double x, double* sgngam, ae_state *_state); -double errorfunction(double x, ae_state *_state); -double errorfunctionc(double x, ae_state *_state); -double normaldistribution(double x, ae_state *_state); -double inverf(double e, ae_state *_state); -double invnormaldistribution(double y0, ae_state *_state); -double incompletegamma(double a, double x, ae_state *_state); -double incompletegammac(double a, double x, ae_state *_state); -double invincompletegammac(double a, double y0, ae_state *_state); -void airy(double x, - double* ai, - double* aip, - double* bi, - double* bip, - ae_state *_state); -double besselj0(double x, ae_state *_state); -double besselj1(double x, ae_state *_state); -double besseljn(ae_int_t n, double x, ae_state *_state); -double bessely0(double x, ae_state *_state); -double bessely1(double x, ae_state *_state); -double besselyn(ae_int_t n, double x, ae_state *_state); -double besseli0(double x, ae_state *_state); -double besseli1(double x, ae_state *_state); -double besselk0(double x, ae_state *_state); -double besselk1(double x, ae_state *_state); -double besselkn(ae_int_t nn, double x, ae_state *_state); -double beta(double a, double b, ae_state *_state); -double incompletebeta(double a, double b, double x, ae_state *_state); -double invincompletebeta(double a, double b, double y, ae_state *_state); -double binomialdistribution(ae_int_t k, - ae_int_t n, - double p, - ae_state *_state); -double binomialcdistribution(ae_int_t k, - ae_int_t n, - double p, - ae_state *_state); -double invbinomialdistribution(ae_int_t k, - ae_int_t n, - double y, - ae_state *_state); -double chebyshevcalculate(ae_int_t r, - ae_int_t n, - double x, - ae_state *_state); -double chebyshevsum(/* Real */ ae_vector* c, - ae_int_t r, - ae_int_t n, - double x, - ae_state *_state); -void chebyshevcoefficients(ae_int_t n, - /* Real */ ae_vector* c, - ae_state *_state); -void fromchebyshev(/* Real */ ae_vector* a, - ae_int_t n, - /* Real */ ae_vector* b, - ae_state *_state); -double chisquaredistribution(double v, double x, ae_state *_state); -double chisquarecdistribution(double v, double x, ae_state *_state); -double invchisquaredistribution(double v, double y, ae_state *_state); -double dawsonintegral(double x, ae_state *_state); -double ellipticintegralk(double m, ae_state *_state); -double ellipticintegralkhighprecision(double m1, ae_state *_state); -double incompleteellipticintegralk(double phi, double m, ae_state *_state); -double ellipticintegrale(double m, ae_state *_state); -double incompleteellipticintegrale(double phi, double m, ae_state *_state); -double exponentialintegralei(double x, ae_state *_state); -double exponentialintegralen(double x, ae_int_t n, ae_state *_state); -double fdistribution(ae_int_t a, ae_int_t b, double x, ae_state *_state); -double fcdistribution(ae_int_t a, ae_int_t b, double x, ae_state *_state); -double invfdistribution(ae_int_t a, - ae_int_t b, - double y, - ae_state *_state); -void fresnelintegral(double x, double* c, double* s, ae_state *_state); -double hermitecalculate(ae_int_t n, double x, ae_state *_state); -double hermitesum(/* Real */ ae_vector* c, - ae_int_t n, - double x, - ae_state *_state); -void hermitecoefficients(ae_int_t n, - /* Real */ ae_vector* c, - ae_state *_state); -void jacobianellipticfunctions(double u, - double m, - double* sn, - double* cn, - double* dn, - double* ph, - ae_state *_state); -double laguerrecalculate(ae_int_t n, double x, ae_state *_state); -double laguerresum(/* Real */ ae_vector* c, - ae_int_t n, - double x, - ae_state *_state); -void laguerrecoefficients(ae_int_t n, - /* Real */ ae_vector* c, - ae_state *_state); -double legendrecalculate(ae_int_t n, double x, ae_state *_state); -double legendresum(/* Real */ ae_vector* c, - ae_int_t n, - double x, - ae_state *_state); -void legendrecoefficients(ae_int_t n, - /* Real */ ae_vector* c, - ae_state *_state); -double poissondistribution(ae_int_t k, double m, ae_state *_state); -double poissoncdistribution(ae_int_t k, double m, ae_state *_state); -double invpoissondistribution(ae_int_t k, double y, ae_state *_state); -double psi(double x, ae_state *_state); -double studenttdistribution(ae_int_t k, double t, ae_state *_state); -double invstudenttdistribution(ae_int_t k, double p, ae_state *_state); -void sinecosineintegrals(double x, - double* si, - double* ci, - ae_state *_state); -void hyperbolicsinecosineintegrals(double x, - double* shi, - double* chi, - ae_state *_state); - -} -#endif - diff --git a/src/core/alglib/statistics.cpp b/src/core/alglib/statistics.cpp deleted file mode 100644 index d59d0a2..0000000 --- a/src/core/alglib/statistics.cpp +++ /dev/null @@ -1,19718 +0,0 @@ -/************************************************************************* -Copyright (c) Sergey Bochkanov (ALGLIB project). - ->>> SOURCE LICENSE >>> -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation (www.fsf.org); either version 2 of the -License, or (at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -A copy of the GNU General Public License is available at -http://www.fsf.org/licensing/licenses ->>> END OF LICENSE >>> -*************************************************************************/ -#include "stdafx.h" -#include "statistics.h" - -// disable some irrelevant warnings -#if (AE_COMPILER==AE_MSVC) -#pragma warning(disable:4100) -#pragma warning(disable:4127) -#pragma warning(disable:4702) -#pragma warning(disable:4996) -#endif -using namespace std; - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS IMPLEMENTATION OF C++ INTERFACE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib -{ - - -/************************************************************************* -Calculation of the distribution moments: mean, variance, skewness, kurtosis. - -INPUT PARAMETERS: - X - sample - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - -OUTPUT PARAMETERS - Mean - mean. - Variance- variance. - Skewness- skewness (if variance<>0; zero otherwise). - Kurtosis- kurtosis (if variance<>0; zero otherwise). - - - -- ALGLIB -- - Copyright 06.09.2006 by Bochkanov Sergey -*************************************************************************/ -void samplemoments(const real_1d_array &x, const ae_int_t n, double &mean, double &variance, double &skewness, double &kurtosis) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::samplemoments(const_cast(x.c_ptr()), n, &mean, &variance, &skewness, &kurtosis, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Calculation of the distribution moments: mean, variance, skewness, kurtosis. - -INPUT PARAMETERS: - X - sample - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - -OUTPUT PARAMETERS - Mean - mean. - Variance- variance. - Skewness- skewness (if variance<>0; zero otherwise). - Kurtosis- kurtosis (if variance<>0; zero otherwise). - - - -- ALGLIB -- - Copyright 06.09.2006 by Bochkanov Sergey -*************************************************************************/ -void samplemoments(const real_1d_array &x, double &mean, double &variance, double &skewness, double &kurtosis) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::samplemoments(const_cast(x.c_ptr()), n, &mean, &variance, &skewness, &kurtosis, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Calculation of the mean. - -INPUT PARAMETERS: - X - sample - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - -NOTE: - -This function return result which calculated by 'SampleMoments' function -and stored at 'Mean' variable. - - - -- ALGLIB -- - Copyright 06.09.2006 by Bochkanov Sergey -*************************************************************************/ -double samplemean(const real_1d_array &x, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::samplemean(const_cast(x.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Calculation of the mean. - -INPUT PARAMETERS: - X - sample - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - -NOTE: - -This function return result which calculated by 'SampleMoments' function -and stored at 'Mean' variable. - - - -- ALGLIB -- - Copyright 06.09.2006 by Bochkanov Sergey -*************************************************************************/ -double samplemean(const real_1d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::samplemean(const_cast(x.c_ptr()), n, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Calculation of the variance. - -INPUT PARAMETERS: - X - sample - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - -NOTE: - -This function return result which calculated by 'SampleMoments' function -and stored at 'Variance' variable. - - - -- ALGLIB -- - Copyright 06.09.2006 by Bochkanov Sergey -*************************************************************************/ -double samplevariance(const real_1d_array &x, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::samplevariance(const_cast(x.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Calculation of the variance. - -INPUT PARAMETERS: - X - sample - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - -NOTE: - -This function return result which calculated by 'SampleMoments' function -and stored at 'Variance' variable. - - - -- ALGLIB -- - Copyright 06.09.2006 by Bochkanov Sergey -*************************************************************************/ -double samplevariance(const real_1d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::samplevariance(const_cast(x.c_ptr()), n, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Calculation of the skewness. - -INPUT PARAMETERS: - X - sample - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - -NOTE: - -This function return result which calculated by 'SampleMoments' function -and stored at 'Skewness' variable. - - - -- ALGLIB -- - Copyright 06.09.2006 by Bochkanov Sergey -*************************************************************************/ -double sampleskewness(const real_1d_array &x, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::sampleskewness(const_cast(x.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Calculation of the skewness. - -INPUT PARAMETERS: - X - sample - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - -NOTE: - -This function return result which calculated by 'SampleMoments' function -and stored at 'Skewness' variable. - - - -- ALGLIB -- - Copyright 06.09.2006 by Bochkanov Sergey -*************************************************************************/ -double sampleskewness(const real_1d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::sampleskewness(const_cast(x.c_ptr()), n, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Calculation of the kurtosis. - -INPUT PARAMETERS: - X - sample - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - -NOTE: - -This function return result which calculated by 'SampleMoments' function -and stored at 'Kurtosis' variable. - - - -- ALGLIB -- - Copyright 06.09.2006 by Bochkanov Sergey -*************************************************************************/ -double samplekurtosis(const real_1d_array &x, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::samplekurtosis(const_cast(x.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Calculation of the kurtosis. - -INPUT PARAMETERS: - X - sample - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - -NOTE: - -This function return result which calculated by 'SampleMoments' function -and stored at 'Kurtosis' variable. - - - -- ALGLIB -- - Copyright 06.09.2006 by Bochkanov Sergey -*************************************************************************/ -double samplekurtosis(const real_1d_array &x) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::samplekurtosis(const_cast(x.c_ptr()), n, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -ADev - -Input parameters: - X - sample - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - -Output parameters: - ADev- ADev - - -- ALGLIB -- - Copyright 06.09.2006 by Bochkanov Sergey -*************************************************************************/ -void sampleadev(const real_1d_array &x, const ae_int_t n, double &adev) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::sampleadev(const_cast(x.c_ptr()), n, &adev, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -ADev - -Input parameters: - X - sample - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - -Output parameters: - ADev- ADev - - -- ALGLIB -- - Copyright 06.09.2006 by Bochkanov Sergey -*************************************************************************/ -void sampleadev(const real_1d_array &x, double &adev) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::sampleadev(const_cast(x.c_ptr()), n, &adev, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Median calculation. - -Input parameters: - X - sample (array indexes: [0..N-1]) - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - -Output parameters: - Median - - -- ALGLIB -- - Copyright 06.09.2006 by Bochkanov Sergey -*************************************************************************/ -void samplemedian(const real_1d_array &x, const ae_int_t n, double &median) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::samplemedian(const_cast(x.c_ptr()), n, &median, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Median calculation. - -Input parameters: - X - sample (array indexes: [0..N-1]) - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - -Output parameters: - Median - - -- ALGLIB -- - Copyright 06.09.2006 by Bochkanov Sergey -*************************************************************************/ -void samplemedian(const real_1d_array &x, double &median) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::samplemedian(const_cast(x.c_ptr()), n, &median, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Percentile calculation. - -Input parameters: - X - sample (array indexes: [0..N-1]) - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - P - percentile (0<=P<=1) - -Output parameters: - V - percentile - - -- ALGLIB -- - Copyright 01.03.2008 by Bochkanov Sergey -*************************************************************************/ -void samplepercentile(const real_1d_array &x, const ae_int_t n, const double p, double &v) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::samplepercentile(const_cast(x.c_ptr()), n, p, &v, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Percentile calculation. - -Input parameters: - X - sample (array indexes: [0..N-1]) - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - P - percentile (0<=P<=1) - -Output parameters: - V - percentile - - -- ALGLIB -- - Copyright 01.03.2008 by Bochkanov Sergey -*************************************************************************/ -void samplepercentile(const real_1d_array &x, const double p, double &v) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::samplepercentile(const_cast(x.c_ptr()), n, p, &v, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -2-sample covariance - -Input parameters: - X - sample 1 (array indexes: [0..N-1]) - Y - sample 2 (array indexes: [0..N-1]) - N - N>=0, sample size: - * if given, only N leading elements of X/Y are processed - * if not given, automatically determined from input sizes - -Result: - covariance (zero for N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -double cov2(const real_1d_array &x, const real_1d_array &y, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::cov2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -2-sample covariance - -Input parameters: - X - sample 1 (array indexes: [0..N-1]) - Y - sample 2 (array indexes: [0..N-1]) - N - N>=0, sample size: - * if given, only N leading elements of X/Y are processed - * if not given, automatically determined from input sizes - -Result: - covariance (zero for N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -double cov2(const real_1d_array &x, const real_1d_array &y) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - if( (x.length()!=y.length())) - throw ap_error("Error while calling 'cov2': looks like one of arguments has wrong size"); - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::cov2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Pearson product-moment correlation coefficient - -Input parameters: - X - sample 1 (array indexes: [0..N-1]) - Y - sample 2 (array indexes: [0..N-1]) - N - N>=0, sample size: - * if given, only N leading elements of X/Y are processed - * if not given, automatically determined from input sizes - -Result: - Pearson product-moment correlation coefficient - (zero for N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -double pearsoncorr2(const real_1d_array &x, const real_1d_array &y, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::pearsoncorr2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Pearson product-moment correlation coefficient - -Input parameters: - X - sample 1 (array indexes: [0..N-1]) - Y - sample 2 (array indexes: [0..N-1]) - N - N>=0, sample size: - * if given, only N leading elements of X/Y are processed - * if not given, automatically determined from input sizes - -Result: - Pearson product-moment correlation coefficient - (zero for N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -double pearsoncorr2(const real_1d_array &x, const real_1d_array &y) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - if( (x.length()!=y.length())) - throw ap_error("Error while calling 'pearsoncorr2': looks like one of arguments has wrong size"); - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::pearsoncorr2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Spearman's rank correlation coefficient - -Input parameters: - X - sample 1 (array indexes: [0..N-1]) - Y - sample 2 (array indexes: [0..N-1]) - N - N>=0, sample size: - * if given, only N leading elements of X/Y are processed - * if not given, automatically determined from input sizes - -Result: - Spearman's rank correlation coefficient - (zero for N=0 or N=1) - - -- ALGLIB -- - Copyright 09.04.2007 by Bochkanov Sergey -*************************************************************************/ -double spearmancorr2(const real_1d_array &x, const real_1d_array &y, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::spearmancorr2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Spearman's rank correlation coefficient - -Input parameters: - X - sample 1 (array indexes: [0..N-1]) - Y - sample 2 (array indexes: [0..N-1]) - N - N>=0, sample size: - * if given, only N leading elements of X/Y are processed - * if not given, automatically determined from input sizes - -Result: - Spearman's rank correlation coefficient - (zero for N=0 or N=1) - - -- ALGLIB -- - Copyright 09.04.2007 by Bochkanov Sergey -*************************************************************************/ -double spearmancorr2(const real_1d_array &x, const real_1d_array &y) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - if( (x.length()!=y.length())) - throw ap_error("Error while calling 'spearmancorr2': looks like one of arguments has wrong size"); - n = x.length(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::spearmancorr2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Covariance matrix - -SMP EDITION OF ALGLIB: - - ! This function can utilize multicore capabilities of your system. In - ! order to do this you have to call version with "smp_" prefix, which - ! indicates that multicore code will be used. - ! - ! This note is given for users of SMP edition; if you use GPL edition, - ! or commercial edition of ALGLIB without SMP support, you still will - ! be able to call smp-version of this function, but all computations - ! will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - ! - ! You should remember that starting/stopping worker thread always have - ! non-zero cost. Although multicore version is pretty efficient on - ! large problems, we do not recommend you to use it on small problems - - ! with covariance matrices smaller than 128*128. - -INPUT PARAMETERS: - X - array[N,M], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - N - N>=0, number of observations: - * if given, only leading N rows of X are used - * if not given, automatically determined from input size - M - M>0, number of variables: - * if given, only leading M columns of X are used - * if not given, automatically determined from input size - -OUTPUT PARAMETERS: - C - array[M,M], covariance matrix (zero if N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -void covm(const real_2d_array &x, const ae_int_t n, const ae_int_t m, real_2d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::covm(const_cast(x.c_ptr()), n, m, const_cast(c.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_covm(const real_2d_array &x, const ae_int_t n, const ae_int_t m, real_2d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_covm(const_cast(x.c_ptr()), n, m, const_cast(c.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Covariance matrix - -SMP EDITION OF ALGLIB: - - ! This function can utilize multicore capabilities of your system. In - ! order to do this you have to call version with "smp_" prefix, which - ! indicates that multicore code will be used. - ! - ! This note is given for users of SMP edition; if you use GPL edition, - ! or commercial edition of ALGLIB without SMP support, you still will - ! be able to call smp-version of this function, but all computations - ! will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - ! - ! You should remember that starting/stopping worker thread always have - ! non-zero cost. Although multicore version is pretty efficient on - ! large problems, we do not recommend you to use it on small problems - - ! with covariance matrices smaller than 128*128. - -INPUT PARAMETERS: - X - array[N,M], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - N - N>=0, number of observations: - * if given, only leading N rows of X are used - * if not given, automatically determined from input size - M - M>0, number of variables: - * if given, only leading M columns of X are used - * if not given, automatically determined from input size - -OUTPUT PARAMETERS: - C - array[M,M], covariance matrix (zero if N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -void covm(const real_2d_array &x, real_2d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t m; - - n = x.rows(); - m = x.cols(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::covm(const_cast(x.c_ptr()), n, m, const_cast(c.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_covm(const real_2d_array &x, real_2d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t m; - - n = x.rows(); - m = x.cols(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_covm(const_cast(x.c_ptr()), n, m, const_cast(c.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Pearson product-moment correlation matrix - -SMP EDITION OF ALGLIB: - - ! This function can utilize multicore capabilities of your system. In - ! order to do this you have to call version with "smp_" prefix, which - ! indicates that multicore code will be used. - ! - ! This note is given for users of SMP edition; if you use GPL edition, - ! or commercial edition of ALGLIB without SMP support, you still will - ! be able to call smp-version of this function, but all computations - ! will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - ! - ! You should remember that starting/stopping worker thread always have - ! non-zero cost. Although multicore version is pretty efficient on - ! large problems, we do not recommend you to use it on small problems - - ! with correlation matrices smaller than 128*128. - -INPUT PARAMETERS: - X - array[N,M], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - N - N>=0, number of observations: - * if given, only leading N rows of X are used - * if not given, automatically determined from input size - M - M>0, number of variables: - * if given, only leading M columns of X are used - * if not given, automatically determined from input size - -OUTPUT PARAMETERS: - C - array[M,M], correlation matrix (zero if N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -void pearsoncorrm(const real_2d_array &x, const ae_int_t n, const ae_int_t m, real_2d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::pearsoncorrm(const_cast(x.c_ptr()), n, m, const_cast(c.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_pearsoncorrm(const real_2d_array &x, const ae_int_t n, const ae_int_t m, real_2d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_pearsoncorrm(const_cast(x.c_ptr()), n, m, const_cast(c.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Pearson product-moment correlation matrix - -SMP EDITION OF ALGLIB: - - ! This function can utilize multicore capabilities of your system. In - ! order to do this you have to call version with "smp_" prefix, which - ! indicates that multicore code will be used. - ! - ! This note is given for users of SMP edition; if you use GPL edition, - ! or commercial edition of ALGLIB without SMP support, you still will - ! be able to call smp-version of this function, but all computations - ! will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - ! - ! You should remember that starting/stopping worker thread always have - ! non-zero cost. Although multicore version is pretty efficient on - ! large problems, we do not recommend you to use it on small problems - - ! with correlation matrices smaller than 128*128. - -INPUT PARAMETERS: - X - array[N,M], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - N - N>=0, number of observations: - * if given, only leading N rows of X are used - * if not given, automatically determined from input size - M - M>0, number of variables: - * if given, only leading M columns of X are used - * if not given, automatically determined from input size - -OUTPUT PARAMETERS: - C - array[M,M], correlation matrix (zero if N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -void pearsoncorrm(const real_2d_array &x, real_2d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t m; - - n = x.rows(); - m = x.cols(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::pearsoncorrm(const_cast(x.c_ptr()), n, m, const_cast(c.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_pearsoncorrm(const real_2d_array &x, real_2d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t m; - - n = x.rows(); - m = x.cols(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_pearsoncorrm(const_cast(x.c_ptr()), n, m, const_cast(c.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Spearman's rank correlation matrix - -SMP EDITION OF ALGLIB: - - ! This function can utilize multicore capabilities of your system. In - ! order to do this you have to call version with "smp_" prefix, which - ! indicates that multicore code will be used. - ! - ! This note is given for users of SMP edition; if you use GPL edition, - ! or commercial edition of ALGLIB without SMP support, you still will - ! be able to call smp-version of this function, but all computations - ! will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - ! - ! You should remember that starting/stopping worker thread always have - ! non-zero cost. Although multicore version is pretty efficient on - ! large problems, we do not recommend you to use it on small problems - - ! with correlation matrices smaller than 128*128. - -INPUT PARAMETERS: - X - array[N,M], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - N - N>=0, number of observations: - * if given, only leading N rows of X are used - * if not given, automatically determined from input size - M - M>0, number of variables: - * if given, only leading M columns of X are used - * if not given, automatically determined from input size - -OUTPUT PARAMETERS: - C - array[M,M], correlation matrix (zero if N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -void spearmancorrm(const real_2d_array &x, const ae_int_t n, const ae_int_t m, real_2d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spearmancorrm(const_cast(x.c_ptr()), n, m, const_cast(c.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_spearmancorrm(const real_2d_array &x, const ae_int_t n, const ae_int_t m, real_2d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_spearmancorrm(const_cast(x.c_ptr()), n, m, const_cast(c.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Spearman's rank correlation matrix - -SMP EDITION OF ALGLIB: - - ! This function can utilize multicore capabilities of your system. In - ! order to do this you have to call version with "smp_" prefix, which - ! indicates that multicore code will be used. - ! - ! This note is given for users of SMP edition; if you use GPL edition, - ! or commercial edition of ALGLIB without SMP support, you still will - ! be able to call smp-version of this function, but all computations - ! will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - ! - ! You should remember that starting/stopping worker thread always have - ! non-zero cost. Although multicore version is pretty efficient on - ! large problems, we do not recommend you to use it on small problems - - ! with correlation matrices smaller than 128*128. - -INPUT PARAMETERS: - X - array[N,M], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - N - N>=0, number of observations: - * if given, only leading N rows of X are used - * if not given, automatically determined from input size - M - M>0, number of variables: - * if given, only leading M columns of X are used - * if not given, automatically determined from input size - -OUTPUT PARAMETERS: - C - array[M,M], correlation matrix (zero if N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -void spearmancorrm(const real_2d_array &x, real_2d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t m; - - n = x.rows(); - m = x.cols(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spearmancorrm(const_cast(x.c_ptr()), n, m, const_cast(c.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_spearmancorrm(const real_2d_array &x, real_2d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t m; - - n = x.rows(); - m = x.cols(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_spearmancorrm(const_cast(x.c_ptr()), n, m, const_cast(c.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Cross-covariance matrix - -SMP EDITION OF ALGLIB: - - ! This function can utilize multicore capabilities of your system. In - ! order to do this you have to call version with "smp_" prefix, which - ! indicates that multicore code will be used. - ! - ! This note is given for users of SMP edition; if you use GPL edition, - ! or commercial edition of ALGLIB without SMP support, you still will - ! be able to call smp-version of this function, but all computations - ! will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - ! - ! You should remember that starting/stopping worker thread always have - ! non-zero cost. Although multicore version is pretty efficient on - ! large problems, we do not recommend you to use it on small problems - - ! with covariance matrices smaller than 128*128. - -INPUT PARAMETERS: - X - array[N,M1], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - Y - array[N,M2], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - N - N>=0, number of observations: - * if given, only leading N rows of X/Y are used - * if not given, automatically determined from input sizes - M1 - M1>0, number of variables in X: - * if given, only leading M1 columns of X are used - * if not given, automatically determined from input size - M2 - M2>0, number of variables in Y: - * if given, only leading M1 columns of X are used - * if not given, automatically determined from input size - -OUTPUT PARAMETERS: - C - array[M1,M2], cross-covariance matrix (zero if N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -void covm2(const real_2d_array &x, const real_2d_array &y, const ae_int_t n, const ae_int_t m1, const ae_int_t m2, real_2d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::covm2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m1, m2, const_cast(c.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_covm2(const real_2d_array &x, const real_2d_array &y, const ae_int_t n, const ae_int_t m1, const ae_int_t m2, real_2d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_covm2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m1, m2, const_cast(c.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Cross-covariance matrix - -SMP EDITION OF ALGLIB: - - ! This function can utilize multicore capabilities of your system. In - ! order to do this you have to call version with "smp_" prefix, which - ! indicates that multicore code will be used. - ! - ! This note is given for users of SMP edition; if you use GPL edition, - ! or commercial edition of ALGLIB without SMP support, you still will - ! be able to call smp-version of this function, but all computations - ! will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - ! - ! You should remember that starting/stopping worker thread always have - ! non-zero cost. Although multicore version is pretty efficient on - ! large problems, we do not recommend you to use it on small problems - - ! with covariance matrices smaller than 128*128. - -INPUT PARAMETERS: - X - array[N,M1], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - Y - array[N,M2], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - N - N>=0, number of observations: - * if given, only leading N rows of X/Y are used - * if not given, automatically determined from input sizes - M1 - M1>0, number of variables in X: - * if given, only leading M1 columns of X are used - * if not given, automatically determined from input size - M2 - M2>0, number of variables in Y: - * if given, only leading M1 columns of X are used - * if not given, automatically determined from input size - -OUTPUT PARAMETERS: - C - array[M1,M2], cross-covariance matrix (zero if N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -void covm2(const real_2d_array &x, const real_2d_array &y, real_2d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t m1; - ae_int_t m2; - if( (x.rows()!=y.rows())) - throw ap_error("Error while calling 'covm2': looks like one of arguments has wrong size"); - n = x.rows(); - m1 = x.cols(); - m2 = y.cols(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::covm2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m1, m2, const_cast(c.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_covm2(const real_2d_array &x, const real_2d_array &y, real_2d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t m1; - ae_int_t m2; - if( (x.rows()!=y.rows())) - throw ap_error("Error while calling 'covm2': looks like one of arguments has wrong size"); - n = x.rows(); - m1 = x.cols(); - m2 = y.cols(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_covm2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m1, m2, const_cast(c.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Pearson product-moment cross-correlation matrix - -SMP EDITION OF ALGLIB: - - ! This function can utilize multicore capabilities of your system. In - ! order to do this you have to call version with "smp_" prefix, which - ! indicates that multicore code will be used. - ! - ! This note is given for users of SMP edition; if you use GPL edition, - ! or commercial edition of ALGLIB without SMP support, you still will - ! be able to call smp-version of this function, but all computations - ! will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - ! - ! You should remember that starting/stopping worker thread always have - ! non-zero cost. Although multicore version is pretty efficient on - ! large problems, we do not recommend you to use it on small problems - - ! with correlation matrices smaller than 128*128. - -INPUT PARAMETERS: - X - array[N,M1], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - Y - array[N,M2], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - N - N>=0, number of observations: - * if given, only leading N rows of X/Y are used - * if not given, automatically determined from input sizes - M1 - M1>0, number of variables in X: - * if given, only leading M1 columns of X are used - * if not given, automatically determined from input size - M2 - M2>0, number of variables in Y: - * if given, only leading M1 columns of X are used - * if not given, automatically determined from input size - -OUTPUT PARAMETERS: - C - array[M1,M2], cross-correlation matrix (zero if N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -void pearsoncorrm2(const real_2d_array &x, const real_2d_array &y, const ae_int_t n, const ae_int_t m1, const ae_int_t m2, real_2d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::pearsoncorrm2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m1, m2, const_cast(c.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_pearsoncorrm2(const real_2d_array &x, const real_2d_array &y, const ae_int_t n, const ae_int_t m1, const ae_int_t m2, real_2d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_pearsoncorrm2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m1, m2, const_cast(c.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Pearson product-moment cross-correlation matrix - -SMP EDITION OF ALGLIB: - - ! This function can utilize multicore capabilities of your system. In - ! order to do this you have to call version with "smp_" prefix, which - ! indicates that multicore code will be used. - ! - ! This note is given for users of SMP edition; if you use GPL edition, - ! or commercial edition of ALGLIB without SMP support, you still will - ! be able to call smp-version of this function, but all computations - ! will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - ! - ! You should remember that starting/stopping worker thread always have - ! non-zero cost. Although multicore version is pretty efficient on - ! large problems, we do not recommend you to use it on small problems - - ! with correlation matrices smaller than 128*128. - -INPUT PARAMETERS: - X - array[N,M1], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - Y - array[N,M2], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - N - N>=0, number of observations: - * if given, only leading N rows of X/Y are used - * if not given, automatically determined from input sizes - M1 - M1>0, number of variables in X: - * if given, only leading M1 columns of X are used - * if not given, automatically determined from input size - M2 - M2>0, number of variables in Y: - * if given, only leading M1 columns of X are used - * if not given, automatically determined from input size - -OUTPUT PARAMETERS: - C - array[M1,M2], cross-correlation matrix (zero if N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -void pearsoncorrm2(const real_2d_array &x, const real_2d_array &y, real_2d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t m1; - ae_int_t m2; - if( (x.rows()!=y.rows())) - throw ap_error("Error while calling 'pearsoncorrm2': looks like one of arguments has wrong size"); - n = x.rows(); - m1 = x.cols(); - m2 = y.cols(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::pearsoncorrm2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m1, m2, const_cast(c.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_pearsoncorrm2(const real_2d_array &x, const real_2d_array &y, real_2d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t m1; - ae_int_t m2; - if( (x.rows()!=y.rows())) - throw ap_error("Error while calling 'pearsoncorrm2': looks like one of arguments has wrong size"); - n = x.rows(); - m1 = x.cols(); - m2 = y.cols(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_pearsoncorrm2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m1, m2, const_cast(c.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Spearman's rank cross-correlation matrix - -SMP EDITION OF ALGLIB: - - ! This function can utilize multicore capabilities of your system. In - ! order to do this you have to call version with "smp_" prefix, which - ! indicates that multicore code will be used. - ! - ! This note is given for users of SMP edition; if you use GPL edition, - ! or commercial edition of ALGLIB without SMP support, you still will - ! be able to call smp-version of this function, but all computations - ! will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - ! - ! You should remember that starting/stopping worker thread always have - ! non-zero cost. Although multicore version is pretty efficient on - ! large problems, we do not recommend you to use it on small problems - - ! with correlation matrices smaller than 128*128. - -INPUT PARAMETERS: - X - array[N,M1], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - Y - array[N,M2], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - N - N>=0, number of observations: - * if given, only leading N rows of X/Y are used - * if not given, automatically determined from input sizes - M1 - M1>0, number of variables in X: - * if given, only leading M1 columns of X are used - * if not given, automatically determined from input size - M2 - M2>0, number of variables in Y: - * if given, only leading M1 columns of X are used - * if not given, automatically determined from input size - -OUTPUT PARAMETERS: - C - array[M1,M2], cross-correlation matrix (zero if N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -void spearmancorrm2(const real_2d_array &x, const real_2d_array &y, const ae_int_t n, const ae_int_t m1, const ae_int_t m2, real_2d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spearmancorrm2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m1, m2, const_cast(c.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_spearmancorrm2(const real_2d_array &x, const real_2d_array &y, const ae_int_t n, const ae_int_t m1, const ae_int_t m2, real_2d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_spearmancorrm2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m1, m2, const_cast(c.c_ptr()), &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Spearman's rank cross-correlation matrix - -SMP EDITION OF ALGLIB: - - ! This function can utilize multicore capabilities of your system. In - ! order to do this you have to call version with "smp_" prefix, which - ! indicates that multicore code will be used. - ! - ! This note is given for users of SMP edition; if you use GPL edition, - ! or commercial edition of ALGLIB without SMP support, you still will - ! be able to call smp-version of this function, but all computations - ! will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - ! - ! You should remember that starting/stopping worker thread always have - ! non-zero cost. Although multicore version is pretty efficient on - ! large problems, we do not recommend you to use it on small problems - - ! with correlation matrices smaller than 128*128. - -INPUT PARAMETERS: - X - array[N,M1], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - Y - array[N,M2], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - N - N>=0, number of observations: - * if given, only leading N rows of X/Y are used - * if not given, automatically determined from input sizes - M1 - M1>0, number of variables in X: - * if given, only leading M1 columns of X are used - * if not given, automatically determined from input size - M2 - M2>0, number of variables in Y: - * if given, only leading M1 columns of X are used - * if not given, automatically determined from input size - -OUTPUT PARAMETERS: - C - array[M1,M2], cross-correlation matrix (zero if N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -void spearmancorrm2(const real_2d_array &x, const real_2d_array &y, real_2d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t m1; - ae_int_t m2; - if( (x.rows()!=y.rows())) - throw ap_error("Error while calling 'spearmancorrm2': looks like one of arguments has wrong size"); - n = x.rows(); - m1 = x.cols(); - m2 = y.cols(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spearmancorrm2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m1, m2, const_cast(c.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_spearmancorrm2(const real_2d_array &x, const real_2d_array &y, real_2d_array &c) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t n; - ae_int_t m1; - ae_int_t m2; - if( (x.rows()!=y.rows())) - throw ap_error("Error while calling 'spearmancorrm2': looks like one of arguments has wrong size"); - n = x.rows(); - m1 = x.cols(); - m2 = y.cols(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_spearmancorrm2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m1, m2, const_cast(c.c_ptr()), &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* - -*************************************************************************/ -void rankdata(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nfeatures) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rankdata(const_cast(xy.c_ptr()), npoints, nfeatures, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_rankdata(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nfeatures) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_rankdata(const_cast(xy.c_ptr()), npoints, nfeatures, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* - -*************************************************************************/ -void rankdata(real_2d_array &xy) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t npoints; - ae_int_t nfeatures; - - npoints = xy.rows(); - nfeatures = xy.cols(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rankdata(const_cast(xy.c_ptr()), npoints, nfeatures, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_rankdata(real_2d_array &xy) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t npoints; - ae_int_t nfeatures; - - npoints = xy.rows(); - nfeatures = xy.cols(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_rankdata(const_cast(xy.c_ptr()), npoints, nfeatures, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* - -*************************************************************************/ -void rankdatacentered(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nfeatures) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rankdatacentered(const_cast(xy.c_ptr()), npoints, nfeatures, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_rankdatacentered(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nfeatures) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_rankdatacentered(const_cast(xy.c_ptr()), npoints, nfeatures, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* - -*************************************************************************/ -void rankdatacentered(real_2d_array &xy) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t npoints; - ae_int_t nfeatures; - - npoints = xy.rows(); - nfeatures = xy.cols(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::rankdatacentered(const_cast(xy.c_ptr()), npoints, nfeatures, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - - -void smp_rankdatacentered(real_2d_array &xy) -{ - alglib_impl::ae_state _alglib_env_state; - ae_int_t npoints; - ae_int_t nfeatures; - - npoints = xy.rows(); - nfeatures = xy.cols(); - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::_pexec_rankdatacentered(const_cast(xy.c_ptr()), npoints, nfeatures, &_alglib_env_state); - - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Obsolete function, we recommend to use PearsonCorr2(). - - -- ALGLIB -- - Copyright 09.04.2007 by Bochkanov Sergey -*************************************************************************/ -double pearsoncorrelation(const real_1d_array &x, const real_1d_array &y, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::pearsoncorrelation(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Obsolete function, we recommend to use SpearmanCorr2(). - - -- ALGLIB -- - Copyright 09.04.2007 by Bochkanov Sergey -*************************************************************************/ -double spearmanrankcorrelation(const real_1d_array &x, const real_1d_array &y, const ae_int_t n) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - double result = alglib_impl::spearmanrankcorrelation(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return *(reinterpret_cast(&result)); - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Pearson's correlation coefficient significance test - -This test checks hypotheses about whether X and Y are samples of two -continuous distributions having zero correlation or whether their -correlation is non-zero. - -The following tests are performed: - * two-tailed test (null hypothesis - X and Y have zero correlation) - * left-tailed test (null hypothesis - the correlation coefficient is - greater than or equal to 0) - * right-tailed test (null hypothesis - the correlation coefficient is - less than or equal to 0). - -Requirements: - * the number of elements in each sample is not less than 5 - * normality of distributions of X and Y. - -Input parameters: - R - Pearson's correlation coefficient for X and Y - N - number of elements in samples, N>=5. - -Output parameters: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - - -- ALGLIB -- - Copyright 09.04.2007 by Bochkanov Sergey -*************************************************************************/ -void pearsoncorrelationsignificance(const double r, const ae_int_t n, double &bothtails, double &lefttail, double &righttail) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::pearsoncorrelationsignificance(r, n, &bothtails, &lefttail, &righttail, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Spearman's rank correlation coefficient significance test - -This test checks hypotheses about whether X and Y are samples of two -continuous distributions having zero correlation or whether their -correlation is non-zero. - -The following tests are performed: - * two-tailed test (null hypothesis - X and Y have zero correlation) - * left-tailed test (null hypothesis - the correlation coefficient is - greater than or equal to 0) - * right-tailed test (null hypothesis - the correlation coefficient is - less than or equal to 0). - -Requirements: - * the number of elements in each sample is not less than 5. - -The test is non-parametric and doesn't require distributions X and Y to be -normal. - -Input parameters: - R - Spearman's rank correlation coefficient for X and Y - N - number of elements in samples, N>=5. - -Output parameters: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - - -- ALGLIB -- - Copyright 09.04.2007 by Bochkanov Sergey -*************************************************************************/ -void spearmanrankcorrelationsignificance(const double r, const ae_int_t n, double &bothtails, double &lefttail, double &righttail) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::spearmanrankcorrelationsignificance(r, n, &bothtails, &lefttail, &righttail, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Jarque-Bera test - -This test checks hypotheses about the fact that a given sample X is a -sample of normal random variable. - -Requirements: - * the number of elements in the sample is not less than 5. - -Input parameters: - X - sample. Array whose index goes from 0 to N-1. - N - size of the sample. N>=5 - -Output parameters: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - -Accuracy of the approximation used (5<=N<=1951): - -p-value relative error (5<=N<=1951) -[1, 0.1] < 1% -[0.1, 0.01] < 2% -[0.01, 0.001] < 6% -[0.001, 0] wasn't measured - -For N>1951 accuracy wasn't measured but it shouldn't be sharply different -from table values. - - -- ALGLIB -- - Copyright 09.04.2007 by Bochkanov Sergey -*************************************************************************/ -void jarqueberatest(const real_1d_array &x, const ae_int_t n, double &p) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::jarqueberatest(const_cast(x.c_ptr()), n, &p, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Mann-Whitney U-test - -This test checks hypotheses about whether X and Y are samples of two -continuous distributions of the same shape and same median or whether -their medians are different. - -The following tests are performed: - * two-tailed test (null hypothesis - the medians are equal) - * left-tailed test (null hypothesis - the median of the first sample - is greater than or equal to the median of the second sample) - * right-tailed test (null hypothesis - the median of the first sample - is less than or equal to the median of the second sample). - -Requirements: - * the samples are independent - * X and Y are continuous distributions (or discrete distributions well- - approximating continuous distributions) - * distributions of X and Y have the same shape. The only possible - difference is their position (i.e. the value of the median) - * the number of elements in each sample is not less than 5 - * the scale of measurement should be ordinal, interval or ratio (i.e. - the test could not be applied to nominal variables). - -The test is non-parametric and doesn't require distributions to be normal. - -Input parameters: - X - sample 1. Array whose index goes from 0 to N-1. - N - size of the sample. N>=5 - Y - sample 2. Array whose index goes from 0 to M-1. - M - size of the sample. M>=5 - -Output parameters: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - -To calculate p-values, special approximation is used. This method lets us -calculate p-values with satisfactory accuracy in interval [0.0001, 1]. -There is no approximation outside the [0.0001, 1] interval. Therefore, if -the significance level outlies this interval, the test returns 0.0001. - -Relative precision of approximation of p-value: - -N M Max.err. Rms.err. -5..10 N..10 1.4e-02 6.0e-04 -5..10 N..100 2.2e-02 5.3e-06 -10..15 N..15 1.0e-02 3.2e-04 -10..15 N..100 1.0e-02 2.2e-05 -15..100 N..100 6.1e-03 2.7e-06 - -For N,M>100 accuracy checks weren't put into practice, but taking into -account characteristics of asymptotic approximation used, precision should -not be sharply different from the values for interval [5, 100]. - - -- ALGLIB -- - Copyright 09.04.2007 by Bochkanov Sergey -*************************************************************************/ -void mannwhitneyutest(const real_1d_array &x, const ae_int_t n, const real_1d_array &y, const ae_int_t m, double &bothtails, double &lefttail, double &righttail) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::mannwhitneyutest(const_cast(x.c_ptr()), n, const_cast(y.c_ptr()), m, &bothtails, &lefttail, &righttail, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Sign test - -This test checks three hypotheses about the median of the given sample. -The following tests are performed: - * two-tailed test (null hypothesis - the median is equal to the given - value) - * left-tailed test (null hypothesis - the median is greater than or - equal to the given value) - * right-tailed test (null hypothesis - the median is less than or - equal to the given value) - -Requirements: - * the scale of measurement should be ordinal, interval or ratio (i.e. - the test could not be applied to nominal variables). - -The test is non-parametric and doesn't require distribution X to be normal - -Input parameters: - X - sample. Array whose index goes from 0 to N-1. - N - size of the sample. - Median - assumed median value. - -Output parameters: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - -While calculating p-values high-precision binomial distribution -approximation is used, so significance levels have about 15 exact digits. - - -- ALGLIB -- - Copyright 08.09.2006 by Bochkanov Sergey -*************************************************************************/ -void onesamplesigntest(const real_1d_array &x, const ae_int_t n, const double median, double &bothtails, double &lefttail, double &righttail) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::onesamplesigntest(const_cast(x.c_ptr()), n, median, &bothtails, &lefttail, &righttail, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -One-sample t-test - -This test checks three hypotheses about the mean of the given sample. The -following tests are performed: - * two-tailed test (null hypothesis - the mean is equal to the given - value) - * left-tailed test (null hypothesis - the mean is greater than or - equal to the given value) - * right-tailed test (null hypothesis - the mean is less than or equal - to the given value). - -The test is based on the assumption that a given sample has a normal -distribution and an unknown dispersion. If the distribution sharply -differs from normal, the test will work incorrectly. - -INPUT PARAMETERS: - X - sample. Array whose index goes from 0 to N-1. - N - size of sample, N>=0 - Mean - assumed value of the mean. - -OUTPUT PARAMETERS: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - -NOTE: this function correctly handles degenerate cases: - * when N=0, all p-values are set to 1.0 - * when variance of X[] is exactly zero, p-values are set - to 1.0 or 0.0, depending on difference between sample mean and - value of mean being tested. - - - -- ALGLIB -- - Copyright 08.09.2006 by Bochkanov Sergey -*************************************************************************/ -void studentttest1(const real_1d_array &x, const ae_int_t n, const double mean, double &bothtails, double &lefttail, double &righttail) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::studentttest1(const_cast(x.c_ptr()), n, mean, &bothtails, &lefttail, &righttail, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Two-sample pooled test - -This test checks three hypotheses about the mean of the given samples. The -following tests are performed: - * two-tailed test (null hypothesis - the means are equal) - * left-tailed test (null hypothesis - the mean of the first sample is - greater than or equal to the mean of the second sample) - * right-tailed test (null hypothesis - the mean of the first sample is - less than or equal to the mean of the second sample). - -Test is based on the following assumptions: - * given samples have normal distributions - * dispersions are equal - * samples are independent. - -Input parameters: - X - sample 1. Array whose index goes from 0 to N-1. - N - size of sample. - Y - sample 2. Array whose index goes from 0 to M-1. - M - size of sample. - -Output parameters: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - -NOTE: this function correctly handles degenerate cases: - * when N=0 or M=0, all p-values are set to 1.0 - * when both samples has exactly zero variance, p-values are set - to 1.0 or 0.0, depending on difference between means. - - -- ALGLIB -- - Copyright 18.09.2006 by Bochkanov Sergey -*************************************************************************/ -void studentttest2(const real_1d_array &x, const ae_int_t n, const real_1d_array &y, const ae_int_t m, double &bothtails, double &lefttail, double &righttail) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::studentttest2(const_cast(x.c_ptr()), n, const_cast(y.c_ptr()), m, &bothtails, &lefttail, &righttail, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Two-sample unpooled test - -This test checks three hypotheses about the mean of the given samples. The -following tests are performed: - * two-tailed test (null hypothesis - the means are equal) - * left-tailed test (null hypothesis - the mean of the first sample is - greater than or equal to the mean of the second sample) - * right-tailed test (null hypothesis - the mean of the first sample is - less than or equal to the mean of the second sample). - -Test is based on the following assumptions: - * given samples have normal distributions - * samples are independent. -Equality of variances is NOT required. - -Input parameters: - X - sample 1. Array whose index goes from 0 to N-1. - N - size of the sample. - Y - sample 2. Array whose index goes from 0 to M-1. - M - size of the sample. - -Output parameters: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - -NOTE: this function correctly handles degenerate cases: - * when N=0 or M=0, all p-values are set to 1.0 - * when both samples has zero variance, p-values are set - to 1.0 or 0.0, depending on difference between means. - * when only one sample has zero variance, test reduces to 1-sample - version. - - -- ALGLIB -- - Copyright 18.09.2006 by Bochkanov Sergey -*************************************************************************/ -void unequalvariancettest(const real_1d_array &x, const ae_int_t n, const real_1d_array &y, const ae_int_t m, double &bothtails, double &lefttail, double &righttail) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::unequalvariancettest(const_cast(x.c_ptr()), n, const_cast(y.c_ptr()), m, &bothtails, &lefttail, &righttail, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Two-sample F-test - -This test checks three hypotheses about dispersions of the given samples. -The following tests are performed: - * two-tailed test (null hypothesis - the dispersions are equal) - * left-tailed test (null hypothesis - the dispersion of the first - sample is greater than or equal to the dispersion of the second - sample). - * right-tailed test (null hypothesis - the dispersion of the first - sample is less than or equal to the dispersion of the second sample) - -The test is based on the following assumptions: - * the given samples have normal distributions - * the samples are independent. - -Input parameters: - X - sample 1. Array whose index goes from 0 to N-1. - N - sample size. - Y - sample 2. Array whose index goes from 0 to M-1. - M - sample size. - -Output parameters: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - - -- ALGLIB -- - Copyright 19.09.2006 by Bochkanov Sergey -*************************************************************************/ -void ftest(const real_1d_array &x, const ae_int_t n, const real_1d_array &y, const ae_int_t m, double &bothtails, double &lefttail, double &righttail) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::ftest(const_cast(x.c_ptr()), n, const_cast(y.c_ptr()), m, &bothtails, &lefttail, &righttail, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -One-sample chi-square test - -This test checks three hypotheses about the dispersion of the given sample -The following tests are performed: - * two-tailed test (null hypothesis - the dispersion equals the given - number) - * left-tailed test (null hypothesis - the dispersion is greater than - or equal to the given number) - * right-tailed test (null hypothesis - dispersion is less than or - equal to the given number). - -Test is based on the following assumptions: - * the given sample has a normal distribution. - -Input parameters: - X - sample 1. Array whose index goes from 0 to N-1. - N - size of the sample. - Variance - dispersion value to compare with. - -Output parameters: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - - -- ALGLIB -- - Copyright 19.09.2006 by Bochkanov Sergey -*************************************************************************/ -void onesamplevariancetest(const real_1d_array &x, const ae_int_t n, const double variance, double &bothtails, double &lefttail, double &righttail) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::onesamplevariancetest(const_cast(x.c_ptr()), n, variance, &bothtails, &lefttail, &righttail, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} - -/************************************************************************* -Wilcoxon signed-rank test - -This test checks three hypotheses about the median of the given sample. -The following tests are performed: - * two-tailed test (null hypothesis - the median is equal to the given - value) - * left-tailed test (null hypothesis - the median is greater than or - equal to the given value) - * right-tailed test (null hypothesis - the median is less than or - equal to the given value) - -Requirements: - * the scale of measurement should be ordinal, interval or ratio (i.e. - the test could not be applied to nominal variables). - * the distribution should be continuous and symmetric relative to its - median. - * number of distinct values in the X array should be greater than 4 - -The test is non-parametric and doesn't require distribution X to be normal - -Input parameters: - X - sample. Array whose index goes from 0 to N-1. - N - size of the sample. - Median - assumed median value. - -Output parameters: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - -To calculate p-values, special approximation is used. This method lets us -calculate p-values with two decimal places in interval [0.0001, 1]. - -"Two decimal places" does not sound very impressive, but in practice the -relative error of less than 1% is enough to make a decision. - -There is no approximation outside the [0.0001, 1] interval. Therefore, if -the significance level outlies this interval, the test returns 0.0001. - - -- ALGLIB -- - Copyright 08.09.2006 by Bochkanov Sergey -*************************************************************************/ -void wilcoxonsignedranktest(const real_1d_array &x, const ae_int_t n, const double e, double &bothtails, double &lefttail, double &righttail) -{ - alglib_impl::ae_state _alglib_env_state; - alglib_impl::ae_state_init(&_alglib_env_state); - try - { - alglib_impl::wilcoxonsignedranktest(const_cast(x.c_ptr()), n, e, &bothtails, &lefttail, &righttail, &_alglib_env_state); - alglib_impl::ae_state_clear(&_alglib_env_state); - return; - } - catch(alglib_impl::ae_error_type) - { - throw ap_error(_alglib_env_state.error_msg); - } -} -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS IMPLEMENTATION OF COMPUTATIONAL CORE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ -static void basestat_rankdatarec(/* Real */ ae_matrix* xy, - ae_int_t i0, - ae_int_t i1, - ae_int_t nfeatures, - ae_bool iscentered, - ae_shared_pool* pool, - ae_int_t basecasecost, - ae_state *_state); -static void basestat_rankdatabasecase(/* Real */ ae_matrix* xy, - ae_int_t i0, - ae_int_t i1, - ae_int_t nfeatures, - ae_bool iscentered, - apbuffers* buf0, - apbuffers* buf1, - ae_state *_state); - - -static double correlationtests_spearmantail5(double s, ae_state *_state); -static double correlationtests_spearmantail6(double s, ae_state *_state); -static double correlationtests_spearmantail7(double s, ae_state *_state); -static double correlationtests_spearmantail8(double s, ae_state *_state); -static double correlationtests_spearmantail9(double s, ae_state *_state); -static double correlationtests_spearmantail(double t, - ae_int_t n, - ae_state *_state); - - -static void jarquebera_jarqueberastatistic(/* Real */ ae_vector* x, - ae_int_t n, - double* s, - ae_state *_state); -static double jarquebera_jarqueberaapprox(ae_int_t n, - double s, - ae_state *_state); -static double jarquebera_jbtbl5(double s, ae_state *_state); -static double jarquebera_jbtbl6(double s, ae_state *_state); -static double jarquebera_jbtbl7(double s, ae_state *_state); -static double jarquebera_jbtbl8(double s, ae_state *_state); -static double jarquebera_jbtbl9(double s, ae_state *_state); -static double jarquebera_jbtbl10(double s, ae_state *_state); -static double jarquebera_jbtbl11(double s, ae_state *_state); -static double jarquebera_jbtbl12(double s, ae_state *_state); -static double jarquebera_jbtbl13(double s, ae_state *_state); -static double jarquebera_jbtbl14(double s, ae_state *_state); -static double jarquebera_jbtbl15(double s, ae_state *_state); -static double jarquebera_jbtbl16(double s, ae_state *_state); -static double jarquebera_jbtbl17(double s, ae_state *_state); -static double jarquebera_jbtbl18(double s, ae_state *_state); -static double jarquebera_jbtbl19(double s, ae_state *_state); -static double jarquebera_jbtbl20(double s, ae_state *_state); -static double jarquebera_jbtbl30(double s, ae_state *_state); -static double jarquebera_jbtbl50(double s, ae_state *_state); -static double jarquebera_jbtbl65(double s, ae_state *_state); -static double jarquebera_jbtbl100(double s, ae_state *_state); -static double jarquebera_jbtbl130(double s, ae_state *_state); -static double jarquebera_jbtbl200(double s, ae_state *_state); -static double jarquebera_jbtbl301(double s, ae_state *_state); -static double jarquebera_jbtbl501(double s, ae_state *_state); -static double jarquebera_jbtbl701(double s, ae_state *_state); -static double jarquebera_jbtbl1401(double s, ae_state *_state); -static void jarquebera_jbcheb(double x, - double c, - double* tj, - double* tj1, - double* r, - ae_state *_state); - - -static void mannwhitneyu_ucheb(double x, - double c, - double* tj, - double* tj1, - double* r, - ae_state *_state); -static double mannwhitneyu_uninterpolate(double p1, - double p2, - double p3, - ae_int_t n, - ae_state *_state); -static double mannwhitneyu_usigma000(ae_int_t n1, - ae_int_t n2, - ae_state *_state); -static double mannwhitneyu_usigma075(ae_int_t n1, - ae_int_t n2, - ae_state *_state); -static double mannwhitneyu_usigma150(ae_int_t n1, - ae_int_t n2, - ae_state *_state); -static double mannwhitneyu_usigma225(ae_int_t n1, - ae_int_t n2, - ae_state *_state); -static double mannwhitneyu_usigma300(ae_int_t n1, - ae_int_t n2, - ae_state *_state); -static double mannwhitneyu_usigma333(ae_int_t n1, - ae_int_t n2, - ae_state *_state); -static double mannwhitneyu_usigma367(ae_int_t n1, - ae_int_t n2, - ae_state *_state); -static double mannwhitneyu_usigma400(ae_int_t n1, - ae_int_t n2, - ae_state *_state); -static double mannwhitneyu_utbln5n5(double s, ae_state *_state); -static double mannwhitneyu_utbln5n6(double s, ae_state *_state); -static double mannwhitneyu_utbln5n7(double s, ae_state *_state); -static double mannwhitneyu_utbln5n8(double s, ae_state *_state); -static double mannwhitneyu_utbln5n9(double s, ae_state *_state); -static double mannwhitneyu_utbln5n10(double s, ae_state *_state); -static double mannwhitneyu_utbln5n11(double s, ae_state *_state); -static double mannwhitneyu_utbln5n12(double s, ae_state *_state); -static double mannwhitneyu_utbln5n13(double s, ae_state *_state); -static double mannwhitneyu_utbln5n14(double s, ae_state *_state); -static double mannwhitneyu_utbln5n15(double s, ae_state *_state); -static double mannwhitneyu_utbln5n16(double s, ae_state *_state); -static double mannwhitneyu_utbln5n17(double s, ae_state *_state); -static double mannwhitneyu_utbln5n18(double s, ae_state *_state); -static double mannwhitneyu_utbln5n19(double s, ae_state *_state); -static double mannwhitneyu_utbln5n20(double s, ae_state *_state); -static double mannwhitneyu_utbln5n21(double s, ae_state *_state); -static double mannwhitneyu_utbln5n22(double s, ae_state *_state); -static double mannwhitneyu_utbln5n23(double s, ae_state *_state); -static double mannwhitneyu_utbln5n24(double s, ae_state *_state); -static double mannwhitneyu_utbln5n25(double s, ae_state *_state); -static double mannwhitneyu_utbln5n26(double s, ae_state *_state); -static double mannwhitneyu_utbln5n27(double s, ae_state *_state); -static double mannwhitneyu_utbln5n28(double s, ae_state *_state); -static double mannwhitneyu_utbln5n29(double s, ae_state *_state); -static double mannwhitneyu_utbln5n30(double s, ae_state *_state); -static double mannwhitneyu_utbln5n100(double s, ae_state *_state); -static double mannwhitneyu_utbln6n6(double s, ae_state *_state); -static double mannwhitneyu_utbln6n7(double s, ae_state *_state); -static double mannwhitneyu_utbln6n8(double s, ae_state *_state); -static double mannwhitneyu_utbln6n9(double s, ae_state *_state); -static double mannwhitneyu_utbln6n10(double s, ae_state *_state); -static double mannwhitneyu_utbln6n11(double s, ae_state *_state); -static double mannwhitneyu_utbln6n12(double s, ae_state *_state); -static double mannwhitneyu_utbln6n13(double s, ae_state *_state); -static double mannwhitneyu_utbln6n14(double s, ae_state *_state); -static double mannwhitneyu_utbln6n15(double s, ae_state *_state); -static double mannwhitneyu_utbln6n30(double s, ae_state *_state); -static double mannwhitneyu_utbln6n100(double s, ae_state *_state); -static double mannwhitneyu_utbln7n7(double s, ae_state *_state); -static double mannwhitneyu_utbln7n8(double s, ae_state *_state); -static double mannwhitneyu_utbln7n9(double s, ae_state *_state); -static double mannwhitneyu_utbln7n10(double s, ae_state *_state); -static double mannwhitneyu_utbln7n11(double s, ae_state *_state); -static double mannwhitneyu_utbln7n12(double s, ae_state *_state); -static double mannwhitneyu_utbln7n13(double s, ae_state *_state); -static double mannwhitneyu_utbln7n14(double s, ae_state *_state); -static double mannwhitneyu_utbln7n15(double s, ae_state *_state); -static double mannwhitneyu_utbln7n30(double s, ae_state *_state); -static double mannwhitneyu_utbln7n100(double s, ae_state *_state); -static double mannwhitneyu_utbln8n8(double s, ae_state *_state); -static double mannwhitneyu_utbln8n9(double s, ae_state *_state); -static double mannwhitneyu_utbln8n10(double s, ae_state *_state); -static double mannwhitneyu_utbln8n11(double s, ae_state *_state); -static double mannwhitneyu_utbln8n12(double s, ae_state *_state); -static double mannwhitneyu_utbln8n13(double s, ae_state *_state); -static double mannwhitneyu_utbln8n14(double s, ae_state *_state); -static double mannwhitneyu_utbln8n15(double s, ae_state *_state); -static double mannwhitneyu_utbln8n30(double s, ae_state *_state); -static double mannwhitneyu_utbln8n100(double s, ae_state *_state); -static double mannwhitneyu_utbln9n9(double s, ae_state *_state); -static double mannwhitneyu_utbln9n10(double s, ae_state *_state); -static double mannwhitneyu_utbln9n11(double s, ae_state *_state); -static double mannwhitneyu_utbln9n12(double s, ae_state *_state); -static double mannwhitneyu_utbln9n13(double s, ae_state *_state); -static double mannwhitneyu_utbln9n14(double s, ae_state *_state); -static double mannwhitneyu_utbln9n15(double s, ae_state *_state); -static double mannwhitneyu_utbln9n30(double s, ae_state *_state); -static double mannwhitneyu_utbln9n100(double s, ae_state *_state); -static double mannwhitneyu_utbln10n10(double s, ae_state *_state); -static double mannwhitneyu_utbln10n11(double s, ae_state *_state); -static double mannwhitneyu_utbln10n12(double s, ae_state *_state); -static double mannwhitneyu_utbln10n13(double s, ae_state *_state); -static double mannwhitneyu_utbln10n14(double s, ae_state *_state); -static double mannwhitneyu_utbln10n15(double s, ae_state *_state); -static double mannwhitneyu_utbln10n30(double s, ae_state *_state); -static double mannwhitneyu_utbln10n100(double s, ae_state *_state); -static double mannwhitneyu_utbln11n11(double s, ae_state *_state); -static double mannwhitneyu_utbln11n12(double s, ae_state *_state); -static double mannwhitneyu_utbln11n13(double s, ae_state *_state); -static double mannwhitneyu_utbln11n14(double s, ae_state *_state); -static double mannwhitneyu_utbln11n15(double s, ae_state *_state); -static double mannwhitneyu_utbln11n30(double s, ae_state *_state); -static double mannwhitneyu_utbln11n100(double s, ae_state *_state); -static double mannwhitneyu_utbln12n12(double s, ae_state *_state); -static double mannwhitneyu_utbln12n13(double s, ae_state *_state); -static double mannwhitneyu_utbln12n14(double s, ae_state *_state); -static double mannwhitneyu_utbln12n15(double s, ae_state *_state); -static double mannwhitneyu_utbln12n30(double s, ae_state *_state); -static double mannwhitneyu_utbln12n100(double s, ae_state *_state); -static double mannwhitneyu_utbln13n13(double s, ae_state *_state); -static double mannwhitneyu_utbln13n14(double s, ae_state *_state); -static double mannwhitneyu_utbln13n15(double s, ae_state *_state); -static double mannwhitneyu_utbln13n30(double s, ae_state *_state); -static double mannwhitneyu_utbln13n100(double s, ae_state *_state); -static double mannwhitneyu_utbln14n14(double s, ae_state *_state); -static double mannwhitneyu_utbln14n15(double s, ae_state *_state); -static double mannwhitneyu_utbln14n30(double s, ae_state *_state); -static double mannwhitneyu_utbln14n100(double s, ae_state *_state); -static double mannwhitneyu_usigma(double s, - ae_int_t n1, - ae_int_t n2, - ae_state *_state); - - - - - - - - -static void wsr_wcheb(double x, - double c, - double* tj, - double* tj1, - double* r, - ae_state *_state); -static double wsr_w5(double s, ae_state *_state); -static double wsr_w6(double s, ae_state *_state); -static double wsr_w7(double s, ae_state *_state); -static double wsr_w8(double s, ae_state *_state); -static double wsr_w9(double s, ae_state *_state); -static double wsr_w10(double s, ae_state *_state); -static double wsr_w11(double s, ae_state *_state); -static double wsr_w12(double s, ae_state *_state); -static double wsr_w13(double s, ae_state *_state); -static double wsr_w14(double s, ae_state *_state); -static double wsr_w15(double s, ae_state *_state); -static double wsr_w16(double s, ae_state *_state); -static double wsr_w17(double s, ae_state *_state); -static double wsr_w18(double s, ae_state *_state); -static double wsr_w19(double s, ae_state *_state); -static double wsr_w20(double s, ae_state *_state); -static double wsr_w21(double s, ae_state *_state); -static double wsr_w22(double s, ae_state *_state); -static double wsr_w23(double s, ae_state *_state); -static double wsr_w24(double s, ae_state *_state); -static double wsr_w25(double s, ae_state *_state); -static double wsr_w26(double s, ae_state *_state); -static double wsr_w27(double s, ae_state *_state); -static double wsr_w28(double s, ae_state *_state); -static double wsr_w29(double s, ae_state *_state); -static double wsr_w30(double s, ae_state *_state); -static double wsr_w40(double s, ae_state *_state); -static double wsr_w60(double s, ae_state *_state); -static double wsr_w120(double s, ae_state *_state); -static double wsr_w200(double s, ae_state *_state); -static double wsr_wsigma(double s, ae_int_t n, ae_state *_state); - - - - - -/************************************************************************* -Calculation of the distribution moments: mean, variance, skewness, kurtosis. - -INPUT PARAMETERS: - X - sample - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - -OUTPUT PARAMETERS - Mean - mean. - Variance- variance. - Skewness- skewness (if variance<>0; zero otherwise). - Kurtosis- kurtosis (if variance<>0; zero otherwise). - - - -- ALGLIB -- - Copyright 06.09.2006 by Bochkanov Sergey -*************************************************************************/ -void samplemoments(/* Real */ ae_vector* x, - ae_int_t n, - double* mean, - double* variance, - double* skewness, - double* kurtosis, - ae_state *_state) -{ - ae_int_t i; - double v; - double v1; - double v2; - double stddev; - - *mean = 0; - *variance = 0; - *skewness = 0; - *kurtosis = 0; - - ae_assert(n>=0, "SampleMoments: N<0", _state); - ae_assert(x->cnt>=n, "SampleMoments: Length(X)ptr.p_double[i]; - } - *mean = *mean/n; - - /* - * Variance (using corrected two-pass algorithm) - */ - if( n!=1 ) - { - v1 = 0; - for(i=0; i<=n-1; i++) - { - v1 = v1+ae_sqr(x->ptr.p_double[i]-(*mean), _state); - } - v2 = 0; - for(i=0; i<=n-1; i++) - { - v2 = v2+(x->ptr.p_double[i]-(*mean)); - } - v2 = ae_sqr(v2, _state)/n; - *variance = (v1-v2)/(n-1); - if( ae_fp_less(*variance,0) ) - { - *variance = 0; - } - stddev = ae_sqrt(*variance, _state); - } - - /* - * Skewness and kurtosis - */ - if( ae_fp_neq(stddev,0) ) - { - for(i=0; i<=n-1; i++) - { - v = (x->ptr.p_double[i]-(*mean))/stddev; - v2 = ae_sqr(v, _state); - *skewness = *skewness+v2*v; - *kurtosis = *kurtosis+ae_sqr(v2, _state); - } - *skewness = *skewness/n; - *kurtosis = *kurtosis/n-3; - } -} - - -/************************************************************************* -Calculation of the mean. - -INPUT PARAMETERS: - X - sample - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - -NOTE: - -This function return result which calculated by 'SampleMoments' function -and stored at 'Mean' variable. - - - -- ALGLIB -- - Copyright 06.09.2006 by Bochkanov Sergey -*************************************************************************/ -double samplemean(/* Real */ ae_vector* x, - ae_int_t n, - ae_state *_state) -{ - double mean; - double tmp0; - double tmp1; - double tmp2; - double result; - - - samplemoments(x, n, &mean, &tmp0, &tmp1, &tmp2, _state); - result = mean; - return result; -} - - -/************************************************************************* -Calculation of the variance. - -INPUT PARAMETERS: - X - sample - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - -NOTE: - -This function return result which calculated by 'SampleMoments' function -and stored at 'Variance' variable. - - - -- ALGLIB -- - Copyright 06.09.2006 by Bochkanov Sergey -*************************************************************************/ -double samplevariance(/* Real */ ae_vector* x, - ae_int_t n, - ae_state *_state) -{ - double variance; - double tmp0; - double tmp1; - double tmp2; - double result; - - - samplemoments(x, n, &tmp0, &variance, &tmp1, &tmp2, _state); - result = variance; - return result; -} - - -/************************************************************************* -Calculation of the skewness. - -INPUT PARAMETERS: - X - sample - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - -NOTE: - -This function return result which calculated by 'SampleMoments' function -and stored at 'Skewness' variable. - - - -- ALGLIB -- - Copyright 06.09.2006 by Bochkanov Sergey -*************************************************************************/ -double sampleskewness(/* Real */ ae_vector* x, - ae_int_t n, - ae_state *_state) -{ - double skewness; - double tmp0; - double tmp1; - double tmp2; - double result; - - - samplemoments(x, n, &tmp0, &tmp1, &skewness, &tmp2, _state); - result = skewness; - return result; -} - - -/************************************************************************* -Calculation of the kurtosis. - -INPUT PARAMETERS: - X - sample - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - -NOTE: - -This function return result which calculated by 'SampleMoments' function -and stored at 'Kurtosis' variable. - - - -- ALGLIB -- - Copyright 06.09.2006 by Bochkanov Sergey -*************************************************************************/ -double samplekurtosis(/* Real */ ae_vector* x, - ae_int_t n, - ae_state *_state) -{ - double kurtosis; - double tmp0; - double tmp1; - double tmp2; - double result; - - - samplemoments(x, n, &tmp0, &tmp1, &tmp2, &kurtosis, _state); - result = kurtosis; - return result; -} - - -/************************************************************************* -ADev - -Input parameters: - X - sample - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - -Output parameters: - ADev- ADev - - -- ALGLIB -- - Copyright 06.09.2006 by Bochkanov Sergey -*************************************************************************/ -void sampleadev(/* Real */ ae_vector* x, - ae_int_t n, - double* adev, - ae_state *_state) -{ - ae_int_t i; - double mean; - - *adev = 0; - - ae_assert(n>=0, "SampleADev: N<0", _state); - ae_assert(x->cnt>=n, "SampleADev: Length(X)ptr.p_double[i]; - } - mean = mean/n; - - /* - * ADev - */ - for(i=0; i<=n-1; i++) - { - *adev = *adev+ae_fabs(x->ptr.p_double[i]-mean, _state); - } - *adev = *adev/n; -} - - -/************************************************************************* -Median calculation. - -Input parameters: - X - sample (array indexes: [0..N-1]) - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - -Output parameters: - Median - - -- ALGLIB -- - Copyright 06.09.2006 by Bochkanov Sergey -*************************************************************************/ -void samplemedian(/* Real */ ae_vector* x, - ae_int_t n, - double* median, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _x; - ae_int_t i; - ae_int_t ir; - ae_int_t j; - ae_int_t l; - ae_int_t midp; - ae_int_t k; - double a; - double tval; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_x, x, _state, ae_true); - x = &_x; - *median = 0; - - ae_assert(n>=0, "SampleMedian: N<0", _state); - ae_assert(x->cnt>=n, "SampleMedian: Length(X)ptr.p_double[0]; - ae_frame_leave(_state); - return; - } - if( n==2 ) - { - *median = 0.5*(x->ptr.p_double[0]+x->ptr.p_double[1]); - ae_frame_leave(_state); - return; - } - - /* - * Common case, N>=3. - * Choose X[(N-1)/2] - */ - l = 0; - ir = n-1; - k = (n-1)/2; - for(;;) - { - if( ir<=l+1 ) - { - - /* - * 1 or 2 elements in partition - */ - if( ir==l+1&&ae_fp_less(x->ptr.p_double[ir],x->ptr.p_double[l]) ) - { - tval = x->ptr.p_double[l]; - x->ptr.p_double[l] = x->ptr.p_double[ir]; - x->ptr.p_double[ir] = tval; - } - break; - } - else - { - midp = (l+ir)/2; - tval = x->ptr.p_double[midp]; - x->ptr.p_double[midp] = x->ptr.p_double[l+1]; - x->ptr.p_double[l+1] = tval; - if( ae_fp_greater(x->ptr.p_double[l],x->ptr.p_double[ir]) ) - { - tval = x->ptr.p_double[l]; - x->ptr.p_double[l] = x->ptr.p_double[ir]; - x->ptr.p_double[ir] = tval; - } - if( ae_fp_greater(x->ptr.p_double[l+1],x->ptr.p_double[ir]) ) - { - tval = x->ptr.p_double[l+1]; - x->ptr.p_double[l+1] = x->ptr.p_double[ir]; - x->ptr.p_double[ir] = tval; - } - if( ae_fp_greater(x->ptr.p_double[l],x->ptr.p_double[l+1]) ) - { - tval = x->ptr.p_double[l]; - x->ptr.p_double[l] = x->ptr.p_double[l+1]; - x->ptr.p_double[l+1] = tval; - } - i = l+1; - j = ir; - a = x->ptr.p_double[l+1]; - for(;;) - { - do - { - i = i+1; - } - while(ae_fp_less(x->ptr.p_double[i],a)); - do - { - j = j-1; - } - while(ae_fp_greater(x->ptr.p_double[j],a)); - if( jptr.p_double[i]; - x->ptr.p_double[i] = x->ptr.p_double[j]; - x->ptr.p_double[j] = tval; - } - x->ptr.p_double[l+1] = x->ptr.p_double[j]; - x->ptr.p_double[j] = a; - if( j>=k ) - { - ir = j-1; - } - if( j<=k ) - { - l = i; - } - } - } - - /* - * If N is odd, return result - */ - if( n%2==1 ) - { - *median = x->ptr.p_double[k]; - ae_frame_leave(_state); - return; - } - a = x->ptr.p_double[n-1]; - for(i=k+1; i<=n-1; i++) - { - if( ae_fp_less(x->ptr.p_double[i],a) ) - { - a = x->ptr.p_double[i]; - } - } - *median = 0.5*(x->ptr.p_double[k]+a); - ae_frame_leave(_state); -} - - -/************************************************************************* -Percentile calculation. - -Input parameters: - X - sample (array indexes: [0..N-1]) - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - P - percentile (0<=P<=1) - -Output parameters: - V - percentile - - -- ALGLIB -- - Copyright 01.03.2008 by Bochkanov Sergey -*************************************************************************/ -void samplepercentile(/* Real */ ae_vector* x, - ae_int_t n, - double p, - double* v, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _x; - ae_int_t i1; - double t; - ae_vector rbuf; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_x, x, _state, ae_true); - x = &_x; - *v = 0; - ae_vector_init(&rbuf, 0, DT_REAL, _state, ae_true); - - ae_assert(n>=0, "SamplePercentile: N<0", _state); - ae_assert(x->cnt>=n, "SamplePercentile: Length(X)ptr.p_double[0]; - ae_frame_leave(_state); - return; - } - if( ae_fp_eq(p,1) ) - { - *v = x->ptr.p_double[n-1]; - ae_frame_leave(_state); - return; - } - t = p*(n-1); - i1 = ae_ifloor(t, _state); - t = t-ae_ifloor(t, _state); - *v = x->ptr.p_double[i1]*(1-t)+x->ptr.p_double[i1+1]*t; - ae_frame_leave(_state); -} - - -/************************************************************************* -2-sample covariance - -Input parameters: - X - sample 1 (array indexes: [0..N-1]) - Y - sample 2 (array indexes: [0..N-1]) - N - N>=0, sample size: - * if given, only N leading elements of X/Y are processed - * if not given, automatically determined from input sizes - -Result: - covariance (zero for N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -double cov2(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_state *_state) -{ - ae_int_t i; - double xmean; - double ymean; - double v; - double x0; - double y0; - double s; - ae_bool samex; - ae_bool samey; - double result; - - - ae_assert(n>=0, "Cov2: N<0", _state); - ae_assert(x->cnt>=n, "Cov2: Length(X)cnt>=n, "Cov2: Length(Y)ptr.p_double[0]; - y0 = y->ptr.p_double[0]; - v = (double)1/(double)n; - for(i=0; i<=n-1; i++) - { - s = x->ptr.p_double[i]; - samex = samex&&ae_fp_eq(s,x0); - xmean = xmean+s*v; - s = y->ptr.p_double[i]; - samey = samey&&ae_fp_eq(s,y0); - ymean = ymean+s*v; - } - if( samex||samey ) - { - result = 0; - return result; - } - - /* - * covariance - */ - v = (double)1/(double)(n-1); - result = 0; - for(i=0; i<=n-1; i++) - { - result = result+v*(x->ptr.p_double[i]-xmean)*(y->ptr.p_double[i]-ymean); - } - return result; -} - - -/************************************************************************* -Pearson product-moment correlation coefficient - -Input parameters: - X - sample 1 (array indexes: [0..N-1]) - Y - sample 2 (array indexes: [0..N-1]) - N - N>=0, sample size: - * if given, only N leading elements of X/Y are processed - * if not given, automatically determined from input sizes - -Result: - Pearson product-moment correlation coefficient - (zero for N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -double pearsoncorr2(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_state *_state) -{ - ae_int_t i; - double xmean; - double ymean; - double v; - double x0; - double y0; - double s; - ae_bool samex; - ae_bool samey; - double xv; - double yv; - double t1; - double t2; - double result; - - - ae_assert(n>=0, "PearsonCorr2: N<0", _state); - ae_assert(x->cnt>=n, "PearsonCorr2: Length(X)cnt>=n, "PearsonCorr2: Length(Y)ptr.p_double[0]; - y0 = y->ptr.p_double[0]; - v = (double)1/(double)n; - for(i=0; i<=n-1; i++) - { - s = x->ptr.p_double[i]; - samex = samex&&ae_fp_eq(s,x0); - xmean = xmean+s*v; - s = y->ptr.p_double[i]; - samey = samey&&ae_fp_eq(s,y0); - ymean = ymean+s*v; - } - if( samex||samey ) - { - result = 0; - return result; - } - - /* - * numerator and denominator - */ - s = 0; - xv = 0; - yv = 0; - for(i=0; i<=n-1; i++) - { - t1 = x->ptr.p_double[i]-xmean; - t2 = y->ptr.p_double[i]-ymean; - xv = xv+ae_sqr(t1, _state); - yv = yv+ae_sqr(t2, _state); - s = s+t1*t2; - } - if( ae_fp_eq(xv,0)||ae_fp_eq(yv,0) ) - { - result = 0; - } - else - { - result = s/(ae_sqrt(xv, _state)*ae_sqrt(yv, _state)); - } - return result; -} - - -/************************************************************************* -Spearman's rank correlation coefficient - -Input parameters: - X - sample 1 (array indexes: [0..N-1]) - Y - sample 2 (array indexes: [0..N-1]) - N - N>=0, sample size: - * if given, only N leading elements of X/Y are processed - * if not given, automatically determined from input sizes - -Result: - Spearman's rank correlation coefficient - (zero for N=0 or N=1) - - -- ALGLIB -- - Copyright 09.04.2007 by Bochkanov Sergey -*************************************************************************/ -double spearmancorr2(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _x; - ae_vector _y; - apbuffers buf; - double result; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_x, x, _state, ae_true); - x = &_x; - ae_vector_init_copy(&_y, y, _state, ae_true); - y = &_y; - _apbuffers_init(&buf, _state, ae_true); - - ae_assert(n>=0, "SpearmanCorr2: N<0", _state); - ae_assert(x->cnt>=n, "SpearmanCorr2: Length(X)cnt>=n, "SpearmanCorr2: Length(Y)=0, number of observations: - * if given, only leading N rows of X are used - * if not given, automatically determined from input size - M - M>0, number of variables: - * if given, only leading M columns of X are used - * if not given, automatically determined from input size - -OUTPUT PARAMETERS: - C - array[M,M], covariance matrix (zero if N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -void covm(/* Real */ ae_matrix* x, - ae_int_t n, - ae_int_t m, - /* Real */ ae_matrix* c, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix _x; - ae_int_t i; - ae_int_t j; - double v; - ae_vector t; - ae_vector x0; - ae_vector same; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init_copy(&_x, x, _state, ae_true); - x = &_x; - ae_matrix_clear(c); - ae_vector_init(&t, 0, DT_REAL, _state, ae_true); - ae_vector_init(&x0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&same, 0, DT_BOOL, _state, ae_true); - - ae_assert(n>=0, "CovM: N<0", _state); - ae_assert(m>=1, "CovM: M<1", _state); - ae_assert(x->rows>=n, "CovM: Rows(X)cols>=m||n==0, "CovM: Cols(X)ptr.pp_double[i][j] = 0; - } - } - ae_frame_leave(_state); - return; - } - - /* - * Calculate means, - * check for constant columns - */ - ae_vector_set_length(&t, m, _state); - ae_vector_set_length(&x0, m, _state); - ae_vector_set_length(&same, m, _state); - ae_matrix_set_length(c, m, m, _state); - for(i=0; i<=m-1; i++) - { - t.ptr.p_double[i] = 0; - same.ptr.p_bool[i] = ae_true; - } - ae_v_move(&x0.ptr.p_double[0], 1, &x->ptr.pp_double[0][0], 1, ae_v_len(0,m-1)); - v = (double)1/(double)n; - for(i=0; i<=n-1; i++) - { - ae_v_addd(&t.ptr.p_double[0], 1, &x->ptr.pp_double[i][0], 1, ae_v_len(0,m-1), v); - for(j=0; j<=m-1; j++) - { - same.ptr.p_bool[j] = same.ptr.p_bool[j]&&ae_fp_eq(x->ptr.pp_double[i][j],x0.ptr.p_double[j]); - } - } - - /* - * * center variables; - * * if we have constant columns, these columns are - * artificially zeroed (they must be zero in exact arithmetics, - * but unfortunately floating point ops are not exact). - * * calculate upper half of symmetric covariance matrix - */ - for(i=0; i<=n-1; i++) - { - ae_v_sub(&x->ptr.pp_double[i][0], 1, &t.ptr.p_double[0], 1, ae_v_len(0,m-1)); - for(j=0; j<=m-1; j++) - { - if( same.ptr.p_bool[j] ) - { - x->ptr.pp_double[i][j] = 0; - } - } - } - rmatrixsyrk(m, n, (double)1/(double)(n-1), x, 0, 0, 1, 0.0, c, 0, 0, ae_true, _state); - rmatrixenforcesymmetricity(c, m, ae_true, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -void _pexec_covm(/* Real */ ae_matrix* x, - ae_int_t n, - ae_int_t m, - /* Real */ ae_matrix* c, ae_state *_state) -{ - covm(x,n,m,c, _state); -} - - -/************************************************************************* -Pearson product-moment correlation matrix - -SMP EDITION OF ALGLIB: - - ! This function can utilize multicore capabilities of your system. In - ! order to do this you have to call version with "smp_" prefix, which - ! indicates that multicore code will be used. - ! - ! This note is given for users of SMP edition; if you use GPL edition, - ! or commercial edition of ALGLIB without SMP support, you still will - ! be able to call smp-version of this function, but all computations - ! will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - ! - ! You should remember that starting/stopping worker thread always have - ! non-zero cost. Although multicore version is pretty efficient on - ! large problems, we do not recommend you to use it on small problems - - ! with correlation matrices smaller than 128*128. - -INPUT PARAMETERS: - X - array[N,M], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - N - N>=0, number of observations: - * if given, only leading N rows of X are used - * if not given, automatically determined from input size - M - M>0, number of variables: - * if given, only leading M columns of X are used - * if not given, automatically determined from input size - -OUTPUT PARAMETERS: - C - array[M,M], correlation matrix (zero if N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -void pearsoncorrm(/* Real */ ae_matrix* x, - ae_int_t n, - ae_int_t m, - /* Real */ ae_matrix* c, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector t; - ae_int_t i; - ae_int_t j; - double v; - - ae_frame_make(_state, &_frame_block); - ae_matrix_clear(c); - ae_vector_init(&t, 0, DT_REAL, _state, ae_true); - - ae_assert(n>=0, "PearsonCorrM: N<0", _state); - ae_assert(m>=1, "PearsonCorrM: M<1", _state); - ae_assert(x->rows>=n, "PearsonCorrM: Rows(X)cols>=m||n==0, "PearsonCorrM: Cols(X)ptr.pp_double[i][i],0) ) - { - t.ptr.p_double[i] = 1/ae_sqrt(c->ptr.pp_double[i][i], _state); - } - else - { - t.ptr.p_double[i] = 0.0; - } - } - for(i=0; i<=m-1; i++) - { - v = t.ptr.p_double[i]; - for(j=0; j<=m-1; j++) - { - c->ptr.pp_double[i][j] = c->ptr.pp_double[i][j]*v*t.ptr.p_double[j]; - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -void _pexec_pearsoncorrm(/* Real */ ae_matrix* x, - ae_int_t n, - ae_int_t m, - /* Real */ ae_matrix* c, ae_state *_state) -{ - pearsoncorrm(x,n,m,c, _state); -} - - -/************************************************************************* -Spearman's rank correlation matrix - -SMP EDITION OF ALGLIB: - - ! This function can utilize multicore capabilities of your system. In - ! order to do this you have to call version with "smp_" prefix, which - ! indicates that multicore code will be used. - ! - ! This note is given for users of SMP edition; if you use GPL edition, - ! or commercial edition of ALGLIB without SMP support, you still will - ! be able to call smp-version of this function, but all computations - ! will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - ! - ! You should remember that starting/stopping worker thread always have - ! non-zero cost. Although multicore version is pretty efficient on - ! large problems, we do not recommend you to use it on small problems - - ! with correlation matrices smaller than 128*128. - -INPUT PARAMETERS: - X - array[N,M], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - N - N>=0, number of observations: - * if given, only leading N rows of X are used - * if not given, automatically determined from input size - M - M>0, number of variables: - * if given, only leading M columns of X are used - * if not given, automatically determined from input size - -OUTPUT PARAMETERS: - C - array[M,M], correlation matrix (zero if N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -void spearmancorrm(/* Real */ ae_matrix* x, - ae_int_t n, - ae_int_t m, - /* Real */ ae_matrix* c, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - apbuffers buf; - ae_matrix xc; - ae_vector t; - double v; - double vv; - double x0; - ae_bool b; - - ae_frame_make(_state, &_frame_block); - ae_matrix_clear(c); - _apbuffers_init(&buf, _state, ae_true); - ae_matrix_init(&xc, 0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&t, 0, DT_REAL, _state, ae_true); - - ae_assert(n>=0, "SpearmanCorrM: N<0", _state); - ae_assert(m>=1, "SpearmanCorrM: M<1", _state); - ae_assert(x->rows>=n, "SpearmanCorrM: Rows(X)cols>=m||n==0, "SpearmanCorrM: Cols(X)ptr.pp_double[i][j] = 0; - } - } - ae_frame_leave(_state); - return; - } - - /* - * Allocate - */ - ae_vector_set_length(&t, ae_maxint(n, m, _state), _state); - ae_matrix_set_length(c, m, m, _state); - - /* - * Replace data with ranks - */ - ae_matrix_set_length(&xc, m, n, _state); - rmatrixtranspose(n, m, x, 0, 0, &xc, 0, 0, _state); - rankdata(&xc, m, n, _state); - - /* - * 1. Calculate means, check for constant columns - * 2. Center variables, constant columns are - * artificialy zeroed (they must be zero in exact arithmetics, - * but unfortunately floating point is not exact). - */ - for(i=0; i<=m-1; i++) - { - - /* - * Calculate: - * * V - mean value of I-th variable - * * B - True in case all variable values are same - */ - v = 0; - b = ae_true; - x0 = xc.ptr.pp_double[i][0]; - for(j=0; j<=n-1; j++) - { - vv = xc.ptr.pp_double[i][j]; - v = v+vv; - b = b&&ae_fp_eq(vv,x0); - } - v = v/n; - - /* - * Center/zero I-th variable - */ - if( b ) - { - - /* - * Zero - */ - for(j=0; j<=n-1; j++) - { - xc.ptr.pp_double[i][j] = 0.0; - } - } - else - { - - /* - * Center - */ - for(j=0; j<=n-1; j++) - { - xc.ptr.pp_double[i][j] = xc.ptr.pp_double[i][j]-v; - } - } - } - - /* - * Calculate upper half of symmetric covariance matrix - */ - rmatrixsyrk(m, n, (double)1/(double)(n-1), &xc, 0, 0, 0, 0.0, c, 0, 0, ae_true, _state); - - /* - * Calculate Pearson coefficients (upper triangle) - */ - for(i=0; i<=m-1; i++) - { - if( ae_fp_greater(c->ptr.pp_double[i][i],0) ) - { - t.ptr.p_double[i] = 1/ae_sqrt(c->ptr.pp_double[i][i], _state); - } - else - { - t.ptr.p_double[i] = 0.0; - } - } - for(i=0; i<=m-1; i++) - { - v = t.ptr.p_double[i]; - for(j=i; j<=m-1; j++) - { - c->ptr.pp_double[i][j] = c->ptr.pp_double[i][j]*v*t.ptr.p_double[j]; - } - } - - /* - * force symmetricity - */ - rmatrixenforcesymmetricity(c, m, ae_true, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -void _pexec_spearmancorrm(/* Real */ ae_matrix* x, - ae_int_t n, - ae_int_t m, - /* Real */ ae_matrix* c, ae_state *_state) -{ - spearmancorrm(x,n,m,c, _state); -} - - -/************************************************************************* -Cross-covariance matrix - -SMP EDITION OF ALGLIB: - - ! This function can utilize multicore capabilities of your system. In - ! order to do this you have to call version with "smp_" prefix, which - ! indicates that multicore code will be used. - ! - ! This note is given for users of SMP edition; if you use GPL edition, - ! or commercial edition of ALGLIB without SMP support, you still will - ! be able to call smp-version of this function, but all computations - ! will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - ! - ! You should remember that starting/stopping worker thread always have - ! non-zero cost. Although multicore version is pretty efficient on - ! large problems, we do not recommend you to use it on small problems - - ! with covariance matrices smaller than 128*128. - -INPUT PARAMETERS: - X - array[N,M1], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - Y - array[N,M2], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - N - N>=0, number of observations: - * if given, only leading N rows of X/Y are used - * if not given, automatically determined from input sizes - M1 - M1>0, number of variables in X: - * if given, only leading M1 columns of X are used - * if not given, automatically determined from input size - M2 - M2>0, number of variables in Y: - * if given, only leading M1 columns of X are used - * if not given, automatically determined from input size - -OUTPUT PARAMETERS: - C - array[M1,M2], cross-covariance matrix (zero if N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -void covm2(/* Real */ ae_matrix* x, - /* Real */ ae_matrix* y, - ae_int_t n, - ae_int_t m1, - ae_int_t m2, - /* Real */ ae_matrix* c, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix _x; - ae_matrix _y; - ae_int_t i; - ae_int_t j; - double v; - ae_vector t; - ae_vector x0; - ae_vector y0; - ae_vector samex; - ae_vector samey; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init_copy(&_x, x, _state, ae_true); - x = &_x; - ae_matrix_init_copy(&_y, y, _state, ae_true); - y = &_y; - ae_matrix_clear(c); - ae_vector_init(&t, 0, DT_REAL, _state, ae_true); - ae_vector_init(&x0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&y0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&samex, 0, DT_BOOL, _state, ae_true); - ae_vector_init(&samey, 0, DT_BOOL, _state, ae_true); - - ae_assert(n>=0, "CovM2: N<0", _state); - ae_assert(m1>=1, "CovM2: M1<1", _state); - ae_assert(m2>=1, "CovM2: M2<1", _state); - ae_assert(x->rows>=n, "CovM2: Rows(X)cols>=m1||n==0, "CovM2: Cols(X)rows>=n, "CovM2: Rows(Y)cols>=m2||n==0, "CovM2: Cols(Y)ptr.pp_double[i][j] = 0; - } - } - ae_frame_leave(_state); - return; - } - - /* - * Allocate - */ - ae_vector_set_length(&t, ae_maxint(m1, m2, _state), _state); - ae_vector_set_length(&x0, m1, _state); - ae_vector_set_length(&y0, m2, _state); - ae_vector_set_length(&samex, m1, _state); - ae_vector_set_length(&samey, m2, _state); - ae_matrix_set_length(c, m1, m2, _state); - - /* - * * calculate means of X - * * center X - * * if we have constant columns, these columns are - * artificially zeroed (they must be zero in exact arithmetics, - * but unfortunately floating point ops are not exact). - */ - for(i=0; i<=m1-1; i++) - { - t.ptr.p_double[i] = 0; - samex.ptr.p_bool[i] = ae_true; - } - ae_v_move(&x0.ptr.p_double[0], 1, &x->ptr.pp_double[0][0], 1, ae_v_len(0,m1-1)); - v = (double)1/(double)n; - for(i=0; i<=n-1; i++) - { - ae_v_addd(&t.ptr.p_double[0], 1, &x->ptr.pp_double[i][0], 1, ae_v_len(0,m1-1), v); - for(j=0; j<=m1-1; j++) - { - samex.ptr.p_bool[j] = samex.ptr.p_bool[j]&&ae_fp_eq(x->ptr.pp_double[i][j],x0.ptr.p_double[j]); - } - } - for(i=0; i<=n-1; i++) - { - ae_v_sub(&x->ptr.pp_double[i][0], 1, &t.ptr.p_double[0], 1, ae_v_len(0,m1-1)); - for(j=0; j<=m1-1; j++) - { - if( samex.ptr.p_bool[j] ) - { - x->ptr.pp_double[i][j] = 0; - } - } - } - - /* - * Repeat same steps for Y - */ - for(i=0; i<=m2-1; i++) - { - t.ptr.p_double[i] = 0; - samey.ptr.p_bool[i] = ae_true; - } - ae_v_move(&y0.ptr.p_double[0], 1, &y->ptr.pp_double[0][0], 1, ae_v_len(0,m2-1)); - v = (double)1/(double)n; - for(i=0; i<=n-1; i++) - { - ae_v_addd(&t.ptr.p_double[0], 1, &y->ptr.pp_double[i][0], 1, ae_v_len(0,m2-1), v); - for(j=0; j<=m2-1; j++) - { - samey.ptr.p_bool[j] = samey.ptr.p_bool[j]&&ae_fp_eq(y->ptr.pp_double[i][j],y0.ptr.p_double[j]); - } - } - for(i=0; i<=n-1; i++) - { - ae_v_sub(&y->ptr.pp_double[i][0], 1, &t.ptr.p_double[0], 1, ae_v_len(0,m2-1)); - for(j=0; j<=m2-1; j++) - { - if( samey.ptr.p_bool[j] ) - { - y->ptr.pp_double[i][j] = 0; - } - } - } - - /* - * calculate cross-covariance matrix - */ - rmatrixgemm(m1, m2, n, (double)1/(double)(n-1), x, 0, 0, 1, y, 0, 0, 0, 0.0, c, 0, 0, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -void _pexec_covm2(/* Real */ ae_matrix* x, - /* Real */ ae_matrix* y, - ae_int_t n, - ae_int_t m1, - ae_int_t m2, - /* Real */ ae_matrix* c, ae_state *_state) -{ - covm2(x,y,n,m1,m2,c, _state); -} - - -/************************************************************************* -Pearson product-moment cross-correlation matrix - -SMP EDITION OF ALGLIB: - - ! This function can utilize multicore capabilities of your system. In - ! order to do this you have to call version with "smp_" prefix, which - ! indicates that multicore code will be used. - ! - ! This note is given for users of SMP edition; if you use GPL edition, - ! or commercial edition of ALGLIB without SMP support, you still will - ! be able to call smp-version of this function, but all computations - ! will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - ! - ! You should remember that starting/stopping worker thread always have - ! non-zero cost. Although multicore version is pretty efficient on - ! large problems, we do not recommend you to use it on small problems - - ! with correlation matrices smaller than 128*128. - -INPUT PARAMETERS: - X - array[N,M1], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - Y - array[N,M2], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - N - N>=0, number of observations: - * if given, only leading N rows of X/Y are used - * if not given, automatically determined from input sizes - M1 - M1>0, number of variables in X: - * if given, only leading M1 columns of X are used - * if not given, automatically determined from input size - M2 - M2>0, number of variables in Y: - * if given, only leading M1 columns of X are used - * if not given, automatically determined from input size - -OUTPUT PARAMETERS: - C - array[M1,M2], cross-correlation matrix (zero if N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -void pearsoncorrm2(/* Real */ ae_matrix* x, - /* Real */ ae_matrix* y, - ae_int_t n, - ae_int_t m1, - ae_int_t m2, - /* Real */ ae_matrix* c, - ae_state *_state) -{ - ae_frame _frame_block; - ae_matrix _x; - ae_matrix _y; - ae_int_t i; - ae_int_t j; - double v; - ae_vector t; - ae_vector x0; - ae_vector y0; - ae_vector sx; - ae_vector sy; - ae_vector samex; - ae_vector samey; - - ae_frame_make(_state, &_frame_block); - ae_matrix_init_copy(&_x, x, _state, ae_true); - x = &_x; - ae_matrix_init_copy(&_y, y, _state, ae_true); - y = &_y; - ae_matrix_clear(c); - ae_vector_init(&t, 0, DT_REAL, _state, ae_true); - ae_vector_init(&x0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&y0, 0, DT_REAL, _state, ae_true); - ae_vector_init(&sx, 0, DT_REAL, _state, ae_true); - ae_vector_init(&sy, 0, DT_REAL, _state, ae_true); - ae_vector_init(&samex, 0, DT_BOOL, _state, ae_true); - ae_vector_init(&samey, 0, DT_BOOL, _state, ae_true); - - ae_assert(n>=0, "PearsonCorrM2: N<0", _state); - ae_assert(m1>=1, "PearsonCorrM2: M1<1", _state); - ae_assert(m2>=1, "PearsonCorrM2: M2<1", _state); - ae_assert(x->rows>=n, "PearsonCorrM2: Rows(X)cols>=m1||n==0, "PearsonCorrM2: Cols(X)rows>=n, "PearsonCorrM2: Rows(Y)cols>=m2||n==0, "PearsonCorrM2: Cols(Y)ptr.pp_double[i][j] = 0; - } - } - ae_frame_leave(_state); - return; - } - - /* - * Allocate - */ - ae_vector_set_length(&t, ae_maxint(m1, m2, _state), _state); - ae_vector_set_length(&x0, m1, _state); - ae_vector_set_length(&y0, m2, _state); - ae_vector_set_length(&sx, m1, _state); - ae_vector_set_length(&sy, m2, _state); - ae_vector_set_length(&samex, m1, _state); - ae_vector_set_length(&samey, m2, _state); - ae_matrix_set_length(c, m1, m2, _state); - - /* - * * calculate means of X - * * center X - * * if we have constant columns, these columns are - * artificially zeroed (they must be zero in exact arithmetics, - * but unfortunately floating point ops are not exact). - * * calculate column variances - */ - for(i=0; i<=m1-1; i++) - { - t.ptr.p_double[i] = 0; - samex.ptr.p_bool[i] = ae_true; - sx.ptr.p_double[i] = 0; - } - ae_v_move(&x0.ptr.p_double[0], 1, &x->ptr.pp_double[0][0], 1, ae_v_len(0,m1-1)); - v = (double)1/(double)n; - for(i=0; i<=n-1; i++) - { - ae_v_addd(&t.ptr.p_double[0], 1, &x->ptr.pp_double[i][0], 1, ae_v_len(0,m1-1), v); - for(j=0; j<=m1-1; j++) - { - samex.ptr.p_bool[j] = samex.ptr.p_bool[j]&&ae_fp_eq(x->ptr.pp_double[i][j],x0.ptr.p_double[j]); - } - } - for(i=0; i<=n-1; i++) - { - ae_v_sub(&x->ptr.pp_double[i][0], 1, &t.ptr.p_double[0], 1, ae_v_len(0,m1-1)); - for(j=0; j<=m1-1; j++) - { - if( samex.ptr.p_bool[j] ) - { - x->ptr.pp_double[i][j] = 0; - } - sx.ptr.p_double[j] = sx.ptr.p_double[j]+x->ptr.pp_double[i][j]*x->ptr.pp_double[i][j]; - } - } - for(j=0; j<=m1-1; j++) - { - sx.ptr.p_double[j] = ae_sqrt(sx.ptr.p_double[j]/(n-1), _state); - } - - /* - * Repeat same steps for Y - */ - for(i=0; i<=m2-1; i++) - { - t.ptr.p_double[i] = 0; - samey.ptr.p_bool[i] = ae_true; - sy.ptr.p_double[i] = 0; - } - ae_v_move(&y0.ptr.p_double[0], 1, &y->ptr.pp_double[0][0], 1, ae_v_len(0,m2-1)); - v = (double)1/(double)n; - for(i=0; i<=n-1; i++) - { - ae_v_addd(&t.ptr.p_double[0], 1, &y->ptr.pp_double[i][0], 1, ae_v_len(0,m2-1), v); - for(j=0; j<=m2-1; j++) - { - samey.ptr.p_bool[j] = samey.ptr.p_bool[j]&&ae_fp_eq(y->ptr.pp_double[i][j],y0.ptr.p_double[j]); - } - } - for(i=0; i<=n-1; i++) - { - ae_v_sub(&y->ptr.pp_double[i][0], 1, &t.ptr.p_double[0], 1, ae_v_len(0,m2-1)); - for(j=0; j<=m2-1; j++) - { - if( samey.ptr.p_bool[j] ) - { - y->ptr.pp_double[i][j] = 0; - } - sy.ptr.p_double[j] = sy.ptr.p_double[j]+y->ptr.pp_double[i][j]*y->ptr.pp_double[i][j]; - } - } - for(j=0; j<=m2-1; j++) - { - sy.ptr.p_double[j] = ae_sqrt(sy.ptr.p_double[j]/(n-1), _state); - } - - /* - * calculate cross-covariance matrix - */ - rmatrixgemm(m1, m2, n, (double)1/(double)(n-1), x, 0, 0, 1, y, 0, 0, 0, 0.0, c, 0, 0, _state); - - /* - * Divide by standard deviations - */ - for(i=0; i<=m1-1; i++) - { - if( ae_fp_neq(sx.ptr.p_double[i],0) ) - { - sx.ptr.p_double[i] = 1/sx.ptr.p_double[i]; - } - else - { - sx.ptr.p_double[i] = 0.0; - } - } - for(i=0; i<=m2-1; i++) - { - if( ae_fp_neq(sy.ptr.p_double[i],0) ) - { - sy.ptr.p_double[i] = 1/sy.ptr.p_double[i]; - } - else - { - sy.ptr.p_double[i] = 0.0; - } - } - for(i=0; i<=m1-1; i++) - { - v = sx.ptr.p_double[i]; - for(j=0; j<=m2-1; j++) - { - c->ptr.pp_double[i][j] = c->ptr.pp_double[i][j]*v*sy.ptr.p_double[j]; - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -void _pexec_pearsoncorrm2(/* Real */ ae_matrix* x, - /* Real */ ae_matrix* y, - ae_int_t n, - ae_int_t m1, - ae_int_t m2, - /* Real */ ae_matrix* c, ae_state *_state) -{ - pearsoncorrm2(x,y,n,m1,m2,c, _state); -} - - -/************************************************************************* -Spearman's rank cross-correlation matrix - -SMP EDITION OF ALGLIB: - - ! This function can utilize multicore capabilities of your system. In - ! order to do this you have to call version with "smp_" prefix, which - ! indicates that multicore code will be used. - ! - ! This note is given for users of SMP edition; if you use GPL edition, - ! or commercial edition of ALGLIB without SMP support, you still will - ! be able to call smp-version of this function, but all computations - ! will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - ! - ! You should remember that starting/stopping worker thread always have - ! non-zero cost. Although multicore version is pretty efficient on - ! large problems, we do not recommend you to use it on small problems - - ! with correlation matrices smaller than 128*128. - -INPUT PARAMETERS: - X - array[N,M1], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - Y - array[N,M2], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - N - N>=0, number of observations: - * if given, only leading N rows of X/Y are used - * if not given, automatically determined from input sizes - M1 - M1>0, number of variables in X: - * if given, only leading M1 columns of X are used - * if not given, automatically determined from input size - M2 - M2>0, number of variables in Y: - * if given, only leading M1 columns of X are used - * if not given, automatically determined from input size - -OUTPUT PARAMETERS: - C - array[M1,M2], cross-correlation matrix (zero if N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -void spearmancorrm2(/* Real */ ae_matrix* x, - /* Real */ ae_matrix* y, - ae_int_t n, - ae_int_t m1, - ae_int_t m2, - /* Real */ ae_matrix* c, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - double v; - double v2; - double vv; - ae_bool b; - ae_vector t; - double x0; - double y0; - ae_vector sx; - ae_vector sy; - ae_matrix xc; - ae_matrix yc; - apbuffers buf; - - ae_frame_make(_state, &_frame_block); - ae_matrix_clear(c); - ae_vector_init(&t, 0, DT_REAL, _state, ae_true); - ae_vector_init(&sx, 0, DT_REAL, _state, ae_true); - ae_vector_init(&sy, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&xc, 0, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&yc, 0, 0, DT_REAL, _state, ae_true); - _apbuffers_init(&buf, _state, ae_true); - - ae_assert(n>=0, "SpearmanCorrM2: N<0", _state); - ae_assert(m1>=1, "SpearmanCorrM2: M1<1", _state); - ae_assert(m2>=1, "SpearmanCorrM2: M2<1", _state); - ae_assert(x->rows>=n, "SpearmanCorrM2: Rows(X)cols>=m1||n==0, "SpearmanCorrM2: Cols(X)rows>=n, "SpearmanCorrM2: Rows(Y)cols>=m2||n==0, "SpearmanCorrM2: Cols(Y)ptr.pp_double[i][j] = 0; - } - } - ae_frame_leave(_state); - return; - } - - /* - * Allocate - */ - ae_vector_set_length(&t, ae_maxint(ae_maxint(m1, m2, _state), n, _state), _state); - ae_vector_set_length(&sx, m1, _state); - ae_vector_set_length(&sy, m2, _state); - ae_matrix_set_length(c, m1, m2, _state); - - /* - * Replace data with ranks - */ - ae_matrix_set_length(&xc, m1, n, _state); - ae_matrix_set_length(&yc, m2, n, _state); - rmatrixtranspose(n, m1, x, 0, 0, &xc, 0, 0, _state); - rmatrixtranspose(n, m2, y, 0, 0, &yc, 0, 0, _state); - rankdata(&xc, m1, n, _state); - rankdata(&yc, m2, n, _state); - - /* - * 1. Calculate means, variances, check for constant columns - * 2. Center variables, constant columns are - * artificialy zeroed (they must be zero in exact arithmetics, - * but unfortunately floating point is not exact). - * - * Description of variables: - * * V - mean value of I-th variable - * * V2- variance - * * VV-temporary - * * B - True in case all variable values are same - */ - for(i=0; i<=m1-1; i++) - { - v = 0; - v2 = 0.0; - b = ae_true; - x0 = xc.ptr.pp_double[i][0]; - for(j=0; j<=n-1; j++) - { - vv = xc.ptr.pp_double[i][j]; - v = v+vv; - b = b&&ae_fp_eq(vv,x0); - } - v = v/n; - if( b ) - { - for(j=0; j<=n-1; j++) - { - xc.ptr.pp_double[i][j] = 0.0; - } - } - else - { - for(j=0; j<=n-1; j++) - { - vv = xc.ptr.pp_double[i][j]; - xc.ptr.pp_double[i][j] = vv-v; - v2 = v2+(vv-v)*(vv-v); - } - } - sx.ptr.p_double[i] = ae_sqrt(v2/(n-1), _state); - } - for(i=0; i<=m2-1; i++) - { - v = 0; - v2 = 0.0; - b = ae_true; - y0 = yc.ptr.pp_double[i][0]; - for(j=0; j<=n-1; j++) - { - vv = yc.ptr.pp_double[i][j]; - v = v+vv; - b = b&&ae_fp_eq(vv,y0); - } - v = v/n; - if( b ) - { - for(j=0; j<=n-1; j++) - { - yc.ptr.pp_double[i][j] = 0.0; - } - } - else - { - for(j=0; j<=n-1; j++) - { - vv = yc.ptr.pp_double[i][j]; - yc.ptr.pp_double[i][j] = vv-v; - v2 = v2+(vv-v)*(vv-v); - } - } - sy.ptr.p_double[i] = ae_sqrt(v2/(n-1), _state); - } - - /* - * calculate cross-covariance matrix - */ - rmatrixgemm(m1, m2, n, (double)1/(double)(n-1), &xc, 0, 0, 0, &yc, 0, 0, 1, 0.0, c, 0, 0, _state); - - /* - * Divide by standard deviations - */ - for(i=0; i<=m1-1; i++) - { - if( ae_fp_neq(sx.ptr.p_double[i],0) ) - { - sx.ptr.p_double[i] = 1/sx.ptr.p_double[i]; - } - else - { - sx.ptr.p_double[i] = 0.0; - } - } - for(i=0; i<=m2-1; i++) - { - if( ae_fp_neq(sy.ptr.p_double[i],0) ) - { - sy.ptr.p_double[i] = 1/sy.ptr.p_double[i]; - } - else - { - sy.ptr.p_double[i] = 0.0; - } - } - for(i=0; i<=m1-1; i++) - { - v = sx.ptr.p_double[i]; - for(j=0; j<=m2-1; j++) - { - c->ptr.pp_double[i][j] = c->ptr.pp_double[i][j]*v*sy.ptr.p_double[j]; - } - } - ae_frame_leave(_state); -} - - -/************************************************************************* -Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. -*************************************************************************/ -void _pexec_spearmancorrm2(/* Real */ ae_matrix* x, - /* Real */ ae_matrix* y, - ae_int_t n, - ae_int_t m1, - ae_int_t m2, - /* Real */ ae_matrix* c, ae_state *_state) -{ - spearmancorrm2(x,y,n,m1,m2,c, _state); -} - - -void rankdata(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nfeatures, - ae_state *_state) -{ - ae_frame _frame_block; - apbuffers buf0; - apbuffers buf1; - ae_int_t basecasecost; - ae_shared_pool pool; - - ae_frame_make(_state, &_frame_block); - _apbuffers_init(&buf0, _state, ae_true); - _apbuffers_init(&buf1, _state, ae_true); - ae_shared_pool_init(&pool, _state, ae_true); - - ae_assert(npoints>=0, "RankData: NPoints<0", _state); - ae_assert(nfeatures>=1, "RankData: NFeatures<1", _state); - ae_assert(xy->rows>=npoints, "RankData: Rows(XY)cols>=nfeatures||npoints==0, "RankData: Cols(XY)=0, "RankData: NPoints<0", _state); - ae_assert(nfeatures>=1, "RankData: NFeatures<1", _state); - ae_assert(xy->rows>=npoints, "RankData: Rows(XY)cols>=nfeatures||npoints==0, "RankData: Cols(XY)=i0, "RankDataRec: internal error", _state); - - /* - * Recursively split problem, if it is too large - */ - problemcost = inttoreal(i1-i0, _state)*inttoreal(nfeatures, _state)*log2(nfeatures, _state); - if( i1-i0>=2&&ae_fp_greater(problemcost,basecasecost) ) - { - im = (i1+i0)/2; - basestat_rankdatarec(xy, i0, im, nfeatures, iscentered, pool, basecasecost, _state); - basestat_rankdatarec(xy, im, i1, nfeatures, iscentered, pool, basecasecost, _state); - ae_frame_leave(_state); - return; - } - - /* - * Retrieve buffers from pool, call serial code, return buffers to pool - */ - ae_shared_pool_retrieve(pool, &_buf0, _state); - ae_shared_pool_retrieve(pool, &_buf1, _state); - basestat_rankdatabasecase(xy, i0, i1, nfeatures, iscentered, buf0, buf1, _state); - ae_shared_pool_recycle(pool, &_buf0, _state); - ae_shared_pool_recycle(pool, &_buf1, _state); - ae_frame_leave(_state); -} - - -static void basestat_rankdatabasecase(/* Real */ ae_matrix* xy, - ae_int_t i0, - ae_int_t i1, - ae_int_t nfeatures, - ae_bool iscentered, - apbuffers* buf0, - apbuffers* buf1, - ae_state *_state) -{ - ae_int_t i; - - - ae_assert(i1>=i0, "RankDataBasecase: internal error", _state); - if( buf1->ra0.cntra0, nfeatures, _state); - } - for(i=i0; i<=i1-1; i++) - { - ae_v_move(&buf1->ra0.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nfeatures-1)); - rankx(&buf1->ra0, nfeatures, iscentered, buf0, _state); - ae_v_move(&xy->ptr.pp_double[i][0], 1, &buf1->ra0.ptr.p_double[0], 1, ae_v_len(0,nfeatures-1)); - } -} - - - - -/************************************************************************* -Pearson's correlation coefficient significance test - -This test checks hypotheses about whether X and Y are samples of two -continuous distributions having zero correlation or whether their -correlation is non-zero. - -The following tests are performed: - * two-tailed test (null hypothesis - X and Y have zero correlation) - * left-tailed test (null hypothesis - the correlation coefficient is - greater than or equal to 0) - * right-tailed test (null hypothesis - the correlation coefficient is - less than or equal to 0). - -Requirements: - * the number of elements in each sample is not less than 5 - * normality of distributions of X and Y. - -Input parameters: - R - Pearson's correlation coefficient for X and Y - N - number of elements in samples, N>=5. - -Output parameters: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - - -- ALGLIB -- - Copyright 09.04.2007 by Bochkanov Sergey -*************************************************************************/ -void pearsoncorrelationsignificance(double r, - ae_int_t n, - double* bothtails, - double* lefttail, - double* righttail, - ae_state *_state) -{ - double t; - double p; - - *bothtails = 0; - *lefttail = 0; - *righttail = 0; - - - /* - * Some special cases - */ - if( ae_fp_greater_eq(r,1) ) - { - *bothtails = 0.0; - *lefttail = 1.0; - *righttail = 0.0; - return; - } - if( ae_fp_less_eq(r,-1) ) - { - *bothtails = 0.0; - *lefttail = 0.0; - *righttail = 1.0; - return; - } - if( n<5 ) - { - *bothtails = 1.0; - *lefttail = 1.0; - *righttail = 1.0; - return; - } - - /* - * General case - */ - t = r*ae_sqrt((n-2)/(1-ae_sqr(r, _state)), _state); - p = studenttdistribution(n-2, t, _state); - *bothtails = 2*ae_minreal(p, 1-p, _state); - *lefttail = p; - *righttail = 1-p; -} - - -/************************************************************************* -Spearman's rank correlation coefficient significance test - -This test checks hypotheses about whether X and Y are samples of two -continuous distributions having zero correlation or whether their -correlation is non-zero. - -The following tests are performed: - * two-tailed test (null hypothesis - X and Y have zero correlation) - * left-tailed test (null hypothesis - the correlation coefficient is - greater than or equal to 0) - * right-tailed test (null hypothesis - the correlation coefficient is - less than or equal to 0). - -Requirements: - * the number of elements in each sample is not less than 5. - -The test is non-parametric and doesn't require distributions X and Y to be -normal. - -Input parameters: - R - Spearman's rank correlation coefficient for X and Y - N - number of elements in samples, N>=5. - -Output parameters: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - - -- ALGLIB -- - Copyright 09.04.2007 by Bochkanov Sergey -*************************************************************************/ -void spearmanrankcorrelationsignificance(double r, - ae_int_t n, - double* bothtails, - double* lefttail, - double* righttail, - ae_state *_state) -{ - double t; - double p; - - *bothtails = 0; - *lefttail = 0; - *righttail = 0; - - - /* - * Special case - */ - if( n<5 ) - { - *bothtails = 1.0; - *lefttail = 1.0; - *righttail = 1.0; - return; - } - - /* - * General case - */ - if( ae_fp_greater_eq(r,1) ) - { - t = 1.0E10; - } - else - { - if( ae_fp_less_eq(r,-1) ) - { - t = -1.0E10; - } - else - { - t = r*ae_sqrt((n-2)/(1-ae_sqr(r, _state)), _state); - } - } - if( ae_fp_less(t,0) ) - { - p = correlationtests_spearmantail(t, n, _state); - *bothtails = 2*p; - *lefttail = p; - *righttail = 1-p; - } - else - { - p = correlationtests_spearmantail(-t, n, _state); - *bothtails = 2*p; - *lefttail = 1-p; - *righttail = p; - } -} - - -/************************************************************************* -Tail(S, 5) -*************************************************************************/ -static double correlationtests_spearmantail5(double s, ae_state *_state) -{ - double result; - - - if( ae_fp_less(s,0.000e+00) ) - { - result = studenttdistribution(3, -s, _state); - return result; - } - if( ae_fp_greater_eq(s,3.580e+00) ) - { - result = 8.304e-03; - return result; - } - if( ae_fp_greater_eq(s,2.322e+00) ) - { - result = 4.163e-02; - return result; - } - if( ae_fp_greater_eq(s,1.704e+00) ) - { - result = 6.641e-02; - return result; - } - if( ae_fp_greater_eq(s,1.303e+00) ) - { - result = 1.164e-01; - return result; - } - if( ae_fp_greater_eq(s,1.003e+00) ) - { - result = 1.748e-01; - return result; - } - if( ae_fp_greater_eq(s,7.584e-01) ) - { - result = 2.249e-01; - return result; - } - if( ae_fp_greater_eq(s,5.468e-01) ) - { - result = 2.581e-01; - return result; - } - if( ae_fp_greater_eq(s,3.555e-01) ) - { - result = 3.413e-01; - return result; - } - if( ae_fp_greater_eq(s,1.759e-01) ) - { - result = 3.911e-01; - return result; - } - if( ae_fp_greater_eq(s,1.741e-03) ) - { - result = 4.747e-01; - return result; - } - if( ae_fp_greater_eq(s,0.000e+00) ) - { - result = 5.248e-01; - return result; - } - result = 0; - return result; -} - - -/************************************************************************* -Tail(S, 6) -*************************************************************************/ -static double correlationtests_spearmantail6(double s, ae_state *_state) -{ - double result; - - - if( ae_fp_less(s,1.001e+00) ) - { - result = studenttdistribution(4, -s, _state); - return result; - } - if( ae_fp_greater_eq(s,5.663e+00) ) - { - result = 1.366e-03; - return result; - } - if( ae_fp_greater_eq(s,3.834e+00) ) - { - result = 8.350e-03; - return result; - } - if( ae_fp_greater_eq(s,2.968e+00) ) - { - result = 1.668e-02; - return result; - } - if( ae_fp_greater_eq(s,2.430e+00) ) - { - result = 2.921e-02; - return result; - } - if( ae_fp_greater_eq(s,2.045e+00) ) - { - result = 5.144e-02; - return result; - } - if( ae_fp_greater_eq(s,1.747e+00) ) - { - result = 6.797e-02; - return result; - } - if( ae_fp_greater_eq(s,1.502e+00) ) - { - result = 8.752e-02; - return result; - } - if( ae_fp_greater_eq(s,1.295e+00) ) - { - result = 1.210e-01; - return result; - } - if( ae_fp_greater_eq(s,1.113e+00) ) - { - result = 1.487e-01; - return result; - } - if( ae_fp_greater_eq(s,1.001e+00) ) - { - result = 1.780e-01; - return result; - } - result = 0; - return result; -} - - -/************************************************************************* -Tail(S, 7) -*************************************************************************/ -static double correlationtests_spearmantail7(double s, ae_state *_state) -{ - double result; - - - if( ae_fp_less(s,1.001e+00) ) - { - result = studenttdistribution(5, -s, _state); - return result; - } - if( ae_fp_greater_eq(s,8.159e+00) ) - { - result = 2.081e-04; - return result; - } - if( ae_fp_greater_eq(s,5.620e+00) ) - { - result = 1.393e-03; - return result; - } - if( ae_fp_greater_eq(s,4.445e+00) ) - { - result = 3.398e-03; - return result; - } - if( ae_fp_greater_eq(s,3.728e+00) ) - { - result = 6.187e-03; - return result; - } - if( ae_fp_greater_eq(s,3.226e+00) ) - { - result = 1.200e-02; - return result; - } - if( ae_fp_greater_eq(s,2.844e+00) ) - { - result = 1.712e-02; - return result; - } - if( ae_fp_greater_eq(s,2.539e+00) ) - { - result = 2.408e-02; - return result; - } - if( ae_fp_greater_eq(s,2.285e+00) ) - { - result = 3.320e-02; - return result; - } - if( ae_fp_greater_eq(s,2.068e+00) ) - { - result = 4.406e-02; - return result; - } - if( ae_fp_greater_eq(s,1.879e+00) ) - { - result = 5.478e-02; - return result; - } - if( ae_fp_greater_eq(s,1.710e+00) ) - { - result = 6.946e-02; - return result; - } - if( ae_fp_greater_eq(s,1.559e+00) ) - { - result = 8.331e-02; - return result; - } - if( ae_fp_greater_eq(s,1.420e+00) ) - { - result = 1.001e-01; - return result; - } - if( ae_fp_greater_eq(s,1.292e+00) ) - { - result = 1.180e-01; - return result; - } - if( ae_fp_greater_eq(s,1.173e+00) ) - { - result = 1.335e-01; - return result; - } - if( ae_fp_greater_eq(s,1.062e+00) ) - { - result = 1.513e-01; - return result; - } - if( ae_fp_greater_eq(s,1.001e+00) ) - { - result = 1.770e-01; - return result; - } - result = 0; - return result; -} - - -/************************************************************************* -Tail(S, 8) -*************************************************************************/ -static double correlationtests_spearmantail8(double s, ae_state *_state) -{ - double result; - - - if( ae_fp_less(s,2.001e+00) ) - { - result = studenttdistribution(6, -s, _state); - return result; - } - if( ae_fp_greater_eq(s,1.103e+01) ) - { - result = 2.194e-05; - return result; - } - if( ae_fp_greater_eq(s,7.685e+00) ) - { - result = 2.008e-04; - return result; - } - if( ae_fp_greater_eq(s,6.143e+00) ) - { - result = 5.686e-04; - return result; - } - if( ae_fp_greater_eq(s,5.213e+00) ) - { - result = 1.138e-03; - return result; - } - if( ae_fp_greater_eq(s,4.567e+00) ) - { - result = 2.310e-03; - return result; - } - if( ae_fp_greater_eq(s,4.081e+00) ) - { - result = 3.634e-03; - return result; - } - if( ae_fp_greater_eq(s,3.697e+00) ) - { - result = 5.369e-03; - return result; - } - if( ae_fp_greater_eq(s,3.381e+00) ) - { - result = 7.708e-03; - return result; - } - if( ae_fp_greater_eq(s,3.114e+00) ) - { - result = 1.087e-02; - return result; - } - if( ae_fp_greater_eq(s,2.884e+00) ) - { - result = 1.397e-02; - return result; - } - if( ae_fp_greater_eq(s,2.682e+00) ) - { - result = 1.838e-02; - return result; - } - if( ae_fp_greater_eq(s,2.502e+00) ) - { - result = 2.288e-02; - return result; - } - if( ae_fp_greater_eq(s,2.340e+00) ) - { - result = 2.883e-02; - return result; - } - if( ae_fp_greater_eq(s,2.192e+00) ) - { - result = 3.469e-02; - return result; - } - if( ae_fp_greater_eq(s,2.057e+00) ) - { - result = 4.144e-02; - return result; - } - if( ae_fp_greater_eq(s,2.001e+00) ) - { - result = 4.804e-02; - return result; - } - result = 0; - return result; -} - - -/************************************************************************* -Tail(S, 9) -*************************************************************************/ -static double correlationtests_spearmantail9(double s, ae_state *_state) -{ - double result; - - - if( ae_fp_less(s,2.001e+00) ) - { - result = studenttdistribution(7, -s, _state); - return result; - } - if( ae_fp_greater_eq(s,9.989e+00) ) - { - result = 2.306e-05; - return result; - } - if( ae_fp_greater_eq(s,8.069e+00) ) - { - result = 8.167e-05; - return result; - } - if( ae_fp_greater_eq(s,6.890e+00) ) - { - result = 1.744e-04; - return result; - } - if( ae_fp_greater_eq(s,6.077e+00) ) - { - result = 3.625e-04; - return result; - } - if( ae_fp_greater_eq(s,5.469e+00) ) - { - result = 6.450e-04; - return result; - } - if( ae_fp_greater_eq(s,4.991e+00) ) - { - result = 1.001e-03; - return result; - } - if( ae_fp_greater_eq(s,4.600e+00) ) - { - result = 1.514e-03; - return result; - } - if( ae_fp_greater_eq(s,4.272e+00) ) - { - result = 2.213e-03; - return result; - } - if( ae_fp_greater_eq(s,3.991e+00) ) - { - result = 2.990e-03; - return result; - } - if( ae_fp_greater_eq(s,3.746e+00) ) - { - result = 4.101e-03; - return result; - } - if( ae_fp_greater_eq(s,3.530e+00) ) - { - result = 5.355e-03; - return result; - } - if( ae_fp_greater_eq(s,3.336e+00) ) - { - result = 6.887e-03; - return result; - } - if( ae_fp_greater_eq(s,3.161e+00) ) - { - result = 8.598e-03; - return result; - } - if( ae_fp_greater_eq(s,3.002e+00) ) - { - result = 1.065e-02; - return result; - } - if( ae_fp_greater_eq(s,2.855e+00) ) - { - result = 1.268e-02; - return result; - } - if( ae_fp_greater_eq(s,2.720e+00) ) - { - result = 1.552e-02; - return result; - } - if( ae_fp_greater_eq(s,2.595e+00) ) - { - result = 1.836e-02; - return result; - } - if( ae_fp_greater_eq(s,2.477e+00) ) - { - result = 2.158e-02; - return result; - } - if( ae_fp_greater_eq(s,2.368e+00) ) - { - result = 2.512e-02; - return result; - } - if( ae_fp_greater_eq(s,2.264e+00) ) - { - result = 2.942e-02; - return result; - } - if( ae_fp_greater_eq(s,2.166e+00) ) - { - result = 3.325e-02; - return result; - } - if( ae_fp_greater_eq(s,2.073e+00) ) - { - result = 3.800e-02; - return result; - } - if( ae_fp_greater_eq(s,2.001e+00) ) - { - result = 4.285e-02; - return result; - } - result = 0; - return result; -} - - -/************************************************************************* -Tail(T,N), accepts T<0 -*************************************************************************/ -static double correlationtests_spearmantail(double t, - ae_int_t n, - ae_state *_state) -{ - double result; - - - if( n==5 ) - { - result = correlationtests_spearmantail5(-t, _state); - return result; - } - if( n==6 ) - { - result = correlationtests_spearmantail6(-t, _state); - return result; - } - if( n==7 ) - { - result = correlationtests_spearmantail7(-t, _state); - return result; - } - if( n==8 ) - { - result = correlationtests_spearmantail8(-t, _state); - return result; - } - if( n==9 ) - { - result = correlationtests_spearmantail9(-t, _state); - return result; - } - result = studenttdistribution(n-2, t, _state); - return result; -} - - - - -/************************************************************************* -Jarque-Bera test - -This test checks hypotheses about the fact that a given sample X is a -sample of normal random variable. - -Requirements: - * the number of elements in the sample is not less than 5. - -Input parameters: - X - sample. Array whose index goes from 0 to N-1. - N - size of the sample. N>=5 - -Output parameters: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - -Accuracy of the approximation used (5<=N<=1951): - -p-value relative error (5<=N<=1951) -[1, 0.1] < 1% -[0.1, 0.01] < 2% -[0.01, 0.001] < 6% -[0.001, 0] wasn't measured - -For N>1951 accuracy wasn't measured but it shouldn't be sharply different -from table values. - - -- ALGLIB -- - Copyright 09.04.2007 by Bochkanov Sergey -*************************************************************************/ -void jarqueberatest(/* Real */ ae_vector* x, - ae_int_t n, - double* p, - ae_state *_state) -{ - double s; - - *p = 0; - - - /* - * N is too small - */ - if( n<5 ) - { - *p = 1.0; - return; - } - - /* - * N is large enough - */ - jarquebera_jarqueberastatistic(x, n, &s, _state); - *p = jarquebera_jarqueberaapprox(n, s, _state); -} - - -static void jarquebera_jarqueberastatistic(/* Real */ ae_vector* x, - ae_int_t n, - double* s, - ae_state *_state) -{ - ae_int_t i; - double v; - double v1; - double v2; - double stddev; - double mean; - double variance; - double skewness; - double kurtosis; - - *s = 0; - - mean = 0; - variance = 0; - skewness = 0; - kurtosis = 0; - stddev = 0; - ae_assert(n>1, "Assertion failed", _state); - - /* - * Mean - */ - for(i=0; i<=n-1; i++) - { - mean = mean+x->ptr.p_double[i]; - } - mean = mean/n; - - /* - * Variance (using corrected two-pass algorithm) - */ - if( n!=1 ) - { - v1 = 0; - for(i=0; i<=n-1; i++) - { - v1 = v1+ae_sqr(x->ptr.p_double[i]-mean, _state); - } - v2 = 0; - for(i=0; i<=n-1; i++) - { - v2 = v2+(x->ptr.p_double[i]-mean); - } - v2 = ae_sqr(v2, _state)/n; - variance = (v1-v2)/(n-1); - if( ae_fp_less(variance,0) ) - { - variance = 0; - } - stddev = ae_sqrt(variance, _state); - } - - /* - * Skewness and kurtosis - */ - if( ae_fp_neq(stddev,0) ) - { - for(i=0; i<=n-1; i++) - { - v = (x->ptr.p_double[i]-mean)/stddev; - v2 = ae_sqr(v, _state); - skewness = skewness+v2*v; - kurtosis = kurtosis+ae_sqr(v2, _state); - } - skewness = skewness/n; - kurtosis = kurtosis/n-3; - } - - /* - * Statistic - */ - *s = (double)n/(double)6*(ae_sqr(skewness, _state)+ae_sqr(kurtosis, _state)/4); -} - - -static double jarquebera_jarqueberaapprox(ae_int_t n, - double s, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector vx; - ae_vector vy; - ae_matrix ctbl; - double t1; - double t2; - double t3; - double t; - double f1; - double f2; - double f3; - double f12; - double f23; - double x; - double result; - - ae_frame_make(_state, &_frame_block); - ae_vector_init(&vx, 0, DT_REAL, _state, ae_true); - ae_vector_init(&vy, 0, DT_REAL, _state, ae_true); - ae_matrix_init(&ctbl, 0, 0, DT_REAL, _state, ae_true); - - result = 1; - x = s; - if( n<5 ) - { - ae_frame_leave(_state); - return result; - } - - /* - * N = 5..20 are tabulated - */ - if( n>=5&&n<=20 ) - { - if( n==5 ) - { - result = ae_exp(jarquebera_jbtbl5(x, _state), _state); - } - if( n==6 ) - { - result = ae_exp(jarquebera_jbtbl6(x, _state), _state); - } - if( n==7 ) - { - result = ae_exp(jarquebera_jbtbl7(x, _state), _state); - } - if( n==8 ) - { - result = ae_exp(jarquebera_jbtbl8(x, _state), _state); - } - if( n==9 ) - { - result = ae_exp(jarquebera_jbtbl9(x, _state), _state); - } - if( n==10 ) - { - result = ae_exp(jarquebera_jbtbl10(x, _state), _state); - } - if( n==11 ) - { - result = ae_exp(jarquebera_jbtbl11(x, _state), _state); - } - if( n==12 ) - { - result = ae_exp(jarquebera_jbtbl12(x, _state), _state); - } - if( n==13 ) - { - result = ae_exp(jarquebera_jbtbl13(x, _state), _state); - } - if( n==14 ) - { - result = ae_exp(jarquebera_jbtbl14(x, _state), _state); - } - if( n==15 ) - { - result = ae_exp(jarquebera_jbtbl15(x, _state), _state); - } - if( n==16 ) - { - result = ae_exp(jarquebera_jbtbl16(x, _state), _state); - } - if( n==17 ) - { - result = ae_exp(jarquebera_jbtbl17(x, _state), _state); - } - if( n==18 ) - { - result = ae_exp(jarquebera_jbtbl18(x, _state), _state); - } - if( n==19 ) - { - result = ae_exp(jarquebera_jbtbl19(x, _state), _state); - } - if( n==20 ) - { - result = ae_exp(jarquebera_jbtbl20(x, _state), _state); - } - ae_frame_leave(_state); - return result; - } - - /* - * N = 20, 30, 50 are tabulated. - * In-between values are interpolated - * using interpolating polynomial of the second degree. - */ - if( n>20&&n<=50 ) - { - t1 = -1.0/20.0; - t2 = -1.0/30.0; - t3 = -1.0/50.0; - t = -1.0/n; - f1 = jarquebera_jbtbl20(x, _state); - f2 = jarquebera_jbtbl30(x, _state); - f3 = jarquebera_jbtbl50(x, _state); - f12 = ((t-t2)*f1+(t1-t)*f2)/(t1-t2); - f23 = ((t-t3)*f2+(t2-t)*f3)/(t2-t3); - result = ((t-t3)*f12+(t1-t)*f23)/(t1-t3); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - result = ae_exp(result, _state); - ae_frame_leave(_state); - return result; - } - - /* - * N = 50, 65, 100 are tabulated. - * In-between values are interpolated - * using interpolating polynomial of the second degree. - */ - if( n>50&&n<=100 ) - { - t1 = -1.0/50.0; - t2 = -1.0/65.0; - t3 = -1.0/100.0; - t = -1.0/n; - f1 = jarquebera_jbtbl50(x, _state); - f2 = jarquebera_jbtbl65(x, _state); - f3 = jarquebera_jbtbl100(x, _state); - f12 = ((t-t2)*f1+(t1-t)*f2)/(t1-t2); - f23 = ((t-t3)*f2+(t2-t)*f3)/(t2-t3); - result = ((t-t3)*f12+(t1-t)*f23)/(t1-t3); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - result = ae_exp(result, _state); - ae_frame_leave(_state); - return result; - } - - /* - * N = 100, 130, 200 are tabulated. - * In-between values are interpolated - * using interpolating polynomial of the second degree. - */ - if( n>100&&n<=200 ) - { - t1 = -1.0/100.0; - t2 = -1.0/130.0; - t3 = -1.0/200.0; - t = -1.0/n; - f1 = jarquebera_jbtbl100(x, _state); - f2 = jarquebera_jbtbl130(x, _state); - f3 = jarquebera_jbtbl200(x, _state); - f12 = ((t-t2)*f1+(t1-t)*f2)/(t1-t2); - f23 = ((t-t3)*f2+(t2-t)*f3)/(t2-t3); - result = ((t-t3)*f12+(t1-t)*f23)/(t1-t3); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - result = ae_exp(result, _state); - ae_frame_leave(_state); - return result; - } - - /* - * N = 200, 301, 501 are tabulated. - * In-between values are interpolated - * using interpolating polynomial of the second degree. - */ - if( n>200&&n<=501 ) - { - t1 = -1.0/200.0; - t2 = -1.0/301.0; - t3 = -1.0/501.0; - t = -1.0/n; - f1 = jarquebera_jbtbl200(x, _state); - f2 = jarquebera_jbtbl301(x, _state); - f3 = jarquebera_jbtbl501(x, _state); - f12 = ((t-t2)*f1+(t1-t)*f2)/(t1-t2); - f23 = ((t-t3)*f2+(t2-t)*f3)/(t2-t3); - result = ((t-t3)*f12+(t1-t)*f23)/(t1-t3); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - result = ae_exp(result, _state); - ae_frame_leave(_state); - return result; - } - - /* - * N = 501, 701, 1401 are tabulated. - * In-between values are interpolated - * using interpolating polynomial of the second degree. - */ - if( n>501&&n<=1401 ) - { - t1 = -1.0/501.0; - t2 = -1.0/701.0; - t3 = -1.0/1401.0; - t = -1.0/n; - f1 = jarquebera_jbtbl501(x, _state); - f2 = jarquebera_jbtbl701(x, _state); - f3 = jarquebera_jbtbl1401(x, _state); - f12 = ((t-t2)*f1+(t1-t)*f2)/(t1-t2); - f23 = ((t-t3)*f2+(t2-t)*f3)/(t2-t3); - result = ((t-t3)*f12+(t1-t)*f23)/(t1-t3); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - result = ae_exp(result, _state); - ae_frame_leave(_state); - return result; - } - - /* - * Asymptotic expansion - */ - if( n>1401 ) - { - result = -0.5*x+(jarquebera_jbtbl1401(x, _state)+0.5*x)*ae_sqrt((double)1401/(double)n, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - result = ae_exp(result, _state); - ae_frame_leave(_state); - return result; - } - ae_frame_leave(_state); - return result; -} - - -static double jarquebera_jbtbl5(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - if( ae_fp_less_eq(s,0.4000) ) - { - x = 2*(s-0.000000)/0.400000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -1.097885e-20, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.854501e-20, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.756616e-20, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,1.1000) ) - { - x = 2*(s-0.400000)/0.700000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -1.324545e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.075941e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -9.772272e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 3.175686e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.576162e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.126861e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.434425e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.790359e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.809178e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -5.479704e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 3.717040e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -5.294170e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.880632e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.023344e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.601531e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -7.920403e-02, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - result = -5.188419e+02*(s-1.100000e+00)-4.767297e+00; - return result; -} - - -static double jarquebera_jbtbl6(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - if( ae_fp_less_eq(s,0.2500) ) - { - x = 2*(s-0.000000)/0.250000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -2.274707e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -5.700471e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.425764e-04, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,1.3000) ) - { - x = 2*(s-0.250000)/1.050000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -1.339000e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.011104e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -8.168177e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.085666e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 7.738606e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 7.022876e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 3.462402e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 6.908270e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -8.230772e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.006996e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -5.410222e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.893768e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 8.114564e-04, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,1.8500) ) - { - x = 2*(s-1.300000)/0.550000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -6.794311e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.578700e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.394664e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -7.928290e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -4.813273e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.076063e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.835380e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.013013e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -5.058903e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.856915e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -6.710887e-03, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - result = -1.770029e+02*(s-1.850000e+00)-1.371015e+01; - return result; -} - - -static double jarquebera_jbtbl7(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - if( ae_fp_less_eq(s,1.4000) ) - { - x = 2*(s-0.000000)/1.400000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -1.093681e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.695911e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -7.473192e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.203236e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 6.590379e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 6.291876e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 3.132007e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 9.411147e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.180067e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.487610e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.436561e-03, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,3.0000) ) - { - x = 2*(s-1.400000)/1.600000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -5.947854e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.772675e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -4.707912e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.691171e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -4.132795e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.481310e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.867536e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 8.772327e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 5.033387e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.378277e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.497964e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.636814e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -9.581640e-04, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,3.2000) ) - { - x = 2*(s-3.000000)/0.200000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -7.511008e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -8.140472e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.682053e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.568561e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.933930e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -8.140472e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.895025e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -8.140472e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.933930e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.568561e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.682053e+00, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - result = -1.824116e+03*(s-3.200000e+00)-1.440330e+01; - return result; -} - - -static double jarquebera_jbtbl8(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - if( ae_fp_less_eq(s,1.3000) ) - { - x = 2*(s-0.000000)/1.300000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -7.199015e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.095921e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -4.736828e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.047438e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.484320e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 7.937923e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 4.810470e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.139780e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 6.708443e-04, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,2.0000) ) - { - x = 2*(s-1.300000)/0.700000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -3.378966e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -7.802461e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.547593e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -6.241042e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.203274e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 5.201990e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -5.125597e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.584426e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.546069e-04, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,5.0000) ) - { - x = 2*(s-2.000000)/3.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -6.828366e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.137533e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -5.016671e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.745637e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -5.189801e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.621610e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -6.741122e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -4.516368e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 3.552085e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.787029e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 5.359774e-03, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - result = -5.087028e+00*(s-5.000000e+00)-1.071300e+01; - return result; -} - - -static double jarquebera_jbtbl9(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - if( ae_fp_less_eq(s,1.3000) ) - { - x = 2*(s-0.000000)/1.300000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -6.279320e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -9.277151e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.669339e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -7.086149e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.333816e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 3.871249e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.007048e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 7.482245e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.355615e-04, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,2.0000) ) - { - x = 2*(s-1.300000)/0.700000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -2.981430e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -7.972248e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.747737e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.808530e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -7.888305e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 9.001302e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.378767e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.108510e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 5.915372e-04, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,7.0000) ) - { - x = 2*(s-2.000000)/5.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -6.387463e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.845231e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.809956e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -7.543461e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -4.880397e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.160074e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -7.356527e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -4.394428e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 9.619892e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.758763e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 4.790977e-05, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - result = -2.020952e+00*(s-7.000000e+00)-9.516623e+00; - return result; -} - - -static double jarquebera_jbtbl10(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - if( ae_fp_less_eq(s,1.2000) ) - { - x = 2*(s-0.000000)/1.200000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -4.590993e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -6.562730e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.353934e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -4.069933e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.849151e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 8.931406e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 3.636295e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.178340e-05, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -8.917749e-05, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,2.0000) ) - { - x = 2*(s-1.200000)/0.800000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -2.537658e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -9.962401e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.838715e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.055792e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.580316e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.781701e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 3.770362e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -4.838983e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -6.999052e-04, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,7.0000) ) - { - x = 2*(s-2.000000)/5.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -5.337524e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.877029e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 4.734650e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -4.249254e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 3.320250e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -6.432266e-03, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - result = -8.711035e-01*(s-7.000000e+00)-7.212811e+00; - return result; -} - - -static double jarquebera_jbtbl11(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - if( ae_fp_less_eq(s,1.2000) ) - { - x = 2*(s-0.000000)/1.200000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -4.339517e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -6.051558e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.000992e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.022547e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -9.808401e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 5.592870e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 3.575081e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.086173e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 6.089011e-05, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,2.2500) ) - { - x = 2*(s-1.200000)/1.050000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -2.523221e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.068388e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.179661e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.555524e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.238964e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 7.364320e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 4.895771e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.762774e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -8.201340e-04, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,8.0000) ) - { - x = 2*(s-2.250000)/5.750000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -5.212179e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.684579e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 8.299519e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.606261e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 7.310869e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.320115e-03, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - result = -5.715445e-01*(s-8.000000e+00)-6.845834e+00; - return result; -} - - -static double jarquebera_jbtbl12(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - if( ae_fp_less_eq(s,1.0000) ) - { - x = 2*(s-0.000000)/1.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -2.736742e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.657836e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.047209e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.319599e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -5.545631e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 9.280445e-05, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.815679e-05, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.213519e-05, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.256838e-05, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,3.0000) ) - { - x = 2*(s-1.000000)/2.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -2.573947e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.515287e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 3.611880e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.271311e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -6.495815e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 4.141186e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 7.180886e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.388211e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 4.890761e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 3.233175e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.946156e-03, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,12.0000) ) - { - x = 2*(s-3.000000)/9.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -5.947819e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.034157e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 6.878986e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -4.078603e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 6.990977e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.866215e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 3.897866e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.512252e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.073743e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 3.022621e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.501343e-03, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - result = -2.877243e-01*(s-1.200000e+01)-7.936839e+00; - return result; -} - - -static double jarquebera_jbtbl13(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - if( ae_fp_less_eq(s,1.0000) ) - { - x = 2*(s-0.000000)/1.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -2.713276e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.557541e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -9.459092e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.044145e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.546132e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.002374e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.349456e-05, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -7.025669e-05, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.590242e-05, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,3.0000) ) - { - x = 2*(s-1.000000)/2.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -2.454383e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.467539e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 3.270774e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -8.075763e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -6.611647e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.990785e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 8.109212e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.135031e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 5.915919e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 3.522390e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.144701e-03, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,13.0000) ) - { - x = 2*(s-3.000000)/10.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -5.736127e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.920809e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.175858e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -4.002049e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.158966e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.157781e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.762172e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 5.780347e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.193310e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.442421e-05, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.547756e-03, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - result = -2.799944e-01*(s-1.300000e+01)-7.566269e+00; - return result; -} - - -static double jarquebera_jbtbl14(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - if( ae_fp_less_eq(s,1.0000) ) - { - x = 2*(s-0.000000)/1.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -2.698527e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.479081e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -8.640733e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -8.466899e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.469485e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.150009e-05, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.965975e-05, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -4.710210e-05, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.327808e-05, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,3.0000) ) - { - x = 2*(s-1.000000)/2.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -2.350359e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.421365e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.960468e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.149167e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -6.361109e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.976022e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.082700e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -8.563328e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.453123e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.917559e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.151067e-05, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,15.0000) ) - { - x = 2*(s-3.000000)/12.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -5.746892e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.010441e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.566146e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -5.129690e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.929724e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.524227e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 3.192933e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -4.254730e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.620685e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 7.289618e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.112350e-03, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - result = -2.590621e-01*(s-1.500000e+01)-7.632238e+00; - return result; -} - - -static double jarquebera_jbtbl15(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - if( ae_fp_less_eq(s,2.0000) ) - { - x = 2*(s-0.000000)/2.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -1.043660e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.361653e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.009497e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 4.951784e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 4.377903e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.003253e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.271309e-03, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,5.0000) ) - { - x = 2*(s-2.000000)/3.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -3.582778e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -8.349578e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 9.476514e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.717385e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.222591e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -6.635124e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.815993e-03, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,17.0000) ) - { - x = 2*(s-5.000000)/12.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -6.115476e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.655936e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 8.404310e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.663794e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 8.868618e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.381447e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 9.444801e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.581503e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -9.468696e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.728509e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.206470e-03, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - result = -1.927937e-01*(s-1.700000e+01)-7.700983e+00; - return result; -} - - -static double jarquebera_jbtbl16(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - if( ae_fp_less_eq(s,2.0000) ) - { - x = 2*(s-0.000000)/2.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -1.002570e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.298141e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.832803e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 3.877026e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 3.539436e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 8.439658e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -4.756911e-04, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,5.0000) ) - { - x = 2*(s-2.000000)/3.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -3.486198e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -8.242944e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.020002e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.130531e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.512373e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -8.054876e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 3.556839e-03, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,20.0000) ) - { - x = 2*(s-5.000000)/15.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -6.241608e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.832655e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.340545e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.361143e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.283219e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 3.484549e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.805968e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.057243e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.454439e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.177513e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.819209e-03, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - result = -2.391580e-01*(s-2.000000e+01)-7.963205e+00; - return result; -} - - -static double jarquebera_jbtbl17(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - if( ae_fp_less_eq(s,3.0000) ) - { - x = 2*(s-0.000000)/3.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -1.566973e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.810330e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -4.840039e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.337294e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -5.383549e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -5.556515e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -8.656965e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.404569e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 6.447867e-03, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,6.0000) ) - { - x = 2*(s-3.000000)/3.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -3.905684e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -6.222920e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 4.146667e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -4.809176e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.057028e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.211838e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -4.099683e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.161105e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.225465e-04, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,24.0000) ) - { - x = 2*(s-6.000000)/18.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -6.594282e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.917838e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.455980e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.999589e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 5.604263e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.484445e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.819937e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.930390e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.771761e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -6.232581e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -7.029083e-04, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - result = -2.127771e-01*(s-2.400000e+01)-8.400197e+00; - return result; -} - - -static double jarquebera_jbtbl18(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - if( ae_fp_less_eq(s,3.0000) ) - { - x = 2*(s-0.000000)/3.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -1.526802e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.762373e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -5.598890e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.189437e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 5.971721e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -4.823067e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.064501e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.014932e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 5.953513e-03, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,6.0000) ) - { - x = 2*(s-3.000000)/3.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -3.818669e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -6.070918e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 4.277196e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -4.879817e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 6.887357e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.638451e-05, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.502800e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.165796e-05, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 5.034960e-05, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,20.0000) ) - { - x = 2*(s-6.000000)/14.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -6.010656e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.496296e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.002227e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.338250e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 4.137036e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.586202e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -9.736384e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.332251e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.877982e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.160963e-05, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.547247e-03, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - result = -1.684623e-01*(s-2.000000e+01)-7.428883e+00; - return result; -} - - -static double jarquebera_jbtbl19(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - if( ae_fp_less_eq(s,3.0000) ) - { - x = 2*(s-0.000000)/3.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -1.490213e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.719633e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -6.459123e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.034878e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.113868e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -4.030922e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.054022e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 7.525623e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 5.277360e-03, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,6.0000) ) - { - x = 2*(s-3.000000)/3.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -3.744750e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -5.977749e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 4.223716e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -5.363889e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 5.711774e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -5.557257e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 4.254794e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 9.034207e-05, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 5.498107e-05, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,20.0000) ) - { - x = 2*(s-6.000000)/14.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -5.872768e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.430689e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.136575e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.726627e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 3.421110e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.581510e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -5.559520e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -6.838208e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 8.428839e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -7.170682e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -6.006647e-04, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - result = -1.539373e-01*(s-2.000000e+01)-7.206941e+00; - return result; -} - - -static double jarquebera_jbtbl20(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - if( ae_fp_less_eq(s,4.0000) ) - { - x = 2*(s-0.000000)/4.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -1.854794e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.948947e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.632184e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.139397e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.006237e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.810031e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 3.573620e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 9.951242e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.274092e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.464196e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 4.882139e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.575144e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.822804e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -7.061348e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 5.908404e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.978353e-04, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,15.0000) ) - { - x = 2*(s-4.000000)/11.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -5.030989e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.327151e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.346404e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.840051e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 7.578551e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -9.813886e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 5.905973e-05, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -5.358489e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.450795e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -6.941157e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -7.432418e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.070537e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 9.375654e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 5.367378e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 9.890859e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 6.679782e-04, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,25.0000) ) - { - x = 2*(s-15.000000)/10.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -7.015854e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -7.487737e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.244254e-02, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - result = -1.318007e-01*(s-2.500000e+01)-7.742185e+00; - return result; -} - - -static double jarquebera_jbtbl30(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - if( ae_fp_less_eq(s,4.0000) ) - { - x = 2*(s-0.000000)/4.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -1.630822e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.724298e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 7.872756e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.658268e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.573597e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.994157e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 5.994825e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 7.394303e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -5.785029e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.990264e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.037838e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 6.755546e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.774473e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.821395e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.392603e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.353313e-04, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,15.0000) ) - { - x = 2*(s-4.000000)/11.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -4.539322e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.197018e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.396848e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.804293e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 6.867928e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.768758e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 5.211792e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 4.925799e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 5.046235e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -9.536469e-05, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -6.489642e-04, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,25.0000) ) - { - x = 2*(s-15.000000)/10.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -6.263462e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -6.177316e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.590637e-02, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - result = -1.028212e-01*(s-2.500000e+01)-6.855288e+00; - return result; -} - - -static double jarquebera_jbtbl50(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - if( ae_fp_less_eq(s,4.0000) ) - { - x = 2*(s-0.000000)/4.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -1.436279e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.519711e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.148699e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.001204e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.207620e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.034778e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.220322e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.033260e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.588280e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.851653e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.287733e-04, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,15.0000) ) - { - x = 2*(s-4.000000)/11.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -4.234645e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.189127e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.429738e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.058822e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 9.086776e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.445783e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.311671e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -7.261298e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 6.496987e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.605249e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 8.162282e-04, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,25.0000) ) - { - x = 2*(s-15.000000)/10.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -5.921095e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -5.888603e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 3.080113e-02, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - result = -9.313116e-02*(s-2.500000e+01)-6.479154e+00; - return result; -} - - -static double jarquebera_jbtbl65(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - if( ae_fp_less_eq(s,4.0000) ) - { - x = 2*(s-0.000000)/4.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -1.360024e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.434631e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -6.514580e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 7.332038e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.158197e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -5.121233e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.051056e-03, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,15.0000) ) - { - x = 2*(s-4.000000)/11.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -4.148601e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.214233e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.487977e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.424720e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.116715e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -4.043152e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.718149e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.313701e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 3.097305e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.181031e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.256975e-04, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,25.0000) ) - { - x = 2*(s-15.000000)/10.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -5.858951e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -5.895179e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.933237e-02, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - result = -9.443768e-02*(s-2.500000e+01)-6.419137e+00; - return result; -} - - -static double jarquebera_jbtbl100(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - if( ae_fp_less_eq(s,4.0000) ) - { - x = 2*(s-0.000000)/4.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -1.257021e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.313418e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.628931e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 4.264287e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.518487e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.499826e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -4.836044e-04, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,15.0000) ) - { - x = 2*(s-4.000000)/11.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -4.056508e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.279690e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.665746e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -4.290012e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.487632e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -5.704465e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.211669e-03, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,25.0000) ) - { - x = 2*(s-15.000000)/10.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -5.866099e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -6.399767e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.498208e-02, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - result = -1.080097e-01*(s-2.500000e+01)-6.481094e+00; - return result; -} - - -static double jarquebera_jbtbl130(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - if( ae_fp_less_eq(s,4.0000) ) - { - x = 2*(s-0.000000)/4.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -1.207999e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.253864e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.618032e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 3.112729e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.210546e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -4.732602e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.410527e-04, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,15.0000) ) - { - x = 2*(s-4.000000)/11.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -4.026324e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.331990e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.779129e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -4.674749e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.669077e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -5.679136e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 8.833221e-04, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,25.0000) ) - { - x = 2*(s-15.000000)/10.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -5.893951e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -6.475304e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 3.116734e-02, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - result = -1.045722e-01*(s-2.500000e+01)-6.510314e+00; - return result; -} - - -static double jarquebera_jbtbl200(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - if( ae_fp_less_eq(s,4.0000) ) - { - x = 2*(s-0.000000)/4.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -1.146155e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.177398e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.297970e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.869745e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.717288e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.982108e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 6.427636e-05, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,15.0000) ) - { - x = 2*(s-4.000000)/11.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -4.034235e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.455006e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.942996e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -4.973795e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.418812e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.156778e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 4.896705e-05, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,25.0000) ) - { - x = 2*(s-15.000000)/10.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -6.086071e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -7.152176e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 3.725393e-02, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - result = -1.132404e-01*(s-2.500000e+01)-6.764034e+00; - return result; -} - - -static double jarquebera_jbtbl301(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - if( ae_fp_less_eq(s,4.0000) ) - { - x = 2*(s-0.000000)/4.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -1.104290e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.125800e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -9.595847e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.219666e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.502210e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -6.414543e-05, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 6.754115e-05, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,15.0000) ) - { - x = 2*(s-4.000000)/11.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -4.065955e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.582060e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.004472e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -4.709092e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.105779e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.197391e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -8.386780e-04, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,25.0000) ) - { - x = 2*(s-15.000000)/10.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -6.311384e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -7.918763e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 3.626584e-02, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - result = -1.293626e-01*(s-2.500000e+01)-7.066995e+00; - return result; -} - - -static double jarquebera_jbtbl501(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - if( ae_fp_less_eq(s,4.0000) ) - { - x = 2*(s-0.000000)/4.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -1.067426e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.079765e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -5.463005e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 6.875659e-03, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,15.0000) ) - { - x = 2*(s-4.000000)/11.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -4.127574e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.740694e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.044502e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.746714e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 3.810594e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.197111e-03, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,25.0000) ) - { - x = 2*(s-15.000000)/10.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -6.628194e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -8.846221e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 4.386405e-02, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - result = -1.418332e-01*(s-2.500000e+01)-7.468952e+00; - return result; -} - - -static double jarquebera_jbtbl701(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - if( ae_fp_less_eq(s,4.0000) ) - { - x = 2*(s-0.000000)/4.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -1.050999e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.059769e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -3.922680e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 4.847054e-03, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,15.0000) ) - { - x = 2*(s-4.000000)/11.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -4.192182e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.860007e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.963942e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.838711e-02, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.893112e-04, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.159788e-03, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,25.0000) ) - { - x = 2*(s-15.000000)/10.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -6.917851e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -9.817020e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 5.383727e-02, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - result = -1.532706e-01*(s-2.500000e+01)-7.845715e+00; - return result; -} - - -static double jarquebera_jbtbl1401(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - if( ae_fp_less_eq(s,4.0000) ) - { - x = 2*(s-0.000000)/4.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -1.026266e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.030061e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.259222e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 2.536254e-03, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,15.0000) ) - { - x = 2*(s-4.000000)/11.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -4.329849e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -2.095443e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 1.759363e-01, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -7.751359e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -6.124368e-03, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.793114e-03, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - if( ae_fp_less_eq(s,25.0000) ) - { - x = 2*(s-15.000000)/10.000000-1; - tj = 1; - tj1 = x; - jarquebera_jbcheb(x, -7.544330e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, -1.225382e+00, &tj, &tj1, &result, _state); - jarquebera_jbcheb(x, 5.392349e-02, &tj, &tj1, &result, _state); - if( ae_fp_greater(result,0) ) - { - result = 0; - } - return result; - } - result = -2.019375e-01*(s-2.500000e+01)-8.715788e+00; - return result; -} - - -static void jarquebera_jbcheb(double x, - double c, - double* tj, - double* tj1, - double* r, - ae_state *_state) -{ - double t; - - - *r = *r+c*(*tj); - t = 2*x*(*tj1)-(*tj); - *tj = *tj1; - *tj1 = t; -} - - - - -/************************************************************************* -Mann-Whitney U-test - -This test checks hypotheses about whether X and Y are samples of two -continuous distributions of the same shape and same median or whether -their medians are different. - -The following tests are performed: - * two-tailed test (null hypothesis - the medians are equal) - * left-tailed test (null hypothesis - the median of the first sample - is greater than or equal to the median of the second sample) - * right-tailed test (null hypothesis - the median of the first sample - is less than or equal to the median of the second sample). - -Requirements: - * the samples are independent - * X and Y are continuous distributions (or discrete distributions well- - approximating continuous distributions) - * distributions of X and Y have the same shape. The only possible - difference is their position (i.e. the value of the median) - * the number of elements in each sample is not less than 5 - * the scale of measurement should be ordinal, interval or ratio (i.e. - the test could not be applied to nominal variables). - -The test is non-parametric and doesn't require distributions to be normal. - -Input parameters: - X - sample 1. Array whose index goes from 0 to N-1. - N - size of the sample. N>=5 - Y - sample 2. Array whose index goes from 0 to M-1. - M - size of the sample. M>=5 - -Output parameters: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - -To calculate p-values, special approximation is used. This method lets us -calculate p-values with satisfactory accuracy in interval [0.0001, 1]. -There is no approximation outside the [0.0001, 1] interval. Therefore, if -the significance level outlies this interval, the test returns 0.0001. - -Relative precision of approximation of p-value: - -N M Max.err. Rms.err. -5..10 N..10 1.4e-02 6.0e-04 -5..10 N..100 2.2e-02 5.3e-06 -10..15 N..15 1.0e-02 3.2e-04 -10..15 N..100 1.0e-02 2.2e-05 -15..100 N..100 6.1e-03 2.7e-06 - -For N,M>100 accuracy checks weren't put into practice, but taking into -account characteristics of asymptotic approximation used, precision should -not be sharply different from the values for interval [5, 100]. - - -- ALGLIB -- - Copyright 09.04.2007 by Bochkanov Sergey -*************************************************************************/ -void mannwhitneyutest(/* Real */ ae_vector* x, - ae_int_t n, - /* Real */ ae_vector* y, - ae_int_t m, - double* bothtails, - double* lefttail, - double* righttail, - ae_state *_state) -{ - ae_frame _frame_block; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t t; - double tmp; - ae_int_t tmpi; - ae_int_t ns; - ae_vector r; - ae_vector c; - double u; - double p; - double mp; - double s; - double sigma; - double mu; - ae_int_t tiecount; - ae_vector tiesize; - - ae_frame_make(_state, &_frame_block); - *bothtails = 0; - *lefttail = 0; - *righttail = 0; - ae_vector_init(&r, 0, DT_REAL, _state, ae_true); - ae_vector_init(&c, 0, DT_INT, _state, ae_true); - ae_vector_init(&tiesize, 0, DT_INT, _state, ae_true); - - - /* - * Prepare - */ - if( n<=4||m<=4 ) - { - *bothtails = 1.0; - *lefttail = 1.0; - *righttail = 1.0; - ae_frame_leave(_state); - return; - } - ns = n+m; - ae_vector_set_length(&r, ns-1+1, _state); - ae_vector_set_length(&c, ns-1+1, _state); - for(i=0; i<=n-1; i++) - { - r.ptr.p_double[i] = x->ptr.p_double[i]; - c.ptr.p_int[i] = 0; - } - for(i=0; i<=m-1; i++) - { - r.ptr.p_double[n+i] = y->ptr.p_double[i]; - c.ptr.p_int[n+i] = 1; - } - - /* - * sort {R, C} - */ - if( ns!=1 ) - { - i = 2; - do - { - t = i; - while(t!=1) - { - k = t/2; - if( ae_fp_greater_eq(r.ptr.p_double[k-1],r.ptr.p_double[t-1]) ) - { - t = 1; - } - else - { - tmp = r.ptr.p_double[k-1]; - r.ptr.p_double[k-1] = r.ptr.p_double[t-1]; - r.ptr.p_double[t-1] = tmp; - tmpi = c.ptr.p_int[k-1]; - c.ptr.p_int[k-1] = c.ptr.p_int[t-1]; - c.ptr.p_int[t-1] = tmpi; - t = k; - } - } - i = i+1; - } - while(i<=ns); - i = ns-1; - do - { - tmp = r.ptr.p_double[i]; - r.ptr.p_double[i] = r.ptr.p_double[0]; - r.ptr.p_double[0] = tmp; - tmpi = c.ptr.p_int[i]; - c.ptr.p_int[i] = c.ptr.p_int[0]; - c.ptr.p_int[0] = tmpi; - t = 1; - while(t!=0) - { - k = 2*t; - if( k>i ) - { - t = 0; - } - else - { - if( k=1); - } - - /* - * compute tied ranks - */ - i = 0; - tiecount = 0; - ae_vector_set_length(&tiesize, ns-1+1, _state); - while(i<=ns-1) - { - j = i+1; - while(j<=ns-1) - { - if( ae_fp_neq(r.ptr.p_double[j],r.ptr.p_double[i]) ) - { - break; - } - j = j+1; - } - for(k=i; k<=j-1; k++) - { - r.ptr.p_double[k] = 1+(double)(i+j-1)/(double)2; - } - tiesize.ptr.p_int[tiecount] = j-i; - tiecount = tiecount+1; - i = j; - } - - /* - * Compute U - */ - u = 0; - for(i=0; i<=ns-1; i++) - { - if( c.ptr.p_int[i]==0 ) - { - u = u+r.ptr.p_double[i]; - } - } - u = n*m+n*(n+1)/2-u; - - /* - * Result - */ - mu = (double)(n*m)/(double)2; - tmp = ns*(ae_sqr(ns, _state)-1)/12; - for(i=0; i<=tiecount-1; i++) - { - tmp = tmp-tiesize.ptr.p_int[i]*(ae_sqr(tiesize.ptr.p_int[i], _state)-1)/12; - } - sigma = ae_sqrt((double)(m*n)/(double)ns/(ns-1)*tmp, _state); - s = (u-mu)/sigma; - if( ae_fp_less_eq(s,0) ) - { - p = ae_exp(mannwhitneyu_usigma(-(u-mu)/sigma, n, m, _state), _state); - mp = 1-ae_exp(mannwhitneyu_usigma(-(u-1-mu)/sigma, n, m, _state), _state); - } - else - { - mp = ae_exp(mannwhitneyu_usigma((u-mu)/sigma, n, m, _state), _state); - p = 1-ae_exp(mannwhitneyu_usigma((u+1-mu)/sigma, n, m, _state), _state); - } - *bothtails = ae_maxreal(2*ae_minreal(p, mp, _state), 1.0E-4, _state); - *lefttail = ae_maxreal(mp, 1.0E-4, _state); - *righttail = ae_maxreal(p, 1.0E-4, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Sequential Chebyshev interpolation. -*************************************************************************/ -static void mannwhitneyu_ucheb(double x, - double c, - double* tj, - double* tj1, - double* r, - ae_state *_state) -{ - double t; - - - *r = *r+c*(*tj); - t = 2*x*(*tj1)-(*tj); - *tj = *tj1; - *tj1 = t; -} - - -/************************************************************************* -Three-point polynomial interpolation. -*************************************************************************/ -static double mannwhitneyu_uninterpolate(double p1, - double p2, - double p3, - ae_int_t n, - ae_state *_state) -{ - double t1; - double t2; - double t3; - double t; - double p12; - double p23; - double result; - - - t1 = 1.0/15.0; - t2 = 1.0/30.0; - t3 = 1.0/100.0; - t = 1.0/n; - p12 = ((t-t2)*p1+(t1-t)*p2)/(t1-t2); - p23 = ((t-t3)*p2+(t2-t)*p3)/(t2-t3); - result = ((t-t3)*p12+(t1-t)*p23)/(t1-t3); - return result; -} - - -/************************************************************************* -Tail(0, N1, N2) -*************************************************************************/ -static double mannwhitneyu_usigma000(ae_int_t n1, - ae_int_t n2, - ae_state *_state) -{ - double p1; - double p2; - double p3; - double result; - - - p1 = mannwhitneyu_uninterpolate(-6.76984e-01, -6.83700e-01, -6.89873e-01, n2, _state); - p2 = mannwhitneyu_uninterpolate(-6.83700e-01, -6.87311e-01, -6.90957e-01, n2, _state); - p3 = mannwhitneyu_uninterpolate(-6.89873e-01, -6.90957e-01, -6.92175e-01, n2, _state); - result = mannwhitneyu_uninterpolate(p1, p2, p3, n1, _state); - return result; -} - - -/************************************************************************* -Tail(0.75, N1, N2) -*************************************************************************/ -static double mannwhitneyu_usigma075(ae_int_t n1, - ae_int_t n2, - ae_state *_state) -{ - double p1; - double p2; - double p3; - double result; - - - p1 = mannwhitneyu_uninterpolate(-1.44500e+00, -1.45906e+00, -1.47063e+00, n2, _state); - p2 = mannwhitneyu_uninterpolate(-1.45906e+00, -1.46856e+00, -1.47644e+00, n2, _state); - p3 = mannwhitneyu_uninterpolate(-1.47063e+00, -1.47644e+00, -1.48100e+00, n2, _state); - result = mannwhitneyu_uninterpolate(p1, p2, p3, n1, _state); - return result; -} - - -/************************************************************************* -Tail(1.5, N1, N2) -*************************************************************************/ -static double mannwhitneyu_usigma150(ae_int_t n1, - ae_int_t n2, - ae_state *_state) -{ - double p1; - double p2; - double p3; - double result; - - - p1 = mannwhitneyu_uninterpolate(-2.65380e+00, -2.67352e+00, -2.69011e+00, n2, _state); - p2 = mannwhitneyu_uninterpolate(-2.67352e+00, -2.68591e+00, -2.69659e+00, n2, _state); - p3 = mannwhitneyu_uninterpolate(-2.69011e+00, -2.69659e+00, -2.70192e+00, n2, _state); - result = mannwhitneyu_uninterpolate(p1, p2, p3, n1, _state); - return result; -} - - -/************************************************************************* -Tail(2.25, N1, N2) -*************************************************************************/ -static double mannwhitneyu_usigma225(ae_int_t n1, - ae_int_t n2, - ae_state *_state) -{ - double p1; - double p2; - double p3; - double result; - - - p1 = mannwhitneyu_uninterpolate(-4.41465e+00, -4.42260e+00, -4.43702e+00, n2, _state); - p2 = mannwhitneyu_uninterpolate(-4.42260e+00, -4.41639e+00, -4.41928e+00, n2, _state); - p3 = mannwhitneyu_uninterpolate(-4.43702e+00, -4.41928e+00, -4.41030e+00, n2, _state); - result = mannwhitneyu_uninterpolate(p1, p2, p3, n1, _state); - return result; -} - - -/************************************************************************* -Tail(3.0, N1, N2) -*************************************************************************/ -static double mannwhitneyu_usigma300(ae_int_t n1, - ae_int_t n2, - ae_state *_state) -{ - double p1; - double p2; - double p3; - double result; - - - p1 = mannwhitneyu_uninterpolate(-6.89839e+00, -6.83477e+00, -6.82340e+00, n2, _state); - p2 = mannwhitneyu_uninterpolate(-6.83477e+00, -6.74559e+00, -6.71117e+00, n2, _state); - p3 = mannwhitneyu_uninterpolate(-6.82340e+00, -6.71117e+00, -6.64929e+00, n2, _state); - result = mannwhitneyu_uninterpolate(p1, p2, p3, n1, _state); - return result; -} - - -/************************************************************************* -Tail(3.33, N1, N2) -*************************************************************************/ -static double mannwhitneyu_usigma333(ae_int_t n1, - ae_int_t n2, - ae_state *_state) -{ - double p1; - double p2; - double p3; - double result; - - - p1 = mannwhitneyu_uninterpolate(-8.31272e+00, -8.17096e+00, -8.13125e+00, n2, _state); - p2 = mannwhitneyu_uninterpolate(-8.17096e+00, -8.00156e+00, -7.93245e+00, n2, _state); - p3 = mannwhitneyu_uninterpolate(-8.13125e+00, -7.93245e+00, -7.82502e+00, n2, _state); - result = mannwhitneyu_uninterpolate(p1, p2, p3, n1, _state); - return result; -} - - -/************************************************************************* -Tail(3.66, N1, N2) -*************************************************************************/ -static double mannwhitneyu_usigma367(ae_int_t n1, - ae_int_t n2, - ae_state *_state) -{ - double p1; - double p2; - double p3; - double result; - - - p1 = mannwhitneyu_uninterpolate(-9.98837e+00, -9.70844e+00, -9.62087e+00, n2, _state); - p2 = mannwhitneyu_uninterpolate(-9.70844e+00, -9.41156e+00, -9.28998e+00, n2, _state); - p3 = mannwhitneyu_uninterpolate(-9.62087e+00, -9.28998e+00, -9.11686e+00, n2, _state); - result = mannwhitneyu_uninterpolate(p1, p2, p3, n1, _state); - return result; -} - - -/************************************************************************* -Tail(4.0, N1, N2) -*************************************************************************/ -static double mannwhitneyu_usigma400(ae_int_t n1, - ae_int_t n2, - ae_state *_state) -{ - double p1; - double p2; - double p3; - double result; - - - p1 = mannwhitneyu_uninterpolate(-1.20250e+01, -1.14911e+01, -1.13231e+01, n2, _state); - p2 = mannwhitneyu_uninterpolate(-1.14911e+01, -1.09927e+01, -1.07937e+01, n2, _state); - p3 = mannwhitneyu_uninterpolate(-1.13231e+01, -1.07937e+01, -1.05285e+01, n2, _state); - result = mannwhitneyu_uninterpolate(p1, p2, p3, n1, _state); - return result; -} - - -/************************************************************************* -Tail(S, 5, 5) -*************************************************************************/ -static double mannwhitneyu_utbln5n5(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/2.611165e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -2.596264e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.412086e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.858542e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.614282e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.372686e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 8.524731e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.435331e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.284665e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.184141e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 5.298360e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 7.447272e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.938769e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.276205e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.138481e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 8.684625e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.558104e-03, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 5, 6) -*************************************************************************/ -static double mannwhitneyu_utbln5n6(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/2.738613e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -2.810459e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.684429e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.712858e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.009324e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.644391e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 6.034173e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.953498e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.279293e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.563485e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.971952e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.506309e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.541406e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.283205e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.016347e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.221626e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.286752e-03, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 5, 7) -*************************************************************************/ -static double mannwhitneyu_utbln5n7(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/2.841993e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -2.994677e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.923264e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.506190e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.054280e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.794587e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.726290e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.534180e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.517845e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.904428e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.882443e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.482988e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.114875e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.515082e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.996056e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.293581e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.349444e-03, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 5, 8) -*************************************************************************/ -static double mannwhitneyu_utbln5n8(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/2.927700e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.155727e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.135078e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.247203e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.309697e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.993725e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.567219e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.383704e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 5.002188e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.487322e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.443899e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.688270e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.600339e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.874948e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.811593e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.072353e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.659457e-03, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 5, 9) -*************************************************************************/ -static double mannwhitneyu_utbln5n9(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.000000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.298162e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.325016e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.939852e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.563029e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.222652e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.195200e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.445665e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 5.204792e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.775217e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.527781e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.221948e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.242968e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.607959e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.771285e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 6.694026e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.481190e-03, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 5, 10) -*************************************************************************/ -static double mannwhitneyu_utbln5n10(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.061862e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.425360e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.496710e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.587658e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.812005e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.427637e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.515702e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.406867e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.796295e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 5.237591e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.654249e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.181165e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.011665e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.417927e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.534880e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.791255e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.871512e-05, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 5, 11) -*************************************************************************/ -static double mannwhitneyu_utbln5n11(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.115427e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.539959e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.652998e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.196503e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.054363e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.618848e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.109411e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.786668e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.215648e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 5.484220e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.935991e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.396191e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.894177e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.206979e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.519055e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.210326e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.189679e-03, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 5, 12) -*************************************************************************/ -static double mannwhitneyu_utbln5n12(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.162278e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.644007e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.796173e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.771177e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.290043e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.794686e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.702110e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.185959e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.416259e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 5.592056e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.201530e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.754365e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.978945e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.012032e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.304579e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.100378e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.728269e-03, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 5, 13) -*************************************************************************/ -static double mannwhitneyu_utbln5n13(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.203616e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.739120e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.928117e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.031605e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.519403e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.962648e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.292183e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.809293e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.465156e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 5.456278e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.446055e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.109490e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.218256e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.941479e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.058603e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.824402e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.830947e-03, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 5, 14) -*************************************************************************/ -static double mannwhitneyu_utbln5n14(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.240370e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.826559e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.050370e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.083408e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.743164e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.012030e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.884686e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.059656e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.327521e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 5.134026e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.584201e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.440618e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.524133e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.990007e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.887334e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.534977e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.705395e-03, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 5, 15) -*************************************************************************/ -static double mannwhitneyu_utbln5n15(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.851572e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.082033e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.095983e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.814595e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.073148e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.420213e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.517175e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.344180e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.371393e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.711443e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.228569e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.683483e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.267112e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.156044e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 9.131316e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.301023e-03, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 5, 16) -*************************************************************************/ -static double mannwhitneyu_utbln5n16(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.852210e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.077482e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.091186e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.797282e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.084994e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.667054e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.843909e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.456732e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.039830e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.723508e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.940608e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.478285e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.649144e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.237703e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.707410e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.874293e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 5, 17) -*************************************************************************/ -static double mannwhitneyu_utbln5n17(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.851752e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.071259e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.084700e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.758898e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.073846e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.684838e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.964936e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.782442e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.956362e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.984727e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.196936e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.558262e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.690746e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.364855e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.401006e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.546748e-03, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 5, 18) -*************************************************************************/ -static double mannwhitneyu_utbln5n18(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.850840e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.064799e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.077651e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.712659e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.049217e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.571333e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.929809e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.752044e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.949464e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.896101e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.614460e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.384357e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.489113e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.445725e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.945636e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.424653e-03, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 5, 19) -*************************************************************************/ -static double mannwhitneyu_utbln5n19(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.850027e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.059159e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.071106e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.669960e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.022780e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.442555e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.851335e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.433865e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.514465e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.332989e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 8.606099e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.341945e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.402164e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.039761e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 5.512831e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.284427e-05, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 5, 20) -*************************************************************************/ -static double mannwhitneyu_utbln5n20(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.849651e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.054729e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.065747e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.636243e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.003234e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.372789e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.831551e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.763090e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.830626e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.122384e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 8.108328e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.557983e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.945666e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.965696e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.493236e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.162591e-03, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 5, 21) -*************************************************************************/ -static double mannwhitneyu_utbln5n21(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.849649e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.051155e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.061430e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.608869e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.902788e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.346562e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.874709e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.682887e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.026206e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.534551e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.990575e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.713334e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 9.737011e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.304571e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.133110e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.123457e-03, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 5, 22) -*************************************************************************/ -static double mannwhitneyu_utbln5n22(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.849598e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.047605e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.057264e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.579513e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.749602e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.275137e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.881768e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.177374e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.981056e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.696290e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.886803e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.085378e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.675242e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.426367e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.039613e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.662378e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 5, 23) -*************************************************************************/ -static double mannwhitneyu_utbln5n23(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.849269e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.043761e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.052735e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.544683e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.517503e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.112082e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.782070e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.549483e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.747329e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.694263e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.147141e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.526209e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.039173e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.235615e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.656546e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.014423e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 5, 24) -*************************************************************************/ -static double mannwhitneyu_utbln5n24(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.848925e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.040178e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.048355e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.510198e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.261134e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.915864e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.627423e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.307345e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.732992e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.869652e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.494176e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.047533e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.178439e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.424171e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.829195e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.840810e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 5, 25) -*************************************************************************/ -static double mannwhitneyu_utbln5n25(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.848937e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.037512e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.044866e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.483269e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.063682e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.767778e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.508540e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.332756e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.881511e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.124041e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.368456e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.930499e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.779630e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.029528e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.658678e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.289695e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 5, 26) -*************************************************************************/ -static double mannwhitneyu_utbln5n26(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.849416e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.035915e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.042493e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.466021e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.956432e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.698914e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.465689e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.035254e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.674614e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.492734e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.014021e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.944953e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.255750e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.075841e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.989330e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.134862e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 5, 27) -*************************************************************************/ -static double mannwhitneyu_utbln5n27(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.850070e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.034815e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.040650e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.453117e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.886426e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.661702e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.452346e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.002476e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.720126e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.001400e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.729826e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.740640e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.206333e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.366093e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.193471e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.804091e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 5, 28) -*************************************************************************/ -static double mannwhitneyu_utbln5n28(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.850668e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.033786e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.038853e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.440281e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.806020e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.612883e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.420436e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.787982e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.535230e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.263121e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.849609e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.863967e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.391610e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.720294e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.952273e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.901413e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 5, 29) -*************************************************************************/ -static double mannwhitneyu_utbln5n29(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.851217e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.032834e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.037113e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.427762e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.719146e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.557172e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.375498e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.452033e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.187516e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.916936e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.065533e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.067301e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.615824e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.432244e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.417795e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.710038e-05, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 5, 30) -*************************************************************************/ -static double mannwhitneyu_utbln5n30(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.851845e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.032148e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.035679e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.417758e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.655330e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.522132e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.352106e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.326911e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.064969e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.813321e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.683881e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.813346e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.627085e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.832107e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.519336e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.888530e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 5, 100) -*************************************************************************/ -static double mannwhitneyu_utbln5n100(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.877940e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.039324e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.022243e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.305825e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.960119e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.112000e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.138868e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.418164e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.174520e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.489617e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.878301e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.302233e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.054113e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.458862e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.186591e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.623412e-05, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 6, 6) -*************************************************************************/ -static double mannwhitneyu_utbln6n6(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/2.882307e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.054075e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.998804e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.681518e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.067578e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.709435e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 9.952661e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.641700e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.304572e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.336275e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.770385e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 5.401891e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.246148e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.442663e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.502866e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.105855e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.739371e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 6, 7) -*************************************************************************/ -static double mannwhitneyu_utbln6n7(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.000000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.265287e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.274613e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.582352e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.334293e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.915502e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.108091e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.546701e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.298827e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.891501e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.313717e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.989501e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.914594e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.062372e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.158841e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.596443e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.185662e-03, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 6, 8) -*************************************************************************/ -static double mannwhitneyu_utbln6n8(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.098387e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.450954e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.520462e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.420299e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.604853e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.165840e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.008756e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.723402e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.843521e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.883405e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.720980e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.301709e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.948034e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.776243e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 8.623736e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.742068e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.796927e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 6, 9) -*************************************************************************/ -static double mannwhitneyu_utbln6n9(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.181981e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.616113e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.741650e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.204487e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.873068e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.446794e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.632286e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.266481e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.280067e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.780687e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.480242e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.592200e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.581019e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.264231e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.347174e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.167535e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.092185e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 6, 10) -*************************************************************************/ -static double mannwhitneyu_utbln6n10(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.253957e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.764382e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.942366e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.939896e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.137812e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.720270e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.281070e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.901060e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.824937e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.802812e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.258132e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.233536e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.085530e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.212151e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.001329e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.226048e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.035298e-03, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 6, 11) -*************************************************************************/ -static double mannwhitneyu_utbln6n11(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.316625e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.898597e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.125710e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.063297e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.396852e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.990126e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.927977e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.726500e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.858745e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.654590e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.217736e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.989770e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.768493e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.924364e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.140215e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.647914e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.924802e-03, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 6, 12) -*************************************************************************/ -static double mannwhitneyu_utbln6n12(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.371709e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.020941e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.294250e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.128842e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.650389e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.248611e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.578510e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.162852e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.746982e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.454209e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.128042e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.936650e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.530794e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.665192e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.994144e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.662249e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.368541e-03, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 6, 13) -*************************************************************************/ -static double mannwhitneyu_utbln6n13(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.420526e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.133167e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.450016e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.191088e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.898220e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.050249e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.226901e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.471113e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.007470e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.049420e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.059074e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.881249e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.452780e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.441805e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.787493e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.483957e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.481590e-03, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 6, 14) -*************************************************************************/ -static double mannwhitneyu_utbln6n14(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.450000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.201268e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.542568e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.226965e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.046029e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.136657e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.786757e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.843748e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.588022e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.253029e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.667188e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.788330e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.474545e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.540494e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.951188e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.863323e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.220904e-03, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 6, 15) -*************************************************************************/ -static double mannwhitneyu_utbln6n15(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.450000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.195689e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.526567e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.213617e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.975035e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.118480e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.859142e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.083312e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.298720e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.766708e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.026356e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.093113e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.135168e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.136376e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.190870e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.435972e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.413129e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 6, 30) -*************************************************************************/ -static double mannwhitneyu_utbln6n30(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.450000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.166269e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.427399e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.118239e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.360847e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.745885e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.025041e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.187179e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.432089e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.408451e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.388774e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.795560e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.304136e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.258516e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.180236e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.388679e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.836027e-06, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 6, 100) -*************************************************************************/ -static double mannwhitneyu_utbln6n100(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.450000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.181350e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.417919e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.094201e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.195883e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.818937e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.514202e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.125047e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.022148e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.284181e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.157766e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.023752e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.127985e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.221690e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.516179e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 9.501398e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 9.380220e-06, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 7, 7) -*************************************************************************/ -static double mannwhitneyu_utbln7n7(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.130495e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.501264e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.584790e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.577311e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.617002e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.145186e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.023462e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.408251e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 8.626515e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.072492e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.722926e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 5.095445e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.842602e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.751427e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.008927e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.892431e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.772386e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 7, 8) -*************************************************************************/ -static double mannwhitneyu_utbln7n8(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.240370e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.709965e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.862154e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.504541e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.900195e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.439995e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.678028e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.485540e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.437047e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.440092e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.114227e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.516569e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.829457e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.787550e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.761866e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.991911e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.533481e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 7, 9) -*************************************************************************/ -static double mannwhitneyu_utbln7n9(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.334314e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.896550e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.112671e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.037277e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.181695e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.765190e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.360116e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.695960e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.780578e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 8.963843e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.616148e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.852104e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.390744e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.014041e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.888101e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.467474e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.004611e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 7, 10) -*************************************************************************/ -static double mannwhitneyu_utbln7n10(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.415650e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.064844e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.340749e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.118888e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.459730e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.097781e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.057688e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.097406e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.209262e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.065641e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.196677e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.313994e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.827157e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.822284e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.389090e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.340850e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.395172e-03, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 7, 11) -*************************************************************************/ -static double mannwhitneyu_utbln7n11(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.486817e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.217795e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.549783e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.195905e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.733093e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.428447e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.760093e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.431676e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.717152e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.032199e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.832423e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.905979e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.302799e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.464371e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.456211e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.736244e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.140712e-03, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 7, 12) -*************************************************************************/ -static double mannwhitneyu_utbln7n12(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.500000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.235822e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.564100e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.190813e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.686546e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.395083e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.967359e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.747096e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.304144e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.903198e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.134906e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.175035e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.266224e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.892931e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 5.604706e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 9.070459e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.427010e-03, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 7, 13) -*************************************************************************/ -static double mannwhitneyu_utbln7n13(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.500000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.222204e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.532300e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.164642e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.523768e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.531984e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.467857e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.483804e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.524136e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.077740e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.745218e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.602085e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.828831e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.994070e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.873879e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.341937e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.706444e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 7, 14) -*************************************************************************/ -static double mannwhitneyu_utbln7n14(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.500000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.211763e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.507542e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.143640e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.395755e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.808020e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.044259e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.182308e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.057325e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.724255e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 8.303900e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.113148e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 8.102514e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.559442e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.634986e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.776476e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.054489e-05, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 7, 15) -*************************************************************************/ -static double mannwhitneyu_utbln7n15(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.500000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.204898e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.489960e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.129172e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.316741e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.506107e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.983676e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.258013e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.262515e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.984156e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.912108e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 8.974023e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 6.056195e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.090842e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.232620e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.816339e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.020421e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 7, 30) -*************************************************************************/ -static double mannwhitneyu_utbln7n30(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.500000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.176536e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.398705e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.045481e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.821982e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.962304e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.698132e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.062667e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.282353e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.014836e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.035683e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.004137e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.801453e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.920705e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.518735e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.821501e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.801008e-05, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 7, 100) -*************************************************************************/ -static double mannwhitneyu_utbln7n100(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.500000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.188337e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.386949e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.022834e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.686517e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.323516e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.399392e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.644333e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.617044e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.031396e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.792066e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.675457e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.673416e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.258552e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.174214e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.073644e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.349958e-06, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 8, 8) -*************************************************************************/ -static double mannwhitneyu_utbln8n8(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.360672e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -3.940217e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.168913e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.051485e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.195325e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.775196e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.385506e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.244902e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.525632e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.771275e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.332874e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.079599e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.882551e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.407944e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.769844e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.062433e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 5.872535e-05, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 8, 9) -*************************************************************************/ -static double mannwhitneyu_utbln8n9(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.464102e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.147004e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.446939e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.146155e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.488561e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.144561e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.116917e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.205667e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.515661e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.618616e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.599011e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.457324e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.482917e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.488267e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.469823e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.957591e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 8.058326e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 8, 10) -*************************************************************************/ -static double mannwhitneyu_utbln8n10(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.554093e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.334282e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.700860e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.235253e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.778489e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.527324e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.862885e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.589781e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.507355e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.717526e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 9.215726e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.848696e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.918854e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.219614e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.753761e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.573688e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.602177e-03, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 8, 11) -*************************************************************************/ -static double mannwhitneyu_utbln8n11(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.600000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.421882e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.812457e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.266153e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.849344e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.971527e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.258944e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.944820e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.894685e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.031836e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.514330e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.351660e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 6.206748e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.492600e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.005338e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.780099e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.673599e-03, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 8, 12) -*************************************************************************/ -static double mannwhitneyu_utbln8n12(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.600000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.398211e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.762214e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.226296e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.603837e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.643223e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.502438e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.544574e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.647734e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.442259e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.011484e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.384758e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.998259e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.659985e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.331046e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.638478e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.056785e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 8, 13) -*************************************************************************/ -static double mannwhitneyu_utbln8n13(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.600000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.380670e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.724511e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.195851e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.420511e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.609928e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.893999e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.115919e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.291410e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.339664e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.801548e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.534710e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.793250e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.806718e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.384624e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.120582e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.936453e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 8, 14) -*************************************************************************/ -static double mannwhitneyu_utbln8n14(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.600000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.368494e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.697171e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.174440e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.300621e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.087393e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.685826e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.085254e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.525658e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.966647e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.453388e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.826066e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.501958e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.336297e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.251972e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.118456e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.415959e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 8, 15) -*************************************************************************/ -static double mannwhitneyu_utbln8n15(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.600000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.358397e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.674485e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.155941e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.195780e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.544830e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.426183e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.309902e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.650956e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.068874e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.538544e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 8.192525e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.073905e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.079673e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 9.423572e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 6.579647e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.765904e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 8, 30) -*************************************************************************/ -static double mannwhitneyu_utbln8n30(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.600000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.318823e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.567159e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.064864e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.688413e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.153712e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.309389e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.226861e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.523815e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.780987e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.166866e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.922431e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.466397e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.690036e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.008185e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.271903e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.534751e-06, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 8, 100) -*************************************************************************/ -static double mannwhitneyu_utbln8n100(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.600000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.324531e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.547071e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.038129e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.541549e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.525605e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.044992e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.085713e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.017871e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.459226e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.092064e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.024349e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 7.366347e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 6.385637e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 8.321722e-08, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.439286e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.058079e-07, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 9, 9) -*************************************************************************/ -static double mannwhitneyu_utbln9n9(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.576237e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.372857e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.750859e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.248233e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.792868e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.559372e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.894941e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.643256e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.091370e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.285034e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 6.112997e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.806229e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.150741e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.509825e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.891051e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.485013e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.343653e-03, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 9, 10) -*************************************************************************/ -static double mannwhitneyu_utbln9n10(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.516726e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.939333e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.305046e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.935326e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.029141e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.420592e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.053140e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.065930e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.523581e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.544888e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.813741e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.510631e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.536057e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.833815e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.189692e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.615050e-03, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 9, 11) -*************************************************************************/ -static double mannwhitneyu_utbln9n11(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.481308e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.867483e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.249072e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.591790e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.400128e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.341992e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.463680e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.487211e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.671196e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.343472e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.544146e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.802335e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.117084e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.217443e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.858766e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.193687e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 9, 12) -*************************************************************************/ -static double mannwhitneyu_utbln9n12(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.456776e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.817037e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.209788e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.362108e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.171356e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.661557e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.026141e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.361908e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.093885e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.298389e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.663603e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.768522e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.579015e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.868677e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.440652e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.523037e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 9, 13) -*************************************************************************/ -static double mannwhitneyu_utbln9n13(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.438840e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.779308e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.180614e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.196489e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.346621e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.234857e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.796211e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.575715e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.525647e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.964651e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.275235e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.299124e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.397416e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.295781e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.237619e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 7.269692e-05, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 9, 14) -*************************************************************************/ -static double mannwhitneyu_utbln9n14(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.425981e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.751545e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.159543e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.086570e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.917446e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.120112e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.175519e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.515473e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.727772e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.070629e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.677569e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.876953e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.233502e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.508182e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.120389e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.847212e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 9, 15) -*************************************************************************/ -static double mannwhitneyu_utbln9n15(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.414952e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.727612e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.140634e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.981231e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.382635e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.853575e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.571051e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.567625e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.214197e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.448700e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.712669e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.015050e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 5.438610e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 6.301363e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 5.309386e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 5.164772e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 9, 30) -*************************************************************************/ -static double mannwhitneyu_utbln9n30(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.370720e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.615712e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.050023e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.504775e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.318265e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.646826e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.741492e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.735360e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.966911e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.100738e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.348991e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.527687e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.917286e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.397466e-07, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.360175e-07, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.892252e-07, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 9, 100) -*************************************************************************/ -static double mannwhitneyu_utbln9n100(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.372506e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.590966e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.021758e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.359849e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.755519e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.533166e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.936659e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.634913e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.730053e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.791845e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.030682e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.228663e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 8.631175e-07, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.636749e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.404599e-07, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.789872e-07, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 10, 10) -*************************************************************************/ -static double mannwhitneyu_utbln10n10(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.468831e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.844398e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.231728e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.486073e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.781321e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.971425e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.215371e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.828451e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.419872e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.430165e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.740363e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.049211e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.269371e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.211393e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.232314e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.016081e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 10, 11) -*************************************************************************/ -static double mannwhitneyu_utbln10n11(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.437998e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.782296e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.184732e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.219585e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.457012e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.296008e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.481501e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.527940e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.953426e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.563840e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.574403e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.535775e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.338037e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.002654e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.852676e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.318132e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 10, 12) -*************************************************************************/ -static double mannwhitneyu_utbln10n12(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.416082e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.737458e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.150952e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.036884e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.609030e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.908684e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.439666e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.162647e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.451601e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.148757e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.803981e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.731621e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.346903e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.013151e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.956148e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.438381e-05, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 10, 13) -*************************************************************************/ -static double mannwhitneyu_utbln10n13(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.399480e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.702863e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.124829e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.897428e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.979802e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.634368e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.180461e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.484926e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.864376e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.186576e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 5.886925e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 5.836828e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 5.074756e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.209547e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.883266e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.380143e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 10, 14) -*************************************************************************/ -static double mannwhitneyu_utbln10n14(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.386924e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.676124e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.104740e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.793826e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.558886e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.492462e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.052903e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.917782e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.878696e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.576046e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.764551e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.288778e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.757658e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.299101e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.265197e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.384503e-07, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 10, 15) -*************************************************************************/ -static double mannwhitneyu_utbln10n15(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.376846e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.654247e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.088083e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.705945e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.169677e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.317213e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.264836e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.548024e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.633910e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.505621e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.658588e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.320254e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.175277e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.122317e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.675688e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.661363e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 10, 30) -*************************************************************************/ -static double mannwhitneyu_utbln10n30(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.333977e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.548099e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.004444e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.291014e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.523674e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.828211e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.716917e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.894256e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.433371e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.522675e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.764192e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.140235e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.629230e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.541895e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.944946e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.726360e-06, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 10, 100) -*************************************************************************/ -static double mannwhitneyu_utbln10n100(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.334008e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.522316e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.769627e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.158110e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.053650e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.242235e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.173571e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.033661e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.824732e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.084420e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.610036e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.728155e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.217130e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.340966e-07, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.001235e-07, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.694052e-07, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 11, 11) -*************************************************************************/ -static double mannwhitneyu_utbln11n11(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.700000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.519760e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.880694e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.200698e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.174092e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.072304e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.054773e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.506613e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.813942e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.223644e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.417416e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.499166e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.194332e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 7.369096e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.968590e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.630532e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 5.061000e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 11, 12) -*************************************************************************/ -static double mannwhitneyu_utbln11n12(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.700000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.495790e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.832622e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.165420e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.987306e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.265621e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.723537e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.347406e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.353464e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 6.613369e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 5.102522e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 5.237709e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.665652e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.626903e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.167518e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.564455e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.047320e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 11, 13) -*************************************************************************/ -static double mannwhitneyu_utbln11n13(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.700000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.477880e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.796242e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.138769e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.851739e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.722104e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.548304e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.176683e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.817895e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.842451e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.935870e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 8.421777e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.238831e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 8.867026e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.458255e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.306259e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.961487e-05, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 11, 14) -*************************************************************************/ -static double mannwhitneyu_utbln11n14(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.700000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.463683e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.766969e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.117082e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.739574e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.238865e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.350306e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.425871e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.640172e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.660633e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.879883e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.349658e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.271795e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.304544e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.024201e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.816867e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.596787e-05, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 11, 15) -*************************************************************************/ -static double mannwhitneyu_utbln11n15(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.700000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.452526e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.743570e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.099705e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.650612e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.858285e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.187036e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.689241e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.294360e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.072623e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.278008e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.322382e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.131558e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.305669e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.825627e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.332689e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.120973e-05, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 11, 30) -*************************************************************************/ -static double mannwhitneyu_utbln11n30(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.700000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.402621e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.627440e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.011333e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.224126e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.232856e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.859347e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.377381e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.756709e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.033230e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.875472e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.608399e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.102943e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.740693e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.343139e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.196878e-07, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.658062e-07, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 11, 100) -*************************************************************************/ -static double mannwhitneyu_utbln11n100(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.700000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.398795e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.596486e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.814761e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.085187e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.766529e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.379425e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.986351e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.214705e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.360075e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.260869e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.033307e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.727087e-07, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.393883e-07, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.242989e-07, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.111928e-07, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.898823e-09, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 12, 12) -*************************************************************************/ -static double mannwhitneyu_utbln12n12(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.700000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.472616e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.786627e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.132099e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.817523e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.570179e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.479511e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.799492e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.565350e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.530139e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.380132e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.242761e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.576269e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.018771e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.933911e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 9.002799e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.022048e-06, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 12, 13) -*************************************************************************/ -static double mannwhitneyu_utbln12n13(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.700000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.454800e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.750794e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.105988e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.684754e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.011826e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.262579e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.044492e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.478741e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.322165e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.621104e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.068753e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.468396e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.056235e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.327375e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.914877e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.784191e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 12, 14) -*************************************************************************/ -static double mannwhitneyu_utbln12n14(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.700000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.440910e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.722404e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.085254e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.579439e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.563738e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.066730e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.129346e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.014531e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.129679e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.000909e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.996174e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 6.377924e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 8.936304e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.051098e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 9.025820e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 8.730585e-05, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 12, 15) -*************************************************************************/ -static double mannwhitneyu_utbln12n15(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.700000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.430123e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.700008e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.068971e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.499725e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.250897e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.473145e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.680008e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.483350e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.766992e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.891081e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.015140e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.977756e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.707414e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.114786e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 6.238865e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.381445e-05, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 12, 30) -*************************************************************************/ -static double mannwhitneyu_utbln12n30(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.700000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.380023e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.585782e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.838583e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.103394e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.834015e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.635212e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.948212e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.574169e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.747980e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.833672e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.722433e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.181038e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.206473e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.716003e-07, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.476434e-07, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.217700e-07, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 12, 100) -*************************************************************************/ -static double mannwhitneyu_utbln12n100(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.700000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.374567e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.553481e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.541334e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.701907e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.414757e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.404103e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.234388e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.453762e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.311060e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.317501e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.713888e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.309583e-07, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.019804e-08, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.224829e-09, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.349019e-08, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.893302e-08, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 13, 13) -*************************************************************************/ -static double mannwhitneyu_utbln13n13(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.750000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.541046e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.859047e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.130164e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.689719e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.950693e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.231455e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.976550e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.538455e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.245603e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.142647e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.831434e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.032483e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.488405e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.156927e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.949279e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.532700e-05, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 13, 14) -*************************************************************************/ -static double mannwhitneyu_utbln13n14(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.750000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.525655e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.828341e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.108110e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.579552e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.488307e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.032328e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.988741e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.766394e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.388950e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.338179e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.133440e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.023518e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.110570e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.202332e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.056132e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.536323e-05, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 13, 15) -*************************************************************************/ -static double mannwhitneyu_utbln13n15(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.750000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.513585e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.803952e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.090686e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.495310e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.160314e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.073124e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.480313e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.478239e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.140914e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.311541e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.677105e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.115464e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.578563e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.044604e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.888939e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 2.395644e-05, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 13, 30) -*************************************************************************/ -static double mannwhitneyu_utbln13n30(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.750000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.455999e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.678434e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.995491e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.078100e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.705220e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.258739e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.671526e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.185458e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.507764e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.411446e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.044355e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.285765e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.345282e-07, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.066940e-07, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.962037e-07, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.723644e-07, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 13, 100) -*************************************************************************/ -static double mannwhitneyu_utbln13n100(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.750000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.446787e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.640804e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.671552e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.364990e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.274444e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.047440e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.161439e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.171729e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.562171e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.359762e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.275494e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.747635e-07, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.700292e-08, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.565559e-09, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 5.005396e-09, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 3.335794e-09, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 14, 14) -*************************************************************************/ -static double mannwhitneyu_utbln14n14(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.750000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.510624e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.798584e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.087107e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.478532e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.098050e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.855986e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.409083e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.299536e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.176177e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.479417e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.812761e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -5.225872e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 4.516521e-07, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 6.730551e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 9.237563e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.611820e-05, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 14, 15) -*************************************************************************/ -static double mannwhitneyu_utbln14n15(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.750000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.498681e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.774668e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.070267e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.399348e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.807239e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.845763e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.071773e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.261698e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.011695e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.305946e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.879295e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.999439e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.904438e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.944986e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.373908e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.140794e-05, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 14, 30) -*************************************************************************/ -static double mannwhitneyu_utbln14n30(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.750000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.440378e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.649587e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.807829e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.989753e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.463646e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.586580e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -6.745917e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.635398e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.923172e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.446699e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.613892e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.214073e-07, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.651683e-07, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.272777e-07, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.464988e-07, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.109803e-07, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 14, 100) -*************************************************************************/ -static double mannwhitneyu_utbln14n100(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/3.750000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - mannwhitneyu_ucheb(x, -4.429701e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -4.610577e+00, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -9.482675e-01, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.605550e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.062151e-02, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.525154e-03, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.835983e-04, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -8.411440e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.744901e-05, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.318850e-06, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.692100e-07, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -1.536270e-07, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -3.705888e-08, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -7.999599e-09, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, -2.908395e-09, &tj, &tj1, &result, _state); - mannwhitneyu_ucheb(x, 1.546923e-09, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, N1, N2) -*************************************************************************/ -static double mannwhitneyu_usigma(double s, - ae_int_t n1, - ae_int_t n2, - ae_state *_state) -{ - double f0; - double f1; - double f2; - double f3; - double f4; - double s0; - double s1; - double s2; - double s3; - double s4; - double result; - - - result = 0; - - /* - * N1=5, N2 = 5, 6, 7, ... - */ - if( ae_minint(n1, n2, _state)==5 ) - { - if( ae_maxint(n1, n2, _state)==5 ) - { - result = mannwhitneyu_utbln5n5(s, _state); - } - if( ae_maxint(n1, n2, _state)==6 ) - { - result = mannwhitneyu_utbln5n6(s, _state); - } - if( ae_maxint(n1, n2, _state)==7 ) - { - result = mannwhitneyu_utbln5n7(s, _state); - } - if( ae_maxint(n1, n2, _state)==8 ) - { - result = mannwhitneyu_utbln5n8(s, _state); - } - if( ae_maxint(n1, n2, _state)==9 ) - { - result = mannwhitneyu_utbln5n9(s, _state); - } - if( ae_maxint(n1, n2, _state)==10 ) - { - result = mannwhitneyu_utbln5n10(s, _state); - } - if( ae_maxint(n1, n2, _state)==11 ) - { - result = mannwhitneyu_utbln5n11(s, _state); - } - if( ae_maxint(n1, n2, _state)==12 ) - { - result = mannwhitneyu_utbln5n12(s, _state); - } - if( ae_maxint(n1, n2, _state)==13 ) - { - result = mannwhitneyu_utbln5n13(s, _state); - } - if( ae_maxint(n1, n2, _state)==14 ) - { - result = mannwhitneyu_utbln5n14(s, _state); - } - if( ae_maxint(n1, n2, _state)==15 ) - { - result = mannwhitneyu_utbln5n15(s, _state); - } - if( ae_maxint(n1, n2, _state)==16 ) - { - result = mannwhitneyu_utbln5n16(s, _state); - } - if( ae_maxint(n1, n2, _state)==17 ) - { - result = mannwhitneyu_utbln5n17(s, _state); - } - if( ae_maxint(n1, n2, _state)==18 ) - { - result = mannwhitneyu_utbln5n18(s, _state); - } - if( ae_maxint(n1, n2, _state)==19 ) - { - result = mannwhitneyu_utbln5n19(s, _state); - } - if( ae_maxint(n1, n2, _state)==20 ) - { - result = mannwhitneyu_utbln5n20(s, _state); - } - if( ae_maxint(n1, n2, _state)==21 ) - { - result = mannwhitneyu_utbln5n21(s, _state); - } - if( ae_maxint(n1, n2, _state)==22 ) - { - result = mannwhitneyu_utbln5n22(s, _state); - } - if( ae_maxint(n1, n2, _state)==23 ) - { - result = mannwhitneyu_utbln5n23(s, _state); - } - if( ae_maxint(n1, n2, _state)==24 ) - { - result = mannwhitneyu_utbln5n24(s, _state); - } - if( ae_maxint(n1, n2, _state)==25 ) - { - result = mannwhitneyu_utbln5n25(s, _state); - } - if( ae_maxint(n1, n2, _state)==26 ) - { - result = mannwhitneyu_utbln5n26(s, _state); - } - if( ae_maxint(n1, n2, _state)==27 ) - { - result = mannwhitneyu_utbln5n27(s, _state); - } - if( ae_maxint(n1, n2, _state)==28 ) - { - result = mannwhitneyu_utbln5n28(s, _state); - } - if( ae_maxint(n1, n2, _state)==29 ) - { - result = mannwhitneyu_utbln5n29(s, _state); - } - if( ae_maxint(n1, n2, _state)>29 ) - { - f0 = mannwhitneyu_utbln5n15(s, _state); - f1 = mannwhitneyu_utbln5n30(s, _state); - f2 = mannwhitneyu_utbln5n100(s, _state); - result = mannwhitneyu_uninterpolate(f0, f1, f2, ae_maxint(n1, n2, _state), _state); - } - return result; - } - - /* - * N1=6, N2 = 6, 7, 8, ... - */ - if( ae_minint(n1, n2, _state)==6 ) - { - if( ae_maxint(n1, n2, _state)==6 ) - { - result = mannwhitneyu_utbln6n6(s, _state); - } - if( ae_maxint(n1, n2, _state)==7 ) - { - result = mannwhitneyu_utbln6n7(s, _state); - } - if( ae_maxint(n1, n2, _state)==8 ) - { - result = mannwhitneyu_utbln6n8(s, _state); - } - if( ae_maxint(n1, n2, _state)==9 ) - { - result = mannwhitneyu_utbln6n9(s, _state); - } - if( ae_maxint(n1, n2, _state)==10 ) - { - result = mannwhitneyu_utbln6n10(s, _state); - } - if( ae_maxint(n1, n2, _state)==11 ) - { - result = mannwhitneyu_utbln6n11(s, _state); - } - if( ae_maxint(n1, n2, _state)==12 ) - { - result = mannwhitneyu_utbln6n12(s, _state); - } - if( ae_maxint(n1, n2, _state)==13 ) - { - result = mannwhitneyu_utbln6n13(s, _state); - } - if( ae_maxint(n1, n2, _state)==14 ) - { - result = mannwhitneyu_utbln6n14(s, _state); - } - if( ae_maxint(n1, n2, _state)==15 ) - { - result = mannwhitneyu_utbln6n15(s, _state); - } - if( ae_maxint(n1, n2, _state)>15 ) - { - f0 = mannwhitneyu_utbln6n15(s, _state); - f1 = mannwhitneyu_utbln6n30(s, _state); - f2 = mannwhitneyu_utbln6n100(s, _state); - result = mannwhitneyu_uninterpolate(f0, f1, f2, ae_maxint(n1, n2, _state), _state); - } - return result; - } - - /* - * N1=7, N2 = 7, 8, ... - */ - if( ae_minint(n1, n2, _state)==7 ) - { - if( ae_maxint(n1, n2, _state)==7 ) - { - result = mannwhitneyu_utbln7n7(s, _state); - } - if( ae_maxint(n1, n2, _state)==8 ) - { - result = mannwhitneyu_utbln7n8(s, _state); - } - if( ae_maxint(n1, n2, _state)==9 ) - { - result = mannwhitneyu_utbln7n9(s, _state); - } - if( ae_maxint(n1, n2, _state)==10 ) - { - result = mannwhitneyu_utbln7n10(s, _state); - } - if( ae_maxint(n1, n2, _state)==11 ) - { - result = mannwhitneyu_utbln7n11(s, _state); - } - if( ae_maxint(n1, n2, _state)==12 ) - { - result = mannwhitneyu_utbln7n12(s, _state); - } - if( ae_maxint(n1, n2, _state)==13 ) - { - result = mannwhitneyu_utbln7n13(s, _state); - } - if( ae_maxint(n1, n2, _state)==14 ) - { - result = mannwhitneyu_utbln7n14(s, _state); - } - if( ae_maxint(n1, n2, _state)==15 ) - { - result = mannwhitneyu_utbln7n15(s, _state); - } - if( ae_maxint(n1, n2, _state)>15 ) - { - f0 = mannwhitneyu_utbln7n15(s, _state); - f1 = mannwhitneyu_utbln7n30(s, _state); - f2 = mannwhitneyu_utbln7n100(s, _state); - result = mannwhitneyu_uninterpolate(f0, f1, f2, ae_maxint(n1, n2, _state), _state); - } - return result; - } - - /* - * N1=8, N2 = 8, 9, 10, ... - */ - if( ae_minint(n1, n2, _state)==8 ) - { - if( ae_maxint(n1, n2, _state)==8 ) - { - result = mannwhitneyu_utbln8n8(s, _state); - } - if( ae_maxint(n1, n2, _state)==9 ) - { - result = mannwhitneyu_utbln8n9(s, _state); - } - if( ae_maxint(n1, n2, _state)==10 ) - { - result = mannwhitneyu_utbln8n10(s, _state); - } - if( ae_maxint(n1, n2, _state)==11 ) - { - result = mannwhitneyu_utbln8n11(s, _state); - } - if( ae_maxint(n1, n2, _state)==12 ) - { - result = mannwhitneyu_utbln8n12(s, _state); - } - if( ae_maxint(n1, n2, _state)==13 ) - { - result = mannwhitneyu_utbln8n13(s, _state); - } - if( ae_maxint(n1, n2, _state)==14 ) - { - result = mannwhitneyu_utbln8n14(s, _state); - } - if( ae_maxint(n1, n2, _state)==15 ) - { - result = mannwhitneyu_utbln8n15(s, _state); - } - if( ae_maxint(n1, n2, _state)>15 ) - { - f0 = mannwhitneyu_utbln8n15(s, _state); - f1 = mannwhitneyu_utbln8n30(s, _state); - f2 = mannwhitneyu_utbln8n100(s, _state); - result = mannwhitneyu_uninterpolate(f0, f1, f2, ae_maxint(n1, n2, _state), _state); - } - return result; - } - - /* - * N1=9, N2 = 9, 10, ... - */ - if( ae_minint(n1, n2, _state)==9 ) - { - if( ae_maxint(n1, n2, _state)==9 ) - { - result = mannwhitneyu_utbln9n9(s, _state); - } - if( ae_maxint(n1, n2, _state)==10 ) - { - result = mannwhitneyu_utbln9n10(s, _state); - } - if( ae_maxint(n1, n2, _state)==11 ) - { - result = mannwhitneyu_utbln9n11(s, _state); - } - if( ae_maxint(n1, n2, _state)==12 ) - { - result = mannwhitneyu_utbln9n12(s, _state); - } - if( ae_maxint(n1, n2, _state)==13 ) - { - result = mannwhitneyu_utbln9n13(s, _state); - } - if( ae_maxint(n1, n2, _state)==14 ) - { - result = mannwhitneyu_utbln9n14(s, _state); - } - if( ae_maxint(n1, n2, _state)==15 ) - { - result = mannwhitneyu_utbln9n15(s, _state); - } - if( ae_maxint(n1, n2, _state)>15 ) - { - f0 = mannwhitneyu_utbln9n15(s, _state); - f1 = mannwhitneyu_utbln9n30(s, _state); - f2 = mannwhitneyu_utbln9n100(s, _state); - result = mannwhitneyu_uninterpolate(f0, f1, f2, ae_maxint(n1, n2, _state), _state); - } - return result; - } - - /* - * N1=10, N2 = 10, 11, ... - */ - if( ae_minint(n1, n2, _state)==10 ) - { - if( ae_maxint(n1, n2, _state)==10 ) - { - result = mannwhitneyu_utbln10n10(s, _state); - } - if( ae_maxint(n1, n2, _state)==11 ) - { - result = mannwhitneyu_utbln10n11(s, _state); - } - if( ae_maxint(n1, n2, _state)==12 ) - { - result = mannwhitneyu_utbln10n12(s, _state); - } - if( ae_maxint(n1, n2, _state)==13 ) - { - result = mannwhitneyu_utbln10n13(s, _state); - } - if( ae_maxint(n1, n2, _state)==14 ) - { - result = mannwhitneyu_utbln10n14(s, _state); - } - if( ae_maxint(n1, n2, _state)==15 ) - { - result = mannwhitneyu_utbln10n15(s, _state); - } - if( ae_maxint(n1, n2, _state)>15 ) - { - f0 = mannwhitneyu_utbln10n15(s, _state); - f1 = mannwhitneyu_utbln10n30(s, _state); - f2 = mannwhitneyu_utbln10n100(s, _state); - result = mannwhitneyu_uninterpolate(f0, f1, f2, ae_maxint(n1, n2, _state), _state); - } - return result; - } - - /* - * N1=11, N2 = 11, 12, ... - */ - if( ae_minint(n1, n2, _state)==11 ) - { - if( ae_maxint(n1, n2, _state)==11 ) - { - result = mannwhitneyu_utbln11n11(s, _state); - } - if( ae_maxint(n1, n2, _state)==12 ) - { - result = mannwhitneyu_utbln11n12(s, _state); - } - if( ae_maxint(n1, n2, _state)==13 ) - { - result = mannwhitneyu_utbln11n13(s, _state); - } - if( ae_maxint(n1, n2, _state)==14 ) - { - result = mannwhitneyu_utbln11n14(s, _state); - } - if( ae_maxint(n1, n2, _state)==15 ) - { - result = mannwhitneyu_utbln11n15(s, _state); - } - if( ae_maxint(n1, n2, _state)>15 ) - { - f0 = mannwhitneyu_utbln11n15(s, _state); - f1 = mannwhitneyu_utbln11n30(s, _state); - f2 = mannwhitneyu_utbln11n100(s, _state); - result = mannwhitneyu_uninterpolate(f0, f1, f2, ae_maxint(n1, n2, _state), _state); - } - return result; - } - - /* - * N1=12, N2 = 12, 13, ... - */ - if( ae_minint(n1, n2, _state)==12 ) - { - if( ae_maxint(n1, n2, _state)==12 ) - { - result = mannwhitneyu_utbln12n12(s, _state); - } - if( ae_maxint(n1, n2, _state)==13 ) - { - result = mannwhitneyu_utbln12n13(s, _state); - } - if( ae_maxint(n1, n2, _state)==14 ) - { - result = mannwhitneyu_utbln12n14(s, _state); - } - if( ae_maxint(n1, n2, _state)==15 ) - { - result = mannwhitneyu_utbln12n15(s, _state); - } - if( ae_maxint(n1, n2, _state)>15 ) - { - f0 = mannwhitneyu_utbln12n15(s, _state); - f1 = mannwhitneyu_utbln12n30(s, _state); - f2 = mannwhitneyu_utbln12n100(s, _state); - result = mannwhitneyu_uninterpolate(f0, f1, f2, ae_maxint(n1, n2, _state), _state); - } - return result; - } - - /* - * N1=13, N2 = 13, 14, ... - */ - if( ae_minint(n1, n2, _state)==13 ) - { - if( ae_maxint(n1, n2, _state)==13 ) - { - result = mannwhitneyu_utbln13n13(s, _state); - } - if( ae_maxint(n1, n2, _state)==14 ) - { - result = mannwhitneyu_utbln13n14(s, _state); - } - if( ae_maxint(n1, n2, _state)==15 ) - { - result = mannwhitneyu_utbln13n15(s, _state); - } - if( ae_maxint(n1, n2, _state)>15 ) - { - f0 = mannwhitneyu_utbln13n15(s, _state); - f1 = mannwhitneyu_utbln13n30(s, _state); - f2 = mannwhitneyu_utbln13n100(s, _state); - result = mannwhitneyu_uninterpolate(f0, f1, f2, ae_maxint(n1, n2, _state), _state); - } - return result; - } - - /* - * N1=14, N2 = 14, 15, ... - */ - if( ae_minint(n1, n2, _state)==14 ) - { - if( ae_maxint(n1, n2, _state)==14 ) - { - result = mannwhitneyu_utbln14n14(s, _state); - } - if( ae_maxint(n1, n2, _state)==15 ) - { - result = mannwhitneyu_utbln14n15(s, _state); - } - if( ae_maxint(n1, n2, _state)>15 ) - { - f0 = mannwhitneyu_utbln14n15(s, _state); - f1 = mannwhitneyu_utbln14n30(s, _state); - f2 = mannwhitneyu_utbln14n100(s, _state); - result = mannwhitneyu_uninterpolate(f0, f1, f2, ae_maxint(n1, n2, _state), _state); - } - return result; - } - - /* - * N1 >= 15, N2 >= 15 - */ - if( ae_fp_greater(s,4) ) - { - s = 4; - } - if( ae_fp_less(s,3) ) - { - s0 = 0.000000e+00; - f0 = mannwhitneyu_usigma000(n1, n2, _state); - s1 = 7.500000e-01; - f1 = mannwhitneyu_usigma075(n1, n2, _state); - s2 = 1.500000e+00; - f2 = mannwhitneyu_usigma150(n1, n2, _state); - s3 = 2.250000e+00; - f3 = mannwhitneyu_usigma225(n1, n2, _state); - s4 = 3.000000e+00; - f4 = mannwhitneyu_usigma300(n1, n2, _state); - f1 = ((s-s0)*f1-(s-s1)*f0)/(s1-s0); - f2 = ((s-s0)*f2-(s-s2)*f0)/(s2-s0); - f3 = ((s-s0)*f3-(s-s3)*f0)/(s3-s0); - f4 = ((s-s0)*f4-(s-s4)*f0)/(s4-s0); - f2 = ((s-s1)*f2-(s-s2)*f1)/(s2-s1); - f3 = ((s-s1)*f3-(s-s3)*f1)/(s3-s1); - f4 = ((s-s1)*f4-(s-s4)*f1)/(s4-s1); - f3 = ((s-s2)*f3-(s-s3)*f2)/(s3-s2); - f4 = ((s-s2)*f4-(s-s4)*f2)/(s4-s2); - f4 = ((s-s3)*f4-(s-s4)*f3)/(s4-s3); - result = f4; - } - else - { - s0 = 3.000000e+00; - f0 = mannwhitneyu_usigma300(n1, n2, _state); - s1 = 3.333333e+00; - f1 = mannwhitneyu_usigma333(n1, n2, _state); - s2 = 3.666667e+00; - f2 = mannwhitneyu_usigma367(n1, n2, _state); - s3 = 4.000000e+00; - f3 = mannwhitneyu_usigma400(n1, n2, _state); - f1 = ((s-s0)*f1-(s-s1)*f0)/(s1-s0); - f2 = ((s-s0)*f2-(s-s2)*f0)/(s2-s0); - f3 = ((s-s0)*f3-(s-s3)*f0)/(s3-s0); - f2 = ((s-s1)*f2-(s-s2)*f1)/(s2-s1); - f3 = ((s-s1)*f3-(s-s3)*f1)/(s3-s1); - f3 = ((s-s2)*f3-(s-s3)*f2)/(s3-s2); - result = f3; - } - return result; -} - - - - -/************************************************************************* -Sign test - -This test checks three hypotheses about the median of the given sample. -The following tests are performed: - * two-tailed test (null hypothesis - the median is equal to the given - value) - * left-tailed test (null hypothesis - the median is greater than or - equal to the given value) - * right-tailed test (null hypothesis - the median is less than or - equal to the given value) - -Requirements: - * the scale of measurement should be ordinal, interval or ratio (i.e. - the test could not be applied to nominal variables). - -The test is non-parametric and doesn't require distribution X to be normal - -Input parameters: - X - sample. Array whose index goes from 0 to N-1. - N - size of the sample. - Median - assumed median value. - -Output parameters: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - -While calculating p-values high-precision binomial distribution -approximation is used, so significance levels have about 15 exact digits. - - -- ALGLIB -- - Copyright 08.09.2006 by Bochkanov Sergey -*************************************************************************/ -void onesamplesigntest(/* Real */ ae_vector* x, - ae_int_t n, - double median, - double* bothtails, - double* lefttail, - double* righttail, - ae_state *_state) -{ - ae_int_t i; - ae_int_t gtcnt; - ae_int_t necnt; - - *bothtails = 0; - *lefttail = 0; - *righttail = 0; - - if( n<=1 ) - { - *bothtails = 1.0; - *lefttail = 1.0; - *righttail = 1.0; - return; - } - - /* - * Calculate: - * GTCnt - count of x[i]>Median - * NECnt - count of x[i]<>Median - */ - gtcnt = 0; - necnt = 0; - for(i=0; i<=n-1; i++) - { - if( ae_fp_greater(x->ptr.p_double[i],median) ) - { - gtcnt = gtcnt+1; - } - if( ae_fp_neq(x->ptr.p_double[i],median) ) - { - necnt = necnt+1; - } - } - if( necnt==0 ) - { - - /* - * all x[i] are equal to Median. - * So we can conclude that Median is a true median :) - */ - *bothtails = 1.0; - *lefttail = 1.0; - *righttail = 1.0; - return; - } - *bothtails = ae_minreal(2*binomialdistribution(ae_minint(gtcnt, necnt-gtcnt, _state), necnt, 0.5, _state), 1.0, _state); - *lefttail = binomialdistribution(gtcnt, necnt, 0.5, _state); - *righttail = binomialcdistribution(gtcnt-1, necnt, 0.5, _state); -} - - - - -/************************************************************************* -One-sample t-test - -This test checks three hypotheses about the mean of the given sample. The -following tests are performed: - * two-tailed test (null hypothesis - the mean is equal to the given - value) - * left-tailed test (null hypothesis - the mean is greater than or - equal to the given value) - * right-tailed test (null hypothesis - the mean is less than or equal - to the given value). - -The test is based on the assumption that a given sample has a normal -distribution and an unknown dispersion. If the distribution sharply -differs from normal, the test will work incorrectly. - -INPUT PARAMETERS: - X - sample. Array whose index goes from 0 to N-1. - N - size of sample, N>=0 - Mean - assumed value of the mean. - -OUTPUT PARAMETERS: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - -NOTE: this function correctly handles degenerate cases: - * when N=0, all p-values are set to 1.0 - * when variance of X[] is exactly zero, p-values are set - to 1.0 or 0.0, depending on difference between sample mean and - value of mean being tested. - - - -- ALGLIB -- - Copyright 08.09.2006 by Bochkanov Sergey -*************************************************************************/ -void studentttest1(/* Real */ ae_vector* x, - ae_int_t n, - double mean, - double* bothtails, - double* lefttail, - double* righttail, - ae_state *_state) -{ - ae_int_t i; - double xmean; - double x0; - double v; - ae_bool samex; - double xvariance; - double xstddev; - double v1; - double v2; - double stat; - double s; - - *bothtails = 0; - *lefttail = 0; - *righttail = 0; - - if( n<=0 ) - { - *bothtails = 1.0; - *lefttail = 1.0; - *righttail = 1.0; - return; - } - - /* - * Mean - */ - xmean = 0; - x0 = x->ptr.p_double[0]; - samex = ae_true; - for(i=0; i<=n-1; i++) - { - v = x->ptr.p_double[i]; - xmean = xmean+v; - samex = samex&&ae_fp_eq(v,x0); - } - if( samex ) - { - xmean = x0; - } - else - { - xmean = xmean/n; - } - - /* - * Variance (using corrected two-pass algorithm) - */ - xvariance = 0; - xstddev = 0; - if( n!=1&&!samex ) - { - v1 = 0; - for(i=0; i<=n-1; i++) - { - v1 = v1+ae_sqr(x->ptr.p_double[i]-xmean, _state); - } - v2 = 0; - for(i=0; i<=n-1; i++) - { - v2 = v2+(x->ptr.p_double[i]-xmean); - } - v2 = ae_sqr(v2, _state)/n; - xvariance = (v1-v2)/(n-1); - if( ae_fp_less(xvariance,0) ) - { - xvariance = 0; - } - xstddev = ae_sqrt(xvariance, _state); - } - if( ae_fp_eq(xstddev,0) ) - { - if( ae_fp_eq(xmean,mean) ) - { - *bothtails = 1.0; - } - else - { - *bothtails = 0.0; - } - if( ae_fp_greater_eq(xmean,mean) ) - { - *lefttail = 1.0; - } - else - { - *lefttail = 0.0; - } - if( ae_fp_less_eq(xmean,mean) ) - { - *righttail = 1.0; - } - else - { - *righttail = 0.0; - } - return; - } - - /* - * Statistic - */ - stat = (xmean-mean)/(xstddev/ae_sqrt(n, _state)); - s = studenttdistribution(n-1, stat, _state); - *bothtails = 2*ae_minreal(s, 1-s, _state); - *lefttail = s; - *righttail = 1-s; -} - - -/************************************************************************* -Two-sample pooled test - -This test checks three hypotheses about the mean of the given samples. The -following tests are performed: - * two-tailed test (null hypothesis - the means are equal) - * left-tailed test (null hypothesis - the mean of the first sample is - greater than or equal to the mean of the second sample) - * right-tailed test (null hypothesis - the mean of the first sample is - less than or equal to the mean of the second sample). - -Test is based on the following assumptions: - * given samples have normal distributions - * dispersions are equal - * samples are independent. - -Input parameters: - X - sample 1. Array whose index goes from 0 to N-1. - N - size of sample. - Y - sample 2. Array whose index goes from 0 to M-1. - M - size of sample. - -Output parameters: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - -NOTE: this function correctly handles degenerate cases: - * when N=0 or M=0, all p-values are set to 1.0 - * when both samples has exactly zero variance, p-values are set - to 1.0 or 0.0, depending on difference between means. - - -- ALGLIB -- - Copyright 18.09.2006 by Bochkanov Sergey -*************************************************************************/ -void studentttest2(/* Real */ ae_vector* x, - ae_int_t n, - /* Real */ ae_vector* y, - ae_int_t m, - double* bothtails, - double* lefttail, - double* righttail, - ae_state *_state) -{ - ae_int_t i; - ae_bool samex; - ae_bool samey; - double x0; - double y0; - double xmean; - double ymean; - double v; - double stat; - double s; - double p; - - *bothtails = 0; - *lefttail = 0; - *righttail = 0; - - if( n<=0||m<=0 ) - { - *bothtails = 1.0; - *lefttail = 1.0; - *righttail = 1.0; - return; - } - - /* - * Mean - */ - xmean = 0; - x0 = x->ptr.p_double[0]; - samex = ae_true; - for(i=0; i<=n-1; i++) - { - v = x->ptr.p_double[i]; - xmean = xmean+v; - samex = samex&&ae_fp_eq(v,x0); - } - if( samex ) - { - xmean = x0; - } - else - { - xmean = xmean/n; - } - ymean = 0; - y0 = y->ptr.p_double[0]; - samey = ae_true; - for(i=0; i<=m-1; i++) - { - v = y->ptr.p_double[i]; - ymean = ymean+v; - samey = samey&&ae_fp_eq(v,y0); - } - if( samey ) - { - ymean = y0; - } - else - { - ymean = ymean/m; - } - - /* - * S - */ - s = 0; - if( n+m>2 ) - { - for(i=0; i<=n-1; i++) - { - s = s+ae_sqr(x->ptr.p_double[i]-xmean, _state); - } - for(i=0; i<=m-1; i++) - { - s = s+ae_sqr(y->ptr.p_double[i]-ymean, _state); - } - s = ae_sqrt(s*((double)1/(double)n+(double)1/(double)m)/(n+m-2), _state); - } - if( ae_fp_eq(s,0) ) - { - if( ae_fp_eq(xmean,ymean) ) - { - *bothtails = 1.0; - } - else - { - *bothtails = 0.0; - } - if( ae_fp_greater_eq(xmean,ymean) ) - { - *lefttail = 1.0; - } - else - { - *lefttail = 0.0; - } - if( ae_fp_less_eq(xmean,ymean) ) - { - *righttail = 1.0; - } - else - { - *righttail = 0.0; - } - return; - } - - /* - * Statistic - */ - stat = (xmean-ymean)/s; - p = studenttdistribution(n+m-2, stat, _state); - *bothtails = 2*ae_minreal(p, 1-p, _state); - *lefttail = p; - *righttail = 1-p; -} - - -/************************************************************************* -Two-sample unpooled test - -This test checks three hypotheses about the mean of the given samples. The -following tests are performed: - * two-tailed test (null hypothesis - the means are equal) - * left-tailed test (null hypothesis - the mean of the first sample is - greater than or equal to the mean of the second sample) - * right-tailed test (null hypothesis - the mean of the first sample is - less than or equal to the mean of the second sample). - -Test is based on the following assumptions: - * given samples have normal distributions - * samples are independent. -Equality of variances is NOT required. - -Input parameters: - X - sample 1. Array whose index goes from 0 to N-1. - N - size of the sample. - Y - sample 2. Array whose index goes from 0 to M-1. - M - size of the sample. - -Output parameters: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - -NOTE: this function correctly handles degenerate cases: - * when N=0 or M=0, all p-values are set to 1.0 - * when both samples has zero variance, p-values are set - to 1.0 or 0.0, depending on difference between means. - * when only one sample has zero variance, test reduces to 1-sample - version. - - -- ALGLIB -- - Copyright 18.09.2006 by Bochkanov Sergey -*************************************************************************/ -void unequalvariancettest(/* Real */ ae_vector* x, - ae_int_t n, - /* Real */ ae_vector* y, - ae_int_t m, - double* bothtails, - double* lefttail, - double* righttail, - ae_state *_state) -{ - ae_int_t i; - ae_bool samex; - ae_bool samey; - double x0; - double y0; - double xmean; - double ymean; - double xvar; - double yvar; - double v; - double df; - double p; - double stat; - double c; - - *bothtails = 0; - *lefttail = 0; - *righttail = 0; - - if( n<=0||m<=0 ) - { - *bothtails = 1.0; - *lefttail = 1.0; - *righttail = 1.0; - return; - } - - /* - * Mean - */ - xmean = 0; - x0 = x->ptr.p_double[0]; - samex = ae_true; - for(i=0; i<=n-1; i++) - { - v = x->ptr.p_double[i]; - xmean = xmean+v; - samex = samex&&ae_fp_eq(v,x0); - } - if( samex ) - { - xmean = x0; - } - else - { - xmean = xmean/n; - } - ymean = 0; - y0 = y->ptr.p_double[0]; - samey = ae_true; - for(i=0; i<=m-1; i++) - { - v = y->ptr.p_double[i]; - ymean = ymean+v; - samey = samey&&ae_fp_eq(v,y0); - } - if( samey ) - { - ymean = y0; - } - else - { - ymean = ymean/m; - } - - /* - * Variance (using corrected two-pass algorithm) - */ - xvar = 0; - if( n>=2&&!samex ) - { - for(i=0; i<=n-1; i++) - { - xvar = xvar+ae_sqr(x->ptr.p_double[i]-xmean, _state); - } - xvar = xvar/(n-1); - } - yvar = 0; - if( m>=2&&!samey ) - { - for(i=0; i<=m-1; i++) - { - yvar = yvar+ae_sqr(y->ptr.p_double[i]-ymean, _state); - } - yvar = yvar/(m-1); - } - - /* - * Handle different special cases - * (one or both variances are zero). - */ - if( ae_fp_eq(xvar,0)&&ae_fp_eq(yvar,0) ) - { - if( ae_fp_eq(xmean,ymean) ) - { - *bothtails = 1.0; - } - else - { - *bothtails = 0.0; - } - if( ae_fp_greater_eq(xmean,ymean) ) - { - *lefttail = 1.0; - } - else - { - *lefttail = 0.0; - } - if( ae_fp_less_eq(xmean,ymean) ) - { - *righttail = 1.0; - } - else - { - *righttail = 0.0; - } - return; - } - if( ae_fp_eq(xvar,0) ) - { - - /* - * X is constant, unpooled 2-sample test reduces to 1-sample test. - * - * NOTE: right-tail and left-tail must be passed to 1-sample - * t-test in reverse order because we reverse order of - * of samples. - */ - studentttest1(y, m, xmean, bothtails, righttail, lefttail, _state); - return; - } - if( ae_fp_eq(yvar,0) ) - { - - /* - * Y is constant, unpooled 2-sample test reduces to 1-sample test. - */ - studentttest1(x, n, ymean, bothtails, lefttail, righttail, _state); - return; - } - - /* - * Statistic - */ - stat = (xmean-ymean)/ae_sqrt(xvar/n+yvar/m, _state); - c = xvar/n/(xvar/n+yvar/m); - df = (n-1)*(m-1)/((m-1)*ae_sqr(c, _state)+(n-1)*ae_sqr(1-c, _state)); - if( ae_fp_greater(stat,0) ) - { - p = 1-0.5*incompletebeta(df/2, 0.5, df/(df+ae_sqr(stat, _state)), _state); - } - else - { - p = 0.5*incompletebeta(df/2, 0.5, df/(df+ae_sqr(stat, _state)), _state); - } - *bothtails = 2*ae_minreal(p, 1-p, _state); - *lefttail = p; - *righttail = 1-p; -} - - - - -/************************************************************************* -Two-sample F-test - -This test checks three hypotheses about dispersions of the given samples. -The following tests are performed: - * two-tailed test (null hypothesis - the dispersions are equal) - * left-tailed test (null hypothesis - the dispersion of the first - sample is greater than or equal to the dispersion of the second - sample). - * right-tailed test (null hypothesis - the dispersion of the first - sample is less than or equal to the dispersion of the second sample) - -The test is based on the following assumptions: - * the given samples have normal distributions - * the samples are independent. - -Input parameters: - X - sample 1. Array whose index goes from 0 to N-1. - N - sample size. - Y - sample 2. Array whose index goes from 0 to M-1. - M - sample size. - -Output parameters: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - - -- ALGLIB -- - Copyright 19.09.2006 by Bochkanov Sergey -*************************************************************************/ -void ftest(/* Real */ ae_vector* x, - ae_int_t n, - /* Real */ ae_vector* y, - ae_int_t m, - double* bothtails, - double* lefttail, - double* righttail, - ae_state *_state) -{ - ae_int_t i; - double xmean; - double ymean; - double xvar; - double yvar; - ae_int_t df1; - ae_int_t df2; - double stat; - - *bothtails = 0; - *lefttail = 0; - *righttail = 0; - - if( n<=2||m<=2 ) - { - *bothtails = 1.0; - *lefttail = 1.0; - *righttail = 1.0; - return; - } - - /* - * Mean - */ - xmean = 0; - for(i=0; i<=n-1; i++) - { - xmean = xmean+x->ptr.p_double[i]; - } - xmean = xmean/n; - ymean = 0; - for(i=0; i<=m-1; i++) - { - ymean = ymean+y->ptr.p_double[i]; - } - ymean = ymean/m; - - /* - * Variance (using corrected two-pass algorithm) - */ - xvar = 0; - for(i=0; i<=n-1; i++) - { - xvar = xvar+ae_sqr(x->ptr.p_double[i]-xmean, _state); - } - xvar = xvar/(n-1); - yvar = 0; - for(i=0; i<=m-1; i++) - { - yvar = yvar+ae_sqr(y->ptr.p_double[i]-ymean, _state); - } - yvar = yvar/(m-1); - if( ae_fp_eq(xvar,0)||ae_fp_eq(yvar,0) ) - { - *bothtails = 1.0; - *lefttail = 1.0; - *righttail = 1.0; - return; - } - - /* - * Statistic - */ - df1 = n-1; - df2 = m-1; - stat = ae_minreal(xvar/yvar, yvar/xvar, _state); - *bothtails = 1-(fdistribution(df1, df2, 1/stat, _state)-fdistribution(df1, df2, stat, _state)); - *lefttail = fdistribution(df1, df2, xvar/yvar, _state); - *righttail = 1-(*lefttail); -} - - -/************************************************************************* -One-sample chi-square test - -This test checks three hypotheses about the dispersion of the given sample -The following tests are performed: - * two-tailed test (null hypothesis - the dispersion equals the given - number) - * left-tailed test (null hypothesis - the dispersion is greater than - or equal to the given number) - * right-tailed test (null hypothesis - dispersion is less than or - equal to the given number). - -Test is based on the following assumptions: - * the given sample has a normal distribution. - -Input parameters: - X - sample 1. Array whose index goes from 0 to N-1. - N - size of the sample. - Variance - dispersion value to compare with. - -Output parameters: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - - -- ALGLIB -- - Copyright 19.09.2006 by Bochkanov Sergey -*************************************************************************/ -void onesamplevariancetest(/* Real */ ae_vector* x, - ae_int_t n, - double variance, - double* bothtails, - double* lefttail, - double* righttail, - ae_state *_state) -{ - ae_int_t i; - double xmean; - double xvar; - double s; - double stat; - - *bothtails = 0; - *lefttail = 0; - *righttail = 0; - - if( n<=1 ) - { - *bothtails = 1.0; - *lefttail = 1.0; - *righttail = 1.0; - return; - } - - /* - * Mean - */ - xmean = 0; - for(i=0; i<=n-1; i++) - { - xmean = xmean+x->ptr.p_double[i]; - } - xmean = xmean/n; - - /* - * Variance - */ - xvar = 0; - for(i=0; i<=n-1; i++) - { - xvar = xvar+ae_sqr(x->ptr.p_double[i]-xmean, _state); - } - xvar = xvar/(n-1); - if( ae_fp_eq(xvar,0) ) - { - *bothtails = 1.0; - *lefttail = 1.0; - *righttail = 1.0; - return; - } - - /* - * Statistic - */ - stat = (n-1)*xvar/variance; - s = chisquaredistribution(n-1, stat, _state); - *bothtails = 2*ae_minreal(s, 1-s, _state); - *lefttail = s; - *righttail = 1-(*lefttail); -} - - - - -/************************************************************************* -Wilcoxon signed-rank test - -This test checks three hypotheses about the median of the given sample. -The following tests are performed: - * two-tailed test (null hypothesis - the median is equal to the given - value) - * left-tailed test (null hypothesis - the median is greater than or - equal to the given value) - * right-tailed test (null hypothesis - the median is less than or - equal to the given value) - -Requirements: - * the scale of measurement should be ordinal, interval or ratio (i.e. - the test could not be applied to nominal variables). - * the distribution should be continuous and symmetric relative to its - median. - * number of distinct values in the X array should be greater than 4 - -The test is non-parametric and doesn't require distribution X to be normal - -Input parameters: - X - sample. Array whose index goes from 0 to N-1. - N - size of the sample. - Median - assumed median value. - -Output parameters: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - -To calculate p-values, special approximation is used. This method lets us -calculate p-values with two decimal places in interval [0.0001, 1]. - -"Two decimal places" does not sound very impressive, but in practice the -relative error of less than 1% is enough to make a decision. - -There is no approximation outside the [0.0001, 1] interval. Therefore, if -the significance level outlies this interval, the test returns 0.0001. - - -- ALGLIB -- - Copyright 08.09.2006 by Bochkanov Sergey -*************************************************************************/ -void wilcoxonsignedranktest(/* Real */ ae_vector* x, - ae_int_t n, - double e, - double* bothtails, - double* lefttail, - double* righttail, - ae_state *_state) -{ - ae_frame _frame_block; - ae_vector _x; - ae_int_t i; - ae_int_t j; - ae_int_t k; - ae_int_t t; - double tmp; - ae_int_t tmpi; - ae_int_t ns; - ae_vector r; - ae_vector c; - double w; - double p; - double mp; - double s; - double sigma; - double mu; - - ae_frame_make(_state, &_frame_block); - ae_vector_init_copy(&_x, x, _state, ae_true); - x = &_x; - *bothtails = 0; - *lefttail = 0; - *righttail = 0; - ae_vector_init(&r, 0, DT_REAL, _state, ae_true); - ae_vector_init(&c, 0, DT_INT, _state, ae_true); - - - /* - * Prepare - */ - if( n<5 ) - { - *bothtails = 1.0; - *lefttail = 1.0; - *righttail = 1.0; - ae_frame_leave(_state); - return; - } - ns = 0; - for(i=0; i<=n-1; i++) - { - if( ae_fp_eq(x->ptr.p_double[i],e) ) - { - continue; - } - x->ptr.p_double[ns] = x->ptr.p_double[i]; - ns = ns+1; - } - if( ns<5 ) - { - *bothtails = 1.0; - *lefttail = 1.0; - *righttail = 1.0; - ae_frame_leave(_state); - return; - } - ae_vector_set_length(&r, ns-1+1, _state); - ae_vector_set_length(&c, ns-1+1, _state); - for(i=0; i<=ns-1; i++) - { - r.ptr.p_double[i] = ae_fabs(x->ptr.p_double[i]-e, _state); - c.ptr.p_int[i] = i; - } - - /* - * sort {R, C} - */ - if( ns!=1 ) - { - i = 2; - do - { - t = i; - while(t!=1) - { - k = t/2; - if( ae_fp_greater_eq(r.ptr.p_double[k-1],r.ptr.p_double[t-1]) ) - { - t = 1; - } - else - { - tmp = r.ptr.p_double[k-1]; - r.ptr.p_double[k-1] = r.ptr.p_double[t-1]; - r.ptr.p_double[t-1] = tmp; - tmpi = c.ptr.p_int[k-1]; - c.ptr.p_int[k-1] = c.ptr.p_int[t-1]; - c.ptr.p_int[t-1] = tmpi; - t = k; - } - } - i = i+1; - } - while(i<=ns); - i = ns-1; - do - { - tmp = r.ptr.p_double[i]; - r.ptr.p_double[i] = r.ptr.p_double[0]; - r.ptr.p_double[0] = tmp; - tmpi = c.ptr.p_int[i]; - c.ptr.p_int[i] = c.ptr.p_int[0]; - c.ptr.p_int[0] = tmpi; - t = 1; - while(t!=0) - { - k = 2*t; - if( k>i ) - { - t = 0; - } - else - { - if( k=1); - } - - /* - * compute tied ranks - */ - i = 0; - while(i<=ns-1) - { - j = i+1; - while(j<=ns-1) - { - if( ae_fp_neq(r.ptr.p_double[j],r.ptr.p_double[i]) ) - { - break; - } - j = j+1; - } - for(k=i; k<=j-1; k++) - { - r.ptr.p_double[k] = 1+(double)(i+j-1)/(double)2; - } - i = j; - } - - /* - * Compute W+ - */ - w = 0; - for(i=0; i<=ns-1; i++) - { - if( ae_fp_greater(x->ptr.p_double[c.ptr.p_int[i]],e) ) - { - w = w+r.ptr.p_double[i]; - } - } - - /* - * Result - */ - mu = (double)(ns*(ns+1))/(double)4; - sigma = ae_sqrt((double)(ns*(ns+1)*(2*ns+1))/(double)24, _state); - s = (w-mu)/sigma; - if( ae_fp_less_eq(s,0) ) - { - p = ae_exp(wsr_wsigma(-(w-mu)/sigma, ns, _state), _state); - mp = 1-ae_exp(wsr_wsigma(-(w-1-mu)/sigma, ns, _state), _state); - } - else - { - mp = ae_exp(wsr_wsigma((w-mu)/sigma, ns, _state), _state); - p = 1-ae_exp(wsr_wsigma((w+1-mu)/sigma, ns, _state), _state); - } - *bothtails = ae_maxreal(2*ae_minreal(p, mp, _state), 1.0E-4, _state); - *lefttail = ae_maxreal(p, 1.0E-4, _state); - *righttail = ae_maxreal(mp, 1.0E-4, _state); - ae_frame_leave(_state); -} - - -/************************************************************************* -Sequential Chebyshev interpolation. -*************************************************************************/ -static void wsr_wcheb(double x, - double c, - double* tj, - double* tj1, - double* r, - ae_state *_state) -{ - double t; - - - *r = *r+c*(*tj); - t = 2*x*(*tj1)-(*tj); - *tj = *tj1; - *tj1 = t; -} - - -/************************************************************************* -Tail(S, 5) -*************************************************************************/ -static double wsr_w5(double s, ae_state *_state) -{ - ae_int_t w; - double r; - double result; - - - r = 0; - w = ae_round(-3.708099e+00*s+7.500000e+00, _state); - if( w>=7 ) - { - r = -6.931e-01; - } - if( w==6 ) - { - r = -9.008e-01; - } - if( w==5 ) - { - r = -1.163e+00; - } - if( w==4 ) - { - r = -1.520e+00; - } - if( w==3 ) - { - r = -1.856e+00; - } - if( w==2 ) - { - r = -2.367e+00; - } - if( w==1 ) - { - r = -2.773e+00; - } - if( w<=0 ) - { - r = -3.466e+00; - } - result = r; - return result; -} - - -/************************************************************************* -Tail(S, 6) -*************************************************************************/ -static double wsr_w6(double s, ae_state *_state) -{ - ae_int_t w; - double r; - double result; - - - r = 0; - w = ae_round(-4.769696e+00*s+1.050000e+01, _state); - if( w>=10 ) - { - r = -6.931e-01; - } - if( w==9 ) - { - r = -8.630e-01; - } - if( w==8 ) - { - r = -1.068e+00; - } - if( w==7 ) - { - r = -1.269e+00; - } - if( w==6 ) - { - r = -1.520e+00; - } - if( w==5 ) - { - r = -1.856e+00; - } - if( w==4 ) - { - r = -2.213e+00; - } - if( w==3 ) - { - r = -2.549e+00; - } - if( w==2 ) - { - r = -3.060e+00; - } - if( w==1 ) - { - r = -3.466e+00; - } - if( w<=0 ) - { - r = -4.159e+00; - } - result = r; - return result; -} - - -/************************************************************************* -Tail(S, 7) -*************************************************************************/ -static double wsr_w7(double s, ae_state *_state) -{ - ae_int_t w; - double r; - double result; - - - r = 0; - w = ae_round(-5.916080e+00*s+1.400000e+01, _state); - if( w>=14 ) - { - r = -6.325e-01; - } - if( w==13 ) - { - r = -7.577e-01; - } - if( w==12 ) - { - r = -9.008e-01; - } - if( w==11 ) - { - r = -1.068e+00; - } - if( w==10 ) - { - r = -1.241e+00; - } - if( w==9 ) - { - r = -1.451e+00; - } - if( w==8 ) - { - r = -1.674e+00; - } - if( w==7 ) - { - r = -1.908e+00; - } - if( w==6 ) - { - r = -2.213e+00; - } - if( w==5 ) - { - r = -2.549e+00; - } - if( w==4 ) - { - r = -2.906e+00; - } - if( w==3 ) - { - r = -3.243e+00; - } - if( w==2 ) - { - r = -3.753e+00; - } - if( w==1 ) - { - r = -4.159e+00; - } - if( w<=0 ) - { - r = -4.852e+00; - } - result = r; - return result; -} - - -/************************************************************************* -Tail(S, 8) -*************************************************************************/ -static double wsr_w8(double s, ae_state *_state) -{ - ae_int_t w; - double r; - double result; - - - r = 0; - w = ae_round(-7.141428e+00*s+1.800000e+01, _state); - if( w>=18 ) - { - r = -6.399e-01; - } - if( w==17 ) - { - r = -7.494e-01; - } - if( w==16 ) - { - r = -8.630e-01; - } - if( w==15 ) - { - r = -9.913e-01; - } - if( w==14 ) - { - r = -1.138e+00; - } - if( w==13 ) - { - r = -1.297e+00; - } - if( w==12 ) - { - r = -1.468e+00; - } - if( w==11 ) - { - r = -1.653e+00; - } - if( w==10 ) - { - r = -1.856e+00; - } - if( w==9 ) - { - r = -2.079e+00; - } - if( w==8 ) - { - r = -2.326e+00; - } - if( w==7 ) - { - r = -2.601e+00; - } - if( w==6 ) - { - r = -2.906e+00; - } - if( w==5 ) - { - r = -3.243e+00; - } - if( w==4 ) - { - r = -3.599e+00; - } - if( w==3 ) - { - r = -3.936e+00; - } - if( w==2 ) - { - r = -4.447e+00; - } - if( w==1 ) - { - r = -4.852e+00; - } - if( w<=0 ) - { - r = -5.545e+00; - } - result = r; - return result; -} - - -/************************************************************************* -Tail(S, 9) -*************************************************************************/ -static double wsr_w9(double s, ae_state *_state) -{ - ae_int_t w; - double r; - double result; - - - r = 0; - w = ae_round(-8.440972e+00*s+2.250000e+01, _state); - if( w>=22 ) - { - r = -6.931e-01; - } - if( w==21 ) - { - r = -7.873e-01; - } - if( w==20 ) - { - r = -8.912e-01; - } - if( w==19 ) - { - r = -1.002e+00; - } - if( w==18 ) - { - r = -1.120e+00; - } - if( w==17 ) - { - r = -1.255e+00; - } - if( w==16 ) - { - r = -1.394e+00; - } - if( w==15 ) - { - r = -1.547e+00; - } - if( w==14 ) - { - r = -1.717e+00; - } - if( w==13 ) - { - r = -1.895e+00; - } - if( w==12 ) - { - r = -2.079e+00; - } - if( w==11 ) - { - r = -2.287e+00; - } - if( w==10 ) - { - r = -2.501e+00; - } - if( w==9 ) - { - r = -2.742e+00; - } - if( w==8 ) - { - r = -3.019e+00; - } - if( w==7 ) - { - r = -3.294e+00; - } - if( w==6 ) - { - r = -3.599e+00; - } - if( w==5 ) - { - r = -3.936e+00; - } - if( w==4 ) - { - r = -4.292e+00; - } - if( w==3 ) - { - r = -4.629e+00; - } - if( w==2 ) - { - r = -5.140e+00; - } - if( w==1 ) - { - r = -5.545e+00; - } - if( w<=0 ) - { - r = -6.238e+00; - } - result = r; - return result; -} - - -/************************************************************************* -Tail(S, 10) -*************************************************************************/ -static double wsr_w10(double s, ae_state *_state) -{ - ae_int_t w; - double r; - double result; - - - r = 0; - w = ae_round(-9.810708e+00*s+2.750000e+01, _state); - if( w>=27 ) - { - r = -6.931e-01; - } - if( w==26 ) - { - r = -7.745e-01; - } - if( w==25 ) - { - r = -8.607e-01; - } - if( w==24 ) - { - r = -9.551e-01; - } - if( w==23 ) - { - r = -1.057e+00; - } - if( w==22 ) - { - r = -1.163e+00; - } - if( w==21 ) - { - r = -1.279e+00; - } - if( w==20 ) - { - r = -1.402e+00; - } - if( w==19 ) - { - r = -1.533e+00; - } - if( w==18 ) - { - r = -1.674e+00; - } - if( w==17 ) - { - r = -1.826e+00; - } - if( w==16 ) - { - r = -1.983e+00; - } - if( w==15 ) - { - r = -2.152e+00; - } - if( w==14 ) - { - r = -2.336e+00; - } - if( w==13 ) - { - r = -2.525e+00; - } - if( w==12 ) - { - r = -2.727e+00; - } - if( w==11 ) - { - r = -2.942e+00; - } - if( w==10 ) - { - r = -3.170e+00; - } - if( w==9 ) - { - r = -3.435e+00; - } - if( w==8 ) - { - r = -3.713e+00; - } - if( w==7 ) - { - r = -3.987e+00; - } - if( w==6 ) - { - r = -4.292e+00; - } - if( w==5 ) - { - r = -4.629e+00; - } - if( w==4 ) - { - r = -4.986e+00; - } - if( w==3 ) - { - r = -5.322e+00; - } - if( w==2 ) - { - r = -5.833e+00; - } - if( w==1 ) - { - r = -6.238e+00; - } - if( w<=0 ) - { - r = -6.931e+00; - } - result = r; - return result; -} - - -/************************************************************************* -Tail(S, 11) -*************************************************************************/ -static double wsr_w11(double s, ae_state *_state) -{ - ae_int_t w; - double r; - double result; - - - r = 0; - w = ae_round(-1.124722e+01*s+3.300000e+01, _state); - if( w>=33 ) - { - r = -6.595e-01; - } - if( w==32 ) - { - r = -7.279e-01; - } - if( w==31 ) - { - r = -8.002e-01; - } - if( w==30 ) - { - r = -8.782e-01; - } - if( w==29 ) - { - r = -9.615e-01; - } - if( w==28 ) - { - r = -1.050e+00; - } - if( w==27 ) - { - r = -1.143e+00; - } - if( w==26 ) - { - r = -1.243e+00; - } - if( w==25 ) - { - r = -1.348e+00; - } - if( w==24 ) - { - r = -1.459e+00; - } - if( w==23 ) - { - r = -1.577e+00; - } - if( w==22 ) - { - r = -1.700e+00; - } - if( w==21 ) - { - r = -1.832e+00; - } - if( w==20 ) - { - r = -1.972e+00; - } - if( w==19 ) - { - r = -2.119e+00; - } - if( w==18 ) - { - r = -2.273e+00; - } - if( w==17 ) - { - r = -2.437e+00; - } - if( w==16 ) - { - r = -2.607e+00; - } - if( w==15 ) - { - r = -2.788e+00; - } - if( w==14 ) - { - r = -2.980e+00; - } - if( w==13 ) - { - r = -3.182e+00; - } - if( w==12 ) - { - r = -3.391e+00; - } - if( w==11 ) - { - r = -3.617e+00; - } - if( w==10 ) - { - r = -3.863e+00; - } - if( w==9 ) - { - r = -4.128e+00; - } - if( w==8 ) - { - r = -4.406e+00; - } - if( w==7 ) - { - r = -4.680e+00; - } - if( w==6 ) - { - r = -4.986e+00; - } - if( w==5 ) - { - r = -5.322e+00; - } - if( w==4 ) - { - r = -5.679e+00; - } - if( w==3 ) - { - r = -6.015e+00; - } - if( w==2 ) - { - r = -6.526e+00; - } - if( w==1 ) - { - r = -6.931e+00; - } - if( w<=0 ) - { - r = -7.625e+00; - } - result = r; - return result; -} - - -/************************************************************************* -Tail(S, 12) -*************************************************************************/ -static double wsr_w12(double s, ae_state *_state) -{ - ae_int_t w; - double r; - double result; - - - r = 0; - w = ae_round(-1.274755e+01*s+3.900000e+01, _state); - if( w>=39 ) - { - r = -6.633e-01; - } - if( w==38 ) - { - r = -7.239e-01; - } - if( w==37 ) - { - r = -7.878e-01; - } - if( w==36 ) - { - r = -8.556e-01; - } - if( w==35 ) - { - r = -9.276e-01; - } - if( w==34 ) - { - r = -1.003e+00; - } - if( w==33 ) - { - r = -1.083e+00; - } - if( w==32 ) - { - r = -1.168e+00; - } - if( w==31 ) - { - r = -1.256e+00; - } - if( w==30 ) - { - r = -1.350e+00; - } - if( w==29 ) - { - r = -1.449e+00; - } - if( w==28 ) - { - r = -1.552e+00; - } - if( w==27 ) - { - r = -1.660e+00; - } - if( w==26 ) - { - r = -1.774e+00; - } - if( w==25 ) - { - r = -1.893e+00; - } - if( w==24 ) - { - r = -2.017e+00; - } - if( w==23 ) - { - r = -2.148e+00; - } - if( w==22 ) - { - r = -2.285e+00; - } - if( w==21 ) - { - r = -2.429e+00; - } - if( w==20 ) - { - r = -2.581e+00; - } - if( w==19 ) - { - r = -2.738e+00; - } - if( w==18 ) - { - r = -2.902e+00; - } - if( w==17 ) - { - r = -3.076e+00; - } - if( w==16 ) - { - r = -3.255e+00; - } - if( w==15 ) - { - r = -3.443e+00; - } - if( w==14 ) - { - r = -3.645e+00; - } - if( w==13 ) - { - r = -3.852e+00; - } - if( w==12 ) - { - r = -4.069e+00; - } - if( w==11 ) - { - r = -4.310e+00; - } - if( w==10 ) - { - r = -4.557e+00; - } - if( w==9 ) - { - r = -4.821e+00; - } - if( w==8 ) - { - r = -5.099e+00; - } - if( w==7 ) - { - r = -5.373e+00; - } - if( w==6 ) - { - r = -5.679e+00; - } - if( w==5 ) - { - r = -6.015e+00; - } - if( w==4 ) - { - r = -6.372e+00; - } - if( w==3 ) - { - r = -6.708e+00; - } - if( w==2 ) - { - r = -7.219e+00; - } - if( w==1 ) - { - r = -7.625e+00; - } - if( w<=0 ) - { - r = -8.318e+00; - } - result = r; - return result; -} - - -/************************************************************************* -Tail(S, 13) -*************************************************************************/ -static double wsr_w13(double s, ae_state *_state) -{ - ae_int_t w; - double r; - double result; - - - r = 0; - w = ae_round(-1.430909e+01*s+4.550000e+01, _state); - if( w>=45 ) - { - r = -6.931e-01; - } - if( w==44 ) - { - r = -7.486e-01; - } - if( w==43 ) - { - r = -8.068e-01; - } - if( w==42 ) - { - r = -8.683e-01; - } - if( w==41 ) - { - r = -9.328e-01; - } - if( w==40 ) - { - r = -1.001e+00; - } - if( w==39 ) - { - r = -1.072e+00; - } - if( w==38 ) - { - r = -1.146e+00; - } - if( w==37 ) - { - r = -1.224e+00; - } - if( w==36 ) - { - r = -1.306e+00; - } - if( w==35 ) - { - r = -1.392e+00; - } - if( w==34 ) - { - r = -1.481e+00; - } - if( w==33 ) - { - r = -1.574e+00; - } - if( w==32 ) - { - r = -1.672e+00; - } - if( w==31 ) - { - r = -1.773e+00; - } - if( w==30 ) - { - r = -1.879e+00; - } - if( w==29 ) - { - r = -1.990e+00; - } - if( w==28 ) - { - r = -2.104e+00; - } - if( w==27 ) - { - r = -2.224e+00; - } - if( w==26 ) - { - r = -2.349e+00; - } - if( w==25 ) - { - r = -2.479e+00; - } - if( w==24 ) - { - r = -2.614e+00; - } - if( w==23 ) - { - r = -2.755e+00; - } - if( w==22 ) - { - r = -2.902e+00; - } - if( w==21 ) - { - r = -3.055e+00; - } - if( w==20 ) - { - r = -3.215e+00; - } - if( w==19 ) - { - r = -3.380e+00; - } - if( w==18 ) - { - r = -3.551e+00; - } - if( w==17 ) - { - r = -3.733e+00; - } - if( w==16 ) - { - r = -3.917e+00; - } - if( w==15 ) - { - r = -4.113e+00; - } - if( w==14 ) - { - r = -4.320e+00; - } - if( w==13 ) - { - r = -4.534e+00; - } - if( w==12 ) - { - r = -4.762e+00; - } - if( w==11 ) - { - r = -5.004e+00; - } - if( w==10 ) - { - r = -5.250e+00; - } - if( w==9 ) - { - r = -5.514e+00; - } - if( w==8 ) - { - r = -5.792e+00; - } - if( w==7 ) - { - r = -6.066e+00; - } - if( w==6 ) - { - r = -6.372e+00; - } - if( w==5 ) - { - r = -6.708e+00; - } - if( w==4 ) - { - r = -7.065e+00; - } - if( w==3 ) - { - r = -7.401e+00; - } - if( w==2 ) - { - r = -7.912e+00; - } - if( w==1 ) - { - r = -8.318e+00; - } - if( w<=0 ) - { - r = -9.011e+00; - } - result = r; - return result; -} - - -/************************************************************************* -Tail(S, 14) -*************************************************************************/ -static double wsr_w14(double s, ae_state *_state) -{ - ae_int_t w; - double r; - double result; - - - r = 0; - w = ae_round(-1.592953e+01*s+5.250000e+01, _state); - if( w>=52 ) - { - r = -6.931e-01; - } - if( w==51 ) - { - r = -7.428e-01; - } - if( w==50 ) - { - r = -7.950e-01; - } - if( w==49 ) - { - r = -8.495e-01; - } - if( w==48 ) - { - r = -9.067e-01; - } - if( w==47 ) - { - r = -9.664e-01; - } - if( w==46 ) - { - r = -1.029e+00; - } - if( w==45 ) - { - r = -1.094e+00; - } - if( w==44 ) - { - r = -1.162e+00; - } - if( w==43 ) - { - r = -1.233e+00; - } - if( w==42 ) - { - r = -1.306e+00; - } - if( w==41 ) - { - r = -1.383e+00; - } - if( w==40 ) - { - r = -1.463e+00; - } - if( w==39 ) - { - r = -1.546e+00; - } - if( w==38 ) - { - r = -1.632e+00; - } - if( w==37 ) - { - r = -1.722e+00; - } - if( w==36 ) - { - r = -1.815e+00; - } - if( w==35 ) - { - r = -1.911e+00; - } - if( w==34 ) - { - r = -2.011e+00; - } - if( w==33 ) - { - r = -2.115e+00; - } - if( w==32 ) - { - r = -2.223e+00; - } - if( w==31 ) - { - r = -2.334e+00; - } - if( w==30 ) - { - r = -2.450e+00; - } - if( w==29 ) - { - r = -2.570e+00; - } - if( w==28 ) - { - r = -2.694e+00; - } - if( w==27 ) - { - r = -2.823e+00; - } - if( w==26 ) - { - r = -2.956e+00; - } - if( w==25 ) - { - r = -3.095e+00; - } - if( w==24 ) - { - r = -3.238e+00; - } - if( w==23 ) - { - r = -3.387e+00; - } - if( w==22 ) - { - r = -3.541e+00; - } - if( w==21 ) - { - r = -3.700e+00; - } - if( w==20 ) - { - r = -3.866e+00; - } - if( w==19 ) - { - r = -4.038e+00; - } - if( w==18 ) - { - r = -4.215e+00; - } - if( w==17 ) - { - r = -4.401e+00; - } - if( w==16 ) - { - r = -4.592e+00; - } - if( w==15 ) - { - r = -4.791e+00; - } - if( w==14 ) - { - r = -5.004e+00; - } - if( w==13 ) - { - r = -5.227e+00; - } - if( w==12 ) - { - r = -5.456e+00; - } - if( w==11 ) - { - r = -5.697e+00; - } - if( w==10 ) - { - r = -5.943e+00; - } - if( w==9 ) - { - r = -6.208e+00; - } - if( w==8 ) - { - r = -6.485e+00; - } - if( w==7 ) - { - r = -6.760e+00; - } - if( w==6 ) - { - r = -7.065e+00; - } - if( w==5 ) - { - r = -7.401e+00; - } - if( w==4 ) - { - r = -7.758e+00; - } - if( w==3 ) - { - r = -8.095e+00; - } - if( w==2 ) - { - r = -8.605e+00; - } - if( w==1 ) - { - r = -9.011e+00; - } - if( w<=0 ) - { - r = -9.704e+00; - } - result = r; - return result; -} - - -/************************************************************************* -Tail(S, 15) -*************************************************************************/ -static double wsr_w15(double s, ae_state *_state) -{ - ae_int_t w; - double r; - double result; - - - r = 0; - w = ae_round(-1.760682e+01*s+6.000000e+01, _state); - if( w>=60 ) - { - r = -6.714e-01; - } - if( w==59 ) - { - r = -7.154e-01; - } - if( w==58 ) - { - r = -7.613e-01; - } - if( w==57 ) - { - r = -8.093e-01; - } - if( w==56 ) - { - r = -8.593e-01; - } - if( w==55 ) - { - r = -9.114e-01; - } - if( w==54 ) - { - r = -9.656e-01; - } - if( w==53 ) - { - r = -1.022e+00; - } - if( w==52 ) - { - r = -1.081e+00; - } - if( w==51 ) - { - r = -1.142e+00; - } - if( w==50 ) - { - r = -1.205e+00; - } - if( w==49 ) - { - r = -1.270e+00; - } - if( w==48 ) - { - r = -1.339e+00; - } - if( w==47 ) - { - r = -1.409e+00; - } - if( w==46 ) - { - r = -1.482e+00; - } - if( w==45 ) - { - r = -1.558e+00; - } - if( w==44 ) - { - r = -1.636e+00; - } - if( w==43 ) - { - r = -1.717e+00; - } - if( w==42 ) - { - r = -1.801e+00; - } - if( w==41 ) - { - r = -1.888e+00; - } - if( w==40 ) - { - r = -1.977e+00; - } - if( w==39 ) - { - r = -2.070e+00; - } - if( w==38 ) - { - r = -2.166e+00; - } - if( w==37 ) - { - r = -2.265e+00; - } - if( w==36 ) - { - r = -2.366e+00; - } - if( w==35 ) - { - r = -2.472e+00; - } - if( w==34 ) - { - r = -2.581e+00; - } - if( w==33 ) - { - r = -2.693e+00; - } - if( w==32 ) - { - r = -2.809e+00; - } - if( w==31 ) - { - r = -2.928e+00; - } - if( w==30 ) - { - r = -3.051e+00; - } - if( w==29 ) - { - r = -3.179e+00; - } - if( w==28 ) - { - r = -3.310e+00; - } - if( w==27 ) - { - r = -3.446e+00; - } - if( w==26 ) - { - r = -3.587e+00; - } - if( w==25 ) - { - r = -3.732e+00; - } - if( w==24 ) - { - r = -3.881e+00; - } - if( w==23 ) - { - r = -4.036e+00; - } - if( w==22 ) - { - r = -4.195e+00; - } - if( w==21 ) - { - r = -4.359e+00; - } - if( w==20 ) - { - r = -4.531e+00; - } - if( w==19 ) - { - r = -4.707e+00; - } - if( w==18 ) - { - r = -4.888e+00; - } - if( w==17 ) - { - r = -5.079e+00; - } - if( w==16 ) - { - r = -5.273e+00; - } - if( w==15 ) - { - r = -5.477e+00; - } - if( w==14 ) - { - r = -5.697e+00; - } - if( w==13 ) - { - r = -5.920e+00; - } - if( w==12 ) - { - r = -6.149e+00; - } - if( w==11 ) - { - r = -6.390e+00; - } - if( w==10 ) - { - r = -6.636e+00; - } - if( w==9 ) - { - r = -6.901e+00; - } - if( w==8 ) - { - r = -7.178e+00; - } - if( w==7 ) - { - r = -7.453e+00; - } - if( w==6 ) - { - r = -7.758e+00; - } - if( w==5 ) - { - r = -8.095e+00; - } - if( w==4 ) - { - r = -8.451e+00; - } - if( w==3 ) - { - r = -8.788e+00; - } - if( w==2 ) - { - r = -9.299e+00; - } - if( w==1 ) - { - r = -9.704e+00; - } - if( w<=0 ) - { - r = -1.040e+01; - } - result = r; - return result; -} - - -/************************************************************************* -Tail(S, 16) -*************************************************************************/ -static double wsr_w16(double s, ae_state *_state) -{ - ae_int_t w; - double r; - double result; - - - r = 0; - w = ae_round(-1.933908e+01*s+6.800000e+01, _state); - if( w>=68 ) - { - r = -6.733e-01; - } - if( w==67 ) - { - r = -7.134e-01; - } - if( w==66 ) - { - r = -7.551e-01; - } - if( w==65 ) - { - r = -7.986e-01; - } - if( w==64 ) - { - r = -8.437e-01; - } - if( w==63 ) - { - r = -8.905e-01; - } - if( w==62 ) - { - r = -9.391e-01; - } - if( w==61 ) - { - r = -9.895e-01; - } - if( w==60 ) - { - r = -1.042e+00; - } - if( w==59 ) - { - r = -1.096e+00; - } - if( w==58 ) - { - r = -1.152e+00; - } - if( w==57 ) - { - r = -1.210e+00; - } - if( w==56 ) - { - r = -1.270e+00; - } - if( w==55 ) - { - r = -1.331e+00; - } - if( w==54 ) - { - r = -1.395e+00; - } - if( w==53 ) - { - r = -1.462e+00; - } - if( w==52 ) - { - r = -1.530e+00; - } - if( w==51 ) - { - r = -1.600e+00; - } - if( w==50 ) - { - r = -1.673e+00; - } - if( w==49 ) - { - r = -1.748e+00; - } - if( w==48 ) - { - r = -1.825e+00; - } - if( w==47 ) - { - r = -1.904e+00; - } - if( w==46 ) - { - r = -1.986e+00; - } - if( w==45 ) - { - r = -2.071e+00; - } - if( w==44 ) - { - r = -2.158e+00; - } - if( w==43 ) - { - r = -2.247e+00; - } - if( w==42 ) - { - r = -2.339e+00; - } - if( w==41 ) - { - r = -2.434e+00; - } - if( w==40 ) - { - r = -2.532e+00; - } - if( w==39 ) - { - r = -2.632e+00; - } - if( w==38 ) - { - r = -2.735e+00; - } - if( w==37 ) - { - r = -2.842e+00; - } - if( w==36 ) - { - r = -2.951e+00; - } - if( w==35 ) - { - r = -3.064e+00; - } - if( w==34 ) - { - r = -3.179e+00; - } - if( w==33 ) - { - r = -3.298e+00; - } - if( w==32 ) - { - r = -3.420e+00; - } - if( w==31 ) - { - r = -3.546e+00; - } - if( w==30 ) - { - r = -3.676e+00; - } - if( w==29 ) - { - r = -3.810e+00; - } - if( w==28 ) - { - r = -3.947e+00; - } - if( w==27 ) - { - r = -4.088e+00; - } - if( w==26 ) - { - r = -4.234e+00; - } - if( w==25 ) - { - r = -4.383e+00; - } - if( w==24 ) - { - r = -4.538e+00; - } - if( w==23 ) - { - r = -4.697e+00; - } - if( w==22 ) - { - r = -4.860e+00; - } - if( w==21 ) - { - r = -5.029e+00; - } - if( w==20 ) - { - r = -5.204e+00; - } - if( w==19 ) - { - r = -5.383e+00; - } - if( w==18 ) - { - r = -5.569e+00; - } - if( w==17 ) - { - r = -5.762e+00; - } - if( w==16 ) - { - r = -5.960e+00; - } - if( w==15 ) - { - r = -6.170e+00; - } - if( w==14 ) - { - r = -6.390e+00; - } - if( w==13 ) - { - r = -6.613e+00; - } - if( w==12 ) - { - r = -6.842e+00; - } - if( w==11 ) - { - r = -7.083e+00; - } - if( w==10 ) - { - r = -7.329e+00; - } - if( w==9 ) - { - r = -7.594e+00; - } - if( w==8 ) - { - r = -7.871e+00; - } - if( w==7 ) - { - r = -8.146e+00; - } - if( w==6 ) - { - r = -8.451e+00; - } - if( w==5 ) - { - r = -8.788e+00; - } - if( w==4 ) - { - r = -9.144e+00; - } - if( w==3 ) - { - r = -9.481e+00; - } - if( w==2 ) - { - r = -9.992e+00; - } - if( w==1 ) - { - r = -1.040e+01; - } - if( w<=0 ) - { - r = -1.109e+01; - } - result = r; - return result; -} - - -/************************************************************************* -Tail(S, 17) -*************************************************************************/ -static double wsr_w17(double s, ae_state *_state) -{ - ae_int_t w; - double r; - double result; - - - r = 0; - w = ae_round(-2.112463e+01*s+7.650000e+01, _state); - if( w>=76 ) - { - r = -6.931e-01; - } - if( w==75 ) - { - r = -7.306e-01; - } - if( w==74 ) - { - r = -7.695e-01; - } - if( w==73 ) - { - r = -8.097e-01; - } - if( w==72 ) - { - r = -8.514e-01; - } - if( w==71 ) - { - r = -8.946e-01; - } - if( w==70 ) - { - r = -9.392e-01; - } - if( w==69 ) - { - r = -9.853e-01; - } - if( w==68 ) - { - r = -1.033e+00; - } - if( w==67 ) - { - r = -1.082e+00; - } - if( w==66 ) - { - r = -1.133e+00; - } - if( w==65 ) - { - r = -1.185e+00; - } - if( w==64 ) - { - r = -1.240e+00; - } - if( w==63 ) - { - r = -1.295e+00; - } - if( w==62 ) - { - r = -1.353e+00; - } - if( w==61 ) - { - r = -1.412e+00; - } - if( w==60 ) - { - r = -1.473e+00; - } - if( w==59 ) - { - r = -1.536e+00; - } - if( w==58 ) - { - r = -1.600e+00; - } - if( w==57 ) - { - r = -1.666e+00; - } - if( w==56 ) - { - r = -1.735e+00; - } - if( w==55 ) - { - r = -1.805e+00; - } - if( w==54 ) - { - r = -1.877e+00; - } - if( w==53 ) - { - r = -1.951e+00; - } - if( w==52 ) - { - r = -2.028e+00; - } - if( w==51 ) - { - r = -2.106e+00; - } - if( w==50 ) - { - r = -2.186e+00; - } - if( w==49 ) - { - r = -2.269e+00; - } - if( w==48 ) - { - r = -2.353e+00; - } - if( w==47 ) - { - r = -2.440e+00; - } - if( w==46 ) - { - r = -2.530e+00; - } - if( w==45 ) - { - r = -2.621e+00; - } - if( w==44 ) - { - r = -2.715e+00; - } - if( w==43 ) - { - r = -2.812e+00; - } - if( w==42 ) - { - r = -2.911e+00; - } - if( w==41 ) - { - r = -3.012e+00; - } - if( w==40 ) - { - r = -3.116e+00; - } - if( w==39 ) - { - r = -3.223e+00; - } - if( w==38 ) - { - r = -3.332e+00; - } - if( w==37 ) - { - r = -3.445e+00; - } - if( w==36 ) - { - r = -3.560e+00; - } - if( w==35 ) - { - r = -3.678e+00; - } - if( w==34 ) - { - r = -3.799e+00; - } - if( w==33 ) - { - r = -3.924e+00; - } - if( w==32 ) - { - r = -4.052e+00; - } - if( w==31 ) - { - r = -4.183e+00; - } - if( w==30 ) - { - r = -4.317e+00; - } - if( w==29 ) - { - r = -4.456e+00; - } - if( w==28 ) - { - r = -4.597e+00; - } - if( w==27 ) - { - r = -4.743e+00; - } - if( w==26 ) - { - r = -4.893e+00; - } - if( w==25 ) - { - r = -5.047e+00; - } - if( w==24 ) - { - r = -5.204e+00; - } - if( w==23 ) - { - r = -5.367e+00; - } - if( w==22 ) - { - r = -5.534e+00; - } - if( w==21 ) - { - r = -5.706e+00; - } - if( w==20 ) - { - r = -5.884e+00; - } - if( w==19 ) - { - r = -6.066e+00; - } - if( w==18 ) - { - r = -6.254e+00; - } - if( w==17 ) - { - r = -6.451e+00; - } - if( w==16 ) - { - r = -6.654e+00; - } - if( w==15 ) - { - r = -6.864e+00; - } - if( w==14 ) - { - r = -7.083e+00; - } - if( w==13 ) - { - r = -7.306e+00; - } - if( w==12 ) - { - r = -7.535e+00; - } - if( w==11 ) - { - r = -7.776e+00; - } - if( w==10 ) - { - r = -8.022e+00; - } - if( w==9 ) - { - r = -8.287e+00; - } - if( w==8 ) - { - r = -8.565e+00; - } - if( w==7 ) - { - r = -8.839e+00; - } - if( w==6 ) - { - r = -9.144e+00; - } - if( w==5 ) - { - r = -9.481e+00; - } - if( w==4 ) - { - r = -9.838e+00; - } - if( w==3 ) - { - r = -1.017e+01; - } - if( w==2 ) - { - r = -1.068e+01; - } - if( w==1 ) - { - r = -1.109e+01; - } - if( w<=0 ) - { - r = -1.178e+01; - } - result = r; - return result; -} - - -/************************************************************************* -Tail(S, 18) -*************************************************************************/ -static double wsr_w18(double s, ae_state *_state) -{ - ae_int_t w; - double r; - double result; - - - r = 0; - w = ae_round(-2.296193e+01*s+8.550000e+01, _state); - if( w>=85 ) - { - r = -6.931e-01; - } - if( w==84 ) - { - r = -7.276e-01; - } - if( w==83 ) - { - r = -7.633e-01; - } - if( w==82 ) - { - r = -8.001e-01; - } - if( w==81 ) - { - r = -8.381e-01; - } - if( w==80 ) - { - r = -8.774e-01; - } - if( w==79 ) - { - r = -9.179e-01; - } - if( w==78 ) - { - r = -9.597e-01; - } - if( w==77 ) - { - r = -1.003e+00; - } - if( w==76 ) - { - r = -1.047e+00; - } - if( w==75 ) - { - r = -1.093e+00; - } - if( w==74 ) - { - r = -1.140e+00; - } - if( w==73 ) - { - r = -1.188e+00; - } - if( w==72 ) - { - r = -1.238e+00; - } - if( w==71 ) - { - r = -1.289e+00; - } - if( w==70 ) - { - r = -1.342e+00; - } - if( w==69 ) - { - r = -1.396e+00; - } - if( w==68 ) - { - r = -1.452e+00; - } - if( w==67 ) - { - r = -1.509e+00; - } - if( w==66 ) - { - r = -1.568e+00; - } - if( w==65 ) - { - r = -1.628e+00; - } - if( w==64 ) - { - r = -1.690e+00; - } - if( w==63 ) - { - r = -1.753e+00; - } - if( w==62 ) - { - r = -1.818e+00; - } - if( w==61 ) - { - r = -1.885e+00; - } - if( w==60 ) - { - r = -1.953e+00; - } - if( w==59 ) - { - r = -2.023e+00; - } - if( w==58 ) - { - r = -2.095e+00; - } - if( w==57 ) - { - r = -2.168e+00; - } - if( w==56 ) - { - r = -2.244e+00; - } - if( w==55 ) - { - r = -2.321e+00; - } - if( w==54 ) - { - r = -2.400e+00; - } - if( w==53 ) - { - r = -2.481e+00; - } - if( w==52 ) - { - r = -2.564e+00; - } - if( w==51 ) - { - r = -2.648e+00; - } - if( w==50 ) - { - r = -2.735e+00; - } - if( w==49 ) - { - r = -2.824e+00; - } - if( w==48 ) - { - r = -2.915e+00; - } - if( w==47 ) - { - r = -3.008e+00; - } - if( w==46 ) - { - r = -3.104e+00; - } - if( w==45 ) - { - r = -3.201e+00; - } - if( w==44 ) - { - r = -3.301e+00; - } - if( w==43 ) - { - r = -3.403e+00; - } - if( w==42 ) - { - r = -3.508e+00; - } - if( w==41 ) - { - r = -3.615e+00; - } - if( w==40 ) - { - r = -3.724e+00; - } - if( w==39 ) - { - r = -3.836e+00; - } - if( w==38 ) - { - r = -3.950e+00; - } - if( w==37 ) - { - r = -4.068e+00; - } - if( w==36 ) - { - r = -4.188e+00; - } - if( w==35 ) - { - r = -4.311e+00; - } - if( w==34 ) - { - r = -4.437e+00; - } - if( w==33 ) - { - r = -4.565e+00; - } - if( w==32 ) - { - r = -4.698e+00; - } - if( w==31 ) - { - r = -4.833e+00; - } - if( w==30 ) - { - r = -4.971e+00; - } - if( w==29 ) - { - r = -5.113e+00; - } - if( w==28 ) - { - r = -5.258e+00; - } - if( w==27 ) - { - r = -5.408e+00; - } - if( w==26 ) - { - r = -5.561e+00; - } - if( w==25 ) - { - r = -5.717e+00; - } - if( w==24 ) - { - r = -5.878e+00; - } - if( w==23 ) - { - r = -6.044e+00; - } - if( w==22 ) - { - r = -6.213e+00; - } - if( w==21 ) - { - r = -6.388e+00; - } - if( w==20 ) - { - r = -6.569e+00; - } - if( w==19 ) - { - r = -6.753e+00; - } - if( w==18 ) - { - r = -6.943e+00; - } - if( w==17 ) - { - r = -7.144e+00; - } - if( w==16 ) - { - r = -7.347e+00; - } - if( w==15 ) - { - r = -7.557e+00; - } - if( w==14 ) - { - r = -7.776e+00; - } - if( w==13 ) - { - r = -7.999e+00; - } - if( w==12 ) - { - r = -8.228e+00; - } - if( w==11 ) - { - r = -8.469e+00; - } - if( w==10 ) - { - r = -8.715e+00; - } - if( w==9 ) - { - r = -8.980e+00; - } - if( w==8 ) - { - r = -9.258e+00; - } - if( w==7 ) - { - r = -9.532e+00; - } - if( w==6 ) - { - r = -9.838e+00; - } - if( w==5 ) - { - r = -1.017e+01; - } - if( w==4 ) - { - r = -1.053e+01; - } - if( w==3 ) - { - r = -1.087e+01; - } - if( w==2 ) - { - r = -1.138e+01; - } - if( w==1 ) - { - r = -1.178e+01; - } - if( w<=0 ) - { - r = -1.248e+01; - } - result = r; - return result; -} - - -/************************************************************************* -Tail(S, 19) -*************************************************************************/ -static double wsr_w19(double s, ae_state *_state) -{ - ae_int_t w; - double r; - double result; - - - r = 0; - w = ae_round(-2.484955e+01*s+9.500000e+01, _state); - if( w>=95 ) - { - r = -6.776e-01; - } - if( w==94 ) - { - r = -7.089e-01; - } - if( w==93 ) - { - r = -7.413e-01; - } - if( w==92 ) - { - r = -7.747e-01; - } - if( w==91 ) - { - r = -8.090e-01; - } - if( w==90 ) - { - r = -8.445e-01; - } - if( w==89 ) - { - r = -8.809e-01; - } - if( w==88 ) - { - r = -9.185e-01; - } - if( w==87 ) - { - r = -9.571e-01; - } - if( w==86 ) - { - r = -9.968e-01; - } - if( w==85 ) - { - r = -1.038e+00; - } - if( w==84 ) - { - r = -1.080e+00; - } - if( w==83 ) - { - r = -1.123e+00; - } - if( w==82 ) - { - r = -1.167e+00; - } - if( w==81 ) - { - r = -1.213e+00; - } - if( w==80 ) - { - r = -1.259e+00; - } - if( w==79 ) - { - r = -1.307e+00; - } - if( w==78 ) - { - r = -1.356e+00; - } - if( w==77 ) - { - r = -1.407e+00; - } - if( w==76 ) - { - r = -1.458e+00; - } - if( w==75 ) - { - r = -1.511e+00; - } - if( w==74 ) - { - r = -1.565e+00; - } - if( w==73 ) - { - r = -1.621e+00; - } - if( w==72 ) - { - r = -1.678e+00; - } - if( w==71 ) - { - r = -1.736e+00; - } - if( w==70 ) - { - r = -1.796e+00; - } - if( w==69 ) - { - r = -1.857e+00; - } - if( w==68 ) - { - r = -1.919e+00; - } - if( w==67 ) - { - r = -1.983e+00; - } - if( w==66 ) - { - r = -2.048e+00; - } - if( w==65 ) - { - r = -2.115e+00; - } - if( w==64 ) - { - r = -2.183e+00; - } - if( w==63 ) - { - r = -2.253e+00; - } - if( w==62 ) - { - r = -2.325e+00; - } - if( w==61 ) - { - r = -2.398e+00; - } - if( w==60 ) - { - r = -2.472e+00; - } - if( w==59 ) - { - r = -2.548e+00; - } - if( w==58 ) - { - r = -2.626e+00; - } - if( w==57 ) - { - r = -2.706e+00; - } - if( w==56 ) - { - r = -2.787e+00; - } - if( w==55 ) - { - r = -2.870e+00; - } - if( w==54 ) - { - r = -2.955e+00; - } - if( w==53 ) - { - r = -3.042e+00; - } - if( w==52 ) - { - r = -3.130e+00; - } - if( w==51 ) - { - r = -3.220e+00; - } - if( w==50 ) - { - r = -3.313e+00; - } - if( w==49 ) - { - r = -3.407e+00; - } - if( w==48 ) - { - r = -3.503e+00; - } - if( w==47 ) - { - r = -3.601e+00; - } - if( w==46 ) - { - r = -3.702e+00; - } - if( w==45 ) - { - r = -3.804e+00; - } - if( w==44 ) - { - r = -3.909e+00; - } - if( w==43 ) - { - r = -4.015e+00; - } - if( w==42 ) - { - r = -4.125e+00; - } - if( w==41 ) - { - r = -4.236e+00; - } - if( w==40 ) - { - r = -4.350e+00; - } - if( w==39 ) - { - r = -4.466e+00; - } - if( w==38 ) - { - r = -4.585e+00; - } - if( w==37 ) - { - r = -4.706e+00; - } - if( w==36 ) - { - r = -4.830e+00; - } - if( w==35 ) - { - r = -4.957e+00; - } - if( w==34 ) - { - r = -5.086e+00; - } - if( w==33 ) - { - r = -5.219e+00; - } - if( w==32 ) - { - r = -5.355e+00; - } - if( w==31 ) - { - r = -5.493e+00; - } - if( w==30 ) - { - r = -5.634e+00; - } - if( w==29 ) - { - r = -5.780e+00; - } - if( w==28 ) - { - r = -5.928e+00; - } - if( w==27 ) - { - r = -6.080e+00; - } - if( w==26 ) - { - r = -6.235e+00; - } - if( w==25 ) - { - r = -6.394e+00; - } - if( w==24 ) - { - r = -6.558e+00; - } - if( w==23 ) - { - r = -6.726e+00; - } - if( w==22 ) - { - r = -6.897e+00; - } - if( w==21 ) - { - r = -7.074e+00; - } - if( w==20 ) - { - r = -7.256e+00; - } - if( w==19 ) - { - r = -7.443e+00; - } - if( w==18 ) - { - r = -7.636e+00; - } - if( w==17 ) - { - r = -7.837e+00; - } - if( w==16 ) - { - r = -8.040e+00; - } - if( w==15 ) - { - r = -8.250e+00; - } - if( w==14 ) - { - r = -8.469e+00; - } - if( w==13 ) - { - r = -8.692e+00; - } - if( w==12 ) - { - r = -8.921e+00; - } - if( w==11 ) - { - r = -9.162e+00; - } - if( w==10 ) - { - r = -9.409e+00; - } - if( w==9 ) - { - r = -9.673e+00; - } - if( w==8 ) - { - r = -9.951e+00; - } - if( w==7 ) - { - r = -1.023e+01; - } - if( w==6 ) - { - r = -1.053e+01; - } - if( w==5 ) - { - r = -1.087e+01; - } - if( w==4 ) - { - r = -1.122e+01; - } - if( w==3 ) - { - r = -1.156e+01; - } - if( w==2 ) - { - r = -1.207e+01; - } - if( w==1 ) - { - r = -1.248e+01; - } - if( w<=0 ) - { - r = -1.317e+01; - } - result = r; - return result; -} - - -/************************************************************************* -Tail(S, 20) -*************************************************************************/ -static double wsr_w20(double s, ae_state *_state) -{ - ae_int_t w; - double r; - double result; - - - r = 0; - w = ae_round(-2.678619e+01*s+1.050000e+02, _state); - if( w>=105 ) - { - r = -6.787e-01; - } - if( w==104 ) - { - r = -7.078e-01; - } - if( w==103 ) - { - r = -7.378e-01; - } - if( w==102 ) - { - r = -7.686e-01; - } - if( w==101 ) - { - r = -8.004e-01; - } - if( w==100 ) - { - r = -8.330e-01; - } - if( w==99 ) - { - r = -8.665e-01; - } - if( w==98 ) - { - r = -9.010e-01; - } - if( w==97 ) - { - r = -9.363e-01; - } - if( w==96 ) - { - r = -9.726e-01; - } - if( w==95 ) - { - r = -1.010e+00; - } - if( w==94 ) - { - r = -1.048e+00; - } - if( w==93 ) - { - r = -1.087e+00; - } - if( w==92 ) - { - r = -1.128e+00; - } - if( w==91 ) - { - r = -1.169e+00; - } - if( w==90 ) - { - r = -1.211e+00; - } - if( w==89 ) - { - r = -1.254e+00; - } - if( w==88 ) - { - r = -1.299e+00; - } - if( w==87 ) - { - r = -1.344e+00; - } - if( w==86 ) - { - r = -1.390e+00; - } - if( w==85 ) - { - r = -1.438e+00; - } - if( w==84 ) - { - r = -1.486e+00; - } - if( w==83 ) - { - r = -1.536e+00; - } - if( w==82 ) - { - r = -1.587e+00; - } - if( w==81 ) - { - r = -1.639e+00; - } - if( w==80 ) - { - r = -1.692e+00; - } - if( w==79 ) - { - r = -1.746e+00; - } - if( w==78 ) - { - r = -1.802e+00; - } - if( w==77 ) - { - r = -1.859e+00; - } - if( w==76 ) - { - r = -1.916e+00; - } - if( w==75 ) - { - r = -1.976e+00; - } - if( w==74 ) - { - r = -2.036e+00; - } - if( w==73 ) - { - r = -2.098e+00; - } - if( w==72 ) - { - r = -2.161e+00; - } - if( w==71 ) - { - r = -2.225e+00; - } - if( w==70 ) - { - r = -2.290e+00; - } - if( w==69 ) - { - r = -2.357e+00; - } - if( w==68 ) - { - r = -2.426e+00; - } - if( w==67 ) - { - r = -2.495e+00; - } - if( w==66 ) - { - r = -2.566e+00; - } - if( w==65 ) - { - r = -2.639e+00; - } - if( w==64 ) - { - r = -2.713e+00; - } - if( w==63 ) - { - r = -2.788e+00; - } - if( w==62 ) - { - r = -2.865e+00; - } - if( w==61 ) - { - r = -2.943e+00; - } - if( w==60 ) - { - r = -3.023e+00; - } - if( w==59 ) - { - r = -3.104e+00; - } - if( w==58 ) - { - r = -3.187e+00; - } - if( w==57 ) - { - r = -3.272e+00; - } - if( w==56 ) - { - r = -3.358e+00; - } - if( w==55 ) - { - r = -3.446e+00; - } - if( w==54 ) - { - r = -3.536e+00; - } - if( w==53 ) - { - r = -3.627e+00; - } - if( w==52 ) - { - r = -3.721e+00; - } - if( w==51 ) - { - r = -3.815e+00; - } - if( w==50 ) - { - r = -3.912e+00; - } - if( w==49 ) - { - r = -4.011e+00; - } - if( w==48 ) - { - r = -4.111e+00; - } - if( w==47 ) - { - r = -4.214e+00; - } - if( w==46 ) - { - r = -4.318e+00; - } - if( w==45 ) - { - r = -4.425e+00; - } - if( w==44 ) - { - r = -4.534e+00; - } - if( w==43 ) - { - r = -4.644e+00; - } - if( w==42 ) - { - r = -4.757e+00; - } - if( w==41 ) - { - r = -4.872e+00; - } - if( w==40 ) - { - r = -4.990e+00; - } - if( w==39 ) - { - r = -5.109e+00; - } - if( w==38 ) - { - r = -5.232e+00; - } - if( w==37 ) - { - r = -5.356e+00; - } - if( w==36 ) - { - r = -5.484e+00; - } - if( w==35 ) - { - r = -5.614e+00; - } - if( w==34 ) - { - r = -5.746e+00; - } - if( w==33 ) - { - r = -5.882e+00; - } - if( w==32 ) - { - r = -6.020e+00; - } - if( w==31 ) - { - r = -6.161e+00; - } - if( w==30 ) - { - r = -6.305e+00; - } - if( w==29 ) - { - r = -6.453e+00; - } - if( w==28 ) - { - r = -6.603e+00; - } - if( w==27 ) - { - r = -6.757e+00; - } - if( w==26 ) - { - r = -6.915e+00; - } - if( w==25 ) - { - r = -7.076e+00; - } - if( w==24 ) - { - r = -7.242e+00; - } - if( w==23 ) - { - r = -7.411e+00; - } - if( w==22 ) - { - r = -7.584e+00; - } - if( w==21 ) - { - r = -7.763e+00; - } - if( w==20 ) - { - r = -7.947e+00; - } - if( w==19 ) - { - r = -8.136e+00; - } - if( w==18 ) - { - r = -8.330e+00; - } - if( w==17 ) - { - r = -8.530e+00; - } - if( w==16 ) - { - r = -8.733e+00; - } - if( w==15 ) - { - r = -8.943e+00; - } - if( w==14 ) - { - r = -9.162e+00; - } - if( w==13 ) - { - r = -9.386e+00; - } - if( w==12 ) - { - r = -9.614e+00; - } - if( w==11 ) - { - r = -9.856e+00; - } - if( w==10 ) - { - r = -1.010e+01; - } - if( w==9 ) - { - r = -1.037e+01; - } - if( w==8 ) - { - r = -1.064e+01; - } - if( w==7 ) - { - r = -1.092e+01; - } - if( w==6 ) - { - r = -1.122e+01; - } - if( w==5 ) - { - r = -1.156e+01; - } - if( w==4 ) - { - r = -1.192e+01; - } - if( w==3 ) - { - r = -1.225e+01; - } - if( w==2 ) - { - r = -1.276e+01; - } - if( w==1 ) - { - r = -1.317e+01; - } - if( w<=0 ) - { - r = -1.386e+01; - } - result = r; - return result; -} - - -/************************************************************************* -Tail(S, 21) -*************************************************************************/ -static double wsr_w21(double s, ae_state *_state) -{ - ae_int_t w; - double r; - double result; - - - r = 0; - w = ae_round(-2.877064e+01*s+1.155000e+02, _state); - if( w>=115 ) - { - r = -6.931e-01; - } - if( w==114 ) - { - r = -7.207e-01; - } - if( w==113 ) - { - r = -7.489e-01; - } - if( w==112 ) - { - r = -7.779e-01; - } - if( w==111 ) - { - r = -8.077e-01; - } - if( w==110 ) - { - r = -8.383e-01; - } - if( w==109 ) - { - r = -8.697e-01; - } - if( w==108 ) - { - r = -9.018e-01; - } - if( w==107 ) - { - r = -9.348e-01; - } - if( w==106 ) - { - r = -9.685e-01; - } - if( w==105 ) - { - r = -1.003e+00; - } - if( w==104 ) - { - r = -1.039e+00; - } - if( w==103 ) - { - r = -1.075e+00; - } - if( w==102 ) - { - r = -1.112e+00; - } - if( w==101 ) - { - r = -1.150e+00; - } - if( w==100 ) - { - r = -1.189e+00; - } - if( w==99 ) - { - r = -1.229e+00; - } - if( w==98 ) - { - r = -1.269e+00; - } - if( w==97 ) - { - r = -1.311e+00; - } - if( w==96 ) - { - r = -1.353e+00; - } - if( w==95 ) - { - r = -1.397e+00; - } - if( w==94 ) - { - r = -1.441e+00; - } - if( w==93 ) - { - r = -1.486e+00; - } - if( w==92 ) - { - r = -1.533e+00; - } - if( w==91 ) - { - r = -1.580e+00; - } - if( w==90 ) - { - r = -1.628e+00; - } - if( w==89 ) - { - r = -1.677e+00; - } - if( w==88 ) - { - r = -1.728e+00; - } - if( w==87 ) - { - r = -1.779e+00; - } - if( w==86 ) - { - r = -1.831e+00; - } - if( w==85 ) - { - r = -1.884e+00; - } - if( w==84 ) - { - r = -1.939e+00; - } - if( w==83 ) - { - r = -1.994e+00; - } - if( w==82 ) - { - r = -2.051e+00; - } - if( w==81 ) - { - r = -2.108e+00; - } - if( w==80 ) - { - r = -2.167e+00; - } - if( w==79 ) - { - r = -2.227e+00; - } - if( w==78 ) - { - r = -2.288e+00; - } - if( w==77 ) - { - r = -2.350e+00; - } - if( w==76 ) - { - r = -2.414e+00; - } - if( w==75 ) - { - r = -2.478e+00; - } - if( w==74 ) - { - r = -2.544e+00; - } - if( w==73 ) - { - r = -2.611e+00; - } - if( w==72 ) - { - r = -2.679e+00; - } - if( w==71 ) - { - r = -2.748e+00; - } - if( w==70 ) - { - r = -2.819e+00; - } - if( w==69 ) - { - r = -2.891e+00; - } - if( w==68 ) - { - r = -2.964e+00; - } - if( w==67 ) - { - r = -3.039e+00; - } - if( w==66 ) - { - r = -3.115e+00; - } - if( w==65 ) - { - r = -3.192e+00; - } - if( w==64 ) - { - r = -3.270e+00; - } - if( w==63 ) - { - r = -3.350e+00; - } - if( w==62 ) - { - r = -3.432e+00; - } - if( w==61 ) - { - r = -3.515e+00; - } - if( w==60 ) - { - r = -3.599e+00; - } - if( w==59 ) - { - r = -3.685e+00; - } - if( w==58 ) - { - r = -3.772e+00; - } - if( w==57 ) - { - r = -3.861e+00; - } - if( w==56 ) - { - r = -3.952e+00; - } - if( w==55 ) - { - r = -4.044e+00; - } - if( w==54 ) - { - r = -4.138e+00; - } - if( w==53 ) - { - r = -4.233e+00; - } - if( w==52 ) - { - r = -4.330e+00; - } - if( w==51 ) - { - r = -4.429e+00; - } - if( w==50 ) - { - r = -4.530e+00; - } - if( w==49 ) - { - r = -4.632e+00; - } - if( w==48 ) - { - r = -4.736e+00; - } - if( w==47 ) - { - r = -4.842e+00; - } - if( w==46 ) - { - r = -4.950e+00; - } - if( w==45 ) - { - r = -5.060e+00; - } - if( w==44 ) - { - r = -5.172e+00; - } - if( w==43 ) - { - r = -5.286e+00; - } - if( w==42 ) - { - r = -5.402e+00; - } - if( w==41 ) - { - r = -5.520e+00; - } - if( w==40 ) - { - r = -5.641e+00; - } - if( w==39 ) - { - r = -5.763e+00; - } - if( w==38 ) - { - r = -5.889e+00; - } - if( w==37 ) - { - r = -6.016e+00; - } - if( w==36 ) - { - r = -6.146e+00; - } - if( w==35 ) - { - r = -6.278e+00; - } - if( w==34 ) - { - r = -6.413e+00; - } - if( w==33 ) - { - r = -6.551e+00; - } - if( w==32 ) - { - r = -6.692e+00; - } - if( w==31 ) - { - r = -6.835e+00; - } - if( w==30 ) - { - r = -6.981e+00; - } - if( w==29 ) - { - r = -7.131e+00; - } - if( w==28 ) - { - r = -7.283e+00; - } - if( w==27 ) - { - r = -7.439e+00; - } - if( w==26 ) - { - r = -7.599e+00; - } - if( w==25 ) - { - r = -7.762e+00; - } - if( w==24 ) - { - r = -7.928e+00; - } - if( w==23 ) - { - r = -8.099e+00; - } - if( w==22 ) - { - r = -8.274e+00; - } - if( w==21 ) - { - r = -8.454e+00; - } - if( w==20 ) - { - r = -8.640e+00; - } - if( w==19 ) - { - r = -8.829e+00; - } - if( w==18 ) - { - r = -9.023e+00; - } - if( w==17 ) - { - r = -9.223e+00; - } - if( w==16 ) - { - r = -9.426e+00; - } - if( w==15 ) - { - r = -9.636e+00; - } - if( w==14 ) - { - r = -9.856e+00; - } - if( w==13 ) - { - r = -1.008e+01; - } - if( w==12 ) - { - r = -1.031e+01; - } - if( w==11 ) - { - r = -1.055e+01; - } - if( w==10 ) - { - r = -1.079e+01; - } - if( w==9 ) - { - r = -1.106e+01; - } - if( w==8 ) - { - r = -1.134e+01; - } - if( w==7 ) - { - r = -1.161e+01; - } - if( w==6 ) - { - r = -1.192e+01; - } - if( w==5 ) - { - r = -1.225e+01; - } - if( w==4 ) - { - r = -1.261e+01; - } - if( w==3 ) - { - r = -1.295e+01; - } - if( w==2 ) - { - r = -1.346e+01; - } - if( w==1 ) - { - r = -1.386e+01; - } - if( w<=0 ) - { - r = -1.456e+01; - } - result = r; - return result; -} - - -/************************************************************************* -Tail(S, 22) -*************************************************************************/ -static double wsr_w22(double s, ae_state *_state) -{ - ae_int_t w; - double r; - double result; - - - r = 0; - w = ae_round(-3.080179e+01*s+1.265000e+02, _state); - if( w>=126 ) - { - r = -6.931e-01; - } - if( w==125 ) - { - r = -7.189e-01; - } - if( w==124 ) - { - r = -7.452e-01; - } - if( w==123 ) - { - r = -7.722e-01; - } - if( w==122 ) - { - r = -7.999e-01; - } - if( w==121 ) - { - r = -8.283e-01; - } - if( w==120 ) - { - r = -8.573e-01; - } - if( w==119 ) - { - r = -8.871e-01; - } - if( w==118 ) - { - r = -9.175e-01; - } - if( w==117 ) - { - r = -9.486e-01; - } - if( w==116 ) - { - r = -9.805e-01; - } - if( w==115 ) - { - r = -1.013e+00; - } - if( w==114 ) - { - r = -1.046e+00; - } - if( w==113 ) - { - r = -1.080e+00; - } - if( w==112 ) - { - r = -1.115e+00; - } - if( w==111 ) - { - r = -1.151e+00; - } - if( w==110 ) - { - r = -1.187e+00; - } - if( w==109 ) - { - r = -1.224e+00; - } - if( w==108 ) - { - r = -1.262e+00; - } - if( w==107 ) - { - r = -1.301e+00; - } - if( w==106 ) - { - r = -1.340e+00; - } - if( w==105 ) - { - r = -1.381e+00; - } - if( w==104 ) - { - r = -1.422e+00; - } - if( w==103 ) - { - r = -1.464e+00; - } - if( w==102 ) - { - r = -1.506e+00; - } - if( w==101 ) - { - r = -1.550e+00; - } - if( w==100 ) - { - r = -1.594e+00; - } - if( w==99 ) - { - r = -1.640e+00; - } - if( w==98 ) - { - r = -1.686e+00; - } - if( w==97 ) - { - r = -1.733e+00; - } - if( w==96 ) - { - r = -1.781e+00; - } - if( w==95 ) - { - r = -1.830e+00; - } - if( w==94 ) - { - r = -1.880e+00; - } - if( w==93 ) - { - r = -1.930e+00; - } - if( w==92 ) - { - r = -1.982e+00; - } - if( w==91 ) - { - r = -2.034e+00; - } - if( w==90 ) - { - r = -2.088e+00; - } - if( w==89 ) - { - r = -2.142e+00; - } - if( w==88 ) - { - r = -2.198e+00; - } - if( w==87 ) - { - r = -2.254e+00; - } - if( w==86 ) - { - r = -2.312e+00; - } - if( w==85 ) - { - r = -2.370e+00; - } - if( w==84 ) - { - r = -2.429e+00; - } - if( w==83 ) - { - r = -2.490e+00; - } - if( w==82 ) - { - r = -2.551e+00; - } - if( w==81 ) - { - r = -2.614e+00; - } - if( w==80 ) - { - r = -2.677e+00; - } - if( w==79 ) - { - r = -2.742e+00; - } - if( w==78 ) - { - r = -2.808e+00; - } - if( w==77 ) - { - r = -2.875e+00; - } - if( w==76 ) - { - r = -2.943e+00; - } - if( w==75 ) - { - r = -3.012e+00; - } - if( w==74 ) - { - r = -3.082e+00; - } - if( w==73 ) - { - r = -3.153e+00; - } - if( w==72 ) - { - r = -3.226e+00; - } - if( w==71 ) - { - r = -3.300e+00; - } - if( w==70 ) - { - r = -3.375e+00; - } - if( w==69 ) - { - r = -3.451e+00; - } - if( w==68 ) - { - r = -3.529e+00; - } - if( w==67 ) - { - r = -3.607e+00; - } - if( w==66 ) - { - r = -3.687e+00; - } - if( w==65 ) - { - r = -3.769e+00; - } - if( w==64 ) - { - r = -3.851e+00; - } - if( w==63 ) - { - r = -3.935e+00; - } - if( w==62 ) - { - r = -4.021e+00; - } - if( w==61 ) - { - r = -4.108e+00; - } - if( w==60 ) - { - r = -4.196e+00; - } - if( w==59 ) - { - r = -4.285e+00; - } - if( w==58 ) - { - r = -4.376e+00; - } - if( w==57 ) - { - r = -4.469e+00; - } - if( w==56 ) - { - r = -4.563e+00; - } - if( w==55 ) - { - r = -4.659e+00; - } - if( w==54 ) - { - r = -4.756e+00; - } - if( w==53 ) - { - r = -4.855e+00; - } - if( w==52 ) - { - r = -4.955e+00; - } - if( w==51 ) - { - r = -5.057e+00; - } - if( w==50 ) - { - r = -5.161e+00; - } - if( w==49 ) - { - r = -5.266e+00; - } - if( w==48 ) - { - r = -5.374e+00; - } - if( w==47 ) - { - r = -5.483e+00; - } - if( w==46 ) - { - r = -5.594e+00; - } - if( w==45 ) - { - r = -5.706e+00; - } - if( w==44 ) - { - r = -5.821e+00; - } - if( w==43 ) - { - r = -5.938e+00; - } - if( w==42 ) - { - r = -6.057e+00; - } - if( w==41 ) - { - r = -6.177e+00; - } - if( w==40 ) - { - r = -6.300e+00; - } - if( w==39 ) - { - r = -6.426e+00; - } - if( w==38 ) - { - r = -6.553e+00; - } - if( w==37 ) - { - r = -6.683e+00; - } - if( w==36 ) - { - r = -6.815e+00; - } - if( w==35 ) - { - r = -6.949e+00; - } - if( w==34 ) - { - r = -7.086e+00; - } - if( w==33 ) - { - r = -7.226e+00; - } - if( w==32 ) - { - r = -7.368e+00; - } - if( w==31 ) - { - r = -7.513e+00; - } - if( w==30 ) - { - r = -7.661e+00; - } - if( w==29 ) - { - r = -7.813e+00; - } - if( w==28 ) - { - r = -7.966e+00; - } - if( w==27 ) - { - r = -8.124e+00; - } - if( w==26 ) - { - r = -8.285e+00; - } - if( w==25 ) - { - r = -8.449e+00; - } - if( w==24 ) - { - r = -8.617e+00; - } - if( w==23 ) - { - r = -8.789e+00; - } - if( w==22 ) - { - r = -8.965e+00; - } - if( w==21 ) - { - r = -9.147e+00; - } - if( w==20 ) - { - r = -9.333e+00; - } - if( w==19 ) - { - r = -9.522e+00; - } - if( w==18 ) - { - r = -9.716e+00; - } - if( w==17 ) - { - r = -9.917e+00; - } - if( w==16 ) - { - r = -1.012e+01; - } - if( w==15 ) - { - r = -1.033e+01; - } - if( w==14 ) - { - r = -1.055e+01; - } - if( w==13 ) - { - r = -1.077e+01; - } - if( w==12 ) - { - r = -1.100e+01; - } - if( w==11 ) - { - r = -1.124e+01; - } - if( w==10 ) - { - r = -1.149e+01; - } - if( w==9 ) - { - r = -1.175e+01; - } - if( w==8 ) - { - r = -1.203e+01; - } - if( w==7 ) - { - r = -1.230e+01; - } - if( w==6 ) - { - r = -1.261e+01; - } - if( w==5 ) - { - r = -1.295e+01; - } - if( w==4 ) - { - r = -1.330e+01; - } - if( w==3 ) - { - r = -1.364e+01; - } - if( w==2 ) - { - r = -1.415e+01; - } - if( w==1 ) - { - r = -1.456e+01; - } - if( w<=0 ) - { - r = -1.525e+01; - } - result = r; - return result; -} - - -/************************************************************************* -Tail(S, 23) -*************************************************************************/ -static double wsr_w23(double s, ae_state *_state) -{ - ae_int_t w; - double r; - double result; - - - r = 0; - w = ae_round(-3.287856e+01*s+1.380000e+02, _state); - if( w>=138 ) - { - r = -6.813e-01; - } - if( w==137 ) - { - r = -7.051e-01; - } - if( w==136 ) - { - r = -7.295e-01; - } - if( w==135 ) - { - r = -7.544e-01; - } - if( w==134 ) - { - r = -7.800e-01; - } - if( w==133 ) - { - r = -8.061e-01; - } - if( w==132 ) - { - r = -8.328e-01; - } - if( w==131 ) - { - r = -8.601e-01; - } - if( w==130 ) - { - r = -8.880e-01; - } - if( w==129 ) - { - r = -9.166e-01; - } - if( w==128 ) - { - r = -9.457e-01; - } - if( w==127 ) - { - r = -9.755e-01; - } - if( w==126 ) - { - r = -1.006e+00; - } - if( w==125 ) - { - r = -1.037e+00; - } - if( w==124 ) - { - r = -1.069e+00; - } - if( w==123 ) - { - r = -1.101e+00; - } - if( w==122 ) - { - r = -1.134e+00; - } - if( w==121 ) - { - r = -1.168e+00; - } - if( w==120 ) - { - r = -1.202e+00; - } - if( w==119 ) - { - r = -1.237e+00; - } - if( w==118 ) - { - r = -1.273e+00; - } - if( w==117 ) - { - r = -1.309e+00; - } - if( w==116 ) - { - r = -1.347e+00; - } - if( w==115 ) - { - r = -1.384e+00; - } - if( w==114 ) - { - r = -1.423e+00; - } - if( w==113 ) - { - r = -1.462e+00; - } - if( w==112 ) - { - r = -1.502e+00; - } - if( w==111 ) - { - r = -1.543e+00; - } - if( w==110 ) - { - r = -1.585e+00; - } - if( w==109 ) - { - r = -1.627e+00; - } - if( w==108 ) - { - r = -1.670e+00; - } - if( w==107 ) - { - r = -1.714e+00; - } - if( w==106 ) - { - r = -1.758e+00; - } - if( w==105 ) - { - r = -1.804e+00; - } - if( w==104 ) - { - r = -1.850e+00; - } - if( w==103 ) - { - r = -1.897e+00; - } - if( w==102 ) - { - r = -1.944e+00; - } - if( w==101 ) - { - r = -1.993e+00; - } - if( w==100 ) - { - r = -2.042e+00; - } - if( w==99 ) - { - r = -2.093e+00; - } - if( w==98 ) - { - r = -2.144e+00; - } - if( w==97 ) - { - r = -2.195e+00; - } - if( w==96 ) - { - r = -2.248e+00; - } - if( w==95 ) - { - r = -2.302e+00; - } - if( w==94 ) - { - r = -2.356e+00; - } - if( w==93 ) - { - r = -2.412e+00; - } - if( w==92 ) - { - r = -2.468e+00; - } - if( w==91 ) - { - r = -2.525e+00; - } - if( w==90 ) - { - r = -2.583e+00; - } - if( w==89 ) - { - r = -2.642e+00; - } - if( w==88 ) - { - r = -2.702e+00; - } - if( w==87 ) - { - r = -2.763e+00; - } - if( w==86 ) - { - r = -2.825e+00; - } - if( w==85 ) - { - r = -2.888e+00; - } - if( w==84 ) - { - r = -2.951e+00; - } - if( w==83 ) - { - r = -3.016e+00; - } - if( w==82 ) - { - r = -3.082e+00; - } - if( w==81 ) - { - r = -3.149e+00; - } - if( w==80 ) - { - r = -3.216e+00; - } - if( w==79 ) - { - r = -3.285e+00; - } - if( w==78 ) - { - r = -3.355e+00; - } - if( w==77 ) - { - r = -3.426e+00; - } - if( w==76 ) - { - r = -3.498e+00; - } - if( w==75 ) - { - r = -3.571e+00; - } - if( w==74 ) - { - r = -3.645e+00; - } - if( w==73 ) - { - r = -3.721e+00; - } - if( w==72 ) - { - r = -3.797e+00; - } - if( w==71 ) - { - r = -3.875e+00; - } - if( w==70 ) - { - r = -3.953e+00; - } - if( w==69 ) - { - r = -4.033e+00; - } - if( w==68 ) - { - r = -4.114e+00; - } - if( w==67 ) - { - r = -4.197e+00; - } - if( w==66 ) - { - r = -4.280e+00; - } - if( w==65 ) - { - r = -4.365e+00; - } - if( w==64 ) - { - r = -4.451e+00; - } - if( w==63 ) - { - r = -4.539e+00; - } - if( w==62 ) - { - r = -4.628e+00; - } - if( w==61 ) - { - r = -4.718e+00; - } - if( w==60 ) - { - r = -4.809e+00; - } - if( w==59 ) - { - r = -4.902e+00; - } - if( w==58 ) - { - r = -4.996e+00; - } - if( w==57 ) - { - r = -5.092e+00; - } - if( w==56 ) - { - r = -5.189e+00; - } - if( w==55 ) - { - r = -5.287e+00; - } - if( w==54 ) - { - r = -5.388e+00; - } - if( w==53 ) - { - r = -5.489e+00; - } - if( w==52 ) - { - r = -5.592e+00; - } - if( w==51 ) - { - r = -5.697e+00; - } - if( w==50 ) - { - r = -5.804e+00; - } - if( w==49 ) - { - r = -5.912e+00; - } - if( w==48 ) - { - r = -6.022e+00; - } - if( w==47 ) - { - r = -6.133e+00; - } - if( w==46 ) - { - r = -6.247e+00; - } - if( w==45 ) - { - r = -6.362e+00; - } - if( w==44 ) - { - r = -6.479e+00; - } - if( w==43 ) - { - r = -6.598e+00; - } - if( w==42 ) - { - r = -6.719e+00; - } - if( w==41 ) - { - r = -6.842e+00; - } - if( w==40 ) - { - r = -6.967e+00; - } - if( w==39 ) - { - r = -7.094e+00; - } - if( w==38 ) - { - r = -7.224e+00; - } - if( w==37 ) - { - r = -7.355e+00; - } - if( w==36 ) - { - r = -7.489e+00; - } - if( w==35 ) - { - r = -7.625e+00; - } - if( w==34 ) - { - r = -7.764e+00; - } - if( w==33 ) - { - r = -7.905e+00; - } - if( w==32 ) - { - r = -8.049e+00; - } - if( w==31 ) - { - r = -8.196e+00; - } - if( w==30 ) - { - r = -8.345e+00; - } - if( w==29 ) - { - r = -8.498e+00; - } - if( w==28 ) - { - r = -8.653e+00; - } - if( w==27 ) - { - r = -8.811e+00; - } - if( w==26 ) - { - r = -8.974e+00; - } - if( w==25 ) - { - r = -9.139e+00; - } - if( w==24 ) - { - r = -9.308e+00; - } - if( w==23 ) - { - r = -9.481e+00; - } - if( w==22 ) - { - r = -9.658e+00; - } - if( w==21 ) - { - r = -9.840e+00; - } - if( w==20 ) - { - r = -1.003e+01; - } - if( w==19 ) - { - r = -1.022e+01; - } - if( w==18 ) - { - r = -1.041e+01; - } - if( w==17 ) - { - r = -1.061e+01; - } - if( w==16 ) - { - r = -1.081e+01; - } - if( w==15 ) - { - r = -1.102e+01; - } - if( w==14 ) - { - r = -1.124e+01; - } - if( w==13 ) - { - r = -1.147e+01; - } - if( w==12 ) - { - r = -1.169e+01; - } - if( w==11 ) - { - r = -1.194e+01; - } - if( w==10 ) - { - r = -1.218e+01; - } - if( w==9 ) - { - r = -1.245e+01; - } - if( w==8 ) - { - r = -1.272e+01; - } - if( w==7 ) - { - r = -1.300e+01; - } - if( w==6 ) - { - r = -1.330e+01; - } - if( w==5 ) - { - r = -1.364e+01; - } - if( w==4 ) - { - r = -1.400e+01; - } - if( w==3 ) - { - r = -1.433e+01; - } - if( w==2 ) - { - r = -1.484e+01; - } - if( w==1 ) - { - r = -1.525e+01; - } - if( w<=0 ) - { - r = -1.594e+01; - } - result = r; - return result; -} - - -/************************************************************************* -Tail(S, 24) -*************************************************************************/ -static double wsr_w24(double s, ae_state *_state) -{ - ae_int_t w; - double r; - double result; - - - r = 0; - w = ae_round(-3.500000e+01*s+1.500000e+02, _state); - if( w>=150 ) - { - r = -6.820e-01; - } - if( w==149 ) - { - r = -7.044e-01; - } - if( w==148 ) - { - r = -7.273e-01; - } - if( w==147 ) - { - r = -7.507e-01; - } - if( w==146 ) - { - r = -7.746e-01; - } - if( w==145 ) - { - r = -7.990e-01; - } - if( w==144 ) - { - r = -8.239e-01; - } - if( w==143 ) - { - r = -8.494e-01; - } - if( w==142 ) - { - r = -8.754e-01; - } - if( w==141 ) - { - r = -9.020e-01; - } - if( w==140 ) - { - r = -9.291e-01; - } - if( w==139 ) - { - r = -9.567e-01; - } - if( w==138 ) - { - r = -9.849e-01; - } - if( w==137 ) - { - r = -1.014e+00; - } - if( w==136 ) - { - r = -1.043e+00; - } - if( w==135 ) - { - r = -1.073e+00; - } - if( w==134 ) - { - r = -1.103e+00; - } - if( w==133 ) - { - r = -1.135e+00; - } - if( w==132 ) - { - r = -1.166e+00; - } - if( w==131 ) - { - r = -1.198e+00; - } - if( w==130 ) - { - r = -1.231e+00; - } - if( w==129 ) - { - r = -1.265e+00; - } - if( w==128 ) - { - r = -1.299e+00; - } - if( w==127 ) - { - r = -1.334e+00; - } - if( w==126 ) - { - r = -1.369e+00; - } - if( w==125 ) - { - r = -1.405e+00; - } - if( w==124 ) - { - r = -1.441e+00; - } - if( w==123 ) - { - r = -1.479e+00; - } - if( w==122 ) - { - r = -1.517e+00; - } - if( w==121 ) - { - r = -1.555e+00; - } - if( w==120 ) - { - r = -1.594e+00; - } - if( w==119 ) - { - r = -1.634e+00; - } - if( w==118 ) - { - r = -1.675e+00; - } - if( w==117 ) - { - r = -1.716e+00; - } - if( w==116 ) - { - r = -1.758e+00; - } - if( w==115 ) - { - r = -1.800e+00; - } - if( w==114 ) - { - r = -1.844e+00; - } - if( w==113 ) - { - r = -1.888e+00; - } - if( w==112 ) - { - r = -1.932e+00; - } - if( w==111 ) - { - r = -1.978e+00; - } - if( w==110 ) - { - r = -2.024e+00; - } - if( w==109 ) - { - r = -2.070e+00; - } - if( w==108 ) - { - r = -2.118e+00; - } - if( w==107 ) - { - r = -2.166e+00; - } - if( w==106 ) - { - r = -2.215e+00; - } - if( w==105 ) - { - r = -2.265e+00; - } - if( w==104 ) - { - r = -2.316e+00; - } - if( w==103 ) - { - r = -2.367e+00; - } - if( w==102 ) - { - r = -2.419e+00; - } - if( w==101 ) - { - r = -2.472e+00; - } - if( w==100 ) - { - r = -2.526e+00; - } - if( w==99 ) - { - r = -2.580e+00; - } - if( w==98 ) - { - r = -2.636e+00; - } - if( w==97 ) - { - r = -2.692e+00; - } - if( w==96 ) - { - r = -2.749e+00; - } - if( w==95 ) - { - r = -2.806e+00; - } - if( w==94 ) - { - r = -2.865e+00; - } - if( w==93 ) - { - r = -2.925e+00; - } - if( w==92 ) - { - r = -2.985e+00; - } - if( w==91 ) - { - r = -3.046e+00; - } - if( w==90 ) - { - r = -3.108e+00; - } - if( w==89 ) - { - r = -3.171e+00; - } - if( w==88 ) - { - r = -3.235e+00; - } - if( w==87 ) - { - r = -3.300e+00; - } - if( w==86 ) - { - r = -3.365e+00; - } - if( w==85 ) - { - r = -3.432e+00; - } - if( w==84 ) - { - r = -3.499e+00; - } - if( w==83 ) - { - r = -3.568e+00; - } - if( w==82 ) - { - r = -3.637e+00; - } - if( w==81 ) - { - r = -3.708e+00; - } - if( w==80 ) - { - r = -3.779e+00; - } - if( w==79 ) - { - r = -3.852e+00; - } - if( w==78 ) - { - r = -3.925e+00; - } - if( w==77 ) - { - r = -4.000e+00; - } - if( w==76 ) - { - r = -4.075e+00; - } - if( w==75 ) - { - r = -4.151e+00; - } - if( w==74 ) - { - r = -4.229e+00; - } - if( w==73 ) - { - r = -4.308e+00; - } - if( w==72 ) - { - r = -4.387e+00; - } - if( w==71 ) - { - r = -4.468e+00; - } - if( w==70 ) - { - r = -4.550e+00; - } - if( w==69 ) - { - r = -4.633e+00; - } - if( w==68 ) - { - r = -4.718e+00; - } - if( w==67 ) - { - r = -4.803e+00; - } - if( w==66 ) - { - r = -4.890e+00; - } - if( w==65 ) - { - r = -4.978e+00; - } - if( w==64 ) - { - r = -5.067e+00; - } - if( w==63 ) - { - r = -5.157e+00; - } - if( w==62 ) - { - r = -5.249e+00; - } - if( w==61 ) - { - r = -5.342e+00; - } - if( w==60 ) - { - r = -5.436e+00; - } - if( w==59 ) - { - r = -5.531e+00; - } - if( w==58 ) - { - r = -5.628e+00; - } - if( w==57 ) - { - r = -5.727e+00; - } - if( w==56 ) - { - r = -5.826e+00; - } - if( w==55 ) - { - r = -5.927e+00; - } - if( w==54 ) - { - r = -6.030e+00; - } - if( w==53 ) - { - r = -6.134e+00; - } - if( w==52 ) - { - r = -6.240e+00; - } - if( w==51 ) - { - r = -6.347e+00; - } - if( w==50 ) - { - r = -6.456e+00; - } - if( w==49 ) - { - r = -6.566e+00; - } - if( w==48 ) - { - r = -6.678e+00; - } - if( w==47 ) - { - r = -6.792e+00; - } - if( w==46 ) - { - r = -6.907e+00; - } - if( w==45 ) - { - r = -7.025e+00; - } - if( w==44 ) - { - r = -7.144e+00; - } - if( w==43 ) - { - r = -7.265e+00; - } - if( w==42 ) - { - r = -7.387e+00; - } - if( w==41 ) - { - r = -7.512e+00; - } - if( w==40 ) - { - r = -7.639e+00; - } - if( w==39 ) - { - r = -7.768e+00; - } - if( w==38 ) - { - r = -7.899e+00; - } - if( w==37 ) - { - r = -8.032e+00; - } - if( w==36 ) - { - r = -8.167e+00; - } - if( w==35 ) - { - r = -8.305e+00; - } - if( w==34 ) - { - r = -8.445e+00; - } - if( w==33 ) - { - r = -8.588e+00; - } - if( w==32 ) - { - r = -8.733e+00; - } - if( w==31 ) - { - r = -8.881e+00; - } - if( w==30 ) - { - r = -9.031e+00; - } - if( w==29 ) - { - r = -9.185e+00; - } - if( w==28 ) - { - r = -9.341e+00; - } - if( w==27 ) - { - r = -9.501e+00; - } - if( w==26 ) - { - r = -9.664e+00; - } - if( w==25 ) - { - r = -9.830e+00; - } - if( w==24 ) - { - r = -1.000e+01; - } - if( w==23 ) - { - r = -1.017e+01; - } - if( w==22 ) - { - r = -1.035e+01; - } - if( w==21 ) - { - r = -1.053e+01; - } - if( w==20 ) - { - r = -1.072e+01; - } - if( w==19 ) - { - r = -1.091e+01; - } - if( w==18 ) - { - r = -1.110e+01; - } - if( w==17 ) - { - r = -1.130e+01; - } - if( w==16 ) - { - r = -1.151e+01; - } - if( w==15 ) - { - r = -1.172e+01; - } - if( w==14 ) - { - r = -1.194e+01; - } - if( w==13 ) - { - r = -1.216e+01; - } - if( w==12 ) - { - r = -1.239e+01; - } - if( w==11 ) - { - r = -1.263e+01; - } - if( w==10 ) - { - r = -1.287e+01; - } - if( w==9 ) - { - r = -1.314e+01; - } - if( w==8 ) - { - r = -1.342e+01; - } - if( w==7 ) - { - r = -1.369e+01; - } - if( w==6 ) - { - r = -1.400e+01; - } - if( w==5 ) - { - r = -1.433e+01; - } - if( w==4 ) - { - r = -1.469e+01; - } - if( w==3 ) - { - r = -1.503e+01; - } - if( w==2 ) - { - r = -1.554e+01; - } - if( w==1 ) - { - r = -1.594e+01; - } - if( w<=0 ) - { - r = -1.664e+01; - } - result = r; - return result; -} - - -/************************************************************************* -Tail(S, 25) -*************************************************************************/ -static double wsr_w25(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/4.000000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - wsr_wcheb(x, -5.150509e+00, &tj, &tj1, &result, _state); - wsr_wcheb(x, -5.695528e+00, &tj, &tj1, &result, _state); - wsr_wcheb(x, -1.437637e+00, &tj, &tj1, &result, _state); - wsr_wcheb(x, -2.611906e-01, &tj, &tj1, &result, _state); - wsr_wcheb(x, -7.625722e-02, &tj, &tj1, &result, _state); - wsr_wcheb(x, -2.579892e-02, &tj, &tj1, &result, _state); - wsr_wcheb(x, -1.086876e-02, &tj, &tj1, &result, _state); - wsr_wcheb(x, -2.906543e-03, &tj, &tj1, &result, _state); - wsr_wcheb(x, -2.354881e-03, &tj, &tj1, &result, _state); - wsr_wcheb(x, 1.007195e-04, &tj, &tj1, &result, _state); - wsr_wcheb(x, -8.437327e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 26) -*************************************************************************/ -static double wsr_w26(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/4.000000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - wsr_wcheb(x, -5.117622e+00, &tj, &tj1, &result, _state); - wsr_wcheb(x, -5.635159e+00, &tj, &tj1, &result, _state); - wsr_wcheb(x, -1.395167e+00, &tj, &tj1, &result, _state); - wsr_wcheb(x, -2.382823e-01, &tj, &tj1, &result, _state); - wsr_wcheb(x, -6.531987e-02, &tj, &tj1, &result, _state); - wsr_wcheb(x, -2.060112e-02, &tj, &tj1, &result, _state); - wsr_wcheb(x, -8.203697e-03, &tj, &tj1, &result, _state); - wsr_wcheb(x, -1.516523e-03, &tj, &tj1, &result, _state); - wsr_wcheb(x, -1.431364e-03, &tj, &tj1, &result, _state); - wsr_wcheb(x, 6.384553e-04, &tj, &tj1, &result, _state); - wsr_wcheb(x, -3.238369e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 27) -*************************************************************************/ -static double wsr_w27(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/4.000000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - wsr_wcheb(x, -5.089731e+00, &tj, &tj1, &result, _state); - wsr_wcheb(x, -5.584248e+00, &tj, &tj1, &result, _state); - wsr_wcheb(x, -1.359966e+00, &tj, &tj1, &result, _state); - wsr_wcheb(x, -2.203696e-01, &tj, &tj1, &result, _state); - wsr_wcheb(x, -5.753344e-02, &tj, &tj1, &result, _state); - wsr_wcheb(x, -1.761891e-02, &tj, &tj1, &result, _state); - wsr_wcheb(x, -7.096897e-03, &tj, &tj1, &result, _state); - wsr_wcheb(x, -1.419108e-03, &tj, &tj1, &result, _state); - wsr_wcheb(x, -1.581214e-03, &tj, &tj1, &result, _state); - wsr_wcheb(x, 3.033766e-04, &tj, &tj1, &result, _state); - wsr_wcheb(x, -5.901441e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 28) -*************************************************************************/ -static double wsr_w28(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/4.000000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - wsr_wcheb(x, -5.065046e+00, &tj, &tj1, &result, _state); - wsr_wcheb(x, -5.539163e+00, &tj, &tj1, &result, _state); - wsr_wcheb(x, -1.328939e+00, &tj, &tj1, &result, _state); - wsr_wcheb(x, -2.046376e-01, &tj, &tj1, &result, _state); - wsr_wcheb(x, -5.061515e-02, &tj, &tj1, &result, _state); - wsr_wcheb(x, -1.469271e-02, &tj, &tj1, &result, _state); - wsr_wcheb(x, -5.711578e-03, &tj, &tj1, &result, _state); - wsr_wcheb(x, -8.389153e-04, &tj, &tj1, &result, _state); - wsr_wcheb(x, -1.250575e-03, &tj, &tj1, &result, _state); - wsr_wcheb(x, 4.047245e-04, &tj, &tj1, &result, _state); - wsr_wcheb(x, -5.128555e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 29) -*************************************************************************/ -static double wsr_w29(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/4.000000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - wsr_wcheb(x, -5.043413e+00, &tj, &tj1, &result, _state); - wsr_wcheb(x, -5.499756e+00, &tj, &tj1, &result, _state); - wsr_wcheb(x, -1.302137e+00, &tj, &tj1, &result, _state); - wsr_wcheb(x, -1.915129e-01, &tj, &tj1, &result, _state); - wsr_wcheb(x, -4.516329e-02, &tj, &tj1, &result, _state); - wsr_wcheb(x, -1.260064e-02, &tj, &tj1, &result, _state); - wsr_wcheb(x, -4.817269e-03, &tj, &tj1, &result, _state); - wsr_wcheb(x, -5.478130e-04, &tj, &tj1, &result, _state); - wsr_wcheb(x, -1.111668e-03, &tj, &tj1, &result, _state); - wsr_wcheb(x, 4.093451e-04, &tj, &tj1, &result, _state); - wsr_wcheb(x, -5.135860e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 30) -*************************************************************************/ -static double wsr_w30(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/4.000000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - wsr_wcheb(x, -5.024071e+00, &tj, &tj1, &result, _state); - wsr_wcheb(x, -5.464515e+00, &tj, &tj1, &result, _state); - wsr_wcheb(x, -1.278342e+00, &tj, &tj1, &result, _state); - wsr_wcheb(x, -1.800030e-01, &tj, &tj1, &result, _state); - wsr_wcheb(x, -4.046294e-02, &tj, &tj1, &result, _state); - wsr_wcheb(x, -1.076162e-02, &tj, &tj1, &result, _state); - wsr_wcheb(x, -3.968677e-03, &tj, &tj1, &result, _state); - wsr_wcheb(x, -1.911679e-04, &tj, &tj1, &result, _state); - wsr_wcheb(x, -8.619185e-04, &tj, &tj1, &result, _state); - wsr_wcheb(x, 5.125362e-04, &tj, &tj1, &result, _state); - wsr_wcheb(x, -3.984370e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 40) -*************************************************************************/ -static double wsr_w40(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/4.000000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - wsr_wcheb(x, -4.904809e+00, &tj, &tj1, &result, _state); - wsr_wcheb(x, -5.248327e+00, &tj, &tj1, &result, _state); - wsr_wcheb(x, -1.136698e+00, &tj, &tj1, &result, _state); - wsr_wcheb(x, -1.170982e-01, &tj, &tj1, &result, _state); - wsr_wcheb(x, -1.824427e-02, &tj, &tj1, &result, _state); - wsr_wcheb(x, -3.888648e-03, &tj, &tj1, &result, _state); - wsr_wcheb(x, -1.344929e-03, &tj, &tj1, &result, _state); - wsr_wcheb(x, 2.790407e-04, &tj, &tj1, &result, _state); - wsr_wcheb(x, -4.619858e-04, &tj, &tj1, &result, _state); - wsr_wcheb(x, 3.359121e-04, &tj, &tj1, &result, _state); - wsr_wcheb(x, -2.883026e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 60) -*************************************************************************/ -static double wsr_w60(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/4.000000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - wsr_wcheb(x, -4.809656e+00, &tj, &tj1, &result, _state); - wsr_wcheb(x, -5.077191e+00, &tj, &tj1, &result, _state); - wsr_wcheb(x, -1.029402e+00, &tj, &tj1, &result, _state); - wsr_wcheb(x, -7.507931e-02, &tj, &tj1, &result, _state); - wsr_wcheb(x, -6.506226e-03, &tj, &tj1, &result, _state); - wsr_wcheb(x, -1.391278e-03, &tj, &tj1, &result, _state); - wsr_wcheb(x, -4.263635e-04, &tj, &tj1, &result, _state); - wsr_wcheb(x, 2.302271e-04, &tj, &tj1, &result, _state); - wsr_wcheb(x, -2.384348e-04, &tj, &tj1, &result, _state); - wsr_wcheb(x, 1.865587e-04, &tj, &tj1, &result, _state); - wsr_wcheb(x, -1.622355e-04, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 120) -*************************************************************************/ -static double wsr_w120(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/4.000000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - wsr_wcheb(x, -4.729426e+00, &tj, &tj1, &result, _state); - wsr_wcheb(x, -4.934426e+00, &tj, &tj1, &result, _state); - wsr_wcheb(x, -9.433231e-01, &tj, &tj1, &result, _state); - wsr_wcheb(x, -4.492504e-02, &tj, &tj1, &result, _state); - wsr_wcheb(x, 1.673948e-05, &tj, &tj1, &result, _state); - wsr_wcheb(x, -6.077014e-04, &tj, &tj1, &result, _state); - wsr_wcheb(x, -7.215768e-05, &tj, &tj1, &result, _state); - wsr_wcheb(x, 9.086734e-05, &tj, &tj1, &result, _state); - wsr_wcheb(x, -8.447980e-05, &tj, &tj1, &result, _state); - wsr_wcheb(x, 6.705028e-05, &tj, &tj1, &result, _state); - wsr_wcheb(x, -5.828507e-05, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S, 200) -*************************************************************************/ -static double wsr_w200(double s, ae_state *_state) -{ - double x; - double tj; - double tj1; - double result; - - - result = 0; - x = ae_minreal(2*(s-0.000000e+00)/4.000000e+00-1, 1.0, _state); - tj = 1; - tj1 = x; - wsr_wcheb(x, -4.700240e+00, &tj, &tj1, &result, _state); - wsr_wcheb(x, -4.883080e+00, &tj, &tj1, &result, _state); - wsr_wcheb(x, -9.132168e-01, &tj, &tj1, &result, _state); - wsr_wcheb(x, -3.512684e-02, &tj, &tj1, &result, _state); - wsr_wcheb(x, 1.726342e-03, &tj, &tj1, &result, _state); - wsr_wcheb(x, -5.189796e-04, &tj, &tj1, &result, _state); - wsr_wcheb(x, -1.628659e-06, &tj, &tj1, &result, _state); - wsr_wcheb(x, 4.261786e-05, &tj, &tj1, &result, _state); - wsr_wcheb(x, -4.002498e-05, &tj, &tj1, &result, _state); - wsr_wcheb(x, 3.146287e-05, &tj, &tj1, &result, _state); - wsr_wcheb(x, -2.727576e-05, &tj, &tj1, &result, _state); - return result; -} - - -/************************************************************************* -Tail(S,N), S>=0 -*************************************************************************/ -static double wsr_wsigma(double s, ae_int_t n, ae_state *_state) -{ - double f0; - double f1; - double f2; - double f3; - double f4; - double x0; - double x1; - double x2; - double x3; - double x4; - double x; - double result; - - - result = 0; - if( n==5 ) - { - result = wsr_w5(s, _state); - } - if( n==6 ) - { - result = wsr_w6(s, _state); - } - if( n==7 ) - { - result = wsr_w7(s, _state); - } - if( n==8 ) - { - result = wsr_w8(s, _state); - } - if( n==9 ) - { - result = wsr_w9(s, _state); - } - if( n==10 ) - { - result = wsr_w10(s, _state); - } - if( n==11 ) - { - result = wsr_w11(s, _state); - } - if( n==12 ) - { - result = wsr_w12(s, _state); - } - if( n==13 ) - { - result = wsr_w13(s, _state); - } - if( n==14 ) - { - result = wsr_w14(s, _state); - } - if( n==15 ) - { - result = wsr_w15(s, _state); - } - if( n==16 ) - { - result = wsr_w16(s, _state); - } - if( n==17 ) - { - result = wsr_w17(s, _state); - } - if( n==18 ) - { - result = wsr_w18(s, _state); - } - if( n==19 ) - { - result = wsr_w19(s, _state); - } - if( n==20 ) - { - result = wsr_w20(s, _state); - } - if( n==21 ) - { - result = wsr_w21(s, _state); - } - if( n==22 ) - { - result = wsr_w22(s, _state); - } - if( n==23 ) - { - result = wsr_w23(s, _state); - } - if( n==24 ) - { - result = wsr_w24(s, _state); - } - if( n==25 ) - { - result = wsr_w25(s, _state); - } - if( n==26 ) - { - result = wsr_w26(s, _state); - } - if( n==27 ) - { - result = wsr_w27(s, _state); - } - if( n==28 ) - { - result = wsr_w28(s, _state); - } - if( n==29 ) - { - result = wsr_w29(s, _state); - } - if( n==30 ) - { - result = wsr_w30(s, _state); - } - if( n>30 ) - { - x = 1.0/n; - x0 = 1.0/30; - f0 = wsr_w30(s, _state); - x1 = 1.0/40; - f1 = wsr_w40(s, _state); - x2 = 1.0/60; - f2 = wsr_w60(s, _state); - x3 = 1.0/120; - f3 = wsr_w120(s, _state); - x4 = 1.0/200; - f4 = wsr_w200(s, _state); - f1 = ((x-x0)*f1-(x-x1)*f0)/(x1-x0); - f2 = ((x-x0)*f2-(x-x2)*f0)/(x2-x0); - f3 = ((x-x0)*f3-(x-x3)*f0)/(x3-x0); - f4 = ((x-x0)*f4-(x-x4)*f0)/(x4-x0); - f2 = ((x-x1)*f2-(x-x2)*f1)/(x2-x1); - f3 = ((x-x1)*f3-(x-x3)*f1)/(x3-x1); - f4 = ((x-x1)*f4-(x-x4)*f1)/(x4-x1); - f3 = ((x-x2)*f3-(x-x3)*f2)/(x3-x2); - f4 = ((x-x2)*f4-(x-x4)*f2)/(x4-x2); - f4 = ((x-x3)*f4-(x-x4)*f3)/(x4-x3); - result = f4; - } - return result; -} - - - -} - diff --git a/src/core/alglib/statistics.h b/src/core/alglib/statistics.h deleted file mode 100644 index d324946..0000000 --- a/src/core/alglib/statistics.h +++ /dev/null @@ -1,1305 +0,0 @@ -/************************************************************************* -Copyright (c) Sergey Bochkanov (ALGLIB project). - ->>> SOURCE LICENSE >>> -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation (www.fsf.org); either version 2 of the -License, or (at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -A copy of the GNU General Public License is available at -http://www.fsf.org/licensing/licenses ->>> END OF LICENSE >>> -*************************************************************************/ -#ifndef _statistics_pkg_h -#define _statistics_pkg_h -#include "ap.h" -#include "alglibinternal.h" -#include "linalg.h" -#include "specialfunctions.h" - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (DATATYPES) -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ - -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS C++ INTERFACE -// -///////////////////////////////////////////////////////////////////////// -namespace alglib -{ - - -/************************************************************************* -Calculation of the distribution moments: mean, variance, skewness, kurtosis. - -INPUT PARAMETERS: - X - sample - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - -OUTPUT PARAMETERS - Mean - mean. - Variance- variance. - Skewness- skewness (if variance<>0; zero otherwise). - Kurtosis- kurtosis (if variance<>0; zero otherwise). - - - -- ALGLIB -- - Copyright 06.09.2006 by Bochkanov Sergey -*************************************************************************/ -void samplemoments(const real_1d_array &x, const ae_int_t n, double &mean, double &variance, double &skewness, double &kurtosis); -void samplemoments(const real_1d_array &x, double &mean, double &variance, double &skewness, double &kurtosis); - - -/************************************************************************* -Calculation of the mean. - -INPUT PARAMETERS: - X - sample - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - -NOTE: - -This function return result which calculated by 'SampleMoments' function -and stored at 'Mean' variable. - - - -- ALGLIB -- - Copyright 06.09.2006 by Bochkanov Sergey -*************************************************************************/ -double samplemean(const real_1d_array &x, const ae_int_t n); -double samplemean(const real_1d_array &x); - - -/************************************************************************* -Calculation of the variance. - -INPUT PARAMETERS: - X - sample - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - -NOTE: - -This function return result which calculated by 'SampleMoments' function -and stored at 'Variance' variable. - - - -- ALGLIB -- - Copyright 06.09.2006 by Bochkanov Sergey -*************************************************************************/ -double samplevariance(const real_1d_array &x, const ae_int_t n); -double samplevariance(const real_1d_array &x); - - -/************************************************************************* -Calculation of the skewness. - -INPUT PARAMETERS: - X - sample - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - -NOTE: - -This function return result which calculated by 'SampleMoments' function -and stored at 'Skewness' variable. - - - -- ALGLIB -- - Copyright 06.09.2006 by Bochkanov Sergey -*************************************************************************/ -double sampleskewness(const real_1d_array &x, const ae_int_t n); -double sampleskewness(const real_1d_array &x); - - -/************************************************************************* -Calculation of the kurtosis. - -INPUT PARAMETERS: - X - sample - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - -NOTE: - -This function return result which calculated by 'SampleMoments' function -and stored at 'Kurtosis' variable. - - - -- ALGLIB -- - Copyright 06.09.2006 by Bochkanov Sergey -*************************************************************************/ -double samplekurtosis(const real_1d_array &x, const ae_int_t n); -double samplekurtosis(const real_1d_array &x); - - -/************************************************************************* -ADev - -Input parameters: - X - sample - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - -Output parameters: - ADev- ADev - - -- ALGLIB -- - Copyright 06.09.2006 by Bochkanov Sergey -*************************************************************************/ -void sampleadev(const real_1d_array &x, const ae_int_t n, double &adev); -void sampleadev(const real_1d_array &x, double &adev); - - -/************************************************************************* -Median calculation. - -Input parameters: - X - sample (array indexes: [0..N-1]) - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - -Output parameters: - Median - - -- ALGLIB -- - Copyright 06.09.2006 by Bochkanov Sergey -*************************************************************************/ -void samplemedian(const real_1d_array &x, const ae_int_t n, double &median); -void samplemedian(const real_1d_array &x, double &median); - - -/************************************************************************* -Percentile calculation. - -Input parameters: - X - sample (array indexes: [0..N-1]) - N - N>=0, sample size: - * if given, only leading N elements of X are processed - * if not given, automatically determined from size of X - P - percentile (0<=P<=1) - -Output parameters: - V - percentile - - -- ALGLIB -- - Copyright 01.03.2008 by Bochkanov Sergey -*************************************************************************/ -void samplepercentile(const real_1d_array &x, const ae_int_t n, const double p, double &v); -void samplepercentile(const real_1d_array &x, const double p, double &v); - - -/************************************************************************* -2-sample covariance - -Input parameters: - X - sample 1 (array indexes: [0..N-1]) - Y - sample 2 (array indexes: [0..N-1]) - N - N>=0, sample size: - * if given, only N leading elements of X/Y are processed - * if not given, automatically determined from input sizes - -Result: - covariance (zero for N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -double cov2(const real_1d_array &x, const real_1d_array &y, const ae_int_t n); -double cov2(const real_1d_array &x, const real_1d_array &y); - - -/************************************************************************* -Pearson product-moment correlation coefficient - -Input parameters: - X - sample 1 (array indexes: [0..N-1]) - Y - sample 2 (array indexes: [0..N-1]) - N - N>=0, sample size: - * if given, only N leading elements of X/Y are processed - * if not given, automatically determined from input sizes - -Result: - Pearson product-moment correlation coefficient - (zero for N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -double pearsoncorr2(const real_1d_array &x, const real_1d_array &y, const ae_int_t n); -double pearsoncorr2(const real_1d_array &x, const real_1d_array &y); - - -/************************************************************************* -Spearman's rank correlation coefficient - -Input parameters: - X - sample 1 (array indexes: [0..N-1]) - Y - sample 2 (array indexes: [0..N-1]) - N - N>=0, sample size: - * if given, only N leading elements of X/Y are processed - * if not given, automatically determined from input sizes - -Result: - Spearman's rank correlation coefficient - (zero for N=0 or N=1) - - -- ALGLIB -- - Copyright 09.04.2007 by Bochkanov Sergey -*************************************************************************/ -double spearmancorr2(const real_1d_array &x, const real_1d_array &y, const ae_int_t n); -double spearmancorr2(const real_1d_array &x, const real_1d_array &y); - - -/************************************************************************* -Covariance matrix - -SMP EDITION OF ALGLIB: - - ! This function can utilize multicore capabilities of your system. In - ! order to do this you have to call version with "smp_" prefix, which - ! indicates that multicore code will be used. - ! - ! This note is given for users of SMP edition; if you use GPL edition, - ! or commercial edition of ALGLIB without SMP support, you still will - ! be able to call smp-version of this function, but all computations - ! will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - ! - ! You should remember that starting/stopping worker thread always have - ! non-zero cost. Although multicore version is pretty efficient on - ! large problems, we do not recommend you to use it on small problems - - ! with covariance matrices smaller than 128*128. - -INPUT PARAMETERS: - X - array[N,M], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - N - N>=0, number of observations: - * if given, only leading N rows of X are used - * if not given, automatically determined from input size - M - M>0, number of variables: - * if given, only leading M columns of X are used - * if not given, automatically determined from input size - -OUTPUT PARAMETERS: - C - array[M,M], covariance matrix (zero if N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -void covm(const real_2d_array &x, const ae_int_t n, const ae_int_t m, real_2d_array &c); -void smp_covm(const real_2d_array &x, const ae_int_t n, const ae_int_t m, real_2d_array &c); -void covm(const real_2d_array &x, real_2d_array &c); -void smp_covm(const real_2d_array &x, real_2d_array &c); - - -/************************************************************************* -Pearson product-moment correlation matrix - -SMP EDITION OF ALGLIB: - - ! This function can utilize multicore capabilities of your system. In - ! order to do this you have to call version with "smp_" prefix, which - ! indicates that multicore code will be used. - ! - ! This note is given for users of SMP edition; if you use GPL edition, - ! or commercial edition of ALGLIB without SMP support, you still will - ! be able to call smp-version of this function, but all computations - ! will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - ! - ! You should remember that starting/stopping worker thread always have - ! non-zero cost. Although multicore version is pretty efficient on - ! large problems, we do not recommend you to use it on small problems - - ! with correlation matrices smaller than 128*128. - -INPUT PARAMETERS: - X - array[N,M], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - N - N>=0, number of observations: - * if given, only leading N rows of X are used - * if not given, automatically determined from input size - M - M>0, number of variables: - * if given, only leading M columns of X are used - * if not given, automatically determined from input size - -OUTPUT PARAMETERS: - C - array[M,M], correlation matrix (zero if N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -void pearsoncorrm(const real_2d_array &x, const ae_int_t n, const ae_int_t m, real_2d_array &c); -void smp_pearsoncorrm(const real_2d_array &x, const ae_int_t n, const ae_int_t m, real_2d_array &c); -void pearsoncorrm(const real_2d_array &x, real_2d_array &c); -void smp_pearsoncorrm(const real_2d_array &x, real_2d_array &c); - - -/************************************************************************* -Spearman's rank correlation matrix - -SMP EDITION OF ALGLIB: - - ! This function can utilize multicore capabilities of your system. In - ! order to do this you have to call version with "smp_" prefix, which - ! indicates that multicore code will be used. - ! - ! This note is given for users of SMP edition; if you use GPL edition, - ! or commercial edition of ALGLIB without SMP support, you still will - ! be able to call smp-version of this function, but all computations - ! will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - ! - ! You should remember that starting/stopping worker thread always have - ! non-zero cost. Although multicore version is pretty efficient on - ! large problems, we do not recommend you to use it on small problems - - ! with correlation matrices smaller than 128*128. - -INPUT PARAMETERS: - X - array[N,M], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - N - N>=0, number of observations: - * if given, only leading N rows of X are used - * if not given, automatically determined from input size - M - M>0, number of variables: - * if given, only leading M columns of X are used - * if not given, automatically determined from input size - -OUTPUT PARAMETERS: - C - array[M,M], correlation matrix (zero if N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -void spearmancorrm(const real_2d_array &x, const ae_int_t n, const ae_int_t m, real_2d_array &c); -void smp_spearmancorrm(const real_2d_array &x, const ae_int_t n, const ae_int_t m, real_2d_array &c); -void spearmancorrm(const real_2d_array &x, real_2d_array &c); -void smp_spearmancorrm(const real_2d_array &x, real_2d_array &c); - - -/************************************************************************* -Cross-covariance matrix - -SMP EDITION OF ALGLIB: - - ! This function can utilize multicore capabilities of your system. In - ! order to do this you have to call version with "smp_" prefix, which - ! indicates that multicore code will be used. - ! - ! This note is given for users of SMP edition; if you use GPL edition, - ! or commercial edition of ALGLIB without SMP support, you still will - ! be able to call smp-version of this function, but all computations - ! will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - ! - ! You should remember that starting/stopping worker thread always have - ! non-zero cost. Although multicore version is pretty efficient on - ! large problems, we do not recommend you to use it on small problems - - ! with covariance matrices smaller than 128*128. - -INPUT PARAMETERS: - X - array[N,M1], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - Y - array[N,M2], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - N - N>=0, number of observations: - * if given, only leading N rows of X/Y are used - * if not given, automatically determined from input sizes - M1 - M1>0, number of variables in X: - * if given, only leading M1 columns of X are used - * if not given, automatically determined from input size - M2 - M2>0, number of variables in Y: - * if given, only leading M1 columns of X are used - * if not given, automatically determined from input size - -OUTPUT PARAMETERS: - C - array[M1,M2], cross-covariance matrix (zero if N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -void covm2(const real_2d_array &x, const real_2d_array &y, const ae_int_t n, const ae_int_t m1, const ae_int_t m2, real_2d_array &c); -void smp_covm2(const real_2d_array &x, const real_2d_array &y, const ae_int_t n, const ae_int_t m1, const ae_int_t m2, real_2d_array &c); -void covm2(const real_2d_array &x, const real_2d_array &y, real_2d_array &c); -void smp_covm2(const real_2d_array &x, const real_2d_array &y, real_2d_array &c); - - -/************************************************************************* -Pearson product-moment cross-correlation matrix - -SMP EDITION OF ALGLIB: - - ! This function can utilize multicore capabilities of your system. In - ! order to do this you have to call version with "smp_" prefix, which - ! indicates that multicore code will be used. - ! - ! This note is given for users of SMP edition; if you use GPL edition, - ! or commercial edition of ALGLIB without SMP support, you still will - ! be able to call smp-version of this function, but all computations - ! will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - ! - ! You should remember that starting/stopping worker thread always have - ! non-zero cost. Although multicore version is pretty efficient on - ! large problems, we do not recommend you to use it on small problems - - ! with correlation matrices smaller than 128*128. - -INPUT PARAMETERS: - X - array[N,M1], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - Y - array[N,M2], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - N - N>=0, number of observations: - * if given, only leading N rows of X/Y are used - * if not given, automatically determined from input sizes - M1 - M1>0, number of variables in X: - * if given, only leading M1 columns of X are used - * if not given, automatically determined from input size - M2 - M2>0, number of variables in Y: - * if given, only leading M1 columns of X are used - * if not given, automatically determined from input size - -OUTPUT PARAMETERS: - C - array[M1,M2], cross-correlation matrix (zero if N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -void pearsoncorrm2(const real_2d_array &x, const real_2d_array &y, const ae_int_t n, const ae_int_t m1, const ae_int_t m2, real_2d_array &c); -void smp_pearsoncorrm2(const real_2d_array &x, const real_2d_array &y, const ae_int_t n, const ae_int_t m1, const ae_int_t m2, real_2d_array &c); -void pearsoncorrm2(const real_2d_array &x, const real_2d_array &y, real_2d_array &c); -void smp_pearsoncorrm2(const real_2d_array &x, const real_2d_array &y, real_2d_array &c); - - -/************************************************************************* -Spearman's rank cross-correlation matrix - -SMP EDITION OF ALGLIB: - - ! This function can utilize multicore capabilities of your system. In - ! order to do this you have to call version with "smp_" prefix, which - ! indicates that multicore code will be used. - ! - ! This note is given for users of SMP edition; if you use GPL edition, - ! or commercial edition of ALGLIB without SMP support, you still will - ! be able to call smp-version of this function, but all computations - ! will be done serially. - ! - ! We recommend you to carefully read ALGLIB Reference Manual, section - ! called 'SMP support', before using parallel version of this function. - ! - ! You should remember that starting/stopping worker thread always have - ! non-zero cost. Although multicore version is pretty efficient on - ! large problems, we do not recommend you to use it on small problems - - ! with correlation matrices smaller than 128*128. - -INPUT PARAMETERS: - X - array[N,M1], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - Y - array[N,M2], sample matrix: - * J-th column corresponds to J-th variable - * I-th row corresponds to I-th observation - N - N>=0, number of observations: - * if given, only leading N rows of X/Y are used - * if not given, automatically determined from input sizes - M1 - M1>0, number of variables in X: - * if given, only leading M1 columns of X are used - * if not given, automatically determined from input size - M2 - M2>0, number of variables in Y: - * if given, only leading M1 columns of X are used - * if not given, automatically determined from input size - -OUTPUT PARAMETERS: - C - array[M1,M2], cross-correlation matrix (zero if N=0 or N=1) - - -- ALGLIB -- - Copyright 28.10.2010 by Bochkanov Sergey -*************************************************************************/ -void spearmancorrm2(const real_2d_array &x, const real_2d_array &y, const ae_int_t n, const ae_int_t m1, const ae_int_t m2, real_2d_array &c); -void smp_spearmancorrm2(const real_2d_array &x, const real_2d_array &y, const ae_int_t n, const ae_int_t m1, const ae_int_t m2, real_2d_array &c); -void spearmancorrm2(const real_2d_array &x, const real_2d_array &y, real_2d_array &c); -void smp_spearmancorrm2(const real_2d_array &x, const real_2d_array &y, real_2d_array &c); - - -/************************************************************************* - -*************************************************************************/ -void rankdata(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nfeatures); -void smp_rankdata(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nfeatures); -void rankdata(real_2d_array &xy); -void smp_rankdata(real_2d_array &xy); - - -/************************************************************************* - -*************************************************************************/ -void rankdatacentered(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nfeatures); -void smp_rankdatacentered(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nfeatures); -void rankdatacentered(real_2d_array &xy); -void smp_rankdatacentered(real_2d_array &xy); - - -/************************************************************************* -Obsolete function, we recommend to use PearsonCorr2(). - - -- ALGLIB -- - Copyright 09.04.2007 by Bochkanov Sergey -*************************************************************************/ -double pearsoncorrelation(const real_1d_array &x, const real_1d_array &y, const ae_int_t n); - - -/************************************************************************* -Obsolete function, we recommend to use SpearmanCorr2(). - - -- ALGLIB -- - Copyright 09.04.2007 by Bochkanov Sergey -*************************************************************************/ -double spearmanrankcorrelation(const real_1d_array &x, const real_1d_array &y, const ae_int_t n); - -/************************************************************************* -Pearson's correlation coefficient significance test - -This test checks hypotheses about whether X and Y are samples of two -continuous distributions having zero correlation or whether their -correlation is non-zero. - -The following tests are performed: - * two-tailed test (null hypothesis - X and Y have zero correlation) - * left-tailed test (null hypothesis - the correlation coefficient is - greater than or equal to 0) - * right-tailed test (null hypothesis - the correlation coefficient is - less than or equal to 0). - -Requirements: - * the number of elements in each sample is not less than 5 - * normality of distributions of X and Y. - -Input parameters: - R - Pearson's correlation coefficient for X and Y - N - number of elements in samples, N>=5. - -Output parameters: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - - -- ALGLIB -- - Copyright 09.04.2007 by Bochkanov Sergey -*************************************************************************/ -void pearsoncorrelationsignificance(const double r, const ae_int_t n, double &bothtails, double &lefttail, double &righttail); - - -/************************************************************************* -Spearman's rank correlation coefficient significance test - -This test checks hypotheses about whether X and Y are samples of two -continuous distributions having zero correlation or whether their -correlation is non-zero. - -The following tests are performed: - * two-tailed test (null hypothesis - X and Y have zero correlation) - * left-tailed test (null hypothesis - the correlation coefficient is - greater than or equal to 0) - * right-tailed test (null hypothesis - the correlation coefficient is - less than or equal to 0). - -Requirements: - * the number of elements in each sample is not less than 5. - -The test is non-parametric and doesn't require distributions X and Y to be -normal. - -Input parameters: - R - Spearman's rank correlation coefficient for X and Y - N - number of elements in samples, N>=5. - -Output parameters: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - - -- ALGLIB -- - Copyright 09.04.2007 by Bochkanov Sergey -*************************************************************************/ -void spearmanrankcorrelationsignificance(const double r, const ae_int_t n, double &bothtails, double &lefttail, double &righttail); - -/************************************************************************* -Jarque-Bera test - -This test checks hypotheses about the fact that a given sample X is a -sample of normal random variable. - -Requirements: - * the number of elements in the sample is not less than 5. - -Input parameters: - X - sample. Array whose index goes from 0 to N-1. - N - size of the sample. N>=5 - -Output parameters: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - -Accuracy of the approximation used (5<=N<=1951): - -p-value relative error (5<=N<=1951) -[1, 0.1] < 1% -[0.1, 0.01] < 2% -[0.01, 0.001] < 6% -[0.001, 0] wasn't measured - -For N>1951 accuracy wasn't measured but it shouldn't be sharply different -from table values. - - -- ALGLIB -- - Copyright 09.04.2007 by Bochkanov Sergey -*************************************************************************/ -void jarqueberatest(const real_1d_array &x, const ae_int_t n, double &p); - -/************************************************************************* -Mann-Whitney U-test - -This test checks hypotheses about whether X and Y are samples of two -continuous distributions of the same shape and same median or whether -their medians are different. - -The following tests are performed: - * two-tailed test (null hypothesis - the medians are equal) - * left-tailed test (null hypothesis - the median of the first sample - is greater than or equal to the median of the second sample) - * right-tailed test (null hypothesis - the median of the first sample - is less than or equal to the median of the second sample). - -Requirements: - * the samples are independent - * X and Y are continuous distributions (or discrete distributions well- - approximating continuous distributions) - * distributions of X and Y have the same shape. The only possible - difference is their position (i.e. the value of the median) - * the number of elements in each sample is not less than 5 - * the scale of measurement should be ordinal, interval or ratio (i.e. - the test could not be applied to nominal variables). - -The test is non-parametric and doesn't require distributions to be normal. - -Input parameters: - X - sample 1. Array whose index goes from 0 to N-1. - N - size of the sample. N>=5 - Y - sample 2. Array whose index goes from 0 to M-1. - M - size of the sample. M>=5 - -Output parameters: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - -To calculate p-values, special approximation is used. This method lets us -calculate p-values with satisfactory accuracy in interval [0.0001, 1]. -There is no approximation outside the [0.0001, 1] interval. Therefore, if -the significance level outlies this interval, the test returns 0.0001. - -Relative precision of approximation of p-value: - -N M Max.err. Rms.err. -5..10 N..10 1.4e-02 6.0e-04 -5..10 N..100 2.2e-02 5.3e-06 -10..15 N..15 1.0e-02 3.2e-04 -10..15 N..100 1.0e-02 2.2e-05 -15..100 N..100 6.1e-03 2.7e-06 - -For N,M>100 accuracy checks weren't put into practice, but taking into -account characteristics of asymptotic approximation used, precision should -not be sharply different from the values for interval [5, 100]. - - -- ALGLIB -- - Copyright 09.04.2007 by Bochkanov Sergey -*************************************************************************/ -void mannwhitneyutest(const real_1d_array &x, const ae_int_t n, const real_1d_array &y, const ae_int_t m, double &bothtails, double &lefttail, double &righttail); - -/************************************************************************* -Sign test - -This test checks three hypotheses about the median of the given sample. -The following tests are performed: - * two-tailed test (null hypothesis - the median is equal to the given - value) - * left-tailed test (null hypothesis - the median is greater than or - equal to the given value) - * right-tailed test (null hypothesis - the median is less than or - equal to the given value) - -Requirements: - * the scale of measurement should be ordinal, interval or ratio (i.e. - the test could not be applied to nominal variables). - -The test is non-parametric and doesn't require distribution X to be normal - -Input parameters: - X - sample. Array whose index goes from 0 to N-1. - N - size of the sample. - Median - assumed median value. - -Output parameters: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - -While calculating p-values high-precision binomial distribution -approximation is used, so significance levels have about 15 exact digits. - - -- ALGLIB -- - Copyright 08.09.2006 by Bochkanov Sergey -*************************************************************************/ -void onesamplesigntest(const real_1d_array &x, const ae_int_t n, const double median, double &bothtails, double &lefttail, double &righttail); - -/************************************************************************* -One-sample t-test - -This test checks three hypotheses about the mean of the given sample. The -following tests are performed: - * two-tailed test (null hypothesis - the mean is equal to the given - value) - * left-tailed test (null hypothesis - the mean is greater than or - equal to the given value) - * right-tailed test (null hypothesis - the mean is less than or equal - to the given value). - -The test is based on the assumption that a given sample has a normal -distribution and an unknown dispersion. If the distribution sharply -differs from normal, the test will work incorrectly. - -INPUT PARAMETERS: - X - sample. Array whose index goes from 0 to N-1. - N - size of sample, N>=0 - Mean - assumed value of the mean. - -OUTPUT PARAMETERS: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - -NOTE: this function correctly handles degenerate cases: - * when N=0, all p-values are set to 1.0 - * when variance of X[] is exactly zero, p-values are set - to 1.0 or 0.0, depending on difference between sample mean and - value of mean being tested. - - - -- ALGLIB -- - Copyright 08.09.2006 by Bochkanov Sergey -*************************************************************************/ -void studentttest1(const real_1d_array &x, const ae_int_t n, const double mean, double &bothtails, double &lefttail, double &righttail); - - -/************************************************************************* -Two-sample pooled test - -This test checks three hypotheses about the mean of the given samples. The -following tests are performed: - * two-tailed test (null hypothesis - the means are equal) - * left-tailed test (null hypothesis - the mean of the first sample is - greater than or equal to the mean of the second sample) - * right-tailed test (null hypothesis - the mean of the first sample is - less than or equal to the mean of the second sample). - -Test is based on the following assumptions: - * given samples have normal distributions - * dispersions are equal - * samples are independent. - -Input parameters: - X - sample 1. Array whose index goes from 0 to N-1. - N - size of sample. - Y - sample 2. Array whose index goes from 0 to M-1. - M - size of sample. - -Output parameters: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - -NOTE: this function correctly handles degenerate cases: - * when N=0 or M=0, all p-values are set to 1.0 - * when both samples has exactly zero variance, p-values are set - to 1.0 or 0.0, depending on difference between means. - - -- ALGLIB -- - Copyright 18.09.2006 by Bochkanov Sergey -*************************************************************************/ -void studentttest2(const real_1d_array &x, const ae_int_t n, const real_1d_array &y, const ae_int_t m, double &bothtails, double &lefttail, double &righttail); - - -/************************************************************************* -Two-sample unpooled test - -This test checks three hypotheses about the mean of the given samples. The -following tests are performed: - * two-tailed test (null hypothesis - the means are equal) - * left-tailed test (null hypothesis - the mean of the first sample is - greater than or equal to the mean of the second sample) - * right-tailed test (null hypothesis - the mean of the first sample is - less than or equal to the mean of the second sample). - -Test is based on the following assumptions: - * given samples have normal distributions - * samples are independent. -Equality of variances is NOT required. - -Input parameters: - X - sample 1. Array whose index goes from 0 to N-1. - N - size of the sample. - Y - sample 2. Array whose index goes from 0 to M-1. - M - size of the sample. - -Output parameters: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - -NOTE: this function correctly handles degenerate cases: - * when N=0 or M=0, all p-values are set to 1.0 - * when both samples has zero variance, p-values are set - to 1.0 or 0.0, depending on difference between means. - * when only one sample has zero variance, test reduces to 1-sample - version. - - -- ALGLIB -- - Copyright 18.09.2006 by Bochkanov Sergey -*************************************************************************/ -void unequalvariancettest(const real_1d_array &x, const ae_int_t n, const real_1d_array &y, const ae_int_t m, double &bothtails, double &lefttail, double &righttail); - -/************************************************************************* -Two-sample F-test - -This test checks three hypotheses about dispersions of the given samples. -The following tests are performed: - * two-tailed test (null hypothesis - the dispersions are equal) - * left-tailed test (null hypothesis - the dispersion of the first - sample is greater than or equal to the dispersion of the second - sample). - * right-tailed test (null hypothesis - the dispersion of the first - sample is less than or equal to the dispersion of the second sample) - -The test is based on the following assumptions: - * the given samples have normal distributions - * the samples are independent. - -Input parameters: - X - sample 1. Array whose index goes from 0 to N-1. - N - sample size. - Y - sample 2. Array whose index goes from 0 to M-1. - M - sample size. - -Output parameters: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - - -- ALGLIB -- - Copyright 19.09.2006 by Bochkanov Sergey -*************************************************************************/ -void ftest(const real_1d_array &x, const ae_int_t n, const real_1d_array &y, const ae_int_t m, double &bothtails, double &lefttail, double &righttail); - - -/************************************************************************* -One-sample chi-square test - -This test checks three hypotheses about the dispersion of the given sample -The following tests are performed: - * two-tailed test (null hypothesis - the dispersion equals the given - number) - * left-tailed test (null hypothesis - the dispersion is greater than - or equal to the given number) - * right-tailed test (null hypothesis - dispersion is less than or - equal to the given number). - -Test is based on the following assumptions: - * the given sample has a normal distribution. - -Input parameters: - X - sample 1. Array whose index goes from 0 to N-1. - N - size of the sample. - Variance - dispersion value to compare with. - -Output parameters: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - - -- ALGLIB -- - Copyright 19.09.2006 by Bochkanov Sergey -*************************************************************************/ -void onesamplevariancetest(const real_1d_array &x, const ae_int_t n, const double variance, double &bothtails, double &lefttail, double &righttail); - -/************************************************************************* -Wilcoxon signed-rank test - -This test checks three hypotheses about the median of the given sample. -The following tests are performed: - * two-tailed test (null hypothesis - the median is equal to the given - value) - * left-tailed test (null hypothesis - the median is greater than or - equal to the given value) - * right-tailed test (null hypothesis - the median is less than or - equal to the given value) - -Requirements: - * the scale of measurement should be ordinal, interval or ratio (i.e. - the test could not be applied to nominal variables). - * the distribution should be continuous and symmetric relative to its - median. - * number of distinct values in the X array should be greater than 4 - -The test is non-parametric and doesn't require distribution X to be normal - -Input parameters: - X - sample. Array whose index goes from 0 to N-1. - N - size of the sample. - Median - assumed median value. - -Output parameters: - BothTails - p-value for two-tailed test. - If BothTails is less than the given significance level - the null hypothesis is rejected. - LeftTail - p-value for left-tailed test. - If LeftTail is less than the given significance level, - the null hypothesis is rejected. - RightTail - p-value for right-tailed test. - If RightTail is less than the given significance level - the null hypothesis is rejected. - -To calculate p-values, special approximation is used. This method lets us -calculate p-values with two decimal places in interval [0.0001, 1]. - -"Two decimal places" does not sound very impressive, but in practice the -relative error of less than 1% is enough to make a decision. - -There is no approximation outside the [0.0001, 1] interval. Therefore, if -the significance level outlies this interval, the test returns 0.0001. - - -- ALGLIB -- - Copyright 08.09.2006 by Bochkanov Sergey -*************************************************************************/ -void wilcoxonsignedranktest(const real_1d_array &x, const ae_int_t n, const double e, double &bothtails, double &lefttail, double &righttail); -} - -///////////////////////////////////////////////////////////////////////// -// -// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (FUNCTIONS) -// -///////////////////////////////////////////////////////////////////////// -namespace alglib_impl -{ -void samplemoments(/* Real */ ae_vector* x, - ae_int_t n, - double* mean, - double* variance, - double* skewness, - double* kurtosis, - ae_state *_state); -double samplemean(/* Real */ ae_vector* x, - ae_int_t n, - ae_state *_state); -double samplevariance(/* Real */ ae_vector* x, - ae_int_t n, - ae_state *_state); -double sampleskewness(/* Real */ ae_vector* x, - ae_int_t n, - ae_state *_state); -double samplekurtosis(/* Real */ ae_vector* x, - ae_int_t n, - ae_state *_state); -void sampleadev(/* Real */ ae_vector* x, - ae_int_t n, - double* adev, - ae_state *_state); -void samplemedian(/* Real */ ae_vector* x, - ae_int_t n, - double* median, - ae_state *_state); -void samplepercentile(/* Real */ ae_vector* x, - ae_int_t n, - double p, - double* v, - ae_state *_state); -double cov2(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_state *_state); -double pearsoncorr2(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_state *_state); -double spearmancorr2(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_state *_state); -void covm(/* Real */ ae_matrix* x, - ae_int_t n, - ae_int_t m, - /* Real */ ae_matrix* c, - ae_state *_state); -void _pexec_covm(/* Real */ ae_matrix* x, - ae_int_t n, - ae_int_t m, - /* Real */ ae_matrix* c, ae_state *_state); -void pearsoncorrm(/* Real */ ae_matrix* x, - ae_int_t n, - ae_int_t m, - /* Real */ ae_matrix* c, - ae_state *_state); -void _pexec_pearsoncorrm(/* Real */ ae_matrix* x, - ae_int_t n, - ae_int_t m, - /* Real */ ae_matrix* c, ae_state *_state); -void spearmancorrm(/* Real */ ae_matrix* x, - ae_int_t n, - ae_int_t m, - /* Real */ ae_matrix* c, - ae_state *_state); -void _pexec_spearmancorrm(/* Real */ ae_matrix* x, - ae_int_t n, - ae_int_t m, - /* Real */ ae_matrix* c, ae_state *_state); -void covm2(/* Real */ ae_matrix* x, - /* Real */ ae_matrix* y, - ae_int_t n, - ae_int_t m1, - ae_int_t m2, - /* Real */ ae_matrix* c, - ae_state *_state); -void _pexec_covm2(/* Real */ ae_matrix* x, - /* Real */ ae_matrix* y, - ae_int_t n, - ae_int_t m1, - ae_int_t m2, - /* Real */ ae_matrix* c, ae_state *_state); -void pearsoncorrm2(/* Real */ ae_matrix* x, - /* Real */ ae_matrix* y, - ae_int_t n, - ae_int_t m1, - ae_int_t m2, - /* Real */ ae_matrix* c, - ae_state *_state); -void _pexec_pearsoncorrm2(/* Real */ ae_matrix* x, - /* Real */ ae_matrix* y, - ae_int_t n, - ae_int_t m1, - ae_int_t m2, - /* Real */ ae_matrix* c, ae_state *_state); -void spearmancorrm2(/* Real */ ae_matrix* x, - /* Real */ ae_matrix* y, - ae_int_t n, - ae_int_t m1, - ae_int_t m2, - /* Real */ ae_matrix* c, - ae_state *_state); -void _pexec_spearmancorrm2(/* Real */ ae_matrix* x, - /* Real */ ae_matrix* y, - ae_int_t n, - ae_int_t m1, - ae_int_t m2, - /* Real */ ae_matrix* c, ae_state *_state); -void rankdata(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nfeatures, - ae_state *_state); -void _pexec_rankdata(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nfeatures, ae_state *_state); -void rankdatacentered(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nfeatures, - ae_state *_state); -void _pexec_rankdatacentered(/* Real */ ae_matrix* xy, - ae_int_t npoints, - ae_int_t nfeatures, ae_state *_state); -double pearsoncorrelation(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_state *_state); -double spearmanrankcorrelation(/* Real */ ae_vector* x, - /* Real */ ae_vector* y, - ae_int_t n, - ae_state *_state); -void pearsoncorrelationsignificance(double r, - ae_int_t n, - double* bothtails, - double* lefttail, - double* righttail, - ae_state *_state); -void spearmanrankcorrelationsignificance(double r, - ae_int_t n, - double* bothtails, - double* lefttail, - double* righttail, - ae_state *_state); -void jarqueberatest(/* Real */ ae_vector* x, - ae_int_t n, - double* p, - ae_state *_state); -void mannwhitneyutest(/* Real */ ae_vector* x, - ae_int_t n, - /* Real */ ae_vector* y, - ae_int_t m, - double* bothtails, - double* lefttail, - double* righttail, - ae_state *_state); -void onesamplesigntest(/* Real */ ae_vector* x, - ae_int_t n, - double median, - double* bothtails, - double* lefttail, - double* righttail, - ae_state *_state); -void studentttest1(/* Real */ ae_vector* x, - ae_int_t n, - double mean, - double* bothtails, - double* lefttail, - double* righttail, - ae_state *_state); -void studentttest2(/* Real */ ae_vector* x, - ae_int_t n, - /* Real */ ae_vector* y, - ae_int_t m, - double* bothtails, - double* lefttail, - double* righttail, - ae_state *_state); -void unequalvariancettest(/* Real */ ae_vector* x, - ae_int_t n, - /* Real */ ae_vector* y, - ae_int_t m, - double* bothtails, - double* lefttail, - double* righttail, - ae_state *_state); -void ftest(/* Real */ ae_vector* x, - ae_int_t n, - /* Real */ ae_vector* y, - ae_int_t m, - double* bothtails, - double* lefttail, - double* righttail, - ae_state *_state); -void onesamplevariancetest(/* Real */ ae_vector* x, - ae_int_t n, - double variance, - double* bothtails, - double* lefttail, - double* righttail, - ae_state *_state); -void wilcoxonsignedranktest(/* Real */ ae_vector* x, - ae_int_t n, - double e, - double* bothtails, - double* lefttail, - double* righttail, - ae_state *_state); - -} -#endif - diff --git a/src/core/alglib/stdafx.h b/src/core/alglib/stdafx.h deleted file mode 100644 index 99a8091..0000000 --- a/src/core/alglib/stdafx.h +++ /dev/null @@ -1,2 +0,0 @@ - - diff --git a/src/core/args.cpp b/src/core/args.cpp deleted file mode 100644 index f6759f2..0000000 --- a/src/core/args.cpp +++ /dev/null @@ -1,469 +0,0 @@ -/*************************************************************************** - * - * Authors: Carlos Oscar S. Sorzano (coss@cnb.csic.es) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include "args.h" -#include "matrix1d.h" - -// Get parameters from the command line ==================================== -const char *getParameter(int argc, const char **argv, const char *param, const char *option) -{ - int i = 0; - - while ((i < argc) && (strcmp(param, argv[i]))) - i++; - if (i < argc - 1) - return(argv[i+1]); - else - if (option == NULL) - REPORT_ERROR(ERR_ARG_MISSING, param); - - return((char *) option); -} - -// Get 2 parameters ======================================================== -bool getTwoDoubleParams(int argc, const char **argv, const char *param, - double &v1, double &v2, double v1_def, double v2_def) -{ - bool retval; - int i = paremeterPosition(argc, argv, param); - if (i != -1) - { - if (i + 2 >= argc) - REPORT_ERROR(ERR_ARG_MISSING, - (std::string)"Not enough arguments after " + *param); - v1 = textToFloat(argv[i+1]); - v2 = textToFloat(argv[i+2]); - retval = true; - } - else - { - v1 = v1_def; - v2 = v2_def; - retval = false; - } - return retval; -} - -// Get 3 parameters ======================================================== -bool getThreeDoubleParams(int argc, const char **argv, const char *param, - double &v1, double &v2, double &v3, - double v1_def, double v2_def, double v3_def) -{ - bool retval; - int i = paremeterPosition(argc, argv, param); - if (i != -1) - { - if (i + 3 >= argc) - REPORT_ERROR(ERR_ARG_MISSING, - (std::string)"Not enough arguments after " + *param); - v1 = textToFloat(argv[i+1]); - v2 = textToFloat(argv[i+2]); - v3 = textToFloat(argv[i+3]); - retval = true; - } - else - { - v1 = v1_def; - v2 = v2_def; - v3 = v3_def; - retval = false; - } - return retval; -} - -// Checks if a boolean parameter was included the command line ============= -bool checkParameter(int argc, const char **argv, const char *param) -{ - int i = 0; - - while ((i < argc) && (strcmp(param, argv[i]) != 0)) - i++; - - if (i < argc) - return(true); - else - return(false); -} - -// Position of a parameter in the command line ============================= -int paremeterPosition(int argc, const char **argv, const char *param) -{ - int i = 0; - - while ((i < argc) && (strcmp(param, argv[i]))) - i++; - - if (i < argc - 1) - return i; - else - return -1; -} - -// Number of components ==================================================== -int numComponents(const std::string &str) -{ - int imax = str.length(); - int retval = 0; - if (str[0] != '[' && str[imax-1] != ']') - return retval; - for (int i = 0; i < imax; i++) - if (str[i] == ',') - retval++; - return retval + 1; -} - -// Get float vector ======================================================== -Matrix1D getVectorParameter(int argc, const char **argv, const char *param, int dim) -{ - Matrix1D aux; - bool count_dimensionality = (dim == -1); - - // Find and form vector - int pos = paremeterPosition(argc, argv, param); - if (pos == -1 || (pos + 1 == argc)) - { - if (count_dimensionality) - return aux; - else - REPORT_ERROR(ERR_ARG_MISSING, param); - } - pos++; - if (*(argv[pos]) != '[') - { - double d = textToFloat(argv[pos]); - aux.resize(1); - aux(0) = d; - return aux; - } - - std::string vector; - bool finished = false; - while (!finished) - { - vector += argv[pos]; - if (vector[vector.length()-1] == ']') - finished = true; - if (++pos == argc && !finished) - REPORT_ERROR(ERR_ARG_INCORRECT, param); - } - - // Remove brackets - vector = vector.substr(1, vector.length() - 2); - - // Count dimensionality - int start_copy = 0, end_copy; - if (count_dimensionality) - { - dim = 0; - start_copy = 0; - do - { - end_copy = vector.find(',', start_copy); - if (end_copy == -1) - break; - start_copy = end_copy + 1; - dim++; - } - while (1); - dim++; - } - - // Read different vector elements - int i = 0; - start_copy = 0; - aux.resize(dim); - while (i < dim - 1) - { - // Find colon - end_copy = vector.find(',', start_copy); - // Store number - aux(i) = textToFloat(vector.substr(start_copy, end_copy)); - - // Prepare for next iteration - i++; - start_copy = end_copy + 1; - } - - // Copy last element - aux(i) = textToFloat(vector.substr(start_copy, vector.length())); - - return aux; -} - -// Get vector param from file ============================================== -Matrix1D getVectorParameter(FILE *fh, const char *param, int dim) -{ - int argcp; - char **argvp = NULL; - char *copy = NULL; - Matrix1D retval; - if (!generateCommandLine(fh, param, argcp, argvp, copy)) - { - if (dim != -1) - REPORT_ERROR(ERR_ARG_MISSING, param); - } - else - { - retval = getVectorParameter(argcp, (const char **)argvp, ((std::string)"-" + param).c_str(), dim); - delete[] copy; - } - return retval; -} - -// Generate command line =================================================== -#define INSIDE_WORD 1 -#define OUTSIDE_WORD 2 -void generateCommandLine(const std::string &command_line, int &argcp, - char ** &argvp, char* ©) -{ - int L = command_line.length(); - - // Some initialization - if (L == 0) - { - argcp = 0; - return; - } - if (command_line[0] == '\n') - { - argcp = 0; - return; - } - - // Check that argvp and copy are empty - if (argvp != NULL) - delete argvp; - if (copy != NULL) - delete[] copy; - - // Copy command line - copy = new char[L+1]; - int i = 0; - while (i < L && command_line[i] != '\n') - { - copy[i] = command_line[i]; - i++; - } - L = i; - copy[L] = '\0'; - - // Now count how many different words are there - int words; - int state; - if (copy[0] == ' ') - { - state = OUTSIDE_WORD; - words = 0; - } - else - { - state = INSIDE_WORD; - words = 1; - } - i = 1; - while (i < L) - { - if (state == OUTSIDE_WORD && copy[i] != ' ') - { - state = INSIDE_WORD; - words++; - } - if (state == INSIDE_WORD && copy[i] == ' ') - state = OUTSIDE_WORD; - i++; - } - - // Resize argv and cut words - argvp = new char *[words+1]; - argvp[0] = new char[6]; - strcpy(argvp[0], "autom"); - if (copy[0] == ' ') - { - state = OUTSIDE_WORD; - argcp = 1; - } - else - { - state = INSIDE_WORD; - argvp[1] = &(copy[0]); - argcp = 2; - } - i = 1; - while (i < L) - { - if (state == OUTSIDE_WORD && copy[i] != ' ') - { - state = INSIDE_WORD; - argvp[argcp] = &(copy[i]); - argcp++; - } - if (state == INSIDE_WORD && copy[i] == ' ') - { - state = OUTSIDE_WORD; - copy[i] = '\0'; - } - i++; - } -} - -// Generate command line from file ========================================= -bool generateCommandLine(FILE *fh, const char *param, int &argcp, - char ** &argvp, char* ©) -{ - long actual_pos = ftell(fh); - fseek(fh, 0, SEEK_SET); - - char line[201]; - char *retval; - bool found = false; - - // Read lines - while (fgets(line, 200, fh) != NULL && !found) - { - if (line[0] == 0) - continue; - if (line[0] == '#') - continue; - if (line[0] == ';') - continue; - if (line[0] == '\n') - continue; - - int i = 0; - while (line[i] != 0 && line[i] != '=') - i++; - if (line[i] == '=') - { - line[i] = 0; - if (strcmp(line, param) == 0) - { - retval = line + i + 1; - found = true; - break; - } - } - } - fseek(fh, actual_pos, SEEK_SET); - if (!found) - return false; - - std::string artificial_line; - artificial_line = (std::string)"-" + param + " " + retval; - generateCommandLine(artificial_line, argcp, argvp, copy); - return true; -} - -// Get "parameter" from file =============================================== -std::string getParameter(FILE *fh, const char *param, int skip, const char *option) -{ - long actual_pos = ftell(fh); - fseek(fh, 0, SEEK_SET); - - char line[201]; - std::string retval; - bool found = false; - int skipped = 0; - - // Read lines - while (fgets(line, 200, fh) != NULL && !found) - { - if (line[0] == 0) - continue; - if (line[0] == '#') - continue; - if (line[0] == ';') - continue; - if (line[0] == '\n') - continue; - - int i = 0; - char *line_wo_spaces = line; - while (*line_wo_spaces == ' ' || *line_wo_spaces == '\t') - line_wo_spaces++; - while (line_wo_spaces[i] != 0 && line_wo_spaces[i] != '=') - i++; - if (line_wo_spaces[i] == '=') - { - line_wo_spaces[i] = 0; - if (strcmp(line_wo_spaces, param) == 0) - { - if (skipped == skip) - { - retval = line_wo_spaces + i + 1; - found = true; - break; - } - else - skipped++; - } - } - } - fseek(fh, actual_pos, SEEK_SET); - if (!found) - if (option == NULL) - REPORT_ERROR(ERR_ARG_INCORRECT, param); - else - return option; - else - return removeSpaces(retval); -} - -// Check "parameter" from file ============================================= -bool checkParameter(FILE *fh, const char *param) -{ - long actual_pos = ftell(fh); - fseek(fh, 0, SEEK_SET); - - char line[201]; - bool found = false; - std::string retval; - - // Read lines - while (fgets(line, 200, fh) != NULL) - { - if (line[0] == 0) - continue; - if (line[0] == '#') - continue; - if (line[0] == '\n') - continue; - - int i = 0; - while (line[i] != 0 && line[i] != '=') - i++; - if (line[i] == '=') - { - line[i] = 0; - if (strcmp(line, param) == 0) - { - retval = line + i + 1; - found = true; - break; - } - } - } - fseek(fh, actual_pos, SEEK_SET); - return found && retval != "No" && retval != "NO" && retval != "no"; -} diff --git a/src/core/args.h b/src/core/args.h deleted file mode 100644 index d75119d..0000000 --- a/src/core/args.h +++ /dev/null @@ -1,421 +0,0 @@ -/*************************************************************************** -* -* Authors: Carlos Oscar S. Sorzano (coss@cnb.csic.es) -* -* Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC -* -* This program is free software; you can redistribute it and/or modify -* it under the terms of the GNU General Public License as published by -* the Free Software Foundation; either version 2 of the License, or -* (at your option) any later version. -* -* This program is distributed in the hope that it will be useful, -* but WITHOUT ANY WARRANTY; without even the implied warranty of -* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -* GNU General Public License for more details. -* -* You should have received a copy of the GNU General Public License -* along with this program; if not, write to the Free Software -* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA -* 02111-1307 USA -* -* All comments concerning this program package may be sent to the -* e-mail address 'xmipp@cnb.csic.es' -***************************************************************************/ - -#ifndef CORE_ARGS_H -#define CORE_ARGS_H - -#include "xmipp_strings.h" -#include "xmipp_error.h" - -template -class Matrix1D; - -/** @defgroup Arguments Arguments parsing - * @ingroup DataLibrary - * - * This set of functions are designed for make easier checking and reading - * parameters from a string. The single value readings don't modify the value of - * the input string, while the multiple value readings do. In general, the - * reading is oriented to be done with a chain of strtok (a general C function), - * for this reason the string itself is modified by the successive calls to - * strtok. - * - * The second group (list reading) uses tokens internally, while in the single - * read functions the token must be given by hand. Anyway, it is not so - * difficult to read a set of fields from a line with all the normal checks we - * would like (existence of a parameter, checking for numerical correctness...) - * - * The following is an example of its use. This code tries to read a number, a - * character and a list of numbers from a line. In the example you can also see - * how to write code for the different error handling methods. - * - * @code - * std::string line; - * int key, param_no; - * std::vector< float > data; - * - * try - * { - * key = textToFloat(firstToken(line), 1602, "Error reading key"); - * param_no = textToInt(nextToken(), 1602, "Error reading number parameters"); - * readFloatList(NULL, param_no, data, 1602, "Error reading doc file line"); - * } - * catch (XmippError XE) - * { - * std::cout << XE; - * DL.line_type = 0; - * REPORT_ERROR(1602, "Line is discarded"); - * } - * @endcode - */ -//@{ -/** @name Read lists - * - * These functions try to read N values of the desired type into the given - * structure (either a STL vector of any numerical type by adding the read - * values at the end or a Matrix1D of any numerical type and then the values are - * written at PHYSICAL positions 0 ... N-1, the Matrix1D must be big enough to - * hold all the data since it is not resized internally. - * - * If it is not possible to read all parameters an exception is thrown. You can - * provide the exception in the function call but there are default values. - * These functions are based in those for reading single values, so it might be - * possible that these other functions throw other exceptions. - * - * The different elements of the list are selected using the tokenizing - * functions (different elements in the string are separated by spaces), so - * after the application of this function to the input string, this is modified - * and NULL characters are introduced as delimiters of the elements. - * - * The following code is an example of doing so: - * - * @code - * getline(in_stream, line); - * readFloatList(line, 10, v1); // Read 10 values from line in v1 - * readFloatList(NULL, 10, v2); // Read NEXT!! 10 values in v2 - * @endcode - */ -//@{ -/** List to STL vector. - */ -template -void readFloatList(const char* str, - int N, std::vector< T >& v) -{ - T valueF; - char* token; - - token = firstToken(str); - for (int i = 0; i < N; i++) - { - if (token == NULL) - REPORT_ERROR(ERR_VALUE_INCORRECT, "Cannot convert string into a list of numbers"); - - valueF = (T) textToFloat(token); - v.push_back(valueF); - - if (i != N - 1) - token = nextToken(); - } -} - -/** List to STL vector. - */ -template -void readFloatList(const std::string& str, - size_t& i, - int N, - std::vector< T >& v) -{ - T valueF; - std::string token; - - token = nextToken(str, i); - for (int j = 0; j < N; j++) - { - if (token == "") - REPORT_ERROR(ERR_VALUE_INCORRECT, "Cannot convert string into list of floats"); - valueF = (T) textToFloat(token.c_str()); - v.push_back(valueF); - - if (j != N - 1) - token = nextToken(str, i); - } -} - -/** Read list into a Matrix1D. - */ -template -void readFloatList(const char* str, - int N, - Matrix1D< T >& v, - ErrorType _errno = ERR_VALUE_INCORRECT, - std::string errmsg = "Error reading floating list", - int exit = 0) -{ - T valueF; - char* token; - - token = firstToken(str); - for (int i = 0; i < N; i++) - { - if (token == NULL) - { - // CO: Should not report other error than the required one - // std::cout << "Read float list: Number of true parameters doesn't coincide\n"; - REPORT_ERROR(_errno, errmsg); - } - - try - { - valueF = (T) textToFloat(token); - } - catch (XmippError) - { - REPORT_ERROR(_errno, errmsg); - } - - v(i) = valueF; - if (i != N - 1) - token = nextToken(); - } -} -//@} - -/** @name Functions for parsing the command line - * - * These functions help you to manage the command line parameters - */ -//@{ -/** Get parameters from the command line. - * - * This function assumes that the command line is structured in such a way that - * for each parameter a block like "-param " is defined. The label - * "param" can be substituted by any other one you like. If the parameter is - * optional then this function allows you to define a default value. If no - * default value is supplied and the parameter is not specified in the command - * line, then an exception is thrown. You may change the default exception. - * - * You may also indicate that in case of error no exception is raised and force - * the program to abort (use the exit variable). - * - * @code - * m_param = textToFloat(getParameter(argc, argv, "-m")); - * - * // Get compulsory parameter "-m" - * m_param = textToFloat(getParameter(argc, argv, "-m","2.65")); - * - * // Optional parameter, if no parameter is given it takes 2.65 by default - * m_param = textToFloat(getParameter(argc, argv, "-m", NULL, 6001, "-m parameter not \ - * found. I'm going out", TRUE); - * - * // Compulsory parameter, if not found give an special error message and exit - * // the program - * - * @endcode - */ -const char* getParameter(int argc, - const char** argv, - const char* param, - const char* option = NULL); - -/** Get two float parameters after a flag from the command line. - * - * An exception is thrown if there are not enough parameters after the flag, if - * the message is empty then "Not enough parameters after " is shown. The - * default values must be provided. TRUE is returned if the two values have been - * found - */ -bool getTwoDoubleParams(int argc, - const char** argv, - const char* param, - double& v1, - double& v2, - double v1_def, - double v2_def); - -/** Get 3 float parameters after a flag from the command line. - * - * An exception is thrown if there are not enough parameters after the flag, if - * the message is empty then "Not enough parameters after " is shown. The - * default values must be provided. TRUE is returned if the two values have been - * found - */ -bool getThreeDoubleParams(int argc, - const char** argv, - const char* param, - double& v1, - double& v2, - double& v3, - double v1_def, - double v2_def, - double v3_def); - -/** Get boolean parameters from the command line. - * - * This function assumes that the command line is structured in such a way that - * for each parameter a block like "-param" is defined. The label "param" can be - * substituted by any other one you like. It might be used to look for a boolean - * parameter, for instance: - * - * -verbose means that verbose functionality is set (TRUE) - * - * @code - * verbose = checkParameter(argc, argv, "-verbose")); - * - * // checks if "-verbose" was supplied in the command line. If -verbose was - * // supplied the function returns TRUE (1), otherwise returns FALSE (0) - * @endcode - */ -bool checkParameter(int argc, const char** argv, const char* param); - -/** Returns the position where the given parameter is in the command line. - * - * This function assumes that the command line is structured in such a way that - * for each parameter a block like "-param" is defined. The label "param" can be - * substituted by any other one you like. It returns -1 if the parameter is not - * found. It is used to look for parameters having a list of values behind, for - * instance: - * - * -ang rot tilt psi - * - * @code - * i = paremeterPosition(argc, argv, "-ang")); - * - * // This condition checks if 3 arguments where introduced after -ang parameter - * // (assuming that the -ang argument is the last one in the string) - * if (i+3 >= argc) - * EXIT_ERROR(1, "Not enough parameters behind -ang"); - * - * ang1 = argv[i+1]; - * ang2 = argv[i+2]; - * ang3 = argv[i+3]; - * @endcode - */ -int paremeterPosition(int argc, const char** argv, const char* param); - -/** Return the number of components of a vector argument. - * - * A vector argument is defined as [x,y,z,...]. It returns 0 if the string does - * not contain a vector - */ -int numComponents(const std::string& str); - -/** Get float vector. - * - * A vector is defined as a "[x,y,z, ...]" of any dimension (by default 2D - * vectors are read). The vector must not contain blank spaces. - * - * @code - * a = getVectorParameter(argc, argv, "-a", 3); // a 3D vector called "-a". - * @endcode - * - * The vector is internally resized properly. If the dimension is -1 then all - * the vector components are read disregarding their dimensionality, ie,-1 is - * used to read vectors of an unknown dimension. If the parameter is not found - * when no dimensionality is given an empty vector is returned but no exception - * is thrown. If there is no dimensionality and a single parameter is behind the - * flag then no brackets are needed - */ -Matrix1D< double > getVectorParameter(int argc, - const char** argv, - const char* param, - int dim = 2); - -/** Get float vector. - * - * Same as the previous function but from a file. - */ -Matrix1D getVectorParameter(FILE *fh, const char *param, int dim=2); - -/** Generate argc and argv for a string. -* -* Given a string this function makes a copy of the string and divides it into -* tokens such that they can be used as argc and argv, as if it were a command -* line. -* -* The string copy remains in "copy" and it can be freed by disposing this -* variable. -* -* argvp[0] (normally the program name) is set to any value, in this case to -* "autom", standing for "automatically generated". -* -* argcp==0 if now valid command line is provided, ie, the line is empty or only -* with blanks. -* -* Next time the function is called it checks that argv and copy are empty -* (pointing to NULL), if they aren't then firstly the associated memory is -* freed. -* -* @code -* int argcp; -* char** argvp; -* char* copy; -* -* copy = NULL; -* argvp = NULL; -* -* string command_line = "-i input_file -o output_file"; -* -* generateCommandLine(command_line, argcp, &argvp, ©); -* -* if (argcp != 0) -* read_parameters(argcp, argvp); -* @endcode -*/ -void generateCommandLine(const std::string& command_line, - int& argcp, - char**& argvp, - char*& copy); - -/** Generate articial command line from a file. -* -* The copy variable must be destroyed outside by "delete copy". This function -* takes "input_file=" and turns it into "-input_file " -* The appropriate argc, argv are also returned. -* -* Returns TRUE if the parameter is found in the file, and FALSE if it is not -*/ -bool generateCommandLine(FILE* fh, - const char* param, - int& argcp, - char**& argvp, - char*& copy); - -/** Get parameter from file. - * - * Parameters are supposed to be identified with an =, so any line which doesn't - * contain an = character cannot contain a parameter. The left part of the "=" - * is the identifier, and the right part the value. The value is returned - * without any extra space, if it is compound of several words, then the spaces - * in between are simplified to a single blank space. - * - * The file position inside the file is not moved and comments are allowed - * starting with "#" and ";". - * - * Parameter skip controls the number of these parameters to skip before - * returning the value, ie, if there are several "parameter=" tags in a file and - * you want the first one then you should skip 0, if you want the second the - * skip=1, ... - * - * The meaning and use of the exit, errors and optional value is the same as in - * the command line getParameter - */ -std::string getParameter(FILE* fh, - const char* param, - int skip = 0, - const char* option = NULL); - -/** Check if a parameter is present in a file. - * - * The same as the previous function, but this function only reports if a - * parameter is present or not in a file. Notice that boolean parameters must be - * defined as "parameter=". If after the parameter, "no" comes then this - * function returns FALSE - */ -bool checkParameter(FILE* fh, const char* param); -//@} -//@} -#endif diff --git a/src/core/argsparser.cpp b/src/core/argsparser.cpp deleted file mode 100644 index 254022d..0000000 --- a/src/core/argsparser.cpp +++ /dev/null @@ -1,1060 +0,0 @@ -/*************************************************************************** - * Authors: J.M de la Rosa Trevin (jmdelarosa@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your param) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include -#include -#include "argsparser.h" -#include "xmipp_error.h" - -//------------------- LEXER IMPLEMENTATIONS -------------------------------- - -const char * ArgToken::typeString(ArgTokenType type) -{ - switch (type) - { - case TOK_ID: //identifier - return "ID"; - case TOK_OPT: // -ID or --ID - return "OPTION"; - case TOK_INT: //integer number - return "INT"; - case TOK_FLOAT: //float number - return "FLOAT"; - case TOK_STR: //string value - return "STRING"; - case TOK_MINUS: // - or -- - return "MINUS"; - case TOK_EQ: // = - return "EQUAL"; - case TOK_COMM: // Comment: from : until end of line - return "COMMENT"; - case TOK_LAN: // < - return "<"; - case TOK_RAN: // > - return ">"; - case TOK_LBRA: // [ - return "["; - case TOK_RBRA: // ] - return "]"; - case TOK_END: // end of input - return "EOF"; - ///Reserved words - case TOK_WHERE: // 'WHERE' keyword - return "WHERE"; - case TOK_ALIAS: // 'ALIAS' keyword - return "ALIAS"; - case TOK_SECTION: - return "SECTION"; - case TOK_SEMI: - return ";"; - case TOK_COMMA: - return ","; - case TOK_PLUS: - return "+"; - default: - return "UKNOWN"; - }; -} - -ArgLexer::ArgLexer() -{ - line = 0; - pos = 0; - pToken = new ArgToken(); - //Initialize reserved words dictionary - reservedWords["WHERE"] = TOK_WHERE; - reservedWords["ALIAS"] = TOK_ALIAS; - reservedWords["OR"] = TOK_OR; - reservedWords["REQUIRES"] = TOK_REQUIRES; -} - -ArgLexer::~ArgLexer() -{ - delete pToken; -} - -//#define DEBUG -void ArgLexer::addLine(const String &line) -{ - input.push_back(line + " "); -#ifdef DEBUG - std::cout << input.size() << ": " << line << std::endl; -#endif -} - -inline void ArgLexer::nextLine() -{ - ++line; - pos = 0; -} - -void ArgLexer::setupToken(ArgTokenType type) -{ - pToken->type = type; - if (type != TOK_END) - { - pToken->line = line; - pToken->start = pos; - pToken->end = pos + offset - 1; - pToken->lexeme = input[line].substr(pos, offset); - - if (type == TOK_ID) - { - String s = pToken->lexeme; - std::transform(s.begin(), s.end(), s.begin(), - ::toupper); - std::map::iterator it; - it = reservedWords.find(s); - if (it != reservedWords.end()) - { - pToken->lexeme = it->first; - pToken->type = it->second; - } - - } - else if (type == TOK_STR) - ++offset; - pos += offset; - offset = 1; - } - else - pToken->lexeme = "EOF"; -} - -void ArgLexer::checkVisibility() -{ - while (input[line][pos] == '+') - { - ++(pToken->visibility); - ++pos; - } -} - -void ArgLexer::checkIndependent() -{ - if (input[line][pos]== '*') - { - pToken->starred = true; - ++pos; - } -} - -bool ArgLexer::nextToken() -{ - //make it visible by default - pToken->visibility = 0; - pToken->starred = false; - - if (line == input.size()) - { - setupToken(TOK_END); - return false; - } - - char c = input[line][pos]; - - //Skip all white spaces - while (line < input.size() && pos < input[line].length() && isspace(c - = input[line][pos])) - { - ++pos; - if (c == '\0' || c == '\n' || pos == input[line].length()) //Next line - { - nextLine(); - } - } - - if (line == input.size()) - setupToken(TOK_END); - else if (isalpha(c) || c == '_') - { - offset = 0; - while (isalnum(c) || c == '_') - { - ++offset; - c = input[line][pos + offset]; - } - setupToken(TOK_ID); - } - else if (isalnum(c) || (c == '-' && isdigit(input[line][pos + 1]))) - { - offset = 1; - ArgTokenType t = TOK_INT; - while (isdigit(input[line][pos + offset])) - ++offset; - if (input[line][pos + offset] == '.') - { - ++offset; - while (isdigit(input[line][pos + offset])) - ++offset; - t = TOK_FLOAT; - } - if (input[line][pos + offset] == 'e') - { - ++offset; - if (input[line][pos + offset] != '+' && input[line][pos + offset] - != '-') - { - std::cerr << "ERROR: expected '+' or '-' " << std::endl - << "at line: " << line + 1 << " pos: " << offset + 1 - << std::endl; - exit(1); - } - ++offset; - while (isdigit(input[line][pos + offset])) - ++offset; - t = TOK_FLOAT; - - } - setupToken(t); - } - else - { - offset = 1; - bool empty; - switch (c) - { - case '<': - setupToken(TOK_LAN); - break; - case '>': - setupToken(TOK_RAN); - break; - case '=': - if (input[line][pos + offset] == '=') - { - pos = input[line].find_first_not_of('=', pos + 1); - checkVisibility(); - offset = input[line].find_first_of('=', pos + 1); - offset -= pos; - setupToken(TOK_SECTION); - nextLine(); - } - else - //simple equal sign '=' - setupToken(TOK_EQ); - break; - case '[': - setupToken(TOK_LBRA); - break; - case ']': - setupToken(TOK_RBRA); - break; - case ';': - setupToken(TOK_SEMI); - break; - case ',': - setupToken(TOK_COMMA); - break; - case '+': - setupToken(TOK_PLUS); - break; - case '.': - if (input[line][pos + offset] == '.' && - input[line][pos + offset + 1] == '.') - { - offset += 2; - setupToken(TOK_ETC); - } - break; - case ':': - ++pos; - - checkVisibility(); - - offset = input[line].find_first_of("\n\r", pos); - offset -= pos; - setupToken(TOK_COMM); - nextLine(); - break; - case '-': - if (input[line][pos + offset] == '-') - ++offset; - empty = true; - c = input[line][pos + offset]; - if (isalpha(c) || c == '_') //should start with letter or _ - { - while (isalnum(c) || c == '_') - { - empty = false; - ++offset; - c = input[line][pos + offset]; - } - } - if (empty) - { - std::cerr << "ERROR: Params should be of the form -ID or --ID" - << std::endl; - exit(1); - } - setupToken(TOK_OPT); - checkVisibility(); - checkIndependent(); - break; - case '"': - offset = input[line].find_first_of('"', pos + 1); - ++pos; - offset -= pos; - setupToken(TOK_STR); - break; - default: - std::cerr << "ERROR: Unexpected character '" << c << "'" - << std::endl << "at line: " << line + 1 << " pos: " << pos - + 1 << std::endl; - std::cerr << "WRONG LINE: " << input[line] << std::endl; - exit(1); - } - } - - //ConsolePrinter * cp = new ConsolePrinter(); - //cp->printToken(pToken); - - return true; -} - -ArgToken * ArgLexer::currentToken() const -{ - return pToken; -} -ArgTokenType ArgLexer::lookahead() const -{ - return pToken->type; -} - - -//------------------- PARSER IMPLEMENTATIONS -------------------------------- - -ASTNode::ASTNode(ArgLexer * lexer, ASTNode * parent) -{ - pLexer = lexer; - visible = 0; - this->parent = parent; -} - -ArgTokenType ASTNode::lookahead() const -{ - return pLexer->lookahead(); -} - -bool ASTNode::lookahead(ArgTokenType type) const -{ - return pLexer->lookahead() == type; -} - -ArgToken * ASTNode::currentToken() const -{ - return pLexer->currentToken(); -} - -void ASTNode::nextToken() -{ - pLexer->nextToken(); -} - -bool ASTNode::consume(ArgTokenType type) -{ - ArgTokenType t = lookahead(); - if (t != type) - unexpectedToken(); - //Store consumed token - if (currentToken() != NULL) - token = *currentToken(); - else - REPORT_ERROR(ERR_MEM_NULLPOINTER, "current token is null"); - - //Ask for new token - nextToken(); - return true; -} - -bool ASTNode::parseCommentList(CommentList &comments) -{ - comments.clear(); - //Comment List (CL) - //CL -> comment CL | e - while (lookahead(TOK_COMM)) - { - consume(TOK_COMM); - comments.addComment(token.lexeme, token.visibility); - } - - return true; -} - -void ASTNode::error(String msg) -{ - std::cerr << ">>> ERROR: " << msg << std::endl << " at line " - << token.line + 1 << " column " << token.start + 1 << std::endl; - exit(1); -} - -void ASTNode::unexpectedToken(String msg) -{ - token = *currentToken(); - error(formatString("Unexpected token '%s' (%s) \n %s", - token.lexeme.c_str(), ArgToken::typeString(token.type), msg.c_str())); - -} - -ArgumentDef::ArgumentDef(ArgLexer *lexer, ASTNode * parent) : - ASTNode(lexer, parent) -{ - isList = false; - hasDefault = false; -} - -ArgumentDef::~ArgumentDef() -{ - for (size_t i = 0; i < subParams.size(); ++i) - delete subParams[i]; -} - -bool ArgumentDef::parse() -{ - // A -> < ID DEF > | <...> - // DEF -> = VALUE | e - // VALUE -> INT | FLOAT | STRING - consume(TOK_LAN); - if (lookahead(TOK_ID)) - { - consume(TOK_ID); - name = token.lexeme; - if (lookahead(TOK_EQ)) - { - consume(TOK_EQ); - //Consume a value, that can be int, float or string - ArgTokenType t = lookahead(); - - if (t == TOK_INT || t == TOK_FLOAT || t == TOK_STR || t == TOK_ID) - consume(t); - else - unexpectedToken(" expecting INT, FLOAT, STRING or ID."); - - hasDefault = true; - argDefault = token.lexeme; - } - } - else - { - consume(TOK_ETC); - name = token.lexeme; - isList = true; - } - consume(TOK_RAN); - return true; -} - -bool ArgumentDef::acceptArguments(std::stringstream &errors, size_t & index, std::vector &cmdArguments) -{ - ProgramDef * prog = (ProgramDef*) parent->parent->parent; - if (index == cmdArguments.size()) - { - if (hasDefault) - { - cmdArguments.push_back(argDefault.c_str()); - } - else - { - errors << "Not enough arguments, <" << name << "> has not default. "; - return false; - } - } - - if (isList) - return true; - - if (!subParams.empty()) - { - bool found = false; - String optionValue = (String)cmdArguments[index]; - for (size_t i = 0; i < subParams.size(); ++i) - { - if (subParams[i]->name == optionValue) - { - found = true; - ++index; - - if (!subParams[i]->checkRequires(errors, prog)) - return false; - - for (size_t j = 0; j < subParams[i]->arguments.size(); ++j) - if (!subParams[i]->arguments[j]->acceptArguments(errors, index, cmdArguments)) - return false; - break; - } - } - if (!found) - { - errors << optionValue << " is not a valid option for <" << name <<"> "; - return false; - } - return true;//not increment index when found subparams, already incremented - } - - //if not list increment index - ++index; - - return true; -} - -ParamDef::ParamDef(ArgLexer *lexer, ASTNode * parent) : - ASTNode(lexer, parent) -{ - exclusiveGroup = NULL; - orBefore = false; -} - -ParamDef::~ParamDef() -{ - for (size_t i = 0; i < arguments.size(); ++i) - delete arguments[i]; - if (!orBefore) - delete exclusiveGroup; -} - -bool ParamDef::containsArgument(const String & argName) -{ - return findArgument(argName) == NULL; -} - -ArgumentDef * ParamDef::findArgument(const String & argName) -{ - for (size_t i = 0; i < arguments.size(); ++i) - if (argName == arguments[i]->name) - return arguments[i]; - return NULL; -} - -bool ParamDef::containsAlias(const String & alias) -{ - for (size_t i = 0; i < aliases.size(); ++i) - if (alias == aliases[i]) - return true; - return false; -} - -bool ParamDef::parse() -{ - ProgramDef * prog = (ProgramDef*) parent->parent; - notOptional = true; - orBefore = false; - independent = false; - counter = 0; - - //Param Definition(OD) - //OD -> OH CL - //Param Header(OH) - //OH -> O | [O] | OR O - //Param(O) - //O -> param AL - if (lookahead(TOK_LBRA)) - { - consume(TOK_LBRA); - notOptional = false; - } - else if (lookahead(TOK_OR)) - { - consume(TOK_OR); - orBefore = true; - } - prog->addParamExclusiveGroup(this); - - consume(TOK_OPT); - name = token.lexeme; - visible = token.visibility; - independent = token.starred; - - prog->addParamName(name, this); - - //Parse argument list - parseArgumentList(); - - if (notOptional == false) - consume(TOK_RBRA); - - //Parse comment list - parseCommentList(comments); - - //WHERE section - while (lookahead(TOK_WHERE)) - { - consume(TOK_WHERE); - while (lookahead(TOK_LAN)) - { - consume(TOK_LAN); - consume(TOK_ID); - ArgumentDef * pArg = findArgument(token.lexeme); - if (pArg == NULL) - { - std::cerr << "ERROR; on WHERE definition.\n Param '" << name - << "' not contains argument '" << token.lexeme << "'" - << std::endl; - exit(1); - } - consume(TOK_RAN); - - while (lookahead(TOK_ID)) - { - ParamDef * pOpt = new ParamDef(pLexer, this); - pOpt->consume(TOK_ID); - - pOpt->name = pOpt->token.lexeme; - pOpt->parseArgumentList(); - pOpt->parseCommentList(pOpt->comments); - pOpt->parseParamList(TOK_REQUIRES, prog, pOpt->requirements, false); - pArg->subParams.push_back(pOpt); - } - - } - } - - //ALIAS section - parseParamList(TOK_ALIAS, prog, aliases, true); - - //REQUIRES section - parseParamList(TOK_REQUIRES, prog, requirements, false); - - return true; -} - -bool ParamDef::parseArgumentList() -{ - bool previousList = false; // to check only one list and at end of arguments - bool previousDefault = false; // to check that default values only can be at end - //Argument List (AL) - //AL -> argument AL | e - while (lookahead(TOK_LAN)) - { - ArgumentDef * arg = new ArgumentDef(pLexer, this); - arg->parse(); - token = arg->token; - - if (previousList) - error("A list <...> has found not at the end of argument list"); - - if (previousDefault && !arg->hasDefault) - error("A non default argument was found before a default one"); - - previousList = arg->isList; - previousDefault = arg->hasDefault; - - arguments.push_back(arg); - } - return true; -} - -bool ParamDef::parseParamList(ArgTokenType startToken, ProgramDef * prog, StringVector ¶mList, - bool isAlias) -{ - paramList.clear(); - if (lookahead(startToken)) - { - consume(startToken); - consume(TOK_OPT); - paramList.push_back(token.lexeme); - - if (isAlias) - prog->addParamName(token.lexeme, this); - else - prog->addParamRequires(token.lexeme); - - while (lookahead(TOK_COMMA)) - { - consume(TOK_COMMA); - consume(TOK_OPT); - paramList.push_back(token.lexeme); - if (isAlias) - prog->addParamName(token.lexeme, this); - else - prog->addParamRequires(token.lexeme); - } - consume(TOK_SEMI); - } - - return true; -} - -bool ParamDef::checkRequires(std::stringstream & errors, ProgramDef * prog) -{ - ParamDef * param; - bool correct = true; - for (size_t i = 0; i < requirements.size(); ++i) - { - param = prog->findParam(requirements[i]); - if (param->counter < 1) - { - errors << "Parameter " << name << " requirements " << requirements[i] << std::endl; - correct = false; - } - } - return correct; -} - -void ParamDef::check(std::stringstream & errors) -{ - String aaa = name; - - ProgramDef * prog = (ProgramDef*) parent->parent; - if (counter > 1 ) - { - errors << "Duplicated parameter: " << name << " (check alias)" << std::endl; - return; - } - - if (counter == 1) - { - //Check requirements restrictions - checkRequires(errors, prog); - - //Check the number of arguments - if (arguments.empty()) //if not arguments - { - if (!cmdArguments.empty()) - errors << "Parameter " << name << " doesn't take any argument, " - << cmdArguments.size() << " provided." << std::endl; - } - else - { - size_t argIndex = 0; - - for (size_t i = 0; i < arguments.size(); ++i) - if (!arguments[i]->acceptArguments(errors, argIndex, cmdArguments)) - { - errors << " parameter: " << name << std::endl; - return; - } - - if (argIndex < cmdArguments.size() && !arguments[arguments.size()-1]->isList) - errors << "Too many arguments for parameter " << name << std::endl; - } - } - else - { - //Fill default arguments - for (size_t i = 0; i < arguments.size(); ++i) - if (arguments[i]->hasDefault) - cmdArguments.push_back(arguments[i]->argDefault.c_str()); - } -} - -void SectionDef::addParamDef(ParamDef * param) -{ - ProgramDef * prog = (ProgramDef*)parent; - if (prog->findParam(param->name) == NULL) - { - prog->addParamName(param->name, param); - param->parent = this; - params.push_back(param); - } -} - -SectionDef::SectionDef(ArgLexer * lexer, ASTNode * parent) : - ASTNode(lexer, parent) -{} - -SectionDef::~SectionDef() -{ - for (size_t i = 0; i < params.size(); ++i) - delete params[i]; -} - -bool SectionDef::parse() -{ - if (lookahead(TOK_SECTION)) - { - consume(TOK_SECTION); - name = token.lexeme; - visible = token.visibility; - parseCommentList(comments); - } - - //OL -> params OD ODL | SD ODL | e - ArgTokenType t = lookahead(); - - if (!(t == TOK_OPT || t == TOK_OR || t == TOK_LBRA)) - unexpectedToken("parsing section, expecting param definition"); - - while (t == TOK_OPT || t == TOK_OR || t == TOK_LBRA) - { - ParamDef * param = new ParamDef(pLexer, this); - param->parse(); - params.push_back(param); - t = lookahead(); - } - - return true; -} - -ProgramDef::ProgramDef() : - ASTNode() -{ - pLexer = new ArgLexer(); - singleOption = false; - exclusiveGroup = NULL; -} - -ProgramDef::~ProgramDef() -{ - delete pLexer; - for (size_t i = 0; i < sections.size(); ++i) - delete sections[i]; -} -/** Parse the program definition. */ -bool ProgramDef::parse() -{ - - // P -> ID CL OL - //consume(TOK_ID); - //name = token.lexeme; - //Usage comments - //parseCommentList(usageComments); - - //Ask for first token - pLexer->nextToken(); - - while (!lookahead(TOK_END)) - { - SectionDef * s = new SectionDef(pLexer, this); - s->parse(); - String name = s->name; - sections.push_back(s); - } - consume(TOK_END); - - return true; -} - -void addOcurrence(std::map &map, const String &name) -{ - if (map.find(name) != map.end()) - map[name]++; - else - map[name] = 1; -} - -void reportExclusiveErrors(std::stringstream & errors, std::vector &exclusive) -{ - if (exclusive.empty()) - return; - - std::vector exclusive2; - for (size_t i = 0; i < exclusive.size(); ++i) - if (exclusive[i]->counter == 1) - exclusive2.push_back(exclusive[i]); - if (exclusive2.size() > 1) - { - errors << "Parameters "; - for (size_t i = 0; i < exclusive.size() - 1; ++i) - errors << exclusive[i]->name << " "; - errors << "and " << exclusive[exclusive.size()-1]->name << " are mutually exclusive (check alias)" << std::endl; - } - else if (exclusive2.empty() && exclusive[0]->notOptional) - { - errors << "You should provide parameter " << exclusive[0]->name; - for (size_t i = 1; i < exclusive.size(); ++i) - errors << " or " << exclusive[i]->name; - errors << std::endl; - } - exclusive.clear(); -} - -void ProgramDef::check(std::stringstream & errors) -{ - std::vector exclusive; - SectionDef * section; - ParamDef * param; - - for (size_t i = 0; i < sections.size(); ++i) - { - section = sections[i]; - for (size_t j = 0; j < section->params.size(); ++j) - { - param = section->params[j]; - //Doesn't check for alias, for doesn't repeat error messages - param->check(errors); - if (!param->orBefore) - reportExclusiveErrors(errors, exclusive); - exclusive.push_back(param); - } - } - reportExclusiveErrors(errors, exclusive); -} - -ParamDef * ProgramDef::findParam(const String &name) -{ - if (paramsMap.find(name) != paramsMap.end()) - return paramsMap[name]; - return NULL; -} - -void ProgramDef::addParamName(const String &name, ParamDef * param) -{ - if (paramsMap.find(name) != paramsMap.end()) - error((String) "The param '" + name + "' is repeated."); - else - paramsMap[name] = param; -} - -void ProgramDef::addParamRequires(const String &name) -{ - pendingRequires.push_back(name); -} - -void ProgramDef::addParamExclusiveGroup(ParamDef * param) -{ - if (exclusiveGroup == NULL || param->orBefore == false) - exclusiveGroup = new std::vector(); - exclusiveGroup->push_back(param); - param->exclusiveGroup = exclusiveGroup; -} - -void ProgramDef::clear() -{ - - SectionDef * section; - ParamDef * param; - - for (size_t i = 0; i < sections.size(); ++i) - { - section = sections[i]; - for (size_t j = 0; j < section->params.size(); ++j) - { - param = section->params[j]; - param->counter = 0; - param->cmdArguments.clear(); - } - } -} - -void ProgramDef::read(int argc, const char ** argv, bool reportErrors) -{ - clear(); - std::stringstream errors; - //Set the name with the first argument - name = argv[0]; - singleOption = false; - - ParamDef * param = NULL; - - //We assume that all options start with - - if (argc > 1 && argv[1][0] != '-') - { - //Assume if the first is missing, treat as -i - if ((param = findParam("-i")) == NULL) //-i is not allowed, report error - REPORT_ERROR(ERR_ARG_INCORRECT, "Parameters should start with a -"); - else - { - ++(param->counter); - if (param->independent) - singleOption = true; - } - //Assume if the first is missing, treat as -i - } - - //Read command line params and arguments - for (int i = 1; i < argc; ++i) - { - - if (argv[i][0] == '-' && !isdigit(argv[i][1])) - { - param = findParam(argv[i]); - if (param == NULL) - errors << "Unrecognized parameter: " << argv[i] << std::endl; - else - { - ++(param->counter); - if (param->independent) - singleOption = true; - } - } - else if (param != NULL) - param->cmdArguments.push_back(argv[i]); - } - - if (!singleOption) - check(errors); - - //Report errors found - if (reportErrors && errors.str().length() > 0) - { - //Unrecognized parameters - //for (size_t i = 0; i < unrecognized.size(); ++i) - // std::cerr << "Unrecognized parameter: " << unrecognized[i] << std::endl; - REPORT_ERROR(ERR_ARG_BADCMDLINE, errors.str().c_str()); - } -} - -SectionDef * ProgramDef::addSection(String sectionName, int visibility) -{ - SectionDef * section = new SectionDef(NULL, this); - section->name = sectionName; - section->visible = visibility; - sections.push_back(section); - return section; -} - -ParamDef* ProgramDef::findAndFillParam(const String ¶m) -{ - ParamDef * paramDef = findParam(param); - if (paramDef == NULL) - REPORT_ERROR(ERR_ARG_INCORRECT, formatString("Doesn't exists param: %s", param.c_str())); - ///Param was provided, not need to fill it - //if (paramDef->counter == 1) - // return paramDef; - std::stringstream errors; - size_t argIndex = 0; - for (size_t i = 0; i < paramDef->arguments.size(); ++i) - if (!paramDef->arguments[i]->acceptArguments(errors, argIndex, paramDef->cmdArguments)) - { - errors << " parameter: " << paramDef->name << std::endl; - REPORT_ERROR(ERR_ARG_INCORRECT, errors.str()); - } - return paramDef; -} - -const char * ProgramDef::getParam(const char * paramName, size_t argNumber) -{ - ParamDef * param = findAndFillParam(paramName); - if (param == NULL) - REPORT_ERROR(ERR_ARG_INCORRECT, formatString("Doesn't exists param: %s", paramName)); - if (argNumber < 0 || argNumber >= param->cmdArguments.size()) - REPORT_ERROR(ERR_ARG_INCORRECT, formatString("Argument index %d in param %s out of bounds.", argNumber, paramName)); - return param->cmdArguments.at(argNumber); -} - -const char * ProgramDef::getParam(const char * paramName, const char * subParam, size_t argNumber) -{ - ParamDef * param = findAndFillParam(paramName); - - size_t i = 0; - for (i = 0; i < param->cmdArguments.size(); ++i) - if (strcmp(param->cmdArguments[i], subParam) == 0) - break; - - if (i == param->cmdArguments.size()) - REPORT_ERROR(ERR_ARG_INCORRECT, formatString("Sub-param %s was not supplied in command line.", subParam)); - - return param->cmdArguments.at(i + 1 + argNumber); -} diff --git a/src/core/argsparser.h b/src/core/argsparser.h deleted file mode 100644 index b8c8cbe..0000000 --- a/src/core/argsparser.h +++ /dev/null @@ -1,275 +0,0 @@ -/*************************************************************************** - * Authors: J.M.de la Rosa Trevin (jmdelarosa@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your param) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_ARGSPARSER_H_ -#define CORE_ARGSPARSER_H_ - -#include -#include -#include "xmipp_strings.h" -#include "comment_list.h" - -//TODO (MARIANA) Please give more documentation and in a good structure e.g. @name (see args.h as example) -/* MARIANA: I defined the name of this group. Please define it as you want. */ - -/** @defgroup Arguments1 Arguments parser - * @ingroup DataLibrary - * @{ - */ - -/** Type of tokens for lexical analysis */ -typedef enum { - TOK_ID, //identifier - TOK_OPT, // -ID or --ID - TOK_INT, //integer number - TOK_FLOAT, //float number - TOK_STR, //string value - TOK_MINUS, // - or -- - TOK_PLUS, // + - TOK_EQ, // = - TOK_COMM, // Comment, from : until end of line - TOK_LAN, // < - TOK_RAN, // > - TOK_LBRA, // [ - TOK_RBRA, // ] - TOK_SEMI, // semicolor ; - TOK_COMMA, // , - TOK_ETC, // ... - TOK_END, // end of input - ///Reserved words - TOK_WHERE, // 'WHERE' keyword - TOK_ALIAS, // 'ALIAS' keyword - TOK_OR, // 'OR' keyword - TOK_REQUIRES,// 'REQUIRES' keyword - TOK_SECTION // section defined by == Section == -} ArgTokenType; - -class ProgramDef; - -/** Just a simple struct to hold information about tokens */ -class ArgToken -{ -public: - ArgTokenType type; ///< Type of the token - String lexeme; ///< the string literal value of the token - int line; ///< line where token was found - int start, end; ///< start and end position of the lexeme. - /// this info will be used by parser and printers - /// 0 - means visible - /// 1 - less visible - /// while great is the number is less visible - int visibility; - /// Some special mark to tokens - bool starred; - - static const char * typeString(ArgTokenType type); -}; - -/** This class will split the input stream into tokens. - * The tokens will be further used by the Parser - * to build the syntax tree. - */ -class ArgLexer -{ -private: - StringVector input; - size_t line; - size_t pos; ///< reading position of the input - size_t offset; ///< the offset from pos of each token - ArgToken * pToken; ///< pointer to the input token. - ///Dictionary for identify reserved words - std::map reservedWords; - - //Some utils functions - void readSpaces(); - void readDigits(); - void readId(); - void setupToken(ArgTokenType type); - void checkVisibility(); - void checkIndependent(); - void nextLine(); - -public: - /** Constructor */ - ArgLexer(); - /** Destructor */ - ~ArgLexer(); - /** Add input lines to the lexer */ - void addLine(const String &line); - /** Function to parse a new token. - * If the token is TOK_END will return false - * and true otherwise. The current token will be changed. - */ - bool nextToken(); - ArgToken * currentToken() const; - ArgTokenType lookahead() const; - -}; - -/** Following classes represent the Abstract Syntax Tree - * for the language of definition of a program. - */ - -/** Class representing the nodes of the tree. - * All nodes will have the parse method, which need - * a ArgLexer to ask for tokens. - * Also a 'consume' method to use the terminal symbols - */ -class ASTNode -{ -public: - ASTNode(ArgLexer *lexer = NULL, ASTNode * parent = NULL); - virtual ~ASTNode() - { - } - ; - - ASTNode * parent; - ArgLexer * pLexer; - ArgToken token; - String name; - int visible; - - virtual bool parse() = 0; //abstract function - virtual void check(std::stringstream & errors) = 0; //abstract function - virtual bool consume(ArgTokenType type); - ArgTokenType lookahead() const; - bool lookahead(ArgTokenType type) const; - ArgToken * currentToken() const; - void nextToken(); - bool parseCommentList(CommentList &comments); - void error(String msg); - void unexpectedToken(String msg = ""); -}; - -class ParamDef; - -class ArgumentDef: public ASTNode -{ -public: - String argDefault; - bool isList; - bool isType; - std::vector subParams; - bool hasDefault; - - ArgumentDef(ArgLexer *lexer, ASTNode * parent); - ~ArgumentDef(); - virtual bool parse(); - virtual void check(std::stringstream & errors) - { - } - /// This function will take an index and check if there are enougth arguments - // to pass to this parameter and increase the index - bool acceptArguments(std::stringstream &errors, size_t &argIndex, std::vector &cmdArguments); -}; - -/** Class representing the definition of an param - * An param definition is in the form: - * */ -class ParamDef: public ASTNode -{ -public: - bool notOptional; //contradictory param not paramal :) - bool orBefore; - bool independent; - std::vector arguments; - std::vector cmdArguments; - std::vector *exclusiveGroup; - int counter; ///< for count the number of times it appears in command line - - CommentList comments; - StringVector aliases; - StringVector requirements; - - //Empty constructor - ParamDef(ArgLexer *lexer, ASTNode * parent); - ~ParamDef(); - bool parseParamList(ArgTokenType startToken, ProgramDef * prog, StringVector ¶mList, bool addName); - bool parseArgumentList(); - virtual bool parse(); - bool checkRequires(std::stringstream & errors, ProgramDef * prog); - virtual void check(std::stringstream & errors); - bool containsArgument(const String & argName); - ArgumentDef * findArgument(const String & argName); - bool containsAlias(const String & alias); -}; - -class SectionDef: public ASTNode -{ -public: - CommentList comments; - std::vector params; ///< All params defined for the program. - - SectionDef(ArgLexer * lexer, ASTNode * parent); - ~SectionDef(); - virtual bool parse(); - virtual void check(std::stringstream & errors) - { - } - ///Add a param to the section - void addParamDef(ParamDef * param); -}; - -class ProgramDef: public ASTNode -{ -private: - std::vector *exclusiveGroup; -public: - std::vector sections; - CommentList usageComments; ///< comments of usage - CommentList examples; ///< examples of use - std::map paramsMap; ///< Dictionary with all params and alias names - StringVector pendingRequires; ///< This is for checking that requires names exists - String keywords; - String seeAlso; - ///This flag is used to check if an independent option was found like: --more, --help - ///that avoid others options restrictions. - bool singleOption; - - ProgramDef(); - ~ProgramDef(); - virtual bool parse(); - virtual void check(std::stringstream & errors); - ParamDef * findParam(const String ¶m); - /** Find a param and if not provided in cmd line, fill with its defaults values */ - ParamDef * findAndFillParam(const String ¶m); - const char * getParam(const char * paramName, size_t paramNumber = 0); - const char * getParam(const char * paramName, const char * subParam, size_t paramNumber = 0); - void addParamName(const String & name, ParamDef *param); - void addParamRequires(const String &name); - void addParamExclusiveGroup(ParamDef * param); - ///clear read arguments - void clear(); - /// Read and validate commmand line - void read(int argc, const char ** argv, bool reportErrors = true); - /// Add a section to the program definition - /// and return a pointer to it, useful for manually - SectionDef * addSection(String sectionName, int visibility = 0); - -}; - -/** @} */ -#endif /* ARGSPARSER_H_ */ diff --git a/src/core/argsprinter.cpp b/src/core/argsprinter.cpp deleted file mode 100644 index 303763b..0000000 --- a/src/core/argsprinter.cpp +++ /dev/null @@ -1,596 +0,0 @@ -/*************************************************************************** - * Authors: J.M de la Rosa Trevin (jmdelarosa@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your param) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include "argsprinter.h" -#include "xmipp_filename.h" -#include "xmipp_color.h" -#include "xmipp_error.h" - -//------------------- PRINTER IMPLEMENTATIONS -------------------------------- -void Printer::printToken(ArgToken * token) -{ - - std::cerr << "token: '" << token->lexeme - << "' type: " << ArgToken::typeString(token->type) - << " line: " << token->line + 1 - << " pos: " << token->start + 1 << std::endl; -} - -//--------- CONSOLE PRINTER ----------------------- -#define COLOR(x, c) (color ? colorString(x, c) : String(x)) - -ConsolePrinter::ConsolePrinter(std::ostream & out, bool color) -{ - this->pOut = &out; - this->color = color; -} - -void ConsolePrinter::printProgram(const ProgramDef &program, int v) -{ - //print program name and usage - *pOut << COLOR("PROGRAM", RED) << std::endl << " " << program.name << std::endl; - if (program.usageComments.size() > 0) - { - *pOut << COLOR("USAGE", RED) << std::endl; - for (size_t i = 0; i < program.usageComments.size(); ++i) - if (program.usageComments.visibility[i] <= v) - *pOut << " " << program.usageComments.comments[i] << std::endl; - } - //print see also - if (!program.seeAlso.empty()) - { - *pOut << COLOR("SEE ALSO", RED) << std::endl; - *pOut << " " << program.seeAlso << std::endl; - } - - //print sections and params - if (program.sections.size() > 0) - { - *pOut << COLOR("OPTIONS", RED) << std::endl; - for (size_t i = 0; i < program.sections.size(); ++i) - printSection(*program.sections[i], v); - } - //print examples - if (program.examples.size() > 0) - { - *pOut << COLOR("EXAMPLES", RED) << std::endl; - for (size_t i = 0; i < program.examples.size(); ++i) - if (program.examples.visibility[i] <= v) - { - if (program.examples.wikiVerbatim[i]) - *pOut << " " << COLOR(program.examples.comments[i].c_str(), BLUE) << std::endl; - else - *pOut << " " << program.examples.comments[i] << std::endl; - } - - } -} - -void ConsolePrinter::printSection(const SectionDef §ion, int v) -{ - if (section.visible <= v) - { - *pOut << std::endl; - if (section.name.length() > 0) - *pOut << COLOR(section.name.c_str(), RED) << std::endl; - for (size_t i = 0; i < section.params.size(); ++i) - printParam(*section.params[i], v); - } -} - -void ConsolePrinter::printRequiresList(StringVector requirements) -{ - if (!requirements.empty()) - { - *pOut << " ( requirements "; - for (size_t i = 0; i < requirements.size(); ++i) - *pOut << requirements[i] << " "; - *pOut << ")"; - } -} - -void ConsolePrinter::printParam(const ParamDef ¶m, int v) -{ - if (param.visible <= v) - { - if (param.orBefore) - *pOut << " OR" << std::endl; - - *pOut << " "; - int pColor = BLUE; - if (!param.notOptional) - { - *pOut << "["; - pColor = GREEN; - } - *pOut << COLOR(param.name.c_str(), pColor); - //print alias - for (size_t i = 0; i < param.aliases.size(); ++i) - *pOut << ", " << param.aliases[i]; - //print arguments - for (size_t i = 0; i < param.arguments.size(); ++i) - { - *pOut << " "; - printArgument(*param.arguments[i], v); - } - if (!param.notOptional) - *pOut << "]"; - - printRequiresList(param.requirements); - *pOut << std::endl; - printCommentList(param.comments, v); - - for (size_t i = 0; i < param.arguments.size(); ++i) - { - ArgumentDef &arg = *param.arguments[i]; - if (!arg.subParams.empty()) - { - *pOut << " where <" << arg.name << "> can be:" << std::endl; - for (size_t j = 0; j < arg.subParams.size(); ++j) - { - *pOut << " " << arg.subParams[j]->name; - for (size_t k = 0; k < arg.subParams[j]->arguments.size(); ++k) - { - *pOut << " "; - printArgument(*(arg.subParams[j]->arguments[k])); - } - printRequiresList(arg.subParams[j]->requirements); - *pOut << std::endl; - printCommentList(arg.subParams[j]->comments, v); - - } - } - } - - } -} - -void ConsolePrinter::printArgument(const ArgumentDef & argument, int v) -{ - *pOut << "<" << argument.name; - if (argument.hasDefault) - *pOut << "=" << argument.argDefault; - *pOut << ">"; -} - -void ConsolePrinter::printCommentList(const CommentList &comments, int v) -{ - for (size_t i = 0; i < comments.size(); ++i) - if (comments.visibility[i] <= v) - *pOut << " " << comments.comments[i] << std::endl; -} - -//------------------- TK PRINTER IMPLEMENTATIONS -------------------------------- - -TkPrinter::TkPrinter() -{ - FileName dir = getXmippPath(); - dir.append("/applications/scripts/program_gui/program_gui.py"); - output = popen(dir.c_str(), "w"); -} - -TkPrinter::~TkPrinter() -{ - pclose(output); -} - -void TkPrinter::printProgram(const ProgramDef &program, int v) -{ - // *pOut << "PROGRAM" << std::endl << " " << program.name << std::endl; - fprintf(output, "XMIPP %d.%d - %s\n", XMIPP_MAJOR, XMIPP_MINOR, program.name.c_str()); - size_t numberOfComments = 0; - for (size_t i = 0; i < program.usageComments.size(); ++i) - if (program.usageComments.visibility[i] <= v) - ++numberOfComments; - //Send number of usage lines - fprintf(output, "%d\n", (int)numberOfComments); - if (numberOfComments > 0) - { - for (size_t i = 0; i < program.usageComments.size(); ++i) - if (program.usageComments.visibility[i] <= v) - fprintf(output, "%s\n", program.usageComments.comments[i].c_str()); - } - - for (size_t i = 0; i < program.sections.size(); ++i) - printSection(*program.sections[i], v); -} - -void TkPrinter::printSection(const SectionDef §ion, int v) -{ - if (section.visible <= v) - { - //Just ignore in the GUI this section - if (section.name == " Common options ") - return; - - //if (section.name.length() > 0) - fprintf(output, "section = self.addSection('%s');\n", section.name.c_str()); - bool first_group = true; - for (size_t i = 0; i < section.params.size(); ++i) - { - if (section.params[i]->visible <= v) - { - if (!section.params[i]->orBefore) - { - const char * single = (i < section.params.size()-1 && section.params[i+1]->orBefore) ? "False" : "True"; - - if (!first_group) - fprintf(output, "section.addGroup(group);\n"); - else - first_group = false; - fprintf(output, "group = ParamsGroup(section, %s);\n", single); - - } - printParam(*section.params[i], v); - } - } - //close last open group - if (!first_group) - fprintf(output, "section.addGroup(group);\n"); - } -} - -void TkPrinter::printParam(const ParamDef ¶m, int v) -{ - if (param.visible <= v) - { - //Independent params are some kind of special ones - if (param.independent) - return; - - fprintf(output, "param = ParamWidget(group, \"%s\");\n", param.name.c_str()); - if (param.notOptional) - fprintf(output, "param.notOptional = True; \n"); - for (size_t i = 0; i < param.arguments.size(); ++i) - { - printArgument(*param.arguments[i], v); - } - //Add comments to the help - for (size_t i = 0; i < param.comments.size(); ++i) - //if (param.comments.visibility[i] <= v) - fprintf(output, "param.addCommentLine('''%s''');\n", param.comments.comments[i].c_str()); - //End with options of the param - fprintf(output, "param.endWithOptions();\n"); - - } -} - -void TkPrinter::printArgument(const ArgumentDef & argument, int v) -{ - static String paramStr = "param"; - fprintf(output, "%s.addOption(\"%s\", \"%s\", %d);\n", - paramStr.c_str(), argument.name.c_str(), argument.argDefault.c_str(), (int)argument.subParams.size()); - if (argument.subParams.size() > 0) - { - - for (size_t j = 0; j < argument.subParams.size(); ++j) - { - fprintf(output, "subparam = param.addSubParam(\"%s\");\n", - argument.subParams[j]->name.c_str()); - for (size_t i = 0; i < argument.subParams[j]->comments.size(); ++i) - fprintf(output, "subparam.addCommentLine('''%s''');\n", argument.subParams[j]->comments.comments[i].c_str()); - paramStr = "subparam"; - for (size_t k = 0; k < argument.subParams[j]->arguments.size(); ++k) - { - printArgument(*(argument.subParams[j]->arguments[k])); - } - paramStr = "param"; - } - } -} - -//--------- WIKI PRINTER ----------------------- -WikiPrinter::WikiPrinter(std::ostream & out) -{ - this->pOut = &out; -} - -void WikiPrinter::printProgram(const ProgramDef &program, int v) -{ - //print program name and usage - *pOut << "---+ !!" << program.name << " (v" << XMIPP_MAJOR <<"." << XMIPP_MINOR << ")" << std::endl; - *pOut << "%TOC%" << std::endl; - //print usage - if (program.usageComments.size() > 0) - { - *pOut << "---++ Usage" << std::endl; - for (size_t i = 0; i < program.usageComments.size(); ++i) - if (program.usageComments.wikiVerbatim[i]) - *pOut << " 
" << program.usageComments.comments[i] << "
\n"; - else - *pOut << " " << program.usageComments.comments[i] << std::endl; - } - if (!program.seeAlso.empty()) - { - *pOut << std::endl << "*See also* %BR%" << std::endl; - StringVector links; - splitString(program.seeAlso, ",", links); - for (size_t i = 0; i < links.size(); ++i) - *pOut << "[[" << links[i] << "_v" << XMIPP_MAJOR << "][" << links[i] <<"]] "; - *pOut << "%BR%" << std::endl; - } - //print sections and params - if (program.sections.size() > 0) - { - *pOut << std::endl << "*Parameters*" << std::endl; - for (size_t i = 0; i < program.sections.size(); ++i) - printSection(*program.sections[i], v); - } - //print examples - if (program.examples.size() > 0) - { - *pOut << "---++ Examples and notes" << std::endl; - bool verbatim = false; - for (size_t i = 0; i < program.examples.size(); ++i) - { - if (program.examples.wikiVerbatim[i]) - { - if (!verbatim) - { - *pOut << "
" << std::endl;
-                    verbatim = true;
-                }
-            }
-            else
-            {
-                if (verbatim)
-                {
-                    *pOut << "
" << std::endl; - verbatim = false; - } - } - *pOut << program.examples.comments[i] << std::endl; - } - if (verbatim) - *pOut << "" << std::endl; - } - //print user comments - *pOut << "---++ User's comments" << std::endl; - *pOut << "%COMMENT{type=\"tableappend\"}%" << std::endl; -} - -void WikiPrinter::printSection(const SectionDef §ion, int v) -{ - if (section.name != " Common options " - && section.visible <= v) - { - *pOut << std::endl; - String name = section.name; - trim(name); - if (name.length() > 0) - *pOut << "_" << name << "_" << std::endl; - for (size_t i = 0; i < section.params.size(); ++i) - printParam(*section.params[i], v); - } -} - -void WikiPrinter::printRequiresList(StringVector requirements) -{ - if (!requirements.empty()) - { - *pOut << " ( requirements "; - for (size_t i = 0; i < requirements.size(); ++i) - *pOut << requirements[i] << " "; - *pOut << ")"; - } -} - -void WikiPrinter::printParam(const ParamDef ¶m, int v) -{ - //* =%BLUE%-i [selfile] %ENDCOLOR%= This file contains all the images that are to build the 3D reconstruction - //* =%GREEN% -o [output file root name] %ENDCOLOR%= If you don't supply this parameter, the same as the input selection one is taken without extension. If you give, for instance, =-o art0001= the following files are created: - if (param.visible <= v) - { - *pOut << " $"; - - if (param.orBefore) - *pOut << " or"; - - String color = param.notOptional ? "BLUE" : "GREEN"; - - *pOut << " =%" << color << "%" << param.name; - //print alias - for (size_t i = 0; i < param.aliases.size(); ++i) - *pOut << ", " << param.aliases[i]; - //print arguments - for (size_t i = 0; i < param.arguments.size(); ++i) - { - *pOut << " "; - printArgument(*param.arguments[i], v); - } - *pOut << " %ENDCOLOR%="; - printRequiresList(param.requirements); - *pOut <<": " ; - printCommentList(param.comments, v); - - if (param.comments.size() == 0) - *pOut << "%BR%" << std::endl; - - for (size_t i = 0; i < param.arguments.size(); ++i) - { - ArgumentDef &arg = *param.arguments[i]; - if (!arg.subParams.empty()) - { - *pOut << " where <" << arg.name << "> can be:" << std::endl; - for (size_t j = 0; j < arg.subParams.size(); ++j) - { - *pOut << " * %MAROON% " << arg.subParams[j]->name; - for (size_t k = 0; k < arg.subParams[j]->arguments.size(); ++k) - { - *pOut << " "; - printArgument(*(arg.subParams[j]->arguments[k]), v); - } - *pOut << " %ENDCOLOR%" << std::endl; - printRequiresList(arg.subParams[j]->requirements); - // *pOut << std::endl; - printCommentList(arg.subParams[j]->comments, v); - - } - } - } - - } -} - -void WikiPrinter::printArgument(const ArgumentDef & argument, int v) -{ - *pOut << "<" << argument.name; - if (argument.hasDefault) - *pOut << "=" << argument.argDefault; - *pOut << ">"; -} - -void WikiPrinter::printCommentList(const CommentList &comments, int v) -{ - *pOut << " "; - for (size_t i = 0; i < comments.size(); ++i) - if (comments.visibility[i] <= v) - *pOut << comments.comments[i] << " "; - *pOut << "%BR%" << std::endl; -} - -//------------------- PROTOCOL PRINTER IMPLEMENTATIONS -------------------------------- - -bool matchArgInList(const String &argName, size_t n, const char** list) -{ - for (size_t i = 0; i < n; ++i) - if (argName.find(list[i]) != String::npos) - return true; - return false; -} - -bool isArgFile(const String &argName) -{ - const char* list[3] = - {"file", "metadata", "selfile" - }; - return matchArgInList(argName, 3, - list); -} - -//------------------- AUTOCOMPLETE PRINTER IMPLEMENTATIONS -------------------------------- - - -AutocompletePrinter::AutocompletePrinter(const char * scriptfile, bool programGui) -{ - output = fopen(scriptfile, "a"); - if (output == NULL) - REPORT_ERROR(ERR_IO, "Couldn't open file to write program autocomplete script"); -} - -AutocompletePrinter::~AutocompletePrinter() -{ - fclose(output); -} - - -void AutocompletePrinter::printProgram(const ProgramDef &program, int v) -{ - - const char * progStr = program.name.c_str(); - fprintf(output, "_%s()\n", progStr); - fprintf(output, "{ \n"); - fprintf(output, "local cur prev opts base \n"); - fprintf(output, "COMPREPLY=() \n"); - fprintf(output, "cur=\"${COMP_WORDS[COMP_CWORD]}\" \n"); - fprintf(output, "prev=\"${COMP_WORDS[COMP_CWORD-1]}\" \n"); - - StringVector::const_iterator iter; - std::vector::const_iterator siter; - std::vector::const_iterator piter; - - String opts = ""; - fprintf(output, "# Autocomplete options: \n"); - fprintf(output, "case \"${prev}\" in\n"); - - for (siter = program.sections.begin(); siter != program.sections.end(); siter++) - { - SectionDef §ion = **siter; - if (section.visible < v) - { - for (piter = section.params.begin(); piter != section.params.end(); ++piter) - { - ParamDef ¶m = **piter; - opts += param.name + " "; - for (iter = param.aliases.begin(); iter != param.aliases.end(); iter++) - opts += *iter + " "; - printParam(param, v); - } - } - } - - fprintf(output, " *)\n ;;\nesac\n"); - - fprintf(output, "# Options: \n"); - fprintf(output, "opts=\"%s\" \n", opts.c_str()); - - fprintf(output, "COMPREPLY=($(compgen -W \"${opts}\" -- ${cur}))\n"); - fprintf(output, "return 0 \n"); - fprintf(output, "} \n"); - - fprintf(output, "complete -o bashdefault -o default -o filenames -F _%s %s \n", - progStr, progStr); - -} - -void AutocompletePrinter::printSection(const SectionDef §ion, int v) -{} - -void AutocompletePrinter::printParam(const ParamDef ¶m, int v) -{ - String caseStr = param.name; - StringVector::const_iterator iter; - - for (iter = param.aliases.begin(); iter != param.aliases.end(); iter++) - caseStr += " | " + *iter; - fprintf(output, " %s)\n", caseStr.c_str()); - - if (param.arguments.size()) - { - ArgumentDef &arg = *(param.arguments[0]); - if (!arg.subParams.empty()) - { - String where_opts = ""; - for (size_t j = 0; j < arg.subParams.size(); ++j) - where_opts += arg.subParams[j]->name + " "; - fprintf(output, " local where_opts=\"%s\"\n", where_opts.c_str()); - fprintf(output, " COMPREPLY=( $(compgen -W \"${where_opts}\" -- ${cur}) )\n"); - fprintf(output, " return 0\n"); - } - else if (isArgFile(arg.name)) - fprintf(output, " return 0\n"); - } - else - fprintf(output, " COMPREPLY=()\n"); - fprintf(output, " ;;\n"); -} - -void AutocompletePrinter::printArgument(const ArgumentDef & argument, int v) -{} - -void AutocompletePrinter::printCommentList(const CommentList &comments, int v) -{} - - diff --git a/src/core/argsprinter.h b/src/core/argsprinter.h deleted file mode 100644 index 2652c3f..0000000 --- a/src/core/argsprinter.h +++ /dev/null @@ -1,120 +0,0 @@ -/*************************************************************************** - * Authors: J.M.de la Rosa Trevin (jmdelarosa@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your param) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_ARGSPRINTER_H_ -#define CORE_ARGSPRINTER_H_ - -#include "argsparser.h" - -#define XMIPP_MAJOR 3 -#define XMIPP_MINOR 1 - -/**Define printers to show the arguments definitions. - * This class is abstract and only define the basic - * methods that a printer should have - */ -class Printer -{ -public: - virtual ~Printer() {} - virtual void printProgram(const ProgramDef &program, int v = 0) = 0; - virtual void printSection(const SectionDef §ion, int v = 0) = 0; - virtual void printParam(const ParamDef ¶m, int v = 0) = 0; - virtual void printArgument(const ArgumentDef & argument, int v = 0) = 0; - virtual void printCommentList(const CommentList &comments, int v = 0) = 0; - virtual void printToken(ArgToken * token); -}; - - -/** Just print to out stream */ -class ConsolePrinter: public Printer -{ -protected: - std::ostream * pOut; - void printRequiresList(StringVector requirements); -public: - bool color; - /**Constructor */ - ConsolePrinter(std::ostream &out=std::cout, bool color = true); - virtual void printProgram(const ProgramDef &program, int v = 0); - virtual void printSection(const SectionDef §ion, int v = 0); - virtual void printParam(const ParamDef ¶m, int v = 0); - virtual void printArgument(const ArgumentDef & argument, int v = 0); - virtual void printCommentList(const CommentList &comments, int v = 0); -}; - -/** Print out to create Tk GUI */ -class TkPrinter: public Printer -{ -protected: - FILE * output; -public: - /** buffer to read the command line output */ - char readbuffer[1024]; - /** Constructor */ - TkPrinter(); - ~TkPrinter(); - virtual void printProgram(const ProgramDef &program, int v = 0); - virtual void printSection(const SectionDef §ion, int v = 0); - virtual void printParam(const ParamDef ¶m, int v = 0); - virtual void printArgument(const ArgumentDef & argument, int v = 0); - virtual void printCommentList(const CommentList &comments, int v = 0){}; -}; - -/** Print wiki text */ -class WikiPrinter: public Printer -{ -protected: - std::ostream * pOut; - void printRequiresList(StringVector requirements); -public: - /**Constructor */ - WikiPrinter(std::ostream &out=std::cout); - virtual void printProgram(const ProgramDef &program, int v = 0); - virtual void printSection(const SectionDef §ion, int v = 0); - virtual void printParam(const ParamDef ¶m, int v = 0); - virtual void printArgument(const ArgumentDef & argument, int v = 0); - virtual void printCommentList(const CommentList &comments, int v = 0); -}; - -/** Print out to create Protocol header script */ -class AutocompletePrinter: public Printer -{ -protected: - FILE * output; - - -public: - /** Constructor */ - AutocompletePrinter(const char * scriptfile, bool programGui = false); - virtual ~AutocompletePrinter(); - virtual void printProgram(const ProgramDef &program, int v = 0); - virtual void printSection(const SectionDef §ion, int v = 0); - virtual void printParam(const ParamDef ¶m, int v = 0); - virtual void printArgument(const ArgumentDef & argument, int v = 0); - virtual void printCommentList(const CommentList &comments, int v = 0); -}; - -#endif /* ARGSPRINTER_H_ */ diff --git a/src/core/axis_view.h b/src/core/axis_view.h deleted file mode 100644 index cf4a340..0000000 --- a/src/core/axis_view.h +++ /dev/null @@ -1,43 +0,0 @@ -/*************************************************************************** - * - * Authors: David Strelak (davidstrelak@gmail.com) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_AXIS_VIEW_H_ -#define CORE_AXIS_VIEW_H_ - -/** - * Possible views for 3D MuldimArray - */ -typedef enum -{ - VIEW_Z_NEG, // Front view (Z negative) - VIEW_Z_POS, // Z positve - VIEW_Y_NEG, // Align -Y axis to Z axis, rotating 90 degrees around X axis"); - VIEW_Y_POS, // Align Y axis to Z axis, rotating -90 degrees around X axis"); - VIEW_X_NEG, // Align -X axis to Z axis, rotating -90 degrees around Y axis"); - VIEW_X_POS // Align X axis to Z axis, rotating 90 degrees around Y axis"); -} AxisView; - - -#endif /* CORE_AXIS_VIEW_H_ */ diff --git a/src/core/bilib/changebasis.cc b/src/core/bilib/changebasis.cc deleted file mode 100644 index ce90b18..0000000 --- a/src/core/bilib/changebasis.cc +++ /dev/null @@ -1,637 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -#include -#include - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" -#include "error.h" -#include "tboundaryconvention.h" -#include "tsplinebasis.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "changebasis.h" -#include "firconvolve.h" -#include "getpoles.h" -#include "getputd.h" -#include "getput.h" -#include "iirconvolve.h" -#include "kernel.h" -#include "messagedisplay.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -#ifdef DEBUG -#include -#include -#endif - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern int ChangeBasis - ( - double InputData[], /* data to process */ - double OutputData[], /* result */ - long SignalLength, /* signal length */ - enum TSplineBasis - FromBasis, /* input basis */ - enum TSplineBasis - ToBasis, /* output basis */ - long Degree, /* degree of the representation space */ - enum TBoundaryConvention - Convention, /* boundary convention */ - double Tolerance, /* admissible relative error */ - int *Status /* error management */ - ) - -/* change spline coefficients from a source basis into a destination basis */ -/* InputData is a (double)vector array of size SignalLength */ -/* OutputData is a (double)vector array of size SignalLength */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin ChangeBasis */ - - double *p; - double *HalfKernel = (double *)NULL, *RealPoles = (double *)NULL, *Buffer = (double *)NULL; - long KernelHalfLength, PoleNumber; - long i; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(ChangeBasis, InputData, *Status, -/**/ "No InputData") -/**/DEBUG_CHECK_NULL_POINTER(ChangeBasis, OutputData, *Status, -/**/ "No OutputData") -/**/DEBUG_CHECK_RANGE_LONG(ChangeBasis, SignalLength, 1L, LONG_MAX, *Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ChangeBasis, Degree, 0L, LONG_MAX, *Status, -/**/ "Invalid degree (should be positive)") -/**/DEBUG_CHECK_RANGE_DOUBLE(ChangeBasis, Tolerance, 0.0, DBL_MAX, *Status, -/**/ "Invalid Tolerance (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(ChangeBasis, *Status) -/**/DEBUG_WRITE_ENTERING(ChangeBasis, -/**/ "About to perform a change of basis for spline coefficients") - - switch (Convention) { - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - default: - *Status = ERROR; - WRITE_ERROR(ChangeBasis, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(ChangeBasis, "Done") - return(*Status); - } - switch (FromBasis) { - case BasicSpline: - switch (ToBasis) { - case BasicSpline: - OutputData = (double *)memcpy(OutputData, InputData, - (size_t)(SignalLength * (long)sizeof(double))); - break; - case CardinalSpline: - KernelHalfLength = Degree / 2L + 1L; - AllocateLineDouble(&HalfKernel, KernelHalfLength, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ChangeBasis, "Done") - return(*Status); - } - p = HalfKernel; - for (i = 0L; (i < KernelHalfLength); i++) { - *Status = Bspline(Degree, (double)i, p++); - if (*Status == ERROR) { - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(ChangeBasis, "Done") - return(*Status); - } - } - *Status = FirConvolveSymmetric(InputData, OutputData, SignalLength, - HalfKernel, KernelHalfLength, Convention); - if (*Status == ERROR) { - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(ChangeBasis, "Done") - return(*Status); - } - *Status = FreeLineDouble(&HalfKernel); - break; - case DualSpline: - ChangeBasis(InputData, OutputData, SignalLength, - BasicSpline, CardinalSpline, 2L * Degree + 1L, - Convention, Tolerance, Status); - break; - case OrthogonalSpline: - *Status = ERROR; - WRITE_ERROR(ChangeBasis, "Not yet implemented") - break; - default: - *Status = ERROR; - WRITE_ERROR(ChangeBasis, "Invalid destination basis") - break; - } - break; - case CardinalSpline: - switch (ToBasis) { - case BasicSpline: - switch (Degree) { - case 0L: - case 1L: - OutputData = (double *)memcpy(OutputData, InputData, - (size_t)(SignalLength * (long)sizeof(double))); - break; - default: - PoleNumber = Degree / 2L; - AllocateLineDouble(&RealPoles, PoleNumber, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ChangeBasis, "Done") - return(*Status); - } - GetBsplinePoles(RealPoles, Degree, Tolerance, Status); - if (*Status == ERROR) { - FreeLineDouble(&RealPoles); -/**/ DEBUG_WRITE_LEAVING(ChangeBasis, "Done") - return(*Status); - } - *Status = IirConvolvePoles(InputData, OutputData, SignalLength, - RealPoles, PoleNumber, Convention, Tolerance); - if (*Status == ERROR) { - FreeLineDouble(&RealPoles); -/**/ DEBUG_WRITE_LEAVING(ChangeBasis, "Done") - return(*Status); - } - *Status = FreeLineDouble(&RealPoles); - break; - } - break; - case CardinalSpline: - OutputData = (double *)memcpy(OutputData, InputData, - (size_t)(SignalLength * (long)sizeof(double))); - break; - case DualSpline: - AllocateLineDouble(&Buffer, SignalLength, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ChangeBasis, "Done") - return(*Status); - } - ChangeBasis(InputData, Buffer, SignalLength, - CardinalSpline, BasicSpline, Degree, - Convention, Tolerance, Status); - if (*Status == ERROR) { - FreeLineDouble(&Buffer); -/**/ DEBUG_WRITE_LEAVING(ChangeBasis, "Done") - return(*Status); - } - ChangeBasis(Buffer, OutputData, SignalLength, - BasicSpline, CardinalSpline, 2L * Degree + 1L, - Convention, Tolerance, Status); - if (*Status == ERROR) { - FreeLineDouble(&Buffer); -/**/ DEBUG_WRITE_LEAVING(ChangeBasis, "Done") - return(*Status); - } - *Status = FreeLineDouble(&Buffer); - break; - case OrthogonalSpline: - AllocateLineDouble(&Buffer, SignalLength, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ChangeBasis, "Done") - return(*Status); - } - ChangeBasis(InputData, Buffer, SignalLength, - CardinalSpline, BasicSpline, Degree, - Convention, Tolerance, Status); - if (*Status == ERROR) { - FreeLineDouble(&Buffer); -/**/ DEBUG_WRITE_LEAVING(ChangeBasis, "Done") - return(*Status); - } - ChangeBasis(Buffer, OutputData, SignalLength, - BasicSpline, OrthogonalSpline, Degree, - Convention, Tolerance, Status); - if (*Status == ERROR) { - FreeLineDouble(&Buffer); -/**/ DEBUG_WRITE_LEAVING(ChangeBasis, "Done") - return(*Status); - } - *Status = FreeLineDouble(&Buffer); - break; - default: - *Status = ERROR; - WRITE_ERROR(ChangeBasis, "Invalid destination basis") - break; - } - break; - case DualSpline: - switch (ToBasis) { - case BasicSpline: - ChangeBasis(InputData, OutputData, SignalLength, - CardinalSpline, BasicSpline, 2L * Degree + 1L, - Convention, Tolerance, Status); - break; - case CardinalSpline: - AllocateLineDouble(&Buffer, SignalLength, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ChangeBasis, "Done") - return(*Status); - } - ChangeBasis(InputData, Buffer, SignalLength, - CardinalSpline, BasicSpline, 2L * Degree + 1L, - Convention, Tolerance, Status); - if (*Status == ERROR) { - FreeLineDouble(&Buffer); -/**/ DEBUG_WRITE_LEAVING(ChangeBasis, "Done") - return(*Status); - } - ChangeBasis(Buffer, OutputData, SignalLength, - BasicSpline, CardinalSpline, Degree, - Convention, Tolerance, Status); - if (*Status == ERROR) { - FreeLineDouble(&Buffer); -/**/ DEBUG_WRITE_LEAVING(ChangeBasis, "Done") - return(*Status); - } - *Status = FreeLineDouble(&Buffer); - break; - case DualSpline: - OutputData = (double *)memcpy(OutputData, InputData, - (size_t)(SignalLength * (long)sizeof(double))); - break; - case OrthogonalSpline: - ChangeBasis(InputData, OutputData, SignalLength, - OrthogonalSpline, BasicSpline, Degree, - Convention, Tolerance, Status); - break; - default: - *Status = ERROR; - WRITE_ERROR(ChangeBasis, "Invalid destination basis") - break; - } - break; - case OrthogonalSpline: - switch (ToBasis) { - case BasicSpline: - *Status = ERROR; - WRITE_ERROR(ChangeBasis, "Not yet implemented") - break; - case CardinalSpline: - AllocateLineDouble(&Buffer, SignalLength, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ChangeBasis, "Done") - return(*Status); - } - ChangeBasis(InputData, Buffer, SignalLength, - OrthogonalSpline, BasicSpline, Degree, - Convention, Tolerance, Status); - if (*Status == ERROR) { - FreeLineDouble(&Buffer); -/**/ DEBUG_WRITE_LEAVING(ChangeBasis, "Done") - return(*Status); - } - ChangeBasis(Buffer, OutputData, SignalLength, - BasicSpline, CardinalSpline, Degree, - Convention, Tolerance, Status); - break; - case DualSpline: - ChangeBasis(InputData, OutputData, SignalLength, - BasicSpline, OrthogonalSpline, Degree, - Convention, Tolerance, Status); - break; - case OrthogonalSpline: - OutputData = (double *)memcpy(OutputData, InputData, - (size_t)(SignalLength * (long)sizeof(double))); - break; - default: - *Status = ERROR; - WRITE_ERROR(ChangeBasis, "Invalid destination basis") - break; - } - break; - default: - *Status = ERROR; - WRITE_ERROR(ChangeBasis, "Invalid source basis") - break; - } -/**/DEBUG_WRITE_LEAVING(ChangeBasis, "Done") - return(*Status); -} /* end ChangeBasis */ - -/*--------------------------------------------------------------------------*/ -extern int ChangeBasisVolume - ( - double *VolumeSource, /* data to process */ - double *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - enum TSplineBasis - FromBasis, /* input basis */ - enum TSplineBasis - ToBasis, /* output basis */ - long Degree, /* degree of the representation space */ - enum TBoundaryConvention - Convention, /* boundary convention */ - double Tolerance, /* admissible relative error */ - int *Status /* error management */ - ) - -/* change a volume of spline coefficients from a source basis into a destination basis */ -/* VolumeSource is a (double)volume of size (Nx x Ny x Nz) */ -/* OutputData is a (double)volume of size (Nx x Ny x Nz) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin ChangeBasisVolume */ - - double *p; - double *HalfKernel = (double *)NULL, *RealPoles = (double *)NULL; - double *Buffer; - long KernelHalfLength, PoleNumber; - long i; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(ChangeBasisVolume, VolumeSource, *Status, -/**/ "No VolumeSource") -/**/DEBUG_CHECK_NULL_POINTER(ChangeBasisVolume, VolumeDestination, *Status, -/**/ "No OutputData") -/**/DEBUG_CHECK_RANGE_LONG(ChangeBasisVolume, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ChangeBasisVolume, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ChangeBasisVolume, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ChangeBasisVolume, Degree, 0L, LONG_MAX, *Status, -/**/ "Invalid degree (should be positive)") -/**/DEBUG_CHECK_RANGE_DOUBLE(ChangeBasisVolume, Tolerance, 0.0, DBL_MAX, *Status, -/**/ "Invalid Tolerance (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(ChangeBasisVolume, *Status) -/**/DEBUG_WRITE_ENTERING(ChangeBasisVolume, -/**/ "About to perform a change of basis for a volume") - - switch (Convention) { - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - default: - *Status = ERROR; - WRITE_ERROR(ChangeBasisVolume, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(ChangeBasisVolume, "Done") - return(*Status); - } - switch (FromBasis) { - case BasicSpline: - switch (ToBasis) { - case BasicSpline: - VolumeDestination = (double *)memcpy(VolumeDestination, VolumeSource, - (size_t)(Nx * Ny * Nz * (long)sizeof(double))); - break; - case CardinalSpline: - KernelHalfLength = Degree / 2L + 1L; - AllocateLineDouble(&HalfKernel, KernelHalfLength, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ChangeBasisVolume, "Done") - return(*Status); - } - p = HalfKernel; - for (i = 0L; (i < KernelHalfLength); i++) { - *Status = Bspline(Degree, (double)i, p++); - if (*Status == ERROR) { - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(ChangeBasisVolume, "Done") - return(*Status); - } - } - *Status = FirConvolveSymmetricVolume(VolumeSource, VolumeDestination, - Nx, Ny, Nz, HalfKernel, KernelHalfLength, Convention); - if (*Status == ERROR) { - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(ChangeBasisVolume, "Done") - return(*Status); - } - *Status = FreeLineDouble(&HalfKernel); - break; - case DualSpline: - ChangeBasisVolume(VolumeSource, VolumeDestination, Nx, Ny, Nz, - BasicSpline, CardinalSpline, 2L * Degree + 1L, - Convention, Tolerance, Status); - break; - case OrthogonalSpline: - *Status = ERROR; - WRITE_ERROR(ChangeBasisVolume, "Not yet implemented") - break; - default: - *Status = ERROR; - WRITE_ERROR(ChangeBasisVolume, "Invalid destination basis") - break; - } - break; - case CardinalSpline: - switch (ToBasis) { - case BasicSpline: - switch (Degree) { - case 0L: - case 1L: - VolumeDestination = (double *)memcpy(VolumeDestination, VolumeSource, - (size_t)(Nx * Ny * Nz * (long)sizeof(double))); - break; - default: - PoleNumber = Degree / 2L; - AllocateLineDouble(&RealPoles, PoleNumber, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ChangeBasisVolume, "Done") - return(*Status); - } - GetBsplinePoles(RealPoles, Degree, Tolerance, Status); - if (*Status == ERROR) { - FreeLineDouble(&RealPoles); -/**/ DEBUG_WRITE_LEAVING(ChangeBasisVolume, "Done") - return(*Status); - } - IirConvolvePolesVolume(VolumeSource, VolumeDestination, - Nx, Ny, Nz, RealPoles, PoleNumber, Convention, Tolerance, Status); - if (*Status == ERROR) { - FreeLineDouble(&RealPoles); -/**/ DEBUG_WRITE_LEAVING(ChangeBasisVolume, "Done") - return(*Status); - } - *Status = FreeLineDouble(&RealPoles); - break; - } - break; - case CardinalSpline: - VolumeDestination = (double *)memcpy(VolumeDestination, VolumeSource, - (size_t)(Nx * Ny * Nz * (long)sizeof(double))); - break; - case DualSpline: - AllocateVolumeDouble(&Buffer, Nx, Ny, Nz, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ChangeBasisVolume, "Done") - return(*Status); - } - ChangeBasisVolume(VolumeSource, Buffer, Nx, Ny, Nz, - CardinalSpline, BasicSpline, Degree, - Convention, Tolerance, Status); - if (*Status == ERROR) { - FreeVolumeDouble(&Buffer); -/**/ DEBUG_WRITE_LEAVING(ChangeBasisVolume, "Done") - return(*Status); - } - ChangeBasisVolume(Buffer, VolumeDestination, Nx, Ny, Nz, - BasicSpline, CardinalSpline, 2L * Degree + 1L, - Convention, Tolerance, Status); - if (*Status == ERROR) { - FreeVolumeDouble(&Buffer); -/**/ DEBUG_WRITE_LEAVING(ChangeBasisVolume, "Done") - return(*Status); - } - *Status = FreeVolumeDouble(&Buffer); - break; - case OrthogonalSpline: - AllocateVolumeDouble(&Buffer, Nx, Ny, Nz, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ChangeBasisVolume, "Done") - return(*Status); - } - ChangeBasisVolume(VolumeSource, Buffer, Nx, Ny, Nz, - CardinalSpline, BasicSpline, Degree, - Convention, Tolerance, Status); - if (*Status == ERROR) { - FreeVolumeDouble(&Buffer); -/**/ DEBUG_WRITE_LEAVING(ChangeBasisVolume, "Done") - return(*Status); - } - ChangeBasisVolume(Buffer, VolumeDestination, Nx, Ny, Nz, - BasicSpline, OrthogonalSpline, Degree, - Convention, Tolerance, Status); - if (*Status == ERROR) { - FreeVolumeDouble(&Buffer); -/**/ DEBUG_WRITE_LEAVING(ChangeBasisVolume, "Done") - return(*Status); - } - *Status = FreeVolumeDouble(&Buffer); - break; - default: - *Status = ERROR; - WRITE_ERROR(ChangeBasisVolume, "Invalid destination basis") - break; - } - break; - case DualSpline: - switch (ToBasis) { - case BasicSpline: - ChangeBasisVolume(VolumeSource, VolumeDestination, Nx, Ny, Nz, - CardinalSpline, BasicSpline, 2L * Degree + 1L, - Convention, Tolerance, Status); - break; - case CardinalSpline: - AllocateVolumeDouble(&Buffer, Nx, Ny, Nz, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ChangeBasisVolume, "Done") - return(*Status); - } - ChangeBasisVolume(VolumeSource, Buffer, Nx, Ny, Nz, - CardinalSpline, BasicSpline, 2L * Degree + 1L, - Convention, Tolerance, Status); - if (*Status == ERROR) { - FreeVolumeDouble(&Buffer); -/**/ DEBUG_WRITE_LEAVING(ChangeBasisVolume, "Done") - return(*Status); - } - ChangeBasisVolume(Buffer, VolumeDestination, Nx, Ny, Nz, - BasicSpline, CardinalSpline, Degree, - Convention, Tolerance, Status); - if (*Status == ERROR) { - FreeVolumeDouble(&Buffer); -/**/ DEBUG_WRITE_LEAVING(ChangeBasisVolume, "Done") - return(*Status); - } - *Status = FreeVolumeDouble(&Buffer); - break; - case DualSpline: - VolumeDestination = (double *)memcpy(VolumeDestination, VolumeSource, - (size_t)(Nx * Ny * Nz * (long)sizeof(double))); - break; - case OrthogonalSpline: - ChangeBasisVolume(VolumeSource, VolumeDestination, Nx, Ny, Nz, - OrthogonalSpline, BasicSpline, Degree, - Convention, Tolerance, Status); - break; - default: - *Status = ERROR; - WRITE_ERROR(ChangeBasisVolume, "Invalid destination basis") - break; - } - break; - case OrthogonalSpline: - switch (ToBasis) { - case BasicSpline: - *Status = ERROR; - WRITE_ERROR(ChangeBasisVolume, "Not yet implemented") - break; - case CardinalSpline: - AllocateVolumeDouble(&Buffer, Nx, Ny, Nz, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ChangeBasisVolume, "Done") - return(*Status); - } - ChangeBasisVolume(VolumeSource, Buffer, Nx, Ny, Nz, - OrthogonalSpline, BasicSpline, Degree, - Convention, Tolerance, Status); - if (*Status == ERROR) { - FreeVolumeDouble(&Buffer); -/**/ DEBUG_WRITE_LEAVING(ChangeBasisVolume, "Done") - return(*Status); - } - ChangeBasisVolume(Buffer, VolumeDestination, Nx, Ny, Nz, - BasicSpline, CardinalSpline, Degree, - Convention, Tolerance, Status); - break; - case DualSpline: - ChangeBasisVolume(VolumeSource, VolumeDestination, Nx, Ny, Nz, - BasicSpline, OrthogonalSpline, Degree, - Convention, Tolerance, Status); - break; - case OrthogonalSpline: - VolumeDestination = (double *)memcpy(VolumeDestination, VolumeSource, - (size_t)(Nx * Ny * Nz * (long)sizeof(double))); - break; - default: - *Status = ERROR; - WRITE_ERROR(ChangeBasisVolume, "Invalid destination basis") - break; - } - break; - default: - *Status = ERROR; - WRITE_ERROR(ChangeBasisVolume, "Invalid source basis") - break; - } -/**/DEBUG_WRITE_LEAVING(ChangeBasisVolume, "Done") - return(*Status); -} /* end ChangeBasisVolume */ - diff --git a/src/core/bilib/changebasis.h b/src/core/bilib/changebasis.h deleted file mode 100644 index 402fb98..0000000 --- a/src/core/bilib/changebasis.h +++ /dev/null @@ -1,62 +0,0 @@ -#ifndef _CHANGEBASIS -#define _CHANGEBASIS - -#include "tsplinebasis.h" -#include "tboundaryconvention.h" - -/*--------------------------------------------------------------------------*/ -/**@defgroup SplineTransform Spline transform - @ingroup BilibLibrary */ -//@{ - -/** Spline transform 1D. - Change spline coefficients from a source basis into a destination basis. - InputData is a (double)vector array of size SignalLength. - OutputData is a (double)vector array of size SignalLength. - - success: return(!ERROR); failure: return(ERROR) -*/ -extern int ChangeBasis - ( - double InputData[], /* data to process */ - double OutputData[], /* result */ - long SignalLength, /* signal length */ - enum TSplineBasis - FromBasis, /* input basis */ - enum TSplineBasis - ToBasis, /* output basis */ - long Degree, /* degree of the representation space */ - enum TBoundaryConvention - Convention, /* boundary convention */ - double Tolerance, /* admissible relative error */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Spline transform 3D. - Change a volume of spline coefficients from a source basis into a - destination basis. - VolumeSource is a (double)volume of size (Nx x Ny x Nz). - OutputData is a (double)volume of size (Nx x Ny x Nz). - - success: return(!ERROR); failure: return(ERROR) -*/ -extern int ChangeBasisVolume - ( - double *VolumeSource, /* data to process */ - double *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - enum TSplineBasis - FromBasis, /* input basis */ - enum TSplineBasis - ToBasis, /* output basis */ - long Degree, /* degree of the representation space */ - enum TBoundaryConvention - Convention, /* boundary convention */ - double Tolerance, /* admissible relative error */ - int *Status /* error management */ - ); -//@} -#endif diff --git a/src/core/bilib/configs.h b/src/core/bilib/configs.h deleted file mode 100644 index 622fffc..0000000 --- a/src/core/bilib/configs.h +++ /dev/null @@ -1,94 +0,0 @@ -/***************************************************************************** - * The definition that the user may change are in between @ signs - * To modify a definition, permute the two lines that define or undefine things - ****************************************************************************/ - - -/*--- Defines ----------------------------------------------------------------*/ -/***************************************************************************** - * Undefine user-modifiable names - ****************************************************************************/ -#undef CODEWARRIOR -#undef CC -#undef GCC -#undef DEBUG - -/***************************************************************************** - * Define some constants - ****************************************************************************/ -#undef FALSE -#define FALSE ((int)(0 != 0)) -#undef TRUE -#define TRUE (!FALSE) -#undef ERROR -#define ERROR TRUE -#undef PI -#define PI ((double)3.14159265358979323846264338327950288419716939937510) - - -/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -------- User-modifiable names start here --------------------------------------- - ________________________________ */ -/* @ @ @ @ */ -/* @ @ @ @ */ -/* @ @ @ @ */ -/* @ @ @ @ @ @ @ @ @ @ @ @ */ -/* @@@ @@@ @@@ @@@ */ -/* @ @ @ @ */ - - -/***************************************************************************** - * Selection of the compiler - ****************************************************************************/ -//#define CODEWARRIOR - -/***************************************************************************** - * Selection of the debugging mode (defined or undefined) - ****************************************************************************/ -#define DEBUG -#undef DEBUG - -/***************************************************************************** - * Selection of the functions to debug - ****************************************************************************/ -/* Use "||" for an empty list */ -/* Use "|Function1|Function2|" for specific functions */ -/* Use "|*|" for every function */ -#undef DEBUG_CONTEXT -#define DEBUG_CONTEXT "|*|" - -/***************************************************************************** - * Selection of the debug level - ****************************************************************************/ -/* Use "||" for an empty list */ -/* Recognized possibilities are - "|ENTER_FUNCTION|INFO|LEAVE_FUNCTION|PERSONAL|RANGE_CHECK|WARNING|*|" */ -#undef DEBUG_LEVEL -#define DEBUG_LEVEL "|*|" - - -/* @ @ @ @ */ -/* @@@ @@@ @@@ @@@ */ -/* @ @ @ @ @ @ @ @ @ @ @ @ */ -/* @ @ @ @ */ -/* @ @ @ @ */ -/* @ @ @ @ */ -/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -------- User-modifiable names end here ----------------------------------------- - ______________________________ */ - - -/*=== Define private switches ================================================*/ -#ifdef CODEWARRIOR -#pragma ANSI_strict on -#pragma only_std_keywords on -#pragma warning_errors on -#pragma warn_emptydecl on -#pragma warn_extracomma on -#pragma warn_implicitconv on -#pragma warn_illpragma on -#pragma warn_possunwant on -#pragma warn_unusedarg on -#pragma warn_unusedvar on -#endif - diff --git a/src/core/bilib/convert.cc b/src/core/bilib/convert.cc deleted file mode 100644 index 26f03e6..0000000 --- a/src/core/bilib/convert.cc +++ /dev/null @@ -1,375 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -#include -#include -#include -#include -#include - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" -#include "error.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "convert.h" -#include "messagedisplay.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern float ConvertDoubleToFloat - ( - double Argument /* value to convert */ - ) - -/* converts a double to a float */ -/* saturation occurs when Argument generates overflow */ - -{ /* begin ConvertDoubleToFloat */ - -/**/DEBUG_WRITE_ENTERING(ConvertDoubleToFloat, -/**/ "About to convert a (double)argument to a (float)") - - if ((double)FLT_MAX < Argument) { - WRITE_WARNING(ConvertDoubleToFloat, "Positive saturation occurred") -/**/ DEBUG_WRITE_LEAVING(ConvertDoubleToFloat, "Done") - return(FLT_MAX); - } - else if (Argument < (double)(-FLT_MAX)) { - WRITE_WARNING(ConvertDoubleToFloat, "Negative saturation occurred") -/**/ DEBUG_WRITE_LEAVING(ConvertDoubleToFloat, "Done") - return(-FLT_MAX); - } - else { -#ifdef DEBUG -/**/ if ((fabs(Argument) < (double)FLT_MIN) && (Argument != 0.0)) { -/**/ WRITE_WARNING(ConvertDoubleToFloat, "Underflow occurred") -/**/ } -#endif -/**/ DEBUG_WRITE_LEAVING(ConvertDoubleToFloat, "Done") - return((float)Argument); - } -} /* end ConvertDoubleToFloat */ - -/*--------------------------------------------------------------------------*/ -extern int ConvertDoubleToInt - ( - double Argument /* value to round */ - ) - -/* rounds a double to an int */ -/* saturation occurs when Argument generates overflow */ - -{ /* begin ConvertDoubleToInt */ - - double Rounded; - -/**/DEBUG_WRITE_ENTERING(ConvertDoubleToInt, -/**/ "About to round a (double)argument to an (int)") - - if ((double)INT_MAX < Argument) { - WRITE_WARNING(ConvertDoubleToInt, "Positive saturation occurred") -/**/ DEBUG_WRITE_LEAVING(ConvertDoubleToInt, "Done") - return(INT_MAX); - } - else if (Argument < (double)INT_MIN) { - WRITE_WARNING(ConvertDoubleToInt, "Negative saturation occurred") -/**/ DEBUG_WRITE_LEAVING(ConvertDoubleToInt, "Done") - return(INT_MIN); - } - Argument += 0.5; - Rounded = (double)((long)Argument); - if ((Argument < 0.0) && (Rounded != Argument)) { - Rounded -= 1.0; - } -/**/DEBUG_WRITE_LEAVING(ConvertDoubleToInt, "Done") - return((int)Rounded); -} /* end ConvertDoubleToInt */ - -/*--------------------------------------------------------------------------*/ -extern long ConvertDoubleToLong - ( - double Argument /* value to round */ - ) - -/* rounds a double to a long */ -/* saturation occurs when Argument generates overflow */ - -{ /* begin ConvertDoubleToLong */ - - double Rounded; - -/**/DEBUG_WRITE_ENTERING(ConvertDoubleToLong, -/**/ "About to round a (double)argument to a (long)") - - if ((double)LONG_MAX < Argument) { - WRITE_WARNING(ConvertDoubleToLong, "Positive saturation occurred") -/**/ DEBUG_WRITE_LEAVING(ConvertDoubleToLong, "Done") - return(LONG_MAX); - } - else if (Argument < (double)LONG_MIN) { - WRITE_WARNING(ConvertDoubleToLong, "Negative saturation occurred") -/**/ DEBUG_WRITE_LEAVING(ConvertDoubleToLong, "Done") - return(LONG_MIN); - } - Argument += 0.5; - Rounded = (double)((long)Argument); - if ((Argument < 0.0) && (Rounded != Argument)) { - Rounded -= 1.0; - } -/**/DEBUG_WRITE_LEAVING(ConvertDoubleToLong, "Done") - return((long)Rounded); -} /* end ConvertDoubleToLong */ - -/*--------------------------------------------------------------------------*/ -extern short ConvertDoubleToShort - ( - double Argument /* value to round */ - ) - -/* rounds a double to a short */ -/* saturation occurs when Argument generates overflow */ - -{ /* begin ConvertDoubleToShort */ - - double Rounded; - -/**/DEBUG_WRITE_ENTERING(ConvertDoubleToShort, -/**/ "About to round a (double)argument to a (short)") - - if ((double)SHRT_MAX < Argument) { - WRITE_WARNING(ConvertDoubleToShort, "Positive saturation occurred") -/**/ DEBUG_WRITE_LEAVING(ConvertDoubleToShort, "Done") - return((short)SHRT_MAX); - } - else if (Argument < (double)SHRT_MIN) { - WRITE_WARNING(ConvertDoubleToShort, "Negative saturation occurred") -/**/ DEBUG_WRITE_LEAVING(ConvertDoubleToShort, "Done") - return((short)SHRT_MIN); - } - Argument += 0.5; - Rounded = (double)((long)Argument); - if ((Argument < 0.0) && (Rounded != Argument)) { - Rounded -= 1.0; - } -/**/DEBUG_WRITE_LEAVING(ConvertDoubleToShort, "Done") - return((short)Rounded); -} /* end ConvertDoubleToShort */ - -/*--------------------------------------------------------------------------*/ -extern int ConvertFloatToInt - ( - float Argument /* value to round */ - ) - -/* rounds a float to an int */ -/* saturation occurs when Argument generates overflow */ - -{ /* begin ConvertFloatToInt */ - - float Rounded; - -/**/DEBUG_WRITE_ENTERING(ConvertFloatToInt, -/**/ "About to round a (float)argument to an (int)") - - if ((double)INT_MAX < (double)Argument) { - WRITE_WARNING(ConvertFloatToInt, "Positive saturation occurred") -/**/ DEBUG_WRITE_LEAVING(ConvertFloatToInt, "Done") - return(INT_MAX); - } - else if ((double)Argument < (double)INT_MIN) { - WRITE_WARNING(ConvertFloatToInt, "Negative saturation occurred") -/**/ DEBUG_WRITE_LEAVING(ConvertFloatToInt, "Done") - return(INT_MIN); - } - Argument += 0.5F; - Rounded = (float)((long)Argument); - if ((Argument < 0.0F) && (Rounded != Argument)) { - Rounded -= 1.0F; - } -/**/DEBUG_WRITE_LEAVING(ConvertFloatToInt, "Done") - return((int)Rounded); -} /* end ConvertFloatToInt */ - -/*--------------------------------------------------------------------------*/ -extern long ConvertFloatToLong - ( - float Argument /* value to round */ - ) - -/* rounds a float to a long */ -/* saturation occurs when Argument generates overflow */ - -{ /* begin ConvertFloatToLong */ - - float Rounded; - -/**/DEBUG_WRITE_ENTERING(ConvertFloatToLong, -/**/ "About to round a (float)argument to a (long)") - - if ((double)LONG_MAX < (double)Argument) { - WRITE_WARNING(ConvertFloatToLong, "Positive saturation occurred") -/**/ DEBUG_WRITE_LEAVING(ConvertFloatToLong, "Done") - return(LONG_MAX); - } - else if ((double)Argument < (double)LONG_MIN) { - WRITE_WARNING(ConvertFloatToLong, "Negative saturation occurred") -/**/ DEBUG_WRITE_LEAVING(ConvertFloatToLong, "Done") - return(LONG_MIN); - } - Argument += 0.5F; - Rounded = (float)((long)Argument); - if ((Argument < 0.0) && (Rounded != Argument)) { - Rounded -= 1.0F; - } -/**/DEBUG_WRITE_LEAVING(ConvertFloatToLong, "Done") - return((long)Rounded); -} /* end ConvertFloatToLong */ - -/*--------------------------------------------------------------------------*/ -extern short ConvertFloatToShort - ( - float Argument /* value to round */ - ) - -/* rounds a float to a short */ -/* saturation occurs when Argument generates overflow */ - -{ /* begin ConvertFloatToShort */ - - float Rounded; - -/**/DEBUG_WRITE_ENTERING(ConvertFloatToShort, -/**/ "About to round a (float)argument to a (short)") - - if ((float)SHRT_MAX < Argument) { - WRITE_WARNING(ConvertFloatToShort, "Positive saturation occurred") -/**/ DEBUG_WRITE_LEAVING(ConvertFloatToShort, "Done") - return((short)SHRT_MAX); - } - else if (Argument < (float)SHRT_MIN) { - WRITE_WARNING(ConvertFloatToShort, "Negative saturation occurred") -/**/ DEBUG_WRITE_LEAVING(ConvertFloatToShort, "Done") - return((short)SHRT_MIN); - } - Argument += 0.5F; - Rounded = (float)((long)Argument); - if ((Argument < 0.0) && (Rounded != Argument)) { - Rounded -= 1.0F; - } -/**/DEBUG_WRITE_LEAVING(ConvertFloatToShort, "Done") - return((short)Rounded); -} /* end ConvertFloatToShort */ - -/*--------------------------------------------------------------------------*/ -extern short ConvertIntToShort - ( - int Argument /* value to convert */ - ) - -/* converts an int to a short */ -/* saturation occurs when Argument generates overflow */ - -{ /* begin ConvertIntToShort */ - -/**/DEBUG_WRITE_ENTERING(ConvertIntToShort, -/**/ "About to convert an (int)argument to a (short)") - - if (SHRT_MAX < Argument) { - WRITE_WARNING(ConvertIntToShort, "Positive saturation occurred") -/**/ DEBUG_WRITE_LEAVING(ConvertIntToShort, "Done") - return((short)SHRT_MAX); - } - else if (Argument < SHRT_MIN) { - WRITE_WARNING(ConvertIntToShort, "Negative saturation occurred") -/**/ DEBUG_WRITE_LEAVING(ConvertIntToShort, "Done") - return((short)SHRT_MIN); - } - else { -/**/ DEBUG_WRITE_LEAVING(ConvertIntToShort, "Done") - return((short)Argument); - } -} /* end ConvertIntToShort */ - -/*--------------------------------------------------------------------------*/ -extern int ConvertLongToInt - ( - long Argument /* value to convert */ - ) - -/* converts a long to an int */ -/* saturation occurs when Argument generates overflow */ - -{ /* begin ConvertLongToInt */ - -/**/DEBUG_WRITE_ENTERING(ConvertLongToInt, -/**/ "About to convert a (long)argument to an (int)") - - if ((long)INT_MAX < Argument) { - WRITE_WARNING(ConvertLongToInt, "Positive saturation occurred") -/**/ DEBUG_WRITE_LEAVING(ConvertLongToInt, "Done") - return(INT_MAX); - } - else if (Argument < (long)INT_MIN) { - WRITE_WARNING(ConvertLongToInt, "Negative saturation occurred") -/**/ DEBUG_WRITE_LEAVING(ConvertLongToInt, "Done") - return(INT_MIN); - } - else { -/**/ DEBUG_WRITE_LEAVING(ConvertLongToInt, "Done") - return((int)Argument); - } -} /* end ConvertLongToInt */ - -/*--------------------------------------------------------------------------*/ -extern short ConvertLongToShort - ( - long Argument /* value to convert */ - ) - -/* converts a long to a short */ -/* saturation occurs when Argument generates overflow */ - -{ /* begin ConvertLongToShort */ - -/**/DEBUG_WRITE_ENTERING(ConvertLongToShort, -/**/ "About to convert a (long)argument to a (short)") - - if ((long)SHRT_MAX < Argument) { - WRITE_WARNING(ConvertLongToShort, "Positive saturation occurred") -/**/ DEBUG_WRITE_LEAVING(ConvertLongToShort, "Done") - return((short)SHRT_MAX); - } - else if (Argument < (long)SHRT_MIN) { - WRITE_WARNING(ConvertLongToShort, "Negative saturation occurred") -/**/ DEBUG_WRITE_LEAVING(ConvertLongToShort, "Done") - return((short)SHRT_MIN); - } - else { -/**/ DEBUG_WRITE_LEAVING(ConvertLongToShort, "Done") - return((short)Argument); - } -} /* end ConvertLongToShort */ - diff --git a/src/core/bilib/convert.h b/src/core/bilib/convert.h deleted file mode 100644 index 505d564..0000000 --- a/src/core/bilib/convert.h +++ /dev/null @@ -1,60 +0,0 @@ -/*--------------------------------------------------------------------------*/ -extern float ConvertDoubleToFloat - ( - double Argument /* value to convert */ - ); - -/*--------------------------------------------------------------------------*/ -extern int ConvertDoubleToInt - ( - double Argument /* value to round */ - ); - -/*--------------------------------------------------------------------------*/ -extern long ConvertDoubleToLong - ( - double Argument /* value to round */ - ); - -/*--------------------------------------------------------------------------*/ -extern short ConvertDoubleToShort - ( - double Argument /* value to round */ - ); - -/*--------------------------------------------------------------------------*/ -extern int ConvertFloatToInt - ( - float Argument /* value to round */ - ); - -/*--------------------------------------------------------------------------*/ -extern long ConvertFloatToLong - ( - float Argument /* value to round */ - ); - -/*--------------------------------------------------------------------------*/ -extern short ConvertFloatToShort - ( - float Argument /* value to round */ - ); - -/*--------------------------------------------------------------------------*/ -extern short ConvertIntToShort - ( - int Argument /* value to convert */ - ); - -/*--------------------------------------------------------------------------*/ -extern int ConvertLongToInt - ( - long Argument /* value to convert */ - ); - -/*--------------------------------------------------------------------------*/ -extern short ConvertLongToShort - ( - long Argument /* value to convert */ - ); - diff --git a/src/core/bilib/debug.h b/src/core/bilib/debug.h deleted file mode 100644 index a30e272..0000000 --- a/src/core/bilib/debug.h +++ /dev/null @@ -1,353 +0,0 @@ -/*............................................................................ - Filename: debug.h - - Project: Biomedical Imaging Library - - Author: Philippe Thevenaz - Swiss Federal Institute of Technology--Lausanne - Biomedical Imaging Group - EPFL/DMT/IOA - BM-Ecublens - CH-1015 Lausanne - Switzerland - - Date: February 4, 1999 - - Purpose: Declaration of macros that deal with debug messages -............................................................................*/ - - - -/****************************************************************************/ -/* Defines */ -/****************************************************************************/ - -/*==========================================================================*/ -#ifdef DEBUG - -/*--------------------------------------------------------------------------*/ -#undef DEBUG_CHECK_NULL_POINTER -#define DEBUG_CHECK_NULL_POINTER(FunctionName, Pointer, Status, String) \ - { \ - if ((void *)Pointer == (void *)NULL) { \ - Status = ERROR; \ - if (((strstr(DEBUG_CONTEXT, "|" #FunctionName "|") != (char *)NULL) \ - || (strstr(DEBUG_CONTEXT, "|*|") != (char *)NULL)) \ - && ((strstr(DEBUG_LEVEL, "|RANGE_CHECK|") != (char *)NULL) \ - || (strstr(DEBUG_LEVEL, "|*|") != (char *)NULL))) { \ - char ErrorMessage[256]; \ - void *isValidIdentifier; \ - isValidIdentifier = (void *)(*FunctionName); \ - if (sprintf(ErrorMessage, #FunctionName " at line %ld in " \ - __FILE__ ": NULL POINTER---" #Pointer, (long)__LINE__) == EOF) \ - MessageDisplay("\a"); \ - else { \ - MessageDisplay(ErrorMessage); \ - MessageDisplay(" " String "\n"); \ - } \ - } \ - } \ - } - -/*--------------------------------------------------------------------------*/ -#undef DEBUG_CHECK_RANGE_CHAR -#define DEBUG_CHECK_RANGE_CHAR(FunctionName, CharVariable, Min, Max, Status, String) \ - { \ - if (((char)CharVariable < (char)Min) \ - || ((char)Max < (char)CharVariable)) { \ - Status = ERROR; \ - if (((strstr(DEBUG_CONTEXT, "|" #FunctionName "|") != (char *)NULL) \ - || (strstr(DEBUG_CONTEXT, "|*|") != (char *)NULL)) \ - && ((strstr(DEBUG_LEVEL, "|RANGE_CHECK|") != (char *)NULL) \ - || (strstr(DEBUG_LEVEL, "|*|") != (char *)NULL))) { \ - char ErrorMessage[256]; \ - void *isValidIdentifier; \ - isValidIdentifier = (void *)(*FunctionName); \ - if (sprintf(ErrorMessage, #FunctionName " at line %ld in " \ - __FILE__ ": INVALID CHAR---" #CharVariable " = %c", \ - (long)__LINE__, (char)CharVariable) == EOF) \ - MessageDisplay("\a"); \ - else { \ - MessageDisplay(ErrorMessage); \ - MessageDisplay(" " String "\n"); \ - } \ - } \ - } \ - } - -/*--------------------------------------------------------------------------*/ -#undef DEBUG_CHECK_RANGE_DOUBLE -#define DEBUG_CHECK_RANGE_DOUBLE(FunctionName, DoubleVariable, Min, Max, Status, String) \ - { \ - if (((double)DoubleVariable < (double)Min) \ - || ((double)Max < (double)DoubleVariable)) { \ - Status = ERROR; \ - if (((strstr(DEBUG_CONTEXT, "|" #FunctionName "|") != (char *)NULL) \ - || (strstr(DEBUG_CONTEXT, "|*|") != (char *)NULL)) \ - && ((strstr(DEBUG_LEVEL, "|RANGE_CHECK|") != (char *)NULL) \ - || (strstr(DEBUG_LEVEL, "|*|") != (char *)NULL))) { \ - char ErrorMessage[256]; \ - void *isValidIdentifier; \ - isValidIdentifier = (void *)(*FunctionName); \ - if (sprintf(ErrorMessage, #FunctionName " at line %ld in " \ - __FILE__ ": INVALID DOUBLE---" #DoubleVariable " = %E", \ - (long)__LINE__, (double)DoubleVariable) == EOF) \ - MessageDisplay("\a"); \ - else { \ - MessageDisplay(ErrorMessage); \ - MessageDisplay(" " String "\n"); \ - } \ - } \ - } \ - } - -/*--------------------------------------------------------------------------*/ -#undef DEBUG_CHECK_RANGE_FLOAT -#define DEBUG_CHECK_RANGE_FLOAT(FunctionName, FloatVariable, Min, Max, Status, String) \ - { \ - if (((float)FloatVariable < (float)Min) \ - || ((float)Max < (float)FloatVariable)) { \ - Status = ERROR; \ - if (((strstr(DEBUG_CONTEXT, "|" #FunctionName "|") != (char *)NULL) \ - || (strstr(DEBUG_CONTEXT, "|*|") != (char *)NULL)) \ - && ((strstr(DEBUG_LEVEL, "|RANGE_CHECK|") != (char *)NULL) \ - || (strstr(DEBUG_LEVEL, "|*|") != (char *)NULL))) { \ - char ErrorMessage[256]; \ - void *isValidIdentifier; \ - isValidIdentifier = (void *)(*FunctionName); \ - if (sprintf(ErrorMessage, #FunctionName " at line %ld in " \ - __FILE__ ": INVALID FLOAT---" #FloatVariable " = %E", \ - (long)__LINE__, (float)FloatVariable) == EOF) \ - MessageDisplay("\a"); \ - else { \ - MessageDisplay(ErrorMessage); \ - MessageDisplay(" " String "\n"); \ - } \ - } \ - } \ - } - -/*--------------------------------------------------------------------------*/ -#undef DEBUG_CHECK_RANGE_INT -#define DEBUG_CHECK_RANGE_INT(FunctionName, IntVariable, Min, Max, Status, String) \ - { \ - if (((int)IntVariable < (int)Min) \ - || ((int)Max < (int)IntVariable)) { \ - Status = ERROR; \ - if (((strstr(DEBUG_CONTEXT, "|" #FunctionName "|") != (char *)NULL) \ - || (strstr(DEBUG_CONTEXT, "|*|") != (char *)NULL)) \ - && ((strstr(DEBUG_LEVEL, "|RANGE_CHECK|") != (char *)NULL) \ - || (strstr(DEBUG_LEVEL, "|*|") != (char *)NULL))) { \ - char ErrorMessage[256]; \ - void *isValidIdentifier; \ - isValidIdentifier = (void *)(*FunctionName); \ - if (sprintf(ErrorMessage, #FunctionName " at line %ld in " \ - __FILE__ ": INVALID INT---" #IntVariable " = %d", \ - (long)__LINE__, (int)IntVariable) == EOF) \ - MessageDisplay("\a"); \ - else { \ - MessageDisplay(ErrorMessage); \ - MessageDisplay(" " String "\n"); \ - } \ - } \ - } \ - } - -/*--------------------------------------------------------------------------*/ -#undef DEBUG_CHECK_RANGE_LONG -#define DEBUG_CHECK_RANGE_LONG(FunctionName, LongVariable, Min, Max, Status, String) \ - { \ - if (((long)LongVariable < (long)Min) \ - || ((long)Max < (long)LongVariable)) { \ - Status = ERROR; \ - if (((strstr(DEBUG_CONTEXT, "|" #FunctionName "|") != (char *)NULL) \ - || (strstr(DEBUG_CONTEXT, "|*|") != (char *)NULL)) \ - && ((strstr(DEBUG_LEVEL, "|RANGE_CHECK|") != (char *)NULL) \ - || (strstr(DEBUG_LEVEL, "|*|") != (char *)NULL))) { \ - char ErrorMessage[256]; \ - void *isValidIdentifier; \ - isValidIdentifier = (void *)(*FunctionName); \ - if (sprintf(ErrorMessage, #FunctionName " at line %ld in " \ - __FILE__ ": INVALID LONG---" #LongVariable " = %ld", \ - (long)__LINE__, (long)LongVariable) == EOF) \ - MessageDisplay("\a"); \ - else { \ - MessageDisplay(ErrorMessage); \ - MessageDisplay(" " String "\n"); \ - } \ - } \ - } \ - } - -/*--------------------------------------------------------------------------*/ -#undef DEBUG_CHECK_RANGE_SHORT -#define DEBUG_CHECK_RANGE_SHORT(FunctionName, ShortVariable, Min, Max, Status, String) \ - { \ - if (((short)ShortVariable < (short)Min) \ - || ((short)Max < (short)ShortVariable)) { \ - Status = ERROR; \ - if (((strstr(DEBUG_CONTEXT, "|" #FunctionName "|") != (char *)NULL) \ - || (strstr(DEBUG_CONTEXT, "|*|") != (char *)NULL)) \ - && ((strstr(DEBUG_LEVEL, "|RANGE_CHECK|") != (char *)NULL) \ - || (strstr(DEBUG_LEVEL, "|*|") != (char *)NULL))) { \ - char ErrorMessage[256]; \ - void *isValidIdentifier; \ - isValidIdentifier = (void *)(*FunctionName); \ - if (sprintf(ErrorMessage, #FunctionName " at line %ld in " \ - __FILE__ ": INVALID SHORT---" #ShortVariable " = %hd", \ - (long)__LINE__, (short)ShortVariable) == EOF) \ - MessageDisplay("\a"); \ - else { \ - MessageDisplay(ErrorMessage); \ - MessageDisplay(" " String "\n"); \ - } \ - } \ - } \ - } - -/*----------------------------------------------------------------------------*/ -#undef DEBUG_RETURN_ON_ERROR -#define DEBUG_RETURN_ON_ERROR(FunctionName, Status) \ - { \ - if (Status == ERROR) \ - return(ERROR); \ - } - -/*--------------------------------------------------------------------------*/ -#undef DEBUG_WRITE_ENTERING -#define DEBUG_WRITE_ENTERING(FunctionName, String) \ - { \ - if (((strstr(DEBUG_CONTEXT, "|" #FunctionName "|") != (char *)NULL) \ - || (strstr(DEBUG_CONTEXT, "|*|") != (char *)NULL)) \ - && ((strstr(DEBUG_LEVEL, "|ENTERING_FUNCTION|") != (char *)NULL) \ - || (strstr(DEBUG_LEVEL, "|*|") != (char *)NULL))) { \ - char ErrorMessage[256]; \ - void *isValidIdentifier; \ - isValidIdentifier = (void *)(*FunctionName); \ - if (sprintf(ErrorMessage, #FunctionName " at line %ld in " \ - __FILE__ ": ENTERING---", (long)__LINE__) == EOF) \ - MessageDisplay("\a"); \ - else { \ - MessageDisplay(ErrorMessage); \ - MessageDisplay(" " String "\n"); \ - } \ - } \ - } - -/*--------------------------------------------------------------------------*/ -#undef DEBUG_WRITE_INFO -#define DEBUG_WRITE_INFO(FunctionName, String) \ - { \ - if (((strstr(DEBUG_CONTEXT, "|" #FunctionName "|") != (char *)NULL) \ - || (strstr(DEBUG_CONTEXT, "|*|") != (char *)NULL)) \ - && ((strstr(DEBUG_LEVEL, "|INFO|") != (char *)NULL) \ - || (strstr(DEBUG_LEVEL, "|*|") != (char *)NULL))) { \ - char ErrorMessage[256]; \ - void *isValidIdentifier; \ - isValidIdentifier = (void *)(*FunctionName); \ - if (sprintf(ErrorMessage, #FunctionName " at line %ld in " \ - __FILE__ ": INFO---", (long)__LINE__) == EOF) \ - MessageDisplay("\a"); \ - else { \ - MessageDisplay(ErrorMessage); \ - MessageDisplay(" " String "\n"); \ - } \ - } \ - } - -/*--------------------------------------------------------------------------*/ -#undef DEBUG_WRITE_LEAVING -#define DEBUG_WRITE_LEAVING(FunctionName, String) \ - { \ - if (((strstr(DEBUG_CONTEXT, "|" #FunctionName "|") != (char *)NULL) \ - || (strstr(DEBUG_CONTEXT, "|*|") != (char *)NULL)) \ - && ((strstr(DEBUG_LEVEL, "|LEAVING_FUNCTION|") != (char *)NULL) \ - || (strstr(DEBUG_LEVEL, "|*|") != (char *)NULL))) { \ - char ErrorMessage[256]; \ - void *isValidIdentifier; \ - isValidIdentifier = (void *)(*FunctionName); \ - if (sprintf(ErrorMessage, #FunctionName " at line %ld in " \ - __FILE__ ": LEAVING---", (long)__LINE__) == EOF) \ - MessageDisplay("\a"); \ - else { \ - MessageDisplay(ErrorMessage); \ - MessageDisplay(" " String "\n"); \ - } \ - } \ - } - -/*--------------------------------------------------------------------------*/ -#undef DEBUG_WRITE_PERSONAL -#define DEBUG_WRITE_PERSONAL(FunctionName, String) \ - { \ - if (((strstr(DEBUG_CONTEXT, "|" #FunctionName "|") != (char *)NULL) \ - || (strstr(DEBUG_CONTEXT, "|*|") != (char *)NULL)) \ - && ((strstr(DEBUG_LEVEL, "|PERSONAL|") != (char *)NULL) \ - || (strstr(DEBUG_LEVEL, "|*|") != (char *)NULL))) { \ - char ErrorMessage[256]; \ - void *isValidIdentifier; \ - isValidIdentifier = (void *)(*FunctionName); \ - if (sprintf(ErrorMessage, #FunctionName " at line %ld in " \ - __FILE__ ": PERSONAL---", (long)__LINE__) == EOF) \ - MessageDisplay("\a"); \ - else { \ - MessageDisplay(ErrorMessage); \ - MessageDisplay(" " String "\n"); \ - } \ - } \ - } - - -#else - -/*--------------------------------------------------------------------------*/ -#undef DEBUG_CHECK_NULL_POINTER -#define DEBUG_CHECK_NULL_POINTER(FunctionName, Pointer, Status, String) - -/*--------------------------------------------------------------------------*/ -#undef DEBUG_CHECK_RANGE_CHAR -#define DEBUG_CHECK_RANGE_CHAR(FunctionName, CharVariable, Min, Max, Status, String) - -/*--------------------------------------------------------------------------*/ -#undef DEBUG_CHECK_RANGE_DOUBLE -#define DEBUG_CHECK_RANGE_DOUBLE(FunctionName, DoubleVariable, Min, Max, Status, String) - -/*--------------------------------------------------------------------------*/ -#undef DEBUG_CHECK_RANGE_FLOAT -#define DEBUG_CHECK_RANGE_FLOAT(FunctionName, FloatVariable, Min, Max, Status, String) - -/*--------------------------------------------------------------------------*/ -#undef DEBUG_CHECK_RANGE_INT -#define DEBUG_CHECK_RANGE_INT(FunctionName, IntVariable, Min, Max, Status, String) - -/*--------------------------------------------------------------------------*/ -#undef DEBUG_CHECK_RANGE_LONG -#define DEBUG_CHECK_RANGE_LONG(FunctionName, LongVariable, Min, Max, Status, String) - -/*--------------------------------------------------------------------------*/ -#undef DEBUG_CHECK_RANGE_SHORT -#define DEBUG_CHECK_RANGE_SHORT(FunctionName, ShortVariable, Min, Max, Status, String) - -/*--------------------------------------------------------------------------*/ -#undef DEBUG_RETURN_ON_ERROR -#define DEBUG_RETURN_ON_ERROR(FunctionName, Status) - -/*--------------------------------------------------------------------------*/ -#undef DEBUG_WRITE_ENTERING -#define DEBUG_WRITE_ENTERING(FunctionName, String) - -/*--------------------------------------------------------------------------*/ -#undef DEBUG_WRITE_INFO -#define DEBUG_WRITE_INFO(FunctionName, String) - -/*--------------------------------------------------------------------------*/ -#undef DEBUG_WRITE_LEAVING -#define DEBUG_WRITE_LEAVING(FunctionName, String) - -/*--------------------------------------------------------------------------*/ -#undef DEBUG_WRITE_PERSONAL -#define DEBUG_WRITE_PERSONAL(FunctionName, String) - - -#endif - diff --git a/src/core/bilib/dft.cc b/src/core/bilib/dft.cc deleted file mode 100644 index ae6994a..0000000 --- a/src/core/bilib/dft.cc +++ /dev/null @@ -1,2905 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -#include -#include -#include -#include -#include - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" -#include "error.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "dft.h" -#include "dht.h" -#include "getputd.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -#include -#include -#include "messagedisplay.h" - -/***************************************************************************** - * Local defines - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -#undef FORWARD -#define FORWARD (TRUE) -#undef BACKWARD -#define BACKWARD (!FORWARD) - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -static int bufferAllocR - ( - double *(H[]), - double *(tmp[]), - double *(CaS[]), - long SignalLength - ); - -/*--------------------------------------------------------------------------*/ -static int bufferAllocRI - ( - double *(Re[]), - double *(Im[]), - double *(TmpRe[]), - double *(TmpIm[]), - double *(CaS[]), - long SignalLength - ); - -/*--------------------------------------------------------------------------*/ -static int bufferFreeR - ( - double *(H[]), - double *(tmp[]), - double *(CaS[]) - ); - -/*--------------------------------------------------------------------------*/ -static int bufferFreeRI - ( - double *(Re[]), - double *(Im[]), - double *(TmpRe[]), - double *(TmpIm[]), - double *(CaS[]) - ); - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -static int bufferAllocR - ( - double *(H[]), - double *(tmp[]), - double *(CaS[]), - long SignalLength - ) - -{ /* Begin bufferAllocR */ - - int Status = !ERROR; -/**/DEBUG_WRITE_ENTERING(bufferAllocR, -/**/ "About to execute bufferAllocR") - if (*H != (double *)NULL) { - Status = ERROR; - WRITE_ERROR(bufferAllocR, "Unexpected nonempty H") -/**/ DEBUG_WRITE_LEAVING(bufferAllocR, "Done") - return(Status); - } - *H = (double *)malloc((size_t)SignalLength * sizeof(double)); - if (*H == (double *)NULL) { - Status = ERROR; - WRITE_ERROR(bufferAllocR, "Not enough memory for H") -/**/ DEBUG_WRITE_LEAVING(bufferAllocR, "Done") - return(Status); - } - if (*tmp != (double *)NULL) { - Status = ERROR; - WRITE_ERROR(bufferAllocR, "Unexpected nonempty tmp") -/**/ DEBUG_WRITE_LEAVING(bufferAllocR, "Done") - return(Status); - } - *tmp = (double *)malloc((size_t)SignalLength * sizeof(double)); - if (*tmp == (double *)NULL) { - Status = ERROR; - WRITE_ERROR(bufferAllocR, "Not enough memory for tmp") -/**/ DEBUG_WRITE_LEAVING(bufferAllocR, "Done") - return(Status); - } - if (*CaS != (double *)NULL) { - Status = ERROR; - WRITE_ERROR(bufferAllocR, "Unexpected nonempty CaS") -/**/ DEBUG_WRITE_LEAVING(bufferAllocR, "Done") - return(Status); - } - *CaS = (double *)malloc((size_t)SignalLength * sizeof(double)); - if (*CaS == (double *)NULL) { - Status = ERROR; - WRITE_ERROR(bufferAllocR, "Not enough memory for CaS") -/**/ DEBUG_WRITE_LEAVING(bufferAllocR, "Done") - return(Status); - } -/**/DEBUG_WRITE_LEAVING(bufferAllocR, "Done") - return(Status); -} /* End bufferAllocR */ - -/*--------------------------------------------------------------------------*/ -static int bufferAllocRI - ( - double *(Re[]), - double *(Im[]), - double *(TmpRe[]), - double *(TmpIm[]), - double *(CaS[]), - long SignalLength - ) - -{ /* Begin bufferAllocRI */ - - int Status = !ERROR; - -/**/DEBUG_WRITE_ENTERING(bufferAllocRI, -/**/ "About to execute bufferAllocRI") - if (*Re != (double *)NULL) { - Status = ERROR; - WRITE_ERROR(bufferAllocRI, "Unexpected nonempty Re") -/**/ DEBUG_WRITE_LEAVING(bufferAllocRI, "Done") - return(Status); - } - *Re = (double *)malloc((size_t)SignalLength * sizeof(double)); - if (*Re == (double *)NULL) { - Status = ERROR; - WRITE_ERROR(bufferAllocRI, "Not enough memory for Re") -/**/ DEBUG_WRITE_LEAVING(bufferAllocRI, "Done") - return(Status); - } - if (*Im != (double *)NULL) { - Status = ERROR; - WRITE_ERROR(bufferAllocRI, "Unexpected nonempty Im") -/**/ DEBUG_WRITE_LEAVING(bufferAllocRI, "Done") - return(Status); - } - *Im = (double *)malloc((size_t)SignalLength * sizeof(double)); - if (*Im == (double *)NULL) { - Status = ERROR; - WRITE_ERROR(bufferAllocRI, "Not enough memory for Im") -/**/ DEBUG_WRITE_LEAVING(bufferAllocRI, "Done") - return(Status); - } - if (*TmpRe != (double *)NULL) { - Status = ERROR; - WRITE_ERROR(bufferAllocRI, "Unexpected nonempty TmpRe") -/**/ DEBUG_WRITE_LEAVING(bufferAllocRI, "Done") - return(Status); - } - *TmpRe = (double *)malloc((size_t)SignalLength * sizeof(double)); - if (*TmpRe == (double *)NULL) { - Status = ERROR; - WRITE_ERROR(bufferAllocRI, "Not enough memory for TmpRe") -/**/ DEBUG_WRITE_LEAVING(bufferAllocRI, "Done") - return(Status); - } - if (*TmpIm != (double *)NULL) { - Status = ERROR; - WRITE_ERROR(bufferAllocRI, "Unexpected nonempty TmpIm") -/**/ DEBUG_WRITE_LEAVING(bufferAllocRI, "Done") - return(Status); - } - *TmpIm = (double *)malloc((size_t)SignalLength * sizeof(double)); - if (*TmpIm == (double *)NULL) { - Status = ERROR; - WRITE_ERROR(bufferAllocRI, "Not enough memory for TmpIm") -/**/ DEBUG_WRITE_LEAVING(bufferAllocRI, "Done") - return(Status); - } - if (*CaS != (double *)NULL) { - Status = ERROR; - WRITE_ERROR(bufferAllocRI, "Unexpected nonempty CaS") -/**/ DEBUG_WRITE_LEAVING(bufferAllocRI, "Done") - return(Status); - } - *CaS = (double *)malloc((size_t)SignalLength * sizeof(double)); - if (*CaS == (double *)NULL) { - Status = ERROR; - WRITE_ERROR(bufferAllocRI, "Not enough memory for CaS") -/**/ DEBUG_WRITE_LEAVING(bufferAllocRI, "Done") - return(Status); - } -/**/DEBUG_WRITE_LEAVING(bufferAllocRI, "Done") - return(Status); -} /* End bufferAllocRI */ - -/*--------------------------------------------------------------------------*/ -static int bufferFreeR - ( - double *(H[]), - double *(tmp[]), - double *(CaS[]) - ) - -{ /* Begin bufferFreeR */ - - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(bufferFreeR, H, Status, -/**/ "Missing H") -/**/DEBUG_CHECK_NULL_POINTER(bufferFreeR, tmp, Status, -/**/ "Missing tmp") -/**/DEBUG_CHECK_NULL_POINTER(bufferFreeR, CaS, Status, -/**/ "Missing CaS") -/**/DEBUG_RETURN_ON_ERROR(bufferFreeR, Status) -/**/DEBUG_WRITE_ENTERING(bufferFreeR, -/**/ "About to execute bufferFreeR") - - free(*H); - *H = (double *)NULL; - free(*tmp); - *tmp = (double *)NULL; - free(*CaS); - *CaS = (double *)NULL; -/**/DEBUG_WRITE_LEAVING(bufferFreeR, "Done") - return(Status); -} /* End bufferFreeR */ - -/*--------------------------------------------------------------------------*/ -static int bufferFreeRI - ( - double *(Re[]), - double *(Im[]), - double *(TmpRe[]), - double *(TmpIm[]), - double *(CaS[]) - ) - -{ /* Begin bufferFreeRI */ - - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(bufferFreeRI, Re, Status, -/**/ "Missing Re") -/**/DEBUG_CHECK_NULL_POINTER(bufferFreeRI, Im, Status, -/**/ "Missing Im") -/**/DEBUG_CHECK_NULL_POINTER(bufferFreeRI, TmpRe, Status, -/**/ "Missing TmpRe") -/**/DEBUG_CHECK_NULL_POINTER(bufferFreeRI, TmpIm, Status, -/**/ "Missing TmpIm") -/**/DEBUG_CHECK_NULL_POINTER(bufferFreeRI, CaS, Status, -/**/ "Missing CaS") -/**/DEBUG_RETURN_ON_ERROR(bufferFreeRI, Status) -/**/DEBUG_WRITE_ENTERING(bufferFreeRI, -/**/ "About to execute bufferFreeRI") - - free(*Re); - *Re = (double *)NULL; - free(*Im); - *Im = (double *)NULL; - free(*TmpRe); - *TmpRe = (double *)NULL; - free(*TmpIm); - *TmpIm = (double *)NULL; - free(*CaS); - *CaS = (double *)NULL; -/**/DEBUG_WRITE_LEAVING(bufferFreeRI, "Done") - return(Status); -} /* End bufferFreeRI */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern int AmplitudePhaseToRealImaginary - ( - double Am2Re[], /* (amplitude -> real) */ - double Ph2Im[], /* (phase -> imaginary) */ - long SignalLength /* signal length */ - ) - -/* converts an (amplitude, phase) representation of a complex signal - into a (real, imaginary) representation */ -/* the input phase is in [rad] */ -/* in-place processing */ -/* the input signal (amplitude Am2Re and phase Ph2Im) is - replaced by the output signal (real Am2Re and imaginary Ph2Im) */ -/* SignalLength is the signal length */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin AmplitudePhaseToRealImaginary */ - - double Phase; - long i; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(AmplitudePhaseToRealImaginary, Am2Re, Status, -/**/ "Missing Am2Re ") -/**/DEBUG_CHECK_NULL_POINTER(AmplitudePhaseToRealImaginary, Ph2Im, Status, -/**/ "Missing Ph2Im ") -/**/DEBUG_CHECK_RANGE_LONG(AmplitudePhaseToRealImaginary, SignalLength, 1L, LONG_MAX, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(AmplitudePhaseToRealImaginary, Status) -/**/DEBUG_WRITE_ENTERING(AmplitudePhaseToRealImaginary, -/**/ "About to convert an amplitude/phase representation to a real/imaginary representation") - - for (i = -SignalLength; (i < 0L); i++) { - Phase = *Ph2Im; - *Ph2Im++ = *Am2Re * sin(Phase); - *Am2Re++ *= cos(Phase); - } -/**/DEBUG_WRITE_LEAVING(AmplitudePhaseToRealImaginary, "Done") - return(Status); -} /* end AmplitudePhaseToRealImaginary */ - -/*--------------------------------------------------------------------------*/ -extern int DftAmplitudePhaseToAmplitudePhase - ( - double Am2Am[], /* amplitude -> amplitude */ - double Ph2Ph[], /* phase -> phase */ - double *TmpRe, /* first scratch workspace */ - double *TmpIm, /* second scratch workspace */ - double CaS[], /* Hartley transform coefficients */ - long SignalLength /* signal length */ - ) - -/* computes the direct DFT of a complex signal given in (amplitude, phase) representation - and returns an (amplitude, phase) representation */ -/* the input phase is in [rad] */ -/* the output phase is in [rad]; its domain is (-PI, PI) */ -/* the origin is at index [0] */ -/* the highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] for SignalLength even */ -/* the highest coordinate (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd */ -/* the lowest coordinate -SignalLength/2 is at index [SignalLength/2] for SignalLength even */ -/* the lowest coordinate -(SignalLength-1)/2 is at index [(SignalLength+1)/2] for SignalLength odd */ -/* the coordinate -1 is at index [SignalLength-1] for SignalLength even or odd */ -/* in-place processing */ -/* the input signal (amplitude Am2Am and phase Ph2Ph) is - replaced by the output signal (amplitude Am2Am and phase Ph2Ph) */ -/* (TmpRe, TmpIm) are pre-allocated workspaces of size SignalLength each */ -/* the values returned in (TmpRe, TmpIm) are meaningless */ -/* CaS is an input array of coefficients of size SignalLength (see GetCaS function) */ -/* CaS is modified internally, but is restored when DftAmplitudePhaseToAmplitudePhase returns */ -/* SignalLength is the length of the signal */ -/* no restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5 */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin DftAmplitudePhaseToAmplitudePhase */ - - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(DftAmplitudePhaseToAmplitudePhase, Am2Am, Status, -/**/ "Missing Am2Am ") -/**/DEBUG_CHECK_NULL_POINTER(DftAmplitudePhaseToAmplitudePhase, Ph2Ph, Status, -/**/ "Missing Ph2Ph ") -/**/DEBUG_CHECK_NULL_POINTER(DftAmplitudePhaseToAmplitudePhase, TmpRe, Status, -/**/ "Missing TmpRe ") -/**/DEBUG_CHECK_NULL_POINTER(DftAmplitudePhaseToAmplitudePhase, TmpIm, Status, -/**/ "Missing TmpIm ") -/**/DEBUG_CHECK_NULL_POINTER(DftAmplitudePhaseToAmplitudePhase, CaS, Status, -/**/ "Missing CaS ") -/**/DEBUG_CHECK_RANGE_LONG(DftAmplitudePhaseToAmplitudePhase, SignalLength, 1L, LONG_MAX, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(DftAmplitudePhaseToAmplitudePhase, Status) -/**/DEBUG_WRITE_ENTERING(DftAmplitudePhaseToAmplitudePhase, -/**/ "About to compute an amplitude/phase to amplitude/phase direct Fourier transform") - - Status = AmplitudePhaseToRealImaginary(Am2Am, Ph2Ph, SignalLength); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DftAmplitudePhaseToAmplitudePhase, "Done") - return(Status); - } - Status = DftRealImaginaryToAmplitudePhase(Am2Am, Ph2Ph, TmpRe, TmpIm, CaS, - SignalLength); -/**/DEBUG_WRITE_LEAVING(DftAmplitudePhaseToAmplitudePhase, "Done") - return(Status); -} /* end DftAmplitudePhaseToAmplitudePhase */ - -/*--------------------------------------------------------------------------*/ -extern int DftAmplitudePhaseToRealImaginary - ( - double Am2Re[], /* amplitude -> real */ - double Ph2Im[], /* phase -> imaginary */ - double *TmpRe, /* first scratch workspace */ - double *TmpIm, /* second scratch workspace */ - double CaS[], /* Hartley transform coefficients */ - long SignalLength /* signal length */ - ) - -/* computes the direct DFT of a complex signal given in (amplitude, phase) representation - and returns a (real, imaginary) representation */ -/* the input phase is in [rad] */ -/* the origin is at index [0] */ -/* the highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] for SignalLength even */ -/* the highest coordinate (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd */ -/* the lowest coordinate -SignalLength/2 is at index [SignalLength/2] for SignalLength even */ -/* the lowest coordinate -(SignalLength-1)/2 is at index [(SignalLength+1)/2] for SignalLength odd */ -/* the coordinate -1 is at index [SignalLength-1] for SignalLength even or odd */ -/* in-place processing */ -/* the input signal (amplitude Am2Re and phase Ph2Im) is - replaced by the output signal (real Am2Re and imaginary Ph2Im) */ -/* (TmpRe, TmpIm) are pre-allocated workspaces of size SignalLength each */ -/* the values returned in (TmpRe, TmpIm) are meaningless */ -/* CaS is an input array of coefficients of size SignalLength (see GetCaS function) */ -/* CaS is modified internally, but is restored when DftAmplitudePhaseToRealImaginary returns */ -/* SignalLength is the length of the signal */ -/* no restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5 */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin DftAmplitudePhaseToRealImaginary */ - - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(DftAmplitudePhaseToRealImaginary, Am2Re, Status, -/**/ "Missing Am2Re ") -/**/DEBUG_CHECK_NULL_POINTER(DftAmplitudePhaseToRealImaginary, Ph2Im, Status, -/**/ "Missing Ph2Im ") -/**/DEBUG_CHECK_NULL_POINTER(DftAmplitudePhaseToRealImaginary, TmpRe, Status, -/**/ "Missing TmpRe ") -/**/DEBUG_CHECK_NULL_POINTER(DftAmplitudePhaseToRealImaginary, TmpIm, Status, -/**/ "Missing TmpIm ") -/**/DEBUG_CHECK_NULL_POINTER(DftAmplitudePhaseToRealImaginary, CaS, Status, -/**/ "Missing CaS ") -/**/DEBUG_CHECK_RANGE_LONG(DftAmplitudePhaseToRealImaginary, SignalLength, 1L, LONG_MAX, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(DftAmplitudePhaseToRealImaginary, Status) -/**/DEBUG_WRITE_ENTERING(DftAmplitudePhaseToRealImaginary, -/**/ "About to compute an amplitude/phase to real/imaginary direct Fourier transform") - - Status = AmplitudePhaseToRealImaginary(Am2Re, Ph2Im, SignalLength); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DftAmplitudePhaseToRealImaginary, "Done") - return(Status); - } - Status = DftRealImaginaryToRealImaginary(Am2Re, Ph2Im, TmpRe, TmpIm, CaS, - SignalLength); -/**/DEBUG_WRITE_LEAVING(DftAmplitudePhaseToRealImaginary, "Done") - return(Status); -} /* end DftAmplitudePhaseToRealImaginary */ - -/*--------------------------------------------------------------------------*/ -extern int DftRealImaginaryToAmplitudePhase - ( - double Re2Am[], /* real -> amplitude */ - double Im2Ph[], /* imaginary -> phase */ - double *TmpRe, /* first scratch workspace */ - double *TmpIm, /* second scratch workspace */ - double CaS[], /* Hartley transform coefficients */ - long SignalLength /* signal length */ - ) - -/* computes the direct DFT of a complex signal given in (real, imaginary) representation - and returns an (amplitude, phase) representation */ -/* the output phase is in [rad]; its domain is (-PI, PI) */ -/* the origin is at index [0] */ -/* the highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] for SignalLength even */ -/* the highest coordinate (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd */ -/* the lowest coordinate -SignalLength/2 is at index [SignalLength/2] for SignalLength even */ -/* the lowest coordinate -(SignalLength-1)/2 is at index [(SignalLength+1)/2] for SignalLength odd */ -/* the coordinate -1 is at index [SignalLength-1] for SignalLength even or odd */ -/* in-place processing */ -/* the input signal (real Re2Am and imaginary Im2Ph) is - replaced by the output signal (amplitude Re2Am and phase Im2Ph) */ -/* (TmpRe, TmpIm) are pre-allocated workspaces of size SignalLength each */ -/* the values returned in (TmpRe, TmpIm) are meaningless */ -/* CaS is an input array of coefficients of size SignalLength (see GetCaS function) */ -/* CaS is modified internally, but is restored when DftRealImaginaryToAmplitudePhase returns */ -/* SignalLength is the length of the signal */ -/* no restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5 */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin DftRealImaginaryToAmplitudePhase */ - - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(DftRealImaginaryToAmplitudePhase, Re2Am, Status, -/**/ "Missing Re2Am ") -/**/DEBUG_CHECK_NULL_POINTER(DftRealImaginaryToAmplitudePhase, Im2Ph, Status, -/**/ "Missing Im2Ph ") -/**/DEBUG_CHECK_NULL_POINTER(DftRealImaginaryToAmplitudePhase, TmpRe, Status, -/**/ "Missing TmpRe ") -/**/DEBUG_CHECK_NULL_POINTER(DftRealImaginaryToAmplitudePhase, TmpIm, Status, -/**/ "Missing TmpIm ") -/**/DEBUG_CHECK_NULL_POINTER(DftRealImaginaryToAmplitudePhase, CaS, Status, -/**/ "Missing CaS ") -/**/DEBUG_CHECK_RANGE_LONG(DftRealImaginaryToAmplitudePhase, SignalLength, 1L, LONG_MAX, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(DftRealImaginaryToAmplitudePhase, Status) -/**/DEBUG_WRITE_ENTERING(DftRealImaginaryToAmplitudePhase, -/**/ "About to compute a real/imaginary to amplitude/phase direct Fourier transform") - - Status = DftRealImaginaryToRealImaginary(Re2Am, Im2Ph, TmpRe, TmpIm, CaS, - SignalLength); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DftRealImaginaryToAmplitudePhase, "Done") - return(Status); - } - Status = RealImaginaryToAmplitudePhase(Re2Am, Im2Ph, SignalLength); -/**/DEBUG_WRITE_LEAVING(DftRealImaginaryToAmplitudePhase, "Done") - return(Status); -} /* end DftRealImaginaryToAmplitudePhase */ - -/*--------------------------------------------------------------------------*/ -extern int DftRealImaginaryToRealImaginary - ( - double Re2Re[], /* real -> real */ - double Im2Im[], /* imaginary -> imaginary */ - double *TmpRe, /* first scratch workspace */ - double *TmpIm, /* second scratch workspace */ - double CaS[], /* Hartley transform coefficients */ - long SignalLength /* signal length */ - ) - -/* computes the direct DFT of a complex signal given in (real, imaginary) representation - and returns a (real, imaginary) representation */ -/* the origin is at index [0] */ -/* the highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] for SignalLength even */ -/* the highest coordinate (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd */ -/* the lowest coordinate -SignalLength/2 is at index [SignalLength/2] for SignalLength even */ -/* the lowest coordinate -(SignalLength-1)/2 is at index [(SignalLength+1)/2] for SignalLength odd */ -/* the coordinate -1 is at index [SignalLength-1] for SignalLength even or odd */ -/* in-place processing */ -/* the input signal (real Re2Re and imaginary Im2Im) is - replaced by the output signal (real Re2Re and imaginary Im2Im) */ -/* (TmpRe, TmpIm) are pre-allocated workspaces of size SignalLength each */ -/* the values returned in (TmpRe, TmpIm) are meaningless */ -/* CaS is an input array of coefficients of size SignalLength (see GetCaS function) */ -/* CaS is modified internally, but is restored when DftRealImaginaryToRealImaginary returns */ -/* SignalLength is the length of the signal */ -/* no restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5 */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin DftRealImaginaryToRealImaginary */ - - double *ReBack, *ImBack; - long i; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(DftRealImaginaryToRealImaginary, Re2Re, Status, -/**/ "Missing Re2Re ") -/**/DEBUG_CHECK_NULL_POINTER(DftRealImaginaryToRealImaginary, Im2Im, Status, -/**/ "Missing Im2Im ") -/**/DEBUG_CHECK_NULL_POINTER(DftRealImaginaryToRealImaginary, TmpRe, Status, -/**/ "Missing TmpRe ") -/**/DEBUG_CHECK_NULL_POINTER(DftRealImaginaryToRealImaginary, TmpIm, Status, -/**/ "Missing TmpIm ") -/**/DEBUG_CHECK_NULL_POINTER(DftRealImaginaryToRealImaginary, CaS, Status, -/**/ "Missing CaS ") -/**/DEBUG_CHECK_RANGE_LONG(DftRealImaginaryToRealImaginary, SignalLength, 1L, LONG_MAX, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(DftRealImaginaryToRealImaginary, Status) -/**/DEBUG_WRITE_ENTERING(DftRealImaginaryToRealImaginary, -/**/ "About to compute a real/imaginary to real/imaginary direct Fourier transform") - - TmpRe = (double *)memcpy(TmpRe, Re2Re, (size_t)(SignalLength - * (long)sizeof(double))); - TmpIm = (double *)memcpy(TmpIm, Im2Im, (size_t)(SignalLength - * (long)sizeof(double))); - Status = DiscreteHartleyTransform(TmpRe, Re2Re, CaS, SignalLength, FORWARD); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DftRealImaginaryToRealImaginary, "Done") - return(Status); - } - Status = DiscreteHartleyTransform(TmpIm, Im2Im, CaS, SignalLength, FORWARD); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DftRealImaginaryToRealImaginary, "Done") - return(Status); - } - ReBack = TmpRe + (ptrdiff_t)(SignalLength - 1L); - ImBack = TmpIm + (ptrdiff_t)(SignalLength - 1L); - *Re2Re = *TmpRe; - *Im2Im = *TmpIm; - Re2Re += (ptrdiff_t)(SignalLength - 1L); - Im2Im += (ptrdiff_t)(SignalLength - 1L); - TmpRe++; - TmpIm++; - for (i = 1L - SignalLength; (i < 0L); i++) { - *Re2Re-- = (*TmpRe + *ReBack - *TmpIm + *ImBack) * 0.5; - *Im2Im-- = (*TmpRe++ - *ReBack-- + *TmpIm++ + *ImBack--) * 0.5; - } -/**/DEBUG_WRITE_LEAVING(DftRealImaginaryToRealImaginary, "Done") - return(Status); -} /* end DftRealImaginaryToRealImaginary */ - -/*--------------------------------------------------------------------------*/ -extern int DftRealToAmplitudePhase - ( - double Re2Am[], /* real -> amplitude */ - double PhOut[], /* output phase */ - double *Tmp, /* scratch workspace */ - double CaS[], /* Hartley transform coefficients */ - long SignalLength /* signal length */ - ) - -/* computes the direct DFT of a real signal - and returns an (amplitude, phase) representation */ -/* the output phase is in [rad]; its domain is (-PI, PI) */ -/* the origin is at index [0] */ -/* the highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] for SignalLength even */ -/* the highest coordinate (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd */ -/* the lowest coordinate -SignalLength/2 is at index [SignalLength/2] for SignalLength even */ -/* the lowest coordinate -(SignalLength-1)/2 is at index [(SignalLength+1)/2] for SignalLength odd */ -/* the coordinate -1 is at index [SignalLength-1] for SignalLength even or odd */ -/* in-place processing */ -/* the input signal (real Re2Am) is - replaced by the output signal (amplitude Re2Am and phase PhOut) */ -/* Tmp is a pre-allocated workspace of size SignalLength */ -/* the values returned in Tmp are meaningless */ -/* CaS is an input array of coefficients of size SignalLength (see GetCaS function) */ -/* CaS is modified internally, but is restored when DftRealToAmplitudePhase returns */ -/* SignalLength is the length of the signal */ -/* no restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5 */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin DftRealToAmplitudePhase */ - - double *AmForw, *PhForw; - double *AmBack, *PhBack; - double Re, Im; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(DftRealToAmplitudePhase, Re2Am, Status, -/**/ "Missing Re2Am ") -/**/DEBUG_CHECK_NULL_POINTER(DftRealToAmplitudePhase, PhOut, Status, -/**/ "Missing PhOut ") -/**/DEBUG_CHECK_NULL_POINTER(DftRealToAmplitudePhase, Tmp, Status, -/**/ "Missing Tmp ") -/**/DEBUG_CHECK_NULL_POINTER(DftRealToAmplitudePhase, CaS, Status, -/**/ "Missing CaS ") -/**/DEBUG_CHECK_RANGE_LONG(DftRealToAmplitudePhase, SignalLength, 1L, LONG_MAX, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(DftRealToAmplitudePhase, Status) -/**/DEBUG_WRITE_ENTERING(DftRealToAmplitudePhase, -/**/ "About to compute a real to amplitude/phase direct Fourier transform") - - Status = DiscreteHartleyTransform(Re2Am, Tmp, CaS, SignalLength, FORWARD); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DftRealToAmplitudePhase, "Done") - return(Status); - } - AmForw = Re2Am; - AmBack = Re2Am + (ptrdiff_t)(SignalLength - 1L); - PhForw = PhOut; - PhBack = PhOut + (ptrdiff_t)(SignalLength - 1L); - if (0.0 <= *AmForw) { - *PhForw = 0.0; - } - else { - *AmForw = -*AmForw; - *PhForw = PI; - } - PhForw++; - AmForw++; - while (AmForw < AmBack) { - Im = *AmBack - *AmForw; - Re = *AmBack + *AmForw; - *PhForw = atan2(Im, Re); - *PhBack-- = -(*PhForw++); - *AmForw = sqrt((Re * Re + Im * Im) * 0.25); - *AmBack-- = *AmForw++; - } - if (AmForw == AmBack) { - if (0.0 <= *AmForw) { - *PhForw = 0.0; - } - else { - *AmForw = -*AmForw; - *PhForw = PI; - } - } -/**/DEBUG_WRITE_LEAVING(DftRealToAmplitudePhase, "Done") - return(Status); -} /* end DftRealToAmplitudePhase */ - -/*--------------------------------------------------------------------------*/ -extern int DftRealToRealImaginary - ( - double Re2Re[], /* real -> real */ - double ImOut[], /* output imaginary */ - double *Tmp, /* scratch workspace */ - double CaS[], /* Hartley transform coefficients */ - long SignalLength /* signal length */ - ) - -/* computes the direct DFT of a real signal - and returns a (real, imaginary) representation */ -/* the origin is at index [0] */ -/* the highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] for SignalLength even */ -/* the highest coordinate (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd */ -/* the lowest coordinate -SignalLength/2 is at index [SignalLength/2] for SignalLength even */ -/* the lowest coordinate -(SignalLength-1)/2 is at index [(SignalLength+1)/2] for SignalLength odd */ -/* the coordinate -1 is at index [SignalLength-1] for SignalLength even or odd */ -/* in-place processing */ -/* the input signal (real Re2Re) is - replaced by the output signal (real Re2Re and imaginary ImOut) */ -/* Tmp is a pre-allocated workspace of size SignalLength */ -/* the values returned in Tmp are meaningless */ -/* CaS is an input array of coefficients of size SignalLength (see GetCaS function) */ -/* CaS is modified internally, but is restored when DftRealToRealImaginary returns */ -/* SignalLength is the length of the signal */ -/* no restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5 */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin DftRealToRealImaginary */ - - double *ReForw, *ImForw; - double *ReBack, *ImBack; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(DftRealToRealImaginary, Re2Re, Status, -/**/ "Missing Re2Re ") -/**/DEBUG_CHECK_NULL_POINTER(DftRealToRealImaginary, ImOut, Status, -/**/ "Missing ImOut ") -/**/DEBUG_CHECK_NULL_POINTER(DftRealToRealImaginary, Tmp, Status, -/**/ "Missing Tmp ") -/**/DEBUG_CHECK_NULL_POINTER(DftRealToRealImaginary, CaS, Status, -/**/ "Missing CaS ") -/**/DEBUG_CHECK_RANGE_LONG(DftRealToRealImaginary, SignalLength, 1L, LONG_MAX, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(DftRealToRealImaginary, Status) -/**/DEBUG_WRITE_ENTERING(DftRealToRealImaginary, -/**/ "About to compute a real to real/imaginary direct Fourier transform") - - Status = DiscreteHartleyTransform(Re2Re, Tmp, CaS, SignalLength, FORWARD); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DftRealToRealImaginary, "Done") - return(Status); - } - ReForw = Re2Re; - ReBack = Re2Re + (ptrdiff_t)(SignalLength - 1L); - ImForw = ImOut; - ImBack = ImOut + (ptrdiff_t)(SignalLength - 1L); - *ImForw++ = 0.0; - ReForw++; - while (ReForw < ReBack) { - *ImForw = (*ReBack - *ReForw) * 0.5; - *ImBack-- = -(*ImForw++); - *ReForw = (*ReBack + *ReForw) * 0.5; - *ReBack-- = *ReForw++; - } - if (ReForw == ReBack) { - *ImForw = 0.0; - } -/**/DEBUG_WRITE_LEAVING(DftRealToRealImaginary, "Done") - return(Status); -} /* end DftRealToRealImaginary */ - -/*--------------------------------------------------------------------------*/ -extern int GetCaS - ( - double CaS[], /* Hartley transform coefficients */ - long SignalLength /* signal length */ - ) - -/* computes an array of coefficients of size SignalLength */ -/* these coefficients are necessary for performing a Hartley transform */ -/* the Hartley transform is an alternate representation of Fourier for real signals */ -/* Hartley computations are more accurate (less roundoff errors) than Fourier */ -/* the same coefficients are used for direct and inverse transforms */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin GetCaS */ - - const double - s2 = sqrt(2.0), pi2 = 2.0 * PI, pi4 = PI * 0.25; - long i; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(GetCaS, CaS, Status, -/**/ "Missing CaS ") -/**/DEBUG_CHECK_RANGE_LONG(GetCaS, SignalLength, 1L, LONG_MAX, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(GetCaS, Status) -/**/DEBUG_WRITE_ENTERING(GetCaS, -/**/ "About to compute Hartley coefficients") - - for (i = 0L; (i < SignalLength); i++) { - *CaS++ = s2 * sin(pi4 + pi2 * (double)i / (double)SignalLength); - } -/**/DEBUG_WRITE_LEAVING(GetCaS, "Done") - return(Status); -} /* end GetCaS */ - -/*--------------------------------------------------------------------------*/ -extern int InvDftAmplitudePhaseToAmplitudePhase - ( - double Am2Am[], /* amplitude -> amplitude */ - double Ph2Ph[], /* phase -> phase */ - double *TmpRe, /* first scratch workspace */ - double *TmpIm, /* second scratch workspace */ - double CaS[], /* Hartley transform coefficients */ - long SignalLength /* signal length */ - ) - -/* computes the inverse DFT of a complex signal given in (amplitude, phase) representation - and returns an (amplitude, phase) representation */ -/* the input phase is in [rad] */ -/* the output phase is in [rad]; its domain is (-PI, PI) */ -/* the origin is at index [0] */ -/* the highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] for SignalLength even */ -/* the highest coordinate (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd */ -/* the lowest coordinate -SignalLength/2 is at index [SignalLength/2] for SignalLength even */ -/* the lowest coordinate -(SignalLength-1)/2 is at index [(SignalLength+1)/2] for SignalLength odd */ -/* the coordinate -1 is at index [SignalLength-1] for SignalLength even or odd */ -/* in-place processing */ -/* the input signal (amplitude Am2Am and phase Ph2Ph) is - replaced by the output signal (amplitude Am2Am and phase Ph2Ph) */ -/* (TmpRe, TmpIm) are pre-allocated workspaces of size SignalLength each */ -/* the values returned in (TmpRe, TmpIm) are meaningless */ -/* CaS is an input array of coefficients of size SignalLength (see GetCaS function) */ -/* CaS is modified internally, but is restored when DftAmplitudePhaseToAmplitudePhase returns */ -/* SignalLength is the length of the signal */ -/* no restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5 */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin InvDftAmplitudePhaseToAmplitudePhase */ - - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(InvDftAmplitudePhaseToAmplitudePhase, Am2Am, Status, -/**/ "Missing Am2Am ") -/**/DEBUG_CHECK_NULL_POINTER(InvDftAmplitudePhaseToAmplitudePhase, Ph2Ph, Status, -/**/ "Missing Ph2Ph ") -/**/DEBUG_CHECK_NULL_POINTER(InvDftAmplitudePhaseToAmplitudePhase, TmpRe, Status, -/**/ "Missing TmpRe ") -/**/DEBUG_CHECK_NULL_POINTER(InvDftAmplitudePhaseToAmplitudePhase, TmpIm, Status, -/**/ "Missing TmpIm ") -/**/DEBUG_CHECK_NULL_POINTER(InvDftAmplitudePhaseToAmplitudePhase, CaS, Status, -/**/ "Missing CaS ") -/**/DEBUG_CHECK_RANGE_LONG(InvDftAmplitudePhaseToAmplitudePhase, SignalLength, 1L, LONG_MAX, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(InvDftAmplitudePhaseToAmplitudePhase, Status) -/**/DEBUG_WRITE_ENTERING(InvDftAmplitudePhaseToAmplitudePhase, -/**/ "About to compute an amplitude/phase to amplitude/phase inverse Fourier transform") - - Status = AmplitudePhaseToRealImaginary(Am2Am, Ph2Ph, SignalLength); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(InvDftAmplitudePhaseToAmplitudePhase, "Done") - return(Status); - } - Status = InvDftRealImaginaryToAmplitudePhase(Am2Am, Ph2Ph, TmpRe, TmpIm, CaS, - SignalLength); -/**/DEBUG_WRITE_LEAVING(InvDftAmplitudePhaseToAmplitudePhase, "Done") - return(Status); -} /* end InvDftAmplitudePhaseToAmplitudePhase */ - -/*--------------------------------------------------------------------------*/ -extern int InvDftAmplitudePhaseToReal - ( - double Am2Re[], /* amplitude -> real */ - double PhIn[], /* input phase */ - double *Tmp, /* scratch workspace */ - double CaS[], /* Hartley transform coefficients */ - long SignalLength /* signal length */ - ) - -/* computes the inverse DFT of a complex signal given in (amplitude, phase) representation - and returns a real signal */ -/* the complex Fourier signal is symmetrized before the inverse transformation is applied */ -/* the input phase is in [rad] */ -/* the origin is at index [0] */ -/* the highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] for SignalLength even */ -/* the highest coordinate (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd */ -/* the lowest coordinate -SignalLength/2 is at index [SignalLength/2] for SignalLength even */ -/* the lowest coordinate -(SignalLength-1)/2 is at index [(SignalLength+1)/2] for SignalLength odd */ -/* the coordinate -1 is at index [SignalLength-1] for SignalLength even or odd */ -/* in-place processing */ -/* the input signal (amplitude Am2Re and phase PhIn) is - replaced by the output signal (real Am2Re) */ -/* Tmp is a pre-allocated workspace of size SignalLength */ -/* the values returned in Tmp are meaningless */ -/* CaS is an input array of coefficients of size SignalLength (see GetCaS function) */ -/* CaS is modified internally, but is restored when InvDftAmplitudePhaseToReal returns */ -/* SignalLength is the length of the signal */ -/* no restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5 */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin InvDftAmplitudePhaseToReal */ - - double *AmForw, *PhForw; - double *AmBack, *PhBack; - double Re, Im; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(InvDftAmplitudePhaseToReal, Am2Re, Status, -/**/ "Missing Am2Re ") -/**/DEBUG_CHECK_NULL_POINTER(InvDftAmplitudePhaseToReal, PhIn, Status, -/**/ "Missing PhIn ") -/**/DEBUG_CHECK_NULL_POINTER(InvDftAmplitudePhaseToReal, Tmp, Status, -/**/ "Missing Tmp ") -/**/DEBUG_CHECK_NULL_POINTER(InvDftAmplitudePhaseToReal, CaS, Status, -/**/ "Missing CaS ") -/**/DEBUG_CHECK_RANGE_LONG(InvDftAmplitudePhaseToReal, SignalLength, 1L, LONG_MAX, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(InvDftAmplitudePhaseToReal, Status) -/**/DEBUG_WRITE_ENTERING(InvDftAmplitudePhaseToReal, -/**/ "About to compute an amplitude/phase to real inverse Fourier transform") - - AmForw = Am2Re; - AmBack = Am2Re + (ptrdiff_t)(SignalLength - 1L); - PhForw = PhIn; - PhBack = PhIn + (ptrdiff_t)(SignalLength - 1L); - *Am2Re = *Am2Re * cos(*PhIn); - PhForw++; - AmForw++; - while (AmForw < AmBack) { - Re = *AmForw * cos(*PhForw) + *AmBack * cos(*PhBack); - Im = *AmForw * sin(*PhForw++) - *AmBack * sin(*PhBack--); - *AmForw++ = (Re - Im) * 0.5; - *AmBack-- = (Re + Im) * 0.5; - } - if (AmForw == AmBack) { - *AmForw *= cos(*PhForw); - } - Status = DiscreteHartleyTransform(Am2Re, Tmp, CaS, SignalLength, FALSE); -/**/DEBUG_WRITE_LEAVING(InvDftAmplitudePhaseToReal, "Done") - return(Status); -} /* end InvDftAmplitudePhaseToReal */ - -/*--------------------------------------------------------------------------*/ -extern int InvDftAmplitudePhaseToRealImaginary - ( - double Am2Re[], /* amplitude -> real */ - double Ph2Im[], /* phase -> imaginary */ - double *TmpRe, /* first scratch workspace */ - double *TmpIm, /* second scratch workspace */ - double CaS[], /* Hartley transform coefficients */ - long SignalLength /* signal length */ - ) - -/* computes the inverse DFT of a complex signal given in (amplitude, phase) representation - and returns a (real, imaginary) representation */ -/* the input phase is in [rad] */ -/* the origin is at index [0] */ -/* the highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] for SignalLength even */ -/* the highest coordinate (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd */ -/* the lowest coordinate -SignalLength/2 is at index [SignalLength/2] for SignalLength even */ -/* the lowest coordinate -(SignalLength-1)/2 is at index [(SignalLength+1)/2] for SignalLength odd */ -/* the coordinate -1 is at index [SignalLength-1] for SignalLength even or odd */ -/* in-place processing */ -/* the input signal (amplitude Am2Re and phase Ph2Im) is - replaced by the output signal (real Am2Re and imaginary Ph2Im) */ -/* (TmpRe, TmpIm) are pre-allocated workspaces of size SignalLength each */ -/* the values returned in (TmpRe, TmpIm) are meaningless */ -/* CaS is an input array of coefficients of size SignalLength (see GetCaS function) */ -/* CaS is modified internally, but is restored when InvDftAmplitudePhaseToRealImaginary returns */ -/* SignalLength is the length of the signal */ -/* no restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5 */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin InvDftAmplitudePhaseToRealImaginary */ - - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(InvDftAmplitudePhaseToRealImaginary, Am2Re, Status, -/**/ "Missing Am2Re ") -/**/DEBUG_CHECK_NULL_POINTER(InvDftAmplitudePhaseToRealImaginary, Ph2Im, Status, -/**/ "Missing Ph2Im ") -/**/DEBUG_CHECK_NULL_POINTER(InvDftAmplitudePhaseToRealImaginary, TmpRe, Status, -/**/ "Missing TmpRe ") -/**/DEBUG_CHECK_NULL_POINTER(InvDftAmplitudePhaseToRealImaginary, TmpIm, Status, -/**/ "Missing TmpIm ") -/**/DEBUG_CHECK_NULL_POINTER(InvDftAmplitudePhaseToRealImaginary, CaS, Status, -/**/ "Missing CaS ") -/**/DEBUG_CHECK_RANGE_LONG(InvDftAmplitudePhaseToRealImaginary, SignalLength, 1L, LONG_MAX, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(InvDftAmplitudePhaseToRealImaginary, Status) -/**/DEBUG_WRITE_ENTERING(InvDftAmplitudePhaseToRealImaginary, -/**/ "About to compute an amplitude/phase to real/imaginary inverse Fourier transform") - - Status = AmplitudePhaseToRealImaginary(Am2Re, Ph2Im, SignalLength); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(InvDftAmplitudePhaseToRealImaginary, "Done") - return(Status); - } - Status = InvDftRealImaginaryToRealImaginary(Am2Re, Ph2Im, TmpRe, TmpIm, CaS, - SignalLength); -/**/DEBUG_WRITE_LEAVING(InvDftAmplitudePhaseToRealImaginary, "Done") - return(Status); -} /* end InvDftAmplitudePhaseToRealImaginary */ - -/*--------------------------------------------------------------------------*/ -extern int InvDftRealImaginaryToAmplitudePhase - ( - double Re2Am[], /* real -> amplitude */ - double Im2Ph[], /* imaginary -> phase */ - double *TmpRe, /* first scratch workspace */ - double *TmpIm, /* second scratch workspace */ - double CaS[], /* Hartley transform coefficients */ - long SignalLength /* signal length */ - ) - -/* computes the inverse DFT of a complex signal given in (real, imaginary) representation - and returns an (amplitude, phase) representation */ -/* the output phase is in [rad]; its domain is (-PI, PI) */ -/* the origin is at index [0] */ -/* the highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] for SignalLength even */ -/* the highest coordinate (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd */ -/* the lowest coordinate -SignalLength/2 is at index [SignalLength/2] for SignalLength even */ -/* the lowest coordinate -(SignalLength-1)/2 is at index [(SignalLength+1)/2] for SignalLength odd */ -/* the coordinate -1 is at index [SignalLength-1] for SignalLength even or odd */ -/* in-place processing */ -/* the input signal (real Re2Am and imaginary Im2Ph) is - replaced by the output signal (amplitude Re2Am and phase Im2Ph) */ -/* (TmpRe, TmpIm) are pre-allocated workspaces of size SignalLength each */ -/* the values returned in (TmpRe, TmpIm) are meaningless */ -/* CaS is an input array of coefficients of size SignalLength (see GetCaS function) */ -/* CaS is modified internally, but is restored when InvDftRealImaginaryToAmplitudePhase returns */ -/* SignalLength is the length of the signal */ -/* no restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5 */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin InvDftRealImaginaryToAmplitudePhase */ - - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(InvDftRealImaginaryToAmplitudePhase, Re2Am, Status, -/**/ "Missing Re2Am ") -/**/DEBUG_CHECK_NULL_POINTER(InvDftRealImaginaryToAmplitudePhase, Im2Ph, Status, -/**/ "Missing Im2Ph ") -/**/DEBUG_CHECK_NULL_POINTER(InvDftRealImaginaryToAmplitudePhase, TmpRe, Status, -/**/ "Missing TmpRe ") -/**/DEBUG_CHECK_NULL_POINTER(InvDftRealImaginaryToAmplitudePhase, TmpIm, Status, -/**/ "Missing TmpIm ") -/**/DEBUG_CHECK_NULL_POINTER(InvDftRealImaginaryToAmplitudePhase, CaS, Status, -/**/ "Missing CaS ") -/**/DEBUG_CHECK_RANGE_LONG(InvDftRealImaginaryToAmplitudePhase, SignalLength, 1L, LONG_MAX, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(InvDftRealImaginaryToAmplitudePhase, Status) -/**/DEBUG_WRITE_ENTERING(InvDftRealImaginaryToAmplitudePhase, -/**/ "About to compute a real/imaginary to amplitude/phase inverse Fourier transform") - - Status = InvDftRealImaginaryToRealImaginary(Re2Am, Im2Ph, TmpRe, TmpIm, CaS, - SignalLength); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(InvDftRealImaginaryToAmplitudePhase, "Done") - return(Status); - } - Status = RealImaginaryToAmplitudePhase(Re2Am, Im2Ph, SignalLength); -/**/DEBUG_WRITE_LEAVING(InvDftRealImaginaryToAmplitudePhase, "Done") - return(Status); -} /* end InvDftRealImaginaryToAmplitudePhase */ - -/*--------------------------------------------------------------------------*/ -extern int InvDftRealImaginaryToReal - ( - double Re2Re[], /* real -> real */ - double ImIn[], /* input imaginary */ - double *Tmp, /* scratch workspace */ - double CaS[], /* Hartley transform coefficients */ - long SignalLength /* signal length */ - ) - -/* computes the inverse DFT of a complex signal given in (real, imaginary) representation - and returns a real signal */ -/* the complex Fourier signal is symmetrized before the inverse transformation is applied */ -/* the origin is at index [0] */ -/* the highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] for SignalLength even */ -/* the highest coordinate (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd */ -/* the lowest coordinate -SignalLength/2 is at index [SignalLength/2] for SignalLength even */ -/* the lowest coordinate -(SignalLength-1)/2 is at index [(SignalLength+1)/2] for SignalLength odd */ -/* the coordinate -1 is at index [SignalLength-1] for SignalLength even or odd */ -/* in-place processing */ -/* the input signal (real Re2Re and imaginary ImIn) is - replaced by the output signal (real Re2Re) */ -/* Tmp is a pre-allocated workspace of size SignalLength */ -/* the values returned in Tmp are meaningless */ -/* CaS is an input array of coefficients of size SignalLength (see GetCaS function) */ -/* CaS is modified internally, but is restored when InvDftRealImaginaryToReal returns */ -/* SignalLength is the length of the signal */ -/* no restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5 */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin InvDftRealImaginaryToReal */ - - double *ReForw, *ImForw; - double *ReBack, *ImBack; - double Re, Im; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(InvDftRealImaginaryToReal, Re2Re, Status, -/**/ "Missing Re2Re ") -/**/DEBUG_CHECK_NULL_POINTER(InvDftRealImaginaryToReal, ImIn, Status, -/**/ "Missing ImIn ") -/**/DEBUG_CHECK_NULL_POINTER(InvDftRealImaginaryToReal, Tmp, Status, -/**/ "Missing Tmp ") -/**/DEBUG_CHECK_NULL_POINTER(InvDftRealImaginaryToReal, CaS, Status, -/**/ "Missing CaS ") -/**/DEBUG_CHECK_RANGE_LONG(InvDftRealImaginaryToReal, SignalLength, 1L, LONG_MAX, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(InvDftRealImaginaryToReal, Status) -/**/DEBUG_WRITE_ENTERING(InvDftRealImaginaryToReal, -/**/ "About to compute a real/imaginary to real inverse Fourier transform") - - ReForw = Re2Re; - ReBack = Re2Re + (ptrdiff_t)(SignalLength - 1L); - ImForw = ImIn; - ImBack = ImIn + (ptrdiff_t)(SignalLength - 1L); - ImForw++; - ReForw++; - while (ReForw < ReBack) { - Re = *ReForw + *ReBack; - Im = *ImForw++ - *ImBack--; - *ReForw++ = (Re - Im) * 0.5; - *ReBack-- = (Re + Im) * 0.5; - } - Status = DiscreteHartleyTransform(Re2Re, Tmp, CaS, SignalLength, BACKWARD); -/**/DEBUG_WRITE_LEAVING(InvDftRealImaginaryToReal, "Done") - return(Status); -} /* end InvDftRealImaginaryToReal */ - -/*--------------------------------------------------------------------------*/ -extern int InvDftRealImaginaryToRealImaginary - ( - double Re2Re[], /* real -> real */ - double Im2Im[], /* imaginary -> imaginary */ - double *TmpRe, /* first scratch workspace */ - double *TmpIm, /* second scratch workspace */ - double CaS[], /* Hartley transform coefficients */ - long SignalLength /* signal length */ - ) - -/* computes the inverse DFT of a complex signal given in (real, imaginary) representation - and returns a (real, imaginary) representation */ -/* the origin is at index [0] */ -/* the highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] for SignalLength even */ -/* the highest coordinate (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd */ -/* the lowest coordinate -SignalLength/2 is at index [SignalLength/2] for SignalLength even */ -/* the lowest coordinate -(SignalLength-1)/2 is at index [(SignalLength+1)/2] for SignalLength odd */ -/* the coordinate -1 is at index [SignalLength-1] for SignalLength even or odd */ -/* in-place processing */ -/* the input signal (real Re2Re and imaginary Im2Im) is - replaced by the output signal (real Re2Re and imaginary Im2Im) */ -/* (TmpRe, TmpIm) are pre-allocated workspaces of size SignalLength each */ -/* the values returned in (TmpRe, TmpIm) are meaningless */ -/* CaS is an input array of coefficients of size SignalLength (see GetCaS function) */ -/* CaS is modified internally, but is restored when InvDftRealImaginaryToRealImaginary returns */ -/* SignalLength is the length of the signal */ -/* no restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5 */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin InvDftRealImaginaryToRealImaginary */ - - double *ReBack, *ImBack; - long i; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(InvDftRealImaginaryToRealImaginary, Re2Re, Status, -/**/ "Missing Re2Re ") -/**/DEBUG_CHECK_NULL_POINTER(InvDftRealImaginaryToRealImaginary, Im2Im, Status, -/**/ "Missing Im2Im ") -/**/DEBUG_CHECK_NULL_POINTER(InvDftRealImaginaryToRealImaginary, TmpRe, Status, -/**/ "Missing TmpRe ") -/**/DEBUG_CHECK_NULL_POINTER(InvDftRealImaginaryToRealImaginary, TmpIm, Status, -/**/ "Missing TmpIm ") -/**/DEBUG_CHECK_NULL_POINTER(InvDftRealImaginaryToRealImaginary, CaS, Status, -/**/ "Missing CaS ") -/**/DEBUG_CHECK_RANGE_LONG(InvDftRealImaginaryToRealImaginary, SignalLength, 1L, LONG_MAX, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(InvDftRealImaginaryToRealImaginary, Status) -/**/DEBUG_WRITE_ENTERING(InvDftRealImaginaryToRealImaginary, -/**/ "About to compute a real/imaginary to real/imaginary inverse Fourier transform") - - TmpRe = (double *)memcpy(TmpRe, Re2Re, (size_t)(SignalLength - * (long)sizeof(double))); - TmpIm = (double *)memcpy(TmpIm, Im2Im, (size_t)(SignalLength - * (long)sizeof(double))); - Status = DiscreteHartleyTransform(TmpRe, Re2Re, CaS, SignalLength, BACKWARD); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(InvDftRealImaginaryToRealImaginary, "Done") - return(Status); - } - Status = DiscreteHartleyTransform(TmpIm, Im2Im, CaS, SignalLength, BACKWARD); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(InvDftRealImaginaryToRealImaginary, "Done") - return(Status); - } - ReBack = TmpRe + (ptrdiff_t)(SignalLength - 1L); - ImBack = TmpIm + (ptrdiff_t)(SignalLength - 1L); - *Re2Re = *TmpRe; - *Im2Im = *TmpIm; - Re2Re += (ptrdiff_t)(SignalLength - 1L); - Im2Im += (ptrdiff_t)(SignalLength - 1L); - TmpRe++; - TmpIm++; - for (i = 1L - SignalLength; (i < 0L); i++) { - *Re2Re-- = (*ReBack + *TmpRe - *ImBack + *TmpIm) * 0.5; - *Im2Im-- = (*ReBack-- - *TmpRe++ + *ImBack-- + *TmpIm++) * 0.5; - } -/**/DEBUG_WRITE_LEAVING(InvDftRealImaginaryToRealImaginary, "Done") - return(Status); -} /* end InvDftRealImaginaryToRealImaginary */ - -/*--------------------------------------------------------------------------*/ -extern int RealImaginaryToAmplitudePhase - ( - double Re2Am[], /* real -> amplitude */ - double Im2Ph[], /* imaginary -> phase */ - long SignalLength /* signal length */ - ) - -/* converts a (real, imaginary) representation of a complex signal - into an (amplitude, phase) representation */ -/* the output phase is in [rad]; its domain is (-PI, PI) */ -/* in-place processing */ -/* the input signal (real Re2Am and imaginary Im2Ph) is - replaced by the output signal (amplitude Re2Am and phase Im2Ph) */ -/* SignalLength is the signal length */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin RealImaginaryToAmplitudePhase */ - - double Phase; - long i; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(RealImaginaryToAmplitudePhase, Re2Am, Status, -/**/ "Missing Re2Am ") -/**/DEBUG_CHECK_NULL_POINTER(RealImaginaryToAmplitudePhase, Im2Ph, Status, -/**/ "Missing Im2Ph ") -/**/DEBUG_CHECK_RANGE_LONG(RealImaginaryToAmplitudePhase, SignalLength, 1L, LONG_MAX, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(RealImaginaryToAmplitudePhase, Status) -/**/DEBUG_WRITE_ENTERING(RealImaginaryToAmplitudePhase, -/**/ "About to convert a real/imaginary representation to an amplitude/phase representation") - - for (i = -SignalLength; (i < 0L); Re2Am++, i++) { - Phase = atan2(*Im2Ph, *Re2Am); - *Re2Am = sqrt(*Re2Am * *Re2Am + *Im2Ph * *Im2Ph); - *Im2Ph++ = Phase; - } -/**/DEBUG_WRITE_LEAVING(RealImaginaryToAmplitudePhase, "Done") - return(Status); -} /* end RealImaginaryToAmplitudePhase */ - -/*--------------------------------------------------------------------------*/ -extern int VolumeAmplitudePhaseToRealImaginary - ( - double Am2Re[], /* (amplitude -> real) */ - double Ph2Im[], /* (phase -> imaginary) */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz /* depth of the volume */ - ) - -/* converts an (amplitude, phase) representation of a complex signal - into a (real, imaginary) representation */ -/* the input phase is in [rad] */ -/* in-place processing */ -/* the input signal (amplitude Am2Re and phase Ph2Im) is - replaced by the output signal (real Am2Re and imaginary Ph2Im) */ -/* Nx is the width of the volume */ -/* Ny is the height of the volume */ -/* Nz is the depth of the volume */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin VolumeAmplitudePhaseToRealImaginary */ - - double Phase; - long i; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(VolumeAmplitudePhaseToRealImaginary, Am2Re, Status, -/**/ "Missing Am2Re ") -/**/DEBUG_CHECK_NULL_POINTER(VolumeAmplitudePhaseToRealImaginary, Ph2Im, Status, -/**/ "Missing Ph2Im ") -/**/DEBUG_CHECK_RANGE_LONG(VolumeAmplitudePhaseToRealImaginary, Nx, 1L, LONG_MAX, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(VolumeAmplitudePhaseToRealImaginary, Ny, 1L, LONG_MAX, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(VolumeAmplitudePhaseToRealImaginary, Nz, 1L, LONG_MAX, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(VolumeAmplitudePhaseToRealImaginary, Status) -/**/DEBUG_WRITE_ENTERING(VolumeAmplitudePhaseToRealImaginary, -/**/ "About to convert an amplitude/phase representation to a real/imaginary representation") - - for (i = -Nx * Ny * Nz; (i < 0L); i++) { - Phase = *Ph2Im; - *Ph2Im++ = (double)(*Am2Re * sin(Phase)); - *Am2Re++ *= (double)cos(Phase); - } -/**/DEBUG_WRITE_LEAVING(VolumeAmplitudePhaseToRealImaginary, "Done") - return(Status); -} /* end VolumeAmplitudePhaseToRealImaginary */ - -/*--------------------------------------------------------------------------*/ -extern int VolumeDftAmplitudePhaseToAmplitudePhase - ( - double *Am2Am, /* amplitude -> amplitude */ - double *Ph2Ph, /* phase -> phase */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - int *Status /* error management */ - ) - -/* computes the direct DFT of a complex signal given in (amplitude, phase) representation - and returns an (amplitude, phase) representation */ -/* the input phase is in [rad] */ -/* the output phase is in [rad]; its domain is (-PI, PI) */ -/* the origin is at index [0] */ -/* the highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] for SignalLength even */ -/* the highest coordinate (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd */ -/* the lowest coordinate -SignalLength/2 is at index [SignalLength/2] for SignalLength even */ -/* the lowest coordinate -(SignalLength-1)/2 is at index [(SignalLength+1)/2] for SignalLength odd */ -/* the coordinate -1 is at index [SignalLength-1] for SignalLength even or odd */ -/* no restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5 */ -/* in the explanations above, SignalLength has to be replaced by Nx, Ny, Nz */ -/* Nx is the width of the volume */ -/* Ny is the height of the volume */ -/* Nz is the depth of the volume */ -/* in-place processing */ -/* the input signal (amplitude Am2Am and phase Ph2Ph) is - replaced by the output signal (amplitude Am2Am and phase Ph2Ph) */ -/* success: return(!ERROR); failure: return(ERROR); */ -/* the returned value is duplicated in Status */ - -{ /* begin VolumeDftAmplitudePhaseToAmplitudePhase */ - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(VolumeDftAmplitudePhaseToAmplitudePhase, Am2Am, *Status, -/**/ "Missing Am2Am ") -/**/DEBUG_CHECK_NULL_POINTER(VolumeDftAmplitudePhaseToAmplitudePhase, Ph2Ph, *Status, -/**/ "Missing Ph2Ph ") -/**/DEBUG_CHECK_RANGE_LONG(VolumeDftAmplitudePhaseToAmplitudePhase, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(VolumeDftAmplitudePhaseToAmplitudePhase, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(VolumeDftAmplitudePhaseToAmplitudePhase, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(VolumeDftAmplitudePhaseToAmplitudePhase, *Status) -/**/DEBUG_WRITE_ENTERING(VolumeDftAmplitudePhaseToAmplitudePhase, -/**/ "About to compute a 3D amplitude/phase to amplitude/phase direct Fourier transform") - - *Status = VolumeAmplitudePhaseToRealImaginary(Am2Am, Ph2Ph, Nx, Ny, Nz); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(VolumeDftAmplitudePhaseToAmplitudePhase, "Done") - return(*Status); - } - VolumeDftRealImaginaryToAmplitudePhase(Am2Am, Ph2Ph, Nx, Ny, Nz, Status); -/**/DEBUG_WRITE_LEAVING(VolumeDftAmplitudePhaseToAmplitudePhase, "Done") - return(*Status); -} /* end VolumeDftAmplitudePhaseToAmplitudePhase */ - -/*--------------------------------------------------------------------------*/ -extern int VolumeDftAmplitudePhaseToRealImaginary - ( - double *Am2Re, /* amplitude -> real */ - double *Ph2Im, /* phase -> imaginary */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - int *Status /* error management */ - ) - -/* computes the direct DFT of a complex signal given in (amplitude, phase) representation - and returns a (real, imaginary) representation */ -/* the input phase is in [rad] */ -/* the origin is at index [0] */ -/* the highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] for SignalLength even */ -/* the highest coordinate (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd */ -/* the lowest coordinate -SignalLength/2 is at index [SignalLength/2] for SignalLength even */ -/* the lowest coordinate -(SignalLength-1)/2 is at index [(SignalLength+1)/2] for SignalLength odd */ -/* the coordinate -1 is at index [SignalLength-1] for SignalLength even or odd */ -/* no restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5 */ -/* in the explanations above, SignalLength has to be replaced by Nx, Ny, Nz */ -/* Nx is the width of the volume */ -/* Ny is the height of the volume */ -/* Nz is the depth of the volume */ -/* in-place processing */ -/* the input signal (amplitude Am2Re and phase Ph2Im) is - replaced by the output signal (real Am2Re and imaginary Ph2Im) */ -/* success: return(!ERROR); failure: return(ERROR); */ -/* the returned value is duplicated in Status */ - -{ /* begin VolumeDftAmplitudePhaseToRealImaginary */ - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(VolumeDftAmplitudePhaseToRealImaginary, Am2Re, *Status, -/**/ "Missing Am2Re ") -/**/DEBUG_CHECK_NULL_POINTER(VolumeDftAmplitudePhaseToRealImaginary, Ph2Im, *Status, -/**/ "Missing Ph2Im ") -/**/DEBUG_CHECK_RANGE_LONG(VolumeDftAmplitudePhaseToRealImaginary, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(VolumeDftAmplitudePhaseToRealImaginary, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(VolumeDftAmplitudePhaseToRealImaginary, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(VolumeDftAmplitudePhaseToRealImaginary, *Status) -/**/DEBUG_WRITE_ENTERING(VolumeDftAmplitudePhaseToRealImaginary, -/**/ "About to compute a 3D amplitude/phase to real/imaginary direct Fourier transform") - - *Status = VolumeAmplitudePhaseToRealImaginary(Am2Re, Ph2Im, Nx, Ny, Nz); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(VolumeDftAmplitudePhaseToRealImaginary, "Done") - return(*Status); - } - VolumeDftRealImaginaryToRealImaginary(Am2Re, Ph2Im, Nx, Ny, Nz, Status); -/**/DEBUG_WRITE_LEAVING(VolumeDftAmplitudePhaseToRealImaginary, "Done") - return(*Status); -} /* end VolumeDftAmplitudePhaseToRealImaginary */ - -/*--------------------------------------------------------------------------*/ -extern int VolumeDftRealImaginaryToAmplitudePhase - ( - double *Re2Am, /* real -> amplitude */ - double *Im2Ph, /* imaginary -> phase */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - int *Status /* error management */ - ) - -/* computes the direct DFT of a complex signal given in (real, imaginary) representation - and returns an (amplitude, phase) representation */ -/* the output phase is in [rad]; its domain is (-PI, PI) */ -/* the origin is at index [0] */ -/* the highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] for SignalLength even */ -/* the highest coordinate (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd */ -/* the lowest coordinate -SignalLength/2 is at index [SignalLength/2] for SignalLength even */ -/* the lowest coordinate -(SignalLength-1)/2 is at index [(SignalLength+1)/2] for SignalLength odd */ -/* the coordinate -1 is at index [SignalLength-1] for SignalLength even or odd */ -/* no restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5 */ -/* in the explanations above, SignalLength has to be replaced by Nx, Ny, Nz */ -/* Nx is the width of the volume */ -/* Ny is the height of the volume */ -/* Nz is the depth of the volume */ -/* in-place processing */ -/* the input signal (real Re2Am and imaginary Im2Ph) is - replaced by the output signal (amplitude Re2Am and phase Im2Ph) */ -/* success: return(!ERROR); failure: return(ERROR); */ -/* the returned value is duplicated in Status */ - -{ /* begin VolumeDftRealImaginaryToAmplitudePhase */ - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(VolumeDftRealImaginaryToAmplitudePhase, Re2Am, *Status, -/**/ "Missing Re2Am ") -/**/DEBUG_CHECK_NULL_POINTER(VolumeDftRealImaginaryToAmplitudePhase, Im2Ph, *Status, -/**/ "Missing Im2Ph ") -/**/DEBUG_CHECK_RANGE_LONG(VolumeDftRealImaginaryToAmplitudePhase, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(VolumeDftRealImaginaryToAmplitudePhase, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(VolumeDftRealImaginaryToAmplitudePhase, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(VolumeDftRealImaginaryToAmplitudePhase, *Status) -/**/DEBUG_WRITE_ENTERING(VolumeDftRealImaginaryToAmplitudePhase, -/**/ "About to compute a 3D real/imaginary to amplitude/phase direct Fourier transform") - - VolumeDftRealImaginaryToRealImaginary(Re2Am, Im2Ph, Nx, Ny, Nz, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealImaginaryToAmplitudePhase, "Done") - return(*Status); - } - *Status = VolumeRealImaginaryToAmplitudePhase(Re2Am, Im2Ph, Nx, Ny, Nz); -/**/DEBUG_WRITE_LEAVING(VolumeDftRealImaginaryToAmplitudePhase, "Done") - return(*Status); -} /* end VolumeDftRealImaginaryToAmplitudePhase */ - -/*--------------------------------------------------------------------------*/ -extern int VolumeDftRealImaginaryToRealImaginary - ( - double *Re2Re, /* real -> real */ - double *Im2Im, /* imaginary -> imaginary */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - int *Status /* error management */ - ) - -/* computes the direct DFT of a complex signal given in (real, imaginary) representation - and returns a (real, imaginary) representation */ -/* the origin is at index [0] */ -/* the highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] for SignalLength even */ -/* the highest coordinate (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd */ -/* the lowest coordinate -SignalLength/2 is at index [SignalLength/2] for SignalLength even */ -/* the lowest coordinate -(SignalLength-1)/2 is at index [(SignalLength+1)/2] for SignalLength odd */ -/* the coordinate -1 is at index [SignalLength-1] for SignalLength even or odd */ -/* no restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5 */ -/* in the explanations above, SignalLength has to be replaced by Nx, Ny, Nz */ -/* Nx is the width of the volume */ -/* Ny is the height of the volume */ -/* Nz is the depth of the volume */ -/* in-place processing */ -/* the input signal (real Re2Re and imaginary Im2Im) is - replaced by the output signal (real Re2Re and imaginary Im2Ph) */ -/* success: return(!ERROR); failure: return(ERROR); */ -/* the returned value is duplicated in Status */ - -{ /* begin VolumeDftRealImaginaryToRealImaginary */ - - double *Re = (double *)NULL, *Im = (double *)NULL; - double *TmpRe = (double *)NULL, *TmpIm = (double *)NULL; - double *CaS = (double *)NULL; - long x, y, z; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(VolumeDftRealImaginaryToRealImaginary, Re2Re, *Status, -/**/ "Missing Re2Re ") -/**/DEBUG_CHECK_NULL_POINTER(VolumeDftRealImaginaryToRealImaginary, Im2Im, *Status, -/**/ "Missing Im2Im ") -/**/DEBUG_CHECK_RANGE_LONG(VolumeDftRealImaginaryToRealImaginary, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(VolumeDftRealImaginaryToRealImaginary, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(VolumeDftRealImaginaryToRealImaginary, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(VolumeDftRealImaginaryToRealImaginary, *Status) -/**/DEBUG_WRITE_ENTERING(VolumeDftRealImaginaryToRealImaginary, -/**/ "About to compute a 3D real/imaginary to real/imaginary direct Fourier transform") - - if (Nz > 1L) { - *Status = bufferAllocRI(&Re, &Im, &TmpRe, &TmpIm, &CaS, Nz); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - *Status = GetCaS(CaS, Nz); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - for (y = 0L; (y < Ny); y++) { - for (x = 0L; (x < Nx); x++) { - *Status = GetzDoubleToDouble(Re2Re, Nx, Ny, Nz, x, y, 0L, Re, Nz); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - *Status = GetzDoubleToDouble(Im2Im, Nx, Ny, Nz, x, y, 0L, Im, Nz); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - *Status = DftRealImaginaryToRealImaginary(Re, Im, TmpRe, TmpIm, CaS, Nz); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - *Status = PutzDoubleToDouble(Re2Re, Nx, Ny, Nz, x, y, 0L, Re, Nz); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - *Status = PutzDoubleToDouble(Im2Im, Nx, Ny, Nz, x, y, 0L, Im, Nz); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - } - } - *Status = bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - } - if (Ny > 1L) { - *Status = bufferAllocRI(&Re, &Im, &TmpRe, &TmpIm, &CaS, Ny); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - *Status = GetCaS(CaS, Ny); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - for (z = 0L; (z < Nz); z++) { - for (x = 0L; (x < Nx); x++) { - *Status = GetyDoubleToDouble(Re2Re, Nx, Ny, Nz, x, 0L, z, Re, Ny); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - *Status = GetyDoubleToDouble(Im2Im, Nx, Ny, Nz, x, 0L, z, Im, Ny); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - *Status = DftRealImaginaryToRealImaginary(Re, Im, TmpRe, TmpIm, CaS, Ny); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - *Status = PutyDoubleToDouble(Re2Re, Nx, Ny, Nz, x, 0L, z, Re, Ny); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - *Status = PutyDoubleToDouble(Im2Im, Nx, Ny, Nz, x, 0L, z, Im, Ny); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - } - } - *Status = bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - } - if (Nx > 1L) { - *Status = bufferAllocRI(&Re, &Im, &TmpRe, &TmpIm, &CaS, Nx); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - *Status = GetCaS(CaS, Nx); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - for (z = 0L; (z < Nz); z++) { - for (y = 0L; (y < Ny); y++) { - *Status = GetxDoubleToDouble(Re2Re, Nx, Ny, Nz, 0L, y, z, Re, Nx); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - *Status = GetxDoubleToDouble(Im2Im, Nx, Ny, Nz, 0L, y, z, Im, Nx); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - *Status = DftRealImaginaryToRealImaginary(Re, Im, TmpRe, TmpIm, CaS, Nx); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - *Status = PutxDoubleToDouble(Re2Re, Nx, Ny, Nz, 0L, y, z, Re, Nx); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - *Status = PutxDoubleToDouble(Im2Im, Nx, Ny, Nz, 0L, y, z, Im, Nx); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - } - } - *Status = bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - } -/**/DEBUG_WRITE_LEAVING(VolumeDftRealImaginaryToRealImaginary, "Done") - return(*Status); -} /* end VolumeDftRealImaginaryToRealImaginary */ - -/*--------------------------------------------------------------------------*/ -extern int VolumeDftRealToAmplitudePhase - ( - double *Re2Am, /* real -> amplitude */ - double *PhOut, /* output phase */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - int *Status /* error management */ - ) - -/* computes the direct DFT of a real signal - and returns an (amplitude, phase) representation */ -/* the output phase is in [rad]; its domain is (-PI, PI) */ -/* the origin is at index [0] */ -/* the highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] for SignalLength even */ -/* the highest coordinate (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd */ -/* the lowest coordinate -SignalLength/2 is at index [SignalLength/2] for SignalLength even */ -/* the lowest coordinate -(SignalLength-1)/2 is at index [(SignalLength+1)/2] for SignalLength odd */ -/* the coordinate -1 is at index [SignalLength-1] for SignalLength even or odd */ -/* no restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5 */ -/* in the explanations above, SignalLength has to be replaced by Nx, Ny, Nz */ -/* Nx is the width of the volume */ -/* Ny is the height of the volume */ -/* Nz is the depth of the volume */ -/* in-place processing */ -/* the input signal Re2Am is - replaced by the output signal (amplitude Re2Am and phase PhOut) */ -/* success: return(!ERROR); failure: return(ERROR); */ -/* the returned value is duplicated in Status */ - -{ /* begin VolumeDftRealToAmplitudePhase */ - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(VolumeDftRealToAmplitudePhase, Re2Am, *Status, -/**/ "Missing Re2Am ") -/**/DEBUG_CHECK_NULL_POINTER(VolumeDftRealToAmplitudePhase, PhOut, *Status, -/**/ "Missing PhOut ") -/**/DEBUG_CHECK_RANGE_LONG(VolumeDftRealToAmplitudePhase, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(VolumeDftRealToAmplitudePhase, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(VolumeDftRealToAmplitudePhase, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(VolumeDftRealToAmplitudePhase, *Status) -/**/DEBUG_WRITE_ENTERING(VolumeDftRealToAmplitudePhase, -/**/ "About to compute a 3D real to amplitude/phase direct Fourier transform") - - VolumeDftRealToRealImaginary(Re2Am, PhOut, Nx, Ny, Nz, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealToAmplitudePhase, "Done") - return(*Status); - } - *Status = VolumeRealImaginaryToAmplitudePhase(Re2Am, PhOut, Nx, Ny, Nz); -/**/DEBUG_WRITE_LEAVING(VolumeDftRealToAmplitudePhase, "Done") - return(*Status); -} /* end VolumeDftRealToAmplitudePhase */ - -/*--------------------------------------------------------------------------*/ -extern int VolumeDftRealToRealImaginary - ( - double *Re2Re, /* real -> real */ - double *ImOut, /* output imaginary */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - int *Status /* error management */ - ) - -/* computes the direct DFT of a real signal - and returns a (real, imaginary) representation */ -/* the origin is at index [0] */ -/* the highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] for SignalLength even */ -/* the highest coordinate (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd */ -/* the lowest coordinate -SignalLength/2 is at index [SignalLength/2] for SignalLength even */ -/* the lowest coordinate -(SignalLength-1)/2 is at index [(SignalLength+1)/2] for SignalLength odd */ -/* the coordinate -1 is at index [SignalLength-1] for SignalLength even or odd */ -/* no restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5 */ -/* in the explanations above, SignalLength has to be replaced by Nx, Ny, Nz */ -/* Nx is the width of the volume */ -/* Ny is the height of the volume */ -/* Nz is the depth of the volume */ -/* in-place processing */ -/* the input signal Re2Re is - replaced by the output signal (real Re2Re and imaginary ImOut) */ -/* success: return(!ERROR); failure: return(ERROR); */ -/* the returned value is duplicated in Status */ - -{ /* begin VolumeDftRealToRealImaginary */ - - double *H = (double *)NULL, *tmp = (double *)NULL; - double *CaS = (double *)NULL; - double *V = (double *)NULL; - double *Rppp, *Rppm, *Rpmp, *Rpmm, *Rmpp, *Rmpm, *Rmmp, *Rmmm; - long x, y, z; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(VolumeDftRealToRealImaginary, Re2Re, *Status, -/**/ "Missing Re2Re ") -/**/DEBUG_CHECK_NULL_POINTER(VolumeDftRealToRealImaginary, ImOut, *Status, -/**/ "Missing ImOut ") -/**/DEBUG_CHECK_RANGE_LONG(VolumeDftRealToRealImaginary, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(VolumeDftRealToRealImaginary, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(VolumeDftRealToRealImaginary, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(VolumeDftRealToRealImaginary, *Status) -/**/DEBUG_WRITE_ENTERING(VolumeDftRealToRealImaginary, -/**/ "About to compute a 3D real to amplitude/phase direct Fourier transform") - - AllocateVolumeDouble(&V, Nx, Ny, Nz, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealToRealImaginary, "Done") - return(*Status); - } - if (Nz > 1L) { - *Status = bufferAllocR(&H, &tmp, &CaS, Nz); - if (*Status == ERROR) { - bufferFreeR(&H, &tmp, &CaS); - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealToRealImaginary, "Done") - return(*Status); - } - *Status = GetCaS(CaS, Nz); - if (*Status == ERROR) { - bufferFreeR(&H, &tmp, &CaS); - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealToRealImaginary, "Done") - return(*Status); - } - for (y = 0L; (y < Ny); y++) { - for (x = 0L; (x < Nx); x++) { - *Status = GetzDoubleToDouble(Re2Re, Nx, Ny, Nz, x, y, 0L, H, Nz); - if (*Status == ERROR) { - bufferFreeR(&H, &tmp, &CaS); - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealToRealImaginary, "Done") - return(*Status); - } - *Status = DiscreteHartleyTransform(H, tmp, CaS, Nz, FORWARD); - if (*Status == ERROR) { - bufferFreeR(&H, &tmp, &CaS); - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealToRealImaginary, "Done") - return(*Status); - } - *Status = PutzDoubleToDouble(Re2Re, Nx, Ny, Nz, x, y, 0L, H, Nz); - if (*Status == ERROR) { - bufferFreeR(&H, &tmp, &CaS); - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealToRealImaginary, "Done") - return(*Status); - } - } - } - *Status = bufferFreeR(&H, &tmp, &CaS); - if (*Status == ERROR) { - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealToRealImaginary, "Done") - return(*Status); - } - } - if (Ny > 1L) { - *Status = bufferAllocR(&H, &tmp, &CaS, Ny); - if (*Status == ERROR) { - bufferFreeR(&H, &tmp, &CaS); - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealToRealImaginary, "Done") - return(*Status); - } - *Status = GetCaS(CaS, Ny); - if (*Status == ERROR) { - bufferFreeR(&H, &tmp, &CaS); - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealToRealImaginary, "Done") - return(*Status); - } - for (z = 0L; (z < Nz); z++) { - for (x = 0L; (x < Nx); x++) { - *Status = GetyDoubleToDouble(Re2Re, Nx, Ny, Nz, x, 0L, z, H, Ny); - if (*Status == ERROR) { - bufferFreeR(&H, &tmp, &CaS); - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealToRealImaginary, "Done") - return(*Status); - } - *Status = DiscreteHartleyTransform(H, tmp, CaS, Ny, FORWARD); - if (*Status == ERROR) { - bufferFreeR(&H, &tmp, &CaS); - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealToRealImaginary, "Done") - return(*Status); - } - *Status = PutyDoubleToDouble(Re2Re, Nx, Ny, Nz, x, 0L, z, H, Ny); - if (*Status == ERROR) { - bufferFreeR(&H, &tmp, &CaS); - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealToRealImaginary, "Done") - return(*Status); - } - } - } - *Status = bufferFreeR(&H, &tmp, &CaS); - if (*Status == ERROR) { - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealToRealImaginary, "Done") - return(*Status); - } - } - if (Nx > 1L) { - *Status = bufferAllocR(&H, &tmp, &CaS, Nx); - if (*Status == ERROR) { - bufferFreeR(&H, &tmp, &CaS); - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealToRealImaginary, "Done") - return(*Status); - } - *Status = GetCaS(CaS, Nx); - if (*Status == ERROR) { - bufferFreeR(&H, &tmp, &CaS); - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealToRealImaginary, "Done") - return(*Status); - } - for (z = 0L; (z < Nz); z++) { - for (y = 0L; (y < Ny); y++) { - *Status = GetxDoubleToDouble(Re2Re, Nx, Ny, Nz, 0L, y, z, H, Nx); - if (*Status == ERROR) { - bufferFreeR(&H, &tmp, &CaS); - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealToRealImaginary, "Done") - return(*Status); - } - *Status = DiscreteHartleyTransform(H, tmp, CaS, Nx, FORWARD); - if (*Status == ERROR) { - bufferFreeR(&H, &tmp, &CaS); - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealToRealImaginary, "Done") - return(*Status); - } - *Status = PutxDoubleToDouble(V, Nx, Ny, Nz, 0L, y, z, H, Nx); - if (*Status == ERROR) { - bufferFreeR(&H, &tmp, &CaS); - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealToRealImaginary, "Done") - return(*Status); - } - } - } - *Status = bufferFreeR(&H, &tmp, &CaS); - if (*Status == ERROR) { - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeDftRealToRealImaginary, "Done") - return(*Status); - } - } - else { - V = (double *)memcpy(V, Re2Re, (size_t)(Nx * Ny * Nz * (long)sizeof(double))); - } - *ImOut++ = 0.0F; - *Re2Re++ = *V; - Rppp = V + (ptrdiff_t)1; - Rmpp = V + (ptrdiff_t)(Nx - 1L); - x = Nx - 1L; - while (x-- > 0L) { - *Re2Re++ = (double)(((double)*Rppp + (double)*Rmpp) * 0.5); - *ImOut++ = (double)((-(double)*Rppp++ + (double)*Rmpp--) * 0.5); - } - Rpmp = Rmmp = V + (ptrdiff_t)(Nx * (Ny - 1L)); - Rmpp = Rppp; - y = Ny - 1L; - while (y-- > 0L) { - *Re2Re++ = (double)(((double)*Rpmp++ + (double)*Rmpp) * 0.5); - *ImOut++ = (double)((-(double)*Rppp++ + (double)*Rmmp) * 0.5); - Rmpp += (ptrdiff_t)(Nx - 1L); - Rmmp += (ptrdiff_t)(Nx - 1L); - x = Nx - 1L; - while (x-- > 0L) { - *Re2Re++ = (double)(((double)*Rpmp++ + (double)*Rmpp--) * 0.5); - *ImOut++ = (double)((-(double)*Rppp++ + (double)*Rmmp--) * 0.5); - } - Rmmp -= (ptrdiff_t)Nx; - Rmpp = Rppp; - Rpmp = Rmmp; - } - Rppm = Rpmm = Rmpm = Rmmm = V + (ptrdiff_t)(Nx * Ny * (Nz - 1L)); - Rpmp = Rmmp = Rppp; - z = Nz - 1L; - while (z-- > 0L) { - *Re2Re++ = (double)((-(double)*Rppp + (double)*Rppm - + (double)*Rpmp + (double)*Rpmm - + (double)*Rmpp + (double)*Rmpm - + (double)*Rmmp - (double)*Rmmm) * 0.25); - *ImOut++ = (double)((-(double)*Rppp++ - (double)*Rppm++ - - (double)*Rpmp++ + (double)*Rpmm++ - - (double)*Rmpp + (double)*Rmpm - + (double)*Rmmp + (double)*Rmmm) * 0.25); - Rmpp += (ptrdiff_t)(Nx - 1L); - Rmpm += (ptrdiff_t)(Nx - 1L); - Rmmp += (ptrdiff_t)(Nx - 1L); - Rmmm += (ptrdiff_t)(Nx - 1L); - x = Nx - 1L; - while (x-- > 0L) { - *Re2Re++ = (double)((-(double)*Rppp + (double)*Rppm - + (double)*Rpmp + (double)*Rpmm - + (double)*Rmpp + (double)*Rmpm - + (double)*Rmmp - (double)*Rmmm) * 0.25); - *ImOut++ = (double)((-(double)*Rppp++ - (double)*Rppm++ - - (double)*Rpmp++ + (double)*Rpmm++ - - (double)*Rmpp-- + (double)*Rmpm-- - + (double)*Rmmp-- + (double)*Rmmm--) * 0.25); - } - Rpmp += (ptrdiff_t)(Nx * (Ny - 2L)); - Rpmm += (ptrdiff_t)(Nx * (Ny - 2L)); - Rmpp = Rppp; - Rmpm = Rppm; - Rmmp = Rpmp; - Rmmm = Rpmm; - y = Ny - 1L; - while (y-- > 0L) { - *Re2Re++ = (double)((-(double)*Rppp + (double)*Rppm - + (double)*Rpmp + (double)*Rpmm - + (double)*Rmpp + (double)*Rmpm - + (double)*Rmmp - (double)*Rmmm) * 0.25); - *ImOut++ = (double)((-(double)*Rppp++ - (double)*Rppm++ - - (double)*Rpmp++ + (double)*Rpmm++ - - (double)*Rmpp + (double)*Rmpm - + (double)*Rmmp + (double)*Rmmm) * 0.25); - Rmpp += (ptrdiff_t)(Nx - 1L); - Rmpm += (ptrdiff_t)(Nx - 1L); - Rmmp += (ptrdiff_t)(Nx - 1L); - Rmmm += (ptrdiff_t)(Nx - 1L); - x = Nx - 1L; - while (x-- > 0L) { - *Re2Re++ = (double)((-(double)*Rppp + (double)*Rppm - + (double)*Rpmp + (double)*Rpmm - + (double)*Rmpp + (double)*Rmpm - + (double)*Rmmp - (double)*Rmmm) * 0.25); - *ImOut++ = (double)((-(double)*Rppp++ - (double)*Rppm++ - - (double)*Rpmp++ + (double)*Rpmm++ - - (double)*Rmpp-- + (double)*Rmpm-- - + (double)*Rmmp-- + (double)*Rmmm--) * 0.25); - } - Rmmp -= (ptrdiff_t)Nx; - Rmmm -= (ptrdiff_t)Nx; - Rmpp = Rppp; - Rmpm = Rppm; - Rpmp = Rmmp; - Rpmm = Rmmm; - } - Rmmm -= (ptrdiff_t)(Nx * Ny); - Rpmp = Rmmp = Rppp; - Rppm = Rpmm = Rmpm = Rmmm; - } - *Status = FreeVolumeDouble(&V); -/**/DEBUG_WRITE_LEAVING(VolumeDftRealToRealImaginary, "Done") - return(*Status); -} /* end VolumeDftRealToRealImaginary */ - -/*--------------------------------------------------------------------------*/ -extern int VolumeInvDftAmplitudePhaseToAmplitudePhase - ( - double *Am2Am, /* amplitude -> amplitude */ - double *Ph2Ph, /* phase -> phase */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - int *Status /* error management */ - ) - -/* computes the inverse DFT of a complex signal given in (amplitude, phase) representation - and returns an (amplitude, phase) representation */ -/* the input phase is in [rad] */ -/* the output phase is in [rad]; its domain is (-PI, PI) */ -/* the origin is at index [0] */ -/* the highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] for SignalLength even */ -/* the highest coordinate (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd */ -/* the lowest coordinate -SignalLength/2 is at index [SignalLength/2] for SignalLength even */ -/* the lowest coordinate -(SignalLength-1)/2 is at index [(SignalLength+1)/2] for SignalLength odd */ -/* the coordinate -1 is at index [SignalLength-1] for SignalLength even or odd */ -/* no restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5 */ -/* in the explanations above, SignalLength has to be replaced by Nx, Ny, Nz */ -/* Nx is the width of the volume */ -/* Ny is the height of the volume */ -/* Nz is the depth of the volume */ -/* in-place processing */ -/* the input signal (amplitude Am2Am and phase Ph2Ph) is - replaced by the output signal (amplitude Am2Am and phase Ph2Ph) */ -/* success: return(!ERROR); failure: return(ERROR); */ -/* the returned value is duplicated in Status */ - -{ /* begin VolumeInvDftAmplitudePhaseToAmplitudePhase */ - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(VolumeInvDftAmplitudePhaseToAmplitudePhase, Am2Am, *Status, -/**/ "Missing Am2Am ") -/**/DEBUG_CHECK_NULL_POINTER(VolumeInvDftAmplitudePhaseToAmplitudePhase, Ph2Ph, *Status, -/**/ "Missing Ph2Ph ") -/**/DEBUG_CHECK_RANGE_LONG(VolumeInvDftAmplitudePhaseToAmplitudePhase, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(VolumeInvDftAmplitudePhaseToAmplitudePhase, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(VolumeInvDftAmplitudePhaseToAmplitudePhase, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(VolumeInvDftAmplitudePhaseToAmplitudePhase, *Status) -/**/DEBUG_WRITE_ENTERING(VolumeInvDftAmplitudePhaseToAmplitudePhase, -/**/ "About to compute a 3D amplitude/phase to amplitude/phase inverse Fourier transform") - - *Status = VolumeAmplitudePhaseToRealImaginary(Am2Am, Ph2Ph, Nx, Ny, Nz); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftAmplitudePhaseToAmplitudePhase, "Done") - return(*Status); - } - VolumeInvDftRealImaginaryToAmplitudePhase(Am2Am, Ph2Ph, Nx, Ny, Nz, Status); -/**/DEBUG_WRITE_LEAVING(VolumeInvDftAmplitudePhaseToAmplitudePhase, "Done") - return(*Status); -} /* end VolumeInvDftAmplitudePhaseToAmplitudePhase */ - -/*--------------------------------------------------------------------------*/ -extern int VolumeInvDftAmplitudePhaseToReal - ( - double *Am2Re, /* amplitude -> real */ - double *PhIn, /* input phase */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - int *Status /* error management */ - ) - -/* computes the inverse DFT of a complex signal given in (amplitude, phase) representation - and returns a real signal */ -/* the complex Fourier signal is symmetrized before the inverse transformation is applied */ -/* the input phase is in [rad] */ -/* the origin is at index [0] */ -/* the highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] for SignalLength even */ -/* the highest coordinate (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd */ -/* the lowest coordinate -SignalLength/2 is at index [SignalLength/2] for SignalLength even */ -/* the lowest coordinate -(SignalLength-1)/2 is at index [(SignalLength+1)/2] for SignalLength odd */ -/* the coordinate -1 is at index [SignalLength-1] for SignalLength even or odd */ -/* no restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5 */ -/* in the explanations above, SignalLength has to be replaced by Nx, Ny, Nz */ -/* Nx is the width of the volume */ -/* Ny is the height of the volume */ -/* Nz is the depth of the volume */ -/* in-place processing */ -/* the input signal (amplitude Am2Re and phase PhIn) is - replaced by the output signal (real Am2Re) */ -/* PhIn is destroyed */ -/* success: return(!ERROR); failure: return(ERROR); */ -/* the returned value is duplicated in Status */ - -{ /* begin VolumeInvDftAmplitudePhaseToReal */ - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(VolumeInvDftAmplitudePhaseToReal, Am2Re, *Status, -/**/ "Missing Am2Re ") -/**/DEBUG_CHECK_NULL_POINTER(VolumeInvDftAmplitudePhaseToReal, PhIn, *Status, -/**/ "Missing PhIn ") -/**/DEBUG_CHECK_RANGE_LONG(VolumeInvDftAmplitudePhaseToReal, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(VolumeInvDftAmplitudePhaseToReal, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(VolumeInvDftAmplitudePhaseToReal, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(VolumeInvDftAmplitudePhaseToReal, *Status) -/**/DEBUG_WRITE_ENTERING(VolumeInvDftAmplitudePhaseToReal, -/**/ "About to compute a 3D amplitude/phase to real inverse Fourier transform") - - *Status = VolumeAmplitudePhaseToRealImaginary(Am2Re, PhIn, Nx, Ny, Nz); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftAmplitudePhaseToReal, "Done") - return(*Status); - } - VolumeInvDftRealImaginaryToReal(Am2Re, PhIn, Nx, Ny, Nz, Status); -/**/DEBUG_WRITE_LEAVING(VolumeInvDftAmplitudePhaseToReal, "Done") - return(*Status); -} /* end VolumeInvDftAmplitudePhaseToReal */ - -/*--------------------------------------------------------------------------*/ -extern int VolumeInvDftAmplitudePhaseToRealImaginary - ( - double *Am2Re, /* amplitude -> real */ - double *Ph2Im, /* phase -> imaginary */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - int *Status /* error management */ - ) - -/* computes the inverse DFT of a complex signal given in (amplitude, phase) representation - and returns a (real, imaginary) representation */ -/* the input phase is in [rad] */ -/* the origin is at index [0] */ -/* the highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] for SignalLength even */ -/* the highest coordinate (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd */ -/* the lowest coordinate -SignalLength/2 is at index [SignalLength/2] for SignalLength even */ -/* the lowest coordinate -(SignalLength-1)/2 is at index [(SignalLength+1)/2] for SignalLength odd */ -/* the coordinate -1 is at index [SignalLength-1] for SignalLength even or odd */ -/* no restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5 */ -/* in the explanations above, SignalLength has to be replaced by Nx, Ny, Nz */ -/* Nx is the width of the volume */ -/* Ny is the height of the volume */ -/* Nz is the depth of the volume */ -/* in-place processing */ -/* the input signal (amplitude Am2Re and phase Ph2Im) is - replaced by the output signal (real Am2Re and imaginary Ph2Im) */ -/* success: return(!ERROR); failure: return(ERROR); */ -/* the returned value is duplicated in Status */ - -{ /* begin VolumeInvDftAmplitudePhaseToRealImaginary */ - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(VolumeInvDftAmplitudePhaseToRealImaginary, Am2Re, *Status, -/**/ "Missing Am2Re ") -/**/DEBUG_CHECK_NULL_POINTER(VolumeInvDftAmplitudePhaseToRealImaginary, Ph2Im, *Status, -/**/ "Missing Ph2Im ") -/**/DEBUG_CHECK_RANGE_LONG(VolumeInvDftAmplitudePhaseToRealImaginary, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(VolumeInvDftAmplitudePhaseToRealImaginary, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(VolumeInvDftAmplitudePhaseToRealImaginary, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(VolumeInvDftAmplitudePhaseToRealImaginary, *Status) -/**/DEBUG_WRITE_ENTERING(VolumeInvDftAmplitudePhaseToRealImaginary, -/**/ "About to compute a 3D amplitude/phase to real/imaginary inverse Fourier transform") - - *Status = VolumeAmplitudePhaseToRealImaginary(Am2Re, Ph2Im, Nx, Ny, Nz); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftAmplitudePhaseToRealImaginary, "Done") - return(*Status); - } - VolumeInvDftRealImaginaryToRealImaginary(Am2Re, Ph2Im, Nx, Ny, Nz, Status); -/**/DEBUG_WRITE_LEAVING(VolumeInvDftAmplitudePhaseToRealImaginary, "Done") - return(*Status); -} /* end VolumeInvDftAmplitudePhaseToRealImaginary */ - -/*--------------------------------------------------------------------------*/ -extern int VolumeInvDftRealImaginaryToAmplitudePhase - ( - double *Re2Am, /* real -> amplitude */ - double *Im2Ph, /* imaginary -> phase */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - int *Status /* error management */ - ) - -/* computes the inverse DFT of a complex signal given in (real, imaginary) representation - and returns an (amplitude, phase) representation */ -/* the output phase is in [rad]; its domain is (-PI, PI) */ -/* the origin is at index [0] */ -/* the highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] for SignalLength even */ -/* the highest coordinate (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd */ -/* the lowest coordinate -SignalLength/2 is at index [SignalLength/2] for SignalLength even */ -/* the lowest coordinate -(SignalLength-1)/2 is at index [(SignalLength+1)/2] for SignalLength odd */ -/* the coordinate -1 is at index [SignalLength-1] for SignalLength even or odd */ -/* no restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5 */ -/* in the explanations above, SignalLength has to be replaced by Nx, Ny, Nz */ -/* Nx is the width of the volume */ -/* Ny is the height of the volume */ -/* Nz is the depth of the volume */ -/* in-place processing */ -/* the input signal (real Re2Am and imaginary Im2Ph) is - replaced by the output signal (amplitude Re2Am and phase Im2Ph) */ -/* success: return(!ERROR); failure: return(ERROR); */ -/* the returned value is duplicated in Status */ - -{ /* begin VolumeInvDftRealImaginaryToAmplitudePhase */ - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(VolumeInvDftRealImaginaryToAmplitudePhase, Re2Am, *Status, -/**/ "Missing Re2Am ") -/**/DEBUG_CHECK_NULL_POINTER(VolumeInvDftRealImaginaryToAmplitudePhase, Im2Ph, *Status, -/**/ "Missing Im2Ph ") -/**/DEBUG_CHECK_RANGE_LONG(VolumeInvDftRealImaginaryToAmplitudePhase, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(VolumeInvDftRealImaginaryToAmplitudePhase, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(VolumeInvDftRealImaginaryToAmplitudePhase, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(VolumeInvDftRealImaginaryToAmplitudePhase, *Status) -/**/DEBUG_WRITE_ENTERING(VolumeInvDftRealImaginaryToAmplitudePhase, -/**/ "About to compute a 3D real/imaginary to amplitude/phase inverse Fourier transform") - - VolumeInvDftRealImaginaryToRealImaginary(Re2Am, Im2Ph, Nx, Ny, Nz, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToAmplitudePhase, "Done") - return(*Status); - } - *Status = VolumeRealImaginaryToAmplitudePhase(Re2Am, Im2Ph, Nx, Ny, Nz); -/**/DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToAmplitudePhase, "Done") - return(*Status); -} /* end VolumeInvDftRealImaginaryToAmplitudePhase */ - -/*--------------------------------------------------------------------------*/ -extern int VolumeInvDftRealImaginaryToReal - ( - double *Re2Re, /* real -> real */ - double *ImIn, /* input imaginary */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - int *Status /* error management */ - ) - -/* computes the inverse DFT of a complex signal given in (real, imaginary) representation - and returns a real signal */ -/* the complex Fourier signal is symmetrized before the inverse transformation is applied */ -/* the origin is at index [0] */ -/* the highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] for SignalLength even */ -/* the highest coordinate (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd */ -/* the lowest coordinate -SignalLength/2 is at index [SignalLength/2] for SignalLength even */ -/* the lowest coordinate -(SignalLength-1)/2 is at index [(SignalLength+1)/2] for SignalLength odd */ -/* the coordinate -1 is at index [SignalLength-1] for SignalLength even or odd */ -/* no restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5 */ -/* in the explanations above, SignalLength has to be replaced by Nx, Ny, Nz */ -/* Nx is the width of the volume */ -/* Ny is the height of the volume */ -/* Nz is the depth of the volume */ -/* in-place processing */ -/* the input signal (real Re2Re and imaginary ImIn) is - replaced by the output signal (real Re2Re) */ -/* success: return(!ERROR); failure: return(ERROR); */ -/* the returned value is duplicated in Status */ - -{ /* begin VolumeInvDftRealImaginaryToReal */ - - double *H = (double *)NULL, *tmp = (double *)NULL; - double *CaS = (double *)NULL; - double *V = (double *)NULL; - double *Rppp, *Rppm, *Rpmp, *Rpmm, *Rmpp, *Rmpm, *Rmmp, *Rmmm; - double *Ippp, *Ippm, *Ipmp, *Ipmm, *Impp, *Impm, *Immp, *Immm; - double re, im; - long x, y, z; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(VolumeInvDftRealImaginaryToReal, Re2Re, *Status, -/**/ "Missing Re2Re ") -/**/DEBUG_CHECK_NULL_POINTER(VolumeInvDftRealImaginaryToReal, ImIn, *Status, -/**/ "Missing ImIn ") -/**/DEBUG_CHECK_RANGE_LONG(VolumeInvDftRealImaginaryToReal, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(VolumeInvDftRealImaginaryToReal, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(VolumeInvDftRealImaginaryToReal, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(VolumeInvDftRealImaginaryToReal, *Status) -/**/DEBUG_WRITE_ENTERING(VolumeInvDftRealImaginaryToReal, -/**/ "About to compute a 3D real/imaginary to real inverse Fourier transform") - - AllocateVolumeDouble(&V, Nx, Ny, Nz, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToReal, "Done") - return(*Status); - } - *V = (double)sqrt((double)*Re2Re * (double)*Re2Re + (double)*ImIn * (double)*ImIn); - *V = (*Re2Re < 0.0) ? (-*V) : (*V); - V++; - Rppp = Re2Re + (ptrdiff_t)1; - Rmpp = Re2Re + (ptrdiff_t)(Nx - 1L); - Ippp = ImIn + (ptrdiff_t)1; - Impp = ImIn + (ptrdiff_t)(Nx - 1L); - x = Nx - 1L; - while (x-- > 0L) { - re = (double)*Rmpp-- + (double)*Rppp++; - im = (double)*Impp-- - (double)*Ippp++; - *V++ = (double)((re + im) * 0.5); - } - Rpmp = Rmmp = Re2Re + (ptrdiff_t)(Nx * (Ny - 1L)); - Rmpp = Rppp; - Immp = ImIn + (ptrdiff_t)(Nx * (Ny - 1L)); - y = Ny - 1L; - while (y-- > 0L) { - re = (double)*Rpmp++ + (double)*Rmpp; - im = (double)*Immp - (double)*Ippp++; - *V++ = (double)((re + im) * 0.5); - Rmpp += (ptrdiff_t)(Nx - 1L); - Immp += (ptrdiff_t)(Nx - 1L); - x = Nx - 1L; - while (x-- > 0L) { - re = (double)*Rpmp++ + (double)*Rmpp--; - im = (double)*Immp-- - (double)*Ippp++; - *V++ = (double)((re + im) * 0.5); - } - Rmmp -= (ptrdiff_t)Nx; - Rmpp += (ptrdiff_t)Nx; - Rpmp = Rmmp; - Immp -= (ptrdiff_t)Nx; - } - Rppm = Rpmm = Rmpm = Rmmm = Re2Re + (ptrdiff_t)(Nx * Ny * (Nz - 1L)); - Rppp += (ptrdiff_t)(Nx * (Ny - 1L)); - Rpmp = Rmmp = Rppp; - Ippm = Ipmm = Impm = Immm = ImIn + (ptrdiff_t)(Nx * Ny * (Nz - 1L)); - Ipmp = Impp = Immp = Ippp; - z = Nz - 1L; - while (z-- > 0L) { - re = -(double)*Rppp++ + (double)*Rppm++ + (double)*Rpmp++ + (double)*Rpmm++ - + (double)*Rmpp + (double)*Rmpm + (double)*Rmmp - (double)*Rmmm; - im = -(double)*Ippp++ - (double)*Ippm++ - (double)*Ipmp++ + (double)*Ipmm++ - - (double)*Impp + (double)*Impm + (double)*Immp + (double)*Immm; - *V++ = (double)((re + im) * 0.25); - Rmpp += (ptrdiff_t)(Nx - 1L); - Rmpm += (ptrdiff_t)(Nx - 1L); - Rmmp += (ptrdiff_t)(Nx - 1L); - Rmmm += (ptrdiff_t)(Nx - 1L); - Impp += (ptrdiff_t)(Nx - 1L); - Impm += (ptrdiff_t)(Nx - 1L); - Immp += (ptrdiff_t)(Nx - 1L); - Immm += (ptrdiff_t)(Nx - 1L); - x = Nx - 1L; - while (x-- > 0L) { - re = -(double)*Rppp++ + (double)*Rppm++ + (double)*Rpmp++ + (double)*Rpmm++ - + (double)*Rmpp-- + (double)*Rmpm-- + (double)*Rmmp-- - (double)*Rmmm--; - im = -(double)*Ippp++ - (double)*Ippm++ - (double)*Ipmp++ + (double)*Ipmm++ - - (double)*Impp-- + (double)*Impm-- + (double)*Immp-- + (double)*Immm--; - *V++ = (double)((re + im) * 0.25); - } - Rpmp += (ptrdiff_t)(Nx * (Ny - 2L)); - Rpmm += (ptrdiff_t)(Nx * (Ny - 2L)); - Rmpp = Rppp; - Rmpm = Rppm; - Rmmp = Rpmp; - Rmmm = Rpmm; - Ipmp += (ptrdiff_t)(Nx * (Ny - 2L)); - Ipmm += (ptrdiff_t)(Nx * (Ny - 2L)); - Impp = Ippp; - Impm = Ippm; - Immp = Ipmp; - Immm = Ipmm; - y = Ny - 1L; - while (y-- > 0L) { - re = -(double)*Rppp++ + (double)*Rppm++ + (double)*Rpmp++ + (double)*Rpmm++ - + (double)*Rmpp + (double)*Rmpm + (double)*Rmmp - (double)*Rmmm; - im = -(double)*Ippp++ - (double)*Ippm++ - (double)*Ipmp++ + (double)*Ipmm++ - - (double)*Impp + (double)*Impm + (double)*Immp + (double)*Immm; - *V++ = (double)((re + im) * 0.25); - Rmpp += (ptrdiff_t)(Nx - 1L); - Rmpm += (ptrdiff_t)(Nx - 1L); - Rmmp += (ptrdiff_t)(Nx - 1L); - Rmmm += (ptrdiff_t)(Nx - 1L); - Impp += (ptrdiff_t)(Nx - 1L); - Impm += (ptrdiff_t)(Nx - 1L); - Immp += (ptrdiff_t)(Nx - 1L); - Immm += (ptrdiff_t)(Nx - 1L); - x = Nx - 1L; - while (x-- > 0L) { - re = -(double)*Rppp++ + (double)*Rppm++ + (double)*Rpmp++ + (double)*Rpmm++ - + (double)*Rmpp-- + (double)*Rmpm-- + (double)*Rmmp-- - (double)*Rmmm--; - im = -(double)*Ippp++ - (double)*Ippm++ - (double)*Ipmp++ + (double)*Ipmm++ - - (double)*Impp-- + (double)*Impm-- + (double)*Immp-- + (double)*Immm--; - *V++ = (double)((re + im) * 0.25); - } - Rmmp -= (ptrdiff_t)Nx; - Rmmm -= (ptrdiff_t)Nx; - Rmpp = Rppp; - Rmpm = Rppm; - Rpmp = Rmmp; - Rpmm = Rmmm; - Immp -= (ptrdiff_t)Nx; - Immm -= (ptrdiff_t)Nx; - Impp = Ippp; - Impm = Ippm; - Ipmp = Immp; - Ipmm = Immm; - } - Rmmm -= (ptrdiff_t)(Nx * Ny); - Rpmp = Rmmp = Rppp; - Rppm = Rpmm = Rmpm = Rmmm; - Immm -= (ptrdiff_t)(Nx * Ny); - Ipmp = Immp = Ippp; - Ippm = Ipmm = Impm = Immm; - } - V -= (ptrdiff_t)(Nx * Ny * Nz); - if (Nz > 1L) { - *Status = bufferAllocR(&H, &tmp, &CaS, Nz); - if (*Status == ERROR) { - bufferFreeR(&H, &tmp, &CaS); - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToReal, "Done") - return(*Status); - } - *Status = GetCaS(CaS, Nz); - if (*Status == ERROR) { - bufferFreeR(&H, &tmp, &CaS); - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToReal, "Done") - return(*Status); - } - for (y = 0L; (y < Ny); y++) { - for (x = 0L; (x < Nx); x++) { - *Status = GetzDoubleToDouble(V, Nx, Ny, Nz, x, y, 0L, H, Nz); - if (*Status == ERROR) { - bufferFreeR(&H, &tmp, &CaS); - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToReal, "Done") - return(*Status); - } - *Status = DiscreteHartleyTransform(H, tmp, CaS, Nz, BACKWARD); - if (*Status == ERROR) { - bufferFreeR(&H, &tmp, &CaS); - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToReal, "Done") - return(*Status); - } - *Status = PutzDoubleToDouble(V, Nx, Ny, Nz, x, y, 0L, H, Nz); - if (*Status == ERROR) { - bufferFreeR(&H, &tmp, &CaS); - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToReal, "Done") - return(*Status); - } - } - } - *Status = bufferFreeR(&H, &tmp, &CaS); - if (*Status == ERROR) { - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToReal, "Done") - return(*Status); - } - } - if (Ny > 1L) { - *Status = bufferAllocR(&H, &tmp, &CaS, Ny); - if (*Status == ERROR) { - bufferFreeR(&H, &tmp, &CaS); - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToReal, "Done") - return(*Status); - } - *Status = GetCaS(CaS, Ny); - if (*Status == ERROR) { - bufferFreeR(&H, &tmp, &CaS); - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToReal, "Done") - return(*Status); - } - for (z = 0L; (z < Nz); z++) { - for (x = 0L; (x < Nx); x++) { - *Status = GetyDoubleToDouble(V, Nx, Ny, Nz, x, 0L, z, H, Ny); - if (*Status == ERROR) { - bufferFreeR(&H, &tmp, &CaS); - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToReal, "Done") - return(*Status); - } - *Status = DiscreteHartleyTransform(H, tmp, CaS, Ny, BACKWARD); - if (*Status == ERROR) { - bufferFreeR(&H, &tmp, &CaS); - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToReal, "Done") - return(*Status); - } - *Status = PutyDoubleToDouble(V, Nx, Ny, Nz, x, 0L, z, H, Ny); - if (*Status == ERROR) { - bufferFreeR(&H, &tmp, &CaS); - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToReal, "Done") - return(*Status); - } - } - } - *Status = bufferFreeR(&H, &tmp, &CaS); - if (*Status == ERROR) { - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToReal, "Done") - return(*Status); - } - } - if (Nx > 1L) { - *Status = bufferAllocR(&H, &tmp, &CaS, Nx); - if (*Status == ERROR) { - bufferFreeR(&H, &tmp, &CaS); - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToReal, "Done") - return(*Status); - } - *Status = GetCaS(CaS, Nx); - if (*Status == ERROR) { - bufferFreeR(&H, &tmp, &CaS); - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToReal, "Done") - return(*Status); - } - for (z = 0L; (z < Nz); z++) { - for (y = 0L; (y < Ny); y++) { - *Status = GetxDoubleToDouble(V, Nx, Ny, Nz, 0L, y, z, H, Nx); - if (*Status == ERROR) { - bufferFreeR(&H, &tmp, &CaS); - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToReal, "Done") - return(*Status); - } - *Status = DiscreteHartleyTransform(H, tmp, CaS, Nx, BACKWARD); - if (*Status == ERROR) { - bufferFreeR(&H, &tmp, &CaS); - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToReal, "Done") - return(*Status); - } - *Status = PutxDoubleToDouble(Re2Re, Nx, Ny, Nz, 0L, y, z, H, Nx); - if (*Status == ERROR) { - bufferFreeR(&H, &tmp, &CaS); - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToReal, "Done") - return(*Status); - } - } - } - *Status = bufferFreeR(&H, &tmp, &CaS); - if (*Status == ERROR) { - FreeVolumeDouble(&V); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToReal, "Done") - return(*Status); - } - } - else { - Re2Re = (double *)memcpy(Re2Re, V, (size_t)(Nx * Ny * Nz * (long)sizeof(double))); - } - *Status = FreeVolumeDouble(&V); -/**/DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToReal, "Done") - return(*Status); -} /* end VolumeInvDftRealImaginaryToReal */ - -/*--------------------------------------------------------------------------*/ -extern int VolumeInvDftRealImaginaryToRealImaginary - ( - double *Re2Re, /* real -> real */ - double *Im2Im, /* imaginary -> imaginary */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - int *Status /* error management */ - ) - -/* computes the inverse DFT of a complex signal given in (real, imaginary) representation - and returns a (real, imaginary) representation */ -/* the origin is at index [0] */ -/* the highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] for SignalLength even */ -/* the highest coordinate (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd */ -/* the lowest coordinate -SignalLength/2 is at index [SignalLength/2] for SignalLength even */ -/* the lowest coordinate -(SignalLength-1)/2 is at index [(SignalLength+1)/2] for SignalLength odd */ -/* the coordinate -1 is at index [SignalLength-1] for SignalLength even or odd */ -/* no restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5 */ -/* in the explanations above, SignalLength has to be replaced by Nx, Ny, Nz */ -/* Nx is the width of the volume */ -/* Ny is the height of the volume */ -/* Nz is the depth of the volume */ -/* in-place processing */ -/* the input signal (real Re2Re and imaginary Im2Im) is - replaced by the output signal (real Re2Re and imaginary Im2Ph) */ -/* success: return(!ERROR); failure: return(ERROR); */ -/* the returned value is duplicated in Status */ - -{ /* begin VolumeInvDftRealImaginaryToRealImaginary */ - - double *Re = (double *)NULL, *Im = (double *)NULL; - double *TmpRe = (double *)NULL, *TmpIm = (double *)NULL; - double *CaS = (double *)NULL; - long x, y, z; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(VolumeInvDftRealImaginaryToRealImaginary, Re2Re, *Status, -/**/ "Missing Re2Re ") -/**/DEBUG_CHECK_NULL_POINTER(VolumeInvDftRealImaginaryToRealImaginary, Im2Im, *Status, -/**/ "Missing Im2Im ") -/**/DEBUG_CHECK_RANGE_LONG(VolumeInvDftRealImaginaryToRealImaginary, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(VolumeInvDftRealImaginaryToRealImaginary, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(VolumeInvDftRealImaginaryToRealImaginary, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(VolumeInvDftRealImaginaryToRealImaginary, *Status) -/**/DEBUG_WRITE_ENTERING(VolumeInvDftRealImaginaryToRealImaginary, -/**/ "About to compute a 3D real/imaginary to real/imaginary direct Fourier transform") - - if (Nz > 1L) { - *Status = bufferAllocRI(&Re, &Im, &TmpRe, &TmpIm, &CaS, Nz); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - *Status = GetCaS(CaS, Nz); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - for (y = 0L; (y < Ny); y++) { - for (x = 0L; (x < Nx); x++) { - *Status = GetzDoubleToDouble(Re2Re, Nx, Ny, Nz, x, y, 0L, Re, Nz); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - *Status = GetzDoubleToDouble(Im2Im, Nx, Ny, Nz, x, y, 0L, Im, Nz); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - *Status = InvDftRealImaginaryToRealImaginary(Re, Im, TmpRe, TmpIm, CaS, Nz); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - *Status = PutzDoubleToDouble(Re2Re, Nx, Ny, Nz, x, y, 0L, Re, Nz); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - *Status = PutzDoubleToDouble(Im2Im, Nx, Ny, Nz, x, y, 0L, Im, Nz); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - } - } - *Status = bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - } - if (Ny > 1L) { - *Status = bufferAllocRI(&Re, &Im, &TmpRe, &TmpIm, &CaS, Ny); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - *Status = GetCaS(CaS, Ny); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - for (z = 0L; (z < Nz); z++) { - for (x = 0L; (x < Nx); x++) { - *Status = GetyDoubleToDouble(Re2Re, Nx, Ny, Nz, x, 0L, z, Re, Ny); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - *Status = GetyDoubleToDouble(Im2Im, Nx, Ny, Nz, x, 0L, z, Im, Ny); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - *Status = InvDftRealImaginaryToRealImaginary(Re, Im, TmpRe, TmpIm, CaS, Ny); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - *Status = PutyDoubleToDouble(Re2Re, Nx, Ny, Nz, x, 0L, z, Re, Ny); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - *Status = PutyDoubleToDouble(Im2Im, Nx, Ny, Nz, x, 0L, z, Im, Ny); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - } - } - *Status = bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - } - if (Nx > 1L) { - *Status = bufferAllocRI(&Re, &Im, &TmpRe, &TmpIm, &CaS, Nx); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - *Status = GetCaS(CaS, Nx); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - for (z = 0L; (z < Nz); z++) { - for (y = 0L; (y < Ny); y++) { - *Status = GetxDoubleToDouble(Re2Re, Nx, Ny, Nz, 0L, y, z, Re, Nx); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - *Status = GetxDoubleToDouble(Im2Im, Nx, Ny, Nz, 0L, y, z, Im, Nx); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - *Status = InvDftRealImaginaryToRealImaginary(Re, Im, TmpRe, TmpIm, CaS, Nx); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - *Status = PutxDoubleToDouble(Re2Re, Nx, Ny, Nz, 0L, y, z, Re, Nx); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - *Status = PutxDoubleToDouble(Im2Im, Nx, Ny, Nz, 0L, y, z, Im, Nx); - if (*Status == ERROR) { - bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - } - } - *Status = bufferFreeRI(&Re, &Im, &TmpRe, &TmpIm, &CaS); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToRealImaginary, "Done") - return(*Status); - } - } -/**/DEBUG_WRITE_LEAVING(VolumeInvDftRealImaginaryToRealImaginary, "Done") - return(*Status); -} /* end VolumeInvInvDftRealImaginaryToRealImaginary */ - -/*--------------------------------------------------------------------------*/ -extern int VolumeRealImaginaryToAmplitudePhase - ( - double Re2Am[], /* real -> amplitude */ - double Im2Ph[], /* imaginary -> phase */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz /* depth of the volume */ - ) - -/* converts a (real, imaginary) representation of a complex signal - into an (amplitude, phase) representation */ -/* the output phase is in [rad]; its domain is (-PI, PI) */ -/* in-place processing */ -/* the input signal (real Re2Am and imaginary Im2Ph) is - replaced by the output signal (amplitude Re2Am and phase Im2Ph) */ -/* Nx is the width of the volume */ -/* Ny is the height of the volume */ -/* Nz is the depth of the volume */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin VolumeRealImaginaryToAmplitudePhase */ - - double Phase; - long i; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(VolumeRealImaginaryToAmplitudePhase, Re2Am, Status, -/**/ "Missing Re2Am ") -/**/DEBUG_CHECK_NULL_POINTER(VolumeRealImaginaryToAmplitudePhase, Im2Ph, Status, -/**/ "Missing Im2Ph ") -/**/DEBUG_CHECK_RANGE_LONG(VolumeRealImaginaryToAmplitudePhase, Nx, 1L, LONG_MAX, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(VolumeRealImaginaryToAmplitudePhase, Ny, 1L, LONG_MAX, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(VolumeRealImaginaryToAmplitudePhase, Nz, 1L, LONG_MAX, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(VolumeRealImaginaryToAmplitudePhase, Status) -/**/DEBUG_WRITE_ENTERING(VolumeRealImaginaryToAmplitudePhase, -/**/ "About to convert a real/imaginary representation to an amplitude/phase representation") - - for (i = -Nx * Ny * Nz; (i < 0L); Re2Am++, i++) { - Phase = (double)atan2(*Im2Ph, *Re2Am); - *Re2Am = (double)sqrt(*Re2Am * *Re2Am + *Im2Ph * *Im2Ph); - *Im2Ph++ = Phase; - } -/**/DEBUG_WRITE_LEAVING(VolumeRealImaginaryToAmplitudePhase, "Done") - return(Status); -} /* end VolumeRealImaginaryToAmplitudePhase */ - diff --git a/src/core/bilib/dft.h b/src/core/bilib/dft.h deleted file mode 100644 index 1af21a8..0000000 --- a/src/core/bilib/dft.h +++ /dev/null @@ -1,1030 +0,0 @@ -/**@defgroup BilibFourierTransform Fourier Transform - @ingroup BilibLibrary */ -//@{ - -/*--------------------------------------------------------------------------*/ -/** Amplitude/Phase --> Real Imaginary. - Converts an (amplitude, phase) representation of a complex signal - into a (real, imaginary) representation the input phase is in [rad]. - in-place processing. The input signal (amplitude Am2Re and phase Ph2Im) is - replaced by the output signal (real Am2Re and imaginary Ph2Im) - SignalLength is the signal length. - - success: return(!ERROR); failure: return(ERROR); -*/ -extern int AmplitudePhaseToRealImaginary - ( - double Am2Re[], /* (amplitude -> real) */ - double Ph2Im[], /* (phase -> imaginary) */ - long SignalLength /* signal length */ - ); - -/*--------------------------------------------------------------------------*/ -/** DFT of a complex signal. - - Computes the direct DFT of a complex signal given in - (amplitude, phase) representation and returns an (amplitude, phase) - representation. The input phase is in [rad]. The output phase is in - [rad]; its domain is (-PI, PI). The origin is at index [0]. - - The highest coordinate (SignalLength-2)/2 is at index - [(SignalLength-2)/2] for SignalLength even. The highest coordinate - (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd. - - The lowest coordinate -SignalLength/2 is at index [SignalLength/2] - for SignalLength even. The lowest coordinate -(SignalLength-1)/2 is at - index [(SignalLength+1)/2] for SignalLength odd. - - The coordinate -1 is at index [SignalLength-1] for SignalLength even or - odd. - - In-place processing. The input signal (amplitude Am2Am and phase Ph2Ph) is - replaced by the output signal (amplitude Am2Am and phase Ph2Ph). - - (TmpRe, TmpIm) are pre-allocated workspaces of size SignalLength each - the values returned in (TmpRe, TmpIm) are meaningless. - - CaS is an input array of coefficients of size SignalLength - (see GetCaS function). - CaS is modified internally, but is restored when - DftAmplitudePhaseToAmplitudePhase returns. - - SignalLength is the length of the signal. - no restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5. - - success: return(!ERROR); failure: return(ERROR); -*/ -extern int DftAmplitudePhaseToAmplitudePhase - ( - double Am2Am[], /* amplitude -> amplitude */ - double Ph2Ph[], /* phase -> phase */ - double *TmpRe, /* first scratch workspace */ - double *TmpIm, /* second scratch workspace */ - double CaS[], /* Hartley transform coefficients */ - long SignalLength /* signal length */ - ); - -/*--------------------------------------------------------------------------*/ -/** DFT of a complex signal. - - Computes the direct DFT of a complex signal given in (amplitude, phase) - representation and returns a (real, imaginary) representation. The input - phase is in [rad]. The origin is at index [0]. - - The highest coordinate (SignalLength-2)/2 is at index - [(SignalLength-2)/2] for SignalLength even. The highest coordinate - (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd. - - The lowest coordinate -SignalLength/2 is at index [SignalLength/2] for - SignalLength even. The lowest coordinate -(SignalLength-1)/2 is at index - [(SignalLength+1)/2] for SignalLength odd. - - The coordinate -1 is at index [SignalLength-1] for SignalLength even or odd. - - In-place processing. The input signal (amplitude Am2Re and phase Ph2Im) is - replaced by the output signal (real Am2Re and imaginary Ph2Im). - - (TmpRe, TmpIm) are pre-allocated workspaces of size SignalLength each. - The values returned in (TmpRe, TmpIm) are meaningless. - - CaS is an input array of coefficients of size SignalLength - (see GetCaS function). CaS is modified internally, but is restored when - DftAmplitudePhaseToRealImaginary returns. - - SignalLength is the length of the signal. - No restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5. - - success: return(!ERROR); failure: return(ERROR); -*/ -extern int DftAmplitudePhaseToRealImaginary - ( - double Am2Re[], /* amplitude -> real */ - double Ph2Im[], /* phase -> imaginary */ - double *TmpRe, /* first scratch workspace */ - double *TmpIm, /* second scratch workspace */ - double CaS[], /* Hartley transform coefficients */ - long SignalLength /* signal length */ - ); - -/*--------------------------------------------------------------------------*/ -/** DFT of a complex signal. - - Computes the direct DFT of a complex signal given in (real, imaginary) - representation and returns an (amplitude, phase) representation. The - output phase is in [rad]; its domain is (-PI, PI). The origin is at index - [0]. - - The highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] - for SignalLength even. The highest coordinate (SignalLength-1)/2 is at - index [(SignalLength-1)/2] for SignalLength odd. - - The lowest coordinate -SignalLength/2 is at index [SignalLength/2] for - SignalLength even. The lowest coordinate -(SignalLength-1)/2 is at index - [(SignalLength+1)/2] for SignalLength odd. - - The coordinate -1 is at index [SignalLength-1] for SignalLength even or - odd. - - In-place processing. The input signal (real Re2Am and imaginary Im2Ph) is - replaced by the output signal (amplitude Re2Am and phase Im2Ph). - - (TmpRe, TmpIm) are pre-allocated workspaces of size SignalLength each. - The values returned in (TmpRe, TmpIm) are meaningless. - - CaS is an input array of coefficients of size SignalLength - (see GetCaS function). CaS is modified internally, but is restored - when DftRealImaginaryToAmplitudePhase returns. - - SignalLength is the length of the signal. No restriction on SignalLength, - but best efficiency for radix 2, 3, 4, 5. - - success: return(!ERROR); failure: return(ERROR); -*/ -extern int DftRealImaginaryToAmplitudePhase - ( - double Re2Am[], /* real -> amplitude */ - double Im2Ph[], /* imaginary -> phase */ - double *TmpRe, /* first scratch workspace */ - double *TmpIm, /* second scratch workspace */ - double CaS[], /* Hartley transform coefficients */ - long SignalLength /* signal length */ - ); - -/*--------------------------------------------------------------------------*/ -/** DFT of a complex signal. - - Computes the direct DFT of a complex signal given in (real, imaginary) - representation and returns a (real, imaginary) representation. The origin - is at index [0]. - - The highest coordinate (SignalLength-2)/2 is at index - [(SignalLength-2)/2] for SignalLength even. The highest coordinate - (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd. - - The lowest coordinate -SignalLength/2 is at index [SignalLength/2] for - SignalLength even. The lowest coordinate -(SignalLength-1)/2 is at index - [(SignalLength+1)/2] for SignalLength odd. - - The coordinate -1 is at index [SignalLength-1] for SignalLength even or - odd. - - In-place processing. The input signal (real Re2Re and imaginary Im2Im) is - replaced by the output signal (real Re2Re and imaginary Im2Im). - - (TmpRe, TmpIm) are pre-allocated workspaces of size SignalLength each. - The values returned in (TmpRe, TmpIm) are meaningless. - - CaS is an input array of coefficients of size SignalLength - (see GetCaS function). CaS is modified internally, but is restored - when DftRealImaginaryToRealImaginary returns - - SignalLength is the length of the signal. No restriction on SignalLength, - but best efficiency for radix 2, 3, 4, 5 - - success: return(!ERROR); failure: return(ERROR); -*/ -extern int DftRealImaginaryToRealImaginary - ( - double Re2Re[], /* real -> real */ - double Im2Im[], /* imaginary -> imaginary */ - double *TmpRe, /* first scratch workspace */ - double *TmpIm, /* second scratch workspace */ - double CaS[], /* Hartley transform coefficients */ - long SignalLength /* signal length */ - ); - -/*--------------------------------------------------------------------------*/ -/** DFT of a real signal. - - Computes the direct DFT of a real signal and returns an - (amplitude, phase) representation. The output phase is in [rad]; - its domain is (-PI, PI). The origin is at index [0]. - - The highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] - for SignalLength even. The highest coordinate (SignalLength-1)/2 is at - index [(SignalLength-1)/2] for SignalLength odd. - - The lowest coordinate -SignalLength/2 is at index [SignalLength/2] for - SignalLength even. The lowest coordinate -(SignalLength-1)/2 is at index - [(SignalLength+1)/2] for SignalLength odd. - - The coordinate -1 is at index [SignalLength-1] for SignalLength even or - odd. - - In-place processing. Te input signal (real R2Am) is replaced by the - output signal (amplitude R2Am and phase PhOut). - - Tmp is a pre-allocated workspace of size SignalLength. - The values returned in Tmp are meaningless. - - CaS is an input array of coefficients of size SignalLength - (see GetCaS function). CaS is modified internally, but is restored - when DftRealToAmplitudePhase returns. - - SignalLength is the length of the signal. No restriction on SignalLength, - but best efficiency for radix 2, 3, 4, 5 - - success: return(!ERROR); failure: return(ERROR); -*/ -extern int DftRealToAmplitudePhase - ( - double R2Am[], /* real -> amplitude */ - double PhOut[], /* output phase */ - double *Tmp, /* scratch workspace */ - double CaS[], /* Hartley transform coefficients */ - long SignalLength /* signal length */ - ); - -/*--------------------------------------------------------------------------*/ -/** DFT of a real signal. - - Computes the direct DFT of a real signal and returns a - (real, imaginary) representation. The origin is at index [0]. - - The highest coordinate (SignalLength-2)/2 is at index - [(SignalLength-2)/2] for SignalLength even. The highest coordinate - (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd. - - The lowest coordinate -SignalLength/2 is at index [SignalLength/2] for - SignalLength even. The lowest coordinate -(SignalLength-1)/2 is at index - [(SignalLength+1)/2] for SignalLength odd. - - The coordinate -1 is at index [SignalLength-1] for SignalLength even or odd. - - In-place processing. The input signal (real R2Re) is replaced by the - output signal (real R2Re and imaginary ImOut). - - Tmp is a pre-allocated workspace of size SignalLength. The values returned - in Tmp are meaningless. - - CaS is an input array of coefficients of size SignalLength - (see GetCaS function). CaS is modified internally, but is restored - when DftRealToRealImaginary returns. - - SignalLength is the length of the signal. No restriction on SignalLength, - but best efficiency for radix 2, 3, 4, 5 - - success: return(!ERROR); failure: return(ERROR); -*/ -extern int DftRealToRealImaginary - ( - double R2Re[], /* real -> real */ - double ImOut[], /* output imaginary */ - double *Tmp, /* scratch workspace */ - double CaS[], /* Hartley transform coefficients */ - long SignalLength /* signal length */ - ); - -/*--------------------------------------------------------------------------*/ -/** Compute the CaS array necessary for Fourier transforms. - - Computes an array of coefficients of size SignalLength. These - coefficients are necessary for performing a Hartley transform. The - Hartley transform is an alternate representation of Fourier for real - signals. Hartley computations are more accurate (less roundoff errors) - than Fourier. The same coefficients are used for direct and inverse - transforms. - - success: return(!ERROR); failure: return(ERROR); -*/ -extern int GetCaS - ( - double CaS[], /* Hartley transform coefficients */ - long SignalLength /* signal length */ - ); - -/*--------------------------------------------------------------------------*/ -/** Inverse Fourier Transform of a complex signal. - - Computes the inverse DFT of a complex signal given in (amplitude, phase) - representation and returns an (amplitude, phase) representation. - The input phase is in [rad]. The output phase is in [rad]; - its domain is (-PI, PI). The origin is at index [0]. - - The highest coordinate (SignalLength-2)/2 is at index - [(SignalLength-2)/2] for SignalLength even. The highest coordinate - (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd. - - The lowest coordinate -SignalLength/2 is at index [SignalLength/2] for - SignalLength even. The lowest coordinate -(SignalLength-1)/2 is at - index [(SignalLength+1)/2] for SignalLength odd. - - The coordinate -1 is at index [SignalLength-1] for SignalLength even or odd. - - In-place processing. The input signal (amplitude Am2Am and phase Ph2Ph) is - replaced by the output signal (amplitude Am2Am and phase Ph2Ph). - - (TmpRe, TmpIm) are pre-allocated workspaces of size SignalLength each. - The values returned in (TmpRe, TmpIm) are meaningless. - - CaS is an input array of coefficients of size SignalLength - (see GetCaS function). CaS is modified internally, but is restored when - DftAmplitudePhaseToAmplitudePhase returns. - - SignalLength is the length of the signal. No restriction on SignalLength, - but best efficiency for radix 2, 3, 4, 5 - - success: return(!ERROR); failure: return(ERROR); -*/ -extern int InvDftAmplitudePhaseToAmplitudePhase - ( - double Am2Am[], /* amplitude -> amplitude */ - double Ph2Ph[], /* phase -> phase */ - double *TmpRe, /* first scratch workspace */ - double *TmpIm, /* second scratch workspace */ - double CaS[], /* Hartley transform coefficients */ - long SignalLength /* signal length */ - ); - -/*--------------------------------------------------------------------------*/ -/** Inverse Fourier Transform of a real signal. - - Computes the inverse DFT of a complex signal given in (amplitude, phase) - representation and returns a real signal. The complex Fourier signal is - symmetrized before the inverse transformation is applied. The input phase - is in [rad]. The origin is at index [0]. - - The highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] - for SignalLength even. The highest coordinate (SignalLength-1)/2 is at - index [(SignalLength-1)/2] for SignalLength odd. - - The lowest coordinate -SignalLength/2 is at index [SignalLength/2] for - SignalLength even. The lowest coordinate -(SignalLength-1)/2 is at index - [(SignalLength+1)/2] for SignalLength odd. - - The coordinate -1 is at index [SignalLength-1] for SignalLength even or odd. - - In-place processing. The input signal (amplitude Am2R and phase PhIn) is - replaced by the output signal (real Am2R). - - Tmp is a pre-allocated workspace of size SignalLength. The values returned - in Tmp are meaningless. - - CaS is an input array of coefficients of size SignalLength - (see GetCaS function). CaS is modified internally, but is restored when - InvDftAmplitudePhaseToReal returns. - - SignalLength is the length of the signal. No restriction on SignalLength, - but best efficiency for radix 2, 3, 4, 5 - - success: return(!ERROR); failure: return(ERROR); -*/ -extern int InvDftAmplitudePhaseToReal - ( - double Am2R[], /* amplitude -> real */ - double PhIn[], /* input phase */ - double *Tmp, /* scratch workspace */ - double CaS[], /* Hartley transform coefficients */ - long SignalLength /* signal length */ - ); - -/*--------------------------------------------------------------------------*/ -/** Inverse Fourier Transform of a complex signal. - - Computes the inverse DFT of a complex signal given in (amplitude, phase) - representation and returns a (real, imaginary) representation. The input - phase is in [rad]. The origin is at index [0]. - - The highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] - for SignalLength even. The highest coordinate (SignalLength-1)/2 is at - index [(SignalLength-1)/2] for SignalLength odd. - - The lowest coordinate -SignalLength/2 is at index [SignalLength/2] for - SignalLength even. The lowest coordinate -(SignalLength-1)/2 is at index - [(SignalLength+1)/2] for SignalLength odd. - - The coordinate -1 is at index [SignalLength-1] for SignalLength even or odd. - - In-place processing. The input signal (amplitude Am2Re and phase Ph2Im) is - replaced by the output signal (real Am2Re and imaginary Ph2Im). - - (TmpRe, TmpIm) are pre-allocated workspaces of size SignalLength each. - Tthe values returned in (TmpRe, TmpIm) are meaningless. - - CaS is an input array of coefficients of size SignalLength - (see GetCaS function). CaS is modified internally, but is restored when - InvDftAmplitudePhaseToRealImaginary returns. - - SignalLength is the length of the signal. - No restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5. - - success: return(!ERROR); failure: return(ERROR); -*/ -extern int InvDftAmplitudePhaseToRealImaginary - ( - double Am2Re[], /* amplitude -> real */ - double Ph2Im[], /* phase -> imaginary */ - double *TmpRe, /* first scratch workspace */ - double *TmpIm, /* second scratch workspace */ - double CaS[], /* Hartley transform coefficients */ - long SignalLength /* signal length */ - ); - -/*--------------------------------------------------------------------------*/ -/** Inverse Fourier Transform for a complex signal. - - Computes the inverse DFT of a complex signal given in (real, imaginary) - representation and returns an (amplitude, phase) representation. - The output phase is in [rad]; its domain is (-PI, PI). The origin is - at index [0]. - - The highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] - for SignalLength even. The highest coordinate (SignalLength-1)/2 is at - index [(SignalLength-1)/2] for SignalLength odd. - - The lowest coordinate -SignalLength/2 is at index [SignalLength/2] for - SignalLength even. The lowest coordinate -(SignalLength-1)/2 is at index - [(SignalLength+1)/2] for SignalLength odd. - - The coordinate -1 is at index [SignalLength-1] for SignalLength even or odd. - - In-place processing. The input signal (real Re2Am and imaginary Im2Ph) is - replaced by the output signal (amplitude Re2Am and phase Im2Ph). - - (TmpRe, TmpIm) are pre-allocated workspaces of size SignalLength each. - The values returned in (TmpRe, TmpIm) are meaningless. - - CaS is an input array of coefficients of size SignalLength - (see GetCaS function). CaS is modified internally, but is restored when - InvDftRealImaginaryToAmplitudePhase returns. - - SignalLength is the length of the signal. No restriction on SignalLength, - but best efficiency for radix 2, 3, 4, 5 - - success: return(!ERROR); failure: return(ERROR); -*/ -extern int InvDftRealImaginaryToAmplitudePhase - ( - double Re2Am[], /* real -> amplitude */ - double Im2Ph[], /* imaginary -> phase */ - double *TmpRe, /* first scratch workspace */ - double *TmpIm, /* second scratch workspace */ - double CaS[], /* Hartley transform coefficients */ - long SignalLength /* signal length */ - ); - -/*--------------------------------------------------------------------------*/ -/** Inverse Fourier Transform of a real signal. - - Computes the inverse DFT of a complex signal given in (real, imaginary) - representation and returns a real signal. The complex Fourier signal is - symmetrized before the inverse transformation is applied. The origin is - at index [0]. - - The highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] - for SignalLength even. The highest coordinate (SignalLength-1)/2 is at - index [(SignalLength-1)/2] for SignalLength odd. - - The lowest coordinate -SignalLength/2 is at index [SignalLength/2] for - SignalLength even. The lowest coordinate -(SignalLength-1)/2 is at index - [(SignalLength+1)/2] for SignalLength odd. - - The coordinate -1 is at index [SignalLength-1] for SignalLength even or odd. - - In-place processing. The input signal (real Re2R and imaginary ImIn) is - replaced by the output signal (real Re2R). - - Tmp is a pre-allocated workspace of size SignalLength. The values returned - in Tmp are meaningless. - - CaS is an input array of coefficients of size SignalLength - (see GetCaS function). CaS is modified internally, but is restored when - InvDftRealImaginaryToReal returns. - - SignalLength is the length of the signal. No restriction on SignalLength, - but best efficiency for radix 2, 3, 4, 5 - - success: return(!ERROR); failure: return(ERROR); -*/ -extern int InvDftRealImaginaryToReal - ( - double Re2R[], /* real -> real */ - double ImIn[], /* input imaginary */ - double *Tmp, /* scratch workspace */ - double CaS[], /* Hartley transform coefficients */ - long SignalLength /* signal length */ - ); - -/*--------------------------------------------------------------------------*/ -/** Inverse Fourier Transform of a complex signal. - - Computes the inverse DFT of a complex signal given in (real, imaginary) - representation and returns a (real, imaginary) representation. - The origin is at index [0]. - - The highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] - for SignalLength even. The highest coordinate (SignalLength-1)/2 is at - index [(SignalLength-1)/2] for SignalLength odd. - - The lowest coordinate -SignalLength/2 is at index [SignalLength/2] for - SignalLength even. The lowest coordinate -(SignalLength-1)/2 is at index - [(SignalLength+1)/2] for SignalLength odd. - - The coordinate -1 is at index [SignalLength-1] for SignalLength even or odd. - - In-place processing. The input signal (real Re2Re and imaginary Im2Im) is - replaced by the output signal (real Re2Re and imaginary Im2Im). - - (TmpRe, TmpIm) are pre-allocated workspaces of size SignalLength each. - The values returned in (TmpRe, TmpIm) are meaningless. - - CaS is an input array of coefficients of size SignalLength - (see GetCaS function). CaS is modified internally, but is restored when - InvDftRealImaginaryToRealImaginary returns. - - SignalLength is the length of the signal. No restriction on SignalLength, - but best efficiency for radix 2, 3, 4, 5 - - success: return(!ERROR); failure: return(ERROR); -*/ -extern int InvDftRealImaginaryToRealImaginary - ( - double Re2Re[], /* real -> real */ - double Im2Im[], /* imaginary -> imaginary */ - double *TmpRe, /* first scratch workspace */ - double *TmpIm, /* second scratch workspace */ - double CaS[], /* Hartley transform coefficients */ - long SignalLength /* signal length */ - ); - -/*--------------------------------------------------------------------------*/ -/** Real/Imaginary --> Amplitude/Phase. - - Converts a (real, imaginary) representation of a complex signal - into an (amplitude, phase) representation The output phase is in [rad]; - its domain is (-PI, PI). - - In-place processing. The input signal (real Re2Am and imaginary Im2Ph) is - replaced by the output signal (amplitude Re2Am and phase Im2Ph). - - SignalLength is the signal length. - - success: return(!ERROR); failure: return(ERROR); -*/ -extern int RealImaginaryToAmplitudePhase - ( - double Re2Am[], /* real -> amplitude */ - double Im2Ph[], /* imaginary -> phase */ - long SignalLength /* signal length */ - ); - -/*--------------------------------------------------------------------------*/ -/** Volume Amplitude/Phase --> Real/Imaginary. - Converts an (amplitude, phase) representation of a complex signal - into a (real, imaginary) representation. - - The input phase is in [rad]. In-place processing . - The input signal (amplitude Am2Re and phase Ph2Im) is - replaced by the output signal (real Am2Re and imaginary Ph2Im). - - Nx is the width of the volume. Ny is the height of the volume. - Nz is the depth of the volume. - - success: return(!ERROR); failure: return(ERROR); */ -extern int VolumeAmplitudePhaseToRealImaginary - ( - double Am2Re[], /* (amplitude -> real) */ - double Ph2Im[], /* (phase -> imaginary) */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz /* depth of the volume */ - ); - -/*--------------------------------------------------------------------------*/ -/** Direct DFT of a complex signal. - Computes the direct DFT of a complex signal given in (amplitude, phase) - representation and returns an (amplitude, phase) representation. - - The input phase is in [rad]. The output phase is in [rad]; its domain - is (-PI, PI). The origin is at index [0]. - - The highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] - for SignalLength even. The highest coordinate (SignalLength-1)/2 is at - index [(SignalLength-1)/2] for SignalLength odd. - The lowest coordinate -SignalLength/2 is at index [SignalLength/2] for - SignalLength even. The lowest coordinate -(SignalLength-1)/2 is at index - [(SignalLength+1)/2] for SignalLength odd. - The coordinate -1 is at index [SignalLength-1] for SignalLength even or - odd. - - No restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5. - In the explanations above, SignalLength has to be replaced by Nx, Ny, Nz. - - Nx is the width of the volume. Ny is the height of the volume. - Nz is the depth of the volume. - - In-place processing. The input signal (amplitude Am2Am and phase Ph2Ph) is - replaced by the output signal (amplitude Am2Am and phase Ph2Ph). - - success: return(!ERROR); failure: return(ERROR); - The returned value is duplicated in Status */ -extern int VolumeDftAmplitudePhaseToAmplitudePhase - ( - double *Am2Am, /* amplitude -> amplitude */ - double *Ph2Ph, /* phase -> phase */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Computes the direct DFT of a complex signal. - Computes the direct DFT of a complex signal given in (amplitude, phase) - representation and returns a (real, imaginary) representation. - - The input phase is in [rad]. The origin is at index [0]. - The highest coordinate (SignalLength-2)/2 is at index - [(SignalLength-2)/2] for SignalLength even. The highest coordinate - (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd. - The lowest coordinate -SignalLength/2 is at index [SignalLength/2] for - SignalLength even. The lowest coordinate -(SignalLength-1)/2 is at index - [(SignalLength+1)/2] for SignalLength odd. The coordinate -1 is at index - [SignalLength-1] for SignalLength even or odd. - - No restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5. - In the explanations above, SignalLength has to be replaced by Nx, Ny, Nz. - Nx is the width of the volume. Ny is the height of the volume. - Nz is the depth of the volume. - - In-place processing, the input signal (amplitude Am2Re and phase Ph2Im) is - replaced by the output signal (real Am2Re and imaginary Ph2Im). - - success: return(!ERROR); failure: return(ERROR); - The returned value is duplicated in Status */ -extern int VolumeDftAmplitudePhaseToRealImaginary - ( - double *Am2Re, /* amplitude -> real */ - double *Ph2Im, /* phase -> imaginary */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Computes the direct DFT of a complex signal. - Computes the direct DFT of a complex signal given in (real, imaginary) - representation and returns an (amplitude, phase) representation. - - The output phase is in [rad]; its domain is (-PI, PI). - The origin is at index [0]. The highest coordinate (SignalLength-2)/2 is - at index [(SignalLength-2)/2] for SignalLength even. The highest coordinate - (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd. - The lowest coordinate -SignalLength/2 is at index [SignalLength/2] for - SignalLength even. The lowest coordinate -(SignalLength-1)/2 is at index - [(SignalLength+1)/2] for SignalLength odd. The coordinate -1 is at index - [SignalLength-1] for SignalLength even or odd. - - No restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5. - In the explanations above, SignalLength has to be replaced by Nx, Ny, Nz. - Nx is the width of the volume. Ny is the height of the volume. - Nz is the depth of the volume. - - In-place processing. The input signal (real Re2Am and imaginary Im2Ph) is - replaced by the output signal (amplitude Re2Am and phase Im2Ph). - - Success: return(!ERROR); failure: return(ERROR); - The returned value is duplicated in Status */ -extern int VolumeDftRealImaginaryToAmplitudePhase - ( - double *Re2Am, /* real -> amplitude */ - double *Im2Ph, /* imaginary -> phase */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Computes the direct DFT of a complex signal. - Computes the direct DFT of a complex signal given in (real, imaginary) - representation and returns a (real, imaginary) representation. - - The origin is at index [0]. The highest coordinate (SignalLength-2)/2 is - at index [(SignalLength-2)/2] for SignalLength even. The highest coordinate - (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd. - The lowest coordinate -SignalLength/2 is at index [SignalLength/2] for - SignalLength even. The lowest coordinate -(SignalLength-1)/2 is at index - [(SignalLength+1)/2] for SignalLength odd. The coordinate -1 is at index - [SignalLength-1] for SignalLength even or odd. - - No restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5. - In the explanations above, SignalLength has to be replaced by Nx, Ny, Nz. - Nx is the width of the volume. Ny is the height of the volume. - Nz is the depth of the volume. - - In-place processing. The input signal (real Re2Re and imaginary Im2Im) is - replaced by the output signal (real Re2Re and imaginary Im2Ph). - - Success: return(!ERROR); failure: return(ERROR);. - The returned value is duplicated in Status */ -extern int VolumeDftRealImaginaryToRealImaginary - ( - double *Re2Re, /* real -> real */ - double *Im2Im, /* imaginary -> imaginary */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Computes the direct DFT of a real signal. - Computes the direct DFT of a real signal and returns an (amplitude, phase) - representation. The output phase is in [rad]; its domain is (-PI, PI). - - The origin is at index [0]. The highest coordinate (SignalLength-2)/2 is - at index [(SignalLength-2)/2] for SignalLength even. The highest coordinate - (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd. - The lowest coordinate -SignalLength/2 is at index [SignalLength/2] for - SignalLength even. The lowest coordinate -(SignalLength-1)/2 is at index - [(SignalLength+1)/2] for SignalLength odd. The coordinate -1 is at index - [SignalLength-1] for SignalLength even or odd. - - No restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5. - In the explanations above, SignalLength has to be replaced by Nx, Ny, Nz. - Nx is the width of the volume. Ny is the height of the volume. - Nz is the depth of the volume. - - In-place processing. The input signal Re2Am is replaced by the output - signal (amplitude Re2Am and phase PhOut). - - success: return(!ERROR); failure: return(ERROR); - The returned value is duplicated in Status */ -extern int VolumeDftRealToAmplitudePhase - ( - double *Re2Am, /* real -> amplitude */ - double *PhOut, /* output phase */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Computes the direct DFT of a real signal. - Computes the direct DFT of a real signal and returns a (real, imaginary) - representation. - - The origin is at index [0]. The highest coordinate (SignalLength-2)/2 is - at index [(SignalLength-2)/2] for SignalLength even. The highest - coordinate (SignalLength-1)/2 is at index [(SignalLength-1)/2] for - SignalLength odd. The lowest coordinate -SignalLength/2 is at index - [SignalLength/2] for SignalLength even. The lowest coordinate - -(SignalLength-1)/2 is at index [(SignalLength+1)/2] for SignalLength odd. - The coordinate -1 is at index [SignalLength-1] for SignalLength even or - odd. - - No restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5. - In the explanations above, SignalLength has to be replaced by Nx, Ny, Nz. - Nx is the width of the volume. Ny is the height of the volume. - Nz is the depth of the volume. - - In-place processing. The input signal Re2Re is - replaced by the output signal (real Re2Re and imaginary ImOut). - - success: return(!ERROR); failure: return(ERROR); - The returned value is duplicated in Status */ -extern int VolumeDftRealToRealImaginary - ( - double *Re2Re, /* real -> real */ - double *ImOut, /* output imaginary */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Computes the inverse DFT of a complex signal. - Computes the inverse DFT of a complex signal given in (amplitude, phase) - representation and returns an (amplitude, phase) representation. - The input phase is in [rad]. The output phase is in [rad]; its domain is - (-PI, PI). - - The origin is at index [0]. The highest coordinate (SignalLength-2)/2 is - at index [(SignalLength-2)/2] for SignalLength even. The highest - coordinate (SignalLength-1)/2 is at index [(SignalLength-1)/2] for - SignalLength odd. The lowest coordinate -SignalLength/2 is at index - [SignalLength/2] for SignalLength even. The lowest coordinate - -(SignalLength-1)/2 is at index [(SignalLength+1)/2] for SignalLength odd. - The coordinate -1 is at index [SignalLength-1] for SignalLength even or - odd. - - No restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5. - In the explanations above, SignalLength has to be replaced by Nx, Ny, Nz. - Nx is the width of the volume. Ny is the height of the volume. - Nz is the depth of the volume. - - In-place processing. The input signal (amplitude Am2Am and phase Ph2Ph) is - replaced by the output signal (amplitude Am2Am and phase Ph2Ph). - - success: return(!ERROR); failure: return(ERROR); - The returned value is duplicated in Status */ -extern int VolumeInvDftAmplitudePhaseToAmplitudePhase - ( - double *Am2Am, /* amplitude -> amplitude */ - double *Ph2Ph, /* phase -> phase */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Computes the inverse DFT of a complex signal. - Computes the inverse DFT of a complex signal given in (amplitude, phase) - representation and returns a real signal. - The complex Fourier signal is symmetrized before the inverse - transformation is applied. The input phase is in [rad]. - The origin is at index [0]. - - The highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] - for SignalLength even. The highest coordinate (SignalLength-1)/2 is at - index [(SignalLength-1)/2] for SignalLength odd. The lowest coordinate - -SignalLength/2 is at index [SignalLength/2] for SignalLength even. - The lowest coordinate -(SignalLength-1)/2 is at index [(SignalLength+1)/2] - for SignalLength odd. The coordinate -1 is at index [SignalLength-1] for - SignalLength even or odd. - - No restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5. - In the explanations above, SignalLength has to be replaced by Nx, Ny, Nz. - Nx is the width of the volume. Ny is the height of the volume. - Nz is the depth of the volume. - - In-place processing. The input signal (amplitude Am2Re and phase PhIn) is - replaced by the output signal (real Am2Re). PhIn is destroyed. - - success: return(!ERROR); failure: return(ERROR); - The returned value is duplicated in Status */ -extern int VolumeInvDftAmplitudePhaseToReal - ( - double *Am2Re, /* amplitude -> real */ - double *PhIn, /* input phase */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Computes the inverse DFT of a complex signal. - Computes the inverse DFT of a complex signal given in (amplitude, phase) - representation and returns a (real, imaginary) representation. - - The input phase is in [rad]. The origin is at index [0]. - - The highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] - for SignalLength even. The highest coordinate (SignalLength-1)/2 is at - index [(SignalLength-1)/2] for SignalLength odd. The lowest coordinate - -SignalLength/2 is at index [SignalLength/2] for SignalLength even. - The lowest coordinate -(SignalLength-1)/2 is at index [(SignalLength+1)/2] - for SignalLength odd. The coordinate -1 is at index [SignalLength-1] for - SignalLength even or odd. - - No restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5. - In the explanations above, SignalLength has to be replaced by Nx, Ny, Nz. - Nx is the width of the volume. Ny is the height of the volume. - Nz is the depth of the volume. - - In-place processing. The input signal (amplitude Am2Re and phase Ph2Im) is - replaced by the output signal (real Am2Re and imaginary Ph2Im). - - success: return(!ERROR); failure: return(ERROR); - The returned value is duplicated in Status */ -extern int VolumeInvDftAmplitudePhaseToRealImaginary - ( - double *Am2Re, /* amplitude -> real */ - double *Ph2Im, /* phase -> imaginary */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Computes the inverse DFT of a complex signal. - Computes the inverse DFT of a complex signal given in (real, imaginary) - representation and returns an (amplitude, phase) representation. - The output phase is in [rad]; its domain is (-PI, PI). - - The origin is at index [0]. The highest coordinate (SignalLength-2)/2 is - at index [(SignalLength-2)/2] for SignalLength even. The highest coordinate - (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd. - The lowest coordinate -SignalLength/2 is at index [SignalLength/2] for - SignalLength even. The lowest coordinate -(SignalLength-1)/2 is at index - [(SignalLength+1)/2] for SignalLength odd. The coordinate -1 is at index - [SignalLength-1] for SignalLength even or odd. - - No restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5. - In the explanations above, SignalLength has to be replaced by Nx, Ny, Nz. - Nx is the width of the volume. Ny is the height of the volume. - Nz is the depth of the volume. - - In-place processing. The input signal (real Re2Am and imaginary Im2Ph) is - replaced by the output signal (amplitude Re2Am and phase Im2Ph). - - success: return(!ERROR); failure: return(ERROR); - The returned value is duplicated in Status */ -extern int VolumeInvDftRealImaginaryToAmplitudePhase - ( - double *Re2Am, /* real -> amplitude */ - double *Im2Ph, /* imaginary -> phase */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Computes the inverse DFT of a complex signal. - Computes the inverse DFT of a complex signal given in (real, imaginary) - representation and returns a real signal. - The complex Fourier signal is symmetrized before the inverse transformation - is applied. - - The origin is at index [0]. The highest coordinate (SignalLength-2)/2 is - at index [(SignalLength-2)/2] for SignalLength even. The highest coordinate - (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd. - The lowest coordinate -SignalLength/2 is at index [SignalLength/2] for - SignalLength even. The lowest coordinate -(SignalLength-1)/2 is at index - [(SignalLength+1)/2] for SignalLength odd. The coordinate -1 is at index - [SignalLength-1] for SignalLength even or odd. - - No restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5. - In the explanations above, SignalLength has to be replaced by Nx, Ny, Nz. - Nx is the width of the volume. Ny is the height of the volume. - Nz is the depth of the volume. - - In-place processing. The input signal (real Re2Re and imaginary ImIn) is - replaced by the output signal (real Re2Re). - - success: return(!ERROR); failure: return(ERROR); - The returned value is duplicated in Status */ -extern int VolumeInvDftRealImaginaryToReal - ( - double *Re2Re, /* real -> real */ - double *ImIn, /* input imaginary */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Computes the inverse DFT of a complex signal. - Computes the inverse DFT of a complex signal given in (real, imaginary) - representation and returns a (real, imaginary) representation. - - The origin is at index [0]. The highest coordinate (SignalLength-2)/2 is - at index [(SignalLength-2)/2] for SignalLength even. The highest - coordinate (SignalLength-1)/2 is at index [(SignalLength-1)/2] for - SignalLength odd. The lowest coordinate -SignalLength/2 is at index - [SignalLength/2] for SignalLength even. The lowest coordinate - -(SignalLength-1)/2 is at index [(SignalLength+1)/2] for SignalLength odd. - The coordinate -1 is at index [SignalLength-1] for SignalLength even or - odd. - - No restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5. - In the explanations above, SignalLength has to be replaced by Nx, Ny, Nz. - Nx is the width of the volume. Ny is the height of the volume. - Nz is the depth of the volume. - - In-place processing. The input signal (real Re2Re and imaginary Im2Im) is - replaced by the output signal (real Re2Re and imaginary Im2Ph). - - success: return(!ERROR); failure: return(ERROR); - The returned value is duplicated in Status */ -extern int VolumeInvDftRealImaginaryToRealImaginary - ( - double *Re2Re, /* real -> real */ - double *Im2Im, /* imaginary -> imaginary */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Volume Real/Imaginary --> Amplitude/Phase. - Converts a (real, imaginary) representation of a complex signal - into an (amplitude, phase) representation. - The output phase is in [rad]; its domain is (-PI, PI). - - In-place processing. The input signal (real Re2Am and imaginary Im2Ph) is - replaced by the output signal (amplitude Re2Am and phase Im2Ph). - - Nx is the width of the volume. Ny is the height of the volume. - Nz is the depth of the volume. - - success: return(!ERROR); failure: return(ERROR);*/ -extern int VolumeRealImaginaryToAmplitudePhase - ( - double Re2Am[], /* real -> amplitude */ - double Im2Ph[], /* imaginary -> phase */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz /* depth of the volume */ - ); -//@} diff --git a/src/core/bilib/dht.cc b/src/core/bilib/dht.cc deleted file mode 100644 index 3125b23..0000000 --- a/src/core/bilib/dht.cc +++ /dev/null @@ -1,862 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -#include -#include - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "dht.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -#ifdef DEBUG -#include -#include -#include "messagedisplay.h" -#endif - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern int DiscreteHartleyTransform - ( - double Data[], /* signal */ - double *ScratchBuffer, /* scratch buffer */ - double CaS[], /* coefficients */ - long SignalLength, /* signal length */ - int Forward /* direction */ - ) - -/* computes the Discrete Hartley Transform of a Real signal */ -/* the input signal is given by Data (double) */ -/* the computation is in-place (the output replaces the input) */ -/* ScratchBuffer is a pre-allocated workspace of size SignalLength */ -/* the values returned in ScratchBuffer are meaningless */ -/* CaS is an input array of coefficients of size SignalLength (see GetCaS function) */ -/* CaS is modified internally, but is restored when DHT returns */ -/* SignalLength is the length of the signal */ -/* no restriction on SignalLength, but best efficiency for radix 2, 3, 4, 5 */ -/* performs a DHT transform when (Forward == TRUE) */ -/* performs an inverse DHT transform when (Forward == FALSE) */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin DiscreteHartleyTransform */ - - static double - *p, *q, *r, *s, *t, *u, *v, *w, *x, *y, *z; - static double - *x1, *y1, *x2, *y2, *x3, *y3, *x4, *y4; - static double - a, b, c, d; - long nHalf, nThird, nFifth; - static long - i; - static int - Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(DiscreteHartleyTransform, Data, Status, -/**/ "No data") -/**/DEBUG_CHECK_NULL_POINTER(DiscreteHartleyTransform, ScratchBuffer, Status, -/**/ "No buffer") -/**/DEBUG_CHECK_NULL_POINTER(DiscreteHartleyTransform, CaS, Status, -/**/ "No Hartley coefficients") -/**/DEBUG_CHECK_RANGE_LONG(DiscreteHartleyTransform, SignalLength, 1L, LONG_MAX, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_INT(DiscreteHartleyTransform, Forward, FALSE, TRUE, Status, -/**/ "Use TRUE for direct Hartley transform and FALSE for inverse Hartley transform") -/**/DEBUG_RETURN_ON_ERROR(DiscreteHartleyTransform, Status) -/**/DEBUG_WRITE_ENTERING(DiscreteHartleyTransform, -/**/ "About to perform a Hartley transform") - - if (SignalLength == 1L) { - } - else if (SignalLength == 2L) { - a = *Data++; - b = *Data; - if (Forward) { - *Data-- = (a - b) * 0.5; - *Data = (a + b) * 0.5; - } - else { - *Data-- = a - b; - *Data = a + b; - } - } - else if (SignalLength == 3L) { - a = *Data++; - b = *Data++; - if (Forward) { - c = (b - *Data) * 0.2886751345948128822545743902509787278238008756350634380093012; - b += *Data; - d = (2.0 * a - b) * (1.0 / 6.0); - *Data-- = d - c; - *Data-- = d + c; - *Data = (a + b) * (1.0 / 3.0); - } - else { - c = (b - *Data) * 0.866025403784438646763723170752936183471402626905190314027903; - b += *Data; - d = a - b * 0.5; - *Data-- = d - c; - *Data-- = d + c; - *Data = a + b; - } - } - else if (SignalLength == 4L) { - p = Data + (ptrdiff_t)2; - a = *p; - *p = *Data - *p; - *Data += a; - Data++; - a = *++p; - *p = *Data - *p; - *Data += a; - Data++; - a = *p; - if (Forward) { - *p = (*Data-- - *p) * 0.25; - b = *Data; - *Data-- = (*--p + a) * 0.25; - *p = (*Data - b) * 0.25; - *Data = (*Data + b) * 0.25; - } - else { - *p = *Data-- - *p; - b = *Data; - *Data-- = *--p + a; - *p = *Data - b; - *Data += b; - } - } - else if (SignalLength == 5L) { - ScratchBuffer = (double *)memcpy(ScratchBuffer, Data, - (size_t)(5L * (long)sizeof(double))); - p = ScratchBuffer + (ptrdiff_t)5; - q = CaS + (ptrdiff_t)5; - r = ScratchBuffer; - a = 0.0; - while (r < p) { - a += *r++; - } - *Data++ = (Forward) ? (a * 0.2) : (a); - for (i = 1L; (i < 5L); i++) { - r = ScratchBuffer; - s = CaS; - a = 0.0; - while (r < p) { - a += *r++ * *s; - s += (ptrdiff_t)i; - if (q <= s) { - s -= (ptrdiff_t)5; - } - } - *Data++ = (Forward) ? (a * 0.2) : (a); - } - } - else if ((SignalLength & 1L) == 0L) { - nHalf = SignalLength / 2L; - ScratchBuffer = (double *)memcpy(ScratchBuffer, Data, - (size_t)(SignalLength * (long)sizeof(double))); - p = ScratchBuffer; - q = ScratchBuffer + (ptrdiff_t)nHalf; - r = Data; - s = Data + (ptrdiff_t)1; - for (i = nHalf; (0L < i--); r += (ptrdiff_t)2, s += (ptrdiff_t)2) { - *p++ = *r; - *q++ = *s; - } - Data = (double *)memcpy(Data, CaS, (size_t)(SignalLength * (long)sizeof(double))); - p = CaS; - q = CaS + (ptrdiff_t)nHalf; - r = Data; - s = Data + (ptrdiff_t)1; - for (i = nHalf; (0L < i--); r += (ptrdiff_t)2, s += (ptrdiff_t)2) { - *p++ = *r; - *q++ = *s; - } - Status = DiscreteHartleyTransform(ScratchBuffer, Data, CaS, nHalf, Forward); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DiscreteHartleyTransform, "Done") - return(Status); - } - Status = DiscreteHartleyTransform(ScratchBuffer + (ptrdiff_t)nHalf, - Data, CaS, nHalf, Forward); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DiscreteHartleyTransform, "Done") - return(Status); - } - Data = (double *)memcpy(Data, CaS, (size_t)(SignalLength * (long)sizeof(double))); - p = CaS; - r = Data; - s = Data + (ptrdiff_t)nHalf; - i = nHalf; - while (0L < i--) { - *p++ = *r++; - *p++ = *s++; - } - p = ScratchBuffer + (ptrdiff_t)nHalf; - q = ScratchBuffer + (ptrdiff_t)SignalLength; - for (p++, q--; (p < q); p++, q--) { - a = *p; - *p = (*p + *q) * 0.5; - *q = (a - *q) * 0.5; - } - p = CaS; - q = CaS + (ptrdiff_t)SignalLength; - r = ScratchBuffer + (ptrdiff_t)nHalf; - s = ScratchBuffer + (ptrdiff_t)SignalLength; - t = ScratchBuffer; - if (Forward) { - *Data++ = (*t++ + *r++) * 0.5; - p++; - q--; - s--; - while (r < s) { - *Data++ = (*t++ + *r++ * *p++ + *s-- * *q--) * 0.5; - } - if (r == s++) { - *Data++ = (*t++ + *r * *p++) * 0.5; - q--; - } - r--; - while (t < r) { - *Data++ = (*t++ + *r-- * *p++ - *s++ * *q--) * 0.5; - } - t = ScratchBuffer; - *Data++ = (*t++ - *r++) * 0.5; - p++; - q--; - s--; - while (r < s) { - *Data++ = (*t++ + *r++ * *p++ + *s-- * *q--) * 0.5; - } - if (r == s++) { - *Data++ = (*t++ + *r * *p++) * 0.5; - q--; - } - r--; - while (t < r) { - *Data++ = (*t++ + *r-- * *p++ - *s++ * *q--) * 0.5; - } - } - else { - *Data++ = *t++ + *r++; - p++; - q--; - s--; - while (r < s) { - *Data++ = *t++ + *r++ * *p++ + *s-- * *q--; - } - if (r == s++) { - *Data++ = *t++ + *r * *p++; - q--; - } - r--; - while (t < r) { - *Data++ = *t++ + *r-- * *p++ - *s++ * *q--; - } - t = ScratchBuffer; - *Data++ = *t++ - *r++; - p++; - q--; - s--; - while (r < s) { - *Data++ = *t++ + *r++ * *p++ + *s-- * *q--; - } - if (r == s++) { - *Data++ = *t++ + *r * *p++; - q--; - } - r--; - while (t < r) { - *Data++ = *t++ + *r-- * *p++ - *s++ * *q--; - } - } - } - else if ((SignalLength % 3L) == 0L) { - nThird = SignalLength / 3L; - ScratchBuffer = (double *)memcpy(ScratchBuffer, Data, - (size_t)(SignalLength * (long)sizeof(double))); - p = ScratchBuffer; - q = p + (ptrdiff_t)nThird; - r = q + (ptrdiff_t)nThird; - s = Data; - t = s + (ptrdiff_t)1; - u = t + (ptrdiff_t)1; - for (i = nThird; (0L < i--); - s += (ptrdiff_t)3, t += (ptrdiff_t)3, u += (ptrdiff_t)3) { - *p++ = *s; - *q++ = *t; - *r++ = *u; - } - Data = (double *)memcpy(Data, CaS, (size_t)(SignalLength * (long)sizeof(double))); - p = CaS; - q = p + (ptrdiff_t)nThird; - r = q + (ptrdiff_t)nThird; - s = Data; - t = s + (ptrdiff_t)1; - u = t + (ptrdiff_t)1; - for (i = nThird; (0L < i--); - s += (ptrdiff_t)3, t += (ptrdiff_t)3, u += (ptrdiff_t)3) { - *p++ = *s; - *q++ = *t; - *r++ = *u; - } - Status = DiscreteHartleyTransform(ScratchBuffer, Data, CaS, nThird, Forward); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DiscreteHartleyTransform, "Done") - return(Status); - } - Status = DiscreteHartleyTransform(ScratchBuffer + (ptrdiff_t)nThird, - Data, CaS, nThird, Forward); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DiscreteHartleyTransform, "Done") - return(Status); - } - Status = DiscreteHartleyTransform(ScratchBuffer + (ptrdiff_t)(2L * nThird), - Data, CaS, nThird, Forward); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DiscreteHartleyTransform, "Done") - return(Status); - } - Data = (double *)memcpy(Data, CaS, (size_t)(SignalLength * (long)sizeof(double))); - p = CaS; - r = Data; - s = r + (ptrdiff_t)nThird; - t = s + (ptrdiff_t)nThird; - i = nThird; - while (0L < i--) { - *p++ = *r++; - *p++ = *s++; - *p++ = *t++; - } - p = ScratchBuffer + (ptrdiff_t)nThird; - q = p + (ptrdiff_t)nThird; - r = q; - s = r + (ptrdiff_t)nThird; - for (p++, q--, r++, s--; (p < q); p++, q--, r++, s--) { - a = *p; - *p = (*p + *q) * 0.5; - *q = (a - *q) * 0.5; - a = *r; - *r = (*r + *s) * 0.5; - *s = (a - *s) * 0.5; - } - p = CaS; - q = p + (ptrdiff_t)SignalLength; - x = CaS; - y = x + (ptrdiff_t)SignalLength; - t = ScratchBuffer; - r = ScratchBuffer + (ptrdiff_t)nThird; - s = r + (ptrdiff_t)nThird; - u = s; - v = u + (ptrdiff_t)nThird; - if (Forward) { - *Data++ = (*t++ + *r++ + *u++) * (1.0 / 3.0); - for (p++, q--, x += (ptrdiff_t)2, y -= (ptrdiff_t)2, s--, v--; - (r < s); x += (ptrdiff_t)2, y -= (ptrdiff_t)2) { - *Data++ = (*t++ + *r++ * *p++ + *s-- * *q-- + *u++ * *x + *v-- * *y) - * (1.0 / 3.0); - } - for (r--, s++, u--, v++; (t < r); x += (ptrdiff_t)2, y -= (ptrdiff_t)2) { - *Data++ = (*t++ + *r-- * *p++ - *s++ * *q-- + *u-- * *x - *v++ * *y) - * (1.0 / 3.0); - } - t = ScratchBuffer; - *Data++ = (*t++ + *r++ * *p++ + *u++ * *x) * (1.0 / 3.0); - x += (ptrdiff_t)2; - y -= (ptrdiff_t)2; - for (q--, s--, v--; (r < s); x += (ptrdiff_t)2, y -= (ptrdiff_t)2) { - *Data++ = (*t++ + *r++ * *p++ + *s-- * *q-- + *u++ * *x + *v-- * *y) - * (1.0 / 3.0); - } - x -= (ptrdiff_t)2; - y += (ptrdiff_t)2; - for (r--, s++, u--, v++; (t < r); x -= (ptrdiff_t)2, y += (ptrdiff_t)2) { - *Data++ = (*t++ + *r-- * *p++ - *s++ * *q-- + *u-- * *y - *v++ * *x) - * (1.0 / 3.0); - } - t = ScratchBuffer; - *Data++ = (*t++ + *r++ * *p++ + *u++ * *y) * (1.0 / 3.0); - x -= (ptrdiff_t)2; - y += (ptrdiff_t)2; - for (q--, s--, v--; (r < s); x -= (ptrdiff_t)2, y += (ptrdiff_t)2) { - *Data++ = (*t++ + *r++ * *p++ + *s-- * *q-- + *u++ * *y + *v-- * *x) - * (1.0 / 3.0); - } - for (r--, s++, u--, v++; (t < r); x -= (ptrdiff_t)2, y += (ptrdiff_t)2) { - *Data++ = (*t++ + *r-- * *p++ - *s++ * *q-- + *u-- * *y - *v++ * *x) - * (1.0 / 3.0); - } - } - else { - *Data++ = *t++ + *r++ + *u++; - for (p++, q--, x += (ptrdiff_t)2, y -= (ptrdiff_t)2, s--, v--; - (r < s); x += (ptrdiff_t)2, y -= (ptrdiff_t)2) { - *Data++ = *t++ + *r++ * *p++ + *s-- * *q-- + *u++ * *x + *v-- * *y; - } - for (r--, s++, u--, v++; (t < r); x += (ptrdiff_t)2, y -= (ptrdiff_t)2) { - *Data++ = *t++ + *r-- * *p++ - *s++ * *q-- + *u-- * *x - *v++ * *y; - } - t = ScratchBuffer; - *Data++ = *t++ + *r++ * *p++ + *u++ * *x; - x += (ptrdiff_t)2; - y -= (ptrdiff_t)2; - for (q--, s--, v--; (r < s); x += (ptrdiff_t)2, y -= (ptrdiff_t)2) { - *Data++ = *t++ + *r++ * *p++ + *s-- * *q-- + *u++ * *x + *v-- * *y; - } - x -= (ptrdiff_t)2; - y += (ptrdiff_t)2; - for (r--, s++, u--, v++; (t < r); x -= (ptrdiff_t)2, y += (ptrdiff_t)2) { - *Data++ = *t++ + *r-- * *p++ - *s++ * *q-- + *u-- * *y - *v++ * *x; - } - t = ScratchBuffer; - *Data++ = *t++ + *r++ * *p++ + *u++ * *y; - x -= (ptrdiff_t)2; - y += (ptrdiff_t)2; - for (q--, s--, v--; (r < s); x -= (ptrdiff_t)2, y += (ptrdiff_t)2) { - *Data++ = *t++ + *r++ * *p++ + *s-- * *q-- + *u++ * *y + *v-- * *x; - } - for (r--, s++, u--, v++; (t < r); x -= (ptrdiff_t)2, y += (ptrdiff_t)2) { - *Data++ = *t++ + *r-- * *p++ - *s++ * *q-- + *u-- * *y - *v++ * *x; - } - } - } - else if ((SignalLength % 5L) == 0L) { - nFifth = SignalLength / 5L; - ScratchBuffer = (double *)memcpy(ScratchBuffer, Data, - (size_t)(SignalLength * (long)sizeof(double))); - p = ScratchBuffer; - q = p + (ptrdiff_t)nFifth; - r = q + (ptrdiff_t)nFifth; - s = r + (ptrdiff_t)nFifth; - t = s + (ptrdiff_t)nFifth; - u = Data; - v = u + (ptrdiff_t)1; - w = v + (ptrdiff_t)1; - x = w + (ptrdiff_t)1; - y = x + (ptrdiff_t)1; - for (i = nFifth; (0L < i--); u += (ptrdiff_t)5, v += (ptrdiff_t)5, - w += (ptrdiff_t)5, x += (ptrdiff_t)5, y += (ptrdiff_t)5) { - *p++ = *u; - *q++ = *v; - *r++ = *w; - *s++ = *x; - *t++ = *y; - } - Data = (double *)memcpy(Data, CaS, (size_t)(SignalLength * (long)sizeof(double))); - p = CaS; - q = p + (ptrdiff_t)nFifth; - r = q + (ptrdiff_t)nFifth; - s = r + (ptrdiff_t)nFifth; - t = s + (ptrdiff_t)nFifth; - u = Data; - v = u + (ptrdiff_t)1; - w = v + (ptrdiff_t)1; - x = w + (ptrdiff_t)1; - y = x + (ptrdiff_t)1; - for (i = nFifth; (0L < i--); u += (ptrdiff_t)5, v += (ptrdiff_t)5, - w += (ptrdiff_t)5, x += (ptrdiff_t)5, y += (ptrdiff_t)5) { - *p++ = *u; - *q++ = *v; - *r++ = *w; - *s++ = *x; - *t++ = *y; - } - Status = DiscreteHartleyTransform(ScratchBuffer, Data, CaS, nFifth, Forward); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DiscreteHartleyTransform, "Done") - return(Status); - } - Status = DiscreteHartleyTransform(ScratchBuffer + (ptrdiff_t)nFifth, - Data, CaS, nFifth, Forward); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DiscreteHartleyTransform, "Done") - return(Status); - } - Status = DiscreteHartleyTransform(ScratchBuffer + (ptrdiff_t)(2L * nFifth), - Data, CaS, nFifth, Forward); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DiscreteHartleyTransform, "Done") - return(Status); - } - Status = DiscreteHartleyTransform(ScratchBuffer + (ptrdiff_t)(3L * nFifth), - Data, CaS, nFifth, Forward); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DiscreteHartleyTransform, "Done") - return(Status); - } - Status = DiscreteHartleyTransform(ScratchBuffer + (ptrdiff_t)(4L * nFifth), - Data, CaS, nFifth, Forward); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DiscreteHartleyTransform, "Done") - return(Status); - } - Data = (double *)memcpy(Data, CaS, (size_t)(SignalLength * (long)sizeof(double))); - p = CaS; - u = Data; - v = u + (ptrdiff_t)nFifth; - w = v + (ptrdiff_t)nFifth; - x = w + (ptrdiff_t)nFifth; - y = x + (ptrdiff_t)nFifth; - i = nFifth; - while (0L < i--) { - *p++ = *u++; - *p++ = *v++; - *p++ = *w++; - *p++ = *x++; - *p++ = *y++; - } - p = ScratchBuffer + (ptrdiff_t)nFifth; - q = p + (ptrdiff_t)nFifth; - r = q; - s = r + (ptrdiff_t)nFifth; - t = s; - u = t + (ptrdiff_t)nFifth; - v = u; - w = v + (ptrdiff_t)nFifth; - for (p++, q--, r++, s--, t++, u--, v++, w--; (p < q); - p++, q--, r++, s--, t++, u--, v++, w--) { - a = *p; - *p = (*p + *q) * 0.5; - *q = (a - *q) * 0.5; - a = *r; - *r = (*r + *s) * 0.5; - *s = (a - *s) * 0.5; - a = *t; - *t = (*t + *u) * 0.5; - *u = (a - *u) * 0.5; - a = *v; - *v = (*v + *w) * 0.5; - *w = (a - *w) * 0.5; - } - x1 = CaS; - y1 = x1 + (ptrdiff_t)SignalLength; - x2 = CaS; - y2 = x2 + (ptrdiff_t)SignalLength; - x3 = CaS; - y3 = x3 + (ptrdiff_t)SignalLength; - x4 = CaS; - y4 = x4 + (ptrdiff_t)SignalLength; - z = ScratchBuffer; - p = z + (ptrdiff_t)nFifth; - q = p + (ptrdiff_t)nFifth; - r = q; - s = r + (ptrdiff_t)nFifth; - t = s; - u = t + (ptrdiff_t)nFifth; - v = u; - w = v + (ptrdiff_t)nFifth; - if (Forward) { - *Data++ = (*z++ + *p++ + *r++ + *t++ + *v++) * 0.2; - x2 += (ptrdiff_t)2; - y2 -= (ptrdiff_t)2; - x3 += (ptrdiff_t)3; - y3 -= (ptrdiff_t)3; - x4 += (ptrdiff_t)4; - y4 -= (ptrdiff_t)4; - for (x1++, y1--, q--, s--, u--, w--; (p < q); - x2 += (ptrdiff_t)2, y2 -= (ptrdiff_t)2, - x3 += (ptrdiff_t)3, y3 -= (ptrdiff_t)3, - x4 += (ptrdiff_t)4, y4 -= (ptrdiff_t)4) { - *Data++ = (*z++ + *p++ * *x1++ + *q-- * *y1-- + *r++ * *x2 + *s-- * *y2 - + *t++ * *x3 + *u-- * *y3 + *v++ * *x4 + *w-- * *y4) * 0.2; - } - for (p--, q++, r--, s++, t--, u++, v--, w++; (z < p); - x2 += (ptrdiff_t)2, y2 -= (ptrdiff_t)2, - x3 += (ptrdiff_t)3, y3 -= (ptrdiff_t)3, - x4 += (ptrdiff_t)4, y4 -= (ptrdiff_t)4) { - *Data++ = (*z++ + *p-- * *x1++ - *q++ * *y1-- + *r-- * *x2 - *s++ * *y2 - + *t-- * *x3 - *u++ * *y3 + *v-- * *x4 - *w++ * *y4) * 0.2; - } - z = ScratchBuffer; - *Data++ = (*z++ + *p++ * *x1 + *r++ * *x2 + *t++ * *x3 + *v++ * *x4) * 0.2; - x2 += (ptrdiff_t)2; - y2 -= (ptrdiff_t)2; - x3 += (ptrdiff_t)3; - y3 -= (ptrdiff_t)3; - x4 += (ptrdiff_t)4; - y4 -= (ptrdiff_t)4; - for (x1++, y1--, q--, s--, u--, w--; (p < q); - x2 += (ptrdiff_t)2, y2 -= (ptrdiff_t)2, - x3 += (ptrdiff_t)3, y3 -= (ptrdiff_t)3, - x4 += (ptrdiff_t)4, y4 -= (ptrdiff_t)4) { - if (y4 < CaS) { - x4 -= (ptrdiff_t)SignalLength; - y4 += (ptrdiff_t)SignalLength; - } - *Data++ = (*z++ + *p++ * *x1++ + *q-- * *y1-- + *r++ * *x2 + *s-- * *y2 - + *t++ * *x3 + *u-- * *y3 + *v++ * *x4 + *w-- * *y4) * 0.2; - } - for (p--, q++, r--, s++, t--, u++, v--, w++; (z < p); - x2 += (ptrdiff_t)2, y2 -= (ptrdiff_t)2, - x3 += (ptrdiff_t)3, y3 -= (ptrdiff_t)3, - x4 += (ptrdiff_t)4, y4 -= (ptrdiff_t)4) { - if (y3 < CaS) { - x3 -= (ptrdiff_t)SignalLength; - y3 += (ptrdiff_t)SignalLength; - } - *Data++ = (*z++ + *p-- * *x1++ - *q++ * *y1-- + *r-- * *x2 - *s++ * *y2 - + *t-- * *x3 - *u++ * *y3 + *v-- * *x4 - *w++ * *y4) * 0.2; - } - z = ScratchBuffer; - *Data++ = (*z++ + *p++ * *x1 + *r++ * *x2 + *t++ * *x3 + *v++ * *x4) * 0.2; - x2 += (ptrdiff_t)2; - y2 -= (ptrdiff_t)2; - x3 += (ptrdiff_t)3; - y3 -= (ptrdiff_t)3; - x4 += (ptrdiff_t)4; - y4 -= (ptrdiff_t)4; - for (x1++, y1--, q--, s--, u--, w--; (p < q); - x2 += (ptrdiff_t)2, y2 -= (ptrdiff_t)2, - x3 += (ptrdiff_t)3, y3 -= (ptrdiff_t)3, - x4 += (ptrdiff_t)4, y4 -= (ptrdiff_t)4) { - *Data++ = (*z++ + *p++ * *x1++ + *q-- * *y1-- + *r++ * *x2 + *s-- * *y2 - + *t++ * *x3 + *u-- * *y3 + *v++ * *x4 + *w-- * *y4) * 0.2; - } - x2 -= (ptrdiff_t)SignalLength; - y2 += (ptrdiff_t)SignalLength; - x4 -= (ptrdiff_t)SignalLength; - y4 += (ptrdiff_t)SignalLength; - for (p--, q++, r--, s++, t--, u++, v--, w++; (z < p); - x2 += (ptrdiff_t)2, y2 -= (ptrdiff_t)2, - x3 += (ptrdiff_t)3, y3 -= (ptrdiff_t)3, - x4 += (ptrdiff_t)4, y4 -= (ptrdiff_t)4) { - *Data++ = (*z++ + *p-- * *x1++ - *q++ * *y1-- + *r-- * *x2 - *s++ * *y2 - + *t-- * *x3 - *u++ * *y3 + *v-- * *x4 - *w++ * *y4) * 0.2; - } - z = ScratchBuffer; - *Data++ = (*z++ + *p++ * *x1 + *r++ * *x2 + *t++ * *x3 + *v++ * *x4) * 0.2; - x2 += (ptrdiff_t)2; - y2 -= (ptrdiff_t)2; - x3 += (ptrdiff_t)3; - y3 -= (ptrdiff_t)3; - x4 += (ptrdiff_t)4; - y4 -= (ptrdiff_t)4; - for (x1++, y1--, q--, s--, u--, w--; (p < q); - x2 += (ptrdiff_t)2, y2 -= (ptrdiff_t)2, - x3 += (ptrdiff_t)3, y3 -= (ptrdiff_t)3, - x4 += (ptrdiff_t)4, y4 -= (ptrdiff_t)4) { - if (y3 < CaS) { - x3 -= (ptrdiff_t)SignalLength; - y3 += (ptrdiff_t)SignalLength; - } - *Data++ = (*z++ + *p++ * *x1++ + *q-- * *y1-- + *r++ * *x2 + *s-- * *y2 - + *t++ * *x3 + *u-- * *y3 + *v++ * *x4 + *w-- * *y4) * 0.2; - } - for (p--, q++, r--, s++, t--, u++, v--, w++; (z < p); - x2 += (ptrdiff_t)2, y2 -= (ptrdiff_t)2, - x3 += (ptrdiff_t)3, y3 -= (ptrdiff_t)3, - x4 += (ptrdiff_t)4, y4 -= (ptrdiff_t)4) { - if (y4 < CaS) { - x4 -= (ptrdiff_t)SignalLength; - y4 += (ptrdiff_t)SignalLength; - } - *Data++ = (*z++ + *p-- * *x1++ - *q++ * *y1-- + *r-- * *x2 - *s++ * *y2 - + *t-- * *x3 - *u++ * *y3 + *v-- * *x4 - *w++ * *y4) * 0.2; - } - z = ScratchBuffer; - *Data++ = (*z++ + *p++ * *x1 + *r++ * *x2 + *t++ * *x3 + *v++ * *x4) * 0.2; - x2 += (ptrdiff_t)2; - y2 -= (ptrdiff_t)2; - x3 += (ptrdiff_t)3; - y3 -= (ptrdiff_t)3; - x4 += (ptrdiff_t)4; - y4 -= (ptrdiff_t)4; - for (x1++, y1--, q--, s--, u--, w--; (p < q); - x2 += (ptrdiff_t)2, y2 -= (ptrdiff_t)2, - x3 += (ptrdiff_t)3, y3 -= (ptrdiff_t)3, - x4 += (ptrdiff_t)4, y4 -= (ptrdiff_t)4) { - *Data++ = (*z++ + *p++ * *x1++ + *q-- * *y1-- + *r++ * *x2 + *s-- * *y2 - + *t++ * *x3 + *u-- * *y3 + *v++ * *x4 + *w-- * *y4) * 0.2; - } - for (p--, q++, r--, s++, t--, u++, v--, w++; (z < p); - x2 += (ptrdiff_t)2, y2 -= (ptrdiff_t)2, - x3 += (ptrdiff_t)3, y3 -= (ptrdiff_t)3, - x4 += (ptrdiff_t)4, y4 -= (ptrdiff_t)4) { - *Data++ = (*z++ + *p-- * *x1++ - *q++ * *y1-- + *r-- * *x2 - *s++ * *y2 - + *t-- * *x3 - *u++ * *y3 + *v-- * *x4 - *w++ * *y4) * 0.2; - } - } - else { - *Data++ = *z++ + *p++ + *r++ + *t++ + *v++; - x2 += (ptrdiff_t)2; - y2 -= (ptrdiff_t)2; - x3 += (ptrdiff_t)3; - y3 -= (ptrdiff_t)3; - x4 += (ptrdiff_t)4; - y4 -= (ptrdiff_t)4; - for (x1++, y1--, q--, s--, u--, w--; (p < q); - x2 += (ptrdiff_t)2, y2 -= (ptrdiff_t)2, - x3 += (ptrdiff_t)3, y3 -= (ptrdiff_t)3, - x4 += (ptrdiff_t)4, y4 -= (ptrdiff_t)4) { - *Data++ = *z++ + *p++ * *x1++ + *q-- * *y1-- + *r++ * *x2 + *s-- * *y2 - + *t++ * *x3 + *u-- * *y3 + *v++ * *x4 + *w-- * *y4; - } - for (p--, q++, r--, s++, t--, u++, v--, w++; (z < p); - x2 += (ptrdiff_t)2, y2 -= (ptrdiff_t)2, - x3 += (ptrdiff_t)3, y3 -= (ptrdiff_t)3, - x4 += (ptrdiff_t)4, y4 -= (ptrdiff_t)4) { - *Data++ = *z++ + *p-- * *x1++ - *q++ * *y1-- + *r-- * *x2 - *s++ * *y2 - + *t-- * *x3 - *u++ * *y3 + *v-- * *x4 - *w++ * *y4; - } - z = ScratchBuffer; - *Data++ = *z++ + *p++ * *x1 + *r++ * *x2 + *t++ * *x3 + *v++ * *x4; - x2 += (ptrdiff_t)2; - y2 -= (ptrdiff_t)2; - x3 += (ptrdiff_t)3; - y3 -= (ptrdiff_t)3; - x4 += (ptrdiff_t)4; - y4 -= (ptrdiff_t)4; - for (x1++, y1--, q--, s--, u--, w--; (p < q); - x2 += (ptrdiff_t)2, y2 -= (ptrdiff_t)2, - x3 += (ptrdiff_t)3, y3 -= (ptrdiff_t)3, - x4 += (ptrdiff_t)4, y4 -= (ptrdiff_t)4) { - if (y4 < CaS) { - x4 -= (ptrdiff_t)SignalLength; - y4 += (ptrdiff_t)SignalLength; - } - *Data++ = *z++ + *p++ * *x1++ + *q-- * *y1-- + *r++ * *x2 + *s-- * *y2 - + *t++ * *x3 + *u-- * *y3 + *v++ * *x4 + *w-- * *y4; - } - for (p--, q++, r--, s++, t--, u++, v--, w++; (z < p); - x2 += (ptrdiff_t)2, y2 -= (ptrdiff_t)2, - x3 += (ptrdiff_t)3, y3 -= (ptrdiff_t)3, - x4 += (ptrdiff_t)4, y4 -= (ptrdiff_t)4) { - if (y3 < CaS) { - x3 -= (ptrdiff_t)SignalLength; - y3 += (ptrdiff_t)SignalLength; - } - *Data++ = *z++ + *p-- * *x1++ - *q++ * *y1-- + *r-- * *x2 - *s++ * *y2 - + *t-- * *x3 - *u++ * *y3 + *v-- * *x4 - *w++ * *y4; - } - z = ScratchBuffer; - *Data++ = *z++ + *p++ * *x1 + *r++ * *x2 + *t++ * *x3 + *v++ * *x4; - x2 += (ptrdiff_t)2; - y2 -= (ptrdiff_t)2; - x3 += (ptrdiff_t)3; - y3 -= (ptrdiff_t)3; - x4 += (ptrdiff_t)4; - y4 -= (ptrdiff_t)4; - for (x1++, y1--, q--, s--, u--, w--; (p < q); - x2 += (ptrdiff_t)2, y2 -= (ptrdiff_t)2, - x3 += (ptrdiff_t)3, y3 -= (ptrdiff_t)3, - x4 += (ptrdiff_t)4, y4 -= (ptrdiff_t)4) { - *Data++ = *z++ + *p++ * *x1++ + *q-- * *y1-- + *r++ * *x2 + *s-- * *y2 - + *t++ * *x3 + *u-- * *y3 + *v++ * *x4 + *w-- * *y4; - } - x2 -= (ptrdiff_t)SignalLength; - y2 += (ptrdiff_t)SignalLength; - x4 -= (ptrdiff_t)SignalLength; - y4 += (ptrdiff_t)SignalLength; - for (p--, q++, r--, s++, t--, u++, v--, w++; (z < p); - x2 += (ptrdiff_t)2, y2 -= (ptrdiff_t)2, - x3 += (ptrdiff_t)3, y3 -= (ptrdiff_t)3, - x4 += (ptrdiff_t)4, y4 -= (ptrdiff_t)4) { - *Data++ = *z++ + *p-- * *x1++ - *q++ * *y1-- + *r-- * *x2 - *s++ * *y2 - + *t-- * *x3 - *u++ * *y3 + *v-- * *x4 - *w++ * *y4; - } - z = ScratchBuffer; - *Data++ = *z++ + *p++ * *x1 + *r++ * *x2 + *t++ * *x3 + *v++ * *x4; - x2 += (ptrdiff_t)2; - y2 -= (ptrdiff_t)2; - x3 += (ptrdiff_t)3; - y3 -= (ptrdiff_t)3; - x4 += (ptrdiff_t)4; - y4 -= (ptrdiff_t)4; - for (x1++, y1--, q--, s--, u--, w--; (p < q); - x2 += (ptrdiff_t)2, y2 -= (ptrdiff_t)2, - x3 += (ptrdiff_t)3, y3 -= (ptrdiff_t)3, - x4 += (ptrdiff_t)4, y4 -= (ptrdiff_t)4) { - if (y3 < CaS) { - x3 -= (ptrdiff_t)SignalLength; - y3 += (ptrdiff_t)SignalLength; - } - *Data++ = *z++ + *p++ * *x1++ + *q-- * *y1-- + *r++ * *x2 + *s-- * *y2 - + *t++ * *x3 + *u-- * *y3 + *v++ * *x4 + *w-- * *y4; - } - for (p--, q++, r--, s++, t--, u++, v--, w++; (z < p); - x2 += (ptrdiff_t)2, y2 -= (ptrdiff_t)2, - x3 += (ptrdiff_t)3, y3 -= (ptrdiff_t)3, - x4 += (ptrdiff_t)4, y4 -= (ptrdiff_t)4) { - if (y4 < CaS) { - x4 -= (ptrdiff_t)SignalLength; - y4 += (ptrdiff_t)SignalLength; - } - *Data++ = *z++ + *p-- * *x1++ - *q++ * *y1-- + *r-- * *x2 - *s++ * *y2 - + *t-- * *x3 - *u++ * *y3 + *v-- * *x4 - *w++ * *y4; - } - z = ScratchBuffer; - *Data++ = *z++ + *p++ * *x1 + *r++ * *x2 + *t++ * *x3 + *v++ * *x4; - x2 += (ptrdiff_t)2; - y2 -= (ptrdiff_t)2; - x3 += (ptrdiff_t)3; - y3 -= (ptrdiff_t)3; - x4 += (ptrdiff_t)4; - y4 -= (ptrdiff_t)4; - for (x1++, y1--, q--, s--, u--, w--; (p < q); - x2 += (ptrdiff_t)2, y2 -= (ptrdiff_t)2, - x3 += (ptrdiff_t)3, y3 -= (ptrdiff_t)3, - x4 += (ptrdiff_t)4, y4 -= (ptrdiff_t)4) { - *Data++ = *z++ + *p++ * *x1++ + *q-- * *y1-- + *r++ * *x2 + *s-- * *y2 - + *t++ * *x3 + *u-- * *y3 + *v++ * *x4 + *w-- * *y4; - } - for (p--, q++, r--, s++, t--, u++, v--, w++; (z < p); - x2 += (ptrdiff_t)2, y2 -= (ptrdiff_t)2, - x3 += (ptrdiff_t)3, y3 -= (ptrdiff_t)3, - x4 += (ptrdiff_t)4, y4 -= (ptrdiff_t)4) { - *Data++ = *z++ + *p-- * *x1++ - *q++ * *y1-- + *r-- * *x2 - *s++ * *y2 - + *t-- * *x3 - *u++ * *y3 + *v-- * *x4 - *w++ * *y4; - } - } - } - else { - b = 1.0 / (double)SignalLength; - ScratchBuffer = (double *)memcpy(ScratchBuffer, Data, - (size_t)(SignalLength * (long)sizeof(double))); - p = ScratchBuffer + (ptrdiff_t)SignalLength; - q = CaS + (ptrdiff_t)SignalLength; - r = ScratchBuffer; - a = 0.0; - while (r < p) { - a += *r++; - } - *Data++ = (Forward) ? (a * b) : (a); - for (i = 1L; (i < SignalLength); i++) { - r = ScratchBuffer; - s = CaS; - a = 0.0; - while (r < p) { - a += *r++ * *s; - s += (ptrdiff_t)i; - if (q <= s) { - s -= (ptrdiff_t)SignalLength; - } - } - *Data++ = (Forward) ? (a * b) : (a); - } - } -/**/DEBUG_WRITE_LEAVING(DiscreteHartleyTransform, "Done") - return(Status); -} /* end DiscreteHartleyTransform */ - diff --git a/src/core/bilib/dht.h b/src/core/bilib/dht.h deleted file mode 100644 index eb36346..0000000 --- a/src/core/bilib/dht.h +++ /dev/null @@ -1,34 +0,0 @@ -/**@defgroup HartleyTransform Hartley Transform - @ingroup BilibLibrary */ -//@{ -/*--------------------------------------------------------------------------*/ -/** Discrete Hartley transform of a real signal. - - The input signal is given by Data (double). The computation is in-place - (the output replaces the input). - - ScratchBuffer is a pre-allocated workspace of size SignalLength. - The values returned in ScratchBuffer are meaningless. - - CaS is an input array of coefficients of size SignalLength - (see GetCaS function). CaS is modified internally, but is restored - when DHT returns. - - SignalLength is the length of the signal. No restriction on SignalLength, - but best efficiency for radix 2, 3, 4, 5. - - Performs a DHT transform when (Forward == TRUE). Performs an inverse DHT - transform when (Forward == FALSE). - - success: return(!ERROR); failure: return(ERROR); -*/ -extern int DiscreteHartleyTransform - ( - double Data[], /* signal */ - double *ScratchBuffer, /* scratch buffer */ - double CaS[], /* coefficients */ - long SignalLength, /* signal length */ - int Forward /* direction */ - ); -//@} - diff --git a/src/core/bilib/error.h b/src/core/bilib/error.h deleted file mode 100644 index 78c93c8..0000000 --- a/src/core/bilib/error.h +++ /dev/null @@ -1,73 +0,0 @@ -/*............................................................................ - Filename: error.h - - Project: Biomedical Imaging Library - - Author: Philippe Thevenaz - Swiss Federal Institute of Technology--Lausanne - Biomedical Imaging Group - EPFL/DMT/IOA - BM-Ecublens - CH-1015 Lausanne - Switzerland - - Date: February 24, 1999 - - Purpose: Declaration of macro for error message -............................................................................*/ - - - -/****************************************************************************/ -/* Defines */ -/****************************************************************************/ - -/*--------------------------------------------------------------------------*/ -#undef WRITE_ERROR -#define WRITE_ERROR(FunctionName, String) \ - { \ - char ErrorMessage[256]; \ - if (sprintf(ErrorMessage, #FunctionName " at line %ld in " \ - __FILE__ ": ERROR---", (long)__LINE__) == EOF) \ - MessageDisplay("\a"); \ - else { \ - MessageDisplay(ErrorMessage); \ - MessageDisplay(" " String "\n"); \ - } \ - } - -/*--------------------------------------------------------------------------*/ -#undef WRITE_WARNING -#ifdef DEBUG -#define WRITE_WARNING(FunctionName, String) \ - { \ - char ErrorMessage[256]; \ - void *isValidIdentifier; \ - isValidIdentifier = (void *)(*FunctionName); \ - if (((strstr(DEBUG_CONTEXT, "|" #FunctionName "|") != (char *)NULL) \ - || (strstr(DEBUG_CONTEXT, "|*|") != (char *)NULL)) \ - && ((strstr(DEBUG_LEVEL, "|WARNING|") != (char *)NULL) \ - || (strstr(DEBUG_LEVEL, "|*|") != (char *)NULL))) { \ - if (sprintf(ErrorMessage, #FunctionName " at line %ld in " \ - __FILE__ ": WARNING---", (long)__LINE__) == EOF) \ - MessageDisplay("\a"); \ - else { \ - MessageDisplay(ErrorMessage); \ - MessageDisplay(" " String "\n"); \ - } \ - } \ - } -#else -#define WRITE_WARNING(FunctionName, String) \ - { \ - char ErrorMessage[256]; \ - if (sprintf(ErrorMessage, #FunctionName " at line %ld in " \ - __FILE__ ": WARNING---", (long)__LINE__) == EOF) \ - MessageDisplay("\a"); \ - else { \ - MessageDisplay(ErrorMessage); \ - MessageDisplay(" " String "\n"); \ - } \ - } -#endif - diff --git a/src/core/bilib/findroot.cc b/src/core/bilib/findroot.cc deleted file mode 100644 index 95bcb11..0000000 --- a/src/core/bilib/findroot.cc +++ /dev/null @@ -1,640 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -#include -#include - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" -#include "error.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "messagedisplay.h" -#include "findroot.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -#ifdef DEBUG -#include -#include -#endif - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern int RootBracket - ( - int (*Function)(double, void *, double *), - /* function to bracket */ - void *AuxilliaryData, /* parameters used by the function */ - double *LowerBound, /* lower interval bound to be updated */ - double *UpperBound, /* upper interval bound to be updated */ - double *LowerSample, /* value of Function for argument LowerBound */ - double *UpperSample, /* value of Function for argument UpperBound */ - double Tolerance, /* admissible relative error */ - int *ValidBracket, /* whether or not a root could be bracketed */ - int *Status /* error management */ - ) - -/* bracketing of a root of (Function) inside the interval [LowerBound, UpperBound] */ -/* the purpose is to search for a pair of arguments for which 'Function' differs in sign */ -/* the search is conducted within [LowerBound, UpperBound] */ -/* at most [(UpperBound - LowerBound) / Tolerance] function evaluations are performed */ -/* even-order roots cannot be bracketed */ -/* the evaluation of Function at LowerBound (UpperBound) */ -/* is returned in LowerSample (UpperSample) */ -/* success: return(!ERROR); failure: return(ERROR) */ -/* the function 'Function' must be declared as follows: */ -/* - extern int myFunction(double myArgument, void *AuxilliaryData, double *myResult); -*/ -/* it must return ERROR upon failure, and !ERROR upon success */ -/* it is evaluated for the value of the variable 'myArgument' */ -/* the result of the function evaluation must be returned in 'myResult' */ -/* the generic pointer 'AuxilliaryData' can be used to pass additional parameters */ -/* what follows is a developed example of the function f(x) = a * x^2 + b * x + c */ -/* a, b, and c are free parameters */ -/* -.............................................................................. - -struct myStruct -{ - double a, b, c; -}; - -extern int myFunction - ( - double myArgument, - void *AuxilliaryData, - double *myResult - ); -extern int myFunction - ( - double myArgument, - void *AuxilliaryData, - double *myResult - ) - -{ - struct myStruct - myData; - - myData = *((struct myStruct *)AuxilliaryData); - *myResult = myArgument * (myArgument * myData.a + myData.b) + myData.c; - return(!ERROR); -} - -int main - ( - void - ) - -{ - struct myStruct - myData; - double LowerBound = -100.0, UpperBound = 100.0; - double LowerSample, UpperSample; - double Tolerance = FLT_EPSILON; - int ValidBracket; - int Status; - - myData.a = 1.0; - myData.b = 5.0; - myData.c = 4.0; - RootBracket(*myFunction, (void *)&myData, &LowerBound, &UpperBound, - &LowerSample, &UpperSample, Tolerance, &ValidBracket, &Status); - return(0); -} - -.............................................................................. -*/ - -{ /* begin RootBracket */ - - double Attempt, Sample, Sign; - long i, n; - - *Status = !ERROR; - *ValidBracket = FALSE; - -/**/DEBUG_CHECK_NULL_POINTER(RootBracket, Function, *Status, -/**/ "Missing function specification") -/**/DEBUG_CHECK_NULL_POINTER(RootBracket, AuxilliaryData, *Status, -/**/ "Missing AuxilliaryData") -/**/DEBUG_CHECK_NULL_POINTER(RootBracket, LowerBound, *Status, -/**/ "Missing LowerBound") -/**/DEBUG_CHECK_NULL_POINTER(RootBracket, UpperBound, *Status, -/**/ "Missing UpperBound") -/**/DEBUG_CHECK_NULL_POINTER(RootBracket, LowerSample, *Status, -/**/ "Missing LowerSample") -/**/DEBUG_CHECK_NULL_POINTER(RootBracket, UpperSample, *Status, -/**/ "Missing UpperSample") -/**/DEBUG_CHECK_RANGE_DOUBLE(RootBracket, Tolerance, 0.0, DBL_MAX, *Status, -/**/ "Invalid Tolerance (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(RootBracket, *Status) -/**/DEBUG_WRITE_ENTERING(RootBracket, -/**/ "About to execute RootBracket") - - if (*UpperBound <= *LowerBound) { - *Status = ERROR; - WRITE_ERROR(RootBracket, "LowerBound must be strictly smaller than UpperBound") -/**/ DEBUG_WRITE_LEAVING(RootBracket, "Done") - return(*Status); - } - *Status = (*Function)(*LowerBound, AuxilliaryData, LowerSample); - if (*Status == ERROR) { - WRITE_ERROR(RootBracket, "Function call failed") -/**/ DEBUG_WRITE_LEAVING(RootBracket, "Done") - return(*Status); - } - Sign = *LowerSample; - *Status = (*Function)(*UpperBound, AuxilliaryData, UpperSample); - if (*Status == ERROR) { - WRITE_ERROR(RootBracket, "Function call failed") -/**/ DEBUG_WRITE_LEAVING(RootBracket, "Done") - return(*Status); - } - if ((*LowerSample * *UpperSample) < 0.0) { - *ValidBracket = TRUE; -/**/ DEBUG_WRITE_LEAVING(RootBracket, "Done") - return(*Status); - } - n = 1L; - while (((double)n * Tolerance) <= 1.0) { - n *= 2L; - for (i = 1L; (i < n); i += 2L) { - Attempt = *LowerBound + (double)i * (*UpperBound - *LowerBound) / (double)n; - *Status = (*Function)(Attempt, AuxilliaryData, &Sample); - if (*Status == ERROR) { - WRITE_ERROR(RootBracket, "Function call failed") -/**/ DEBUG_WRITE_LEAVING(RootBracket, "Done") - return(*Status); - } - if ((Sign * Sample) < 0.0) { - *ValidBracket = TRUE; - *LowerBound = Attempt - (*UpperBound - *LowerBound) / (double)n; - *UpperBound = Attempt; - *Status = (*Function)(*LowerBound, AuxilliaryData, LowerSample); - if (*Status == ERROR) { - WRITE_ERROR(RootBracket, "Function call failed") -/**/ DEBUG_WRITE_LEAVING(RootBracket, "Done") - return(*Status); - } - *UpperSample = Sample; -/**/ DEBUG_WRITE_LEAVING(RootBracket, "Done") - return(*Status); - } - } - } -/**/DEBUG_WRITE_LEAVING(RootBracket, "Done") - return(*Status); -} /* end RootBracket */ - -/*--------------------------------------------------------------------------*/ -extern int RootFindBisection - ( - int (*Function)(double, void *, double *), - /* function, of which a root is sought */ - void *AuxilliaryData, /* parameters used by the function */ - double *Root, /* returned root */ - double LowerBound, /* lower bound of an interval containing a root */ - double UpperBound, /* upper bound of an interval containing a root */ - double Tolerance, /* admissible relative error */ - int *Status /* error management */ - ) - -/* search for a root of (Function) inside the bracketing interval [LowerBound, UpperBound] */ -/* the strategy proceeds by iteratively cutting the interval in two equal parts */ -/* even-order roots generally cannot be found */ -/* only one root is returned, even if there are several ones */ -/* Tolerance is relative to the size of the bracketing interval */ -/* success: return(!ERROR); failure: return(ERROR) */ -/* the function 'Function' must be declared as follows: */ -/* - extern int myFunction(double myArgument, void *AuxilliaryData, double *myResult); -*/ -/* it must return ERROR upon failure, and !ERROR upon success */ -/* it is evaluated for the value of the variable 'myArgument' */ -/* the result of the function evaluation must be returned in 'myResult' */ -/* the generic pointer 'AuxilliaryData' can be used to pass additional parameters */ -/* what follows is a developed example of the function f(x) = a * x^2 + b * x + c */ -/* a, b, and c are free parameters */ -/* -.............................................................................. - -struct myStruct -{ - double a, b, c; -}; - -extern int myFunction - ( - double myArgument, - void *AuxilliaryData, - double *myResult - ); -extern int myFunction - ( - double myArgument, - void *AuxilliaryData, - double *myResult - ) - -{ - struct myStruct - myData; - - myData = *((struct myStruct *)AuxilliaryData); - *myResult = myArgument * (myArgument * myData.a + myData.b) + myData.c; - return(!ERROR); -} - -int main - ( - void - ) - -{ - struct myStruct - myData; - double LowerBound = -100.0, UpperBound = 100.0; - double Root; - double Tolerance = FLT_EPSILON; - int Status; - - myData.a = 1.0; - myData.b = 5.0; - myData.c = 4.0; - RootBracket(*myFunction, (void *)&myData, &LowerBound, &UpperBound, Tolerance, &Status); - RootFindBisection(*myFunction, (void *)&myData, &Root, LowerBound, UpperBound, Tolerance, &Status); - return(0); -} - -.............................................................................. -*/ - -{ /* begin RootFindBisection */ - - const double - dx = Tolerance * (UpperBound - LowerBound); - double x0 = LowerBound, x1, x2 = UpperBound, old; - double fx0, fx1, fx2; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(RootFindBisection, Function, *Status, -/**/ "Missing function specification") -/**/DEBUG_CHECK_NULL_POINTER(RootFindBisection, AuxilliaryData, *Status, -/**/ "Missing AuxilliaryData") -/**/DEBUG_CHECK_NULL_POINTER(RootFindBisection, Root, *Status, -/**/ "Missing UpperBound") -/**/DEBUG_RETURN_ON_ERROR(RootFindBisection, *Status) -/**/DEBUG_WRITE_ENTERING(RootFindBisection, -/**/ "About to execute RootFindBisection") - - if (UpperBound <= LowerBound) { - *Status = ERROR; - WRITE_ERROR(RootFindBisection, "LowerBound must be strictly smaller than UpperBound") -/**/ DEBUG_WRITE_LEAVING(RootFindBisection, "Done") - return(*Status); - } - if (Tolerance <= 0.0) { - *Status = ERROR; - WRITE_ERROR(RootFindBisection, "Invalid Tolerance (should be strictly positive)") -/**/ DEBUG_WRITE_LEAVING(RootFindBisection, "Done") - return(*Status); - } - if (1.0 <= Tolerance) { - *Status = ERROR; - WRITE_ERROR(RootFindBisection, "Invalid Tolerance (should be strictly less than unity)") -/**/ DEBUG_WRITE_LEAVING(RootFindBisection, "Done") - return(*Status); - } - *Status = (*Function)(x0, AuxilliaryData, &fx0); - if (*Status == ERROR) { - WRITE_ERROR(RootFindBisection, "Function call failed") -/**/ DEBUG_WRITE_LEAVING(RootFindBisection, "Done") - return(*Status); - } - if (fx0 == 0.0) { - *Root = x0; -/**/ DEBUG_WRITE_LEAVING(RootFindBisection, "Done") - return(*Status); - } - *Status = (*Function)(x2, AuxilliaryData, &fx2); - if (*Status == ERROR) { - WRITE_ERROR(RootFindBisection, "Function call failed") -/**/ DEBUG_WRITE_LEAVING(RootFindBisection, "Done") - return(*Status); - } - if (fx2 == 0.0) { - *Root = x2; -/**/ DEBUG_WRITE_LEAVING(RootFindBisection, "Done") - return(*Status); - } - if (0.0 < (fx0 * fx2)) { - *Status = ERROR; - WRITE_ERROR(RootFindBisection, "Non-bracketing interval") -/**/ DEBUG_WRITE_LEAVING(RootFindBisection, "Done") - return(*Status); - } - old = x0; - while (dx < (x2 - x0)) { - x1 = 0.5 * (x0 + x2); - if (x1 == old) { - *Root = x1; - WRITE_WARNING(RootFindBisection, "Unable to reach the desired precision") -/**/ DEBUG_WRITE_LEAVING(RootFindBisection, "Done") - return(*Status); - } - old = x1; - *Status = (*Function)(x1, AuxilliaryData, &fx1); - if (*Status == ERROR) { - WRITE_ERROR(RootFindBisection, "Function call failed") -/**/ DEBUG_WRITE_LEAVING(RootFindBisection, "Done") - return(*Status); - } - if (fx1 == 0.0) { - *Root = x1; -/**/ DEBUG_WRITE_LEAVING(RootFindBisection, "Done") - return(*Status); - } - if ((fx0 * fx1) < 0.0) { - x2 = x1; - fx2 = fx1; - } - else { - x0 = x1; - fx0 = fx1; - } - } - x1 = 0.5 * (x0 + x2); - *Status = (*Function)(x1, AuxilliaryData, &fx1); - if (*Status == ERROR) { - WRITE_ERROR(RootFindBisection, "Function call failed") -/**/ DEBUG_WRITE_LEAVING(RootFindBisection, "Done") - return(*Status); - } - *Root = (fabs(fx0) < fabs(fx1)) ? ((fabs(fx0) < fabs(fx2)) ? (x0) : (x2)) - : (fabs(fx1) < fabs(fx2) ? (x1) : (x2)); -/**/DEBUG_WRITE_LEAVING(RootFindBisection, "Done") - return(*Status); -} /* end RootFindBisection */ - -/*--------------------------------------------------------------------------*/ -extern int RootFindBrent - ( - int (*Function)(double, void *, double *), - /* function, of which a root is sought */ - void *AuxilliaryData, /* parameters used by the function */ - double *Root, /* returned root */ - double LowerBound, /* lower bound of an interval containing a root */ - double UpperBound, /* upper bound of an interval containing a root */ - double Tolerance, /* admissible relative error */ - int *Status /* error management */ - ) - -/* search for a root of (Function) inside the bracketing interval [LowerBound, UpperBound] */ -/* the strategy proceeds by fitting an inverse quadratic function and by using the root that */ -/* belong to the interval, if any */ -/* even-order roots generally cannot be found */ -/* only one root is returned, even if there are several ones */ -/* Tolerance is relative to the size of the bracketing interval */ -/* success: return(!ERROR); failure: return(ERROR) */ -/* the function 'Function' must be declared as follows: */ -/* - extern int myFunction(double myArgument, void *AuxilliaryData, double *myResult); -*/ -/* it must return ERROR upon failure, and !ERROR upon success */ -/* it is evaluated for the value of the variable 'myArgument' */ -/* the result of the function evaluation must be returned in 'myResult' */ -/* the generic pointer 'AuxilliaryData' can be used to pass additional parameters */ -/* what follows is a developed example of the function f(x) = a * x^2 + b * x + c */ -/* a, b, and c are free parameters */ -/* -.............................................................................. - -struct myStruct -{ - double a, b, c; -}; - -extern int myFunction - ( - double myArgument, - void *AuxilliaryData, - double *myResult - ); -extern int myFunction - ( - double myArgument, - void *AuxilliaryData, - double *myResult - ) - -{ - struct myStruct - myData; - - myData = *((struct myStruct *)AuxilliaryData); - *myResult = myArgument * (myArgument * myData.a + myData.b) + myData.c; - return(!ERROR); -} - -int main - ( - void - ) - -{ - struct myStruct - myData; - double LowerBound = -100.0, UpperBound = 100.0; - double Root; - double Tolerance = FLT_EPSILON; - int Status; - - myData.a = 1.0; - myData.b = 5.0; - myData.c = 4.0; - RootBracket(*myFunction, (void *)&myData, &LowerBound, &UpperBound, Tolerance, &Status); - RootFindBrent(*myFunction, (void *)&myData, &Root, LowerBound, UpperBound, Tolerance, &Status); - return(0); -} - -.............................................................................. -*/ - -{ /* begin RootFindBrent */ - - const double - dx = Tolerance * (UpperBound - LowerBound); - double x, x0 = LowerBound, x1, x2 = UpperBound, old; - double fx0, fx1, fx2; - double p, q, r, s; - double d = 0.0, e= 0.0; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(RootFindBrent, Function, *Status, -/**/ "Missing function specification") -/**/DEBUG_CHECK_NULL_POINTER(RootFindBrent, AuxilliaryData, *Status, -/**/ "Missing AuxilliaryData") -/**/DEBUG_CHECK_NULL_POINTER(RootFindBrent, Root, *Status, -/**/ "Missing UpperBound") -/**/DEBUG_RETURN_ON_ERROR(RootFindBrent, *Status) -/**/DEBUG_WRITE_ENTERING(RootFindBrent, -/**/ "About to execute RootFindBrent") - - if (UpperBound <= LowerBound) { - *Status = ERROR; - WRITE_ERROR(RootFindBrent, "LowerBound must be strictly smaller than UpperBound") -/**/ DEBUG_WRITE_LEAVING(RootFindBrent, "Done") - return(*Status); - } - if (Tolerance <= 0.0) { - *Status = ERROR; - WRITE_ERROR(RootFindBrent, "Invalid Tolerance (should be strictly positive)") -/**/ DEBUG_WRITE_LEAVING(RootFindBrent, "Done") - return(*Status); - } - if (1.0 <= Tolerance) { - *Status = ERROR; - WRITE_ERROR(RootFindBrent, "Invalid Tolerance (should be strictly less than unity)") -/**/ DEBUG_WRITE_LEAVING(RootFindBrent, "Done") - return(*Status); - } - *Status = (*Function)(x0, AuxilliaryData, &fx0); - if (*Status == ERROR) { - WRITE_ERROR(RootFindBrent, "Function call failed") -/**/ DEBUG_WRITE_LEAVING(RootFindBrent, "Done") - return(*Status); - } - if (fx0 == 0.0) { - *Root = x0; -/**/ DEBUG_WRITE_LEAVING(RootFindBrent, "Done") - return(*Status); - } - *Status = (*Function)(x2, AuxilliaryData, &fx2); - if (*Status == ERROR) { - WRITE_ERROR(RootFindBrent, "Function call failed") -/**/ DEBUG_WRITE_LEAVING(RootFindBrent, "Done") - return(*Status); - } - if (fx2 == 0.0) { - *Root = x2; -/**/ DEBUG_WRITE_LEAVING(RootFindBrent, "Done") - return(*Status); - } - if (0.0 < (fx0 * fx2)) { - *Status = ERROR; - WRITE_ERROR(RootFindBrent, "Non-bracketing interval") -/**/ DEBUG_WRITE_LEAVING(RootFindBrent, "Done") - return(*Status); - } - x1 = x2; - fx1 = fx2; - old = x0; - while (TRUE) { - if (0.0 < (fx1 * fx2)) { - x2 = x0; - fx2 = fx0; - d = x1 - x0; - e = d; - } - if (fabs(fx2) < fabs(fx1)) { - x0 = x1; - fx0 = fx1; - x1 = x2; - fx1 = fx2; - x2 = x0; - fx2 = fx0; - } - x = 0.5 * (x2 - x1); - if (fabs(x) <= dx) { - *Status = (*Function)(x1 + x, AuxilliaryData, &fx0); - if (*Status == ERROR) { - WRITE_ERROR(RootFindBisection, "Function call failed") -/**/ DEBUG_WRITE_LEAVING(RootFindBisection, "Done") - return(*Status); - } - *Root = (fabs(fx0) < fabs(fx1)) ? ((fabs(fx0) < fabs(fx2)) ? (x0) : (x2)) - : (fabs(fx1) < fabs(fx2) ? (x1) : (x2)); -/**/ DEBUG_WRITE_LEAVING(RootFindBrent, "Done") - return(*Status); - } - if ((dx <= fabs(e)) && (fabs(fx1) < fabs(fx0))) { - s = fx1 / fx0; - if (x0 == x2) { - p = 2.0 * x * s; - q = 1.0 - s; - } - else { - q = fx0 / fx2; - r = fx1 / fx2; - p = s * (2.0 * x * q * (q - r) - (x1 - x0) * (r - 1.0)); - q = (q - 1.0) * (r - 1.0) * (s - 1.0); - } - if (0.0 < p) { - q = -q; - } - p = fabs(p); - if (((2.0 * p) < (3.0 * x * q - dx * fabs(q))) && ((2.0 * p) < fabs(e * q))) { - e = d; - d = p / q; - } - else { - d = x; - e = d; - } - } - else { - d = x; - e = d; - } - x0 = x1; - fx0 = fx1; - if (dx < fabs(d)) { - x1 += d; - } - else { - x1 += (0.0 <= x) ? (dx) : (-dx); - } - if (x1 == old) { - *Root = x1; - WRITE_WARNING(RootFindBrent, "Unable to reach the desired precision") -/**/ DEBUG_WRITE_LEAVING(RootFindBrent, "Done") - return(*Status); - } - old = x1; - *Status = (*Function)(x1, AuxilliaryData, &fx1); - if (*Status == ERROR) { - WRITE_ERROR(RootFindBrent, "Function call failed") -/**/ DEBUG_WRITE_LEAVING(RootFindBrent, "Done") - return(*Status); - } - if (fx1 == 0.0) { - *Root = x1; -/**/ DEBUG_WRITE_LEAVING(RootFindBrent, "Done") - return(*Status); - } - } -} /* end RootFindBrent */ - diff --git a/src/core/bilib/findroot.h b/src/core/bilib/findroot.h deleted file mode 100644 index 38b4e8b..0000000 --- a/src/core/bilib/findroot.h +++ /dev/null @@ -1,210 +0,0 @@ -/**@defgroup FindRoot Find root - @ingroup BilibLibrary */ -//@{ -/*--------------------------------------------------------------------------*/ -/** Find root by bracketing. - * Bracketing of a root of (Function) inside the interval - * [LowerBound, UpperBound]. The purpose is to search for a pair of - * arguments for which 'Function' differs in sign. The search is conducted - * within [LowerBound, UpperBound]. - * At most [(UpperBound - LowerBound) / Tolerance] function evaluations - * are performed. Even-order roots cannot be bracketed. - * The evaluation of Function at LowerBound (UpperBound) is returned in - * LowerSample (UpperSample) - * - * success: return(!ERROR); failure: return(ERROR) - * - * the function 'Function' must be declared as follows: - * @code - * extern int myFunction(double myArgument, void *AuxilliaryData, double *myResult); - * @endcode - * It must return ERROR upon failure, and !ERROR upon success - * - * It is evaluated for the value of the variable 'myArgument'. The result - * of the function evaluation must be returned in 'myResult'. The - * generic pointer 'AuxilliaryData' can be used to pass additional parameters. - * - * What follows is a developed example of the function - * f(x) = a * x^2 + b * x + c (a, b, and c are free parameters) - * - * @code - * struct myStruct { - * double a, b, c; - * }; - * - * extern int myFunction ( - * double myArgument, - * void *AuxilliaryData, - * double *myResult) { - * struct myStruct myData; - * - * myData = *((struct myStruct *)AuxilliaryData); - * *myResult = myArgument * (myArgument * myData.a + myData.b) + myData.c; - * return(!ERROR); - * } - * - * int main() { - * struct myStruct myData; - * double LowerBound = -100.0, UpperBound = 100.0; - * double LowerSample, UpperSample; - * double Tolerance = FLT_EPSILON; - * int ValidBracket; - * int Status; - * - * myData.a = 1.0; - * myData.b = 5.0; - * myData.c = 4.0; - * RootBracket(*myFunction, (void *)&myData, &LowerBound, &UpperBound, - * &LowerSample, &UpperSample, Tolerance, &ValidBracket, &Status); - * return(0); - * } - * @endcode -*/ -extern int RootBracket - ( - int(*Function)(double, void *, double *), - /* function to bracket */ - void *AuxilliaryData, /* parameters used by the function */ - double *LowerBound, /* lower interval bound to be updated */ - double *UpperBound, /* upper interval bound to be updated */ - double *LowerSample, /* value of Function for argument LowerBound */ - double *UpperSample, /* value of Function for argument UpperBound */ - double Tolerance, /* admissible relative error */ - int *ValidBracket, /* whether or not a root could be bracketed */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Find a root by bisection. - * Search for a root of (Function) inside the bracketing interval - * [LowerBound, UpperBound]. The strategy proceeds by iteratively - * cutting the interval in two equal parts. Even-order roots generally - * cannot be found. Only one root is returned, even if there are several - * ones. Tolerance is relative to the size of the bracketing interval - * - * success: return(!ERROR); failure: return(ERROR) - * - * The function 'Function' must be declared as follows: - * @code - * extern int myFunction(double myArgument, void *AuxilliaryData, double *myResult); - * @endcode - * It must return ERROR upon failure, and !ERROR upon success. It is - * evaluated for the value of the variable 'myArgument'. The result of the - * function evaluation must be returned in 'myResult'. The generic pointer - * 'AuxilliaryData' can be used to pass additional parameters. - * - * What follows is a developed example of the function - * f(x) = a * x^2 + b * x + c (a, b, and c are free parameters) - * @code - * struct myStruct { - * double a, b, c; - * }; - * - * extern int myFunction ( - * double myArgument, - * void *AuxilliaryData, - * double *myResult) { - * struct myStruct myData; - * - * myData = *((struct myStruct *)AuxilliaryData); - * *myResult = myArgument * (myArgument * myData.a + myData.b) + myData.c; - * return(!ERROR); - * } - * - * int main() { - * struct myStruct myData; - * double LowerBound = -100.0, UpperBound = 100.0; - * double Root; - * double Tolerance = FLT_EPSILON; - * int Status; - * - * myData.a = 1.0; - * myData.b = 5.0; - * myData.c = 4.0; - * RootBracket(*myFunction, (void *)&myData, &LowerBound, &UpperBound, Tolerance, &Status); - * RootFindBisection(*myFunction, (void *)&myData, &Root, LowerBound, - * UpperBound, Tolerance, &Status); - * return(0); - * } - * @endcode -*/ -extern int RootFindBisection - ( - int(*Function)(double, void *, double *), - /* function, of which a root is sought */ - void *AuxilliaryData, /* parameters used by the function */ - double *Root, /* returned root */ - double LowerBound, /* lower bound of an interval containing a root */ - double UpperBound, /* upper bound of an interval containing a root */ - double Tolerance, /* admissible relative error */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Find root using Brent algorithm. - * Search for a root of (Function) inside the bracketing interval - * [LowerBound, UpperBound]. The strategy proceeds by fitting an inverse - * quadratic function and by using the root that belong to the interval. - * If any even-order roots generally cannot be found. - * Only one root is returned, even if there are several ones. - * Tolerance is relative to the size of the bracketing interval. - * - * success: return(!ERROR); failure: return(ERROR) - * - * The function 'Function' must be declared as follows: - * @code - * extern int myFunction(double myArgument, void *AuxilliaryData, double *myResult); - * @endcode - * - * It must return ERROR upon failure, and !ERROR upon success. It is - * evaluated for the value of the variable 'myArgument'. The result of the - * function evaluation must be returned in 'myResult'. The generic pointer - * 'AuxilliaryData' can be used to pass additional parameters. - * - * What follows is a developed example of the function - * f(x) = a * x^2 + b * x + c (a, b, and c are free parameters) - * @code - * struct myStruct { - * double a, b, c; - * }; - * - * extern int myFunction ( - * double myArgument, - * void *AuxilliaryData, - * double *myResult) { - * struct myStruct myData; - * - * myData = *((struct myStruct *)AuxilliaryData); - * *myResult = myArgument * (myArgument * myData.a + myData.b) + myData.c; - * return(!ERROR); - * } - * - * int main() { - * struct myStruct myData; - * double LowerBound = -100.0, UpperBound = 100.0; - * double Root; - * double Tolerance = FLT_EPSILON; - * int Status; - * - * myData.a = 1.0; - * myData.b = 5.0; - * myData.c = 4.0; - * RootBracket(*myFunction, (void *)&myData, &LowerBound, &UpperBound, Tolerance, &Status); - * RootFindBisection(*myFunction, (void *)&myData, &Root, LowerBound, - * UpperBound, Tolerance, &Status); - * return(0); - * } - * @endcode -*/ -extern int RootFindBrent - ( - int(*Function)(double, void *, double *), - /* function, of which a root is sought */ - void *AuxilliaryData, /* parameters used by the function */ - double *Root, /* returned root */ - double LowerBound, /* lower bound of an interval containing a root */ - double UpperBound, /* upper bound of an interval containing a root */ - double Tolerance, /* admissible relative error */ - int *Status /* error management */ - ); -//@} diff --git a/src/core/bilib/firconvolve.cc b/src/core/bilib/firconvolve.cc deleted file mode 100644 index bd2f23b..0000000 --- a/src/core/bilib/firconvolve.cc +++ /dev/null @@ -1,2423 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -#include -#include -#include -#include - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" -#include "error.h" -#include "tboundaryconvention.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "firconvolve.h" -#include "getput.h" -#include "getputd.h" -#include "messagedisplay.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -#ifdef DEBUG -#include -#endif - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern int FirConvolve - ( - double InputData[], /* data to process */ - double OutputData[], /* result */ - long SignalLength, /* length of the 1D data array */ - double Kernel[], /* kernel */ - long KernelOrigin, /* center of the kernel */ - long KernelLength, /* length of the 1D kernel */ - enum TBoundaryConvention - Convention /* boundary convention */ - ) - -/* the specified boundary convention applies to the input data only, not to the kernel */ -/* the boundary convention applied to the kernel is FiniteDataSupport */ -/* the input and the output have the same length */ -/* the origin for the kernel is given with respect to the leftmost sample [0] */ -/* success: return(!ERROR); failure: return(ERROR) */ -/* general structure is as follows: - for (i = 0L; (i < SignalLength); i++) { - Sum = 0.0; - for (j = -Infinity; (j <= Infinity); j++) { - Sum += InputData[j] * Kernel[KernelOrigin + i - j]; - } - OutputData[i] = Sum; - } -*/ - -{ /* begin FirConvolve */ - - double *p, *q; - double f0, fk, fn, df; - double Sum; - long i, j, k; - long m, n; - long n2; - long kp, km; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(FirConvolve, InputData, Status, -/**/ "No input data") -/**/DEBUG_CHECK_NULL_POINTER(FirConvolve, OutputData, Status, -/**/ "No output data") -/**/DEBUG_CHECK_RANGE_LONG(FirConvolve, SignalLength, 1L, LONG_MAX, Status, -/**/ "Invalid signal length (should be strictly positive)") -/**/DEBUG_CHECK_NULL_POINTER(FirConvolve, Kernel, Status, -/**/ "No kernel") -/**/DEBUG_CHECK_RANGE_LONG(FirConvolve, KernelLength, 1L, LONG_MAX, Status, -/**/ "Invalid kernel length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(FirConvolve, Status) -/**/DEBUG_WRITE_ENTERING(FirConvolve, -/**/ "About to perform FIR convolution") - - switch (Convention) { - case AntiMirrorOnBounds: -/* More optimization needed for better efficiency in AntiMirrorOnBounds */ - Kernel += (ptrdiff_t)(KernelLength - 1L); - if (SignalLength == 1L) { - Sum = 0.0; - for (j = -KernelLength; (j < 0L); j++) { - Sum += *Kernel--; - } - *OutputData = *InputData * Sum; - } - else { - n2 = 2L * (SignalLength - 1L); - f0 = *InputData; - fn = InputData[SignalLength - 1L]; - df = fn - f0; - m = 1L + KernelOrigin - KernelLength; - km = m; - m -= (m < 0L) ? (n2 * ((m + 1L - n2) / n2)) : (n2 * (m / n2)); - for (i = 0L; (i < SignalLength); km++, i++) { - q = Kernel; - k = m; - kp = km; - Sum = 0.0; - for (j = -KernelLength; (j < 0L); kp++, j++) { - fk = (k < SignalLength) ? (InputData[k]) : (2.0 * fn - InputData[n2 - k]); - Sum += ((double)((kp - k) / (SignalLength - 1L)) * df + fk) * *q--; - if (++k == n2) { - k = 0L; - } - } - if (++m == n2) { - m = 0L; - } - *OutputData++ = Sum; - } - } - break; - case FiniteDataSupport: - Kernel += (ptrdiff_t)(KernelLength - 1L); - k = KernelOrigin - (KernelLength - 1L); - for (i = -SignalLength; (i < 0L); k++, i++) { - kp = (0L < k) ? (k) : (0L); - km = k - kp; - p = InputData + (ptrdiff_t)kp; - q = Kernel + (ptrdiff_t)km; - Sum = 0.0; - for (j = kp - ((SignalLength < (k + KernelLength)) ? (SignalLength) - : (k + KernelLength)); (j < 0L); j++) { - Sum += *p++ * *q--; - } - *OutputData++ = Sum; - } - break; - case MirrorOffBounds: - Kernel += (ptrdiff_t)(KernelLength - 1L); - if (SignalLength == 1L) { - Sum = 0.0; - for (j = -KernelLength; (j < 0L); j++) { - Sum += *Kernel--; - } - *OutputData = *InputData * Sum; - } - else { - n2 = 2L * SignalLength; - m = 1L + KernelOrigin - KernelLength; - m -= (m < 0L) ? (n2 * ((m + 1L - n2) / n2)) : (n2 * (m / n2)); - for (i = 0L; (i < SignalLength); i++) { - j = -KernelLength; - k = m; - q = Kernel; - Sum = 0.0; - while (j < 0L) { - p = InputData + (ptrdiff_t)k; - kp = ((k - SignalLength) < j) ? (j) : (k - SignalLength); - if (kp < 0L) { - for (n = kp; (n < 0L); n++) { - Sum += *p++ * *q--; - } - k -= kp; - j -= kp; - } - p = InputData + (ptrdiff_t)(n2 - k - 1L); - km = ((k - n2) < j) ? (j) : (k - n2); - if (km < 0L) { - for (n = km; (n < 0L); n++) { - Sum += *p-- * *q--; - } - j -= km; - } - k = 0L; - } - if (++m == n2) { - m = 0L; - } - *OutputData++ = Sum; - } - } - break; - case MirrorOnBounds: - Kernel += (ptrdiff_t)(KernelLength - 1L); - if (SignalLength == 1L) { - Sum = 0.0; - for (j = -KernelLength; (j < 0L); j++) { - Sum += *Kernel--; - } - *OutputData = *InputData * Sum; - } - else { - n2 = 2L * (SignalLength - 1L); - m = 1L + KernelOrigin - KernelLength; - m -= (m < 0L) ? (n2 * ((m + 1L - n2) / n2)) : (n2 * (m / n2)); - for (i = 0L; (i < SignalLength); i++) { - j = -KernelLength; - k = m; - q = Kernel; - Sum = 0.0; - while (j < 0L) { - p = InputData + (ptrdiff_t)k; - kp = ((k - SignalLength) < j) ? (j) : (k - SignalLength); - if (kp < 0L) { - for (n = kp; (n < 0L); n++) { - Sum += *p++ * *q--; - } - k -= kp; - j -= kp; - } - p = InputData + (ptrdiff_t)(n2 - k); - km = ((k - n2) < j) ? (j) : (k - n2); - if (km < 0L) { - for (n = km; (n < 0L); n++) { - Sum += *p-- * *q--; - } - j -= km; - } - k = 0L; - } - if (++m == n2) { - m = 0L; - } - *OutputData++ = Sum; - } - } - break; - case Periodic: - Kernel += (ptrdiff_t)(KernelLength - 1L); - k = KernelOrigin - (KernelLength - 1L); - k = (k < 0L) ? (k + SignalLength * ((SignalLength - 1L - k) / SignalLength)) - : ((SignalLength <= k) ? (k - SignalLength * (k / SignalLength)) : (k)); - for (i = -SignalLength; (i < 0L); i++) { - p = InputData + (ptrdiff_t)k; - q = Kernel; - Sum = 0.0; - j = k - SignalLength; - if ((j + KernelLength) <= 0L) { - for (j = -KernelLength; (j < 0L); j++) { - Sum += *p++ * *q--; - } - } - else { - while (j++ < 0L) { - Sum += *p++ * *q--; - } - p = InputData; - m = 1L - (KernelLength + k) / SignalLength; - for (n = m; (n < 0L); n++) { - for (j = -SignalLength; (j < 0L); j++) { - Sum += *p++ * *q--; - } - p = InputData; - } - for (j = (1L - m) * SignalLength - KernelLength - k; (j < 0L); j++) { - Sum += *p++ * *q--; - } - } - if (++k == SignalLength) { - k = 0L; - } - *OutputData++ = Sum; - } - break; - default: - Status = ERROR; - WRITE_ERROR(FirConvolve, "Invalid boundary convention") - break; - } -/**/DEBUG_WRITE_LEAVING(FirConvolve, "Done") - return(Status); -} /* end FirConvolve */ - -/*--------------------------------------------------------------------------*/ -extern int FirConvolveAntiSymmetric - ( - double InputData[], /* data to process */ - double OutputData[], /* result */ - long SignalLength, /* length of the 1D data array */ - double HalfKernel[], /* causal part of the kernel */ - long KernelHalfLength, /* length of the causal part of the kernel */ - enum TBoundaryConvention - Convention /* boundary convention */ - ) - -/* the specified boundary convention applies to the input data only, not to the kernel */ -/* the boundary convention applied to the kernel is FiniteDataSupport */ -/* the input and the output have the same length */ -/* the origin for the kernel is its leftmost sample; it corresponds to its anti-symmetry axis */ -/* the value of the kernel at the origin is expected to be HalfKernel[0] = 0.0 */ -/* the full length of the symmetric kernel is (2L * KernelHalfLength - 1L) */ -/* success: return(!ERROR); failure: return(ERROR) */ -/* general structure is as follows: - for (i = 0L; (i < SignalLength); i++) { - Sum = 0.0; - for (j = 1L; (j < KernelHalfLength); j++) { - Sum += (InputData[i + j] - InputData[i - j]) * HalfKernel[j]; - } - OutputData[i] = Sum; - } -*/ - -{ /* begin FirConvolveAntiSymmetric */ - - double *q, *u, *v; - double *u1, *u2, *v1, *v2; - double Sum; - double c1, c2; - long i, j; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(FirConvolveAntiSymmetric, InputData, Status, -/**/ "No input data") -/**/DEBUG_CHECK_NULL_POINTER(FirConvolveAntiSymmetric, OutputData, Status, -/**/ "No output data") -/**/DEBUG_CHECK_RANGE_LONG(FirConvolveAntiSymmetric, SignalLength, 1L, LONG_MAX, Status, -/**/ "Invalid signal length (should be strictly positive)") -/**/DEBUG_CHECK_NULL_POINTER(FirConvolveAntiSymmetric, HalfKernel, Status, -/**/ "No kernel") -/**/DEBUG_CHECK_RANGE_LONG(FirConvolveAntiSymmetric, KernelHalfLength, 1L, LONG_MAX, Status, -/**/ "Invalid kernel length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(FirConvolveAntiSymmetric, Status) -/**/DEBUG_WRITE_ENTERING(FirConvolveAntiSymmetric, -/**/ "About to perform FIR symmetric convolution") - - if (*HalfKernel != 0.0) { - Status = ERROR; - WRITE_ERROR(FirConvolveAntiSymmetric, - "Invalid anti-symmetric kernel (should be 0.0 at the origin)") -/**/ DEBUG_WRITE_LEAVING(FirConvolveAntiSymmetric, "Done") - return(Status); - } - switch (Convention) { - case AntiMirrorOnBounds: - Status = ERROR; - WRITE_ERROR(FirConvolveAntiSymmetric, "Not yet implemented") - break; - case FiniteDataSupport: - switch (KernelHalfLength) { - case 1L: - for (i = -SignalLength; (i < 0L); i++) { - *OutputData++ = 0.0; - } - break; - case 2L: - if (3L <= SignalLength) { - c1 = *++HalfKernel; - u = InputData; - *OutputData++ = -*++u * c1; - for (i = 2L - SignalLength; (i < 0L); i++) { - v = InputData; - InputData = u++; - *OutputData++ = (*v - *u) * c1; - } - *OutputData = *InputData * c1; - } - else { - switch (SignalLength) { - case 2L: - c1 = *++HalfKernel; - v = InputData++; - *OutputData++ = -*InputData * c1; - *OutputData = *v * c1; - break; - case 1L: - *OutputData = 0.0; - break; - default: - Status = ERROR; - WRITE_ERROR(FirConvolveAntiSymmetric, - "Unexpected signal length") - break; - } - } - break; - case 3L: - if (5L <= SignalLength) { - c1 = *++HalfKernel; - c2 = *++HalfKernel; - u2 = InputData; - u2++; - u1 = u2++; - *OutputData++ = -*u1 * c1 - *u2 * c2; - v1 = InputData; - InputData = u1; - u1 = u2++; - *OutputData++ = (*v1 - *u1) * c1 - *u2 * c2; - for (i = 4L - SignalLength; (i < 0L); i++) { - v2 = v1; - v1 = InputData; - InputData = u1; - u1 = u2++; - *OutputData++ = (*v1 - *u1) * c1 + (*v2 - *u2) * c2; - } - *OutputData++ = (*InputData - *u2) * c1 + *v1 * c2; - *OutputData = *u1 * c1 + *InputData * c2; - } - else { - switch (SignalLength) { - case 4L: - c1 = *++HalfKernel; - c2 = *++HalfKernel; - u2 = InputData; - u2++; - u1 = u2++; - *OutputData++ = -*u1 * c1 - *u2 * c2; - v = u2++; - *OutputData++ = (*InputData - *v) * c1 - *u2 * c2; - *OutputData++ = (*u1 - *u2) * c1 + *InputData * c2; - *OutputData = *v * c1 + *u1 * c2; - break; - case 3L: - c1 = *++HalfKernel; - c2 = *++HalfKernel; - u2 = InputData; - u2++; - u1 = u2++; - *OutputData++ = -*u1 * c1 - *u2 * c2; - *OutputData++ = (*InputData - *u2) * c1; - *OutputData = *u1 * c1 + *InputData * c2; - break; - case 2L: - c1 = *++HalfKernel; - v = InputData++; - *OutputData++ = -*InputData * c1; - *OutputData = *v * c1; - break; - case 1L: - *OutputData = 0.0; - break; - default: - Status = ERROR; - WRITE_ERROR(FirConvolveAntiSymmetric, - "Unexpected signal length") - break; - } - } - break; - default: - if ((2L * KernelHalfLength - 1L) <= SignalLength) { - for (i = 1L - KernelHalfLength; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - InputData++; - Sum = 0.0; - for (j = 1L - KernelHalfLength - i; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - for (j = i; (j < 0L); j++) { - Sum -= *++u * *++q; - } - *OutputData++ = Sum; - } - for (i = 2L * KernelHalfLength - SignalLength - 2L; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - InputData++; - Sum = 0.0; - for (j = 1L - KernelHalfLength; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - *OutputData++ = Sum; - } - for (i = 1L - KernelHalfLength; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - InputData++; - Sum = 0.0; - for (j = i + 1L; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - for (j = -KernelHalfLength - i; (j < 0L); j++) { - Sum += *--v * *++q; - } - *OutputData++ = Sum; - } - } - else if (KernelHalfLength <= SignalLength) { - for (i = KernelHalfLength - SignalLength - 1L; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - InputData++; - Sum = 0.0; - for (j = KernelHalfLength - SignalLength - i - 1L; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - for (j = SignalLength - 2L * KernelHalfLength + i + 2L; (j < 0L); j++) { - Sum -= *++u * *++q; - } - *OutputData++ = Sum; - } - for (i = SignalLength - (SignalLength / 2L) - KernelHalfLength + 1L; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - InputData++; - Sum = 0.0; - for (j = -(SignalLength / 2L) - i; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - for (j = 2L * (SignalLength / 2L) - SignalLength + 2L * i + 1L; (j < 0L); j++) { - Sum -= *++u * *++q; - } - *OutputData++ = Sum; - } - if ((2L * (SignalLength / 2L) + 1L) == SignalLength) { - q = HalfKernel; - u = v = InputData; - InputData++; - Sum = 0.0; - for (j = -(SignalLength / 2L); (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - *OutputData++ = Sum; - i = 1L; - } - for (i += SignalLength / 2L - KernelHalfLength + 1L; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - InputData++; - Sum = 0.0; - for (j = KernelHalfLength - SignalLength + i; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - for (j = SignalLength - 2L * KernelHalfLength - 2L * i + 1L; (j < 0L); j++) { - Sum += *--v * *++q; - } - *OutputData++ = Sum; - } - for (i = KernelHalfLength - SignalLength - 1L; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - InputData++; - Sum = 0.0; - for (j = i + 1L; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - for (j = -KernelHalfLength - i; (j < 0L); j++) { - Sum += *--v * *++q; - } - *OutputData++ = Sum; - } - } - else { - for (i = -(SignalLength / 2L); (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - InputData++; - Sum = 0.0; - for (j = -(SignalLength / 2L) - i; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - for (j = 2L * (SignalLength / 2L) - SignalLength + 2L * i + 1L; (j < 0L); j++) { - Sum -= *++u * *++q; - } - *OutputData++ = Sum; - } - if ((2L * (SignalLength / 2L) + 1L) == SignalLength) { - q = HalfKernel; - u = v = InputData; - InputData++; - Sum = 0.0; - for (j = -(SignalLength / 2L) - i; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - *OutputData++ = Sum; - i = 1L; - } - for (i += SignalLength / 2L - SignalLength; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - InputData++; - Sum = 0.0; - for (j = i + 1L; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - for (j = -SignalLength - 2L * i - 1L; (j < 0L); j++) { - Sum += *--v * *++q; - } - *OutputData++ = Sum; - } - } - break; - } - break; - case MirrorOffBounds: - Status = ERROR; - WRITE_ERROR(FirConvolveAntiSymmetric, "Not yet implemented") - break; - case MirrorOnBounds: - switch (KernelHalfLength) { - case 1L: - for (i = -SignalLength; (i < 0L); i++) { - *OutputData++ = 0.0; - } - break; - case 2L: - if (3L <= SignalLength) { - c1 = *++HalfKernel; - u = InputData; - u++; - *OutputData++ = 0.0; - for (i = 2L - SignalLength; (i < 0L); i++) { - v = InputData; - InputData = u++; - *OutputData++ = (*v - *u) * c1; - } - *OutputData = 0.0; - } - else { - switch (SignalLength) { - case 2L: - *OutputData++ = 0.0; - *OutputData = 0.0; - break; - case 1L: - *OutputData = 0.0; - break; - default: - Status = ERROR; - WRITE_ERROR(FirConvolveAntiSymmetric, - "Unexpected signal length") - break; - } - } - break; - case 3L: - if (5L <= SignalLength) { - c1 = *++HalfKernel; - c2 = *++HalfKernel; - u2 = InputData; - u2++; - u1 = u2++; - *OutputData++ = 0.0; - v1 = InputData; - InputData = u1; - u1 = u2++; - *OutputData++ = (*v1 - *u1) * c1 + (*InputData - *u2) * c2; - for (i = 4L - SignalLength; (i < 0L); i++) { - v2 = v1; - v1 = InputData; - InputData = u1; - u1 = u2++; - *OutputData++ = (*v1 - *u1) * c1 + (*v2 - *u2) * c2; - } - *OutputData++ = (*InputData - *u2) * c1 + (*v1 - *u1) * c2; - *OutputData = 0.0; - } - else { - switch (SignalLength) { - case 4L: - c1 = *++HalfKernel; - c2 = *++HalfKernel; - u2 = InputData; - u2++; - u1 = u2++; - v = u2++; - *OutputData++ = 0.0; - *OutputData++ = (*InputData - *v) * c1 + (*u1 - *u2) * c2; - *OutputData++ = (*u1 - *u2) * c1 + (*InputData - *v) * c2; - *OutputData = 0.0; - break; - case 3L: - c1 = *++HalfKernel; - u2 = InputData + (ptrdiff_t)2; - *OutputData++ = 0.0; - *OutputData++ = (*InputData - *u2) * c1; - *OutputData = 0.0; - break; - case 2L: - *OutputData++ = 0.0; - *OutputData = 0.0; - break; - case 1L: - *OutputData = 0.0; - break; - default: - Status = ERROR; - WRITE_ERROR(FirConvolveAntiSymmetric, - "Unexpected signal length") - break; - } - } - break; - default: - if ((2L * KernelHalfLength - 1L) <= SignalLength) { - for (i = 1L - KernelHalfLength; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - InputData++; - Sum = 0.0; - for (j = 1L - KernelHalfLength - i; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - for (j = i; (j < 0L); j++) { - Sum -= (*++u - *++v) * *++q; - } - *OutputData++ = Sum; - } - for (i = 2L * KernelHalfLength - SignalLength - 2L; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - InputData++; - Sum = 0.0; - for (j = 1L - KernelHalfLength; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - *OutputData++ = Sum; - } - for (i = 1L - KernelHalfLength; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - InputData++; - Sum = 0.0; - for (j = i + 1L; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - for (j = -KernelHalfLength - i; (j < 0L); j++) { - Sum -= (*--u - *--v) * *++q; - } - *OutputData++ = Sum; - } - } - else if (KernelHalfLength <= SignalLength) { - for (i = KernelHalfLength - SignalLength - 1L; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - InputData++; - Sum = 0.0; - for (j = KernelHalfLength - SignalLength - i - 1L; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - for (j = SignalLength - 2L * KernelHalfLength + i + 2L; (j < 0L); j++) { - Sum -= (*++u - *++v) * *++q; - } - *OutputData++ = Sum; - } - for (i = SignalLength - (SignalLength / 2L) - KernelHalfLength + 1L; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - InputData++; - Sum = 0.0; - for (j = -(SignalLength / 2L) - i; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - for (j = 2L * (SignalLength / 2L) - SignalLength + 2L * i + 1L; (j < 0L); j++) { - Sum -= (*++u - *++v) * *++q; - } - for (j = SignalLength - (SignalLength / 2L) - KernelHalfLength - i; (j < 0L); j++) { - Sum -= (*--u - *++v) * *++q; - } - *OutputData++ = Sum; - } - if ((2L * (SignalLength / 2L) + 1L) == SignalLength) { - q = HalfKernel; - u = v = InputData; - InputData++; - Sum = 0.0; - for (j = -(SignalLength / 2L); (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - for (j = SignalLength / 2L - KernelHalfLength + 1L; (j < 0L); j++) { - Sum -= (*--u - *++v) * *++q; - } - *OutputData++ = Sum; - i = 1L; - } - for (i += SignalLength / 2L - KernelHalfLength + 1L; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - InputData++; - Sum = 0.0; - for (j = KernelHalfLength - SignalLength + i; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - for (j = SignalLength - 2L * KernelHalfLength - 2L * i + 1L; (j < 0L); j++) { - Sum -= (*--u - *--v) * *++q; - } - for (j = i; (j < 0L); j++) { - Sum -= (*--u - *++v) * *++q; - } - *OutputData++ = Sum; - } - for (i = KernelHalfLength - SignalLength - 1L; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - InputData++; - Sum = 0.0; - for (j = i + 1L; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - for (j = -KernelHalfLength - i; (j < 0L); j++) { - Sum -= (*--u - *--v) * *++q; - } - *OutputData++ = Sum; - } - } - else { - if (SignalLength == 1L) { - *OutputData = 0.0; - } - else { - v1 = InputData; - u1 = InputData + (ptrdiff_t)(SignalLength - 1L); - for (i = -SignalLength; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - InputData++; - Sum = 0.0; - j = 1L - KernelHalfLength; - while ((j < 0L) && (u < u1) && (v1 < v)) { - Sum -= (*++u - *--v) * *++q; - j++; - } - if ((u == u1) && (v == v1)) { - while (j < 0L) { - while ((j < 0L) && (v < u1)) { - Sum -= (*--u - *++v) * *++q; - j++; - } - while ((j < 0L) && (u < u1)) { - Sum -= (*++u - *--v) * *++q; - j++; - } - } - } - else if (u == u1) { - while (j < 0L) { - while ((j < 0L) && (v1 < v)) { - Sum -= (*--u - *--v) * *++q; - j++; - } - while ((j < 0L) && (v1 < u)) { - Sum -= (*--u - *++v) * *++q; - j++; - } - while ((j < 0L) && (v < u1)) { - Sum -= (*++u - *++v) * *++q; - j++; - } - while ((j < 0L) && (u < u1)) { - Sum -= (*++u - *--v) * *++q; - j++; - } - } - } - else { - while (j < 0L) { - while ((j < 0L) && (u < u1)) { - Sum -= (*++u - *++v) * *++q; - j++; - } - while ((j < 0L) && (v < u1)) { - Sum -= (*--u - *++v) * *++q; - j++; - } - while ((j < 0L) && (v1 < u)) { - Sum -= (*--u - *--v) * *++q; - j++; - } - while ((j < 0L) && (v1 < v)) { - Sum -= (*++u - *--v) * *++q; - j++; - } - } - } - *OutputData++ = Sum; - } - } - } - break; - } - break; - case Periodic: - switch (KernelHalfLength) { - case 1L: - for (i = -SignalLength; (i < 0L); i++) { - *OutputData++ = 0.0; - } - break; - case 2L: - if (3L <= SignalLength) { - c1 = *++HalfKernel; - u = u1 = InputData; - v = InputData + (ptrdiff_t)SignalLength; - *OutputData++ = (*--v - *++u) * c1; - for (i = 2L - SignalLength; (i < 0L); i++) { - v = InputData; - InputData = u++; - *OutputData++ = (*v - *u) * c1; - } - *OutputData = (*InputData - *u1) * c1; - } - else { - switch (SignalLength) { - case 2L: - *OutputData++ = 0.0; - *OutputData = 0.0; - break; - case 1L: - *OutputData = 0.0; - break; - default: - Status = ERROR; - WRITE_ERROR(FirConvolveAntiSymmetric, - "Unexpected signal length") - break; - } - } - break; - case 3L: - if (5L <= SignalLength) { - c1 = *++HalfKernel; - c2 = *++HalfKernel; - u = u2 = InputData; - u2++; - u1 = u2++; - v = u++; - v1 = InputData + (ptrdiff_t)SignalLength; - v2 = v1--; - *OutputData++ = (*--v2 - *u1) * c1 + (*--v1 - *u2) * c2; - v1 = InputData; - InputData = u1; - u1 = u2++; - *OutputData++ = (*v1 - *u1) * c1 + (*v2 - *u2) * c2; - for (i = 4L - SignalLength; (i < 0L); i++) { - v2 = v1; - v1 = InputData; - InputData = u1; - u1 = u2++; - *OutputData++ = (*v1 - *u1) * c1 + (*v2 - *u2) * c2; - } - *OutputData++ = (*InputData - *u2) * c1 + (*v1 - *v) * c2; - *OutputData = (*u1 - *v) * c1 + (*InputData - *u) * c2; - } - else { - switch (SignalLength) { - case 4L: - c1 = *++HalfKernel; - c2 = *++HalfKernel; - u2 = InputData; - u2++; - u1 = u2++; - v = u2++; - c2 = (*u1 - *u2) * c1; - c1 *= *v - *InputData; - *OutputData++ = -c2; - *OutputData++ = -c1; - *OutputData++ = c2; - *OutputData = c1; - break; - case 3L: - c1 = *++HalfKernel; - c2 = *++HalfKernel; - u2 = InputData; - u2++; - u1 = u2++; - c1 -= c2; - *OutputData++ = (*u2 - *u1) * c1; - *OutputData++ = (*InputData - *u2) * c1; - *OutputData = (*u1 - *InputData) * c1; - break; - case 2L: - *OutputData++ = 0.0; - *OutputData = 0.0; - break; - case 1L: - *OutputData = 0.0; - break; - default: - Status = ERROR; - WRITE_ERROR(FirConvolveAntiSymmetric, - "Unexpected signal length") - break; - } - } - break; - default: - v2 = InputData; - v1 = v2--; - u1 = InputData + (ptrdiff_t)SignalLength; - u2 = u1--; - if ((2L * KernelHalfLength - 1L) <= SignalLength) { - for (i = 1L - KernelHalfLength; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - InputData++; - Sum = 0.0; - for (j = 1L - KernelHalfLength - i; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - v = u2; - for (j = i; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - *OutputData++ = Sum; - } - for (i = 2L * KernelHalfLength - SignalLength - 2L; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - InputData++; - Sum = 0.0; - for (j = 1L - KernelHalfLength; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - *OutputData++ = Sum; - } - for (i = 1L - KernelHalfLength; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - InputData++; - Sum = 0.0; - for (j = i + 1L; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - u = v2; - for (j = -KernelHalfLength - i; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - *OutputData++ = Sum; - } - } - else if (KernelHalfLength <= SignalLength) { - for (i = KernelHalfLength - SignalLength - 1L; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - InputData++; - Sum = 0.0; - for (j = KernelHalfLength - SignalLength - i - 1L; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - v = u2; - for (j = SignalLength - 2L * KernelHalfLength + i + 2L; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - *OutputData++ = Sum; - } - for (i = SignalLength - (SignalLength / 2L) - KernelHalfLength + 1L; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - InputData++; - Sum = 0.0; - for (j = -(SignalLength / 2L) - i; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - v = u2; - for (j = 2L * (SignalLength / 2L) - SignalLength + 2L * i + 1L; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - u = v2; - for (j = SignalLength - (SignalLength / 2L) - KernelHalfLength - i; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - *OutputData++ = Sum; - } - if ((2L * (SignalLength / 2L) + 1L) == SignalLength) { - q = HalfKernel; - u = v = InputData; - InputData++; - Sum = 0.0; - for (j = -(SignalLength / 2L); (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - v = u2; - u = v2; - for (j = SignalLength / 2L - KernelHalfLength + 1L; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - *OutputData++ = Sum; - i = 1L; - } - for (i += SignalLength / 2L - KernelHalfLength + 1L; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - InputData++; - Sum = 0.0; - for (j = KernelHalfLength - SignalLength + i; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - u = v2; - for (j = SignalLength - 2L * KernelHalfLength - 2L * i + 1L; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - v = u2; - for (j = i; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - *OutputData++ = Sum; - } - for (i = KernelHalfLength - SignalLength - 1L; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - InputData++; - Sum = 0.0; - for (j = i + 1L; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - u = v2; - for (j = -KernelHalfLength - i; (j < 0L); j++) { - Sum -= (*++u - *--v) * *++q; - } - *OutputData++ = Sum; - } - } - else { - for (i = -SignalLength; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - InputData++; - Sum = 0.0; - for (j = 1L - KernelHalfLength; (j < 0L); j++) { - if (u == u1) { - u = v2; - } - if (v == v1) { - v = u2; - } - Sum -= (*++u - *--v) * *++q; - } - *OutputData++ = Sum; - } - } - break; - } - break; - default: - Status = ERROR; - WRITE_ERROR(FirConvolveAntiSymmetric, "Invalid boundary convention") - break; - } -/**/DEBUG_WRITE_LEAVING(FirConvolveAntiSymmetric, "Done") - return(Status); -} /* end FirConvolveAntiSymmetric */ - -/*--------------------------------------------------------------------------*/ -extern int FirConvolveAntiSymmetricVolume - ( - double *VolumeSource, /* data to process */ - double *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - double HalfKernel[], /* causal part of the kernel */ - long KernelHalfLength, /* length of the causal part of the kernel */ - enum TBoundaryConvention - Convention /* boundary convention */ - ) - -/* the specified boundary convention applies to the input data only, not to the kernel */ -/* the boundary convention applied to the kernel is FiniteDataSupport */ -/* VolumeSource is a (double)volume of size (Nx x Ny x Nz) */ -/* OutputData is a (double)volume of size (Nx x Ny x Nz) */ -/* the origin for the kernel is its leftmost sample; it corresponds to its anti-symmetry axis */ -/* the full length of the amti-symmetric kernel is (2L * KernelHalfLength - 1L) */ -/* the 1D kernel is applied successively to each principal direction in a separable fashion */ -/* success: return(!ERROR); failure: return(ERROR) */ -/* general structure is as follows: - for (i = 0L; (i < SignalLength); i++) { - Sum = InputData[i] * HalfKernel[0]; - for (j = 1L; (j < KernelHalfLength); j++) { - Sum += (InputData[i + j] - InputData[i - j]) * HalfKernel[j]; - } - OutputData[i] = Sum; - } -*/ - -{ /* begin FirConvolveAntiSymmetricVolume */ - - double *InBuffer = (double *)NULL, *OutBuffer = (double *)NULL; - long i, j, k; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(FirConvolveAntiSymmetricVolume, VolumeSource, Status, -/**/ "No VolumeSource") -/**/DEBUG_CHECK_NULL_POINTER(FirConvolveAntiSymmetricVolume, VolumeDestination, Status, -/**/ "No OutputData") -/**/DEBUG_CHECK_RANGE_LONG(FirConvolveAntiSymmetricVolume, Nx, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(FirConvolveAntiSymmetricVolume, Ny, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(FirConvolveAntiSymmetricVolume, Nz, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_NULL_POINTER(FirConvolveAntiSymmetricVolume, HalfKernel, Status, -/**/ "No kernel") -/**/DEBUG_CHECK_RANGE_LONG(FirConvolveAntiSymmetricVolume, KernelHalfLength, 1L, LONG_MAX, Status, -/**/ "Invalid kernel length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(FirConvolveAntiSymmetricVolume, Status) -/**/DEBUG_WRITE_ENTERING(FirConvolveAntiSymmetricVolume, -/**/ "About to perform IIR recursive convolution for a volume") - - switch (Convention) { - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - default: - Status = ERROR; - WRITE_ERROR(FirConvolveAntiSymmetricVolume, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(FirConvolveAntiSymmetricVolume, "Done") - return(Status); - } - if (1L < Nx) { - AllocateLineDouble(&InBuffer, Nx, &Status); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(FirConvolveAntiSymmetricVolume, "Done") - return(Status); - } - AllocateLineDouble(&OutBuffer, Nx, &Status); - if (Status == ERROR) { - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(FirConvolveAntiSymmetricVolume, "Done") - return(Status); - } - for (k = 0L; (k < Nz); k++) { - for (j = 0L; (j < Ny); j++) { - Status = GetxDoubleToDouble(VolumeSource, Nx, Ny, Nz, 0L, j, k, InBuffer, Nx); - if (Status == ERROR) { - FreeLineDouble(&OutBuffer); - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(FirConvolveAntiSymmetricVolume, "Done") - return(Status); - } - Status = FirConvolveAntiSymmetric(InBuffer, OutBuffer, Nx, - HalfKernel, KernelHalfLength, Convention); - if (Status == ERROR) { - FreeLineDouble(&OutBuffer); - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(FirConvolveAntiSymmetricVolume, "Done") - return(Status); - } - Status = PutxDoubleToDouble(VolumeDestination, Nx, Ny, Nz, 0L, j, k, OutBuffer, Nx); - if (Status == ERROR) { - FreeLineDouble(&OutBuffer); - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(FirConvolveAntiSymmetricVolume, "Done") - return(Status); - } - } - } - Status = FreeLineDouble(&OutBuffer); - if (Status == ERROR) { - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(FirConvolveAntiSymmetricVolume, "Done") - return(Status); - } - Status = FreeLineDouble(&InBuffer); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(FirConvolveAntiSymmetricVolume, "Done") - return(Status); - } - } - else { - VolumeDestination = (double *)memcpy(VolumeDestination, VolumeSource, - (size_t)(Nx * Ny * Nz * (long)sizeof(double))); - } - if (1L < Ny) { - AllocateLineDouble(&InBuffer, Ny, &Status); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(FirConvolveAntiSymmetricVolume, "Done") - return(Status); - } - AllocateLineDouble(&OutBuffer, Ny, &Status); - if (Status == ERROR) { - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(FirConvolveAntiSymmetricVolume, "Done") - return(Status); - } - for (k = 0L; (k < Nz); k++) { - for (i = 0L; (i < Nx); i++) { - Status = GetyDoubleToDouble(VolumeDestination, Nx, Ny, Nz, i, 0L, k, InBuffer, Ny); - if (Status == ERROR) { - FreeLineDouble(&OutBuffer); - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(FirConvolveAntiSymmetricVolume, "Done") - return(Status); - } - Status = FirConvolveAntiSymmetric(InBuffer, OutBuffer, Ny, - HalfKernel, KernelHalfLength, Convention); - if (Status == ERROR) { - FreeLineDouble(&OutBuffer); - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(FirConvolveAntiSymmetricVolume, "Done") - return(Status); - } - Status = PutyDoubleToDouble(VolumeDestination, Nx, Ny, Nz, i, 0L, k, OutBuffer, Ny); - if (Status == ERROR) { - FreeLineDouble(&OutBuffer); - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(FirConvolveAntiSymmetricVolume, "Done") - return(Status); - } - } - } - Status = FreeLineDouble(&OutBuffer); - if (Status == ERROR) { - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(FirConvolveAntiSymmetricVolume, "Done") - return(Status); - } - Status = FreeLineDouble(&InBuffer); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(FirConvolveAntiSymmetricVolume, "Done") - return(Status); - } - } - if (1L < Nz) { - AllocateLineDouble(&InBuffer, Nz, &Status); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(FirConvolveAntiSymmetricVolume, "Done") - return(Status); - } - AllocateLineDouble(&OutBuffer, Nz, &Status); - if (Status == ERROR) { - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(FirConvolveAntiSymmetricVolume, "Done") - return(Status); - } - for (j = 0L; (j < Ny); j++) { - for (i = 0L; (i < Nx); i++) { - Status = GetzDoubleToDouble(VolumeDestination, Nx, Ny, Nz, i, j, 0L, InBuffer, Nz); - if (Status == ERROR) { - FreeLineDouble(&OutBuffer); - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(FirConvolveAntiSymmetricVolume, "Done") - return(Status); - } - Status = FirConvolveAntiSymmetric(InBuffer, OutBuffer, Nz, - HalfKernel, KernelHalfLength, Convention); - if (Status == ERROR) { - FreeLineDouble(&OutBuffer); - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(FirConvolveAntiSymmetricVolume, "Done") - return(Status); - } - Status = PutzDoubleToDouble(VolumeDestination, Nx, Ny, Nz, i, j, 0L, OutBuffer, Nz); - if (Status == ERROR) { - FreeLineDouble(&OutBuffer); - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(FirConvolveAntiSymmetricVolume, "Done") - return(Status); - } - } - } - Status = FreeLineDouble(&OutBuffer); - if (Status == ERROR) { - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(FirConvolveAntiSymmetricVolume, "Done") - return(Status); - } - Status = FreeLineDouble(&InBuffer); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(FirConvolveAntiSymmetricVolume, "Done") - return(Status); - } - } -/**/DEBUG_WRITE_LEAVING(FirConvolveAntiSymmetricVolume, "Done") - return(Status); -} /* end FirConvolveAntiSymmetricVolume */ - -/*--------------------------------------------------------------------------*/ -extern int FirConvolveSymmetric - ( - double InputData[], /* data to process */ - double OutputData[], /* result */ - long SignalLength, /* length of the 1D data array */ - double HalfKernel[], /* causal part of the kernel */ - long KernelHalfLength, /* length of the causal part of the kernel */ - enum TBoundaryConvention - Convention /* boundary convention */ - ) - -/* the specified boundary convention applies to the input data only, not to the kernel */ -/* the boundary convention applied to the kernel is FiniteDataSupport */ -/* the input and the output have the same length */ -/* the origin for the kernel is its leftmost sample; it corresponds to its symmetry axis */ -/* the full length of the symmetric kernel is (2L * KernelHalfLength - 1L) */ -/* success: return(!ERROR); failure: return(ERROR) */ -/* general structure is as follows: - for (i = 0L; (i < SignalLength); i++) { - Sum = InputData[i] * HalfKernel[0]; - for (j = 1L; (j < KernelHalfLength); j++) { - Sum += (InputData[i + j] + InputData[i - j]) * HalfKernel[j]; - } - OutputData[i] = Sum; - } -*/ - -{ /* begin FirConvolveSymmetric */ - - double *q, *u, *v; - double *u1, *u2, *v1, *v2; - double Sum; - double c0, c1, c2; - long i, j; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(FirConvolveSymmetric, InputData, Status, -/**/ "No input data") -/**/DEBUG_CHECK_NULL_POINTER(FirConvolveSymmetric, OutputData, Status, -/**/ "No output data") -/**/DEBUG_CHECK_RANGE_LONG(FirConvolveSymmetric, SignalLength, 1L, LONG_MAX, Status, -/**/ "Invalid signal length (should be strictly positive)") -/**/DEBUG_CHECK_NULL_POINTER(FirConvolveSymmetric, HalfKernel, Status, -/**/ "No kernel") -/**/DEBUG_CHECK_RANGE_LONG(FirConvolveSymmetric, KernelHalfLength, 1L, LONG_MAX, Status, -/**/ "Invalid kernel length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(FirConvolveSymmetric, Status) -/**/DEBUG_WRITE_ENTERING(FirConvolveSymmetric, -/**/ "About to perform FIR symmetric convolution") - - switch (Convention) { - case AntiMirrorOnBounds: - Status = ERROR; - WRITE_ERROR(FirConvolveSymmetric, "Not yet implemented") - break; - case FiniteDataSupport: - switch (KernelHalfLength) { - case 1L: - c0 = *HalfKernel; - for (i = -SignalLength; (i < 0L); i++) { - *OutputData++ = *InputData++ * c0; - } - break; - case 2L: - c0 = *HalfKernel++; - c1 = *HalfKernel; - if (3L <= SignalLength) { - u = InputData; - *OutputData++ = *InputData * c0 + *++u * c1; - for (i = 2L - SignalLength; (i < 0L); i++) { - v = InputData; - InputData = u++; - *OutputData++ = *InputData * c0 + (*u + *v) * c1; - } - *OutputData = *u * c0 + *InputData * c1; - } - else { - switch (SignalLength) { - case 2L: - v = InputData++; - *OutputData++ = *v * c0 + *InputData * c1; - *OutputData = *InputData * c0 + *v * c1; - break; - case 1L: - *OutputData = *InputData * c0; - break; - default: - Status = ERROR; - WRITE_ERROR(FirConvolveSymmetric, - "Unexpected signal length") - break; - } - } - break; - case 3L: - c0 = *HalfKernel++; - c1 = *HalfKernel++; - c2 = *HalfKernel; - if (5L <= SignalLength) { - u2 = InputData; - u2++; - u1 = u2++; - *OutputData++ = *InputData * c0 + *u1 * c1 + *u2 * c2; - v1 = InputData; - InputData = u1; - u1 = u2++; - *OutputData++ = *InputData * c0 + (*u1 + *v1) * c1 + *u2 * c2; - for (i = 4L - SignalLength; (i < 0L); i++) { - v2 = v1; - v1 = InputData; - InputData = u1; - u1 = u2++; - *OutputData++ = *InputData * c0 + (*u1 + *v1) * c1 + (*u2 + *v2) * c2; - } - *OutputData++ = *u1 * c0 + (*u2 + *InputData) * c1 + *v1 * c2; - *OutputData = *u2 * c0 + *u1 * c1 + *InputData * c2; - } - else { - switch (SignalLength) { - case 4L: - u2 = InputData; - u2++; - u1 = u2++; - *OutputData++ = *InputData * c0 + *u1 * c1 + *u2 * c2; - v = u2++; - *OutputData++ = *u1 * c0 + (*v + *InputData) * c1 + *u2 * c2; - *OutputData++ = *v * c0 + (*u2 + *u1) * c1 + *InputData * c2; - *OutputData = *u2 * c0 + *v * c1 + *u1 * c2; - break; - case 3L: - u2 = InputData; - u2++; - u1 = u2++; - *OutputData++ = *InputData * c0 + *u1 * c1 + *u2 * c2; - *OutputData++ = *u1 * c0 + (*u2 + *InputData) * c1; - *OutputData = *u2 * c0 + *u1 * c1 + *InputData * c2; - break; - case 2L: - v = InputData++; - *OutputData++ = *v * c0 + *InputData * c1; - *OutputData = *InputData * c0 + *v * c1; - break; - case 1L: - *OutputData = *InputData * c0; - break; - default: - Status = ERROR; - WRITE_ERROR(FirConvolveSymmetric, - "Unexpected signal length") - break; - } - } - break; - default: - if ((2L * KernelHalfLength - 1L) <= SignalLength) { - for (i = 1L - KernelHalfLength; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - Sum = *InputData++ * *q; - for (j = 1L - KernelHalfLength - i; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - for (j = i; (j < 0L); j++) { - Sum += *++u * *++q; - } - *OutputData++ = Sum; - } - for (i = 2L * KernelHalfLength - SignalLength - 2L; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - Sum = *InputData++ * *q; - for (j = 1L - KernelHalfLength; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - *OutputData++ = Sum; - } - for (i = 1L - KernelHalfLength; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - Sum = *InputData++ * *q; - for (j = i + 1L; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - for (j = -KernelHalfLength - i; (j < 0L); j++) { - Sum += *--v * *++q; - } - *OutputData++ = Sum; - } - } - else if (KernelHalfLength <= SignalLength) { - for (i = KernelHalfLength - SignalLength - 1L; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - Sum = *InputData++ * *q; - for (j = KernelHalfLength - SignalLength - i - 1L; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - for (j = SignalLength - 2L * KernelHalfLength + i + 2L; (j < 0L); j++) { - Sum += *++u * *++q; - } - *OutputData++ = Sum; - } - for (i = SignalLength - (SignalLength / 2L) - KernelHalfLength + 1L; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - Sum = *InputData++ * *q; - for (j = -(SignalLength / 2L) - i; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - for (j = 2L * (SignalLength / 2L) - SignalLength + 2L * i + 1L; (j < 0L); j++) { - Sum += *++u * *++q; - } - *OutputData++ = Sum; - } - if ((2L * (SignalLength / 2L) + 1L) == SignalLength) { - q = HalfKernel; - u = v = InputData; - Sum = *InputData++ * *q; - for (j = -(SignalLength / 2L); (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - *OutputData++ = Sum; - i = 1L; - } - for (i += SignalLength / 2L - KernelHalfLength + 1L; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - Sum = *InputData++ * *q; - for (j = KernelHalfLength - SignalLength + i; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - for (j = SignalLength - 2L * KernelHalfLength - 2L * i + 1L; (j < 0L); j++) { - Sum += *--v * *++q; - } - *OutputData++ = Sum; - } - for (i = KernelHalfLength - SignalLength - 1L; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - Sum = *InputData++ * *q; - for (j = i + 1L; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - for (j = -KernelHalfLength - i; (j < 0L); j++) { - Sum += *--v * *++q; - } - *OutputData++ = Sum; - } - } - else { - for (i = -(SignalLength / 2L); (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - Sum = *InputData++ * *q; - for (j = -(SignalLength / 2L) - i; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - for (j = 2L * (SignalLength / 2L) - SignalLength + 2L * i + 1L; (j < 0L); j++) { - Sum += *++u * *++q; - } - *OutputData++ = Sum; - } - if ((2L * (SignalLength / 2L) + 1L) == SignalLength) { - q = HalfKernel; - u = v = InputData; - Sum = *InputData++ * *q; - for (j = -(SignalLength / 2L) - i; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - *OutputData++ = Sum; - i = 1L; - } - for (i += SignalLength / 2L - SignalLength; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - Sum = *InputData++ * *q; - for (j = i + 1L; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - for (j = -SignalLength - 2L * i - 1L; (j < 0L); j++) { - Sum += *--v * *++q; - } - *OutputData++ = Sum; - } - } - break; - } - break; - case MirrorOffBounds: - Status = ERROR; - WRITE_ERROR(FirConvolveSymmetric, "Not yet implemented") - break; - case MirrorOnBounds: - switch (KernelHalfLength) { - case 1L: - c0 = *HalfKernel; - for (i = -SignalLength; (i < 0L); i++) { - *OutputData++ = *InputData++ * c0; - } - break; - case 2L: - c0 = *HalfKernel++; - c1 = *HalfKernel; - u = InputData; - if (3L <= SignalLength) { - *OutputData++ = *InputData * c0 + *++u * 2.0 * c1; - for (i = 2L - SignalLength; (i < 0L); i++) { - v = InputData; - InputData = u++; - *OutputData++ = *InputData * c0 + (*u + *v) * c1; - } - *OutputData = *u * c0 + *InputData * 2.0 * c1; - } - else { - switch (SignalLength) { - case 2L: - c1 += c1; - *OutputData++ = *InputData * c0 + *++u * c1; - *OutputData = *u * c0 + *InputData * c1; - break; - case 1L: - *OutputData = *InputData * (c0 + 2.0 * c1); - break; - default: - Status = ERROR; - WRITE_ERROR(FirConvolveSymmetric, - "Unexpected signal length") - break; - } - } - break; - case 3L: - c0 = *HalfKernel++; - c1 = *HalfKernel++; - c2 = *HalfKernel; - u2 = InputData; - u2++; - u1 = u2++; - if (5L <= SignalLength) { - *OutputData++ = *InputData * c0 + *u1 * 2.0 * c1 + *u2 * 2.0 * c2; - v1 = InputData; - InputData = u1; - u1 = u2++; - *OutputData++ = *InputData * c0 + (*u1 + *v1) * c1 + (*u2 + *InputData) * c2; - for (i = 4L - SignalLength; (i < 0L); i++) { - v2 = v1; - v1 = InputData; - InputData = u1; - u1 = u2++; - *OutputData++ = *InputData * c0 + (*u1 + *v1) * c1 + (*u2 + *v2) * c2; - } - *OutputData++ = *u1 * c0 + (*u2 + *InputData) * c1 + (*u1 + *v1) * c2; - *OutputData = *u2 * c0 + *u1 * 2.0 * c1 + *InputData * 2.0 * c2; - } - else { - switch (SignalLength) { - case 4L: - v = u2++; - *OutputData++ = *InputData * c0 + *u1 * 2.0 * c1 + *v * 2.0 * c2; - *OutputData++ = *u1 * c0 + (*v + *InputData) * c1 + (*u2 + *u1) * c2; - *OutputData++ = *v * c0 + (*u2 + *u1) * c1 + (*v + *InputData) * c2; - *OutputData = *u2 * c0 + *v * 2.0 * c1 + *u1 * 2.0 * c2; - break; - case 3L: - c2 *= 2.0; - *OutputData++ = *InputData * c0 + *u1 * 2.0 * c1 + *u2 * c2; - *OutputData++ = *u1 * c0 + (*u2 + *InputData) * c1 + *u1 * c2; - *OutputData = *u2 * c0 + *u1 * 2.0 * c1 + *InputData * c2; - break; - case 2L: - c0 += 2.0 * c2; - c1 *= 2.0; - *OutputData++ = *InputData * c0 + *u1 * c1; - *OutputData = *u1 * c0 + *InputData * c1; - break; - case 1L: - *OutputData = *InputData * (c0 + 2.0 * c1 + 2.0 * c2); - break; - default: - Status = ERROR; - WRITE_ERROR(FirConvolveSymmetric, - "Unexpected signal length") - break; - } - } - break; - default: - if ((2L * KernelHalfLength - 1L) <= SignalLength) { - for (i = 1L - KernelHalfLength; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - Sum = *InputData++ * *q; - for (j = 1L - KernelHalfLength - i; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - for (j = i; (j < 0L); j++) { - Sum += (*++u + *++v) * *++q; - } - *OutputData++ = Sum; - } - for (i = 2L * KernelHalfLength - SignalLength - 2L; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - Sum = *InputData++ * *q; - for (j = 1L - KernelHalfLength; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - *OutputData++ = Sum; - } - for (i = 1L - KernelHalfLength; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - Sum = *InputData++ * *q; - for (j = i + 1L; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - for (j = -KernelHalfLength - i; (j < 0L); j++) { - Sum += (*--u + *--v) * *++q; - } - *OutputData++ = Sum; - } - } - else if (KernelHalfLength <= SignalLength) { - for (i = KernelHalfLength - SignalLength - 1L; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - Sum = *InputData++ * *q; - for (j = KernelHalfLength - SignalLength - i - 1L; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - for (j = SignalLength - 2L * KernelHalfLength + i + 2L; (j < 0L); j++) { - Sum += (*++u + *++v) * *++q; - } - *OutputData++ = Sum; - } - for (i = SignalLength - (SignalLength / 2L) - KernelHalfLength + 1L; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - Sum = *InputData++ * *q; - for (j = -(SignalLength / 2L) - i; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - for (j = 2L * (SignalLength / 2L) - SignalLength + 2L * i + 1L; (j < 0L); j++) { - Sum += (*++u + *++v) * *++q; - } - for (j = SignalLength - (SignalLength / 2L) - KernelHalfLength - i; (j < 0L); j++) { - Sum += (*--u + *++v) * *++q; - } - *OutputData++ = Sum; - } - if ((2L * (SignalLength / 2L) + 1L) == SignalLength) { - q = HalfKernel; - u = v = InputData; - Sum = *InputData++ * *q; - for (j = -(SignalLength / 2L); (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - for (j = SignalLength / 2L - KernelHalfLength + 1L; (j < 0L); j++) { - Sum += (*--u + *++v) * *++q; - } - *OutputData++ = Sum; - i = 1L; - } - for (i += SignalLength / 2L - KernelHalfLength + 1L; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - Sum = *InputData++ * *q; - for (j = KernelHalfLength - SignalLength + i; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - for (j = SignalLength - 2L * KernelHalfLength - 2L * i + 1L; (j < 0L); j++) { - Sum += (*--u + *--v) * *++q; - } - for (j = i; (j < 0L); j++) { - Sum += (*--u + *++v) * *++q; - } - *OutputData++ = Sum; - } - for (i = KernelHalfLength - SignalLength - 1L; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - Sum = *InputData++ * *q; - for (j = i + 1L; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - for (j = -KernelHalfLength - i; (j < 0L); j++) { - Sum += (*--u + *--v) * *++q; - } - *OutputData++ = Sum; - } - } - else { - if (SignalLength == 1L) { - Sum = *HalfKernel++; - for (j = 1L - KernelHalfLength; (j < 0L); j++) { - Sum += 2.0 * *HalfKernel++; - } - *OutputData = Sum * *InputData; - } - else { - v1 = InputData; - u1 = InputData + (ptrdiff_t)(SignalLength - 1L); - for (i = -SignalLength; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - Sum = *InputData++ * *q; - j = 1L - KernelHalfLength; - while ((j < 0L) && (u < u1) && (v1 < v)) { - Sum += (*++u + *--v) * *++q; - j++; - } - if ((u == u1) && (v == v1)) { - while (j < 0L) { - while ((j < 0L) && (v < u1)) { - Sum += (*--u + *++v) * *++q; - j++; - } - while ((j < 0L) && (u < u1)) { - Sum += (*++u + *--v) * *++q; - j++; - } - } - } - else if (u == u1) { - while (j < 0L) { - while ((j < 0L) && (v1 < v)) { - Sum += (*--u + *--v) * *++q; - j++; - } - while ((j < 0L) && (v1 < u)) { - Sum += (*--u + *++v) * *++q; - j++; - } - while ((j < 0L) && (v < u1)) { - Sum += (*++u + *++v) * *++q; - j++; - } - while ((j < 0L) && (u < u1)) { - Sum += (*++u + *--v) * *++q; - j++; - } - } - } - else { - while (j < 0L) { - while ((j < 0L) && (u < u1)) { - Sum += (*++u + *++v) * *++q; - j++; - } - while ((j < 0L) && (v < u1)) { - Sum += (*--u + *++v) * *++q; - j++; - } - while ((j < 0L) && (v1 < u)) { - Sum += (*--u + *--v) * *++q; - j++; - } - while ((j < 0L) && (v1 < v)) { - Sum += (*++u + *--v) * *++q; - j++; - } - } - } - *OutputData++ = Sum; - } - } - } - break; - } - break; - case Periodic: - switch (KernelHalfLength) { - case 1L: - c0 = *HalfKernel; - for (i = -SignalLength; (i < 0L); i++) { - *OutputData++ = *InputData++ * c0; - } - break; - case 2L: - c0 = *HalfKernel++; - c1 = *HalfKernel; - u = InputData; - if (3L <= SignalLength) { - u1 = InputData; - v = InputData + (ptrdiff_t)SignalLength; - *OutputData++ = *InputData * c0 + (*++u + *--v) * c1; - for (i = 2L - SignalLength; (i < 0L); i++) { - v = InputData; - InputData = u++; - *OutputData++ = *InputData * c0 + (*u + *v) * c1; - } - *OutputData = *u * c0 + (*u1 + *InputData) * c1; - } - else { - switch (SignalLength) { - case 2L: - c1 += c1; - *OutputData++ = *InputData * c0 + *++u * c1; - *OutputData = *u * c0 + *InputData * c1; - break; - case 1L: - *OutputData = *InputData * (c0 + 2.0 * c1); - break; - default: - Status = ERROR; - WRITE_ERROR(FirConvolveSymmetric, - "Unexpected signal length") - break; - } - } - break; - case 3L: - c0 = *HalfKernel++; - c1 = *HalfKernel++; - c2 = *HalfKernel; - u2 = InputData; - u2++; - u1 = u2++; - if (5L <= SignalLength) { - u = InputData; - v = u++; - v1 = InputData + (ptrdiff_t)SignalLength; - v2 = v1--; - *OutputData++ = *InputData * c0 + (*u1 + *--v2) * c1 + (*u2 + *--v1) * c2; - v1 = InputData; - InputData = u1; - u1 = u2++; - *OutputData++ = *InputData * c0 + (*u1 + *v1) * c1 + (*u2 + *v2) * c2; - for (i = 4L - SignalLength; (i < 0L); i++) { - v2 = v1; - v1 = InputData; - InputData = u1; - u1 = u2++; - *OutputData++ = *InputData * c0 + (*u1 + *v1) * c1 + (*u2 + *v2) * c2; - } - *OutputData++ = *u1 * c0 + (*u2 + *InputData) * c1 + (*v + *v1) * c2; - *OutputData = *u2 * c0 + (*v + *u1) * c1 + (*u + *InputData) * c2; - } - else { - switch (SignalLength) { - case 4L: - c2 *= 2.0; - v = u2++; - *OutputData++ = *InputData * c0 + (*u1 + *u2) * c1 + *v * c2; - *OutputData++ = *u1 * c0 + (*v + *InputData) * c1 + *u2 * c2; - *OutputData++ = *v * c0 + (*u2 + *u1) * c1 + *InputData * c2; - *OutputData = *u2 * c0 + (*InputData + *v) * c1 + *u1 * c2; - break; - case 3L: - c1 += c2; - *OutputData++ = *InputData * c0 + (*u1 + *u2) * c1; - *OutputData++ = *u1 * c0 + (*u2 + *InputData) * c1; - *OutputData = *u2 * c0 + (*InputData + *u1) * c1; - break; - case 2L: - c0 += 2.0 * c2; - c1 += c1; - *OutputData++ = *InputData * c0 + *u1 * c1; - *OutputData = *u1 * c0 + *InputData * c1; - break; - case 1L: - *OutputData = *InputData * (c0 + 2.0 * c1 + 2.0 * c2); - break; - default: - Status = ERROR; - WRITE_ERROR(FirConvolveSymmetric, - "Unexpected signal length") - break; - } - } - break; - default: - v2 = InputData; - v1 = v2--; - u1 = InputData + (ptrdiff_t)SignalLength; - u2 = u1--; - if ((2L * KernelHalfLength - 1L) <= SignalLength) { - for (i = 1L - KernelHalfLength; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - Sum = *InputData++ * *q; - for (j = 1L - KernelHalfLength - i; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - v = u2; - for (j = i; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - *OutputData++ = Sum; - } - for (i = 2L * KernelHalfLength - SignalLength - 2L; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - Sum = *InputData++ * *q; - for (j = 1L - KernelHalfLength; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - *OutputData++ = Sum; - } - for (i = 1L - KernelHalfLength; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - Sum = *InputData++ * *q; - for (j = i + 1L; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - u = v2; - for (j = -KernelHalfLength - i; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - *OutputData++ = Sum; - } - } - else if (KernelHalfLength <= SignalLength) { - for (i = KernelHalfLength - SignalLength - 1L; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - Sum = *InputData++ * *q; - for (j = KernelHalfLength - SignalLength - i - 1L; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - v = u2; - for (j = SignalLength - 2L * KernelHalfLength + i + 2L; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - *OutputData++ = Sum; - } - for (i = SignalLength - (SignalLength / 2L) - KernelHalfLength + 1L; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - Sum = *InputData++ * *q; - for (j = -(SignalLength / 2L) - i; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - v = u2; - for (j = 2L * (SignalLength / 2L) - SignalLength + 2L * i + 1L; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - u = v2; - for (j = SignalLength - (SignalLength / 2L) - KernelHalfLength - i; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - *OutputData++ = Sum; - } - if ((2L * (SignalLength / 2L) + 1L) == SignalLength) { - q = HalfKernel; - u = v = InputData; - Sum = *InputData++ * *q; - for (j = -(SignalLength / 2L); (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - v = u2; - u = v2; - for (j = SignalLength / 2L - KernelHalfLength + 1L; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - *OutputData++ = Sum; - i = 1L; - } - for (i += SignalLength / 2L - KernelHalfLength + 1L; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - Sum = *InputData++ * *q; - for (j = KernelHalfLength - SignalLength + i; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - u = v2; - for (j = SignalLength - 2L * KernelHalfLength - 2L * i + 1L; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - v = u2; - for (j = i; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - *OutputData++ = Sum; - } - for (i = KernelHalfLength - SignalLength - 1L; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - Sum = *InputData++ * *q; - for (j = i + 1L; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - u = v2; - for (j = -KernelHalfLength - i; (j < 0L); j++) { - Sum += (*++u + *--v) * *++q; - } - *OutputData++ = Sum; - } - } - else { - for (i = -SignalLength; (i < 0L); i++) { - q = HalfKernel; - u = v = InputData; - Sum = *InputData++ * *q; - for (j = 1L - KernelHalfLength; (j < 0L); j++) { - if (u == u1) { - u = v2; - } - if (v == v1) { - v = u2; - } - Sum += (*++u + *--v) * *++q; - } - *OutputData++ = Sum; - } - } - break; - } - break; - default: - Status = ERROR; - WRITE_ERROR(FirConvolveSymmetric, "Invalid boundary convention") - break; - } -/**/DEBUG_WRITE_LEAVING(FirConvolveSymmetric, "Done") - return(Status); -} /* end FirConvolveSymmetric */ - -/*--------------------------------------------------------------------------*/ -extern int FirConvolveSymmetricVolume - ( - double *VolumeSource, /* data to process */ - double *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - double HalfKernel[], /* causal part of the kernel */ - long KernelHalfLength, /* length of the causal part of the kernel */ - enum TBoundaryConvention - Convention /* boundary convention */ - ) - -/* the specified boundary convention applies to the input data only, not to the kernel */ -/* the boundary convention applied to the kernel is FiniteDataSupport */ -/* VolumeSource is a (double)volume of size (Nx x Ny x Nz) */ -/* OutputData is a (double)volume of size (Nx x Ny x Nz) */ -/* the origin for the kernel is its leftmost sample; it corresponds to its symmetry axis */ -/* the full length of the symmetric kernel is (2L * KernelHalfLength - 1L) */ -/* the 1D kernel is applied successively to each principal direction in a separable fashion */ -/* success: return(!ERROR); failure: return(ERROR) */ -/* general structure is as follows: - for (i = 0L; (i < SignalLength); i++) { - Sum = InputData[i] * HalfKernel[0]; - for (j = 1L; (j < KernelHalfLength); j++) { - Sum += (InputData[i + j] + InputData[i - j]) * HalfKernel[j]; - } - OutputData[i] = Sum; - } -*/ - -{ /* begin FirConvolveSymmetricVolume */ - - double *InBuffer = (double *)NULL, *OutBuffer = (double *)NULL; - long i, j, k; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(FirConvolveSymmetricVolume, VolumeSource, Status, -/**/ "No VolumeSource") -/**/DEBUG_CHECK_NULL_POINTER(FirConvolveSymmetricVolume, VolumeDestination, Status, -/**/ "No OutputData") -/**/DEBUG_CHECK_RANGE_LONG(FirConvolveSymmetricVolume, Nx, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(FirConvolveSymmetricVolume, Ny, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(FirConvolveSymmetricVolume, Nz, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_NULL_POINTER(FirConvolveSymmetricVolume, HalfKernel, Status, -/**/ "No kernel") -/**/DEBUG_CHECK_RANGE_LONG(FirConvolveSymmetricVolume, KernelHalfLength, 1L, LONG_MAX, Status, -/**/ "Invalid kernel length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(FirConvolveSymmetricVolume, Status) -/**/DEBUG_WRITE_ENTERING(FirConvolveSymmetricVolume, -/**/ "About to perform IIR recursive convolution for a volume") - - switch (Convention) { - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - default: - Status = ERROR; - WRITE_ERROR(FirConvolveSymmetricVolume, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(FirConvolveSymmetricVolume, "Done") - return(Status); - } - if (1L < Nx) { - AllocateLineDouble(&InBuffer, Nx, &Status); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(FirConvolveSymmetricVolume, "Done") - return(Status); - } - AllocateLineDouble(&OutBuffer, Nx, &Status); - if (Status == ERROR) { - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(FirConvolveSymmetricVolume, "Done") - return(Status); - } - for (k = 0L; (k < Nz); k++) { - for (j = 0L; (j < Ny); j++) { - Status = GetxDoubleToDouble(VolumeSource, Nx, Ny, Nz, 0L, j, k, InBuffer, Nx); - if (Status == ERROR) { - FreeLineDouble(&OutBuffer); - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(FirConvolveSymmetricVolume, "Done") - return(Status); - } - Status = FirConvolveSymmetric(InBuffer, OutBuffer, Nx, - HalfKernel, KernelHalfLength, Convention); - if (Status == ERROR) { - FreeLineDouble(&OutBuffer); - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(FirConvolveSymmetricVolume, "Done") - return(Status); - } - Status = PutxDoubleToDouble(VolumeDestination, Nx, Ny, Nz, 0L, j, k, OutBuffer, Nx); - if (Status == ERROR) { - FreeLineDouble(&OutBuffer); - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(FirConvolveSymmetricVolume, "Done") - return(Status); - } - } - } - Status = FreeLineDouble(&OutBuffer); - if (Status == ERROR) { - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(FirConvolveSymmetricVolume, "Done") - return(Status); - } - Status = FreeLineDouble(&InBuffer); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(FirConvolveSymmetricVolume, "Done") - return(Status); - } - } - else { - VolumeDestination = (double *)memcpy(VolumeDestination, VolumeSource, - (size_t)(Nx * Ny * Nz * (long)sizeof(double))); - } - if (1L < Ny) { - AllocateLineDouble(&InBuffer, Ny, &Status); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(FirConvolveSymmetricVolume, "Done") - return(Status); - } - AllocateLineDouble(&OutBuffer, Ny, &Status); - if (Status == ERROR) { - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(FirConvolveSymmetricVolume, "Done") - return(Status); - } - for (k = 0L; (k < Nz); k++) { - for (i = 0L; (i < Nx); i++) { - Status = GetyDoubleToDouble(VolumeDestination, Nx, Ny, Nz, i, 0L, k, InBuffer, Ny); - if (Status == ERROR) { - FreeLineDouble(&OutBuffer); - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(FirConvolveSymmetricVolume, "Done") - return(Status); - } - Status = FirConvolveSymmetric(InBuffer, OutBuffer, Ny, - HalfKernel, KernelHalfLength, Convention); - if (Status == ERROR) { - FreeLineDouble(&OutBuffer); - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(FirConvolveSymmetricVolume, "Done") - return(Status); - } - Status = PutyDoubleToDouble(VolumeDestination, Nx, Ny, Nz, i, 0L, k, OutBuffer, Ny); - if (Status == ERROR) { - FreeLineDouble(&OutBuffer); - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(FirConvolveSymmetricVolume, "Done") - return(Status); - } - } - } - Status = FreeLineDouble(&OutBuffer); - if (Status == ERROR) { - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(FirConvolveSymmetricVolume, "Done") - return(Status); - } - Status = FreeLineDouble(&InBuffer); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(FirConvolveSymmetricVolume, "Done") - return(Status); - } - } - if (1L < Nz) { - AllocateLineDouble(&InBuffer, Nz, &Status); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(FirConvolveSymmetricVolume, "Done") - return(Status); - } - AllocateLineDouble(&OutBuffer, Nz, &Status); - if (Status == ERROR) { - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(FirConvolveSymmetricVolume, "Done") - return(Status); - } - for (j = 0L; (j < Ny); j++) { - for (i = 0L; (i < Nx); i++) { - Status = GetzDoubleToDouble(VolumeDestination, Nx, Ny, Nz, i, j, 0L, InBuffer, Nz); - if (Status == ERROR) { - FreeLineDouble(&OutBuffer); - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(FirConvolveSymmetricVolume, "Done") - return(Status); - } - Status = FirConvolveSymmetric(InBuffer, OutBuffer, Nz, - HalfKernel, KernelHalfLength, Convention); - if (Status == ERROR) { - FreeLineDouble(&OutBuffer); - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(FirConvolveSymmetricVolume, "Done") - return(Status); - } - Status = PutzDoubleToDouble(VolumeDestination, Nx, Ny, Nz, i, j, 0L, OutBuffer, Nz); - if (Status == ERROR) { - FreeLineDouble(&OutBuffer); - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(FirConvolveSymmetricVolume, "Done") - return(Status); - } - } - } - Status = FreeLineDouble(&OutBuffer); - if (Status == ERROR) { - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(FirConvolveSymmetricVolume, "Done") - return(Status); - } - Status = FreeLineDouble(&InBuffer); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(FirConvolveSymmetricVolume, "Done") - return(Status); - } - } -/**/DEBUG_WRITE_LEAVING(FirConvolveSymmetricVolume, "Done") - return(Status); -} /* end FirConvolveSymmetricVolume */ - diff --git a/src/core/bilib/firconvolve.h b/src/core/bilib/firconvolve.h deleted file mode 100644 index ac6cc5e..0000000 --- a/src/core/bilib/firconvolve.h +++ /dev/null @@ -1,173 +0,0 @@ -/**@defgroup FIRConvolve FIR Convolve - @ingroup BilibLibrary */ -//@{ -/*--------------------------------------------------------------------------*/ -/** FIR Convolve 1D. - * The specified boundary convention applies to the input data only, - * not to the kernel. The boundary convention applied to the kernel - * is FiniteDataSupport. The input and the output have the same length. - * The origin for the kernel is given with respect to the leftmost sample [0]. - * - * success: return(!ERROR); failure: return(ERROR) - * - * General structure is as follows: - * @code - * for (i = 0L; (i < SignalLength); i++) { - * Sum = 0.0; - * for (j = -Infinity; (j <= Infinity); j++) - * Sum += InputData[j] * Kernel[KernelOrigin + i - j]; - * OutputData[i] = Sum; - * } - * @endcode -*/ -extern int FirConvolve - ( - double InputData[], /* data to process */ - double OutputData[], /* result */ - long SignalLength, /* length of the 1D data array */ - double Kernel[], /* kernel */ - long KernelOrigin, /* center of the kernel */ - long KernelLength, /* length of the 1D kernel */ - enum TBoundaryConvention - Convention /* boundary convention */ - ); - -/*--------------------------------------------------------------------------*/ -/** FIR Convolve Antisymmetric 1D. - * The specified boundary convention applies to the input data only, - * not to the kernel. The boundary convention applied to the kernel is - * FiniteDataSupport. The input and the output have the same length. - * The origin for the kernel is its leftmost sample; it corresponds to its - * anti-symmetry axis. The value of the kernel at the origin is expected to be - * HalfKernel[0] = 0.0. The full length of the symmetric kernel is - * (2L * KernelHalfLength - 1L) - * - * success: return(!ERROR); failure: return(ERROR) - * - * General structure is as follows: - * @code - * for (i = 0L; (i < SignalLength); i++) { - * Sum = 0.0; - * for (j = 1L; (j < KernelHalfLength); j++) - * Sum += (InputData[i + j] - InputData[i - j]) * HalfKernel[j]; - * OutputData[i] = Sum; - * } - * @endcode -*/ -extern int FirConvolveAntiSymmetric - ( - double InputData[], /* data to process */ - double OutputData[], /* result */ - long SignalLength, /* length of the 1D data array */ - double HalfKernel[], /* causal part of the kernel */ - long KernelHalfLength, /* length of the causal part of the kernel */ - enum TBoundaryConvention - Convention /* boundary convention */ - ); - -/*--------------------------------------------------------------------------*/ -/** FIR Convolve Antisymmetric 3D. - * The specified boundary convention applies to the input data only, - * not to the kernel. The boundary convention applied to the kernel is - * FiniteDataSupport. VolumeSource is a (double)volume of size (Nx x Ny x Nz). - * OutputData is a (double)volume of size (Nx x Ny x Nz). The origin for the - * kernel is its leftmost sample; it corresponds to its anti-symmetry axis. - * The full length of the amti-symmetric kernel is (2L * KernelHalfLength - 1L). - * The 1D kernel is applied successively to each principal direction in a - * separable fashion. - * - * success: return(!ERROR); failure: return(ERROR) - * - * General structure is as follows: - * @code - * for (i = 0L; (i < SignalLength); i++) { - * Sum = InputData[i] * HalfKernel[0]; - * for (j = 1L; (j < KernelHalfLength); j++) - * Sum += (InputData[i + j] - InputData[i - j]) * HalfKernel[j]; - * OutputData[i] = Sum; - * } - * @endcode -*/ -extern int FirConvolveAntiSymmetricVolume - ( - double *VolumeSource, /* data to process */ - double *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - double HalfKernel[], /* causal part of the kernel */ - long KernelHalfLength, /* length of the causal part of the kernel */ - enum TBoundaryConvention - Convention /* boundary convention */ - ); - -/*--------------------------------------------------------------------------*/ -/** FIR Convolve Symmetric 1D. - * The specified boundary convention applies to the input data only, not - * to the kernel. The boundary convention applied to the kernel is - * FiniteDataSupport. The input and the output have the same length. - * The origin for the kernel is its leftmost sample; it corresponds to its - * symmetry axis. The full length of the symmetric kernel is - * (2L * KernelHalfLength - 1L). - * - * success: return(!ERROR); failure: return(ERROR) - * - * General structure is as follows: - * @code - * for (i = 0L; (i < SignalLength); i++) { - * Sum = InputData[i] * HalfKernel[0]; - * for (j = 1L; (j < KernelHalfLength); j++) - * Sum += (InputData[i + j] + InputData[i - j]) * HalfKernel[j]; - * OutputData[i] = Sum; - * } - * @endcode -*/ - -extern int FirConvolveSymmetric - ( - double InputData[], /* data to process */ - double OutputData[], /* result */ - long SignalLength, /* length of the 1D data array */ - double HalfKernel[], /* causal part of the kernel */ - long KernelHalfLength, /* length of the causal part of the kernel */ - enum TBoundaryConvention - Convention /* boundary convention */ - ); - -/*--------------------------------------------------------------------------*/ -/** FIR Convolve Symmetric 3D. - * The specified boundary convention applies to the input data only, - * not to the kernel. The boundary convention applied to the kernel is - * FiniteDataSupport. VolumeSource is a (double)volume of size (Nx x Ny x Nz). - * OutputData is a (double)volume of size (Nx x Ny x Nz). The origin for the - * kernel is its leftmost sample; it corresponds to its symmetry axis. - * The full length of the symmetric kernel is (2L * KernelHalfLength - 1L). - * The 1D kernel is applied successively to each principal direction in a - * separable fashion. - * - * success: return(!ERROR); failure: return(ERROR) - * - * General structure is as follows: - * @code - * for (i = 0L; (i < SignalLength); i++) { - * Sum = InputData[i] * HalfKernel[0]; - * for (j = 1L; (j < KernelHalfLength); j++) - * Sum += (InputData[i + j] + InputData[i - j]) * HalfKernel[j]; - * OutputData[i] = Sum; - * } - * @endcode -*/ -extern int FirConvolveSymmetricVolume - ( - double *VolumeSource, /* data to process */ - double *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - double HalfKernel[], /* causal part of the kernel */ - long KernelHalfLength, /* length of the causal part of the kernel */ - enum TBoundaryConvention - Convention /* boundary convention */ - ); -//@} - diff --git a/src/core/bilib/flip.cc b/src/core/bilib/flip.cc deleted file mode 100644 index 8f4561c..0000000 --- a/src/core/bilib/flip.cc +++ /dev/null @@ -1,169 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -#include -#include -#include -#include -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" -#include "error.h" -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "messagedisplay.h" -#include "flip.h" -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -#ifdef DEBUG -#include -#endif -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ -/* None */ -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/* None */ -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern int FlipXvolumeFloat - ( - float *VolumeSource, /* float input data */ - float *VolumeDestination, /* float output data */ - long Nx, /* width */ - long Ny, /* height */ - long Nz /* depth */ - ) -/* flip the x-axis of a volume */ -/* input VolumeSource is a (float)volume of size (Nx x Ny x Nz) */ -/* output VolumeDestination is a (float)volume of size (Nx x Ny x Nz) */ -/* success: return(!ERROR); failure: return(ERROR); */ -{ /* begin FlipXvolumeFloat */ - float *p, *q; - long i, j, k; - int Status = !ERROR; -/**/DEBUG_CHECK_NULL_POINTER(FlipXvolumeFloat, VolumeSource, Status, -/**/ "No VolumeSource") -/**/DEBUG_CHECK_NULL_POINTER(FlipXvolumeFloat, VolumeDestination, Status, -/**/ "No VolumeDestination") -/**/DEBUG_CHECK_RANGE_LONG(FlipXvolumeFloat, Nx, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(FlipXvolumeFloat, Ny, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(FlipXvolumeFloat, Nz, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(FlipXvolumeFloat, Status) -/**/DEBUG_WRITE_ENTERING(FlipXvolumeFloat, -/**/ "About to flip the x-axis of a float volume") - p = VolumeSource; - q = VolumeDestination + (ptrdiff_t)Nx; - for (k = 0L; (k < Nz); k++) { - for (j = 0L; (j < Ny); j++) { - for (i = 0L; (i < Nx); i++) { - *--q = *p++; - } - q += (ptrdiff_t)(2L * Nx); - } - } -/**/DEBUG_WRITE_LEAVING(FlipXvolumeFloat, "Done") - return(Status); -} /* end FlipXvolumeFloat */ -/*--------------------------------------------------------------------------*/ -extern int FlipYvolumeFloat - ( - float *VolumeSource, /* float input data */ - float *VolumeDestination, /* float output data */ - long Nx, /* width */ - long Ny, /* height */ - long Nz /* depth */ - ) -/* flip the y-axis of a volume */ -/* input VolumeSource is a (float)volume of size (Nx x Ny x Nz) */ -/* output VolumeDestination is a (float)volume of size (Nx x Ny x Nz) */ -{ /* begin FlipYvolumeFloat */ - float *p, *q; - long i, j, k; - int Status = !ERROR; -/**/DEBUG_CHECK_NULL_POINTER(FlipYvolumeFloat, VolumeSource, Status, -/**/ "No VolumeSource") -/**/DEBUG_CHECK_NULL_POINTER(FlipYvolumeFloat, VolumeDestination, Status, -/**/ "No VolumeDestination") -/**/DEBUG_CHECK_RANGE_LONG(FlipYvolumeFloat, Nx, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(FlipYvolumeFloat, Ny, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(FlipYvolumeFloat, Nz, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(FlipYvolumeFloat, Status) -/**/DEBUG_WRITE_ENTERING(FlipYvolumeFloat, -/**/ "About to flip the y-axis of a float volume") - VolumeDestination += (ptrdiff_t)(Nx * (Ny - 1L)); - for (k = 0L; (k < Nz); k++) { - for (i = 0L; (i < Nx); i++) { - p = VolumeSource++; - q = VolumeDestination++; - for (j = 0L; (j < Ny); i++) { - *q = *p; - p += (ptrdiff_t)Nx; - q -= (ptrdiff_t)Nx; - } - } - VolumeSource += (ptrdiff_t)(Nx * (Ny - 1L)); - VolumeDestination += (ptrdiff_t)(Nx * (Ny - 1L)); - } -/**/DEBUG_WRITE_LEAVING(FlipYvolumeFloat, "Done") - return(Status); -} /* end FlipYvolumeFloat */ -/*--------------------------------------------------------------------------*/ -extern int FlipZvolumeFloat - ( - float *VolumeSource, /* float input data */ - float *VolumeDestination, /* float output data */ - long Nx, /* width */ - long Ny, /* height */ - long Nz /* depth */ - ) -/* flip the z-axis of a volume */ -/* input VolumeSource is a (float)volume of size (Nx x Ny x Nz) */ -/* output VolumeDestination is a (float)volume of size (Nx x Ny x Nz) */ -{ /* begin FlipZvolumeFloat */ - float *p, *q; - long i, j, k; - long Nxy = Nx * Ny; - int Status = !ERROR; -/**/DEBUG_CHECK_NULL_POINTER(FlipZvolumeFloat, VolumeSource, Status, -/**/ "No VolumeSource") -/**/DEBUG_CHECK_NULL_POINTER(FlipZvolumeFloat, VolumeDestination, Status, -/**/ "No VolumeDestination") -/**/DEBUG_CHECK_RANGE_LONG(FlipZvolumeFloat, Nx, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(FlipZvolumeFloat, Ny, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(FlipZvolumeFloat, Nz, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(FlipZvolumeFloat, Status) -/**/DEBUG_WRITE_ENTERING(FlipZvolumeFloat, -/**/ "About to flip the z-axis of a float volume") - VolumeDestination += (ptrdiff_t)(Nxy * (Nz - 1L)); - for (j = 0L; (j < Ny); i++) { - for (i = 0L; (i < Nx); i++) { - p = VolumeSource++; - q = VolumeDestination++; - for (k = 0L; (k < Nz); k++) { - *q = *p; - p += (ptrdiff_t)Nxy; - q -= (ptrdiff_t)Nxy; - } - } - } -/**/DEBUG_WRITE_LEAVING(FlipZvolumeFloat, "Done") - return(Status); -} /* end FlipZvolumeFloat */ diff --git a/src/core/bilib/flip.h b/src/core/bilib/flip.h deleted file mode 100644 index 1de6ad4..0000000 --- a/src/core/bilib/flip.h +++ /dev/null @@ -1,30 +0,0 @@ -/*--------------------------------------------------------------------------*/ -extern int FlipXvolumeFloat - ( - float *VolumeSource, /* float input data */ - float *VolumeDestination, /* float output data */ - long Nx, /* width */ - long Ny, /* height */ - long Nz /* depth */ - ); - -/*--------------------------------------------------------------------------*/ -extern int FlipYvolumeFloat - ( - float *VolumeSource, /* float input data */ - float *VolumeDestination, /* float output data */ - long Nx, /* width */ - long Ny, /* height */ - long Nz /* depth */ - ); - -/*--------------------------------------------------------------------------*/ -extern int FlipZvolumeFloat - ( - float *VolumeSource, /* float input data */ - float *VolumeDestination, /* float output data */ - long Nx, /* width */ - long Ny, /* height */ - long Nz /* depth */ - ); - diff --git a/src/core/bilib/fold.cc b/src/core/bilib/fold.cc deleted file mode 100644 index 9d549c8..0000000 --- a/src/core/bilib/fold.cc +++ /dev/null @@ -1,288 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -#include -#include - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" -#include "error.h" -#include "tboundaryconvention.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "convert.h" -#include "fold.h" -#include "messagedisplay.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -#ifdef DEBUG -#include -#include -#endif - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern int GetFoldedIndex - ( - long InputIndex, /* index to fold back */ - long *OutputIndex, /* folded index */ - long SignalLength, /* length of the signal */ - enum TBoundaryConvention - Convention /* boundary convention */ - ) - -/* for (Periodic, MirrorOnBounds, MirrorOffBounds) boundary conditions: - set the output index in the range [0L..SignalLength-1L] */ -/* see (GetFoldedValueDouble, GetFoldedValueShort) functions - for (FiniteDataSupport, AntiMirrorOnBounds) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin GetFoldedIndex */ - - long N; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(GetFoldedIndex, OutputIndex, Status, -/**/ "No output index") -/**/DEBUG_CHECK_RANGE_LONG(GetFoldedIndex, SignalLength, 1L, (LONG_MAX - 1L) / 2L, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(GetFoldedIndex, Status) -/**/DEBUG_WRITE_ENTERING(GetFoldedIndex, -/**/ "About to fold back an index into its legitimate range") - - switch (Convention) { - case MirrorOffBounds: - N = SignalLength << 1L; - if (InputIndex < 0L) { - InputIndex += N * ((N - InputIndex - 1L) / N); - } - else { - InputIndex -= N * (InputIndex / N); - } - *OutputIndex = (InputIndex < SignalLength) ? (InputIndex) - : (N - InputIndex - 1L); - break; - case MirrorOnBounds: - if (SignalLength == 1L) { - *OutputIndex = 0L; - } - else { - N = SignalLength-1; - N = N << 1L; - InputIndex = labs(InputIndex); - InputIndex -= N * (InputIndex / N); - *OutputIndex = (InputIndex < SignalLength) ? (InputIndex) - : (N - InputIndex); - } - break; - case Periodic: - *OutputIndex = InputIndex; - if (InputIndex < 0L) { - *OutputIndex += SignalLength * ((SignalLength - InputIndex - 1L) - / SignalLength); - } - else { - *OutputIndex -= SignalLength * (InputIndex / SignalLength); - } - break; - default: - Status = ERROR; - WRITE_ERROR(GetFoldedIndex, "Invalid boundary convention") - break; - } -/**/DEBUG_WRITE_LEAVING(GetFoldedIndex, "Done") - return(Status); -} /* end GetFoldedIndex */ - -/*--------------------------------------------------------------------------*/ -extern int GetFoldedValueDouble - ( - double Signal[], /* double input data */ - long InputIndex, /* index to fold back */ - double *OutputValue, /* double output value */ - long SignalLength, /* length of the input data */ - enum TBoundaryConvention - Convention /* boundary convention */ - ) - -/* for (FiniteDataSupport, AntiMirrorOnBounds) boundary conditions: - set a double output value */ -/* see (GetFoldedValueShort) function for short */ -/* see (GetFoldedIndex) function for (Periodic, MirrorOnBounds, MirrorOffBounds) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin GetFoldedValueDouble */ - - double F0, Fn; - long K, N; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(GetFoldedValueDouble, Signal, Status, -/**/ "No input data") -/**/DEBUG_CHECK_NULL_POINTER(GetFoldedValueDouble, OutputValue, Status, -/**/ "No output value") -/**/DEBUG_CHECK_RANGE_LONG(GetFoldedValueDouble, SignalLength, 1L, (LONG_MAX - 1L) / 2L, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(GetFoldedValueDouble, Status) -/**/DEBUG_WRITE_ENTERING(GetFoldedValueDouble, -/**/ "About to fold back an index into its legitimate range and to get the corresponding value") - - switch (Convention) { - case AntiMirrorOnBounds: - if (SignalLength == 1L) { - *OutputValue = Signal[0L]; - } - else { - F0 = Signal[0L]; - N = SignalLength; - Fn = Signal[--N]; - N = N << 1L; - K = InputIndex - ((InputIndex < 0L) ? (N * ((1L + InputIndex - N) / N)) - : ((InputIndex < N) ? (0L) : (N * (InputIndex / N)))); - *OutputValue = ((K < SignalLength) ? (Signal[K]) : (2.0 * Fn - Signal[N - K])) - + (Fn - F0) * (double)((InputIndex - K) / (SignalLength - 1L)); - } - break; - case FiniteDataSupport: - *OutputValue = (InputIndex < 0L) ? (0.0) - : ((InputIndex < SignalLength) ? (Signal[InputIndex]) : (0.0)); - break; - case MirrorOffBounds: - Status = GetFoldedIndex(InputIndex, &K, SignalLength, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(GetFoldedValueDouble, "Done") - return(Status); - } - *OutputValue = Signal[K]; - break; - case MirrorOnBounds: - Status = GetFoldedIndex(InputIndex, &K, SignalLength, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(GetFoldedValueDouble, "Done") - return(Status); - } - *OutputValue = Signal[K]; - break; - case Periodic: - Status = GetFoldedIndex(InputIndex, &K, SignalLength, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(GetFoldedValueDouble, "Done") - return(Status); - } - *OutputValue = Signal[K]; - break; - default: - Status = ERROR; - WRITE_ERROR(GetFoldedValueDouble, "Invalid boundary convention") - break; - } -/**/DEBUG_WRITE_LEAVING(GetFoldedValueDouble, "Done") - return(Status); -} /* end GetFoldedValueDouble */ - -/*--------------------------------------------------------------------------*/ -extern int GetFoldedValueShort - ( - short Signal[], /* short input data */ - long InputIndex, /* index to fold back */ - short *OutputValue, /* short output value */ - long SignalLength, /* length of the input data */ - enum TBoundaryConvention - Convention /* boundary convention */ - ) - -/* for (FiniteDataSupport, AntiMirrorOnBounds) boundary conditions: - set a float output value */ -/* see (GetFoldedValueShort) function for short */ -/* see (GetFoldedIndex) function for (Periodic, MirrorOnBounds, MirrorOffBounds) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin GetFoldedValueShort */ - - double F0, Fn; - long K, N; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(GetFoldedValueShort, Signal, Status, -/**/ "No input data") -/**/DEBUG_CHECK_NULL_POINTER(GetFoldedValueShort, OutputValue, Status, -/**/ "No output value") -/**/DEBUG_CHECK_RANGE_LONG(GetFoldedValueShort, SignalLength, 1L, (LONG_MAX - 1L) / 2L, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(GetFoldedValueShort, Status) -/**/DEBUG_WRITE_ENTERING(GetFoldedValueShort, -/**/ "About to fold back an index into its legitimate range and to get the corresponding value") - - switch (Convention) { - case AntiMirrorOnBounds: - if (SignalLength == 1L) { - *OutputValue = Signal[0L]; - } - else { - F0 = (double)Signal[0L]; - N = SignalLength; - Fn = (double)Signal[--N]; - N = N << 1L; - K = InputIndex - ((InputIndex < 0L) ? (N * ((1L + InputIndex - N) / N)) - : ((InputIndex < N) ? (0L) : (N * (InputIndex / N)))); - *OutputValue = ConvertDoubleToShort(((K < SignalLength) ? ((double)Signal[K]) - : (2.0 * Fn - (double)Signal[N - K])) + (Fn - F0) - * (double)((InputIndex - K) / (SignalLength - 1L))); - } - break; - case FiniteDataSupport: - *OutputValue = (InputIndex < 0L) ? ((short)0) - : ((SignalLength <= InputIndex) ? ((short)0) : (Signal[InputIndex])); - break; - case MirrorOffBounds: - Status = GetFoldedIndex(InputIndex, &K, SignalLength, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(GetFoldedValueShort, "Done") - return(Status); - } - *OutputValue = Signal[K]; - break; - case MirrorOnBounds: - Status = GetFoldedIndex(InputIndex, &K, SignalLength, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(GetFoldedValueShort, "Done") - return(Status); - } - *OutputValue = Signal[K]; - break; - case Periodic: - Status = GetFoldedIndex(InputIndex, &K, SignalLength, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(GetFoldedValueShort, "Done") - return(Status); - } - *OutputValue = Signal[K]; - break; - default: - Status = ERROR; - WRITE_ERROR(GetFoldedValueShort, "Invalid boundary convention") - break; - } -/**/DEBUG_WRITE_LEAVING(GetFoldedValueShort, "Done") - return(Status); -} /* end GetFoldedValueShort */ - diff --git a/src/core/bilib/fold.h b/src/core/bilib/fold.h deleted file mode 100644 index 337b323..0000000 --- a/src/core/bilib/fold.h +++ /dev/null @@ -1,32 +0,0 @@ -/*--------------------------------------------------------------------------*/ -extern int GetFoldedIndex - ( - long InputIndex, /* index to fold back */ - long *OutputIndex, /* folded index */ - long SignalLength, /* length of the signal */ - enum TBoundaryConvention - Convention /* boundary convention */ - ); - -/*--------------------------------------------------------------------------*/ -extern int GetFoldedValueDouble - ( - double Signal[], /* double input data */ - long InputIndex, /* index to fold back */ - double *OutputValue, /* double output value */ - long SignalLength, /* length of the input data */ - enum TBoundaryConvention - Convention /* boundary convention */ - ); - -/*--------------------------------------------------------------------------*/ -extern int GetFoldedValueShort - ( - short Signal[], /* short input data */ - long InputIndex, /* index to fold back */ - short *OutputValue, /* short output value */ - long SignalLength, /* length of the input data */ - enum TBoundaryConvention - Convention /* boundary convention */ - ); - diff --git a/src/core/bilib/fourierconvolve.cc b/src/core/bilib/fourierconvolve.cc deleted file mode 100644 index e386e5a..0000000 --- a/src/core/bilib/fourierconvolve.cc +++ /dev/null @@ -1,395 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -#include -#include -#include -#include -#include - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" -#include "error.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "dft.h" -#include "dht.h" -#include "fourierconvolve.h" -#include "getput.h" -#include "messagedisplay.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -#ifdef DEBUG -#include -#endif - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern int ManyConvolveFourier - ( - double Data[], /* data for in-place processing */ - double KernelDht[], /* discrete Hartley transform of the kernel */ - double CaS[], /* Hartley transform coefficients */ - double *ScratchBuffer, /* scratch buffer */ - long SignalLength, /* signal length */ - double Shift /* additional translation */ - ) - -/* Fourier convolution with any kernel */ -/* same conventions as for OneConvolveFourier */ -/* preprocessing steps have to be carrried out elsewhere */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin ManyConvolveFourier */ - - double *p, *q, *u, *v, *t; - double c, s, ct, st; - double butterfly; - long i; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(ManyConvolveFourier, Data, Status, -/**/ "No in-place data") -/**/DEBUG_CHECK_NULL_POINTER(ManyConvolveFourier, KernelDht, Status, -/**/ "No kernel") -/**/DEBUG_CHECK_NULL_POINTER(ManyConvolveFourier, CaS, Status, -/**/ "No Hartley-coefficients") -/**/DEBUG_CHECK_NULL_POINTER(ManyConvolveFourier, ScratchBuffer, Status, -/**/ "No buffer") -/**/DEBUG_CHECK_RANGE_LONG(ManyConvolveFourier, SignalLength, 1L, LONG_MAX, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(ManyConvolveFourier, Status) -/**/DEBUG_WRITE_ENTERING(ManyConvolveFourier, -/**/ "About to perform a preprocessed Fourier convolution") - - Status = DiscreteHartleyTransform(Data, ScratchBuffer, CaS, SignalLength, TRUE); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ManyConvolveFourier, "Done") - return(Status); - } - p = Data; - q = Data + (ptrdiff_t)SignalLength; - u = KernelDht; - v = KernelDht + (ptrdiff_t)SignalLength; - t = ScratchBuffer; - *t++ = *p++ * *u++; - for (q--, v--, i = 1L; (i < SignalLength); u++, v--, i++) { - *t++ = (*p++ * (*u + *v) + *q-- * (*u - *v)) / 2.0; - } - if (Shift == 0.0) { - Data = (double *)memcpy(Data, ScratchBuffer, - (size_t)(SignalLength * (long)sizeof(double))); - } - else { - p = Data; - q = Data + (ptrdiff_t)SignalLength; - u = ScratchBuffer; - v = ScratchBuffer + (ptrdiff_t)SignalLength; - c = ct = cos(2.0 * PI * Shift / (double)SignalLength); - s = st = -sin(2.0 * PI * Shift / (double)SignalLength); - *p++ = *u++; - q--; - v--; - while (p < q) { - *p++ = *u * c - *v * s; - *q-- = *v-- * c + *u++ * s; - butterfly = c * ct - s * st; - s = s * ct + c * st; - c = butterfly; - } - if (p == q) { - *p = *u * c; - } - } - Status = DiscreteHartleyTransform(Data, ScratchBuffer, CaS, SignalLength, FALSE); -/**/DEBUG_WRITE_LEAVING(ManyConvolveFourier, "Done") - return(Status); -} /* end ManyConvolveFourier */ - -/*--------------------------------------------------------------------------*/ -extern int ManyConvolveFourierSymmetricKernel - ( - double Data[], /* data for in-place processing */ - double SymmetricKernelDht[], - /* discrete Hartley transform of the kernel */ - double CaS[], /* Hartley transform coefficients */ - double *ScratchBuffer, /* scratch buffer */ - long SignalLength, /* signal length */ - double Shift /* additional translation */ - ) - -/* Fourier convolution with a symmetric kernel */ -/* same conventions as for OneConvolveFourierSymmetricKernel */ -/* preprocessing steps have to be carrried out elsewhere */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin ManyConvolveFourierSymmetricKernel */ - - double *p, *q, *u, *v, *t; - double c, s, ct, st; - double butterfly; - long i; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(ManyConvolveFourierSymmetricKernel, Data, Status, -/**/ "No in-place data") -/**/DEBUG_CHECK_NULL_POINTER(ManyConvolveFourierSymmetricKernel, SymmetricKernelDht, Status, -/**/ "No kernel") -/**/DEBUG_CHECK_NULL_POINTER(ManyConvolveFourierSymmetricKernel, CaS, Status, -/**/ "No Hartley-coefficients") -/**/DEBUG_CHECK_NULL_POINTER(ManyConvolveFourierSymmetricKernel, ScratchBuffer, Status, -/**/ "No buffer") -/**/DEBUG_CHECK_RANGE_LONG(ManyConvolveFourierSymmetricKernel, SignalLength, 1L, LONG_MAX, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(ManyConvolveFourierSymmetricKernel, Status) -/**/DEBUG_WRITE_ENTERING(ManyConvolveFourierSymmetricKernel, -/**/ "About to perform a preprocessed Fourier convolution with a symmetric kernel") - - Status = DiscreteHartleyTransform(Data, ScratchBuffer, CaS, SignalLength, TRUE); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ManyConvolveFourierSymmetricKernel, "Done") - return(Status); - } - p = SymmetricKernelDht; - q = Data; - t = ScratchBuffer; - for (i = 0L; (i < SignalLength); i++) { - *t++ = *q++ * *p++; - } - if (Shift == 0.0) { - Data = (double *)memcpy(Data, ScratchBuffer, - (size_t)(SignalLength * (long)sizeof(double))); - } - else { - p = Data; - q = Data + (ptrdiff_t)SignalLength; - u = ScratchBuffer; - v = ScratchBuffer + (ptrdiff_t)SignalLength; - c = ct = cos(2.0 * PI * Shift / (double)SignalLength); - s = st = -sin(2.0 * PI * Shift / (double)SignalLength); - *p++ = *u++; - q--; - v--; - while (p < q) { - *p++ = *u * c - *v * s; - *q-- = *v-- * c + *u++ * s; - butterfly = c * ct - s * st; - s = s * ct + c * st; - c = butterfly; - } - if (p == q) { - *p = *u * c; - } - } - Status = DiscreteHartleyTransform(Data, ScratchBuffer, CaS, SignalLength, FALSE); -/**/DEBUG_WRITE_LEAVING(ManyConvolveFourierSymmetricKernel, "Done") - return(Status); -} /* end ManyConvolveFourierSymmetricKernel */ - -/*--------------------------------------------------------------------------*/ -extern int OneConvolveFourier - ( - double Data[], /* data for in-place processing */ - double Kernel[], /* kernel for in-place processing */ - long SignalLength, /* signal length */ - double Shift, /* additional translation */ - int *Status /* error management */ - ) - -/* Fourier convolution with any kernel */ -/* the kernel has an infinite, periodic (SignalLength) support */ -/* the kernel origin (hot spot) is at index [0] */ -/* the highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] for SignalLength even */ -/* the highest coordinate (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd */ -/* the lowest coordinate -SignalLength/2 is at index [SignalLength/2] for SignalLength even */ -/* the lowest coordinate -(SignalLength-1)/2 is at index [(SignalLength+1)/2] for SignalLength odd */ -/* the coordinate -1 is at index [SignalLength-1] for SignalLength even or odd */ -/* the signal has an infinite, periodic (SignalLength) support */ -/* the output has same length SignalLength than the input */ -/* the output has already been allocated */ -/* the result of the convolution overwrites the input */ -/* the inverse DHT of the kernel overwrites the kernel */ -/* if the kernel is finite support, don't forget to pad! */ -/* success: return(!ERROR); failure: return(ERROR) */ -/* the returned value is duplicated in Status */ - -{ /* begin OneConvolveFourier */ - - double *CaS = (double *)NULL, *ScratchBuffer = (double *)NULL; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(OneConvolveFourier, Data, *Status, -/**/ "No in-place data") -/**/DEBUG_CHECK_NULL_POINTER(OneConvolveFourier, Kernel, *Status, -/**/ "No kernel") -/**/DEBUG_CHECK_RANGE_LONG(OneConvolveFourier, SignalLength, 1L, LONG_MAX, *Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(OneConvolveFourier, *Status) -/**/DEBUG_WRITE_ENTERING(OneConvolveFourier, -/**/ "About to perform Fourier convolution") - - AllocateLineDouble(&ScratchBuffer, SignalLength, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(OneConvolveFourier, "Done") - return(*Status); - } - AllocateLineDouble(&CaS, SignalLength, Status); - if (*Status == ERROR) { - FreeLineDouble(&ScratchBuffer); -/**/ DEBUG_WRITE_LEAVING(OneConvolveFourier, "Done") - return(*Status); - } - *Status = GetCaS(CaS, SignalLength); - if (*Status == ERROR) { - FreeLineDouble(&CaS); - FreeLineDouble(&ScratchBuffer); -/**/ DEBUG_WRITE_LEAVING(OneConvolveFourier, "Done") - return(*Status); - } - *Status = DiscreteHartleyTransform(Kernel, ScratchBuffer, CaS, SignalLength, FALSE); - if (*Status == ERROR) { - FreeLineDouble(&CaS); - FreeLineDouble(&ScratchBuffer); -/**/ DEBUG_WRITE_LEAVING(OneConvolveFourier, "Done") - return(*Status); - } - *Status = ManyConvolveFourier(Data, Kernel, CaS, ScratchBuffer, SignalLength, Shift); - if (*Status == ERROR) { - FreeLineDouble(&CaS); - FreeLineDouble(&ScratchBuffer); -/**/ DEBUG_WRITE_LEAVING(OneConvolveFourier, "Done") - return(*Status); - } - *Status = FreeLineDouble(&CaS); - if (*Status == ERROR) { - FreeLineDouble(&ScratchBuffer); -/**/ DEBUG_WRITE_LEAVING(OneConvolveFourier, "Done") - return(*Status); - } - *Status = FreeLineDouble(&ScratchBuffer); -/**/DEBUG_WRITE_LEAVING(OneConvolveFourier, "Done") - return(*Status); -} /* end oneConvolveFourier */ - -/*--------------------------------------------------------------------------*/ -extern int OneConvolveFourierSymmetricKernel - ( - double Data[], /* data for in-place processing */ - double SymmetricKernel[], /* symmetric kernel for in-place processing */ - long SignalLength, /* signal length */ - double Shift, /* additional translation */ - int *Status /* error management */ - ) - -/* Fourier convolution with a symmetric kernel */ -/* the kernel has an infinite, periodic (SignalLength) support */ -/* the kernel origin (hot spot) is at index [0] */ -/* the highest coordinate (SignalLength-2)/2 is at index [(SignalLength-2)/2] for SignalLength even */ -/* for symmetry, kernel[(SignalLength-2)/2] = 0 for SignalLength even */ -/* the highest coordinate (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd */ -/* no special symmetry requirement for SignalLength odd */ -/* the lowest coordinate -SignalLength/2 is at index [SignalLength/2] for SignalLength even */ -/* the lowest coordinate -(SignalLength-1)/2 is at index [(SignalLength+1)/2] for SignalLength odd */ -/* the coordinate -1 is at index [SignalLength-1] for SignalLength even or odd */ -/* the signal has an infinite, periodic (SignalLength) support */ -/* the output has the same length SignalLength than the input */ -/* the output has already been allocated */ -/* the kernel is even-symmetric around 0 (k[x] = k[-x]) */ -/* only the coord. >= 0 of the kernel need be given */ -/* the result of the convolution overwrites the input */ -/* the inverse DHT of the kernel overwrites the kernel */ -/* if the kernel is finite support, don't forget to pad! */ -/* observe the separate symmetries for SignalLength odd/even! */ -/* for a symmetric kernel, DHT <=> DFT */ -/* success: return(!ERROR); failure: return(ERROR) */ -/* the returned value is duplicated in Status */ - -{ /* begin OneConvolveFourierSymmetricKernel */ - - double *CaS = (double *)NULL, *ScratchBuffer = (double *)NULL; - double *p, *q; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(OneConvolveFourierSymmetricKernel, Data, *Status, -/**/ "No in-place data") -/**/DEBUG_CHECK_NULL_POINTER(OneConvolveFourierSymmetricKernel, SymmetricKernel, *Status, -/**/ "No kernel") -/**/DEBUG_CHECK_RANGE_LONG(OneConvolveFourierSymmetricKernel, SignalLength, 1L, LONG_MAX, *Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(OneConvolveFourierSymmetricKernel, *Status) -/**/DEBUG_WRITE_ENTERING(OneConvolveFourierSymmetricKernel, -/**/ "About to perform Fourier symmetric convolution") - - AllocateLineDouble(&ScratchBuffer, SignalLength, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(OneConvolveFourierSymmetricKernel, "Done") - return(*Status); - } - AllocateLineDouble(&CaS, SignalLength, Status); - if (*Status == ERROR) { - FreeLineDouble(&ScratchBuffer); -/**/ DEBUG_WRITE_LEAVING(OneConvolveFourierSymmetricKernel, "Done") - return(*Status); - } - *Status = GetCaS(CaS, SignalLength); - if (*Status == ERROR) { - FreeLineDouble(&CaS); - FreeLineDouble(&ScratchBuffer); -/**/ DEBUG_WRITE_LEAVING(OneConvolveFourierSymmetricKernel, "Done") - return(*Status); - } - p = SymmetricKernel; - q = SymmetricKernel + (ptrdiff_t)SignalLength; - while (++p < --q) { - *q = *p; - } - if (p == q) { - *q = 0.0; - } - *Status = DiscreteHartleyTransform(SymmetricKernel, ScratchBuffer, CaS, SignalLength, FALSE); - if (*Status == ERROR) { - FreeLineDouble(&CaS); - FreeLineDouble(&ScratchBuffer); -/**/ DEBUG_WRITE_LEAVING(OneConvolveFourierSymmetricKernel, "Done") - return(*Status); - } - *Status = ManyConvolveFourierSymmetricKernel(Data, SymmetricKernel, CaS, - ScratchBuffer, SignalLength, Shift); - if (*Status == ERROR) { - FreeLineDouble(&CaS); - FreeLineDouble(&ScratchBuffer); -/**/ DEBUG_WRITE_LEAVING(OneConvolveFourierSymmetricKernel, "Done") - return(*Status); - } - *Status = FreeLineDouble(&CaS); - if (*Status == ERROR) { - FreeLineDouble(&ScratchBuffer); -/**/ DEBUG_WRITE_LEAVING(OneConvolveFourierSymmetricKernel, "Done") - return(*Status); - } - *Status = FreeLineDouble(&ScratchBuffer); -/**/DEBUG_WRITE_LEAVING(OneConvolveFourierSymmetricKernel, "Done") - return(*Status); -} /* end OneConvolveFourierSymmetricKernel */ - diff --git a/src/core/bilib/fourierconvolve.h b/src/core/bilib/fourierconvolve.h deleted file mode 100644 index d6c41c9..0000000 --- a/src/core/bilib/fourierconvolve.h +++ /dev/null @@ -1,115 +0,0 @@ -/**@defgroup FourierConvolve Fourier Convolve - @ingroup BilibLibrary */ -//@{ -/*--------------------------------------------------------------------------*/ -/** Fourier convolution with any kernel. - Same conventions as for OneConvolveFourier. - Preprocessing steps have to be carrried out elsewhere. - - success: return(!ERROR); failure: return(ERROR) -*/ -extern int ManyConvolveFourier - ( - double Data[], /* data for in-place processing */ - double KernelDht[], /* discrete Hartley transform of the kernel */ - double CaS[], /* Hartley transform coefficients */ - double *ScratchBuffer, /* scratch buffer */ - long SignalLength, /* signal length */ - double Shift /* additional translation */ - ); - -/*--------------------------------------------------------------------------*/ -/** Fourier convolution with a symmetric kernel. - Same conventions as for OneConvolveFourierSymmetricKernel. - Preprocessing steps have to be carrried out elsewhere - - success: return(!ERROR); failure: return(ERROR) -*/ -extern int ManyConvolveFourierSymmetricKernel - ( - double Data[], /* data for in-place processing */ - double KernelDht[], /* discrete Hartley transform of the kernel */ - double CaS[], /* Hartley transform coefficients */ - double *ScratchBuffer, /* scratch buffer */ - long SignalLength, /* signal length */ - double Shift /* additional translation */ - ); - -/*--------------------------------------------------------------------------*/ -/** Fourier convolution 1D. - Fourier convolution with any kernel. The kernel has an infinite, - periodic (SignalLength) support. The kernel origin (hot spot) is at - index [0]. - - The highest coordinate (SignalLength-2)/2 is at index - [(SignalLength-2)/2] for SignalLength even. The highest coordinate - (SignalLength-1)/2 is at index [(SignalLength-1)/2] for SignalLength odd. - - The lowest coordinate -SignalLength/2 is at index [SignalLength/2] - for SignalLength even. The lowest coordinate -(SignalLength-1)/2 is at - index [(SignalLength+1)/2] for SignalLength odd. - - The coordinate -1 is at index [SignalLength-1] for SignalLength even or odd. - - The signal has an infinite, periodic (SignalLength) support. The output - has same length SignalLength than the input. The output has already - been allocated. The result of the convolution overwrites the input. - The inverse DHT of the kernel overwrites the kernel. If the kernel is - finite support, don't forget to pad! - - success: return(!ERROR); failure: return(ERROR) - - The returned value is duplicated in Status -*/ -extern int OneConvolveFourier - ( - double Data[], /* data for in-place processing */ - double Kernel[], /* kernel for in-place processing */ - long SignalLength, /* signal length */ - double Shift, /* additional translation */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Fourier convolution with a symmetrical kernel. - The kernel has an infinite, periodic (SignalLength) support. The kernel - origin (hot spot) is at index [0]. The highest coordinate - (SignalLength-2)/2 is at index [(SignalLength-2)/2] for SignalLength even. - For symmetry, kernel[(SignalLength-2)/2] = 0 for SignalLength even. - - The highest coordinate (SignalLength-1)/2 is at index [(SignalLength-1)/2] - for SignalLength odd. No special symmetry requirement for SignalLength odd. - - The lowest coordinate -SignalLength/2 is at index [SignalLength/2] for - SignalLength even. The lowest coordinate -(SignalLength-1)/2 is at - index [(SignalLength+1)/2] for SignalLength odd. - - The coordinate -1 is at index [SignalLength-1] for SignalLength even or odd. - - The signal has an infinite, periodic (SignalLength) support. The output has - the same length SignalLength than the input. The output has already been - allocated. - - The kernel is even-symmetric around 0 (k[x] = k[-x]). Only the coord. >= 0 - of the kernel need be given. - - The result of the convolution overwrites the input. The inverse DHT of - the kernel overwrites the kernel. If the kernel is finite support, don't - forget to pad! - - Observe the separate symmetries for SignalLength odd/even! - For a symmetric kernel, DHT <=> DFT - - success: return(!ERROR); failure: return(ERROR) - - The returned value is duplicated in Status -*/ -extern int OneConvolveFourierSymmetricKernel - ( - double Data[], /* data for in-place processing */ - double SymmetricKernel[], /* symmetric kernel for in-place processing */ - long SignalLength, /* signal length */ - double Shift, /* additional translation */ - int *Status /* error management */ - ); -//@} diff --git a/src/core/bilib/geometry.cc b/src/core/bilib/geometry.cc deleted file mode 100644 index 66300a9..0000000 --- a/src/core/bilib/geometry.cc +++ /dev/null @@ -1,1740 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -#include -#include - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" -#include "error.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "geometry.h" -#include "linearalgebra.h" -#include "messagedisplay.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -#ifdef DEBUG -#include -#include -#include -#include -#endif - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern int AffineToRotationMatrix - ( - double *A, /* input 4x4 homogenous affine matrix */ - double *R, /* output 4x4 homogenous rotation matrix */ - double *xRotation, /* output rotation around x-axis */ - double *yRotation, /* output rotation around y-axis */ - double *zRotation, /* output rotation around z-axis */ - int FirstOctant, /* constrains the rotation */ - double Tolerance, /* admissible relative error */ - long MaxIterations, /* convergence limit */ - int *Status /* error management */ - ) - -/* approximate a (4 x 4) homogenous affine matrix by a (4 x 4) rotation matrix */ -/* the rotation matrix has the form R = Rx.Ry.Rz */ -/* A and R are homogenous: (A, R) = {{*, *, *, 0}, {*, *, *, 0}, {*, *, *, 0}, {0, 0, 0, 1}} */ -/* the returned rotation angles are given in the unit of radian */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin AffineToRotationMatrix */ - - double *p, *q; - double U[3*3], W[3], V[3*3]; - double Angles[32][4]; - double InvDeterminant, SecTheta; - double Phi, Theta, Psi; - double Best; - long i, j ,k; - long iBest; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(AffineToRotationMatrix, A, *Status, -/**/ "Missing input") -/**/DEBUG_CHECK_NULL_POINTER(AffineToRotationMatrix, R, *Status, -/**/ "Missing output") -/**/DEBUG_CHECK_NULL_POINTER(AffineToRotationMatrix, xRotation, *Status, -/**/ "Missing xRotation") -/**/DEBUG_CHECK_NULL_POINTER(AffineToRotationMatrix, yRotation, *Status, -/**/ "Missing yRotation") -/**/DEBUG_CHECK_NULL_POINTER(AffineToRotationMatrix, zRotation, *Status, -/**/ "Missing zRotation") -/**/DEBUG_CHECK_RANGE_INT(AffineToRotationMatrix, FirstOctant, FALSE, TRUE, *Status, -/**/ "Invalid FirstOctant (should be in [FALSE, TRUE])") -/**/DEBUG_CHECK_RANGE_LONG(AffineToRotationMatrix, MaxIterations, 1L, LONG_MAX, *Status, -/**/ "Invalid iterations (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_DOUBLE(AffineToRotationMatrix, Tolerance, 0.0, DBL_MAX, *Status, -/**/ "Invalid Tolerance (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(AffineToRotationMatrix, *Status) -/**/DEBUG_WRITE_ENTERING(AffineToRotationMatrix, -/**/ "About to approximate an affine matrix by a rotation") - - if ((A[12] != 0.0) || (A[13] != 0.0) || (A[14] != 0.0) || (A[15] != 1.0)) { - *Status = ERROR; - WRITE_ERROR(AffineToRotationMatrix, "Non-homogenous matrix") -/**/ DEBUG_WRITE_LEAVING(AffineToRotationMatrix, "Done") - return(*Status); - } - p = A; - q = U; - for (i = -3L; (i < 0L); i++) { - for (j = -3L; (j < 0L); j++) { - *q++ = *p++; - } - p++; - } - SingularValueDecomposition(U, 3L, 3L, W, R, MaxIterations, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(AffineToRotationMatrix, "Done") - return(*Status); - } - *Status = MatrixTranspose(R, V, 3L, 3L); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(AffineToRotationMatrix, "Done") - return(*Status); - } - *Status = MatrixMultiply(U, V, R, 3L, 3L, 3L); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(AffineToRotationMatrix, "Done") - return(*Status); - } - SquareMatrixDeterminant(R, 3L, &InvDeterminant, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(AffineToRotationMatrix, "Done") - return(*Status); - } - if (fabs(InvDeterminant) <= Tolerance) { - *Status = ERROR; - WRITE_ERROR(AffineToRotationMatrix, "Degenerate Matrix") -/**/ DEBUG_WRITE_LEAVING(AffineToRotationMatrix, "Done") - return(*Status); - } - if (InvDeterminant < 0.0) { - WRITE_ERROR(AffineToRotationMatrix, "Left-handed matrix") - *Status = ERROR; -/**/ DEBUG_WRITE_LEAVING(AffineToRotationMatrix, "Done") - return(*Status); - } - InvDeterminant = 1.0 / InvDeterminant; - Theta = asin(InvDeterminant * R[2]); - for (k = 0L; (k < 4L); k++) { - Angles[k][1] = Theta; - Angles[k + 8L][1] = Theta; - Angles[k + 16L][1] = Theta; - Angles[k + 24L][1] = Theta; - } - Theta = PI - Theta; - for (k = 4L; (k < 8L); k++) { - Angles[k][1] = Theta; - Angles[k + 8L][1] = Theta; - Angles[k + 16L][1] = Theta; - Angles[k + 24L][1] = Theta; - } - SecTheta = cos(Theta); - if (fabs(SecTheta) <= Tolerance) { - WRITE_WARNING(AffineToRotationMatrix, "Gimbals lock") - if (0.0 < R[2]) { - *yRotation = 0.5 * PI; - *xRotation = 0.5 * atan2(R[7] + R[3], R[4] - R[6]); - *zRotation = *xRotation; - } - else { - *yRotation = -0.5 * PI; - *xRotation = 0.5 * atan2(R[7] - R[3], R[4] + R[6]); - *zRotation = -*xRotation; - } - } - else { - SecTheta = -1.0 / SecTheta; - Phi = asin(-InvDeterminant * R[5] * SecTheta); - for (k = 0L; (k < 8L); k++) { - Angles[k][0] = Phi; - } - Phi = PI - Phi; - for (k = 8L; (k < 16L); k++) { - Angles[k][0] = Phi; - } - Phi = asin(InvDeterminant * R[5] * SecTheta); - for (k = 16L; (k < 24L); k++) { - Angles[k][0] = Phi; - } - Phi = PI - Phi; - for (k = 24L; (k < 32L); k++) { - Angles[k][0] = Phi; - } - Psi = asin(-InvDeterminant * R[1] * SecTheta); - for (k = 0L; (k < 32L); k += 4L) { - Angles[k][2] = Psi; - } - Psi = PI - Psi; - for (k = 1L; (k < 32L); k += 4L) { - Angles[k][2] = Psi; - } - Psi = asin(InvDeterminant * R[1] * SecTheta); - for (k = 2L; (k < 32L); k += 4L) { - Angles[k][2] = Psi; - } - Psi = PI - Psi; - for (k = 3L; (k < 32L); k += 4L) { - Angles[k][2] = Psi; - } - for (k = 0L; (k < 32L); k++) { - *Status = GetRotationMatrix(R, Angles[k][0], Angles[k][1], Angles[k][2]); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(AffineToRotationMatrix, "Done") - return(*Status); - } - Angles[k][3] = 0.0; - p = A; - q = R; - for (i = -3L; (i < 0L); i++) { - for (j = -3L; (j < 0L); j++) { - Angles[k][3] += (*p - *q) * (*p - *q); - p++; - q++; - } - p++; - q++; - } - } - Best = Angles[0][3]; - iBest = 0L; - if (!FirstOctant) - for (k = 1L; (k < 32L); k++) - if (Angles[k][3] < Best) { - Best = Angles[k][3]; - iBest = k; - } - *xRotation = Angles[iBest][0]; - *yRotation = Angles[iBest][1]; - *zRotation = Angles[iBest][2]; - *Status = GetRotationMatrix(R, Angles[iBest][0], Angles[iBest][1], Angles[iBest][2]); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(AffineToRotationMatrix, "Done") - return(*Status); - } - R[3] = A[3]; - R[7] = A[7]; - R[11] = A[11]; - } - *xRotation = (*xRotation < 0.0) ? (PI + fmod(*xRotation, PI)) : (fmod(*xRotation, PI)); - *xRotation = (*xRotation <= (0.5 * PI)) ? (*xRotation) : (*xRotation - PI); - *yRotation = (*yRotation < 0.0) ? (PI + fmod(*yRotation, PI)) : (fmod(*yRotation, PI)); - *yRotation = (*yRotation <= (0.5 * PI)) ? (*yRotation) : (*yRotation - PI); - *zRotation = (*zRotation < 0.0) ? (PI + fmod(*zRotation, PI)) : (fmod(*zRotation, PI)); - *zRotation = (*zRotation <= (0.5 * PI)) ? (*zRotation) : (*zRotation - PI); -/**/DEBUG_WRITE_LEAVING(AffineToRotationMatrix, "Done") - return(*Status); -} /* end AffineToRotationMatrix */ - -/*--------------------------------------------------------------------------*/ -extern int GetRotationMatrix - ( - double *R, /* output 4x4 homogenous matrix */ - double xRotation, /* rotation around x-axis */ - double yRotation, /* rotation around y-axis */ - double zRotation /* rotation around z-axis */ - ) - -/* fill a rotation matrix R such that R = Rx.Ry.Rz */ -/* the size of the output matrix R is (4 x 4) */ -/* R is homogenous: R = {{*, *, *, 0}, {*, *, *, 0}, {*, *, *, 0}, {0, 0, 0, 1}} */ -/* the rotation angles are given in the unit of radian */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin GetRotationMatrix */ - - double Rx[4][4], Ry[4][4], Rz[4][4]; - double Rxy[4][4]; - double Sum; - long i, j, k; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(GetRotationMatrix, R, Status, -/**/ "Missing output") -/**/DEBUG_RETURN_ON_ERROR(GetRotationMatrix, Status) -/**/DEBUG_WRITE_ENTERING(GetRotationMatrix, -/**/ "About to build a rotation matrix") - - for (i = 0L; (i < 4L); i++) { - for (j = 0L; (j < 4L); j++) { - Rx[i][j] = 0.0; - Ry[i][j] = 0.0; - Rz[i][j] = 0.0; - Rxy[i][j] = 0.0; - } - Rx[i][i] = 1.0; - Ry[i][i] = 1.0; - Rz[i][i] = 1.0; - Rxy[i][i] = 1.0; - } - Rx[1][1] = cos(xRotation); - Rx[1][2] = -sin(xRotation); - Rx[2][1] = sin(xRotation); - Rx[2][2] = cos(xRotation); - Ry[0][0] = cos(yRotation); - Ry[0][2] = sin(yRotation); - Ry[2][0] = -sin(yRotation); - Ry[2][2] = cos(yRotation); - Rz[0][0] = cos(zRotation); - Rz[0][1] = -sin(zRotation); - Rz[1][0] = sin(zRotation); - Rz[1][1] = cos(zRotation); - for (i = 0L; (i < 3L); i++) { - for (j = 0L; (j < 3L); j++) { - Sum = 0.0; - for (k = 0L; (k < 3L); k++) { - Sum += Rx[i][k] * Ry[k][j]; - } - Rxy[i][j] = Sum; - } - } - for (i = 0; (i < 4L); i++) { - for (j = 0; (j < 4L); j++) { - Sum = 0.0; - for (k = 0; (k < 4L); k++) { - Sum += Rxy[i][k] * Rz[k][j]; - } - *R++ = Sum; - } - } -/**/DEBUG_WRITE_LEAVING(GetRotationMatrix, "Done") - return(Status); -} /* end GetRotationMatrix */ - -/*--------------------------------------------------------------------------*/ -extern int GetScalingMatrix - ( - double *S, /* output 4x4 homogenous matrix */ - double xScale, /* scaling along x-axis */ - double yScale, /* scaling along y-axis */ - double zScale /* scaling along z-axis */ - ) - -/* fill a scaling matrix T */ -/* the size of the output matrix T is (4 x 4) */ -/* T is homogenous: T = {{sx, 0, 0, 0}, {0, sy, 0, 0}, {0, 0, sz, 0}, {0, 0, 0, 1}} */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin GetScalingMatrix */ - - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(GetScalingMatrix, S, Status, -/**/ "Missing output") -/**/DEBUG_RETURN_ON_ERROR(GetScalingMatrix, Status) -/**/DEBUG_WRITE_ENTERING(GetScalingMatrix, -/**/ "About to build a scaling matrix") - - Status = GetIdentitySquareMatrix(S, 4L); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(GetScalingMatrix, "Done") - return(Status); - } - S[0] = xScale; - S[5] = yScale; - S[10] = zScale; -/**/DEBUG_WRITE_LEAVING(GetScalingMatrix, "Done") - return(Status); -} /* end GetScalingMatrix */ - -/*--------------------------------------------------------------------------*/ -extern int GetTranslationMatrix - ( - double *T, /* output 4x4 homogenous matrix */ - double xTranslation, /* translation along x-axis */ - double yTranslation, /* translation along y-axis */ - double zTranslation /* translation along z-axis */ - ) - -/* fill a translation matrix T */ -/* the size of the output matrix T is (4 x 4) */ -/* T is homogenous: T = {{1, 0, 0, dx}, {0, 1, 0, dy}, {0, 0, 1, dz}, {0, 0, 0, 1}} */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin GetTranslationMatrix */ - - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(GetTranslationMatrix, T, Status, -/**/ "Missing output") -/**/DEBUG_RETURN_ON_ERROR(GetTranslationMatrix, Status) -/**/DEBUG_WRITE_ENTERING(GetTranslationMatrix, -/**/ "About to build a translation matrix") - - Status = GetIdentitySquareMatrix(T, 4L); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(GetTranslationMatrix, "Done") - return(Status); - } - T[3] = xTranslation; - T[7] = yTranslation; - T[11] = zTranslation; -/**/DEBUG_WRITE_LEAVING(GetTranslationMatrix, "Done") - return(Status); -} /* end GetTranslationMatrix */ - -/*--------------------------------------------------------------------------*/ -extern int LineToLineIntersection - ( - double P[], /* 1st point on line1 */ - double Q[], /* 2nd point on line1 */ - double A[], /* 1st point on line2 */ - double B[], /* 2nd point on line2 */ - double X[], /* output intersection */ - long Lines, /* height of the vectors */ - double Tolerance, /* admissible relative error */ - long MaxIterations, /* convergence limit */ - int *Intersection, /* resulting validity of intersection */ - int *Status /* error management */ - ) - -/* compute the intersection of the line (P,Q) with the line (A,B) */ -/* all vectors have (Lines) elements */ -/* return Intersection = FALSE if there is no intersection */ -/* return Intersection = TRUE if the intersection is valid */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin LineToLineIntersection */ - - double *u, *v, *w, *x; - double U[4], V[4], W[2]; - double Y[2], Z[2]; - double AB, PQ, PA; - double ABAB, ABPQ, PQPQ; - double ABPA, PQPA; - long i; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(LineToLineIntersection, P, *Status, -/**/ "Empty Line1 1st point") -/**/DEBUG_CHECK_NULL_POINTER(LineToLineIntersection, Q, *Status, -/**/ "Empty Line1 2nd point") -/**/DEBUG_CHECK_NULL_POINTER(LineToLineIntersection, A, *Status, -/**/ "Empty Line2 1st point") -/**/DEBUG_CHECK_NULL_POINTER(LineToLineIntersection, B, *Status, -/**/ "Empty Line2 2nd point") -/**/DEBUG_CHECK_NULL_POINTER(LineToLineIntersection, X, *Status, -/**/ "Empty output") -/**/DEBUG_CHECK_NULL_POINTER(LineToLineIntersection, Intersection, *Status, -/**/ "Missing result") -/**/DEBUG_CHECK_RANGE_LONG(LineToLineIntersection, Lines, 1L, LONG_MAX, *Status, -/**/ "Invalid Lines (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(LineToLineIntersection, MaxIterations, 1L, LONG_MAX, *Status, -/**/ "Invalid iterations (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_DOUBLE(LineToLineIntersection, Tolerance, 0.0, DBL_MAX, *Status, -/**/ "Invalid Tolerance (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(LineToLineIntersection, *Status) -/**/DEBUG_WRITE_ENTERING(LineToLineIntersection, -/**/ "About to determine a (line/line) intersection") - - u = A; - v = B; - w = P; - x = Q; - ABAB = 0.0; - ABPQ = 0.0; - PQPQ = 0.0; - ABPA = 0.0; - PQPA = 0.0; - for (i = Lines; (0L < i); i--) { - AB = *v++ - *u; - PQ = *x++ - *w; - PA = *u++ - *w++; - ABAB += AB * AB; - ABPQ -= AB * PQ; - PQPQ += PQ * PQ; - ABPA -= AB * PA; - PQPA += PQ * PA; - } - U[0] = ABAB; - U[1] = ABPQ; - U[2] = ABPQ; - U[3] = PQPQ; - SingularValueDecomposition(U, 2L, 2L, W, V, MaxIterations, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(LineToLineIntersection, "Done") - return(*Status); - } - W[0] = (W[0] < Tolerance) ? (0.0) : (W[0]); - W[1] = (W[1] < Tolerance) ? (0.0) : (W[1]); - Y[0] = ABPA; - Y[1] = PQPA; - SingularValueBackSubstitution(U, W, V, 2L, 2L, Y, Z, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(LineToLineIntersection, "Done") - return(*Status); - } - ABPQ = 0.0; - for (i = Lines; (0L < i); i--) { - AB = *B++ - *A; - PQ = *Q++ - *P; - AB = *A++ + Z[0] * AB; - PQ = *P++ + Z[1] * PQ; - PA = AB - PQ; - ABPQ += PA * PA; - *X++ = 0.5 * (AB + PQ); - } - *Intersection = (sqrt(ABPQ) < Tolerance); -/**/DEBUG_WRITE_LEAVING(LineToLineIntersection, "Done") - return(*Status); -} /* end LineToLineIntersection */ - -/*--------------------------------------------------------------------------*/ -extern int LineToLineIntersection3D - ( - double P[], /* point on line1 */ - double q[], /* direction of line1 */ - double A[], /* point on line2 */ - double b[], /* direction of line2 */ - double X[], /* output intersection */ - double Tolerance, /* admissible relative error */ - int *Intersection /* resulting validity of intersection */ - ) - -/* compute the intersection of the line (P,q) with the line (A,b) */ -/* all points have 3 elements */ -/* all vectors have 3 elements */ -/* a line is described by a point and a vector: X = P + t1 * q, X = A + t2 * b */ -/* where (t1,t2) are free scalars */ -/* the vectors (q, b) must have a normalized unit length */ -/* return Intersection = FALSE if there is no intersection */ -/* return Intersection = TRUE if the intersection is valid */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin LineToLineIntersection3D */ - - double Y[3], Z[3]; - double d, qb, PAq, PAb; - double tq, tb; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(LineToLineIntersection3D, P, Status, -/**/ "Empty Line1 point") -/**/DEBUG_CHECK_NULL_POINTER(LineToLineIntersection3D, q, Status, -/**/ "Empty Line1 direction") -/**/DEBUG_CHECK_NULL_POINTER(LineToLineIntersection3D, A, Status, -/**/ "Empty Line2 point") -/**/DEBUG_CHECK_NULL_POINTER(LineToLineIntersection3D, b, Status, -/**/ "Empty Line2 direction") -/**/DEBUG_CHECK_NULL_POINTER(LineToLineIntersection3D, X, Status, -/**/ "Empty output") -/**/DEBUG_CHECK_NULL_POINTER(LineToLineIntersection3D, Intersection, Status, -/**/ "Missing result") -/**/DEBUG_CHECK_RANGE_DOUBLE(LineToLineIntersection3D, Tolerance, 0.0, DBL_MAX, Status, -/**/ "Invalid Tolerance (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(LineToLineIntersection3D, Status) -/**/DEBUG_WRITE_ENTERING(LineToLineIntersection3D, -/**/ "About to determine a (line/line) intersection") -#ifdef DEBUG -/**/tq = sqrt(q[0] * q[0] + q[1] * q[1] + q[2] * q[2]); -/**/if (Tolerance < fabs(tq - 1.0)) { -/**/ Status = ERROR; -/**/ WRITE_ERROR(LineToLineIntersection3D, -/**/ "Invalid vector q (should have a unit length)") -/**/ DEBUG_WRITE_LEAVING(LineToLineIntersection3D, "Done") -/**/ return(Status); -/**/} -/**/tb = sqrt(b[0] * b[0] + b[1] * b[1] + b[2] * b[2]); -/**/if (Tolerance < fabs(tb - 1.0)) { -/**/ Status = ERROR; -/**/ WRITE_ERROR(LineToLineIntersection3D, -/**/ "Invalid vector b (should have a unit length)") -/**/ DEBUG_WRITE_LEAVING(LineToLineIntersection3D, "Done") -/**/ return(Status); -/**/} -#endif - - X[0] = A[0] - P[0]; - X[1] = A[1] - P[1]; - X[2] = A[2] - P[2]; - PAq = X[0] * q[0] + X[1] * q[1] + X[2] * q[2]; - PAb = X[0] * b[0] + X[1] * b[1] + X[2] * b[2]; - qb = q[0] * b[0] + q[1] * b[1] + q[2] * b[2]; - d = 1.0 - qb * qb; - if (Tolerance < fabs(d)) { - tq = (PAq * qb - PAb) / d; - tb = (PAq - qb * PAb) / d; - Y[0] = P[0] + tq * q[0]; - Y[1] = P[1] + tq * q[1]; - Y[2] = P[2] + tq * q[2]; - Z[0] = A[0] + tb * b[0]; - Z[1] = A[1] + tb * b[1]; - Z[2] = A[2] + tb * b[2]; - X[0] = Z[0] - Y[0]; - X[1] = Z[1] - Y[1]; - X[2] = Z[2] - Y[2]; - *Intersection = (sqrt(X[0] * X[0] + X[1] * X[1] + X[2] * X[2]) <= Tolerance); - X[0] = 0.5 * (Y[0] + Z[0]); - X[1] = 0.5 * (Y[1] + Z[1]); - X[2] = 0.5 * (Y[2] + Z[2]); - } - else { - d = sqrt(X[0] * X[0] + X[1] * X[1] + X[2] * X[2]); - if (d <= Tolerance) { - *Intersection = TRUE; - } - else { - d = 1.0 / d; - Y[0] = (X[1] * q[2] - X[2] * q[1]) * d; - Y[1] = (X[2] * q[0] - X[0] * q[2]) * d; - Y[2] = (X[0] * q[1] - X[1] * q[0]) * d; - Z[0] = (X[1] * b[2] - X[2] * b[1]) * d; - Z[1] = (X[2] * b[0] - X[0] * b[2]) * d; - Z[2] = (X[0] * b[1] - X[1] * b[0]) * d; - *Intersection = (sqrt(Y[0] * Y[0] + Y[1] * Y[1] + Y[2] * Y[2] - + Z[0] * Z[0] + Z[1] * Z[1] + Z[2] * Z[2]) <= Tolerance); - } - X[0] = 0.5 * (P[0] + A[0]); - X[1] = 0.5 * (P[1] + A[1]); - X[2] = 0.5 * (P[2] + A[2]); - } -/**/DEBUG_WRITE_LEAVING(LineToLineIntersection3D, "Done") - return(Status); -} /* end LineToLineIntersection3D */ - -/*--------------------------------------------------------------------------*/ -extern int LineToPlaneIntersection - ( - double P[], /* 1st point on line */ - double Q[], /* 2nd point on line */ - double A[], /* 1st point on plane */ - double B[], /* 2nd point on plane */ - double C[], /* 3rd point on plane */ - double X[], /* output intersection */ - long Lines, /* height of the vectors */ - double Tolerance, /* admissible relative error */ - long MaxIterations, /* convergence limit */ - int *Intersection, /* resulting validity of intersection */ - int *Status /* error management */ - ) - -/* compute the intersection of the line (P,Q) with the plane (A,B,C) */ -/* all vectors have (Lines) elements */ -/* return Intersection = FALSE if there is no intersection */ -/* return Intersection = TRUE if the intersection is valid */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin LineToPlaneIntersection */ - - double *u, *v, *w, *x, *y; - double U[16], V[16], W[4]; - double Y[4], Z[4]; - double AB, BC, CA, PQ, PA; - double ABPQ, ABCA, ABBC, ABAB; - double BCPQ, BCCA, BCBC; - double CAPQ, CACA; - double PQPQ; - double ABPA, BCPA, CAPA, PQPA; - long i; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(LineToPlaneIntersection, P, *Status, -/**/ "Empty Line 1st point") -/**/DEBUG_CHECK_NULL_POINTER(LineToPlaneIntersection, Q, *Status, -/**/ "Empty Line 2nd point") -/**/DEBUG_CHECK_NULL_POINTER(LineToPlaneIntersection, A, *Status, -/**/ "Empty Plane 1st point") -/**/DEBUG_CHECK_NULL_POINTER(LineToPlaneIntersection, B, *Status, -/**/ "Empty Plane 2nd point") -/**/DEBUG_CHECK_NULL_POINTER(LineToPlaneIntersection, C, *Status, -/**/ "Empty Plane 3rd point") -/**/DEBUG_CHECK_NULL_POINTER(LineToPlaneIntersection, X, *Status, -/**/ "Empty output") -/**/DEBUG_CHECK_NULL_POINTER(LineToPlaneIntersection, Intersection, *Status, -/**/ "Missing result") -/**/DEBUG_CHECK_RANGE_LONG(LineToPlaneIntersection, Lines, 1L, LONG_MAX, *Status, -/**/ "Invalid Lines (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(LineToPlaneIntersection, MaxIterations, 1L, LONG_MAX, *Status, -/**/ "Invalid iterations (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_DOUBLE(LineToPlaneIntersection, Tolerance, 0.0, DBL_MAX, *Status, -/**/ "Invalid Tolerance (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(LineToPlaneIntersection, *Status) -/**/DEBUG_WRITE_ENTERING(LineToPlaneIntersection, -/**/ "About to determine a (line/plane) intersection") - - u = A; - v = B; - w = C; - x = P; - y = Q; - ABAB = 0.0; - ABBC = 0.0; - ABCA = 0.0; - ABPQ = 0.0; - BCBC = 0.0; - BCCA = 0.0; - BCPQ = 0.0; - CACA = 0.0; - CAPQ = 0.0; - PQPQ = 0.0; - ABPA = 0.0; - BCPA = 0.0; - CAPA = 0.0; - PQPA = 0.0; - for (i = Lines; (0L < i); i--) { - AB = *v - *u; - BC = *w - *v++; - CA = *u - *w++; - PQ = *y++ - *x; - PA = *u++ - *x++; - ABAB += AB * AB; - ABBC += AB * BC; - ABCA += AB * CA; - ABPQ -= AB * PQ; - BCBC += BC * BC; - BCCA += BC * CA; - BCPQ -= BC * PQ; - CACA += CA * CA; - CAPQ -= CA * PQ; - PQPQ += PQ * PQ; - ABPA -= AB * PA; - BCPA -= BC * PA; - CAPA -= CA * PA; - PQPA += PQ * PA; - } - U[0] = ABAB; - U[1] = ABBC; - U[2] = ABCA; - U[3] = ABPQ; - U[4] = ABBC; - U[5] = BCBC; - U[6] = BCCA; - U[7] = BCPQ; - U[8] = ABCA; - U[9] = BCCA; - U[10] = CACA; - U[11] = CAPQ; - U[12] = ABPQ; - U[13] = BCPQ; - U[14] = CAPQ; - U[15] = PQPQ; - SingularValueDecomposition(U, 4L, 4L, W, V, MaxIterations, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(LineToPlaneIntersection, "Done") - return(*Status); - } - W[0] = (W[0] < Tolerance) ? (0.0) : (W[0]); - W[1] = (W[1] < Tolerance) ? (0.0) : (W[1]); - W[2] = (W[2] < Tolerance) ? (0.0) : (W[2]); - W[3] = (W[3] < Tolerance) ? (0.0) : (W[3]); - Y[0] = ABPA; - Y[1] = BCPA; - Y[2] = CAPA; - Y[3] = PQPA; - SingularValueBackSubstitution(U, W, V, 4L, 4L, Y, Z, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(LineToPlaneIntersection, "Done") - return(*Status); - } - ABPQ = 0.0; - for (i = Lines; (0L < i); i--) { - AB = *B - *A; - BC = *C - *B++; - CA = *A - *C++; - PQ = *Q++ - *P; - AB = *A++ + Z[0] * AB + Z[1] * BC + Z[2] * CA; - PQ = *P++ + Z[3] * PQ; - PA = AB - PQ; - ABPQ += PA * PA; - *X++ = 0.5 * (AB + PQ); - } - *Intersection = (sqrt(ABPQ) <= Tolerance); -/**/DEBUG_WRITE_LEAVING(LineToPlaneIntersection, "Done") - return(*Status); -} /* end LineToPlaneIntersection */ - -/*--------------------------------------------------------------------------*/ -extern int LineToPlaneIntersection3D - ( - double P[], /* point on line */ - double q[], /* direction of line */ - double A[], /* point on plane */ - double b[], /* normal of plane */ - double X[], /* output intersection */ - double Tolerance, /* admissible relative error */ - int *Intersection /* resulting validity of intersection */ - ) - -/* compute the intersection of the line (P,q) with the plane (A,b) */ -/* all points have 3 elements */ -/* all vectors have 3 elements */ -/* a line is described by a point P and a vector q: X = P + t * q, with t a free scalar */ -/* a plane is described by a point A and a normal b: = 0 */ -/* the vectors (q, b) must have a normalized unit length */ -/* return Intersection = FALE if there is no intersection */ -/* return Intersection = TRUE if the intersection is valid */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin LineToPlaneIntersection3D */ - - double PAb, qb, t; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(LineToPlaneIntersection3D, P, Status, -/**/ "Empty Line point") -/**/DEBUG_CHECK_NULL_POINTER(LineToPlaneIntersection3D, q, Status, -/**/ "Empty Line direction") -/**/DEBUG_CHECK_NULL_POINTER(LineToPlaneIntersection3D, A, Status, -/**/ "Empty Plane point") -/**/DEBUG_CHECK_NULL_POINTER(LineToPlaneIntersection3D, b, Status, -/**/ "Empty Plane normal") -/**/DEBUG_CHECK_NULL_POINTER(LineToPlaneIntersection3D, X, Status, -/**/ "Empty output") -/**/DEBUG_CHECK_NULL_POINTER(LineToPlaneIntersection3D, Intersection, Status, -/**/ "Missing result") -/**/DEBUG_CHECK_RANGE_DOUBLE(LineToPlaneIntersection3D, Tolerance, 0.0, DBL_MAX, Status, -/**/ "Invalid Tolerance (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(LineToPlaneIntersection3D, Status) -/**/DEBUG_WRITE_ENTERING(LineToPlaneIntersection3D, -/**/ "About to determine a (line/plane) intersection") -#ifdef DEBUG -/**/t = sqrt(q[0] * q[0] + q[1] * q[1] + q[2] * q[2]); -/**/if (Tolerance < fabs(t - 1.0)) { -/**/ Status = ERROR; -/**/ WRITE_ERROR(LineToPlaneIntersection3D, -/**/ "Invalid vector q (should have a unit length)") -/**/ DEBUG_WRITE_LEAVING(LineToPlaneIntersection3D, "Done") -/**/ return(Status); -/**/} -/**/t = sqrt(b[0] * b[0] + b[1] * b[1] + b[2] * b[2]); -/**/if (Tolerance < fabs(t - 1.0)) { -/**/ Status = ERROR; -/**/ WRITE_ERROR(LineToPlaneIntersection3D, -/**/ "Invalid vector b (should have a unit length)") -/**/ DEBUG_WRITE_LEAVING(LineToPlaneIntersection3D, "Done") -/**/ return(Status); -/**/} -#endif - - X[0] = A[0] - P[0]; - X[1] = A[1] - P[1]; - X[2] = A[2] - P[2]; - PAb = X[0] * b[0] + X[1] * b[1] + X[2] * b[2]; - qb = q[0] * b[0] + q[1] * b[1] + q[2] * b[2]; - if (fabs(qb) <= Tolerance) { - *Intersection = (fabs(PAb) <= Tolerance); - X[0] = A[0]; - X[1] = A[1]; - X[2] = A[2]; - } - else { - *Intersection = TRUE; - t = PAb / qb; - X[0] = P[0] + t * q[0]; - X[1] = P[1] + t * q[1]; - X[2] = P[2] + t * q[2]; - } -/**/DEBUG_WRITE_LEAVING(LineToPlaneIntersection3D, "Done") - return(Status); -} /* end LineToPlaneIntersection3D */ - -/*--------------------------------------------------------------------------*/ -extern int PointsToLine3D - ( - double P[], /* 1st point on input line */ - double Q[], /* 2nd point on input line */ - double A[], /* point on output line */ - double b[], /* direction of output line */ - double Tolerance /* admissible relative error */ - ) - -/* transform the points (P,Q) into the line (A,b) */ -/* all points have 3 elements */ -/* all vectors have 3 elements */ -/* a line is described by a point A and a vector b: X = A + t * b, with t a free scalar */ -/* the vector b has a normalized unit length */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin PointsToLine3D */ - - double t; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(PointsToLine3D, P, Status, -/**/ "Empty Line 1st point") -/**/DEBUG_CHECK_NULL_POINTER(PointsToLine3D, Q, Status, -/**/ "Empty Line 2nd point") -/**/DEBUG_CHECK_NULL_POINTER(PointsToLine3D, A, Status, -/**/ "Empty output line point") -/**/DEBUG_CHECK_NULL_POINTER(PointsToLine3D, b, Status, -/**/ "Empty output line direction") -/**/DEBUG_CHECK_RANGE_DOUBLE(PointsToLine3D, Tolerance, 0.0, DBL_MAX, Status, -/**/ "Invalid Tolerance (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(PointsToLine3D, Status) -/**/DEBUG_WRITE_ENTERING(PointsToLine3D, -/**/ "About to transform 2 points into a line") - - A[0] = 0.5 * (P[0] + Q[0]); - A[1] = 0.5 * (P[1] + Q[1]); - A[2] = 0.5 * (P[2] + Q[2]); - b[0] = Q[0] - P[0]; - b[1] = Q[1] - P[1]; - b[2] = Q[2] - P[2]; - t = sqrt(b[0] * b[0] + b[1] * b[1] + b[2] * b[2]); - if (Tolerance < t) { - b[0] /= t; - b[1] /= t; - b[2] /= t; - } - else { - Status = ERROR; - } -/**/DEBUG_WRITE_LEAVING(PointsToLine3D, "Done") - return(Status); -} /* end PointsToLine3D */ - -/*--------------------------------------------------------------------------*/ -extern int PointsToPlane3D - ( - double P[], /* 1st point on input line */ - double Q[], /* 2nd point on input line */ - double R[], /* 3rd point on input line */ - double A[], /* point on output plane */ - double b[], /* normal of output plane */ - double Tolerance /* admissible relative error */ - ) - -/* transform the points (P,Q,R) into the plane (A,b) */ -/* all points have 3 elements */ -/* all vectors have 3 elements */ -/* a plane is described by a point A and a normal b: = 0 */ -/* the vectors b has a normalized unit length */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin PointsToPlane3D */ - - double u[3], v[3], w[3]; - double t; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(PointsToPlane3D, P, Status, -/**/ "Empty Plane 1st point") -/**/DEBUG_CHECK_NULL_POINTER(PointsToPlane3D, Q, Status, -/**/ "Empty Plane 2nd point") -/**/DEBUG_CHECK_NULL_POINTER(PointsToPlane3D, R, Status, -/**/ "Empty Plane 3rd point") -/**/DEBUG_CHECK_NULL_POINTER(PointsToPlane3D, A, Status, -/**/ "Empty output plane point") -/**/DEBUG_CHECK_NULL_POINTER(PointsToPlane3D, b, Status, -/**/ "Empty output plane normal") -/**/DEBUG_CHECK_RANGE_DOUBLE(PointsToPlane3D, Tolerance, 0.0, DBL_MAX, Status, -/**/ "Invalid Tolerance (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(PointsToPlane3D, Status) -/**/DEBUG_WRITE_ENTERING(PointsToPlane3D, -/**/ "About to transform 2 points into a line") - - A[0] = (1.0 / 3.0) * (P[0] + Q[0] + R[0]); - A[1] = (1.0 / 3.0) * (P[1] + Q[1] + R[1]); - A[2] = (1.0 / 3.0) * (P[2] + Q[2] + R[2]); - u[0] = Q[0] - P[0]; - u[1] = Q[1] - P[1]; - u[2] = Q[2] - P[2]; - v[0] = R[0] - Q[0]; - v[1] = R[1] - Q[1]; - v[2] = R[2] - Q[2]; - w[0] = P[0] - R[0]; - w[1] = P[1] - R[1]; - w[2] = P[2] - R[2]; - b[0] = u[1] * v[2] + v[1] * w[2] + w[1] * u[2] - u[2] * v[1] - v[2] * w[1] - w[2] * u[1]; - b[1] = u[2] * v[0] + v[2] * w[0] + w[2] * u[0] - u[0] * v[2] - v[0] * w[2] - w[0] * u[2]; - b[2] = u[0] * v[1] + v[0] * w[1] + w[0] * u[1] - u[1] * v[0] - v[1] * w[0] - w[1] * u[0]; - t = sqrt(b[0] * b[0] + b[1] * b[1] + b[2] * b[2]); - if (Tolerance < t) { - b[0] /= t; - b[1] /= t; - b[2] /= t; - } - else { - Status = ERROR; - } -/**/DEBUG_WRITE_LEAVING(PointsToPlane3D, "Done") - return(Status); -} /* end PointsToPlane3D */ - -/*--------------------------------------------------------------------------*/ -extern int PointToLineMembership - ( - double P[], /* point to test */ - double A[], /* 1st point on line */ - double B[], /* 2nd point on line */ - long Lines, /* height of the vectors */ - double Tolerance, /* admissible relative error */ - int *Membership, /* resulting type of intersection */ - int *Status /* error management */ - ) - -/* test the membership of the point P to the line (A,B) */ -/* all vectors have (Lines) elements */ -/* return Membership = FALSE if P doesn't belong to (A,B) */ -/* return Membership = TRUE if P does belong to (A,B) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin PointToLineMembership */ - - double *u; - double *U = (double *)NULL; - double Diff, Norm; - long i; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(PointToLineMembership, P, *Status, -/**/ "Empty point") -/**/DEBUG_CHECK_NULL_POINTER(PointToLineMembership, A, *Status, -/**/ "Empty line 1st point") -/**/DEBUG_CHECK_NULL_POINTER(PointToLineMembership, B, *Status, -/**/ "Empty line 2nd point") -/**/DEBUG_CHECK_NULL_POINTER(PointToLineMembership, Membership, *Status, -/**/ "Missing result") -/**/DEBUG_CHECK_RANGE_LONG(PointToLineMembership, Lines, 1L, LONG_MAX, *Status, -/**/ "Invalid Lines (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_DOUBLE(PointToLineMembership, Tolerance, 0.0, DBL_MAX, *Status, -/**/ "Invalid Tolerance (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(PointToLineMembership, *Status) -/**/DEBUG_WRITE_ENTERING(PointToLineMembership, -/**/ "About to determine the membership of a point to a line") - - AllocateVector(&U, Lines, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(PointToLineMembership, "Done") - return(*Status); - } - *Status = ProjectPointToLine(P, A, B, U, Lines, Tolerance); - if (*Status == ERROR) { - FreeVector(&U); -/**/ DEBUG_WRITE_LEAVING(PointToLineMembership, "Done") - return(*Status); - } - u = U; - Norm = 0.0; - for (i = Lines; (0L < i); i--) { - Diff = *P++ - *u++; - Norm += Diff * Diff; - } - *Membership = (sqrt(Norm) <= Tolerance); - *Status = FreeVector(&U); -/**/DEBUG_WRITE_LEAVING(PointToLineMembership, "Done") - return(*Status); -} /* end PointToLineMembership */ - -/*--------------------------------------------------------------------------*/ -extern int PointToLineMembership3D - ( - double P[], /* point to test */ - double A[], /* point on line */ - double b[], /* direction of line */ - double Tolerance, /* admissible relative error */ - int *Membership /* resulting type of intersection */ - ) - -/* test the membership of the point P to the line (A,b) */ -/* all points have 3 elements */ -/* all vectors have 3 elements */ -/* a line is described by a point A and a vector b: X = A + t * b, with t a free scalar */ -/* the vector b must have a normalized unit length */ -/* return Membership = FALSE if P doesn't belong to (A,b) */ -/* return Membership = TRUE if P does belong to (A,b) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin PointToLineMembership3D */ - - double v[3], w[3]; - double t; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(PointToLineMembership3D, P, Status, -/**/ "Empty point") -/**/DEBUG_CHECK_NULL_POINTER(PointToLineMembership3D, A, Status, -/**/ "Empty line point") -/**/DEBUG_CHECK_NULL_POINTER(PointToLineMembership3D, b, Status, -/**/ "Empty line direction") -/**/DEBUG_CHECK_NULL_POINTER(PointToLineMembership3D, Membership, Status, -/**/ "Missing result") -/**/DEBUG_CHECK_RANGE_DOUBLE(PointToLineMembership3D, Tolerance, 0.0, DBL_MAX, Status, -/**/ "Invalid Tolerance (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(PointToLineMembership3D, Status) -/**/DEBUG_WRITE_ENTERING(PointToLineMembership3D, -/**/ "About to determine the membership of a point to a line") -#ifdef DEBUG -/**/t = sqrt(b[0] * b[0] + b[1] * b[1] + b[2] * b[2]); -/**/if (Tolerance < fabs(t - 1.0)) { -/**/ Status = ERROR; -/**/ WRITE_ERROR(PointToLineMembership3D, -/**/ "Invalid vector b (should have a unit length)") -/**/ DEBUG_WRITE_LEAVING(PointToLineMembership3D, "Done") -/**/ return(Status); -/**/} -#endif - - v[0] = A[0] - P[0]; - v[1] = A[1] - P[1]; - v[2] = A[2] - P[2]; - t = sqrt(v[0] * v[0] + v[1] * v[1] + v[2] * v[2]); - if (Tolerance < t) { - v[0] /= t; - v[1] /= t; - v[2] /= t; - w[0] = v[1] * b[2] - v[2] * b[1]; - w[1] = v[2] * b[0] - v[0] * b[2]; - w[2] = v[0] * b[1] - v[1] * b[0]; - t = sqrt(w[0] * w[0] + w[1] * w[1] + w[2] * w[2]); - *Membership = (t <= Tolerance); - } - else { - *Membership = TRUE; - } -/**/DEBUG_WRITE_LEAVING(PointToLineMembership3D, "Done") - return(Status); -} /* end PointToLineMembership3D */ - -/*--------------------------------------------------------------------------*/ -extern int PointToPlaneMembership - ( - double P[], /* point to test */ - double A[], /* 1st point on plane */ - double B[], /* 2nd point on plane */ - double C[], /* 2nd point on plane */ - long Lines, /* height of the vectors */ - double Tolerance, /* admissible relative error */ - long MaxIterations, /* convergence limit */ - int *Membership, /* resulting type of intersection */ - int *Status /* error management */ - ) - -/* test the membership of the point P to the plane (A,B,C) */ -/* all vectors have (Lines) elements */ -/* return Membership = FALSE if P doesn't belong to (A,B,C) */ -/* return Membership = TRUE if P does belong to (A,B,C) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin PointToPlaneMembership */ - - double *u; - double *U = (double *)NULL; - double Diff, Norm; - long i; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(PointToPlaneMembership, P, *Status, -/**/ "Empty point") -/**/DEBUG_CHECK_NULL_POINTER(PointToPlaneMembership, A, *Status, -/**/ "Empty plane 1st point") -/**/DEBUG_CHECK_NULL_POINTER(PointToPlaneMembership, B, *Status, -/**/ "Empty plane 2nd point") -/**/DEBUG_CHECK_NULL_POINTER(PointToPlaneMembership, C, *Status, -/**/ "Empty plane 3rd point") -/**/DEBUG_CHECK_NULL_POINTER(PointToPlaneMembership, Membership, *Status, -/**/ "Missing result") -/**/DEBUG_CHECK_RANGE_LONG(PointToPlaneMembership, Lines, 1L, LONG_MAX, *Status, -/**/ "Invalid Lines (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(PointToPlaneMembership, MaxIterations, 1L, LONG_MAX, *Status, -/**/ "Invalid iterations (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_DOUBLE(PointToPlaneMembership, Tolerance, 0.0, DBL_MAX, *Status, -/**/ "Invalid Tolerance (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(PointToPlaneMembership, *Status) -/**/DEBUG_WRITE_ENTERING(PointToPlaneMembership, -/**/ "About to determine the membership of a point to a plane") - - AllocateVector(&U, Lines, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(PointToPlaneMembership, "Done") - return(*Status); - } - ProjectPointToPlane(P, A, B, C, U, Lines, Tolerance, MaxIterations, Status); - if (*Status == ERROR) { - FreeVector(&U); -/**/ DEBUG_WRITE_LEAVING(PointToPlaneMembership, "Done") - return(*Status); - } - u = U; - Norm = 0.0; - for (i = Lines; (0L < i); i--) { - Diff = *P++ - *u++; - Norm += Diff * Diff; - } - *Membership = (sqrt(Norm) <= Tolerance); - *Status = FreeVector(&U); -/**/DEBUG_WRITE_LEAVING(PointToPlaneMembership, "Done") - return(*Status); -} /* end PointToPlaneMembership */ - -/*--------------------------------------------------------------------------*/ -extern int PointToPlaneMembership3D - ( - double P[], /* point to test */ - double A[], /* point on plane */ - double b[], /* normal of plane */ - double Tolerance, /* admissible relative error */ - int *Membership /* resulting type of intersection */ - ) - -/* test the membership of the point P to the plane (A,b) */ -/* all points have 3 elements */ -/* all vectors have 3 elements */ -/* a plane is described by a point A and a normal b: = 0 */ -/* the vectors b must have a normalized unit length */ -/* return Membership = FALSE if P doesn't belong to (A,b) */ -/* return Membership = TRUE if P does belong to (A,b) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin PointToPlaneMembership3D */ - - double u[3]; - double t; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(PointToPlaneMembership3D, P, Status, -/**/ "Empty point") -/**/DEBUG_CHECK_NULL_POINTER(PointToPlaneMembership3D, A, Status, -/**/ "Empty plane point") -/**/DEBUG_CHECK_NULL_POINTER(PointToPlaneMembership3D, b, Status, -/**/ "Empty plane normal") -/**/DEBUG_CHECK_NULL_POINTER(PointToPlaneMembership3D, Membership, Status, -/**/ "Missing result") -/**/DEBUG_CHECK_RANGE_DOUBLE(PointToPlaneMembership3D, Tolerance, 0.0, DBL_MAX, Status, -/**/ "Invalid Tolerance (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(PointToPlaneMembership3D, Status) -/**/DEBUG_WRITE_ENTERING(PointToPlaneMembership3D, -/**/ "About to determine the membership of a point to a plane") -#ifdef DEBUG -/**/t = sqrt(b[0] * b[0] + b[1] * b[1] + b[2] * b[2]); -/**/if (Tolerance < fabs(t - 1.0)) { -/**/ Status = ERROR; -/**/ WRITE_ERROR(PointToPlaneMembership3D, -/**/ "Invalid vector b (should have a unit length)") -/**/ DEBUG_WRITE_LEAVING(PointToPlaneMembership3D, "Done") -/**/ return(Status); -/**/} -#endif - - u[0] = A[0] - P[0]; - u[1] = A[1] - P[1]; - u[2] = A[2] - P[2]; - t = u[0] * b[0] + u[1] * b[1] + u[2] * b[2]; - *Membership = (fabs(t) <= Tolerance); -/**/DEBUG_WRITE_LEAVING(PointToPlaneMembership3D, "Done") - return(Status); -} /* end PointToPlaneMembership3D */ - -/*--------------------------------------------------------------------------*/ -extern int ProjectPointToLine - ( - double P[], /* point to project */ - double A[], /* 1st point on line */ - double B[], /* 2nd point on line */ - double X[], /* resulting projection */ - long Lines, /* height of the vectors */ - double Tolerance /* admissible relative error */ - ) - -/* project the point P onto the line (A,B) */ -/* all vectors have (Lines) elements */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin ProjectPointToLine */ - - double *u, *v, *w; - double ABAB, APAB; - double AB, AP; - long i; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(ProjectPointToLine, P, Status, -/**/ "Empty Point") -/**/DEBUG_CHECK_NULL_POINTER(ProjectPointToLine, A, Status, -/**/ "Empty Plane 1st point") -/**/DEBUG_CHECK_NULL_POINTER(ProjectPointToLine, B, Status, -/**/ "Empty Plane 2nd point") -/**/DEBUG_CHECK_NULL_POINTER(ProjectPointToLine, X, Status, -/**/ "Empty output") -/**/DEBUG_CHECK_RANGE_LONG(ProjectPointToLine, Lines, 1L, LONG_MAX, Status, -/**/ "Invalid Lines (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_DOUBLE(ProjectPointToLine, Tolerance, 0.0, DBL_MAX, Status, -/**/ "Invalid Tolerance (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(ProjectPointToLine, Status) -/**/DEBUG_WRITE_ENTERING(ProjectPointToLine, -/**/ "About to project a point onto a plane") - - u = P; - v = A; - w = B; - APAB = 0.0; - ABAB = 0.0; - for (i = Lines; (0L < i); i--) { - AP = *u++ - *v; - AB = *w++ - *v++; - APAB += AB * AP; - ABAB += AB * AB; - } - if (ABAB < Tolerance) { - for (i = Lines; (0L < i); i--) { - *X++ = 0.5 * (*A++ + *B++); - } - } - else { - APAB /= ABAB; - for (i = Lines; (0L < i); i--) { - *X++ = *A + APAB * (*B++ - *A); - A++; - } - } -/**/DEBUG_WRITE_LEAVING(ProjectPointToLine, "Done") - return(Status); -} /* end ProjectPointToLine */ - -/*--------------------------------------------------------------------------*/ -extern int ProjectPointToLine3D - ( - double P[], /* point to project */ - double A[], /* point on line */ - double b[], /* direction of line */ - double X[], /* resulting projection */ - double Tolerance /* admissible relative error */ - ) - -/* project the point P onto the line (A,b) */ -/* all points have 3 elements */ -/* all vectors have 3 elements */ -/* a line is described by a point A and a vector b: X = A + t * b, with t a free scalar */ -/* the vector b must have a normalized unit length */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin ProjectPointToLine3D */ - - double t; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(ProjectPointToLine3D, P, Status, -/**/ "Empty Point") -/**/DEBUG_CHECK_NULL_POINTER(ProjectPointToLine3D, A, Status, -/**/ "Empty Plane point") -/**/DEBUG_CHECK_NULL_POINTER(ProjectPointToLine3D, b, Status, -/**/ "Empty Plane normal") -/**/DEBUG_CHECK_NULL_POINTER(ProjectPointToLine3D, X, Status, -/**/ "Empty output") -/**/DEBUG_CHECK_RANGE_DOUBLE(ProjectPointToLine3D, Tolerance, 0.0, DBL_MAX, Status, -/**/ "Invalid Tolerance (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(ProjectPointToLine3D, Status) -/**/DEBUG_WRITE_ENTERING(ProjectPointToLine3D, -/**/ "About to project a point onto a plane") -#ifdef DEBUG -/**/t = sqrt(b[0] * b[0] + b[1] * b[1] + b[2] * b[2]); -/**/if (Tolerance < fabs(t - 1.0)) { -/**/ Status = ERROR; -/**/ WRITE_ERROR(ProjectPointToLine3D, -/**/ "Invalid vector b (should have a unit length)") -/**/ DEBUG_WRITE_LEAVING(ProjectPointToLine3D, "Done") -/**/ return(Status); -/**/} -#endif - - X[0] = A[0] - P[0]; - X[1] = A[1] - P[1]; - X[2] = A[2] - P[2]; - t = X[0] * b[0] + X[1] * b[1] + X[2] * b[2]; - X[0] = P[0] + t * b[0]; - X[1] = P[1] + t * b[1]; - X[2] = P[2] + t * b[2]; -/**/DEBUG_WRITE_LEAVING(ProjectPointToLine3D, "Done") - return(Status); -} /* end ProjectPointToLine3D */ - -/*--------------------------------------------------------------------------*/ -extern int ProjectPointToPlane - ( - double P[], /* point to project */ - double A[], /* 1st point on plane */ - double B[], /* 2nd point on plane */ - double C[], /* 3rd point on plane */ - double X[], /* resulting projection */ - long Lines, /* height of the vectors */ - double Tolerance, /* admissible relative error */ - long MaxIterations, /* convergence limit */ - int *Status /* error management */ - ) - -/* project the point P onto the plane (A,B,C) */ -/* all vectors have (Lines) elements */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin ProjectPointToPlane */ - - double *u, *v, *w, *x; - double U[9], V[9], W[3], Y[3], Z[3]; - double APAB, ABAB; - double APBC, ABBC, BCBC; - double APCA, ABCA, BCCA, CACA; - double AP, AB, BC, CA; - long i; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(ProjectPointToPlane, P, *Status, -/**/ "Empty Point") -/**/DEBUG_CHECK_NULL_POINTER(ProjectPointToPlane, A, *Status, -/**/ "Empty Plane 1st point") -/**/DEBUG_CHECK_NULL_POINTER(ProjectPointToPlane, B, *Status, -/**/ "Empty Plane 2nd point") -/**/DEBUG_CHECK_NULL_POINTER(ProjectPointToPlane, X, *Status, -/**/ "Empty output") -/**/DEBUG_CHECK_RANGE_LONG(ProjectPointToPlane, Lines, 1L, LONG_MAX, *Status, -/**/ "Invalid Lines (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ProjectPointToPlane, MaxIterations, 1L, LONG_MAX, *Status, -/**/ "Invalid iterations (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_DOUBLE(ProjectPointToPlane, Tolerance, 0.0, DBL_MAX, *Status, -/**/ "Invalid Tolerance (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(ProjectPointToPlane, *Status) -/**/DEBUG_WRITE_ENTERING(ProjectPointToPlane, -/**/ "About to project a point onto a plane") - - u = P; - v = A; - w = B; - x = C; - APAB = 0.0; - APBC = 0.0; - APCA = 0.0; - ABAB = 0.0; - ABBC = 0.0; - BCBC = 0.0; - ABCA = 0.0; - BCCA = 0.0; - CACA = 0.0; - for (i = Lines; (0L < i); i--) { - AP = *u++ - *v; - AB = *w - *v; - BC = *x - *w++; - CA = *v++ - *x++; - APAB += AP * AB; - APBC += AP * BC; - APCA += AP * CA; - ABAB += AB * AB; - ABBC += AB * BC; - BCBC += BC * BC; - ABCA += AB * CA; - BCCA += BC * CA; - CACA += CA * CA; - } - U[0] = ABAB; - U[1] = ABBC; - U[2] = ABCA; - U[3] = ABBC; - U[4] = BCBC; - U[5] = BCCA; - U[6] = ABCA; - U[7] = BCCA; - U[8] = CACA; - SingularValueDecomposition(U, 3L, 3L, W, V, MaxIterations, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ProjectPointToPlane, "Done") - return(*Status); - } - W[0] = (W[0] < Tolerance) ? (0.0) : (W[0]); - W[1] = (W[1] < Tolerance) ? (0.0) : (W[1]); - W[2] = (W[2] < Tolerance) ? (0.0) : (W[2]); - Y[0] = APAB; - Y[1] = APBC; - Y[2] = APCA; - SingularValueBackSubstitution(U, W, V, 3L, 3L, Y, Z, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ProjectPointToPlane, "Done") - return(*Status); - } - for (i = Lines; (0L < i); i--) { - *X++ = *A + Z[0] * (*B - *A) + Z[1] * (*C - *B) + Z[2] * (*A - *C); - A++; - B++; - C++; - } -/**/DEBUG_WRITE_LEAVING(ProjectPointToPlane, "Done") - return(*Status); -} /* end ProjectPointToPlane */ - -/*--------------------------------------------------------------------------*/ -extern int ProjectPointToPlane3D - ( - double P[], /* point to project */ - double A[], /* point on plane */ - double b[], /* normal of plane */ - double X[], /* resulting projection */ - double Tolerance /* admissible relative error */ - ) - -/* project the point P onto the plane (A,b) */ -/* all points have 3 elements */ -/* all vectors have 3 elements */ -/* a plane is described by a point A and a normal b: = 0 */ -/* the vectors b must have a normalized unit length */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin ProjectPointToPlane3D */ - - double t; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(ProjectPointToPlane3D, P, Status, -/**/ "Empty Point") -/**/DEBUG_CHECK_NULL_POINTER(ProjectPointToPlane3D, A, Status, -/**/ "Empty Plane point") -/**/DEBUG_CHECK_NULL_POINTER(ProjectPointToPlane3D, b, Status, -/**/ "Empty Plane normal") -/**/DEBUG_CHECK_NULL_POINTER(ProjectPointToPlane3D, X, Status, -/**/ "Empty output") -/**/DEBUG_CHECK_RANGE_DOUBLE(ProjectPointToPlane3D, Tolerance, 0.0, DBL_MAX, Status, -/**/ "Invalid Tolerance (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(ProjectPointToPlane3D, Status) -/**/DEBUG_WRITE_ENTERING(ProjectPointToPlane3D, -/**/ "About to project a point onto a plane") -#ifdef DEBUG -/**/t = sqrt(b[0] * b[0] + b[1] * b[1] + b[2] * b[2]); -/**/if (Tolerance < fabs(t - 1.0)) { -/**/ Status = ERROR; -/**/ WRITE_ERROR(ProjectPointToPlane3D, -/**/ "Invalid vector b (should have a unit length)") -/**/ DEBUG_WRITE_LEAVING(ProjectPointToPlane3D, "Done") -/**/ return(Status); -/**/} -#endif - - X[0] = A[0] - P[0]; - X[1] = A[1] - P[1]; - X[2] = A[2] - P[2]; - t = X[0] * b[0] + X[1] * b[1] + X[2] * b[2]; - X[0] = A[0] - t * b[0]; - X[1] = A[1] - t * b[1]; - X[2] = A[2] - t * b[2]; -/**/DEBUG_WRITE_LEAVING(ProjectPointToPlane3D, "Done") - return(Status); -} /* end ProjectPointToPlane3D */ - -/*--------------------------------------------------------------------------*/ -extern int TestColinearVector - ( - double U[], /* 1st vector */ - double V[], /* 2nd vector */ - long Lines, /* height of the vector */ - double Tolerance, /* admissible relative error */ - int *Colinear /* resulting test of colinearity */ - ) - -/* determine whether the vectors U and V are colinear */ -/* the vectors U and V have (Lines) elements */ -/* return Colinear = -1 if at least one of the vectors is degenerate */ -/* return Colinear = 0 if the vectors are not colinear */ -/* return Colinear = 1 if the vectors are colinear */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin TestColinearVector */ - - double *u, *v; - double NormU, NormV; - double Diff, Norm; - long i; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(TestColinearVector, U, Status, -/**/ "Empty input left operand") -/**/DEBUG_CHECK_NULL_POINTER(TestColinearVector, V, Status, -/**/ "Empty input right operand") -/**/DEBUG_CHECK_NULL_POINTER(TestColinearVector, Colinear, Status, -/**/ "Missing result") -/**/DEBUG_CHECK_RANGE_LONG(TestColinearVector, Lines, 1L, LONG_MAX, Status, -/**/ "Invalid Lines (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_DOUBLE(TestColinearVector, Tolerance, 0.0, DBL_MAX, Status, -/**/ "Invalid Tolerance (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(TestColinearVector, Status) -/**/DEBUG_WRITE_ENTERING(TestColinearVector, -/**/ "About to test for colinearity") - - u = U; - v = V; - NormU = 0.0; - NormV = 0.0; - for (i = Lines; (0L < i); i--) { - NormU += *u * *u; - NormV += *v * *v; - u++; - v++; - } - NormU = sqrt(NormU); - NormV = sqrt(NormV); - if (NormU <= Tolerance) { - *Colinear = -1; -/**/ DEBUG_WRITE_LEAVING(TestColinearVector, "Done") - return(Status); - } - if (NormV <= Tolerance) { - *Colinear = -1; -/**/ DEBUG_WRITE_LEAVING(TestColinearVector, "Done") - return(Status); - } - NormU = 1.0 / NormU; - NormV = 1.0 / NormV; - Norm = 0.0; - for (i = Lines; (0L < i); i--) { - Diff = *U++ * NormU - *V++ * NormV; - Norm += Diff * Diff; - } - *Colinear = (sqrt(Norm) < Tolerance) ? (1) : (0); -/**/DEBUG_WRITE_LEAVING(TestColinearVector, "Done") - return(Status); -} /* end TestColinearVector */ - -/*--------------------------------------------------------------------------*/ -extern int TestCoplanarVector - ( - double U[], /* 1st vector */ - double V[], /* 2nd vector */ - double W[], /* 3rd vector */ - long Lines, /* height of the vectors */ - double Tolerance, /* admissible relative error */ - long MaxIterations, /* convergence limit */ - int *Coplanar, /* resulting test of coplanarity */ - int *Status /* error management */ - ) - -/* determine whether the vectors (U,V,W) are coplanar */ -/* the vectors (U,V,W) have (Lines) elements */ -/* return Coplanar = -1 in degenerate cases */ -/* return Coplanar = 0 if the vectors are not coplanar */ -/* return Coplanar = 1 if the vectors are coplanar */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin TestCoplanarVector */ - - double *u, *v, *w, *x; - double *M = (double *)NULL; - double X[9], Y[3]; - long i; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(TestCoplanarVector, U, *Status, -/**/ "Empty 1st vector") -/**/DEBUG_CHECK_NULL_POINTER(TestCoplanarVector, V, *Status, -/**/ "Empty 2nd vector") -/**/DEBUG_CHECK_NULL_POINTER(TestCoplanarVector, W, *Status, -/**/ "Empty 3rd vector") -/**/DEBUG_CHECK_NULL_POINTER(TestCoplanarVector, Coplanar, *Status, -/**/ "Missing result") -/**/DEBUG_CHECK_RANGE_LONG(TestCoplanarVector, Lines, 1L, LONG_MAX, *Status, -/**/ "Invalid Lines (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(TestCoplanarVector, MaxIterations, 1L, LONG_MAX, *Status, -/**/ "Invalid iterations (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_DOUBLE(TestCoplanarVector, Tolerance, 0.0, DBL_MAX, *Status, -/**/ "Invalid Tolerance (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(TestCoplanarVector, *Status) -/**/DEBUG_WRITE_ENTERING(TestCoplanarVector, -/**/ "About to determine a (line/line) intersection") - - *Status = TestColinearVector(U, V, Lines, Tolerance, Coplanar); - switch (*Coplanar) { - case 1: - *Coplanar = -1; - case -1: -/**/ DEBUG_WRITE_LEAVING(TestCoplanarVector, "Done") - return(*Status); - case 0: - break; - default: - *Status = ERROR; - WRITE_ERROR(TestCoplanarVector, "Unexpected internal error") -/**/ DEBUG_WRITE_LEAVING(TestCoplanarVector, "Done") - return(*Status); - } - *Status = TestColinearVector(V, W, Lines, Tolerance, Coplanar); - switch (*Coplanar) { - case 1: - *Coplanar = -1; - case -1: -/**/ DEBUG_WRITE_LEAVING(TestCoplanarVector, "Done") - return(*Status); - case 0: - break; - default: - *Status = ERROR; - WRITE_ERROR(TestCoplanarVector, "Unexpected internal error") -/**/ DEBUG_WRITE_LEAVING(TestCoplanarVector, "Done") - return(*Status); - } - *Status = TestColinearVector(W, U, Lines, Tolerance, Coplanar); - switch (*Coplanar) { - case 1: - *Coplanar = -1; - case -1: -/**/ DEBUG_WRITE_LEAVING(TestCoplanarVector, "Done") - return(*Status); - case 0: - break; - default: - *Status = ERROR; - WRITE_ERROR(TestCoplanarVector, "Unexpected internal error") -/**/ DEBUG_WRITE_LEAVING(TestCoplanarVector, "Done") - return(*Status); - } - AllocateMatrix(&M, Lines, 3L, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(TestCoplanarVector, "Done") - return(*Status); - } - u = U; - v = V; - w = W; - x = M; - for (i = Lines; (0L < i); i--) { - *x++ = *u++; - *x++ = *v++; - *x++ = *w++; - } - SingularValueDecomposition(M, Lines, 3L, Y, X, MaxIterations, Status); - if (*Status == ERROR) { - FreeMatrix(&M); -/**/ DEBUG_WRITE_LEAVING(TestCoplanarVector, "Done") - return(*Status); - } - if (((Y[0] <= Tolerance) && (Tolerance < Y[1]) && (Tolerance < Y[2])) - || ((Tolerance < Y[0]) && (Y[1] <= Tolerance) && (Tolerance < Y[2])) - || ((Tolerance < Y[0]) && (Tolerance < Y[1]) && (Y[2] <= Tolerance))) { - *Coplanar = 1; - } - else if ((Tolerance < Y[0]) && (Tolerance < Y[1]) && (Tolerance < Y[2])) { - *Coplanar = 0; - } - else { - WRITE_WARNING(TestCoplanarVector, "Unexpected condition") - *Coplanar = -1; - } - *Status = FreeMatrix(&M); -/**/DEBUG_WRITE_LEAVING(TestCoplanarVector, "Done") - return(*Status); -} /* end TestCoplanarVector */ - diff --git a/src/core/bilib/geometry.h b/src/core/bilib/geometry.h deleted file mode 100644 index 5e91163..0000000 --- a/src/core/bilib/geometry.h +++ /dev/null @@ -1,425 +0,0 @@ -/**@defgroup BilibGeometry Bilib Geometry - @ingroup BilibLibrary */ -//@{ -/*--------------------------------------------------------------------------*/ -/** Affine -> Rotation matrix. - Approximate a (4 x 4) homogenous affine matrix by a (4 x 4) rotation - matrix. The rotation matrix has the form R = Rx.Ry.Rz. - - A and R are homogenous: (A, R) = {{*, *, *, 0}, {*, *, *, 0}, - {*, *, *, 0}, {0, 0, 0, 1}} - - The returned rotation angles are given in the unit of radian. - - success: return(!ERROR); failure: return(ERROR) -*/ -extern int AffineToRotationMatrix - ( - double *A, /* input 4x4 homogenous affine matrix */ - double *R, /* output 4x4 homogenous rotation matrix */ - double *xRotation, /* output rotation around x-axis */ - double *yRotation, /* output rotation around y-axis */ - double *zRotation, /* output rotation around z-axis */ - int FirstOctant, /* constrains the rotation */ - double Tolerance, /* admissible relative error */ - long MaxIterations, /* convergence limit */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Produce Euler rotation matrix (X,Y,Z). - Fill a rotation matrix R such that R = Rx.Ry.Rz. - The size of the output matrix R is (4 x 4). R is homogenous: - R = {{*, *, *, 0}, {*, *, *, 0}, {*, *, *, 0}, {0, 0, 0, 1}}. - The rotation angles are given in the unit of radian. - - success: return(!ERROR); failure: return(ERROR) -*/ -extern int GetRotationMatrix - ( - double *R, /* output 4x4 homogenous matrix */ - double xRotation, /* rotation around x-axis */ - double yRotation, /* rotation around y-axis */ - double zRotation /* rotation around z-axis */ - ); - -/*--------------------------------------------------------------------------*/ -/** Produce scaling matrix. - Fill a scaling matrix T. The size of the output matrix T is (4 x 4). - T is homogenous: - T = {{sx, 0, 0, 0}, {0, sy, 0, 0}, {0, 0, sz, 0}, {0, 0, 0, 1}} - - success: return(!ERROR); failure: return(ERROR) -*/ -extern int GetScalingMatrix - ( - double *S, /* output 4x4 homogenous matrix */ - double xScale, /* scaling along x-axis */ - double yScale, /* scaling along y-axis */ - double zScale /* scaling along z-axis */ - ); - -/*--------------------------------------------------------------------------*/ -/** Produce a translation matrix. - Fill a translation matrix T. The size of the output matrix T is (4 x 4) - T is homogenous: - T = {{1, 0, 0, dx}, {0, 1, 0, dy}, {0, 0, 1, dz}, {0, 0, 0, 1}} - - success: return(!ERROR); failure: return(ERROR) -*/ -extern int GetTranslationMatrix - ( - double *T, /* output 4x4 homogenous matrix */ - double xTranslation, /* translation along x-axis */ - double yTranslation, /* translation along y-axis */ - double zTranslation /* translation along z-axis */ - ); - -/*--------------------------------------------------------------------------*/ -/** Do two lines intersect (n-D)?. - Compute the intersection of the line (P,Q) with the line (A,B). - All vectors have (Lines) elements. I.e., the dimension of the space - is (Lines). - - return Intersection = FALSE if there is no intersection. - return Intersection = TRUE if the intersection is valid. - - success: return(!ERROR); failure: return(ERROR) -*/ -extern int LineToLineIntersection - ( - double P[], /* 1st point on line1 */ - double Q[], /* 2nd point on line1 */ - double A[], /* 1st point on line2 */ - double B[], /* 2nd point on line2 */ - double X[], /* output intersection */ - long Lines, /* height of the vectors */ - double Tolerance, /* admissible relative error */ - long MaxIterations, /* convergence limit */ - int *Intersection, /* resulting validity of intersection */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Do two lines intersect (3-D)? - Compute the intersection of the line (P,q) with the line (A,b). - All points have 3 elements. All vectors have 3 elements. - - A line is described by a point and a vector: X = P + t1 * q, - X = A + t2 * b where (t1,t2) are free scalars. - - The vectors (q, b) must have a normalized unit length. - - return Intersection = FALSE if there is no intersection. - return Intersection = TRUE if the intersection is valid. - - success: return(!ERROR); failure: return(ERROR) -*/ -extern int LineToLineIntersection3D - ( - double P[], /* point on line1 */ - double q[], /* direction of line1 */ - double A[], /* point on line2 */ - double b[], /* direction of line2 */ - double X[], /* output intersection */ - double Tolerance, /* admissible relative error */ - int *Intersection /* resulting validity of intersection */ - ); - -/*--------------------------------------------------------------------------*/ -/** Does a line intersect a plane (n-D)? - Compute the intersection of the line (P,Q) with the plane (A,B,C). - All vectors have (Lines) elements. I.e., the dimension of the space - is (Lines). - - return Intersection = FALSE if there is no intersection. - return Intersection = TRUE if the intersection is valid. - - success: return(!ERROR); failure: return(ERROR) -*/ -extern int LineToPlaneIntersection - ( - double P[], /* 1st point on line */ - double Q[], /* 2nd point on line */ - double A[], /* 1st point on plane */ - double B[], /* 2nd point on plane */ - double C[], /* 3rd point on plane */ - double X[], /* output intersection */ - long Lines, /* height of the vectors */ - double Tolerance, /* admissible relative error */ - long MaxIterations, /* convergence limit */ - int *Intersection, /* resulting validity of intersection */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Does a line intersect a plane (3-D)? - Compute the intersection of the line (P,q) with the plane (A,b). - All points have 3 elements. All vectors have 3 elements. - - A line is described by a point P and a vector q: X = P + t * q, - with t a free scalar. A plane is described by a point A and a normal b: - = 0. The vectors (q, b) must have a normalized unit length. - - return Intersection = FALE if there is no intersection. - return Intersection = TRUE if the intersection is valid. - - success: return(!ERROR); failure: return(ERROR) -*/ -extern int LineToPlaneIntersection3D - ( - double P[], /* point on line */ - double q[], /* direction of line */ - double A[], /* point on plane */ - double b[], /* normal of plane */ - double X[], /* output intersection */ - double Tolerance, /* admissible relative error */ - int *Intersection /* resulting validity of intersection */ - ); - -/*--------------------------------------------------------------------------*/ -/** What is the line that passes through two points (3-D)?. - Transform the points (P,Q) into the line (A,b). - All points have 3 elements. All vectors have 3 elements. - - A line is described by a point A and a vector b: X = A + t * b, - with t a free scalar. The vector b has a normalized unit length. - - success: return(!ERROR); failure: return(ERROR) -*/ -extern int PointsToLine3D - ( - double P[], /* 1st point on input line */ - double Q[], /* 2nd point on input line */ - double A[], /* point on output line */ - double b[], /* direction of output line */ - double Tolerance /* admissible relative error */ - ); - -/*--------------------------------------------------------------------------*/ -/** What is the plane passing through 3 points (3-D)? - Transform the points (P,Q,R) into the plane (A,b). - All points have 3 elements. All vectors have 3 elements. - - A plane is described by a point A and a normal b: = 0. - The vectors b has a normalized unit length. - - success: return(!ERROR); failure: return(ERROR) -*/ -extern int PointsToPlane3D - ( - double P[], /* 1st point on input line */ - double Q[], /* 2nd point on input line */ - double R[], /* 3rd point on input line */ - double A[], /* point on output plane */ - double b[], /* normal of output plane */ - double Tolerance /* admissible relative error */ - ); - -/*--------------------------------------------------------------------------*/ -/** Does a point belong to a line (n-D)?. - Test the membership of the point P to the line (A,B). - All vectors have (Lines) elements. - - return Membership = FALSE if P doesn't belong to (A,B). - return Membership = TRUE if P does belong to (A,B). - - success: return(!ERROR); failure: return(ERROR) -*/ -extern int PointToLineMembership - ( - double P[], /* point to test */ - double A[], /* 1st point on line */ - double B[], /* 2nd point on line */ - long Lines, /* height of the vectors */ - double Tolerance, /* admissible relative error */ - int *Membership, /* resulting type of intersection */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Does a point belong to a line (3-D)? - Test the membership of the point P to the line (A,b). - All points have 3 elements. All vectors have 3 elements. - - A line is described by a point A and a vector b: X = A + t * b, - with t a free scalar. The vector b must have a normalized unit length. - - return Membership = FALSE if P doesn't belong to (A,b). - return Membership = TRUE if P does belong to (A,b). - - success: return(!ERROR); failure: return(ERROR) -*/ -extern int PointToLineMembership3D - ( - double P[], /* point to test */ - double A[], /* point on line */ - double b[], /* direction of line */ - double Tolerance, /* admissible relative error */ - int *Membership /* resulting type of intersection */ - ); - -/*--------------------------------------------------------------------------*/ -/** Does a point belong to a plane (n-D)?. - Test the membership of the point P to the plane (A,B,C). - All vectors have (Lines) elements. - - return Membership = FALSE if P doesn't belong to (A,B,C). - return Membership = TRUE if P does belong to (A,B,C) - - success: return(!ERROR); failure: return(ERROR) -*/ -extern int PointToPlaneMembership - ( - double P[], /* point to test */ - double A[], /* 1st point on plane */ - double B[], /* 2nd point on plane */ - double C[], /* 2nd point on plane */ - long Lines, /* height of the vectors */ - double Tolerance, /* admissible relative error */ - long MaxIterations, /* convergence limit */ - int *Membership, /* resulting type of intersection */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Does a point belong to a plane (3-D)? - Test the membership of the point P to the plane (A,b). - All points have 3 elements. All vectors have 3 elements. - - A plane is described by a point A and a normal b: = 0. - The vectors b must have a normalized unit length. - - return Membership = FALSE if P doesn't belong to (A,b). - return Membership = TRUE if P does belong to (A,b) - - success: return(!ERROR); failure: return(ERROR) -*/ -extern int PointToPlaneMembership3D - ( - double P[], /* point to test */ - double A[], /* point on plane */ - double b[], /* normal of plane */ - double Tolerance, /* admissible relative error */ - int *Membership /* resulting type of intersection */ - ); - -/*--------------------------------------------------------------------------*/ -/** Project a point onto a line (n-D). - Project the point P onto the line (A,B). - All vectors have (Lines) elements. - - success: return(!ERROR); failure: return(ERROR) -*/ -extern int ProjectPointToLine - ( - double P[], /* point to project */ - double A[], /* 1st point on line */ - double B[], /* 2nd point on line */ - double X[], /* resulting projection */ - long Lines, /* height of the vectors */ - double Tolerance /* admissible relative error */ - ); - -/*--------------------------------------------------------------------------*/ -/** Project a point onto a line (3-D). - Project the point P onto the line (A,b). - All points have 3 elements. All vectors have 3 elements. - - A line is described by a point A and a vector b: X = A + t * b, - with t a free scalar. The vector b must have a normalized unit length. - - success: return(!ERROR); failure: return(ERROR) -*/ -extern int ProjectPointToLine3D - ( - double P[], /* point to project */ - double A[], /* point on line */ - double b[], /* direction of line */ - double X[], /* resulting projection */ - double Tolerance /* admissible relative error */ - ); - -/*--------------------------------------------------------------------------*/ -/** Project a point onto a plane (n-D). - Project the point P onto the plane (A,B,C). - All vectors have (Lines) elements. - - success: return(!ERROR); failure: return(ERROR) -*/ -extern int ProjectPointToPlane - ( - double P[], /* point to project */ - double A[], /* 1st point on plane */ - double B[], /* 2nd point on plane */ - double C[], /* 3rd point on plane */ - double X[], /* resulting projection */ - long Lines, /* height of the vectors */ - double Tolerance, /* admissible relative error */ - long MaxIterations, /* convergence limit */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Project a point onto a plane (3-D). - Project the point P onto the plane (A,b). - All points have 3 elements. All vectors have 3 elements. - - A plane is described by a point A and a normal b: = 0. - The vectors b must have a normalized unit length. - - success: return(!ERROR); failure: return(ERROR) -*/ - -extern int ProjectPointToPlane3D - ( - double P[], /* point to project */ - double A[], /* point on plane */ - double b[], /* normal of plane */ - double X[], /* resulting projection */ - double Tolerance /* admissible relative error */ - ); - -/*--------------------------------------------------------------------------*/ -/** Are two vectors colinear (n-D)?. - Determine whether the vectors U and V are colinear. - The vectors U and V have (Lines) elements. - - return Colinear = -1 if at least one of the vectors is degenerate. - return Colinear = 0 if the vectors are not colinear. - return Colinear = 1 if the vectors are colinear. - - success: return(!ERROR); failure: return(ERROR) -*/ -extern int TestColinearVector - ( - double U[], /* 1st vector */ - double V[], /* 2nd vector */ - long Lines, /* height of the vector */ - double Tolerance, /* admissible relative error */ - int *Colinear /* resulting test of colinearity */ - ); - -/*--------------------------------------------------------------------------*/ -/** Are three vectors coplanar (n-D)? - Determine whether the vectors (U,V,W) are coplanar. - The vectors (U,V,W) have (Lines) elements. - - return Coplanar = -1 in degenerate cases. - return Coplanar = 0 if the vectors are not coplanar. - return Coplanar = 1 if the vectors are coplanar. - - success: return(!ERROR); failure: return(ERROR) -*/ -extern int TestCoplanarVector - ( - double U[], /* 1st vector */ - double V[], /* 2nd vector */ - double W[], /* 3rd vector */ - long Lines, /* height of the vectors */ - double Tolerance, /* admissible relative error */ - long MaxIterations, /* convergence limit */ - int *Coplanar, /* resulting test of coplanarity */ - int *Status /* error management */ - ); -//@} diff --git a/src/core/bilib/getpoles.cc b/src/core/bilib/getpoles.cc deleted file mode 100644 index f3851fd..0000000 --- a/src/core/bilib/getpoles.cc +++ /dev/null @@ -1,319 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -#include -#include - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" -#include "error.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "getpoles.h" -#include "kernel.h" -#include "linearalgebra.h" -#include "messagedisplay.h" -#include "polynomial.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -#ifdef DEBUG -#include -#include -#endif - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern int GetBsplinePoles - ( - double RealPoles[], /* returned array of poles */ - long Degree, /* spline degree */ - double Tolerance, /* admissible relative error */ - int *Status /* error management */ - ) - -/* fill an array with the values of spline poles */ -/* the number of returned poles is (Degree / 2L) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin GetBsplinePoles */ - - double *p; - double *Polynomial = (double *)NULL; - double *AllPolesReal = (double *)NULL; - long i, PoleNumber; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(GetBsplinePoles, RealPoles, *Status, -/**/ "Empty output") -/**/DEBUG_CHECK_RANGE_DOUBLE(GetBsplinePoles, Tolerance, 0.0, DBL_MAX, *Status, -/**/ "Invalid Tolerance (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(GetBsplinePoles, *Status) -/**/DEBUG_WRITE_ENTERING(GetBsplinePoles, -/**/ "About to fill an array of spline poles") - - switch (Degree) { - case 0L: - case 1L: - *Status = ERROR; - WRITE_ERROR(GetBsplinePoles, "Invalid spline degree") - break; - case 2L: - RealPoles[0] = sqrt(8.0) - 3.0; - break; - case 3L: - RealPoles[0] = sqrt(3.0) - 2.0; - break; - case 4L: - RealPoles[0] = sqrt(664.0 - sqrt(438976.0)) + sqrt(304.0) - 19.0; - RealPoles[1] = sqrt(664.0 + sqrt(438976.0)) - sqrt(304.0) - 19.0; - break; - case 5L: - RealPoles[0] = sqrt(135.0 / 2.0 - sqrt(17745.0 / 4.0)) + sqrt(105.0 / 4.0) - - 13.0 / 2.0; - RealPoles[1] = sqrt(135.0 / 2.0 + sqrt(17745.0 / 4.0)) - sqrt(105.0 / 4.0) - - 13.0 / 2.0; - break; - case 6L: - RealPoles[0] = -0.488294589303044755130118038883789062112279161239377608394; - RealPoles[1] = -0.081679271076237512597937765737059080653379610398148178525368; - RealPoles[2] = -0.00141415180832581775108724397655859252786416905534669851652709; - break; - case 7L: - RealPoles[0] = -0.5352804307964381655424037816816460718339231523426924148812; - RealPoles[1] = -0.122554615192326690515272264359357343605486549427295558490763; - RealPoles[2] = -0.0091486948096082769285930216516478534156925639545994482648003; - break; - case 8L: - RealPoles[0] = -0.57468690924876543053013930412874542429066157804125211200188; - RealPoles[1] = -0.163035269297280935240551896860737052234768145508298548489731; - RealPoles[2] = -0.0236322946948448500234039192963613206126659208546294370651457; - RealPoles[3] = -0.000153821310641690911739352530184021607629640540700430019629940; - break; - case 9L: - RealPoles[0] = -0.60799738916862577900772082395428976943963471853990829550220; - RealPoles[1] = -0.201750520193153238796064685055970434680898865757470649318867; - RealPoles[2] = -0.043222608540481752133321142979429688265852380231497069381435; - RealPoles[3] = -0.00212130690318081842030489655784862342205485609886239466341517; - break; - case 10L: - RealPoles[0] = -0.63655066396942385875799205491349773313787959010128860432339; - RealPoles[1] = -0.238182798377573284887456162200161978666543494059728787251924; - RealPoles[2] = -0.065727033228308551538201803949684252205121694392255863103034; - RealPoles[3] = -0.0075281946755486906437698340318148831650567567441314086093636; - RealPoles[4] = -0.0000169827628232746642307274679399688786114400132341362095006930; - break; - case 11L: - RealPoles[0] = -0.66126606890073470691013126292248166961816286716800880802421; - RealPoles[1] = -0.272180349294785885686295280258287768151235259565335176244192; - RealPoles[2] = -0.089759599793713309944142676556141542547561966017018544406214; - RealPoles[3] = -0.0166696273662346560965858360898150837154727205519335156053610; - RealPoles[4] = -0.00051055753444650205713591952840749392417989252534014106289610; - break; - default: - AllocateVector(&Polynomial, Degree + 1L, Status); - if (*Status == ERROR) { - FreeVector(&Polynomial); -/**/ DEBUG_WRITE_LEAVING(GetBsplinePoles, "Done") - return(*Status); - } - p = Polynomial; - for (i = -Degree / 2L; (i <= (Degree / 2L)); i++) { - *Status = Bspline(Degree, (double)i, p++); - if (*Status == ERROR) { - FreeVector(&Polynomial); -/**/ DEBUG_WRITE_LEAVING(GetBsplinePoles, "Done") - return(*Status); - } - } - AllocateVector(&AllPolesReal, Degree, Status); - if (*Status == ERROR) { - FreeVector(&Polynomial); -/**/ DEBUG_WRITE_LEAVING(GetBsplinePoles, "Done") - return(*Status); - } - PolynomialRealRoots(Polynomial, Degree, AllPolesReal, &PoleNumber, - Tolerance, Status); - if (*Status == ERROR) { - FreeVector(&AllPolesReal); - FreeVector(&Polynomial); -/**/ DEBUG_WRITE_LEAVING(GetBsplinePoles, "Done") - return(*Status); - } - *Status = FreeVector(&Polynomial); - if (*Status == ERROR) { - FreeVector(&AllPolesReal); -/**/ DEBUG_WRITE_LEAVING(GetBsplinePoles, "Done") - return(*Status); - } - for (i = -Degree / 2L; (i <= (Degree / 2L)); i++) { - if (*AllPolesReal < 0.0) { - *RealPoles++ = *AllPolesReal; - } - AllPolesReal++; - } - *Status = FreeVector(&AllPolesReal); - break; - } -/**/DEBUG_WRITE_LEAVING(GetBsplinePoles, "Done") - return(*Status); -} /* end GetBsplinePoles */ - -/*--------------------------------------------------------------------------*/ -extern int GetOmomsPoles - ( - double RealPoles[], /* returned array of poles */ - long Degree, /* oMoms degree */ - double Tolerance, /* admissible relative error */ - int *Status /* error management */ - ) - -/* fill an array with the values of oMoms poles */ -/* the number of returned poles is (Degree / 2L) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin GetOmomsPoles */ - - double *p; - double *Polynomial = (double *)NULL; - double *AllPolesReal = (double *)NULL; - long i, PoleNumber; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(GetOmomsPoles, RealPoles, *Status, -/**/ "Empty output") -/**/DEBUG_CHECK_RANGE_DOUBLE(GetOmomsPoles, Tolerance, 0.0, DBL_MAX, *Status, -/**/ "Invalid Tolerance (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(GetOmomsPoles, *Status) -/**/DEBUG_WRITE_ENTERING(GetOmomsPoles, -/**/ "About to fill an array of oMoms poles") - - switch (Degree) { - case 0L: - case 1L: - *Status = ERROR; - WRITE_ERROR(GetOmomsPoles, "Invalid oMoms degree") - break; - case 2L: - RealPoles[0] = sqrt(1560.0 / 289.0) - 43.0 / 17.0; - break; - case 3L: - RealPoles[0] = sqrt(105.0 / 64.0) - 13.0 / 8.0; - break; - case 4L: - RealPoles[0] = sqrt(68880840.0 / 552049.0 - sqrt(4666909808998080.0 - / 304758098401.0)) + sqrt(28511280.0 / 552049.0) - 6397.0 / 743.0; - RealPoles[1] = sqrt(68880840.0 / 552049.0 + sqrt(4666909808998080.0 - / 304758098401.0)) - sqrt(28511280.0 / 552049.0) - 6397.0 / 743.0; - break; - case 5L: - RealPoles[0] = sqrt(285420.0 / 11449.0 - sqrt(77202800640.0 / 131079601.0)) - + sqrt(96165.0 / 11449.0) - 448.0 / 107.0; - RealPoles[1] = sqrt(285420.0 / 11449.0 + sqrt(77202800640.0 / 131079601.0)) - - sqrt(96165.0 / 11449.0) - 448.0 / 107.0; - break; - case 6L: - RealPoles[0] = -0.52667681509090929598702625804052518367299232611182543044727; - RealPoles[1] = -0.113602213794490707459277514309782377945743188648838906585927; - RealPoles[2] = -0.0062184195886762433029497449362169006376506731708848957234005; - break; - case 7L: - RealPoles[0] = -0.56853761800229298164787483927617716585997958614632832393829; - RealPoles[1] = -0.155700774677357760841565001104679442932629669048969307010564; - RealPoles[2] = -0.0197684253838613956123727080799270645154754590429447748430377; - break; - case 8L: - RealPoles[0] = -0.60339620680495477357624485934607992088475202356468905280774; - RealPoles[1] = -0.195760866811992318305809476612370514400584120988635886262742; - RealPoles[2] = -0.039301266108611678563535490932330519287035489696802783105375; - RealPoles[3] = -0.00131723647225732476410835675436309476443645309809984514964350; - break; - case 9L: - RealPoles[0] = -0.63302645078114260206493405039483007841576319677177837016686; - RealPoles[1] = -0.233245076299699204682329507753694890665166631856015048882768; - RealPoles[2] = -0.062016051554856745489712385333682728202357092758651943221208; - RealPoles[3] = -0.0061077992746160882560927708014738068983721892883552093101361; - break; - case 10L: - RealPoles[0] = -0.65850232025797824268236835412538454392471957294049823149805; - RealPoles[1] = -0.268073111692664696090244736364513359311223180893644790376100; - RealPoles[2] = -0.086377390153589325877599225694789952508471024430869300205191; - RealPoles[3] = -0.0148944273821827884756957892122847609801573110427489810826383; - RealPoles[4] = -0.000287827212515962754748623276177592144223736764032594845958710; - break; - case 11L: - RealPoles[0] = -0.68065728168114552507405373070786114528043918248200630786792; - RealPoles[1] = -0.300332056088588604876865222180030612313181015580081525329237; - RealPoles[2] = -0.111312514706830149369412472075399334332922094176016717237651; - RealPoles[3] = -0.0269288910734721128228921792213836378705084951700165010332794; - RealPoles[4] = -0.00197961213746736842587514349996322223537646370088176083984645; - break; - default: - AllocateVector(&Polynomial, Degree + 1L, Status); - if (*Status == ERROR) { - FreeVector(&Polynomial); -/**/ DEBUG_WRITE_LEAVING(GetOmomsPoles, "Done") - return(*Status); - } - p = Polynomial; - for (i = -Degree / 2L; (i <= (Degree / 2L)); i++) { - *Status = Omoms(Degree, (double)i, p++); - if (*Status == ERROR) { - FreeVector(&Polynomial); -/**/ DEBUG_WRITE_LEAVING(GetOmomsPoles, "Done") - return(*Status); - } - } - AllocateVector(&AllPolesReal, Degree, Status); - if (*Status == ERROR) { - FreeVector(&Polynomial); -/**/ DEBUG_WRITE_LEAVING(GetOmomsPoles, "Done") - return(*Status); - } - PolynomialRealRoots(Polynomial, Degree, AllPolesReal, &PoleNumber, - Tolerance, Status); - if (*Status == ERROR) { - FreeVector(&AllPolesReal); - FreeVector(&Polynomial); -/**/ DEBUG_WRITE_LEAVING(GetOmomsPoles, "Done") - return(*Status); - } - *Status = FreeVector(&Polynomial); - if (*Status == ERROR) { - FreeVector(&AllPolesReal); -/**/ DEBUG_WRITE_LEAVING(GetOmomsPoles, "Done") - return(*Status); - } - for (i = -Degree / 2L; (i <= (Degree / 2L)); i++) { - if (*AllPolesReal < 0.0) { - *RealPoles++ = *AllPolesReal; - } - AllPolesReal++; - } - *Status = FreeVector(&AllPolesReal); - break; - } -/**/DEBUG_WRITE_LEAVING(GetOmomsPoles, "Done") - return(*Status); -} /* end GetOmomsPoles */ - diff --git a/src/core/bilib/getpoles.h b/src/core/bilib/getpoles.h deleted file mode 100644 index 004a570..0000000 --- a/src/core/bilib/getpoles.h +++ /dev/null @@ -1,33 +0,0 @@ -/**@defgroup BsplinePoles Poles of B-spline and Omom - @ingroup BilibLibrary */ -//@{ -/*--------------------------------------------------------------------------*/ -/** Get poles of B-spline. - Fill an array with the values of spline poles. - The number of returned poles is (Degree / 2L). - - success: return(!ERROR); failure: return(ERROR) -*/ -extern int GetBsplinePoles - ( - double RealPoles[], /* returned array of poles */ - long Degree, /* spline degree */ - double Tolerance, /* admissible relative error */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Get poles of Omom. - Fill an array with the values of oMoms poles. - The number of returned poles is (Degree / 2L). - - success: return(!ERROR); failure: return(ERROR) -*/ -extern int GetOmomsPoles - ( - double RealPoles[], /* returned array of poles */ - long Degree, /* oMoms degree */ - double Tolerance, /* admissible relative error */ - int *Status /* error management */ - ); -//@} diff --git a/src/core/bilib/getput.cc b/src/core/bilib/getput.cc deleted file mode 100644 index 866184e..0000000 --- a/src/core/bilib/getput.cc +++ /dev/null @@ -1,1309 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -#include -#include -#include -#include - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" -#include "error.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "convert.h" -#include "getput.h" -#include "messagedisplay.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -#ifdef DEBUG -#include -#endif - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern int AllocateLineDouble - ( - double *(Line[]), /* double output pointer */ - long LineLength, /* length of the line */ - int *Status /* error management */ - ) - -/* Allocates a 1D array of double */ -/* success: return(!ERROR); failure: return(ERROR) and set *Line to NULL */ -/* the returned value is duplicated in Status */ - -{ /* begin AllocateLineDouble */ - - *Status = !ERROR; - -/**/DEBUG_CHECK_RANGE_LONG(AllocateLineDouble, LineLength, 1L, LONG_MAX, *Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(AllocateLineDouble, *Status) -/**/DEBUG_WRITE_ENTERING(AllocateLineDouble, -/**/ "About to allocate a 1D array of double") -#ifdef DEBUG -/**/if (*Line != (double *)NULL) { -/**/ WRITE_WARNING(AllocateLineDouble, "Line may have been previously allocated") -/**/} -#endif - - *Line = (double *)malloc((size_t)(LineLength * (long)sizeof(double))); - if (*Line == (double *)NULL) { - *Status = ERROR; - WRITE_ERROR(AllocateLineDouble, "Unable to perform allocation") - } -/**/DEBUG_WRITE_LEAVING(AllocateLineDouble, "Done") - return(*Status); -} /* end AllocateLineDouble */ - -/*--------------------------------------------------------------------------*/ -extern int AllocateVolumeFloat - ( - float **Volume, /* float output pointer */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - int *Status /* error management */ - ) - -/* Allocates a 3D array of float */ -/* success: return(!ERROR); failure: return(ERROR) and set *Volume to NULL */ - -{ /* begin AllocateVolumeFloat */ - - *Status = !ERROR; - -/**/DEBUG_CHECK_RANGE_LONG(AllocateVolumeFloat, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(AllocateVolumeFloat, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(AllocateVolumeFloat, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(AllocateVolumeFloat, *Status) -/**/DEBUG_WRITE_ENTERING(AllocateVolumeFloat, -/**/ "About to allocate a 3D array of float") -#ifdef DEBUG -/**/if (*Volume != (float *)NULL) { -/**/ WRITE_WARNING(AllocateVolumeFloat, "Volume may have been previously allocated") -/**/} -#endif - - *Volume = (float *)malloc((size_t)(Nx * Ny * Nz * (long)sizeof(float))); - if (*Volume == (float *)NULL) { - *Status = ERROR; - WRITE_ERROR(AllocateVolumeFloat, "Unable to perform allocation") - } -/**/DEBUG_WRITE_LEAVING(AllocateVolumeFloat, "Done") - return(*Status); -} /* end AllocateVolumeFloat */ - -/*--------------------------------------------------------------------------*/ -extern int AllocateVolumeShort - ( - short **Volume, /* short output pointer */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - int *Status /* error management */ - ) - -/* Allocates a 3D array of short */ -/* success: return(!ERROR); failure: return(ERROR) and set Volume to NULL */ - -{ /* begin AllocateVolumeShort */ - - *Status = !ERROR; - -/**/DEBUG_CHECK_RANGE_LONG(AllocateVolumeShort, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(AllocateVolumeShort, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(AllocateVolumeShort, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(AllocateVolumeShort, *Status) -/**/DEBUG_WRITE_ENTERING(AllocateVolumeShort, -/**/ "About to allocate a 3D array of short") -#ifdef DEBUG -/**/if (*Volume != (short *)NULL) { -/**/ WRITE_WARNING(AllocateVolumeShort, "Volume may have been previously allocated") -/**/} -#endif - - *Volume = (short *)malloc((size_t)(Nx * Ny * Nz * (long)sizeof(short))); - if (*Volume == (short *)NULL) { - *Status = ERROR; - WRITE_ERROR(AllocateVolumeShort, "Unable to perform allocation") - } -/**/DEBUG_WRITE_LEAVING(AllocateVolumeShort, "Done") - return(*Status); -} /* end AllocateVolumeShort */ - -/*--------------------------------------------------------------------------*/ -extern int CopyFloatToFloat - ( - float *VolumeSource, /* float input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - float *VolumeDestination, /* float output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - long NxCopy, /* width of the block to copy */ - long NyCopy, /* height of the block to copy */ - long NzCopy /* depth of the block to copy */ - ) - -/* copies a sub-volume from a float input volume into a portion of a float output volume */ -/* input and output may not share their memory space */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin CopyFloatToFloat */ - - float *P, *Q; - const ptrdiff_t - NxNySource = (ptrdiff_t)(NxSource * NySource), - NxNyDestination = (ptrdiff_t)(NxDestination * NyDestination); - long Y, Z; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(CopyFloatToFloat, VolumeSource, Status, -/**/ "No input") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToFloat, NxSource, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToFloat, NySource, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToFloat, NzSource, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToFloat, XSource, 0L, NxSource - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToFloat, YSource, 0L, NySource - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToFloat, ZSource, 0L, NzSource - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_NULL_POINTER(CopyFloatToFloat, VolumeDestination, Status, -/**/ "No output") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToFloat, NxDestination, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToFloat, NyDestination, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToFloat, NzDestination, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToFloat, XDestination, 0L, NxDestination - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToFloat, YDestination, 0L, NyDestination - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToFloat, ZDestination, 0L, NzDestination - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToFloat, NxCopy, 1L, NxSource - XSource, Status, -/**/ "Invalid width (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToFloat, NyCopy, 1L, NySource - YSource, Status, -/**/ "Invalid height (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToFloat, NzCopy, 1L, NzSource - ZSource, Status, -/**/ "Invalid depth (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToFloat, NxCopy, 1L, NxDestination - XDestination, Status, -/**/ "Invalid width (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToFloat, NyCopy, 1L, NyDestination - YDestination, Status, -/**/ "Invalid height (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToFloat, NzCopy, 1L, NzDestination - ZDestination, Status, -/**/ "Invalid depth (negative or excessive)") -/**/DEBUG_RETURN_ON_ERROR(CopyFloatToFloat, Status) -/**/DEBUG_WRITE_ENTERING(CopyFloatToFloat, -/**/ "About to copy a float subvolume into a float subvolume") -#ifdef DEBUG -/**/if (((VolumeSource + (ptrdiff_t)(NxSource * NySource * NzSource)) -/**/ > (VolumeDestination + (ptrdiff_t)(XDestination + NxDestination -/**/ * (YDestination + NyDestination * ZDestination)))) -/**/ && ((VolumeDestination + (ptrdiff_t)(NxDestination * NyDestination -/**/ * NzDestination)) > (VolumeSource + (ptrdiff_t)(XSource + NxSource -/**/ * (YSource + NySource * ZSource))))) { -/**/ WRITE_WARNING(CopyFloatToFloat, "Data overlap: memcpy may fail") -/**/} -#endif - - VolumeSource += (ptrdiff_t)(XSource + NxSource * (YSource + NySource * ZSource)); - VolumeDestination += (ptrdiff_t)(XDestination + NxDestination * (YDestination - + NyDestination * ZDestination)); - for (Z = -NzCopy; (Z < 0L); Z++) { - P = VolumeSource; - Q = VolumeDestination; - for (Y = -NyCopy; (Y < 0L); Y++) { - Q = (float *)memcpy(Q, P, (size_t)(NxCopy * (long)sizeof(float))); - P += (ptrdiff_t)NxSource; - Q += (ptrdiff_t)NxDestination; - } - VolumeSource += NxNySource; - VolumeDestination += NxNyDestination; - } -/**/DEBUG_WRITE_LEAVING(CopyFloatToFloat, "Done") - return(Status); -} /* end CopyFloatToFloat */ - -/*--------------------------------------------------------------------------*/ -extern int CopyFloatToShort - ( - float *VolumeSource, /* float input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - short *VolumeDestination, /* short output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - long NxCopy, /* width of the block to copy */ - long NyCopy, /* height of the block to copy */ - long NzCopy /* depth of the block to copy */ - ) - -/* copies a sub-volume from a float input volume into a portion of a short output volume */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin CopyFloatToShort */ - - float *P; - short *Q; - const ptrdiff_t - IgnoredDestination = (ptrdiff_t)(NxDestination - NxCopy), - IgnoredSource = (ptrdiff_t)(NxSource - NxCopy), - NxNyDestination = (ptrdiff_t)(NxDestination * NyDestination), - NxNySource = (ptrdiff_t)(NxSource * NySource); - long X, Y, Z; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(CopyFloatToShort, VolumeSource, Status, -/**/ "No input") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToShort, NxSource, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToShort, NySource, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToShort, NzSource, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToShort, XSource, 0L, NxSource - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToShort, YSource, 0L, NySource - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToShort, ZSource, 0L, NzSource - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_NULL_POINTER(CopyFloatToShort, VolumeDestination, Status, -/**/ "No output") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToShort, NxDestination, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToShort, NyDestination, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToShort, NzDestination, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToShort, XDestination, 0L, NxDestination - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToShort, YDestination, 0L, NyDestination - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToShort, ZDestination, 0L, NzDestination - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToShort, NxCopy, 1L, NxSource - XSource, Status, -/**/ "Invalid width (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToShort, NyCopy, 1L, NySource - YSource, Status, -/**/ "Invalid height (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToShort, NzCopy, 1L, NzSource - ZSource, Status, -/**/ "Invalid depth (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToShort, NxCopy, 1L, NxDestination - XDestination, Status, -/**/ "Invalid width (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToShort, NyCopy, 1L, NyDestination - YDestination, Status, -/**/ "Invalid height (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToShort, NzCopy, 1L, NzDestination - ZDestination, Status, -/**/ "Invalid depth (negative or excessive)") -/**/DEBUG_RETURN_ON_ERROR(CopyFloatToShort, Status) -/**/DEBUG_WRITE_ENTERING(CopyFloatToShort, -/**/ "About to copy a float subvolume into a short subvolume") - - VolumeSource += (ptrdiff_t)(XSource + NxSource * (YSource + NySource * ZSource)); - VolumeDestination += (ptrdiff_t)(XDestination + NxDestination * (YDestination - + NyDestination * ZDestination)); - for (Z = -NzCopy; (Z < 0L); Z++) { - P = VolumeSource; - Q = VolumeDestination; - for (Y = -NyCopy; (Y < 0L); Y++) { - for (X = -NxCopy; (X < 0L); X++) { - *Q++ = ConvertFloatToShort(*P++); - } - P += IgnoredSource; - Q += IgnoredDestination; - } - VolumeSource += NxNySource; - VolumeDestination += NxNyDestination; - } -/**/DEBUG_WRITE_LEAVING(CopyFloatToShort, "Done") - return(Status); -} /* end CopyFloatToShort */ - -/*--------------------------------------------------------------------------*/ -extern int CopyShortToFloat - ( - short *VolumeSource, /* short input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - float *VolumeDestination, /* float output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - long NxCopy, /* width of the block to copy */ - long NyCopy, /* height of the block to copy */ - long NzCopy /* depth of the block to copy */ - ) - -/* copies a sub-volume from a short input volume into a portion of a float output volume */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin CopyShortToFloat */ - - float *Q; - short *P; - const ptrdiff_t - IgnoredDestination = (ptrdiff_t)(NxDestination - NxCopy), - IgnoredSource = (ptrdiff_t)(NxSource - NxCopy), - NxNyDestination = (ptrdiff_t)(NxDestination * NyDestination), - NxNySource = (ptrdiff_t)(NxSource * NySource); - long X, Y, Z; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(CopyShortToFloat, VolumeSource, Status, -/**/ "No input") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToFloat, NxSource, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToFloat, NySource, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToFloat, NzSource, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToFloat, XSource, 0L, NxSource - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToFloat, YSource, 0L, NySource - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToFloat, ZSource, 0L, NzSource - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_NULL_POINTER(CopyShortToFloat, VolumeDestination, Status, -/**/ "No output") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToFloat, NxDestination, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToFloat, NyDestination, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToFloat, NzDestination, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToFloat, XDestination, 0L, NxDestination - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToFloat, YDestination, 0L, NyDestination - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToFloat, ZDestination, 0L, NzDestination - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToFloat, NxCopy, 1L, NxSource - XSource, Status, -/**/ "Invalid width (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToFloat, NyCopy, 1L, NySource - YSource, Status, -/**/ "Invalid height (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToFloat, NzCopy, 1L, NzSource - ZSource, Status, -/**/ "Invalid depth (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToFloat, NxCopy, 1L, NxDestination - XDestination, Status, -/**/ "Invalid width (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToFloat, NyCopy, 1L, NyDestination - YDestination, Status, -/**/ "Invalid height (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToFloat, NzCopy, 1L, NzDestination - ZDestination, Status, -/**/ "Invalid depth (negative or excessive)") -/**/DEBUG_RETURN_ON_ERROR(CopyShortToFloat, Status) -/**/DEBUG_WRITE_ENTERING(CopyShortToFloat, -/**/ "About to copy a short subvolume into a float subvolume") - - VolumeSource += (ptrdiff_t)(XSource + NxSource * (YSource + NySource * ZSource)); - VolumeDestination += (ptrdiff_t)(XDestination + NxDestination * (YDestination - + NyDestination * ZDestination)); - for (Z = -NzCopy; (Z < 0L); Z++) { - P = VolumeSource; - Q = VolumeDestination; - for (Y = -NyCopy; (Y < 0L); Y++) { - for (X = -NxCopy; (X < 0L); X++) { - *Q++ = (float)*P++; - } - P += IgnoredSource; - Q += IgnoredDestination; - } - VolumeSource += NxNySource; - VolumeDestination += NxNyDestination; - } -/**/DEBUG_WRITE_LEAVING(CopyShortToFloat, "Done") - return(Status); -} /* end CopyShortToFloat */ - -/*--------------------------------------------------------------------------*/ -extern int CopyShortToShort - ( - short *VolumeSource, /* short input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - short *VolumeDestination, /* short output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - long NxCopy, /* width of the block to copy */ - long NyCopy, /* height of the block to copy */ - long NzCopy /* depth of the block to copy */ - ) - -/* copies a sub-volume from a short input volume into a portion of a short output volume */ -/* input and output may not share their memory space */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin CopyShortToShort */ - - short *P, *Q; - const ptrdiff_t - NxNySource = (ptrdiff_t)(NxSource * NySource), - NxNyDestination = (ptrdiff_t)(NxDestination * NyDestination); - long Y, Z; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(CopyShortToShort, VolumeSource, Status, -/**/ "No input") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToShort, NxSource, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToShort, NySource, 1L, LONG_MAX, Status, -/**/ "Invalid heigth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToShort, NzSource, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToShort, XSource, 0L, NxSource - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToShort, YSource, 0L, NySource - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToShort, ZSource, 0L, NzSource - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_NULL_POINTER(CopyShortToShort, VolumeDestination, Status, -/**/ "No output") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToShort, NxDestination, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToShort, NyDestination, 1L, LONG_MAX, Status, -/**/ "Invalid heigth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToShort, NzDestination, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToShort, XDestination, 0L, NxDestination - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToShort, YDestination, 0L, NyDestination - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToShort, ZDestination, 0L, NzDestination - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToShort, NxCopy, 1L, NxSource - XSource, Status, -/**/ "Invalid width (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToShort, NyCopy, 1L, NySource - YSource, Status, -/**/ "Invalid height (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToShort, NzCopy, 1L, NzSource - ZSource, Status, -/**/ "Invalid depth (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToShort, NxCopy, 1L, NxDestination - XDestination, Status, -/**/ "Invalid width (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToShort, NyCopy, 1L, NyDestination - YDestination, Status, -/**/ "Invalid height (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyShortToShort, NzCopy, 1L, NzDestination - ZDestination, Status, -/**/ "Invalid depth (negative or excessive)") -/**/DEBUG_RETURN_ON_ERROR(CopyShortToShort, Status) -/**/DEBUG_WRITE_ENTERING(CopyShortToShort, -/**/ "About to copy a short subvolume into a short subvolume") -#ifdef DEBUG -/**/if (((VolumeSource + (ptrdiff_t)(NxSource * NySource * NzSource)) -/**/ > (VolumeDestination + (ptrdiff_t)(XDestination + NxDestination -/**/ * (YDestination + NyDestination * ZDestination)))) -/**/ && ((VolumeDestination + (ptrdiff_t)(NxDestination * NyDestination -/**/ * NzDestination)) > (VolumeSource + (ptrdiff_t)(XSource + NxSource -/**/ * (YSource + NySource * ZSource))))) { -/**/ WRITE_WARNING(CopyShortToShort, "Data overlap: memcpy may fail") -/**/} -#endif - - VolumeSource += (ptrdiff_t)(XSource + NxSource * (YSource + NySource * ZSource)); - VolumeDestination += (ptrdiff_t)(XDestination + NxDestination * (YDestination - + NyDestination * ZDestination)); - for (Z = -NzCopy; (Z < 0L); Z++) { - P = VolumeSource; - Q = VolumeDestination; - for (Y = -NyCopy; (Y < 0L); Y++) { - Q = (short *)memcpy(Q, P, (size_t)(NxCopy * (long)sizeof(short))); - P += (ptrdiff_t)NxSource; - Q += (ptrdiff_t)NxDestination; - } - VolumeSource += NxNySource; - VolumeDestination += NxNyDestination; - } -/**/DEBUG_WRITE_LEAVING(CopyShortToShort, "Done") - return(Status); -} /* end CopyShortToShort */ - -/*--------------------------------------------------------------------------*/ -extern int FreeLineDouble - ( - double *(Line[]) /* 1D double array */ - ) - -/* Frees a 1D array of double */ -/* success: return(!ERROR) and set *Line to NULL; failure: return(ERROR); */ - -{ /* begin FreeLineDouble */ - - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(FreeLineDouble, *Line, Status, -/**/ "Nothing to free") -/**/DEBUG_RETURN_ON_ERROR(FreeLineDouble, Status) -/**/DEBUG_WRITE_ENTERING(FreeLineDouble, -/**/ "About to free a 1D array of double") - - free(*Line); - *Line = (double *)NULL; -/**/DEBUG_WRITE_LEAVING(FreeLineDouble, "Done") - return(Status); -} /* end FreeLineDouble */ - -/*--------------------------------------------------------------------------*/ -extern int FreeVolumeFloat - ( - float **Volume /* 3D float array */ - ) - -/* Frees a 3D array of float */ -/* success: return(!ERROR) and set *Volume to NULL; failure: return(ERROR); */ - -{ /* begin FreeVolumeFloat */ - - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(FreeVolumeFloat, *Volume, Status, -/**/ "Nothing to free") -/**/DEBUG_RETURN_ON_ERROR(FreeVolumeFloat, Status) -/**/DEBUG_WRITE_ENTERING(FreeVolumeFloat, -/**/ "About to free a 3D array of float") - - free(*Volume); - *Volume = (float *)NULL; -/**/DEBUG_WRITE_LEAVING(FreeVolumeFloat, "Done") - return(Status); -} /* end FreeVolumeFloat */ - -/*--------------------------------------------------------------------------*/ -extern int FreeVolumeShort - ( - short **Volume /* 3D short array */ - ) - -/* Frees a 3D array of short */ -/* success: return(!ERROR) and set Volume to NULL; failure: return(ERROR); */ - -{ /* begin FreeVolumeShort */ - - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(FreeVolumeShort, *Volume, Status, -/**/ "Nothing to free") -/**/DEBUG_RETURN_ON_ERROR(FreeVolumeShort, Status) -/**/DEBUG_WRITE_ENTERING(FreeVolumeShort, -/**/ "About to free a 3D array of short") - - free(*Volume); - *Volume = (short *)NULL; -/**/DEBUG_WRITE_LEAVING(FreeVolumeShort, "Done") - return(Status); -} /* end FreeVolumeShort */ - -/*--------------------------------------------------------------------------*/ -extern int GetxFloatToDouble - ( - float *VolumeSource, /* float input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - double RowDestination[], /* double output data */ - long NxCopy /* length of the output */ - ) - -/* copies a horizontal line from a float input volume into a 1D double output array */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin GetxFloatToDouble */ - - double *End; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(GetxFloatToDouble, VolumeSource, Status, -/**/ "No input volume") -/**/DEBUG_CHECK_RANGE_LONG(GetxFloatToDouble, NxSource, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(GetxFloatToDouble, NySource, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(GetxFloatToDouble, NzSource, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(GetxFloatToDouble, XSource, 0L, NxSource - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(GetxFloatToDouble, YSource, 0L, NySource - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(GetxFloatToDouble, ZSource, 0L, NzSource - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_NULL_POINTER(GetxFloatToDouble, RowDestination, Status, -/**/ "No output line") -/**/DEBUG_CHECK_RANGE_LONG(GetxFloatToDouble, NxCopy, 1L, NxSource - XSource, Status, -/**/ "Invalid width (negative or excessive)") -/**/DEBUG_RETURN_ON_ERROR(GetxFloatToDouble, Status) -/**/DEBUG_WRITE_ENTERING(GetxFloatToDouble, -/**/ "About to get a (double)row from a (float)volume") - - VolumeSource += (ptrdiff_t)(XSource + NxSource * (YSource + NySource * ZSource)); - End = RowDestination + (ptrdiff_t)NxCopy; - while (RowDestination < End) { - *RowDestination++ = (double)*VolumeSource++; - } -/**/DEBUG_WRITE_LEAVING(GetxFloatToDouble, "Done") - return(Status); -} /* end GetxFloatToDouble */ - -/*--------------------------------------------------------------------------*/ -extern int GetxShortToDouble - ( - short *VolumeSource, /* short input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - double RowDestination[], /* double output data */ - long NxCopy /* length of the output */ - ) - -/* copies a horizontal line from a short input volume into a 1D double output array */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin GetxShortToDouble */ - - double *End; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(GetxShortToDouble, VolumeSource, Status, -/**/ "No input volume") -/**/DEBUG_CHECK_RANGE_LONG(GetxShortToDouble, NxSource, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(GetxShortToDouble, NySource, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(GetxShortToDouble, NzSource, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(GetxShortToDouble, XSource, 0L, NxSource - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(GetxShortToDouble, YSource, 0L, NySource - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(GetxShortToDouble, ZSource, 0L, NzSource - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_NULL_POINTER(GetxShortToDouble, RowDestination, Status, -/**/ "No output line") -/**/DEBUG_CHECK_RANGE_LONG(GetxShortToDouble, NxCopy, 1L, NxSource - XSource, Status, -/**/ "Invalid width (negative or excessive)") -/**/DEBUG_RETURN_ON_ERROR(GetxShortToDouble, Status) -/**/DEBUG_WRITE_ENTERING(GetxShortToDouble, -/**/ "About to get a (double)row from a (short)volume") - - VolumeSource += (ptrdiff_t)(XSource + NxSource * (YSource + NySource * ZSource)); - End = RowDestination + (ptrdiff_t)NxCopy; - while (RowDestination < End) { - *RowDestination++ = (double)*VolumeSource++; - } -/**/DEBUG_WRITE_LEAVING(GetxShortToDouble, "Done") - return(Status); -} /* end GetxShortToDouble */ - -/*--------------------------------------------------------------------------*/ -extern int GetyFloatToDouble - ( - float *VolumeSource, /* float input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - double ColumnDestination[],/* double output data */ - long NyCopy /* length of the output */ - ) - -/* copies a vertical line from a float input volume into a 1D double output array */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin GetyFloatToDouble */ - - double *End; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(GetyFloatToDouble, VolumeSource, Status, -/**/ "No input volume") -/**/DEBUG_CHECK_RANGE_LONG(GetyFloatToDouble, NxSource, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(GetyFloatToDouble, NySource, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(GetyFloatToDouble, NzSource, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(GetyFloatToDouble, XSource, 0L, NxSource - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(GetyFloatToDouble, YSource, 0L, NySource - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(GetyFloatToDouble, ZSource, 0L, NzSource - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_NULL_POINTER(GetyFloatToDouble, ColumnDestination, Status, -/**/ "No output line") -/**/DEBUG_CHECK_RANGE_LONG(GetyFloatToDouble, NyCopy, 1L, NySource - YSource, Status, -/**/ "Invalid height (negative or excessive)") -/**/DEBUG_RETURN_ON_ERROR(GetyFloatToDouble, Status) -/**/DEBUG_WRITE_ENTERING(GetyFloatToDouble, -/**/ "About to get a (double)column from a (float)volume") - - VolumeSource += (ptrdiff_t)(XSource + NxSource * (YSource + NySource * ZSource)); - End = ColumnDestination + (ptrdiff_t)NyCopy; - while (ColumnDestination < End) { - *ColumnDestination++ = (double)*VolumeSource; - VolumeSource += NxSource; - } -/**/DEBUG_WRITE_LEAVING(GetyFloatToDouble, "Done") - return(Status); -} /* end GetyFloatToDouble */ - -/*--------------------------------------------------------------------------*/ -extern int GetyShortToDouble - ( - short *VolumeSource, /* short input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - double ColumnDestination[],/* double output data */ - long NyCopy /* length of the output */ - ) - -/* copies a vertical line from a short input volume into a 1D double output array */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin GetyShortToDouble */ - - double *End; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(GetyShortToDouble, VolumeSource, Status, -/**/ "No input volume") -/**/DEBUG_CHECK_RANGE_LONG(GetyShortToDouble, NxSource, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(GetyShortToDouble, NySource, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(GetyShortToDouble, NzSource, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(GetyShortToDouble, XSource, 0L, NxSource - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(GetyShortToDouble, YSource, 0L, NySource - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(GetyShortToDouble, ZSource, 0L, NzSource - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_NULL_POINTER(GetyShortToDouble, ColumnDestination, Status, -/**/ "No output line") -/**/DEBUG_CHECK_RANGE_LONG(GetyShortToDouble, NyCopy, 1L, NySource - YSource, Status, -/**/ "Invalid height (negative or excessive)") -/**/DEBUG_RETURN_ON_ERROR(GetyShortToDouble, Status) -/**/DEBUG_WRITE_ENTERING(GetyShortToDouble, -/**/ "About to get a (double)column from a (short)volume") - - VolumeSource += (ptrdiff_t)(XSource + NxSource * (YSource + NySource * ZSource)); - End = ColumnDestination + (ptrdiff_t)NyCopy; - while (ColumnDestination < End) { - *ColumnDestination++ = (double)*VolumeSource; - VolumeSource += NxSource; - } -/**/DEBUG_WRITE_LEAVING(GetyShortToDouble, "Done") - return(Status); -} /* end GetyShortToDouble */ - -/*--------------------------------------------------------------------------*/ -extern int GetzFloatToDouble - ( - float *VolumeSource, /* float input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - double PillarDestination[],/* double output data */ - long NzCopy /* length of the output */ - ) - -/* copies a line perpendicular to the screen from a float input volume into a 1D double output array */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin GetzFloatToDouble */ - - double *End; - const ptrdiff_t - NxNySource = (ptrdiff_t)(NxSource * NySource); - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(GetzFloatToDouble, VolumeSource, Status, -/**/ "No input volume") -/**/DEBUG_CHECK_RANGE_LONG(GetzFloatToDouble, NxSource, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(GetzFloatToDouble, NySource, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(GetzFloatToDouble, NzSource, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(GetzFloatToDouble, XSource, 0L, NxSource - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(GetzFloatToDouble, YSource, 0L, NySource - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(GetzFloatToDouble, ZSource, 0L, NzSource - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_NULL_POINTER(GetzFloatToDouble, PillarDestination, Status, -/**/ "No output line") -/**/DEBUG_CHECK_RANGE_LONG(GetzFloatToDouble, NzCopy, 1L, NzSource - ZSource, Status, -/**/ "Invalid depth (negative or excessive)") -/**/DEBUG_RETURN_ON_ERROR(GetzFloatToDouble, Status) -/**/DEBUG_WRITE_ENTERING(GetzFloatToDouble, -/**/ "About to get a (double)pillar from a (float)volume") - - VolumeSource += (ptrdiff_t)(XSource + NxSource * (YSource + NySource * ZSource)); - End = PillarDestination + (ptrdiff_t)NzCopy; - while (PillarDestination < End) { - *PillarDestination++ = (double)*VolumeSource; - VolumeSource += NxNySource; - } -/**/DEBUG_WRITE_LEAVING(GetzFloatToDouble, "Done") - return(Status); -} /* end GetzFloatToDouble */ - -/*--------------------------------------------------------------------------*/ -extern int GetzShortToDouble - ( - short *VolumeSource, /* short input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - double PillarDestination[],/* double output data */ - long NzCopy /* length of the output */ - ) - -/* copies a line perpendicular to the screen from a short input volume into a 1D double output array */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin GetzShortToDouble */ - - double *End; - const ptrdiff_t - NxNySource = (ptrdiff_t)(NxSource * NySource); - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(GetzShortToDouble, VolumeSource, Status, -/**/ "No input volume") -/**/DEBUG_CHECK_RANGE_LONG(GetzShortToDouble, NxSource, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(GetzShortToDouble, NySource, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(GetzShortToDouble, NzSource, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(GetzShortToDouble, XSource, 0L, NxSource - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(GetzShortToDouble, YSource, 0L, NySource - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(GetzShortToDouble, ZSource, 0L, NzSource - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_NULL_POINTER(GetzShortToDouble, PillarDestination, Status, -/**/ "No output line") -/**/DEBUG_CHECK_RANGE_LONG(GetzShortToDouble, NzCopy, 1L, NzSource - ZSource, Status, -/**/ "Invalid depth (negative or excessive)") -/**/DEBUG_RETURN_ON_ERROR(GetzShortToDouble, Status) -/**/DEBUG_WRITE_ENTERING(GetzShortToDouble, -/**/ "About to get a (double)pillar from a (short)volume") - - VolumeSource += (ptrdiff_t)(XSource + NxSource * (YSource + NySource * ZSource)); - End = PillarDestination + (ptrdiff_t)NzCopy; - while (PillarDestination < End) { - *PillarDestination++ = (double)*VolumeSource; - VolumeSource += NxNySource; - } -/**/DEBUG_WRITE_LEAVING(GetzShortToDouble, "Done") - return(Status); -} /* end GetzShortToDouble */ - -/*--------------------------------------------------------------------------*/ -extern int PutxDoubleToFloat - ( - float *VolumeDestination, /* float output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - double RowSource[], /* double input data */ - long NxCopy /* length of the input */ - ) - -/* copies a 1D double input array into a horizontal line of a float output volume */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin PutxDoubleToFloat */ - - double *End; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(PutxDoubleToFloat, VolumeDestination, Status, -/**/ "No output volume") -/**/DEBUG_CHECK_RANGE_LONG(PutxDoubleToFloat, NxDestination, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(PutxDoubleToFloat, NyDestination, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(PutxDoubleToFloat, NzDestination, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(PutxDoubleToFloat, XDestination, 0L, NxDestination - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(PutxDoubleToFloat, YDestination, 0L, NyDestination - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(PutxDoubleToFloat, ZDestination, 0L, NzDestination - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_NULL_POINTER(PutxDoubleToFloat, RowSource, Status, -/**/ "No output line") -/**/DEBUG_CHECK_RANGE_LONG(PutxDoubleToFloat, NxCopy, 1L, NxDestination - XDestination, Status, -/**/ "Invalid width (negative or excessive)") -/**/DEBUG_RETURN_ON_ERROR(PutxDoubleToFloat, Status) -/**/DEBUG_WRITE_ENTERING(PutxDoubleToFloat, -/**/ "About to put a (double)row into a (float)volume") - - VolumeDestination += (ptrdiff_t)(XDestination + NxDestination * (YDestination - + NyDestination * ZDestination)); - End = RowSource + (ptrdiff_t)NxCopy; - while (RowSource < End) { - *VolumeDestination++ = ConvertDoubleToFloat(*RowSource++); - } -/**/DEBUG_WRITE_LEAVING(PutxDoubleToFloat, "Done") - return(Status); -} /* end PutxDoubleToFloat */ - -/*--------------------------------------------------------------------------*/ -extern int PutxDoubleToShort - ( - short *VolumeDestination, /* short output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - double RowSource[], /* double input data */ - long NxCopy /* length of the input */ - ) - -/* copies a 1D double input array into a horizontal line of a short output volume */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin PutxDoubleToShort */ - - double *End; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(PutxDoubleToShort, VolumeDestination, Status, -/**/ "No output volume") -/**/DEBUG_CHECK_RANGE_LONG(PutxDoubleToShort, NxDestination, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(PutxDoubleToShort, NyDestination, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(PutxDoubleToShort, NzDestination, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(PutxDoubleToShort, XDestination, 0L, NxDestination - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(PutxDoubleToShort, YDestination, 0L, NyDestination - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(PutxDoubleToShort, ZDestination, 0L, NzDestination - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_NULL_POINTER(PutxDoubleToShort, RowSource, Status, -/**/ "No output line") -/**/DEBUG_CHECK_RANGE_LONG(PutxDoubleToShort, NxCopy, 1L, NxDestination - XDestination, Status, -/**/ "Invalid width (negative or excessive)") -/**/DEBUG_RETURN_ON_ERROR(PutxDoubleToShort, Status) -/**/DEBUG_WRITE_ENTERING(PutxDoubleToShort, -/**/ "About to put a (double)row into a (short)volume") - - VolumeDestination += (ptrdiff_t)(XDestination + NxDestination * (YDestination - + NyDestination * ZDestination)); - End = RowSource + (ptrdiff_t)NxCopy; - while (RowSource < End) { - *VolumeDestination++ = ConvertDoubleToShort(*RowSource++); - } -/**/DEBUG_WRITE_LEAVING(PutxDoubleToShort, "Done") - return(Status); -} /* end PutxDoubleToShort */ - -/*--------------------------------------------------------------------------*/ -extern int PutyDoubleToFloat - ( - float *VolumeDestination, /* float output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - double ColumnSource[], /* double input data */ - long NyCopy /* length of the input */ - ) - -/* copies a 1D double input array into a vertical line of a float output volume */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin PutyDoubleToFloat */ - - double *End; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(PutyDoubleToFloat, VolumeDestination, Status, -/**/ "No output volume") -/**/DEBUG_CHECK_RANGE_LONG(PutyDoubleToFloat, NxDestination, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(PutyDoubleToFloat, NyDestination, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(PutyDoubleToFloat, NzDestination, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(PutyDoubleToFloat, XDestination, 0L, NxDestination - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(PutyDoubleToFloat, YDestination, 0L, NyDestination - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(PutyDoubleToFloat, ZDestination, 0L, NzDestination - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_NULL_POINTER(PutyDoubleToFloat, ColumnSource, Status, -/**/ "No output line") -/**/DEBUG_CHECK_RANGE_LONG(PutyDoubleToFloat, NyCopy, 1L, NyDestination - YDestination, Status, -/**/ "Invalid height (negative or excessive)") -/**/DEBUG_RETURN_ON_ERROR(PutyDoubleToFloat, Status) -/**/DEBUG_WRITE_ENTERING(PutyDoubleToFloat, -/**/ "About to put a (double)column into a (float)volume") - - VolumeDestination += (ptrdiff_t)(XDestination + NxDestination * (YDestination - + NyDestination * ZDestination)); - End = ColumnSource + (ptrdiff_t)NyCopy; - while (ColumnSource < End) { - *VolumeDestination = ConvertDoubleToFloat(*ColumnSource++); - VolumeDestination += NxDestination; - } -/**/DEBUG_WRITE_LEAVING(PutyDoubleToFloat, "Done") - return(Status); -} /* end PutyDoubleToFloat */ - -/*--------------------------------------------------------------------------*/ -extern int PutyDoubleToShort - ( - short *VolumeDestination, /* short output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - double ColumnSource[], /* double input data */ - long NyCopy /* length of the input */ - ) - -/* copies a 1D double input array into a vertical line of a short output volume */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin PutyDoubleToShort */ - - double *End; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(PutyDoubleToShort, VolumeDestination, Status, -/**/ "No output volume") -/**/DEBUG_CHECK_RANGE_LONG(PutyDoubleToShort, NxDestination, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(PutyDoubleToShort, NyDestination, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(PutyDoubleToShort, NzDestination, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(PutyDoubleToShort, XDestination, 0L, NxDestination - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(PutyDoubleToShort, YDestination, 0L, NyDestination - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(PutyDoubleToShort, ZDestination, 0L, NzDestination - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_NULL_POINTER(PutyDoubleToShort, ColumnSource, Status, -/**/ "No output line") -/**/DEBUG_CHECK_RANGE_LONG(PutyDoubleToShort, NyCopy, 1L, NyDestination - YDestination, Status, -/**/ "Invalid height (negative or excessive)") -/**/DEBUG_RETURN_ON_ERROR(PutyDoubleToShort, Status) -/**/DEBUG_WRITE_ENTERING(PutyDoubleToShort, -/**/ "About to put a (double)column into a (short)volume") - - VolumeDestination += (ptrdiff_t)(XDestination + NxDestination * (YDestination - + NyDestination * ZDestination)); - End = ColumnSource + (ptrdiff_t)NyCopy; - while (ColumnSource < End) { - *VolumeDestination = ConvertDoubleToShort(*ColumnSource++); - VolumeDestination += NxDestination; - } -/**/DEBUG_WRITE_LEAVING(PutyDoubleToShort, "Done") - return(Status); -} /* end PutyDoubleToShort */ - -/*--------------------------------------------------------------------------*/ -extern int PutzDoubleToFloat - ( - float *VolumeDestination, /* float output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - double PillarSource[], /* double input data */ - long NzCopy /* length of the input */ - ) - -/* copies a 1D double input array into a line perpendicular to the screen of a float output volume */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin PutzDoubleToFloat */ - - double *End; - const ptrdiff_t - NxNyDestination = (ptrdiff_t)(NxDestination * NyDestination); - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(PutzDoubleToFloat, VolumeDestination, Status, -/**/ "No output volume") -/**/DEBUG_CHECK_RANGE_LONG(PutzDoubleToFloat, NxDestination, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(PutzDoubleToFloat, NyDestination, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(PutzDoubleToFloat, NzDestination, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(PutzDoubleToFloat, XDestination, 0L, NxDestination - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(PutzDoubleToFloat, YDestination, 0L, NyDestination - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(PutzDoubleToFloat, ZDestination, 0L, NzDestination - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_NULL_POINTER(PutzDoubleToFloat, PillarSource, Status, -/**/ "No output line") -/**/DEBUG_CHECK_RANGE_LONG(PutzDoubleToFloat, NzCopy, 1L, NzDestination - ZDestination, Status, -/**/ "Invalid depth (negative or excessive)") -/**/DEBUG_RETURN_ON_ERROR(PutzDoubleToFloat, Status) -/**/DEBUG_WRITE_ENTERING(PutzDoubleToFloat, -/**/ "About to put a (double)pillar into a (float)volume") - - VolumeDestination += (ptrdiff_t)(XDestination + NxDestination * (YDestination - + NyDestination * ZDestination)); - End = PillarSource + (ptrdiff_t)NzCopy; - while (PillarSource < End) { - *VolumeDestination = ConvertDoubleToFloat(*PillarSource++); - VolumeDestination += NxNyDestination; - } -/**/DEBUG_WRITE_LEAVING(PutzDoubleToFloat, "Done") - return(Status); -} /* end PutzDoubleToFloat */ - -/*--------------------------------------------------------------------------*/ -extern int PutzDoubleToShort - ( - short *VolumeDestination, /* short output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - double PillarSource[], /* double input data */ - long NzCopy /* length of the input */ - ) - -/* copies a 1D double input array into a line perpendicular to the screen of a short output volume */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin PutzDoubleToShort */ - - double *End; - const ptrdiff_t - NxNyDestination = (ptrdiff_t)(NxDestination * NyDestination); - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(PutzDoubleToShort, VolumeDestination, Status, -/**/ "No output volume") -/**/DEBUG_CHECK_RANGE_LONG(PutzDoubleToShort, NxDestination, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(PutzDoubleToShort, NyDestination, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(PutzDoubleToShort, NzDestination, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(PutzDoubleToShort, XDestination, 0L, NxDestination - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(PutzDoubleToShort, YDestination, 0L, NyDestination - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(PutzDoubleToShort, ZDestination, 0L, NzDestination - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_NULL_POINTER(PutzDoubleToShort, PillarSource, Status, -/**/ "No output line") -/**/DEBUG_CHECK_RANGE_LONG(PutzDoubleToShort, NzCopy, 1L, NzDestination - ZDestination, Status, -/**/ "Invalid depth (negative or excessive)") -/**/DEBUG_RETURN_ON_ERROR(PutzDoubleToShort, Status) -/**/DEBUG_WRITE_ENTERING(PutzDoubleToShort, -/**/ "About to put a (double)pillar into a (short)volume") - - VolumeDestination += (ptrdiff_t)(XDestination + NxDestination * (YDestination - + NyDestination * ZDestination)); - End = PillarSource + (ptrdiff_t)NzCopy; - while (PillarSource < End) { - *VolumeDestination = ConvertDoubleToShort(*PillarSource++); - VolumeDestination += NxNyDestination; - } -/**/DEBUG_WRITE_LEAVING(PutzDoubleToShort, "Done") - return(Status); -} /* end PutzDoubleToShort */ - diff --git a/src/core/bilib/getput.h b/src/core/bilib/getput.h deleted file mode 100644 index 55ccdd9..0000000 --- a/src/core/bilib/getput.h +++ /dev/null @@ -1,302 +0,0 @@ -/*--------------------------------------------------------------------------*/ -extern int AllocateLineDouble - ( - double *(Line[]), /* double output pointer */ - long LineLength, /* length of the line */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -extern int AllocateVolumeFloat - ( - float **Volume, /* float output pointer */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -extern int AllocateVolumeShort - ( - short **Volume, /* short output pointer */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -extern int CopyFloatToFloat - ( - float *VolumeSource, /* float input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - float *VolumeDestination, /* float output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - long NxCopy, /* width of the block to copy */ - long NyCopy, /* height of the block to copy */ - long NzCopy /* depth of the block to copy */ - ); - -/*--------------------------------------------------------------------------*/ -extern int CopyFloatToShort - ( - float *VolumeSource, /* float input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - short *VolumeDestination, /* short output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - long NxCopy, /* width of block to copy */ - long NyCopy, /* height of block to copy */ - long NzCopy /* depth of the block to copy */ - ); - -/*--------------------------------------------------------------------------*/ -extern int CopyShortToFloat - ( - short *VolumeSource, /* short input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - float *VolumeDestination, /* float output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - long NxCopy, /* width of block to copy */ - long NyCopy, /* height of block to copy */ - long NzCopy /* depth of the block to copy */ - ); - -/*--------------------------------------------------------------------------*/ -extern int CopyShortToShort - ( - short *VolumeSource, /* short input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - short *VolumeDestination, /* short output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - long NxCopy, /* width of block to copy */ - long NyCopy, /* height of block to copy */ - long NzCopy /* depth of the block to copy */ - ); - -/*--------------------------------------------------------------------------*/ -extern int FreeLineDouble - ( - double *(Line[]) /* 1D double array */ - ); - -/*--------------------------------------------------------------------------*/ -extern int FreeVolumeFloat - ( - float **Volume /* 3D float array */ - ); - -/*--------------------------------------------------------------------------*/ -extern int FreeVolumeShort - ( - short **Volume /* 3D short array */ - ); - -/*--------------------------------------------------------------------------*/ -extern int GetxFloatToDouble - ( - float *VolumeSource, /* float input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - double RowDestination[], /* double output data */ - long NxCopy /* length of the output */ - ); - -/*--------------------------------------------------------------------------*/ -extern int GetxShortToDouble - ( - short *VolumeSource, /* short input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - double RowDestination[], /* double output data */ - long NxCopy /* length of the output */ - ); - -/*--------------------------------------------------------------------------*/ -extern int GetyFloatToDouble - ( - float *VolumeSource, /* float input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - double ColumnDestination[],/* double output data */ - long NyCopy /* length of the output */ - ); - -/*--------------------------------------------------------------------------*/ -extern int GetyShortToDouble - ( - short *VolumeSource, /* short input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - double ColumnDestination[],/* double output data */ - long NyCopy /* length of the output */ - ); - -/*--------------------------------------------------------------------------*/ -extern int GetzFloatToDouble - ( - float *VolumeSource, /* float input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - double PillarDestination[],/* double output data */ - long NzCopy /* length of the output */ - ); - -/*--------------------------------------------------------------------------*/ -extern int GetzShortToDouble - ( - short *VolumeSource, /* short input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - double PillarDestination[],/* double output data */ - long NzCopy /* length of the output */ - ); - -/*--------------------------------------------------------------------------*/ -extern int PutxDoubleToFloat - ( - float *VolumeDestination, /* float output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - double RowSource[], /* double input data */ - long NxCopy /* length of the input */ - ); - -/*--------------------------------------------------------------------------*/ -extern int PutxDoubleToShort - ( - short *VolumeDestination, /* short output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - double RowSource[], /* double input data */ - long NxCopy /* length of the input */ - ); - -/*--------------------------------------------------------------------------*/ -extern int PutyDoubleToFloat - ( - float *VolumeDestination, /* float output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - double ColumnSource[], /* double input data */ - long NyCopy /* length of the input */ - ); - -/*--------------------------------------------------------------------------*/ -extern int PutyDoubleToShort - ( - short *VolumeDestination, /* short output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - double ColumnSource[], /* double input data */ - long NyCopy /* length of the input */ - ); - -/*--------------------------------------------------------------------------*/ -extern int PutzDoubleToFloat - ( - float *VolumeDestination, /* float output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - double PillarSource[], /* double input data */ - long NzCopy /* length of the input */ - ); - -/*--------------------------------------------------------------------------*/ -extern int PutzDoubleToShort - ( - short *VolumeDestination, /* short output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - double PillarSource[], /* double input data */ - long NzCopy /* length of the input */ - ); - diff --git a/src/core/bilib/getputd.cc b/src/core/bilib/getputd.cc deleted file mode 100644 index 1c4cc9e..0000000 --- a/src/core/bilib/getputd.cc +++ /dev/null @@ -1,742 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -#include -#include -#include -#include - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" -#include "error.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "convert.h" -#include "getputd.h" -#include "messagedisplay.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -#ifdef DEBUG -#include -#endif - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern int AllocateVolumeDouble - ( - double **Volume, /* double output pointer */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - int *Status /* error management */ - ) - -/* Allocates a 3D array of double */ -/* success: return(!ERROR); failure: return(ERROR) and set *Volume to NULL */ - -{ /* begin AllocateVolumeDouble */ - - *Status = !ERROR; - -/**/DEBUG_CHECK_RANGE_LONG(AllocateVolumeDouble, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(AllocateVolumeDouble, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(AllocateVolumeDouble, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(AllocateVolumeDouble, *Status) -/**/DEBUG_WRITE_ENTERING(AllocateVolumeDouble, -/**/ "About to allocate a 3D array of double") -#ifdef DEBUG -/**/if (*Volume != (double *)NULL) { -/**/ WRITE_WARNING(AllocateVolumeDouble, "Volume may have been previously allocated") -/**/} -#endif - - *Volume = (double *)malloc((size_t)(Nx * Ny * Nz * (long)sizeof(double))); - if (*Volume == (double *)NULL) { - *Status = ERROR; - WRITE_ERROR(AllocateVolumeDouble, "Unable to perform allocation") - } -/**/DEBUG_WRITE_LEAVING(AllocateVolumeDouble, "Done") - return(*Status); -} /* end AllocateVolumeDouble */ - -/*--------------------------------------------------------------------------*/ -extern int CopyDoubleToFloat - ( - double *VolumeSource, /* double input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - float *VolumeDestination, /* float output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - long NxCopy, /* width of the block to copy */ - long NyCopy, /* height of the block to copy */ - long NzCopy /* depth of the block to copy */ - ) - -/* copies a sub-volume from a double input volume into a portion of a float output volume */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin CopyDoubleToFloat */ - - double *P; - float *Q; - const ptrdiff_t - IgnoredDestination = (ptrdiff_t)(NxDestination - NxCopy), - IgnoredSource = (ptrdiff_t)(NxSource - NxCopy), - NxNyDestination = (ptrdiff_t)(NxDestination * NyDestination), - NxNySource = (ptrdiff_t)(NxSource * NySource); - long X, Y, Z; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(CopyDoubleToFloat, VolumeSource, Status, -/**/ "No input") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToFloat, NxSource, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToFloat, NySource, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToFloat, NzSource, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToFloat, XSource, 0L, NxSource - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToFloat, YSource, 0L, NySource - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToFloat, ZSource, 0L, NzSource - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_NULL_POINTER(CopyDoubleToFloat, VolumeDestination, Status, -/**/ "No output") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToFloat, NxDestination, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToFloat, NyDestination, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToFloat, NzDestination, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToFloat, XDestination, 0L, NxDestination - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToFloat, YDestination, 0L, NyDestination - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToFloat, ZDestination, 0L, NzDestination - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToFloat, NxCopy, 1L, NxSource - XSource, Status, -/**/ "Invalid width (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToFloat, NyCopy, 1L, NySource - YSource, Status, -/**/ "Invalid height (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToFloat, NzCopy, 1L, NzSource - ZSource, Status, -/**/ "Invalid depth (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToFloat, NxCopy, 1L, NxDestination - XDestination, Status, -/**/ "Invalid width (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToFloat, NyCopy, 1L, NyDestination - YDestination, Status, -/**/ "Invalid height (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToFloat, NzCopy, 1L, NzDestination - ZDestination, Status, -/**/ "Invalid depth (negative or excessive)") -/**/DEBUG_RETURN_ON_ERROR(CopyDoubleToFloat, Status) -/**/DEBUG_WRITE_ENTERING(CopyDoubleToFloat, -/**/ "About to copy a double subvolume into a float subvolume") - - VolumeSource += (ptrdiff_t)(XSource + NxSource * (YSource + NySource * ZSource)); - VolumeDestination += (ptrdiff_t)(XDestination + NxDestination * (YDestination - + NyDestination * ZDestination)); - for (Z = -NzCopy; (Z < 0L); Z++) { - P = VolumeSource; - Q = VolumeDestination; - for (Y = -NyCopy; (Y < 0L); Y++) { - for (X = -NxCopy; (X < 0L); X++) { - *Q++ = ConvertDoubleToFloat(*P++); - } - P += IgnoredSource; - Q += IgnoredDestination; - } - VolumeSource += NxNySource; - VolumeDestination += NxNyDestination; - } -/**/DEBUG_WRITE_LEAVING(CopyDoubleToFloat, "Done") - return(Status); -} /* end CopyDoubleToFloat */ - - -/*--------------------------------------------------------------------------*/ -extern int CopyDoubleToDouble - ( - double *VolumeSource, /* double input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - double *VolumeDestination, /* double output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - long NxCopy, /* width of the block to copy */ - long NyCopy, /* height of the block to copy */ - long NzCopy /* depth of the block to copy */ - ) - -/* copies a sub-volume from a double input volume into a portion of a double output volume */ -/* input and output may not share their memory space */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin CopyDoubleToDouble */ - - double *P, *Q; - const ptrdiff_t - NxNySource = (ptrdiff_t)(NxSource * NySource), - NxNyDestination = (ptrdiff_t)(NxDestination * NyDestination); - long Y, Z; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(CopyDoubleToDouble, VolumeSource, Status, -/**/ "No input") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToDouble, NxSource, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToDouble, NySource, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToDouble, NzSource, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToDouble, XSource, 0L, NxSource - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToDouble, YSource, 0L, NySource - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToDouble, ZSource, 0L, NzSource - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_NULL_POINTER(CopyDoubleToDouble, VolumeDestination, Status, -/**/ "No output") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToDouble, NxDestination, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToDouble, NyDestination, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToDouble, NzDestination, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToDouble, XDestination, 0L, NxDestination - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToDouble, YDestination, 0L, NyDestination - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToDouble, ZDestination, 0L, NzDestination - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToDouble, NxCopy, 1L, NxSource - XSource, Status, -/**/ "Invalid width (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToDouble, NyCopy, 1L, NySource - YSource, Status, -/**/ "Invalid height (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToDouble, NzCopy, 1L, NzSource - ZSource, Status, -/**/ "Invalid depth (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToDouble, NxCopy, 1L, NxDestination - XDestination, Status, -/**/ "Invalid width (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToDouble, NyCopy, 1L, NyDestination - YDestination, Status, -/**/ "Invalid height (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyDoubleToDouble, NzCopy, 1L, NzDestination - ZDestination, Status, -/**/ "Invalid depth (negative or excessive)") -/**/DEBUG_RETURN_ON_ERROR(CopyDoubleToDouble, Status) -/**/DEBUG_WRITE_ENTERING(CopyDoubleToDouble, -/**/ "About to copy a double subvolume into a double subvolume") -#ifdef DEBUG -/**/if (((VolumeSource + (ptrdiff_t)(NxSource * NySource * NzSource)) -/**/ > (VolumeDestination + (ptrdiff_t)(XDestination + NxDestination -/**/ * (YDestination + NyDestination * ZDestination)))) -/**/ && ((VolumeDestination + (ptrdiff_t)(NxDestination * NyDestination -/**/ * NzDestination)) > (VolumeSource + (ptrdiff_t)(XSource + NxSource -/**/ * (YSource + NySource * ZSource))))) { -/**/ WRITE_WARNING(CopyDoubleToDouble, "Data overlap: memcpy may fail") -/**/} -#endif - - VolumeSource += (ptrdiff_t)(XSource + NxSource * (YSource + NySource * ZSource)); - VolumeDestination += (ptrdiff_t)(XDestination + NxDestination * (YDestination - + NyDestination * ZDestination)); - for (Z = -NzCopy; (Z < 0L); Z++) { - P = VolumeSource; - Q = VolumeDestination; - for (Y = -NyCopy; (Y < 0L); Y++) { - Q = (double *)memcpy(Q, P, (size_t)(NxCopy * (long)sizeof(double))); - P += (ptrdiff_t)NxSource; - Q += (ptrdiff_t)NxDestination; - } - VolumeSource += NxNySource; - VolumeDestination += NxNyDestination; - } -/**/DEBUG_WRITE_LEAVING(CopyDoubleToDouble, "Done") - return(Status); -} /* end CopyDoubleToDouble */ - - -/*--------------------------------------------------------------------------*/ -extern int CopyFloatToDouble - ( - float *VolumeSource, /* float input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - double *VolumeDestination, /* double output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - long NxCopy, /* width of block to copy */ - long NyCopy, /* height of block to copy */ - long NzCopy /* depth of the block to copy */ - ) - -/* copies a sub-volume from a float input volume into a portion of a double output volume */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin CopyFloatToDouble */ - - double *Q; - float *P; - const ptrdiff_t - IgnoredDestination = (ptrdiff_t)(NxDestination - NxCopy), - IgnoredSource = (ptrdiff_t)(NxSource - NxCopy), - NxNyDestination = (ptrdiff_t)(NxDestination * NyDestination), - NxNySource = (ptrdiff_t)(NxSource * NySource); - long X, Y, Z; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(CopyFloatToDouble, VolumeSource, Status, -/**/ "No input") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToDouble, NxSource, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToDouble, NySource, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToDouble, NzSource, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToDouble, XSource, 0L, NxSource - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToDouble, YSource, 0L, NySource - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToDouble, ZSource, 0L, NzSource - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_NULL_POINTER(CopyFloatToDouble, VolumeDestination, Status, -/**/ "No output") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToDouble, NxDestination, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToDouble, NyDestination, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToDouble, NzDestination, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToDouble, XDestination, 0L, NxDestination - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToDouble, YDestination, 0L, NyDestination - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToDouble, ZDestination, 0L, NzDestination - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToDouble, NxCopy, 1L, NxSource - XSource, Status, -/**/ "Invalid width (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToDouble, NyCopy, 1L, NySource - YSource, Status, -/**/ "Invalid height (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToDouble, NzCopy, 1L, NzSource - ZSource, Status, -/**/ "Invalid depth (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToDouble, NxCopy, 1L, NxDestination - XDestination, Status, -/**/ "Invalid width (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToDouble, NyCopy, 1L, NyDestination - YDestination, Status, -/**/ "Invalid height (negative or excessive)") -/**/DEBUG_CHECK_RANGE_LONG(CopyFloatToDouble, NzCopy, 1L, NzDestination - ZDestination, Status, -/**/ "Invalid depth (negative or excessive)") -/**/DEBUG_RETURN_ON_ERROR(CopyFloatToDouble, Status) -/**/DEBUG_WRITE_ENTERING(CopyFloatToDouble, -/**/ "About to copy a float subvolume into a double subvolume") - - VolumeSource += (ptrdiff_t)(XSource + NxSource * (YSource + NySource * ZSource)); - VolumeDestination += (ptrdiff_t)(XDestination + NxDestination * (YDestination - + NyDestination * ZDestination)); - for (Z = -NzCopy; (Z < 0L); Z++) { - P = VolumeSource; - Q = VolumeDestination; - for (Y = -NyCopy; (Y < 0L); Y++) { - for (X = -NxCopy; (X < 0L); X++) { - *Q++ = (double)*P++; - } - P += IgnoredSource; - Q += IgnoredDestination; - } - VolumeSource += NxNySource; - VolumeDestination += NxNyDestination; - } -/**/DEBUG_WRITE_LEAVING(CopyFloatToDouble, "Done") - return(Status); -} /* end CopyFloatToDouble */ - -/*--------------------------------------------------------------------------*/ -extern int FreeVolumeDouble - ( - double **Volume /* 3D double array */ - ) - -/* Frees a 3D array of double */ -/* success: return(!ERROR) and set *Volume to NULL; failure: return(ERROR); */ - -{ /* begin FreeVolumeDouble */ - - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(FreeVolumeDouble, *Volume, Status, -/**/ "Nothing to free") -/**/DEBUG_RETURN_ON_ERROR(FreeVolumeDouble, Status) -/**/DEBUG_WRITE_ENTERING(FreeVolumeDouble, -/**/ "About to free a 3D array of double") - - free(*Volume); - *Volume = (double *)NULL; -/**/DEBUG_WRITE_LEAVING(FreeVolumeDouble, "Done") - return(Status); -} /* end FreeVolumeDouble */ - -/*--------------------------------------------------------------------------*/ -extern int GetxDoubleToDouble - ( - double *VolumeSource, /* double input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - double RowDestination[], /* double output data */ - long NxCopy /* length of the output */ - ) - -/* copies a horizontal line from a double input volume into a 1D double output array */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin GetxDoubleToDouble */ - - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(GetxDoubleToDouble, VolumeSource, Status, -/**/ "No input volume") -/**/DEBUG_CHECK_RANGE_LONG(GetxDoubleToDouble, NxSource, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(GetxDoubleToDouble, NySource, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(GetxDoubleToDouble, NzSource, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(GetxDoubleToDouble, XSource, 0L, NxSource - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(GetxDoubleToDouble, YSource, 0L, NySource - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(GetxDoubleToDouble, ZSource, 0L, NzSource - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_NULL_POINTER(GetxDoubleToDouble, RowDestination, Status, -/**/ "No output line") -/**/DEBUG_CHECK_RANGE_LONG(GetxDoubleToDouble, NxCopy, 1L, NxSource - XSource, Status, -/**/ "Invalid width (negative or excessive)") -/**/DEBUG_RETURN_ON_ERROR(GetxDoubleToDouble, Status) -/**/DEBUG_WRITE_ENTERING(GetxDoubleToDouble, -/**/ "About to get a (double)row from a (double)volume") - - VolumeSource += (ptrdiff_t)(XSource + NxSource * (YSource + NySource * ZSource)); - RowDestination = (double *)memcpy(RowDestination, VolumeSource, (size_t)(NxCopy - * (long)sizeof(double))); -/**/DEBUG_WRITE_LEAVING(GetxDoubleToDouble, "Done") - return(Status); -} /* end GetxDoubleToDouble */ - -/*--------------------------------------------------------------------------*/ -extern int GetyDoubleToDouble - ( - double *VolumeSource, /* double input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - double ColumnDestination[],/* double output data */ - long NyCopy /* length of the output */ - ) - -/* copies a vertical line from a double input volume into a 1D double output array */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin GetyDoubleToDouble */ - - double *End; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(GetyDoubleToDouble, VolumeSource, Status, -/**/ "No input volume") -/**/DEBUG_CHECK_RANGE_LONG(GetyDoubleToDouble, NxSource, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(GetyDoubleToDouble, NySource, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(GetyDoubleToDouble, NzSource, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(GetyDoubleToDouble, XSource, 0L, NxSource - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(GetyDoubleToDouble, YSource, 0L, NySource - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(GetyDoubleToDouble, ZSource, 0L, NzSource - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_NULL_POINTER(GetyDoubleToDouble, ColumnDestination, Status, -/**/ "No output line") -/**/DEBUG_CHECK_RANGE_LONG(GetyDoubleToDouble, NyCopy, 1L, NySource - YSource, Status, -/**/ "Invalid height (negative or excessive)") -/**/DEBUG_RETURN_ON_ERROR(GetyDoubleToDouble, Status) -/**/DEBUG_WRITE_ENTERING(GetyDoubleToDouble, -/**/ "About to get a (double)column from a (double)volume") - - VolumeSource += (ptrdiff_t)(XSource + NxSource * (YSource + NySource * ZSource)); - End = ColumnDestination + (ptrdiff_t)NyCopy; - while (ColumnDestination < End) { - *ColumnDestination++ = *VolumeSource; - VolumeSource += NxSource; - } -/**/DEBUG_WRITE_LEAVING(GetyDoubleToDouble, "Done") - return(Status); -} /* end GetyDoubleToDouble */ - -/*--------------------------------------------------------------------------*/ -extern int GetzDoubleToDouble - ( - double *VolumeSource, /* double input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - double PillarDestination[],/* double output data */ - long NzCopy /* length of the output */ - ) - -/* copies a line perpendicular to the screen from a double input volume into a 1D double output array */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin GetzDoubleToDouble */ - - double *End; - const ptrdiff_t - NxNySource = (ptrdiff_t)(NxSource * NySource); - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(GetzDoubleToDouble, VolumeSource, Status, -/**/ "No input volume") -/**/DEBUG_CHECK_RANGE_LONG(GetzDoubleToDouble, NxSource, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(GetzDoubleToDouble, NySource, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(GetzDoubleToDouble, NzSource, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(GetzDoubleToDouble, XSource, 0L, NxSource - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(GetzDoubleToDouble, YSource, 0L, NySource - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(GetzDoubleToDouble, ZSource, 0L, NzSource - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_NULL_POINTER(GetzDoubleToDouble, PillarDestination, Status, -/**/ "No output line") -/**/DEBUG_CHECK_RANGE_LONG(GetzDoubleToDouble, NzCopy, 1L, NzSource - ZSource, Status, -/**/ "Invalid depth (negative or excessive)") -/**/DEBUG_RETURN_ON_ERROR(GetzDoubleToDouble, Status) -/**/DEBUG_WRITE_ENTERING(GetzDoubleToDouble, -/**/ "About to get a (double)pillar from a (double)volume") - - VolumeSource += (ptrdiff_t)(XSource + NxSource * (YSource + NySource * ZSource)); - End = PillarDestination + (ptrdiff_t)NzCopy; - while (PillarDestination < End) { - *PillarDestination++ = *VolumeSource; - VolumeSource += NxNySource; - } -/**/DEBUG_WRITE_LEAVING(GetzDoubleToDouble, "Done") - return(Status); -} /* end GetzDoubleToDouble */ - -/*--------------------------------------------------------------------------*/ -extern int PutxDoubleToDouble - ( - double *VolumeDestination, /* double output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - double RowSource[], /* double input data */ - long NxCopy /* length of the input */ - ) - -/* copies a 1D double input array into a horizontal line of a double output volume */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin PutxDoubleToDouble */ - - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(PutxDoubleToDouble, VolumeDestination, Status, -/**/ "No output volume") -/**/DEBUG_CHECK_RANGE_LONG(PutxDoubleToDouble, NxDestination, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(PutxDoubleToDouble, NyDestination, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(PutxDoubleToDouble, NzDestination, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(PutxDoubleToDouble, XDestination, 0L, NxDestination - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(PutxDoubleToDouble, YDestination, 0L, NyDestination - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(PutxDoubleToDouble, ZDestination, 0L, NzDestination - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_NULL_POINTER(PutxDoubleToDouble, RowSource, Status, -/**/ "No output line") -/**/DEBUG_CHECK_RANGE_LONG(PutxDoubleToDouble, NxCopy, 1L, NxDestination - XDestination, Status, -/**/ "Invalid width (negative or excessive)") -/**/DEBUG_RETURN_ON_ERROR(PutxDoubleToDouble, Status) -/**/DEBUG_WRITE_ENTERING(PutxDoubleToDouble, -/**/ "About to put a (double)row into a (double)volume") - - VolumeDestination += (ptrdiff_t)(XDestination + NxDestination * (YDestination - + NyDestination * ZDestination)); - VolumeDestination = (double *)memcpy(VolumeDestination, RowSource, (size_t)(NxCopy - * (long)sizeof(double))); -/**/DEBUG_WRITE_LEAVING(PutxDoubleToDouble, "Done") - return(Status); -} /* end PutxDoubleToDouble */ - -/*--------------------------------------------------------------------------*/ -extern int PutyDoubleToDouble - ( - double *VolumeDestination, /* double output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - double ColumnSource[], /* double input data */ - long NyCopy /* length of the input */ - ) - -/* copies a 1D double input array into a vertical line of a double output volume */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin PutyDoubleToDouble */ - - double *End; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(PutyDoubleToDouble, VolumeDestination, Status, -/**/ "No output volume") -/**/DEBUG_CHECK_RANGE_LONG(PutyDoubleToDouble, NxDestination, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(PutyDoubleToDouble, NyDestination, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(PutyDoubleToDouble, NzDestination, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(PutyDoubleToDouble, XDestination, 0L, NxDestination - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(PutyDoubleToDouble, YDestination, 0L, NyDestination - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(PutyDoubleToDouble, ZDestination, 0L, NzDestination - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_NULL_POINTER(PutyDoubleToDouble, ColumnSource, Status, -/**/ "No output line") -/**/DEBUG_CHECK_RANGE_LONG(PutyDoubleToDouble, NyCopy, 1L, NyDestination - YDestination, Status, -/**/ "Invalid height (negative or excessive)") -/**/DEBUG_RETURN_ON_ERROR(PutyDoubleToDouble, Status) -/**/DEBUG_WRITE_ENTERING(PutyDoubleToDouble, -/**/ "About to put a (double)column into a (double)volume") - - VolumeDestination += (ptrdiff_t)(XDestination + NxDestination * (YDestination - + NyDestination * ZDestination)); - End = ColumnSource + (ptrdiff_t)NyCopy; - while (ColumnSource < End) { - *VolumeDestination = *ColumnSource++; - VolumeDestination += NxDestination; - } -/**/DEBUG_WRITE_LEAVING(PutyDoubleToDouble, "Done") - return(Status); -} /* end PutyDoubleToDouble */ - -/*--------------------------------------------------------------------------*/ -extern int PutzDoubleToDouble - ( - double *VolumeDestination, /* double output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - double PillarSource[], /* double input data */ - long NzCopy /* length of the input */ - ) - -/* copies a 1D double input array into a line perpendicular to the screen of a double output volume */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin PutzDoubleToDouble */ - - double *End; - const ptrdiff_t - NxNyDestination = (ptrdiff_t)(NxDestination * NyDestination); - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(PutzDoubleToDouble, VolumeDestination, Status, -/**/ "No output volume") -/**/DEBUG_CHECK_RANGE_LONG(PutzDoubleToDouble, NxDestination, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(PutzDoubleToDouble, NyDestination, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(PutzDoubleToDouble, NzDestination, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(PutzDoubleToDouble, XDestination, 0L, NxDestination - 1L, Status, -/**/ "Invalid X coordinate") -/**/DEBUG_CHECK_RANGE_LONG(PutzDoubleToDouble, YDestination, 0L, NyDestination - 1L, Status, -/**/ "Invalid Y coordinate") -/**/DEBUG_CHECK_RANGE_LONG(PutzDoubleToDouble, ZDestination, 0L, NzDestination - 1L, Status, -/**/ "Invalid Z coordinate") -/**/DEBUG_CHECK_NULL_POINTER(PutzDoubleToDouble, PillarSource, Status, -/**/ "No output line") -/**/DEBUG_CHECK_RANGE_LONG(PutzDoubleToDouble, NzCopy, 1L, NzDestination - ZDestination, Status, -/**/ "Invalid depth (negative or excessive)") -/**/DEBUG_RETURN_ON_ERROR(PutzDoubleToDouble, Status) -/**/DEBUG_WRITE_ENTERING(PutzDoubleToDouble, -/**/ "About to put a (double)pillar into a (double)volume") - - VolumeDestination += (ptrdiff_t)(XDestination + NxDestination * (YDestination - + NyDestination * ZDestination)); - End = PillarSource + (ptrdiff_t)NzCopy; - while (PillarSource < End) { - *VolumeDestination = *PillarSource++; - VolumeDestination += NxNyDestination; - } -/**/DEBUG_WRITE_LEAVING(PutzDoubleToDouble, "Done") - return(Status); -} /* end PutzDoubleToDouble */ - diff --git a/src/core/bilib/getputd.h b/src/core/bilib/getputd.h deleted file mode 100644 index 6022cbf..0000000 --- a/src/core/bilib/getputd.h +++ /dev/null @@ -1,166 +0,0 @@ -/*--------------------------------------------------------------------------*/ -extern int AllocateVolumeDouble - ( - double **Volume, /* double output pointer */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -extern int CopyDoubleToFloat - ( - double *VolumeSource, /* double input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - float *VolumeDestination, /* float output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - long NxCopy, /* width of the block to copy */ - long NyCopy, /* height of the block to copy */ - long NzCopy /* depth of the block to copy */ - ); - -/*--------------------------------------------------------------------------*/ -extern int CopyDoubleToDouble - ( - double *VolumeSource, /* double input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - double *VolumeDestination, /* double output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - long NxCopy, /* width of the block to copy */ - long NyCopy, /* height of the block to copy */ - long NzCopy /* depth of the block to copy */ - ); - -/*--------------------------------------------------------------------------*/ -extern int CopyFloatToDouble - ( - float *VolumeSource, /* float input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - double *VolumeDestination, /* double output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - long NxCopy, /* width of block to copy */ - long NyCopy, /* height of block to copy */ - long NzCopy /* depth of the block to copy */ - ); - -/*--------------------------------------------------------------------------*/ -extern int FreeVolumeDouble - ( - double **Volume /* 3D double array */ - ); - -/*--------------------------------------------------------------------------*/ -extern int GetxDoubleToDouble - ( - double *VolumeSource, /* double input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - double RowDestination[], /* double output data */ - long NxCopy /* length of the output */ - ); - -/*--------------------------------------------------------------------------*/ -extern int GetyDoubleToDouble - ( - double *VolumeSource, /* double input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - double ColumnDestination[],/* double output data */ - long NyCopy /* length of the output */ - ); - -/*--------------------------------------------------------------------------*/ -extern int GetzDoubleToDouble - ( - double *VolumeSource, /* double input data */ - long NxSource, /* width of the input */ - long NySource, /* height of the input */ - long NzSource, /* depth of the input */ - long XSource, /* x coordinate to get from */ - long YSource, /* y coordinate to get from */ - long ZSource, /* z coordinate to get from */ - double PillarDestination[],/* double output data */ - long NzCopy /* length of the output */ - ); - -/*--------------------------------------------------------------------------*/ -extern int PutxDoubleToDouble - ( - double *VolumeDestination, /* double output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - double RowSource[], /* double input data */ - long NxCopy /* length of the input */ - ); - -/*--------------------------------------------------------------------------*/ -extern int PutyDoubleToDouble - ( - double *VolumeDestination, /* double output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - double ColumnSource[], /* double input data */ - long NyCopy /* length of the input */ - ); - -/*--------------------------------------------------------------------------*/ -extern int PutzDoubleToDouble - ( - double *VolumeDestination, /* double output data */ - long NxDestination, /* width of the output */ - long NyDestination, /* height of the output */ - long NzDestination, /* depth of the output */ - long XDestination, /* x coordinate to put into */ - long YDestination, /* y coordinate to put into */ - long ZDestination, /* z coordinate to put into */ - double PillarSource[], /* double input data */ - long NzCopy /* length of the input */ - ); - diff --git a/src/core/bilib/gradient.cc b/src/core/bilib/gradient.cc deleted file mode 100644 index ff934f6..0000000 --- a/src/core/bilib/gradient.cc +++ /dev/null @@ -1,701 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -#include - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" -#include "error.h" -#include "tboundaryconvention.h" -#include "tsplinebasis.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "changebasis.h" -#include "convert.h" -#include "firconvolve.h" -#include "getput.h" -#include "gradient.h" -#include "kernel.h" -#include "messagedisplay.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -#ifdef DEBUG -#include -#include -#include -#include -#endif - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern int LinearGradient - ( - double InputData[], /* input 1D data */ - double OutputGradient[], /* output 1D gradient */ - long SignalLength, /* signal length */ - long Degree, /* degree of the spline space */ - enum TBoundaryConvention - Convention, /* boundary convention */ - double Tolerance, /* admissible relative error */ - int *Status /* error management */ - ) - -/* compute the gradient of 1D data */ -/* InputData and OutputGradient have size SignalLength */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin LinearGradient */ - - double *Bcoeff = (double *)NULL, *HalfKernel = (double *)NULL; - long HalfDegree = (1L < Degree) ? (Degree / 2L) : (1L); - long i; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(LinearGradient, InputData, *Status, -/**/ "Missing input") -/**/DEBUG_CHECK_NULL_POINTER(LinearGradient, OutputGradient, *Status, -/**/ "Missing output") -/**/DEBUG_CHECK_RANGE_LONG(LinearGradient, SignalLength, 1L, LONG_MAX, *Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(LinearGradient, Degree, 1L, LONG_MAX, *Status, -/**/ "Invalid degree (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_DOUBLE(LinearGradient, Tolerance, 0.0, DBL_MAX, *Status, -/**/ "Invalid Tolerance (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(LinearGradient, *Status) -/**/DEBUG_WRITE_ENTERING(LinearGradient, -/**/ "About to compute a 1D gradient") - - switch (Convention) { - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - default: - *Status = ERROR; - WRITE_ERROR(LinearGradient, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(LinearGradient, "Done") - return(*Status); - } - AllocateLineDouble(&Bcoeff, SignalLength, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(LinearGradient, "Done") - return(*Status); - } - AllocateLineDouble(&HalfKernel, HalfDegree + 1L, Status); - if (*Status == ERROR) { - FreeLineDouble(&Bcoeff); -/**/ DEBUG_WRITE_LEAVING(LinearGradient, "Done") - return(*Status); - } - ChangeBasis(InputData, Bcoeff, SignalLength, CardinalSpline, BasicSpline, - Degree, Convention, Tolerance, Status); - if (*Status == ERROR) { - FreeLineDouble(&HalfKernel); - FreeLineDouble(&Bcoeff); -/**/ DEBUG_WRITE_LEAVING(LinearGradient, "Done") - return(*Status); - } - for (i = 0L; (i < HalfDegree); i++) { - *Status = Bspline(Degree - 1L, 0.5 + (double)i, &(HalfKernel[i])); - if (*Status == ERROR) { - FreeLineDouble(&HalfKernel); - FreeLineDouble(&Bcoeff); -/**/ DEBUG_WRITE_LEAVING(LinearGradient, "Done") - return(*Status); - } - } - HalfKernel[i] = 0.0; - do { - HalfKernel[i] -= HalfKernel[i - 1L]; - } while (0L < --i); - HalfKernel[i] = 0.0; - *Status = FirConvolveAntiSymmetric(Bcoeff, OutputGradient, SignalLength, - HalfKernel, HalfDegree + 1L, Convention); - if (*Status == ERROR) { - FreeLineDouble(&HalfKernel); - FreeLineDouble(&Bcoeff); -/**/ DEBUG_WRITE_LEAVING(LinearGradient, "Done") - return(*Status); - } - *Status = FreeLineDouble(&HalfKernel); - if (*Status == ERROR) { - FreeLineDouble(&Bcoeff); -/**/ DEBUG_WRITE_LEAVING(LinearGradient, "Done") - return(*Status); - } - *Status = FreeLineDouble(&Bcoeff); -/**/DEBUG_WRITE_LEAVING(LinearGradient, "Done") - return(*Status); -} /* end LinearGradient */ - -/*--------------------------------------------------------------------------*/ -extern int PlanarGradient - ( - float *InputImage, /* input 2D data */ - float *OutputGradient[], /* output 2D gradient array [x, y] */ - long Nx, /* width of the image */ - long Ny, /* height of the image */ - long Degree, /* degree of the spline space */ - enum TBoundaryConvention - Convention, /* boundary convention */ - double Tolerance, /* admissible relative error */ - int *Status /* error management */ - ) - -/* compute the gradient of 2D data */ -/* InputImage has size (Nx x Ny) */ -/* OutputGradient is an array of two elements */ -/* each element of OutputGradient is a (float *) pointer to an image */ -/* each element has size (Nx x Ny) */ -/* the first element is the gradient along x */ -/* the second element is the gradient along y */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin PlanarGradient */ - - float *p; - double *Line1 = (double *)NULL, *Line2 = (double *)NULL, *HalfKernel = (double *)NULL; - long HalfDegree = (1L < Degree) ? (Degree / 2L) : (1L); - long x, y; - long i; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(PlanarGradient, InputImage, *Status, -/**/ "Missing input") -/**/DEBUG_CHECK_NULL_POINTER(PlanarGradient, OutputGradient, *Status, -/**/ "Missing output") -/**/DEBUG_CHECK_NULL_POINTER(PlanarGradient, OutputGradient[0], *Status, -/**/ "Missing output x gradient") -/**/DEBUG_CHECK_NULL_POINTER(PlanarGradient, OutputGradient[1], *Status, -/**/ "Missing output y gradient") -/**/DEBUG_CHECK_RANGE_LONG(PlanarGradient, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(PlanarGradient, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(PlanarGradient, Degree, 1L, LONG_MAX, *Status, -/**/ "Invalid degree (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_DOUBLE(PlanarGradient, Tolerance, 0.0, DBL_MAX, *Status, -/**/ "Invalid Tolerance (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(PlanarGradient, *Status) -/**/DEBUG_WRITE_ENTERING(PlanarGradient, -/**/ "About to compute a 2D gradient") - - switch (Convention) { - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - default: - *Status = ERROR; - WRITE_ERROR(PlanarGradient, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(PlanarGradient, "Done") - return(*Status); - } - AllocateLineDouble(&HalfKernel, HalfDegree + 1L, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(PlanarGradient, "Done") - return(*Status); - } - for (i = 0L; (i < HalfDegree); i++) { - *Status = Bspline(Degree - 1L, 0.5 + (double)i, &(HalfKernel[i])); - if (*Status == ERROR) { - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(PlanarGradient, "Done") - return(*Status); - } - } - HalfKernel[i] = 0.0; - do { - HalfKernel[i] -= HalfKernel[i - 1L]; - } while (0L < --i); - HalfKernel[i] = 0.0; - if (1L < Nx) { - AllocateLineDouble(&Line1, Nx, Status); - if (*Status == ERROR) { - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(PlanarGradient, "Done") - return(*Status); - } - AllocateLineDouble(&Line2, Nx, Status); - if (*Status == ERROR) { - FreeLineDouble(&Line1); - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(PlanarGradient, "Done") - return(*Status); - } - for (y = 0L; (y < Ny); y++) { - *Status = GetxFloatToDouble(InputImage, Nx, Ny, 1L, 0L, y, 0L, Line1, Nx); - if (*Status == ERROR) { - FreeLineDouble(&Line2); - FreeLineDouble(&Line1); - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(PlanarGradient, "Done") - return(*Status); - } - ChangeBasis(Line1, Line2, Nx, CardinalSpline, BasicSpline, - Degree, Convention, Tolerance, Status); - if (*Status == ERROR) { - FreeLineDouble(&Line2); - FreeLineDouble(&Line1); - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(PlanarGradient, "Done") - return(*Status); - } - *Status = FirConvolveAntiSymmetric(Line2, Line1, Nx, - HalfKernel, HalfDegree + 1L, Convention); - if (*Status == ERROR) { - FreeLineDouble(&Line2); - FreeLineDouble(&Line1); - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(PlanarGradient, "Done") - return(*Status); - } - *Status = PutxDoubleToFloat(OutputGradient[0], Nx, Ny, 1L, 0L, y, 0L, Line1, Nx); - if (*Status == ERROR) { - FreeLineDouble(&Line2); - FreeLineDouble(&Line1); - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(PlanarGradient, "Done") - return(*Status); - } - } - *Status = FreeLineDouble(&Line2); - if (*Status == ERROR) { - FreeLineDouble(&Line1); - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(PlanarGradient, "Done") - return(*Status); - } - *Status = FreeLineDouble(&Line1); - if (*Status == ERROR) { - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(PlanarGradient, "Done") - return(*Status); - } - } - else { - p = OutputGradient[0]; - for (y = Ny; (0L < y); y--) { - *p++ = 0.0F; - } - } - if (1L < Ny) { - AllocateLineDouble(&Line1, Ny, Status); - if (*Status == ERROR) { - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(PlanarGradient, "Done") - return(*Status); - } - AllocateLineDouble(&Line2, Ny, Status); - if (*Status == ERROR) { - FreeLineDouble(&Line1); - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(PlanarGradient, "Done") - return(*Status); - } - for (x = 0L; (x < Nx); x++) { - *Status = GetyFloatToDouble(InputImage, Nx, Ny, 1L, x, 0L, 0L, Line1, Ny); - if (*Status == ERROR) { - FreeLineDouble(&Line2); - FreeLineDouble(&Line1); - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(PlanarGradient, "Done") - return(*Status); - } - ChangeBasis(Line1, Line2, Ny, CardinalSpline, BasicSpline, - Degree, Convention, Tolerance, Status); - if (*Status == ERROR) { - FreeLineDouble(&Line2); - FreeLineDouble(&Line1); - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(PlanarGradient, "Done") - return(*Status); - } - *Status = FirConvolveAntiSymmetric(Line2, Line1, Ny, - HalfKernel, HalfDegree + 1L, Convention); - if (*Status == ERROR) { - FreeLineDouble(&Line2); - FreeLineDouble(&Line1); - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(PlanarGradient, "Done") - return(*Status); - } - *Status = PutyDoubleToFloat(OutputGradient[1], Nx, Ny, 1L, x, 0L, 0L, Line1, Ny); - if (*Status == ERROR) { - FreeLineDouble(&Line2); - FreeLineDouble(&Line1); - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(PlanarGradient, "Done") - return(*Status); - } - } - *Status = FreeLineDouble(&Line2); - if (*Status == ERROR) { - FreeLineDouble(&Line1); - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(PlanarGradient, "Done") - return(*Status); - } - *Status = FreeLineDouble(&Line1); - if (*Status == ERROR) { - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(PlanarGradient, "Done") - return(*Status); - } - } - else { - p = OutputGradient[1]; - for (x = Nx; (0L < x); x--) { - *p++ = 0.0F; - } - } - *Status = FreeLineDouble(&HalfKernel); -/**/DEBUG_WRITE_LEAVING(PlanarGradient, "Done") - return(*Status); -} /* end PlanarGradient */ - -/*--------------------------------------------------------------------------*/ -extern int VolumetricGradient - ( - float *InputVolume, /* input 3D data */ - float *OutputGradient[], /* output 3D gradient array [x, y, z] */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long Degree, /* degree of the spline space */ - enum TBoundaryConvention - Convention, /* boundary convention */ - double Tolerance, /* admissible relative error */ - int *Status /* error management */ - ) - -/* compute the gradient of 3D data */ -/* InputVolume has size (Nx x Ny x Nz) */ -/* OutputGradient is an array of three elements */ -/* each element of OutputGradient is a (float *) pointer to a volume */ -/* each element of OutputGradient has size (Nx x Ny x Nz) */ -/* the first element is the gradient along x */ -/* the second element is the gradient along y */ -/* the third element is the gradient along z */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin VolumetricGradient */ - - float *p; - double *Line1 = (double *)NULL, *Line2 = (double *)NULL, *HalfKernel = (double *)NULL; - long HalfDegree = (1L < Degree) ? (Degree / 2L) : (1L); - long x, y, z; - long i; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(VolumetricGradient, InputVolume, *Status, -/**/ "Missing input") -/**/DEBUG_CHECK_NULL_POINTER(VolumetricGradient, OutputGradient, *Status, -/**/ "Missing output") -/**/DEBUG_CHECK_NULL_POINTER(VolumetricGradient, OutputGradient[0], *Status, -/**/ "Missing output x gradient") -/**/DEBUG_CHECK_NULL_POINTER(VolumetricGradient, OutputGradient[1], *Status, -/**/ "Missing output y gradient") -/**/DEBUG_CHECK_NULL_POINTER(VolumetricGradient, OutputGradient[2], *Status, -/**/ "Missing output z gradient") -/**/DEBUG_CHECK_RANGE_LONG(VolumetricGradient, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(VolumetricGradient, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(VolumetricGradient, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(VolumetricGradient, Degree, 1L, LONG_MAX, *Status, -/**/ "Invalid degree (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_DOUBLE(VolumetricGradient, Tolerance, 0.0, DBL_MAX, *Status, -/**/ "Invalid Tolerance (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(VolumetricGradient, *Status) -/**/DEBUG_WRITE_ENTERING(VolumetricGradient, -/**/ "About to compute a 3D gradient") - - switch (Convention) { - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - default: - *Status = ERROR; - WRITE_ERROR(VolumetricGradient, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(VolumetricGradient, "Done") - return(*Status); - } - AllocateLineDouble(&HalfKernel, HalfDegree + 1L, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(VolumetricGradient, "Done") - return(*Status); - } - for (i = 0L; (i < HalfDegree); i++) { - *Status = Bspline(Degree - 1L, 0.5 + (double)i, &(HalfKernel[i])); - if (*Status == ERROR) { - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(VolumetricGradient, "Done") - return(*Status); - } - } - HalfKernel[i] = 0.0; - do { - HalfKernel[i] -= HalfKernel[i - 1L]; - } while (0L < --i); - HalfKernel[i] = 0.0; - if (1L < Nx) { - AllocateLineDouble(&Line1, Nx, Status); - if (*Status == ERROR) { - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(VolumetricGradient, "Done") - return(*Status); - } - AllocateLineDouble(&Line2, Nx, Status); - if (*Status == ERROR) { - FreeLineDouble(&Line1); - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(VolumetricGradient, "Done") - return(*Status); - } - for (z = 0L; (z < Nz); z++) { - for (y = 0L; (y < Ny); y++) { - *Status = GetxFloatToDouble(InputVolume, Nx, Ny, Nz, 0L, y, z, Line1, Nx); - if (*Status == ERROR) { - FreeLineDouble(&Line2); - FreeLineDouble(&Line1); - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(VolumetricGradient, "Done") - return(*Status); - } - ChangeBasis(Line1, Line2, Nx, CardinalSpline, BasicSpline, - Degree, Convention, Tolerance, Status); - if (*Status == ERROR) { - FreeLineDouble(&Line2); - FreeLineDouble(&Line1); - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(VolumetricGradient, "Done") - return(*Status); - } - *Status = FirConvolveAntiSymmetric(Line2, Line1, Nx, - HalfKernel, HalfDegree + 1L, Convention); - if (*Status == ERROR) { - FreeLineDouble(&Line2); - FreeLineDouble(&Line1); - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(VolumetricGradient, "Done") - return(*Status); - } - *Status = PutxDoubleToFloat(OutputGradient[0], Nx, Ny, Nz, 0L, y, z, Line1, Nx); - if (*Status == ERROR) { - FreeLineDouble(&Line2); - FreeLineDouble(&Line1); - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(VolumetricGradient, "Done") - return(*Status); - } - } - } - *Status = FreeLineDouble(&Line2); - if (*Status == ERROR) { - FreeLineDouble(&Line1); - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(VolumetricGradient, "Done") - return(*Status); - } - *Status = FreeLineDouble(&Line1); - if (*Status == ERROR) { - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(VolumetricGradient, "Done") - return(*Status); - } - } - else { - p = OutputGradient[0]; - for (z = Nz; (0L < z); z--) { - for (y = Ny; (0L < y); y--) { - *p++ = 0.0F; - } - } - } - if (1L < Ny) { - AllocateLineDouble(&Line1, Ny, Status); - if (*Status == ERROR) { - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(VolumetricGradient, "Done") - return(*Status); - } - AllocateLineDouble(&Line2, Ny, Status); - if (*Status == ERROR) { - FreeLineDouble(&Line1); - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(VolumetricGradient, "Done") - return(*Status); - } - for (z = 0L; (z < Nz); z++) { - for (x = 0L; (x < Nx); x++) { - *Status = GetyFloatToDouble(InputVolume, Nx, Ny, Nz, x, 0L, z, Line1, Ny); - if (*Status == ERROR) { - FreeLineDouble(&Line2); - FreeLineDouble(&Line1); - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(VolumetricGradient, "Done") - return(*Status); - } - ChangeBasis(Line1, Line2, Ny, CardinalSpline, BasicSpline, - Degree, Convention, Tolerance, Status); - if (*Status == ERROR) { - FreeLineDouble(&Line2); - FreeLineDouble(&Line1); - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(VolumetricGradient, "Done") - return(*Status); - } - *Status = FirConvolveAntiSymmetric(Line2, Line1, Ny, - HalfKernel, HalfDegree + 1L, Convention); - if (*Status == ERROR) { - FreeLineDouble(&Line2); - FreeLineDouble(&Line1); - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(VolumetricGradient, "Done") - return(*Status); - } - *Status = PutyDoubleToFloat(OutputGradient[1], Nx, Ny, Nz, x, 0L, z, Line1, Ny); - if (*Status == ERROR) { - FreeLineDouble(&Line2); - FreeLineDouble(&Line1); - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(VolumetricGradient, "Done") - return(*Status); - } - } - } - *Status = FreeLineDouble(&Line2); - if (*Status == ERROR) { - FreeLineDouble(&Line1); - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(VolumetricGradient, "Done") - return(*Status); - } - *Status = FreeLineDouble(&Line1); - if (*Status == ERROR) { - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(VolumetricGradient, "Done") - return(*Status); - } - } - else { - p = OutputGradient[1]; - for (z = Nz; (0L < z); z--) { - for (x = Nx; (0L < x); x--) { - *p++ = 0.0F; - } - } - } - if (1L < Nz) { - AllocateLineDouble(&Line1, Nz, Status); - if (*Status == ERROR) { - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(VolumetricGradient, "Done") - return(*Status); - } - AllocateLineDouble(&Line2, Nz, Status); - if (*Status == ERROR) { - FreeLineDouble(&Line1); - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(VolumetricGradient, "Done") - return(*Status); - } - for (y = 0L; (y < Ny); y++) { - for (x = 0L; (x < Nx); x++) { - *Status = GetzFloatToDouble(InputVolume, Nx, Ny, Nz, x, y, 0L, Line1, Nz); - if (*Status == ERROR) { - FreeLineDouble(&Line2); - FreeLineDouble(&Line1); - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(VolumetricGradient, "Done") - return(*Status); - } - ChangeBasis(Line1, Line2, Nz, CardinalSpline, BasicSpline, - Degree, Convention, Tolerance, Status); - if (*Status == ERROR) { - FreeLineDouble(&Line2); - FreeLineDouble(&Line1); - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(VolumetricGradient, "Done") - return(*Status); - } - *Status = FirConvolveAntiSymmetric(Line2, Line1, Nz, - HalfKernel, HalfDegree + 1L, Convention); - if (*Status == ERROR) { - FreeLineDouble(&Line2); - FreeLineDouble(&Line1); - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(VolumetricGradient, "Done") - return(*Status); - } - *Status = PutzDoubleToFloat(OutputGradient[2], Nx, Ny, Nz, x, y, 0L, Line1, Nz); - if (*Status == ERROR) { - FreeLineDouble(&Line2); - FreeLineDouble(&Line1); - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(VolumetricGradient, "Done") - return(*Status); - } - } - } - *Status = FreeLineDouble(&Line2); - if (*Status == ERROR) { - FreeLineDouble(&Line1); - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(VolumetricGradient, "Done") - return(*Status); - } - *Status = FreeLineDouble(&Line1); - if (*Status == ERROR) { - FreeLineDouble(&HalfKernel); -/**/ DEBUG_WRITE_LEAVING(VolumetricGradient, "Done") - return(*Status); - } - } - else { - p = OutputGradient[2]; - for (y = Ny; (0L < y); y--) { - for (x = Nx; (0L < x); x--) { - *p++ = 0.0F; - } - } - } - *Status = FreeLineDouble(&HalfKernel); -/**/DEBUG_WRITE_LEAVING(VolumetricGradient, "Done") - return(*Status); -} /* end VolumetricGradient */ - diff --git a/src/core/bilib/gradient.h b/src/core/bilib/gradient.h deleted file mode 100644 index 64cee51..0000000 --- a/src/core/bilib/gradient.h +++ /dev/null @@ -1,67 +0,0 @@ -/**@defgroup BilibGradient Gradient - @ingroup BilibLibrary */ -//@{ -/*--------------------------------------------------------------------------*/ -/** Compute the gradient of 1D data. - InputData and OutputGradient have size SignalLength. - - success: return(!ERROR); failure: return(ERROR) -*/ -extern int LinearGradient - ( - double InputData[], /* input 1D data */ - double OutputGradient[], /* output 1D gradient */ - long SignalLength, /* signal length */ - long Degree, /* degree of the spline space */ - enum TBoundaryConvention - Convention, /* boundary convention */ - double Tolerance, /* admissible relative error */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Compute the gradient of 2D data. - InputImage has size (Nx x Ny). OutputGradient is an array of two - elements. Each element of OutputGradient is a (float *) pointer to an - image. Each element has size (Nx x Ny). The first element is the gradient - along x. The second element is the gradient along y. - - success: return(!ERROR); failure: return(ERROR) -*/ -extern int PlanarGradient - ( - float *InputImage, /* input 2D data */ - float *OutputGradient[], /* output 2D gradient array [x, y] */ - long Nx, /* width of the image */ - long Ny, /* height of the image */ - long Degree, /* degree of the spline space */ - enum TBoundaryConvention - Convention, /* boundary convention */ - double Tolerance, /* admissible relative error */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Compute the gradient of 3D data. - InputVolume has size (Nx x Ny x Nz). OutputGradient is an array of - three elements. Each element of OutputGradient is a (float *) pointer - to a volume. Each element of OutputGradient has size (Nx x Ny x Nz). - The first element is the gradient along x. The second element is the - gradient along y. The third element is the gradient along z. - - success: return(!ERROR); failure: return(ERROR) -*/ -extern int VolumetricGradient - ( - float *InputVolume, /* input 3D data */ - float *OutputGradient[], /* output 3D gradient array [x, y, z] */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long Degree, /* degree of the spline space */ - enum TBoundaryConvention - Convention, /* boundary convention */ - double Tolerance, /* admissible relative error */ - int *Status /* error management */ - ); -//@} diff --git a/src/core/bilib/histogram.cc b/src/core/bilib/histogram.cc deleted file mode 100644 index 4dd3ea5..0000000 --- a/src/core/bilib/histogram.cc +++ /dev/null @@ -1,761 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -#include -#include -#include -#include - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" -#include "error.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "histogram.h" -#include "messagedisplay.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -#ifdef DEBUG -#include -#include -#include -#endif - -/***************************************************************************** - * Local struct - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -struct TOrderedTree -{ - float Value; - long Occurence; - struct TOrderedTree - *LowerBranch, *HigherBranch, *Trunk; -}; - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -static void FlattenAndFreeTree - ( - struct TOrderedTree - **Root, /* root of the ordered tree to flatten */ - double Frequency[], /* ordinates */ - float Value[] /* abscissa */ - ); - -/*--------------------------------------------------------------------------*/ -static void FreeTree - ( - struct TOrderedTree - **Root /* root of the ordered tree to free */ - ); - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -static void FlattenAndFreeTree - ( - struct TOrderedTree - **Root, /* root of the ordered tree to free */ - double Frequency[], /* ordinates */ - float Value[] /* abscissa */ - ) - -{ /* begin FlattenAndFreeTree */ - - struct TOrderedTree - *u, *v; - -/**/DEBUG_WRITE_ENTERING(FlattenAndFreeTree, -/**/ "About to execute FlattenAndFreeTree") - u = *Root; - while (u != (struct TOrderedTree *)NULL) { - if (u->LowerBranch != (struct TOrderedTree *)NULL) { - v = u->LowerBranch; - u->LowerBranch = (struct TOrderedTree *)NULL; - u = v; - continue; - } - if (u->HigherBranch != (struct TOrderedTree *)NULL) { - *Value++ = u->Value; - *Frequency++ = (double)(u->Occurence); - u->Occurence = -1L; - v = u->HigherBranch; - u->HigherBranch = (struct TOrderedTree *)NULL; - u = v; - continue; - } - if (u->Occurence != -1L) { - *Value++ = u->Value; - *Frequency++ = (double)(u->Occurence); - } - v = u; - u = u->Trunk; - free(v); - } - *Root = (struct TOrderedTree *)NULL; -/**/DEBUG_WRITE_LEAVING(FlattenAndFreeTree, "Done") -} /* end FlattenAndFreeTree */ - -/*--------------------------------------------------------------------------*/ -static void FreeTree - ( - struct TOrderedTree - **Root /* root of the ordered tree to free */ - ) - -{ /* begin FreeTree */ - - struct TOrderedTree - *u, *v; - -/**/DEBUG_WRITE_ENTERING(FreeTree, -/**/ "About to execute FreeTree") - u = *Root; - while (u != (struct TOrderedTree *)NULL) { - if (u->LowerBranch != (struct TOrderedTree *)NULL) { - v = u->LowerBranch; - u->LowerBranch = (struct TOrderedTree *)NULL; - u = v; - continue; - } - if (u->HigherBranch != (struct TOrderedTree *)NULL) { - v = u->HigherBranch; - u->HigherBranch = (struct TOrderedTree *)NULL; - u = v; - continue; - } - v = u; - u = u->Trunk; - free(v); - } - *Root = (struct TOrderedTree *)NULL; -/**/DEBUG_WRITE_LEAVING(FreeTree, "Done") -} /* end FreeTree */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern int HistogramBuild - ( - float *VolumeSource, /* data to process */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - double Frequency[], /* output vector of ordinates */ - float Value[], /* output vector of abscissa */ - int *Status /* error management */ - ) - -/* computation of the frequencies of occurence of data values */ -/* VolumeSource is a (float)volume of size (Nx x Ny x Nz) */ -/* Value[] is a (float)array of length previously determined by HistogramGetSize */ -/* the returned content of Value[] is sorted in strict ascending order */ -/* Frequency[] is a (double)array of length previously determined by HistogramGetSize */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin HistogramBuild */ - - struct TOrderedTree - *Root; - struct TOrderedTree - *u, *v; - float *p; - double Normalization; - long HistogramLength; - long i, Nxyz = Nx * Ny * Nz; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(HistogramBuild, VolumeSource, *Status, -/**/ "Missing input VolumeSource") -/**/DEBUG_CHECK_NULL_POINTER(HistogramBuild, Value, *Status, -/**/ "Missing output Value") -/**/DEBUG_CHECK_NULL_POINTER(HistogramBuild, Frequency, *Status, -/**/ "Missing output Frequency") -/**/DEBUG_CHECK_RANGE_LONG(HistogramBuild, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid volume width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(HistogramBuild, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid volume height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(HistogramBuild, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid volume depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(HistogramBuild, *Status) -/**/DEBUG_WRITE_ENTERING(HistogramBuild, -/**/ "About to execute HistogramBuild") - - p = VolumeSource + (ptrdiff_t)(Nxyz - 1L); - Root = (struct TOrderedTree *)malloc(sizeof(struct TOrderedTree)); - if (Root == (struct TOrderedTree *)NULL) { - *Status = ERROR; - WRITE_ERROR(HistogramBuild, "Unable to perform allocation of Root") -/**/ DEBUG_WRITE_LEAVING(HistogramBuild, "Done") - return(*Status); - } - Root->Value = *p; - HistogramLength = 1L; - Root->Occurence = 1L; - Root->LowerBranch = (struct TOrderedTree *)NULL; - Root->HigherBranch = (struct TOrderedTree *)NULL; - Root->Trunk = (struct TOrderedTree *)NULL; - while (VolumeSource <= --p) { - u = Root; - do { - if (*p == u->Value) { - (u->Occurence)++; - u = Root; - } - else { - if (*p < u->Value) { - v = u->LowerBranch; - if (v == (struct TOrderedTree *)NULL) { - v = (struct TOrderedTree *)malloc(sizeof(struct TOrderedTree)); - if (v == (struct TOrderedTree *)NULL) { - *Status = ERROR; - FreeTree(&Root); - WRITE_ERROR(HistogramBuild, "Unable to perform allocation of a low leaf") -/**/ DEBUG_WRITE_LEAVING(HistogramBuild, "Done") - return(*Status); - } - v->Value = *p; - HistogramLength++; - v->Occurence = 1L; - v->LowerBranch = (struct TOrderedTree *)NULL; - v->HigherBranch = (struct TOrderedTree *)NULL; - v->Trunk = u; - u->LowerBranch = v; - u = Root; - } - else { - u = v; - } - } - else { - v = u->HigherBranch; - if (v == (struct TOrderedTree *)NULL) { - v = (struct TOrderedTree *)malloc(sizeof(struct TOrderedTree)); - if (v == (struct TOrderedTree *)NULL) { - *Status = ERROR; - FreeTree(&Root); - WRITE_ERROR(HistogramBuild, "Unable to perform allocation of a high leaf") -/**/ DEBUG_WRITE_LEAVING(HistogramBuild, "Done") - return(*Status); - } - v->Value = *p; - HistogramLength++; - v->Occurence = 1L; - v->LowerBranch = (struct TOrderedTree *)NULL; - v->HigherBranch = (struct TOrderedTree *)NULL; - v->Trunk = u; - u->HigherBranch = v; - u = Root; - } - else { - u = v; - } - } - } - } while (u != Root); - } - FlattenAndFreeTree(&Root, Frequency, Value); - Normalization = 1.0 / (double)Nxyz; - for (i = 0L; (i < HistogramLength); i++) { - Frequency[i] *= Normalization; - } -/**/DEBUG_WRITE_LEAVING(HistogramBuild, "Done") - return(*Status); -} /* end HistogramBuild */ - -/*--------------------------------------------------------------------------*/ -extern int HistogramEqualize - ( - double Frequency[], /* histogram ordinates */ - float Value[], /* histogram abscissa */ - float EqualizedValue[], /* output vector of abscissa */ - long HistogramLength, /* length of the histogram */ - long *NumberOfClasses, /* number of classes, desired -> actual */ - double Tolerance /* admissible relative error */ - ) - -/* construction of the lookup table: Value[k] <-> EqualizedValue[k] */ -/* EqualizedValue[] satisfies */ -/* sum(k in K(n0)) Frequency[k] ~=~ sum(k in K(n1)) Frequency[k] */ -/* for all n0, n1 in [0L, NumberOfClasses - 1L] */ -/* where ~=~ means "is about equal to", */ -/* and where K(n) is a domain such that */ -/* EqualizedValue[k0] = (sum(k1 in K(n)) Frequency[k1] * Value[k1]) */ -/* / (sum(k2 in K(n)) Frequency[k2]) */ -/* for all k0 in K(n) */ -/* under the constraint */ -/* DistinctElements(QuantizedValue[]) == NumberOfClasses */ -/* Frequency[] is a (double)array of length HistogramLength */ -/* the content of Frequency[] must be strictly positive */ -/* the content of Frequency[] must have unit sum */ -/* Value[] is a (float)array of length HistogramLength */ -/* the content of Value[] must be sorted in strictly ascending order */ -/* EqualizedValue[] is a returned (float)array of length HistogramLength */ -/* on input, NumberOfClasses indicates the desired number of classes */ -/* on output, NumberOfClasses returns the effective number of classes */ -/* NumberOfClasses is no greater than (1.0 / max(Frequency[])), and never increases */ -/* it may happen that the only solution that satisfies all constraints is undesirable */ -/* e.g., Frequency[] = {0.9, 0.1}; */ -/* Value[] = {10.0F, 90.0F}; */ -/* NumberOfClasses = 2L; (desired) */ -/* results in */ -/* QuantizedValues[] = {18.0F, 18.0F}; */ -/* NumberOfClasses = 1L; (actual) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin HistogramEqualize */ - - double Mean, Norm, Threshold; - long i, j, k; - int LessClasses; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(HistogramEqualize, Frequency, Status, -/**/ "Missing input Frequency") -/**/DEBUG_CHECK_NULL_POINTER(HistogramEqualize, Value, Status, -/**/ "Missing input Value") -/**/DEBUG_CHECK_NULL_POINTER(HistogramEqualize, EqualizedValue, Status, -/**/ "Missing output EqualizedValue") -/**/DEBUG_CHECK_NULL_POINTER(HistogramEqualize, NumberOfClasses, Status, -/**/ "Missing in-place NumberOfClasses") -/**/DEBUG_CHECK_RANGE_LONG(HistogramEqualize, HistogramLength, 1L, LONG_MAX, Status, -/**/ "Invalid HistogramLength (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(HistogramEqualize, *NumberOfClasses, 1L, LONG_MAX, Status, -/**/ "Invalid NumberOfClasses (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_DOUBLE(HistogramEqualize, Tolerance, 0.0, DBL_MAX, Status, -/**/ "Invalid Tolerance (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(HistogramEqualize, Status) -/**/DEBUG_WRITE_ENTERING(HistogramEqualize, -/**/ "About to execute HistogramEqualize") - - if (HistogramLength < *NumberOfClasses) { - WRITE_WARNING(HistogramEqualize, "Reducing the number of classes") - *NumberOfClasses = HistogramLength; - } - Threshold = 1.0 / (double)*NumberOfClasses; - Norm = 0.0; - for (i = 0L; (i < HistogramLength); i++) { - if (Frequency[i] <= 0.0) { - Status = ERROR; - WRITE_ERROR(HistogramEqualize, "Invalid Frequency[i] (should be strictly positive)") -/**/ DEBUG_WRITE_LEAVING(HistogramEqualize, "Done") - return(Status); - } - if (Threshold < Frequency[i]) { - WRITE_WARNING(HistogramEqualize, "Reducing the number of classes") - *NumberOfClasses = (long)floor(1.0 / Frequency[i]); - Threshold = 1.0 / (double)*NumberOfClasses; - } - Norm += Frequency[i]; - } - if (Tolerance < ((Norm - 1.0) * (Norm - 1.0))) { - Status = ERROR; - WRITE_ERROR(HistogramEqualize, "Invalid Frequency[] (should have unit sum)") -/**/ DEBUG_WRITE_LEAVING(HistogramEqualize, "Done") - return(Status); - } - for (i = 1L; (i < HistogramLength); i++) { - if (Value[i] <= Value[i - 1L]) { - Status = ERROR; - WRITE_ERROR(HistogramEqualize, "Invalid Value[] (should be strictly increasing)") -/**/ DEBUG_WRITE_LEAVING(HistogramEqualize, "Done") - return(Status); - } - } - do { - LessClasses = FALSE; - EqualizedValue[0] = (float)Frequency[0]; - for (i = 1L; (i < HistogramLength); i++) { - EqualizedValue[i] = (float)((double)EqualizedValue[i - 1L] + Frequency[i]); - } - k = 0L; - for (i = 1L; (i < *NumberOfClasses); i++) { - Mean = 0.0; - Norm = 0.0; - Threshold = (float)((double)i / (double)*NumberOfClasses); - j = k; - while (EqualizedValue[j] <= Threshold) { - Mean += Frequency[j] * (double)Value[j]; - Norm += Frequency[j++]; - } - if (Norm < Tolerance) { - WRITE_WARNING(HistogramEqualize, "Reducing the number of classes") - (*NumberOfClasses)--; - LessClasses = TRUE; - break; - } - Mean /= Norm; - while (EqualizedValue[k] <= Threshold) { - EqualizedValue[k++] = (float)Mean; - } - } - if (LessClasses) { - continue; - } - Mean = 0.0; - Norm = 0.0; - j = k; - while (j < HistogramLength) { - Mean += Frequency[j] * (double)Value[j]; - Norm += Frequency[j++]; - } - if (Norm < Tolerance) { - WRITE_WARNING(HistogramEqualize, "Reducing the number of classes") - (*NumberOfClasses)--; - LessClasses = TRUE; - continue; - } - Mean /= Norm; - while (k < HistogramLength) { - EqualizedValue[k++] = (float)Mean; - } - } while (LessClasses); -/**/DEBUG_WRITE_LEAVING(HistogramEqualize, "Done") - return(Status); -} /* end HistogramEqualize */ - -/*--------------------------------------------------------------------------*/ -extern int HistogramGetSize - ( - float *VolumeSource, /* data to process */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long *HistogramLength, /* output length of the histogram */ - int *Status /* error management */ - ) - -/* determination of the number of differing data values in a volume */ -/* VolumeSource is a (float)volume of size (Nx x Ny x Nz) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin HistogramGetSize */ - - struct TOrderedTree - *Root; - struct TOrderedTree - *u, *v; - float *p; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(HistogramGetSize, VolumeSource, *Status, -/**/ "Missing input VolumeSource") -/**/DEBUG_CHECK_NULL_POINTER(HistogramGetSize, HistogramLength, *Status, -/**/ "Missing output HistogramLength") -/**/DEBUG_CHECK_RANGE_LONG(HistogramGetSize, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid volume width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(HistogramGetSize, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid volume height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(HistogramGetSize, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid volume depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(HistogramGetSize, *Status) -/**/DEBUG_WRITE_ENTERING(HistogramGetSize, -/**/ "About to execute HistogramGetSize") - - p = VolumeSource + (ptrdiff_t)(Nx * Ny * Nz - 1L); - Root = (struct TOrderedTree *)malloc(sizeof(struct TOrderedTree)); - if (Root == (struct TOrderedTree *)NULL) { - *Status = ERROR; - WRITE_ERROR(HistogramGetSize, "Unable to perform allocation of Root") -/**/ DEBUG_WRITE_LEAVING(HistogramGetSize, "Done") - return(*Status); - } - Root->Value = *p; - *HistogramLength = 1L; - Root->LowerBranch = (struct TOrderedTree *)NULL; - Root->HigherBranch = (struct TOrderedTree *)NULL; - Root->Trunk = (struct TOrderedTree *)NULL; - while (VolumeSource <= --p) { - u = Root; - do { - if (*p == u->Value) { - u = Root; - } - else { - if (*p < u->Value) { - v = u->LowerBranch; - if (v == (struct TOrderedTree *)NULL) { - v = (struct TOrderedTree *)malloc(sizeof(struct TOrderedTree)); - if (v == (struct TOrderedTree *)NULL) { - *Status = ERROR; - FreeTree(&Root); - WRITE_ERROR(HistogramGetSize, "Unable to perform allocation of a low leaf") -/**/ DEBUG_WRITE_LEAVING(HistogramGetSize, "Done") - return(*Status); - } - v->Value = *p; - (*HistogramLength)++; - v->LowerBranch = (struct TOrderedTree *)NULL; - v->HigherBranch = (struct TOrderedTree *)NULL; - v->Trunk = u; - u->LowerBranch = v; - u = Root; - } - else { - u = v; - } - } - else { - v = u->HigherBranch; - if (v == (struct TOrderedTree *)NULL) { - v = (struct TOrderedTree *)malloc(sizeof(struct TOrderedTree)); - if (v == (struct TOrderedTree *)NULL) { - *Status = ERROR; - FreeTree(&Root); - WRITE_ERROR(HistogramGetSize, "Unable to perform allocation of a high leaf") -/**/ DEBUG_WRITE_LEAVING(HistogramGetSize, "Done") - return(*Status); - } - v->Value = *p; - (*HistogramLength)++; - v->LowerBranch = (struct TOrderedTree *)NULL; - v->HigherBranch = (struct TOrderedTree *)NULL; - v->Trunk = u; - u->HigherBranch = v; - u = Root; - } - else { - u = v; - } - } - } - } while (u != Root); - } - FreeTree(&Root); -/**/DEBUG_WRITE_LEAVING(HistogramGetSize, "Done") - return(*Status); -} /* end HistogramGetSize */ - -/*--------------------------------------------------------------------------*/ -extern int HistogramKMeans - ( - double Frequency[], /* histogram ordinates */ - float Value[], /* histogram abscissa */ - float QuantizedValue[], /* output vector of abscissa */ - long HistogramLength, /* length of the histogram */ - long *NumberOfClasses, /* number of classes, desired -> actual */ - double Tolerance, /* admissible relative error */ - int *Status /* error management */ - ) - -/* construction of the lookup table */ -/* Value[k] <-> QuantizedValue[k] */ -/* minimization of */ -/* sum(k) Frequency[k] * (Value[k] - QuantizedValue[k])^2 */ -/* under the constraint */ -/* DistinctElements(QuantizedValue[]) == NumberOfClasses */ -/* Frequency[] is a (double)array of length HistogramLength */ -/* the content of Frequency[] must be strictly positive */ -/* the content of Frequency[] must have unit sum */ -/* Value[] is a (float)array of length HistogramLength */ -/* the content of Value[] must be sorted in strictly ascending order */ -/* QuantizedValue[] is a returned (float)array of length HistogramLength */ -/* on input, NumberOfClasses indicates the desired number of classes */ -/* on output, NumberOfClasses returns the effective number of classes */ -/* NumberOfClasses never increases */ -/* important cases that go undetected (unfortunately): */ -/* 1. convergence to a non-global optimum */ -/* e.g., Frequency[] = {0.25, 0.25, 0.25, 0.25}; */ -/* Value[] = {1.0F, 2.0F, 10.0F, 20.0F}; */ -/* NumberOfClasses = 3L; */ -/* results in the local optimum */ -/* QuantizedValues[] = {1.0F, 2.0F, 15.0F, 15.0F}; */ -/* instead of the true global optimum */ -/* QuantizedValues[] = {1.5F, 1.5F, 10.0F, 20.0F}; */ -/* 2. there may be more than one global optimum */ -/* e.g., Frequency[] = {1.0 / 3.0, 1.0 / 3.0, 1.0 / 3.0}; */ -/* Value[] = {-1.0F, 0.0F, 1.0F}; */ -/* NumberOfClasses = 2L; */ -/* results in the global optimum */ -/* QuantizedValues[] = {-0.5F, -0.5F, 1.0F}; */ -/* the other global optimum is ignored */ -/* QuantizedValues[] = {-1.0F, 0.5F, 0.5F}; */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin HistogramKMeans */ - - float *Threshold, *ClassRepresentative; - double Mean, Norm; - float Old; - long i, j, k; - int Modified, LessClasses; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(HistogramKMeans, Frequency, *Status, -/**/ "Missing input Frequency") -/**/DEBUG_CHECK_NULL_POINTER(HistogramKMeans, Value, *Status, -/**/ "Missing input Value") -/**/DEBUG_CHECK_NULL_POINTER(HistogramKMeans, QuantizedValue, *Status, -/**/ "Missing output QuantizedValue") -/**/DEBUG_CHECK_NULL_POINTER(HistogramKMeans, NumberOfClasses, *Status, -/**/ "Missing in-place NumberOfClasses") -/**/DEBUG_CHECK_RANGE_LONG(HistogramKMeans, HistogramLength, 1L, LONG_MAX, *Status, -/**/ "Invalid HistogramLength (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(HistogramKMeans, *NumberOfClasses, 1L, LONG_MAX, *Status, -/**/ "Invalid NumberOfClasses (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_DOUBLE(HistogramKMeans, Tolerance, 0.0, DBL_MAX, *Status, -/**/ "Invalid Tolerance (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(HistogramKMeans, *Status) -/**/DEBUG_WRITE_ENTERING(HistogramKMeans, -/**/ "About to execute HistogramKMeans") - - if (HistogramLength < *NumberOfClasses) { - WRITE_WARNING(HistogramKMeans, "Reducing the number of classes") - *NumberOfClasses = HistogramLength; - } - Norm = 0.0; - for (i = 0L; (i < HistogramLength); i++) { - if (Frequency[i] <= 0.0) { - *Status = ERROR; - WRITE_ERROR(HistogramKMeans, "Invalid Frequency[i] (should be strictly positive)") -/**/ DEBUG_WRITE_LEAVING(HistogramKMeans, "Done") - return(*Status); - } - Norm += Frequency[i]; - } - if (Tolerance < ((Norm - 1.0) * (Norm - 1.0))) { - *Status = ERROR; - WRITE_ERROR(HistogramKMeans, "Invalid Frequency[] (should have unit sum)") -/**/ DEBUG_WRITE_LEAVING(HistogramKMeans, "Done") - return(*Status); - } - for (i = 1L; (i < HistogramLength); i++) { - if (Value[i] <= Value[i - 1L]) { - *Status = ERROR; - WRITE_ERROR(HistogramKMeans, "Invalid Value[] (should be strictly increasing)") -/**/ DEBUG_WRITE_LEAVING(HistogramKMeans, "Done") - return(*Status); - } - } - if (*NumberOfClasses == 1L) { - Mean = 0.0; - for (k = 0L; (k < HistogramLength); k++) { - Mean += Frequency[k] * (double)Value[k]; - } - for (k = 0L; (k < HistogramLength); k++) { - QuantizedValue[k] = (float)Mean; - } -/**/ DEBUG_WRITE_LEAVING(HistogramKMeans, "Done") - return(*Status); - } - Threshold = (float *)malloc((size_t)((*NumberOfClasses - 1L) * (long)sizeof(float))); - if (Threshold == (float *)NULL) { - *Status = ERROR; - WRITE_ERROR(HistogramKMeans, "Unable to allocate Threshold") -/**/ DEBUG_WRITE_LEAVING(HistogramKMeans, "Done") - return(*Status); - } - ClassRepresentative = (float *)malloc((size_t)(*NumberOfClasses * (long)sizeof(float))); - if (ClassRepresentative == (float *)NULL) { - *Status = ERROR; - free(Threshold); - WRITE_ERROR(HistogramKMeans, "Unable to allocate ClassRepresentative") -/**/ DEBUG_WRITE_LEAVING(HistogramKMeans, "Done") - return(*Status); - } - do { - LessClasses = FALSE; - if (*NumberOfClasses == 1L) { - Mean = 0.0; - for (k = 0L; (k < HistogramLength); k++) { - Mean += Frequency[k] * (double)Value[k]; - } - for (k = 0L; (k < HistogramLength); k++) { - QuantizedValue[k] = (float)Mean; - } - free(ClassRepresentative); - free(Threshold); -/**/ DEBUG_WRITE_LEAVING(HistogramKMeans, "Done") - return(*Status); - } - j = (HistogramLength - 1L) / (*NumberOfClasses - 1L); - for (i = 0L; (i < *NumberOfClasses); i++) { - ClassRepresentative[i] = Value[i * j]; - } - for (i = 0L; (i < (*NumberOfClasses - 1L)); i++) { - Threshold[i] = (float)(0.5 * ((double)ClassRepresentative[i] - + (double)ClassRepresentative[i + 1L])); - } - do { - Modified = FALSE; - k = 0L; - for (i = 0L; (i < (*NumberOfClasses - 1L)); i++) { - Mean = 0.0; - Norm = 0.0; - while (Value[k] < Threshold[i]) { - Mean += Frequency[k] * (double)Value[k]; - Norm += Frequency[k++]; - } - if (Norm < Tolerance) { - WRITE_WARNING(HistogramKMeans, "Reducing the number of classes") - (*NumberOfClasses)--; - LessClasses = TRUE; - break; - } - Old = ClassRepresentative[i]; - ClassRepresentative[i] = (float)(Mean / Norm); - Modified = (Modified || (Tolerance < ((Old - - ClassRepresentative[i]) * (Old - ClassRepresentative[i])))); - } - if (LessClasses) { - break; - } - Mean = 0.0; - Norm = 0.0; - while (k < HistogramLength) { - Mean += Frequency[k] * (double)Value[k]; - Norm += Frequency[k++]; - } - if (Norm < Tolerance) { - WRITE_WARNING(HistogramKMeans, "Reducing the number of classes") - (*NumberOfClasses)--; - LessClasses = TRUE; - break; - } - Old = ClassRepresentative[*NumberOfClasses - 1L]; - ClassRepresentative[*NumberOfClasses - 1L] = (float)(Mean / Norm); - Modified = (Modified || (Tolerance < ((Old - - ClassRepresentative[*NumberOfClasses - 1L]) * (Old - - ClassRepresentative[*NumberOfClasses - 1L])))); - for (i = 0L; (i < (*NumberOfClasses - 1L)); i++) { - Old = Threshold[i]; - Threshold[i] = (float)(0.5 * ((double)ClassRepresentative[i] - + (double)ClassRepresentative[i + 1L])); - Modified = (Modified || (Tolerance < ((Old - Threshold[i]) - * (Old - Threshold[i])))); - } - } while (Modified); - if (LessClasses) { - continue; - } - k = 0L; - for (i = 0L; (i < (*NumberOfClasses - 1L)); i++) { - while (Value[k] < Threshold[i]) { - QuantizedValue[k++] = ClassRepresentative[i]; - } - } - while (k < HistogramLength) { - QuantizedValue[k++] = ClassRepresentative[*NumberOfClasses - 1L]; - } - } while (LessClasses); - free(ClassRepresentative); - free(Threshold); -/**/DEBUG_WRITE_LEAVING(HistogramKMeans, "Done") - return(*Status); -} /* end HistogramKMeans */ - diff --git a/src/core/bilib/histogram.h b/src/core/bilib/histogram.h deleted file mode 100644 index 68def2f..0000000 --- a/src/core/bilib/histogram.h +++ /dev/null @@ -1,139 +0,0 @@ -/**@defgroup BilibHistograms Histograms - @ingroup BilibLibrary */ -//@{ -/*--------------------------------------------------------------------------*/ -/** Build histogram. - Computation of the frequencies of occurrence of data values. - VolumeSource is a (float)volume of size (Nx x Ny x Nz). - Value[] is a (float)array of length previously determined by - HistogramGetSize. The returned content of Value[] is sorted in strict - ascending order. Frequency[] is a (double)array of length previously - determined by HistogramGetSize. - - success: return(!ERROR); failure: return(ERROR) -*/ -extern int HistogramBuild - ( - float *VolumeSource, /* data to process */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - double Frequency[], /* output vector of ordinates */ - float Value[], /* output vector of abscissa */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Equalize histogram. - * Construction of the lookup table: Value[k] <-> EqualizedValue[k]. - * EqualizedValue[] satisfies: - * @code - * sum(k in K(n0)) Frequency[k] ~=~ sum(k in K(n1)) Frequency[k] - * for all n0, n1 in [0L, NumberOfClasses - 1L] - * @endcode - * where ~=~ means "is about equal to", and where K(n) is a domain such that - * @code - * EqualizedValue[k0] = (sum(k1 in K(n)) Frequency[k1] * Value[k1]) - * / (sum(k2 in K(n)) Frequency[k2]) - * for all k0 in K(n) - * @endcode - * under the constraint - * @code - * DistinctElements(QuantizedValue[]) == NumberOfClasses - * @endcode - * - * Frequency[] is a (double)array of length HistogramLength. - * The content of Frequency[] must be strictly positive. - * The content of Frequency[] must have unit sum. - * Value[] is a (float)array of length HistogramLength. - * The content of Value[] must be sorted in strictly ascending order. - * EqualizedValue[] is a returned (float)array of length HistogramLength. - * - * On input, NumberOfClasses indicates the desired number of classes. - * On output, NumberOfClasses returns the effective number of classes. - * NumberOfClasses is no greater than (1.0 / max(Frequency[])), and never - * increases. - * - * It may happen that the only solution that satisfies all constraints is - * undesirable - * e.g., Frequency[] = {0.9, 0.1}; - * Value[] = {10.0F, 90.0F}; - * NumberOfClasses = 2L; (desired) - * results in - * QuantizedValues[] = {18.0F, 18.0F}; - * NumberOfClasses = 1L; (actual) - * - * success: return(!ERROR); failure: return(ERROR) -*/ -extern int HistogramEqualize - ( - double Frequency[], /* histogram ordinates */ - float Value[], /* histogram abscissa */ - float EqualizedValue[], /* output vector of abscissa */ - long HistogramLength, /* length of the histogram */ - long *NumberOfClasses, /* number of classes, desired -> actual */ - double Tolerance /* admissible relative error */ - ); - -/*--------------------------------------------------------------------------*/ -/** Get size of histogram. - Determination of the number of differing data values in a volume. - VolumeSource is a (float)volume of size (Nx x Ny x Nz). - - success: return(!ERROR); failure: return(ERROR) */ -extern int HistogramGetSize - ( - float *VolumeSource, /* data to process */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long *HistogramLength, /* output length of the histogram */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Histogram K means. - Construction of the lookup table: Value[k] <-> QuantizedValue[k]. - Minimization of sum(k) Frequency[k] * (Value[k] - QuantizedValue[k])^2. - under the constraint DistinctElements(QuantizedValue[]) == NumberOfClasses. - - Frequency[] is a (double)array of length HistogramLength. The content of - Frequency[] must be strictly positive. The content of Frequency[] must have - unit sum. Value[] is a (float)array of length HistogramLength. - The content of Value[] must be sorted in strictly ascending order. - QuantizedValue[] is a returned (float)array of length HistogramLength. - - On input, NumberOfClasses indicates the desired number of classes. - On output, NumberOfClasses returns the effective number of classes. - NumberOfClasses never increases. - - Important cases that go undetected (unfortunately): - 1. convergence to a non-global optimum - e.g., Frequency[] = {0.25, 0.25, 0.25, 0.25}; - Value[] = {1.0F, 2.0F, 10.0F, 20.0F}; - NumberOfClasses = 3L; - results in the local optimum - QuantizedValues[] = {1.0F, 2.0F, 15.0F, 15.0F}; - instead of the true global optimum - QuantizedValues[] = {1.5F, 1.5F, 10.0F, 20.0F}; - - 2. there may be more than one global optimum - e.g., Frequency[] = {1.0 / 3.0, 1.0 / 3.0, 1.0 / 3.0}; - Value[] = {-1.0F, 0.0F, 1.0F}; - NumberOfClasses = 2L; - results in the global optimum - QuantizedValues[] = {-0.5F, -0.5F, 1.0F}; - the other global optimum is ignored - QuantizedValues[] = {-1.0F, 0.5F, 0.5F}; - - success: return(!ERROR); failure: return(ERROR) */ -extern int HistogramKMeans - ( - double Frequency[], /* histogram ordinates */ - float Value[], /* histogram abscissa */ - float QuantizedValue[], /* output vector of abscissa */ - long HistogramLength, /* length of the histogram */ - long *NumberOfClasses, /* number of classes, desired -> actual */ double Tolerance, /* admissible relative error */ - int *Status /* error management */ - ); -//@} diff --git a/src/core/bilib/iirconvolve.cc b/src/core/bilib/iirconvolve.cc deleted file mode 100644 index ba9e16f..0000000 --- a/src/core/bilib/iirconvolve.cc +++ /dev/null @@ -1,853 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -#include -#include -#include -#include -#include - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" -#include "error.h" -#include "tboundaryconvention.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "convert.h" -#include "getput.h" -#include "getputd.h" -#include "iirconvolve.h" -#include "messagedisplay.h" -#include "positivepower.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -#ifdef DEBUG -#include -#include -#endif - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern int IirConvolveCanonicProgressive - ( - double InputData[], /* data to process */ - double OutputData[], /* result */ - long SignalLength, /* length of the 1D data array */ - double Kernel[], /* kernel */ - double RightInit[], /* progressive recursion initialization */ - long KernelLength /* length of the 1D kernel */ - ) - -/* computes OutputData[i] = InputData[i] + SUM(k): OutputData[i + k + 1] * Kernel[k] */ -/* the input and the output have the same length */ -/* the kernel and the initial output values have the same length */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin IirConvolveCanonicProgressive */ - - double *p, *q; - double Sum; - long i, j; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(IirConvolveCanonicProgressive, InputData, Status, -/**/ "No input data") -/**/DEBUG_CHECK_NULL_POINTER(IirConvolveCanonicProgressive, OutputData, Status, -/**/ "No output data") -/**/DEBUG_CHECK_RANGE_LONG(IirConvolveCanonicProgressive, SignalLength, 1L, LONG_MAX, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_CHECK_NULL_POINTER(IirConvolveCanonicProgressive, Kernel, Status, -/**/ "No kernel") -/**/DEBUG_CHECK_NULL_POINTER(IirConvolveCanonicProgressive, RightInit, Status, -/**/ "No initialization") -/**/DEBUG_CHECK_RANGE_LONG(IirConvolveCanonicProgressive, KernelLength, 1L, LONG_MAX, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(IirConvolveCanonicProgressive, Status) -/**/DEBUG_WRITE_ENTERING(IirConvolveCanonicProgressive, -/**/ "About to perform IIR progressive canonic convolution") - -/* - if (KernelLength <= SignalLength) { - for (i = SignalLength - 1L; ((SignalLength - KernelLength) <= i); i--) { - Sum = InputData[i]; - for (j = KernelLength - 1L; ((SignalLength - i - 1L) <= j); j--) { - Sum += RightInit[i - SignalLength + j + 1L] * Kernel[j]; - } - while (0L <= j) { - Sum += OutputData[i + j + 1L] * Kernel[j]; - j--; - } - OutputData[i] = Sum; - } - while (0L <= i) { - Sum = InputData[i]; - for (j = KernelLength - 1L; (0L <= j); j--) { - Sum += OutputData[i + j + 1L] * Kernel[j]; - } - OutputData[i] = Sum; - i--; - } - } - else { - for (i = SignalLength - 1L; (0L <= i); i--) { - Sum = InputData[i]; - for (j = KernelLength - 1L; ((SignalLength - i - 1L) <= j); j--) { - Sum += RightInit[i - SignalLength + j + 1L] * Kernel[j]; - } - while (0L <= j) { - Sum += OutputData[i + j + 1L] * Kernel[j]; - j--; - } - OutputData[i] = Sum; - } - } -*/ - InputData += (ptrdiff_t)(SignalLength - 1L); - OutputData += (ptrdiff_t)(SignalLength - 1L); - RightInit += (ptrdiff_t)(KernelLength - 1L); - Kernel += (ptrdiff_t)(KernelLength - 1L); - if (KernelLength <= SignalLength) { - for (i = SignalLength - 1L; ((SignalLength - KernelLength) <= i); i--) { - Sum = *InputData--; - p = RightInit--; - q = Kernel; - for (j = KernelLength - 1L; ((SignalLength - i - 1L) <= j); j--) { - Sum += *p-- * *q--; - } - p = OutputData + (ptrdiff_t)(j + 1L); - while (0L <= j--) { - Sum += *p-- * *q--; - } - *OutputData-- = Sum; - } - while (0L <= i--) { - Sum = *InputData--; - p = OutputData + (ptrdiff_t)KernelLength; - q = Kernel; - for (j = KernelLength - 1L; (0L <= j); j--) { - Sum += *p-- * *q--; - } - *OutputData-- = Sum; - } - } - else { - for (i = SignalLength - 1L; (0L <= i); i--) { - Sum = *InputData--; - p = RightInit--; - q = Kernel; - for (j = KernelLength - 1L; ((SignalLength - i - 1L) <= j); j--) { - Sum += *p-- * *q--; - } - p = OutputData + (ptrdiff_t)(j + 1L); - while (0L <= j--) { - Sum += *p-- * *q--; - } - *OutputData-- = Sum; - } - } -/**/DEBUG_WRITE_LEAVING(IirConvolveCanonicProgressive, "Done") - return(Status); -} /* end IirConvolveCanonicProgressive */ - -/*--------------------------------------------------------------------------*/ -extern int IirConvolveCanonicRegressive - ( - double InputData[], /* data to process */ - double OutputData[], /* result */ - long SignalLength, /* length of the 1D data array */ - double Kernel[], /* kernel */ - double LeftInit[], /* regressive recursion initialization */ - long KernelLength /* length of the 1D kernel */ - ) - -/* computes OutputData[i] = InputData[i] + SUM(k): OutputData[i - k - 1] * Kernel[k] */ -/* the input and the output have the same length */ -/* the kernel and the initial output values have the same length */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin IirConvolveCanonicRegressive */ - - double *p, *q; - double Sum; - long i, j; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(IirConvolveCanonicRegressive, InputData, Status, -/**/ "No input data") -/**/DEBUG_CHECK_NULL_POINTER(IirConvolveCanonicRegressive, OutputData, Status, -/**/ "No output data") -/**/DEBUG_CHECK_RANGE_LONG(IirConvolveCanonicRegressive, SignalLength, 1L, LONG_MAX, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_CHECK_NULL_POINTER(IirConvolveCanonicRegressive, Kernel, Status, -/**/ "No kernel") -/**/DEBUG_CHECK_NULL_POINTER(IirConvolveCanonicRegressive, LeftInit, Status, -/**/ "No initialization") -/**/DEBUG_CHECK_RANGE_LONG(IirConvolveCanonicRegressive, KernelLength, 1L, LONG_MAX, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(IirConvolveCanonicRegressive, Status) -/**/DEBUG_WRITE_ENTERING(IirConvolveCanonicRegressive, -/**/ "About to perform IIR regressive canonic convolution") - -/* - if (KernelLength < SignalLength) { - for (i = 0L; (i <= KernelLength); i++) { - Sum = InputData[i]; - for (j = 0L; (j < i); j++) { - Sum += OutputData[i - j - 1L] * Kernel[j]; - } - while (j < KernelLength) { - Sum += LeftInit[KernelLength + i - j - 1L] * Kernel[j]; - j++; - } - OutputData[i] = Sum; - } - while (i < SignalLength) { - Sum = InputData[i]; - for (j = 0L; (j < KernelLength); j++) { - Sum += OutputData[i - j - 1L] * Kernel[j]; - } - OutputData[i] = Sum; - i++; - } - } - else { - for (i = 0L; (i < SignalLength); i++) { - Sum = InputData[i]; - for (j = 0L; (j < i); j++) { - Sum += OutputData[i - j - 1L] * Kernel[j]; - } - while (j < KernelLength) { - Sum += LeftInit[KernelLength + i - j - 1L] * Kernel[j]; - j++; - } - OutputData[i] = Sum; - } - } -*/ - LeftInit += (ptrdiff_t)(KernelLength - 1L); - if (KernelLength < SignalLength) { - for (i = 0L; (i <= KernelLength); i++) { - Sum = *InputData++; - p = OutputData - (ptrdiff_t)1L; - q = Kernel; - for (j = 0L; (j < i); j++) { - Sum += *p-- * *q++; - } - p = LeftInit; - while (j++ < KernelLength) { - Sum += *p-- * *q++; - } - *OutputData++ = Sum; - } - while (i++ < SignalLength) { - Sum = *InputData++; - p = OutputData - (ptrdiff_t)1L; - q = Kernel; - for (j = 0L; (j < KernelLength); j++) { - Sum += *p-- * *q++; - } - *OutputData++ = Sum; - } - } - else { - for (i = 0L; (i < SignalLength); i++) { - Sum = *InputData++; - p = OutputData - (ptrdiff_t)1L; - q = Kernel; - for (j = 0L; (j < i); j++) { - Sum += *p-- * *q++; - } - p = LeftInit; - while (j++ < KernelLength) { - Sum += *p-- * *q++; - } - *OutputData++ = Sum; - } - } -/**/DEBUG_WRITE_LEAVING(IirConvolveCanonicRegressive, "Done") - return(Status); -} /* end IirConvolveCanonicRegressive */ - -/*--------------------------------------------------------------------------*/ -extern int IirConvolvePoles - ( - double InputData[], /* data to process */ - double OutputData[], /* result */ - long SignalLength, /* length of the 1D data array */ - double RealPoles[], /* array of real poles */ - long PoleNumber, /* number of poles */ - enum TBoundaryConvention - Convention, /* boundary convention */ - double Tolerance /* admissible relative error */ - ) - -/* the input and the output have the same length */ -/* in-place processing is allowed */ -/* no more than two poles are allowed for a finite support boundary */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin IirConvolvePoles */ - - double *p, *q; - double Sum, Gain; - double z, z0, z1, z2, iz; - long Horizon; - long i, j; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(IirConvolvePoles, InputData, Status, -/**/ "No input data") -/**/DEBUG_CHECK_NULL_POINTER(IirConvolvePoles, OutputData, Status, -/**/ "No output data") -/**/DEBUG_CHECK_RANGE_LONG(IirConvolvePoles, SignalLength, 1L, LONG_MAX, Status, -/**/ "Invalid length (should be strictly positive)") -/**/DEBUG_CHECK_NULL_POINTER(IirConvolvePoles, RealPoles, Status, -/**/ "No poles") -/**/DEBUG_CHECK_RANGE_LONG(IirConvolvePoles, PoleNumber, 1L, LONG_MAX, Status, -/**/ "Invalid number of poles (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_DOUBLE(IirConvolvePoles, Tolerance, 0.0, DBL_MAX, Status, -/**/ "Invalid Tolerance (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(IirConvolvePoles, Status) -/**/DEBUG_WRITE_ENTERING(IirConvolvePoles, -/**/ "About to perform IIR recursive convolution") - - Gain = 1.0; - for (i = 0L; (i < PoleNumber); i++) { - z = RealPoles[i]; - if (fabs(z) < Tolerance) { - Status = ERROR; - WRITE_ERROR(IirConvolvePoles, "Invalid pole (too small)") -/**/ DEBUG_WRITE_LEAVING(IirConvolvePoles, "Done") - return(Status); - } - z1 = 1.0 - z; - Gain *= -(z1 * z1) / z; - } - p = InputData; - q = OutputData; - for (i = -SignalLength; (i < 0L); i++) { - *q++ = *p++ * Gain; - } - switch (Convention) { - case AntiMirrorOnBounds: - if (SignalLength == 1L) { - *OutputData = *InputData; -/**/ DEBUG_WRITE_LEAVING(IirConvolvePoles, "Done") - return(Status); - } - for (i = 0L; (i < PoleNumber); i++) { - z = RealPoles[i]; - Sum = ((1.0 + z) / (1.0 - z)) * (OutputData[0] - - PositiveIntPower(z, SignalLength - 1L) * OutputData[SignalLength - 1L]); - z1 = z; - z2 = PositiveIntPower(z, 2L * SignalLength - 3L); - iz = 1.0 / z; - for (j = 1L; (j < (SignalLength - 1L)); j++) { - Sum += (z2 - z1) * OutputData[j]; - z1 *= z; - z2 *= iz; - } - OutputData[0] = Sum / (1.0 - PositiveIntPower(z, 2L * SignalLength - 2L)); - for (j = 1L; (j < SignalLength); j++) { - OutputData[j] += z * OutputData[j - 1L]; - } - OutputData[SignalLength - 1L] = (-z / ((1.0 - z) * (1.0 - z))) - * (OutputData[SignalLength - 1L] - z * OutputData[SignalLength - 2L]); - for (j = SignalLength - 2L; (0L <= j); j--) { - OutputData[j] = z * (OutputData[j + 1L] - OutputData[j]); - } - } - break; - case FiniteCoefficientSupport: - switch (PoleNumber) { - case 1L: - z = RealPoles[0]; - Sum = 0.0; - z1 = z; - z2 = PositiveIntPower(z, 2L * SignalLength - 1L); - iz = 1.0 / z; - for (j = 1L; (j < SignalLength); j++) { - Sum += (z1 - z2) * OutputData[j]; - z1 *= z; - z2 *= iz; - } - z2 = z * z; - OutputData[0] -= Sum * z2 / (1.0 - z2); - OutputData[0] *= (1.0 - z2) - / (1.0 - PositiveIntPower(z2, SignalLength + 1L)); - for (j = 1L; (j < SignalLength); j++) { - OutputData[j] += z * OutputData[j - 1L]; - } - OutputData[SignalLength - 1L] *= -z; - for (j = SignalLength - 2L; (0L <= j); j--) { - OutputData[j] = z * (OutputData[j + 1L] - OutputData[j]); - } - break; - default: - Status = ERROR; - WRITE_ERROR(IirConvolvePoles, - "Invalid number of poles (should be 1 for FiniteCoefficientSupport)") - break; - } - break; - case FiniteDataSupport: - switch (PoleNumber) { - case 1L: - z = RealPoles[0]; - for (j = 1L; (j < SignalLength); j++) { - OutputData[j] += z * OutputData[j - 1L]; - } - OutputData[SignalLength - 1L] *= z / (z * z - 1.0); - for (j = SignalLength - 2L; (0L <= j); j--) { - OutputData[j] = z * (OutputData[j + 1L] - OutputData[j]); - } - break; - case 2L: - z0 = RealPoles[0]; - for (j = 1L; (j < SignalLength); j++) { - OutputData[j] += z0 * OutputData[j - 1L]; - } - OutputData[SignalLength - 1L] *= z0 / (z0 * z0 - 1.0); - z = OutputData[SignalLength - 1L]; - for (j = SignalLength - 2L; (0L <= j); j--) { - OutputData[j] = z0 * (OutputData[j + 1L] - OutputData[j]); - } - z1 = RealPoles[1]; - OutputData[0] /= 1.0 - z0 * z1; - for (j = 1L; (j < SignalLength); j++) { - OutputData[j] += z1 * OutputData[j - 1L]; - } - OutputData[SignalLength - 1L] = (z1 / (z1 * z1 - 1.0)) - * (OutputData[SignalLength - 1L] - (z0 * z1 / (z0 * z1 - 1.0)) * z); - for (j = SignalLength - 2L; (0L <= j); j--) { - OutputData[j] = z1 * (OutputData[j + 1L] - OutputData[j]); - } - break; - default: - Status = ERROR; - WRITE_ERROR(IirConvolvePoles, - "Invalid number of poles (should be 1 or 2 for FiniteDataSupport)") - break; - } - break; - case MirrorOffBounds: - if (SignalLength == 1L) { - *OutputData = *InputData; -/**/ DEBUG_WRITE_LEAVING(IirConvolvePoles, "Done") - return(Status); - } - for (i = 0L; (i < PoleNumber); i++) { - z = RealPoles[i]; - Sum = (OutputData[0] + PositiveIntPower(z, SignalLength) - * OutputData[SignalLength - 1L]) * (1.0 + z) / z; - z1 = z; - z2 = PositiveIntPower(z, 2L * SignalLength - 2L); - iz = 1.0 / z; - for (j = 1L; (j < (SignalLength - 1L)); j++) { - Sum += (z2 + z1) * OutputData[j]; - z1 *= z; - z2 *= iz; - } - OutputData[0] = Sum * z / (1.0 - PositiveIntPower(z, 2L * SignalLength)); - for (j = 1L; (j < SignalLength); j++) { - OutputData[j] += z * OutputData[j - 1L]; - } - OutputData[SignalLength - 1L] *= z / (z - 1.0); - for (j = SignalLength - 2L; (0L <= j); j--) { - OutputData[j] = z * (OutputData[j + 1L] - OutputData[j]); - } - } - break; - case MirrorOnBounds: - if (SignalLength == 1L) { - *OutputData = *InputData; -/**/ DEBUG_WRITE_LEAVING(IirConvolvePoles, "Done") - return(Status); - } -/* - for (i = 0L; (i < PoleNumber); i++) { - z = RealPoles[i]; - Sum = OutputData[0] + PositiveIntPower(z, SignalLength - 1L) - * OutputData[SignalLength - 1L]; - for (j = 1L; (j < (SignalLength - 1L)); j++) { - Sum += (PositiveIntPower(z, 2L * SignalLength - 2L - j) - + PositiveIntPower(z, j)) * OutputData[j]; - } - OutputData[0] = Sum / (1.0 - PositiveIntPower(z, 2L * SignalLength - 2L)); - for (j = 1L; (j < SignalLength); j++) { - OutputData[j] += z * OutputData[j - 1L]; - } - OutputData[SignalLength - 1L] = (z / (z * z - 1.0)) - * (z * OutputData[SignalLength - 2L] + OutputData[SignalLength - 1L]); - for (j = SignalLength - 2L; (0L <= j); j--) { - OutputData[j] = z * (OutputData[j + 1L] - OutputData[j]); - } - } -*/ - for (i = 0L; (i < PoleNumber); i++) { - z = *RealPoles++; - if (Tolerance == 0.0) { - Horizon = SignalLength; - } - else { - Horizon = ConvertDoubleToLong(ceil(log(Tolerance) / log(fabs(z)))); - } - if (Horizon < SignalLength) { - z1 = z; - Sum = *OutputData; - p = OutputData; - for (j = -Horizon; (j < 0L); j++) { - Sum += z1 * *++p; - z1 *= z; - } - p = OutputData; - q = OutputData; - *p++ = Sum; - for (j = 1L - SignalLength; (j < 0L); j++) { - *p++ += z * *q++; - } - p = q--; - *p = (z * *q + *p) * z / (z * z - 1.0); - for (j = SignalLength - 2L; (0L <= j); j--) { - *q = z * (*p-- - *q); - q--; - } - } - else { - z1 = z; - z2 = PositiveIntPower(z, SignalLength - 1L); - iz = 1.0 / z; - Sum = *OutputData + z2 * OutputData[SignalLength - 1L]; - z2 *= z2 * iz; - p = OutputData; - for (j = 2L - SignalLength; (j < 0L); j++) { - Sum += (z1 + z2) * *++p; - z1 *= z; - z2 *= iz; - } - p = OutputData; - q = OutputData; - *p++ = Sum / (1.0 - z2 * z2); - for (j = 1L - SignalLength; (j < 0L); j++) { - *p++ += z * *q++; - } - p = q--; - *p = (z * *q + *p) * z / (z * z - 1.0); - for (j = SignalLength - 2L; (0L <= j); j--) { - *q = z * (*p-- - *q); - q--; - } - } - } - break; - case Periodic: - if (SignalLength == 1L) { - *OutputData = *InputData; -/**/ DEBUG_WRITE_LEAVING(IirConvolvePoles, "Done") - return(Status); - } - for (i = 0L; (i < PoleNumber); i++) { - z = RealPoles[i]; - if (Tolerance == 0.0) { - Horizon = SignalLength; - } - else { - Horizon = ConvertDoubleToLong(ceil(log(Tolerance) / log(fabs(z)))); - } - if (Horizon < SignalLength) { - z1 = z; - Sum = OutputData[0]; - for (j = 1L; (j < Horizon); j++) { - Sum += z1 * OutputData[SignalLength - j]; - z1 *= z; - } - OutputData[0] = Sum / (1.0 - PositiveIntPower(z, SignalLength)); - for (j = 1L; (j < SignalLength); j++) { - OutputData[j] += z * OutputData[j - 1L]; - } - z1 = z; - Sum = OutputData[0] + OutputData[SignalLength - 1L] / z; - for (j = 1L; (j < Horizon); j++) { - Sum += z1 * OutputData[j]; - z1 *= z; - } - OutputData[SignalLength - 1L] = Sum * z * z - / (PositiveIntPower(z, SignalLength) - 1.0); - for (j = SignalLength - 2L; (0L <= j); j--) { - OutputData[j] = z * (OutputData[j + 1L] - OutputData[j]); - } - } - else { - z1 = PositiveIntPower(z, SignalLength - 1L); - iz = 1.0 / z; - Sum = OutputData[0]; - for (j = 1L; (j < SignalLength); j++) { - Sum += z1 * OutputData[j]; - z1 *= iz; - } - OutputData[0] = Sum / (1.0 - PositiveIntPower(z, SignalLength)); - for (j = 1L; (j < SignalLength); j++) { - OutputData[j] += z * OutputData[j - 1L]; - } - z1 = z; - Sum = OutputData[0] + OutputData[SignalLength - 1L] / z; - for (j = 1L; (j < (SignalLength - 1L)); j++) { - Sum += z1 * OutputData[j]; - z1 *= z; - } - OutputData[SignalLength - 1L] = Sum * z * z - / (PositiveIntPower(z, SignalLength) - 1.0); - for (j = SignalLength - 2L; (0L <= j); j--) { - OutputData[j] = z * (OutputData[j + 1L] - OutputData[j]); - } - } - } - break; - default: - Status = ERROR; - WRITE_ERROR(IirConvolvePoles, "Invalid boundary convention") - break; - } -/**/DEBUG_WRITE_LEAVING(IirConvolvePoles, "Done") - return(Status); -} /* end IirConvolvePoles */ - -/*--------------------------------------------------------------------------*/ -extern int IirConvolvePolesVolume - ( - double *VolumeSource, /* data to process */ - double *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - double RealPoles[], /* array of real poles */ - long PoleNumber, /* number of poles */ - enum TBoundaryConvention - Convention, /* boundary convention */ - double Tolerance, /* admissible relative error */ - int *Status /* error management */ - ) - -/* no more than two poles are allowed for a finite support boundary */ -/* VolumeSource is a (double)volume of size (Nx x Ny x Nz) */ -/* OutputData is a (double)volume of size (Nx x Ny x Nz) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin IirConvolvePolesVolume */ - - double *Buffer = (double *)NULL, *cBuffer = (double *)NULL; - long i, j, k; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(IirConvolvePolesVolume, VolumeSource, *Status, -/**/ "No VolumeSource") -/**/DEBUG_CHECK_NULL_POINTER(IirConvolvePolesVolume, VolumeDestination, *Status, -/**/ "No OutputData") -/**/DEBUG_CHECK_RANGE_LONG(IirConvolvePolesVolume, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(IirConvolvePolesVolume, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(IirConvolvePolesVolume, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_NULL_POINTER(IirConvolvePolesVolume, RealPoles, *Status, -/**/ "No poles") -/**/DEBUG_CHECK_RANGE_LONG(IirConvolvePolesVolume, PoleNumber, 1L, LONG_MAX, *Status, -/**/ "Invalid number of poles (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_DOUBLE(IirConvolvePolesVolume, Tolerance, 0.0, DBL_MAX, *Status, -/**/ "Invalid Tolerance (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(IirConvolvePolesVolume, *Status) -/**/DEBUG_WRITE_ENTERING(IirConvolvePolesVolume, -/**/ "About to perform IIR recursive convolution for a volume") - - switch (Convention) { - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - default: - *Status = ERROR; - WRITE_ERROR(IirConvolvePolesVolume, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(IirConvolvePolesVolume, "Done") - return(*Status); - } - if (1L < Nx) { - AllocateLineDouble(&Buffer, Nx, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(IirConvolvePolesVolume, "Done") - return(*Status); - } - AllocateLineDouble(&cBuffer, Nx, Status); - if (*Status == ERROR) { - FreeLineDouble(&Buffer); -/**/ DEBUG_WRITE_LEAVING(IirConvolvePolesVolume, "Done") - return(*Status); - } - for (k = 0L; (k < Nz); k++) { - for (j = 0L; (j < Ny); j++) { - *Status = GetxDoubleToDouble(VolumeSource, Nx, Ny, Nz, 0L, j, k, Buffer, Nx); - if (*Status == ERROR) { - FreeLineDouble(&cBuffer); - FreeLineDouble(&Buffer); -/**/ DEBUG_WRITE_LEAVING(IirConvolvePolesVolume, "Done") - return(*Status); - } - *Status = IirConvolvePoles(Buffer, cBuffer, Nx, - RealPoles, PoleNumber, Convention, Tolerance); - if (*Status == ERROR) { - FreeLineDouble(&cBuffer); - FreeLineDouble(&Buffer); -/**/ DEBUG_WRITE_LEAVING(IirConvolvePolesVolume, "Done") - return(*Status); - } - *Status = PutxDoubleToDouble(VolumeDestination, Nx, Ny, Nz, 0L, j, k, cBuffer, Nx); - if (*Status == ERROR) { - FreeLineDouble(&cBuffer); - FreeLineDouble(&Buffer); -/**/ DEBUG_WRITE_LEAVING(IirConvolvePolesVolume, "Done") - return(*Status); - } - } - } - *Status = FreeLineDouble(&cBuffer); - if (*Status == ERROR) { - FreeLineDouble(&Buffer); -/**/ DEBUG_WRITE_LEAVING(IirConvolvePolesVolume, "Done") - return(*Status); - } - *Status = FreeLineDouble(&Buffer); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(IirConvolvePolesVolume, "Done") - return(*Status); - } - } - else { - VolumeDestination = (double *)memcpy(VolumeDestination, VolumeSource, - (size_t)(Nx * Ny * Nz * (long)sizeof(double))); - } - if (1L < Ny) { - AllocateLineDouble(&Buffer, Ny, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(IirConvolvePolesVolume, "Done") - return(*Status); - } - AllocateLineDouble(&cBuffer, Ny, Status); - if (*Status == ERROR) { - FreeLineDouble(&Buffer); -/**/ DEBUG_WRITE_LEAVING(IirConvolvePolesVolume, "Done") - return(*Status); - } - for (k = 0L; (k < Nz); k++) { - for (i = 0L; (i < Nx); i++) { - *Status = GetyDoubleToDouble(VolumeDestination, Nx, Ny, Nz, i, 0L, k, Buffer, Ny); - if (*Status == ERROR) { - FreeLineDouble(&cBuffer); - FreeLineDouble(&Buffer); -/**/ DEBUG_WRITE_LEAVING(IirConvolvePolesVolume, "Done") - return(*Status); - } - *Status = IirConvolvePoles(Buffer, cBuffer, Ny, - RealPoles, PoleNumber, Convention, Tolerance); - if (*Status == ERROR) { - FreeLineDouble(&cBuffer); - FreeLineDouble(&Buffer); -/**/ DEBUG_WRITE_LEAVING(IirConvolvePolesVolume, "Done") - return(*Status); - } - *Status = PutyDoubleToDouble(VolumeDestination, Nx, Ny, Nz, i, 0L, k, cBuffer, Ny); - if (*Status == ERROR) { - FreeLineDouble(&cBuffer); - FreeLineDouble(&Buffer); -/**/ DEBUG_WRITE_LEAVING(IirConvolvePolesVolume, "Done") - return(*Status); - } - } - } - *Status = FreeLineDouble(&cBuffer); - if (*Status == ERROR) { - FreeLineDouble(&Buffer); -/**/ DEBUG_WRITE_LEAVING(IirConvolvePolesVolume, "Done") - return(*Status); - } - *Status = FreeLineDouble(&Buffer); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(IirConvolvePolesVolume, "Done") - return(*Status); - } - } - if (1L < Nz) { - AllocateLineDouble(&Buffer, Nz, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(IirConvolvePolesVolume, "Done") - return(*Status); - } - AllocateLineDouble(&cBuffer, Nz, Status); - if (*Status == ERROR) { - FreeLineDouble(&Buffer); -/**/ DEBUG_WRITE_LEAVING(IirConvolvePolesVolume, "Done") - return(*Status); - } - for (j = 0L; (j < Ny); j++) { - for (i = 0L; (i < Nx); i++) { - *Status = GetzDoubleToDouble(VolumeDestination, Nx, Ny, Nz, i, j, 0L, Buffer, Nz); - if (*Status == ERROR) { - FreeLineDouble(&cBuffer); - FreeLineDouble(&Buffer); -/**/ DEBUG_WRITE_LEAVING(IirConvolvePolesVolume, "Done") - return(*Status); - } - *Status = IirConvolvePoles(Buffer, cBuffer, Nz, - RealPoles, PoleNumber, Convention, Tolerance); - if (*Status == ERROR) { - FreeLineDouble(&cBuffer); - FreeLineDouble(&Buffer); -/**/ DEBUG_WRITE_LEAVING(IirConvolvePolesVolume, "Done") - return(*Status); - } - *Status = PutzDoubleToDouble(VolumeDestination, Nx, Ny, Nz, i, j, 0L, cBuffer, Nz); - if (*Status == ERROR) { - FreeLineDouble(&cBuffer); - FreeLineDouble(&Buffer); -/**/ DEBUG_WRITE_LEAVING(IirConvolvePolesVolume, "Done") - return(*Status); - } - } - } - *Status = FreeLineDouble(&cBuffer); - if (*Status == ERROR) { - FreeLineDouble(&Buffer); -/**/ DEBUG_WRITE_LEAVING(IirConvolvePolesVolume, "Done") - return(*Status); - } - *Status = FreeLineDouble(&Buffer); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(IirConvolvePolesVolume, "Done") - return(*Status); - } - } -/**/DEBUG_WRITE_LEAVING(IirConvolvePolesVolume, "Done") - return(*Status); -} /* end IirConvolvePolesVolume */ - diff --git a/src/core/bilib/iirconvolve.h b/src/core/bilib/iirconvolve.h deleted file mode 100644 index 2d5773b..0000000 --- a/src/core/bilib/iirconvolve.h +++ /dev/null @@ -1,81 +0,0 @@ -#include "tboundaryconvention.h" - -/**@defgroup IIRConvolve IIR Convolve - @ingroup BilibLibrary */ -//@{ -/*--------------------------------------------------------------------------*/ -/** Canonic progressive. - Computes OutputData[i] = InputData[i] + SUM(k): OutputData[i + k + 1] * - Kernel[k]. - The input and the output have the same length. - The kernel and the initial output values have the same length. - - success: return(!ERROR); failure: return(ERROR) */ -extern int IirConvolveCanonicProgressive - ( - double InputData[], /* data to process */ - double OutputData[], /* result */ - long SignalLength, /* length of the 1D data array */ - double Kernel[], /* kernel */ - double RightInit[], /* progressive recursion initialization */ - long KernelLength /* length of the 1D kernel */ - ); - -/*--------------------------------------------------------------------------*/ -/** Canonic regressive. - Computes OutputData[i] = InputData[i] + SUM(k): OutputData[i - k - 1] - * Kernel[k]. The input and the output have the same length. - The kernel and the initial output values have the same length. - - success: return(!ERROR); failure: return(ERROR) */ -extern int IirConvolveCanonicRegressive - ( - double InputData[], /* data to process */ - double OutputData[], /* result */ - long SignalLength, /* length of the 1D data array */ - double Kernel[], /* kernel */ - double LeftInit[], /* regressive recursion initialization */ - long KernelLength /* length of the 1D kernel */ - ); - -/*--------------------------------------------------------------------------*/ -/** The filter is defined by its poles (1D). - The input and the output have the same length. In-place processing is - allowed. No more than two poles are allowed for a finite support boundary. - - success: return(!ERROR); failure: return(ERROR) */ -extern int IirConvolvePoles - ( - double InputData[], /* data to process */ - double OutputData[], /* result */ - long SignalLength, /* length of the 1D data array */ - double RealPoles[], /* array of real poles */ - long PoleNumber, /* number of poles */ - enum TBoundaryConvention - Convention, /* boundary convention */ - double Tolerance /* admissible relative error */ - ); - -/*--------------------------------------------------------------------------*/ -/** The filter is defined by its poles (3D). - No more than two poles are allowed for a finite support boundary. - VolumeSource is a (double)volume of size (Nx x Ny x Nz). - OutputData is a (double)volume of size (Nx x Ny x Nz). - - success: return(!ERROR); failure: return(ERROR) */ -extern int IirConvolvePolesVolume - ( - double *VolumeSource, /* data to process */ - double *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - double RealPoles[], /* array of real poles */ - long PoleNumber, /* number of poles */ - enum TBoundaryConvention - Convention, /* boundary convention */ - double Tolerance, /* admissible relative error */ - int *Status /* error management */ - ); -//@} - diff --git a/src/core/bilib/interpolate.cc b/src/core/bilib/interpolate.cc deleted file mode 100644 index 7170fe2..0000000 --- a/src/core/bilib/interpolate.cc +++ /dev/null @@ -1,1974 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -#include -#include -#include -#include - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" -#include "error.h" -#include "tboundaryconvention.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "convert.h" -#include "fold.h" -#include "getput.h" -#include "interpolate.h" -#include "kernel.h" -#include "messagedisplay.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -#ifdef DEBUG -#include -#include -#endif - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern int SplineInterpolateImage - ( - float *ImageCoeff, /* B-spline coefficients to interpolate */ - long Nx, /* width of the image */ - long Ny, /* height of the image */ - double Xargument, /* input X abscissa */ - double Yargument, /* input Y abscissa */ - double *Result, /* output ordinate */ - long Degree, /* degree of the spline */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ) - -{ /* begin SplineInterpolateImage */ - - double *wx = (double *)NULL, *wy = (double *)NULL; - double *ux, *uy; - float *pi; - long *v, *vx, *vy; - long *kx, *ky; - double Xfrac, Yfrac; - double w0, w1; - double qi, qj; - long i, j, k, l; - long x, y; - long x0, x1, y0, y1; - const long - HalfDegree = Degree / 2L, Width = Degree + 1L; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(SplineInterpolateImage, ImageCoeff, *Status, -/**/ "Missing ImageCoeff") -/**/DEBUG_CHECK_NULL_POINTER(SplineInterpolateImage, Result, *Status, -/**/ "Missing Result") -/**/DEBUG_CHECK_RANGE_LONG(SplineInterpolateImage, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid Nx (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(SplineInterpolateImage, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid Ny (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(SplineInterpolateImage, Degree, 0L, LONG_MAX, *Status, -/**/ "Invalid Degree (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(SplineInterpolateImage, *Status) -/**/DEBUG_WRITE_ENTERING(SplineInterpolateImage, -/**/ "About to execute SplineInterpolateImage") - - switch (Convention) { - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case FiniteDataSupport: - if (2L <= Degree) { - *Status = ERROR; - WRITE_ERROR(SplineInterpolateImage, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateImage, "Done") - return(*Status); - } - break; - case FiniteCoefficientSupport: - Convention = FiniteDataSupport; - break; - case AntiMirrorOnBounds: - default: - *Status = ERROR; - WRITE_ERROR(SplineInterpolateImage, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateImage, "Done") - return(*Status); - } - switch (Degree) { - case 0L: - case 1L: - wy = (double *)NULL; - wx = (double *)NULL; - ky = (long *)NULL; - kx = (long *)NULL; - break; - default: - AllocateLineDouble(&wy, Width, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateImage, "Done") - return(*Status); - } - AllocateLineDouble(&wx, Width, Status); - if (*Status == ERROR) { - FreeLineDouble(&wy); -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateImage, "Done") - return(*Status); - } - ky = (long *)malloc((size_t)(Width * (long)sizeof(long))); - *Status = (ky == (long *)NULL); - if (*Status == ERROR) { - FreeLineDouble(&wx); - FreeLineDouble(&wy); -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateImage, "Done") - return(*Status); - } - kx = (long *)malloc((size_t)(Width * (long)sizeof(long))); - *Status = (kx == (long *)NULL); - if (*Status == ERROR) { - free(ky); - FreeLineDouble(&wx); - FreeLineDouble(&wy); -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateImage, "Done") - return(*Status); - } - break; - } - switch (Degree) { - case 0L: - j = ConvertDoubleToLong(Yargument); - i = ConvertDoubleToLong(Xargument); - if (fabs(Xargument - (double)i) == 0.5) { - if (fabs(Yargument - (double)j) == 0.5) { - SplineInterpolateImage(ImageCoeff, Nx, Ny, Xargument, Yargument, - Result, 1L, Convention, Status); - } - else { - SplineInterpolateImage(ImageCoeff, Nx, Ny, Xargument, (double)j, - Result, 1L, Convention, Status); - } - } - else { - if (fabs(Yargument - (double)j) == 0.5) { - SplineInterpolateImage(ImageCoeff, Nx, Ny, (double)i, Yargument, - Result, 1L, Convention, Status); - } - else { - if ((0L <= i) && (i < Nx) && (0L <= j) && (j < Ny)) { - *Result = (double)ImageCoeff[Nx * j + i]; - } - else { - switch (Convention) { - case FiniteDataSupport: - *Result = 0.0; - break; - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - *Status = GetFoldedIndex(j, &y, Ny, Convention); - if (*Status == ERROR) { - break; - } - *Status = GetFoldedIndex(i, &x, Nx, Convention); - if (*Status == ERROR) { - break; - } - *Result = (double)ImageCoeff[Nx * y + x]; - break; - default: - *Status = ERROR; - WRITE_ERROR(SplineInterpolateImage, - "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateImage, "Done") - return(*Status); - } - } - } - } -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateImage, "Done") - return(*Status); - case 1L: - y = (long)floor(Yargument); - x = (long)floor(Xargument); - Yfrac = Yargument - (double)y; - Xfrac = Xargument - (double)x; - if ((0L <= x) && (x < (Nx - 1L)) && (0L <= y) && (y < (Ny - 1L))) { - k = Nx * y + x; - w0 = Xfrac * (double)ImageCoeff[k + 1L] + (1.0 - Xfrac) - * (double)ImageCoeff[k]; - k += Nx; - w1 = Xfrac * (double)ImageCoeff[k + 1L] + (1.0 - Xfrac) - * (double)ImageCoeff[k]; - *Result = Yfrac * w1 + (1.0 - Yfrac) * w0; - } - else { - switch (Convention) { - case FiniteDataSupport: - if ((x < -1L) || (Nx <= x) || (y < -1L) || (Ny <= y)) { - *Result = 0.0; - break; - } - if (x == -1L) { - if (y == -1L) { - *Result = Xfrac * Yfrac * (double)*ImageCoeff; - break; - } - if (y == (Ny - 1L)) { - *Result = Xfrac * (1.0 - Yfrac) - * (double)ImageCoeff[Nx * y]; - break; - } - y *= Nx; - w0 = (double)ImageCoeff[y]; - y += Nx; - w1 = (double)ImageCoeff[y]; - *Result = Xfrac * (Yfrac * w1 + (1.0 - Yfrac) * w0); - break; - } - if (x == (Nx - 1L)) { - if (y == -1L) { - *Result = (1.0 - Xfrac) * Yfrac * (double)ImageCoeff[x]; - break; - } - if (y == (Ny - 1L)) { - *Result = (1.0 - Xfrac) * (1.0 - Yfrac) - * (double)ImageCoeff[Nx * Ny - 1L]; - break; - } - k = Nx * y + x; - w0 = (double)ImageCoeff[k]; - k += Nx; - w1 = (double)ImageCoeff[k]; - *Result = (1.0 - Xfrac) * (Yfrac * w1 + (1.0 - Yfrac) * w0); - break; - } - if (y == -1L) { - *Result = Yfrac * (Xfrac * (double)ImageCoeff[x + 1L] - + (1.0 - Xfrac) * (double)ImageCoeff[x]); - break; - } - if (y == (Ny - 1L)) { - k = Nx * y + x; - *Result = (1.0 - Yfrac) * (Xfrac * (double)ImageCoeff[k + 1L] - + (1.0 - Xfrac) * (double)ImageCoeff[k]); - break; - } - *Status = ERROR; - WRITE_ERROR(SplineInterpolateImage, "Unexpected internal condition") -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateImage, "Done") - return(*Status); - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - *Status = GetFoldedIndex(y, &y0, Ny, Convention); - if (*Status == ERROR) { - break; - } - *Status = GetFoldedIndex(y + 1L, &y1, Ny, Convention); - if (*Status == ERROR) { - break; - } - *Status = GetFoldedIndex(x, &x0, Nx, Convention); - if (*Status == ERROR) { - break; - } - *Status = GetFoldedIndex(x + 1L, &x1, Nx, Convention); - if (*Status == ERROR) { - break; - } - y0 *= Nx; - y1 *= Nx; - w0 = Xfrac * (double)ImageCoeff[y0 + x1] - + (1.0 - Xfrac) * (double)ImageCoeff[y0 + x0]; - w1 = Xfrac * (double)ImageCoeff[y1 + x1] - + (1.0 - Xfrac) * (double)ImageCoeff[y1 + x0]; - *Result = Yfrac * w1 + (1.0 - Yfrac) * w0; - break; - default: - *Status = ERROR; - WRITE_ERROR(SplineInterpolateImage, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateImage, "Done") - return(*Status); - } - } -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateImage, "Done") - return(*Status); - case 2L: - y = ConvertDoubleToLong(Yargument); - x = ConvertDoubleToLong(Xargument); - BsplineArray02(Yargument - (double)y, wy, &(wy[1]), &(wy[2])); - v = ky; - *v++ = y + 1L; - *v++ = y; - *v = y - 1L; - BsplineArray02(Xargument - (double)x, wx, &(wx[1]), &(wx[2])); - v = kx; - *v++ = x + 1L; - *v++ = x; - *v = x - 1L; - if ((x < 1L) || ((Nx - 1L) <= x) || (y < 1L) || ((Ny - 1L) <= y)) { - switch (Convention) { - case FiniteDataSupport: - for (k = 0L; (k < 3L); k++) { - if (ky[k] < 0L) { - wy[k] = 0.0; - ky[k] = 0L; - } - else if (Ny <= ky[k]) { - wy[k] = 0.0; - ky[k] = 0L; - } - if (kx[k] < 0L) { - wx[k] = 0.0; - kx[k] = 0L; - } - else if (Nx <= kx[k]) { - wx[k] = 0.0; - kx[k] = 0L; - } - } - break; - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - for (k = 0L; (k < 3L); k++) { - GetFoldedIndex(ky[k], &l, Ny, Convention); - ky[k] = l; - GetFoldedIndex(kx[k], &l, Nx, Convention); - kx[k] = l; - } - break; - default: - *Status = ERROR; - free(kx); - free(ky); - FreeLineDouble(&wx); - FreeLineDouble(&wy); - WRITE_ERROR(SplineInterpolateImage, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateImage, "Done") - return(*Status); - } - } - uy = wy; - vy = ky; - ux = wx; - vx = kx; - pi = ImageCoeff + (ptrdiff_t)(Nx * *vy++); - qi = *ux++ * (double)*(pi + (ptrdiff_t)*vx++); - qi += *ux++ * (double)*(pi + (ptrdiff_t)*vx++); - qi += *ux * (double)*(pi+ (ptrdiff_t)*vx); - qj = *uy++ * qi; - ux = wx; - vx = kx; - pi = ImageCoeff + (ptrdiff_t)(Nx * *vy++); - qi = *ux++ * (double)*(pi + (ptrdiff_t)*vx++); - qi += *ux++ * (double)*(pi + (ptrdiff_t)*vx++); - qi += *ux * (double)*(pi+ (ptrdiff_t)*vx); - qj += *uy++ * qi; - ux = wx; - vx = kx; - pi = ImageCoeff + (ptrdiff_t)(Nx * *vy); - qi = *ux++ * (double)*(pi + (ptrdiff_t)*vx++); - qi += *ux++ * (double)*(pi + (ptrdiff_t)*vx++); - qi += *ux * (double)*(pi+ (ptrdiff_t)*vx); - qj += *uy * qi; - *Result = qj; - free(kx); - free(ky); - *Status = FreeLineDouble(&wx); - if (*Status == ERROR) { - FreeLineDouble(&wy); -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateImage, "Done") - return(*Status); - } - *Status = FreeLineDouble(&wy); -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateImage, "Done") - return(*Status); - case 3L: - y = ConvertDoubleToLong(Yargument); - x = ConvertDoubleToLong(Xargument); - Yargument -= (double)y; - Xargument -= (double)x; - if (Yargument < 0.0) { - BsplineArray03(Yargument + 1.0, wy, &(wy[1]), &(wy[2]), &(wy[3])); - v = ky; - *v++ = ++y; - *v++ = --y; - *v++ = --y; - *v = --y; - } - else { - BsplineArray03(Yargument, wy, &(wy[1]), &(wy[2]), &(wy[3])); - v = ky; - y += 2L; - *v++ = y; - *v++ = --y; - *v++ = --y; - *v = --y; - } - if (Xargument < 0.0) { - BsplineArray03(Xargument + 1.0, wx, &(wx[1]), &(wx[2]), &(wx[3])); - v = kx; - *v++ = ++x; - *v++ = --x; - *v++ = --x; - *v = --x; - } - else { - BsplineArray03(Xargument, wx, &(wx[1]), &(wx[2]), &(wx[3])); - v = kx; - x += 2L; - *v++ = --x; - *v++ = --x; - *v++ = --x; - *v = --x; - } - if ((kx[3] < 0L) || (Nx <= kx[0]) || (ky[3] < 0L) || (Ny <= ky[0])) { - switch (Convention) { - case FiniteDataSupport: - for (k = 0L; (k < 4L); k++) { - if (ky[k] < 0L) { - wy[k] = 0.0; - ky[k] = 0L; - } - else if (Ny <= ky[k]) { - wy[k] = 0.0; - ky[k] = 0L; - } - if (kx[k] < 0L) { - wx[k] = 0.0; - kx[k] = 0L; - } - else if (Nx <= kx[k]) { - wx[k] = 0.0; - kx[k] = 0L; - } - } - break; - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - for (k = 0L; (k < 4L); k++) { - GetFoldedIndex(ky[k], &l, Ny, Convention); - ky[k] = l; - GetFoldedIndex(kx[k], &l, Nx, Convention); - kx[k] = l; - } - break; - default: - *Status = ERROR; - free(kx); - free(ky); - FreeLineDouble(&wx); - FreeLineDouble(&wy); - WRITE_ERROR(SplineInterpolateImage, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateImage, "Done") - return(*Status); - } - } - uy = wy; - vy = ky; - ux = wx; - vx = kx; - pi = ImageCoeff + (ptrdiff_t)(Nx * *vy++); - qi = *ux++ * (double)*(pi + (ptrdiff_t)*vx++); - qi += *ux++ * (double)*(pi + (ptrdiff_t)*vx++); - qi += *ux++ * (double)*(pi + (ptrdiff_t)*vx++); - qi += *ux * (double)*(pi+ (ptrdiff_t)*vx); - qj = *uy++ * qi; - ux = wx; - vx = kx; - pi = ImageCoeff + (ptrdiff_t)(Nx * *vy++); - qi = *ux++ * (double)*(pi + (ptrdiff_t)*vx++); - qi += *ux++ * (double)*(pi + (ptrdiff_t)*vx++); - qi += *ux++ * (double)*(pi + (ptrdiff_t)*vx++); - qi += *ux * (double)*(pi+ (ptrdiff_t)*vx); - qj += *uy++ * qi; - ux = wx; - vx = kx; - pi = ImageCoeff + (ptrdiff_t)(Nx * *vy++); - qi = *ux++ * (double)*(pi + (ptrdiff_t)*vx++); - qi += *ux++ * (double)*(pi + (ptrdiff_t)*vx++); - qi += *ux++ * (double)*(pi + (ptrdiff_t)*vx++); - qi += *ux * (double)*(pi+ (ptrdiff_t)*vx); - qj += *uy++ * qi; - ux = wx; - vx = kx; - pi = ImageCoeff + (ptrdiff_t)(Nx * *vy); - qi = *ux++ * (double)*(pi + (ptrdiff_t)*vx++); - qi += *ux++ * (double)*(pi + (ptrdiff_t)*vx++); - qi += *ux++ * (double)*(pi + (ptrdiff_t)*vx++); - qi += *ux * (double)*(pi+ (ptrdiff_t)*vx); - qj += *uy * qi; - *Result = qj; - free(kx); - free(ky); - *Status = FreeLineDouble(&wx); - if (*Status == ERROR) { - FreeLineDouble(&wy); -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateImage, "Done") - return(*Status); - } - *Status = FreeLineDouble(&wy); -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateImage, "Done") - return(*Status); - case 4L: - y = ConvertDoubleToLong(Yargument) + 2L; - x = ConvertDoubleToLong(Xargument) + 2L; - Yargument -= (double)y; - Xargument -= (double)x; - for (k = 0L; (k < 5L); k++) { - wy[k] = Bspline04(Yargument++); - ky[k] = y--; - wx[k] = Bspline04(Xargument++); - ky[k] = x--; - } - break; - case 5L: - y = ConvertDoubleToLong(Yargument); - x = ConvertDoubleToLong(Xargument); - Yargument -= (double)y; - Xargument -= (double)x; - if (Yargument < 0.0) { - Yargument -= 2.0; - y += 2L; - } - else { - Yargument -= 3.0; - y += 3L; - } - if (Xargument < 0.0) { - Xargument -= 2.0; - x += 2L; - } - else { - Xargument -= 3.0; - x += 3L; - } - for (k = 0L; (k < 6L); k++) { - wy[k] = Bspline05(Yargument++); - ky[k] = y--; - wx[k] = Bspline05(Xargument++); - kx[k] = x--; - } - break; - case 6L: - y = ConvertDoubleToLong(Yargument) + 3L; - x = ConvertDoubleToLong(Xargument) + 3L; - Yargument -= (double)y; - Xargument -= (double)x; - for (k = 0L; (k < 7L); k++) { - wy[k] = Bspline06(Yargument++); - ky[k] = y--; - wx[k] = Bspline06(Xargument++); - ky[k] = x--; - } - break; - case 7L: - y = ConvertDoubleToLong(Yargument); - x = ConvertDoubleToLong(Xargument); - Yargument -= (double)y; - Xargument -= (double)x; - if (Yargument < 0.0) { - Yargument -= 3.0; - y += 3L; - } - else { - Yargument -= 4.0; - y += 4L; - } - if (Xargument < 0.0) { - Xargument -= 3.0; - x += 3L; - } - else { - Xargument -= 4.0; - x += 4L; - } - for (k = 0L; (k < 8L); k++) { - wy[k] = Bspline07(Yargument++); - ky[k] = y--; - wx[k] = Bspline07(Xargument++); - kx[k] = x--; - } - break; - case 8L: - y = ConvertDoubleToLong(Yargument) + 4L; - x = ConvertDoubleToLong(Xargument) + 4L; - Yargument -= (double)y; - Xargument -= (double)x; - for (k = 0L; (k < 9L); k++) { - wy[k] = Bspline08(Yargument++); - ky[k] = y--; - wx[k] = Bspline08(Xargument++); - ky[k] = x--; - } - break; - case 9L: - y = ConvertDoubleToLong(Yargument); - x = ConvertDoubleToLong(Xargument); - Yargument -= (double)y; - Xargument -= (double)x; - if (Yargument < 0.0) { - Yargument -= 4.0; - y += 4L; - } - else { - Yargument -= 5.0; - y += 5L; - } - if (Xargument < 0.0) { - Xargument -= 4.0; - x += 4L; - } - else { - Xargument -= 5.0; - x += 5L; - } - for (k = 0L; (k < 10L); k++) { - wy[k] = Bspline09(Yargument++); - ky[k] = y--; - wx[k] = Bspline09(Xargument++); - kx[k] = x--; - } - break; - case 10L: - y = ConvertDoubleToLong(Yargument) + 5L; - x = ConvertDoubleToLong(Xargument) + 5L; - Yargument -= (double)y; - Xargument -= (double)x; - for (k = 0L; (k < 11L); k++) { - wy[k] = Bspline10(Yargument++); - ky[k] = y--; - wx[k] = Bspline10(Xargument++); - ky[k] = x--; - } - break; - case 11L: - y = ConvertDoubleToLong(Yargument); - x = ConvertDoubleToLong(Xargument); - Yargument -= (double)y; - Xargument -= (double)x; - if (Yargument < 0.0) { - Yargument -= 5.0; - y += 5L; - } - else { - Yargument -= 6.0; - y += 6L; - } - if (Xargument < 0.0) { - Xargument -= 5.0; - x += 5L; - } - else { - Xargument -= 6.0; - x += 6L; - } - for (k = 0L; (k < 12L); k++) { - wy[k] = Bspline11(Yargument++); - ky[k] = y--; - wx[k] = Bspline11(Xargument++); - kx[k] = x--; - } - break; - default: - y = ConvertDoubleToLong(Yargument); - x = ConvertDoubleToLong(Xargument); - Yargument -= (double)y; - Xargument -= (double)x; - if (Degree & 1L) { - if (Yargument < 0.0) { - Yargument -= (double)HalfDegree; - y += HalfDegree; - } - else { - Yargument -= (double)HalfDegree + 1.0; - y += HalfDegree + 1L; - } - if (Xargument < 0.0) { - Xargument -= (double)HalfDegree; - x += HalfDegree; - } - else { - Xargument -= (double)HalfDegree + 1.0; - x += HalfDegree + 1L; - } - } - for (k = 0L; (k < Width); k++) { - *Status = Bspline(Degree, Yargument++, &(wy[k])); - if (*Status == ERROR) { - free(kx); - free(ky); - FreeLineDouble(&wx); - FreeLineDouble(&wy); -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateImage, "Done") - return(*Status); - } - ky[k] = y--; - *Status = Bspline(Degree, Xargument++, &(wx[k])); - if (*Status == ERROR) { - free(kx); - free(ky); - FreeLineDouble(&wx); - FreeLineDouble(&wy); -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateImage, "Done") - return(*Status); - } - kx[k] = x--; - } - break; - } - if ((kx[Degree] < 0L) || (Nx <= kx[0]) || (ky[Degree] < 0L) || (Ny <= ky[0])) { - switch (Convention) { - case FiniteDataSupport: - for (k = 0L; (k < Width); k++) { - if (ky[k] < 0L) { - wy[k] = 0.0; - ky[k] = 0L; - } - else if (Ny <= ky[k]) { - wy[k] = 0.0; - ky[k] = 0L; - } - if (kx[k] < 0L) { - wx[k] = 0.0; - kx[k] = 0L; - } - else if (Nx <= kx[k]) { - wx[k] = 0.0; - kx[k] = 0L; - } - } - break; - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - for (k = 0L; (k < Width); k++) { - GetFoldedIndex(ky[k], &l, Ny, Convention); - ky[k] = l; - GetFoldedIndex(kx[k], &l, Nx, Convention); - kx[k] = l; - } - break; - default: - *Status = ERROR; - free(kx); - free(ky); - FreeLineDouble(&wx); - FreeLineDouble(&wy); - WRITE_ERROR(SplineInterpolateImage, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateImage, "Done") - return(*Status); - } - } - uy = wy; - vy = ky; - qj = 0.0; - for (j = 0L; (j < Width); j++) { - ux = wx; - vx = kx; - pi = ImageCoeff + (ptrdiff_t)(Nx * *vy++); - qi = 0.0; - for (i = 0L; (i < Width); i++) { - qi += *ux++ * (double)*(pi + (ptrdiff_t)*vx++); - } - qj += *uy++ * qi; - } - *Result = qj; - free(kx); - free(ky); - *Status = FreeLineDouble(&wx); - if (*Status == ERROR) { - FreeLineDouble(&wy); -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateImage, "Done") - return(*Status); - } - *Status = FreeLineDouble(&wy); -/**/DEBUG_WRITE_LEAVING(SplineInterpolateImage, "Done") - return(*Status); -} /* SplineInterpolateImage */ - -/*--------------------------------------------------------------------------*/ -extern int SplineInterpolateLine - ( - double LineCoeff[], /* B-spline coefficients to interpolate */ - long LineLength, /* length of the line */ - double Argument, /* input abscissa */ - double *Result, /* output ordinate */ - long Degree, /* degree of the spline */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ) - -/* interpolation of the 1D array LineCoeff[] of length LineLength */ -/* Result = SUM(k): LineCoeff[k] * B-spline(Degree, Argument - k) */ -/* Convention must be consistent with the B-spline coefficients stored in LineCoeff[] */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin SplineInterpolateLine */ - - double *p, *x = (double *)NULL, *y = (double *)NULL; - long *n; - double Weight[12], Value[12]; - long Index[12]; - double u, v, w; - long i, j, k; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(SplineInterpolateLine, LineCoeff, *Status, -/**/ "Missing LineCoeff") -/**/DEBUG_CHECK_NULL_POINTER(SplineInterpolateLine, Result, *Status, -/**/ "Missing Result") -/**/DEBUG_CHECK_RANGE_LONG(SplineInterpolateLine, LineLength, 1L, LONG_MAX, *Status, -/**/ "Invalid LineLength (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(SplineInterpolateLine, Degree, 0L, LONG_MAX, *Status, -/**/ "Invalid Degree (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(SplineInterpolateLine, *Status) -/**/DEBUG_WRITE_ENTERING(SplineInterpolateLine, -/**/ "About to execute SplineInterpolateLine") - - switch (Convention) { - case AntiMirrorOnBounds: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case FiniteDataSupport: - if (2L <= Degree) { - *Status = ERROR; - WRITE_ERROR(SplineInterpolateLine, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - break; - case FiniteCoefficientSupport: - Convention = FiniteDataSupport; - break; - default: - *Status = ERROR; - WRITE_ERROR(SplineInterpolateLine, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - switch (Degree) { - case 0L: - i = ConvertDoubleToLong(Argument); - if (fabs(Argument - (double)i) == 0.5) { - SplineInterpolateLine(LineCoeff, LineLength, Argument, Result, 1L, - Convention, Status); - } - else { - if ((0L <= i) && (i < LineLength)) { - *Result = LineCoeff[i]; - } - else { - switch (Convention) { - case AntiMirrorOnBounds: - case FiniteDataSupport: - *Status = GetFoldedValueDouble(LineCoeff, i, Result, LineLength, - Convention); - break; - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - *Status = GetFoldedIndex(i, &j, LineLength, Convention); - if (*Status == !ERROR) { - *Result = (double)LineCoeff[j]; - } - break; - default: - *Status = ERROR; - WRITE_ERROR(SplineInterpolateLine, - "Unexpected boundary convention") - break; - } - } - } - break; - case 1L: - i = (long)floor(Argument); - w = Argument - (double)i; - if ((0L <= i) && (i < (LineLength - 1L))) { - *Result = w * LineCoeff[i + 1L] + (1.0 - w) * LineCoeff[i]; - } - else { - switch (Convention) { - case AntiMirrorOnBounds: - case FiniteDataSupport: - *Status = GetFoldedValueDouble(LineCoeff, i + 1L, &u, LineLength, - Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Status = GetFoldedValueDouble(LineCoeff, i, &v, LineLength, - Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Result = w * u + (1.0 - w) * v; - break; - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - *Status = GetFoldedIndex(i + 1L, &j, LineLength, Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Status = GetFoldedIndex(i, &k, LineLength, Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Result = w * LineCoeff[j] + (1.0 - w) * LineCoeff[k]; - break; - default: - *Status = ERROR; - WRITE_ERROR(SplineInterpolateLine, "Unexpected boundary convention") - break; - } - } - break; - case 2L: - i = ConvertDoubleToLong(Argument); - *Status = BsplineArray02(Argument - (double)i, - &(Weight[0]), &(Weight[1]), &(Weight[2])); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - if ((1L <= i) && (i < (LineLength - 1L))) { - *Result = Weight[0] * LineCoeff[i + 1L] + Weight[1] * LineCoeff[i] - + Weight[2] * LineCoeff[i - 1L]; - } - else { - switch (Convention) { - case AntiMirrorOnBounds: - case FiniteDataSupport: - *Status = GetFoldedValueDouble(LineCoeff, i + 1L, &(Value[2]), - LineLength, Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Status = GetFoldedValueDouble(LineCoeff, i, &(Value[1]), - LineLength, Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Status = GetFoldedValueDouble(LineCoeff, i - 1L, &(Value[0]), - LineLength, Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Result = Weight[0] * Value[2] + Weight[1] * Value[1] - + Weight[2] * Value[0]; - break; - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - *Status = GetFoldedIndex(i + 1L, &(Index[2]), LineLength, - Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Status = GetFoldedIndex(i, &(Index[1]), LineLength, Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Status = GetFoldedIndex(i - 1L, &(Index[0]), LineLength, - Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Result = Weight[0] * LineCoeff[Index[2]] + Weight[1] - * LineCoeff[Index[1]] + Weight[2] * LineCoeff[Index[0]]; - break; - default: - *Status = ERROR; - WRITE_ERROR(SplineInterpolateLine, "Unexpected boundary convention") - break; - } - } - break; - case 3L: - i = (long)floor(Argument); - *Status = BsplineArray03(Argument - (double)i, - &(Weight[0]), &(Weight[1]), &(Weight[2]), &(Weight[3])); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - if ((1L <= i) && (i < (LineLength - 2L))) { - *Result = Weight[0] * LineCoeff[i + 2L] + Weight[1] * LineCoeff[i + 1L] - + Weight[2] * LineCoeff[i] + Weight[3] * LineCoeff[i - 1L]; - } - else { - switch (Convention) { - case AntiMirrorOnBounds: - case FiniteDataSupport: - *Status = GetFoldedValueDouble(LineCoeff, i + 2L, &(Value[3]), - LineLength, Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Status = GetFoldedValueDouble(LineCoeff, i + 1L, &(Value[2]), - LineLength, Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Status = GetFoldedValueDouble(LineCoeff, i, &(Value[1]), - LineLength, Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Status = GetFoldedValueDouble(LineCoeff, i - 1L, &(Value[0]), - LineLength, Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Result = Weight[0] * Value[3] + Weight[1] * Value[2] - + Weight[2] * Value[1] + Weight[3] * Value[0]; - break; - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - *Status = GetFoldedIndex(i + 2L, &(Index[3]), LineLength, - Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Status = GetFoldedIndex(i + 1L, &(Index[2]), LineLength, - Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Status = GetFoldedIndex(i, &(Index[1]), LineLength, Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Status = GetFoldedIndex(i - 1L, &(Index[0]), LineLength, - Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Result = Weight[0] * LineCoeff[Index[3]] + Weight[1] - * LineCoeff[Index[2]] + Weight[2] * LineCoeff[Index[1]] - + Weight[3] * LineCoeff[Index[0]]; - break; - default: - *Status = ERROR; - WRITE_ERROR(SplineInterpolateLine, "Unexpected boundary convention") - break; - } - } - break; - case 4L: - i = ConvertDoubleToLong(Argument); - w = Argument - (double)i; - Weight[0] = Bspline04(w - 2.0); - Weight[1] = Bspline04(w - 1.0); - Weight[2] = Bspline04(w); - Weight[3] = Bspline04(w + 1.0); - Weight[4] = Bspline04(w + 2.0); - if ((2L <= i) && (i < (LineLength - 2L))) { - *Result = Weight[0] * LineCoeff[i + 2L] + Weight[1] * LineCoeff[i + 1L] - + Weight[2] * LineCoeff[i] + Weight[3] * LineCoeff[i - 1L] - + Weight[4] * LineCoeff[i - 2L]; - } - else { - switch (Convention) { - case AntiMirrorOnBounds: - case FiniteDataSupport: - *Status = GetFoldedValueDouble(LineCoeff, i + 2L, &(Value[4]), - LineLength, Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Status = GetFoldedValueDouble(LineCoeff, i + 1L, &(Value[3]), - LineLength, Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Status = GetFoldedValueDouble(LineCoeff, i, &(Value[2]), - LineLength, Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Status = GetFoldedValueDouble(LineCoeff, i - 1L, &(Value[1]), - LineLength, Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Status = GetFoldedValueDouble(LineCoeff, i - 2L, &(Value[0]), - LineLength, Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Result = Weight[0] * Value[4] + Weight[1] * Value[3] - + Weight[2] * Value[2] + Weight[3] * Value[1] - + Weight[4] * Value[0]; - break; - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - *Status = GetFoldedIndex(i + 2L, &(Index[4]), LineLength, - Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Status = GetFoldedIndex(i + 1L, &(Index[3]), LineLength, - Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Status = GetFoldedIndex(i, &(Index[2]), LineLength, Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Status = GetFoldedIndex(i - 1L, &(Index[1]), LineLength, - Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Status = GetFoldedIndex(i - 2L, &(Index[0]), LineLength, - Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Result = Weight[0] * LineCoeff[Index[4]] + Weight[1] - * LineCoeff[Index[3]] + Weight[2] * LineCoeff[Index[2]] - + Weight[3] * LineCoeff[Index[1]] + Weight[4] - * LineCoeff[Index[0]]; - break; - default: - *Status = ERROR; - WRITE_ERROR(SplineInterpolateLine, "Unexpected boundary convention") - break; - } - } - break; - case 5L: - i = (long)floor(Argument); - w = Argument - (double)i; - Weight[0] = Bspline05(w - 3.0); - Weight[1] = Bspline05(w - 2.0); - Weight[2] = Bspline05(w - 1.0); - Weight[3] = Bspline05(w); - Weight[4] = Bspline05(w + 1.0); - Weight[5] = Bspline05(w + 2.0); - if ((2L <= i) && (i < (LineLength - 3L))) { - *Result = Weight[0] * LineCoeff[i + 3L] + Weight[1] * LineCoeff[i + 2L] - + Weight[2] * LineCoeff[i + 1L] + Weight[3] * LineCoeff[i] - + Weight[4] * LineCoeff[i - 1L] + Weight[5] * LineCoeff[i - 2L]; - } - else { - switch (Convention) { - case AntiMirrorOnBounds: - case FiniteDataSupport: - *Status = GetFoldedValueDouble(LineCoeff, i + 3L, &(Value[5]), - LineLength, Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Status = GetFoldedValueDouble(LineCoeff, i + 2L, &(Value[4]), - LineLength, Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Status = GetFoldedValueDouble(LineCoeff, i + 1L, &(Value[3]), - LineLength, Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Status = GetFoldedValueDouble(LineCoeff, i, &(Value[2]), - LineLength, Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Status = GetFoldedValueDouble(LineCoeff, i - 1L, &(Value[1]), - LineLength, Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Status = GetFoldedValueDouble(LineCoeff, i - 2L, &(Value[0]), - LineLength, Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Result = Weight[0] * Value[5] + Weight[1] * Value[4] - + Weight[2] * Value[3] + Weight[3] * Value[2] - + Weight[4] * Value[1] + Weight[5] * Value[0]; - break; - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - *Status = GetFoldedIndex(i + 3L, &(Index[5]), LineLength, - Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Status = GetFoldedIndex(i + 2L, &(Index[4]), LineLength, - Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Status = GetFoldedIndex(i + 1L, &(Index[3]), LineLength, - Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Status = GetFoldedIndex(i, &(Index[2]), LineLength, Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Status = GetFoldedIndex(i - 1L, &(Index[1]), LineLength, - Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Status = GetFoldedIndex(i - 2L, &(Index[0]), LineLength, - Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - *Result = Weight[0] * LineCoeff[Index[5]] + Weight[1] - * LineCoeff[Index[4]] + Weight[2] * LineCoeff[Index[3]] - + Weight[3] * LineCoeff[Index[2]] + Weight[4] - * LineCoeff[Index[1]] + Weight[5] * LineCoeff[Index[0]]; - break; - default: - *Status = ERROR; - WRITE_ERROR(SplineInterpolateLine, "Unexpected boundary convention") - break; - } - } - break; - case 6L: - i = ConvertDoubleToLong(Argument); - w = Argument - (double)i; - Weight[0] = Bspline06(w - 3.0); - Weight[1] = Bspline06(w - 2.0); - Weight[2] = Bspline06(w - 1.0); - Weight[3] = Bspline06(w); - Weight[4] = Bspline06(w + 1.0); - Weight[5] = Bspline06(w + 2.0); - Weight[6] = Bspline06(w + 3.0); - if ((3L <= i) && (i < (LineLength - 3L))) { - *Result = Weight[0] * LineCoeff[i + 3L] + Weight[1] * LineCoeff[i + 2L] - + Weight[2] * LineCoeff[i + 1L] + Weight[3] * LineCoeff[i] - + Weight[4] * LineCoeff[i - 1L] + Weight[5] * LineCoeff[i - 2L] - + Weight[6] * LineCoeff[i - 3L]; - } - else { - switch (Convention) { - case AntiMirrorOnBounds: - case FiniteDataSupport: - k = Degree; - for (j = i + Degree / 2L; ((i - Degree / 2L) <= j); j--) { - *Status = GetFoldedValueDouble(LineCoeff, j, &(Value[k--]), - LineLength, Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - } - *Result = Weight[0] * Value[6] + Weight[1] * Value[5] - + Weight[2] * Value[4] + Weight[3] * Value[3] - + Weight[4] * Value[2] + Weight[5] * Value[1] - + Weight[6] * Value[0]; - break; - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - k = Degree; - for (j = i + Degree / 2L; ((i - Degree / 2L) <= j); j--) { - *Status = GetFoldedIndex(j, &(Index[k--]), LineLength, - Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - } - *Result = Weight[0] * LineCoeff[Index[6]] + Weight[1] - * LineCoeff[Index[5]] + Weight[2] * LineCoeff[Index[4]] - + Weight[3] * LineCoeff[Index[3]] + Weight[4] - * LineCoeff[Index[2]] + Weight[5] * LineCoeff[Index[1]] - + Weight[6] * LineCoeff[Index[0]]; - break; - default: - *Status = ERROR; - WRITE_ERROR(SplineInterpolateLine, "Unexpected boundary convention") - break; - } - } - break; - case 7L: - i = (long)floor(Argument); - w = Argument - (double)i; - Weight[0] = Bspline07(w - 4.0); - Weight[1] = Bspline07(w - 3.0); - Weight[2] = Bspline07(w - 2.0); - Weight[3] = Bspline07(w - 1.0); - Weight[4] = Bspline07(w); - Weight[5] = Bspline07(w + 1.0); - Weight[6] = Bspline07(w + 2.0); - Weight[7] = Bspline07(w + 3.0); - if ((3L <= i) && (i < (LineLength - 4L))) { - *Result = Weight[0] * LineCoeff[i + 4L] + Weight[1] * LineCoeff[i + 3L] - + Weight[2] * LineCoeff[i + 2L] + Weight[3] * LineCoeff[i + 1L] - + Weight[4] * LineCoeff[i] + Weight[5] * LineCoeff[i - 1L] - + Weight[6] * LineCoeff[i - 2L] + Weight[7] * LineCoeff[i - 3L]; - } - else { - switch (Convention) { - case AntiMirrorOnBounds: - case FiniteDataSupport: - k = Degree; - for (j = i + (Degree + 1L) / 2L; ((i - (Degree - 1L) / 2L) <= j); - j--) { - *Status = GetFoldedValueDouble(LineCoeff, j, &(Value[k--]), - LineLength, Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - } - *Result = Weight[0] * Value[7] + Weight[1] * Value[6] - + Weight[2] * Value[5] + Weight[3] * Value[4] - + Weight[4] * Value[3] + Weight[5] * Value[2] - + Weight[6] * Value[1] + Weight[7] * Value[0]; - break; - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - k = Degree; - for (j = i + (Degree + 1L) / 2L; ((i - (Degree - 1L) / 2L) <= j); - j--) { - *Status = GetFoldedIndex(j, &(Index[k--]), LineLength, - Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - } - *Result = Weight[0] * LineCoeff[Index[7]] + Weight[1] - * LineCoeff[Index[6]] + Weight[2] * LineCoeff[Index[5]] - + Weight[3] * LineCoeff[Index[4]] + Weight[4] - * LineCoeff[Index[3]] + Weight[5] * LineCoeff[Index[2]] - + Weight[6] * LineCoeff[Index[1]] + Weight[7] - * LineCoeff[Index[0]]; - break; - default: - *Status = ERROR; - WRITE_ERROR(SplineInterpolateLine, "Unexpected boundary convention") - break; - } - } - break; - case 8L: - i = ConvertDoubleToLong(Argument); - w = Argument - (double)i; - Weight[0] = Bspline08(w - 4.0); - Weight[1] = Bspline08(w - 3.0); - Weight[2] = Bspline08(w - 2.0); - Weight[3] = Bspline08(w - 1.0); - Weight[4] = Bspline08(w); - Weight[5] = Bspline08(w + 1.0); - Weight[6] = Bspline08(w + 2.0); - Weight[7] = Bspline08(w + 3.0); - Weight[8] = Bspline08(w + 4.0); - if ((4L <= i) && (i < (LineLength - 4L))) { - *Result = Weight[0] * LineCoeff[i + 4L] + Weight[1] * LineCoeff[i + 3L] - + Weight[2] * LineCoeff[i + 2L] + Weight[3] * LineCoeff[i + 1L] - + Weight[4] * LineCoeff[i] + Weight[5] * LineCoeff[i - 1L] - + Weight[6] * LineCoeff[i - 2L] + Weight[7] * LineCoeff[i - 3L] - + Weight[8] * LineCoeff[i - 4L]; - } - else { - switch (Convention) { - case AntiMirrorOnBounds: - case FiniteDataSupport: - k = Degree; - for (j = i + Degree / 2L; ((i - Degree / 2L) <= j); j--) { - *Status = GetFoldedValueDouble(LineCoeff, j, &(Value[k--]), - LineLength, Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - } - *Result = Weight[0] * Value[8] + Weight[1] * Value[7] - + Weight[2] * Value[6] + Weight[3] * Value[5] - + Weight[4] * Value[4] + Weight[5] * Value[3] - + Weight[6] * Value[2] + Weight[7] * Value[1] - + Weight[8] * Value[0]; - break; - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - k = Degree; - for (j = i + Degree / 2L; ((i - Degree / 2L) <= j); j--) { - *Status = GetFoldedIndex(j, &(Index[k--]), LineLength, - Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - } - *Result = Weight[0] * LineCoeff[Index[8]] + Weight[1] - * LineCoeff[Index[7]] + Weight[2] * LineCoeff[Index[6]] - + Weight[3] * LineCoeff[Index[5]] + Weight[4] - * LineCoeff[Index[4]] + Weight[5] * LineCoeff[Index[3]] - + Weight[6] * LineCoeff[Index[2]] + Weight[7] - * LineCoeff[Index[1]] + Weight[8] * LineCoeff[Index[0]]; - break; - default: - *Status = ERROR; - WRITE_ERROR(SplineInterpolateLine, "Unexpected boundary convention") - break; - } - } - break; - case 9L: - i = (long)floor(Argument); - w = Argument - (double)i; - Weight[0] = Bspline09(w - 5.0); - Weight[1] = Bspline09(w - 4.0); - Weight[2] = Bspline09(w - 3.0); - Weight[3] = Bspline09(w - 2.0); - Weight[4] = Bspline09(w - 1.0); - Weight[5] = Bspline09(w); - Weight[6] = Bspline09(w + 1.0); - Weight[7] = Bspline09(w + 2.0); - Weight[8] = Bspline09(w + 3.0); - Weight[9] = Bspline09(w + 4.0); - if ((4L <= i) && (i < (LineLength - 5L))) { - *Result = Weight[0] * LineCoeff[i + 5L] + Weight[1] * LineCoeff[i + 4L] - + Weight[2] * LineCoeff[i + 3L] + Weight[3] * LineCoeff[i + 2L] - + Weight[4] * LineCoeff[i + 1L] + Weight[5] * LineCoeff[i] - + Weight[6] * LineCoeff[i - 1L] + Weight[7] * LineCoeff[i - 2L] - + Weight[8] * LineCoeff[i - 3L] + Weight[9] * LineCoeff[i - 4L]; - } - else { - switch (Convention) { - case AntiMirrorOnBounds: - case FiniteDataSupport: - k = Degree; - for (j = i + (Degree + 1L) / 2L; ((i - (Degree - 1L) / 2L) <= j); - j--) { - *Status = GetFoldedValueDouble(LineCoeff, j, &(Value[k--]), - LineLength, Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - } - *Result = Weight[0] * Value[9] + Weight[1] * Value[8] - + Weight[2] * Value[7] + Weight[3] * Value[6] - + Weight[4] * Value[5] + Weight[5] * Value[4] - + Weight[6] * Value[3] + Weight[7] * Value[2] - + Weight[8] * Value[1] + Weight[9] * Value[0]; - break; - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - k = Degree; - for (j = i + (Degree + 1L) / 2L; ((i - (Degree - 1L) / 2L) <= j); - j--) { - *Status = GetFoldedIndex(j, &(Index[k--]), LineLength, - Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - } - *Result = Weight[0] * LineCoeff[Index[9]] + Weight[1] - * LineCoeff[Index[8]] + Weight[2] * LineCoeff[Index[7]] - + Weight[3] * LineCoeff[Index[6]] + Weight[4] - * LineCoeff[Index[5]] + Weight[5] * LineCoeff[Index[4]] - + Weight[6] * LineCoeff[Index[3]] + Weight[7] - * LineCoeff[Index[2]] + Weight[8] * LineCoeff[Index[1]] - + Weight[9] * LineCoeff[Index[0]]; - break; - default: - *Status = ERROR; - WRITE_ERROR(SplineInterpolateLine, "Unexpected boundary convention") - break; - } - } - break; - case 10L: - i = ConvertDoubleToLong(Argument); - w = Argument - (double)i; - Weight[0] = Bspline10(w - 5.0); - Weight[1] = Bspline10(w - 4.0); - Weight[2] = Bspline10(w - 3.0); - Weight[3] = Bspline10(w - 2.0); - Weight[4] = Bspline10(w - 1.0); - Weight[5] = Bspline10(w); - Weight[6] = Bspline10(w + 1.0); - Weight[7] = Bspline10(w + 2.0); - Weight[8] = Bspline10(w + 3.0); - Weight[9] = Bspline10(w + 4.0); - Weight[10] = Bspline10(w + 5.0); - if ((5L <= i) && (i < (LineLength - 5L))) { - *Result = Weight[0] * LineCoeff[i + 5L] + Weight[1] * LineCoeff[i + 4L] - + Weight[2] * LineCoeff[i + 3L] + Weight[3] * LineCoeff[i + 2L] - + Weight[4] * LineCoeff[i + 1L] + Weight[5] * LineCoeff[i] - + Weight[6] * LineCoeff[i - 1L] + Weight[7] * LineCoeff[i - 2L] - + Weight[8] * LineCoeff[i - 3L] + Weight[9] * LineCoeff[i - 4L] - + Weight[10] * LineCoeff[i - 5L]; - } - else { - switch (Convention) { - case AntiMirrorOnBounds: - case FiniteDataSupport: - k = Degree; - for (j = i + Degree / 2L; ((i - Degree / 2L) <= j); j--) { - *Status = GetFoldedValueDouble(LineCoeff, j, &(Value[k--]), - LineLength, Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - } - *Result = Weight[0] * Value[10] + Weight[1] * Value[9] - + Weight[2] * Value[8] + Weight[3] * Value[7] - + Weight[4] * Value[6] + Weight[5] * Value[5] - + Weight[6] * Value[4] + Weight[7] * Value[3] - + Weight[8] * Value[2] + Weight[9] * Value[1] - + Weight[10] * Value[0]; - break; - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - k = Degree; - for (j = i + Degree / 2L; ((i - Degree / 2L) <= j); j--) { - *Status = GetFoldedIndex(j, &(Index[k--]), LineLength, - Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - } - *Result = Weight[0] * LineCoeff[Index[10]] + Weight[1] - * LineCoeff[Index[9]] + Weight[2] * LineCoeff[Index[8]] - + Weight[3] * LineCoeff[Index[7]] + Weight[4] - * LineCoeff[Index[6]] + Weight[5] * LineCoeff[Index[5]] - + Weight[6] * LineCoeff[Index[4]] + Weight[7] - * LineCoeff[Index[3]] + Weight[8] * LineCoeff[Index[2]] - + Weight[9] * LineCoeff[Index[1]] + Weight[10] - * LineCoeff[Index[0]]; - break; - default: - *Status = ERROR; - WRITE_ERROR(SplineInterpolateLine, "Unexpected boundary convention") - break; - } - } - break; - case 11L: - i = (long)floor(Argument); - w = Argument - (double)i; - Weight[0] = Bspline11(w - 6.0); - Weight[1] = Bspline11(w - 5.0); - Weight[2] = Bspline11(w - 4.0); - Weight[3] = Bspline11(w - 3.0); - Weight[4] = Bspline11(w - 2.0); - Weight[5] = Bspline11(w - 1.0); - Weight[6] = Bspline11(w); - Weight[7] = Bspline11(w + 1.0); - Weight[8] = Bspline11(w + 2.0); - Weight[9] = Bspline11(w + 3.0); - Weight[10] = Bspline11(w + 4.0); - Weight[11] = Bspline11(w + 5.0); - if ((5L <= i) && (i < (LineLength - 6L))) { - *Result = Weight[0] * LineCoeff[i + 6L] + Weight[1] * LineCoeff[i + 5L] - + Weight[2] * LineCoeff[i + 4L] + Weight[3] * LineCoeff[i + 3L] - + Weight[4] * LineCoeff[i + 2L] + Weight[5] * LineCoeff[i + 1L] - + Weight[6] * LineCoeff[i] + Weight[7] * LineCoeff[i - 1L] - + Weight[8] * LineCoeff[i - 2L] + Weight[9] * LineCoeff[i - 3L] - + Weight[10] * LineCoeff[i - 4L] + Weight[11] * LineCoeff[i - 5L]; - } - else { - switch (Convention) { - case AntiMirrorOnBounds: - case FiniteDataSupport: - k = Degree; - for (j = i + (Degree + 1L) / 2L; ((i - (Degree - 1L) / 2L) <= j); - j--) { - *Status = GetFoldedValueDouble(LineCoeff, j, &(Value[k--]), - LineLength, Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - } - *Result = Weight[0] * Value[11] + Weight[1] * Value[10] - + Weight[2] * Value[9] + Weight[3] * Value[8] - + Weight[4] * Value[7] + Weight[5] * Value[6] - + Weight[6] * Value[5] + Weight[7] * Value[4] - + Weight[8] * Value[3] + Weight[9] * Value[2] - + Weight[10] * Value[1] + Weight[11] * Value[0]; - break; - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - k = Degree; - for (j = i + (Degree + 1L) / 2L; ((i - (Degree - 1L) / 2L) <= j); - j--) { - *Status = GetFoldedIndex(j, &(Index[k--]), LineLength, - Convention); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - } - *Result = Weight[0] * LineCoeff[Index[11]] + Weight[1] - * LineCoeff[Index[10]] + Weight[2] * LineCoeff[Index[9]] - + Weight[3] * LineCoeff[Index[8]] + Weight[4] - * LineCoeff[Index[7]] + Weight[5] * LineCoeff[Index[6]] - + Weight[6] * LineCoeff[Index[5]] + Weight[7] - * LineCoeff[Index[4]] + Weight[8] * LineCoeff[Index[3]] - + Weight[9] * LineCoeff[Index[2]] + Weight[10] - * LineCoeff[Index[1]] + Weight[11] * LineCoeff[Index[0]]; - break; - default: - *Status = ERROR; - WRITE_ERROR(SplineInterpolateLine, "Unexpected boundary convention") - break; - } - } - break; - default: - AllocateLineDouble(&x, Degree + 1L, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - if ((Degree & 1L) != 0L) { - i = (long)floor(Argument); - w = Argument - (double)i - (double)((Degree - 1L) / 2L); - p = x; - for (j = 0L; (j <= Degree); j++) { - *Status = Bspline(Degree, w++, p++); - if (*Status == ERROR) { - FreeLineDouble(&x); -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - } - if ((((Degree - 1L) / 2L) <= i) && (i < (LineLength - (Degree + 1L) - / 2L))) { - *Result = 0.0; - p = LineCoeff + (ptrdiff_t)(i + (Degree + 1L) / 2L); - y = x; - for (j = 0L; (j <= Degree); j++) { - *Result += *y++ * *p--; - } - } - else { - switch (Convention) { - case AntiMirrorOnBounds: - case FiniteDataSupport: - AllocateLineDouble(&y, Degree + 1L, Status); - if (*Status == ERROR) { - FreeLineDouble(&x); -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - k = Degree; - for (j = i + (Degree + 1L) / 2L; ((i - (Degree - 1L) / 2L) - <= j); j--) { - *Status = GetFoldedValueDouble(LineCoeff, j, &(y[k--]), - LineLength, Convention); - if (*Status == ERROR) { - FreeLineDouble(&y); - FreeLineDouble(&x); -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - } - *Result = 0.0; - k = Degree; - for (j = 0L; (j <= Degree); j++) { - *Result += x[j] * y[k--]; - } - *Status = FreeLineDouble(&y); - if (*Status == ERROR) { - FreeLineDouble(&x); -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - break; - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - n = (long *)malloc((size_t)((Degree + 1L) - * (long)sizeof(long))); - if (n == (long *)NULL) { - *Status = ERROR; - FreeLineDouble(&x); - WRITE_ERROR(SplineInterpolateLine, - "Unable to perform allocation") -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - k = Degree; - for (j = i + (Degree + 1L) / 2L; ((i - (Degree - 1L) / 2L) - <= j); j--) { - *Status = GetFoldedIndex(j, &(n[k--]), LineLength, - Convention); - if (*Status == ERROR) { - free(n); - FreeLineDouble(&x); -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - } - *Result = 0.0; - k = Degree; - for (j = 0L; (j <= Degree); j++) { - *Result += x[j] * LineCoeff[n[k--]]; - } - free(n); - break; - default: - *Status = ERROR; - FreeLineDouble(&x); - WRITE_ERROR(SplineInterpolateLine, - "Unexpected boundary convention") -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - } - } - else { - i = ConvertDoubleToLong(Argument); - w = Argument - (double)i - (double)(Degree / 2L); - p = x; - for (j = 0L; (j <= Degree); j++) { - *Status = Bspline(Degree, w++, p++); - if (*Status == ERROR) { - FreeLineDouble(&x); -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - } - if (((Degree / 2L) <= i) && (i < (LineLength - Degree / 2L))) { - *Result = 0.0; - p = LineCoeff + (ptrdiff_t)(i + Degree / 2L); - y = x; - for (j = 0L; (j <= Degree); j++) { - *Result += *y++ * *p--; - } - } - else { - switch (Convention) { - case AntiMirrorOnBounds: - case FiniteDataSupport: - AllocateLineDouble(&y, Degree + 1L, Status); - if (*Status == ERROR) { - FreeLineDouble(&x); -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - k = Degree; - for (j = i + Degree / 2L; ((i - Degree / 2L) <= j); j--) { - *Status = GetFoldedValueDouble(LineCoeff, j, &(y[k--]), - LineLength, Convention); - if (*Status == ERROR) { - FreeLineDouble(&y); - FreeLineDouble(&x); -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - } - *Result = 0.0; - k = Degree; - for (j = 0L; (j <= Degree); j++) { - *Result += x[j] * y[k--]; - } - *Status = FreeLineDouble(&y); - if (*Status == ERROR) { - FreeLineDouble(&x); -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - break; - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - n = (long *)malloc((size_t)((Degree + 1L) - * (long)sizeof(long))); - if (n == (long *)NULL) { - *Status = ERROR; - FreeLineDouble(&x); - WRITE_ERROR(SplineInterpolateLine, - "Unable to perform allocation") -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - k = Degree; - for (j = i + Degree / 2L; ((i - Degree / 2L) <= j); j--) { - *Status = GetFoldedIndex(j, &(n[k--]), LineLength, - Convention); - if (*Status == ERROR) { - free(n); - FreeLineDouble(&x); -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - } - *Result = 0.0; - k = Degree; - for (j = 0L; (j <= Degree); j++) { - *Result += x[j] * LineCoeff[n[k--]]; - } - free(n); - break; - default: - *Status = ERROR; - FreeLineDouble(&x); - WRITE_ERROR(SplineInterpolateLine, - "Unexpected boundary convention") -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); - } - } - } - *Status = FreeLineDouble(&x); - break; - } -/**/DEBUG_WRITE_LEAVING(SplineInterpolateLine, "Done") - return(*Status); -} /* end SplineInterpolateLine */ - -/*--------------------------------------------------------------------------*/ -extern int SplineInterpolateVolume - ( - float *VolumeCoeff, /* B-spline coefficients to interpolate */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - double Xargument, /* input X abscissa */ - double Yargument, /* input Y abscissa */ - double Zargument, /* input Z abscissa */ - double *Result, /* output ordinate */ - long Degree, /* degree of the spline */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ) - -{ /* begin SplineInterpolateVolume */ - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(SplineInterpolateVolume, VolumeCoeff, *Status, -/**/ "Missing VolumeCoeff") -/**/DEBUG_CHECK_NULL_POINTER(SplineInterpolateVolume, Result, *Status, -/**/ "Missing Result") -/**/DEBUG_CHECK_RANGE_LONG(SplineInterpolateVolume, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid Nx (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(SplineInterpolateVolume, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid Ny (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(SplineInterpolateVolume, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid Nz (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(SplineInterpolateVolume, Degree, 0L, LONG_MAX, *Status, -/**/ "Invalid Degree (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(SplineInterpolateVolume, *Status) -/**/DEBUG_WRITE_ENTERING(SplineInterpolateVolume, -/**/ "About to execute SplineInterpolateVolume") - - switch (Convention) { - case AntiMirrorOnBounds: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case FiniteDataSupport: - if (2L <= Degree) { - *Status = ERROR; - WRITE_ERROR(SplineInterpolateVolume, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateVolume, "Done") - return(*Status); - } - break; - case FiniteCoefficientSupport: - Convention = FiniteDataSupport; - break; - default: - *Status = ERROR; - WRITE_ERROR(SplineInterpolateVolume, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(SplineInterpolateVolume, "Done") - return(*Status); - } - - *Status = ERROR; - WRITE_ERROR(SplineInterpolateVolume, "Not yet implemented") - -/**/DEBUG_WRITE_LEAVING(SplineInterpolateVolume, "Done") - return(*Status); -} /* SplineInterpolateVolume */ - diff --git a/src/core/bilib/interpolate.h b/src/core/bilib/interpolate.h deleted file mode 100644 index 78081cb..0000000 --- a/src/core/bilib/interpolate.h +++ /dev/null @@ -1,59 +0,0 @@ -/**@defgroup SplineInterpolation Spline interpolation - @ingroup BilibLibrary */ -//@{ -/*--------------------------------------------------------------------------*/ -/** Interpolation 1D. - Interpolation of the 1D array LineCoeff[] of length LineLength. - Result = SUM(k): LineCoeff[k] * B-spline(Degree, Argument - k). - Convention must be consistent with the B-spline coefficients stored - in LineCoeff[] - - success: return(!ERROR); failure: return(ERROR) */ -extern int SplineInterpolateLine - ( - double LineCoeff[], /* B-spline coefficients to interpolate */ - long LineLength, /* length of the line */ - double Argument, /* input abscissa */ - double *Result, /* output ordinate */ - long Degree, /* degree of the spline */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Interpolation 2D. - See coments on the 1D interpolation. */ -extern int SplineInterpolateImage - ( - float *ImageCoeff, /* B-spline coefficients to interpolate */ - long Nx, /* width of the image */ - long Ny, /* height of the image */ - double Xargument, /* input X abscissa */ - double Yargument, /* input Y abscissa */ - double *Result, /* output ordinate */ - long Degree, /* degree of the spline */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Interpolation 3D. - See coments on the 1D interpolation. */ -extern int SplineInterpolateVolume - ( - float *VolumeCoeff, /* B-spline coefficients to interpolate */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - double Xargument, /* input X abscissa */ - double Yargument, /* input Y abscissa */ - double Zargument, /* input Z abscissa */ - double *Result, /* output ordinate */ - long Degree, /* degree of the spline */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ); -//@} diff --git a/src/core/bilib/kernel.cc b/src/core/bilib/kernel.cc deleted file mode 100644 index 81f122a..0000000 --- a/src/core/bilib/kernel.cc +++ /dev/null @@ -1,2185 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -#include -#include - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" -#include "error.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "kernel.h" -#include "messagedisplay.h" -#include "positivepower.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -#ifdef DEBUG -#include -#include -#endif - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern int Blip - ( - long Degree, /* degree */ - double Argument, /* input */ - double *Result /* output */ - ) - -/* computes a Blu interpolant function */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin Blip */ - - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(Blip, Result, Status, -/**/ "No output data") -/**/DEBUG_RETURN_ON_ERROR(Blip, Status) -/**/DEBUG_WRITE_ENTERING(Blip, -/**/ "About to compute a generic blip") - - switch (Degree) { - case 0L: - *Result = Blip00(Argument); - break; - case 1L: - *Result = Blip01(Argument); - break; - case 3L: - *Result = Blip03(Argument); - break; - default: - Status = ERROR; - WRITE_ERROR(Blip, "Invalid blip degree") - break; - } -/**/DEBUG_WRITE_LEAVING(Blip, "Done") - return(Status); -} /* end Blip */ - -/*--------------------------------------------------------------------------*/ -extern double Blip00 - ( - double Argument /* input */ - ) - -/* returns the value of a Blu interpolant function of degree 0 (order 1) evaluated at Argument */ - -{ /* begin Blip00 */ - -/**/DEBUG_WRITE_ENTERING(Blip00, -/**/ "About to compute a blip of degree 0") - - Argument = fabs(Argument); - if (Argument < 0.5) { -/**/ DEBUG_WRITE_LEAVING(Blip00, "Done") - return(1.0); - } - else if (Argument == 0.5) { -/**/ DEBUG_WRITE_LEAVING(Blip00, "Done") - return(0.5); - } - else { -/**/ DEBUG_WRITE_LEAVING(Blip00, "Done") - return(0.0); - } -} /* end Blip00 */ - -/*--------------------------------------------------------------------------*/ -extern double Blip01 - ( - double Argument /* input */ - ) - -/* returns the value of a Blu interpolant function of degree 1 (order 2) evaluated at Argument */ - -{ /* begin Blip01 */ - -/**/DEBUG_WRITE_ENTERING(Blip01, -/**/ "About to compute a blip of degree 1") - - Argument = fabs(Argument); - if (Argument < 1.0) { -/**/ DEBUG_WRITE_LEAVING(Blip01, "Done") - return(1.0 - Argument); - } - else { -/**/ DEBUG_WRITE_LEAVING(Blip01, "Done") - return(0.0); - } -} /* end Blip01 */ - -/*--------------------------------------------------------------------------*/ -extern double Blip03 - ( - double Argument /* input */ - ) - -/* returns the value of a Blu interpolant function of degree 3 (order 4) evaluated at Argument */ - -{ /* begin Blip03 */ - -/**/DEBUG_WRITE_ENTERING(Blip03, -/**/ "About to compute a blip of degree 3") - - Argument = fabs(Argument); - if (Argument < 1.0) { -/**/ DEBUG_WRITE_LEAVING(Blip03, "Done") - return(Argument * (Argument * (Argument * (1.0 / 2.0) - 1.0) + 3.0 / 56.0) - + 53.0 / 84.0); - } - else if (Argument < 2.0) { -/**/ DEBUG_WRITE_LEAVING(Blip03, "Done") - return(Argument * (Argument * (1.0 - Argument * (1.0 / 6.0)) - 113.0 / 56.0) - + 115.0 / 84.0); - } - else { -/**/ DEBUG_WRITE_LEAVING(Blip03, "Done") - return(0.0); - } -} /* end Blip03 */ - -/*--------------------------------------------------------------------------*/ -extern int Bspline - ( - long Degree, /* degree */ - double Argument, /* input */ - double *Result /* output */ - ) - -/* computes a Basic spline function */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin Bspline */ - - double Up, Shift, Binomial; - long i; - int Status = !ERROR; - -/**/DEBUG_CHECK_RANGE_LONG(Bspline, Degree, 0L, LONG_MAX, Status, -/**/ "Invalid degree (should be positive)") -/**/DEBUG_CHECK_NULL_POINTER(Bspline, Result, Status, -/**/ "No output data") -/**/DEBUG_RETURN_ON_ERROR(Bspline, Status) -/**/DEBUG_WRITE_ENTERING(Bspline, -/**/ "About to compute a generic B-spline") - - switch (Degree) { - case 0L: - *Result = Bspline00(Argument); - break; - case 1L: - *Result = Bspline01(Argument); - break; - case 2L: - *Result = Bspline02(Argument); - break; - case 3L: - *Result = Bspline03(Argument); - break; - case 4L: - *Result = Bspline04(Argument); - break; - case 5L: - *Result = Bspline05(Argument); - break; - case 6L: - *Result = Bspline06(Argument); - break; - case 7L: - *Result = Bspline07(Argument); - break; - case 8L: - *Result = Bspline08(Argument); - break; - case 9L: - *Result = Bspline09(Argument); - break; - case 10L: - *Result = Bspline10(Argument); - break; - case 11L: - *Result = Bspline11(Argument); - break; - default: - Argument = fabs(Argument); - *Result = 0.0; - Up = (double)(Degree + 1L); - Argument += 0.5 * Up; - Binomial = 1.0; - for (i = 2L; (i <= Degree); i++) { - Binomial *= (double)i; - } - Binomial = 1.0 / Binomial; - Shift = 0.0; - while ((Shift <= Up) && (Shift < Argument)) { - *Result += Binomial * PositiveIntPower(Argument - Shift, Degree); - Binomial *= (Shift - Up) / (Shift + 1.0); - Shift += 1.0; - } - break; - } -/**/DEBUG_WRITE_LEAVING(Bspline, "Done") - return(Status); -} /* end Bspline */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline00 - ( - double Argument /* input */ - ) - -/* returns the value of a Basic spline function of degree 0 (order 1) evaluated at Argument */ - -{ /* begin Bspline00 */ - -/**/DEBUG_WRITE_ENTERING(Bspline00, -/**/ "About to compute a B-spline of degree 0") - - Argument = fabs(Argument); - if (Argument < 0.5) { -/**/ DEBUG_WRITE_LEAVING(Bspline00, "Done") - return(1.0); - } - else if (Argument == 0.5) { -/**/ DEBUG_WRITE_LEAVING(Bspline00, "Done") - return(0.5); - } - else { -/**/ DEBUG_WRITE_LEAVING(Bspline00, "Done") - return(0.0); - } -} /* end Bspline00 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline01 - ( - double Argument /* input */ - ) - -/* returns the value of a Basic spline function of degree 1 (order 2) evaluated at Argument */ - -{ /* begin Bspline01 */ - -/**/DEBUG_WRITE_ENTERING(Bspline01, -/**/ "About to compute a B-spline of degree 1") - - Argument = fabs(Argument); - if (Argument < 1.0) { -/**/ DEBUG_WRITE_LEAVING(Bspline01, "Done") - return(1.0 - Argument); - } - else { -/**/ DEBUG_WRITE_LEAVING(Bspline01, "Done") - return(0.0); - } -} /* end Bspline01 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline02 - ( - double Argument /* input */ - ) - -/* returns the value of a Basic spline function of degree 2 (order 3) evaluated at Argument */ - -{ /* begin Bspline02 */ - -/**/DEBUG_WRITE_ENTERING(Bspline02, -/**/ "About to compute a B-spline of degree 2") - - Argument = fabs(Argument); - if (Argument < 0.5) { -/**/ DEBUG_WRITE_LEAVING(Bspline02, "Done") - return(3.0 / 4.0 - Argument * Argument); - } - else if (Argument < 1.5) { - Argument -= 3.0 / 2.0; -/**/ DEBUG_WRITE_LEAVING(Bspline02, "Done") - return(Argument * Argument * (1.0 / 2.0)); - } - else { -/**/ DEBUG_WRITE_LEAVING(Bspline02, "Done") - return(0.0); - } -} /* end Bspline02 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline03 - ( - double Argument /* input */ - ) - -/* returns the value of a Basic spline function of degree 3 (order 4) evaluated at Argument */ - -{ /* begin Bspline03 */ - -/**/DEBUG_WRITE_ENTERING(Bspline03, -/**/ "About to compute a B-spline of degree 3") - - Argument = fabs(Argument); - if (Argument < 1.0) { -/**/ DEBUG_WRITE_LEAVING(Bspline03, "Done") - return(Argument * Argument * (Argument - 2.0) * (1.0 / 2.0) + 2.0 / 3.0); - } - else if (Argument < 2.0) { - Argument -= 2.0; -/**/ DEBUG_WRITE_LEAVING(Bspline03, "Done") - return(Argument * Argument * Argument * (-1.0 / 6.0)); - } - else { -/**/ DEBUG_WRITE_LEAVING(Bspline03, "Done") - return(0.0); - } -} /* end Bspline03 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline04 - ( - double Argument /* input */ - ) - -/* returns the value of a Basic spline function of degree 4 (order 5) evaluated at Argument */ - -{ /* begin Bspline04 */ - -/**/DEBUG_WRITE_ENTERING(Bspline04, -/**/ "About to compute a B-spline of degree 4") - - Argument = fabs(Argument); - if (Argument < 0.5) { - Argument *= Argument; -/**/ DEBUG_WRITE_LEAVING(Bspline04, "Done") - return(Argument * (Argument * (1.0 / 4.0) - 5.0 / 8.0) + 115.0 / 192.0); - } - else if (Argument < 1.5) { -/**/ DEBUG_WRITE_LEAVING(Bspline04, "Done") - return(Argument * (Argument * (Argument * (5.0 / 6.0 - Argument * (1.0 / 6.0)) - - 5.0 / 4.0) + 5.0 / 24.0) + 55.0 / 96.0); - } - else if (Argument < 2.5) { - Argument -= 5.0 / 2.0; - Argument *= Argument; -/**/ DEBUG_WRITE_LEAVING(Bspline04, "Done") - return(Argument * Argument * (1.0 / 24.0)); - } - else { -/**/ DEBUG_WRITE_LEAVING(Bspline04, "Done") - return(0.0); - } -} /* end Bspline04 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline05 - ( - double Argument /* input */ - ) - -/* returns the value of a Basic spline function of degree 5 (order 6) evaluated at Argument */ - -{ /* begin Bspline05 */ - - double a; - -/**/DEBUG_WRITE_ENTERING(Bspline05, -/**/ "About to compute a B-spline of degree 5") - - Argument = fabs(Argument); - if (Argument < 1.0) { - a = Argument * Argument; -/**/ DEBUG_WRITE_LEAVING(Bspline05, "Done") - return(a * (a * (1.0 / 4.0 - Argument * (1.0 / 12.0)) - 1.0 / 2.0) - + 11.0 / 20.0); - } - else if (Argument < 2.0) { -/**/ DEBUG_WRITE_LEAVING(Bspline05, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument - * (1.0 / 24.0) - 3.0 / 8.0) + 5.0 / 4.0) - 7.0 / 4.0) + 5.0 / 8.0) + 17.0 / 40.0); - } - else if (Argument < 3.0) { - a = 3.0 - Argument; - Argument = a * a; -/**/ DEBUG_WRITE_LEAVING(Bspline05, "Done") - return(a * Argument * Argument * (1.0 / 120.0)); - } - else { -/**/ DEBUG_WRITE_LEAVING(Bspline05, "Done") - return(0.0); - } -} /* end Bspline05 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline06 - ( - double Argument /* input */ - ) - -/* returns the value of a Basic spline function of degree 6 (order 7) evaluated at Argument */ - -{ /* begin Bspline06 */ - -/**/DEBUG_WRITE_ENTERING(Bspline06, -/**/ "About to compute a B-spline of degree 6") - - Argument = fabs(Argument); - if (Argument < 0.5) { - Argument *= Argument; -/**/ DEBUG_WRITE_LEAVING(Bspline06, "Done") - return(Argument * (Argument * (7.0 / 48.0 - Argument - * (1.0 / 36.0)) - 77.0 / 192.0) + 5887.0 / 11520.0); - } - else if (Argument < 1.5) { -/**/ DEBUG_WRITE_LEAVING(Bspline06, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (1.0 / 48.0) - 7.0 / 48.0) + 21.0 / 64.0) - 35.0 / 288.0) - 91.0 / 256.0) - - 7.0 / 768.0) + 7861.0 / 15360.0); - } - else if (Argument < 2.5) { -/**/ DEBUG_WRITE_LEAVING(Bspline06, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument - * (7.0 / 60.0 - Argument * (1.0 / 120.0)) - 21.0 / 32.0) + 133.0 / 72.0) - - 329.0 / 128.0) + 1267.0 / 960.0) + 1379.0 / 7680.0); - } - else if (Argument < 3.5) { - Argument -= 7.0 / 2.0; - Argument *= Argument * Argument; -/**/ DEBUG_WRITE_LEAVING(Bspline06, "Done") - return(Argument * Argument * (1.0 / 720.0)); - } - else { -/**/ DEBUG_WRITE_LEAVING(Bspline06, "Done") - return(0.0); - } -} /* end Bspline06 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline07 - ( - double Argument /* input */ - ) - -/* returns the value of a Basic spline function of degree 7 (order 8) evaluated at Argument */ - -{ /* begin Bspline07 */ - - double a; - -/**/DEBUG_WRITE_ENTERING(Bspline07, -/**/ "About to compute a B-spline of degree 7") - - Argument = fabs(Argument); - if (Argument < 1.0) { - a = Argument * Argument; -/**/ DEBUG_WRITE_LEAVING(Bspline07, "Done") - return(a * (a * (a * (Argument * (1.0 / 144.0) - 1.0 / 36.0) + 1.0 / 9.0) - - 1.0 / 3.0) + 151.0 / 315.0); - } - else if (Argument < 2.0) { -/**/ DEBUG_WRITE_LEAVING(Bspline07, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (1.0 / 20.0 - Argument * (1.0 / 240.0)) - 7.0 / 30.0) + 1.0 / 2.0) - - 7.0 / 18.0) - 1.0 / 10.0) - 7.0 / 90.0) + 103.0 / 210.0); - } - else if (Argument < 3.0) { -/**/ DEBUG_WRITE_LEAVING(Bspline07, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (1.0 / 720.0) - 1.0 / 36.0) + 7.0 / 30.0) - 19.0 / 18.0) - + 49.0 / 18.0) - 23.0 / 6.0) + 217.0 / 90.0) - 139.0 / 630.0); - } - else if (Argument < 4.0) { - a = 4.0 - Argument; - Argument = a * a * a; -/**/ DEBUG_WRITE_LEAVING(Bspline07, "Done") - return(Argument * Argument * a * (1.0 / 5040.0)); - } - else { -/**/ DEBUG_WRITE_LEAVING(Bspline07, "Done") - return(0.0); - } -} /* end Bspline07 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline08 - ( - double Argument /* input */ - ) - -/* returns the value of a Basic spline function of degree 8 (order 9) evaluated at Argument */ - -{ /* begin Bspline08 */ - -/**/DEBUG_WRITE_ENTERING(Bspline08, -/**/ "About to compute a B-spline of degree 8") - - Argument = fabs(Argument); - if (Argument < 0.5) { - Argument *= Argument; -/**/ DEBUG_WRITE_LEAVING(Bspline08, "Done") - return(Argument * (Argument * (Argument * (Argument * (1.0 / 576.0) - 1.0 / 64.0) - + 43.0 / 512.0) - 289.0 / 1024.0) + 259723.0 / 573440.0); - } - else if (Argument < 1.5) { -/**/ DEBUG_WRITE_LEAVING(Bspline08, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (1.0 / 80.0 - Argument * (1.0 / 720.0)) - 3.0 / 80.0) - + 7.0 / 320.0) + 9.0 / 128.0) + 7.0 / 1280.0) - 363.0 / 1280.0) - + 1.0 / 5120.0) + 64929.0 / 143360.0); - } - else if (Argument < 2.5) { -/**/ DEBUG_WRITE_LEAVING(Bspline08, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (1.0 / 1440.0) - 1.0 / 80.0) + 3.0 / 32.0) - - 119.0 / 320.0) + 207.0 / 256.0) - 1127.0 / 1280.0) + 195.0 / 512.0) - - 1457.0 / 5120.0) + 145167.0 / 286720.0); - } - else if (Argument < 3.5) { -/**/ DEBUG_WRITE_LEAVING(Bspline08, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (3.0 / 560.0 - Argument * (1.0 / 5040.0)) - 5.0 / 80.0) - + 131.0 / 320.0) - 209.0 / 128.0) + 5123.0 / 1280.0) - 1465.0 / 256.0) - + 146051.0 / 35840.0) - 122729.0 / 143360.0); - } - else if (Argument < 4.5) { - Argument -= 9.0 / 2.0; - Argument *= Argument; - Argument *= Argument; -/**/ DEBUG_WRITE_LEAVING(Bspline08, "Done") - return(Argument * Argument * (1.0 / 40320.0)); - } - else { -/**/ DEBUG_WRITE_LEAVING(Bspline08, "Done") - return(0.0); - } -} /* end Bspline08 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline09 - ( - double Argument /* input */ - ) - -/* returns the value of a Basic spline function of degree 9 (order 10) evaluated at Argument */ - -{ /* begin Bspline09 */ - - double a; - -/**/DEBUG_WRITE_ENTERING(Bspline09, -/**/ "About to compute a B-spline of degree 9") - - Argument = fabs(Argument); - if (Argument < 1.0) { - a = Argument * Argument; -/**/ DEBUG_WRITE_LEAVING(Bspline09, "Done") - return(a * (a * (a * (a * (1.0 / 576.0 - Argument * (1.0 / 2880.0)) - - 5.0 / 432.0) + 19.0 / 288.0) - 35.0 / 144.0) + 15619.0 / 36288.0); - } - else if (Argument < 2.0) { -/**/ DEBUG_WRITE_LEAVING(Bspline09, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (Argument * (1.0 / 4320.0) - 1.0 / 288.0) - + 1.0 / 48.0) - 13.0 / 216.0) + 7.0 / 96.0) - 1.0 / 144.0) + 7.0 / 144.0) - - 19.0 / 72.0) + 1.0 / 192.0) + 7799.0 / 18144.0); - } - else if (Argument < 3.0) { -/**/ DEBUG_WRITE_LEAVING(Bspline09, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (5.0 / 2016.0 - Argument * (1.0 / 10080.0)) - - 3.0 / 112.0) + 35.0 / 216.0) - 19.0 / 32.0) + 191.0 / 144.0) - 83.0 / 48.0) - + 635.0 / 504.0) - 339.0 / 448.0) + 1553.0 / 2592.0); - } - else if (Argument < 4.0) { -/**/ DEBUG_WRITE_LEAVING(Bspline09, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (Argument * (1.0 / 40320.0) - 1.0 / 1152.0) - + 3.0 / 224.0) - 103.0 / 864.0) + 43.0 / 64.0) - 1423.0 / 576.0) - + 563.0 / 96.0) - 2449.0 / 288.0) + 5883.0 / 896.0) - 133663.0 / 72576.0); - } - else if (Argument < 5.0) { - a = 5.0 - Argument; - Argument = a * a; - Argument *= Argument; -/**/ DEBUG_WRITE_LEAVING(Bspline09, "Done") - return(Argument * Argument * a * (1.0 / 362880.0)); - } - else { -/**/ DEBUG_WRITE_LEAVING(Bspline09, "Done") - return(0.0); - } -} /* end Bspline09 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline10 - ( - double Argument /* input */ - ) - -/* returns the value of a Basic spline function of degree 10 (order 11) evaluated at Argument */ - -{ /* begin Bspline10 */ - - double a; - -/**/DEBUG_WRITE_ENTERING(Bspline10, -/**/ "About to compute a B-spline of degree 10") - - Argument = fabs(Argument); - if (Argument < 0.5) { - Argument *= Argument; -/**/ DEBUG_WRITE_LEAVING(Bspline10, "Done") - return(Argument * (Argument * (Argument * (Argument * (11.0 / 11520.0 - - Argument * (1.0 / 14400.0)) - 583.0 / 69120.0) + 14597.0 / 276480.0) - - 156409.0 / 737280.0) + 381773117.0 / 928972800.0); - } - else if (Argument < 1.5) { -/**/ DEBUG_WRITE_LEAVING(Bspline10, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (Argument * (Argument * (1.0 / 17280.0) - - 11.0 / 17280.0) + 11.0 / 4608.0) - 11.0 / 5760.0) - 187.0 / 27648.0) - - 77.0 / 76800.0) + 5885.0 / 110592.0) - 11.0 / 92160.0) - - 62557.0 / 294912.0) - 11.0 / 4423680.0) + 152709293.0 / 371589120.0); - } - else if (Argument < 2.5) { -/**/ DEBUG_WRITE_LEAVING(Bspline10, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (Argument * (11.0 / 15120.0 - Argument - * (1.0 / 30240.0)) - 55.0 / 8064.0) + 11.0 / 315.0) - 715.0 / 6912.0) - + 1661.0 / 9600.0) - 4543.0 / 27648.0) + 7513.0 / 40320.0) - - 163603.0 / 516096.0) + 135311.0 / 3870720.0) + 37690169.0 / 92897280.0); - } - else if (Argument < 3.5) { -/**/ DEBUG_WRITE_LEAVING(Bspline10, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (Argument * (Argument * (1.0 / 80640.0) - - 11.0 / 26880.0) + 55.0 / 9216.0) - 451.0 / 8960.0) + 14905.0 / 55296.0) - - 48433.0 / 51200.0) + 479281.0 / 221184.0) - 1352153.0 / 430080.0) - + 1654543.0 / 589824.0) - 11695211.0 / 6881280.0) + 623786977.0 / 743178240.0); - } - else if (Argument < 4.5) { -/**/ DEBUG_WRITE_LEAVING(Bspline10, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (Argument * (11.0 / 90720.0 - Argument - * (1.0 / 362880.0)) - 11.0 / 4608.0) + 209.0 / 7560.0) - 5753.0 / 27648.0) - + 61061.0 / 57600.0) - 407429.0 / 110592.0) + 2070343.0 / 241920.0) - - 3702215.0 / 294912.0) + 237959711.0 / 23224320.0) - 1241720381.0 / 371589120.0); - } - else if (Argument < 5.5) { - Argument -= 11.0 / 2.0; - a = Argument * Argument; - a *= Argument * a; -/**/ DEBUG_WRITE_LEAVING(Bspline10, "Done") - return(a * a * (1.0 / 3628800.0)); - } - else { -/**/ DEBUG_WRITE_LEAVING(Bspline10, "Done") - return(0.0); - } -} /* end Bspline10 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline11 - ( - double Argument /* input */ - ) - -/* returns the value of a Basic spline function of degree 11 (order 12) evaluated at Argument */ - -{ /* begin Bspline11 */ - - double a; - -/**/DEBUG_WRITE_ENTERING(Bspline11, -/**/ "About to compute a B-spline of degree 11") - - Argument = fabs(Argument); - if (Argument < 1.0) { - a = Argument * Argument; -/**/ DEBUG_WRITE_LEAVING(Bspline11, "Done") - return(a * (a * (a * (a * (a * (Argument * (1.0 / 86400.0) - 1.0 / 14400.0) - + 1.0 / 1440.0) - 23.0 / 3600.0) + 31.0 / 720.0) - 809.0 / 4320.0) - + 655177.0 / 1663200.0); - } - else if (Argument < 2.0) { -/**/ DEBUG_WRITE_LEAVING(Bspline11, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (Argument * (Argument * (1.0 / 6720.0 - - Argument * (1.0 / 120960.0)) - 11.0 / 10080.0) + 1.0 / 252.0) - - 11.0 / 1680.0) + 1.0 / 360.0) - 11.0 / 1200.0) + 25.0 / 504.0) - - 11.0 / 3360.0) - 563.0 / 3024.0) - 11.0 / 50400.0) + 65521.0 / 166320.0); - } - else if (Argument < 3.0) { -/**/ DEBUG_WRITE_LEAVING(Bspline11, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (Argument * (Argument * (Argument - * (1.0 / 241920.0) - 1.0 / 8064.0) + 11.0 / 6720.0) - 25.0 / 2016.0) - + 33.0 / 560.0) - 13.0 / 72.0) + 143.0 / 400.0) - 239.0 / 504.0) - + 583.0 / 1120.0) - 1619.0 / 3024.0) + 781.0 / 5600.0) + 61297.0 / 166320.0); - } - else if (Argument < 4.0) { -/**/ DEBUG_WRITE_LEAVING(Bspline11, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (Argument * (Argument * (1.0 / 17280.0 - - Argument * (1.0 / 725760.0)) - 11.0 / 10080.0) + 7.0 / 576.0) - - 99.0 / 1120.0) + 631.0 / 1440.0) - 1199.0 / 800.0) + 1009.0 / 288.0) - - 12199.0 / 2240.0) + 9385.0 / 1728.0) - 38533.0 / 11200.0) - + 894727.0 / 665280.0); - } - else if (Argument < 5.0) { -/**/ DEBUG_WRITE_LEAVING(Bspline11, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (Argument * (Argument * (Argument - * (1.0 / 3628800.0) - 1.0 / 67200.0) + 11.0 / 30240.0) - - 107.0 / 20160.0) + 517.0 / 10080.0) - 2477.0 / 7200.0) - + 11737.0 / 7200.0) - 54797.0 / 10080.0) + 250657.0 / 20160.0) - - 1113317.0 / 60480.0) + 4726777.0 / 302400.0) - 18595037.0 / 3326400.0); - } - else if (Argument < 6.0) { - a = 6.0 - Argument; - Argument = a * a; - Argument *= Argument * a; -/**/ DEBUG_WRITE_LEAVING(Bspline11, "Done") - return(Argument * Argument * a * (1.0 / 39916800.0)); - } - else { -/**/ DEBUG_WRITE_LEAVING(Bspline11, "Done") - return(0.0); - } -} /* end Bspline11 */ - -/*--------------------------------------------------------------------------*/ -extern int BsplineArray02 - ( - double Argument, /* fractional input */ - double *b2_minus1, /* 1st returned coefficient */ - double *b2_plus0, /* 2nd returned coefficient */ - double *b2_plus1 /* 3rd returned coefficient */ - ) - -/* returns 3 values for a Basic spline function of degree 2 (order 3) */ -/* evaluation is performed at {Argument - 1.0, Argument, Argument + 1.0} */ -/* Argument must be in [-0.5, 0.5] */ -/* computational load: */ -/* 3 indirections */ -/* 4(double)assignments, 4 (double)additions, 2 (double)multiplications */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin BsplineArray02 */ - - double a = Argument - 0.5; - int Status = !ERROR; - -/**/DEBUG_CHECK_RANGE_DOUBLE(BsplineArray02, Argument, 0.0, 1.0, Status, -/**/ "Invalid argument (should be in [-0.5, 0.5])") -/**/DEBUG_CHECK_NULL_POINTER(BsplineArray02, b2_minus1, Status, -/**/ "No 1st output coefficient") -/**/DEBUG_CHECK_NULL_POINTER(BsplineArray02, b2_plus0, Status, -/**/ "No 2nd output coefficient") -/**/DEBUG_CHECK_NULL_POINTER(BsplineArray02, b2_plus1, Status, -/**/ "No 3rd output coefficient") -/**/DEBUG_RETURN_ON_ERROR(BsplineArray02, Status) -/**/DEBUG_WRITE_ENTERING(BsplineArray02, -/**/ "About to compute an array of B-splines of degree 2") - - *b2_plus1 = 0.5 * a * a; - *b2_minus1 = *b2_plus1 + Argument; - *b2_plus0 = 1.0 - *b2_plus1 - *b2_minus1; - -/**/DEBUG_WRITE_LEAVING(BsplineArray02, "Done") - return(Status); -} /* end BsplineArray02 */ - -/*--------------------------------------------------------------------------*/ -extern int BsplineArray03 - ( - double Argument, /* fractional input */ - double *b3_minus2, /* 1st returned coefficient */ - double *b3_minus1, /* 2nd returned coefficient */ - double *b3_plus0, /* 3rd returned coefficient */ - double *b3_plus1 /* 4th returned coefficient */ - ) - -/* returns 4 values for a Basic spline function of degree 3 (order 4) */ -/* evaluation is performed at {Argument - 2.0, Argument - 1.0, Argument, Argument + 1.0} */ -/* Argument must be in [0.0, 1.0] */ -/* computational load: */ -/* 7 indirections */ -/* 7(double)assignments, 6 (double)additions, 8 (double)multiplications */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin BsplineArray03 */ - - double a1 = 1.0 - Argument, a2 = Argument * Argument; - int Status = !ERROR; - -/**/DEBUG_CHECK_RANGE_DOUBLE(BsplineArray03, Argument, 0.0, 1.0, Status, -/**/ "Invalid argument (should be in [0.0, 1.0])") -/**/DEBUG_CHECK_NULL_POINTER(BsplineArray03, b3_minus2, Status, -/**/ "No 1st output coefficient") -/**/DEBUG_CHECK_NULL_POINTER(BsplineArray03, b3_minus1, Status, -/**/ "No 2nd output coefficient") -/**/DEBUG_CHECK_NULL_POINTER(BsplineArray03, b3_plus0, Status, -/**/ "No 3rd output coefficient") -/**/DEBUG_CHECK_NULL_POINTER(BsplineArray03, b3_plus1, Status, -/**/ "No 4th output coefficient") -/**/DEBUG_RETURN_ON_ERROR(BsplineArray03, Status) -/**/DEBUG_WRITE_ENTERING(BsplineArray03, -/**/ "About to compute an array of B-splines of degree 3") - - *b3_plus1 = (1.0 / 6.0) * a1 * a1 * a1; - *b3_plus0 = 2.0 / 3.0 - (1.0 / 2.0) * a2 * ++a1; - *b3_minus2 = (1.0 / 6.0) * a2 * Argument; - *b3_minus1 = 1.0 - *b3_plus1 - *b3_plus0 - *b3_minus2; - -/**/DEBUG_WRITE_LEAVING(BsplineArray03, "Done") - return(Status); -} /* end BsplineArray03 */ - -/*--------------------------------------------------------------------------*/ -extern double Dodgson - ( - double Argument /* input */ - ) - -/* returns the value of a Dodgson kernel evaluated at Argument (order 2) */ - -{ /* begin Dodgson */ - -/**/DEBUG_WRITE_ENTERING(Dodgson, -/**/ "About to compute a Dodgson kernel") - - Argument = fabs(Argument); - if (Argument < 0.5) { -/**/ DEBUG_WRITE_LEAVING(Dodgson, "Done") - return(1.0 - 2.0 * Argument * Argument); - } - else if (Argument < 1.5) { - Argument -= 5.0 / 4.0; -/**/ DEBUG_WRITE_LEAVING(Dodgson, "Done") - return(Argument * Argument - 1.0 / 16.0); - } - else { -/**/ DEBUG_WRITE_LEAVING(Dodgson, "Done") - return(0.0); - } -} /* end Dodgson */ - -/*--------------------------------------------------------------------------*/ -extern int DodgsonArray - ( - double Argument, /* fractional input */ - double *d_minus1, /* 1st returned coefficient */ - double *d_plus0, /* 2nd returned coefficient */ - double *d_plus1 /* 3rd returned coefficient */ - ) - -/* returns 3 values for a Dodgson kernel (order 2) */ -/* evaluation is performed at {Argument - 1.0, Argument, Argument + 1.0} */ -/* Argument must be in [-0.5, 0.5] */ -/* computational load: */ -/* 5 indirections */ -/* 4(double)assignments, 4 (double)additions, 3 (double)multiplications */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin DodgsonArray */ - - double a2 = Argument * Argument; - int Status = !ERROR; - -/**/DEBUG_CHECK_RANGE_DOUBLE(DodgsonArray, Argument, -0.5, 0.5, Status, -/**/ "Invalid argument (should be in [0.0, 1.0])") -/**/DEBUG_CHECK_NULL_POINTER(DodgsonArray, d_minus1, Status, -/**/ "No 1st output coefficient") -/**/DEBUG_CHECK_NULL_POINTER(DodgsonArray, d_plus0, Status, -/**/ "No 2nd output coefficient") -/**/DEBUG_CHECK_NULL_POINTER(DodgsonArray, d_plus1, Status, -/**/ "No 3rd output coefficient") -/**/DEBUG_RETURN_ON_ERROR(DodgsonArray, Status) -/**/DEBUG_WRITE_ENTERING(DodgsonArray, -/**/ "About to compute an array of Dodgson") - - *d_plus1 = a2 - (1.0 / 2.0) * Argument; - *d_plus0 = 1.0 - 2.0 * a2; - *d_minus1 = 1.0 - *d_plus1 - *d_plus0; - -/**/DEBUG_WRITE_LEAVING(DodgsonArray, "Done") - return(Status); -} /* end DodgsonArray */ - -/*--------------------------------------------------------------------------*/ -extern double German04 - ( - double Argument /* input */ - ) - -/* returns the value of the quartic German kernel (order 5) evaluated at Argument */ - -{ /* begin German04 */ - -/**/DEBUG_WRITE_ENTERING(German04, -/**/ "About to compute a quartic German kernel") - - Argument = fabs(Argument); - if (Argument < 1.0) { -/**/ DEBUG_WRITE_LEAVING(German04, "Done") - return(Argument * Argument * (Argument * (Argument * (1.0 / 24.0) + 185.0 / 144.0) - - 335.0 / 144.0) + 1.0); - } - else if (Argument < 2.0) { -/**/ DEBUG_WRITE_LEAVING(German04, "Done") - return(Argument * (Argument * (Argument * (-29.0 / 144.0 - Argument * (1.0 / 16.0)) - + 17.0 / 8.0) - 145.0 / 36.0) + 13.0 / 6.0); - } - else if (Argument < 3.0) { -/**/ DEBUG_WRITE_LEAVING(German04, "Done") - return(Argument * (Argument * (Argument * (Argument * (1.0 / 48.0) - 7.0 / 48.0) - + 5.0 / 18.0) + 1.0 / 36.0) - 1.0 / 3.0); - } - else if (Argument < 4.0) { -/**/ DEBUG_WRITE_LEAVING(German04, "Done") - return(Argument * (Argument * (Argument * (1.0 / 144.0) - 11.0 / 144.0) - + 5.0 / 18.0) - 1.0 / 3.0); - } - else { -/**/ DEBUG_WRITE_LEAVING(German04, "Done") - return(0.0); - } -} /* end German04 */ - -/*--------------------------------------------------------------------------*/ -extern double KeysOptimal - ( - double Argument /* input */ - ) - -/* returns the value of the cubic Keys optimal kernel (order 3) evaluated at Argument */ - -{ /* begin KeysOptimal */ - -/**/DEBUG_WRITE_ENTERING(KeysOptimal, -/**/ "About to compute an optimal cubic Keys kernel") - - Argument = fabs(Argument); - if (Argument < 1.0) { -/**/ DEBUG_WRITE_LEAVING(KeysOptimal, "Done") - return(Argument * Argument * (Argument * (3.0 / 2.0) - 5.0 / 2.0) + 1.0); - } - else if (Argument < 2.0) { - Argument -= 2.0; -/**/ DEBUG_WRITE_LEAVING(KeysOptimal, "Done") - return(Argument * Argument * (Argument + 1.0) * (-1.0 / 2.0)); - } - else { -/**/ DEBUG_WRITE_LEAVING(KeysOptimal, "Done") - return(0.0); - } -} /* end KeysOptimal */ - -/*--------------------------------------------------------------------------*/ -extern double Keys - ( - double Argument, /* input */ - double a /* tuning parameter */ - ) - -/* returns the value of the cubic Keys kernel evaluated at Argument */ - -{ /* begin Keys */ - -/**/DEBUG_WRITE_ENTERING(Keys, -/**/ "About to compute a cubic Keys kernel") - - Argument = fabs(Argument); - if (Argument < 1.0) { -/**/ DEBUG_WRITE_LEAVING(Keys, "Done") - return(Argument * Argument * (Argument * (a + 2.0) - (a + 3.0)) + 1.0); - } - else if (Argument < 2.0) { - Argument -= 2.0; -/**/ DEBUG_WRITE_LEAVING(Keys, "Done") - return(a * Argument * Argument * (Argument + 1.0)); - } - else { -/**/ DEBUG_WRITE_LEAVING(Keys, "Done") - return(0.0); - } -} /* end Keys */ - -/*--------------------------------------------------------------------------*/ -extern int KeysOptimalArray - ( - double Argument, /* fractional input */ - double *k_minus2, /* 1st returned coefficient */ - double *k_minus1, /* 2nd returned coefficient */ - double *k_plus0, /* 3rd returned coefficient */ - double *k_plus1 /* 4th returned coefficient */ - ) - -/* returns 4 values for a Keys kernel) */ -/* evaluation is performed at {Argument - 2.0, Argument - 1.0, Argument, Argument + 1.0} */ -/* Argument must be in [0.0, 1.0] */ -/* computational load: */ -/* 7 indirections */ -/* 6(double)assignments, 6 (double)additions, 8 (double)multiplications */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin KeysOptimalArray */ - - double a1 = 1.0 - Argument, a2 = Argument * Argument; - int Status = !ERROR; - -/**/DEBUG_CHECK_RANGE_DOUBLE(KeysOptimalArray, Argument, 0.0, 1.0, Status, -/**/ "Invalid argument (should be in [0.0, 1.0])") -/**/DEBUG_CHECK_NULL_POINTER(KeysOptimalArray, k_minus2, Status, -/**/ "No 1st output coefficient") -/**/DEBUG_CHECK_NULL_POINTER(KeysOptimalArray, k_minus1, Status, -/**/ "No 2nd output coefficient") -/**/DEBUG_CHECK_NULL_POINTER(KeysOptimalArray, k_plus0, Status, -/**/ "No 3rd output coefficient") -/**/DEBUG_CHECK_NULL_POINTER(KeysOptimalArray, k_plus1, Status, -/**/ "No 4th output coefficient") -/**/DEBUG_RETURN_ON_ERROR(KeysOptimalArray, Status) -/**/DEBUG_WRITE_ENTERING(KeysOptimalArray, -/**/ "About to compute an array of Keys") - - *k_minus2 = a1 * a2 * (-1.0 / 2.0); - *k_plus1 = Argument * a1 * a1 * (-1.0 / 2.0); - *k_plus0 = a2 * (Argument * (3.0 / 2.0) - 5.0 / 2.0) + 1.0; - *k_minus1 = 1.0 - *k_minus2 - *k_plus1 - *k_plus0; - -/**/DEBUG_WRITE_LEAVING(KeysOptimalArray, "Done") - return(Status); -} /* end KeysOptimalArray */ - -/*--------------------------------------------------------------------------*/ -extern double Meijering05 - ( - double Argument /* input */ - ) - -/* returns the value of a Meijering function of degree 5 (order ?) evaluated at Argument */ - -{ /* begin Meijering05 */ - - double a; - -/**/DEBUG_WRITE_ENTERING(Meijering05, -/**/ "About to compute a Meijering of degree 5") - - Argument = fabs(Argument); - if (Argument < 1.0) { - a = Argument * Argument; -/**/ DEBUG_WRITE_LEAVING(Meijering05, "Done") - return(a * (a * (63.0 / 32.0 - Argument * (27.0 / 32.0)) - 17.0 / 8.0) + 1.0); - } - else if (Argument < 2.0) { -/**/ DEBUG_WRITE_LEAVING(Meijering05, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument - * (13.0 / 64.0) - 21.0 / 16.0) + 85.0 / 32.0) - 7.0 / 8.0) - 165.0 / 64.0) - + 61.0 / 32.0); - } - else if (Argument < 3.0) { - a = 3.0 - Argument; - a *= a; - a *= a; -/**/ DEBUG_WRITE_LEAVING(Meijering05, "Done") - return(a * (Argument - 2.0) * (3.0 / 64.0)); - } - else { -/**/ DEBUG_WRITE_LEAVING(Meijering05, "Done") - return(0.0); - } -} /* end Meijering05 */ - -/*--------------------------------------------------------------------------*/ -extern double Meijering07 - ( - double Argument /* input */ - ) - -/* returns the value of a Meijering function of degree 7 (order ?) evaluated at Argument */ - -{ /* begin Meijering07 */ - - double a; - -/**/DEBUG_WRITE_ENTERING(Meijering07, -/**/ "About to compute a Meijering of degree 7") - - Argument = fabs(Argument); - if (Argument < 1.0) { - a = Argument * Argument; -/**/ DEBUG_WRITE_LEAVING(Meijering07, "Done") - return(a * (a * (a * (Argument * (22013.0 / 83232.0) - 22039.0 / 27744.0) - + 16775.0 / 10404.0) - 3611.0 / 1734.0) + 1.0); - } - else if (Argument < 2.0) { -/**/ DEBUG_WRITE_LEAVING(Meijering07, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (-477.0 / 9248.0 - Argument * (1127.0 / 83232.0)) + 9583.0 / 6936.0) - - 5815.0 / 867.0) + 33145.0 / 2312.0) - 243.0 / 17.0) + 109739.0 / 20808.0) - + 259.0 / 3468.0); - } - else if (Argument < 3.0) { -/**/ DEBUG_WRITE_LEAVING(Meijering07, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (79.0 / 96.0 - Argument * (403.0 / 9248.0)) - 45703.0 / 6936.0) - + 301115.0 / 10404.0) - 521045.0 / 6936.0) + 99572.0 / 867.0) - - 1983989.0 / 20808.0) + 114355.0 / 3468.0); - } - else if (Argument < 4.0) { -/**/ DEBUG_WRITE_LEAVING(Meijering07, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (213.0 / 9248.0 - Argument * (71.0 / 83232.0)) - 923.0 / 3468.0) - + 8875.0 / 5202.0) - 5680.0 / 867.0) + 13064.0 / 867.0) - 49984.0 / 2601.0) - + 9088.0 / 867.0); - } - else { -/**/ DEBUG_WRITE_LEAVING(Meijering07, "Done") - return(0.0); - } -} /* end Meijering07 */ - -/*--------------------------------------------------------------------------*/ -extern int Omoms - ( - long Degree, /* degree */ - double Argument, /* input */ - double *Result /* output */ - ) - -/* computes a Blu optimum function */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin Omoms */ - - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(Omoms, Result, Status, -/**/ "No output data") -/**/DEBUG_RETURN_ON_ERROR(Omoms, Status) -/**/DEBUG_WRITE_ENTERING(Omoms, -/**/ "About to compute a generic oMoms") - - switch (Degree) { - case 0L: - *Result = Omoms00(Argument); - break; - case 1L: - *Result = Omoms01(Argument); - break; - case 2L: - *Result = Omoms02(Argument); - break; - case 3L: - *Result = Omoms03(Argument); - break; - case 4L: - *Result = Omoms04(Argument); - break; - case 5L: - *Result = Omoms05(Argument); - break; - case 6L: - *Result = Omoms06(Argument); - break; - case 7L: - *Result = Omoms07(Argument); - break; - case 8L: - *Result = Omoms08(Argument); - break; - case 9L: - *Result = Omoms09(Argument); - break; - case 10L: - *Result = Omoms10(Argument); - break; - case 11L: - *Result = Omoms11(Argument); - break; - default: - Status = ERROR; - WRITE_ERROR(Omoms, "Invalid oMoms degree") - break; - } -/**/DEBUG_WRITE_LEAVING(Omoms, "Done") - return(Status); -} /* end Omoms */ - -/*--------------------------------------------------------------------------*/ -extern double Omoms00 - ( - double Argument /* input */ - ) - -/* returns the value of a Blu optimum function of degree 0 (order 1) evaluated at Argument */ - -{ /* begin Omoms00 */ - -/**/DEBUG_WRITE_ENTERING(Omoms00, -/**/ "About to compute an oMoms of degree 0") - - Argument = fabs(Argument); - if (Argument < 0.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms00, "Done") - return(1.0); - } - else if (Argument == 0.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms00, "Done") - return(0.5); - } - else { -/**/ DEBUG_WRITE_LEAVING(Omoms00, "Done") - return(0.0); - } -} /* end Omoms00 */ - -/*--------------------------------------------------------------------------*/ -extern double Omoms01 - ( - double Argument /* input */ - ) - -/* returns the value of a Blu optimum function of degree 1 (order 2) evaluated at Argument */ - -{ /* begin Omoms01 */ - -/**/DEBUG_WRITE_ENTERING(Omoms01, -/**/ "About to compute an oMoms of degree 1") - - Argument = fabs(Argument); - if (Argument < 1.0) { -/**/ DEBUG_WRITE_LEAVING(Omoms01, "Done") - return(1.0 - Argument); - } - else { -/**/ DEBUG_WRITE_LEAVING(Omoms01, "Done") - return(0.0); - } -} /* end Omoms01 */ - -/*--------------------------------------------------------------------------*/ -extern double Omoms02 - ( - double Argument /* input */ - ) - -/* returns the value of a Blu optimum function of degree 2 (order 3) evaluated at Argument */ - -{ /* begin Omoms02 */ - -/**/DEBUG_WRITE_ENTERING(Omoms02, -/**/ "About to compute an oMoms of degree 2") - - Argument = fabs(Argument); - if (Argument < 0.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms02, "Done") - return(43.0 / 60.0 - Argument * Argument); - } - else if (Argument == 0.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms02, "Done") - return(59.0 / 120.0); - } - else if (Argument < 1.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms02, "Done") - return(Argument * (Argument * (1.0 / 2.0) - 3.0 / 2.0) + 137.0 / 120.0); - } - else if (Argument == 1.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms02, "Done") - return(1.0 / 120.0); - } - else { -/**/ DEBUG_WRITE_LEAVING(Omoms02, "Done") - return(0.0); - } -} /* end Omoms02 */ - -/*--------------------------------------------------------------------------*/ -extern double Omoms03 - ( - double Argument /* input */ - ) - -/* returns the value of a Blu optimum function of degree 3 (order 4) evaluated at Argument */ - -{ /* begin Omoms03 */ - -/**/DEBUG_WRITE_ENTERING(Omoms03, -/**/ "About to compute an oMoms of degree 3") - - Argument = fabs(Argument); - if (Argument < 1.0) { -/**/ DEBUG_WRITE_LEAVING(Omoms03, "Done") - return(Argument * (Argument * (Argument * (1.0 / 2.0) - 1.0) + 1.0 / 14.0) - + 13.0 / 21.0); - } - else if (Argument < 2.0) { -/**/ DEBUG_WRITE_LEAVING(Omoms03, "Done") - return(Argument * (Argument * (1.0 - Argument * (1.0 / 6.0)) - 85.0 / 42.0) - + 29.0 / 21.0); - } - else { -/**/ DEBUG_WRITE_LEAVING(Omoms03, "Done") - return(0.0); - } -} /* end Omoms03 */ - -/*--------------------------------------------------------------------------*/ -extern double Omoms04 - ( - double Argument /* input */ - ) - -/* returns the value of a Blu optimum function of degree 4 (order 5) evaluated at Argument */ - -{ /* begin Omoms04 */ - -/**/DEBUG_WRITE_ENTERING(Omoms04, -/**/ "About to compute an oMoms of degree 4") - - Argument = fabs(Argument); - if (Argument < 0.5) { - Argument *= Argument; -/**/ DEBUG_WRITE_LEAVING(Omoms04, "Done") - return(Argument * (Argument * (1.0 / 4.0) - 13.0 / 24.0) + 11383.0 / 20160.0); - } - else if (Argument == 0.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms04, "Done") - return(6721.0 / 15120.0); - } - else if (Argument < 1.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms04, "Done") - return(Argument * (Argument * (Argument * (5.0 / 6.0 - Argument * (1.0 / 6.0)) - - 47.0 / 36.0) + 25.0 / 72.0) + 15217.0 / 30240.0); - } - else if (Argument == 1.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms04, "Done") - return(559.0 / 10080.0); - } - else if (Argument < 2.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms04, "Done") - return(Argument * (Argument * (Argument * (Argument * (1.0 / 24.0) - 5.0 / 12.0) - + 227.0 / 144.0) - 385.0 / 144.0) + 207383.0 / 120960.0); - } - else if (Argument == 2.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms04, "Done") - return(1.0 / 30240.0); - } - else { -/**/ DEBUG_WRITE_LEAVING(Omoms04, "Done") - return(0.0); - } -} /* end Omoms04 */ - -/*--------------------------------------------------------------------------*/ -extern double Omoms05 - ( - double Argument /* input */ - ) - -/* returns the value of a Blu optimum function of degree 5 (order 6) evaluated at Argument */ - -{ /* begin Omoms05 */ - -/**/DEBUG_WRITE_ENTERING(Omoms05, -/**/ "About to compute an oMoms of degree 5") - - Argument = fabs(Argument); - if (Argument < 1.0) { -/**/ DEBUG_WRITE_LEAVING(Omoms05, "Done") - return(Argument * (Argument * (Argument * (Argument * (1.0 / 4.0 - - Argument * (1.0 / 12.0)) - 5.0 / 99.0) - 9.0 / 22.0) - 1.0 / 792.0) - + 229.0 / 440.0); - } - else if (Argument < 2.0) { -/**/ DEBUG_WRITE_LEAVING(Omoms05, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (1.0 / 24.0) - - 3.0 / 8.0) + 505.0 / 396.0) - 83.0 / 44.0) + 1351.0 / 1584.0) + 839.0 / 2640.0); - } - else if (Argument < 3.0) { -/**/ DEBUG_WRITE_LEAVING(Omoms05, "Done") - return(Argument * (Argument * (Argument * (Argument * (1.0 / 8.0 - - Argument * (1.0 / 120.0)) - 299.0 / 396.0) + 101.0 / 44.0) - 27811.0 / 7920.0) - + 5707.0 / 2640.0); - } - else { -/**/ DEBUG_WRITE_LEAVING(Omoms05, "Done") - return(0.0); - } -} /* end Omoms05 */ - -/*--------------------------------------------------------------------------*/ -extern double Omoms06 - ( - double Argument /* input */ - ) - -/* returns the value of a Blu optimum function of degree 6 (order 7) evaluated at Argument */ - -{ /* begin Omoms06 */ - -/**/DEBUG_WRITE_ENTERING(Omoms06, -/**/ "About to compute an oMoms of degree 6") - - Argument = fabs(Argument); - if (Argument < 0.5) { - Argument *= Argument; -/**/ DEBUG_WRITE_LEAVING(Omoms06, "Done") - return(Argument * (Argument * (223.0 / 1872.0 - Argument * (1.0 / 36.0)) - - 3173.0 / 9152.0) + 16810399.0 / 34594560.0); - } - else if (Argument == 0.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms06, "Done") - return(540559.0 / 1330560.0); - } - else if (Argument < 1.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms06, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (1.0 / 48.0) - 7.0 / 48.0) + 869.0 / 2496.0) - 805.0 / 3744.0) - - 8345.0 / 36608.0) - 11711.0 / 329472.0) + 22619117.0 / 46126080.0); - } - else if (Argument == 1.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms06, "Done") - return(174749.0 / 1921920.0); - } - else if (Argument < 2.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms06, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (7.0 / 60.0 - - Argument * (1.0 / 120.0)) - 829.0 / 1248.0) + 1799.0 / 936.0) - - 258383.0 / 91520.0) + 690851.0 / 411840.0) + 21359.0 / 1774080.0); - } - else if (Argument == 2.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms06, "Done") - return(4421.0 / 1572480.0); - } - else if (Argument < 3.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms06, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (1.0 / 720.0) - 7.0 / 240.0) + 1921.0 / 7488.0) - 4529.0 / 3744.0) - + 590221.0 / 183040.0) - 7588511.0 / 1647360.0) + 34652699.0 / 12579840.0); - } - else if (Argument == 3.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms06, "Done") - return(1.0 / 17297280.0); - } - else { -/**/ DEBUG_WRITE_LEAVING(Omoms06, "Done") - return(0.0); - } -} /* end Omoms06 */ - -/*--------------------------------------------------------------------------*/ -extern double Omoms07 - ( - double Argument /* input */ - ) - -/* returns the value of a Blu optimum function of degree 7 (order 8) evaluated at Argument */ - -{ /* begin Omoms07 */ - -/**/DEBUG_WRITE_ENTERING(Omoms07, -/**/ "About to compute an oMoms of degree 7") - - Argument = fabs(Argument); - if (Argument < 1.0) { -/**/ DEBUG_WRITE_LEAVING(Omoms07, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (1.0 / 144.0) - 1.0 / 36.0) + 7.0 / 720.0) + 1.0 / 12.0) - + 7.0 / 5616.0) - 227.0 / 780.0) + 1.0 / 102960.0) + 247409.0 / 540540.0); - } - else if (Argument < 2.0) { -/**/ DEBUG_WRITE_LEAVING(Omoms07, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (1.0 / 20.0 - Argument * (1.0 / 240.0)) - 287.0 / 1200.0) + 11.0 / 20.0) - - 567.0 / 1040.0) + 27.0 / 260.0) - 27721.0 / 171600.0) + 48687.0 / 100100.0); - } - else if (Argument < 3.0) { -/**/ DEBUG_WRITE_LEAVING(Omoms07, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (1.0 / 720.0) - 1.0 / 36.0) + 847.0 / 3600.0) - 13.0 / 12.0) - + 16163.0 / 5616.0) - 1107.0 / 260.0) + 117277.0 / 39600.0) - - 260329.0 / 540540.0); - } - else if (Argument < 4.0) { -/**/ DEBUG_WRITE_LEAVING(Omoms07, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (1.0 / 180.0 - Argument * (1.0 / 5040.0)) - 241.0 / 3600.0) + 9.0 / 20.0) - - 51169.0 / 28080.0) + 3467.0 / 780.0) - 21787921.0 / 3603600.0) - + 9560851.0 / 2702700.0); - } - else { -/**/ DEBUG_WRITE_LEAVING(Omoms07, "Done") - return(0.0); - } -} /* end Omoms07 */ - -/*--------------------------------------------------------------------------*/ -extern double Omoms08 - ( - double Argument /* input */ - ) - -/* returns the value of a Blu optimum function of degree 8 (order 9) evaluated at Argument */ - -{ /* begin Omoms08 */ - -/**/DEBUG_WRITE_ENTERING(Omoms08, -/**/ "About to compute an oMoms of degree 8") - - Argument = fabs(Argument); - if (Argument < 0.5) { - Argument *= Argument; -/**/ DEBUG_WRITE_LEAVING(Omoms08, "Done") - return(Argument * (Argument * (Argument * (Argument * (1.0 / 576.0) - - 361.0 / 29376.0) + 5375.0 / 78336.0) - 507163.0 / 2036736.0) - + 49010505197.0 / 112916643840.0); - } - else if (Argument == 0.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms08, "Done") - return(255075379.0 / 678585600.0); - } - else if (Argument < 1.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms08, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (1.0 / 80.0 - Argument * (1.0 / 720.0)) - 295.0 / 7344.0) - + 217.0 / 5440.0) + 3049.0 / 97920.0) + 301.0 / 13056.0) - - 656753.0 / 2545920.0) + 451.0 / 226304.0) + 3602106707.0 / 8302694400.0); - } - else if (Argument == 1.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms08, "Done") - return(508155113.0 / 4410806400.0); - } - else if (Argument < 2.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms08, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (1.0 / 1440.0) - 1.0 / 80.0) + 6983.0 / 73440.0) - - 2121.0 / 5440.0) + 177311.0 / 195840.0) - 14861.0 / 13056.0) - + 3676757.0 / 5091840.0) - 539519.0 / 1131520.0) - + 151654522541.0 / 282291609600.0); - } - else if (Argument == 2.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms08, "Done") - return(7778497.0 / 882161280.0); - } - else if (Argument < 3.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms08, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (3.0 / 560.0 - Argument * (1.0 / 5040.0)) - 2309.0 / 36720.0) - + 2269.0 / 5440.0) - 166193.0 / 97920.0) + 55937.0 / 13056.0) - - 114066257.0 / 17821440.0) + 38899437.0 / 7920640.0) - - 177624353243.0 / 141145804800.0); - } - else if (Argument == 3.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms08, "Done") - return(1462553.0 / 17643225600.0); - } - else if (Argument < 4.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms08, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (1.0 / 40320.0) - 1.0 / 1120.0) + 829.0 / 58752.0) - - 1391.0 / 10880.0) + 569033.0 / 783360.0) - 23065.0 / 8704.0) - + 864109733.0 / 142571520.0) - 25173235.0 / 3168256.0) - + 5160686670443.0 / 1129166438400.0); - } - else if (Argument == 4.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms08, "Done") - return(1.0 / 17643225600.0); - } - else { -/**/ DEBUG_WRITE_LEAVING(Omoms08, "Done") - return(0.0); - } -} /* end Omoms08 */ - -/*--------------------------------------------------------------------------*/ -extern double Omoms09 - ( - double Argument /* input */ - ) - -/* returns the value of a Blu optimum function of degree 9 (order 10) evaluated at Argument */ - -{ /* begin Omoms09 */ - -/**/DEBUG_WRITE_ENTERING(Omoms09, -/**/ "About to compute an oMoms of degree 9") - - Argument = fabs(Argument); - if (Argument < 1.0) { -/**/ DEBUG_WRITE_LEAVING(Omoms09, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (1.0 / 576.0 - Argument * (1.0 / 2880.0)) - - 1.0 / 1140.0) - 67.0 / 8208.0) - 147.0 / 516800.0) + 30463.0 / 558144.0) - - 1.0 / 77520.0) - 20129.0 / 93024.0) - 1.0 / 24186240.0) - + 630498007.0 / 1523733120.0); - } - else if (Argument < 2.0) { -/**/ DEBUG_WRITE_LEAVING(Omoms09, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (Argument * (1.0 / 4320.0) - 1.0 / 288.0) - + 293.0 / 13680.0) - 275.0 / 4104.0) + 3353.0 / 32300.0) - 20059.0 / 279072.0) - + 48619.0 / 465120.0) - 12685.0 / 46512.0) + 648571.0 / 36279360.0) - + 313316657.0 / 761866560.0); - } - else if (Argument < 3.0) { -/**/ DEBUG_WRITE_LEAVING(Omoms09, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (5.0 / 2016.0 - Argument * (1.0 / 10080.0)) - - 863.0 / 31920.0) + 685.0 / 4104.0) - 81823.0 / 129200.0) + 418073.0 / 279072.0) - - 778483.0 / 361760.0) + 597197.0 / 325584.0) - 96512911.0 / 84651840.0) - + 75779819.0 / 108838080.0); - } - else if (Argument < 4.0) { -/**/ DEBUG_WRITE_LEAVING(Omoms09, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (Argument * (1.0 / 40320.0) - 1.0 / 1152.0) - + 859.0 / 63840.0) - 1985.0 / 16416.0) + 714871.0 / 1033600.0) - - 2898295.0 / 1116288.0) + 13759447.0 / 2170560.0) - 1777747.0 / 186048.0) - + 2648715421.0 / 338607360.0) - 7480147879.0 / 3047466240.0); - } - else if (Argument < 5.0) { -/**/ DEBUG_WRITE_LEAVING(Omoms09, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (1.0 / 8064.0 - Argument * (1.0 / 362880.0)) - - 1429.0 / 574560.0) + 479.0 / 16416.0) - 684257.0 / 3100800.0) - + 1245313.0 / 1116288.0) - 73642277.0 / 19535040.0) + 10692427.0 / 1302336.0) - - 31866240901.0 / 3047466240.0) + 3616276301.0 / 609493248.0); - } - else { -/**/ DEBUG_WRITE_LEAVING(Omoms09, "Done") - return(0.0); - } -} /* end Omoms09 */ - -/*--------------------------------------------------------------------------*/ -extern double Omoms10 - ( - double Argument /* input */ - ) - -/* returns the value of a Blu optimum function of degree 10 (order 11) evaluated at Argument */ - -{ /* begin Omoms10 */ - -/**/DEBUG_WRITE_ENTERING(Omoms10, -/**/ "About to compute an oMoms of degree 10") - - Argument = fabs(Argument); - if (Argument < 0.5) { - Argument *= Argument; -/**/ DEBUG_WRITE_LEAVING(Omoms10, "Done") - return(Argument * (Argument * (Argument * (Argument * (59.0 / 80640.0 - - Argument * (1.0 / 14400.0)) - 43517.0 / 6566400.0) + 9214241.0 / 208373760.0) - - 27203797.0 / 142884864.0) + 16999223061911.0 / 42908324659200.0); - } - else if (Argument == 0.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms10, "Done") - return(13852170803.0 / 39437798400.0); - } - else if (Argument < 1.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms10, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (Argument * (Argument * (1.0 / 17280.0) - - 11.0 / 17280.0) + 83.0 / 32256.0) - 143.0 / 40320.0) - 1667.0 / 875520.0) - - 19393.0 / 4377600.0) + 3929617.0 / 83349504.0) - 119141.0 / 89303040.0) - - 14076065.0 / 74088448.0) - 3539371.0 / 50009702400.0) - + 2266595190421.0 / 5721109954560.0); - } - else if (Argument == 1.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms10, "Done") - return(617888623367.0 / 4693098009600.0); - } - else if (Argument < 2.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms10, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (Argument * (11.0 / 15120.0 - - Argument * (1.0 / 30240.0)) - 391.0 / 56448.0) + 649.0 / 17640.0) - - 538399.0 / 4596480.0) + 865843.0 / 3830400.0) - 1934417.0 / 6945792.0) - + 222233.0 / 697680.0) - 1394728309.0 / 3500679168.0) - + 3548488471.0 / 43758489600.0) + 11469642367213.0 / 30035827261440.0); - } - else if (Argument == 2.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms10, "Done") - return(40687175.0 / 2453907456.0); - } - else if (Argument < 3.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms10, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (Argument * (Argument * (1.0 / 80640.0) - - 11.0 / 26880.0) + 2713.0 / 451584.0) - 3223.0 / 62720.0) - + 1478771.0 / 5253120.0) - 6958193.0 / 6809600.0) + 21571063.0 / 8773632.0) - - 532328621.0 / 138915840.0) + 105364263311.0 / 28005433344.0) - - 62407010457.0 / 25930956800.0) + 50704007329529.0 / 48057323618304.0); - } - else if (Argument == 3.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms10, "Done") - return(297590927.0 / 574665062400.0); - } - else if (Argument < 4.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms10, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (Argument * (11.0 / 90720.0 - - Argument * (1.0 / 362880.0)) - 541.0 / 225792.0) + 2959.0 / 105840.0) - - 1677257.0 / 7879680.0) + 25318843.0 / 22982400.0) - 977236835.0 / 250048512.0) - + 1092629879.0 / 117210240.0) - 594602457269.0 / 42008150016.0) - + 3181407449671.0 / 262550937600.0) - 1536983047451107.0 / 360429927137280.0); - } - else if (Argument == 4.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms10, "Done") - return(15015569.0 / 9386196019200.0); - } - else if (Argument < 5.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms10, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (Argument * (Argument * (1.0 / 3628800.0) - - 11.0 / 725760.0) + 283.0 / 752640.0) - 9383.0 / 1693440.0) - + 29622839.0 / 551577600.0) - 65779153.0 / 183859200.0) - + 4147831559.0 / 2500485120.0) - 2832070043.0 / 535818240.0) - + 930545778049.0 / 84016300032.0) - 28948369472011.0 / 2100407500800.0) - + 1639552734983279.0 / 212017604198400.0); - } - else if (Argument == 5.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms10, "Done") - return(1.0 / 28158588057600.0); - } - else { -/**/ DEBUG_WRITE_LEAVING(Omoms10, "Done") - return(0.0); - } -} /* end Omoms10 */ - -/*--------------------------------------------------------------------------*/ -extern double Omoms11 - ( - double Argument /* input */ - ) - -/* returns the value of a Blu optimum function of degree 11 (order 12) evaluated at Argument */ - -{ /* begin Omoms11 */ - -/**/DEBUG_WRITE_ENTERING(Omoms11, -/**/ "About to compute an oMoms of degree 11") - - Argument = fabs(Argument); - if (Argument < 1.0) { -/**/ DEBUG_WRITE_LEAVING(Omoms11, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (Argument * (Argument * (Argument * (1.0 / 86400.0) - - 1.0 / 14400.0) + 11.0 / 238464.0) + 31.0 / 66240.0) + 11.0 / 386400.0) - - 79.0 / 15525.0) + 11.0 / 3146400.0) + 11473.0 / 314640.0) + 11.0 / 154047744.0) - - 760452073.0 / 4493059200.0) + 1.0 / 8986118400.0) - + 56442621569.0 / 148270953600.0); - } - else if (Argument < 2.0) { -/**/ DEBUG_WRITE_LEAVING(Omoms11, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (Argument * (Argument * (1.0 / 6720.0 - - Argument * (1.0 / 120960.0)) - 9383.0 / 8346240.0) + 59.0 / 13248.0) - - 5093.0 / 540960.0) + 3847.0 / 347760.0) - 443971.0 / 22024800.0) - + 3443.0 / 62928.0) - 62998331.0 / 5391671040.0) - 147576503.0 / 898611840.0) - - 81893201.0 / 62902828800.0) + 79051603531.0 / 207579335040.0); - } - else if (Argument < 3.0) { -/**/ DEBUG_WRITE_LEAVING(Omoms11, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (Argument * (Argument * (Argument * (1.0 / 241920.0) - - 1.0 / 8064.0) + 27599.0 / 16692480.0) - 2375.0 / 185472.0) - + 68387.0 / 1081920.0) - 28643.0 / 139104.0) + 19765603.0 / 44049600.0) - - 596387.0 / 880992.0) + 8573363843.0 / 10783342080.0) - - 273887483.0 / 359444736.0) + 33491661593.0 / 125805657600.0) - + 135383117087.0 / 415158670080.0); - } - else if (Argument < 4.0) { -/**/ DEBUG_WRITE_LEAVING(Omoms11, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (Argument * (Argument * (1.0 / 17280.0 - - Argument * (1.0 / 725760.0)) - 54923.0 / 50077440.0) + 109.0 / 8832.0) - - 296153.0 / 3245760.0) + 22999.0 / 49680.0) - 215968951.0 / 132148800.0) - + 501677.0 / 125856.0) - 212059333211.0 / 32350026240.0) - + 4195676377.0 / 599074560.0) - 1766543369981.0 / 377416972800.0) - + 104670284681.0 / 59308381440.0); - } - else if (Argument < 5.0) { -/**/ DEBUG_WRITE_LEAVING(Omoms11, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (Argument * (Argument * (Argument * (1.0 / 3628800.0) - - 1.0 / 67200.0) + 18271.0 / 50077440.0) - 4967.0 / 927360.0) - + 847781.0 / 16228800.0) - 616961.0 / 1738800.0) + 225780203.0 / 132148800.0) - - 25605701.0 / 4404960.0) + 440867545327.0 / 32350026240.0) - - 187002461077.0 / 8986118400.0) + 6942498798313.0 / 377416972800.0) - - 14457478232713.0 / 2075793350400.0); - } - else if (Argument < 6.0) { -/**/ DEBUG_WRITE_LEAVING(Omoms11, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (Argument * (Argument * (1.0 / 604800.0 - - Argument * (1.0 / 39916800.0)) - 2489.0 / 50077440.0) + 119.0 / 132480.0) - - 175981.0 / 16228800.0) + 35477.0 / 386400.0) - 73521109.0 / 132148800.0) - + 1518187.0 / 629280.0) - 237350824133.0 / 32350026240.0) - + 133911171673.0 / 8986118400.0) - 75527106646069.0 / 4151586700800.0) - + 6997050016189.0 / 691931116800.0); - } - else { -/**/ DEBUG_WRITE_LEAVING(Omoms11, "Done") - return(0.0); - } -} /* end Omoms11 */ - -/*--------------------------------------------------------------------------*/ -extern int OmomsArray03 - ( - double Argument, /* fractional input */ - double *b3_minus2, /* 1st returned coefficient */ - double *b3_minus1, /* 2nd returned coefficient */ - double *b3_plus0, /* 3rd returned coefficient */ - double *b3_plus1 /* 4th returned coefficient */ - ) - -/* returns 4 values for an oMoms function of degree 3 (order 4) */ -/* evaluation is performed at {Argument - 2.0, Argument - 1.0, Argument, Argument + 1.0} */ -/* Argument must be in [0.0, 1.0] */ -/* computational load: */ -/* 7 indirections */ -/* 6(double)assignments, 11 (double)additions, 9 (double)multiplications */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin OmomsArray03 */ - - double a1 = 1.0 - Argument, a2 = Argument * Argument; - int Status = !ERROR; - -/**/DEBUG_CHECK_RANGE_DOUBLE(OmomsArray03, Argument, 0.0, 1.0, Status, -/**/ "Invalid argument (should be in [0.0, 1.0])") -/**/DEBUG_CHECK_NULL_POINTER(OmomsArray03, b3_minus2, Status, -/**/ "No 1st output coefficient") -/**/DEBUG_CHECK_NULL_POINTER(OmomsArray03, b3_minus1, Status, -/**/ "No 2nd output coefficient") -/**/DEBUG_CHECK_NULL_POINTER(OmomsArray03, b3_plus0, Status, -/**/ "No 3rd output coefficient") -/**/DEBUG_CHECK_NULL_POINTER(OmomsArray03, b3_plus1, Status, -/**/ "No 4th output coefficient") -/**/DEBUG_RETURN_ON_ERROR(OmomsArray03, Status) -/**/DEBUG_WRITE_ENTERING(OmomsArray03, -/**/ "About to compute an array of B-splines of degree 3") - - *b3_minus2 = Argument * (a2 * (1.0 / 6.0) + 1.0 / 42.0); - *b3_minus1 = a1 * (a1 * (a1 * (1.0 / 2.0) - 1.0) + 1.0 / 14.0) + 13.0 / 21.0; - *b3_plus0 = Argument * (Argument * (Argument * (1.0 / 2.0) - 1.0) + 1.0 / 14.0) + 13.0 / 21.0; - *b3_plus1 = 1.0 - *b3_minus2 - *b3_minus1 - *b3_plus0; - -/**/DEBUG_WRITE_LEAVING(OmomsArray03, "Done") - return(Status); -} /* end OmomsArray03 */ - -/*--------------------------------------------------------------------------*/ -extern double Positive - ( - double Argument /* input */ - ) - -/* returns the value of the Positive kernel of degree 3 evaluated at Argument */ - -{ /* begin Positive */ - - double a; - -/**/DEBUG_WRITE_ENTERING(Positive, -/**/ "About to compute a Positive kernel") - - Argument = fabs(Argument); - if (Argument < 0.5) { - a = Argument * Argument; -/**/ DEBUG_WRITE_LEAVING(Positive, "Done") - return(a * (Argument * 4.0 - 9.0 / 2.0) + 1.0); - } - if (Argument < 1.0) { - Argument -= 1.0; -/**/ DEBUG_WRITE_LEAVING(Positive, "Done") - return(Argument * Argument * (3.0 / 2.0)); - } - else if (Argument < 1.5) { - Argument -= 1.0; -/**/ DEBUG_WRITE_LEAVING(Positive, "Done") - return(Argument * Argument * (3.0 / 2.0 - Argument * 2.0)); - } - else if (Argument < 2.0) { - Argument -= 2.0; -/**/ DEBUG_WRITE_LEAVING(Positive, "Done") - return(Argument * Argument * (Argument * 2.0 + 3.0 / 2.0)); - } - else { -/**/ DEBUG_WRITE_LEAVING(Positive, "Done") - return(0.0); - } -} /* end Positive */ - -/*--------------------------------------------------------------------------*/ -extern int Schaum - ( - long Degree, /* degree */ - double Argument, /* input */ - double *Result /* output */ - ) - -/* computes a Schaum interpolating function */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin Schaum */ - - double i, j, k, l; - double a; - int Status = !ERROR; - -/**/DEBUG_CHECK_RANGE_LONG(Schaum, Degree, 0L, LONG_MAX, Status, -/**/ "Invalid degree (should be positive)") -/**/DEBUG_CHECK_NULL_POINTER(Schaum, Result, Status, -/**/ "No output data") -/**/DEBUG_RETURN_ON_ERROR(Schaum, Status) -/**/DEBUG_WRITE_ENTERING(Schaum, -/**/ "About to compute a generic Schaum") - - switch (Degree) { - case 2L: - *Result = Schaum02(Argument); - break; - case 3L: - *Result = Schaum03(Argument); - break; - case 4L: - *Result = Schaum04(Argument); - break; - default: - Argument = fabs(Argument); - i = -(double)((Degree + 1L) / 2L); - if ((Degree & 1L) != 0L) { - *Result = -1.0; - k = floor(Argument); - j = i + k + 1.0; - } - else { - *Result = 1.0; - k = floor(Argument + 0.5); - j = i + k; - } - i -= k; - l = (double)(Degree / 2L) - k; - if (k <= (double)(Degree / 2L)) { - while (i <= l) { - if (i != 0.0) { - *Result *= Argument + i; - } - if (j != 0.0) { - *Result /= j; - } - i += 1.0; - j += 1.0; - } - k -= 1.0; - if (((Degree & 1L) == 0L) && ((Argument - 0.5) == k)) { - i = -(double)((Degree + 1L) / 2L); - a = 1.0; - j = i + k; - i -= k; - l = (double)(Degree / 2L) - k; - while (i <= l) { - if (i != 0.0) { - a *= Argument + i; - } - if (j != 0.0) { - a /= j; - } - i += 1.0; - j += 1.0; - } - *Result = 0.5 * (*Result + a); - } - } - else { - k -= 1.0; - if (((Degree & 1L) == 0L) && ((Argument - 0.5) == k) - && (k <= (double)(Degree / 2L))) { - i = -(double)((Degree + 1L) / 2L); - *Result = 0.5; - j = i + k; - i -= k; - l = (double)(Degree / 2L) - k; - while (i <= l) { - if (i != 0.0) { - *Result *= Argument + i; - } - if (j != 0.0) { - *Result /= j; - } - i += 1.0; - j += 1.0; - } - } - else { - *Result *= 0.0; - } - } - break; - } -/**/DEBUG_WRITE_LEAVING(Schaum, "Done") - return(Status); -} /* end Schaum */ - -/*--------------------------------------------------------------------------*/ -extern double Schaum02 - ( - double Argument /* input */ - ) - -/* returns the value of the Schaum kernel of degree 2 evaluated at Argument */ - -{ /* begin Schaum02 */ - -/**/DEBUG_WRITE_ENTERING(Schaum02, -/**/ "About to compute a Schaum of degree 2") - - Argument = fabs(Argument); - if (Argument < 0.5) { -/**/ DEBUG_WRITE_LEAVING(Schaum02, "Done") - return(1.0 - Argument * Argument); - } - else if (Argument == 0.5) { -/**/ DEBUG_WRITE_LEAVING(Schaum02, "Done") - return(9.0 / 16.0); - } - else if (Argument < 1.5) { -/**/ DEBUG_WRITE_LEAVING(Schaum02, "Done") - return(Argument * (Argument * (1.0 / 2.0) - 3.0 / 2.0) + 1.0); - } - else if (Argument == 1.5) { -/**/ DEBUG_WRITE_LEAVING(Schaum02, "Done") - return(-1.0 / 16.0); - } - else { -/**/ DEBUG_WRITE_LEAVING(Schaum02, "Done") - return(0.0); - } -} /* end Schaum02 */ - -/*--------------------------------------------------------------------------*/ -extern double Schaum03 - ( - double Argument /* input */ - ) - -/* returns the value of the Schaum kernel of degree 3 evaluated at Argument */ - -{ /* begin Schaum03 */ - -/**/DEBUG_WRITE_ENTERING(Schaum03, -/**/ "About to compute a Schaum of degree 3") - - Argument = fabs(Argument); - if (Argument < 1.0) { -/**/ DEBUG_WRITE_LEAVING(Schaum03, "Done") - return(Argument * (Argument * (Argument * (1.0 / 2.0) - 1.0) - 1.0 / 2.0) + 1.0); - } - else if (Argument < 2.0) { -/**/ DEBUG_WRITE_LEAVING(Schaum03, "Done") - return(Argument * (Argument * (1.0 - Argument * (1.0 / 6.0)) - 11.0 / 6.0) + 1.0); - } - else { -/**/ DEBUG_WRITE_LEAVING(Schaum03, "Done") - return(0.0); - } -} /* end Schaum03 */ - -/*--------------------------------------------------------------------------*/ -extern double Schaum04 - ( - double Argument /* input */ - ) - -/* returns the value of the Schaum kernel of degree 4 evaluated at Argument */ - -{ /* begin Schaum04 */ - -/**/DEBUG_WRITE_ENTERING(Schaum04, -/**/ "About to compute a Schaum of degree 4") - - Argument = fabs(Argument); - if (Argument < 0.5) { - Argument *= Argument; -/**/ DEBUG_WRITE_LEAVING(Schaum04, "Done") - return(Argument * (Argument * (1.0 / 4.0) - 5.0 / 4.0) + 1.0); - } - else if (Argument == 0.5) { -/**/ DEBUG_WRITE_LEAVING(Schaum04, "Done") - return(75.0 / 128.0); - } - else if (Argument < 1.5) { -/**/ DEBUG_WRITE_LEAVING(Schaum04, "Done") - return(Argument * (Argument * (Argument * (5.0 / 6.0 - Argument - * (1.0 / 6.0)) - 5.0 / 6.0) - 5.0 / 6.0) + 1.0); - } - else if (Argument == 1.5) { -/**/ DEBUG_WRITE_LEAVING(Schaum04, "Done") - return(-25.0 / 256.0); - } - else if (Argument < 2.5) { -/**/ DEBUG_WRITE_LEAVING(Schaum04, "Done") - return(Argument * (Argument * (Argument * (Argument * (1.0 / 24.0) - -5.0 / 12.0) + 35.0 / 24.0) - 25.0 / 12.0) + 1.0); - } - else if (Argument == 2.5) { -/**/ DEBUG_WRITE_LEAVING(Schaum04, "Done") - return(3.0 / 256.0); - } - else { -/**/ DEBUG_WRITE_LEAVING(Schaum04, "Done") - return(0.0); - } -} /* end Schaum04 */ - -/*--------------------------------------------------------------------------*/ -extern double Sinc - ( - double Argument /* input */ - ) - -/* returns the value of the sinc kernel evaluated at Argument */ - -{ /* begin Sinc */ - -/**/DEBUG_WRITE_ENTERING(Sinc, -/**/ "About to compute a sinc kernel") - - if (Argument == 0.0) { -/**/ DEBUG_WRITE_LEAVING(Sinc, "Done") - return(1.0); - } - else { - Argument *= PI; -/**/ DEBUG_WRITE_LEAVING(Sinc, "Done") - return(sin(Argument) / Argument); - } -} /* end Sinc */ - diff --git a/src/core/bilib/kernel.h b/src/core/bilib/kernel.h deleted file mode 100644 index 435695b..0000000 --- a/src/core/bilib/kernel.h +++ /dev/null @@ -1,442 +0,0 @@ -#ifndef _BILIBKERNEL -#define _BILIBKERNEL -/**@defgroup KernelDefinition Kernel definition - @ingroup BilibLibrary */ -//@{ -/*--------------------------------------------------------------------------*/ -/** Computes a Blu interpolant function. - success: return(!ERROR); failure: return(ERROR); */ -extern int Blip - ( - long Degree, /* degree */ - double Argument, /* input */ - double *Result /* output */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Blu interpolant function of degree 0 (order 1) - evaluated at Argument. */ -extern double Blip00 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Blu interpolant function of degree 1 (order 2) - evaluated at Argument */ -extern double Blip01 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/* Returns the value of a Blu interpolant function of degree 3 (order 4) - evaluated at Argument */ -extern double Blip03 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Computes a Basic spline function. - success: return(!ERROR); failure: return(ERROR); */ -extern int Bspline - ( - long Degree, /* degree */ - double Argument, /* input */ - double *Result /* output */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Blu interpolant function of degree 0 (order 1) - evaluated at Argument */ -extern double Bspline00 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Basic spline function of degree 1 (order 2) - evaluated at Argument */ -extern double Bspline01 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Basic spline function of degree 2 (order 3) - evaluated at Argument */ -extern double Bspline02 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Basic spline function of degree 3 (order 4) - evaluated at Argument */ -extern double Bspline03 - ( - double Argument /* input */ - ); - -/** Bspline03 as a macro */ -#define BSPLINE03(y,x) \ -{\ - double Argument = fabs(x);\ - if (Argument < 1.0)\ - y=Argument * Argument * (Argument - 2.0) * 0.5 + 2.0 / 3.0;\ - else if (Argument < 2.0)\ - {\ - Argument -= 2.0; \ - y=Argument * Argument * Argument * (-1.0 / 6.0);\ - } \ - else\ - y=0.0;\ -} - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Basic spline function of degree 4 (order 5) - evaluated at Argument */ -extern double Bspline04 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Basic spline function of degree 5 (order 6) - evaluated at Argument */ -extern double Bspline05 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Basic spline function of degree 6 (order 7) - evaluated at Argument */ -extern double Bspline06 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Basic spline function of degree 7 (order 8) - evaluated at Argument */ -extern double Bspline07 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Basic spline function of degree 8 (order 9) - evaluated at Argument */ -extern double Bspline08 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Basic spline function of degree 9 (order 10) - evaluated at Argument */ -extern double Bspline09 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Basic spline function of degree 10 (order 11) - evaluated at Argument */ -extern double Bspline10 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Basic spline function of degree 11 (order 12) - evaluated at Argument */ -extern double Bspline11 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns 3 values for a Basic spline function of degree 2 (order 3). - Evaluation is performed at {Argument - 1.0, Argument, Argument + 1.0}. - Argument must be in [-0.5, 0.5]. Computational load: 3 indirections, - 4(double)assignments, 4 (double)additions, 2 (double)multiplications. - - success: return(!ERROR); failure: return(ERROR); */ -extern int BsplineArray02 - ( - double Argument, /* fractional input */ - double *b2_minus1, /* 1st returned coefficient */ - double *b2_plus0, /* 2nd returned coefficient */ - double *b2_plus1 /* 3rd returned coefficient */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns 4 values for a Basic spline function of degree 3 (order 4). - Evaluation is performed at {Argument - 2.0, Argument - 1.0, Argument, - Argument + 1.0}. Argument must be in [0.0, 1.0]. - Computational load: 7 indirections, 7(double)assignments, - 6 (double)additions, 8 (double)multiplications. - - success: return(!ERROR); failure: return(ERROR); */ -extern int BsplineArray03 - ( - double Argument, /* fractional input */ - double *b3_minus2, /* 1st returned coefficient */ - double *b3_minus1, /* 2nd returned coefficient */ - double *b3_plus0, /* 3rd returned coefficient */ - double *b3_plus1 /* 4th returned coefficient */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Dodgson kernel evaluated at Argument (order 2) */ -extern double Dodgson - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns 3 values for a Dodgson kernel (order 2). - Evaluation is performed at {Argument - 1.0, Argument, Argument + 1.0}. - Argument must be in [-0.5, 0.5]. - Computational load: 5 indirections, 4(double)assignments, - 4 (double)additions, 3 (double)multiplications - - success: return(!ERROR); failure: return(ERROR); */ -extern int DodgsonArray - ( - double Argument, /* fractional input */ - double *d_minus1, /* 1st returned coefficient */ - double *d_plus0, /* 2nd returned coefficient */ - double *d_plus1 /* 3rd returned coefficient */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of the quartic German kernel (order 5) evaluated at - Argument */ -extern double German04 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of the cubic Keys kernel evaluated at Argument */ -extern double Keys - ( - double Argument, /* input */ - double a /* tuning parameter */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of the cubic Keys optimal kernel (order 3) evaluated at - Argument */ -extern double KeysOptimal - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns 4 values for a Keys kernel). - Evaluation is performed at {Argument - 2.0, Argument - 1.0, Argument, - Argument + 1.0}. Argument must be in [0.0, 1.0]. - Computational load: 7 indirections, 6(double)assignments, - 6 (double)additions, 8 (double)multiplications. - - success: return(!ERROR); failure: return(ERROR); */ -extern int KeysOptimalArray - ( - double Argument, /* fractional input */ - double *k3_minus2, /* 1st returned coefficient */ - double *k3_minus1, /* 2nd returned coefficient */ - double *k3_plus0, /* 3rd returned coefficient */ - double *k3_plus1 /* 4th returned coefficient */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Meijering function of degree 5 (order ?) - evaluated at Argument */ -extern double Meijering05 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Meijering function of degree 7 (order ?) - evaluated at Argument */ -extern double Meijering07 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Computes a Blu optimum function. - success: return(!ERROR); failure: return(ERROR); */ -extern int Omoms - ( - long Degree, /* degree */ - double Argument, /* input */ - double *Result /* output */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Blu optimum function of degree 0 (order 1) - evaluated at Argument */ -extern double Omoms00 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Blu optimum function of degree 1 (order 2) - evaluated at Argument */ -extern double Omoms01 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Blu optimum function of degree 2 (order 3) - evaluated at Argument */ -extern double Omoms02 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Blu optimum function of degree 3 (order 4) - evaluated at Argument */ -extern double Omoms03 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Blu optimum function of degree 4 (order 5) - evaluated at Argument */ -extern double Omoms04 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Blu optimum function of degree 5 (order 6) - evaluated at Argument */ -extern double Omoms05 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Blu optimum function of degree 6 (order 7) - evaluated at Argument */ -extern double Omoms06 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Blu optimum function of degree 7 (order 8) - evaluated at Argument */ -extern double Omoms07 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Blu optimum function of degree 8 (order 9) - evaluated at Argument */ -extern double Omoms08 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Blu optimum function of degree 9 (order 10) - evaluated at Argument */ -extern double Omoms09 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Blu optimum function of degree 10 (order 11) - evaluated at Argument */ -extern double Omoms10 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Blu optimum function of degree 11 (order 12) - evaluated at Argument */ -extern double Omoms11 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns 4 values for an oMoms function of degree 3 (order 4). - Evaluation is performed at {Argument - 2.0, Argument - 1.0, Argument, - Argument + 1.0}. Argument must be in [0.0, 1.0] - Computational load: 7 indirections, 6(double)assignments, - 11 (double)additions, 9 (double)multiplications - - success: return(!ERROR); failure: return(ERROR); */ -extern int OmomsArray03 - ( - double Argument, /* fractional input */ - double *b3_minus2, /* 1st returned coefficient */ - double *b3_minus1, /* 2nd returned coefficient */ - double *b3_plus0, /* 3rd returned coefficient */ - double *b3_plus1 /* 4th returned coefficient */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of the Positive kernel of degree 3 evaluated at - Argument */ -extern double Positive - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Computes a Schaum interpolating function. - success: return(!ERROR); failure: return(ERROR); */ -extern int Schaum - ( - long Degree, /* degree */ - double Argument, /* input */ - double *Result /* output */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of the Schaum kernel of degree 2 evaluated at Argument */ -extern double Schaum02 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of the Schaum kernel of degree 3 evaluated at Argument */ -extern double Schaum03 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of the Schaum kernel of degree 4 evaluated at Argument */ -extern double Schaum04 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of the sinc kernel evaluated at Argument */ -extern double Sinc - ( - double Argument /* input */ - ); -//@} -#endif diff --git a/src/core/bilib/kerneldiff.cc b/src/core/bilib/kerneldiff.cc deleted file mode 100644 index 6fad504..0000000 --- a/src/core/bilib/kerneldiff.cc +++ /dev/null @@ -1,695 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -#include -#include - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" -#include "error.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "kernel.h" -#include "kerneldiff.h" -#include "kerneldiff1.h" -#include "kerneldiff2.h" -#include "messagedisplay.h" -#include "positivepower.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -#ifdef DEBUG -#include -#include -#endif - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern int BlipDiff - ( - long Degree, /* degree */ - long Derivative, /* order of the derivative */ - double Argument, /* input */ - double *Result /* output */ - ) - -/* computes a derivative of order Derivative for a Blu interpolant function */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin BlipDiff */ - - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(BlipDiff, Result, Status, -/**/ "No output data") -/**/DEBUG_RETURN_ON_ERROR(BlipDiff, Status) -/**/DEBUG_WRITE_ENTERING(BlipDiff, -/**/ "About to compute the derivative of a blip") - - switch (Degree) { - case 0L: - switch (Derivative) { - case 0L: - *Result = Blip00(Argument); - break; - case 1L: - *Result = Blip00Diff1(Argument); - break; - case 2L: - *Result = Blip00Diff2(Argument); - break; - default: - Status = ERROR; - WRITE_ERROR(BlipDiff, - "Invalid derivative order for a blip of degree 0") - break; - } - break; - case 1L: - switch (Derivative) { - case 0L: - *Result = Blip01(Argument); - break; - case 1L: - *Result = Blip01Diff1(Argument); - break; - case 2L: - *Result = Blip01Diff2(Argument); - break; - default: - Status = ERROR; - WRITE_ERROR(BlipDiff, - "Invalid derivative order for a blip of degree 1") - break; - } - break; - case 3L: - switch (Derivative) { - case 0L: - *Result = Blip03(Argument); - break; - case 1L: - *Result = Blip03Diff1(Argument); - break; - case 2L: - *Result = Blip03Diff2(Argument); - break; - default: - Status = ERROR; - WRITE_ERROR(BlipDiff, - "Invalid derivative order for a blip of degree 3") - break; - } - break; - default: - Status = ERROR; - WRITE_ERROR(BlipDiff, "Invalid blip degree") - break; - } -/**/DEBUG_WRITE_LEAVING(BlipDiff, "Done") - return(Status); -} /* end BlipDiff */ - -/*--------------------------------------------------------------------------*/ -extern int BsplineDiff - ( - long Degree, /* degree */ - long Derivative, /* order of the derivative */ - double Argument, /* input */ - double *Result /* output */ - ) - -/* computes a derivative of order Derivative for a Basic spline function of degree Degree*/ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin BsplineDiff */ - - double Left, Right; - int Status = !ERROR; - int Done = TRUE; - -/**/DEBUG_CHECK_RANGE_LONG(BsplineDiff, Degree, 0L, LONG_MAX, Status, -/**/ "Invalid degree (should be positive)") -/**/DEBUG_CHECK_NULL_POINTER(BsplineDiff, Result, Status, -/**/ "No output data") -/**/DEBUG_RETURN_ON_ERROR(BsplineDiff, Status) -/**/DEBUG_WRITE_ENTERING(BsplineDiff, -/**/ "About to compute the derivative of a B-spline") - - switch (Degree) { - case 0L: - switch (Derivative) { - case 0L: - *Result = Bspline00(Argument); - break; - case 1L: - *Result = Bspline00Diff1(Argument); - break; - case 2L: - *Result = Bspline00Diff2(Argument); - break; - default: - Status = ERROR; - WRITE_ERROR(BsplineDiff, - "Invalid derivative order for a B-spline of degree 0") - break; - } - break; - case 1L: - switch (Derivative) { - case 0L: - *Result = Bspline01(Argument); - break; - case 1L: - *Result = Bspline01Diff1(Argument); - break; - case 2L: - *Result = Bspline01Diff2(Argument); - break; - default: - Status = ERROR; - WRITE_ERROR(BsplineDiff, - "Invalid derivative order for a B-spline of degree 1") - break; - } - break; - case 2L: - switch (Derivative) { - case 0L: - *Result = Bspline02(Argument); - break; - case 1L: - *Result = Bspline02Diff1(Argument); - break; - case 2L: - *Result = Bspline02Diff2(Argument); - break; - default: - Status = ERROR; - WRITE_ERROR(BsplineDiff, - "Invalid derivative order for a B-spline of degree 2") - break; - } - break; - case 3L: - switch (Derivative) { - case 0L: - *Result = Bspline03(Argument); - break; - case 1L: - *Result = Bspline03Diff1(Argument); - break; - case 2L: - *Result = Bspline03Diff2(Argument); - break; - default: - Done = FALSE; - break; - } - break; - case 4L: - switch (Derivative) { - case 0L: - *Result = Bspline04(Argument); - break; - case 1L: - *Result = Bspline04Diff1(Argument); - break; - case 2L: - *Result = Bspline04Diff2(Argument); - break; - default: - Done = FALSE; - break; - } - break; - case 5L: - switch (Derivative) { - case 0L: - *Result = Bspline05(Argument); - break; - case 1L: - *Result = Bspline05Diff1(Argument); - break; - case 2L: - *Result = Bspline05Diff2(Argument); - break; - default: - Done = FALSE; - break; - } - break; - case 6L: - switch (Derivative) { - case 0L: - *Result = Bspline06(Argument); - break; - case 1L: - *Result = Bspline06Diff1(Argument); - break; - case 2L: - *Result = Bspline06Diff2(Argument); - break; - default: - Done = FALSE; - break; - } - break; - case 7L: - switch (Derivative) { - case 0L: - *Result = Bspline07(Argument); - break; - case 1L: - *Result = Bspline07Diff1(Argument); - break; - case 2L: - *Result = Bspline07Diff2(Argument); - break; - default: - Done = FALSE; - break; - } - break; - case 8L: - switch (Derivative) { - case 0L: - *Result = Bspline08(Argument); - break; - case 1L: - *Result = Bspline08Diff1(Argument); - break; - case 2L: - *Result = Bspline08Diff2(Argument); - break; - default: - Done = FALSE; - break; - } - break; - case 9L: - switch (Derivative) { - case 0L: - *Result = Bspline09(Argument); - break; - case 1L: - *Result = Bspline09Diff1(Argument); - break; - case 2L: - *Result = Bspline09Diff2(Argument); - break; - default: - Done = FALSE; - break; - } - break; - case 10L: - switch (Derivative) { - case 0L: - *Result = Bspline10(Argument); - break; - case 1L: - *Result = Bspline10Diff1(Argument); - break; - case 2L: - *Result = Bspline10Diff2(Argument); - break; - default: - Done = FALSE; - break; - } - break; - case 11L: - switch (Derivative) { - case 0L: - *Result = Bspline11(Argument); - break; - case 1L: - *Result = Bspline11Diff1(Argument); - break; - case 2L: - *Result = Bspline11Diff2(Argument); - break; - default: - Done = FALSE; - break; - } - break; - default: - Done = FALSE; - break; - } - if (!Done) { -/**/ DEBUG_CHECK_RANGE_LONG(BsplineDiff, Derivative, 0L, Degree, Status, -/**/ "Invalid derivative order (should be positive and should not exceed Degree)") -/**/ DEBUG_RETURN_ON_ERROR(BsplineDiff, Status) - switch (Derivative) { - case 0L: - Status = Bspline(Degree, Argument, Result); - break; - case 1L: - Status = BsplineDiff1(Degree, Argument, Result); - break; - case 2L: - Status = BsplineDiff2(Degree, Argument, Result); - break; - default: - Status = BsplineDiff(Degree - 1L, Derivative - 1L, Argument - 0.5, &Left); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(BsplineDiff, "Done") - return(Status); - } - Status = BsplineDiff(Degree - 1L, Derivative - 1L, Argument + 0.5, &Right); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(BsplineDiff, "Done") - return(Status); - } - *Result = Right - Left; - break; - } - } -/**/DEBUG_WRITE_LEAVING(BsplineDiff, "Done") - return(Status); -} /* end BsplineDiff */ - -/*--------------------------------------------------------------------------*/ -extern int DodgsonDiff - ( - long Derivative, /* order of the derivative */ - double Argument, /* input */ - double *Result /* output */ - ) - -/* computes a derivative of order Derivative for a Dodgson kernel - (order 2) evaluated at Argument */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin DodgsonDiff */ - - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(DodgsonDiff, Result, Status, -/**/ "No output data") -/**/DEBUG_RETURN_ON_ERROR(DodgsonDiff, Status) -/**/DEBUG_WRITE_ENTERING(DodgsonDiff, -/**/ "About to compute the derivative of a Dodgson kernel") - - switch (Derivative) { - case 0L: - *Result = Dodgson(Argument); - break; - case 1L: - *Result = DodgsonDiff1(Argument); - break; - case 2L: - *Result = DodgsonDiff2(Argument); - break; - default: - Status = ERROR; - WRITE_ERROR(KeysOptimalDiff, - "Invalid derivative order for a Dodgson kernel") - break; - } -/**/DEBUG_WRITE_LEAVING(KeysOptimalDiff, "Done") - return(Status); -} /* end DodgsonDiff */ - -/*--------------------------------------------------------------------------*/ -extern int KeysOptimalDiff - ( - long Derivative, /* order of the derivative */ - double Argument, /* input */ - double *Result /* output */ - ) - -/* computes a derivative of order Derivative for a cubic Keys optimal kernel - (order 3) evaluated at Argument */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin KeysOptimalDiff */ - - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(KeysOptimalDiff, Result, Status, -/**/ "No output data") -/**/DEBUG_RETURN_ON_ERROR(KeysOptimalDiff, Status) -/**/DEBUG_WRITE_ENTERING(KeysOptimalDiff, -/**/ "About to compute the derivative of a cubic Keys optimal kernel") - - switch (Derivative) { - case 0L: - *Result = KeysOptimal(Argument); - break; - case 1L: - *Result = KeysOptimalDiff1(Argument); - break; - case 2L: - *Result = KeysOptimalDiff2(Argument); - break; - default: - Status = ERROR; - WRITE_ERROR(KeysOptimalDiff, - "Invalid derivative order for a cubic Keys optimal kernel") - break; - } -/**/DEBUG_WRITE_LEAVING(KeysOptimalDiff, "Done") - return(Status); -} /* end KeysOptimalDiff */ - -/*--------------------------------------------------------------------------*/ -extern int OmomsDiff - ( - long Degree, /* degree */ - long Derivative, /* order of the derivative */ - double Argument, /* input */ - double *Result /* output */ - ) - -/* computes a derivative of order Derivative for a Blu optimum function */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin OmomsDiff */ - - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(OmomsDiff, Result, Status, -/**/ "No output data") -/**/DEBUG_RETURN_ON_ERROR(OmomsDiff, Status) -/**/DEBUG_WRITE_ENTERING(OmomsDiff, -/**/ "About to compute the derivative of an oMoms") - - switch (Degree) { - case 0L: - switch (Derivative) { - case 0L: - *Result = Omoms00(Argument); - break; - case 1L: - *Result = Omoms00Diff1(Argument); - break; - case 2L: - *Result = Omoms00Diff2(Argument); - break; - default: - Status = ERROR; - WRITE_ERROR(OmomsDiff, - "Invalid derivative order for an oMoms of degree 0") - break; - } - break; - case 1L: - switch (Derivative) { - case 0L: - *Result = Omoms01(Argument); - break; - case 1L: - *Result = Omoms01Diff1(Argument); - break; - case 2L: - *Result = Omoms01Diff2(Argument); - break; - default: - Status = ERROR; - WRITE_ERROR(OmomsDiff, - "Invalid derivative order for an oMoms of degree 1") - break; - } - break; - case 2L: - switch (Derivative) { - case 0L: - *Result = Omoms02(Argument); - break; - case 1L: - *Result = Omoms02Diff1(Argument); - break; - case 2L: - *Result = Omoms02Diff2(Argument); - break; - default: - Status = ERROR; - WRITE_ERROR(OmomsDiff, - "Invalid derivative order for an oMoms of degree 2") - break; - } - break; - case 3L: - switch (Derivative) { - case 0L: - *Result = Omoms03(Argument); - break; - case 1L: - *Result = Omoms03Diff1(Argument); - break; - case 2L: - *Result = Omoms03Diff2(Argument); - break; - default: - Status = ERROR; - WRITE_ERROR(OmomsDiff, - "Invalid derivative order for an oMoms of degree 3") - break; - } - break; - default: - Status = ERROR; - WRITE_ERROR(OmomsDiff, "Invalid oMoms degree") - break; - } -/**/DEBUG_WRITE_LEAVING(OmomsDiff, "Done") - return(Status); -} /* end OmomsDiff */ - -/*--------------------------------------------------------------------------*/ -extern int PositiveDiff - ( - long Derivative, /* order of the derivative */ - double Argument, /* input */ - double *Result /* output */ - ) - -/* computes a derivative of order Derivative for a Positive kernel - (order 1) evaluated at Argument */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin PositiveDiff */ - - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(PositiveDiff, Result, Status, -/**/ "No output data") -/**/DEBUG_RETURN_ON_ERROR(PositiveDiff, Status) -/**/DEBUG_WRITE_ENTERING(PositiveDiff, -/**/ "About to compute the derivative of a Positive kernel") - - switch (Derivative) { - case 0L: - *Result = Positive(Argument); - break; - case 1L: - *Result = PositiveDiff1(Argument); - break; - case 2L: - *Result = PositiveDiff2(Argument); - break; - default: - Status = ERROR; - WRITE_ERROR(PositiveDiff, - "Invalid derivative order for a Positive kernel") - break; - } -/**/DEBUG_WRITE_LEAVING(PositiveDiff, "Done") - return(Status); -} /* end PositiveDiff */ - -/*--------------------------------------------------------------------------*/ -extern int SincDiff - ( - long Derivative, /* order of the derivative */ - double Argument, /* input */ - double *Result /* output */ - ) - -/* computes a derivative of order Derivative for a sinc kernel evaluated at Argument */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin SincDiff */ - - double SumSin, SumCos, Sign, Fact; - long k; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(SincDiff, Result, Status, -/**/ "No output data") -/**/DEBUG_RETURN_ON_ERROR(SincDiff, Status) -/**/DEBUG_WRITE_ENTERING(SincDiff, -/**/ "About to compute the derivative of a sinc kernel") - - switch (Derivative) { - case 0L: - *Result = Sinc(Argument); - break; - case 1L: - *Result = SincDiff1(Argument); - break; - case 2L: - *Result = SincDiff2(Argument); - break; - default: - if (Argument == 0.0) { - *Result = cos((double)Derivative * (PI / 2.0)) - * PositiveIntPower(PI, Derivative) / (double)(Derivative + 1L); - } - else { - SumSin = 0.0; - Sign = 1.0 - (double)(2L * (Derivative & 1L)); - Fact = 1.0; - k = 0L; - while (k <= (2L * (Derivative / 2L))) { - SumSin += Sign * PositiveIntPower(PI * Argument, k) / Fact; - Sign *= -1.0; - Fact *= (double)++k; - Fact *= (double)++k; - } - SumSin *= Sinc(Argument); - SumCos = 0.0; - Sign = 1.0 - (double)(2L * (Derivative & 1L)); - Fact = 1.0; - k = 1L; - while (k <= (2L * ((Derivative + 1L) / 2L))) { - SumCos += Sign * PositiveIntPower(PI * Argument, k - 1L) / Fact; - Sign *= -1.0; - Fact *= (double)++k; - Fact *= (double)++k; - } - SumCos *= cos(PI * Argument); - Fact = 1.0; - for (k = 2L; (k <= Derivative); k++) { - Fact *= (double)k; - } - *Result = Fact * (SumSin - SumCos) / PositiveIntPower(Argument, Derivative); - } - break; - } -/**/DEBUG_WRITE_LEAVING(SincDiff, "Done") - return(Status); -} /* end SincDiff */ - diff --git a/src/core/bilib/kerneldiff.h b/src/core/bilib/kerneldiff.h deleted file mode 100644 index 1153dd6..0000000 --- a/src/core/bilib/kerneldiff.h +++ /dev/null @@ -1,82 +0,0 @@ -/**@defgroup KernelDerivatives Kernel derivatives - @ingroup BilibLibrary */ -//@{ -/*--------------------------------------------------------------------------*/ -/** Computes a derivative of order Derivative for a Blu interpolant function. - success: return(!ERROR); failure: return(ERROR); */ - -extern int BlipDiff - ( - long Degree, /* degree */ - long Derivative, /* order of the derivative */ - double Argument, /* input */ - double *Result /* output */ - ); - -/*--------------------------------------------------------------------------*/ -/** Computes a derivative of order Derivative for a Basic spline function - of degree Degree. - success: return(!ERROR); failure: return(ERROR); */ -extern int BsplineDiff - ( - long Degree, /* degree */ - long Derivative, /* order of the derivative */ - double Argument, /* input */ - double *Result /* output */ - ); - -/*--------------------------------------------------------------------------*/ -/** Computes a derivative of order Derivative for a Dodgson kernel - (order 2) evaluated at Argument. - success: return(!ERROR); failure: return(ERROR); */ -extern int DodgsonDiff - ( - long Derivative, /* order of the derivative */ - double Argument, /* input */ - double *Result /* output */ - ); - -/*--------------------------------------------------------------------------*/ -/** Computes a derivative of order Derivative for a cubic Keys optimal kernel - (order 3) evaluated at Argument. - success: return(!ERROR); failure: return(ERROR); */ -extern int KeysOptimalDiff - ( - long Derivative, /* order of the derivative */ - double Argument, /* input */ - double *Result /* output */ - ); - -/*--------------------------------------------------------------------------*/ -/** Computes a derivative of order Derivative for a Blu optimum function. - success: return(!ERROR); failure: return(ERROR); */ -extern int OmomsDiff - ( - long Degree, /* degree */ - long Derivative, /* order of the derivative */ - double Argument, /* input */ - double *Result /* output */ - ); - -/*--------------------------------------------------------------------------*/ -/** Computes a derivative of order Derivative for a Positive kernel - (order 1) evaluated at Argument. - success: return(!ERROR); failure: return(ERROR); */ -extern int PositiveDiff - ( - long Derivative, /* order of the derivative */ - double Argument, /* input */ - double *Result /* output */ - ); - -/*--------------------------------------------------------------------------*/ -/** Computes a derivative of order Derivative for a sinc kernel evaluated - at Argument. success: return(!ERROR); failure: return(ERROR); */ -extern int SincDiff - ( - long Derivative, /* order of the derivative */ - double Argument, /* input */ - double *Result /* output */ - ); -//@} - diff --git a/src/core/bilib/kerneldiff1.cc b/src/core/bilib/kerneldiff1.cc deleted file mode 100644 index 6ca76d1..0000000 --- a/src/core/bilib/kerneldiff1.cc +++ /dev/null @@ -1,1094 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -#include -#include - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" -#include "error.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "kernel.h" -#include "kerneldiff1.h" -#include "messagedisplay.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -#ifdef DEBUG -#include -#include -#endif - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern int BlipDiff1 - ( - long Degree, /* degree */ - double Argument, /* input */ - double *Result /* output */ - ) - -/* computes the first derivative of a Blu interpolant function */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin BlipDiff1 */ - - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(BlipDiff1, Result, Status, -/**/ "No output data") -/**/DEBUG_RETURN_ON_ERROR(BlipDiff1, Status) -/**/DEBUG_WRITE_ENTERING(BlipDiff1, -/**/ "About to compute the first order derivative of a generic blip") - - switch (Degree) { - case 0L: - *Result = Blip00Diff1(Argument); - break; - case 1L: - *Result = Blip01Diff1(Argument); - break; - case 3L: - *Result = Blip03Diff1(Argument); - break; - default: - Status = ERROR; - WRITE_ERROR(BlipDiff1, "Invalid blip degree") - break; - } -/**/DEBUG_WRITE_LEAVING(BlipDiff1, "Done") - return(Status); -} /* end BlipDiff1 */ - -/*--------------------------------------------------------------------------*/ -extern double Blip00Diff1 - ( - double Argument /* input */ - ) - -/* returns the value of the first derivative of a Blu interpolant function - of degree 0 (order 1) evaluated at Argument */ - -{ /* begin Blip00Diff1 */ - -/**/DEBUG_WRITE_ENTERING(Blip00Diff1, -/**/ "About to compute the first derivative of a blip of degree 0") - - if (Argument == -0.5) { - WRITE_ERROR(Blip00Diff1, "Undefined value at Argument == -0.5") -/**/ DEBUG_WRITE_LEAVING(Blip00Diff1, "Done") - return(HUGE_VAL); - } - else if (Argument == 0.5) { - WRITE_ERROR(Blip00Diff1, "Undefined value at Argument == 0.5") -/**/ DEBUG_WRITE_LEAVING(Blip00Diff1, "Done") - return(-HUGE_VAL); - } - else { -/**/ DEBUG_WRITE_LEAVING(Blip00Diff1, "Done") - return(0.0); - } -} /* end Blip00Diff1 */ - -/*--------------------------------------------------------------------------*/ -extern double Blip01Diff1 - ( - double Argument /* input */ - ) - -/* returns the value of the first derivative of a Blu interpolant function - of degree 1 (order 2) evaluated at Argument */ - -{ /* begin Blip01Diff1 */ - - double a; - -/**/DEBUG_WRITE_ENTERING(Blip01Diff1, -/**/ "About to compute the first derivative of a blip of degree 1") - - a = fabs(Argument); - if (a == 0.0) { - } - else if (a < 1.0) { - a = -1.0; - } - else if (a == 1.0) { - a = -1.0 / 2.0; - } - else { - a = 0.0; - } -/**/DEBUG_WRITE_LEAVING(Blip01Diff1, "Done") - return((0.0 < Argument) ? (a) : (-a)); -} /* end Blip01Diff1 */ - -/*--------------------------------------------------------------------------*/ -extern double Blip03Diff1 - ( - double Argument /* input */ - ) - -/* returns the value of the first derivative of a Blu interpolant function - of degree 3 (order 4) evaluated at Argument */ - -{ /* begin Blip03Diff1 */ - - double a; - -/**/DEBUG_WRITE_ENTERING(Blip03Diff1, -/**/ "About to compute the first derivative of a blip of degree 3") - - a = fabs(Argument); - if (a == 0.0) { - } - else if (a < 1.0) { - a = a * (a * (3.0 / 2.0) - 2.0) + 3.0 / 56.0; - } - else if (a == 1.0) { - a = -27.0 / 56.0; - } - else if (a < 2.0) { - a = a * (2.0 - a * (1.0 / 2.0)) - 113.0 / 56.0; - } - else if (a == 2.0) { - a = -1.0 / 112.0; - } - else { - a = 0.0; - } -/**/DEBUG_WRITE_LEAVING(Blip03Diff1, "Done") - return((0.0 < Argument) ? (a) : (-a)); -} /* end Blip03Diff1 */ - -/*--------------------------------------------------------------------------*/ -extern int BsplineDiff1 - ( - long Degree, /* degree */ - double Argument, /* input */ - double *Result /* output */ - ) - -/* computes the first derivative of a Basic spline function */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin BsplineDiff1 */ - - double Left, Right; - int Status = !ERROR; - -/**/DEBUG_CHECK_RANGE_LONG(BsplineDiff1, Degree, 0L, LONG_MAX, Status, -/**/ "Invalid degree (should be positive)") -/**/DEBUG_CHECK_NULL_POINTER(BsplineDiff1, Result, Status, -/**/ "No output data") -/**/DEBUG_RETURN_ON_ERROR(BsplineDiff1, Status) -/**/DEBUG_WRITE_ENTERING(BsplineDiff1, -/**/ "About to compute the first order derivative of a generic B-spline") - - switch (Degree) { - case 0L: - *Result = Bspline00Diff1(Argument); - break; - case 1L: - *Result = Bspline01Diff1(Argument); - break; - case 2L: - *Result = Bspline02Diff1(Argument); - break; - case 3L: - *Result = Bspline03Diff1(Argument); - break; - case 4L: - *Result = Bspline04Diff1(Argument); - break; - case 5L: - *Result = Bspline05Diff1(Argument); - break; - case 6L: - *Result = Bspline06Diff1(Argument); - break; - case 7L: - *Result = Bspline07Diff1(Argument); - break; - case 8L: - *Result = Bspline08Diff1(Argument); - break; - case 9L: - *Result = Bspline09Diff1(Argument); - break; - case 10L: - *Result = Bspline10Diff1(Argument); - break; - case 11L: - *Result = Bspline11Diff1(Argument); - break; - default: - Status = Bspline(Degree - 1L, Argument - 0.5, &Left); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(BsplineDiff1, "Done") - return(Status); - } - Status = Bspline(Degree - 1L, Argument + 0.5, &Right); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(BsplineDiff1, "Done") - return(Status); - } - *Result = Right - Left; - break; - } -/**/DEBUG_WRITE_LEAVING(BsplineDiff1, "Done") - return(Status); -} /* end BsplineDiff1 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline00Diff1 - ( - double Argument /* input */ - ) - -/* returns the value of the first derivative of a Basic spline function - of degree 0 (order 1) evaluated at Argument */ - -{ /* begin Bspline00Diff1 */ - -/**/DEBUG_WRITE_ENTERING(Bspline00Diff1, -/**/ "About to compute the first derivative of a B-spline of degree 0") - - if (Argument == -0.5) { - WRITE_ERROR(Bspline00Diff1, "Undefined value at Argument == -0.5") -/**/ DEBUG_WRITE_LEAVING(Bspline00Diff1, "Done") - return(HUGE_VAL); - } - else if (Argument == 0.5) { - WRITE_ERROR(Bspline00Diff1, "Undefined value at Argument == 0.5") -/**/ DEBUG_WRITE_LEAVING(Bspline00Diff1, "Done") - return(-HUGE_VAL); - } - else { -/**/ DEBUG_WRITE_LEAVING(Bspline00Diff1, "Done") - return(0.0); - } -} /* end Bspline00Diff1 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline01Diff1 - ( - double Argument /* input */ - ) - -/* returns the value of the first derivative of a Basic spline function - of degree 1 (order 2) evaluated at Argument */ - -{ /* begin Bspline01Diff1 */ - - double a; - -/**/DEBUG_WRITE_ENTERING(Bspline01Diff1, -/**/ "About to compute the first derivative of a B-spline of degree 1") - - a = fabs(Argument); - if (a == 0.0) { - } - else if (a < 1.0) { - a = -1.0; - } - else if (a == 1.0) { - a = -1.0 / 2.0; - } - else { - a = 0.0; - } -/**/DEBUG_WRITE_LEAVING(Bspline01Diff1, "Done") - return((0.0 < Argument) ? (a) : (-a)); -} /* end Bspline01Diff1 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline02Diff1 - ( - double Argument /* input */ - ) - -/* returns the value of the first derivative of a Basic spline function - of degree 2 (order 3) evaluated at Argument */ - -{ /* begin Bspline02Diff1 */ - - double a; - -/**/DEBUG_WRITE_ENTERING(Bspline02Diff1, -/**/ "About to compute the first derivative of a B-spline of degree 2") - - a = fabs(Argument); - if (a < 0.5) { - a *= -2.0; - } - else if (a < 1.5) { - a -= 3.0 / 2.0; - } - else { - a = 0.0; - } -/**/DEBUG_WRITE_LEAVING(Bspline02Diff1, "Done") - return((0.0 < Argument) ? (a) : (-a)); -} /* end Bspline02Diff1 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline03Diff1 - ( - double Argument /* input */ - ) - -/* returns the value of the first derivative of a Basic spline function - of degree 3 (order 4) evaluated at Argument */ - -{ /* begin Bspline03Diff1 */ - - double a; - -/**/DEBUG_WRITE_ENTERING(Bspline03Diff1, -/**/ "About to compute the first derivative of a B-spline of degree 3") - - a = fabs(Argument); - if (a < 1.0) { - a *= a * (3.0 / 2.0) - 2.0; - } - else if (a < 2.0) { - a = 2.0 - a; - a *= a * (-1.0 / 2.0); - } - else { - a = 0.0; - } -/**/DEBUG_WRITE_LEAVING(Bspline03Diff1, "Done") - return((0.0 < Argument) ? (a) : (-a)); -} /* end Bspline03Diff1 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline04Diff1 - ( - double Argument /* input */ - ) - -/* returns the value of the first derivative of a Basic spline function - of degree 4 (order 5) evaluated at Argument */ - -{ /* begin Bspline04Diff1 */ - - double a; - -/**/DEBUG_WRITE_ENTERING(Bspline04Diff1, -/**/ "About to compute the first derivative of a B-spline of degree 4") - - a = fabs(Argument); - if (a < 0.5) { - a *= a * a - 5.0 / 4.0; - } - else if (a < 1.5) { - a = a * (a * (5.0 / 2.0 - a * (2.0 / 3.0)) - 5.0 / 2.0) + 5.0 / 24.0; - } - else if (a < 2.5) { - a -= 5.0 / 2.0; - a *= a * a * (1.0 / 6.0); - } - else { - a = 0.0; - } -/**/DEBUG_WRITE_LEAVING(Bspline04Diff1, "Done") - return((0.0 < Argument) ? (a) : (-a)); -} /* end Bspline04Diff1 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline05Diff1 - ( - double Argument /* input */ - ) - -/* returns the value of the first derivative of a Basic spline function - of degree 5 (order 6) evaluated at Argument */ - -{ /* begin Bspline05Diff1 */ - - double a; - -/**/DEBUG_WRITE_ENTERING(Bspline05Diff1, -/**/ "About to compute the first derivative of a B-spline of degree 5") - - a = fabs(Argument); - if (a < 1.0) { - a *= a * a * (1.0 - a * (5.0 / 12.0)) - 1.0; - } - else if (a < 2.0) { - a = a * (a * (a * (a * (5.0 / 24.0) - 3.0 / 2.0) + 15.0 / 4.0) - - 7.0 / 2.0) + 5.0 / 8.0; - } - else if (a < 3.0) { - a -= 3.0; - a *= a; - a *= a * (-1.0 / 24.0); - } - else { - a = 0.0; - } -/**/DEBUG_WRITE_LEAVING(Bspline05Diff1, "Done") - return((0.0 < Argument) ? (a) : (-a)); -} /* end Bspline05Diff1 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline06Diff1 - ( - double Argument /* input */ - ) - -/* returns the value of the first derivative of a Basic spline function - of degree 6 (order 7) evaluated at Argument */ - -{ /* begin Bspline06Diff1 */ - - double a, a2; - -/**/DEBUG_WRITE_ENTERING(Bspline06Diff1, -/**/ "About to compute the first derivative of a B-spline of degree 6") - - a = fabs(Argument); - if (a < 0.5) { - a2 = a * a; - a *= a2 * (7.0 / 12.0 - a2 * (1.0 / 6.0)) - 77.0 / 96.0; - } - else if (a < 1.5) { - a = a * (a * (a * (a * (a * (1.0 / 8.0) - 35.0 / 48.0) + 21.0 / 16.0) - 35.0 / 96.0) - - 91.0 / 128.0) - 7.0 / 768.0; - } - else if (a < 2.5) { - a = a * (a * (a * (a * (7.0 / 12.0 - a * (1.0 / 20.0)) - 21.0 / 8.0) + 133.0 / 24.0) - - 329.0 / 64.0) + 1267.0 / 960.0; - } - else if (a < 3.5) { - a -= 7.0 / 2.0; - a2 = a * a; - a *= a2 * a2 * (1.0 / 120.0); - } - else { - a = 0.0; - } -/**/DEBUG_WRITE_LEAVING(Bspline06Diff1, "Done") - return((0.0 < Argument) ? (a) : (-a)); -} /* end Bspline06Diff1 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline07Diff1 - ( - double Argument /* input */ - ) - -/* returns the value of the first derivative of a Basic spline function - of degree 7 (order 8) evaluated at Argument */ - -{ /* begin Bspline07Diff1 */ - - double a, a2; - -/**/DEBUG_WRITE_ENTERING(Bspline07Diff1, -/**/ "About to compute the first derivative of a B-spline of degree 7") - - a = fabs(Argument); - if (a < 1.0) { - a2 = a * a; - a *= a2 * (a2 * (a * (7.0 / 144.0) - 1.0 / 6.0) + 4.0 / 9.0) - 2.0 / 3.0; - } - else if (a < 2.0) { - a = a * (a * (a * (a * (a * (3.0 / 10.0 - a * (7.0 / 240.0)) - 7.0 / 6.0) - + 2.0) - 7.0 / 6.0) - 2.0 / 10.0) - 7.0 / 90.0; - } - else if (a < 3.0) { - a = a * (a * (a * (a * (a * (a * (7.0 / 720.0) - 1.0 / 6.0) + 7.0 / 6.0) - - 38.0 / 9.0) + 49.0 / 6.0) - 23.0 / 3.0) + 217.0 / 90.0; - } - else if (a < 4.0) { - a -= 4.0; - a *= a; - a *= a * a * (-1.0 / 720.0); - } - else { - a = 0.0; - } -/**/DEBUG_WRITE_LEAVING(Bspline07Diff1, "Done") - return((0.0 < Argument) ? (a) : (-a)); -} /* end Bspline07Diff1 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline08Diff1 - ( - double Argument /* input */ - ) - -/* returns the value of the first derivative of a Basic spline function - of degree 8 (order 9) evaluated at Argument */ - -{ /* begin Bspline08Diff1 */ - - double a, a2; - -/**/DEBUG_WRITE_ENTERING(Bspline08Diff1, -/**/ "About to compute the first derivative of a B-spline of degree 8") - - a = fabs(Argument); - if (a < 0.5) { - a2 = a * a; - a *= a2 * (a2 * (a2 * (1.0 / 72.0) - 3.0 / 32) + 43.0 / 128.0) - 289.0 / 512.0; - } - else if (a < 1.5) { - a = a * (a * (a * (a * (a * (a * (7.0 / 80.0 - a * (1.0 / 90.0)) - - 9.0 / 40.0) + 7.0 / 64.0) + 9.0 / 32.0) + 21.0 / 1280.0) - - 363.0 / 640.0) + 1.0 / 5120.0; - } - else if (a < 2.5) { - a = a * (a * (a * (a * (a * (a * (a * (1.0 / 180.0) - 7.0 / 80.0) - + 9.0 / 16.0) - 119.0 / 64.0) + 207.0 / 64.0) - 3381.0 / 1280.0) - + 195.0 / 256.0) - 1457.0 / 5120.0; - } - else if (a < 3.5) { - a = a * (a * (a * (a * (a * (a * (3.0 / 80.0 - a * (1.0 / 630.0)) - - 3.0 / 8.0) + 131.0 / 64.0) - 209.0 / 32.0) + 15369.0 / 1280.0) - - 1465.0 / 128.0) + 146051.0 / 35840.0; - } - else if (a < 4.5) { - a -= 9.0 / 2.0; - a2 = a * a * a; - a2 *= a2; - a *= a2 * (1.0 / 5040.0); - } - else { - a = 0.0; - } -/**/DEBUG_WRITE_LEAVING(Bspline08Diff1, "Done") - return((0.0 < Argument) ? (a) : (-a)); -} /* end Bspline08Diff1 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline09Diff1 - ( - double Argument /* input */ - ) - -/* returns the value of the first derivative of a Basic spline function - of degree 9 (order 10) evaluated at Argument */ - -{ /* begin Bspline09Diff1 */ - - double a, a2; - -/**/DEBUG_WRITE_ENTERING(Bspline09Diff1, -/**/ "About to compute the first derivative of a B-spline of degree 9") - - a = fabs(Argument); - if (a < 1.0) { - a2 = a * a; - a *= a2 * (a2 * (a2 * (1.0 / 72.0 - a * (1.0 / 320.0)) - 5.0 / 72.0) - + 19.0 / 72.0) - 35.0 / 72.0; - } - else if (a < 2.0) { - a = a * (a * (a * (a * (a * (a * (a * (a * (1.0 / 480.0) - 1.0 / 36.0) - + 7.0 / 48.0) - 13.0 / 36.0) + 35.0 / 96.0) - 1.0 / 36.0) + 7.0 / 48.0) - - 19.0 / 36.0) + 1.0 / 192.0; - } - else if (a < 3.0) { - a = a * (a * (a * (a * (a * (a * (a * (5.0 / 252.0 - a * (1.0 / 1120.0)) - - 3.0 / 16.0) +35.0 / 36.0) - 95.0 / 32.0) + 191.0 / 36.0) - 83.0 / 16.0) - + 635.0 / 252.0) - 339.0 / 448.0; - } - else if (a < 4.0) { - a = a * (a * (a * (a * (a * (a * (a * (a * (1.0 / 4480.0) - 1.0 / 144.0) - + 3.0 / 32.0) - 103.0 / 144.0) + 215.0 / 64.0) - 1423.0 / 144.0) - + 563.0 / 32.0) - 2449.0 / 144.0) + 5883.0 / 896.0; - } - else if (a < 5.0) { - a -= 5.0; - a *= a; - a *= a; - a *= a * (-1.0 / 40320.0); - } - else { - a = 0.0; - } -/**/DEBUG_WRITE_LEAVING(Bspline09Diff1, "Done") - return((0.0 < Argument) ? (a) : (-a)); -} /* end Bspline09Diff1 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline10Diff1 - ( - double Argument /* input */ - ) - -/* returns the value of the first derivative of a Basic spline function - of degree 10 (order 11) evaluated at Argument */ - -{ /* begin Bspline10Diff1 */ - - double a, a2; - -/**/DEBUG_WRITE_ENTERING(Bspline10Diff1, -/**/ "About to compute the first derivative of a B-spline of degree 10") - - a = fabs(Argument); - if (a < 0.5) { - a2 = a * a; - a *= a2 * (a2 * (a2 * (11.0 / 1440.0 - a2 * (1.0 / 1440.0)) - - 583.0 / 11520.0) + 14597.0 / 69120.0) - 156409.0 / 368640.0; - } - else if (a < 1.5) { - a = a * (a * (a * (a * (a * (a * (a * (a * (a * (1.0 / 1728.0) - - 11.0 / 1920.0) + 11.0 / 576.0) - 77.0 / 5760.0) - 187.0 / 4608.0) - - 77.0 / 15360.0) + 5885.0 / 27648.0) - 11.0 / 30720.0) - - 62557.0 / 147456.0) - 11.0 / 4423680.0; - } - else if (a < 2.5) { - a = a * (a * (a * (a * (a * (a * (a * (a * (11.0 / 1680.0 - a * (1.0 / 3024.0)) - - 55.0 / 1008.0) + 11.0 / 45.0) - 715.0 / 1152.0) + 1661.0 / 1920.0) - - 4543.0 / 6912.0) + 7513.0 / 13440.0) - 163603.0 / 258048.0) - + 135311.0 / 3870720.0; - } - else if (a < 3.5) { - a = a * (a * (a * (a * (a * (a * (a * (a * (a * (1.0 / 8064.0) - 33.0 / 8960.0) - + 55.0 / 1152.0) - 451.0 / 1280.0) + 14905.0 / 9216.0) - 48433.0 / 10240.0) - + 479281.0 / 55296.0) - 1352153.0 / 143360.0) + 1654543.0 / 294912.0) - - 11695211.0 / 6881280.0; - } - else if (a < 4.5) { - a = a * (a * (a * (a * (a * (a * (a * (a * (11.0 / 10080.0 - a * (1.0 / 36288.0)) - - 11.0 / 576.0) + 209.0 / 1080.0) - 5753.0 / 4608.0) + 61061.0 / 11520.0) - - 407429.0 / 27648.0) + 2070343.0 / 80640.0) - 3702215.0 / 147456.0) - + 237959711.0 / 23224320.0; - } - else if (a < 5.5) { - a -= 11.0 / 2.0; - a2 = a * a; - a2 *= a2; - a2 *= a2; - a *= a2 * (1.0 / 362880.0); - } - else { - a = 0.0; - } -/**/DEBUG_WRITE_LEAVING(Bspline10Diff1, "Done") - return((0.0 < Argument) ? (a) : (-a)); -} /* end Bspline10Diff1 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline11Diff1 - ( - double Argument /* input */ - ) - -/* returns the value of the first derivative of a Basic spline function - of degree 11 (order 12) evaluated at Argument */ - -{ /* begin Bspline11Diff1 */ - - double a, a2; - -/**/DEBUG_WRITE_ENTERING(Bspline11Diff1, -/**/ "About to compute the first derivative of a B-spline of degree 11") - - a = fabs(Argument); - if (a < 1.0) { - a2 = a * a; - a *= a2 * (a2 * (a2 * (a2 * (a * (11.0 / 86400.0) - 1.0 / 1440.0) - + 1.0 / 180.0) - 23.0 / 600.0) + 31.0 / 180.0) - 809.0 / 2160.0; - } - else if (a < 2.0) { - a = a * (a * (a * (a * (a * (a * (a * (a * (a * (1.0 / 672.0 - - a * (11.0 / 120960.0)) - 11.0 / 1120.0) + 2.0 / 63.0) - 11.0 / 240.0) - + 1.0 / 60.0) - 11.0 / 240.0) + 25.0 / 126.0) - 11.0 / 1120.0) - - 563.0 / 1512.0) - 11.0 / 50400.0; - } - else if (a < 3.0) { - a = a * (a * (a * (a * (a * (a * (a * (a * (a * (a * (11.0 / 241920.0) - - 5.0 / 4032.0) + 33.0 / 2240.0) - 25.0 / 252.0) + 33.0 / 80.0) - - 13.0 / 12.0) + 143.0 / 80.0) - 239.0 / 126.0) + 1749.0 / 1120.0) - - 1619.0 / 1512.0) + 781.0 / 5600.0; - } - else if (a < 4.0) { - a = a * (a * (a * (a * (a * (a * (a * (a * (a * (1.0 / 1728.0 - - a * (11.0 / 725760.0)) - 11.0 / 1120.0) + 7.0 / 72.0) - - 99.0 / 160.0) + 631.0 / 240.0) - 1199.0 / 160.0) + 1009.0 / 72.0) - - 36597.0 / 2240.0) + 9385.0 / 864.0) - 38533.0 / 11200.0; - } - else if (a < 5.0) { - a = a * (a * (a * (a * (a * (a * (a * (a * (a * (a * (11.0 / 3628800.0) - - 1.0 / 6720.0) + 11.0 / 3360.0) - 107.0 / 2520.0) + 517.0 / 1440.0) - - 2477.0 / 1200.0) + 11737.0 / 1440.0) - 54797.0 / 2520.0) - + 250657.0 / 6720.0) - 1113317.0 / 30240.0) + 4726777.0 / 302400.0; - } - else if (a < 6.0) { - a -= 6.0; - a *= a; - a2 = a * a; - a *= a2 * a2 * (-1.0 / 3628800.0); - } - else { - a = 0.0; - } -/**/DEBUG_WRITE_LEAVING(Bspline11Diff1, "Done") - return((0.0 < Argument) ? (a) : (-a)); -} /* end Bspline11Diff1 */ - -/*--------------------------------------------------------------------------*/ -extern double DodgsonDiff1 - ( - double Argument /* input */ - ) - -/* returns the value of the first derivative of the Dodgson kernel - (order 2) evaluated at Argument */ - -{ /* begin DodgsonDiff1 */ - - double a; - -/**/DEBUG_WRITE_ENTERING(DodgsonDiff1, -/**/ "About to compute the first derivative of a Keys") - - a = fabs(Argument); - if (a < 0.5) { - a *= -4.0; - } - else if (a == 0.5) { - a = -7.0 / 2.0; - } - else if (a < 1.5) { - a = 2.0 * a - 5.0 / 2.0; - } - else if (a == 1.5) { - a = 1.0 / 4.0; - } - else { - a = 0.0; - } -/**/DEBUG_WRITE_LEAVING(DodgsonDiff1, "Done") - return((0.0 < Argument) ? (a) : (-a)); -} /* end DodgsonDiff1 */ - -/*--------------------------------------------------------------------------*/ -extern double German04Diff1 - ( - double Argument /* input */ - ) - -/* returns the value of the first derivative of a German function - of degree 4 (order 5) evaluated at Argument */ - -{ /* begin German04Diff1 */ - - double a; - -/**/DEBUG_WRITE_ENTERING(German04Diff1, -/**/ "About to compute the first derivative of a German of degree 4") - - a = fabs(Argument); - if (a < 1.0) { - a *= a * (a * (1.0 / 6.0) + 185.0 / 48.0) - 335.0 / 72.0; - } - else if (a < 2.0) { - a = a * (a * (-29.0 / 48.0 - a * (1.0 / 4.0)) + 17.0 / 4.0) - 145.0 / 36.0; - } - else if (a < 3.0) { - a = a * (a * (a * (1.0 / 12.0) - 7.0 / 16.0) + 5.0 / 9.0) + 1.0 / 36.0; - } - else if (a < 4.0) { - a = a * (a * (1.0 / 48.0) - 11.0 / 72.0) + 5.0 / 18.0; - } - else { - a = 0.0; - } -/**/DEBUG_WRITE_LEAVING(German04Diff1, "Done") - return((0.0 < Argument) ? (a) : (-a)); -} /* end German04Diff1 */ - -/*--------------------------------------------------------------------------*/ -extern double KeysOptimalDiff1 - ( - double Argument /* input */ - ) - -/* returns the value of the first derivative of the cubic Keys optimal kernel - (order 3) evaluated at Argument */ - -{ /* begin KeysOptimalDiff1 */ - - double a; - -/**/DEBUG_WRITE_ENTERING(KeysOptimalDiff1, -/**/ "About to compute the first derivative of a Keys") - - a = fabs(Argument); - if (a < 1.0) { - a *= a * (9.0 / 2.0) - 5.0; - } - else if (a < 2.0) { - a = a * (5.0 - a * (3.0 / 2.0)) - 4.0; - } - else { - a = 0.0; - } -/**/DEBUG_WRITE_LEAVING(KeysOptimalDiff1, "Done") - return((0.0 < Argument) ? (a) : (-a)); -} /* end KeysOptimalDiff1 */ - -/*--------------------------------------------------------------------------*/ -extern int OmomsDiff1 - ( - long Degree, /* degree */ - double Argument, /* input */ - double *Result /* output */ - ) - -/* computes the first derivative of a Blu optimum function */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin OmomsDiff1 */ - - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(OmomsDiff1, Result, Status, -/**/ "No output data") -/**/DEBUG_RETURN_ON_ERROR(OmomsDiff1, Status) -/**/DEBUG_WRITE_ENTERING(OmomsDiff1, -/**/ "About to compute the first order derivative of a generic oMoms") - - switch (Degree) { - case 0L: - *Result = Omoms00Diff1(Argument); - break; - case 1L: - *Result = Omoms01Diff1(Argument); - break; - case 3L: - *Result = Omoms03Diff1(Argument); - break; - default: - Status = ERROR; - WRITE_ERROR(OmomsDiff1, "Invalid oMoms degree") - break; - } -/**/DEBUG_WRITE_LEAVING(OmomsDiff1, "Done") - return(Status); -} /* end OmomsDiff1 */ - -/*--------------------------------------------------------------------------*/ -extern double Omoms00Diff1 - ( - double Argument /* input */ - ) - -/* returns the value of the first derivative of a Blu optimum function - of degree 0 (order 1) evaluated at Argument */ - -{ /* begin Omoms00Diff1 */ - -/**/DEBUG_WRITE_ENTERING(Omoms00Diff1, -/**/ "About to compute the first derivative of an oMoms of degree 0") - - if (Argument == -0.5) { - WRITE_ERROR(Omoms00Diff1, "Undefined value at Argument == -0.5") -/**/ DEBUG_WRITE_LEAVING(Omoms00Diff1, "Done") - return(HUGE_VAL); - } - else if (Argument == 0.5) { - WRITE_ERROR(Omoms00Diff1, "Undefined value at Argument == 0.5") -/**/ DEBUG_WRITE_LEAVING(Omoms00Diff1, "Done") - return(-HUGE_VAL); - } - else { -/**/ DEBUG_WRITE_LEAVING(Omoms00Diff1, "Done") - return(0.0); - } -} /* end Omoms00Diff1 */ - -/*--------------------------------------------------------------------------*/ -extern double Omoms01Diff1 - ( - double Argument /* input */ - ) - -/* returns the value of the first derivative of a Blu optimum function - of degree 1 (order 2) evaluated at Argument */ - -{ /* begin Omoms01Diff1 */ - - double a; - -/**/DEBUG_WRITE_ENTERING(Omoms01Diff1, -/**/ "About to compute the first derivative of an oMoms of degree 1") - - a = fabs(Argument); - if (a == 0.0) { - } - else if (a < 1.0) { - a = -1.0; - } - else if (a == 1.0) { - a = -1.0 / 2.0; - } - else { - a = 0.0; - } -/**/DEBUG_WRITE_LEAVING(Omoms01Diff1, "Done") - return((0.0 < Argument) ? (a) : (-a)); -} /* end Omoms01Diff1 */ - -/*--------------------------------------------------------------------------*/ -extern double Omoms02Diff1 - ( - double Argument /* input */ - ) - -/* returns the value of the first derivative of a Blu optimum function - of degree 2 (order 3) evaluated at Argument */ - -{ /* begin Omoms02Diff1 */ - - double a; - -/**/DEBUG_WRITE_ENTERING(Omoms02Diff1, -/**/ "About to compute the first derivative of an oMoms of degree 2") - - a = fabs(Argument); - if (a < 0.5) { - a *= -2.0; - } - else if (a == 0.5) { - WRITE_ERROR(Omoms02Diff1, "Undefined value at |Argument| == 0.5") -/**/ DEBUG_WRITE_LEAVING(Omoms02Diff1, "Done") - return(HUGE_VAL); - } - else if (a < 1.5) { - a -= 3.0 / 2.0; - } - else if (a == 1.5) { - WRITE_ERROR(Omoms02Diff1, "Undefined value at |Argument| == 1.5") -/**/ DEBUG_WRITE_LEAVING(Omoms02Diff1, "Done") - return(-HUGE_VAL); - } - else { - a = 0.0; - } -/**/DEBUG_WRITE_LEAVING(Omoms02Diff1, "Done") - return((0.0 < Argument) ? (a) : (-a)); -} /* end Omoms02Diff1 */ - -/*--------------------------------------------------------------------------*/ -extern double Omoms03Diff1 - ( - double Argument /* input */ - ) - -/* returns the value of the first derivative of a Blu optimum function - of degree 3 (order 4) evaluated at Argument */ - -{ /* begin Omoms03Diff1 */ - - double a; - -/**/DEBUG_WRITE_ENTERING(Omoms03Diff1, -/**/ "About to compute the first derivative of an oMoms of degree 3") - - a = fabs(Argument); - if (a == 0.0) { - } - else if (a < 1.0) { - a = a * (a * (3.0 / 2.0) - 2.0) + 1.0 / 14.0; - } - else if (a == 1.0) { - a = -10.0 / 21.0; - } - else if (a < 2.0) { - a = a * (2.0 - a * (1.0 / 2.0)) - 85.0 / 42.0; - } - else if (a == 2.0) { - a = -1.0 / 84.0; - } - else { - a = 0.0; - } -/**/DEBUG_WRITE_LEAVING(Omoms03Diff1, "Done") - return((0.0 < Argument) ? (a) : (-a)); -} /* end Omoms03Diff1 */ - -/*--------------------------------------------------------------------------*/ -extern double PositiveDiff1 - ( - double Argument /* input */ - ) - -/* returns the value of the first derivative of Positive kernel - (order 1) evaluated at Argument */ - -{ /* begin PositiveDiff1 */ - - double a; - -/**/DEBUG_WRITE_ENTERING(PositiveDiff1, -/**/ "About to compute the first derivative of a Positive") - - a = fabs(Argument); - if (a < 0.5) { - a *= a * 12.0 - 9.0; - } - else if (a < 1.0) { - a = a * 3.0 - 3.0; - } - else if (a < 1.5) { - a = a * (15.0 - a * 6.0) - 9.0; - } - else if (a < 2.0) { - a = a * (a * 6.0 - 21.0) + 18.0; - } - else { - a = 0.0; - } -/**/DEBUG_WRITE_LEAVING(PositiveDiff1, "Done") - return((0.0 < Argument) ? (a) : (-a)); -} /* end PositiveDiff1 */ - -/*--------------------------------------------------------------------------*/ -extern double SincDiff1 - ( - double Argument /* input */ - ) - -/* returns the value of the first derivative of the sinc kernel evaluated at Argument */ - -{ /* begin SincDiff1 */ - -/**/DEBUG_WRITE_ENTERING(SincDiff1, -/**/ "About to compute the first derivative of a sinc") - - if (Argument == 0.0) { -/**/ DEBUG_WRITE_LEAVING(SincDiff1, "Done") - return(0.0); - } - else { -/**/ DEBUG_WRITE_LEAVING(SincDiff1, "Done") - return((cos(PI * Argument) - Sinc(Argument)) / Argument); - } -} /* end SincDiff1 */ - diff --git a/src/core/bilib/kerneldiff1.h b/src/core/bilib/kerneldiff1.h deleted file mode 100644 index 3d6954b..0000000 --- a/src/core/bilib/kerneldiff1.h +++ /dev/null @@ -1,186 +0,0 @@ -/*--------------------------------------------------------------------------*/ -extern int BlipDiff1 - ( - long Degree, /* degree */ - double Argument, /* input */ - double *Result /* output */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Blip00Diff1 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Blip01Diff1 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Blip03Diff1 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern int BsplineDiff1 - ( - long Degree, /* degree */ - double Argument, /* input */ - double *Result /* output */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Bspline00Diff1 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Bspline01Diff1 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Bspline02Diff1 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Bspline03Diff1 - ( - double Argument /* input */ - ); - -/** Bspline03Diff1 as a macro */ -#define BSPLINE03DIFF1(y,x) \ -{\ - double a = fabs(x); \ - if (a < 1.0) \ - { \ - a *= a * 1.5 - 2.0; \ - y=(x>0.0) ? (a) : (-a); \ - } \ - else if (a < 2.0) { \ - a = 2.0 - a; \ - a *= a * -0.5; \ - y=(x>0.0) ? (a) : (-a); \ - } \ - else \ - y = 0.0; \ -} - -/*--------------------------------------------------------------------------*/ -extern double Bspline04Diff1 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Bspline05Diff1 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Bspline06Diff1 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Bspline07Diff1 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Bspline08Diff1 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Bspline09Diff1 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Bspline10Diff1 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Bspline11Diff1 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double DodgsonDiff1 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double German04Diff1 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double KeysOptimalDiff1 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern int OmomsDiff1 - ( - long Degree, /* degree */ - double Argument, /* input */ - double *Result /* output */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Omoms00Diff1 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Omoms01Diff1 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Omoms02Diff1 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Omoms03Diff1 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double PositiveDiff1 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double SincDiff1 - ( - double Argument /* input */ - ); - diff --git a/src/core/bilib/kerneldiff2.cc b/src/core/bilib/kerneldiff2.cc deleted file mode 100644 index 28ab3fd..0000000 --- a/src/core/bilib/kerneldiff2.cc +++ /dev/null @@ -1,1145 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -#include -#include - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" -#include "error.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "kernel.h" -#include "kerneldiff2.h" -#include "messagedisplay.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -#ifdef DEBUG -#include -#include -#endif - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern int BlipDiff2 - ( - long Degree, /* degree */ - double Argument, /* input */ - double *Result /* output */ - ) - -/* computes the second derivative of a Blu interpolant function */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin BlipDiff2 */ - - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(BlipDiff2, Result, Status, -/**/ "No output data") -/**/DEBUG_RETURN_ON_ERROR(BlipDiff2, Status) -/**/DEBUG_WRITE_ENTERING(BlipDiff2, -/**/ "About to compute the second derivative of a generic blip") - - switch (Degree) { - case 0L: - *Result = Blip00Diff2(Argument); - break; - case 1L: - *Result = Blip01Diff2(Argument); - break; - case 3L: - *Result = Blip03Diff2(Argument); - break; - default: - Status = ERROR; - WRITE_ERROR(BlipDiff2, "Invalid blip degree") - break; - } -/**/DEBUG_WRITE_LEAVING(BlipDiff2, "Done") - return(Status); -} /* end BlipDiff2 */ - -/*--------------------------------------------------------------------------*/ -extern double Blip00Diff2 - ( - double Argument /* input */ - ) - -/* returns the value of the second derivative of a Blu interpolant function - of degree 0 (order 1) evaluated at Argument */ - -{ /* begin Blip00Diff2 */ - -/**/DEBUG_WRITE_ENTERING(Blip00Diff2, -/**/ "About to compute the second derivative of a blip of degree 0") - - if (fabs(Argument) == 0.5) { - WRITE_ERROR(Blip00Diff2, "Undefined value at |Argument| == 0.5") -/**/ DEBUG_WRITE_LEAVING(Blip00Diff2, "Done") - return(HUGE_VAL); - } - else { -/**/ DEBUG_WRITE_LEAVING(Blip00Diff2, "Done") - return(0.0); - } -} /* end Blip00Diff2 */ - -/*--------------------------------------------------------------------------*/ -extern double Blip01Diff2 - ( - double Argument /* input */ - ) - -/* returns the value of the second derivative of a Blu interpolant function - of degree 1 (order 2) evaluated at Argument */ - -{ /* begin Blip01Diff2 */ - -/**/DEBUG_WRITE_ENTERING(Blip01Diff2, -/**/ "About to compute the second derivative of a blip of degree 1") - - if (Argument == 0.0) { - WRITE_ERROR(Blip01Diff2, "Undefined value at Argument == 0.0") -/**/ DEBUG_WRITE_LEAVING(Blip01Diff2, "Done") - return(-HUGE_VAL); - } - else if (fabs(Argument) == 1.0) { - WRITE_ERROR(Blip01Diff2, "Undefined value at |Argument| == 1.0") -/**/ DEBUG_WRITE_LEAVING(Blip01Diff2, "Done") - return(HUGE_VAL); - } - else { -/**/ DEBUG_WRITE_LEAVING(Blip01Diff2, "Done") - return(0.0); - } -} /* end Blip01Diff2 */ - -/*--------------------------------------------------------------------------*/ -extern double Blip03Diff2 - ( - double Argument /* input */ - ) - -/* returns the value of the second derivative of a Blu interpolant function - of degree 3 (order 4) evaluated at Argument */ - -{ /* begin Blip03Diff2 */ - -/**/DEBUG_WRITE_ENTERING(Blip03Diff2, -/**/ "About to compute the second derivative of a blip of degree 3") - - Argument = fabs(Argument); - if (Argument == 0.0) { - WRITE_ERROR(Blip03Diff2, "Undefined value at |Argument| == 0.0") -/**/ DEBUG_WRITE_LEAVING(Blip03Diff2, "Done") - return(HUGE_VAL); - } - else if (Argument < 1.0) { -/**/ DEBUG_WRITE_LEAVING(Blip03Diff2, "Done") - return(Argument * 3.0 - 2.0); - } - else if (Argument == 1.0) { - WRITE_ERROR(Blip03Diff2, "Undefined value at |Argument| == 1.0") -/**/ DEBUG_WRITE_LEAVING(Blip03Diff2, "Done") - return(-HUGE_VAL); - } - else if (Argument < 2.0) { -/**/ DEBUG_WRITE_LEAVING(Blip03Diff2, "Done") - return(2.0 - Argument); - } - else if (Argument == 2.0) { - WRITE_ERROR(Blip03Diff2, "Undefined value at |Argument| == 2.0") -/**/ DEBUG_WRITE_LEAVING(Blip03Diff2, "Done") - return(HUGE_VAL); - } - else { -/**/ DEBUG_WRITE_LEAVING(Blip03Diff2, "Done") - return(0.0); - } -} /* end Blip03Diff2 */ - -/*--------------------------------------------------------------------------*/ -extern int BsplineDiff2 - ( - long Degree, /* degree */ - double Argument, /* input */ - double *Result /* output */ - ) - -/* computes the second derivative of a Basic spline function */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin BsplineDiff2 */ - - double Left, Center, Right; - int Status = !ERROR; - -/**/DEBUG_CHECK_RANGE_LONG(BsplineDiff2, Degree, 0L, LONG_MAX, Status, -/**/ "Invalid degree (should be positive)") -/**/DEBUG_CHECK_NULL_POINTER(BsplineDiff2, Result, Status, -/**/ "No output data") -/**/DEBUG_RETURN_ON_ERROR(BsplineDiff2, Status) -/**/DEBUG_WRITE_ENTERING(BsplineDiff2, -/**/ "About to compute the second derivative of a generic B-spline") - - switch (Degree) { - case 0L: - *Result = Bspline00Diff2(Argument); - break; - case 1L: - *Result = Bspline01Diff2(Argument); - break; - case 2L: - *Result = Bspline02Diff2(Argument); - break; - case 3L: - *Result = Bspline03Diff2(Argument); - break; - case 4L: - *Result = Bspline04Diff2(Argument); - break; - case 5L: - *Result = Bspline05Diff2(Argument); - break; - case 6L: - *Result = Bspline06Diff2(Argument); - break; - case 7L: - *Result = Bspline07Diff2(Argument); - break; - case 8L: - *Result = Bspline08Diff2(Argument); - break; - case 9L: - *Result = Bspline09Diff2(Argument); - break; - case 10L: - *Result = Bspline10Diff2(Argument); - break; - case 11L: - *Result = Bspline11Diff2(Argument); - break; - default: - Status = Bspline(Degree - 2L, Argument - 1.0, &Left); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(BsplineDiff2, "Done") - return(Status); - } - Status = Bspline(Degree - 2L, Argument, &Center); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(BsplineDiff2, "Done") - return(Status); - } - Status = Bspline(Degree - 2L, Argument + 1.0, &Right); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(BsplineDiff2, "Done") - return(Status); - } - *Result = Right - 2.0 * Center + Left; - break; - } -/**/DEBUG_WRITE_LEAVING(BsplineDiff2, "Done") - return(Status); -} /* end BsplineDiff2 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline00Diff2 - ( - double Argument /* input */ - ) - -/* returns the value of the second derivative of a Basic spline function - of degree 0 (order 1) evaluated at Argument */ - -{ /* begin Bspline00Diff2 */ - -/**/DEBUG_WRITE_ENTERING(Bspline00Diff2, -/**/ "About to compute the second derivative of a B-spline of degree 0") - - if (fabs(Argument) == 0.5) { - WRITE_ERROR(Bspline00Diff2, "Undefined value at |Argument| == 0.5") -/**/ DEBUG_WRITE_LEAVING(Bspline00Diff2, "Done") - return(HUGE_VAL); - } - else { -/**/ DEBUG_WRITE_LEAVING(Bspline00Diff2, "Done") - return(0.0); - } -} /* end Bspline00Diff2 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline01Diff2 - ( - double Argument /* input */ - ) - -/* returns the value of the second derivative of a Basic spline function - of degree 1 (order 2) evaluated at Argument */ - -{ /* begin Bspline01Diff2 */ - -/**/DEBUG_WRITE_ENTERING(Bspline01Diff2, -/**/ "About to compute the second derivative of a B-spline of degree 1") - - if (Argument == 0.0) { - WRITE_ERROR(Bspline01Diff2, "Undefined value at Argument == 0.0") -/**/ DEBUG_WRITE_LEAVING(Bspline01Diff2, "Done") - return(-HUGE_VAL); - } - else if (fabs(Argument) == 1.0) { - WRITE_ERROR(Bspline01Diff2, "Undefined value at |Argument| == 1.0") -/**/ DEBUG_WRITE_LEAVING(Bspline01Diff2, "Done") - return(HUGE_VAL); - } - else { -/**/ DEBUG_WRITE_LEAVING(Bspline01Diff2, "Done") - return(0.0); - } -} /* end Bspline01Diff2 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline02Diff2 - ( - double Argument /* input */ - ) - -/* returns the value of the second derivative of a Basic spline function - of degree 2 (order 3) evaluated at Argument */ - -{ /* begin Bspline02Diff2 */ - -/**/DEBUG_WRITE_ENTERING(Bspline02Diff2, -/**/ "About to compute the second derivative of a B-spline of degree 2") - - Argument = fabs(Argument); - if (Argument < 0.5) { -/**/ DEBUG_WRITE_LEAVING(Bspline02Diff2, "Done") - return(-2.0); - } - else if (Argument == 0.5) { -/**/ DEBUG_WRITE_LEAVING(Bspline02Diff2, "Done") - return(-1.0 / 2.0); - } - else if (Argument < 1.5) { -/**/ DEBUG_WRITE_LEAVING(Bspline02Diff2, "Done") - return(1.0); - } - else if (Argument == 1.5) { -/**/ DEBUG_WRITE_LEAVING(Bspline02Diff2, "Done") - return(1.0 / 2.0); - } - else { -/**/ DEBUG_WRITE_LEAVING(Bspline02Diff2, "Done") - return(0.0); - } -} /* end Bspline02Diff2 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline03Diff2 - ( - double Argument /* input */ - ) - -/* returns the value of the second derivative of a Basic spline function - of degree 3 (order 4) evaluated at Argument */ - -{ /* begin Bspline03Diff2 */ - -/**/DEBUG_WRITE_ENTERING(Bspline03Diff2, -/**/ "About to compute the second derivative of a B-spline of degree 3") - - Argument = fabs(Argument); - if (Argument < 1.0) { -/**/ DEBUG_WRITE_LEAVING(Bspline03Diff2, "Done") - return(Argument * 3.0 - 2.0); - } - else if (Argument < 2.0) { -/**/ DEBUG_WRITE_LEAVING(Bspline03Diff2, "Done") - return(2.0 - Argument); - } - else { -/**/ DEBUG_WRITE_LEAVING(Bspline03Diff2, "Done") - return(0.0); - } -} /* end Bspline03Diff2 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline04Diff2 - ( - double Argument /* input */ - ) - -/* returns the value of the second derivative of a Basic spline function - of degree 4 (order 5) evaluated at Argument */ - -{ /* begin Bspline04Diff2 */ - -/**/DEBUG_WRITE_ENTERING(Bspline04Diff2, -/**/ "About to compute the second derivative of a B-spline of degree 4") - - Argument = fabs(Argument); - if (Argument < 0.5) { -/**/ DEBUG_WRITE_LEAVING(Bspline04Diff2, "Done") - return(Argument * Argument * 3.0 - 5.0 / 4.0); - } - else if (Argument < 1.5) { -/**/ DEBUG_WRITE_LEAVING(Bspline04Diff2, "Done") - return(Argument * (5.0 - Argument * 2.0) - 5.0 / 2.0); - } - else if (Argument < 2.5) { - Argument -= 5.0 / 2.0; -/**/ DEBUG_WRITE_LEAVING(Bspline04Diff2, "Done") - return(Argument * Argument * (1.0 / 2.0)); - } - else { -/**/ DEBUG_WRITE_LEAVING(Bspline04Diff2, "Done") - return(0.0); - } -} /* end Bspline04Diff2 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline05Diff2 - ( - double Argument /* input */ - ) - -/* returns the value of the second derivative of a Basic spline function - of degree 5 (order 6) evaluated at Argument */ - -{ /* begin Bspline05Diff2 */ - -/**/DEBUG_WRITE_ENTERING(Bspline05Diff2, -/**/ "About to compute the second derivative of a B-spline of degree 5") - - Argument = fabs(Argument); - if (Argument < 1.0) { -/**/ DEBUG_WRITE_LEAVING(Bspline05Diff2, "Done") - return(Argument * Argument * (3.0 - Argument * (5.0 / 3.0)) - 1.0); - } - else if (Argument < 2.0) { -/**/ DEBUG_WRITE_LEAVING(Bspline05Diff2, "Done") - return(Argument * (Argument * (Argument * (5.0 / 6.0) - 9.0 / 2.0) - + 15.0 / 2.0) - 7.0 / 2.0); - } - else if (Argument < 3.0) { - Argument -= 3.0; -/**/ DEBUG_WRITE_LEAVING(Bspline05Diff2, "Done") - return(Argument * Argument * Argument * (-1.0 / 6.0)); - } - else { -/**/ DEBUG_WRITE_LEAVING(Bspline05Diff2, "Done") - return(0.0); - } -} /* end Bspline05Diff2 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline06Diff2 - ( - double Argument /* input */ - ) - -/* returns the value of the second derivative of a Basic spline function - of degree 6 (order 7) evaluated at Argument */ - -{ /* begin Bspline06Diff2 */ - -/**/DEBUG_WRITE_ENTERING(Bspline06Diff2, -/**/ "About to compute the second derivative of a B-spline of degree 6") - - Argument = fabs(Argument); - if (Argument < 0.5) { - Argument *= Argument; -/**/ DEBUG_WRITE_LEAVING(Bspline06Diff2, "Done") - return(Argument * (7.0 / 4.0 - Argument * (5.0 / 6.0)) - 77.0 / 96.0); - } - else if (Argument < 1.5) { -/**/ DEBUG_WRITE_LEAVING(Bspline06Diff2, "Done") - return(Argument * (Argument * (Argument * (Argument * 5.0 / 8.0 - - 35.0 / 12.0) + 63.0 / 16.0) - 35.0 / 48.0) - 91.0 / 128.0); - } - else if (Argument < 2.5) { -/**/ DEBUG_WRITE_LEAVING(Bspline06Diff2, "Done") - return(Argument * (Argument * (Argument * (7.0 / 3.0 - Argument * (1.0 / 4.0)) - - 63.0 / 8.0) + 133.0 / 12.0) - 329.0 / 64.0); - } - else if (Argument < 3.5) { - Argument -= 7.0 / 2.0; - Argument *= Argument; -/**/ DEBUG_WRITE_LEAVING(Bspline06Diff2, "Done") - return(Argument * Argument * (1.0 / 24.0)); - } - else { -/**/ DEBUG_WRITE_LEAVING(Bspline06Diff2, "Done") - return(0.0); - } -} /* end Bspline06Diff2 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline07Diff2 - ( - double Argument /* input */ - ) - -/* returns the value of the second derivative of a Basic spline function - of degree 7 (order 8) evaluated at Argument */ - -{ /* begin Bspline07Diff2 */ - - double a2; - -/**/DEBUG_WRITE_ENTERING(Bspline07Diff2, -/**/ "About to compute the second derivative of a B-spline of degree 7") - - Argument = fabs(Argument); - if (Argument < 1.0) { - a2 = Argument * Argument; -/**/ DEBUG_WRITE_LEAVING(Bspline07Diff2, "Done") - return(a2 * (a2 * (Argument * (7.0 / 24.0) - 5.0 / 6.0) + 4.0 / 3.0) - - 2.0 / 3.0); - } - else if (Argument < 2.0) { -/**/ DEBUG_WRITE_LEAVING(Bspline07Diff2, "Done") - return(Argument * (Argument * (Argument * (Argument * (3.0 / 2.0 - - Argument * (7.0 / 40.0)) - 14.0 / 3.0) + 6.0) - 7.0 / 3.0) - 1.0 / 5.0); - } - else if (Argument < 3.0) { -/**/ DEBUG_WRITE_LEAVING(Bspline07Diff2, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (7.0 / 120.0) - - 5.0 / 6.0) + 14.0 / 3.0) - 38.0 / 3.0) + 49.0 / 3.0) - 23.0 / 3.0); - } - else if (Argument < 4.0) { - Argument -= 4.0; - a2 = Argument * Argument; -/**/ DEBUG_WRITE_LEAVING(Bspline07Diff2, "Done") - return(Argument * a2 * a2 * (-1.0 / 120.0)); - } - else { -/**/ DEBUG_WRITE_LEAVING(Bspline07Diff2, "Done") - return(0.0); - } -} /* end Bspline07Diff2 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline08Diff2 - ( - double Argument /* input */ - ) - -/* returns the value of the second derivative of a Basic spline function - of degree 8 (order 9) evaluated at Argument */ - -{ /* begin Bspline08Diff2 */ - -/**/DEBUG_WRITE_ENTERING(Bspline08Diff2, -/**/ "About to compute the second derivative of a B-spline of degree 8") - - Argument = fabs(Argument); - if (Argument < 0.5) { - Argument *= Argument; -/**/ DEBUG_WRITE_LEAVING(Bspline08Diff2, "Done") - return(Argument * (Argument * (Argument * (7.0 / 72.0) - 15.0 / 32.0) - + 129.0 / 128.0) - 289.0 / 512.0); - } - else if (Argument < 1.5) { -/**/ DEBUG_WRITE_LEAVING(Bspline08Diff2, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (21.0 / 40.0 - - Argument * (7.0 / 90.0)) - 9.0 / 8.0) + 7.0 / 16.0) + 27.0 / 32.0) - + 21.0 / 640.0) - 363.0 / 640.0); - } - else if (Argument < 2.5) { -/**/ DEBUG_WRITE_LEAVING(Bspline08Diff2, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (7.0 / 180.0) - 21.0 / 40.0) + 45.0 / 16.0) - 119.0 / 16.0) - + 621.0 / 64.0) - 3381.0 / 640.0) + 195.0 / 256.0); - } - else if (Argument < 3.5) { -/**/ DEBUG_WRITE_LEAVING(Bspline08Diff2, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (9.0 / 40.0 - - Argument * (1.0 / 90.0)) - 15.0 / 8.0) + 131.0 / 16.0) - 627.0 / 32.0) - + 15369.0 / 640.0) - 1465.0 / 128.0); - } - else if (Argument < 4.5) { - Argument -= 9.0 / 2.0; - Argument *= Argument * Argument; -/**/ DEBUG_WRITE_LEAVING(Bspline08Diff2, "Done") - return(Argument * Argument * (1.0 / 720.0)); - } - else { -/**/ DEBUG_WRITE_LEAVING(Bspline08Diff2, "Done") - return(0.0); - } -} /* end Bspline08Diff2 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline09Diff2 - ( - double Argument /* input */ - ) - -/* returns the value of the second derivative of a Basic spline function - of degree 9 (order 10) evaluated at Argument */ - -{ /* begin Bspline09Diff2 */ - - double a2; - -/**/DEBUG_WRITE_ENTERING(Bspline09Diff2, -/**/ "About to compute the second derivative of a B-spline of degree 9") - - Argument = fabs(Argument); - if (Argument < 1.0) { - a2 = Argument * Argument; -/**/ DEBUG_WRITE_LEAVING(Bspline09Diff2, "Done") - return(a2 * (a2 * (a2 * (7.0 / 72.0 - Argument * (1.0 / 40.0)) - - 25.0 / 72.0) + 19.0 / 24.0) - 35.0 / 72.0); - } - else if (Argument < 2.0) { -/**/ DEBUG_WRITE_LEAVING(Bspline09Diff2, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (1.0 / 60.0) - 7.0 / 36.0) + 7.0 / 8.0) - 65.0 / 36.0) - + 35.0 / 24.0) - 1.0 / 12.0) + 7.0 / 24.0) - 19.0 / 36.0); - } - else if (Argument < 3.0) { -/**/ DEBUG_WRITE_LEAVING(Bspline09Diff2, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (5.0 / 36.0 - Argument * (1.0 / 140.0)) - 9.0 / 8.0) + 175.0 / 36.0) - - 95.0 / 8.0) + 191.0 / 12.0) - 83.0 / 8.0) + 635.0 / 252.0); - } - else if (Argument < 4.0) { -/**/ DEBUG_WRITE_LEAVING(Bspline09Diff2, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (1.0 / 560.0) - 7.0 / 144.0) + 9.0 / 16.0) - 515.0 / 144.0) - + 215.0 / 16.0) - 1423.0 / 48.0) + 563.0 / 16.0) - 2449.0 / 144.0); - } - else if (Argument < 5.0) { - Argument -= 5.0; - a2 = Argument * Argument * Argument; -/**/ DEBUG_WRITE_LEAVING(Bspline09Diff2, "Done") - return(Argument * a2 * a2 * (-1.0 / 5040.0)); - } - else { -/**/ DEBUG_WRITE_LEAVING(Bspline09Diff2, "Done") - return(0.0); - } -} /* end Bspline09Diff2 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline10Diff2 - ( - double Argument /* input */ - ) - -/* returns the value of the second derivative of a Basic spline function - of degree 10 (order 11) evaluated at Argument */ - -{ /* begin Bspline10Diff2 */ - -/**/DEBUG_WRITE_ENTERING(Bspline10Diff2, -/**/ "About to compute the second derivative of a B-spline of degree 10") - - Argument = fabs(Argument); - if (Argument < 0.5) { - Argument *= Argument; -/**/ DEBUG_WRITE_LEAVING(Bspline10Diff2, "Done") - return(Argument * (Argument * (Argument * (77.0 / 1440.0 - Argument - * (1.0 / 160.0)) - 583.0 / 2304.0) + 14597.0 / 23040.0) - - 156409.0 / 368640.0); - } - else if (Argument < 1.5) { -/**/ DEBUG_WRITE_LEAVING(Bspline10Diff2, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (1.0 / 192.0) - 11.0 / 240.0) + 77.0 / 576.0) - - 77.0 / 960.0) - 935.0 / 4608.0) - 77.0 / 3840.0) + 5885.0 / 9216.0) - - 11.0 / 15360.0) - 62557.0 / 147456.0); - } - else if (Argument < 2.5) { -/**/ DEBUG_WRITE_LEAVING(Bspline10Diff2, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (11.0 / 210.0 - Argument * (1.0 / 336.0)) - 55.0 / 144.0) - + 22.0 / 15.0) - 3575.0 / 1152.0) + 1661.0 / 480.0) - 4543.0 / 2304.0) - + 7513.0 / 6720.0) - 163603.0 / 258048.0); - } - else if (Argument < 3.5) { -/**/ DEBUG_WRITE_LEAVING(Bspline10Diff2, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (1.0 / 896.0) - 33.0 / 1120.0) - + 385.0 / 1152.0) - 1353.0 / 640.0) + 74525.0 / 9216.0) - 48433.0 / 2560.0) - + 479281.0 / 18432.0) - 1352153.0 / 71680.0) + 1654543.0 / 294912.0); - } - else if (Argument < 4.5) { -/**/ DEBUG_WRITE_LEAVING(Bspline10Diff2, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (11.0 / 1260.0 - Argument * (1.0 / 4032.0)) - 77.0 / 576.0) - + 209.0 / 180.0) - 28765.0 / 4608.0) + 61061.0 / 2880.0) - 407429.0 / 9216.0) - + 2070343.0 / 40320.0) - 3702215.0 / 147456.0); - } - else if (Argument < 5.5) { - Argument -= 11.0 / 2.0; - Argument *= Argument; - Argument *= Argument; -/**/ DEBUG_WRITE_LEAVING(Bspline10Diff2, "Done") - return(Argument * Argument * (1.0 / 40320.0)); - } - else { -/**/ DEBUG_WRITE_LEAVING(Bspline10Diff2, "Done") - return(0.0); - } -} /* end Bspline10Diff2 */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline11Diff2 - ( - double Argument /* input */ - ) - -/* returns the value of the second derivative of a Basic spline function - of degree 11 (order 12) evaluated at Argument */ - -{ /* begin Bspline11Diff2 */ - - double a2; - -/**/DEBUG_WRITE_ENTERING(Bspline11Diff2, -/**/ "About to compute the second derivative of a B-spline of degree 11") - - Argument = fabs(Argument); - if (Argument < 1.0) { - a2 = Argument * Argument; -/**/ DEBUG_WRITE_LEAVING(Bspline11Diff2, "Done") - return(a2 * (a2 * (a2 * (a2 * (Argument * (11.0 / 8640.0) - 1.0 / 160.0) - + 7.0 / 180.0) - 23.0 / 120.0) + 31.0 / 60.0) - 809.0 / 2160.0); - } - else if (Argument < 2.0) { -/**/ DEBUG_WRITE_LEAVING(Bspline11Diff2, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (3.0 / 224.0 - Argument * (11.0 / 12096.0)) - - 11.0 / 140.0) + 2.0 / 9.0) - 11.0 / 40.0) + 1.0 / 12.0) - 11.0 / 60.0) - + 25.0 / 42.0) - 11.0 / 560.0) - 563.0 / 1512.0); - } - else if (Argument < 3.0) { -/**/ DEBUG_WRITE_LEAVING(Bspline11Diff2, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (Argument * (11.0 / 24192.0) - 5.0 / 448.0) - + 33.0 / 280.0) - 25.0 / 36.0) + 99.0 / 40.0) - 65.0 / 12.0) + 143.0 / 20.0) - - 239.0 / 42.0) + 1749.0 / 560.0) - 1619.0 / 1512.0); - } - else if (Argument < 4.0) { -/**/ DEBUG_WRITE_LEAVING(Bspline11Diff2, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (1.0 / 192.0 - Argument * (11.0 / 72576.0)) - - 11.0 / 140.0) + 49.0 / 72.0) - 297.0 / 80.0) + 631.0 / 48.0) - - 1199.0 / 40.0) + 1009.0 / 24.0) - 36597.0 / 1120.0) + 9385.0 / 864.0); - } - else if (Argument < 5.0) { -/**/ DEBUG_WRITE_LEAVING(Bspline11Diff2, "Done") - return(Argument * (Argument * (Argument * (Argument * (Argument * (Argument - * (Argument * (Argument * (Argument * (11.0 / 362880.0) - 3.0 / 2240.0) - + 11.0 / 420.0) - 107.0 / 360.0) + 517.0 / 240.0) - 2477.0 / 240.0) - + 11737.0 / 360.0) - 54797.0 / 840.0) + 250657.0 / 3360.0) - 1113317.0 / 30240.0); - } - else if (Argument < 6.0) { - Argument -= 6.0; - a2 = Argument * Argument; - a2 *= a2; - a2 *= a2; -/**/ DEBUG_WRITE_LEAVING(Bspline11Diff2, "Done") - return(Argument * a2 * (-1.0 / 362880.0)); - } - else { -/**/ DEBUG_WRITE_LEAVING(Bspline11Diff2, "Done") - return(0.0); - } -} /* end Bspline11Diff2 */ - -/*--------------------------------------------------------------------------*/ -extern double DodgsonDiff2 - ( - double Argument /* input */ - ) - -/* returns the value of the second derivative of a Dodgson kernel - (order 2) evaluated at Argument */ - -{ /* begin DodgsonDiff2 */ - -/**/DEBUG_WRITE_ENTERING(DodgsonDiff2, -/**/ "About to compute the second derivative of a Dodgson kernel") - - Argument = fabs(Argument); - if (Argument < 0.5) { -/**/ DEBUG_WRITE_LEAVING(DodgsonDiff2, "Done") - return(-4.0); - } - else if (Argument == 0.5) { - WRITE_ERROR(DodgsonDiff2, "Undefined value at Argument == 0.5") -/**/ DEBUG_WRITE_LEAVING(DodgsonDiff2, "Done") - return(-HUGE_VAL); - } - else if (Argument < 1.5) { -/**/ DEBUG_WRITE_LEAVING(DodgsonDiff2, "Done") - return(2.0); - } - else if (fabs(Argument) == 1.5) { - WRITE_ERROR(DodgsonDiff2, "Undefined value at |Argument| == 1.5") -/**/ DEBUG_WRITE_LEAVING(DodgsonDiff2, "Done") - return(HUGE_VAL); - } - else { -/**/ DEBUG_WRITE_LEAVING(DodgsonDiff2, "Done") - return(0.0); - } -} /* end DodgsonDiff2 */ - -/*--------------------------------------------------------------------------*/ -extern double German04Diff2 - ( - double Argument /* input */ - ) - -/* returns the value of the second derivative of a German function - of degree 4 (order 5) evaluated at Argument */ - -{ /* begin German04Diff2 */ - -/**/DEBUG_WRITE_ENTERING(German04Diff2, -/**/ "About to compute the second derivative of a German of degree 4") - - Argument = fabs(Argument); - if (Argument < 1.0) { -/**/ DEBUG_WRITE_LEAVING(German04Diff2, "Done") - return(Argument * (Argument * (1.0 / 2.0) + 185.0 / 24.0) - 335.0 / 72.0); - } - else if (Argument == 1.0) { -/**/ DEBUG_WRITE_LEAVING(German04Diff2, "Done") - return(421.0 / 144.0); - } - else if (Argument < 2.0) { -/**/ DEBUG_WRITE_LEAVING(German04Diff2, "Done") - return(Argument * (-29.0 / 24.0 - Argument * (3.0 / 4.0)) + 17.0 / 4.0); - } - else if (Argument == 2.0) { -/**/ DEBUG_WRITE_LEAVING(German04Diff2, "Done") - return(-49.0 / 72.0); - } - else if (Argument < 3.0) { -/**/ DEBUG_WRITE_LEAVING(German04Diff2, "Done") - return(Argument * (Argument * (1.0 / 4.0) - 7.0 / 8.0) + 5.0 / 9.0); - } - else if (Argument == 3.0) { -/**/ DEBUG_WRITE_LEAVING(German04Diff2, "Done") - return(11.0 / 144.0); - } - else if (Argument < 4.0) { -/**/ DEBUG_WRITE_LEAVING(German04Diff2, "Done") - return(Argument * (1.0 / 24.0) - 11.0 / 72.0); - } - else if (Argument == 4.0) { -/**/ DEBUG_WRITE_LEAVING(German04Diff2, "Done") - return(1.0 / 144.0); - } - else { -/**/ DEBUG_WRITE_LEAVING(German04Diff2, "Done") - return(0.0); - } -} /* end German04Diff2 */ - -/*--------------------------------------------------------------------------*/ -extern double KeysOptimalDiff2 - ( - double Argument /* input */ - ) - -/* returns the value of the second derivative of the cubic Keys optimal kernel - (order 3) evaluated at Argument */ - -{ /* begin KeysOptimalDiff2 */ - -/**/DEBUG_WRITE_ENTERING(KeysOptimalDiff2, -/**/ "About to compute the second derivative of a Keys kernel") - - Argument = fabs(Argument); - if (Argument < 1.0) { -/**/ DEBUG_WRITE_LEAVING(KeysOptimalDiff2, "Done") - return(Argument * 9.0 - 5.0); - } - else if (Argument == 1.0) { -/**/ DEBUG_WRITE_LEAVING(KeysOptimalDiff2, "Done") - return(3.0); - } - else if (Argument < 2.0) { -/**/ DEBUG_WRITE_LEAVING(KeysOptimalDiff2, "Done") - return(5.0 - Argument * 3.0); - } - else if (Argument == 2.0) { -/**/ DEBUG_WRITE_LEAVING(KeysOptimalDiff2, "Done") - return(-1.0 / 2.0); - } - else { -/**/ DEBUG_WRITE_LEAVING(KeysOptimalDiff2, "Done") - return(0.0); - } -} /* end KeysOptimalDiff2 */ - -/*--------------------------------------------------------------------------*/ -extern int OmomsDiff2 - ( - long Degree, /* degree */ - double Argument, /* input */ - double *Result /* output */ - ) - -/* computes the second derivative of a Blu optimum function */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin OmomsDiff2 */ - - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(OmomsDiff2, Result, Status, -/**/ "No output data") -/**/DEBUG_RETURN_ON_ERROR(OmomsDiff2, Status) -/**/DEBUG_WRITE_ENTERING(OmomsDiff2, -/**/ "About to compute the second derivative of a generic oMoms") - - switch (Degree) { - case 0L: - *Result = Omoms00Diff2(Argument); - break; - case 1L: - *Result = Omoms01Diff2(Argument); - break; - case 3L: - *Result = Omoms03Diff2(Argument); - break; - default: - Status = ERROR; - WRITE_ERROR(OmomsDiff2, "Invalid oMoms degree") - break; - } -/**/DEBUG_WRITE_LEAVING(OmomsDiff2, "Done") - return(Status); -} /* end OmomsDiff2 */ - -/*--------------------------------------------------------------------------*/ -extern double Omoms00Diff2 - ( - double Argument /* input */ - ) - -/* returns the value of the second derivative of a Blu optimum function - of degree 0 (order 1) evaluated at Argument */ - -{ /* begin Omoms00Diff2 */ - -/**/DEBUG_WRITE_ENTERING(Omoms00Diff2, -/**/ "About to compute the second derivative of an oMoms of degree 0") - - if (fabs(Argument) == 0.5) { - WRITE_ERROR(Omoms00Diff2, "Undefined value at |Argument| == 0.5") -/**/ DEBUG_WRITE_LEAVING(Omoms00Diff2, "Done") - return(HUGE_VAL); - } - else { -/**/ DEBUG_WRITE_LEAVING(Omoms00Diff2, "Done") - return(0.0); - } -} /* end Omoms00Diff2 */ - -/*--------------------------------------------------------------------------*/ -extern double Omoms01Diff2 - ( - double Argument /* input */ - ) - -/* returns the value of the second derivative of a Blu optimum function - of degree 1 (order 2) evaluated at Argument */ - -{ /* begin Omoms01Diff2 */ - -/**/DEBUG_WRITE_ENTERING(Omoms01Diff2, -/**/ "About to compute the second derivative of an oMoms of degree 1") - - if (Argument == 0.0) { - WRITE_ERROR(Omoms01Diff2, "Undefined value at Argument == 0.0") -/**/ DEBUG_WRITE_LEAVING(Omoms01Diff2, "Done") - return(-HUGE_VAL); - } - else if (fabs(Argument) == 1.0) { - WRITE_ERROR(Omoms01Diff2, "Undefined value at |Argument| == 1.0") -/**/ DEBUG_WRITE_LEAVING(Omoms01Diff2, "Done") - return(HUGE_VAL); - } - else { -/**/ DEBUG_WRITE_LEAVING(Omoms01Diff2, "Done") - return(0.0); - } -} /* end Omoms01Diff2 */ - -/*--------------------------------------------------------------------------*/ -extern double Omoms02Diff2 - ( - double Argument /* input */ - ) - -/* returns the value of the second derivative of a Blu optimum function - of degree 2 (order 3) evaluated at Argument */ - -{ /* begin Omoms02Diff2 */ - -/**/DEBUG_WRITE_ENTERING(Omoms02Diff2, -/**/ "About to compute the second derivative of an oMoms of degree 2") - - Argument = fabs(Argument); - if (Argument < 0.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms02Diff2, "Done") - return(-2.0); - } - else if (Argument == 0.5) { - WRITE_ERROR(Omoms02Diff2, "Undefined value at |Argument| == 0.5") -/**/ DEBUG_WRITE_LEAVING(Omoms02Diff2, "Done") - return(HUGE_VAL); - } - else if (Argument < 1.5) { -/**/ DEBUG_WRITE_LEAVING(Omoms02Diff2, "Done") - return(1.0); - } - else if (Argument == 1.5) { - WRITE_ERROR(Omoms02Diff2, "Undefined value at |Argument| == 1.5") -/**/ DEBUG_WRITE_LEAVING(Omoms02Diff2, "Done") - return(HUGE_VAL); - } - else { -/**/ DEBUG_WRITE_LEAVING(Omoms02Diff2, "Done") - return(0.0); - } -} /* end Omoms02Diff2 */ - -/*--------------------------------------------------------------------------*/ -extern double Omoms03Diff2 - ( - double Argument /* input */ - ) - -/* returns the value of the second derivative of a Blu optimum function - of degree 3 (order 4) evaluated at Argument */ - -{ /* begin Omoms03Diff2 */ - -/**/DEBUG_WRITE_ENTERING(Omoms03Diff2, -/**/ "About to compute the second derivative of an oMoms of degree 3") - - Argument = fabs(Argument); - if (Argument == 0.0) { - WRITE_ERROR(Omoms03Diff2, "Undefined value at |Argument| == 0.0") -/**/ DEBUG_WRITE_LEAVING(Omoms03Diff2, "Done") - return(HUGE_VAL); - } - else if (Argument < 1.0) { -/**/ DEBUG_WRITE_LEAVING(Omoms03Diff2, "Done") - return(Argument * 3.0 - 2.0); - } - else if (Argument == 1.0) { - WRITE_ERROR(Omoms03Diff2, "Undefined value at |Argument| == 1.0") -/**/ DEBUG_WRITE_LEAVING(Omoms03Diff2, "Done") - return(-HUGE_VAL); - } - else if (Argument < 2.0) { -/**/ DEBUG_WRITE_LEAVING(Omoms03Diff2, "Done") - return(2.0 - Argument); - } - else if (Argument == 2.0) { - WRITE_ERROR(Omoms03Diff2, "Undefined value at |Argument| == 2.0") -/**/ DEBUG_WRITE_LEAVING(Omoms03Diff2, "Done") - return(HUGE_VAL); - } - else { -/**/ DEBUG_WRITE_LEAVING(Omoms03Diff2, "Done") - return(0.0); - } -} /* end Omoms03Diff2 */ - -/*--------------------------------------------------------------------------*/ -extern double PositiveDiff2 - ( - double Argument /* input */ - ) - -/* returns the value of the second derivative of a Positive function - of degree 3 (order 1) evaluated at Argument */ - -{ /* begin PositiveDiff2 */ - -/**/DEBUG_WRITE_ENTERING(PositiveDiff2, -/**/ "About to compute the second derivative of Positive of degree 3") - - Argument = fabs(Argument); - if (Argument < 0.5) { -/**/ DEBUG_WRITE_LEAVING(PositiveDiff2, "Done") - return(Argument * 24.0 - 9.0); - } - else if (Argument < 1.0) { -/**/ DEBUG_WRITE_LEAVING(PositiveDiff2, "Done") - return(3.0); - } - else if (Argument < 1.5) { -/**/ DEBUG_WRITE_LEAVING(PositiveDiff2, "Done") - return(15.0 - Argument * 12.0); - } - else if (Argument < 2.0) { -/**/ DEBUG_WRITE_LEAVING(PositiveDiff2, "Done") - return(Argument * 12.0 - 21.0); - } - else if (Argument == 2.0) { -/**/ DEBUG_WRITE_LEAVING(PositiveDiff2, "Done") - return(3.0 / 2.0); - } - else { -/**/ DEBUG_WRITE_LEAVING(PositiveDiff2, "Done") - return(0.0); - } -} /* end PositiveDiff2 */ - -/*--------------------------------------------------------------------------*/ -extern double SincDiff2 - ( - double Argument /* input */ - ) - -/* returns the value of the second derivative of the sinc kernel evaluated at Argument */ - -{ /* begin SincDiff2 */ - -/**/DEBUG_WRITE_ENTERING(SincDiff2, -/**/ "About to compute the second derivative of a sinc kernel") - - if (Argument == 0.0) { - return((-1.0 / 3.0) * PI * PI); -/**/ DEBUG_WRITE_LEAVING(SincDiff2, "Done") - } - else { -/**/ DEBUG_WRITE_LEAVING(SincDiff2, "Done") - return(2.0 * (Sinc(Argument) * (1.0 - (1.0 / 2.0) * PI * PI * Argument * Argument) - - cos(PI * Argument)) / (Argument * Argument)); - } -} /* end SincDiff2 */ - diff --git a/src/core/bilib/kerneldiff2.h b/src/core/bilib/kerneldiff2.h deleted file mode 100644 index 4ad9669..0000000 --- a/src/core/bilib/kerneldiff2.h +++ /dev/null @@ -1,168 +0,0 @@ -/*--------------------------------------------------------------------------*/ -extern int BlipDiff2 - ( - long Degree, /* degree */ - double Argument, /* input */ - double *Result /* output */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Blip00Diff2 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Blip01Diff2 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Blip03Diff2 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern int BsplineDiff2 - ( - long Degree, /* degree */ - double Argument, /* input */ - double *Result /* output */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Bspline00Diff2 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Bspline01Diff2 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Bspline02Diff2 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Bspline03Diff2 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Bspline04Diff2 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Bspline05Diff2 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Bspline06Diff2 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Bspline07Diff2 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Bspline08Diff2 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Bspline09Diff2 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Bspline10Diff2 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Bspline11Diff2 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double DodgsonDiff2 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double German04Diff2 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double KeysOptimalDiff2 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern int OmomsDiff2 - ( - long Degree, /* degree */ - double Argument, /* input */ - double *Result /* output */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Omoms00Diff2 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Omoms01Diff2 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Omoms02Diff2 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double Omoms03Diff2 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double PositiveDiff2 - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -extern double SincDiff2 - ( - double Argument /* input */ - ); - diff --git a/src/core/bilib/kernelintegrate.cc b/src/core/bilib/kernelintegrate.cc deleted file mode 100644 index 8393779..0000000 --- a/src/core/bilib/kernelintegrate.cc +++ /dev/null @@ -1,1015 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -#include -#include - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" -#include "error.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "kernel.h" -#include "kernelintegrate.h" -#include "messagedisplay.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -#ifdef DEBUG -#include -#include -#endif - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern int BlipIntegrate - ( - long Degree, /* degree */ - double Argument, /* input */ - double *Result /* output */ - ) - -/* computes the integral(-Infinity, Argument) for a Blu interpolant function */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin BlipIntegrate */ - - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(BlipIntegrate, Result, Status, -/**/ "No output data") -/**/DEBUG_RETURN_ON_ERROR(BlipIntegrate, Status) -/**/DEBUG_WRITE_ENTERING(BlipIntegrate, -/**/ "About to integrate a generic blip") - - switch (Degree) { - case 0L: - *Result = Blip00Integrate(Argument); - break; - case 1L: - *Result = Blip01Integrate(Argument); - break; - case 3L: - *Result = Blip03Integrate(Argument); - break; - default: - Status = ERROR; - WRITE_ERROR(BlipIntegrate, "Invalid blip degree") - break; - } -/**/DEBUG_WRITE_LEAVING(BlipIntegrate, "Done") - return(Status); -} /* end BlipIntegrate */ - -/*--------------------------------------------------------------------------*/ -extern double Blip00Integrate - ( - double Argument /* input */ - ) - -/* returns the integral(-Infinity, Argument) for a Blu interpolant function - of degree 0 (order 1) */ - -{ /* begin Blip00Integrate */ - - double a; - -/**/DEBUG_WRITE_ENTERING(Blip00Integrate, -/**/ "About to integrate a blip of degree 0") - - a = fabs(Argument); - if (a < 0.5) { - a = a + 1.0 / 2.0; - } - else { - a = 1.0; - } -/**/DEBUG_WRITE_LEAVING(Blip00Integrate, "Done") - return((0.0 < Argument) ? (a) : (1.0 - a)); -} /* end Blip00Integrate */ - -/*--------------------------------------------------------------------------*/ -extern double Blip01Integrate - ( - double Argument /* input */ - ) - -/* returns the integral(-Infinity, Argument) for a Blu interpolant function - of degree 1 (order 2) */ - -{ /* begin Blip01Integrate */ - - double a; - -/**/DEBUG_WRITE_ENTERING(Blip01Integrate, -/**/ "About to integrate a blip of degree 1") - - a = fabs(Argument); - if (a < 1.0) { - a = a * (1.0 - a * (1.0 / 2.0)) + 1.0 / 2.0; - } - else { - a = 1.0; - } -/**/DEBUG_WRITE_LEAVING(Blip01Integrate, "Done") - return((0.0 < Argument) ? (a) : (1.0 - a)); -} /* end Blip01Integrate */ - -/*--------------------------------------------------------------------------*/ -extern double Blip03Integrate - ( - double Argument /* input */ - ) - -/* returns the integral(-Infinity, Argument) for a Blu interpolant function - of degree 3 (order 4) */ - -{ /* begin Blip03Integrate */ - - double a; - -/**/DEBUG_WRITE_ENTERING(Blip03Integrate, -/**/ "About to integrate a blip of degree 3") - - a = fabs(Argument); - if (a < 1.0) { - a = a * (a * (a * (a * (1.0 / 8.0) - 1.0 / 3.0) + 3.0 / 112.0) - + 53.0 / 84.0) + 1.0 / 2.0; - } - else if (a < 2.0) { - a = a * (a * (a * (1.0 / 3.0 - a * (1.0 / 24.0)) - 113.0 / 112.0) - + 115.0 / 84.0) + 25.0 / 84.0; - } - else { - a = 1.0; - } -/**/DEBUG_WRITE_LEAVING(Blip03Integrate, "Done") - return((0.0 < Argument) ? (a) : (1.0 - a)); -} /* end Blip03Integrate */ - -/*--------------------------------------------------------------------------*/ -extern int BsplineIntegrate - ( - long Degree, /* degree */ - double Argument, /* input */ - double *Result /* output */ - ) - -/* computes the integral(-Infinity, Argument) for a Basic spline function of degree Degree*/ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin BsplineIntegrate */ - - double B, C; - double HalfWidth; - long i; - int Status = !ERROR; - -/**/DEBUG_CHECK_RANGE_LONG(BsplineIntegrate, Degree, 0L, LONG_MAX, Status, -/**/ "Invalid degree (should be positive)") -/**/DEBUG_CHECK_NULL_POINTER(BsplineIntegrate, Result, Status, -/**/ "No output data") -/**/DEBUG_RETURN_ON_ERROR(BsplineIntegrate, Status) -/**/DEBUG_WRITE_ENTERING(BsplineIntegrate, -/**/ "About to integrate a generic B-spline") - - switch (Degree) { - case 0L: - *Result = Bspline00Integrate(Argument); - break; - case 1L: - *Result = Bspline01Integrate(Argument); - break; - case 2L: - *Result = Bspline02Integrate(Argument); - break; - case 3L: - *Result = Bspline03Integrate(Argument); - break; - case 4L: - *Result = Bspline04Integrate(Argument); - break; - case 5L: - *Result = Bspline05Integrate(Argument); - break; - case 6L: - *Result = Bspline06Integrate(Argument); - break; - case 7L: - *Result = Bspline07Integrate(Argument); - break; - case 8L: - *Result = Bspline08Integrate(Argument); - break; - case 9L: - *Result = Bspline09Integrate(Argument); - break; - case 10L: - *Result = Bspline10Integrate(Argument); - break; - case 11L: - *Result = Bspline11Integrate(Argument); - break; - default: - HalfWidth = 0.5 * (double)(Degree + 1L); - *Result = (HalfWidth < Argument) ? (0.0) - : ((Argument == HalfWidth) ? (0.5) : (1.0)); - C = Argument + HalfWidth; - for (i = 0L; (i <= Degree); i++) { - Status = Bspline(Degree - i, Argument, &B); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(BsplineIntegrate, "Done") - return(Status); - } - *Result += B * C / (double)(Degree + 1L - i); - C -= 1.0; - Argument -= 0.5; - } - break; - } -/**/DEBUG_WRITE_LEAVING(BsplineIntegrate, "Done") - return(Status); -} /* end BsplineIntegrate */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline00Integrate - ( - double Argument /* input */ - ) - -/* returns the integral(-Infinity, Argument) for a Basic spline function - of degree 0 (order 1) */ - -{ /* begin Bspline00Integrate */ - - double a; - -/**/DEBUG_WRITE_ENTERING(Bspline00Integrate, -/**/ "About to integrate a B-spline of degree 0") - - a = fabs(Argument); - if (a < 0.5) { - a = a + 1.0 / 2.0; - } - else { - a = 1.0; - } -/**/DEBUG_WRITE_LEAVING(Bspline00Integrate, "Done") - return((0.0 < Argument) ? (a) : (1.0 - a)); -} /* end Bspline00Integrate */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline01Integrate - ( - double Argument /* input */ - ) - -/* returns the integral(-Infinity, Argument) for a Basic spline function - of degree 1 (order 2) */ - -{ /* begin Bspline01Integrate */ - - double a; - -/**/DEBUG_WRITE_ENTERING(Bspline01Integrate, -/**/ "About to integrate a B-spline of degree 1") - - a = fabs(Argument); - if (a < 1.0) { - a = a * (1.0 - a * (1.0 / 2.0)) + 1.0 / 2.0; - } - else { - a = 1.0; - } -/**/DEBUG_WRITE_LEAVING(Bspline01Integrate, "Done") - return((0.0 < Argument) ? (a) : (1.0 - a)); -} /* end Bspline01Integrate */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline02Integrate - ( - double Argument /* input */ - ) - -/* returns the integral(-Infinity, Argument) for a Basic spline function - of degree 2 (order 3) */ - -{ /* begin Bspline02Integrate */ - - double a; - -/**/DEBUG_WRITE_ENTERING(Bspline02Integrate, -/**/ "About to integrate a B-spline of degree 2") - - a = fabs(Argument); - if (a < 0.5) { - a = a * (3.0 / 4.0 - a * a * (1.0 / 3.0)) + 1.0 / 2.0; - } - else if (a < 1.5) { - a = a * (a * (a * (1.0 / 6.0) - 3.0 / 4.0) + 9.0 / 8.0) + 7.0 / 16.0; - } - else { - a = 1.0; - } -/**/DEBUG_WRITE_LEAVING(Bspline02Integrate, "Done") - return((0.0 < Argument) ? (a) : (1.0 - a)); -} /* end Bspline02Integrate */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline03Integrate - ( - double Argument /* input */ - ) - -/* returns the integral(-Infinity, Argument) for a Basic spline function - of degree 3 (order 4) */ - -{ /* begin Bspline03Integrate */ - - double a; - -/**/DEBUG_WRITE_ENTERING(Bspline03Integrate, -/**/ "About to integrate a B-spline of degree 3") - - a = fabs(Argument); - if (a < 1.0) { - a = a * (a * (a * (a * (1.0 / 8.0) - 1.0 / 3.0)) + 2.0 / 3.0) + 1.0 / 2.0; - } - else if (a < 2.0) { - a = a * (a * (a * (1.0 / 3.0 - a * (1.0 / 24.0)) - 1.0) + 4.0 / 3.0) + 1.0 / 3.0; - } - else { - a = 1.0; - } -/**/DEBUG_WRITE_LEAVING(Bspline03Integrate, "Done") - return((0.0 < Argument) ? (a) : (1.0 - a)); -} /* end Bspline03Integrate */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline04Integrate - ( - double Argument /* input */ - ) - -/* returns the integral(-Infinity, Argument) for a Basic spline function - of degree 4 (order 5) */ - -{ /* begin Bspline04Integrate */ - - double a, a2; - -/**/DEBUG_WRITE_ENTERING(Bspline04Integrate, -/**/ "About to integrate a B-spline of degree 4") - - a = fabs(Argument); - if (a < 0.5) { - a2 = a * a; - a = a * (a2 * (a2 * (1.0 / 20.0) - 5.0 / 24.0) + 115.0 / 192.0) + 1.0 / 2.0; - } - else if (a < 1.5) { - a = a * (a * (a * (a * (5.0 / 24.0 - a * (1.0 / 30.0)) - 5.0 / 12.0) - + 5.0 / 48.0) + 55.0 / 96.0) + 193.0 / 384.0; - } - else if (a < 2.5) { - a = a * (a * (a * (a * (a * (1.0 / 120.0) - 5.0 / 48.0) + 25.0 / 48.0) - - 125.0 / 96.0) + 625.0 / 384.0) + 143.0 / 768.0; - } - else { - a = 1.0; - } -/**/DEBUG_WRITE_LEAVING(Bspline04Integrate, "Done") - return((0.0 < Argument) ? (a) : (1.0 - a)); -} /* end Bspline04Integrate */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline05Integrate - ( - double Argument /* input */ - ) - -/* returns the integral(-Infinity, Argument) for a Basic spline function - of degree 5 (order 6) */ - -{ /* begin Bspline05Integrate */ - - double a, a2; - -/**/DEBUG_WRITE_ENTERING(Bspline05Integrate, -/**/ "About to integrate a B-spline of degree 5") - - a = fabs(Argument); - if (a < 1.0) { - a2 = a * a; - a = a * (a2 * (a2 * (1.0 / 20.0 - a * (1.0 / 72.0)) - 1.0 / 6.0) - + 11.0 / 20.0) + 1.0 / 2.0; - } - else if (a < 2.0) { - a = a * (a * (a * (a * (a * (a * (1.0 / 144.0) - 3.0 / 40.0) + 5.0 / 16.0) - - 7.0 / 12.0) + 5.0 / 16.0) + 17.0 / 40.0) + 25.0 / 48.0; - } - else if (a < 3.0) { - a = a * (a * (a * (a * (a * (1.0 / 40.0 - a * (1.0 / 720.0)) - 3.0 / 16.0) - + 3.0 / 4.0) - 27.0 / 16.0) + 81.0 / 40.0) - 1.0 / 80.0; - } - else { - a = 1.0; - } -/**/DEBUG_WRITE_LEAVING(Bspline05Integrate, "Done") - return((0.0 < Argument) ? (a) : (1.0 - a)); -} /* end Bspline05Integrate */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline06Integrate - ( - double Argument /* input */ - ) - -/* returns the integral(-Infinity, Argument) for a Basic spline function - of degree 6 (order 7) */ - -{ /* begin Bspline06Integrate */ - - double a, a2; - -/**/DEBUG_WRITE_ENTERING(Bspline06Integrate, -/**/ "About to integrate a B-spline of degree 6") - - a = fabs(Argument); - if (a < 0.5) { - a2 = a * a; - a = a * (a2 * (a2 * (7.0 / 240.0 - a2 * (1.0 / 252.0)) - 77.0 / 576.0) - + 5887.0 / 11520.0) + 1.0 / 2.0; - } - else if (a < 1.5) { - a = a * (a * (a * (a * (a * (a * (a * (1.0 / 336.0) - 7.0 / 288.0) - + 21.0 / 320.0) - 35.0 / 1152.0) - 91.0 / 768.0) - 7.0 / 1536.0) - + 7861.0 / 15360.0) + 9215.0 / 18432.0; - } - else if (a < 2.5) { - a = a * (a * (a * (a * (a * (a * (7.0 / 360.0 - a * (1.0 / 840.0)) - - 21.0 / 160.0) + 133.0 / 288.0) - 329.0 / 384.0) + 1267.0 / 1920.0) - + 1379.0 / 7680.0) + 13159.0 / 23040.0; - } - else if (a < 3.5) { - a = a * (a * (a * (a * (a * (a * (a * (1.0 / 5040.0) - 7.0 / 1440.0) - + 49.0 / 960.0) - 343.0 / 1152.0) + 2401.0 / 2304.0) - 16807.0 / 7680.0) - + 117649.0 / 46080.0) - 25489.0 / 92160.0; - } - else { - a = 1.0; - } -/**/DEBUG_WRITE_LEAVING(Bspline06Integrate, "Done") - return((0.0 < Argument) ? (a) : (1.0 - a)); -} /* end Bspline06Integrate */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline07Integrate - ( - double Argument /* input */ - ) - -/* returns the integral(-Infinity, Argument) for a Basic spline function - of degree 7 (order 8) */ - -{ /* begin Bspline07Integrate */ - - double a, a2; - -/**/DEBUG_WRITE_ENTERING(Bspline07Integrate, -/**/ "About to integrate a B-spline of degree 7") - - a = fabs(Argument); - if (a < 1.0) { - a2 = a * a; - a = a * (a2 * (a2 * (a2 * (a * (1.0 / 1152.0) - 1.0 / 252.0) + 1.0 / 45.0) - - 1.0 / 9.0) + 151.0 / 315.0) + 1.0 / 2.0; - } - else if (a < 2.0) { - a = a * (a * (a * (a * (a * (a * (a * (1.0 / 140.0 - a * (1.0 /1920.0)) - - 7.0 / 180.0) + 1.0 /10.0) - 7.0 / 72.0) - 1.0 / 30.0) - 7.0 / 180.0) - + 103.0 / 210.0) + 359.0 / 720.0; - } - else if (a < 3.0) { - a = a * (a * (a * (a * (a * (a * (a * (a * (1.0 / 5760.0) - 1.0 / 252.0) - + 7.0 / 180.0) - 19.0 / 90.0) + 49.0 / 72.0) - 23.0 / 18.0) + 217.0 / 180.0) - - 139.0 / 630.0) + 487.0 / 720.0; - } - else if (a < 4.0) { - a = a * (a * (a * (a * (a * (a * (a * (1.0 / 1260.0 - a * (1.0 / 40320.0)) - - 1.0 / 90.0) + 4.0 / 45.0) - 4.0 / 9.0) + 64.0 / 45.0) - 128.0 / 45.0) - + 1024.0 / 315.0) - 197.0 / 315.0; - } - else { - a = 1.0; - } -/**/DEBUG_WRITE_LEAVING(Bspline07Integrate, "Done") - return((0.0 < Argument) ? (a) : (1.0 - a)); -} /* end Bspline07Integrate */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline08Integrate - ( - double Argument /* input */ - ) - -/* returns the integral(-Infinity, Argument) for a Basic spline function - of degree 8 (order 9) */ - -{ /* begin Bspline08Integrate */ - - double a, a2; - -/**/DEBUG_WRITE_ENTERING(Bspline08Integrate, -/**/ "About to integrate a B-spline of degree 8") - - a = fabs(Argument); - if (a < 0.5) { - a2 = a * a; - a = a * (a2 * (a2 * (a2 * (a2 * (1.0 / 5184.0) - 1.0 / 448.0) + 43.0 / 2560.0) - - 289.0 / 3072.0) + 259723.0 / 573440.0) + 1.0 / 2.0; - } - else if (a < 1.5) { - a = a * (a * (a * (a * (a * (a * (a * (a * (1.0 / 640.0 - a * (1.0 / 6480.0)) - - 3.0 / 560.0) + 7.0 / 1920.0) + 9.0 / 640.0) + 7.0 / 5120.0) - 121.0 / 1280.0) - + 1.0 / 10240.0) + 64929.0 / 143360.0) + 737281.0 / 1474560.0; - } - else if (a < 2.5) { - a = a * (a * (a * (a * (a * (a * (a * (a * (a * (1.0 / 12960.0) - 1.0 / 640.0) - + 3.0 / 224.0) - 119.0 / 1920.0) + 207.0 / 1280.0) - 1127.0 / 5120.0) - + 65.0 / 512.0) - 1457.0 / 10240.0) + 145167.0 / 286720.0) + 724159.0 / 1474560.0; - } - else if (a < 3.5) { - a = a * (a * (a * (a * (a * (a * (a * (a * (3.0 / 4480.0 - a * (1.0 / 45360.0)) - - 1.0 / 112.0) + 131.0 / 1920.0) - 209.0 / 640.0) + 5123.0 / 5120.0) - - 1465.0 / 768.0) + 146051.0 / 71680.0) - 122729.0 / 143360.0) - + 8975363.0 / 10321920.0; - } - else if (a < 4.5) { - a = a * (a * (a * (a * (a * (a * (a * (a * (a * (1.0 / 362880.0) - 1.0 / 8960.0) - + 9.0 / 4480.0) - 27.0 / 1280.0) + 729.0 / 5120.0) - 6561.0 / 10240.0) - + 19683.0 / 10240.0) - 531441.0 / 143360.0) + 4782969.0 / 1146880.0) - - 2489209.0 / 2293760.0; - } - else { - a = 1.0; - } -/**/DEBUG_WRITE_LEAVING(Bspline08Integrate, "Done") - return((0.0 < Argument) ? (a) : (1.0 - a)); -} /* end Bspline08Integrate */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline09Integrate - ( - double Argument /* input */ - ) - -/* returns the integral(-Infinity, Argument) for a Basic spline function - of degree 9 (order 10) */ - -{ /* begin Bspline09Integrate */ - - double a, a2; - -/**/DEBUG_WRITE_ENTERING(Bspline09Integrate, -/**/ "About to integrate a B-spline of degree 9") - - a = fabs(Argument); - if (a < 1.0) { - a2 = a * a; - a = a * (a2 * (a2 * (a2 * (a2 * (1.0 / 5184.0 - a * (1.0 / 28800.0)) - - 5.0 / 3024.0) + 19.0 / 1440.0) - 35.0 / 432.0) + 15619.0 / 36288.0) + 1.0 / 2.0; - } - else if (a < 2.0) { - a = a * (a * (a * (a * (a * (a * (a * (a * (a * (a * (1.0 / 43200.0) - - 1.0 / 2592.0) + 1.0 / 384.0) - 13.0 / 1512.0) + 7.0 / 576.0) - - 1.0 / 720.0) + 7.0 / 576.0) - 19.0 / 216.0) + 1.0 / 384.0) - + 7799.0 / 18144.0) + 8641.0 / 17280.0; - } - else if (a < 3.0) { - a = a * (a * (a * (a * (a * (a * (a * (a * (a * (5.0 / 18144.0 - - a * (1.0 / 100800.0)) - 3.0 / 896.0) + 5.0 / 216.0) - 19.0 / 192.0) - + 191.0 / 720.0) - 83.0 / 192.0) + 635.0 / 1512.0) - 339.0 / 896.0) - + 1553.0 / 2592.0) + 18797.0 / 40320.0; - } - else if (a < 4.0) { - a = a * (a * (a * (a * (a * (a * (a * (a * (a * (a * (1.0 / 403200.0) - - 1.0 / 10368.0) + 3.0 / 1792.0) - 103.0 / 6048.0) + 43.0 / 384.0) - - 1423.0 / 2880.0) + 563.0 / 384.0) - 2449.0 / 864.0) + 5883.0 / 1792.0) - - 133663.0 / 72576.0) + 96643.0 / 80640.0; - } - else if (a < 5.0) { - a = a * (a * (a * (a * (a * (a * (a * (a * (a * (1.0 / 72576.0 - - a * (1.0 / 3628800.0)) - 5.0 / 16128.0) + 25.0 / 6048.0) - - 125.0 / 3456.0) + 125.0 / 576.0) - 3125.0 / 3456.0) + 15625.0 / 6048.0) - - 78125.0 / 16128.0) + 390625.0 / 72576.0) - 245473.0 / 145152.0; - } - else { - a = 1.0; - } -/**/DEBUG_WRITE_LEAVING(Bspline09Integrate, "Done") - return((0.0 < Argument) ? (a) : (1.0 - a)); -} /* end Bspline09Integrate */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline10Integrate - ( - double Argument /* input */ - ) - -/* returns the integral(-Infinity, Argument) for a Basic spline function - of degree 10 (order 11) */ - -{ /* begin Bspline10Integrate */ - - double a, a2; - -/**/DEBUG_WRITE_ENTERING(Bspline10Integrate, -/**/ "About to integrate a B-spline of degree 10") - - a = fabs(Argument); - if (a < 0.5) { - a2 = a * a; - a = a * (a2 * (a2 * (a2 * (a2 * (11.0 / 103680.0 - a2 * (1.0 / 158400.0)) - - 583.0 / 483840.0) + 14597.0 / 1382400.0) - 156409.0 / 2211840.0) - + 381773117.0 / 928972800.0) + 1.0 / 2.0; - } - else if (a < 1.5) { - a = a * (a * (a * (a * (a * (a * (a * (a * (a * (a * (a * (1.0 / 190080.0) - - 11.0 / 172800.0) + 11.0 / 41472.0) - 11.0 / 46080.0) - 187.0 / 193536.0) - - 77.0 / 460800.0) + 1177.0 / 110592.0) - 11.0 / 368640.0) - 62557.0 / 884736.0) - - 11.0 / 8847360.0) + 152709293.0 / 371589120.0) + 88473599.0 / 176947200.0; - } - else if (a < 2.5) { - a = a * (a * (a * (a * (a * (a * (a * (a * (a * (a * (11.0 / 151200.0 - - a * (1.0 / 332640.0)) - 55.0 / 72576.0) + 11.0 / 2520.0) - - 715.0 / 48384.0) + 1661.0 / 57600.0) - 4543.0 / 138240.0) - + 7513.0 / 161280.0) - 163603.0 / 1548288.0) + 135311.0 / 7741440.0) - + 37690169.0 / 92897280.0) + 19381279.0 / 38707200.0; - } - else if (a < 3.5) { - a = a * (a * (a * (a * (a * (a * (a * (a * (a * (a * (a * (1.0 / 887040.0) - - 11.0 / 268800.0) + 55.0 / 82944.0) - 451.0 / 71680.0) + 14905.0 / 387072.0) - - 48433.0 / 307200.0) + 479281.0 / 1105920.0) - 1352153.0 / 1720320.0) - + 1654543.0 / 1769472.0) - 11695211.0 / 13762560.0) + 623786977.0 / 743178240.0) - + 47441011.0 / 117964800.0; - } - else if (a < 4.5) { - a = a * (a * (a * (a * (a * (a * (a * (a * (a * (a * (11.0 / 907200.0 - - a * (1.0 / 3991680.0)) - 11.0 / 41472.0) + 209.0 / 60480.0) - - 5753.0 / 193536.0) + 61061.0 / 345600.0) - 407429.0 / 552960.0) - + 2070343.0 / 967680.0) - 3702215.0 / 884736.0) + 237959711.0 / 46448640.0) - - 1241720381.0 / 371589120.0) + 28739771.0 / 16588800.0; - } - else if (a < 5.5) { - a = a * (a * (a * (a * (a * (a * (a * (a * (a * (a * (a * (1.0 / 39916800.0) - - 11.0 / 7257600.0) + 121.0 / 2903040.0) - 1331.0 / 1935360.0) - + 14641.0 / 1935360.0) - 161051.0 / 2764800.0) + 1771561.0 / 5529600.0) - - 19487171.0 / 15482880.0) + 214358881.0 / 61931520.0) - - 2357947691.0 / 371589120.0) + 25937424601.0 / 3715891200.0) - - 18505642201.0 / 7431782400.0; - } - else { - a = 1.0; - } -/**/DEBUG_WRITE_LEAVING(Bspline10Integrate, "Done") - return((0.0 < Argument) ? (a) : (1.0 - a)); -} /* end Bspline10Integrate */ - -/*--------------------------------------------------------------------------*/ -extern double Bspline11Integrate - ( - double Argument /* input */ - ) - -/* returns the integral(-Infinity, Argument) for a Basic spline function - of degree 11 (order 12) */ - -{ /* begin Bspline11Integrate */ - - double a, a2; - -/**/DEBUG_WRITE_ENTERING(Bspline11Integrate, -/**/ "About to integrate a B-spline of degree 11") - - a = fabs(Argument); - if (a < 1.0) { - a2 = a * a; - a = a * (a2 * (a2 * (a2 * (a2 * (a2 * (a * (1.0 / 1036800.0) - - 1.0 / 158400.0) + 1.0 / 12960.0) - 23.0 / 25200.0) + 31.0 / 3600.0) - - 809.0 / 12960.0) + 655177.0 / 1663200.0) + 1.0 / 2.0; - } - else if (a < 2.0) { - a = a * (a * (a * (a * (a * (a * (a * (a * (a * (a * (a * (1.0 / 73920.0 - - a * (1.0 / 1451520.0)) - 11.0 / 100800.0) + 1.0 / 2268.0) - - 11.0 / 13440.0) + 1.0 / 2520.0) - 11.0 / 7200.0) + 5.0 / 504.0) - - 11.0 / 13440.0) - 563.0 / 9072.0) - 11.0 / 100800.0) + 65521.0 / 166320.0) - + 302399.0 / 604800.0; - } - else if (a < 3.0) { - a = a * (a * (a * (a * (a * (a * (a * (a * (a * (a * (a * (a * (1.0 / 2903040.0) - - 1.0 / 88704.0) + 11.0 / 67200.0) - 25.0 / 18144.0) + 33.0 / 4480.0) - - 13.0 / 504.0) + 143.0 / 2400.0) - 239.0 / 2520.0) + 583.0 / 4480.0) - - 1619.0 / 9072.0) + 781.0 / 11200.0) + 61297.0 / 166320.0) - + 101653.0 / 201600.0; - } - else if (a < 4.0) { - a = a * (a * (a * (a * (a * (a * (a * (a * (a * (a * (a * (1.0 / 190080.0 - - a * (1.0 / 8709120.0)) - 11.0 / 100800.0) + 7.0 / 5184.0) - 99.0 / 8960.0) - + 631.0 / 10080.0) - 1199.0 /4800.0) + 1009.0 / 1440.0) - 12199.0 / 8960.0) - + 9385.0 / 5184.0) - 38533.0 / 22400.0) + 894727.0 / 665280.0) - + 104891.0 / 403200.0; - } - else if (a < 5.0) { - a = a * (a * (a * (a * (a * (a * (a * (a * (a * (a * (a * (a * (1.0 / 43545600.0) - - 1.0 / 739200.0) + 11.0 / 302400.0) - 107.0 / 181440.0) + 517.0 / 80640.0) - - 2477.0 / 50400.0) + 11737.0 / 43200.0) - 54797.0 / 50400.0) - + 250657.0 / 80640.0) - 1113317.0 / 181440.0) + 4726777.0 / 604800.0) - - 18595037.0 / 3326400.0) + 9332627.0 / 3628800.0; - } - else if (a < 6.0) { - a = a * (a * (a * (a * (a * (a * (a * (a * (a * (a * (a * (1.0 / 6652800.0 - - a * (1.0 / 479001600.0)) - 1.0 / 201600.0) + 1.0 / 10080.0) - 3.0 / 2240.0) - + 9.0 / 700.0) - 9.0 / 100.0) + 81.0 / 175.0) - 243.0 / 140.0) - + 162.0 / 35.0) - 1458.0 / 175.0) + 17496.0 / 1925.0) - 6823.0 / 1925.0; - } - else { - a = 1.0; - } -/**/DEBUG_WRITE_LEAVING(Bspline11Integrate, "Done") - return((0.0 < Argument) ? (a) : (1.0 - a)); -} /* end Bspline11Integrate */ - -/*--------------------------------------------------------------------------*/ -extern double DodgsonIntegrate - ( - double Argument /* input */ - ) - -/* returns the integral(-Infinity, Argument) for a Dodgson kernel - (order 2) evaluated at Argument */ - -{ /* begin DodgsonIntegrate */ - - double a; - -/**/DEBUG_WRITE_ENTERING(DodgsonIntegrate, -/**/ "About to integrate a Dodgson kernel") - - a = fabs(Argument); - if (a < 0.5) { - a = a * (1.0 - a * a * (2.0 / 3.0)) + 1.0 / 2.0; - } - else if (a < 1.5) { - a = a * (a * (a * (1.0 / 3.0) - 5.0 / 4.0) + 3.0 / 2) + 7.0 / 16; - } - else { - a = 1.0; - } -/**/DEBUG_WRITE_LEAVING(DodgsonIntegrate, "Done") - return((0.0 < Argument) ? (a) : (1.0 - a)); -} /* end DodgsonIntegrate */ - -/*--------------------------------------------------------------------------*/ -extern double KeysOptimalIntegrate - ( - double Argument /* input */ - ) - -/* returns the integral(-Infinity, Argument) for a cubic Keys optimal kernel - (order 3) evaluated at Argument */ - -{ /* begin KeysOptimalIntegrate */ - - double a; - -/**/DEBUG_WRITE_ENTERING(KeysOptimalIntegrate, -/**/ "About to integrate a cubic Keys kernel") - - a = fabs(Argument); - if (a < 1.0) { - a = a * (a * (a * (a * (3.0 / 8.0) - 5.0 / 6.0)) + 1.0) + 1.0 / 2.0; - } - else if (a < 2.0) { - a = a * (a * (a * (5.0 / 6.0 - a * (1.0 / 8.0)) - 2.0) + 2.0) + 1.0 / 3.0; - } - else { - a = 1.0; - } -/**/DEBUG_WRITE_LEAVING(KeysOptimalIntegrate, "Done") - return((0.0 < Argument) ? (a) : (1.0 - a)); -} /* end KeysOptimalIntegrate */ - -/*--------------------------------------------------------------------------*/ -extern int OmomsIntegrate - ( - long Degree, /* degree */ - double Argument, /* input */ - double *Result /* output */ - ) - -/* computes the integral(-Infinity, Argument) for a Blu optimum function */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin OmomsIntegrate */ - - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(OmomsIntegrate, Result, Status, -/**/ "No output data") -/**/DEBUG_RETURN_ON_ERROR(OmomsIntegrate, Status) -/**/DEBUG_WRITE_ENTERING(OmomsIntegrate, -/**/ "About to integrate a generic oMoms") - - switch (Degree) { - case 0L: - *Result = Omoms00Integrate(Argument); - break; - case 1L: - *Result = Omoms01Integrate(Argument); - break; - case 2L: - *Result = Omoms02Integrate(Argument); - break; - case 3L: - *Result = Omoms03Integrate(Argument); - break; - default: - Status = ERROR; - WRITE_ERROR(OmomsIntegrate, "Invalid oMoms degree") - break; - } -/**/DEBUG_WRITE_LEAVING(OmomsIntegrate, "Done") - return(Status); -} /* end OmomsIntegrate */ - -/*--------------------------------------------------------------------------*/ -extern double Omoms00Integrate - ( - double Argument /* input */ - ) - -/* returns the integral(-Infinity, Argument) for a Blu interpolant function - of degree 0 (order 1) */ - -{ /* begin Omoms00Integrate */ - - double a; - -/**/DEBUG_WRITE_ENTERING(Omoms00Integrate, -/**/ "About to integrate an oMoms of degree 0") - - a = fabs(Argument); - if (a < 0.5) { - a = a + 1.0 / 2.0; - } - else { - a = 1.0; - } -/**/DEBUG_WRITE_LEAVING(Omoms00Integrate, "Done") - return((0.0 < Argument) ? (a) : (1.0 - a)); -} /* end Omoms00Integrate */ - -/*--------------------------------------------------------------------------*/ -extern double Omoms01Integrate - ( - double Argument /* input */ - ) - -/* returns the integral(-Infinity, Argument) for a Blu interpolant function - of degree 1 (order 2) */ - -{ /* begin Omoms01Integrate */ - - double a; - -/**/DEBUG_WRITE_ENTERING(Omoms01Integrate, -/**/ "About to integrate an oMoms of degree 1") - - a = fabs(Argument); - if (a < 1.0) { - a = a * (1.0 - a * (1.0 / 2.0)) + 1.0 / 2.0; - } - else { - a = 1.0; - } -/**/DEBUG_WRITE_LEAVING(Omoms01Integrate, "Done") - return((0.0 < Argument) ? (a) : (1.0 - a)); -} /* end Omoms01Integrate */ - -/*--------------------------------------------------------------------------*/ -extern double Omoms02Integrate - ( - double Argument /* input */ - ) - -/* returns the integral(-Infinity, Argument) for a Blu optimum function - of degree 2 (order 3) */ - -{ /* begin Omoms02Integrate */ - - double a; - -/**/DEBUG_WRITE_ENTERING(Omoms02Integrate, -/**/ "About to integrate an oMoms of degree 2") - - a = fabs(Argument); - if (a < 0.5) { - a = a * (43.0 / 60.0 - a * a * (1.0 / 3.0)) + 1.0 / 2.0; - } - else if (a < 1.5) { - a = a * (a * (a * (1.0 / 6.0) - 3.0 / 4.0) + 137.0 / 120.0) + 33.0 / 80.0; - } - else { - a = 1.0; - } -/**/DEBUG_WRITE_LEAVING(Omoms02Integrate, "Done") - return((0.0 < Argument) ? (a) : (1.0 - a)); -} /* end Omoms02Integrate */ - -/*--------------------------------------------------------------------------*/ -extern double Omoms03Integrate - ( - double Argument /* input */ - ) - -/* returns the integral(-Infinity, Argument) for a Blu optimum function - of degree 3 (order 4) */ - -{ /* begin Omoms03Integrate */ - - double a; - -/**/DEBUG_WRITE_ENTERING(Omoms03Integrate, -/**/ "About to integrate an oMoms of degree 3") - - a = fabs(Argument); - if (a < 1.0) { - a = a * (a * (a * (a * (1.0 / 8.0) - 1.0 / 3.0) + 1.0 / 28.0) - + 13.0 / 21.0) + 1.0 / 2.0; - } - else if (a < 2.0) { - a = a * (a * (a * (1.0 / 3.0 - a * (1.0 / 24.0)) - 85.0 / 84.0) - + 29.0 / 21.0) + 2.0 / 7.0; - } - else { - a = 1.0; - } -/**/DEBUG_WRITE_LEAVING(Omoms03Integrate, "Done") - return((0.0 < Argument) ? (a) : (-a)); -} /* end Omoms03Integrate */ - -/*--------------------------------------------------------------------------*/ -extern double SincIntegrate - ( - double Argument /* input */ - ) - -/* returns the approximate integral(-Infinity, Argument) for a sinc kernel - evaluated at Argument */ -/* maximum error is about 2.0E-7 */ - -{ /* begin SincIntegrate */ - - double a, a2; - -/**/DEBUG_WRITE_ENTERING(SincIntegrate, -/**/ "About to integrate a sinc kernel") - - a = fabs(Argument); - if (a < 0.5) { - a2 = (PI * PI) * a * a; - a *= a2 * (a2 * (a2 * (a2 * (1.0 /3265920.0) - 1.0 / 35280.0) - + 1.0 / 600.0) - 1.0 /18.0) + 1.0; - } - else { - a *= PI; - a2 = a * a; - a = 0.5 - (1.0 / PI) * ((1.0 / a) * (a2 * (a2 * (a2 * (a2 + 38.027264) - + 265.187033) + 335.677320) + 38.102495) / (a2 * (a2 * (a2 * (a2 - + 40.021433) + 322.624911) + 570.236280) + 157.105423) * cos(a) - + (1.0 / a2) * (a2 * (a2 * (a2 * (a2 + 42.242855) + 302.757865) - + 352.018498) + 21.821899) / (a2 * (a2 * (a2 * (a2 + 48.196927) - + 482.485984) + 1114.978885) + 449.690326) * sin(a)); - } -/**/DEBUG_WRITE_LEAVING(SincIntegrate, "Done") - return((0.0 < Argument) ? (a) : (1.0 - a)); -} /* end SincIntegrate */ - diff --git a/src/core/bilib/kernelintegrate.h b/src/core/bilib/kernelintegrate.h deleted file mode 100644 index eb778c5..0000000 --- a/src/core/bilib/kernelintegrate.h +++ /dev/null @@ -1,210 +0,0 @@ -/**@defgroup BilibKernelIntegrals Kernel integrals - @ingroup BilibLibrary */ -//@{ -/*--------------------------------------------------------------------------*/ -/** Computes the integral(-Infinity, Argument) for a Blu interpolant function. - success: return(!ERROR); failure: return(ERROR); */ -extern int BlipIntegrate - ( - long Degree, /* degree */ - double Argument, /* input */ - double *Result /* output */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the integral(-Infinity, Argument) for a Blu interpolant function - of degree 0 (order 1) */ -extern double Blip00Integrate - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the integral(-Infinity, Argument) for a Blu interpolant function - of degree 1 (order 2) */ -extern double Blip01Integrate - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the integral(-Infinity, Argument) for a Blu interpolant function - of degree 3 (order 4) */ -extern double Blip03Integrate - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Computes the integral(-Infinity, Argument) for a Basic spline function - of degree Degree. - success: return(!ERROR); failure: return(ERROR); */ -extern int BsplineIntegrate - ( - long Degree, /* degree */ - double Argument, /* input */ - double *Result /* output */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the integral(-Infinity, Argument) for a Basic spline function - of degree 0 (order 1) */ -extern double Bspline00Integrate - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the integral(-Infinity, Argument) for a Basic spline function - of degree 1 (order 2) */ -extern double Bspline01Integrate - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the integral(-Infinity, Argument) for a Basic spline function - of degree 2 (order 3) */ -extern double Bspline02Integrate - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the integral(-Infinity, Argument) for a Basic spline function - of degree 3 (order 4) */ -extern double Bspline03Integrate - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the integral(-Infinity, Argument) for a Basic spline function - of degree 4 (order 5) */ -extern double Bspline04Integrate - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the integral(-Infinity, Argument) for a Basic spline function - of degree 5 (order 6) */ -extern double Bspline05Integrate - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the integral(-Infinity, Argument) for a Basic spline function - of degree 6 (order 7) */ -extern double Bspline06Integrate - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the integral(-Infinity, Argument) for a Basic spline function - of degree 7 (order 8) */ -extern double Bspline07Integrate - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the integral(-Infinity, Argument) for a Basic spline function - of degree 8 (order 9) */ -extern double Bspline08Integrate - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the integral(-Infinity, Argument) for a Basic spline function - of degree 9 (order 10) */ -extern double Bspline09Integrate - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the integral(-Infinity, Argument) for a Basic spline function - of degree 10 (order 11) */ -extern double Bspline10Integrate - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the integral(-Infinity, Argument) for a Basic spline function - of degree 11 (order 12) */ -extern double Bspline11Integrate - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the integral(-Infinity, Argument) for a Dodgson kernel - (order 2) evaluated at Argument */ -extern double DodgsonIntegrate - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the integral(-Infinity, Argument) for a cubic Keys optimal kernel - (order 3) evaluated at Argument */ -extern double KeysOptimalIntegrate - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Computes the integral(-Infinity, Argument) for a Blu optimum function. - success: return(!ERROR); failure: return(ERROR); */ -extern int OmomsIntegrate - ( - long Degree, /* degree */ - double Argument, /* input */ - double *Result /* output */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the integral(-Infinity, Argument) for a Blu interpolant function - of degree 0 (order 1) */ -extern double Omoms00Integrate - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the integral(-Infinity, Argument) for a Blu interpolant function - of degree 1 (order 2) */ -extern double Omoms01Integrate - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the integral(-Infinity, Argument) for a Blu interpolant function - of degree 2 (order 3) */ -extern double Omoms02Integrate - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the integral(-Infinity, Argument) for a Blu interpolant function - of degree 3 (order 4) */ -extern double Omoms03Integrate - ( - double Argument /* input */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the approximate integral(-Infinity, Argument) for a sinc kernel - evaluated at Argument. Maximum error is about 2.0E-7 */ -extern double SincIntegrate - ( - double Argument /* input */ - ); -//@} diff --git a/src/core/bilib/linearalgebra.cc b/src/core/bilib/linearalgebra.cc deleted file mode 100644 index 444da4d..0000000 --- a/src/core/bilib/linearalgebra.cc +++ /dev/null @@ -1,2380 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -#include -#include -#include -#include -#include -#include - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" -#include "error.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "linearalgebra.h" -#include "messagedisplay.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -#ifdef DEBUG -#include -#endif - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -static double Pythag(double a, /* 1st side */ -double b /* 2nd side */ -); - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -static double Pythag(double a, /* 1st side */ -double b /* 2nd side */ -) - -/* compute sqrt(a^2+b^2) in a stable numerical form */ - -{ /* begin Pythag */ - - double absa, absb; - - /**/DEBUG_WRITE_ENTERING(Pythag, - /**/"About to apply the Pythagorean theorem") - - absa = fabs(a); - absb = fabs(b); - if (absb < absa) { - /**/DEBUG_WRITE_LEAVING(Pythag, "Done") - return (absa * sqrt(1.0 + absb * absb / (absa * absa))); - } else { - /**/DEBUG_WRITE_LEAVING(Pythag, "Done") - return ((absb == 0.0) ? (0.0) : (absb * sqrt( - 1.0 + absa * absa / (absb * absb)))); - } -} /* end Pythag */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern int AllocateMatrix(double **Matrix, /* double output pointer */ -long Lines, /* height of the matrix */ -long Columns, /* width of the matrix */ -int *Status /* error management */ -) - -/* allocate a (double)matrix of size (Lines x Columns) */ -/* success: return(!ERROR); failure: return(ERROR) and set *Matrix to NULL */ - -{ /* begin AllocateMatrix */ - - *Status = !ERROR; - - /**/DEBUG_CHECK_RANGE_LONG(AllocateMatrix, Lines, 1L, LONG_MAX, *Status, - /**/"Invalid Lines (should be strictly positive)") - /**/DEBUG_CHECK_RANGE_LONG(AllocateMatrix, Columns, 1L, LONG_MAX, *Status, - /**/"Invalid Columns (should be strictly positive)") - /**/DEBUG_RETURN_ON_ERROR(AllocateMatrix, *Status) - /**/DEBUG_WRITE_ENTERING(AllocateMatrix, - /**/"About to allocate a matrix") -#ifdef DEBUG - /**/if (*Matrix != (double *)NULL) { - /**/WRITE_WARNING(AllocateMatrix, "Matrix may have been previously allocated") - /**/} -#endif - - *Matrix = (double *) malloc( - (size_t) (Lines * Columns * (long) sizeof(double))); - if (*Matrix == (double *) NULL) { - *Status = ERROR; -WRITE_ERROR (AllocateMatrix, "Unable to perform allocation") -} -/**/DEBUG_WRITE_LEAVING(AllocateMatrix, "Done") -return(*Status); -} /* end AllocateMatrix */ - -/*--------------------------------------------------------------------------*/ -extern int AllocateVector(double *(Vector[]), /* double output pointer */ -long Lines, /* height of the vector */ -int *Status /* error management */ -) - -/* allocate a (double)vector of size (Lines x 1) */ -/* success: return(!ERROR); failure: return(ERROR) and set *Vector to NULL */ - -{ /* begin AllocateVector */ - - *Status = !ERROR; - - /**/DEBUG_CHECK_RANGE_LONG(AllocateVector, Lines, 1L, LONG_MAX, *Status, - /**/"Invalid Lines (should be strictly positive)") - /**/DEBUG_RETURN_ON_ERROR(AllocateVector, *Status) - /**/DEBUG_WRITE_ENTERING(AllocateVector, - /**/"About to allocate a vector") -#ifdef DEBUG - /**/if (*Vector != (double *)NULL) { - /**/WRITE_WARNING(AllocateVector, "Vector may have been previously allocated") - /**/} -#endif - - *Vector = (double *) malloc((size_t) (Lines * (long) sizeof(double))); - if (*Vector == (double *) NULL) { - *Status = ERROR; -WRITE_ERROR (AllocateVector, "Unable to perform allocation") -} -/**/DEBUG_WRITE_LEAVING(AllocateVector, "Done") -return(*Status); -} /* end AllocateVector */ - -/*--------------------------------------------------------------------------*/ -extern int FreeMatrix(double **Matrix /* (double)matrix array */ -) - -/* free a (double)matrix */ -/* success: return(!ERROR) and set *Matrix to NULL; failure: return(ERROR); */ - -{ /* begin FreeMatrix */ - - int Status = !ERROR; - - /**/DEBUG_CHECK_NULL_POINTER(FreeMatrix, *Matrix, Status, - /**/"Nothing to free") - /**/DEBUG_RETURN_ON_ERROR(FreeMatrix, Status) - /**/DEBUG_WRITE_ENTERING(FreeMatrix, - /**/"About to free a matrix") - - free(*Matrix); - *Matrix = (double *) NULL; - /**/DEBUG_WRITE_LEAVING(FreeMatrix, "Done") - return (Status); -} /* end FreeMatrix */ - -/*--------------------------------------------------------------------------*/ -extern int FreeVector(double *(Vector[]) /* (double)vector array */ -) - -/* free a (double)vector */ -/* success: return(!ERROR) and set *Vector to NULL; failure: return(ERROR); */ - -{ /* begin FreeVector */ - - int Status = !ERROR; - - /**/DEBUG_CHECK_NULL_POINTER(FreeVector, *Vector, Status, - /**/"Nothing to free") - /**/DEBUG_RETURN_ON_ERROR(FreeVector, Status) - /**/DEBUG_WRITE_ENTERING(FreeVector, - /**/"About to free a vector") - - free(*Vector); - *Vector = (double *) NULL; - /**/DEBUG_WRITE_LEAVING(FreeVector, "Done") - return (Status); -} /* end FreeVector */ - -/*--------------------------------------------------------------------------*/ -extern int FrobeniusNorm(double *A, /* input matrix */ -double *Norm, /* resulting scalar norm */ -long Lines, /* height of the matrix A */ -long Columns /* width of the matrix A */ -) - -/* compute the Frobenius norm of the matrix A */ -/* the size of A is (Lines x Columns) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin FrobeniusNorm */ - - double *p, *q; - double Sum; - long i, j; - int Status = !ERROR; - - /**/DEBUG_CHECK_NULL_POINTER(FrobeniusNorm, A, Status, - /**/"Empty input major matrix") - /**/DEBUG_CHECK_NULL_POINTER(FrobeniusNorm, Norm, Status, - /**/"Empty output") - /**/DEBUG_CHECK_RANGE_LONG(FrobeniusNorm, Lines, 1L, LONG_MAX, Status, - /**/"Invalid Lines (should be strictly positive)") - /**/DEBUG_CHECK_RANGE_LONG(FrobeniusNorm, Columns, 1L, LONG_MAX, Status, - /**/"Invalid Columns (should be strictly positive)") - /**/DEBUG_RETURN_ON_ERROR(FrobeniusNorm, Status) - /**/DEBUG_WRITE_ENTERING(FrobeniusNorm, - /**/"About to compute the Frobenius norm of a matrix") - - Sum = 0.0; - p = A; - q = A; - for (i = Lines; (0L < i); i--) { - for (j = Columns; (0L < j); j--) { - Sum += *p++ * *q++; - } - } - *Norm = sqrt(Sum); - /**/DEBUG_WRITE_LEAVING(FrobeniusNorm, "Done") - return (Status); -} /* end FrobeniusNorm */ - -/*--------------------------------------------------------------------------*/ -extern int GetIdentitySquareMatrix(double *A, /* output identity matrix */ -long Size /* height or width of the square matrix */ -) - -/* fill a matrix with identity */ -/* the size of the output matrix A is (Size x Size) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin GetIdentitySquareMatrix */ - - long i, j; - int Status = !ERROR; - - /**/DEBUG_CHECK_NULL_POINTER(GetIdentitySquareMatrix, A, Status, - /**/"Missing output") - /**/DEBUG_CHECK_RANGE_LONG(GetIdentitySquareMatrix, Size, 1L, LONG_MAX, Status, - /**/"Invalid size (should be strictly positive)") - /**/DEBUG_RETURN_ON_ERROR(GetIdentitySquareMatrix, Status) - /**/DEBUG_WRITE_ENTERING(GetIdentitySquareMatrix, - /**/"About to build an identity matrix") - - for (i = Size; (0L < i); i--) { - for (j = Size; (i < j); j--) { - *A++ = 0.0; - } - *A++ = 1.0; - j--; - while (0L < j--) { - *A++ = 0.0; - } - } - /**/DEBUG_WRITE_LEAVING(GetIdentitySquareMatrix, "Done") - return (Status); -} /* end GetIdentitySquareMatrix */ - -/*--------------------------------------------------------------------------*/ -extern int LinearLeastSquares(double *A, /* matrix */ -long Lines, /* height the matrix */ -long Columns, /* width of the matrix */ -double B[], /* right-hand side vector */ -double X[], /* resulting vector */ -double Tolerance, /* admissible relative error */ -int *Status /* error management */ -) - -/* give the least-squares solution to (A * X = B) such that */ -/* (A^T * A)^-1 * A^T * B = X is a vector of size (Columns), where A is */ -/* a (Lines x Columns) matrix, and where B is a vector of size (Lines) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin LinearLeastSquares */ - - double *Q, *R; - double *p, *q, *x, *y; - double s; - long i, j; - - *Status = !ERROR; - - /**/DEBUG_CHECK_NULL_POINTER(LinearLeastSquares, A, *Status, - /**/"No input matrix") - /**/DEBUG_CHECK_NULL_POINTER(LinearLeastSquares, B, *Status, - /**/"No input vector") - /**/DEBUG_CHECK_NULL_POINTER(LinearLeastSquares, X, *Status, - /**/"No output vector") - /**/DEBUG_CHECK_RANGE_LONG(LinearLeastSquares, Lines, 1L, LONG_MAX, *Status, - /**/"Invalid size (should be strictly positive)") - /**/DEBUG_CHECK_RANGE_LONG(LinearLeastSquares, Columns, 1L, LONG_MAX, *Status, - /**/"Invalid size (should be strictly positive)") - /**/DEBUG_CHECK_RANGE_DOUBLE(LinearLeastSquares, Tolerance, 0.0, DBL_MAX, *Status, - /**/"Invalid Tolerance (should be positive)") - /**/DEBUG_RETURN_ON_ERROR(LinearLeastSquares, *Status) - /**/DEBUG_WRITE_ENTERING(LinearLeastSquares, - /**/"About to solve a linear least-squares problem by QR decomposition") - - AllocateMatrix(&Q, Lines, Columns, Status); - if (*Status == ERROR) { - /**/DEBUG_WRITE_LEAVING(LinearLeastSquares, "Done") - return (*Status); - } - AllocateMatrix(&R, Columns, Columns, Status); - if (*Status == ERROR) { - FreeMatrix(&Q); - /**/DEBUG_WRITE_LEAVING(LinearLeastSquares, "Done") - return (*Status); - } - q = (double *) memcpy(Q, A, - (size_t) (Lines * Columns * (long) sizeof(double))); - QRdecomposition(Q, R, Lines, Columns, Tolerance, Status); - if (*Status == ERROR) { - FreeMatrix(&R); - FreeMatrix(&Q); - /**/DEBUG_WRITE_LEAVING(LinearLeastSquares, "Done") - return (*Status); - } - x = X; - for (i = Columns; (0L < i); i--) { - s = 0.0; - p = q++; - y = B; - for (j = Lines; (0L < j); j--) { - s += *p * *y++; - p += (ptrdiff_t) Columns; - } - *x++ = s; - } - p = R + (ptrdiff_t) (Columns * Columns); - for (i = Columns; (0L < i); i--) { - s = *--p; - p -= (ptrdiff_t) Columns; - if ((s * s) < Tolerance) { - *--x = 0.0; - } else { - *--x /= s; - } - q = R + (ptrdiff_t) ((i - 2L) * Columns + i - 1L); - y = X + (ptrdiff_t) (i - 2L); - for (j = i - 2L; (0L <= j); j--) { - *y-- -= *q * *x; - q -= (ptrdiff_t) Columns; - } - } - *Status = FreeMatrix(&R); - if (*Status == ERROR) { - FreeMatrix(&Q); - /**/DEBUG_WRITE_LEAVING(LinearLeastSquares, "Done") - return (*Status); - } - *Status = FreeMatrix(&Q); - /**/DEBUG_WRITE_LEAVING(LinearLeastSquares, "Done") - return (*Status); -} /* end LinearLeastSquares */ - -/*--------------------------------------------------------------------------*/ -extern int MatrixAdd(double *A, /* left matrix operand */ -double *B, /* right matrix operand */ -double *X, /* resulting matrix */ -long Lines, /* height of the matrices */ -long Columns /* width of the matrices */ -) - -/* perform the matrix addition X = A + B */ -/* the size of A, B and X is (Lines x Columns) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin MatrixAdd */ - - long i, j; - int Status = !ERROR; - - /**/DEBUG_CHECK_NULL_POINTER(MatrixAdd, A, Status, - /**/"Empty input left operand") - /**/DEBUG_CHECK_NULL_POINTER(MatrixAdd, B, Status, - /**/"Empty input right operand") - /**/DEBUG_CHECK_NULL_POINTER(MatrixAdd, X, Status, - /**/"Missing result") - /**/DEBUG_CHECK_RANGE_LONG(MatrixAdd, Lines, 1L, LONG_MAX, Status, - /**/"Invalid Lines (should be strictly positive)") - /**/DEBUG_CHECK_RANGE_LONG(MatrixAdd, Columns, 1L, LONG_MAX, Status, - /**/"Invalid Columns (should be strictly positive)") - /**/DEBUG_RETURN_ON_ERROR(MatrixAdd, Status) - /**/DEBUG_WRITE_ENTERING(MatrixAdd, - /**/"About to add two matrices") - - for (i = Lines; (0L < i); i--) { - for (j = Columns; (0L < j); j--) { - *X++ = *A++ + *B++; - } - } - /**/DEBUG_WRITE_LEAVING(MatrixAdd, "Done") - return (Status); -} /* end MatrixAdd */ - -/*--------------------------------------------------------------------------*/ -extern int MatrixConditionNumber(double *A, /* input matrix */ -long Lines, /* height of the matrix A */ -long Columns, /* width of the matrix A */ -double *ConditionNumber, /* resulting scalar condition number */ -double Tolerance, /* admissible relative error */ -long MaxIterations, /* convergence limit */ -int *Status /* error management */ -) - -/* compute the condition number of the matrix A */ -/* the size of A is (Lines x Columns) */ -/* ConditionNumber = -1.0 indicates a singular matrix */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin MatrixConditionNumber */ - - double *w; - double *U = (double *) NULL, *W = (double *) NULL, *V = (double *) NULL; - double Small, Large; - - *Status = !ERROR; - - /**/DEBUG_CHECK_NULL_POINTER(MatrixConditionNumber, A, *Status, - /**/"Empty input") - /**/DEBUG_CHECK_NULL_POINTER(MatrixConditionNumber, ConditionNumber, *Status, - /**/"Empty output") - /**/DEBUG_CHECK_RANGE_LONG(MatrixConditionNumber, Lines, 1L, LONG_MAX, *Status, - /**/"Invalid Lines (should be strictly positive)") - /**/DEBUG_CHECK_RANGE_LONG(MatrixConditionNumber, Columns, 1L, LONG_MAX, *Status, - /**/"Invalid Columns (should be strictly positive)") - /**/DEBUG_CHECK_RANGE_LONG(MatrixConditionNumber, MaxIterations, 1L, LONG_MAX, *Status, - /**/"Invalid iterations (should be strictly positive)") - /**/DEBUG_CHECK_RANGE_DOUBLE(MatrixConditionNumber, Tolerance, 0.0, DBL_MAX, *Status, - /**/"Invalid Tolerance (should be positive)") - /**/DEBUG_RETURN_ON_ERROR(MatrixConditionNumber, *Status) - /**/DEBUG_WRITE_ENTERING(MatrixConditionNumber, - /**/"About to compute the condition number of a matrix") - - AllocateMatrix(&U, Lines, Columns, Status); - if (*Status == ERROR) { - /**/DEBUG_WRITE_LEAVING(MatrixConditionNumber, "Done") - return (*Status); - } - AllocateMatrix(&V, Columns, Columns, Status); - if (*Status == ERROR) { - FreeMatrix(&U); - /**/DEBUG_WRITE_LEAVING(MatrixConditionNumber, "Done") - return (*Status); - } - AllocateVector(&W, Columns, Status); - if (*Status == ERROR) { - FreeMatrix(&V); - FreeMatrix(&U); - /**/DEBUG_WRITE_LEAVING(MatrixConditionNumber, "Done") - return (*Status); - } - U = (double *) memcpy(U, A, - (size_t) (Lines * Columns * (long) sizeof(double))); - SingularValueDecomposition(U, Lines, Columns, W, V, MaxIterations, Status); - if (*Status == ERROR) { - FreeVector(&W); - FreeMatrix(&V); - FreeMatrix(&U); - /**/DEBUG_WRITE_LEAVING(MatrixConditionNumber, "Done") - return (*Status); - } - *Status = FreeMatrix(&V); - if (*Status == ERROR) { - FreeVector(&W); - FreeMatrix(&U); - /**/DEBUG_WRITE_LEAVING(MatrixConditionNumber, "Done") - return (*Status); - } - *Status = FreeMatrix(&U); - if (*Status == ERROR) { - FreeVector(&W); - /**/DEBUG_WRITE_LEAVING(MatrixConditionNumber, "Done") - return (*Status); - } - w = W; - Small = *w; - Large = *w; - while (0L < --Columns) { - w++; - Small = (*w < Small) ? (*w) : (Small); - Large = (Large < *w) ? (*w) : (Large); - } - *ConditionNumber = ((Tolerance * Large) < Small) ? (Large / Small) : (-1.0); - *Status = FreeVector(&W); - /**/DEBUG_WRITE_LEAVING(MatrixConditionNumber, "Done") - return (*Status); -} /* end MatrixConditionNumber */ - -/*--------------------------------------------------------------------------*/ -extern int MatrixGramSchmidtOrthonormalize(double *A, /* input matrix */ -double *B, /* resulting matrix */ -long Lines, /* height of the matrix A */ -long Columns, /* width of the matrix A */ -double Tolerance /* admissible relative error */ -) - -/* orthonormalize a matrix */ -/* the size of A and B is (Lines x Columns) */ -/* the orthogonalization proceeds row-wise */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin MatrixGramSchmidtOrthonormalize */ - - double *u, *v, *w, *x; - double Sum; - long i, j, k; - int Status = !ERROR; - - /**/DEBUG_CHECK_NULL_POINTER(MatrixGramSchmidtOrthonormalize, A, Status, - /**/"Empty input") - /**/DEBUG_CHECK_NULL_POINTER(MatrixGramSchmidtOrthonormalize, B, Status, - /**/"Empty output") - /**/DEBUG_CHECK_RANGE_LONG(MatrixGramSchmidtOrthonormalize, Lines, 1L, LONG_MAX, Status, - /**/"Invalid Lines (should be strictly positive)") - /**/DEBUG_CHECK_RANGE_LONG(MatrixGramSchmidtOrthonormalize, Columns, 1L, LONG_MAX, Status, - /**/"Invalid Columns (should be strictly positive)") - /**/DEBUG_CHECK_RANGE_DOUBLE(MatrixGramSchmidtOrthonormalize, Tolerance, 0.0, DBL_MAX, Status, - /**/"Invalid Tolerance (should be positive)") - /**/DEBUG_RETURN_ON_ERROR(MatrixGramSchmidtOrthonormalize, Status) - /**/DEBUG_WRITE_ENTERING(MatrixGramSchmidtOrthonormalize, - /**/"About to othonormalize a matrix by the Gram-Schmidt procedure") - - u = B; - i = 0L; - do { - v = A; - Sum = 0.0; - for (j = Columns; (0L < j); j--) { - Sum += *v * *v; - v++; - } - if (Tolerance < Sum) { - Sum = 1.0 / sqrt(Sum); - for (j = Columns; (0L < j); j--) { - *u++ = *A++ * Sum; - } - } else { - u = (double *) memcpy(u, A, - (size_t) (Columns * (long) sizeof(double))); - u += (ptrdiff_t) Columns; - A += (ptrdiff_t) Columns; - } - i++; - } while (Sum < Tolerance); - while (i++ < Lines) { - u = (double *) memcpy(u, A, (size_t) (Columns * (long) sizeof(double))); - v = B; - for (k = i - 1L; (0L < k); k--) { - w = A; - x = v; - Sum = 0.0; - for (j = Columns; (0L < j); j--) { - Sum += *w++ * *x++; - } - w = u; - for (j = Columns; (0L < j); j--) { - *w++ -= *v++ * Sum; - } - } - Sum = 0.0; - for (j = Columns; (0L < j); j--) { - Sum += *v * *v; - v++; - } - if (Tolerance < Sum) { - Sum = 1.0 / sqrt(Sum); - for (j = Columns; (0L < j); j--) { - *u++ *= Sum; - } - } else { - u += (ptrdiff_t) Columns; - } - A += (ptrdiff_t) Columns; - } - /**/DEBUG_WRITE_LEAVING(MatrixGramSchmidtOrthonormalize, "Done") - return (Status); -} /* end MatrixGramSchmidtOrthonormalize */ - -/*--------------------------------------------------------------------------*/ -extern int MatrixMinor(double *A, /* input matrix */ -double *B, /* smaller output matrix */ -long Lines, /* height of the matrix A */ -long Columns, /* width of the matrix A */ -long i, /* line to delete */ -long j /* column to delete */ -) - -/* extract a minor matrix B from the major matrix A */ -/* the size of A is (Lines x Columns) */ -/* the size of B is ((Lines - 1) x (Columns - 1)) */ -/* the line to delete is i (indexing starts from 0) */ -/* the column to delete is j (indexing starts from 0) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin MatrixMinor */ - - long c, l; - int Status = !ERROR; - - /**/DEBUG_CHECK_NULL_POINTER(MatrixMinor, A, Status, - /**/"Empty input major matrix") - /**/DEBUG_CHECK_NULL_POINTER(MatrixMinor, B, Status, - /**/"Empty output minor matrix") - /**/DEBUG_CHECK_RANGE_LONG(MatrixMinor, Lines, 1L, LONG_MAX, Status, - /**/"Invalid Lines (should be strictly positive)") - /**/DEBUG_CHECK_RANGE_LONG(MatrixMinor, Columns, 1L, LONG_MAX, Status, - /**/"Invalid Columns (should be strictly positive)") - /**/DEBUG_CHECK_RANGE_LONG(MatrixMinor, i, 0L, Lines - 1L, Status, - /**/"Invalid line to delete (should be in [0, Lines - 1])") - /**/DEBUG_CHECK_RANGE_LONG(MatrixMinor, j, 0L, Columns - 1L, Status, - /**/"Invalid column to delete (should be in [0, Columns - 1])") - /**/DEBUG_RETURN_ON_ERROR(MatrixMinor, Status) - /**/DEBUG_WRITE_ENTERING(MatrixMinor, - /**/"About to extract a minor matrix from a major matrix") - - for (l = 0L; (l < i); l++) { - for (c = 0L; (c < j); c++) { - *B++ = *A++; - } - A++; - while (c++ < Columns) { - *B++ = *A++; - } - } - A += (ptrdiff_t) Columns; - while (l++ < Lines) { - for (c = 0L; (c < j); c++) { - *B++ = *A++; - } - A++; - while (c++ < Columns) { - *B++ = *A++; - } - } - /**/DEBUG_WRITE_LEAVING(MatrixMinor, "Done") - return (Status); -} /* end MatrixMinor */ - -/*--------------------------------------------------------------------------*/ -extern int MatrixMultiply(double *A, /* left matrix operand */ -double *B, /* right maxtrix operand */ -double *X, /* resulting matrix */ -long Lines, /* height (left and resulting) */ -long CommonSize, /* left width and right height */ -long Columns /* width (right and resulting) */ -) - -/* perform the matrix multiplication X = A.B */ -/* the size of A is (Lines x CommonSize) */ -/* the size of B is (CommonSize x Columns) */ -/* the size of X is (Lines x Columns) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin MatrixMultiply */ - - double *a, *b, *p; - double Sum; - long i, j, k; - int Status = !ERROR; - - /**/DEBUG_CHECK_NULL_POINTER(MatrixMultiply, A, Status, - /**/"Empty input left operand") - /**/DEBUG_CHECK_NULL_POINTER(MatrixMultiply, B, Status, - /**/"Empty input right operand") - /**/DEBUG_CHECK_NULL_POINTER(MatrixMultiply, X, Status, - /**/"Missing result") - /**/DEBUG_CHECK_RANGE_LONG(MatrixMultiply, Lines, 1L, LONG_MAX, Status, - /**/"Invalid Lines (should be strictly positive)") - /**/DEBUG_CHECK_RANGE_LONG(MatrixMultiply, CommonSize, 1L, LONG_MAX, Status, - /**/"Invalid CommonSize (should be strictly positive)") - /**/DEBUG_CHECK_RANGE_LONG(MatrixMultiply, Columns, 1L, LONG_MAX, Status, - /**/"Invalid Columns (should be strictly positive)") - /**/DEBUG_RETURN_ON_ERROR(MatrixMultiply, Status) - /**/DEBUG_WRITE_ENTERING(MatrixMultiply, - /**/"About to multiply two matrices together") - - for (i = Lines; (0L < i); i--) { - p = B; - for (j = Columns; (0L < j); j--) { - Sum = 0.0; - a = A; - b = p++; - for (k = CommonSize; (0L < k); k--) { - Sum += *a++ * *b; - b += (ptrdiff_t) Columns; - } - *X++ = Sum; - } - A += (ptrdiff_t) CommonSize; - } - /**/DEBUG_WRITE_LEAVING(MatrixMultiply, "Done") - return (Status); -} /* end MatrixMultiply */ - -/*--------------------------------------------------------------------------*/ -extern int MatrixRank(double *A, /* input matrix */ -long Lines, /* height of the matrix A */ -long Columns, /* width of the matrix A */ -long *Rank, /* resulting scalar condition number */ -double Tolerance, /* admissible relative error */ -long MaxIterations, /* convergence limit */ -int *Status /* error management */ -) - -/* compute the rank of the matrix A */ -/* the size of A is (Lines x Columns) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin MatrixRank */ - - double *w; - double *U = (double *) NULL, *W = (double *) NULL, *V = (double *) NULL; - double Norm; - long j; - - *Status = !ERROR; - - /**/DEBUG_CHECK_NULL_POINTER(MatrixRank, A, *Status, - /**/"Empty input") - /**/DEBUG_CHECK_NULL_POINTER(MatrixRank, Rank, *Status, - /**/"Empty output") - /**/DEBUG_CHECK_RANGE_LONG(MatrixRank, Lines, 1L, LONG_MAX, *Status, - /**/"Invalid Lines (should be strictly positive)") - /**/DEBUG_CHECK_RANGE_LONG(MatrixRank, Columns, 1L, LONG_MAX, *Status, - /**/"Invalid Columns (should be strictly positive)") - /**/DEBUG_CHECK_RANGE_LONG(MatrixRank, MaxIterations, 1L, LONG_MAX, *Status, - /**/"Invalid iterations (should be strictly positive)") - /**/DEBUG_CHECK_RANGE_DOUBLE(MatrixRank, Tolerance, 0.0, DBL_MAX, *Status, - /**/"Invalid Tolerance (should be positive)") - /**/DEBUG_RETURN_ON_ERROR(MatrixRank, *Status) - /**/DEBUG_WRITE_ENTERING(MatrixRank, - /**/"About to compute the rank of a matrix") - - AllocateMatrix(&U, Lines, Columns, Status); - if (*Status == ERROR) { - /**/DEBUG_WRITE_LEAVING(MatrixRank, "Done") - return (*Status); - } - AllocateMatrix(&V, Columns, Columns, Status); - if (*Status == ERROR) { - FreeMatrix(&U); - /**/DEBUG_WRITE_LEAVING(MatrixRank, "Done") - return (*Status); - } - AllocateVector(&W, Columns, Status); - if (*Status == ERROR) { - FreeMatrix(&V); - FreeMatrix(&U); - /**/DEBUG_WRITE_LEAVING(MatrixRank, "Done") - return (*Status); - } - U = (double *) memcpy(U, A, - (size_t) (Lines * Columns * (long) sizeof(double))); - SingularValueDecomposition(U, Lines, Columns, W, V, MaxIterations, Status); - if (*Status == ERROR) { - FreeVector(&W); - FreeMatrix(&V); - FreeMatrix(&U); - /**/DEBUG_WRITE_LEAVING(MatrixRank, "Done") - return (*Status); - } - *Status = FreeMatrix(&V); - if (*Status == ERROR) { - FreeVector(&W); - FreeMatrix(&U); - /**/DEBUG_WRITE_LEAVING(MatrixRank, "Done") - return (*Status); - } - *Status = FreeMatrix(&U); - if (*Status == ERROR) { - FreeVector(&W); - /**/DEBUG_WRITE_LEAVING(MatrixRank, "Done") - return (*Status); - } - w = W; - Norm = 0.0; - for (j = Columns; (0L < j); j--) { - Norm += *w * *w; - w++; - } - Norm = sqrt(Norm); - *Rank = 0L; - if (Tolerance < Norm) { - w = W; - Norm = 1.0 / Norm; - for (j = Columns; (0L < j); j--) { - *Rank += ((*w++ * Norm) < Tolerance) ? (0L) : (1L); - } - } - *Status = FreeVector(&W); - /**/DEBUG_WRITE_LEAVING(MatrixRank, "Done") - return (*Status); -} /* end MatrixRank */ - -/*--------------------------------------------------------------------------*/ -extern int MatrixSubtract(double *A, /* left matrix operand */ -double *B, /* right matrix operand */ -double *X, /* resulting matrix */ -long Lines, /* height of the matrices */ -long Columns /* width of the matrices */ -) - -/* perform the matrix subtraction X = A - B */ -/* the size of A, B and X is (Lines x Columns) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin MatrixSubtract */ - - long i, j; - int Status = !ERROR; - - /**/DEBUG_CHECK_NULL_POINTER(MatrixSubtract, A, Status, - /**/"Empty input left operand") - /**/DEBUG_CHECK_NULL_POINTER(MatrixSubtract, B, Status, - /**/"Empty input right operand") - /**/DEBUG_CHECK_NULL_POINTER(MatrixSubtract, X, Status, - /**/"Missing result") - /**/DEBUG_CHECK_RANGE_LONG(MatrixSubtract, Lines, 1L, LONG_MAX, Status, - /**/"Invalid Lines (should be strictly positive)") - /**/DEBUG_CHECK_RANGE_LONG(MatrixSubtract, Columns, 1L, LONG_MAX, Status, - /**/"Invalid Columns (should be strictly positive)") - /**/DEBUG_RETURN_ON_ERROR(MatrixSubtract, Status) - /**/DEBUG_WRITE_ENTERING(MatrixSubtract, - /**/"About to subtract two matrices") - - for (i = Lines; (0L < i); i--) { - for (j = Columns; (0L < j); j--) { - *X++ = *A++ - *B++; - } - } - /**/DEBUG_WRITE_LEAVING(MatrixSubtract, "Done") - return (Status); -} /* end MatrixSubtract */ - -/*--------------------------------------------------------------------------*/ -extern int MatrixTimesVector(double *A, /* left matrix operand */ -double *B, /* right vector operand */ -double *X, /* resulting vector */ -long Lines, /* matrix height */ -long Columns /* matrix width and vector height */ -) - -/* perform the matrix/vector multiplication X = A.B */ -/* the size of A is (Lines x Columns) */ -/* the size of B is (Columns x 1) */ -/* the size of X is (Lines x 1) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin MatrixTimesVector */ - - double *p; - double Sum; - long i, j; - int Status = !ERROR; - - /**/DEBUG_CHECK_NULL_POINTER(MatrixTimesVector, A, Status, - /**/"Empty input left operand") - /**/DEBUG_CHECK_NULL_POINTER(MatrixTimesVector, B, Status, - /**/"Empty input right operand") - /**/DEBUG_CHECK_NULL_POINTER(MatrixTimesVector, X, Status, - /**/"Missing result") - /**/DEBUG_CHECK_RANGE_LONG(MatrixTimesVector, Lines, 1L, LONG_MAX, Status, - /**/"Invalid Lines (should be strictly positive)") - /**/DEBUG_CHECK_RANGE_LONG(MatrixTimesVector, Columns, 1L, LONG_MAX, Status, - /**/"Invalid Columns (should be strictly positive)") - /**/DEBUG_RETURN_ON_ERROR(MatrixTimesVector, Status) - /**/DEBUG_WRITE_ENTERING(MatrixTimesVector, - /**/"About to multiply two matrices together") - - for (i = Lines; (0L < i); i--) { - Sum = 0.0; - p = B; - for (j = Columns; (0L < j); j--) { - Sum += *A++ * *p++; - } - *X++ = Sum; - } - /**/DEBUG_WRITE_LEAVING(MatrixTimesVector, "Done") - return (Status); -} /* end MatrixTimesVector */ - -/*--------------------------------------------------------------------------*/ -extern int MatrixTranspose(double *A, /* input matrix */ -double *At, /* transposed output matrix */ -long Lines, /* height input, width output */ -long Columns /* width input, height output */ -) - -/* perform the transposition of a matrix */ -/* the size of the input matrix A is (Lines x Columns) */ -/* the size of the output matrix At is (Columns x Lines) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin MatrixTranspose */ - - double *p; - long i, j; - int Status = !ERROR; - - /**/DEBUG_CHECK_NULL_POINTER(MatrixTranspose, A, Status, - /**/"No input") - /**/DEBUG_CHECK_NULL_POINTER(MatrixTranspose, At, Status, - /**/"Missing output") - /**/DEBUG_CHECK_RANGE_LONG(MatrixTranspose, Lines, 1L, LONG_MAX, Status, - /**/"Invalid Lines (should be strictly positive)") - /**/DEBUG_CHECK_RANGE_LONG(MatrixTranspose, Columns, 1L, LONG_MAX, Status, - /**/"Invalid Columns (should be strictly positive)") - /**/DEBUG_RETURN_ON_ERROR(MatrixTranspose, Status) - /**/DEBUG_WRITE_ENTERING(MatrixTranspose, - /**/"About to transpose a matrix") - - for (i = Lines; (0L < i); i--) { - p = At++; - for (j = Columns; (0L < j); j--) { - *p = *A++; - p += (ptrdiff_t) Lines; - } - } - /**/DEBUG_WRITE_LEAVING(MatrixTranspose, "Done") - return (Status); -} /* end MatrixTranspose */ - -/*--------------------------------------------------------------------------*/ -int multiply_3Matrices(double *A, /* left matrix operand */ -double *B, /* middle maxtrix operand */ -double *C, /* right maxtrix operand */ -double *X, /* resulting matrix */ -long Lines, /* height (left and resulting) */ -long CommonSizeH, /* left width and middle hight */ -long CommonSizeW, /* right hight and middle width */ -long Columns /* width (right and resulting) */) { - - double *Help; - - Help = (double *) malloc((size_t) (Columns * CommonSizeH) * sizeof(double)); - if (Help == (double *) NULL) { - WRITE_ERROR(multiply_3Matrices, "ERROR - Not enough memory for Help"); - return (ERROR); - } - - if (MatrixMultiply(B, C, Help, CommonSizeH, CommonSizeW, Columns) == ERROR) { - WRITE_ERROR(multiply_3Matrices, "Error returned by MatrixMultiply"); - return (ERROR); - } - if (MatrixMultiply(A, Help, X, Lines, CommonSizeH, Columns) == ERROR) { - WRITE_ERROR(multiply_3Matrices, "Error returned by MatrixMultiply"); - return (ERROR); - } - - free(Help); - - return (!ERROR); -} -/*--------------------------------------------------------------------------*/ -int multiply_4Matrices(double *A, /* first matrix operand */ -double *B, /* second maxtrix operand */ -double *C, /* third maxtrix operand */ -double *D, /* fourth maxtrix operand */ -double *X, /* resulting matrix */ -long Lines, /* height (first and resulting) */ -long CommonSizeH1,/* first width and second hight */ -long CommonSizeW1,/* third hight and second width */ -long CommonSizeW2,/* fourth hight and third width */ -long Columns /* width (fourth and resulting) */) { - - /* Multiplies 3 matrices: X = A.B.C.D */ - /* the size of A is (Lines x CommonSizeH1) */ - /* the size of B is (CommonSizeH1 x CommonSizeW1) */ - /* the size of C is (CommonSizeW1 x CommonSizeW2) */ - /* the size of D is (CommonSizeW2 x Columns) */ - /* The size of X is (Lines x Columns) */ - double *Help; - - Help - = (double *) malloc( - (size_t) (CommonSizeH1 * Columns) * sizeof(double)); - if (Help == (double *) NULL) { - WRITE_ERROR(multiply_3Matrices, "ERROR - Not enough memory for Help"); - return (ERROR); - } - - if (multiply_3Matrices(B, C, D, Help, CommonSizeH1, CommonSizeW1, - CommonSizeW2, Columns) == ERROR) { - WRITE_ERROR(multiply_4Matrices, "Error returned by multiply_3Matrices"); - return (ERROR); - } - if (MatrixMultiply(A, Help, X, Lines, CommonSizeH1, Columns) == ERROR) { - WRITE_ERROR(multiply_3Matrices, "Error returned by MatrixMultiply"); - return (ERROR); - } - - free(Help); - - return (!ERROR); -}/* End of multiply_4Matrices */ -/*--------------------------------------------------------------------------*/ -int multiply_5Matrices(double *A, /* first matrix operand */ -double *B, /* second maxtrix operand */ -double *C, /* third maxtrix operand */ -double *D, /* fourth maxtrix operand */ -double *E, /* fifth maxtrix operand */ -double *X, /* resulting matrix */ -long Lines, /* height (first and resulting) */ -long CommonSizeH1,/* first width and second hight */ -long CommonSizeW1,/* third hight and second width */ -long CommonSizeW2,/* fourth hight and third width */ -long CommonSizeH2,/* fifth hight and fourth width */ -long Columns /* width (fourth and resulting) */) { - - /* Multiplies 3 matrices: X = A.B.C.D.E */ - /* the size of A is (Lines x CommonSizeH1) */ - /* the size of B is (CommonSizeH1 x CommonSizeW1) */ - /* the size of C is (CommonSizeW1 x CommonSizeW2) */ - /* the size of D is (CommonSizeW2 x CommonSizeH2) */ - /* the size of E is (CommonSizeH2 x Columns) */ - /* The size of X is (Lines x Columns) */ - double *Help; - - Help - = (double *) malloc( - (size_t) (CommonSizeH1 * Columns) * sizeof(double)); - if (Help == (double *) NULL) { - WRITE_ERROR(multiply_5Matrices, "ERROR - Not enough memory for Help"); - return (ERROR); - } - - if (multiply_4Matrices(B, C, D, E, Help, CommonSizeH1, CommonSizeW1, - CommonSizeW2, CommonSizeH2, Columns) == ERROR) { - WRITE_ERROR(multiply_5Matrices, "Error returned by multiply_4Matrices"); - return (ERROR); - } - if (MatrixMultiply(A, Help, X, Lines, CommonSizeH1, Columns) == ERROR) { - WRITE_ERROR(multiply_5Matrices, "Error returned by MatrixMultiply"); - return (ERROR); - } - - free(Help); - - return (!ERROR); -}/* End of multiply_5Matrices */ - -/*--------------------------------------------------------------------------*/ -extern int QRdecomposition(double *Q, /* in-place matrix */ -double *R, /* output matrix */ -long Lines, /* height the matrix */ -long Columns, /* width of the matrix */ -double Tolerance, /* admissible relative error */ -int *Status /* error management */ -) - -/* decompose the (Lines x Columns) input matrix Q into an orthonormal */ -/* output matrix Q of same size (Lines x Columns) and an upper-diagonal */ -/* square matrix R of size (Columns x Columns), such that the matrix */ -/* product (Q * R) gives the input matrix, and such that the matrix */ -/* product (Q^T * Q) gives the identity. */ -/* requirement: Columns <= Lines */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin QRdecomposition */ - - double *A; - double *a, *b, *c, *p, *q, *u, *v; - double s; - long i, j, k; - - *Status = !ERROR; - - /**/DEBUG_CHECK_NULL_POINTER(QRdecomposition, Q, *Status, - /**/"No input matrix Q") - /**/DEBUG_CHECK_NULL_POINTER(QRdecomposition, R, *Status, - /**/"No output matrix R") - /**/DEBUG_CHECK_RANGE_LONG(QRdecomposition, Lines, 1L, LONG_MAX, *Status, - /**/"Invalid size (should be strictly positive)") - /**/DEBUG_CHECK_RANGE_LONG(QRdecomposition, Columns, 1L, Lines, *Status, - /**/"Invalid size (should be [0 < Columns <= Lines])") - /**/DEBUG_CHECK_RANGE_DOUBLE(QRdecomposition, Tolerance, 0.0, DBL_MAX, *Status, - /**/"Invalid Tolerance (should be positive)") - /**/DEBUG_RETURN_ON_ERROR(QRdecomposition, *Status) - /**/DEBUG_WRITE_ENTERING(QRdecomposition, - /**/"About to a QR decomposition") - - AllocateMatrix(&A, Lines, Columns, Status); - if (*Status == ERROR) { - /**/DEBUG_WRITE_LEAVING(QRdecomposition, "Done") - return (*Status); - } - a = (double *) memcpy(A, Q, - (size_t) (Lines * Columns * (long) sizeof(double))); - u = Q; - for (j = 0L; (j < Columns); a++, u++, j++) { - p = Q; - for (k = j; (0 < k); k--) { - s = 0.0; - b = a; - q = p++; - for (i = Lines; (0 < i); i--) { - s += *b * *q; - b += (ptrdiff_t) Columns; - q += (ptrdiff_t) Columns; - } - v = u + (ptrdiff_t) (Lines * Columns); - for (i = Lines; (0 < i); i--) { - q -= (ptrdiff_t) Columns; - v -= (ptrdiff_t) Columns; - *v -= s * *q; - } - } - s = 0.0; - v = u; - for (i = Lines; (0 < i); i--) { - s += *v * *v; - v += (ptrdiff_t) Columns; - } - if ((s * s) < Tolerance) { - s = 0.0; - } else { - s = 1.0 / sqrt((double) s); - } - for (i = Lines; (0 < i); i--) { - v -= (ptrdiff_t) Columns; - *v *= s; - } - } - a = A; - for (i = 0L; (i < Columns); Q++, i++) { - for (j = 0; (j < i); j++) { - *R++ = 0.0; - } - b = a++; - for (j = i; (j < Columns); j++) { - s = 0.0; - c = b++; - q = Q; - for (k = 0L; (k < Lines); k++) { - s += *q * *c; - c += (ptrdiff_t) Columns; - q += (ptrdiff_t) Columns; - } - *R++ = s; - } - } - *Status = FreeMatrix(&A); - /**/DEBUG_WRITE_LEAVING(QRdecomposition, "Done") - return (*Status); -} /* end QRdecomposition */ - -/*--------------------------------------------------------------------------*/ -extern int SingularValueBackSubstitution(double *U, /* input matrix */ -double W[], /* vector of singular values */ -double *V, /* untransposed orthogonal matrix */ -long Lines, /* height the matrix */ -long Columns, /* width of the matrix */ -double B[], /* input vector */ -double X[], /* returned solution */ -int *Status /* error management */ -) - -/* solve (U.W.Transpose(V)).X == B in terms of X */ -/* {U, W, V} are given by SingularValueDecomposition */ -/* by convention, set w[i,j]=0 to get (1/w[i,j])=0 */ -/* the size of the input matrix U is (Lines x Columns) */ -/* the size of the vector (1/W) of singular values is (Columns) */ -/* the size of the untransposed orthogonal matrix V is (Columns x Columns) */ -/* the size of the input vector B is (Columns) */ -/* the size of the output vector X is (Columns) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin SingularValueBackSubstitution */ - - double *Workspace = (double *) NULL; - double *p, *q, *r; - double s; - long i, j; - - *Status = !ERROR; - - /**/DEBUG_CHECK_NULL_POINTER(SingularValueBackSubstitution, U, *Status, - /**/"No input matrix") - /**/DEBUG_CHECK_NULL_POINTER(SingularValueBackSubstitution, W, *Status, - /**/"No input singular values") - /**/DEBUG_CHECK_NULL_POINTER(SingularValueBackSubstitution, V, *Status, - /**/"No input untransposed orthogonal matrix") - /**/DEBUG_CHECK_NULL_POINTER(SingularValueBackSubstitution, B, *Status, - /**/"No input vector") - /**/DEBUG_CHECK_NULL_POINTER(SingularValueBackSubstitution, X, *Status, - /**/"No output vector") - /**/DEBUG_CHECK_RANGE_LONG(SingularValueBackSubstitution, Lines, 1L, LONG_MAX, *Status, - /**/"Invalid size (should be strictly positive)") - /**/DEBUG_CHECK_RANGE_LONG(SingularValueBackSubstitution, Columns, 1L, LONG_MAX, *Status, - /**/"Invalid size (should be strictly positive)") - /**/DEBUG_RETURN_ON_ERROR(SingularValueBackSubstitution, *Status) - /**/DEBUG_WRITE_ENTERING(SingularValueBackSubstitution, - /**/"About to perform SVD back substitution") - - AllocateVector(&Workspace, Columns, Status); - if (*Status == ERROR) { - /**/DEBUG_WRITE_LEAVING(SingularValueBackSubstitution, "Done") - return (*Status); - } - q = Workspace; - for (j = Columns; (0L < j); W++, j--) { - s = 0.0; - r = U++; - if (*W != 0.0) { - p = B; - for (i = Lines; (0L < i); i--) { - s += *r * *p++; - r += (ptrdiff_t) Columns; - } - s /= *W; - } - *q++ = s; - } - for (i = Columns; (0L < i); i--) { - s = 0.0; - q = Workspace; - for (j = Columns; (0L < j); j--) { - s += *V++ * *q++; - } - *X++ = s; - } - *Status = FreeVector(&Workspace); - /**/DEBUG_WRITE_LEAVING(SingularValueBackSubstitution, "Done") - return (*Status); -} /* end SingularValueBackSubstitution */ - -#include - -/*--------------------------------------------------------------------------*/ -extern int SingularValueDecomposition(double *U, /* input matrix (in-place processing) */ -long Lines, /* height the matrix */ -long Columns, /* width of the matrix */ -double W[], /* resulting vector of singular values */ -double *V, /* untransposed orthogonal matrix */ -long MaxIterations, /* convergence limit */ -int *Status /* error management */ -) - -/* decomposition of the input matrix into U.W.Transpose(V) */ -/* the size of the input matrix U is (Lines x Columns) */ -/* the singular values are returned in the vector W of size (Columns) */ -/* the size of the returned untransposed orthogonal matrix V is (Columns x Columns) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin SingularValueDecomposition */ - - double *rv1 = (double *) NULL; - double Norm, Scale; - double c, f, g, h, s; - double x, y, z; - long i, its, j, jj, k, l = 0L, nm = 0L; - int Flag; - - *Status = !ERROR; - - /**/DEBUG_CHECK_NULL_POINTER(SingularValueDecomposition, U, *Status, - /**/"No input matrix") - /**/DEBUG_CHECK_NULL_POINTER(SingularValueDecomposition, W, *Status, - /**/"No output singular values") - /**/DEBUG_CHECK_NULL_POINTER(SingularValueDecomposition, V, *Status, - /**/"No output matrix") - /**/DEBUG_CHECK_RANGE_LONG(SingularValueDecomposition, Lines, 1L, LONG_MAX, *Status, - /**/"Invalid size (should be strictly positive)") - /**/DEBUG_CHECK_RANGE_LONG(SingularValueDecomposition, Columns, 1L, LONG_MAX, *Status, - /**/"Invalid size (should be strictly positive)") - /**/DEBUG_CHECK_RANGE_LONG(SingularValueDecomposition, MaxIterations, 1L, LONG_MAX, *Status, - /**/"Invalid iterations (should be strictly positive)") - /**/DEBUG_RETURN_ON_ERROR(SingularValueDecomposition, *Status) - /**/DEBUG_WRITE_ENTERING(SingularValueDecomposition, - /**/"About to decompose a matrix into singular values") - - AllocateMatrix(&rv1, Columns, Columns, Status); - if (*Status == ERROR) { - /**/DEBUG_WRITE_LEAVING(SingularValueDecomposition, "Done") - return (*Status); - } - - g = Scale = Norm = 0.0; - for (i = 0L; (i < Columns); i++) { - l = i + 1L; - rv1[i] = Scale * g; - g = s = Scale = 0.0; - if (i < Lines) { - for (k = i; (k < Lines); k++) { - Scale += fabs(U[k * Columns + i]); - } - if (Scale != 0.0) { - double iScale = 1.0 / Scale; - if (!isinf(iScale) && !isnan(iScale)) { - for (k = i; (k < Lines); k++) { - long ki = k * Columns + i; - U[ki] *= iScale; - s += U[ki] * U[ki]; - } - long ii = i * Columns + i; - f = U[ii]; - g = (0.0 <= f) ? (-sqrt(s)) : (sqrt(s)); - h = f * g - s; - U[ii] = f - g; - for (j = l; (j < Columns); j++) { - double *ptrUi = &U[i * Columns + i]; - double *ptrUj = &U[i * Columns + j]; - for (s = 0.0, k = i; (k < Lines); k++, ptrUi += Columns, ptrUj - += Columns) { - s += (*ptrUi) * (*ptrUj); - } - f = s / h; - ptrUi = &U[i * Columns + i]; - ptrUj = &U[i * Columns + j]; - for (k = i; (k < Lines); k++, ptrUi += Columns, ptrUj - += Columns) { - *ptrUj += f * *ptrUi; - } - } - for (k = i; (k < Lines); k++) { - U[k * Columns + i] *= Scale; - } - } - } - } - W[i] = Scale * g; - g = s = Scale = 0.0; - if ((i < Lines) && (i != (Columns - 1L))) { - for (k = l; (k < Columns); k++) { - Scale += fabs(U[i * Columns + k]); - } - if (Scale != 0.0) { - double iScale = 1.0 / Scale; - if (!isinf(iScale) && !isnan(iScale)) { - for (k = l; (k < Columns); k++) { - long ik = i * Columns + k; - U[ik] *= iScale; - s += U[ik] * U[ik]; - } - long il = i * Columns + l; - f = U[il]; - g = (0.0 <= f) ? (-sqrt(s)) : (sqrt(s)); - h = f * g - s; - U[il] = f - g; - double ih = 1.0 / h; - for (k = l; (k < Columns); k++) { - rv1[k] = U[i * Columns + k] * ih; - } - for (j = l; (j < Lines); j++) { - double *ptrUj = &U[j * Columns + l]; - double *ptrUi = &U[i * Columns + l]; - for (s = 0.0, k = l; (k < Columns); ++k, ++ptrUi, ++ptrUj) { - s += (*ptrUj) * (*ptrUi); - } - ptrUj = &U[j * Columns + l]; - for (k = l; (k < Columns); ++k, ++ptrUj) { - *ptrUj += s * rv1[k]; - } - } - for (k = l; (k < Columns); k++) { - U[i * Columns + k] *= Scale; - } - } - } - } - Norm = ((fabs(W[i]) + fabs(rv1[i])) < Norm) ? (Norm) : (fabs(W[i]) - + fabs(rv1[i])); - } - for (i = Columns - 1L; (0L <= i); i--) { - if (i < (Columns - 1L)) { - if (g != 0.0) { - for (j = l; (j < Columns); j++) { - double denominator=U[i * Columns+ l] * g; - double idenominator=1.0/(denominator); - if (!isinf(idenominator) && !isnan(idenominator)) - V[j * Columns + i] = U[i * Columns + j] * idenominator; - else - V[j * Columns + i] = (denominator>=0)?-1:1; - } - for (j = l; (j < Columns); j++) { - for (s = 0.0, k = l; (k < Columns); k++) { - s += U[i * Columns + k] * V[k * Columns + j]; - } - for (k = l; (k < Columns); k++) { - if (s != 0.0) { - V[k * Columns + j] += s * V[k * Columns + i]; - } - } - } - } - for (j = l; (j < Columns); j++) { - V[i * Columns + j] = V[j * Columns + i] = 0.0; - } - } - V[i * Columns + i] = 1.0; - g = rv1[i]; - l = i; - } - for (i = (Lines < Columns) ? (Lines - 1L) : (Columns - 1L); (0L <= i); i--) { - l = i + 1L; - g = W[i]; - for (j = l; (j < Columns); j++) { - U[i * Columns + j] = 0.0; - } - if (g != 0.0) { - g = 1.0 / g; - for (j = l; (j < Columns); j++) { - double *ptrUi = &U[l * Columns + i]; - double *ptrUj = &U[l * Columns + j]; - for (s = 0.0, k = l; (k < Lines); k++, ptrUi += Columns, ptrUj - += Columns) { - s += (*ptrUi) * (*ptrUj); - } - f = s * g / U[i * Columns + i]; - if (f != 0.0) { - ptrUi = &U[i * Columns + i]; - ptrUj = &U[i * Columns + j]; - for (k = i; (k < Lines); k++, ptrUi += Columns, ptrUj - += Columns) { - *ptrUj += f * (*ptrUi); - } - } - } - for (j = i; (j < Lines); j++) { - U[j * Columns + i] *= g; - } - } else { - for (j = i; (j < Lines); j++) { - U[j * Columns + i] = 0.0; - } - } - U[i * Columns + i] += 1.0; - } - for (k = Columns - 1L; (0L <= k); k--) { - for (its = 1L; (its <= MaxIterations); its++) { - Flag = TRUE; - for (l = k; (0L <= l); l--) { - nm = l - 1L; - if ((fabs(rv1[l]) + Norm) == Norm) { - Flag = FALSE; - break; - } - if ((fabs(W[nm]) + Norm) == Norm) { - break; - } - } - if (Flag) { - c = 0.0; - s = 1.0; - for (i = l; (i <= k); i++) { - f = s * rv1[i]; - rv1[i] *= c; - if ((fabs(f) + Norm) == Norm) { - break; - } - g = W[i]; - h = Pythag(f, g); - W[i] = h; - h = 1.0 / h; - c = g * h; - s = -f * h; - for (j = 0L; (j < Lines); j++) { - long jnm = j * Columns + nm; - long ji = j * Columns + i; - y = U[jnm]; - z = U[ji]; - U[jnm] = y * c + z * s; - U[ji] = z * c - y * s; - } - } - } - z = W[k]; - if (l == k) { - if (z < 0.0) { - W[k] = -z; - for (j = 0L; (j < Columns); j++) { - long jk = j * Columns + k; - V[jk] = -V[jk]; - } - } - break; - } - if (its == MaxIterations) { - *Status = ERROR; - FreeMatrix(&rv1); - //WRITE_ERROR(SingularValueDecomposition, "No convergence") - /**/DEBUG_WRITE_LEAVING(SingularValueDecomposition, "Done") - return (*Status); - } - x = W[l]; - nm = k - 1L; - y = W[nm]; - g = rv1[nm]; - h = rv1[k]; - f = ((y - z) * (y + z) + (g - h) * (g + h)) / (2.0 * h * y); - g = Pythag(f, 1.0); - f = ((x - z) * (x + z) + h * ((y / (f + ((0.0 <= f) ? (fabs(g)) - : (-fabs(g))))) - h)) / x; - c = s = 1.0; - for (j = l; (j <= nm); j++) { - i = j + 1L; - g = rv1[i]; - y = W[i]; - h = s * g; - g = c * g; - z = Pythag(f, h); - rv1[j] = z; - double iz = 1.0 / z; - c = f * iz; - s = h * iz; - f = x * c + g * s; - g = g * c - x * s; - h = y * s; - y *= c; - for (jj = 0L; (jj < Columns); jj++) { - long jjj = jj * Columns + j; - long jji = jj * Columns + i; - x = V[jjj]; - z = V[jji]; - V[jjj] = x * c + z * s; - V[jji] = z * c - x * s; - } - z = Pythag(f, h); - W[j] = z; - if (z != 0.0) { - z = 1.0 / z; - c = f * z; - s = h * z; - } - f = c * g + s * y; - x = c * y - s * g; - for (jj = 0L; (jj < Lines); jj++) { - long jjj = jj * Columns + j; - long jji = jj * Columns + i; - y = U[jjj]; - z = U[jji]; - U[jjj] = y * c + z * s; - U[jji] = z * c - y * s; - } - } - rv1[l] = 0.0; - rv1[k] = f; - W[k] = x; - } - } - *Status = FreeMatrix(&rv1); - /**/DEBUG_WRITE_LEAVING(SingularValueDecomposition, "Done") - return (*Status); -} /* end SingularValueDecomposition */ - -/*--------------------------------------------------------------------------*/ -extern int SquareMatrixDeterminant(double *A, /* input square matrix */ -long Size, /* height or width of the square matrix */ -double *Determinant, /* resulting scalar determinant */ -int *Status /* error management */ -) - -/* compute the determinant of a square matrix */ -/* the size of the input matrix A is (Size x Size) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin SquareMatrixDeterminant */ - - double *B = (double *) NULL; - double Det; - double a0, a1, a2, a3, a4, a5; - long i; - - *Status = !ERROR; - - /**/DEBUG_CHECK_NULL_POINTER(SquareMatrixDeterminant, A, *Status, - /**/"Missing input") - /**/DEBUG_CHECK_NULL_POINTER(SquareMatrixDeterminant, Determinant, *Status, - /**/"Missing output") - /**/DEBUG_CHECK_RANGE_LONG(SquareMatrixDeterminant, Size, 1L, LONG_MAX, *Status, - /**/"Invalid size (should be strictly positive)") - /**/DEBUG_RETURN_ON_ERROR(SquareMatrixDeterminant, *Status) - /**/DEBUG_WRITE_ENTERING(SquareMatrixDeterminant, - /**/"About to compute a determinant") - - switch (Size) { - case 1L: - *Determinant = *A; - break; - case 2L: - *Determinant = A[0] * A[3] - A[1] * A[2]; - break; - case 3L: - *Determinant = A[0] * A[4] * A[8] + A[1] * A[5] * A[6] + A[2] * A[3] - * A[7] - A[0] * A[5] * A[7] - A[1] * A[3] * A[8] - A[2] * A[4] - * A[6]; - break; - case 4L: - a0 = A[10] * A[15] - A[11] * A[14]; - a1 = A[11] * A[13] - A[9] * A[15]; - a2 = A[9] * A[14] - A[10] * A[13]; - a3 = A[8] * A[15] - A[11] * A[12]; - a4 = A[10] * A[12] - A[8] * A[14]; - a5 = A[8] * A[13] - A[9] * A[12]; - *Determinant = A[0] * A[5] * a0 + A[0] * A[6] * a1 + A[0] * A[7] * a2 - + A[1] * A[6] * a3 + A[1] * A[7] * a4 + A[2] * A[7] * a5 - A[1] - * A[4] * a0 - A[2] * A[4] * a1 - A[2] * A[5] * a3 - A[3] * A[4] - * a2 - A[3] * A[5] * a4 - A[3] * A[6] * a5; - break; - default: - *Determinant = 0.0; - AllocateMatrix(&B, Size - 1L, Size - 1L, Status); - if (*Status == ERROR) { - /**/DEBUG_WRITE_LEAVING(SquareMatrixDeterminant, "Done") - return (*Status); - } - for (i = 0L; (i < Size); i++) { - *Status = MatrixMinor(A, B, Size, Size, 0L, i); - if (*Status == ERROR) { - FreeMatrix(&B); - /**/DEBUG_WRITE_LEAVING(SquareMatrixDeterminant, "Done") - return (*Status); - } - SquareMatrixDeterminant(B, Size - 1L, &Det, Status); - if (*Status == ERROR) { - FreeMatrix(&B); - /**/DEBUG_WRITE_LEAVING(SquareMatrixDeterminant, "Done") - return (*Status); - } - if ((i & 1L) != 0L) { - *Determinant -= A[i] * Det; - } else { - *Determinant += A[i] * Det; - } - } - *Status = FreeMatrix(&B); - break; - } - /**/DEBUG_WRITE_LEAVING(SquareMatrixDeterminant, "Done") - return (*Status); -} /* end SquareMatrixDeterminant */ - -/*--------------------------------------------------------------------------*/ -extern int SquareMatrixInvertGauss(double *Direct, /* input matrix */ -double *Inverse, /* resulting matrix */ -long Size, /* height or width of the square matrix */ -double Tolerance, /* admissible relative error */ -int *Status /* error management */ -) - -/* compute the inverse of a square matrix such that Direct.Inverse = Identity */ -/* the size of the matrices Direct and Inverse is (Size x Size) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin SquareMatrixInvertGauss */ - - double *Workspace = (double *) NULL; - double *p, *q, *r, *s, *t, *u, *v; - double AbsMax, Max; - double Swap, Gain; - long i, j, k; - - *Status = !ERROR; - - /**/DEBUG_CHECK_NULL_POINTER(SquareMatrixInvertGauss, Direct, *Status, - /**/"No input matrix") - /**/DEBUG_CHECK_NULL_POINTER(SquareMatrixInvertGauss, Inverse, *Status, - /**/"No output matrix") - /**/DEBUG_CHECK_RANGE_LONG(SquareMatrixInvertGauss, Size, 1L, LONG_MAX, *Status, - /**/"Invalid size (should be strictly positive)") - /**/DEBUG_CHECK_RANGE_DOUBLE(SquareMatrixInvertGauss, Tolerance, 0.0, DBL_MAX, *Status, - /**/"Invalid Tolerance (should be positive)") - /**/DEBUG_RETURN_ON_ERROR(SquareMatrixInvertGauss, *Status) - /**/DEBUG_WRITE_ENTERING(SquareMatrixInvertGauss, - /**/"About to invert a matrix by Gauss-Jordan") - - /* Workspace allocation */ - AllocateMatrix(&Workspace, Size, Size, Status); - if (*Status == ERROR) { - /**/DEBUG_WRITE_LEAVING(SquareMatrixInvertGauss, "Done") - return (*Status); - } - Workspace = (double *) memcpy(Workspace, Direct, - (size_t) (Size * Size * (long) sizeof(double))); - /* Null matrix */ - q = Inverse; - for (i = Size; (0L < i); i--) { - for (j = Size; (0L < j); j--) { - *q++ = 0.0; - } - } - /* Normalize */ - p = Workspace; - q = Inverse; - r = p; - for (i = 0L; (i < Size); i++) { - Max = *p++; - AbsMax = fabs(Max); - for (j = 1L; (j < Size); p++, j++) { - if (AbsMax < fabs(*p)) { - Max = *p; - AbsMax = fabs(Max); - } - } - if (AbsMax < Tolerance) { - *Status = ERROR; - FreeMatrix(&Workspace); -WRITE_ERROR (SquareMatrixInvertGauss, "Singular matrix") - /**/DEBUG_WRITE_LEAVING(SquareMatrixInvertGauss, "Done") - return(*Status); - } - Max = 1.0 / Max; - q[i] = Max; - for (j = Size; (0L < j); j--) { - *r++ *= Max; - } - q += (ptrdiff_t)Size; -} -p = Workspace; -u = Workspace; -v = Inverse; -for (j = 0L; (j < Size); j++) { - /* Select pivot */ - q = p++; - r = q; - Max = *r; - AbsMax = fabs(Max); - r += (ptrdiff_t)Size; - for (i = 1L; (i < (Size - j)); i++) { - if (AbsMax < fabs(*r)) { - Max = *r; - AbsMax = fabs(Max); - q = r; - } - r += (ptrdiff_t)Size; - } - if (AbsMax < Tolerance) { - *Status = ERROR; - FreeMatrix(&Workspace); - WRITE_ERROR(SquareMatrixInvertGauss, "Singular matrix") - /**/DEBUG_WRITE_LEAVING(SquareMatrixInvertGauss, "Done") - return(*Status); - } - Max = 1.0 / Max; - /* Permute lines */ - q -= (ptrdiff_t)j; - if (q != u) { - r = u; - t = v; - s = t + (q - r); - for (i = 0L; (i < Size); i++) { - Swap = *r; - *r++ = *q; - *q++ = Swap; - Swap = *t; - *t++ = *s; - *s++ = Swap; - } - } - /* Subtract line */ - q = Workspace + (ptrdiff_t)j; - r = Inverse; - for (i = 0L; (i < j); i++) { - Gain = *q * Max; - s = u + (ptrdiff_t)j; - t = v; - for (k = 0L; (k < j); k++) { - *r++ -= Gain * *t++; - } - while (k++ < Size) { - *q++ -= Gain * *s++; - *r++ -= Gain * *t++; - } - q += (ptrdiff_t)j; - } - i++; - q += (ptrdiff_t)Size; - r += (ptrdiff_t)Size; - while (i++ < Size) { - Gain = *q * Max; - s = u + (ptrdiff_t)j; - t = v; - for (k = 0L; (k < j); k++) { - *r++ -= Gain * *t++; - } - while (k++ < Size) { - *q++ -= Gain * *s++; - *r++ -= Gain * *t++; - } - q += (ptrdiff_t)j; - } - p += (ptrdiff_t)Size; - u += (ptrdiff_t)Size; - v += (ptrdiff_t)Size; -} -/* Re-normalize */ -p = Workspace; -q = Inverse; -for (i = Size; (0L < i); i--) { - Gain = 1.0 / *p++; - for (j = Size; (0L < j); j--) { - *q++ *= Gain; - } - p += (ptrdiff_t)Size; -} -*Status = FreeMatrix(&Workspace); -/**/DEBUG_WRITE_LEAVING(SquareMatrixInvertGauss, "Done") -return(*Status); -} /* end SquareMatrixInvertGauss */ - -/*--------------------------------------------------------------------------*/ -extern int SquareMatrixSquareRoot(double *A, /* input matrix */ -double *B, /* output matrix and initial solution */ -long Size, /* height or width of the square matrix */ -double Tolerance, /* admissible relative error */ -long MaxIterations, /* convergence limit */ -int *Status /* error management */ -) - -/* compute one out of the 2^Size square roots B of a matrix A such that B.B = A */ -/* the size of the matrices A and B is (Size x Size) */ -/* B must provide an initial solution */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin SquareMatrixSquareRoot */ - - double *x, *y, *z; - double *R = (double *) NULL, *X = (double *) NULL, *Y = (double *) NULL, - *Z = (double *) NULL; - double Err, Eps, OldEps, Norm; - long Iteration; - long i, j; - - *Status = !ERROR; - - /**/DEBUG_CHECK_NULL_POINTER(SquareMatrixSquareRoot, A, *Status, - /**/"Empty input") - /**/DEBUG_CHECK_NULL_POINTER(SquareMatrixSquareRoot, B, *Status, - /**/"Empty output") - /**/DEBUG_CHECK_RANGE_LONG(SquareMatrixSquareRoot, Size, 1L, LONG_MAX, *Status, - /**/"Invalid size (should be strictly positive)") - /**/DEBUG_CHECK_RANGE_LONG(SquareMatrixSquareRoot, MaxIterations, 1L, LONG_MAX, *Status, - /**/"Invalid iterations (should be strictly positive)") - /**/DEBUG_CHECK_RANGE_DOUBLE(SquareMatrixSquareRoot, Tolerance, 0.0, DBL_MAX, *Status, - /**/"Invalid Tolerance (should be positive)") - /**/DEBUG_RETURN_ON_ERROR(SquareMatrixSquareRoot, *Status) - /**/DEBUG_WRITE_ENTERING(SquareMatrixSquareRoot, - /**/"About to compute one square root of a matrix") - - *Status = FrobeniusNorm(A, &Norm, Size, Size); - if (*Status == ERROR) { - /**/DEBUG_WRITE_LEAVING(SquareMatrixSquareRoot, "Done") - return (*Status); - } - if (Norm < Tolerance) { - for (i = Size; (0L < i); i--) { - for (j = Size; (0L < j); j--) { - *B++ = 0.0; - } - } - /**/DEBUG_WRITE_LEAVING(SquareMatrixSquareRoot, "Done") - return (*Status); - } - AllocateMatrix(&R, Size, Size, Status); - if (*Status == ERROR) { - /**/DEBUG_WRITE_LEAVING(SquareMatrixSquareRoot, "Done") - return (*Status); - } - AllocateMatrix(&X, Size, Size, Status); - if (*Status == ERROR) { - FreeMatrix(&R); - /**/DEBUG_WRITE_LEAVING(SquareMatrixSquareRoot, "Done") - return (*Status); - } - AllocateMatrix(&Y, Size, Size, Status); - if (*Status == ERROR) { - FreeMatrix(&X); - FreeMatrix(&R); - /**/DEBUG_WRITE_LEAVING(SquareMatrixSquareRoot, "Done") - return (*Status); - } - AllocateMatrix(&Z, Size, Size, Status); - if (*Status == ERROR) { - FreeMatrix(&Y); - FreeMatrix(&X); - FreeMatrix(&R); - /**/DEBUG_WRITE_LEAVING(SquareMatrixSquareRoot, "Done") - return (*Status); - } - Iteration = 0L; - Z = (double *) memcpy(Z, B, (size_t) (Size * Size * (long) sizeof(double))); - OldEps = DBL_MAX; - do { - SquareMatrixInvertGauss(Z, R, Size, Tolerance, Status); - if (*Status == ERROR) { - FreeMatrix(&Z); - FreeMatrix(&Y); - FreeMatrix(&X); - FreeMatrix(&R); - /**/DEBUG_WRITE_LEAVING(SquareMatrixSquareRoot, "Done") - return (*Status); - } - *Status = MatrixMultiply(R, A, X, Size, Size, Size); - if (*Status == ERROR) { - FreeMatrix(&Z); - FreeMatrix(&Y); - FreeMatrix(&X); - FreeMatrix(&R); - /**/DEBUG_WRITE_LEAVING(SquareMatrixSquareRoot, "Done") - return (*Status); - } - *Status = MatrixMultiply(A, R, Y, Size, Size, Size); - if (*Status == ERROR) { - FreeMatrix(&Z); - FreeMatrix(&Y); - FreeMatrix(&X); - FreeMatrix(&R); - /**/DEBUG_WRITE_LEAVING(SquareMatrixSquareRoot, "Done") - return (*Status); - } - x = X; - y = Y; - z = Z; - for (i = Size; (0L < i); i--) { - for (j = Size; (0L < j); j--) { - *z += *z + *x++ + *y++; - *z++ *= 0.25; - } - } - *Status = MatrixMultiply(Z, Z, X, Size, Size, Size); - if (*Status == ERROR) { - FreeMatrix(&Z); - FreeMatrix(&Y); - FreeMatrix(&X); - FreeMatrix(&R); - /**/DEBUG_WRITE_LEAVING(SquareMatrixSquareRoot, "Done") - return (*Status); - } - z = A; - x = X; - Eps = 0.0; - for (i = Size; (0L < i); i--) { - for (j = Size; (0L < j); j--) { - Err = *z++ - *x++; - Eps += Err * Err; - } - } - Eps = sqrt(Eps); - Eps /= Norm; - if (Eps <= OldEps) { - B = (double *) memcpy(B, Z, - (size_t) (Size * Size * (long) sizeof(double))); - OldEps = Eps; - } - Iteration++; - } while ((Tolerance < Eps) && (Iteration < MaxIterations)); - *Status = FreeMatrix(&Z); - if (*Status == ERROR) { - FreeMatrix(&Y); - FreeMatrix(&X); - FreeMatrix(&R); - /**/DEBUG_WRITE_LEAVING(SquareMatrixSquareRoot, "Done") - return (*Status); - } - *Status = FreeMatrix(&Y); - if (*Status == ERROR) { - FreeMatrix(&X); - FreeMatrix(&R); - /**/DEBUG_WRITE_LEAVING(SquareMatrixSquareRoot, "Done") - return (*Status); - } - *Status = FreeMatrix(&X); - if (*Status == ERROR) { - FreeMatrix(&R); - /**/DEBUG_WRITE_LEAVING(SquareMatrixSquareRoot, "Done") - return (*Status); - } - *Status = FreeMatrix(&R); - /**/DEBUG_WRITE_LEAVING(SquareMatrixSquareRoot, "Done") - return (*Status); -} /* end SquareMatrixSquareRoot */ - -/*--------------------------------------------------------------------------*/ -extern int SquareMatrixTrace(double *A, /* input matrix */ -double *Trace, /* resulting scalar trace */ -long Size /* height or width of the square matrix */ -) - -/* perform the vector cross product X = A x B */ -/* the size of A is (Size x Size) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin SquareMatrixTrace */ - - double Sum; - long i; - int Status = !ERROR; - - /**/DEBUG_CHECK_NULL_POINTER(SquareMatrixTrace, A, Status, - /**/"Empty input") - /**/DEBUG_CHECK_NULL_POINTER(SquareMatrixTrace, Trace, Status, - /**/"Empty output") - /**/DEBUG_CHECK_RANGE_LONG(SquareMatrixTrace, Size, 1L, LONG_MAX, Status, - /**/"Invalid size (should be strictly positive)") - /**/DEBUG_RETURN_ON_ERROR(SquareMatrixTrace, Status) - /**/DEBUG_WRITE_ENTERING(SquareMatrixTrace, - /**/"About to compute the trace of a matrix") - - Sum = 0.0; - for (i = -Size; (i < 0L); i++) { - Sum += *A++; - A += (ptrdiff_t) Size; - } - *Trace = Sum; - /**/DEBUG_WRITE_LEAVING(SquareMatrixTrace, "Done") - return (Status); -} /* end SquareMatrixTrace */ - -/*--------------------------------------------------------------------------*/ -extern int Vector3DcrossProduct(double A[], /* left vector operand */ -double B[], /* right vector operand */ -double X[] /* resulting vector */ -) - -/* perform the vector cross product X = A x B */ -/* the size of A, B and X is (3 x 1) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin Vector3DcrossProduct */ - - int Status = !ERROR; - - /**/DEBUG_CHECK_NULL_POINTER(Vector3DcrossProduct, A, Status, - /**/"Empty input left operand") - /**/DEBUG_CHECK_NULL_POINTER(Vector3DcrossProduct, B, Status, - /**/"Empty input right operand") - /**/DEBUG_CHECK_NULL_POINTER(Vector3DcrossProduct, X, Status, - /**/"Missing result") - /**/DEBUG_RETURN_ON_ERROR(Vector3DcrossProduct, Status) - /**/DEBUG_WRITE_ENTERING(Vector3DcrossProduct, - /**/"About to compute a cross product") - - *X++ = A[1] * B[2] - A[2] * B[1]; - *X++ = A[2] * B[0] - A[0] * B[2]; - *X = A[0] * B[1] - A[1] * B[0]; - /**/DEBUG_WRITE_LEAVING(Vector3DcrossProduct, "Done") - return (Status); -} /* end Vector3DcrossProduct */ - -/*--------------------------------------------------------------------------*/ -extern int VectorAdd(double A[], /* left vector operand */ -double B[], /* right vector operand */ -double X[], /* resulting vector */ -long Lines /* height of the vectors */ -) - -/* perform the vector addition X = A + B */ -/* the vectors A, B and X have (Lines) elements */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin VectorAdd */ - - long i; - int Status = !ERROR; - - /**/DEBUG_CHECK_NULL_POINTER(VectorAdd, A, Status, - /**/"Empty input left operand") - /**/DEBUG_CHECK_NULL_POINTER(VectorAdd, B, Status, - /**/"Empty input right operand") - /**/DEBUG_CHECK_NULL_POINTER(VectorAdd, X, Status, - /**/"Missing result") - /**/DEBUG_CHECK_RANGE_LONG(VectorAdd, Lines, 1L, LONG_MAX, Status, - /**/"Invalid Lines (should be strictly positive)") - /**/DEBUG_RETURN_ON_ERROR(VectorAdd, Status) - /**/DEBUG_WRITE_ENTERING(VectorAdd, - /**/"About to add two vectors") - - for (i = Lines; (0L < i); i--) { - *X++ = *A++ + *B++; - } - /**/DEBUG_WRITE_LEAVING(VectorAdd, "Done") - return (Status); -} /* end VectorAdd */ - -/*--------------------------------------------------------------------------*/ -extern int VectorAngle(double A[], /* 1st input vector */ -double B[], /* 2nd input vector */ -double *Angle, /* resulting scalar angle in rad */ -long Lines, /* height of the vectors */ -double Tolerance /* admissible relative error */ -) - -/* compute the angle between two vectors */ -/* the size of A and B is (Lines x 1) */ -/* the angle unit is radian */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin VectorAngle */ - - double NormA, NormB, Sum; - long i; - int Status = !ERROR; - - /**/DEBUG_CHECK_NULL_POINTER(VectorAngle, A, Status, - /**/"Empty input A") - /**/DEBUG_CHECK_NULL_POINTER(VectorAngle, B, Status, - /**/"Empty input B") - /**/DEBUG_CHECK_NULL_POINTER(VectorAngle, Angle, Status, - /**/"Missing result") - /**/DEBUG_CHECK_RANGE_LONG(VectorAngle, Lines, 1L, LONG_MAX, Status, - /**/"Invalid Lines (should be strictly positive)") - /**/DEBUG_CHECK_RANGE_DOUBLE(VectorAngle, Tolerance, 0.0, DBL_MAX, Status, - /**/"Invalid Tolerance (should be positive)") - /**/DEBUG_RETURN_ON_ERROR(VectorAngle, Status) - /**/DEBUG_WRITE_ENTERING(VectorAngle, - /**/"About to compute the angle between {A,B}") - - NormA = 0.0; - NormB = 0.0; - Sum = 0.0; - for (i = Lines; (0L < i); i--) { - NormA += *A * *A; - NormB += *B * *B; - Sum += *A++ * *B++; - } - NormA = sqrt(NormA); - NormB = sqrt(NormB); - NormA *= NormB; - if (NormA < Tolerance) { -WRITE_WARNING (VectorAngle, "Undefined angle") - /**/DEBUG_WRITE_LEAVING(VectorAngle, "Done") - return(Status); -} -Sum /= NormA; -if ((Sum < -1.0) || (1.0 < Sum)) { - Status = ERROR; - WRITE_ERROR(VectorAngle, "Unexpected numeric error") - /**/DEBUG_WRITE_LEAVING(VectorAngle, "Done") - return(Status); -} -*Angle = acos(Sum); -/**/DEBUG_WRITE_LEAVING(VectorAngle, "Done") -return(Status); -} /* end VectorAngle */ - -/*--------------------------------------------------------------------------*/ -extern int VectorHomogenize(double A[], /* input vector */ -double X[], /* output homogenous vector */ -long Lines, /* height of the vectors */ -double Tolerance /* admissible relative error */ -) - -/* convert a vector from non-homogenous to homogenous coordinates */ -/* satisfy (Vout = a * Vin) such that (Vout[last] = 1.0) */ -/* the size of A and X is (Lines x 1) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin VectorHomogenize */ - - double Scale; - long i; - int Status = !ERROR; - - /**/DEBUG_CHECK_NULL_POINTER(VectorHomogenize, A, Status, - /**/"Empty input A") - /**/DEBUG_CHECK_NULL_POINTER(VectorHomogenize, X, Status, - /**/"Empty output X") - /**/DEBUG_CHECK_RANGE_LONG(VectorHomogenize, Lines, 1L, LONG_MAX, Status, - /**/"Invalid Lines (should be strictly positive)") - /**/DEBUG_CHECK_RANGE_DOUBLE(VectorHomogenize, Tolerance, 0.0, DBL_MAX, Status, - /**/"Invalid Tolerance (should be positive)") - /**/DEBUG_RETURN_ON_ERROR(VectorHomogenize, Status) - /**/DEBUG_WRITE_ENTERING(VectorHomogenize, - /**/"About to convert a vector into homogenous coordinates") - - Scale = A[Lines - 1L]; - if (fabs(Scale) < Tolerance) { - Status = ERROR; -WRITE_ERROR (VectorHomogenize, - "Unable to perform conversion in homogenous coordinates") - /**/DEBUG_WRITE_LEAVING(VectorHomogenize, "Done") - return(Status); -} -Scale = 1.0 / Scale; -for (i = Lines - 1L; (0L < i); i--) { - *X++ = Scale * *A++; -} -*X = 1.0; -/**/DEBUG_WRITE_LEAVING(VectorHomogenize, "Done") -return(Status); -} /* end VectorHomogenize */ - -/*--------------------------------------------------------------------------*/ -extern int VectorNorm(double A[], /* input vector */ -double *Norm, /* resulting scalar norm */ -long Lines /* height of the vector */ -) - -/* compute the norm of a vector */ -/* the size of A is (Lines x 1) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin VectorNorm */ - - double Sum; - long i; - int Status = !ERROR; - - /**/DEBUG_CHECK_NULL_POINTER(VectorNorm, A, Status, - /**/"Empty input A") - /**/DEBUG_CHECK_NULL_POINTER(VectorNorm, Norm, Status, - /**/"Missing result") - /**/DEBUG_CHECK_RANGE_LONG(VectorNorm, Lines, 1L, LONG_MAX, Status, - /**/"Invalid Lines (should be strictly positive)") - /**/DEBUG_RETURN_ON_ERROR(VectorNorm, Status) - /**/DEBUG_WRITE_ENTERING(VectorNorm, - /**/"About to compute the norm of a vector") - - Sum = 0.0; - for (i = Lines; (0L < i); i--) { - Sum += *A * *A; - A++; - } - *Norm = sqrt(Sum); - /**/DEBUG_WRITE_LEAVING(VectorNorm, "Done") - return (Status); -} /* end VectorNorm */ - -/*--------------------------------------------------------------------------*/ -extern int VectorNormalize(double A[], /* input vector */ -double X[], /* resulting normalized vector */ -long Lines /* height of the vector */ -) - -/* normalize of a vector to unit length */ -/* the size of A and X is (Lines x 1) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin VectorNormalize */ - - double *p; - double Sum; - long i; - int Status = !ERROR; - - /**/DEBUG_CHECK_NULL_POINTER(VectorNormalize, A, Status, - /**/"Empty input A") - /**/DEBUG_CHECK_NULL_POINTER(VectorNormalize, X, Status, - /**/"Missing result") - /**/DEBUG_CHECK_RANGE_LONG(VectorNormalize, Lines, 1L, LONG_MAX, Status, - /**/"Invalid Lines (should be strictly positive)") - /**/DEBUG_RETURN_ON_ERROR(VectorNormalize, Status) - /**/DEBUG_WRITE_ENTERING(VectorNormalize, - /**/"About to compute the norm of a vector") - - p = A; - Sum = 0.0; - for (i = Lines; (0L < i); i--) { - Sum += *p * *p; - p++; - } - Sum = sqrt(Sum); - if (Sum == 0.0) { -WRITE_WARNING (VectorNormalize, "Degenerate vector") -} -else { - Sum = 1.0 / Sum; -} -for (i = Lines; (0L < i); i--) { - *X++ = Sum * *A++; -} -/**/DEBUG_WRITE_LEAVING(VectorNormalize, "Done") -return(Status); -} /* end VectorNormalize */ - -/*--------------------------------------------------------------------------*/ -extern int VectorScalarProduct(double A[], /* left vector operand */ -double B[], /* right vector operand */ -double *X, /* resulting scalar product */ -long Lines /* height of the vector */ -) - -/* perform the vector scalar product X = Transpose(A).B */ -/* the size of A and B is (Lines x 1) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin VectorScalarProduct */ - - double Sum; - long i; - int Status = !ERROR; - - /**/DEBUG_CHECK_NULL_POINTER(VectorScalarProduct, A, Status, - /**/"Empty input left operand") - /**/DEBUG_CHECK_NULL_POINTER(VectorScalarProduct, B, Status, - /**/"Empty input right operand") - /**/DEBUG_CHECK_NULL_POINTER(VectorScalarProduct, X, Status, - /**/"Missing result") - /**/DEBUG_CHECK_RANGE_LONG(VectorScalarProduct, Lines, 1L, LONG_MAX, Status, - /**/"Invalid Lines (should be strictly positive)") - /**/DEBUG_RETURN_ON_ERROR(VectorScalarProduct, Status) - /**/DEBUG_WRITE_ENTERING(VectorScalarProduct, - /**/"About to compute the scalar product of two vectors") - - Sum = 0.0; - for (i = Lines; (0L < i); i--) { - Sum += *A++ * *B++; - } - *X = Sum; - /**/DEBUG_WRITE_LEAVING(VectorScalarProduct, "Done") - return (Status); -} /* end VectorScalarProduct */ - -/*--------------------------------------------------------------------------*/ -extern int VectorScale(double A[], /* input vector */ -double X[], /* output vector */ -double Scale, /* scale factor */ -long Lines /* height of the vector */ -) - -/* scale a vector */ -/* satisfy (Vout = Scale * Vin) */ -/* the size of A and X is (Lines x 1) */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin VectorScale */ - - int Status = !ERROR; - - /**/DEBUG_CHECK_NULL_POINTER(VectorScale, A, Status, - /**/"Empty input A") - /**/DEBUG_CHECK_NULL_POINTER(VectorScale, X, Status, - /**/"Empty output X") - /**/DEBUG_CHECK_RANGE_LONG(VectorScale, Lines, 1L, LONG_MAX, Status, - /**/"Invalid Lines (should be strictly positive)") - /**/DEBUG_RETURN_ON_ERROR(VectorScale, Status) - /**/DEBUG_WRITE_ENTERING(VectorScale, - /**/"About to scale a vector") - - while (Lines-- > 0L) { - *X++ = Scale * *A++; - } - /**/DEBUG_WRITE_LEAVING(VectorScale, "Done") - return (Status); -} /* end VectorScale */ - -/*--------------------------------------------------------------------------*/ -extern int VectorSubtract(double A[], /* left vector operand */ -double B[], /* right vector operand */ -double X[], /* resulting vector */ -long Lines /* height of the vectors */ -) - -/* perform the vector subtraction X = A - B */ -/* the vectors A, B and X have (Lines) elements */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin VectorSubtract */ - - long i; - int Status = !ERROR; - - /**/DEBUG_CHECK_NULL_POINTER(VectorSubtract, A, Status, - /**/"Empty input left operand") - /**/DEBUG_CHECK_NULL_POINTER(VectorSubtract, B, Status, - /**/"Empty input right operand") - /**/DEBUG_CHECK_NULL_POINTER(VectorSubtract, X, Status, - /**/"Missing result") - /**/DEBUG_CHECK_RANGE_LONG(VectorSubtract, Lines, 1L, LONG_MAX, Status, - /**/"Invalid Lines (should be strictly positive)") - /**/DEBUG_RETURN_ON_ERROR(VectorSubtract, Status) - /**/DEBUG_WRITE_ENTERING(VectorSubtract, - /**/"About to subtract two vectors") - - for (i = Lines; (0L < i); i--) { - *X++ = *A++ - *B++; - } - /**/DEBUG_WRITE_LEAVING(VectorSubtract, "Done") - return (Status); -} /* end VectorSubtract */ - diff --git a/src/core/bilib/linearalgebra.h b/src/core/bilib/linearalgebra.h deleted file mode 100644 index 36f4b9d..0000000 --- a/src/core/bilib/linearalgebra.h +++ /dev/null @@ -1,405 +0,0 @@ -#ifndef _LINEARALGEBRA -#define _LINEARALGEBRA -/**@defgroup BilibLinearAlgebra Linear algebra - @ingroup BilibLibrary */ -//@{ -/*--------------------------------------------------------------------------*/ -extern int AllocateMatrix - ( - double **Matrix, /* double output pointer */ - long Lines, /* width of the matrix */ - long Columns, /* height of the matrix */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -extern int AllocateVector - ( - double *(Vector[]), /* double output pointer */ - long Lines, /* height of the vector */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -extern int FreeMatrix - ( - double **Matrix /* (double)matrix array */ - ); - -/*--------------------------------------------------------------------------*/ -extern int FreeVector - ( - double *(Vector[]) /* (double)vector array */ - ); - -/*--------------------------------------------------------------------------*/ -/** Compute the Frobenius norm of the matrix A. - The size of A is (Lines x Columns). - success: return(!ERROR); failure: return(ERROR) */ -extern int FrobeniusNorm - ( - double *A, /* input matrix */ - double *Norm, /* resulting scalar norm */ - long Lines, /* height of the matrix A */ - long Columns /* width of the matrix A */ - ); - -/*--------------------------------------------------------------------------*/ -extern int GetIdentitySquareMatrix - ( - double *A, /* output identity matrix */ - long Size /* height or width of the square matrix */ - ); - -/*--------------------------------------------------------------------------*/ -extern int LinearLeastSquares - ( - double *A, /* matrix */ - long Lines, /* height the matrix */ - long Columns, /* width of the matrix */ - double B[], /* right-hand side vector */ - double X[], /* resulting vector */ - double Tolerance, /* admissible relative error */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -extern int MatrixAdd - ( - double *A, /* left matrix operand */ - double *B, /* right matrix operand */ - double *X, /* resulting matrix */ - long Lines, /* height of the matrices */ - long Columns /* width of the matrices */ - ); - -/*--------------------------------------------------------------------------*/ -/** Compute the condition number of the matrix A. - The size of A is (Lines x Columns). - ConditionNumber = -1.0 indicates a singular matrix. - - success: return(!ERROR); failure: return(ERROR) */ -extern int MatrixConditionNumber - ( - double *A, /* input matrix */ - long Lines, /* height of the matrix A */ - long Columns, /* width of the matrix A */ - double *ConditionNumber, /* resulting scalar condition number */ - double Tolerance, /* admissible relative error */ - long MaxIterations, /* convergence limit */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Orthonormalize a matrix. - The size of A and B is (Lines x Columns). - The orthogonalization proceeds row-wise. - - success: return(!ERROR); failure: return(ERROR) */ -extern int MatrixGramSchmidtOrthonormalize - ( - double *A, /* input matrix */ - double *B, /* resulting matrix */ - long Lines, /* height of the matrix A */ - long Columns, /* width of the matrix A */ - double Tolerance /* admissible relative error */ - ); - -/*--------------------------------------------------------------------------*/ -/** Extract a minor matrix B from the major matrix A. - The size of A is (Lines x Columns). - The size of B is ((Lines - 1) x (Columns - 1)). - The line to delete is i (indexing starts from 0). - The column to delete is j (indexing starts from 0). - - success: return(!ERROR); failure: return(ERROR) */ -extern int MatrixMinor - ( - double *A, /* input matrix */ - double *B, /* smaller output matrix */ - long Lines, /* height of the matrix A */ - long Columns, /* width of the matrix A */ - long i, /* line to delete */ - long j /* column to delete */ - ); - -/*--------------------------------------------------------------------------*/ -extern int MatrixMultiply - ( - double *A, /* left matrix operand */ - double *B, /* right matrix operand */ - double *X, /* resulting matrix */ - long Lines, /* height (left and resulting) */ - long CommonSize, /* left width and right height */ - long Columns /* width (right and resulting) */ - ); - -/*--------------------------------------------------------------------------*/ -/** Compute the rank of the matrix A. - The size of A is (Lines x Columns). - - success: return(!ERROR); failure: return(ERROR) */ -extern int MatrixRank - ( - double *A, /* input square matrix */ - long Lines, /* height of the matrix A */ - long Columns, /* width of the matrix A */ - long *Rank, /* resulting scalar condition number */ - double Tolerance, /* admissible relative error */ - long MaxIterations, /* convergence limit */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -extern int MatrixSubtract - ( - double *A, /* left matrix operand */ - double *B, /* right matrix operand */ - double *X, /* resulting matrix */ - long Lines, /* height of the matrices */ - long Columns /* width of the matrices */ - ); - -/*--------------------------------------------------------------------------*/ -extern int MatrixTimesVector - ( - double *A, /* left matrix operand */ - double *B, /* right vector operand */ - double *X, /* resulting vector */ - long Lines, /* matrix height */ - long Columns /* matrix width and vector height */ - ); - -/*--------------------------------------------------------------------------*/ -extern int MatrixTranspose - ( - double *A, /* input matrix */ - double *At, /* transposed output matrix */ - long Lines, /* height input, width output */ - long Columns /* width input, height output */ - ); - -/*--------------------------------------------------------------------------*/ -/** Multiply 3 Matrices. - X=A*B*C; A is of size Lines x CommonSizeH, - B is of size CommonSizeH x CommonSizeW, - C is of size CommonSizeW x Columns. - Finally, X is of size Lines x Columns. -*/ -int multiply_3Matrices(double *A, - double *B, - double *C, - double *X, - long Lines, - long CommonSizeH, - long CommonSizeW, - long Columns - ); - -int multiply_4Matrices( double *A, - double *B, - double *C, - double *D, - double *X, - long Lines, - long CommonSizeH1, - long CommonSizeW1, - long CommonSizeW2, - long Columns); - -int multiply_5Matrices( double *A, - double *B, - double *C, - double *D, - double *E, - double *X, - long Lines, - long CommonSizeH1, - long CommonSizeW1, - long CommonSizeW2, - long CommonSizeH2, - long Columns ); - -/*--------------------------------------------------------------------------*/ -/** Decompose the (Lines x Columns) input matrix Q into an orthonormal. - Output matrix Q of same size (Lines x Columns) and an upper-diagonal. - Square matrix R of size (Columns x Columns), such that the matrix. - Product (Q * R) gives the input matrix, and such that the matrix. - Product (Q^T * Q) gives the identity. - - requirement: Columns <= Lines - - success: return(!ERROR); failure: return(ERROR) */ -extern int QRdecomposition - ( - double *Q, /* in-place matrix */ - double *R, /* output matrix */ - long Lines, /* height the matrix */ - long Columns, /* width of the matrix */ - double Tolerance, /* admissible relative error */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -extern int SingularValueBackSubstitution - ( - double *U, /* input matrix (in-place processing) */ - double W[], /* vector of singular values */ - double *V, /* untransposed orthogonal matrix */ - long Lines, /* height the matrix */ - long Columns, /* width of the matrix */ - double B[], /* input vector */ - double X[], /* returned solution */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -#define SVDMAXITER 1000 -extern int SingularValueDecomposition - ( - double *U, /* input matrix (in-place processing) */ - long Lines, /* height the matrix */ - long Columns, /* width of the matrix */ - double W[], /* resulting vector of singular values */ - double *V, /* untransposed orthogonal matrix */ - long MaxIterations, /* convergence limit */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -extern int SquareMatrixDeterminant - ( - double *A, /* input square matrix */ - long Size, /* height or width of the square matrix */ - double *Determinant, /* resulting scalar determinant */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -extern int SquareMatrixInvertGauss - ( - double *Direct, /* input matrix */ - double *Inverse, /* resulting matrix */ - long Size, /* height or width of the square matrix */ - double Tolerance, /* admissible relative error */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Compute one out of the 2^Size square roots B of a matrix A such that - B.B = A. - The size of the matrices A and B is (Size x Size). - B must provide an initial solution. - - success: return(!ERROR); failure: return(ERROR) */ -extern int SquareMatrixSquareRoot - ( - double *A, /* input matrix */ - double *B, /* output matrix and initial solution */ - long Size, /* height or width of the square matrix */ - double Tolerance, /* admissible relative error */ - long MaxIterations, /* convergence limit */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Perform the vector cross product X = A x B. - The size of A is (Size x Size) - - success: return(!ERROR); failure: return(ERROR) */ -extern int SquareMatrixTrace - ( - double *A, /* input matrix */ - double *Trace, /* resulting scalar trace */ - long Size /* height or width of the square matrix */ - ); - -/*--------------------------------------------------------------------------*/ -extern int Vector3DcrossProduct - ( - double A[], /* left vector operand */ - double B[], /* right vector operand */ - double X[] /* resulting vector */ - ); - -/*--------------------------------------------------------------------------*/ -extern int VectorAdd - ( - double A[], /* left vector operand */ - double B[], /* right vector operand */ - double X[], /* resulting vector */ - long Lines /* height of the vectors */ - ); - -/*--------------------------------------------------------------------------*/ -/** Compute the angle between two vectors *(n-D). - The size of A and B is (Lines x 1). The angle unit is radian. - - success: return(!ERROR); failure: return(ERROR) */ -extern int VectorAngle - ( - double A[], /* 1st input vector */ - double B[], /* 2nd input vector */ - double *Angle, /* resulting scalar angle in rad */ - long Lines, /* height of the vectors */ - double Tolerance /* admissible relative error */ - ); - -/*--------------------------------------------------------------------------*/ -/** Convert a vector from non-homogenous to homogenous coordinates. - Satisfy (Vout = a * Vin) such that (Vout[last] = 1.0). - The size of A and X is (Lines x 1). - - success: return(!ERROR); failure: return(ERROR) */ -extern int VectorHomogenize - ( - double A[], /* input vector */ - double X[], /* output homogenous vector */ - long Lines, /* height of the vectors */ - double Tolerance /* admissible relative error */ - ); - -/*--------------------------------------------------------------------------*/ -extern int VectorNorm - ( - double A[], /* input vector */ - double *Norm, /* resulting scalar norm */ - long Lines /* height of the vector */ - ); - -/*--------------------------------------------------------------------------*/ -extern int VectorNormalize - ( - double A[], /* input vector */ - double X[], /* resulting normalized vector */ - long Lines /* height of the vector */ - ); - -/*--------------------------------------------------------------------------*/ -extern int VectorScalarProduct - ( - double A[], /* left vector operand */ - double B[], /* right vector operand */ - double *X, /* resulting scalar product */ - long Lines /* height of the vector */ - ); - -/*--------------------------------------------------------------------------*/ -extern int VectorScale - ( - double A[], /* input vector */ - double X[], /* output vector */ - double Scale, /* scale factor */ - long Lines /* height of the vector */ - ); - -/*--------------------------------------------------------------------------*/ -extern int VectorSubtract - ( - double A[], /* left vector operand */ - double B[], /* right vector operand */ - double X[], /* resulting vector */ - long Lines /* height of the vectors */ - ); -//@} -#endif diff --git a/src/core/bilib/messagedisplay.cc b/src/core/bilib/messagedisplay.cc deleted file mode 100644 index 7e6516b..0000000 --- a/src/core/bilib/messagedisplay.cc +++ /dev/null @@ -1,7 +0,0 @@ -#include - -extern int MessageDisplay(const char *_str) { - printf("%s\n",_str); - return 0; -} - diff --git a/src/core/bilib/messagedisplay.h b/src/core/bilib/messagedisplay.h deleted file mode 100644 index 889c11f..0000000 --- a/src/core/bilib/messagedisplay.h +++ /dev/null @@ -1,7 +0,0 @@ -/*--------------------------------------------------------------------------*/ -extern int MessageDisplay - ( - const char - *Message - ); - diff --git a/src/core/bilib/minmax.cc b/src/core/bilib/minmax.cc deleted file mode 100644 index c68a33a..0000000 --- a/src/core/bilib/minmax.cc +++ /dev/null @@ -1,207 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "minmax.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -#ifdef DEBUG -#include -#include -#include "messagedisplay.h" -#endif - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern double MaxDouble - ( - double Argument1, /* first argument */ - double Argument2 /* second argument */ - ) - -/* returns the most positive of a pair of double arguments */ - -{ /* begin MaxDouble */ - -/**/DEBUG_WRITE_ENTERING(MaxDouble, -/**/ "About to return the most positive of two (double)arguments") -/**/DEBUG_WRITE_LEAVING(MaxDouble, "Done") - return((Argument1 < Argument2) ? (Argument2) : (Argument1)); -} /* end MaxDouble */ - -/*--------------------------------------------------------------------------*/ -extern float MaxFloat - ( - float Argument1, /* first argument */ - float Argument2 /* second argument */ - ) - -/* returns the most positive of a pair of float arguments */ - -{ /* begin MaxFloat */ - -/**/DEBUG_WRITE_ENTERING(MaxFloat, -/**/ "About to return the most positive of two (float)arguments") -/**/DEBUG_WRITE_LEAVING(MaxFloat, "Done") - return((Argument1 < Argument2) ? (Argument2) : (Argument1)); -} /* end MaxFloat */ - -/*--------------------------------------------------------------------------*/ -extern int MaxInt - ( - int Argument1, /* first argument */ - int Argument2 /* second argument */ - ) - -/* returns the most positive of a pair of int arguments */ - -{ /* begin MaxInt */ - -/**/DEBUG_WRITE_ENTERING(MaxInt, -/**/ "About to return the most positive of two (int)arguments") -/**/DEBUG_WRITE_LEAVING(MaxInt, "Done") - return((Argument1 < Argument2) ? (Argument2) : (Argument1)); -} /* end MaxInt */ - -/*--------------------------------------------------------------------------*/ -extern long MaxLong - ( - long Argument1, /* first argument */ - long Argument2 /* second argument */ - ) - -/* returns the most positive of a pair of long arguments */ - -{ /* begin MaxLong */ - -/**/DEBUG_WRITE_ENTERING(MaxLong, -/**/ "About to return the most positive of two (long)arguments") -/**/DEBUG_WRITE_LEAVING(MaxLong, "Done") - return((Argument1 < Argument2) ? (Argument2) : (Argument1)); -} /* end MaxLong */ - -/*--------------------------------------------------------------------------*/ -extern short MaxShort - ( - short Argument1, /* first argument */ - short Argument2) /* second argument */ - -/* returns the most positive of a pair of short arguments */ - -{ /* begin MaxShort */ - -/**/DEBUG_WRITE_ENTERING(MaxShort, -/**/ "About to return the most positive of two (short)arguments") -/**/DEBUG_WRITE_LEAVING(MaxShort, "Done") - return((Argument1 < Argument2) ? (Argument2) : (Argument1)); -} /* end MaxShort */ - -/*--------------------------------------------------------------------------*/ -extern double MinDouble - ( - double Argument1, /* first argument */ - double Argument2 /* second argument */ - ) - -/* returns the most negative of a pair of double arguments */ - -{ /* begin MinDouble */ - -/**/DEBUG_WRITE_ENTERING(MinDouble, -/**/ "About to return the most negative of two (double)arguments") -/**/DEBUG_WRITE_LEAVING(MinDouble, "Done") - return((Argument1 < Argument2) ? (Argument1) : (Argument2)); -} /* end MinDouble */ - -/*--------------------------------------------------------------------------*/ -extern float MinFloat - ( - float Argument1, /* first argument */ - float Argument2 /* second argument */ - ) - -/* returns the most negative of a pair of float arguments */ - -{ /* begin MinFloat */ - -/**/DEBUG_WRITE_ENTERING(MinFloat, -/**/ "About to return the most negative of two (float)arguments") -/**/DEBUG_WRITE_LEAVING(MinFloat, "Done") - return((Argument1 < Argument2) ? (Argument1) : (Argument2)); -} /* end MinFloat */ - -/*--------------------------------------------------------------------------*/ -extern int MinInt - ( - int Argument1, /* first argument */ - int Argument2 /* second argument */ - ) - -/* returns the most negative of a pair of int arguments */ - -{ /* begin MinInt */ - -/**/DEBUG_WRITE_ENTERING(MinInt, -/**/ "About to return the most negative of two (int)arguments") -/**/DEBUG_WRITE_LEAVING(MinInt, "Done") - return((Argument1 < Argument2) ? (Argument1) : (Argument2)); -} /* end MinInt */ - -/*--------------------------------------------------------------------------*/ -extern long MinLong - ( - long Argument1, /* first argument */ - long Argument2 /* second argument */ - ) - -/* returns the most negative of a pair of long arguments */ - -{ /* begin MinLong */ - -/**/DEBUG_WRITE_ENTERING(MinLong, -/**/ "About to return the most negative of two (long)arguments") -/**/DEBUG_WRITE_LEAVING(MinLong, "Done") - return((Argument1 < Argument2) ? (Argument1) : (Argument2)); -} /* end MinLong */ - -/*--------------------------------------------------------------------------*/ -extern short MinShort - ( - short Argument1, /* first argument */ - short Argument2 /* second argument */ - ) - -/* returns the most negative of a pair of short arguments */ - -{ /* begin MinShort */ - -/**/DEBUG_WRITE_ENTERING(MinShort, -/**/ "About to return the most negative of two (short)arguments") -/**/DEBUG_WRITE_LEAVING(MinShort, "Done") - return((Argument1 < Argument2) ? (Argument1) : (Argument2)); -} /* end MinShort */ - diff --git a/src/core/bilib/minmax.h b/src/core/bilib/minmax.h deleted file mode 100644 index 42b2d4c..0000000 --- a/src/core/bilib/minmax.h +++ /dev/null @@ -1,70 +0,0 @@ -/*--------------------------------------------------------------------------*/ -extern double MaxDouble - ( - double Argument1, /* first argument */ - double Argument2 /* second argument */ - ); - -/*--------------------------------------------------------------------------*/ -extern float MaxFloat - ( - float Argument1, /* first argument */ - float Argument2 /* second argument */ - ); - -/*--------------------------------------------------------------------------*/ -extern int MaxInt - ( - int Argument1, /* first argument */ - int Argument2 /* second argument */ - ); - -/*--------------------------------------------------------------------------*/ -extern long MaxLong - ( - long Argument1, /* first argument */ - long Argument2 /* second argument */ - ); - -/*--------------------------------------------------------------------------*/ -extern short MaxShort - ( - short Argument1, /* first argument */ - short Argument2 /* second argument */ - ); - -/*--------------------------------------------------------------------------*/ -extern double MinDouble - ( - double Argument1, /* first argument */ - double Argument2 /* second argument */ - ); - -/*--------------------------------------------------------------------------*/ -extern float MinFloat - ( - float Argument1, /* first argument */ - float Argument2 /* second argument */ - ); - -/*--------------------------------------------------------------------------*/ -extern int MinInt - ( - int Argument1, /* first argument */ - int Argument2 /* second argument */ - ); - -/*--------------------------------------------------------------------------*/ -extern long MinLong - ( - long Argument1, /* first argument */ - long Argument2 /* second argument */ - ); - -/*--------------------------------------------------------------------------*/ -extern short MinShort - ( - short Argument1, /* first argument */ - short Argument2 /* second argument */ - ); - diff --git a/src/core/bilib/morphology.cc b/src/core/bilib/morphology.cc deleted file mode 100644 index 6ac21be..0000000 --- a/src/core/bilib/morphology.cc +++ /dev/null @@ -1,3435 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -#include -#include - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" -#include "error.h" -#include "tboundaryconvention.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "convert.h" -#include "fold.h" -#include "getput.h" -#include "messagedisplay.h" -#include "morphology.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -#ifdef DEBUG -#include -#endif - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -static int MaxFilterLine - ( - double *BufferIn, - double *BufferOut, - long Nx, - long Kx, - enum TBoundaryConvention - Convention - ); - -/*--------------------------------------------------------------------------*/ -static int MinFilterLine - ( - double *BufferIn, - double *BufferOut, - long Nx, - long Kx, - enum TBoundaryConvention - Convention - ); - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -static int MaxFilterLine - ( - double *BufferIn, - double *BufferOut, - long N, - long K, - enum TBoundaryConvention - Convention - ) - -{ /* begin MaxFilterLine */ - - double f, fmax; - long Ok = (K - 1L) / 2L; - long i, n, k; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(MaxFilterLine, BufferIn, Status, -/**/ "Missing BufferIn") -/**/DEBUG_CHECK_NULL_POINTER(MaxFilterLine, BufferOut, Status, -/**/ "Missing BufferOut") -/**/DEBUG_CHECK_RANGE_LONG(MaxFilterLine, N, 1L, LONG_MAX, Status, -/**/ "Invalid data width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MaxFilterLine, K, 1L, LONG_MAX, Status, -/**/ "Invalid kernel width (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(MaxFilterLine, Status) -/**/DEBUG_WRITE_ENTERING(MaxFilterLine, -/**/ "About to execute MaxFilterLine") - - switch (Convention) { - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - default: - Status = ERROR; - WRITE_ERROR(MaxFilterLine, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(MaxFilterLine, "Done") - return(Status); - } - for (n = Ok; (n < (N + Ok)); n++) { - Status = GetFoldedIndex(n, &i, N, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MaxFilterLine, "Done") - return(Status); - } - fmax = BufferIn[i]; - for (k = n + 1L - K; (k < n); k++) { - Status = GetFoldedIndex(k, &i, N, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MaxFilterLine, "Done") - return(Status); - } - f = BufferIn[i]; - fmax = (f < fmax) ? (fmax) : (f); - } - *BufferOut++ = fmax; - } -/**/DEBUG_WRITE_LEAVING(MaxFilterLine, "Done") - return(Status); -} /* end MaxFilterLine */ - -/*--------------------------------------------------------------------------*/ -static int MinFilterLine - ( - double *BufferIn, - double *BufferOut, - long N, - long K, - enum TBoundaryConvention - Convention - ) - -{ /* begin MinFilterLine */ - - double f, fmin; - long Ok = (K - 1L) / 2L; - long i, n, k; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(MinFilterLine, BufferIn, Status, -/**/ "Missing BufferIn") -/**/DEBUG_CHECK_NULL_POINTER(MinFilterLine, BufferOut, Status, -/**/ "Missing BufferOut") -/**/DEBUG_CHECK_RANGE_LONG(MinFilterLine, N, 1L, LONG_MAX, Status, -/**/ "Invalid data width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MinFilterLine, K, 1L, LONG_MAX, Status, -/**/ "Invalid kernel width (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(MinFilterLine, Status) -/**/DEBUG_WRITE_ENTERING(MinFilterLine, -/**/ "About to execute MinFilterLine") - - switch (Convention) { - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - default: - Status = ERROR; - WRITE_ERROR(MinFilterLine, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(MinFilterLine, "Done") - return(Status); - } - for (n = -Ok; (n < (N - Ok)); n++) { - Status = GetFoldedIndex(n, &i, N, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MinFilterLine, "Done") - return(Status); - } - fmin = BufferIn[i]; - for (k = n + 1L; (k < (n + K)); k++) { - Status = GetFoldedIndex(k, &i, N, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MinFilterLine, "Done") - return(Status); - } - f = BufferIn[i]; - fmin = (f < fmin) ? (f) : (fmin); - } - *BufferOut++ = fmin; - } -/**/DEBUG_WRITE_LEAVING(MinFilterLine, "Done") - return(Status); -} /* end MinFilterLine */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern int BrightTopHatFloat - ( - float *VolumeSource, /* data to process */ - float *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - float *Kernel, /* structural element */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - long Ox, /* kernel X origin */ - long Oy, /* kernel Y origin */ - long Oz, /* kernel Z origin */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ) - -/* perform the grey-scale morphological operation known as bright top hat */ -/* VolumeSource is the grey-scale volume to process */ -/* VolumeDestination is the resulting grey-scale volume */ -/* both VolumeSource and VolumeDestination have size (Nx, Ny, Nz) */ -/* Kernel is the grey-scale structural element by which VolumeSource is processed */ -/* (Kx, Ky, Kz) is the size (bounding box) of the structural element */ -/* (Ox, Oy, Oz) is the origin of the structural element */ -/* Convention is the boundary convention applied to VolumeSource before processing */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin BrightTopHatFloat */ - - float *p; - float *Opened = (float *)NULL; - long x, y, z; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(BrightTopHatFloat, VolumeSource, *Status, -/**/ "Missing VolumeSource") -/**/DEBUG_CHECK_NULL_POINTER(BrightTopHatFloat, VolumeDestination, *Status, -/**/ "Missing VolumeDestination") -/**/DEBUG_CHECK_NULL_POINTER(BrightTopHatFloat, Kernel, *Status, -/**/ "Missing Kernel") -/**/DEBUG_CHECK_RANGE_LONG(BrightTopHatFloat, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid data width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(BrightTopHatFloat, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid data height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(BrightTopHatFloat, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid data depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(BrightTopHatFloat, Kx, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(BrightTopHatFloat, Ky, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(BrightTopHatFloat, Kz, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(BrightTopHatFloat, *Status) -/**/DEBUG_WRITE_ENTERING(BrightTopHatFloat, -/**/ "About to execute BrightTopHatFloat") - - switch (Convention) { - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - default: - *Status = ERROR; - WRITE_ERROR(BrightTopHatFloat, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(BrightTopHatFloat, "Done") - return(*Status); - } - AllocateVolumeFloat(&Opened, Nx, Ny, Nz, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(BrightTopHatFloat, "Done") - return(*Status); - } - OpeningFloat(VolumeSource, Opened, Nx, Ny, Nz, Kernel, Kx, Ky, Kz, - Ox, Oy, Oz, Convention, Status); - if (*Status == ERROR) { - FreeVolumeFloat(&Opened); -/**/ DEBUG_WRITE_LEAVING(BrightTopHatFloat, "Done") - return(*Status); - } - p = Opened; - for (z = -Nz; (z < 0L); z++) { - for (y = -Ny; (y < 0L); y++) { - for (x = -Nx; (x < 0L); x++) { - *VolumeDestination++ = *VolumeSource++ - *p++; - } - } - } - *Status = FreeVolumeFloat(&Opened); -/**/DEBUG_WRITE_LEAVING(BrightTopHatFloat, "Done") - return(*Status); -} /* end BrightTopHatFloat */ - -/*--------------------------------------------------------------------------*/ -extern int BrightTopHatFloatCuboid - ( - float *Volume, /* data to process in-place */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ) - -/* perform a morphological grey-scale bright top hat filter using a cuboid as structural element */ -/* Volume is the grey-scale volume to process in-place */ -/* Volume has size (Nx, Ny, Nz) */ -/* (Kx, Ky, Kz) is the size of the structural element that is filled with the value 1.0F */ -/* the origin of the structural element is ((Kx - 1L) / 2L, (Ky - 1L) / 2L, (Kz - 1L) / 2L) */ -/* Convention is the boundary convention applied to Volume before processing */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin BrightTopHatFloatCuboid */ - - float *p; - float *Opened = (float *)NULL; - long x, y, z; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(BrightTopHatFloatCuboid, Volume, *Status, -/**/ "Missing Volume") -/**/DEBUG_CHECK_RANGE_LONG(BrightTopHatFloatCuboid, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid data width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(BrightTopHatFloatCuboid, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid data height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(BrightTopHatFloatCuboid, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid data depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(BrightTopHatFloatCuboid, Kx, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(BrightTopHatFloatCuboid, Ky, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(BrightTopHatFloatCuboid, Kz, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(BrightTopHatFloatCuboid, *Status) -/**/DEBUG_WRITE_ENTERING(BrightTopHatFloatCuboid, -/**/ "About to execute BrightTopHatFloatCuboid") - - switch (Convention) { - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - default: - *Status = ERROR; - WRITE_ERROR(BrightTopHatFloatCuboid, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(BrightTopHatFloatCuboid, "Done") - return(*Status); - } - AllocateVolumeFloat(&Opened, Nx, Ny, Nz, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(BrightTopHatFloatCuboid, "Done") - return(*Status); - } - memcpy(Opened, Volume, (size_t)(Nx * Ny * Nz * (long)sizeof(float))); - OpeningFloatCuboid(Opened, Nx, Ny, Nz, Kx, Ky, Kz, Convention, Status); - if (*Status == ERROR) { - FreeVolumeFloat(&Opened); -/**/ DEBUG_WRITE_LEAVING(BrightTopHatFloatCuboid, "Done") - return(*Status); - } - p = Opened; - for (z = -Nz; (z < 0L); z++) { - for (y = -Ny; (y < 0L); y++) { - for (x = -Nx; (x < 0L); x++) { - *Volume++ -= *p++; - } - } - } - *Status = FreeVolumeFloat(&Opened); -/**/DEBUG_WRITE_LEAVING(BrightTopHatFloatCuboid, "Done") - return(*Status); -} /* end BrightTopHatFloatCuboid */ - -/*--------------------------------------------------------------------------*/ -extern int BrightTopHatShort - ( - short *VolumeSource, /* data to process */ - short *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - short *Kernel, /* structural element */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - long Ox, /* kernel X origin */ - long Oy, /* kernel Y origin */ - long Oz, /* kernel Z origin */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ) - -/* perform the grey-scale morphological operation known as bright top hat */ -/* VolumeSource is the grey-scale volume to process */ -/* VolumeDestination is the resulting grey-scale volume */ -/* both VolumeSource and VolumeDestination have size (Nx, Ny, Nz) */ -/* Kernel is the grey-scale structural element by which VolumeSource is processed */ -/* (Kx, Ky, Kz) is the size (bounding box) of the structural element */ -/* (Ox, Oy, Oz) is the origin of the structural element */ -/* Convention is the boundary convention applied to VolumeSource before processing */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin BrightTopHatShort */ - - short *p; - short *Opened = (short *)NULL; - long x, y, z; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(BrightTopHatShort, VolumeSource, *Status, -/**/ "Missing VolumeSource") -/**/DEBUG_CHECK_NULL_POINTER(BrightTopHatShort, VolumeDestination, *Status, -/**/ "Missing VolumeDestination") -/**/DEBUG_CHECK_NULL_POINTER(BrightTopHatShort, Kernel, *Status, -/**/ "Missing Kernel") -/**/DEBUG_CHECK_RANGE_LONG(BrightTopHatShort, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid data width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(BrightTopHatShort, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid data height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(BrightTopHatShort, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid data depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(BrightTopHatShort, Kx, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(BrightTopHatShort, Ky, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(BrightTopHatShort, Kz, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(BrightTopHatShort, *Status) -/**/DEBUG_WRITE_ENTERING(BrightTopHatShort, -/**/ "About to execute BrightTopHatShort") - - switch (Convention) { - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - default: - *Status = ERROR; - WRITE_ERROR(BrightTopHatShort, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(BrightTopHatShort, "Done") - return(*Status); - } - AllocateVolumeShort(&Opened, Nx, Ny, Nz, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(BrightTopHatShort, "Done") - return(*Status); - } - OpeningShort(VolumeSource, Opened, Nx, Ny, Nz, Kernel, Kx, Ky, Kz, - Ox, Oy, Oz, Convention, Status); - if (*Status == ERROR) { - FreeVolumeShort(&Opened); -/**/ DEBUG_WRITE_LEAVING(BrightTopHatShort, "Done") - return(*Status); - } - p = Opened; - for (z = -Nz; (z < 0L); z++) { - for (y = -Ny; (y < 0L); y++) { - for (x = -Nx; (x < 0L); x++) { - *VolumeDestination++ = ConvertIntToShort((int)*VolumeSource++ - (int)*p++); - } - } - } - *Status = FreeVolumeShort(&Opened); -/**/DEBUG_WRITE_LEAVING(BrightTopHatShort, "Done") - return(*Status); -} /* end BrightTopHatShort */ - -/*--------------------------------------------------------------------------*/ -extern int BrightTopHatShortCuboid - ( - short *Volume, /* data to process in-place */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ) - -/* perform a morphological grey-scale bright top hat filter using a cuboid as structural element */ -/* Volume is the grey-scale volume to process in-place */ -/* Volume has size (Nx, Ny, Nz) */ -/* (Kx, Ky, Kz) is the size of the structural element that is filled with the value 1.0F */ -/* the origin of the structural element is ((Kx - 1L) / 2L, (Ky - 1L) / 2L, (Kz - 1L) / 2L) */ -/* Convention is the boundary convention applied to Volume before processing */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin BrightTopHatShortCuboid */ - - short *p; - short *Opened = (short *)NULL; - long x, y, z; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(BrightTopHatShortCuboid, Volume, *Status, -/**/ "Missing Volume") -/**/DEBUG_CHECK_RANGE_LONG(BrightTopHatShortCuboid, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid data width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(BrightTopHatShortCuboid, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid data height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(BrightTopHatShortCuboid, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid data depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(BrightTopHatShortCuboid, Kx, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(BrightTopHatShortCuboid, Ky, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(BrightTopHatShortCuboid, Kz, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(BrightTopHatShortCuboid, *Status) -/**/DEBUG_WRITE_ENTERING(BrightTopHatShortCuboid, -/**/ "About to execute BrightTopHatShortCuboid") - - switch (Convention) { - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - default: - *Status = ERROR; - WRITE_ERROR(BrightTopHatShortCuboid, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(BrightTopHatShortCuboid, "Done") - return(*Status); - } - AllocateVolumeShort(&Opened, Nx, Ny, Nz, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(BrightTopHatShortCuboid, "Done") - return(*Status); - } - memcpy(Opened, Volume, (size_t)(Nx * Ny * Nz * (long)sizeof(short))); - OpeningShortCuboid(Opened, Nx, Ny, Nz, Kx, Ky, Kz, Convention, Status); - if (*Status == ERROR) { - FreeVolumeShort(&Opened); -/**/ DEBUG_WRITE_LEAVING(BrightTopHatShortCuboid, "Done") - return(*Status); - } - p = Opened; - for (z = -Nz; (z < 0L); z++) { - for (y = -Ny; (y < 0L); y++) { - for (x = -Nx; (x < 0L); x++) { - *Volume++ -= *p++; - } - } - } - *Status = FreeVolumeShort(&Opened); -/**/DEBUG_WRITE_LEAVING(BrightTopHatShortCuboid, "Done") - return(*Status); -} /* end BrightTopHatShortCuboid */ - -/*--------------------------------------------------------------------------*/ -extern int ClosingFloat - ( - float *VolumeSource, /* data to process */ - float *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - float *Kernel, /* structural element */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - long Ox, /* kernel X origin */ - long Oy, /* kernel Y origin */ - long Oz, /* kernel Z origin */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ) - -/* perform the grey-scale morphological operation known as closing */ -/* VolumeSource is the grey-scale volume to close */ -/* VolumeDestination is the resulting grey-scale volume after closing */ -/* both VolumeSource and VolumeDestination have size (Nx, Ny, Nz) */ -/* Kernel is the grey-scale structural element by which VolumeSource is closed */ -/* (Kx, Ky, Kz) is the size (bounding box) of the structural element */ -/* (Ox, Oy, Oz) is the origin of the structural element */ -/* Convention is the boundary convention applied to VolumeSource before closing */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin ClosingFloat */ - - float *Buffer = (float *)NULL; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(ClosingFloat, VolumeSource, *Status, -/**/ "Missing VolumeSource") -/**/DEBUG_CHECK_NULL_POINTER(ClosingFloat, VolumeDestination, *Status, -/**/ "Missing VolumeDestination") -/**/DEBUG_CHECK_NULL_POINTER(ClosingFloat, Kernel, *Status, -/**/ "Missing Kernel") -/**/DEBUG_CHECK_RANGE_LONG(ClosingFloat, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid data width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ClosingFloat, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid data height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ClosingFloat, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid data depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ClosingFloat, Kx, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ClosingFloat, Ky, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ClosingFloat, Kz, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(ClosingFloat, *Status) -/**/DEBUG_WRITE_ENTERING(ClosingFloat, -/**/ "About to execute ClosingFloat") - - switch (Convention) { - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - default: - *Status = ERROR; - WRITE_ERROR(ClosingFloat, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(ClosingFloat, "Done") - return(*Status); - } - AllocateVolumeFloat(&Buffer, Nx, Ny, Nz, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ClosingFloat, "Done") - return(*Status); - } - *Status = DilateFloat(VolumeSource, Buffer, Nx, Ny, Nz, Kernel, Kx, Ky, Kz, - Ox, Oy, Oz, Convention); - if (*Status == ERROR) { - FreeVolumeFloat(&Buffer); -/**/ DEBUG_WRITE_LEAVING(ClosingFloat, "Done") - return(*Status); - } - *Status = ErodeFloat(Buffer, VolumeDestination, Nx, Ny, Nz, Kernel, Kx, Ky, Kz, - Ox, Oy, Oz, Convention); - if (*Status == ERROR) { - FreeVolumeFloat(&Buffer); -/**/ DEBUG_WRITE_LEAVING(ClosingFloat, "Done") - return(*Status); - } - *Status = FreeVolumeFloat(&Buffer); -/**/DEBUG_WRITE_LEAVING(ClosingFloat, "Done") - return(*Status); -} /* end ClosingFloat */ - -/*--------------------------------------------------------------------------*/ -extern int ClosingFloatCuboid - ( - float *Volume, /* data to process in-place */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ) - -/* perform a morphological grey-scale closing filter using a cuboid as structural element */ -/* Volume is the grey-scale volume to close in-place */ -/* Volume has size (Nx, Ny, Nz) */ -/* (Kx, Ky, Kz) is the size of the structural element that is filled with the value 1.0F */ -/* the origin of the structural element is ((Kx - 1L) / 2L, (Ky - 1L) / 2L, (Kz - 1L) / 2L) */ -/* Convention is the boundary convention applied to Volume before closing */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin ClosingFloatCuboid */ - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(ClosingFloatCuboid, Volume, *Status, -/**/ "Missing Volume") -/**/DEBUG_CHECK_RANGE_LONG(ClosingFloatCuboid, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid data width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ClosingFloatCuboid, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid data height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ClosingFloatCuboid, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid data depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ClosingFloatCuboid, Kx, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ClosingFloatCuboid, Ky, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ClosingFloatCuboid, Kz, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(ClosingFloatCuboid, *Status) -/**/DEBUG_WRITE_ENTERING(ClosingFloatCuboid, -/**/ "About to execute ClosingFloatCuboid") - - switch (Convention) { - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - default: - *Status = ERROR; - WRITE_ERROR(ClosingFloatCuboid, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(ClosingFloatCuboid, "Done") - return(*Status); - } - MaxFilterFloatCuboid(Volume, Nx, Ny, Nz, Kx, Ky, Kz, Convention, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ClosingFloatCuboid, "Done") - return(*Status); - } - MinFilterFloatCuboid(Volume, Nx, Ny, Nz, Kx, Ky, Kz, Convention, Status); -/**/DEBUG_WRITE_LEAVING(ClosingFloatCuboid, "Done") - return(*Status); -} /* end ClosingFloatCuboid */ - -/*--------------------------------------------------------------------------*/ -extern int ClosingShort - ( - short *VolumeSource, /* data to process */ - short *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - short *Kernel, /* structural element */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - long Ox, /* kernel X origin */ - long Oy, /* kernel Y origin */ - long Oz, /* kernel Z origin */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ) - -/* perform the grey-scale morphological operation known as closing */ -/* VolumeSource is the grey-scale volume to close */ -/* VolumeDestination is the resulting grey-scale volume after closing */ -/* both VolumeSource and VolumeDestination have size (Nx, Ny, Nz) */ -/* Kernel is the grey-scale structural element by which VolumeSource is closed */ -/* (Kx, Ky, Kz) is the size (bounding box) of the structural element */ -/* (Ox, Oy, Oz) is the origin of the structural element */ -/* Convention is the boundary convention applied to VolumeSource before closing */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin ClosingShort */ - - short *Buffer = (short *)NULL; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(ClosingShort, VolumeSource, *Status, -/**/ "Missing VolumeSource") -/**/DEBUG_CHECK_NULL_POINTER(ClosingShort, VolumeDestination, *Status, -/**/ "Missing VolumeDestination") -/**/DEBUG_CHECK_NULL_POINTER(ClosingShort, Kernel, *Status, -/**/ "Missing Kernel") -/**/DEBUG_CHECK_RANGE_LONG(ClosingShort, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid data width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ClosingShort, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid data height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ClosingShort, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid data depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ClosingShort, Kx, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ClosingShort, Ky, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ClosingShort, Kz, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(ClosingShort, *Status) -/**/DEBUG_WRITE_ENTERING(ClosingShort, -/**/ "About to execute ClosingShort") - - switch (Convention) { - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - default: - *Status = ERROR; - WRITE_ERROR(ClosingShort, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(ClosingShort, "Done") - return(*Status); - } - AllocateVolumeShort(&Buffer, Nx, Ny, Nz, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ClosingShort, "Done") - return(*Status); - } - *Status = DilateShort(VolumeSource, Buffer, Nx, Ny, Nz, Kernel, Kx, Ky, Kz, - Ox, Oy, Oz, Convention); - if (*Status == ERROR) { - FreeVolumeShort(&Buffer); -/**/ DEBUG_WRITE_LEAVING(ClosingShort, "Done") - return(*Status); - } - *Status = ErodeShort(Buffer, VolumeDestination, Nx, Ny, Nz, Kernel, Kx, Ky, Kz, - Ox, Oy, Oz, Convention); - if (*Status == ERROR) { - FreeVolumeShort(&Buffer); -/**/ DEBUG_WRITE_LEAVING(ClosingShort, "Done") - return(*Status); - } - *Status = FreeVolumeShort(&Buffer); -/**/DEBUG_WRITE_LEAVING(ClosingShort, "Done") - return(*Status); -} /* end ClosingShort */ - -/*--------------------------------------------------------------------------*/ -extern int ClosingShortCuboid - ( - short *Volume, /* data to process in-place */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ) - -/* perform a morphological grey-scale closing filter using a cuboid as structural element */ -/* Volume is the grey-scale volume to close in-place */ -/* Volume has size (Nx, Ny, Nz) */ -/* (Kx, Ky, Kz) is the size of the structural element that is filled with the value 1.0F */ -/* the origin of the structural element is ((Kx - 1L) / 2L, (Ky - 1L) / 2L, (Kz - 1L) / 2L) */ -/* Convention is the boundary convention applied to Volume before closing */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin ClosingShortCuboid */ - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(ClosingShortCuboid, Volume, *Status, -/**/ "Missing Volume") -/**/DEBUG_CHECK_RANGE_LONG(ClosingShortCuboid, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid data width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ClosingShortCuboid, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid data height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ClosingShortCuboid, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid data depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ClosingShortCuboid, Kx, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ClosingShortCuboid, Ky, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ClosingShortCuboid, Kz, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(ClosingShortCuboid, *Status) -/**/DEBUG_WRITE_ENTERING(ClosingShortCuboid, -/**/ "About to execute ClosingShortCuboid") - - switch (Convention) { - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - default: - *Status = ERROR; - WRITE_ERROR(ClosingShortCuboid, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(ClosingShortCuboid, "Done") - return(*Status); - } - MaxFilterShortCuboid(Volume, Nx, Ny, Nz, Kx, Ky, Kz, Convention, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ClosingShortCuboid, "Done") - return(*Status); - } - MinFilterShortCuboid(Volume, Nx, Ny, Nz, Kx, Ky, Kz, Convention, Status); -/**/DEBUG_WRITE_LEAVING(ClosingShortCuboid, "Done") - return(*Status); -} /* end ClosingShortCuboid */ - -/*--------------------------------------------------------------------------*/ -extern int DarkTopHatFloat - ( - float *VolumeSource, /* data to process */ - float *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - float *Kernel, /* structural element */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - long Ox, /* kernel X origin */ - long Oy, /* kernel Y origin */ - long Oz, /* kernel Z origin */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ) - -/* perform the grey-scale morphological operation known as dark top hat */ -/* VolumeSource is the grey-scale volume to process */ -/* VolumeDestination is the resulting grey-scale volume */ -/* both VolumeSource and VolumeDestination have size (Nx, Ny, Nz) */ -/* Kernel is the grey-scale structural element by which VolumeSource is processed */ -/* (Kx, Ky, Kz) is the size (bounding box) of the structural element */ -/* (Ox, Oy, Oz) is the origin of the structural element */ -/* Convention is the boundary convention applied to VolumeSource before processing */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin DarkTopHatFloat */ - - float *p; - float *Closed = (float *)NULL; - long x, y, z; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(DarkTopHatFloat, VolumeSource, *Status, -/**/ "Missing VolumeSource") -/**/DEBUG_CHECK_NULL_POINTER(DarkTopHatFloat, VolumeDestination, *Status, -/**/ "Missing VolumeDestination") -/**/DEBUG_CHECK_NULL_POINTER(DarkTopHatFloat, Kernel, *Status, -/**/ "Missing Kernel") -/**/DEBUG_CHECK_RANGE_LONG(DarkTopHatFloat, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid data width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(DarkTopHatFloat, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid data height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(DarkTopHatFloat, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid data depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(DarkTopHatFloat, Kx, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(DarkTopHatFloat, Ky, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(DarkTopHatFloat, Kz, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(DarkTopHatFloat, *Status) -/**/DEBUG_WRITE_ENTERING(DarkTopHatFloat, -/**/ "About to execute DarkTopHatFloat") - - switch (Convention) { - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - default: - *Status = ERROR; - WRITE_ERROR(DarkTopHatFloat, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(DarkTopHatFloat, "Done") - return(*Status); - } - AllocateVolumeFloat(&Closed, Nx, Ny, Nz, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DarkTopHatFloat, "Done") - return(*Status); - } - ClosingFloat(VolumeSource, Closed, Nx, Ny, Nz, Kernel, Kx, Ky, Kz, - Ox, Oy, Oz, Convention, Status); - if (*Status == ERROR) { - FreeVolumeFloat(&Closed); -/**/ DEBUG_WRITE_LEAVING(DarkTopHatFloat, "Done") - return(*Status); - } - p = Closed; - for (z = -Nz; (z < 0L); z++) { - for (y = -Ny; (y < 0L); y++) { - for (x = -Nx; (x < 0L); x++) { - *VolumeDestination++ = *VolumeSource++ - *p++; - } - } - } - *Status = FreeVolumeFloat(&Closed); -/**/DEBUG_WRITE_LEAVING(DarkTopHatFloat, "Done") - return(*Status); -} /* end DarkTopHatFloat */ - -/*--------------------------------------------------------------------------*/ -extern int DarkTopHatFloatCuboid - ( - float *Volume, /* data to process in-place */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ) - -/* perform a morphological grey-scale dark top hat filter using a cuboid as structural element */ -/* Volume is the grey-scale volume to process in-place */ -/* Volume has size (Nx, Ny, Nz) */ -/* (Kx, Ky, Kz) is the size of the structural element that is filled with the value 1.0F */ -/* the origin of the structural element is ((Kx - 1L) / 2L, (Ky - 1L) / 2L, (Kz - 1L) / 2L) */ -/* Convention is the boundary convention applied to Volume before processing */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin DarkTopHatFloatCuboid */ - - float *p; - float *Closed = (float *)NULL; - long x, y, z; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(DarkTopHatFloatCuboid, Volume, *Status, -/**/ "Missing Volume") -/**/DEBUG_CHECK_RANGE_LONG(DarkTopHatFloatCuboid, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid data width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(DarkTopHatFloatCuboid, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid data height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(DarkTopHatFloatCuboid, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid data depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(DarkTopHatFloatCuboid, Kx, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(DarkTopHatFloatCuboid, Ky, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(DarkTopHatFloatCuboid, Kz, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(DarkTopHatFloatCuboid, *Status) -/**/DEBUG_WRITE_ENTERING(DarkTopHatFloatCuboid, -/**/ "About to execute DarkTopHatFloatCuboid") - - switch (Convention) { - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - default: - *Status = ERROR; - WRITE_ERROR(DarkTopHatFloatCuboid, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(DarkTopHatFloatCuboid, "Done") - return(*Status); - } - AllocateVolumeFloat(&Closed, Nx, Ny, Nz, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DarkTopHatFloatCuboid, "Done") - return(*Status); - } - memcpy(Closed, Volume, (size_t)(Nx * Ny * Nz * (long)sizeof(float))); - ClosingFloatCuboid(Closed, Nx, Ny, Nz, Kx, Ky, Kz, Convention, Status); - if (*Status == ERROR) { - FreeVolumeFloat(&Closed); -/**/ DEBUG_WRITE_LEAVING(DarkTopHatFloatCuboid, "Done") - return(*Status); - } - p = Closed; - for (z = -Nz; (z < 0L); z++) { - for (y = -Ny; (y < 0L); y++) { - for (x = -Nx; (x < 0L); x++) { - *Volume++ -= *p++; - } - } - } - *Status = FreeVolumeFloat(&Closed); -/**/DEBUG_WRITE_LEAVING(DarkTopHatFloatCuboid, "Done") - return(*Status); -} /* end DarkTopHatFloatCuboid */ - -/*--------------------------------------------------------------------------*/ -extern int DarkTopHatShort - ( - short *VolumeSource, /* data to process */ - short *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - short *Kernel, /* structural element */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - long Ox, /* kernel X origin */ - long Oy, /* kernel Y origin */ - long Oz, /* kernel Z origin */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ) - -/* perform the grey-scale morphological operation known as dark top hat */ -/* VolumeSource is the grey-scale volume to process */ -/* VolumeDestination is the resulting grey-scale volume */ -/* both VolumeSource and VolumeDestination have size (Nx, Ny, Nz) */ -/* Kernel is the grey-scale structural element by which VolumeSource is processed */ -/* (Kx, Ky, Kz) is the size (bounding box) of the structural element */ -/* (Ox, Oy, Oz) is the origin of the structural element */ -/* Convention is the boundary convention applied to VolumeSource before processing */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin DarkTopHatShort */ - - short *p; - short *Closed = (short *)NULL; - long x, y, z; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(DarkTopHatShort, VolumeSource, *Status, -/**/ "Missing VolumeSource") -/**/DEBUG_CHECK_NULL_POINTER(DarkTopHatShort, VolumeDestination, *Status, -/**/ "Missing VolumeDestination") -/**/DEBUG_CHECK_NULL_POINTER(DarkTopHatShort, Kernel, *Status, -/**/ "Missing Kernel") -/**/DEBUG_CHECK_RANGE_LONG(DarkTopHatShort, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid data width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(DarkTopHatShort, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid data height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(DarkTopHatShort, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid data depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(DarkTopHatShort, Kx, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(DarkTopHatShort, Ky, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(DarkTopHatShort, Kz, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(DarkTopHatShort, *Status) -/**/DEBUG_WRITE_ENTERING(DarkTopHatShort, -/**/ "About to execute DarkTopHatShort") - - switch (Convention) { - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - default: - *Status = ERROR; - WRITE_ERROR(DarkTopHatShort, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(DarkTopHatShort, "Done") - return(*Status); - } - AllocateVolumeShort(&Closed, Nx, Ny, Nz, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DarkTopHatShort, "Done") - return(*Status); - } - ClosingShort(VolumeSource, Closed, Nx, Ny, Nz, Kernel, Kx, Ky, Kz, - Ox, Oy, Oz, Convention, Status); - if (*Status == ERROR) { - FreeVolumeShort(&Closed); -/**/ DEBUG_WRITE_LEAVING(DarkTopHatShort, "Done") - return(*Status); - } - p = Closed; - for (z = -Nz; (z < 0L); z++) { - for (y = -Ny; (y < 0L); y++) { - for (x = -Nx; (x < 0L); x++) { - *VolumeDestination++ = ConvertIntToShort((int)*VolumeSource++ - (int)*p++); - } - } - } - *Status = FreeVolumeShort(&Closed); -/**/DEBUG_WRITE_LEAVING(DarkTopHatShort, "Done") - return(*Status); -} /* end DarkTopHatShort */ - -/*--------------------------------------------------------------------------*/ -extern int DarkTopHatShortCuboid - ( - short *Volume, /* data to process in-place */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ) - -/* perform a morphological grey-scale dark top hat filter using a cuboid as structural element */ -/* Volume is the grey-scale volume to process in-place */ -/* Volume has size (Nx, Ny, Nz) */ -/* (Kx, Ky, Kz) is the size of the structural element that is filled with the value 1.0F */ -/* the origin of the structural element is ((Kx - 1L) / 2L, (Ky - 1L) / 2L, (Kz - 1L) / 2L) */ -/* Convention is the boundary convention applied to Volume before processing */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin DarkTopHatShortCuboid */ - - short *p; - short *Closed = (short *)NULL; - long x, y, z; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(DarkTopHatShortCuboid, Volume, *Status, -/**/ "Missing Volume") -/**/DEBUG_CHECK_RANGE_LONG(DarkTopHatShortCuboid, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid data width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(DarkTopHatShortCuboid, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid data height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(DarkTopHatShortCuboid, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid data depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(DarkTopHatShortCuboid, Kx, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(DarkTopHatShortCuboid, Ky, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(DarkTopHatShortCuboid, Kz, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(DarkTopHatShortCuboid, *Status) -/**/DEBUG_WRITE_ENTERING(DarkTopHatShortCuboid, -/**/ "About to execute DarkTopHatShortCuboid") - - switch (Convention) { - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - default: - *Status = ERROR; - WRITE_ERROR(DarkTopHatShortCuboid, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(DarkTopHatShortCuboid, "Done") - return(*Status); - } - AllocateVolumeShort(&Closed, Nx, Ny, Nz, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DarkTopHatShortCuboid, "Done") - return(*Status); - } - memcpy(Closed, Volume, (size_t)(Nx * Ny * Nz * (long)sizeof(short))); - ClosingShortCuboid(Closed, Nx, Ny, Nz, Kx, Ky, Kz, Convention, Status); - if (*Status == ERROR) { - FreeVolumeShort(&Closed); -/**/ DEBUG_WRITE_LEAVING(DarkTopHatShortCuboid, "Done") - return(*Status); - } - p = Closed; - for (z = -Nz; (z < 0L); z++) { - for (y = -Ny; (y < 0L); y++) { - for (x = -Nx; (x < 0L); x++) { - *Volume++ -= *p++; - } - } - } - *Status = FreeVolumeShort(&Closed); -/**/DEBUG_WRITE_LEAVING(DarkTopHatShortCuboid, "Done") - return(*Status); -} /* end DarkTopHatShortCuboid */ - -/*--------------------------------------------------------------------------*/ -extern int DilateFloat - ( - float *VolumeSource, /* data to process */ - float *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - float *Kernel, /* structural element */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - long Ox, /* kernel X origin */ - long Oy, /* kernel Y origin */ - long Oz, /* kernel Z origin */ - enum TBoundaryConvention - Convention /* boundary convention */ - ) - -/* perform the grey-scale morphological operation known as dilatation */ -/* VolumeSource is the grey-scale volume to dilate */ -/* VolumeDestination is the resulting grey-scale volume after dilatation */ -/* both VolumeSource and VolumeDestination have size (Nx, Ny, Nz) */ -/* Kernel is the grey-scale structural element by which VolumeSource is dilated */ -/* (Kx, Ky, Kz) is the size (bounding box) of the structural element */ -/* (Ox, Oy, Oz) is the origin of the structural element */ -/* Convention is the boundary convention applied to VolumeSource before dilatation */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin DilateFloat */ - - float *p, *q; - float f, fmax; - long x, y, z; - long x0, y0, z0; - long i, j, k; - const long - Nxy = Nx * Ny; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(DilateFloat, VolumeSource, Status, -/**/ "Missing VolumeSource") -/**/DEBUG_CHECK_NULL_POINTER(DilateFloat, VolumeDestination, Status, -/**/ "Missing VolumeDestination") -/**/DEBUG_CHECK_NULL_POINTER(DilateFloat, Kernel, Status, -/**/ "Missing Kernel") -/**/DEBUG_CHECK_RANGE_LONG(DilateFloat, Nx, 1L, LONG_MAX, Status, -/**/ "Invalid data width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(DilateFloat, Ny, 1L, LONG_MAX, Status, -/**/ "Invalid data height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(DilateFloat, Nz, 1L, LONG_MAX, Status, -/**/ "Invalid data depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(DilateFloat, Kx, 1L, LONG_MAX, Status, -/**/ "Invalid kernel width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(DilateFloat, Ky, 1L, LONG_MAX, Status, -/**/ "Invalid kernel height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(DilateFloat, Kz, 1L, LONG_MAX, Status, -/**/ "Invalid kernel depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(DilateFloat, Status) -/**/DEBUG_WRITE_ENTERING(DilateFloat, -/**/ "About to execute DilateFloat") - - switch (Convention) { - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - default: - Status = ERROR; - WRITE_ERROR(DilateFloat, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(DilateFloat, "Done") - return(Status); - } - p = VolumeDestination; - for (z = Oz; (z < (Nz + Oz)); z++) { - for (y = Oy; (y < (Ny + Oy)); y++) { - for (x = Ox; (x < (Nx + Ox)); x++) { - q = Kernel; - Status = GetFoldedIndex(z, &z0, Nz, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DilateFloat, "Done") - return(Status); - } - Status = GetFoldedIndex(y, &y0, Ny, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DilateFloat, "Done") - return(Status); - } - Status = GetFoldedIndex(x, &x0, Nx, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DilateFloat, "Done") - return(Status); - } - fmax = VolumeSource[Nxy * z0 + Nx * y0 + x0] + *q; - for (k = z + 1L - Kz; (k <= 0L); k++) { - Status = GetFoldedIndex(k, &z0, Nz, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DilateFloat, "Done") - return(Status); - } - z0 *= Nxy; - for (j = y + 1L - Ky; (j <= 0L); j++) { - Status = GetFoldedIndex(j, &y0, Ny, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DilateFloat, "Done") - return(Status); - } - y0 *= Nx; - y0 += z0; - for (i = x + 1L - Kx; (i <= 0L); i++) { - Status = GetFoldedIndex(i, &x0, Nx, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DilateFloat, "Done") - return(Status); - } - f = VolumeSource[y0 + x0] + *q++; - fmax = (f < fmax) ? (fmax) : (f); - } - } - } - *p++ = fmax; - } - } - } -/**/DEBUG_WRITE_LEAVING(DilateFloat, "Done") - return(Status); -} /* end DilateFloat */ - -/*--------------------------------------------------------------------------*/ -extern int DilateShort - ( - short *VolumeSource, /* data to process */ - short *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - short *Kernel, /* structural element */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - long Ox, /* kernel X origin */ - long Oy, /* kernel Y origin */ - long Oz, /* kernel Z origin */ - enum TBoundaryConvention - Convention /* boundary convention */ - ) - -/* perform the grey-scale morphological operation known as dilatation */ -/* VolumeSource is the grey-scale volume to dilate */ -/* VolumeDestination is the resulting grey-scale volume after dilatation */ -/* both VolumeSource and VolumeDestination have size (Nx, Ny, Nz) */ -/* Kernel is the grey-scale structural element by which VolumeSource is dilated */ -/* (Kx, Ky, Kz) is the size (bounding box) of the structural element */ -/* (Ox, Oy, Oz) is the origin of the structural element */ -/* Convention is the boundary convention applied to VolumeSource before dilatation */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin DilateShort */ - - short *p, *q; - short f, fmax; - long x, y, z; - long x0, y0, z0; - long i, j, k; - const long - Nxy = Nx * Ny; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(DilateShort, VolumeSource, Status, -/**/ "Missing VolumeSource") -/**/DEBUG_CHECK_NULL_POINTER(DilateShort, VolumeDestination, Status, -/**/ "Missing VolumeDestination") -/**/DEBUG_CHECK_NULL_POINTER(DilateShort, Kernel, Status, -/**/ "Missing Kernel") -/**/DEBUG_CHECK_RANGE_LONG(DilateShort, Nx, 1L, LONG_MAX, Status, -/**/ "Invalid data width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(DilateShort, Ny, 1L, LONG_MAX, Status, -/**/ "Invalid data height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(DilateShort, Nz, 1L, LONG_MAX, Status, -/**/ "Invalid data depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(DilateShort, Kx, 1L, LONG_MAX, Status, -/**/ "Invalid kernel width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(DilateShort, Ky, 1L, LONG_MAX, Status, -/**/ "Invalid kernel height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(DilateShort, Kz, 1L, LONG_MAX, Status, -/**/ "Invalid kernel depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(DilateShort, Status) -/**/DEBUG_WRITE_ENTERING(DilateShort, -/**/ "About to execute DilateShort") - - switch (Convention) { - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - default: - Status = ERROR; - WRITE_ERROR(DilateShort, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(DilateShort, "Done") - return(Status); - } - p = VolumeDestination; - for (z = Oz; (z < (Nz + Oz)); z++) { - for (y = Oy; (y < (Ny + Oy)); y++) { - for (x = Ox; (x < (Nx + Ox)); x++) { - q = Kernel; - Status = GetFoldedIndex(z, &z0, Nz, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DilateShort, "Done") - return(Status); - } - Status = GetFoldedIndex(y, &y0, Ny, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DilateShort, "Done") - return(Status); - } - Status = GetFoldedIndex(x, &x0, Nx, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DilateShort, "Done") - return(Status); - } - fmax = ConvertIntToShort((int)VolumeSource[Nxy * z0 + Nx * y0 + x0] + (int)*q); - for (k = z + 1L - Kz; (k <= 0L); k++) { - Status = GetFoldedIndex(k, &z0, Nz, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DilateShort, "Done") - return(Status); - } - z0 *= Nxy; - for (j = y + 1L - Ky; (j <= 0L); j++) { - Status = GetFoldedIndex(j, &y0, Ny, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DilateShort, "Done") - return(Status); - } - y0 *= Nx; - y0 += z0; - for (i = x + 1L - Kx; (i <= 0L); i++) { - Status = GetFoldedIndex(i, &x0, Nx, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(DilateShort, "Done") - return(Status); - } - f = ConvertIntToShort((int)VolumeSource[y0 + x0] + (int)*q++); - fmax = (f < fmax) ? (fmax) : (f); - } - } - } - *p++ = fmax; - } - } - } -/**/DEBUG_WRITE_LEAVING(DilateShort, "Done") - return(Status); -} /* end DilateShort */ - -/*--------------------------------------------------------------------------*/ -extern int ErodeFloat - ( - float *VolumeSource, /* data to process */ - float *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - float *Kernel, /* structural element */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - long Ox, /* kernel X origin */ - long Oy, /* kernel Y origin */ - long Oz, /* kernel Z origin */ - enum TBoundaryConvention - Convention /* boundary convention */ - ) - -/* perform the grey-scale morphological operation known as erosion */ -/* VolumeSource is the grey-scale volume to erode */ -/* VolumeDestination is the resulting grey-scale volume after erosion */ -/* both VolumeSource and VolumeDestination have size (Nx, Ny, Nz) */ -/* Kernel is the grey-scale structural element by which VolumeSource is eroded */ -/* (Kx, Ky, Kz) is the size (bounding box) of the structural element */ -/* (Ox, Oy, Oz) is the origin of the structural element */ -/* Convention is the boundary convention applied to VolumeSource before erosion */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin ErodeFloat */ - - float *p, *q; - float f, fmin; - long x, y, z; - long x0, y0, z0; - long i, j, k; - const long - Nxy = Nx * Ny; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(ErodeFloat, VolumeSource, Status, -/**/ "Missing VolumeSource") -/**/DEBUG_CHECK_NULL_POINTER(ErodeFloat, VolumeDestination, Status, -/**/ "Missing VolumeDestination") -/**/DEBUG_CHECK_NULL_POINTER(ErodeFloat, Kernel, Status, -/**/ "Missing Kernel") -/**/DEBUG_CHECK_RANGE_LONG(ErodeFloat, Nx, 1L, LONG_MAX, Status, -/**/ "Invalid data width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ErodeFloat, Ny, 1L, LONG_MAX, Status, -/**/ "Invalid data height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ErodeFloat, Nz, 1L, LONG_MAX, Status, -/**/ "Invalid data depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ErodeFloat, Kx, 1L, LONG_MAX, Status, -/**/ "Invalid kernel width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ErodeFloat, Ky, 1L, LONG_MAX, Status, -/**/ "Invalid kernel height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ErodeFloat, Kz, 1L, LONG_MAX, Status, -/**/ "Invalid kernel depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(ErodeFloat, Status) -/**/DEBUG_WRITE_ENTERING(ErodeFloat, -/**/ "About to execute ErodeFloat") - - switch (Convention) { - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - default: - Status = ERROR; - WRITE_ERROR(ErodeFloat, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(ErodeFloat, "Done") - return(Status); - } - p = VolumeDestination; - for (z = -Oz; (z < (Nz - Oz)); z++) { - for (y = -Oy; (y < (Ny - Oy)); y++) { - for (x = -Ox; (x < (Nx - Ox)); x++) { - q = Kernel; - Status = GetFoldedIndex(z, &z0, Nz, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ErodeFloat, "Done") - return(Status); - } - Status = GetFoldedIndex(y, &y0, Ny, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ErodeFloat, "Done") - return(Status); - } - Status = GetFoldedIndex(x, &x0, Nx, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ErodeFloat, "Done") - return(Status); - } - fmin = VolumeSource[Nxy * z0 + Nx * y0 + x0] - *q; - for (k = z; (k < (z + Kz)); k++) { - Status = GetFoldedIndex(k, &z0, Nz, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ErodeFloat, "Done") - return(Status); - } - z0 *= Nxy; - for (j = y; (j < (y + Ky)); j++) { - Status = GetFoldedIndex(j, &y0, Ny, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ErodeFloat, "Done") - return(Status); - } - y0 *= Nx; - y0 += z0; - for (i = x; (i < (x + Kx)); i++) { - Status = GetFoldedIndex(i, &x0, Nx, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ErodeFloat, "Done") - return(Status); - } - f = VolumeSource[y0 + x0] - *q++; - fmin = (f < fmin) ? (f) : (fmin); - } - } - } - *p++ = fmin; - } - } - } -/**/DEBUG_WRITE_LEAVING(ErodeFloat, "Done") - return(Status); -} /* end ErodeFloat */ - -/*--------------------------------------------------------------------------*/ -extern int ErodeShort - ( - short *VolumeSource, /* data to process */ - short *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - short *Kernel, /* structural element */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - long Ox, /* kernel X origin */ - long Oy, /* kernel Y origin */ - long Oz, /* kernel Z origin */ - enum TBoundaryConvention - Convention /* boundary convention */ - ) - -/* perform the grey-scale morphological operation known as erosion */ -/* VolumeSource is the grey-scale volume to erode */ -/* VolumeDestination is the resulting grey-scale volume after erosion */ -/* both VolumeSource and VolumeDestination have size (Nx, Ny, Nz) */ -/* Kernel is the grey-scale structural element by which VolumeSource is eroded */ -/* (Kx, Ky, Kz) is the size (bounding box) of the structural element */ -/* (Ox, Oy, Oz) is the origin of the structural element */ -/* Convention is the boundary convention applied to VolumeSource before erosion */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin ErodeShort */ - - short *p, *q; - short f, fmin; - long x, y, z; - long x0, y0, z0; - long i, j, k; - const long - Nxy = Nx * Ny; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(ErodeShort, VolumeSource, Status, -/**/ "Missing VolumeSource") -/**/DEBUG_CHECK_NULL_POINTER(ErodeShort, VolumeDestination, Status, -/**/ "Missing VolumeDestination") -/**/DEBUG_CHECK_NULL_POINTER(ErodeShort, Kernel, Status, -/**/ "Missing Kernel") -/**/DEBUG_CHECK_RANGE_LONG(ErodeShort, Nx, 1L, LONG_MAX, Status, -/**/ "Invalid data width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ErodeShort, Ny, 1L, LONG_MAX, Status, -/**/ "Invalid data height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ErodeShort, Nz, 1L, LONG_MAX, Status, -/**/ "Invalid data depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ErodeShort, Kx, 1L, LONG_MAX, Status, -/**/ "Invalid kernel width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ErodeShort, Ky, 1L, LONG_MAX, Status, -/**/ "Invalid kernel height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(ErodeShort, Kz, 1L, LONG_MAX, Status, -/**/ "Invalid kernel depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(ErodeShort, Status) -/**/DEBUG_WRITE_ENTERING(ErodeShort, -/**/ "About to execute ErodeShort") - - switch (Convention) { - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - default: - Status = ERROR; - WRITE_ERROR(ErodeShort, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(ErodeShort, "Done") - return(Status); - } - p = VolumeDestination; - for (z = -Oz; (z < (Nz - Oz)); z++) { - for (y = -Oy; (y < (Ny - Oy)); y++) { - for (x = -Ox; (x < (Nx - Ox)); x++) { - q = Kernel; - Status = GetFoldedIndex(z, &z0, Nz, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ErodeShort, "Done") - return(Status); - } - Status = GetFoldedIndex(y, &y0, Ny, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ErodeShort, "Done") - return(Status); - } - Status = GetFoldedIndex(x, &x0, Nx, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ErodeShort, "Done") - return(Status); - } - fmin = ConvertIntToShort((int)VolumeSource[Nxy * z0 + Nx * y0 + x0] - (int)*q); - for (k = z; (k < (z + Kz)); k++) { - Status = GetFoldedIndex(k, &z0, Nz, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ErodeShort, "Done") - return(Status); - } - z0 *= Nxy; - for (j = y; (j < (y + Ky)); j++) { - Status = GetFoldedIndex(j, &y0, Ny, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ErodeShort, "Done") - return(Status); - } - y0 *= Nx; - y0 += z0; - for (i = x; (i < (x + Kx)); i++) { - Status = GetFoldedIndex(i, &x0, Nx, Convention); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(ErodeShort, "Done") - return(Status); - } - f = ConvertIntToShort((int)VolumeSource[y0 + x0] - (int)*q++); - fmin = (f < fmin) ? (f) : (fmin); - } - } - } - *p++ = fmin; - } - } - } -/**/DEBUG_WRITE_LEAVING(ErodeShort, "Done") - return(Status); -} /* end ErodeShort */ - -/*--------------------------------------------------------------------------*/ -extern int MaxFilterFloatCuboid - ( - float *Volume, /* data to process in-place */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ) - -/* perform a morphological grey-scale max filter using a cuboid as structural element */ -/* Volume is the grey-scale volume to dilate in-place */ -/* Volume has size (Nx, Ny, Nz) */ -/* (Kx, Ky, Kz) is the size of the structural element that is filled with the value 1.0F */ -/* the origin of the structural element is ((Kx - 1L) / 2L, (Ky - 1L) / 2L, (Kz - 1L) / 2L) */ -/* Convention is the boundary convention applied to Volume before dilatation */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin MaxFilterFloatCuboid */ - - double *BufferIn = (double *)NULL, *BufferOut = (double *)NULL; - long i, j, k; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(MaxFilterFloatCuboid, Volume, *Status, -/**/ "Missing Volume") -/**/DEBUG_CHECK_RANGE_LONG(MaxFilterFloatCuboid, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid data width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MaxFilterFloatCuboid, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid data height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MaxFilterFloatCuboid, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid data depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MaxFilterFloatCuboid, Kx, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MaxFilterFloatCuboid, Ky, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MaxFilterFloatCuboid, Kz, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(MaxFilterFloatCuboid, *Status) -/**/DEBUG_WRITE_ENTERING(MaxFilterFloatCuboid, -/**/ "About to execute MaxFilterFloatCuboid") - - switch (Convention) { - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - default: - *Status = ERROR; - WRITE_ERROR(MaxFilterFloatCuboid, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(MaxFilterFloatCuboid, "Done") - return(*Status); - } - if (1L < Nx) { - AllocateLineDouble(&BufferIn, Nx, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MaxFilterFloatCuboid, "Done") - return(*Status); - } - AllocateLineDouble(&BufferOut, Nx, Status); - if (*Status == ERROR) { - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MaxFilterFloatCuboid, "Done") - return(*Status); - } - for (k = 0L; (k < Nz); k++) { - for (j = 0L; (j < Ny); j++) { - *Status = GetxFloatToDouble(Volume, Nx, Ny, Nz, 0L, j, k, BufferIn, Nx); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MaxFilterFloatCuboid, "Done") - return(*Status); - } - *Status = MaxFilterLine(BufferIn, BufferOut, Nx, Kx, Convention); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MaxFilterFloatCuboid, "Done") - return(*Status); - } - *Status = PutxDoubleToFloat(Volume, Nx, Ny, Nz, 0L, j, k, BufferOut, Nx); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MaxFilterFloatCuboid, "Done") - return(*Status); - } - } - } - *Status = FreeLineDouble(&BufferOut); - if (*Status == ERROR) { - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MaxFilterFloatCuboid, "Done") - return(*Status); - } - *Status = FreeLineDouble(&BufferIn); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MaxFilterFloatCuboid, "Done") - return(*Status); - } - } - if (1L < Ny) { - AllocateLineDouble(&BufferIn, Ny, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MaxFilterFloatCuboid, "Done") - return(*Status); - } - AllocateLineDouble(&BufferOut, Ny, Status); - if (*Status == ERROR) { - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MaxFilterFloatCuboid, "Done") - return(*Status); - } - for (k = 0L; (k < Nz); k++) { - for (i = 0L; (i < Nx); i++) { - *Status = GetyFloatToDouble(Volume, Nx, Ny, Nz, i, 0L, k, BufferIn, Ny); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MaxFilterFloatCuboid, "Done") - return(*Status); - } - *Status = MaxFilterLine(BufferIn, BufferOut, Ny, Ky, Convention); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MaxFilterFloatCuboid, "Done") - return(*Status); - } - *Status = PutyDoubleToFloat(Volume, Nx, Ny, Nz, i, 0L, k, BufferOut, Ny); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MaxFilterFloatCuboid, "Done") - return(*Status); - } - } - } - *Status = FreeLineDouble(&BufferOut); - if (*Status == ERROR) { - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MaxFilterFloatCuboid, "Done") - return(*Status); - } - *Status = FreeLineDouble(&BufferIn); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MaxFilterFloatCuboid, "Done") - return(*Status); - } - } - if (1L < Nz) { - AllocateLineDouble(&BufferIn, Nz, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MaxFilterFloatCuboid, "Done") - return(*Status); - } - AllocateLineDouble(&BufferOut, Nz, Status); - if (*Status == ERROR) { - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MaxFilterFloatCuboid, "Done") - return(*Status); - } - for (j = 0L; (j < Ny); j++) { - for (i = 0L; (i < Nx); i++) { - *Status = GetzFloatToDouble(Volume, Nx, Ny, Nz, i, j, 0L, BufferIn, Nz); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MaxFilterFloatCuboid, "Done") - return(*Status); - } - *Status = MaxFilterLine(BufferIn, BufferOut, Nz, Kz, Convention); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MaxFilterFloatCuboid, "Done") - return(*Status); - } - *Status = PutzDoubleToFloat(Volume, Nx, Ny, Nz, i, j, 0L, BufferOut, Nz); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MaxFilterFloatCuboid, "Done") - return(*Status); - } - } - } - *Status = FreeLineDouble(&BufferOut); - if (*Status == ERROR) { - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MaxFilterFloatCuboid, "Done") - return(*Status); - } - *Status = FreeLineDouble(&BufferIn); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MaxFilterFloatCuboid, "Done") - return(*Status); - } - } -/**/DEBUG_WRITE_LEAVING(MaxFilterFloatCuboid, "Done") - return(*Status); -} /* end MaxFilterFloatCuboid */ - -/*--------------------------------------------------------------------------*/ -extern int MaxFilterShortCuboid - ( - short *Volume, /* data to process in-place */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ) - -/* perform a morphological grey-scale max filter using a cuboid as structural element */ -/* Volume is the grey-scale volume to dilate in-place */ -/* Volume has size (Nx, Ny, Nz) */ -/* (Kx, Ky, Kz) is the size of the structural element that is filled with the value 1.0F */ -/* the origin of the structural element is ((Kx - 1L) / 2L, (Ky - 1L) / 2L, (Kz - 1L) / 2L) */ -/* Convention is the boundary convention applied to Volume before dilatation */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin MaxFilterShortCuboid */ - - double *BufferIn = (double *)NULL, *BufferOut = (double *)NULL; - long i, j, k; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(MaxFilterShortCuboid, Volume, *Status, -/**/ "Missing Volume") -/**/DEBUG_CHECK_RANGE_LONG(MaxFilterShortCuboid, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid data width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MaxFilterShortCuboid, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid data height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MaxFilterShortCuboid, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid data depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MaxFilterShortCuboid, Kx, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MaxFilterShortCuboid, Ky, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MaxFilterShortCuboid, Kz, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(MaxFilterShortCuboid, *Status) -/**/DEBUG_WRITE_ENTERING(MaxFilterShortCuboid, -/**/ "About to execute MaxFilterShortCuboid") - - switch (Convention) { - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - default: - *Status = ERROR; - WRITE_ERROR(MaxFilterShortCuboid, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(MaxFilterShortCuboid, "Done") - return(*Status); - } - if (1L < Nx) { - AllocateLineDouble(&BufferIn, Nx, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MaxFilterShortCuboid, "Done") - return(*Status); - } - AllocateLineDouble(&BufferOut, Nx, Status); - if (*Status == ERROR) { - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MaxFilterShortCuboid, "Done") - return(*Status); - } - for (k = 0L; (k < Nz); k++) { - for (j = 0L; (j < Ny); j++) { - *Status = GetxShortToDouble(Volume, Nx, Ny, Nz, 0L, j, k, BufferIn, Nx); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MaxFilterShortCuboid, "Done") - return(*Status); - } - *Status = MaxFilterLine(BufferIn, BufferOut, Nx, Kx, Convention); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MaxFilterShortCuboid, "Done") - return(*Status); - } - *Status = PutxDoubleToShort(Volume, Nx, Ny, Nz, 0L, j, k, BufferOut, Nx); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MaxFilterShortCuboid, "Done") - return(*Status); - } - } - } - *Status = FreeLineDouble(&BufferOut); - if (*Status == ERROR) { - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MaxFilterShortCuboid, "Done") - return(*Status); - } - *Status = FreeLineDouble(&BufferIn); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MaxFilterShortCuboid, "Done") - return(*Status); - } - } - if (1L < Ny) { - AllocateLineDouble(&BufferIn, Ny, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MaxFilterShortCuboid, "Done") - return(*Status); - } - AllocateLineDouble(&BufferOut, Ny, Status); - if (*Status == ERROR) { - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MaxFilterShortCuboid, "Done") - return(*Status); - } - for (k = 0L; (k < Nz); k++) { - for (i = 0L; (i < Nx); i++) { - *Status = GetyShortToDouble(Volume, Nx, Ny, Nz, i, 0L, k, BufferIn, Ny); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MaxFilterShortCuboid, "Done") - return(*Status); - } - *Status = MaxFilterLine(BufferIn, BufferOut, Ny, Ky, Convention); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MaxFilterShortCuboid, "Done") - return(*Status); - } - *Status = PutyDoubleToShort(Volume, Nx, Ny, Nz, i, 0L, k, BufferOut, Ny); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MaxFilterShortCuboid, "Done") - return(*Status); - } - } - } - *Status = FreeLineDouble(&BufferOut); - if (*Status == ERROR) { - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MaxFilterShortCuboid, "Done") - return(*Status); - } - *Status = FreeLineDouble(&BufferIn); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MaxFilterShortCuboid, "Done") - return(*Status); - } - } - if (1L < Nz) { - AllocateLineDouble(&BufferIn, Nz, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MaxFilterShortCuboid, "Done") - return(*Status); - } - AllocateLineDouble(&BufferOut, Nz, Status); - if (*Status == ERROR) { - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MaxFilterShortCuboid, "Done") - return(*Status); - } - for (j = 0L; (j < Ny); j++) { - for (i = 0L; (i < Nx); i++) { - *Status = GetzShortToDouble(Volume, Nx, Ny, Nz, i, j, 0L, BufferIn, Nz); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MaxFilterShortCuboid, "Done") - return(*Status); - } - *Status = MaxFilterLine(BufferIn, BufferOut, Nz, Kz, Convention); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MaxFilterShortCuboid, "Done") - return(*Status); - } - *Status = PutzDoubleToShort(Volume, Nx, Ny, Nz, i, j, 0L, BufferOut, Nz); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MaxFilterShortCuboid, "Done") - return(*Status); - } - } - } - *Status = FreeLineDouble(&BufferOut); - if (*Status == ERROR) { - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MaxFilterShortCuboid, "Done") - return(*Status); - } - *Status = FreeLineDouble(&BufferIn); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MaxFilterShortCuboid, "Done") - return(*Status); - } - } -/**/DEBUG_WRITE_LEAVING(MaxFilterShortCuboid, "Done") - return(*Status); -} /* end MaxFilterShortCuboid */ - -/*--------------------------------------------------------------------------*/ -extern int MinFilterFloatCuboid - ( - float *Volume, /* data to process in-place */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ) - -/* perform a morphological grey-scale min filter using a cuboid as structural element */ -/* Volume is the grey-scale volume to erode in-place */ -/* Volume has size (Nx, Ny, Nz) */ -/* (Kx, Ky, Kz) is the size of the structural element that is filled with the value 1.0F */ -/* the origin of the structural element is ((Kx - 1L) / 2L, (Ky - 1L) / 2L, (Kz - 1L) / 2L) */ -/* Convention is the boundary convention applied to Volume before erosion */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin MinFilterFloatCuboid */ - - double *BufferIn = (double *)NULL, *BufferOut = (double *)NULL; - long i, j, k; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(MinFilterFloatCuboid, Volume, *Status, -/**/ "Missing Volume") -/**/DEBUG_CHECK_RANGE_LONG(MinFilterFloatCuboid, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid data width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MinFilterFloatCuboid, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid data height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MinFilterFloatCuboid, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid data depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MinFilterFloatCuboid, Kx, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MinFilterFloatCuboid, Ky, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MinFilterFloatCuboid, Kz, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(MinFilterFloatCuboid, *Status) -/**/DEBUG_WRITE_ENTERING(MinFilterFloatCuboid, -/**/ "About to execute MinFilterFloatCuboid") - - switch (Convention) { - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - default: - *Status = ERROR; - WRITE_ERROR(MinFilterFloatCuboid, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(MinFilterFloatCuboid, "Done") - return(*Status); - } - if (1L < Nx) { - AllocateLineDouble(&BufferIn, Nx, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MinFilterFloatCuboid, "Done") - return(*Status); - } - AllocateLineDouble(&BufferOut, Nx, Status); - if (*Status == ERROR) { - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MinFilterFloatCuboid, "Done") - return(*Status); - } - for (k = 0L; (k < Nz); k++) { - for (j = 0L; (j < Ny); j++) { - *Status = GetxFloatToDouble(Volume, Nx, Ny, Nz, 0L, j, k, BufferIn, Nx); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MinFilterFloatCuboid, "Done") - return(*Status); - } - *Status = MinFilterLine(BufferIn, BufferOut, Nx, Kx, Convention); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MinFilterFloatCuboid, "Done") - return(*Status); - } - *Status = PutxDoubleToFloat(Volume, Nx, Ny, Nz, 0L, j, k, BufferOut, Nx); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MinFilterFloatCuboid, "Done") - return(*Status); - } - } - } - *Status = FreeLineDouble(&BufferOut); - if (*Status == ERROR) { - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MinFilterFloatCuboid, "Done") - return(*Status); - } - *Status = FreeLineDouble(&BufferIn); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MinFilterFloatCuboid, "Done") - return(*Status); - } - } - if (1L < Ny) { - AllocateLineDouble(&BufferIn, Ny, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MinFilterFloatCuboid, "Done") - return(*Status); - } - AllocateLineDouble(&BufferOut, Ny, Status); - if (*Status == ERROR) { - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MinFilterFloatCuboid, "Done") - return(*Status); - } - for (k = 0L; (k < Nz); k++) { - for (i = 0L; (i < Nx); i++) { - *Status = GetyFloatToDouble(Volume, Nx, Ny, Nz, i, 0L, k, BufferIn, Ny); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MinFilterFloatCuboid, "Done") - return(*Status); - } - *Status = MinFilterLine(BufferIn, BufferOut, Ny, Ky, Convention); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MinFilterFloatCuboid, "Done") - return(*Status); - } - *Status = PutyDoubleToFloat(Volume, Nx, Ny, Nz, i, 0L, k, BufferOut, Ny); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MinFilterFloatCuboid, "Done") - return(*Status); - } - } - } - *Status = FreeLineDouble(&BufferOut); - if (*Status == ERROR) { - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MinFilterFloatCuboid, "Done") - return(*Status); - } - *Status = FreeLineDouble(&BufferIn); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MinFilterFloatCuboid, "Done") - return(*Status); - } - } - if (1L < Nz) { - AllocateLineDouble(&BufferIn, Nz, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MinFilterFloatCuboid, "Done") - return(*Status); - } - AllocateLineDouble(&BufferOut, Nz, Status); - if (*Status == ERROR) { - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MinFilterFloatCuboid, "Done") - return(*Status); - } - for (j = 0L; (j < Ny); j++) { - for (i = 0L; (i < Nx); i++) { - *Status = GetzFloatToDouble(Volume, Nx, Ny, Nz, i, j, 0L, BufferIn, Nz); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MinFilterFloatCuboid, "Done") - return(*Status); - } - *Status = MinFilterLine(BufferIn, BufferOut, Nz, Kz, Convention); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MinFilterFloatCuboid, "Done") - return(*Status); - } - *Status = PutzDoubleToFloat(Volume, Nx, Ny, Nz, i, j, 0L, BufferOut, Nz); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MinFilterFloatCuboid, "Done") - return(*Status); - } - } - } - *Status = FreeLineDouble(&BufferOut); - if (*Status == ERROR) { - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MinFilterFloatCuboid, "Done") - return(*Status); - } - *Status = FreeLineDouble(&BufferIn); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MinFilterFloatCuboid, "Done") - return(*Status); - } - } -/**/DEBUG_WRITE_LEAVING(MinFilterFloatCuboid, "Done") - return(*Status); -} /* end MinFilterFloatCuboid */ - -/*--------------------------------------------------------------------------*/ -extern int MinFilterShortCuboid - ( - short *Volume, /* data to process in-place */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ) - -/* perform a morphological grey-scale min filter using a cuboid as structural element */ -/* Volume is the grey-scale volume to erode in-place */ -/* Volume has size (Nx, Ny, Nz) */ -/* (Kx, Ky, Kz) is the size of the structural element that is filled with the value 1.0F */ -/* the origin of the structural element is ((Kx - 1L) / 2L, (Ky - 1L) / 2L, (Kz - 1L) / 2L) */ -/* Convention is the boundary convention applied to Volume before erosion */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin MinFilterShortCuboid */ - - double *BufferIn = (double *)NULL, *BufferOut = (double *)NULL; - long i, j, k; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(MinFilterShortCuboid, Volume, *Status, -/**/ "Missing Volume") -/**/DEBUG_CHECK_RANGE_LONG(MinFilterShortCuboid, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid data width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MinFilterShortCuboid, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid data height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MinFilterShortCuboid, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid data depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MinFilterShortCuboid, Kx, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MinFilterShortCuboid, Ky, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MinFilterShortCuboid, Kz, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(MinFilterShortCuboid, *Status) -/**/DEBUG_WRITE_ENTERING(MinFilterShortCuboid, -/**/ "About to execute MinFilterShortCuboid") - - switch (Convention) { - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - default: - *Status = ERROR; - WRITE_ERROR(MinFilterShortCuboid, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(MinFilterShortCuboid, "Done") - return(*Status); - } - if (1L < Nx) { - AllocateLineDouble(&BufferIn, Nx, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MinFilterShortCuboid, "Done") - return(*Status); - } - AllocateLineDouble(&BufferOut, Nx, Status); - if (*Status == ERROR) { - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MinFilterShortCuboid, "Done") - return(*Status); - } - for (k = 0L; (k < Nz); k++) { - for (j = 0L; (j < Ny); j++) { - *Status = GetxShortToDouble(Volume, Nx, Ny, Nz, 0L, j, k, BufferIn, Nx); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MinFilterShortCuboid, "Done") - return(*Status); - } - *Status = MinFilterLine(BufferIn, BufferOut, Nx, Kx, Convention); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MinFilterShortCuboid, "Done") - return(*Status); - } - *Status = PutxDoubleToShort(Volume, Nx, Ny, Nz, 0L, j, k, BufferOut, Nx); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MinFilterShortCuboid, "Done") - return(*Status); - } - } - } - *Status = FreeLineDouble(&BufferOut); - if (*Status == ERROR) { - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MinFilterShortCuboid, "Done") - return(*Status); - } - *Status = FreeLineDouble(&BufferIn); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MinFilterShortCuboid, "Done") - return(*Status); - } - } - if (1L < Ny) { - AllocateLineDouble(&BufferIn, Ny, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MinFilterShortCuboid, "Done") - return(*Status); - } - AllocateLineDouble(&BufferOut, Ny, Status); - if (*Status == ERROR) { - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MinFilterShortCuboid, "Done") - return(*Status); - } - for (k = 0L; (k < Nz); k++) { - for (i = 0L; (i < Nx); i++) { - *Status = GetyShortToDouble(Volume, Nx, Ny, Nz, i, 0L, k, BufferIn, Ny); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MinFilterShortCuboid, "Done") - return(*Status); - } - *Status = MinFilterLine(BufferIn, BufferOut, Ny, Ky, Convention); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MinFilterShortCuboid, "Done") - return(*Status); - } - *Status = PutyDoubleToShort(Volume, Nx, Ny, Nz, i, 0L, k, BufferOut, Ny); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MinFilterShortCuboid, "Done") - return(*Status); - } - } - } - *Status = FreeLineDouble(&BufferOut); - if (*Status == ERROR) { - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MinFilterShortCuboid, "Done") - return(*Status); - } - *Status = FreeLineDouble(&BufferIn); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MinFilterShortCuboid, "Done") - return(*Status); - } - } - if (1L < Nz) { - AllocateLineDouble(&BufferIn, Nz, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MinFilterShortCuboid, "Done") - return(*Status); - } - AllocateLineDouble(&BufferOut, Nz, Status); - if (*Status == ERROR) { - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MinFilterShortCuboid, "Done") - return(*Status); - } - for (j = 0L; (j < Ny); j++) { - for (i = 0L; (i < Nx); i++) { - *Status = GetzShortToDouble(Volume, Nx, Ny, Nz, i, j, 0L, BufferIn, Nz); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MinFilterShortCuboid, "Done") - return(*Status); - } - *Status = MinFilterLine(BufferIn, BufferOut, Nz, Kz, Convention); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MinFilterShortCuboid, "Done") - return(*Status); - } - *Status = PutzDoubleToShort(Volume, Nx, Ny, Nz, i, j, 0L, BufferOut, Nz); - if (*Status == ERROR) { - FreeLineDouble(&BufferOut); - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MinFilterShortCuboid, "Done") - return(*Status); - } - } - } - *Status = FreeLineDouble(&BufferOut); - if (*Status == ERROR) { - FreeLineDouble(&BufferIn); -/**/ DEBUG_WRITE_LEAVING(MinFilterShortCuboid, "Done") - return(*Status); - } - *Status = FreeLineDouble(&BufferIn); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MinFilterShortCuboid, "Done") - return(*Status); - } - } -/**/DEBUG_WRITE_LEAVING(MinFilterShortCuboid, "Done") - return(*Status); -} /* end MinFilterShortCuboid */ - -/*--------------------------------------------------------------------------*/ -extern int MorphologicalGradientFloat - ( - float *VolumeSource, /* data to process */ - float *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - float *Kernel, /* structural element */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - long Ox, /* kernel X origin */ - long Oy, /* kernel Y origin */ - long Oz, /* kernel Z origin */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ) - -/* perform the grey-scale morphological operation known as morphological gradient */ -/* VolumeSource is the grey-scale volume to process */ -/* VolumeDestination is the resulting grey-scale volume after the gradient operation */ -/* both VolumeSource and VolumeDestination have size (Nx, Ny, Nz) */ -/* Kernel is the grey-scale structural element by which VolumeSource is processed */ -/* (Kx, Ky, Kz) is the size (bounding box) of the structural element */ -/* (Ox, Oy, Oz) is the origin of the structural element */ -/* Convention is the boundary convention applied to VolumeSource before the gradient operation */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin MorphologicalGradientFloat */ - - float *p, *q; - float *Dilated = (float *)NULL, *Eroded = (float *)NULL; - long x, y, z; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(MorphologicalGradientFloat, VolumeSource, *Status, -/**/ "Missing VolumeSource") -/**/DEBUG_CHECK_NULL_POINTER(MorphologicalGradientFloat, VolumeDestination, *Status, -/**/ "Missing VolumeDestination") -/**/DEBUG_CHECK_NULL_POINTER(MorphologicalGradientFloat, Kernel, *Status, -/**/ "Missing Kernel") -/**/DEBUG_CHECK_RANGE_LONG(MorphologicalGradientFloat, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid data width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MorphologicalGradientFloat, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid data height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MorphologicalGradientFloat, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid data depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MorphologicalGradientFloat, Kx, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MorphologicalGradientFloat, Ky, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MorphologicalGradientFloat, Kz, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(MorphologicalGradientFloat, *Status) -/**/DEBUG_WRITE_ENTERING(MorphologicalGradientFloat, -/**/ "About to execute MorphologicalGradientFloat") - - switch (Convention) { - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - default: - *Status = ERROR; - WRITE_ERROR(MorphologicalGradientFloat, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(MorphologicalGradientFloat, "Done") - return(*Status); - } - AllocateVolumeFloat(&Dilated, Nx, Ny, Nz, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MorphologicalGradientFloat, "Done") - return(*Status); - } - *Status = DilateFloat(VolumeSource, Dilated, Nx, Ny, Nz, Kernel, Kx, Ky, Kz, - Ox, Oy, Oz, Convention); - if (*Status == ERROR) { - FreeVolumeFloat(&Dilated); -/**/ DEBUG_WRITE_LEAVING(MorphologicalGradientFloat, "Done") - return(*Status); - } - AllocateVolumeFloat(&Eroded, Nx, Ny, Nz, Status); - if (*Status == ERROR) { - FreeVolumeFloat(&Dilated); -/**/ DEBUG_WRITE_LEAVING(MorphologicalGradientFloat, "Done") - return(*Status); - } - *Status = ErodeFloat(VolumeSource, Eroded, Nx, Ny, Nz, Kernel, Kx, Ky, Kz, - Ox, Oy, Oz, Convention); - if (*Status == ERROR) { - FreeVolumeFloat(&Eroded); - FreeVolumeFloat(&Dilated); -/**/ DEBUG_WRITE_LEAVING(MorphologicalGradientFloat, "Done") - return(*Status); - } - p = Dilated; - q = Eroded; - for (z = -Nz; (z < 0L); z++) { - for (y = -Ny; (y < 0L); y++) { - for (x = -Nx; (x < 0L); x++) { - *VolumeDestination++ = *p++ - *q++; - } - } - } - *Status = FreeVolumeFloat(&Eroded); - if (*Status == ERROR) { - FreeVolumeFloat(&Dilated); -/**/ DEBUG_WRITE_LEAVING(MorphologicalGradientFloat, "Done") - return(*Status); - } - *Status = FreeVolumeFloat(&Dilated); -/**/DEBUG_WRITE_LEAVING(MorphologicalGradientFloat, "Done") - return(*Status); -} /* end MorphologicalGradientFloat */ - -/*--------------------------------------------------------------------------*/ -extern int MorphologicalGradientFloatCuboid - ( - float *Volume, /* data to process in-place */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ) - -/* perform a morphological grey-scale gradient filter using a cuboid as structural element */ -/* Volume is the grey-scale volume to process in-place */ -/* Volume has size (Nx, Ny, Nz) */ -/* (Kx, Ky, Kz) is the size of the structural element that is filled with the value 1.0F */ -/* the origin of the structural element is ((Kx - 1L) / 2L, (Ky - 1L) / 2L, (Kz - 1L) / 2L) */ -/* Convention is the boundary convention applied to Volume before processing */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin MorphologicalGradientFloatCuboid */ - - float *p, *q; - float *Dilated = (float *)NULL, *Eroded = (float *)NULL; - long x, y, z; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(MorphologicalGradientFloatCuboid, Volume, *Status, -/**/ "Missing Volume") -/**/DEBUG_CHECK_RANGE_LONG(MorphologicalGradientFloatCuboid, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid data width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MorphologicalGradientFloatCuboid, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid data height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MorphologicalGradientFloatCuboid, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid data depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MorphologicalGradientFloatCuboid, Kx, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MorphologicalGradientFloatCuboid, Ky, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MorphologicalGradientFloatCuboid, Kz, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(MorphologicalGradientFloatCuboid, *Status) -/**/DEBUG_WRITE_ENTERING(MorphologicalGradientFloatCuboid, -/**/ "About to execute MorphologicalGradientFloatCuboid") - - switch (Convention) { - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - default: - *Status = ERROR; - WRITE_ERROR(MorphologicalGradientFloatCuboid, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(MorphologicalGradientFloatCuboid, "Done") - return(*Status); - } - AllocateVolumeFloat(&Dilated, Nx, Ny, Nz, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MorphologicalGradientFloatCuboid, "Done") - return(*Status); - } - memcpy(Dilated, Volume, (size_t)(Nx * Ny * Nz * (long)sizeof(float))); - MaxFilterFloatCuboid(Dilated, Nx, Ny, Nz, Kx, Ky, Kz, Convention, Status); - if (*Status == ERROR) { - FreeVolumeFloat(&Dilated); -/**/ DEBUG_WRITE_LEAVING(MorphologicalGradientFloatCuboid, "Done") - return(*Status); - } - AllocateVolumeFloat(&Eroded, Nx, Ny, Nz, Status); - if (*Status == ERROR) { - FreeVolumeFloat(&Dilated); -/**/ DEBUG_WRITE_LEAVING(MorphologicalGradientFloatCuboid, "Done") - return(*Status); - } - memcpy(Eroded, Volume, (size_t)(Nx * Ny * Nz * (long)sizeof(float))); - MinFilterFloatCuboid(Eroded, Nx, Ny, Nz, Kx, Ky, Kz, Convention, Status); - if (*Status == ERROR) { - FreeVolumeFloat(&Eroded); - FreeVolumeFloat(&Dilated); -/**/ DEBUG_WRITE_LEAVING(MorphologicalGradientFloatCuboid, "Done") - return(*Status); - } - p = Dilated; - q = Eroded; - for (z = -Nz; (z < 0L); z++) { - for (y = -Ny; (y < 0L); y++) { - for (x = -Nx; (x < 0L); x++) { - *Volume++ = *p++ - *q++; - } - } - } - *Status = FreeVolumeFloat(&Eroded); - if (*Status == ERROR) { - FreeVolumeFloat(&Dilated); -/**/ DEBUG_WRITE_LEAVING(MorphologicalGradientFloatCuboid, "Done") - return(*Status); - } - *Status = FreeVolumeFloat(&Dilated); -/**/DEBUG_WRITE_LEAVING(MorphologicalGradientFloatCuboid, "Done") - return(*Status); -} /* end MorphologicalGradientFloatCuboid */ - -/*--------------------------------------------------------------------------*/ -extern int MorphologicalGradientShort - ( - short *VolumeSource, /* data to process */ - short *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - short *Kernel, /* structural element */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - long Ox, /* kernel X origin */ - long Oy, /* kernel Y origin */ - long Oz, /* kernel Z origin */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ) - -/* perform the grey-scale morphological operation known as morphological gradient */ -/* VolumeSource is the grey-scale volume to process */ -/* VolumeDestination is the resulting grey-scale volume after the gradient operation */ -/* both VolumeSource and VolumeDestination have size (Nx, Ny, Nz) */ -/* Kernel is the grey-scale structural element by which VolumeSource is processed */ -/* (Kx, Ky, Kz) is the size (bounding box) of the structural element */ -/* (Ox, Oy, Oz) is the origin of the structural element */ -/* Convention is the boundary convention applied to VolumeSource before the gradient operation */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin MorphologicalGradientShort */ - - short *p, *q; - short *Dilated = (short *)NULL, *Eroded = (short *)NULL; - long x, y, z; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(MorphologicalGradientShort, VolumeSource, *Status, -/**/ "Missing VolumeSource") -/**/DEBUG_CHECK_NULL_POINTER(MorphologicalGradientShort, VolumeDestination, *Status, -/**/ "Missing VolumeDestination") -/**/DEBUG_CHECK_NULL_POINTER(MorphologicalGradientShort, Kernel, *Status, -/**/ "Missing Kernel") -/**/DEBUG_CHECK_RANGE_LONG(MorphologicalGradientShort, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid data width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MorphologicalGradientShort, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid data height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MorphologicalGradientShort, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid data depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MorphologicalGradientShort, Kx, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MorphologicalGradientShort, Ky, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MorphologicalGradientShort, Kz, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(MorphologicalGradientShort, *Status) -/**/DEBUG_WRITE_ENTERING(MorphologicalGradientShort, -/**/ "About to execute MorphologicalGradientShort") - - switch (Convention) { - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - default: - *Status = ERROR; - WRITE_ERROR(MorphologicalGradientShort, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(MorphologicalGradientShort, "Done") - return(*Status); - } - AllocateVolumeShort(&Dilated, Nx, Ny, Nz, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MorphologicalGradientShort, "Done") - return(*Status); - } - *Status = DilateShort(VolumeSource, Dilated, Nx, Ny, Nz, Kernel, Kx, Ky, Kz, - Ox, Oy, Oz, Convention); - if (*Status == ERROR) { - FreeVolumeShort(&Dilated); -/**/ DEBUG_WRITE_LEAVING(MorphologicalGradientShort, "Done") - return(*Status); - } - AllocateVolumeShort(&Eroded, Nx, Ny, Nz, Status); - if (*Status == ERROR) { - FreeVolumeShort(&Dilated); -/**/ DEBUG_WRITE_LEAVING(MorphologicalGradientShort, "Done") - return(*Status); - } - *Status = ErodeShort(VolumeSource, Eroded, Nx, Ny, Nz, Kernel, Kx, Ky, Kz, - Ox, Oy, Oz, Convention); - if (*Status == ERROR) { - FreeVolumeShort(&Eroded); - FreeVolumeShort(&Dilated); -/**/ DEBUG_WRITE_LEAVING(MorphologicalGradientShort, "Done") - return(*Status); - } - p = Dilated; - q = Eroded; - for (z = -Nz; (z < 0L); z++) { - for (y = -Ny; (y < 0L); y++) { - for (x = -Nx; (x < 0L); x++) { - *VolumeDestination++ = ConvertIntToShort((int)*p++ - (int)*q++); - } - } - } - *Status = FreeVolumeShort(&Eroded); - if (*Status == ERROR) { - FreeVolumeShort(&Dilated); -/**/ DEBUG_WRITE_LEAVING(MorphologicalGradientShort, "Done") - return(*Status); - } - *Status = FreeVolumeShort(&Dilated); -/**/DEBUG_WRITE_LEAVING(MorphologicalGradientShort, "Done") - return(*Status); -} /* end MorphologicalGradientShort */ - -/*--------------------------------------------------------------------------*/ -extern int MorphologicalGradientShortCuboid - ( - short *Volume, /* data to process in-place */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ) - -/* perform a morphological grey-scale gradient filter using a cuboid as structural element */ -/* Volume is the grey-scale volume to process in-place */ -/* Volume has size (Nx, Ny, Nz) */ -/* (Kx, Ky, Kz) is the size of the structural element that is filled with the value 1.0F */ -/* the origin of the structural element is ((Kx - 1L) / 2L, (Ky - 1L) / 2L, (Kz - 1L) / 2L) */ -/* Convention is the boundary convention applied to Volume before processing */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin MorphologicalGradientShortCuboid */ - - short *p, *q; - short *Dilated = (short *)NULL, *Eroded = (short *)NULL; - long x, y, z; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(MorphologicalGradientShortCuboid, Volume, *Status, -/**/ "Missing Volume") -/**/DEBUG_CHECK_RANGE_LONG(MorphologicalGradientShortCuboid, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid data width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MorphologicalGradientShortCuboid, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid data height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MorphologicalGradientShortCuboid, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid data depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MorphologicalGradientShortCuboid, Kx, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MorphologicalGradientShortCuboid, Ky, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MorphologicalGradientShortCuboid, Kz, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(MorphologicalGradientShortCuboid, *Status) -/**/DEBUG_WRITE_ENTERING(MorphologicalGradientShortCuboid, -/**/ "About to execute MorphologicalGradientShortCuboid") - - switch (Convention) { - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - default: - *Status = ERROR; - WRITE_ERROR(MorphologicalGradientShortCuboid, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(MorphologicalGradientShortCuboid, "Done") - return(*Status); - } - AllocateVolumeShort(&Dilated, Nx, Ny, Nz, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MorphologicalGradientShortCuboid, "Done") - return(*Status); - } - memcpy(Dilated, Volume, (size_t)(Nx * Ny * Nz * (long)sizeof(short))); - MaxFilterShortCuboid(Dilated, Nx, Ny, Nz, Kx, Ky, Kz, Convention, Status); - if (*Status == ERROR) { - FreeVolumeShort(&Dilated); -/**/ DEBUG_WRITE_LEAVING(MorphologicalGradientShortCuboid, "Done") - return(*Status); - } - AllocateVolumeShort(&Eroded, Nx, Ny, Nz, Status); - if (*Status == ERROR) { - FreeVolumeShort(&Dilated); -/**/ DEBUG_WRITE_LEAVING(MorphologicalGradientShortCuboid, "Done") - return(*Status); - } - memcpy(Eroded, Volume, (size_t)(Nx * Ny * Nz * (long)sizeof(short))); - MinFilterShortCuboid(Eroded, Nx, Ny, Nz, Kx, Ky, Kz, Convention, Status); - if (*Status == ERROR) { - FreeVolumeShort(&Eroded); - FreeVolumeShort(&Dilated); -/**/ DEBUG_WRITE_LEAVING(MorphologicalGradientShortCuboid, "Done") - return(*Status); - } - p = Dilated; - q = Eroded; - for (z = -Nz; (z < 0L); z++) { - for (y = -Ny; (y < 0L); y++) { - for (x = -Nx; (x < 0L); x++) { - *Volume++ = ConvertIntToShort((int)*p++ - (int)*q++); - } - } - } - *Status = FreeVolumeShort(&Eroded); - if (*Status == ERROR) { - FreeVolumeShort(&Dilated); -/**/ DEBUG_WRITE_LEAVING(MorphologicalGradientShortCuboid, "Done") - return(*Status); - } - *Status = FreeVolumeShort(&Dilated); -/**/DEBUG_WRITE_LEAVING(MorphologicalGradientShortCuboid, "Done") - return(*Status); -} /* end MorphologicalGradientShortCuboid */ - -/*--------------------------------------------------------------------------*/ -extern int OpeningFloat - ( - float *VolumeSource, /* data to process */ - float *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - float *Kernel, /* structural element */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - long Ox, /* kernel X origin */ - long Oy, /* kernel Y origin */ - long Oz, /* kernel Z origin */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ) - -/* perform the grey-scale morphological operation known as opening */ -/* VolumeSource is the grey-scale volume to open */ -/* VolumeDestination is the resulting grey-scale volume after opening */ -/* both VolumeSource and VolumeDestination have size (Nx, Ny, Nz) */ -/* Kernel is the grey-scale structural element by which VolumeSource is opened */ -/* (Kx, Ky, Kz) is the size (bounding box) of the structural element */ -/* (Ox, Oy, Oz) is the origin of the structural element */ -/* Convention is the boundary convention applied to VolumeSource before opening */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin OpeningFloat */ - - float *Buffer = (float *)NULL; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(OpeningFloat, VolumeSource, *Status, -/**/ "Missing VolumeSource") -/**/DEBUG_CHECK_NULL_POINTER(OpeningFloat, VolumeDestination, *Status, -/**/ "Missing VolumeDestination") -/**/DEBUG_CHECK_NULL_POINTER(OpeningFloat, Kernel, *Status, -/**/ "Missing Kernel") -/**/DEBUG_CHECK_RANGE_LONG(OpeningFloat, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid data width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(OpeningFloat, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid data height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(OpeningFloat, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid data depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(OpeningFloat, Kx, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(OpeningFloat, Ky, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(OpeningFloat, Kz, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(OpeningFloat, *Status) -/**/DEBUG_WRITE_ENTERING(OpeningFloat, -/**/ "About to execute OpeningFloat") - - switch (Convention) { - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - default: - *Status = ERROR; - WRITE_ERROR(OpeningFloat, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(OpeningFloat, "Done") - return(*Status); - } - AllocateVolumeFloat(&Buffer, Nx, Ny, Nz, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(OpeningFloat, "Done") - return(*Status); - } - *Status = ErodeFloat(VolumeSource, Buffer, Nx, Ny, Nz, Kernel, Kx, Ky, Kz, - Ox, Oy, Oz, Convention); - if (*Status == ERROR) { - FreeVolumeFloat(&Buffer); -/**/ DEBUG_WRITE_LEAVING(OpeningFloat, "Done") - return(*Status); - } - *Status = DilateFloat(Buffer, VolumeDestination, Nx, Ny, Nz, Kernel, Kx, Ky, Kz, - Ox, Oy, Oz, Convention); - if (*Status == ERROR) { - FreeVolumeFloat(&Buffer); -/**/ DEBUG_WRITE_LEAVING(OpeningFloat, "Done") - return(*Status); - } - *Status = FreeVolumeFloat(&Buffer); -/**/DEBUG_WRITE_LEAVING(OpeningFloat, "Done") - return(*Status); -} /* end OpeningFloat */ - -/*--------------------------------------------------------------------------*/ -extern int OpeningFloatCuboid - ( - float *Volume, /* data to process in-place */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ) - -/* perform a morphological grey-scale opening filter using a cuboid as structural element */ -/* Volume is the grey-scale volume to open in-place */ -/* Volume has size (Nx, Ny, Nz) */ -/* (Kx, Ky, Kz) is the size of the structural element that is filled with the value 1.0F */ -/* the origin of the structural element is ((Kx - 1L) / 2L, (Ky - 1L) / 2L, (Kz - 1L) / 2L) */ -/* Convention is the boundary convention applied to Volume before opening */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin OpeningFloatCuboid */ - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(OpeningFloatCuboid, Volume, *Status, -/**/ "Missing Volume") -/**/DEBUG_CHECK_RANGE_LONG(OpeningFloatCuboid, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid data width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(OpeningFloatCuboid, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid data height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(OpeningFloatCuboid, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid data depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(OpeningFloatCuboid, Kx, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(OpeningFloatCuboid, Ky, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(OpeningFloatCuboid, Kz, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(OpeningFloatCuboid, *Status) -/**/DEBUG_WRITE_ENTERING(OpeningFloatCuboid, -/**/ "About to execute OpeningFloatCuboid") - - switch (Convention) { - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - default: - *Status = ERROR; - WRITE_ERROR(OpeningFloatCuboid, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(OpeningFloatCuboid, "Done") - return(*Status); - } - MinFilterFloatCuboid(Volume, Nx, Ny, Nz, Kx, Ky, Kz, Convention, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(OpeningFloatCuboid, "Done") - return(*Status); - } - MaxFilterFloatCuboid(Volume, Nx, Ny, Nz, Kx, Ky, Kz, Convention, Status); -/**/DEBUG_WRITE_LEAVING(OpeningFloatCuboid, "Done") - return(*Status); -} /* end OpeningFloatCuboid */ - -/*--------------------------------------------------------------------------*/ -extern int OpeningShort - ( - short *VolumeSource, /* data to process */ - short *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - short *Kernel, /* structural element */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - long Ox, /* kernel X origin */ - long Oy, /* kernel Y origin */ - long Oz, /* kernel Z origin */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ) - -/* perform the grey-scale morphological operation known as opening */ -/* VolumeSource is the grey-scale volume to open */ -/* VolumeDestination is the resulting grey-scale volume after opening */ -/* both VolumeSource and VolumeDestination have size (Nx, Ny, Nz) */ -/* Kernel is the grey-scale structural element by which VolumeSource is opened */ -/* (Kx, Ky, Kz) is the size (bounding box) of the structural element */ -/* (Ox, Oy, Oz) is the origin of the structural element */ -/* Convention is the boundary convention applied to VolumeSource before opening */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin OpeningShort */ - - short *Buffer = (short *)NULL; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(OpeningShort, VolumeSource, *Status, -/**/ "Missing VolumeSource") -/**/DEBUG_CHECK_NULL_POINTER(OpeningShort, VolumeDestination, *Status, -/**/ "Missing VolumeDestination") -/**/DEBUG_CHECK_NULL_POINTER(OpeningShort, Kernel, *Status, -/**/ "Missing Kernel") -/**/DEBUG_CHECK_RANGE_LONG(OpeningShort, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid data width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(OpeningShort, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid data height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(OpeningShort, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid data depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(OpeningShort, Kx, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(OpeningShort, Ky, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(OpeningShort, Kz, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(OpeningShort, *Status) -/**/DEBUG_WRITE_ENTERING(OpeningShort, -/**/ "About to execute OpeningShort") - - switch (Convention) { - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - default: - *Status = ERROR; - WRITE_ERROR(OpeningShort, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(OpeningShort, "Done") - return(*Status); - } - AllocateVolumeShort(&Buffer, Nx, Ny, Nz, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(OpeningShort, "Done") - return(*Status); - } - *Status = ErodeShort(VolumeSource, Buffer, Nx, Ny, Nz, Kernel, Kx, Ky, Kz, - Ox, Oy, Oz, Convention); - if (*Status == ERROR) { - FreeVolumeShort(&Buffer); -/**/ DEBUG_WRITE_LEAVING(OpeningShort, "Done") - return(*Status); - } - *Status = DilateShort(Buffer, VolumeDestination, Nx, Ny, Nz, Kernel, Kx, Ky, Kz, - Ox, Oy, Oz, Convention); - if (*Status == ERROR) { - FreeVolumeShort(&Buffer); -/**/ DEBUG_WRITE_LEAVING(OpeningShort, "Done") - return(*Status); - } - *Status = FreeVolumeShort(&Buffer); -/**/DEBUG_WRITE_LEAVING(OpeningShort, "Done") - return(*Status); -} /* end OpeningShort */ - -/*--------------------------------------------------------------------------*/ -extern int OpeningShortCuboid - ( - short *Volume, /* data to process in-place */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ) - -/* perform a morphological grey-scale opening filter using a cuboid as structural element */ -/* Volume is the grey-scale volume to open in-place */ -/* Volume has size (Nx, Ny, Nz) */ -/* (Kx, Ky, Kz) is the size of the structural element that is filled with the value 1.0F */ -/* the origin of the structural element is ((Kx - 1L) / 2L, (Ky - 1L) / 2L, (Kz - 1L) / 2L) */ -/* Convention is the boundary convention applied to Volume before opening */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin OpeningShortCuboid */ - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(OpeningShortCuboid, Volume, *Status, -/**/ "Missing Volume") -/**/DEBUG_CHECK_RANGE_LONG(OpeningShortCuboid, Nx, 1L, LONG_MAX, *Status, -/**/ "Invalid data width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(OpeningShortCuboid, Ny, 1L, LONG_MAX, *Status, -/**/ "Invalid data height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(OpeningShortCuboid, Nz, 1L, LONG_MAX, *Status, -/**/ "Invalid data depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(OpeningShortCuboid, Kx, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(OpeningShortCuboid, Ky, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(OpeningShortCuboid, Kz, 1L, LONG_MAX, *Status, -/**/ "Invalid kernel depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(OpeningShortCuboid, *Status) -/**/DEBUG_WRITE_ENTERING(OpeningShortCuboid, -/**/ "About to execute OpeningShortCuboid") - - switch (Convention) { - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - default: - *Status = ERROR; - WRITE_ERROR(OpeningShortCuboid, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(OpeningShortCuboid, "Done") - return(*Status); - } - MinFilterShortCuboid(Volume, Nx, Ny, Nz, Kx, Ky, Kz, Convention, Status); - if (*Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(OpeningShortCuboid, "Done") - return(*Status); - } - MaxFilterShortCuboid(Volume, Nx, Ny, Nz, Kx, Ky, Kz, Convention, Status); -/**/DEBUG_WRITE_LEAVING(OpeningShortCuboid, "Done") - return(*Status); -} /* end OpeningShortCuboid */ - diff --git a/src/core/bilib/morphology.h b/src/core/bilib/morphology.h deleted file mode 100644 index a72031b..0000000 --- a/src/core/bilib/morphology.h +++ /dev/null @@ -1,793 +0,0 @@ -/**@defgroup BilibMorphology Morphology - @ingroup BilibLibrary */ -//@{ -/*--------------------------------------------------------------------------*/ -/** Perform the grey-scale morphological operation known as bright top hat. - VolumeSource is the grey-scale volume to process. - VolumeDestination is the resulting grey-scale volume. - Both VolumeSource and VolumeDestination have size (Nx, Ny, Nz). - Kernel is the grey-scale structural element by which VolumeSource - is processed. (Kx, Ky, Kz) is the size (bounding box) of the - structural element. (Ox, Oy, Oz) is the origin of the structural element. - - Convention is the boundary convention applied to VolumeSource before - processing. - - success: return(!ERROR); failure: return(ERROR) */ -extern int BrightTopHatFloat - ( - float *VolumeSource, /* data to process */ - float *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - float *Kernel, /* structural element */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - long Ox, /* kernel X origin */ - long Oy, /* kernel Y origin */ - long Oz, /* kernel Z origin */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Perform a morphological grey-scale bright top hat filter using a cuboid - as structural element. - Volume is the grey-scale volume to process in-place. - Volume has size (Nx, Ny, Nz). - (Kx, Ky, Kz) is the size of the structural element that is filled with - the value 1.0F. - The origin of the structural element is ((Kx - 1L) / 2L, (Ky - 1L) / 2L, - (Kz - 1L) / 2L). - Convention is the boundary convention applied to Volume before processing. - success: return(!ERROR); failure: return(ERROR) */ -extern int BrightTopHatFloatCuboid - ( - float *Volume, /* data to process in-place */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Perform the grey-scale morphological operation known as bright top hat. - VolumeSource is the grey-scale volume to process. - VolumeDestination is the resulting grey-scale volume. - Both VolumeSource and VolumeDestination have size (Nx, Ny, Nz). - Kernel is the grey-scale structural element by which VolumeSource is - processed. (Kx, Ky, Kz) is the size (bounding box) of the structural - element. (Ox, Oy, Oz) is the origin of the structural element. - Convention is the boundary convention applied to VolumeSource before - processing. - success: return(!ERROR); failure: return(ERROR) */ -extern int BrightTopHatShort - ( - short *VolumeSource, /* data to process */ - short *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - short *Kernel, /* structural element */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - long Ox, /* kernel X origin */ - long Oy, /* kernel Y origin */ - long Oz, /* kernel Z origin */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Perform a morphological grey-scale bright top hat filter using a cuboid - as structural element. - Volume is the grey-scale volume to process in-place. - Volume has size (Nx, Ny, Nz). - (Kx, Ky, Kz) is the size of the structural element that is filled with - the value 1.0F. The origin of the structural element is ((Kx - 1L) / 2L, - (Ky - 1L) / 2L, (Kz - 1L) / 2L). - Convention is the boundary convention applied to Volume before processing. - - success: return(!ERROR); failure: return(ERROR) */ -extern int BrightTopHatShortCuboid - ( - short *Volume, /* data to process in-place */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Perform the grey-scale morphological operation known as closing. - VolumeSource is the grey-scale volume to close. - VolumeDestination is the resulting grey-scale volume after closing. - Both VolumeSource and VolumeDestination have size (Nx, Ny, Nz). - Kernel is the grey-scale structural element by which VolumeSource is - closed. (Kx, Ky, Kz) is the size (bounding box) of the structural element. - (Ox, Oy, Oz) is the origin of the structural element. - Convention is the boundary convention applied to VolumeSource before - closing. - - success: return(!ERROR); failure: return(ERROR) */ -extern int ClosingFloat - ( - float *VolumeSource, /* data to process */ - float *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - float *Kernel, /* structural element */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - long Ox, /* kernel X origin */ - long Oy, /* kernel Y origin */ - long Oz, /* kernel Z origin */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Perform a morphological grey-scale closing filter using a cuboid as - structural element. - Volume is the grey-scale volume to close in-place. - Volume has size (Nx, Ny, Nz). - (Kx, Ky, Kz) is the size of the structural element that is filled with - the value 1.0F. - The origin of the structural element is ((Kx - 1L) / 2L, (Ky - 1L) / 2L, - (Kz - 1L) / 2L). - Convention is the boundary convention applied to Volume before closing. - - success: return(!ERROR); failure: return(ERROR) */ -extern int ClosingFloatCuboid - ( - float *Volume, /* data to process in-place */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Perform the grey-scale morphological operation known as closing. - VolumeSource is the grey-scale volume to close. - VolumeDestination is the resulting grey-scale volume after closing. - Both VolumeSource and VolumeDestination have size (Nx, Ny, Nz). - Kernel is the grey-scale structural element by which VolumeSource is - closed. (Kx, Ky, Kz) is the size (bounding box) of the structural element. - (Ox, Oy, Oz) is the origin of the structural element. - Convention is the boundary convention applied to VolumeSource before - closing. - - success: return(!ERROR); failure: return(ERROR) */ -extern int ClosingShort - ( - short *VolumeSource, /* data to process */ - short *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - short *Kernel, /* structural element */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - long Ox, /* kernel X origin */ - long Oy, /* kernel Y origin */ - long Oz, /* kernel Z origin */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Perform a morphological grey-scale closing filter using a cuboid as - structural element. - Volume is the grey-scale volume to close in-place. - Volume has size (Nx, Ny, Nz). - (Kx, Ky, Kz) is the size of the structural element that is filled with - the value 1.0F. - The origin of the structural element is ((Kx - 1L) / 2L, (Ky - 1L) / 2L, - (Kz - 1L) / 2L). - Convention is the boundary convention applied to Volume before closing. - - success: return(!ERROR); failure: return(ERROR) */ -extern int ClosingShortCuboid - ( - short *Volume, /* data to process in-place */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Perform the grey-scale morphological operation known as dark top hat. - VolumeSource is the grey-scale volume to process. - VolumeDestination is the resulting grey-scale volume. - Both VolumeSource and VolumeDestination have size (Nx, Ny, Nz). - Kernel is the grey-scale structural element by which VolumeSource - is processed. (Kx, Ky, Kz) is the size (bounding box) of the structural - element. (Ox, Oy, Oz) is the origin of the structural element. - Convention is the boundary convention applied to VolumeSource before - processing. - - success: return(!ERROR); failure: return(ERROR) */ -extern int DarkTopHatFloat - ( - float *VolumeSource, /* data to process */ - float *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - float *Kernel, /* structural element */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - long Ox, /* kernel X origin */ - long Oy, /* kernel Y origin */ - long Oz, /* kernel Z origin */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Perform a morphological grey-scale dark top hat filter using a cuboid - as structural element. - Volume is the grey-scale volume to process in-place. - Volume has size (Nx, Ny, Nz). - (Kx, Ky, Kz) is the size of the structural element that is filled with - the value 1.0F. The origin of the structural element is ((Kx - 1L) / 2L, - (Ky - 1L) / 2L, (Kz - 1L) / 2L). - Convention is the boundary convention applied to Volume before processing - success: return(!ERROR); failure: return(ERROR) */ -extern int DarkTopHatFloatCuboid - ( - float *Volume, /* data to process in-place */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Perform the grey-scale morphological operation known as dark top hat. - VolumeSource is the grey-scale volume to process. - VolumeDestination is the resulting grey-scale volume. - Both VolumeSource and VolumeDestination have size (Nx, Ny, Nz). - Kernel is the grey-scale structural element by which VolumeSource is - processed. (Kx, Ky, Kz) is the size (bounding box) of the structural - element. (Ox, Oy, Oz) is the origin of the structural element. - Convention is the boundary convention applied to VolumeSource before - processing. - - success: return(!ERROR); failure: return(ERROR) */ -extern int DarkTopHatShort - ( - short *VolumeSource, /* data to process */ - short *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - short *Kernel, /* structural element */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - long Ox, /* kernel X origin */ - long Oy, /* kernel Y origin */ - long Oz, /* kernel Z origin */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Perform a morphological grey-scale dark top hat filter using a cuboid - as structural element. - Volume is the grey-scale volume to process in-place. - Volume has size (Nx, Ny, Nz). - (Kx, Ky, Kz) is the size of the structural element that is filled - with the value 1.0F. - The origin of the structural element is ((Kx - 1L) / 2L, (Ky - 1L) / 2L, - (Kz - 1L) / 2L). - Convention is the boundary convention applied to Volume before processing. - - success: return(!ERROR); failure: return(ERROR) */ -extern int DarkTopHatShortCuboid - ( - short *Volume, /* data to process in-place */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Perform the grey-scale morphological operation known as dilatation. - VolumeSource is the grey-scale volume to dilate. - VolumeDestination is the resulting grey-scale volume after dilatation. - Both VolumeSource and VolumeDestination have size (Nx, Ny, Nz). - Kernel is the grey-scale structural element by which VolumeSource is - dilated. (Kx, Ky, Kz) is the size (bounding box) of the structural element. - (Ox, Oy, Oz) is the origin of the structural element. - Convention is the boundary convention applied to VolumeSource before - dilatation. - - success: return(!ERROR); failure: return(ERROR) */ -extern int DilateFloat - ( - float *VolumeSource, /* data to process */ - float *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - float *Kernel, /* structural element */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - long Ox, /* kernel X origin */ - long Oy, /* kernel Y origin */ - long Oz, /* kernel Z origin */ - enum TBoundaryConvention - Convention /* boundary convention */ - ); - -/*--------------------------------------------------------------------------*/ -/** Perform the grey-scale morphological operation known as dilatation. - VolumeSource is the grey-scale volume to dilate. - VolumeDestination is the resulting grey-scale volume after dilatation. - Both VolumeSource and VolumeDestination have size (Nx, Ny, Nz). - Kernel is the grey-scale structural element by which VolumeSource is - dilated. (Kx, Ky, Kz) is the size (bounding box) of the structural element. - (Ox, Oy, Oz) is the origin of the structural element. - Convention is the boundary convention applied to VolumeSource before - dilatation. - - success: return(!ERROR); failure: return(ERROR) */ -extern int DilateShort - ( - short *VolumeSource, /* data to process */ - short *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - short *Kernel, /* structural element */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - long Ox, /* kernel X origin */ - long Oy, /* kernel Y origin */ - long Oz, /* kernel Z origin */ - enum TBoundaryConvention - Convention /* boundary convention */ - ); - -/*--------------------------------------------------------------------------*/ -/** Perform the grey-scale morphological operation known as erosion. - VolumeSource is the grey-scale volume to erode. - VolumeDestination is the resulting grey-scale volume after erosion. - Both VolumeSource and VolumeDestination have size (Nx, Ny, Nz). - Kernel is the grey-scale structural element by which VolumeSource is - eroded. (Kx, Ky, Kz) is the size (bounding box) of the structural element. - (Ox, Oy, Oz) is the origin of the structural element. - Convention is the boundary convention applied to VolumeSource before - erosion. - success: return(!ERROR); failure: return(ERROR) */ -extern int ErodeFloat - ( - float *VolumeSource, /* data to process */ - float *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - float *Kernel, /* structural element */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - long Ox, /* kernel X origin */ - long Oy, /* kernel Y origin */ - long Oz, /* kernel Z origin */ - enum TBoundaryConvention - Convention /* boundary convention */ - ); - -/*--------------------------------------------------------------------------*/ -/** Perform the grey-scale morphological operation known as erosion. - VolumeSource is the grey-scale volume to erode. - VolumeDestination is the resulting grey-scale volume after erosion. - Both VolumeSource and VolumeDestination have size (Nx, Ny, Nz). - Kernel is the grey-scale structural element by which VolumeSource is eroded. - (Kx, Ky, Kz) is the size (bounding box) of the structural element. - (Ox, Oy, Oz) is the origin of the structural element. - Convention is the boundary convention applied to VolumeSource before erosion. - - success: return(!ERROR); failure: return(ERROR) */ -extern int ErodeShort - ( - short *VolumeSource, /* data to process */ - short *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - short *Kernel, /* structural element */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - long Ox, /* kernel X origin */ - long Oy, /* kernel Y origin */ - long Oz, /* kernel Z origin */ - enum TBoundaryConvention - Convention /* boundary convention */ - ); - -/*--------------------------------------------------------------------------*/ -/** Perform a morphological grey-scale max filter using a cuboid as - structural element. - Volume is the grey-scale volume to dilate in-place. - Volume has size (Nx, Ny, Nz). - (Kx, Ky, Kz) is the size of the structural element that is filled with - the value 1.0F. The origin of the structural element is ((Kx - 1L) / 2L, - (Ky - 1L) / 2L, (Kz - 1L) / 2L). - Convention is the boundary convention applied to Volume before dilatation. - - success: return(!ERROR); failure: return(ERROR) */ -extern int MaxFilterFloatCuboid - ( - float *Volume, /* data to process in-place */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Perform a morphological grey-scale max filter using a cuboid as - structural element. - Volume is the grey-scale volume to dilate in-place. - Volume has size (Nx, Ny, Nz). - (Kx, Ky, Kz) is the size of the structural element that is filled - with the value 1.0F. - The origin of the structural element is ((Kx - 1L) / 2L, (Ky - 1L) / 2L, - (Kz - 1L) / 2L). - Convention is the boundary convention applied to Volume before dilatation. - - success: return(!ERROR); failure: return(ERROR) */ -extern int MaxFilterShortCuboid - ( - short *Volume, /* data to process in-place */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Perform a morphological grey-scale min filter using a cuboid as - structural element. - Volume is the grey-scale volume to erode in-place. - Volume has size (Nx, Ny, Nz). - (Kx, Ky, Kz) is the size of the structural element that is filled with - the value 1.0F. - The origin of the structural element is ((Kx - 1L) / 2L, (Ky - 1L) / 2L, - (Kz - 1L) / 2L). - Convention is the boundary convention applied to Volume before erosion. - - success: return(!ERROR); failure: return(ERROR) */ -extern int MinFilterFloatCuboid - ( - float *Volume, /* data to process in-place */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Perform a morphological grey-scale min filter using a cuboid as - structural element. - Volume is the grey-scale volume to erode in-place. - Volume has size (Nx, Ny, Nz). - (Kx, Ky, Kz) is the size of the structural element that is filled with - the value 1.0F. - The origin of the structural element is ((Kx - 1L) / 2L, (Ky - 1L) / 2L, - (Kz - 1L) / 2L). - Convention is the boundary convention applied to Volume before erosion. - - success: return(!ERROR); failure: return(ERROR) */ -extern int MinFilterShortCuboid - ( - short *Volume, /* data to process in-place */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Perform the grey-scale morphological operation known as morphological - gradient. - VolumeSource is the grey-scale volume to process. - VolumeDestination is the resulting grey-scale volume after the gradient - operation. - Both VolumeSource and VolumeDestination have size (Nx, Ny, Nz). - Kernel is the grey-scale structural element by which VolumeSource is - processed. (Kx, Ky, Kz) is the size (bounding box) of the structural - element. (Ox, Oy, Oz) is the origin of the structural element. - Convention is the boundary convention applied to VolumeSource before - the gradient operation. - - success: return(!ERROR); failure: return(ERROR) */ -extern int MorphologicalGradientFloat - ( - float *VolumeSource, /* data to process */ - float *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - float *Kernel, /* structural element */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - long Ox, /* kernel X origin */ - long Oy, /* kernel Y origin */ - long Oz, /* kernel Z origin */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Perform a morphological grey-scale gradient filter using a cuboid as - structural element. - Volume is the grey-scale volume to process in-place. - Volume has size (Nx, Ny, Nz). - (Kx, Ky, Kz) is the size of the structural element that is filled with - the value 1.0F. - The origin of the structural element is ((Kx - 1L) / 2L, (Ky - 1L) / 2L, - (Kz - 1L) / 2L). - Convention is the boundary convention applied to Volume before processing. - - success: return(!ERROR); failure: return(ERROR) */ -extern int MorphologicalGradientFloatCuboid - ( - float *Volume, /* data to process in-place */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Perform the grey-scale morphological operation known as morphological - gradient. - VolumeSource is the grey-scale volume to process. - VolumeDestination is the resulting grey-scale volume after the gradient - operation. - Both VolumeSource and VolumeDestination have size (Nx, Ny, Nz). - Kernel is the grey-scale structural element by which VolumeSource is - processed. (Kx, Ky, Kz) is the size (bounding box) of the structural - element. (Ox, Oy, Oz) is the origin of the structural element. - Convention is the boundary convention applied to VolumeSource before - the gradient operation. - - success: return(!ERROR); failure: return(ERROR) */ -extern int MorphologicalGradientShort - ( - short *VolumeSource, /* data to process */ - short *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - short *Kernel, /* structural element */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - long Ox, /* kernel X origin */ - long Oy, /* kernel Y origin */ - long Oz, /* kernel Z origin */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Perform a morphological grey-scale gradient filter using a cuboid as - structural element. - Volume is the grey-scale volume to process in-place. - Volume has size (Nx, Ny, Nz). - (Kx, Ky, Kz) is the size of the structural element that is filled with - the value 1.0F. - The origin of the structural element is ((Kx - 1L) / 2L, (Ky - 1L) / 2L, - (Kz - 1L) / 2L). - Convention is the boundary convention applied to Volume before processing. - - success: return(!ERROR); failure: return(ERROR) */ -extern int MorphologicalGradientShortCuboid - ( - short *Volume, /* data to process in-place */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Perform the grey-scale morphological operation known as opening. - VolumeSource is the grey-scale volume to open. - VolumeDestination is the resulting grey-scale volume after opening. - Both VolumeSource and VolumeDestination have size (Nx, Ny, Nz). - Kernel is the grey-scale structural element by which VolumeSource is - opened. (Kx, Ky, Kz) is the size (bounding box) of the structural element. - (Ox, Oy, Oz) is the origin of the structural element. - Convention is the boundary convention applied to VolumeSource before opening. - - success: return(!ERROR); failure: return(ERROR) */ -extern int OpeningFloat - ( - float *VolumeSource, /* data to process */ - float *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - float *Kernel, /* structural element */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - long Ox, /* kernel X origin */ - long Oy, /* kernel Y origin */ - long Oz, /* kernel Z origin */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Perform a morphological grey-scale opening filter using a cuboid as - structural element. - Volume is the grey-scale volume to open in-place. - Volume has size (Nx, Ny, Nz). - (Kx, Ky, Kz) is the size of the structural element that is filled with - the value 1.0F. - The origin of the structural element is ((Kx - 1L) / 2L, (Ky - 1L) / 2L, - (Kz - 1L) / 2L). - Convention is the boundary convention applied to Volume before opening. - - success: return(!ERROR); failure: return(ERROR) */ -extern int OpeningFloatCuboid - ( - float *Volume, /* data to process in-place */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Perform the grey-scale morphological operation known as opening. - VolumeSource is the grey-scale volume to open. - VolumeDestination is the resulting grey-scale volume after opening. - Both VolumeSource and VolumeDestination have size (Nx, Ny, Nz). - Kernel is the grey-scale structural element by which VolumeSource is - opened. (Kx, Ky, Kz) is the size (bounding box) of the structural element. - (Ox, Oy, Oz) is the origin of the structural element. - Convention is the boundary convention applied to VolumeSource before - opening. - - success: return(!ERROR); failure: return(ERROR) */ -extern int OpeningShort - ( - short *VolumeSource, /* data to process */ - short *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - short *Kernel, /* structural element */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - long Ox, /* kernel X origin */ - long Oy, /* kernel Y origin */ - long Oz, /* kernel Z origin */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Perform a morphological grey-scale opening filter using a cuboid as - structural element. - Volume is the grey-scale volume to open in-place. - Volume has size (Nx, Ny, Nz). - (Kx, Ky, Kz) is the size of the structural element that is filled with - the value 1.0F - The origin of the structural element is ((Kx - 1L) / 2L, (Ky - 1L) / 2L, - (Kz - 1L) / 2L) - Convention is the boundary convention applied to Volume before opening. - - success: return(!ERROR); failure: return(ERROR) */ -extern int OpeningShortCuboid - ( - short *Volume, /* data to process in-place */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long Kx, /* width of the kernel */ - long Ky, /* height of the kernel */ - long Kz, /* depth of the kernel */ - enum TBoundaryConvention - Convention, /* boundary convention */ - int *Status /* error management */ - ); -//@} diff --git a/src/core/bilib/movingaverage.cc b/src/core/bilib/movingaverage.cc deleted file mode 100644 index 12c5329..0000000 --- a/src/core/bilib/movingaverage.cc +++ /dev/null @@ -1,603 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -#include -#include -#include -#include - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" -#include "error.h" -#include "tboundaryconvention.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "fold.h" -#include "getput.h" -#include "messagedisplay.h" -#include "movingaverage.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -#ifdef DEBUG -#include -#endif - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern int MovingAverage - ( - double InputData[], /* data to process */ - double OutputData[], /* result */ - long SignalLength, /* length of the 1D data array */ - long KernelOrigin, /* center of the kernel */ - long KernelLength, /* length of the 1D kernel */ - enum TBoundaryConvention - Convention /* boundary convention */ - ) - -/* the specified boundary convention applies to the input data only, not to the kernel */ -/* the boundary convention applied to the kernel is FiniteDataSupport */ -/* the kernel has a constant value and sums up to 1.0 */ -/* the input and the output have the same length */ -/* the origin for the kernel is given with respect to the leftmost sample [0] */ -/* success: return(!ERROR); failure: return(ERROR) */ -/* general structure is as follows: - for (i = 0L; (i < SignalLength); i++) { - Sum = 0.0; - for (j = -Infinity; (j <= Infinity); j++) { - Sum += InputData[j] * Kernel[KernelOrigin + i - j]; - } - OutputData[i] = Sum; - } -*/ - -{ /* begin MovingAverage */ - - double *p, *q; - double Sum, Norm; - long i, j; - long km, kp; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(MovingAverage, InputData, Status, -/**/ "No input data") -/**/DEBUG_CHECK_NULL_POINTER(MovingAverage, OutputData, Status, -/**/ "No output data") -/**/DEBUG_CHECK_RANGE_LONG(MovingAverage, SignalLength, 1L, LONG_MAX, Status, -/**/ "Invalid signal length (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MovingAverage, KernelLength, 1L, LONG_MAX, Status, -/**/ "Invalid kernel length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(MovingAverage, Status) -/**/DEBUG_WRITE_ENTERING(MovingAverage, -/**/ "About to perform a convolution by moving average") - - Norm = 1.0 / (double)KernelLength; - switch (Convention) { - case AntiMirrorOnBounds: - if (SignalLength == 1L) { - *OutputData = *InputData; - break; - } - Status = ERROR; - WRITE_ERROR(MovingAverage, "Not yet implemented") - break; - case FiniteDataSupport: - Sum = 0.0; - KernelOrigin = KernelLength - KernelOrigin - 1L; - km = (KernelOrigin < 0L) ? (-KernelOrigin) : (0L); - kp = ((KernelLength - KernelOrigin) < SignalLength) ? (KernelLength - KernelOrigin) - : (SignalLength); - p = InputData + (ptrdiff_t)km; - for (j = km - kp; (j < 0L); j++) { - Sum += *p++; - } - *OutputData++ = Sum * Norm; - km = -KernelOrigin; - kp = km + KernelLength; - p = InputData + (ptrdiff_t)km; - q = InputData + (ptrdiff_t)kp; - i = 1L - SignalLength; - if (i < kp) { - if (kp < 0L) { - p -= (ptrdiff_t)kp; - q -= (ptrdiff_t)kp; - km -= kp; - i -= kp; - while (kp++ < 0L) { - *OutputData++ = Sum * Norm; - } - } - } - else { - Sum *= Norm; - while (i++ < 0L) { - *OutputData++ = Sum; - } - break; - } - if (i < km) { - if (km < (kp - SignalLength)) { - if (kp < SignalLength) { - p += (ptrdiff_t)(SignalLength - kp); - km += SignalLength - kp; - i += SignalLength - kp; - while (kp++ < SignalLength) { - Sum += *q++; - *OutputData++ = Sum * Norm; - } - } - } - else { - if (km < 0L) { - p -= (ptrdiff_t)km; - kp -= km; - i -= km; - while (km++ < 0L) { - Sum += *q++; - *OutputData++ = Sum * Norm; - } - } - } - } - else { - if (i < (kp - SignalLength)) { - if (kp < SignalLength) { - p += (ptrdiff_t)(SignalLength - kp); - km += SignalLength - kp; - i += SignalLength - kp; - while (kp++ < SignalLength) { - Sum += *q++; - *OutputData++ = Sum * Norm; - } - } - } - else { - while (i++ < 0L) { - Sum += *q++; - *OutputData++ = Sum * Norm; - } - break; - } - } - if (i < km) { - if (km < 0L) { - p -= (ptrdiff_t)km; - q -= (ptrdiff_t)km; - kp -= km; - i -= km; - while (km++ < 0L) { - *OutputData++ = Sum * Norm; - } - } - } - else { - Sum *= Norm; - while (i++ < 0L) { - *OutputData++ = Sum; - } - break; - } - if (i < (kp - SignalLength)) { - if (kp < SignalLength) { - km += SignalLength - kp; - i += SignalLength - kp; - while (kp++ < SignalLength) { - Sum -= *p++; - Sum += *q++; - *OutputData++ = Sum * Norm; - } - } - } - else { - while (i++ < 0L) { - Sum -= *p++; - Sum += *q++; - *OutputData++ = Sum * Norm; - } - break; - } - if (i < (km - SignalLength)) { - i += SignalLength - km; - while (km++ < SignalLength) { - Sum -= *p++; - *OutputData++ = Sum * Norm; - } - } - else { - while (i++ < 0L) { - Sum -= *p++; - *OutputData++ = Sum * Norm; - } - break; - } - Sum *= Norm; - while (i++ < 0L) { - *OutputData++ = Sum; - } - break; - case MirrorOffBounds: - if (SignalLength == 1L) { - *OutputData = *InputData; - break; - } - Status = ERROR; - WRITE_ERROR(MovingAverage, "Not yet implemented") - break; - case MirrorOnBounds: - if (SignalLength == 1L) { - *OutputData = *InputData; - break; - } - Status = ERROR; - WRITE_ERROR(MovingAverage, "Not yet implemented") - break; - case Periodic: - if (SignalLength == 1L) { - *OutputData = *InputData; - break; - } - Sum = 0.0; - if (KernelLength < SignalLength) { - km = KernelOrigin - KernelLength + 1L; - km += (km < 0L) - ? (SignalLength * ((SignalLength - km - 1L) / SignalLength)) - : (-SignalLength * (km / SignalLength)); - kp = KernelOrigin; - kp += (kp < 0L) - ? (SignalLength * ((SignalLength - kp - 1L) / SignalLength)) - : (-SignalLength * (kp / SignalLength)); - if (km < kp) { - p = InputData + (ptrdiff_t)km; - q = p; - for (j = -KernelLength; (j < 0L); j++) { - Sum += *q++; - } - *OutputData++ = Sum * Norm; - i = -kp; - j = -km; - km += SignalLength - kp - 1L; - while (++kp < SignalLength) { - Sum -= *p++; - Sum += *q++; - *OutputData++ = Sum * Norm; - } - q = InputData; - kp = 0L; - if ((km - SignalLength) <= i) { - while (i++ < 0L) { - Sum -= *p++; - Sum += *q++; - *OutputData++ = Sum * Norm; - } - break; - } - else { - while (km++ < SignalLength) { - Sum -= *p++; - Sum += *q++; - *OutputData++ = Sum * Norm; - } - p = InputData; - while (++j < 0L) { - Sum -= *p++; - Sum += *q++; - *OutputData++ = Sum * Norm; - } - break; - } - } - else if (km == kp) { - kp = SignalLength - km; - OutputData = (double *)memcpy(OutputData, InputData + (ptrdiff_t)km, - (size_t)(kp * (long)sizeof(double))); - OutputData += (ptrdiff_t)kp; - OutputData = (double *)memcpy(OutputData, InputData, - (size_t)((SignalLength - kp) * (long)sizeof(double))); - } - else { - q = InputData + (ptrdiff_t)kp; - p = q; - do { - Sum += *p--; - } while (InputData <= p); - p = InputData + (ptrdiff_t)km; - for (j = km - SignalLength; (j < 0L); j++) { - Sum += *p++; - } - *OutputData++ = Sum * Norm; - i = -km; - j = -kp; - p = InputData + (ptrdiff_t)km; - kp += SignalLength - km + 1L; - while (km++ < SignalLength) { - Sum -= *p++; - Sum += *++q; - *OutputData++ = Sum * Norm; - } - p = InputData; - km = 0L; - while (kp++ < SignalLength) { - Sum -= *p++; - Sum += *++q; - *OutputData++ = Sum * Norm; - } - q = InputData; - while (j++ < 0L) { - Sum -= *p++; - Sum += *q++; - *OutputData++ = Sum * Norm; - } - break; - } - } - if (KernelLength == SignalLength) { - for (j = -SignalLength; (j < 0L); j++) { - Sum += *InputData++; - } - Sum *= Norm; - for (j = -SignalLength; (j < 0L); j++) { - *OutputData++ = Sum; - } - break; - } - if (SignalLength < KernelLength) { -/* -@ -*/ - } - Status = ERROR; - WRITE_ERROR(MovingAverage, "Not yet implemented") - break; - default: - Status = ERROR; - WRITE_ERROR(MovingAverage, "Invalid boundary convention") - break; - } -/**/DEBUG_WRITE_LEAVING(MovingAverage, "Done") - return(Status); -} /* end MovingAverage */ - -/*--------------------------------------------------------------------------*/ -extern int MovingAverageVolume - ( - float *VolumeSource, /* data to process */ - float *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long KernelOrigin, /* center of the kernel */ - long KernelLength, /* length of the 1D kernel */ - enum TBoundaryConvention - Convention /* boundary convention */ - ) - -/* the specified boundary convention applies to the input data only, not to the kernel */ -/* the boundary convention applied to the kernel is FiniteDataSupport */ -/* VolumeSource is a (float)volume of size (Nx x Ny x Nz) */ -/* OutputData is a (float)volume of size (Nx x Ny x Nz) */ -/* the origin for the kernel is given with respect to the leftmost sample [0] */ -/* the 1D kernel is applied successively to each principal direction in a separable fashion */ -/* success: return(!ERROR); failure: return(ERROR) */ -/* general structure is as follows: - for (i = 0L; (i < SignalLength); i++) { - Sum = 0.0; - for (j = i - KernelOrigin; (j < (KernelLength + i - KernelOrigin)); j++) { - Sum += InputData[j]; - } - OutputData[i] = Sum / KernelLength; - } -*/ - -{ /* begin MovingAverageVolume */ - - double *InBuffer = (double *)NULL, *OutBuffer = (double *)NULL; - long i, j, k; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(MovingAverageVolume, VolumeSource, Status, -/**/ "No VolumeSource") -/**/DEBUG_CHECK_NULL_POINTER(MovingAverageVolume, VolumeDestination, Status, -/**/ "No OutputData") -/**/DEBUG_CHECK_RANGE_LONG(MovingAverageVolume, Nx, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MovingAverageVolume, Ny, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MovingAverageVolume, Nz, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(MovingAverageVolume, KernelLength, 1L, LONG_MAX, Status, -/**/ "Invalid kernel length (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(MovingAverageVolume, Status) -/**/DEBUG_WRITE_ENTERING(MovingAverageVolume, -/**/ "About to perform IIR recursive convolution for a volume") - - switch (Convention) { - case AntiMirrorOnBounds: - case FiniteCoefficientSupport: - case FiniteDataSupport: - case MirrorOffBounds: - case MirrorOnBounds: - case Periodic: - break; - default: - Status = ERROR; - WRITE_ERROR(MovingAverageVolume, "Invalid boundary convention") -/**/ DEBUG_WRITE_LEAVING(MovingAverageVolume, "Done") - return(Status); - } - if (1L < Nx) { - AllocateLineDouble(&InBuffer, Nx, &Status); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MovingAverageVolume, "Done") - return(Status); - } - AllocateLineDouble(&OutBuffer, Nx, &Status); - if (Status == ERROR) { - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(MovingAverageVolume, "Done") - return(Status); - } - for (k = 0L; (k < Nz); k++) { - for (j = 0L; (j < Ny); j++) { - Status = GetxFloatToDouble(VolumeSource, Nx, Ny, Nz, 0L, j, k, InBuffer, Nx); - if (Status == ERROR) { - FreeLineDouble(&OutBuffer); - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(MovingAverageVolume, "Done") - return(Status); - } - Status = MovingAverage(InBuffer, OutBuffer, Nx, - KernelOrigin, KernelLength, Convention); - if (Status == ERROR) { - FreeLineDouble(&OutBuffer); - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(MovingAverageVolume, "Done") - return(Status); - } - Status = PutxDoubleToFloat(VolumeDestination, Nx, Ny, Nz, 0L, j, k, OutBuffer, Nx); - if (Status == ERROR) { - FreeLineDouble(&OutBuffer); - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(MovingAverageVolume, "Done") - return(Status); - } - } - } - Status = FreeLineDouble(&OutBuffer); - if (Status == ERROR) { - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(MovingAverageVolume, "Done") - return(Status); - } - Status = FreeLineDouble(&InBuffer); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MovingAverageVolume, "Done") - return(Status); - } - } - else { - VolumeDestination = (float *)memcpy(VolumeDestination, VolumeSource, - (size_t)(Nx * Ny * Nz * (long)sizeof(float))); - } - if (1L < Ny) { - AllocateLineDouble(&InBuffer, Ny, &Status); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MovingAverageVolume, "Done") - return(Status); - } - AllocateLineDouble(&OutBuffer, Ny, &Status); - if (Status == ERROR) { - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(MovingAverageVolume, "Done") - return(Status); - } - for (k = 0L; (k < Nz); k++) { - for (i = 0L; (i < Nx); i++) { - Status = GetyFloatToDouble(VolumeDestination, Nx, Ny, Nz, i, 0L, k, InBuffer, Ny); - if (Status == ERROR) { - FreeLineDouble(&OutBuffer); - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(MovingAverageVolume, "Done") - return(Status); - } - Status = MovingAverage(InBuffer, OutBuffer, Ny, - KernelOrigin, KernelLength, Convention); - if (Status == ERROR) { - FreeLineDouble(&OutBuffer); - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(MovingAverageVolume, "Done") - return(Status); - } - Status = PutyDoubleToFloat(VolumeDestination, Nx, Ny, Nz, i, 0L, k, OutBuffer, Ny); - if (Status == ERROR) { - FreeLineDouble(&OutBuffer); - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(MovingAverageVolume, "Done") - return(Status); - } - } - } - Status = FreeLineDouble(&OutBuffer); - if (Status == ERROR) { - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(MovingAverageVolume, "Done") - return(Status); - } - Status = FreeLineDouble(&InBuffer); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MovingAverageVolume, "Done") - return(Status); - } - } - if (1L < Nz) { - AllocateLineDouble(&InBuffer, Nz, &Status); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MovingAverageVolume, "Done") - return(Status); - } - AllocateLineDouble(&OutBuffer, Nz, &Status); - if (Status == ERROR) { - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(MovingAverageVolume, "Done") - return(Status); - } - for (j = 0L; (j < Ny); j++) { - for (i = 0L; (i < Nx); i++) { - Status = GetzFloatToDouble(VolumeDestination, Nx, Ny, Nz, i, j, 0L, InBuffer, Nz); - if (Status == ERROR) { - FreeLineDouble(&OutBuffer); - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(MovingAverageVolume, "Done") - return(Status); - } - Status = MovingAverage(InBuffer, OutBuffer, Nz, - KernelOrigin, KernelLength, Convention); - if (Status == ERROR) { - FreeLineDouble(&OutBuffer); - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(MovingAverageVolume, "Done") - return(Status); - } - Status = PutzDoubleToFloat(VolumeDestination, Nx, Ny, Nz, i, j, 0L, OutBuffer, Nz); - if (Status == ERROR) { - FreeLineDouble(&OutBuffer); - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(MovingAverageVolume, "Done") - return(Status); - } - } - } - Status = FreeLineDouble(&OutBuffer); - if (Status == ERROR) { - FreeLineDouble(&InBuffer); -/**/ DEBUG_WRITE_LEAVING(MovingAverageVolume, "Done") - return(Status); - } - Status = FreeLineDouble(&InBuffer); - if (Status == ERROR) { -/**/ DEBUG_WRITE_LEAVING(MovingAverageVolume, "Done") - return(Status); - } - } -/**/DEBUG_WRITE_LEAVING(MovingAverageVolume, "Done") - return(Status); -} /* end MovingAverageVolume */ - diff --git a/src/core/bilib/movingaverage.h b/src/core/bilib/movingaverage.h deleted file mode 100644 index 16519a9..0000000 --- a/src/core/bilib/movingaverage.h +++ /dev/null @@ -1,72 +0,0 @@ -/**@defgroup BilibMA Moving average - @ingroup BilibLibrary */ -//@{ -/*--------------------------------------------------------------------------*/ -/** Moving average (1D). - * The specified boundary convention applies to the input data only, not to - * the kernel. The boundary convention applied to the kernel is - * FiniteDataSupport. - * - * The kernel has a constant value and sums up to 1.0. - * The input and the output have the same length. - * The origin for the kernel is given with respect to the leftmost sample [0]. - * - * success: return(!ERROR); failure: return(ERROR) - * - * General structure is as follows: - * @code - * for (i = 0L; (i < SignalLength); i++) { - * Sum = 0.0; - * for (j = -Infinity; (j <= Infinity); j++) - * Sum += InputData[j] * Kernel[KernelOrigin + i - j]; - * OutputData[i] = Sum; - * } - * @endcode -*/ -extern int MovingAverage - ( - double InputData[], /* data to process */ - double OutputData[], /* result */ - long SignalLength, /* length of the 1D data array */ - long KernelOrigin, /* center of the kernel */ - long KernelLength, /* length of the 1D kernel */ - enum TBoundaryConvention - Convention /* boundary convention */ - ); - -/*--------------------------------------------------------------------------*/ -/** Moving average (3D). - * The specified boundary convention applies to the input data only, - * not to the kernel. The boundary convention applied to the kernel is - * FiniteDataSupport. - * VolumeSource is a (float)volume of size (Nx x Ny x Nz). - * OutputData is a (float)volume of size (Nx x Ny x Nz). - * The origin for the kernel is given with respect to the leftmost sample [0]. - * The 1D kernel is applied successively to each principal direction in a - * separable fashion. - * - * success: return(!ERROR); failure: return(ERROR). - * - * General structure is as follows: - * @code - * for (i = 0L; (i < SignalLength); i++) { - * Sum = 0.0; - * for (j = i - KernelOrigin; (j < (KernelLength + i - KernelOrigin)); j++) - * Sum += InputData[j]; - * OutputData[i] = Sum / KernelLength; - * } - * @endcode -*/ -extern int MovingAverageVolume - ( - float *VolumeSource, /* data to process */ - float *VolumeDestination, /* result */ - long Nx, /* width of the volume */ - long Ny, /* height of the volume */ - long Nz, /* depth of the volume */ - long KernelOrigin, /* center of the kernel */ - long KernelLength, /* length of the 1D kernel */ - enum TBoundaryConvention - Convention /* boundary convention */ - ); -//@} diff --git a/src/core/bilib/polynomial.cc b/src/core/bilib/polynomial.cc deleted file mode 100644 index 37c1891..0000000 --- a/src/core/bilib/polynomial.cc +++ /dev/null @@ -1,611 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -#include -#include -#include - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" -#include "error.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "linearalgebra.h" -#include "messagedisplay.h" -#include "polynomial.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -#ifdef DEBUG -#include -#include -#include -#endif - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern int PolynomialDifferentiation - ( - double a[], /* input polynomial coefficients */ - long Degree, /* degree of the input polynomial */ - double b[] /* resulting coefficients */ - ) - -/* differentiation of the polynomial p(x) = (a[0] + Sum a[k] x^k) */ -/* the degree of the input polynomial is Degree */ -/* there are (Degree+1) input coefficients */ -/* the degree of the output polynomial is (Degree-1) */ -/* there are Degree output coefficients */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin PolynomialDifferentiation */ - - long i; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(PolynomialDifferentiation, a, Status, -/**/ "Missing input polynomial coefficients") -/**/DEBUG_CHECK_NULL_POINTER(PolynomialDifferentiation, b, Status, -/**/ "Missing output polynomial coefficients") -/**/DEBUG_CHECK_RANGE_LONG(PolynomialDifferentiation, Degree, 0L, LONG_MAX, Status, -/**/ "Invalid polynomial degree (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(PolynomialDifferentiation, Status) -/**/DEBUG_WRITE_ENTERING(PolynomialDifferentiation, -/**/ "About to execute PolynomialDifferentiation") - - if (Degree == 0L) { - *b = 0.0; -/**/ DEBUG_WRITE_LEAVING(PolynomialDifferentiation, "Done") - return(Status); - } - for (i = 1L; (i <= Degree); i++) { - *b++ = *++a * (double)i; - } -/**/DEBUG_WRITE_LEAVING(PolynomialDifferentiation, "Done") - return(Status); -} /* end PolynomialDifferentiation */ - -/*--------------------------------------------------------------------------*/ -extern int PolynomialEvaluation - ( - double x, /* argument */ - double a[], /* polynomial coefficients */ - long Degree, /* degree of the polynomial */ - double *Result /* resulting value */ - ) - -/* evaluates a polynomial: result = a[0] + Sum a[k] x^k */ -/* the degree of the polynomial is Degree */ -/* there are (Degree+1) coefficients */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin PolynomialEvaluation */ - - double *p; - double Sum; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(PolynomialEvaluation, a, Status, -/**/ "Missing polynomial coefficients") -/**/DEBUG_CHECK_NULL_POINTER(PolynomialEvaluation, Result, Status, -/**/ "Missing Result") -/**/DEBUG_CHECK_RANGE_LONG(PolynomialEvaluation, Degree, 0L, LONG_MAX, Status, -/**/ "Invalid polynomial degree (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(PolynomialEvaluation, Status) -/**/DEBUG_WRITE_ENTERING(PolynomialEvaluation, -/**/ "About to evaluate a polynomial") - - p = a + (ptrdiff_t)Degree; - Sum = *p--; - while (a <= p) { - Sum = x * Sum + *p--; - } - *Result = Sum; -/**/DEBUG_WRITE_LEAVING(PolynomialEvaluation, "Done") - return(Status); -} /* end PolynomialEvaluation */ - -/*--------------------------------------------------------------------------*/ -extern int PolynomialMultiplication - ( - double a1[], /* 1st input polynomial coefficients */ - long Degree1, /* degree of the 1st input polynomial */ - double a2[], /* 2nd input polynomial coefficients */ - long Degree2, /* degree of the 2nd input polynomial */ - double b[] /* resulting coefficients */ - ) - -/* multiplication resulting in */ -/* b[0] + Sum b[k] x^k = (a1[0] + Sum a1[k] x^k) (a2[0] + Sum a2[k] x^k) */ -/* the degree of the 1st input polynomial is Degree1 */ -/* the degree of the 2nd input polynomial is Degree2 */ -/* there are (Degree1+1) input coefficients for the first multiplicand */ -/* there are (Degree2+1) input coefficients for the second multiplicand */ -/* the degree of the output polynomial is (Degree1+Degree2) */ -/* there are (Degree1+Degree2+1) output coefficients */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin PolynomialMultiplication */ - - double *p, *q; - double Sum; - long i; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(PolynomialMultiplication, a1, Status, -/**/ "Missing first input polynomial coefficients") -/**/DEBUG_CHECK_NULL_POINTER(PolynomialMultiplication, a2, Status, -/**/ "Missing second input polynomial coefficients") -/**/DEBUG_CHECK_NULL_POINTER(PolynomialMultiplication, b, Status, -/**/ "Missing output polynomial coefficients") -/**/DEBUG_CHECK_RANGE_LONG(PolynomialMultiplication, Degree1, 0L, LONG_MAX, Status, -/**/ "Invalid first polynomial degree (should be positive)") -/**/DEBUG_CHECK_RANGE_LONG(PolynomialMultiplication, Degree2, 0L, LONG_MAX, Status, -/**/ "Invalid second polynomial degree (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(PolynomialMultiplication, Status) -/**/DEBUG_WRITE_ENTERING(PolynomialMultiplication, -/**/ "About to execute PolynomialMultiplication") - - for (i = 0L; (i <= (Degree1 + Degree2)); i++) { - Sum = 0.0; - p = a2; - q = a1 + (ptrdiff_t)i; - while (a1 <= q) { - Sum += *q-- * *p++; - } - *b++ = Sum; - } -/**/DEBUG_WRITE_LEAVING(PolynomialMultiplication, "Done") - return(Status); -} /* end PolynomialMultiplication */ - -/*--------------------------------------------------------------------------*/ -extern int PolynomialPrimitive - ( - double a[], /* input polynomial coefficients */ - long Degree, /* degree of the input polynomial */ - double b[] /* resulting coefficients */ - ) - -/* primitive of the polynomial p(t) = (a[0] + Sum a[k] t^k) */ -/* the degree of the input polynomial is Degree */ -/* there are (Degree+1) input coefficients */ -/* the degree of the output polynomial is (Degree+1) */ -/* there are (Degree+2) output coefficients */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin PolynomialPrimitive */ - - long i; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(PolynomialPrimitive, a, Status, -/**/ "Missing input polynomial coefficients") -/**/DEBUG_CHECK_NULL_POINTER(PolynomialPrimitive, b, Status, -/**/ "Missing output polynomial coefficients") -/**/DEBUG_CHECK_RANGE_LONG(PolynomialPrimitive, Degree, 0L, LONG_MAX, Status, -/**/ "Invalid polynomial degree (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(PolynomialPrimitive, Status) -/**/DEBUG_WRITE_ENTERING(PolynomialPrimitive, -/**/ "About to execute PolynomialPrimitive") - - *b++ = 0.0; - for (i = 0L; (i <= Degree); i++) { - *b++ = *a++ / (double)(i + 1L); - } -/**/DEBUG_WRITE_LEAVING(PolynomialPrimitive, "Done") - return(Status); -} /* end PolynomialPrimitive */ - -/*--------------------------------------------------------------------------*/ -extern int PolynomialRealRoots - ( - double a[], /* polynomial coefficients */ - long Degree, /* degree of the polynomial */ - double RealRoot[], /* resulting real roots */ - long *RealRootNumber, /* number of real roots */ - double Tolerance, /* admissible relative error */ - int *Status /* error management */ - ) - -/* find the real roots of the polynomial p(x) = (a[0] + Sum a[k] x^k) */ -/* the degree of the polynomial is Degree */ -/* there are (Degree+1) input coefficients (a[]) */ -/* the output array (RealRoot[]) must have size (Degree) */ -/* only the first (RealRootNumber) roots returned in RealRoot[] are valid */ -/* (RealRootNumber) -> -1 when the equation is indeterminate */ -/* the returned roots are sorted in ascendent order */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin PolynomialRealRoots */ - - double CubicResolvent[4], QuadraticResolvent[3]; - double p, q, r, s, t; - double Det, Swap; - - *Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(PolynomialRealRoots, a, *Status, -/**/ "Missing polynomial coefficients") -/**/DEBUG_CHECK_NULL_POINTER(PolynomialRealRoots, RealRoot, *Status, -/**/ "Missing RealRoot") -/**/DEBUG_CHECK_NULL_POINTER(PolynomialRealRoots, RealRootNumber, *Status, -/**/ "Missing RealRootNumber") -/**/DEBUG_CHECK_RANGE_LONG(PolynomialRealRoots, Degree, 0L, LONG_MAX, *Status, -/**/ "Invalid polynomial degree (should be positive)") -/**/DEBUG_CHECK_RANGE_DOUBLE(PolynomialRealRoots, Tolerance, 0.0, DBL_MAX, *Status, -/**/ "Invalid Tolerance (should be positive)") -/**/DEBUG_RETURN_ON_ERROR(PolynomialRealRoots, *Status) -/**/DEBUG_WRITE_ENTERING(PolynomialRealRoots, -/**/ "About to execute PolynomialRealRoots") - - switch (Degree) { - case 0L: - if (fabs(a[Degree]) <= Tolerance) { - *RealRootNumber = -1L; - WRITE_WARNING(PolynomialRealRoots, "Indeterminate equation") - break; - } - *Status = ERROR; - WRITE_ERROR(PolynomialRealRoots, "Absurd equation encountered (0 != 0)") - break; - case 1L: - if (fabs(a[Degree]) <= Tolerance) { - PolynomialRealRoots(a, Degree - 1L, RealRoot, RealRootNumber, - Tolerance, Status); - break; - } - RealRoot[0] = -a[0] / a[1]; - *RealRootNumber = 1L; - break; - case 2L: - if (fabs(a[Degree]) <= Tolerance) { - PolynomialRealRoots(a, Degree - 1L, RealRoot, RealRootNumber, - Tolerance, Status); - break; - } - Det = a[1] * a[1] - 4.0 * a[0] * a[2]; - if (Det < 0.0) { - *RealRootNumber = 0L; - } - else if (Det == 0.0) { - RealRoot[0] = -0.5 * a[1] / a[2]; - RealRoot[1] = RealRoot[0]; - *RealRootNumber = 2L; - } - else { - Det = (a[1] < 0.0) ? (a[1] - sqrt(Det)) : (a[1] + sqrt(Det)); - RealRoot[0] = -0.5 * Det / a[2]; - RealRoot[1] = -2.0 * a[0] / Det; - if (RealRoot[1] < RealRoot[0]) { - Swap = RealRoot[0]; - RealRoot[0] = RealRoot[1]; - RealRoot[1] = Swap; - } - *RealRootNumber = 2L; - } - break; - case 3L: - if (fabs(a[Degree]) <= Tolerance) { - PolynomialRealRoots(a, Degree - 1L, RealRoot, RealRootNumber, - Tolerance, Status); - break; - } - q = (3.0 * a[1] - a[2] * a[2] / a[3]) / (9.0 * a[3]); - r = (a[1] * a[2] - 3.0 * a[0] * a[3] - (2.0 / 9.0) * a[2] * a[2] * a[2] / a[3]) - / (6.0 * a[3] * a[3]); - Det = q * q * q + r * r; - if (Det < 0.0) { - Det = 2.0 * sqrt(-q); - r /= sqrt(-q * q * q); - r = (1.0 / 3.0) * acos(r); - q = (1.0 / 3.0) * a[2] / a[3]; - RealRoot[0] = Det * cos(r) - q; - RealRoot[1] = Det * cos(r + (2.0 / 3.0) * PI) - q; - RealRoot[2] = Det * cos(r + (4.0 / 3.0) * PI) - q; - if (RealRoot[0] < RealRoot[1]) { - if (RealRoot[2] < RealRoot[1]) { - Swap = RealRoot[1]; - RealRoot[1] = RealRoot[2]; - RealRoot[2] = Swap; - if (RealRoot[1] < RealRoot[0]) { - Swap = RealRoot[0]; - RealRoot[0] = RealRoot[1]; - RealRoot[1] = Swap; - } - } - } - else { - Swap = RealRoot[0]; - RealRoot[0] = RealRoot[1]; - RealRoot[1] = Swap; - if (RealRoot[2] < RealRoot[1]) { - Swap = RealRoot[1]; - RealRoot[1] = RealRoot[2]; - RealRoot[2] = Swap; - if (RealRoot[1] < RealRoot[0]) { - Swap = RealRoot[0]; - RealRoot[0] = RealRoot[1]; - RealRoot[1] = Swap; - } - } - } - *RealRootNumber = 3L; - } - else if (Det == 0.0) { - p = 2.0 * pow(r, 1.0 / 3.0); - q = (1.0 / 3.0) * a[2] / a[3]; - if (p < 0) { - RealRoot[0] = p - q; - RealRoot[1] = -0.5 * p - q; - RealRoot[2] = RealRoot[1]; - } - else { - RealRoot[0] = -0.5 * p - q; - RealRoot[1] = RealRoot[0]; - RealRoot[2] = p - q; - } - *RealRootNumber = 3L; - } - else { - Det = sqrt(Det); - q = ((r + Det) < 0.0) ? (-exp((1.0 / 3.0) * log(-r - Det))) - : (exp((1.0 / 3.0) * log(r + Det))); - r = (r < Det) ? (-exp((1.0 / 3.0) * log(Det - r))) - : (exp((1.0 / 3.0) * log(r - Det))); - Det = (-1.0 / 3.0) * a[2] / a[3]; - RealRoot[0] = q + r + Det; - *RealRootNumber = 1L; - } - break; - case 4L: - if (fabs(a[Degree]) <= Tolerance) { - PolynomialRealRoots(a, Degree - 1L, RealRoot, RealRootNumber, - Tolerance, Status); - break; - } - s = a[3] / a[4]; - p = a[2] / a[4] - (3.0 / 8.0) * s * s; - s = 2.0 * a[4]; - t = a[3] * a[3]; - q = a[1] / a[4] + a[3] * (t - 4.0 * a[4] * a[2]) / (s * s * s); - r = a[3] * (3.0 * t * a[3] + 16.0 * (s * s * a[1] - a[2] * a[3] * a[4])); - s *= 4.0 * s; - r = a[0] / a[4] - r / (s * s); - s = 0.25 * a[3] / a[4]; - CubicResolvent[0] = 4.0 * p * r - q * q; - CubicResolvent[1] = -4.0 * r; - CubicResolvent[2] = -p; - CubicResolvent[3] = 1.0; - PolynomialRealRoots(CubicResolvent, 3L, RealRoot, RealRootNumber, - Tolerance, Status); - if (*Status == ERROR) { - WRITE_ERROR(PolynomialRealRoots, - "Unable to solve the cubic resolvent of a quartic equation") - break; - } - switch (*RealRootNumber) { - case 1L: - t = RealRoot[0]; - break; - case 3L: - t = RealRoot[2]; - break; - default: - *Status = ERROR; - WRITE_ERROR(PolynomialRealRoots, - "Unexpected error (wrong number of cubic roots)") - DEBUG_WRITE_LEAVING(PolynomialRealRoots, "Done") - return(*Status); - } - if (t < p) { - *RealRootNumber = 0L; - DEBUG_WRITE_LEAVING(PolynomialRealRoots, "Done") - return(*Status); - } - if ((t == p) || (fabs(q) <= Tolerance)) { - QuadraticResolvent[0] = r; - QuadraticResolvent[1] = p; - QuadraticResolvent[2] = 1.0; - PolynomialRealRoots(QuadraticResolvent, 2L, RealRoot, RealRootNumber, - Tolerance, Status); - if (*Status == ERROR) { - WRITE_ERROR(PolynomialRealRoots, - "Unable to solve the quadratic resolvent of a degenerate quartic equation") - break; - } - switch (*RealRootNumber) { - case 0L: - break; - case 2L: - if ((RealRoot[0] < 0.0) && (RealRoot[1] < 0.0)) { - *RealRootNumber = 0L; - break; - } - if ((RealRoot[0] < 0.0) && (0.0 <= RealRoot[1])) { - RealRoot[0] = -sqrt(RealRoot[1]) - s; - RealRoot[1] = sqrt(RealRoot[1]) - s; - break; - } - *RealRootNumber = 4L; - RealRoot[3] = sqrt(RealRoot[1]) - s; - RealRoot[2] = sqrt(RealRoot[0]) - s; - RealRoot[1] = -sqrt(RealRoot[0]) - s; - RealRoot[0] = -RealRoot[3] - 2.0 * s; - break; - default: - *Status = ERROR; - WRITE_ERROR(PolynomialRealRoots, - "Unexpected error (wrong number of degenerate quadratic roots)") - } - DEBUG_WRITE_LEAVING(PolynomialRealRoots, "Done") - return(*Status); - } - r = sqrt(t - p); - QuadraticResolvent[0] = 0.5 * (t - q / r); - QuadraticResolvent[1] = r; - QuadraticResolvent[2] = 1.0; - PolynomialRealRoots(QuadraticResolvent, 2L, RealRoot, RealRootNumber, - Tolerance, Status); - if (*Status == ERROR) { - WRITE_ERROR(PolynomialRealRoots, - "Unable to solve the first quadratic resolvent of a quartic equation") - DEBUG_WRITE_LEAVING(PolynomialRealRoots, "Done") - return(*Status); - } - switch (*RealRootNumber) { - case 0L: - QuadraticResolvent[0] = 0.5 * (t + q / r); - QuadraticResolvent[1] = -r; - PolynomialRealRoots(QuadraticResolvent, 2L, RealRoot, RealRootNumber, - Tolerance, Status); - if (*Status == ERROR) { - WRITE_ERROR(PolynomialRealRoots, - "Unable to solve the second quadratic resolvent of a quartic equation") - break; - } - switch (*RealRootNumber) { - case 0L: - DEBUG_WRITE_LEAVING(PolynomialRealRoots, "Done") - return(*Status); - case 2L: - RealRoot[0] -= s; - RealRoot[1] -= s; - DEBUG_WRITE_LEAVING(PolynomialRealRoots, "Done") - return(*Status); - default: - *Status = ERROR; - WRITE_ERROR(PolynomialRealRoots, - "Unexpected error (wrong number of quadratic roots)") - break; - } - break; - case 2L: - QuadraticResolvent[0] = 0.5 * (t + q / r); - QuadraticResolvent[1] = -r; - PolynomialRealRoots(QuadraticResolvent, 2L, RealRoot + (ptrdiff_t)2, - RealRootNumber, Tolerance, Status); - if (*Status == ERROR) { - WRITE_ERROR(PolynomialRealRoots, - "Unable to solve the second quadratic resolvent of a quartic equation") - break; - } - switch (*RealRootNumber) { - case 0L: - RealRoot[0] -= s; - RealRoot[1] -= s; - DEBUG_WRITE_LEAVING(PolynomialRealRoots, "Done") - return(*Status); - case 2L: - *RealRootNumber = 4L; - RealRoot[0] -= s; - RealRoot[1] -= s; - RealRoot[2] -= s; - RealRoot[3] -= s; - if (RealRoot[2] < RealRoot[0]) { - r = RealRoot[0]; - RealRoot[0] = RealRoot[2]; - RealRoot[2] = r; - r = RealRoot[1]; - RealRoot[1] = RealRoot[3]; - RealRoot[3] = r; - } - if (RealRoot[1] >= RealRoot[2]) { - r = RealRoot[1]; - RealRoot[1] = RealRoot[2]; - RealRoot[2] = r; - if (RealRoot[2] >= RealRoot[3]) { - r = RealRoot[2]; - RealRoot[2] = RealRoot[3]; - RealRoot[3] = r; - } - } - DEBUG_WRITE_LEAVING(PolynomialRealRoots, "Done") - return(*Status); - default: - *Status = ERROR; - WRITE_ERROR(PolynomialRealRoots, - "Unexpected error (wrong number of quadratic roots)") - break; - } - break; - default: - *Status = ERROR; - WRITE_ERROR(PolynomialRealRoots, - "Unexpected error (wrong number of quadratic roots)") - break; - } - break; - default: - if (a[Degree] == 0.0) { - PolynomialRealRoots(a, Degree - 1L, RealRoot, RealRootNumber, - Tolerance, Status); - break; - } - *Status = ERROR; - WRITE_ERROR(PolynomialRealRoots, "Not yet implemented") - break; - } -/**/DEBUG_WRITE_LEAVING(PolynomialRealRoots, "Done") - return(*Status); -} /* end PolynomialRealRoots */ - -/*--------------------------------------------------------------------------*/ -extern double Sign - ( - double x /* argument */ - ) - -/* returns the sign of x with Sign(0) = 0 */ - -{ /* begin Sign */ - -/**/DEBUG_WRITE_ENTERING(Sign, -/**/ "About to execute Sign") - - if (x < 0.0) { - x = -1.0; - } - else if (0.0 < x) { - x = 1.0; - } -/**/DEBUG_WRITE_LEAVING(Sign, "Done") - return(x); -} /* end Sign */ - -/*--------------------------------------------------------------------------*/ -extern double xPlus - ( - double x, /* argument */ - double p /* power */ - ) - -/* computes the one-sided power function with xPlus(0, 0) = 1/2 */ - -{ /* begin xPlus */ - -/**/DEBUG_WRITE_ENTERING(xPlus, -/**/ "About to execute xPlus") - - x = (x < 0.0) ? (0.0) : ((p == 0.0) ? ((x == 0.0) ? (0.5) : (1.0)) : (pow(x, p))); -/**/DEBUG_WRITE_LEAVING(xPlus, "Done") - return(x); -} /* end xPlus */ diff --git a/src/core/bilib/polynomial.h b/src/core/bilib/polynomial.h deleted file mode 100644 index aee41ab..0000000 --- a/src/core/bilib/polynomial.h +++ /dev/null @@ -1,104 +0,0 @@ -/**@defgroup BilibPolynomial Polynomial - @ingroup BilibLibrary */ -//@{ -/*--------------------------------------------------------------------------*/ -/** Differentiation of the polynomial p(x) = (a[0] + Sum a[k] x^k). - The degree of the input polynomial is Degree. - There are (Degree+1) input coefficients. - The degree of the output polynomial is (Degree-1). - There are Degree output coefficients. - - success: return(!ERROR); failure: return(ERROR) */ -extern int PolynomialDifferentiation - ( - double a[], /* input polynomial coefficients */ - long Degree, /* degree of the input polynomial */ - double b[] /* resulting coefficients */ - ); - -/*--------------------------------------------------------------------------*/ -/** Evaluates a polynomial: result = a[0] + Sum a[k] x^k. - The degree of the polynomial is Degree. - There are (Degree+1) coefficients. - - success: return(!ERROR); failure: return(ERROR) */ -extern int PolynomialEvaluation - ( - double x, /* argument */ - double a[], /* polynomial coefficients */ - long Degree, /* degree of the polynomial */ - double *Result /* resulting value */ - ); - -/*--------------------------------------------------------------------------*/ -/** Polynomial multuplication. - Multiplication resulting in - b[0] + Sum b[k] x^k = (a1[0] + Sum a1[k] x^k) (a2[0] + Sum a2[k] x^k). - - The degree of the 1st input polynomial is Degree1. - The degree of the 2nd input polynomial is Degree2. - There are (Degree1+1) input coefficients for the first multiplicand. - There are (Degree2+1) input coefficients for the second multiplicand. - The degree of the output polynomial is (Degree1+Degree2). - There are (Degree1+Degree2+1) output coefficients. - - success: return(!ERROR); failure: return(ERROR) */ -extern int PolynomialMultiplication - ( - double a1[], /* 1st input polynomial coefficients */ - long Degree1, /* degree of the 1st input polynomial */ - double a2[], /* 2nd input polynomial coefficients */ - long Degree2, /* degree of the 2nd input polynomial */ - double b[] /* resulting coefficients */ - ); - -/*--------------------------------------------------------------------------*/ -/** Primitive of the polynomial p(t) = (a[0] + Sum a[k] t^k). - The degree of the input polynomial is Degree. - There are (Degree+1) input coefficients. - The degree of the output polynomial is (Degree+1). - There are (Degree+2) output coefficients. - - success: return(!ERROR); failure: return(ERROR) */ -extern int PolynomialPrimitive - ( - double a[], /* input polynomial coefficients */ - long Degree, /* degree of the input polynomial */ - double b[] /* resulting coefficients */ - ); - -/*--------------------------------------------------------------------------*/ -/** Find the real roots of the polynomial p(x) = (a[0] + Sum a[k] x^k). - The degree of the polynomial is Degree. - There are (Degree+1) input coefficients (a[]). - The output array (RealRoot[]) must have size (Degree). - Only the first (RealRootNumber) roots returned in RealRoot[] are valid. - (RealRootNumber) -> -1 when the equation is indeterminate. - The returned roots are sorted in ascendent order. - - success: return(!ERROR); failure: return(ERROR) */ -extern int PolynomialRealRoots - ( - double a[], /* polynomial coefficients */ - long Degree, /* degree of the polynomial */ - double RealRoot[], /* resulting real roots */ - long *RealRootNumber, /* number of real roots */ - double Tolerance, /* admissible relative error */ - int *Status /* error management */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the sign of x with Sign(0) = 0. */ -extern double Sign - ( - double x /* argument */ - ); - -/*--------------------------------------------------------------------------*/ -/** Computes the one-sided power function. xPlus(0, 0) = 1/2 */ -extern double xPlus - ( - double x, /* argument */ - double p /* power */ - ); -//@} diff --git a/src/core/bilib/positivepower.cc b/src/core/bilib/positivepower.cc deleted file mode 100644 index f776507..0000000 --- a/src/core/bilib/positivepower.cc +++ /dev/null @@ -1,137 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -#include - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "positivepower.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -#ifdef DEBUG -#include -#include -#include -#include "error.h" -#include "messagedisplay.h" -#endif - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ - /* None */ - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern double PositiveIntPower - ( - double Argument, /* argument */ - long Exponent /* exponent */ - ) - -/* recursive computation of a positive integer power of the argument */ -/* negative arguments are allowed */ - -{ /* begin PositiveIntPower */ - - double PseudoRoot; -#ifdef DEBUG -/**/int Status = !ERROR; -#endif - -/**/DEBUG_CHECK_RANGE_LONG(PositiveIntPower, Exponent, 0L, LONG_MAX, Status, -/**/ "Invalid exponent (should be strictly positive)") -/**/DEBUG_WRITE_ENTERING(PositiveIntPower, -/**/ "About to raise a (double)argument to a positive (int)exponent") -#ifdef DEBUG -/**/if (Status == ERROR) { -/**/ WRITE_ERROR(PositiveIntPower, "Unable to perform PositiveIntPower") -/**/ DEBUG_WRITE_LEAVING(PositiveIntPower, "Done") -/**/ return(HUGE_VAL); -/**/} -#endif - - if ((Exponent & 1L) != 0L) { - if (Exponent == 1L) { -/**/ DEBUG_WRITE_LEAVING(PositiveIntPower, "Done") - return(Argument); - } - if (Exponent == 3L) { -/**/ DEBUG_WRITE_LEAVING(PositiveIntPower, "Done") - return(Argument * Argument * Argument); - } - if (Exponent == 5L) { - PseudoRoot = Argument * Argument; -/**/ DEBUG_WRITE_LEAVING(PositiveIntPower, "Done") - return(Argument * PseudoRoot * PseudoRoot); - } - if (Exponent == 7L) { - PseudoRoot = Argument * Argument * Argument; -/**/ DEBUG_WRITE_LEAVING(PositiveIntPower, "Done") - return(Argument * PseudoRoot * PseudoRoot); - } - if (Exponent <= POSITIVE_POWER_TRADE_OFF) { - PseudoRoot = PositiveIntPower(Argument, Exponent / 2L); -/**/ DEBUG_WRITE_LEAVING(PositiveIntPower, "Done") - return(Argument * PseudoRoot * PseudoRoot); - } -/**/ DEBUG_WRITE_LEAVING(PositiveIntPower, "Done") - return(pow(Argument, (double)Exponent)); - } - else { - if (Exponent == 0L) { - if (Argument == 0.0) { -/**/ DEBUG_WRITE_LEAVING(PositiveIntPower, "Done") - return(0.5); - } - else { -/**/ DEBUG_WRITE_LEAVING(PositiveIntPower, "Done") - return(1.0); - } - } - if (Exponent == 2L) { -/**/ DEBUG_WRITE_LEAVING(PositiveIntPower, "Done") - return(Argument * Argument); - } - if (Exponent == 4L) { - Argument *= Argument; -/**/ DEBUG_WRITE_LEAVING(PositiveIntPower, "Done") - return(Argument * Argument); - } - if (Exponent == 6L) { - Argument *= Argument * Argument; -/**/ DEBUG_WRITE_LEAVING(PositiveIntPower, "Done") - return(Argument * Argument); - } - if (Exponent == 8L) { - Argument *= Argument; - Argument *= Argument; -/**/ DEBUG_WRITE_LEAVING(PositiveIntPower, "Done") - return(Argument * Argument); - } - if (Exponent <= POSITIVE_POWER_TRADE_OFF) { - PseudoRoot = PositiveIntPower(Argument, Exponent / 2L); -/**/ DEBUG_WRITE_LEAVING(PositiveIntPower, "Done") - return(PseudoRoot * PseudoRoot); - } -/**/ DEBUG_WRITE_LEAVING(PositiveIntPower, "Done") - return(pow(Argument, (double)Exponent)); - } -} /* end PositiveIntPower */ - diff --git a/src/core/bilib/positivepower.h b/src/core/bilib/positivepower.h deleted file mode 100644 index b37f7a0..0000000 --- a/src/core/bilib/positivepower.h +++ /dev/null @@ -1,10 +0,0 @@ -/*--------------------------------------------------------------------------*/ -#define POSITIVE_POWER_TRADE_OFF 256 - -/*--------------------------------------------------------------------------*/ -extern double PositiveIntPower - ( - double Argument, /* argument */ - long Exponent /* exponent */ - ); - diff --git a/src/core/bilib/pyramidfilters.cc b/src/core/bilib/pyramidfilters.cc deleted file mode 100644 index 4437a70..0000000 --- a/src/core/bilib/pyramidfilters.cc +++ /dev/null @@ -1,867 +0,0 @@ -/* ---------------------------------------------------------------------------- - Filename: pyramidfilters.h - - Author: Daniel Sage - Swiss Federal Institute of Technology - Lausanne - Biomedical Imaging Group - EPFL/DMT/IOA, BM-Ecublens, CH-1015 Lausanne, Switzerland - - Date: 17 March 1999 - - Purpose: Coefficient of the pyramidal filters - Included the centered pyramid filters - - Note: h : expand filter - g : reduce filter - - History: Michael Unser, NIH, BEIP, May 1992 Pyramid filters - Patrick Brigger, NIH, BEIP, May 1996 Centered Pyramid filters ----------------------------------------------------------------------------- */ - -/* --- System includes --- */ -#include - -/* --- Private includes --- */ -#include "messagedisplay.h" -#include "pyramidfilters.h" - -/* ---------------------------------------------------------------------------- - Function: PyramidFilterSplinel2 - - Purpose: Initializes down- and up-sampling filter arrays for - least squares splines of order 0 to 3. (little l_2 norm) - g : reduce filter - h : expand filter - - Author: Michael Unser, NIH, BEIP, May 1992 - ----------------------------------------------------------------------------- */ -extern void PyramidFilterSplinel2(double g[],long *ng,double *h,long *nh,long Order) -{ - - switch (Order) { - - case 0L : - *ng = 1L; - *nh = 1L; - break; - - case 1L : - g[0] = 0.707107; - g[1] = 0.292893; - g[2] = -0.12132; - g[3] = -0.0502525; - g[4] = 0.0208153; - g[5] = 0.00862197; - g[6] = -0.00357134; - g[7] = -0.0014793; - g[8] = 0.000612745; - *ng = 9L; - h[0] = 1.; - h[1] = 0.5; - *nh = 2L; - break; - case 2L : - g[0] = 0.617317; - g[1] = 0.310754; - g[2] = -0.0949641; - g[3] = -0.0858654; - g[4] = 0.0529153; - g[5] = 0.0362437; - g[6] = -0.0240408; - g[7] = -0.0160987; - g[8] = 0.0107498; - g[9] = 0.00718418; - g[10] = -0.00480004; - g[11] = -0.00320734; - g[12] = 0.00214306; - g[13] = 0.00143195; - g[14] = -0.0009568; - g[15] = -0.000639312; - *ng = 16L; - h[0] = 1.; - h[1] = 0.585786; - h[2] = 0; - h[3] = -0.100505; - h[4] = 0; - h[5] = 0.0172439; - h[6] = 0; - h[7] = -0.00295859; - h[8] = 0; - h[9] = 0.000507614; - *nh = 10L; - break; - case 3L : - g[0] = 0.596797; - g[1] = 0.313287; - g[2] = -0.0827691; - g[3] = -0.0921993; - g[4] = 0.0540288; - g[5] = 0.0436996; - g[6] = -0.0302508; - g[7] = -0.0225552; - g[8] = 0.0162251; - g[9] = 0.0118738; - g[10] = -0.00861788; - g[11] = -0.00627964; - g[12] = 0.00456713; - g[13] = 0.00332464; - g[14] = -0.00241916; - g[15] = -0.00176059; - g[16] = 0.00128128; - g[17] = 0.000932349; - g[18] = -0.000678643; - g[19] = -0.000493682; - *ng = 20L; - h[0] = 1.; - h[1] = 0.600481; - h[2] = 0; - h[3] = -0.127405; - h[4] = 0; - h[5] = 0.034138; - h[6] = 0; - h[7] = -0.00914725; - h[8] = 0; - h[9] = 0.002451; - h[10] = 0; - h[11] = -0.000656743; - *nh = 12L; - break; - default : - *ng = -1L; - *nh = -1L; - break; - } - -} - -/* ---------------------------------------------------------------------------- - Function: PyramidFilterSplineL2 - - Purpose: Initializes down- and up-sampling filter arrays for - L2 spline pyramid of order 0 to 5. - g : reduce filter - h : expand filter - - Author: Michael Unser, NIH, BEIP, May 1992 - ----------------------------------------------------------------------------- */ - -extern void PyramidFilterSplineL2(double g[],long *ng,double h[],long *nh,long Order) -{ - - switch (Order) { - case 0L : - *ng = 1L; - *nh = 1L; - break; - - case 1L : - g[0] = 0.683013; - g[1] = 0.316987; - g[2] = -0.116025; - g[3] = -0.0849365; - g[4] = 0.0310889; - g[5] = 0.0227587; - g[6] = -0.00833025; - g[7] = -0.00609817; - g[8] = 0.00223208; - g[9] = 0.001634; - g[10] = -0.000598085; - g[11] = -0.000437829; - g[12] = 0.000160256; - g[13] = 0.000117316; - *ng = 14L; - h[0] = 1.; - h[1] = 0.5; - *nh = 2L; - break; - - case 3L : - g[0] = 0.594902; - g[1] = 0.31431; - g[2] = -0.0816632; - g[3] = -0.0942586; - g[4] = 0.0541374; - g[5] = 0.0454105; - g[6] = -0.0307778; - g[7] = -0.0236728; - g[8] = 0.0166858; - g[9] = 0.0125975; - g[10] = -0.00895838; - g[11] = -0.00673388; - g[12] = 0.00479847; - g[13] = 0.00360339; - g[14] = -0.00256892; - g[15] = -0.00192868; - g[16] = 0.00137514; - g[17] = 0.00103237; - g[18] = -0.000736093; - g[19] = -0.000552606; - g[20] = 0.000394017; - g[21] = 0.000295799; - g[22] = -0.00021091; - g[23] = -0.000158335; - g[24] = 0.000112896; - *ng = 25L; - h[0] = 1.; - h[1] = 0.600481; - h[2] = 0.0; - h[3] = -0.127405; - h[4] = 0; - h[5] = 0.034138; - h[6] = 0; - h[7] = -0.00914725; - h[8] = 0; - h[9] = 0.002451; - h[10] = 0; - h[11] = -0.000656743; - *nh = 12L; - break; - - case 5L : - g[0] = 0.564388; - g[1] = 0.316168; - g[2] = -0.0597634; - g[3] = -0.0998708; - g[4] = 0.0484525; - g[5] = 0.0539099; - g[6] = -0.0355614; - g[7] = -0.033052; - g[8] = 0.0246347; - g[9] = 0.0212024; - g[10] = -0.0166097; - g[11] = -0.0138474; - g[12] = 0.0110719; - g[13] = 0.00911006; - g[14] = -0.00734567; - g[15] = -0.0060115; - g[16] = 0.00486404; - g[17] = 0.00397176; - g[18] = -0.00321822; - g[19] = -0.00262545; - g[20] = 0.00212859; - g[21] = 0.00173587; - g[22] = -0.0014077; - g[23] = -0.0011478; - g[24] = 0.000930899; - g[25] = 0.000758982; - g[26] = -0.000615582; - g[27] = -0.000501884; - g[28] = 0.000407066; - g[29] = 0.000331877; - g[30] = -0.00026918; - g[31] = -0.000219459; - g[32] = 0.000178; - g[33] = 0.00014512; - g[34] = -0.000117706; - *ng = 35L; - h[0] = 1.; - h[1] = 0.619879; - h[2] = 0.0; - h[3] = -0.167965; - h[4] = 0; - h[5] = 0.0686374; - h[6] = 0; - h[7] = -0.0293948; - h[8] = 0.0; - h[9] = 0.0126498; - h[10] = 0; - h[11] = -0.00544641; - h[12] = 0.0; - h[13] = 0.00234508; - h[14] = 0; - h[15] = -0.00100973; - h[16] = 0.0; - h[17] = 0.000434766; - h[18] = 0; - h[19] = -0.000187199; - *nh = 20L; - break; - - default : - *ng = -1L; - *nh = -1L; - MessageDisplay( "Spline filters only defined for n=0,1,3,5"); - break; - } -} - -/* ---------------------------------------------------------------------------- - Function: PyramidFilterCentered - - Purpose: Initializes down- and up-sampling filter arrays for - least squares CENTERED splines of order 0 to 4. (little l_2 norm) - g : reduce filter - h : expand filter - - Note: filter arrays should be defined as - double g[20],h[20] filter arrays - short *ng,*nh; number of taps - short Order; order of the spline - - Author: Patrick Brigger, NIH, BEIP May 1996 - Daniel Sage, EPFL, Biomedical Imaging Group, November 1999 - ----------------------------------------------------------------------------- */ -extern void PyramidFilterCentered(double g[],long *ng,double h[],long *nh,long Order) -{ - switch (Order) { - case 0 : - g[0] = 1; - *ng=1; - h[0] = 2; - *nh=1; - break; - - case 1 : - g[0] = 1.; - g[1] = 0.333333; - g[2] = -0.333333; - g[3] = -0.111111; - g[4] = 0.111111; - g[5] = 0.037037; - g[6] = -0.037037; - g[7] = -0.0123457; - g[8] = 0.0123457; - g[9] = 0.00411523; - g[10] = -0.00411523; - g[11] = -0.00137174; - g[12] = 0.00137174; - g[13] = 0.000457247; - g[14] = -0.000457247; - g[15] = -0.000152416; - g[16] = 0.000152416; - g[17] = 0.0000508053; - g[18] = -0.0000508053; - g[19] = -0.0000169351; - g[20] = 0.0000169351; - *ng = 21; - h[0] = 1; - h[1] = 0.5; - *nh = 2; - break; - - case 2 : - g[0] = 0.738417; - g[1] = 0.307916; - g[2] = -0.171064; - g[3] = -0.0799199; - g[4] = 0.0735791; - g[5] = 0.03108; - g[6] = -0.0307862; - g[7] = -0.0128561; - g[8] = 0.0128425; - g[9] = 0.00535611; - g[10] = -0.00535548; - g[11] = -0.00223325; - g[12] = 0.00223322; - g[13] = 0.000931242; - g[14] = -0.00093124; - g[15] = -0.000388322; - g[16] = 0.000388322; - g[17] = 0.000161928; - g[18] = -0.000161928; - g[19] = -0.0000675233; - g[20] = 0.0000675233; - *ng = 21; - h[0] = 1.20711; - h[1] = 0.585786; - h[2] = -0.12132; - h[3] = -0.100505; - h[4] = 0.0208153; - h[5] = 0.0172439; - h[6] = -0.00357134; - h[7] = -0.00295859; - h[8] = 0.000612745; - h[9] = 0.000507614; - h[10] = -0.00010513; - *nh = 11; - break; - - case 3 : - g[0] = 0.708792; - g[1] = 0.328616; - g[2] = -0.165157; - g[3] = -0.114448; - g[4] = 0.0944036; - g[5] = 0.0543881; - g[6] = -0.05193; - g[7] = -0.0284868; - g[8] = 0.0281854; - g[9] = 0.0152877; - g[10] = -0.0152508; - g[11] = -0.00825077; - g[12] = 0.00824629; - g[13] = 0.00445865; - g[14] = -0.0044582; - g[15] = -0.00241009; - g[16] = 0.00241022; - g[17] = 0.00130278; - g[18] = -0.00130313; - g[19] = -0.000704109; - g[20] = 0.000704784; - *ng = 21; - h[0] = 1.13726; - h[1] = 0.625601; - h[2] = -0.0870191; - h[3] = -0.159256; - h[4] = 0.0233167; - h[5] = 0.0426725; - h[6] = -0.00624769; - h[7] = -0.0114341; - h[8] = 0.00167406; - h[9] = 0.00306375; - h[10] = -0.000448564; - h[11] = -0.000820929; - h[12] = 0.000120192; - h[13] = 0.000219967; - h[14] = -0.0000322054; - h[15] = -0.00005894; - *nh = 16; - break; - - case 4 : - g[0] = 0.673072; - g[1] = 0.331218; - g[2] = -0.139359; - g[3] = -0.12051; - g[4] = 0.086389; - g[5] = 0.0611801; - g[6] = -0.0542989; - g[7] = -0.034777; - g[8] = 0.033388; - g[9] = 0.0206275; - g[10] = -0.0203475; - g[11] = -0.0124183; - g[12] = 0.0123625; - g[13] = 0.00751369; - g[14] = -0.00750374; - g[15] = -0.00455348; - g[16] = 0.00455363; - g[17] = 0.00276047; - g[18] = -0.00276406; - g[19] = -0.00167279; - g[20] = 0.00167938; - *ng = 21; - h[0] = 1.14324; - h[1] = 0.643609; - h[2] = -0.0937888; - h[3] = -0.194993; - h[4] = 0.030127; - h[5] = 0.0699433; - h[6] = -0.0108345; - h[7] = -0.0252663; - h[8] = 0.00391424; - h[9] = 0.00912967; - h[10] = -0.00141437; - h[11] = -0.00329892; - h[12] = 0.000511068; - h[13] = 0.00119204; - h[14] = -0.00018467; - h[15] = -0.000430732; - h[16] = 0.0000667289; - h[17] = 0.000155641; - h[18] = -0.0000241119; - h[19] = -0.0000562395; - *nh = 20; - break; - - default : - g[0] = 1.; - *ng = 1; - h[0] = 2.; - *nh = 1; - MessageDisplay( "Spline filters only defined for n=0,1,2,3,4"); - break; - } -} - -/* ---------------------------------------------------------------------------- - Function: PyramidFilterCenteredL2 - - Purpose: Initializes the symmetric down- and up-sampling filter arrays for - L2 spline pyramid of order 0 to 5 when the downsampled grid is centered. - These filters have then to be followed by a Haar filter. - g: reduce filter - h: expand filter - - Note: filter arrays should be defined as - double g[35],h[35] filter arrays - short *ng,*nh number of taps - short Order order of the spline - - Author: Patrick Brigger, NIH, BEIP, April 1996 - Daniel Sage, EPFL, Biomedical Imaging Group, November 1999 - ----------------------------------------------------------------------------- */ -extern void PyramidFilterCenteredL2(double g[],long *ng,double h[],long *nh,long Order) -{ - switch (Order) { - case 0 : - g[0] = 1.; - *ng = 1; - h[0] = 2.; - *nh = 1; - break; - - case 1 : - g[0] = 0.820272; - g[1] = 0.316987; - g[2] = -0.203044; - g[3] = -0.0849365; - g[4] = 0.0544056; - g[5] = 0.0227587; - g[6] = -0.0145779; - g[7] = -0.00609817; - g[8] = 0.00390615; - g[9] = 0.001634; - g[10] = -0.00104665; - g[11] = -0.000437829; - g[12] = 0.000280449; - g[13] = 0.000117316; - g[14] = -0.000075146; - g[15] = -0.0000314347; - g[16] = 0.0000201353; - *ng = 17; - h[0] = 1.20096; - h[1] = 0.473076; - h[2] = -0.0932667; - h[3] = 0.0249907; - h[4] = -0.00669625; - h[5] = 0.00179425; - h[6] = -0.000480769; - h[7] = 0.000128822; - h[8] = -0.0000345177; - *nh = 9; - break; - - case 2 : - g[0] = 0.727973; - g[1] = 0.314545; - g[2] = -0.167695; - g[3] = -0.0893693; - g[4] = 0.0768426; - g[5] = 0.0354175; - g[6] = -0.0331015; - g[7] = -0.0151496; - g[8] = 0.0142588; - g[9] = 0.00651781; - g[10] = -0.00613959; - g[11] = -0.00280621; - g[12] = 0.00264356; - g[13] = 0.00120827; - g[14] = -0.00113825; - g[15] = -0.000520253; - g[16] = 0.000490105; - g[17] = 0.000224007; - g[18] = -0.000211028; - g[19] = -0.0000964507; - g[20] = 0.0000908666; - *ng = 21; - h[0] = 1.20711; - h[1] = 0.585786; - h[2] = -0.12132; - h[3] = -0.100505; - h[4] = 0.0208153; - h[5] = 0.0172439; - h[6] = -0.00357134; - h[7] = -0.00295859; - h[8] = 0.000612745; - h[9] = 0.000507614; - h[10] = -0.00010513; - *nh = 11; - break; - - case 3 : - g[0] = 0.70222; - g[1] = 0.328033; - g[2] = -0.159368; - g[3] = -0.113142; - g[4] = 0.0902447; - g[5] = 0.0530861; - g[6] = -0.0492084; - g[7] = -0.0274987; - g[8] = 0.0264529; - g[9] = 0.0146073; - g[10] = -0.0141736; - g[11] = -0.0078052; - g[12] = 0.00758856; - g[13] = 0.00417626; - g[14] = -0.00406225; - g[15] = -0.00223523; - g[16] = 0.00217454; - g[17] = 0.00119638; - g[18] = -0.00116412; - g[19] = -0.000640258; - g[20] = 0.000623379; - *ng = 21; - h[0] = 1.15089; - h[1] = 0.623278; - h[2] = -0.0961988; - h[3] = -0.155743; - h[4] = 0.0259827; - h[5] = 0.041346; - h[6] = -0.0067263; - h[7] = -0.0112084; - h[8] = 0.00187221; - h[9] = 0.00296581; - h[10] = -0.000481593; - h[11] = -0.000805427; - h[12] = 0.000134792; - h[13] = 0.000212736; - h[14] = -0.00003447; - *nh = 15; - break; - - case 4: - g[0] = 0.672101; - g[1] = 0.331667; - g[2] = -0.138779; - g[3] = -0.121385; - g[4] = 0.0864024; - g[5] = 0.0618776; - g[6] = -0.0545165; - g[7] = -0.0352403; - g[8] = 0.0335951; - g[9] = 0.0209537; - g[10] = -0.0205211; - g[11] = -0.0126439; - g[12] = 0.0124959; - g[13] = 0.0076682; - g[14] = -0.00760135; - g[15] = -0.00465835; - g[16] = 0.00462238; - g[17] = 0.00283148; - g[18] = -0.00281055; - g[19] = -0.00172137; - g[20] = 0.00170884; - *ng = 21; - h[0] = 1.14324; - h[1] = 0.643609; - h[2] = -0.0937888; - h[3] = -0.194993; - h[4] = 0.030127; - h[5] = 0.0699433; - h[6] = -0.0108345; - h[7] = -0.0252663; - h[8] = 0.00391424; - h[9] = 0.00912967; - h[10] = -0.00141437; - h[11] = -0.00329892; - h[12] = 0.000511068; - h[13] = 0.00119204; - h[14] = -0.00018467; - h[15] = -0.000430732; - h[16] = 0.0000667289; - h[17] = 0.000155641; - h[18] = -0.0000241119; - h[19] = -0.0000562396; - *nh = 20; - break; - - default : - g[0] = 1.; - *ng = 1; - h[0] = 2.; - *nh = 1; - MessageDisplay( "Spline filters only defined for n=0,1,2,3,4"); - break; - } -} - - -/* ---------------------------------------------------------------------------- - Function: PyramidFilterCenteredL2Derivate - - Purpose: Initializes the symmetric down- and up-sampling filter arrays for - L2 DERIVATIVE spline pyramid of order 0 to 5 when the downsampled - grid is centered. - These filters have then to be followed by a Derivative Haar filter. - g : reduce filter - h : expand filter - Note: filter arrays should be defined as - double g[35],h[35] filter arrays - short *ng,*nh number of taps - short Order order of the spline - - Author: Patrick Brigger, NIH, BEIP, April 1996 - Daniel Sage, EPFL, Biomedical Imaging Group, November 1999 - ----------------------------------------------------------------------------- */ -extern void PyramidFilterCenteredL2Derivate(double g[],long *ng,double h[],long *nh,long Order) -{ - switch (Order) { - case 0 : - g[0] = 1.; - *ng=1; - h[0] = 2.; - *nh=1; - break; - - case 1 : - g[0] = 0.820272; - g[1] = 0.316987; - g[2] = -0.203044; - g[3] = -0.0849365; - g[4] = 0.0544056; - g[5] = 0.0227587; - g[6] = -0.0145779; - g[7] = -0.00609817; - g[8] = 0.00390615; - g[9] = 0.001634; - g[10] = -0.00104665; - g[11] = -0.000437829; - g[12] = 0.000280449; - g[13] = 0.000117316; - g[14] = -0.000075146; - g[15] = -0.0000314347; - g[16] = 0.0000201353; - *ng = 17; - h[0] = 1.20096; - h[1] = 1.20096; - h[2] = -0.254809; - h[3] = 0.068276; - h[4] = -0.0182945; - h[5] = 0.004902; - h[6] = -0.00131349; - h[7] = 0.000351947; - h[8] = -0.000094304; - h[9] = 0.0000252687; - *nh = 10; - break; - - case 2 : - g[0] = 0.727973; - g[1] = 0.314545; - g[2] = -0.167695; - g[3] = -0.0893693; - g[4] = 0.0768426; - g[5] = 0.0354175; - g[6] = -0.0331015; - g[7] = -0.0151496; - g[8] = 0.0142588; - g[9] = 0.00651781; - g[10] = -0.00613959; - g[11] = -0.00280621; - g[12] = 0.00264356; - g[13] = 0.00120827; - g[14] = -0.00113825; - g[15] = -0.000520253; - g[16] = 0.000490105; - g[17] = 0.000224007; - g[18] = -0.000211028; - g[19] = -0.0000964507; - g[20] = 0.0000908666; - *ng = 21; - h[0] = 1.20711; - h[1] = 0.585786; - h[2] = -0.12132; - h[3] = -0.100505; - h[4] = 0.0208153; - h[5] = 0.0172439; - h[6] = -0.00357134; - h[7] = -0.00295859; - h[8] = 0.000612745; - h[9] = 0.000507614; - h[10] = -0.00010513; - *nh = 11; - break; - - case 3 : - g[0] = 0.70222; - g[1] = 0.328033; - g[2] = -0.159368; - g[3] = -0.113142; - g[4] = 0.0902447; - g[5] = 0.0530861; - g[6] = -0.0492084; - g[7] = -0.0274987; - g[8] = 0.0264529; - g[9] = 0.0146073; - g[10] = -0.0141736; - g[11] = -0.0078052; - g[12] = 0.00758856; - g[13] = 0.00417626; - g[14] = -0.00406225; - g[15] = -0.00223523; - g[16] = 0.00217454; - g[17] = 0.00119638; - g[18] = -0.00116412; - g[19] = -0.000640258; - g[20] = 0.000623379; - *ng = 21; - h[0] = 1.15089; - h[1] = 0.623278; - h[2] = -0.0961988; - h[3] = -0.155743; - h[4] = 0.0259827; - h[5] = 0.041346; - h[6] = -0.0067263; - h[7] = -0.0112084; - h[8] = 0.00187221; - h[9] = 0.00296581; - h[10] = -0.000481593; - h[11] = -0.000805427; - h[12] = 0.000134792; - h[13] = 0.000212736; - h[14] = -0.00003447; - *nh = 15; - break; - - case 4: - g[0] = 0.672101; - g[1] = 0.331667; - g[2] = -0.138779; - g[3] = -0.121385; - g[4] = 0.0864024; - g[5] = 0.0618776; - g[6] = -0.0545165; - g[7] = -0.0352403; - g[8] = 0.0335951; - g[9] = 0.0209537; - g[10] = -0.0205211; - g[11] = -0.0126439; - g[12] = 0.0124959; - g[13] = 0.0076682; - g[14] = -0.00760135; - g[15] = -0.00465835; - g[16] = 0.00462238; - g[17] = 0.00283148; - g[18] = -0.00281055; - g[19] = -0.00172137; - g[20] = 0.00170884; - *ng = 21; - h[0] = 1.14324; - h[1] = 0.643609; - h[2] = -0.0937888; - h[3] = -0.194993; - h[4] = 0.030127; - h[5] = 0.0699433; - h[6] = -0.0108345; - h[7] = -0.0252663; - h[8] = 0.00391424; - h[9] = 0.00912967; - h[10] = -0.00141437; - h[11] = -0.00329892; - h[12] = 0.000511068; - h[13] = 0.00119204; - h[14] = -0.00018467; - h[15] = -0.000430732; - h[16] = 0.0000667289; - h[17] = 0.000155641; - h[18] = -0.0000241119; - h[19] = -0.0000562396; - *nh = 20; - break; - - default : - g[0] = 1.; - *ng=1; - h[0] = 2.; - *nh=1; - MessageDisplay( "Spline filters only defined for n=0,1,2,3,4"); - break; - } -} - diff --git a/src/core/bilib/pyramidfilters.h b/src/core/bilib/pyramidfilters.h deleted file mode 100644 index 194ced8..0000000 --- a/src/core/bilib/pyramidfilters.h +++ /dev/null @@ -1,103 +0,0 @@ -#ifndef _PYRAMIDFILTERS -#define _PYRAMIDFILTERS -/* ---------------------------------------------------------------------------- - Filename: pyramidfilters.h - - Project: Biomedical Imaging Library - - Author: Daniel Sage - Swiss Federal Institute of Technology - Lausanne - Biomedical Imaging Group - EPFL/DMT/IOA, BM-Ecublens, CH-1015 Lausanne, Switzerland - - Date: 17 March 1999 - - Purpose: Header associated to pyramidfilters.c - ----------------------------------------------------------------------------- */ - -/**@defgroup PyramidFilters Pyramid filters - @ingroup BilibLibrary */ -//@{ -/** PyramidFilterSplinel2. - Function: PyramidFilterSplinel2 - - Purpose: Initializes down- and up-sampling filter arrays for - least squares splines of order 0 to 3. (little l_2 norm) - g : reduce filter - h : expand filter - - Author: Michael Unser, NIH, BEIP, May 1992 -*/ -extern void PyramidFilterSplinel2(double g[], long *ng, double *h, long *nh, long Order); - -/** PyramidFilterSplineL2. - Function: PyramidFilterSplineL2 - - Purpose: Initializes down- and up-sampling filter arrays for - L2 spline pyramid of order 0 to 5. - g : reduce filter - h : expand filter - - Author: Michael Unser, NIH, BEIP, May 1992 -*/ -extern void PyramidFilterSplineL2(double g[], long *ng, double *h, long *nh, long Order); - -/** PyramidFilterCentered. - Function: PyramidFilterCentered - - Purpose: Initializes down- and up-sampling filter arrays for - least squares CENTERED splines of order 0 to 4. (little l_2 norm) - g : reduce filter - h : expand filter - - Note: filter arrays should be defined as - double g[20],h[20] filter arrays - short *ng,*nh; number of taps - short Order; order of the spline - - Author: Patrick Brigger, NIH, BEIP May 1996 - Daniel Sage, EPFL, Biomedical Imaging Group, November 1999 -*/ -extern void PyramidFilterCentered(double g[], long *ng, double h[], long *nh, long Order); - -/** PyramidFilterCenteredL2. - Function: PyramidFilterCenteredL2 - - Purpose: Initializes the symmetric down- and up-sampling filter arrays for - L2 spline pyramid of order 0 to 5 when the downsampled grid is centered. - These filters have then to be followed by a Haar filter. - g: reduce filter - h: expand filter - - Note: filter arrays should be defined as - float g[35],h[35] filter arrays - short *ng,*nh number of taps - short Order order of the spline - - Author: Patrick Brigger, NIH, BEIP, April 1996 - Daniel Sage, EPFL, Biomedical Imaging Group, November 1999 -*/ -extern void PyramidFilterCenteredL2(double g[], long *ng, double h[], long *nh, long Order); - -/** PyramidFilterCenteredL2Derivate. - Function: PyramidFilterCenteredL2Derivate - - Purpose: Initializes the symmetric down- and up-sampling filter arrays for - L2 DERIVATIVE spline pyramid of order 0 to 5 when the downsampled - grid is centered. - These filters have then to be followed by a Derivative Haar filter. - g : reduce filter - h : expand filter - Note: filter arrays should be defined as - float g[35],h[35] filter arrays - short *ng,*nh number of taps - short Order order of the spline - - Author: Patrick Brigger, NIH, BEIP, April 1996 - Daniel Sage, EPFL, Biomedical Imaging Group, November 1999 -*/ -extern void PyramidFilterCenteredL2Derivate(double g[], long *ng, double h[], long *nh, long Order); - -//@} -#endif diff --git a/src/core/bilib/pyramidtools.cc b/src/core/bilib/pyramidtools.cc deleted file mode 100644 index a705473..0000000 --- a/src/core/bilib/pyramidtools.cc +++ /dev/null @@ -1,1170 +0,0 @@ -/* ---------------------------------------------------------------------------- - Filename: pyramidtools.h - - Author: Daniel Sage - Swiss Federal Institute of Technology - Lausanne - Biomedical Imaging Group - EPFL/DMT/IOA, BM-Ecublens, CH-1015 Lausanne, Switzerland - - Date: 17 March 1999 - - Purpose: Basic functions reduce and expand by factors of 2 in 1D - signal or in 2D signal. - Includes the standard pyramid and the centered pyramid. - - References: - - [1] M. Unser, "Splines: a perfect fit for signal and image processing," - IEEE Signal Processing Magazine, 1999. - - [2] M. Unser, A. Aldroubi and M. Eden, "B-spline signal processing: - Part II: efficient design and applications," IEEE Trans. Signal Processing, - vol. 41, no. 2, pp. 834-848, February 1993. - - [3] M. Unser, A. Aldroubi and M. Eden, "The L2 polynomial spline pyramid," - IEEE Trans. Pattern Anal. Mach. Intell., vol. 15, no. 4, pp. 364-379, April 1993. - - [4] P. Brigger, F. Muller, K. Illgner and M. Unser, "Centered pyramids," - IEEE Trans. Image Processing, vol. 6, no. 9, pp. 1254-1264, September 1999. - - [5] P.J. Burt and E.H. Adelson, "The Laplacian pyramid as a compact code," - IEEE Trans. Commun., vol. COM-31, no. 4, pp. 337-345, April 1983. - - ----------------------------------------------------------------------------- */ - -/* --- System includes --- */ -#include -#include -#include -#include -#include - -using namespace std; - -/* --- Private includes --- */ -#include "configs.h" -#include "messagedisplay.h" -#include "pyramidtools.h" -#include "pyramidfilters.h" - -/* ------------------------------------------------------------------------- */ -/* Declaration of static procedures */ -/* ------------------------------------------------------------------------- */ -static void ExpandStandard_1D( - double In[], long int NxIn, - double Out[], - double w[], long int nw - ); - -static void ReduceStandard_1D( - double In[], long int NxIn, - double Out[], - double w[], long int nw - ); - -static void ExpandCentered_1D( - double In[], long int NxIn, - double Out[], - double w[], long int nw - ); - -static void ReduceCentered_1D( - double In[], long int NxIn, - double Out[], - double w[], long int nw - ); - -static void GetRow( - double *Image, long int Nx, long int Ny, - long int RowNb, - double *Row, long int RowSize - ); - -static void GetColumn( - double *Image, long int Nx, long int Ny, - long int ColumnNb, - double *Column, long int ColumnSize - ); - -static void PutRow( - double *Image, long int Nx, long int Ny, - long int RowNb, - double *Row, long int RowSize - ); - -static void PutColumn( - double *Image, long int Nx, long int Ny, - long int ColumnNb, - double *Column, long int ColumnSize - ); - -static void GetX_3D( - double *Image, long int Nx, long int Ny, long int Nz, - long int y, long int z, - double *out, long int OutSize - ); - -static void GetY_3D( - double *Image, long int Nx, long int Ny, long int Nz, - long int x, long int z, - double *out, long int OutSize - ); - -static void GetZ_3D( - double *Image, long int Nx, long int Ny, long int Nz, - long int x, long int y, - double *out, long int OutSize - ); - -static void PutX_3D( - double *Image, long int Nx, long int Ny, long int Nz, - long int y, long int z, - double *in, long int inSize - ); - -static void PutY_3D( - double *Image, long int Nx, long int Ny, long int Nz, - long int x, long int z, - double *in, long int inSize - ); - -static void PutZ_3D( - double *Image, long int Nx, long int Ny, long int Nz, - long int x, long int y, - double *in, long int inSize - ); - -/* ---------------------------------------------------------------------------- - - Function: - GetPyramidFilter - - Purpose: - Get the coefficients of the filter (reduce and expand filter) - Return the coefficients in g[ng] and in h[nh] - - Convention: - g[ng] for the reduce filter - h[nh] for the expansion filter - - Parameters: - Filter is the name of the filter - - Order is the order for the filters based on splines - For the "Spline" filter, Order is 0, 1, 2 or 3 - For the "Spline L2" filter, Order is 0, 1, 3 or 5 - For the "Centered Spline" filter, Order is 0, 1, 2, 3 or 4 - For the "Centered Spline L2" filter, Order is 0, 1, 2, 3 or 4 - - IsCentered is a return value indicates if the filter is a centered filter - TRUE if it is a centered filter - FALSE if it is not a centered filter - ----------------------------------------------------------------------------- */ -extern int GetPyramidFilter( - const char *Filter, - long int Order, - double g[], long int *ng, - double h[], long int *nh, - short *IsCentered) -{ - - ng[0] = -1L; - nh[0] = -1L; - *IsCentered = FALSE; - - if ( !strcmp(Filter, "Spline")) { - PyramidFilterSplinel2(g, ng, h, nh, Order); - *IsCentered = FALSE; - } - - if ( !strcmp(Filter, "Spline L2")) { - PyramidFilterSplineL2(g, ng, h, nh, Order); - *IsCentered = FALSE; - } - - if ( !strcmp(Filter, "Centered Spline")) { - PyramidFilterCentered(g, ng, h, nh, Order); - *IsCentered = TRUE; - } - - if ( !strcmp(Filter, "Centered Spline L2")) { - PyramidFilterCenteredL2(g, ng, h, nh, Order); - *IsCentered = TRUE; - } - - if ( ng[0] == -1L && nh[0] == -1L) { - MessageDisplay( "This familly filters is unknown"); - return(ERROR); - } - return( !ERROR); - -} - -/* ---------------------------------------------------------------------------- - - Function: - Reduce_2D - - Purpose: - Reduces an image by a factor of two in each dimension. - - Note: - Expects the output array (Out) to be allocated. - - Parameters: - Input image: In[NxIn*NyIn] - Output image: Out[NxIn/2*NyIn/2] - Filter: g[ng] coefficients of the filter - ----------------------------------------------------------------------------- */ -extern int Reduce_2D( - double *In, long int NxIn, long int NyIn, - double *Out, - double g[], long int ng, - short IsCentered - ) -{ -double *Tmp; -double *InBuffer; /* Input buffer to 1D process */ -double *OutBuffer; /* Output buffer to 1D process */ -long kx, ky; -long int NxOut; -long int NyOut; - - /* --- Define dimension of the output --- */ - NxOut = NxIn/2L; - if (NxOut < 1L) NxOut = 1L; - - NyOut = NyIn/2L; - if (NyOut < 1L) NyOut = 1L; - - /* --- Allocate a temporary image --- */ - Tmp = (double *)malloc((size_t)(NxOut*NyIn*(long)sizeof(double))); - if (Tmp == (double *)NULL) { - MessageDisplay("Unable to allocate memory"); - return(ERROR); - } - - /* --- X processing --- */ - if (NxIn > 1L) { - InBuffer = (double *)malloc((size_t)(NxIn*(long)sizeof(double))); - if (InBuffer == (double *)NULL) { - free(Tmp); - MessageDisplay("Unable to allocate memory"); - return(ERROR); - } - OutBuffer = (double *)malloc((size_t)(NxOut*(long)sizeof(double))); - if (OutBuffer == (double *)NULL) { - free(Tmp); - free(InBuffer); - MessageDisplay("Unable to allocate memory"); - return(ERROR); - } - for (ky=0L; ky 1L) { - InBuffer = (double *)malloc((size_t)(NyIn*(long)sizeof(double))); - if (InBuffer == (double *)NULL) { - MessageDisplay("Unable to allocate memory"); - return(ERROR); - } - OutBuffer = (double *)malloc((size_t)(NyOut*(long)sizeof(double))); - if (OutBuffer == (double *)NULL) { - free(InBuffer); - MessageDisplay("Unable to allocate memory"); - return(ERROR); - } - for (kx=0L; kx 1L) { - InBuffer = (double *)malloc((size_t)(NxIn*(long)sizeof(double))); - if (InBuffer == (double *)NULL) { - free(Tmp); free(Tmp2); - MessageDisplay("Unable to allocate memory"); - return(ERROR); - } - OutBuffer = (double *)malloc((size_t)(NxOut*(long)sizeof(double))); - if (OutBuffer == (double *)NULL) { - free(Tmp); free(Tmp2); - free(InBuffer); - MessageDisplay("Unable to allocate memory"); - return(ERROR); - } - for (kz=0L; kz 1L) { - InBuffer = (double *)malloc((size_t)(NyIn*(long)sizeof(double))); - if (InBuffer == (double *)NULL) { - free(Tmp); free(Tmp2); - MessageDisplay("Unable to allocate memory"); - return(ERROR); - } - OutBuffer = (double *)malloc((size_t)(NyOut*(long)sizeof(double))); - if (OutBuffer == (double *)NULL) { - free(Tmp); free(Tmp2); - free(InBuffer); - MessageDisplay("Unable to allocate memory"); - return(ERROR); - } - for (kz=0L; kz 1L) { - InBuffer = (double *)malloc((size_t)(NzIn*(long)sizeof(double))); - if (InBuffer == (double *)NULL) { - free(Tmp); free(Tmp2); - MessageDisplay("Unable to allocate memory"); - return(ERROR); - } - OutBuffer = (double *)malloc((size_t)(NzOut*(long)sizeof(double))); - if (OutBuffer == (double *)NULL) { - free(Tmp); free(Tmp2); - free(InBuffer); - MessageDisplay("Unable to allocate memory"); - return(ERROR); - } - for (kx=0L; kx 1L) { - InBuffer = (double *)malloc((size_t)(NxIn*(long)sizeof(double))); - if (InBuffer == (double *)NULL) { - MessageDisplay("Unable to allocate memory"); - return(ERROR); - } - OutBuffer = (double *)malloc((size_t)(NxOut*(long)sizeof(double))); - if (OutBuffer == (double *)NULL) { - free(InBuffer); - MessageDisplay("Unable to allocate memory"); - return(ERROR); - } - for (ky=0L; ky 1L) { - InBuffer = (double *)malloc((size_t)(NyIn*(long)sizeof(double))); - if (InBuffer == (double *)NULL) { - MessageDisplay("Unable to allocate memory"); - return(ERROR); - } - OutBuffer = (double *)malloc((size_t)(NyOut*(long)sizeof(double))); - if (OutBuffer == (double *)NULL) { - free(InBuffer); - MessageDisplay("Unable to allocate memory"); - return(ERROR); - } - for (kx=0L; kx 1L) { - InBuffer = (double *)malloc((size_t)(NxIn*(long)sizeof(double))); - if (InBuffer == (double *)NULL) { - MessageDisplay("Unable to allocate memory"); - return(ERROR); - } - OutBuffer = (double *)malloc((size_t)(NxOut*(long)sizeof(double))); - if (OutBuffer == (double *)NULL) { - free(InBuffer); - MessageDisplay("Unable to allocate memory"); - return(ERROR); - } - for (kz=0L; kz 1L) { - InBuffer = (double *)malloc((size_t)(NyIn*(long)sizeof(double))); - if (InBuffer == (double *)NULL) { - MessageDisplay("Unable to allocate memory"); - return(ERROR); - } - OutBuffer = (double *)malloc((size_t)(NyOut*(long)sizeof(double))); - if (OutBuffer == (double *)NULL) { - free(InBuffer); - MessageDisplay("Unable to allocate memory"); - return(ERROR); - } - for (kz=0L; kz 1L) { - InBuffer = (double *)malloc((size_t)(NzIn*(long)sizeof(double))); - if (InBuffer == (double *)NULL) { - MessageDisplay("Unable to allocate memory"); - return(ERROR); - } - OutBuffer = (double *)malloc((size_t)(NyOut*(long)sizeof(double))); - if (OutBuffer == (double *)NULL) { - free(InBuffer); - MessageDisplay("Unable to allocate memory"); - return(ERROR); - } - for (ky=0L; ky n-1L) - i2 = kn-i2; - Out[kk] = (In[k]+In[i2])/2.; - } - } - - else { - for (kk=0L; kk n-1) - i1=kn-i1; - } - if (i2 > n-1L) { - i2 = i2 % kn; - if (i2 > n-1L) - i2=kn-i2; - } - Out[kk] = Out[kk] + g[i]*(In[i1]+In[i2]); - } - } - } - -} - -/* ---------------------------------------------------------------------------- - - Function: - ExpandStandard_1D - - Purpose: - Basic function to expand a 1D signal - - Parameters: - In[NxIn] is the input signal (NxIn should be greater than 1) - Out[NxIn*2] is the output signal - w[nw] is an array that contains the coefficients of the filter - - Author: - Michael Unser, NIH, BEIP, June 1994 - Daniel Sage, EPFL, Biomedical Imaging Group, April 1999 - ----------------------------------------------------------------------------- */ -static void ExpandStandard_1D( - double In[], long int NxIn, - double Out[], - double h[], long int nh) -{ -long int k, j, i, i1, i2; -long int kn, nexp, n; - - nexp = NxIn*2L; - n = NxIn; - kn = n-1; - - if (nh < 2L) { - for (i=0L; i kn) - i1=kn-i1; - } - Out[i] = Out[i] + h[k]*In[i1]; - } - - for (k=2L-(i % 2L); k kn) { - i2 = i2 % kn; - i2 = kn-i2; - if (i2 > kn) - i2 = kn-i2; - } - Out[i] = Out[i] + h[k]*In[i2]; - } - } - } - -} - -/* ---------------------------------------------------------------------------- - - Function: ReduceCentered_1D - - Purpose: Reduces an image by a factor of two - The reduced image grid is between the finer grid - - Parameters: - In[NxIn] is the input signal (NxIn should be greater than 2 and even) - Out[NxIn/2] is the output signal - g[ng] is an array that contains the coefficients of the filter - - Author: - Michael Unser, NIH, BEIP, June 1994 - Patrick Brigger, NIH, BEIP, May 1996, modified - Daniel Sage, EPFL, Biomedical Imaging Group, April 1999 - ----------------------------------------------------------------------------- */ -extern void ReduceCentered_1D( double In[], long int NxIn, - double Out[], - double g[], long int ng) -{ -double *y_tmp; -long int k, i, i1, i2; -long kk, kn, nred, n; - - nred = NxIn/2L; - n = nred*2L; - kn = 2L*n; - - /* --- Allocated memory for a temporary buffer --- */ - y_tmp = (double *)malloc( (size_t)(n*(long)sizeof(double))); - if ( y_tmp == (double *)NULL) { - MessageDisplay("Out of memory in reduce_centered!"); - return; - } - - /* --- Apply the symmetric filter to all the coefficients --- */ - for (k=0L; k= n) - i1 = kn-i1-1L; - } - if (i2 > (n-1L)) { - i2 = i2 % kn; - if (i2 >= n) i2 = kn-i2-1L; - } - y_tmp[k] += g[i]*(In[i1]+In[i2]); - } - } - - /* --- Now apply the Haar and perform downsampling --- */ - for(kk=0L; kk pseudo mirror image */ - if (i1 >= n) - i1=kn-i1-1L; - } - if (i2 >= n) { - i2= (i2) % kn; - if (i2 >= n) - i2=kn-i2-1L; - } - Out[j] += h[k]*(In[i1]+In[i2]); - } - Out[j+1] = 0.; - for (k=-k0; k n-1) - i1 = kn-i1-1L; - } - if (i1 >= n) { - i1 = (i1) % kn; - if (i1 >= n) - i1=kn-i1-1; - } - Out[j+1L] += h[kk]*In[i1]; - } - } - - /* Now apply the Haar[-x] and */ - for (j=nexp-1L; j>0L; j--) - Out[j] = 0.5*(Out[j] + Out[j-1]); - Out[0] *= 0.5; -} - -/* ---------------------------------------------------------------------------- - - Function: - GetRow - - Purpose: - Get a row from an image - - Parameters: - Image[Nx*Ny] is the input image - RowNb is the number of the row - Row[RowSize] is the output signal - ----------------------------------------------------------------------------- */ -static void GetRow( - double *Image, long int Nx, long int Ny, - long int RowNb, - double *Row, long int RowSize - ) -{ -int i; -int BaseIndex; - - BaseIndex = RowNb*Nx; - for (i=0L; i - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "convert.h" -#include "round.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -#ifdef DEBUG -#include -#include -#include "messagedisplay.h" -#endif - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern double RoundDoubleToDouble - ( - double Argument /* value to round */ - ) - -/* rounds a double to a double */ -/* returns the nearest integer value */ - -{ /* begin RoundDoubleToDouble */ - -/**/DEBUG_WRITE_ENTERING(RoundDoubleToDouble, -/**/ "About to round a (double)argument") - - Argument += 0.5; - -/**/DEBUG_WRITE_LEAVING(RoundDoubleToDouble, "Done") - return(floor(Argument)); -} /* end RoundDoubleToDouble */ - -/*--------------------------------------------------------------------------*/ -extern float RoundDoubleToFloat - ( - double Argument /* value to round */ - ) - -/* rounds a double to a float */ -/* returns the nearest integer value */ - -{ /* begin RoundDoubleToFloat */ - -/**/DEBUG_WRITE_ENTERING(RoundDoubleToFloat, -/**/ "About to round a (double)argument to a (float)") - - Argument += 0.5; - -/**/DEBUG_WRITE_LEAVING(RoundDoubleToFloat, "Done") - return(ConvertDoubleToFloat(floor(Argument))); -} /* end RoundDoubleToFloat */ - -/*--------------------------------------------------------------------------*/ -extern float RoundFloatToFloat - ( - float Argument /* value to round */ - ) - -/* rounds a foat to a foat */ -/* returns the nearest integer value */ - -{ /* begin RoundFloatToFloat */ - -/**/DEBUG_WRITE_ENTERING(RoundFloatToFloat, -/**/ "About to round a (float)argument") - - Argument += 0.5F; - -/**/DEBUG_WRITE_LEAVING(RoundFloatToFloat, "Done") - return(ConvertDoubleToFloat(floor((double)Argument))); -} /* end RoundFloatToFloat */ - diff --git a/src/core/bilib/round.h b/src/core/bilib/round.h deleted file mode 100644 index 7bbdccf..0000000 --- a/src/core/bilib/round.h +++ /dev/null @@ -1,18 +0,0 @@ -/*--------------------------------------------------------------------------*/ -extern double RoundDoubleToDouble - ( - double Argument /* value to round */ - ); - -/*--------------------------------------------------------------------------*/ -extern float RoundDoubleToFloat - ( - double Argument /* value to round */ - ); - -/*--------------------------------------------------------------------------*/ -extern float RoundFloatToFloat - ( - float Argument /* value to round */ - ); - diff --git a/src/core/bilib/swap.cc b/src/core/bilib/swap.cc deleted file mode 100644 index 4b42d1c..0000000 --- a/src/core/bilib/swap.cc +++ /dev/null @@ -1,195 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -#include -#include -#include -#include - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" -#include "error.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "messagedisplay.h" -#include "swap.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -#ifdef DEBUG -#include -#endif - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern int SwapXyVolumeFloat - ( - float *VolumeSource, /* float input data */ - float *VolumeDestination, /* float output data */ - long Nxy, /* input width, output height */ - long Nyx, /* input height, output width */ - long Nz /* depth */ - ) - -/* swap the x-axis and the y-axis of a volume */ -/* input VolumeSource is a (float)volume of size (Nxy x Nyx x Nz) */ -/* output VolumeDestination is a (float)volume of size (Nyx x Nxy x Nz) */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin SwapXyVolumeFloat */ - - const long - N = Nxy * Nyx; - long k, i, j; - long n; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(SwapXyVolumeFloat, VolumeSource, Status, -/**/ "No VolumeSource") -/**/DEBUG_CHECK_NULL_POINTER(SwapXyVolumeFloat, VolumeDestination, Status, -/**/ "No VolumeDestination") -/**/DEBUG_CHECK_RANGE_LONG(SwapXyVolumeFloat, Nxy, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(SwapXyVolumeFloat, Nyx, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(SwapXyVolumeFloat, Nz, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(SwapXyVolumeFloat, Status) -/**/DEBUG_WRITE_ENTERING(SwapXyVolumeFloat, -/**/ "About to swap x<->y axis of a float volume") - - for (k = 0L; (k < Nz); k++) { - for (j = 0L; (j < Nyx); j++) { - n = 0L; - for (i = 0L; (i < Nxy); i++) { - VolumeDestination[n] = *VolumeSource++; - n += Nyx; - } - VolumeDestination++; - } - VolumeDestination += (ptrdiff_t)N; - } -/**/DEBUG_WRITE_LEAVING(SwapXyVolumeFloat, "Done") - return(Status); -} /* end SwapXyVolumeFloat */ - -/*--------------------------------------------------------------------------*/ -extern int SwapYzVolumeFloat - ( - float *VolumeSource, /* float input data */ - float *VolumeDestination, /* float output data */ - long Nx, /* width */ - long Nyz, /* input height, output depth */ - long Nzy /* input depth, output height */ - ) - -/* swap the y-axis and the z-axis of a volume */ -/* input VolumeSource is a (float)volume of size (Nx x Nyz x Nzy) */ -/* output VolumeDestination is a (float)volume of size (Nx x Nzy x Nyz) */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin SwapYzVolumeFloat */ - - float *p; - const long - N = Nx * Nzy; - long k, j; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(SwapYzVolumeFloat, VolumeSource, Status, -/**/ "No VolumeSource") -/**/DEBUG_CHECK_NULL_POINTER(SwapYzVolumeFloat, VolumeDestination, Status, -/**/ "No VolumeDestination") -/**/DEBUG_CHECK_RANGE_LONG(SwapYzVolumeFloat, Nx, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(SwapYzVolumeFloat, Nyz, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(SwapYzVolumeFloat, Nzy, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(SwapYzVolumeFloat, Status) -/**/DEBUG_WRITE_ENTERING(SwapYzVolumeFloat, -/**/ "About to swap y<->z axis of a float volume") - - for (k = 0L; (k < Nzy); k++) { - p = VolumeDestination; - for (j = 0L; (j < Nyz); j++) { - p = (float *)memcpy(p, VolumeSource, (size_t)(Nx * (long)sizeof(float))); - VolumeSource += (ptrdiff_t)Nx; - p += (ptrdiff_t)N; - } - VolumeDestination += (ptrdiff_t)Nx; - } -/**/DEBUG_WRITE_LEAVING(SwapYzVolumeFloat, "Done") - return(Status); -} /* end SwapYzVolumeFloat */ - -/*--------------------------------------------------------------------------*/ -extern int SwapZxVolumeFloat - ( - float *VolumeSource, /* float input data */ - float *VolumeDestination, /* float output data */ - long Nxz, /* input width, output depth */ - long Ny, /* height */ - long Nzx /* input depth, output width */ - ) - -/* swap the z-axis and the x-axis of a volume */ -/* input VolumeSource is a (float)volume of size (Nxz x Ny x Nzx) */ -/* output VolumeDestination is a (float)volume of size (Nzx x Ny x Nxz) */ -/* success: return(!ERROR); failure: return(ERROR); */ - -{ /* begin SwapZxVolumeFloat */ - - float *p, *q; - const long - N = Nzx * Ny; - long k, j, i; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(SwapZxVolumeFloat, VolumeSource, Status, -/**/ "No VolumeSource") -/**/DEBUG_CHECK_NULL_POINTER(SwapZxVolumeFloat, VolumeDestination, Status, -/**/ "No VolumeDestination") -/**/DEBUG_CHECK_RANGE_LONG(SwapZxVolumeFloat, Nxz, 1L, LONG_MAX, Status, -/**/ "Invalid width (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(SwapZxVolumeFloat, Ny, 1L, LONG_MAX, Status, -/**/ "Invalid height (should be strictly positive)") -/**/DEBUG_CHECK_RANGE_LONG(SwapZxVolumeFloat, Nzx, 1L, LONG_MAX, Status, -/**/ "Invalid depth (should be strictly positive)") -/**/DEBUG_RETURN_ON_ERROR(SwapZxVolumeFloat, Status) -/**/DEBUG_WRITE_ENTERING(SwapZxVolumeFloat, -/**/ "About to swap z<->x axis of a float volume") - - for (k = 0L; (k < Nzx); k++) { - q = VolumeDestination++; - for (j = 0L; (j < Ny); j++) { - p = q; - for (i = 0L; (i < Nxz); i++) { - *p = *VolumeSource++; - p += (ptrdiff_t)N; - } - q += (ptrdiff_t)Nzx; - } - } -/**/DEBUG_WRITE_LEAVING(SwapZxVolumeFloat, "Done") - return(Status); -} /* end SwapZxVolumeFloat */ - diff --git a/src/core/bilib/swap.h b/src/core/bilib/swap.h deleted file mode 100644 index 118d2ed..0000000 --- a/src/core/bilib/swap.h +++ /dev/null @@ -1,48 +0,0 @@ -/**@defgroup SwapAxes Swap axes in a volume - @ingroup BilibLibrary */ -//@{ -/*--------------------------------------------------------------------------*/ -/** Swap the x-axis and the y-axis of a volume. - Input VolumeSource is a (float)volume of size (Nxy x Nyx x Nz). - Output VolumeDestination is a (float)volume of size (Nyx x Nxy x Nz). - - success: return(!ERROR); failure: return(ERROR); */ -extern int SwapXyVolumeFloat - ( - float *VolumeSource, /* float input data */ - float *VolumeDestination, /* float output data */ - long Nxy, /* input width, output height */ - long Nyx, /* input height, output width */ - long Nz /* depth */ - ); - -/*--------------------------------------------------------------------------*/ -/** Swap the y-axis and the z-axis of a volume. - Input VolumeSource is a (float)volume of size (Nx x Nyz x Nzy). - Output VolumeDestination is a (float)volume of size (Nx x Nzy x Nyz). - - success: return(!ERROR); failure: return(ERROR); */ -extern int SwapYzVolumeFloat - ( - float *VolumeSource, /* float input data */ - float *VolumeDestination, /* float output data */ - long Nx, /* width */ - long Nyz, /* input height, output depth */ - long Nzy /* input depth, output height */ - ); - -/*--------------------------------------------------------------------------*/ -/** Swap the z-axis and the x-axis of a volume. - Input VolumeSource is a (float)volume of size (Nxz x Ny x Nzx). - Output VolumeDestination is a (float)volume of size (Nzx x Ny x Nxz). - - success: return(!ERROR); failure: return(ERROR); */ -extern int SwapZxVolumeFloat - ( - float *VolumeSource, /* float input data */ - float *VolumeDestination, /* float output data */ - long Nxz, /* input width, output depth */ - long Ny, /* height */ - long Nzx /* input depth, output width */ - ); -//@} diff --git a/src/core/bilib/tboundaryconvention.h b/src/core/bilib/tboundaryconvention.h deleted file mode 100644 index 39af325..0000000 --- a/src/core/bilib/tboundaryconvention.h +++ /dev/null @@ -1,17 +0,0 @@ -#ifndef _TBOUNDARYCONDITIONS -#define _TBOUNDARYCONDITIONS -/*--------------------------------------------------------------------------*/ -/** Type of Boundary Conventions. - Valid types are AntiMirrorOnBounds, FiniteCoefficientSupport, - FiniteDataSupport, MirrorOffBounds, MirrorOnBounds, and Periodic*/ -enum TBoundaryConvention -{ - AntiMirrorOnBounds, - FiniteCoefficientSupport, - FiniteDataSupport, - MirrorOffBounds, - MirrorOnBounds, - Periodic -}; - -#endif diff --git a/src/core/bilib/timestamp.cc b/src/core/bilib/timestamp.cc deleted file mode 100644 index 6261faa..0000000 --- a/src/core/bilib/timestamp.cc +++ /dev/null @@ -1,191 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -#include -#include -#include - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" -#include "error.h" -#include "ttimestamp.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "messagedisplay.h" -#include "timestamp.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ - /* None */ - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern int GetTimeStamp - ( - struct TTimeStamp - *TimeStamp /* output time stamp */ - ) - -/* get a time stamp */ -/* system time is the number of seconds elapsed since - the last system boot (MacOS) or the start of the current process (UNIX) */ -/* calendar time is the number of seconds since Midnight, January 1, 1904 A.D. */ -/* UTC time is Coordinated Universal Time */ -/* local time is UTC time after correction for time zone and Daylight Saving Time */ - -{ /* begin GetTimeStamp */ - - struct tm - *p; - time_t Now; - clock_t ticks; - int Status = !ERROR; - -/**/DEBUG_WRITE_ENTERING(GetTimeStamp, -/**/ "About to get a time stamp") - - ticks = clock(); - Status = (ticks == (clock_t)(-1)); - if (Status == ERROR) { - WRITE_ERROR(GetTimeStamp, "System processing time is not available") -/**/ DEBUG_WRITE_LEAVING(GetTimeStamp, "Done") - return(Status); - } - Now = time(&Now); - Status = (Now == (time_t)(-1)); - if (Status == ERROR) { - WRITE_ERROR(GetTimeStamp, "Calendar time is not available") -/**/ DEBUG_WRITE_LEAVING(GetTimeStamp, "Done") - return(Status); - } - TimeStamp->SecondsSinceProcessBirth = (double)ticks / (double)CLOCKS_PER_SEC; - TimeStamp->SecondsSince1904_01_01_00H00 = (double)Now; - p = gmtime(&Now); - Status = (p == (struct tm *)NULL); - if (Status == ERROR) { - WRITE_ERROR(GetTimeStamp, "UTC time is not available") -/**/ DEBUG_WRITE_LEAVING(GetTimeStamp, "Done") - return(Status); - } - p = (struct tm *) memcpy(&(TimeStamp->UTCTime), p, sizeof(struct tm)); - p = localtime(&Now); - p = (struct tm *) memcpy(&(TimeStamp->LocalTime), p, sizeof(struct tm)); -/**/DEBUG_WRITE_LEAVING(GetTimeStamp, "Done") - return(Status); -} /* end GetTimeStamp */ - -/*--------------------------------------------------------------------------*/ -extern int GetElapsedTime - ( - struct TTimeStamp - OldTimeStamp, /* oldest time stamp */ - struct TTimeStamp - NewTimeStamp, /* newest time stamp */ - double *SystemTimeDifference, - /* elapsed system time in seconds */ - double *RealTimeDifference /* true elapsed time in seconds */ - ) - -/* get the time elapsed between two time stamps */ -/* system time is the fractional number of seconds since the last system boot */ -/* calendar time is the integer number of seconds since Midnight, January 1, 1904 A.D. */ -/* UTC time is Coordinated Universal Time */ -/* local time is UTC time after correction for time zone and Daylight Saving Time (if available) */ -/* note that, if it is possible to compute the elapsed time between two historical dates, - the elapsed time between two dates that follow the release of the compiler - may be inaccurate because of the time drift of UTC time with respect to - International Atomic Time (TAI). This drift is +/- 1 leap second about once a year, - and is corrected by the International Earth Rotation Service (IERS), - which impedes any algorithmic approach. Unfortunately, TAI is not available in ANSI-C. - The list of leap seconds (so far, all positive) is available at - ftp://maia.usno.navy.mil/ser7/tai-utc.dat - The first correction was +10 seconds on January 1, 1972 A.D. - - 1972 JAN 1 =JD 2441317.5 TAI-UTC= 10.0 S + (MJD - 41317.) X 0.0 S - 1972 JUL 1 =JD 2441499.5 TAI-UTC= 11.0 S + (MJD - 41317.) X 0.0 S - 1973 JAN 1 =JD 2441683.5 TAI-UTC= 12.0 S + (MJD - 41317.) X 0.0 S - 1974 JAN 1 =JD 2442048.5 TAI-UTC= 13.0 S + (MJD - 41317.) X 0.0 S - 1975 JAN 1 =JD 2442413.5 TAI-UTC= 14.0 S + (MJD - 41317.) X 0.0 S - 1976 JAN 1 =JD 2442778.5 TAI-UTC= 15.0 S + (MJD - 41317.) X 0.0 S - 1977 JAN 1 =JD 2443144.5 TAI-UTC= 16.0 S + (MJD - 41317.) X 0.0 S - 1978 JAN 1 =JD 2443509.5 TAI-UTC= 17.0 S + (MJD - 41317.) X 0.0 S - 1979 JAN 1 =JD 2443874.5 TAI-UTC= 18.0 S + (MJD - 41317.) X 0.0 S - 1980 JAN 1 =JD 2444239.5 TAI-UTC= 19.0 S + (MJD - 41317.) X 0.0 S - 1981 JUL 1 =JD 2444786.5 TAI-UTC= 20.0 S + (MJD - 41317.) X 0.0 S - 1982 JUL 1 =JD 2445151.5 TAI-UTC= 21.0 S + (MJD - 41317.) X 0.0 S - 1983 JUL 1 =JD 2445516.5 TAI-UTC= 22.0 S + (MJD - 41317.) X 0.0 S - 1985 JUL 1 =JD 2446247.5 TAI-UTC= 23.0 S + (MJD - 41317.) X 0.0 S - 1988 JAN 1 =JD 2447161.5 TAI-UTC= 24.0 S + (MJD - 41317.) X 0.0 S - 1990 JAN 1 =JD 2447892.5 TAI-UTC= 25.0 S + (MJD - 41317.) X 0.0 S - 1991 JAN 1 =JD 2448257.5 TAI-UTC= 26.0 S + (MJD - 41317.) X 0.0 S - 1992 JUL 1 =JD 2448804.5 TAI-UTC= 27.0 S + (MJD - 41317.) X 0.0 S - 1993 JUL 1 =JD 2449169.5 TAI-UTC= 28.0 S + (MJD - 41317.) X 0.0 S - 1994 JUL 1 =JD 2449534.5 TAI-UTC= 29.0 S + (MJD - 41317.) X 0.0 S - 1996 JAN 1 =JD 2450083.5 TAI-UTC= 30.0 S + (MJD - 41317.) X 0.0 S - 1997 JUL 1 =JD 2450630.5 TAI-UTC= 31.0 S + (MJD - 41317.) X 0.0 S - 1999 JAN 1 =JD 2451179.5 TAI-UTC= 32.0 S + (MJD - 41317.) X 0.0 S -*/ - -{ /* begin GetElapsedTime */ - - time_t Old, New; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(GetElapsedTime, SystemTimeDifference, Status, -/**/ "No SystemTimeDifference") -/**/DEBUG_CHECK_NULL_POINTER(GetElapsedTime, RealTimeDifference, Status, -/**/ "No RealTimeDifference") -/**/DEBUG_RETURN_ON_ERROR(GetElapsedTime, Status) -/**/DEBUG_WRITE_ENTERING(GetElapsedTime, -/**/ "About to compute time difference") - - Old = mktime(&(OldTimeStamp.UTCTime)); - Status = (Old == (time_t)(-1)); - if (Status == ERROR) { - WRITE_ERROR(GetElapsedTime, "Invalid OldTimeStamp") -/**/ DEBUG_WRITE_LEAVING(GetElapsedTime, "Done") - return(Status); - } - New = mktime(&(NewTimeStamp.UTCTime)); - Status = (New == (time_t)(-1)); - if (Status == ERROR) { - WRITE_ERROR(GetElapsedTime, "Invalid NewTimeStamp") -/**/ DEBUG_WRITE_LEAVING(GetElapsedTime, "Done") - return(Status); - } - *RealTimeDifference = difftime(New, Old); - Status = (*RealTimeDifference < 0.0); - if (Status == ERROR) { - WRITE_ERROR(GetElapsedTime, "Loss of causality") -/**/ DEBUG_WRITE_LEAVING(GetElapsedTime, "Done") - return(Status); - } - *SystemTimeDifference = NewTimeStamp.SecondsSinceProcessBirth - - OldTimeStamp.SecondsSinceProcessBirth; - if (*SystemTimeDifference < 0.0) { - WRITE_ERROR(GetElapsedTime, "Wrap-around of the system clock occurred") -/**/ DEBUG_WRITE_LEAVING(GetElapsedTime, "Done") - return(Status); - } -/**/DEBUG_WRITE_LEAVING(GetElapsedTime, "Done") - return(Status); -} /* end GetElapsedTime */ - diff --git a/src/core/bilib/timestamp.h b/src/core/bilib/timestamp.h deleted file mode 100644 index bbadd44..0000000 --- a/src/core/bilib/timestamp.h +++ /dev/null @@ -1,19 +0,0 @@ -/*--------------------------------------------------------------------------*/ -extern int GetTimeStamp - ( - struct TTimeStamp - *TimeStamp /* output time stamp */ - ); - -/*--------------------------------------------------------------------------*/ -extern int GetElapsedTime - ( - struct TTimeStamp - OldTimeStamp, /* oldest time stamp */ - struct TTimeStamp - NewTimeStamp, /* newest time stamp */ - double *SystemTimeDifference, - /* elapsed system time in seconds */ - double *RealTimeDifference /* true elapsed time in seconds */ - ); - diff --git a/src/core/bilib/traceline.cc b/src/core/bilib/traceline.cc deleted file mode 100644 index c0ad2c5..0000000 --- a/src/core/bilib/traceline.cc +++ /dev/null @@ -1,1072 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -#include - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" -#include "error.h" -#include "ttraceline.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "convert.h" -#include "messagedisplay.h" -#include "traceline.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -#ifdef DEBUG -#include -#include -#include -#endif - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern int FirstIndex3DLine6Connected - ( - struct TTraceLine - *LineData /* line description */ - ) - -/* get precomputed elements for tracing a discrete 3D 6-connected line */ -/* must be called prior to calling NextIndex3DLine6Connected() */ -/* k[] returns the first coordinates of the discrete line */ -/* Quadrant returns a code for the general orientation (sign) of q[] */ -/* this code is as follows: */ -/* -1 -1 -1 -1 -1 -1 -1 -1 -1 */ -/* -1 -1 -1 0 0 0 1 1 1 */ -/* -1 0 1 -1 0 1 -1 0 1 */ -/* == == == == == == == == == */ -/* 0 9 18 3 12 21 6 15 24 */ -/* */ -/* 0 0 0 0 0 0 0 0 */ -/* -1 -1 -1 0 0 1 1 1 */ -/* -1 0 1 -1 1 -1 0 1 */ -/* == == == == == == == == */ -/* 1 10 19 4 22 7 16 25 */ -/* */ -/* 1 1 1 1 1 1 1 1 1 */ -/* -1 -1 -1 0 0 0 1 1 1 */ -/* -1 0 1 -1 0 1 -1 0 1 */ -/* == == == == == == == == == */ -/* 2 11 20 5 14 23 8 17 26 */ -/* ModificationCode returns the direction along which a step will be taken next */ -/* the code is as follows: */ -/* -3 <-> z--; -2 <-> y--; -1 <-> x--; 1 <-> x++; 2 <-> y++; 3 <-> z++ */ -/* (P + Entry * q) belongs to the bounding box of the voxel surrounding k */ -/* (P + Exit * q) belongs to the bounding box of the voxel surrounding k */ -/* (Entry < Exit) is satisfied */ -/* LineData->P[] is a 3D coordinate that belongs to the line */ -/* this coordinate is modified after calling FirstIndex3DLine6Connected */ -/* q[] is a 3D unit vector that gives the direction in which to draw the line */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin FirstIndex3DLine6Connected */ - - double t0, t1, t2; - int Status = !ERROR; - -/**/DEBUG_CHECK_NULL_POINTER(FirstIndex3DLine6Connected, LineData, Status, -/**/ "Missing LineData") -/**/DEBUG_RETURN_ON_ERROR(FirstIndex3DLine6Connected, Status) -/**/DEBUG_WRITE_ENTERING(FirstIndex3DLine6Connected, -/**/ "About to precompute elements for drawing a 3D discrete line") - - LineData->k[0] = ConvertDoubleToLong(LineData->P[0]); - LineData->k[1] = ConvertDoubleToLong(LineData->P[1]); - LineData->k[2] = ConvertDoubleToLong(LineData->P[2]); - if (LineData->q[0] < 0.0) { - LineData->Quadrant = 0; - } - else { - if (LineData->q[0] == 0.0) { - LineData->Quadrant = 1; - } - else { - LineData->Quadrant = 2; - } - } - if (LineData->q[1] == 0.0) { - LineData->Quadrant += 3; - } - else if (0.0 < LineData->q[1]) { - LineData->Quadrant += 6; - } - if (LineData->q[2] == 0.0) { - LineData->Quadrant += 9; - } - else if (0.0 < LineData->q[2]) { - LineData->Quadrant += 18; - } - if (LineData->Quadrant == 13) { - Status = ERROR; - WRITE_ERROR(FirstIndex3DLine6Connected, - "Invalid vector q (should have a unit length)") -/**/ DEBUG_WRITE_LEAVING(FirstIndex3DLine6Connected, "Done") - return(Status); - } - switch (LineData->Quadrant) { - case 0: - t0 = ((double)LineData->k[0] + 0.5 - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] + 0.5 - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] + 0.5 - LineData->P[2]) / LineData->q[2]; - LineData->Entry = (t0 < t1) ? ((t1 < t2) ? (t2) : (t1)) : ((t0 < t2) ? (t2) : (t0)); - LineData->P[0] += 0.5; - LineData->P[1] += 0.5; - LineData->P[2] += 0.5; - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - if (t0 < t1) { - if (t0 < t2) { - LineData->Exit = t0; - LineData->ModificationCode = -1; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = -3; - } - } - else { - if (t1 < t2) { - LineData->Exit = t1; - LineData->ModificationCode = -2; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = -3; - } - } - break; - case 1: - t1 = ((double)LineData->k[1] + 0.5 - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] + 0.5 - LineData->P[2]) / LineData->q[2]; - LineData->Entry = (t1 < t2) ? (t2) : (t1); - LineData->P[1] += 0.5; - LineData->P[2] += 0.5; - t1 = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - if (t1 < t2) { - LineData->Exit = t1; - LineData->ModificationCode = -2; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = -3; - } - break; - case 2: - t0 = ((double)LineData->k[0] - 0.5 - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] + 0.5 - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] + 0.5 - LineData->P[2]) / LineData->q[2]; - LineData->Entry = (t0 < t1) ? ((t1 < t2) ? (t2) : (t1)) : ((t0 < t2) ? (t2) : (t0)); - LineData->P[0] -= 0.5; - LineData->P[1] += 0.5; - LineData->P[2] += 0.5; - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - if (t0 < t1) { - if (t0 < t2) { - LineData->Exit = t0; - LineData->ModificationCode = 1; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = -3; - } - } - else { - if (t1 < t2) { - LineData->Exit = t1; - LineData->ModificationCode = -2; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = -3; - } - } - break; - case 3: - t0 = ((double)LineData->k[0] + 0.5 - LineData->P[0]) / LineData->q[0]; - t2 = ((double)LineData->k[2] + 0.5 - LineData->P[2]) / LineData->q[2]; - LineData->Entry = (t0 < t2) ? (t2) : (t0); - LineData->P[0] += 0.5; - LineData->P[2] += 0.5; - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t2 = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - if (t0 < t2) { - LineData->Exit = t0; - LineData->ModificationCode = -1; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = -3; - } - break; - case 4: - LineData->Entry = ((double)LineData->k[2] + 0.5 - LineData->P[2]) / LineData->q[2]; - LineData->P[2] += 0.5; - LineData->Exit = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - LineData->ModificationCode = -3; - break; - case 5: - t0 = ((double)LineData->k[0] - 0.5 - LineData->P[0]) / LineData->q[0]; - t2 = ((double)LineData->k[2] + 0.5 - LineData->P[2]) / LineData->q[2]; - LineData->Entry = (t0 < t2) ? (t2) : (t0); - LineData->P[0] -= 0.5; - LineData->P[2] += 0.5; - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t2 = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - if (t0 < t2) { - LineData->Exit = t0; - LineData->ModificationCode = 1; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = -3; - } - break; - case 6: - t0 = ((double)LineData->k[0] + 0.5 - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] - 0.5 - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] + 0.5 - LineData->P[2]) / LineData->q[2]; - LineData->Entry = (t0 < t1) ? ((t1 < t2) ? (t2) : (t1)) : ((t0 < t2) ? (t2) : (t0)); - LineData->P[0] += 0.5; - LineData->P[1] -= 0.5; - LineData->P[2] += 0.5; - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - if (t0 < t1) { - if (t0 < t2) { - LineData->Exit = t0; - LineData->ModificationCode = -1; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = -3; - } - } - else { - if (t1 < t2) { - LineData->Exit = t1; - LineData->ModificationCode = 2; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = -3; - } - } - break; - case 7: - t1 = ((double)LineData->k[1] - 0.5 - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] + 0.5 - LineData->P[2]) / LineData->q[2]; - LineData->Entry = (t1 < t2) ? (t2) : (t1); - LineData->P[1] -= 0.5; - LineData->P[2] += 0.5; - t1 = ((double)LineData->k[1] + 0.5 - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] - 0.5 - LineData->P[2]) / LineData->q[2]; - if (t1 < t2) { - LineData->Exit = t1; - LineData->ModificationCode = 2; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = -3; - } - break; - case 8: - t0 = ((double)LineData->k[0] - 0.5 - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] - 0.5 - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] + 0.5 - LineData->P[2]) / LineData->q[2]; - LineData->Entry = (t0 < t1) ? ((t1 < t2) ? (t2) : (t1)) : ((t0 < t2) ? (t2) : (t0)); - LineData->P[0] -= 0.5; - LineData->P[1] -= 0.5; - LineData->P[2] += 0.5; - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - if (t0 < t1) { - if (t0 < t2) { - LineData->Exit = t0; - LineData->ModificationCode = 1; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = -3; - } - } - else { - if (t1 < t2) { - LineData->Exit = t1; - LineData->ModificationCode = 2; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = -3; - } - } - break; - case 9: - t0 = ((double)LineData->k[0] + 0.5 - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] + 0.5 - LineData->P[1]) / LineData->q[1]; - LineData->Entry = (t0 < t1) ? (t1) : (t0); - LineData->P[0] += 0.5; - LineData->P[1] += 0.5; - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - if (t0 < t1) { - LineData->Exit = t0; - LineData->ModificationCode = -1; - } - else { - LineData->Exit = t1; - LineData->ModificationCode = -2; - } - break; - case 10: - LineData->Entry = ((double)LineData->k[1] + 0.5 - LineData->P[1]) / LineData->q[1]; - LineData->P[1] += 0.5; - LineData->Exit = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - LineData->ModificationCode = -2; - break; - case 11: - t0 = ((double)LineData->k[0] - 0.5 - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] + 0.5 - LineData->P[1]) / LineData->q[1]; - LineData->Entry = (t0 < t1) ? (t1) : (t0); - LineData->P[0] -= 0.5; - LineData->P[1] += 0.5; - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - if (t0 < t1) { - LineData->Exit = t0; - LineData->ModificationCode = 1; - } - else { - LineData->Exit = t1; - LineData->ModificationCode = -2; - } - break; - case 12: - LineData->Entry = ((double)LineData->k[0] + 0.5 - LineData->P[0]) / LineData->q[0]; - LineData->P[0] += 0.5; - LineData->Exit = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - LineData->ModificationCode = -1; - break; - case 14: - LineData->Entry = ((double)LineData->k[0] - 0.5 - LineData->P[0]) / LineData->q[0]; - LineData->P[0] -= 0.5; - LineData->Exit = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - LineData->ModificationCode = 1; - break; - case 15: - t0 = ((double)LineData->k[0] + 0.5 - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] - 0.5 - LineData->P[1]) / LineData->q[1]; - LineData->Entry = (t0 < t1) ? (t1) : (t0); - LineData->P[0] += 0.5; - LineData->P[1] -= 0.5; - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - if (t0 < t1) { - LineData->Exit = t0; - LineData->ModificationCode = -1; - } - else { - LineData->Exit = t1; - LineData->ModificationCode = 2; - } - break; - case 16: - LineData->Entry = ((double)LineData->k[1] - 0.5 - LineData->P[1]) / LineData->q[1]; - LineData->P[1] -= 0.5; - LineData->Exit = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - LineData->ModificationCode = 2; - break; - case 17: - t0 = ((double)LineData->k[0] - 0.5 - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] - 0.5 - LineData->P[1]) / LineData->q[1]; - LineData->Entry = (t0 < t1) ? (t1) : (t0); - LineData->P[0] -= 0.5; - LineData->P[1] -= 0.5; - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - if (t0 < t1) { - LineData->Exit = t0; - LineData->ModificationCode = 1; - } - else { - LineData->Exit = t1; - LineData->ModificationCode = 2; - } - break; - case 18: - t0 = ((double)LineData->k[0] + 0.5 - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] + 0.5 - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] - 0.5 - LineData->P[2]) / LineData->q[2]; - LineData->Entry = (t0 < t1) ? ((t1 < t2) ? (t2) : (t1)) : ((t0 < t2) ? (t2) : (t0)); - LineData->P[0] += 0.5; - LineData->P[1] += 0.5; - LineData->P[2] -= 0.5; - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - if (t0 < t1) { - if (t0 < t2) { - LineData->Exit = t0; - LineData->ModificationCode = -1; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = 3; - } - } - else { - if (t1 < t2) { - LineData->Exit = t1; - LineData->ModificationCode = -2; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = 3; - } - } - break; - case 19: - t1 = ((double)LineData->k[1] + 0.5 - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] - 0.5 - LineData->P[2]) / LineData->q[2]; - LineData->Entry = (t1 < t2) ? (t2) : (t1); - LineData->P[1] += 0.5; - LineData->P[2] -= 0.5; - t1 = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - if (t1 < t2) { - LineData->Exit = t1; - LineData->ModificationCode = -2; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = 3; - } - break; - case 20: - t0 = ((double)LineData->k[0] - 0.5 - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] + 0.5 - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] - 0.5 - LineData->P[2]) / LineData->q[2]; - LineData->Entry = (t0 < t1) ? ((t1 < t2) ? (t2) : (t1)) : ((t0 < t2) ? (t2) : (t0)); - LineData->P[0] -= 0.5; - LineData->P[1] += 0.5; - LineData->P[2] -= 0.5; - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - if (t0 < t1) { - if (t0 < t2) { - LineData->Exit = t0; - LineData->ModificationCode = 1; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = 3; - } - } - else { - if (t1 < t2) { - LineData->Exit = t1; - LineData->ModificationCode = -2; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = 3; - } - } - break; - case 21: - t0 = ((double)LineData->k[0] + 0.5 - LineData->P[0]) / LineData->q[0]; - t2 = ((double)LineData->k[2] - 0.5 - LineData->P[2]) / LineData->q[2]; - LineData->Entry = (t0 < t2) ? (t2) : (t0); - LineData->P[0] += 0.5; - LineData->P[2] -= 0.5; - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t2 = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - if (t0 < t2) { - LineData->Exit = t0; - LineData->ModificationCode = -1; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = 3; - } - break; - case 22: - LineData->Entry = ((double)LineData->k[2] - 0.5 - LineData->P[2]) / LineData->q[2]; - LineData->P[2] -= 0.5; - LineData->Exit = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - LineData->ModificationCode = 3; - break; - case 23: - t0 = ((double)LineData->k[0] - 0.5 - LineData->P[0]) / LineData->q[0]; - t2 = ((double)LineData->k[2] - 0.5 - LineData->P[2]) / LineData->q[2]; - LineData->Entry = (t0 < t2) ? (t2) : (t0); - LineData->P[0] -= 0.5; - LineData->P[2] -= 0.5; - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t2 = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - if (t0 < t2) { - LineData->Exit = t0; - LineData->ModificationCode = 1; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = 3; - } - break; - case 24: - t0 = ((double)LineData->k[0] + 0.5 - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] - 0.5 - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] - 0.5 - LineData->P[2]) / LineData->q[2]; - LineData->Entry = (t0 < t1) ? ((t1 < t2) ? (t2) : (t1)) : ((t0 < t2) ? (t2) : (t0)); - LineData->P[0] += 0.5; - LineData->P[1] -= 0.5; - LineData->P[2] -= 0.5; - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - if (t0 < t1) { - if (t0 < t2) { - LineData->Exit = t0; - LineData->ModificationCode = -1; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = 3; - } - } - else { - if (t1 < t2) { - LineData->Exit = t1; - LineData->ModificationCode = 2; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = 3; - } - } - break; - case 25: - t1 = ((double)LineData->k[1] - 0.5 - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] - 0.5 - LineData->P[2]) / LineData->q[2]; - LineData->Entry = (t1 < t2) ? (t2) : (t1); - LineData->P[1] -= 0.5; - LineData->P[2] -= 0.5; - t1 = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - if (t1 < t2) { - LineData->Exit = t1; - LineData->ModificationCode = 2; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = 3; - } - break; - case 26: - t0 = ((double)LineData->k[0] - 0.5 - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] - 0.5 - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] - 0.5 - LineData->P[2]) / LineData->q[2]; - LineData->Entry = (t0 < t1) ? ((t1 < t2) ? (t2) : (t1)) : ((t0 < t2) ? (t2) : (t0)); - LineData->P[0] -= 0.5; - LineData->P[1] -= 0.5; - LineData->P[2] -= 0.5; - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - if (t0 < t1) { - if (t0 < t2) { - LineData->Exit = t0; - LineData->ModificationCode = 1; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = 3; - } - } - else { - if (t1 < t2) { - LineData->Exit = t1; - LineData->ModificationCode = 2; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = 3; - } - } - break; - default: - Status = ERROR; - WRITE_ERROR(FirstIndex3DLine6Connected, - "Invalid Quadrant (shoud belong to [0..26] - {13})") -/**/ DEBUG_WRITE_LEAVING(FirstIndex3DLine6Connected, "Done") - return(Status); - } -/**/DEBUG_WRITE_LEAVING(FirstIndex3DLine6Connected, "Done") - return(Status); -} /* end FirstIndex3DLine6Connected */ - -/*--------------------------------------------------------------------------*/ -extern int NextIndex3DLine6Connected - ( - struct TTraceLine - *LineData /* line description */ - ) - -/* updates the 3D index k[] to run along a discrete 6-connected 3D line */ -/* see other usage notes at FirstIndex3DLine6Connected() */ -/* success: return(!ERROR); failure: return(ERROR) */ - -{ /* begin NextIndex3DLine6Connected */ - - static double - t0, t1, t2; - static int - Status; - -/**/DEBUG_CHECK_NULL_POINTER(NextIndex3DLine6Connected, LineData, Status, -/**/ "Missing LineData") -/**/DEBUG_RETURN_ON_ERROR(NextIndex3DLine6Connected, Status) -/**/DEBUG_WRITE_ENTERING(NextIndex3DLine6Connected, -/**/ "About to precompute elements for drawing a 3D discrete line") - - Status = !ERROR; - LineData->Entry = LineData->Exit; - if (LineData->ModificationCode < 0) { - switch (LineData->ModificationCode) { - case -3: - (LineData->k[2])--; - break; - case -2: - (LineData->k[1])--; - break; - case -1: - (LineData->k[0])--; - break; - default: - Status = ERROR; - WRITE_ERROR(NextIndex3DLine6Connected, - "Invalid ModificationCode (shoud belong to [-3..3] - {0})") -/**/ DEBUG_WRITE_LEAVING(NextIndex3DLine6Connected, "Done") - return(Status); - } - } - else { - switch (LineData->ModificationCode) { - case 1: - (LineData->k[0])++; - break; - case 2: - (LineData->k[1])++; - break; - case 3: - (LineData->k[2])++; - break; - default: - Status = ERROR; - WRITE_ERROR(NextIndex3DLine6Connected, - "Invalid ModificationCode (shoud belong to [-3..3] - {0})") -/**/ DEBUG_WRITE_LEAVING(NextIndex3DLine6Connected, "Done") - return(Status); - } - } - switch (LineData->Quadrant) { - case 0: - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - if (t0 < t1) { - if (t0 < t2) { - LineData->Exit = t0; - LineData->ModificationCode = -1; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = -3; - } - } - else { - if (t1 < t2) { - LineData->Exit = t1; - LineData->ModificationCode = -2; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = -3; - } - } - break; - case 1: - t1 = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - if (t1 < t2) { - LineData->Exit = t1; - LineData->ModificationCode = -2; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = -3; - } - break; - case 2: - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - if (t0 < t1) { - if (t0 < t2) { - LineData->Exit = t0; - LineData->ModificationCode = 1; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = -3; - } - } - else { - if (t1 < t2) { - LineData->Exit = t1; - LineData->ModificationCode = -2; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = -3; - } - } - break; - case 3: - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t2 = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - if (t0 < t2) { - LineData->Exit = t0; - LineData->ModificationCode = -1; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = -3; - } - break; - case 4: - LineData->Exit = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - break; - case 5: - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t2 = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - if (t0 < t2) { - LineData->Exit = t0; - LineData->ModificationCode = 1; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = -3; - } - break; - case 6: - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - if (t0 < t1) { - if (t0 < t2) { - LineData->Exit = t0; - LineData->ModificationCode = -1; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = -3; - } - } - else { - if (t1 < t2) { - LineData->Exit = t1; - LineData->ModificationCode = 2; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = -3; - } - } - break; - case 7: - t1 = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - if (t1 < t2) { - LineData->Exit = t1; - LineData->ModificationCode = 2; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = -3; - } - break; - case 8: - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - if (t0 < t1) { - if (t0 < t2) { - LineData->Exit = t0; - LineData->ModificationCode = 1; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = -3; - } - } - else { - if (t1 < t2) { - LineData->Exit = t1; - LineData->ModificationCode = 2; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = -3; - } - } - break; - case 9: - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - if (t0 < t1) { - LineData->Exit = t0; - LineData->ModificationCode = -1; - } - else { - LineData->Exit = t1; - LineData->ModificationCode = -2; - } - break; - case 10: - LineData->Exit = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - break; - case 11: - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - if (t0 < t1) { - LineData->Exit = t0; - LineData->ModificationCode = 1; - } - else { - LineData->Exit = t1; - LineData->ModificationCode = -2; - } - break; - case 12: - LineData->Exit = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - break; - case 14: - LineData->Exit = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - break; - case 15: - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - if (t0 < t1) { - LineData->Exit = t0; - LineData->ModificationCode = -1; - } - else { - LineData->Exit = t1; - LineData->ModificationCode = 2; - } - break; - case 16: - LineData->Exit = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - break; - case 17: - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - if (t0 < t1) { - LineData->Exit = t0; - LineData->ModificationCode = 1; - } - else { - LineData->Exit = t1; - LineData->ModificationCode = 2; - } - break; - case 18: - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - if (t0 < t1) { - if (t0 < t2) { - LineData->Exit = t0; - LineData->ModificationCode = -1; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = 3; - } - } - else { - if (t1 < t2) { - LineData->Exit = t1; - LineData->ModificationCode = -2; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = 3; - } - } - break; - case 19: - t1 = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - if (t1 < t2) { - LineData->Exit = t1; - LineData->ModificationCode = -2; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = 3; - } - break; - case 20: - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - if (t0 < t1) { - if (t0 < t2) { - LineData->Exit = t0; - LineData->ModificationCode = 1; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = 3; - } - } - else { - if (t1 < t2) { - LineData->Exit = t1; - LineData->ModificationCode = -2; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = 3; - } - } - break; - case 21: - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t2 = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - if (t0 < t2) { - LineData->Exit = t0; - LineData->ModificationCode = -1; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = 3; - } - break; - case 22: - LineData->Exit = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - break; - case 23: - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t2 = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - if (t0 < t2) { - LineData->Exit = t0; - LineData->ModificationCode = 1; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = 3; - } - break; - case 24: - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - if (t0 < t1) { - if (t0 < t2) { - LineData->Exit = t0; - LineData->ModificationCode = -1; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = 3; - } - } - else { - if (t1 < t2) { - LineData->Exit = t1; - LineData->ModificationCode = 2; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = 3; - } - } - break; - case 25: - t1 = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - if (t1 < t2) { - LineData->Exit = t1; - LineData->ModificationCode = 2; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = 3; - } - break; - case 26: - t0 = ((double)LineData->k[0] - LineData->P[0]) / LineData->q[0]; - t1 = ((double)LineData->k[1] - LineData->P[1]) / LineData->q[1]; - t2 = ((double)LineData->k[2] - LineData->P[2]) / LineData->q[2]; - if (t0 < t1) { - if (t0 < t2) { - LineData->Exit = t0; - LineData->ModificationCode = 1; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = 3; - } - } - else { - if (t1 < t2) { - LineData->Exit = t1; - LineData->ModificationCode = 2; - } - else { - LineData->Exit = t2; - LineData->ModificationCode = 3; - } - } - break; - default: - Status = ERROR; - WRITE_ERROR(NextIndex3DLine6Connected, - "Invalid Quadrant (shoud belong to [0..26] - {13})") -/**/ DEBUG_WRITE_LEAVING(NextIndex3DLine6Connected, "Done") - return(Status); - } -/**/DEBUG_WRITE_LEAVING(NextIndex3DLine6Connected, "Done") - return(Status); -} /* end NextIndex3DLine6Connected */ - diff --git a/src/core/bilib/traceline.h b/src/core/bilib/traceline.h deleted file mode 100644 index 2a66ba8..0000000 --- a/src/core/bilib/traceline.h +++ /dev/null @@ -1,14 +0,0 @@ -/*--------------------------------------------------------------------------*/ -extern int FirstIndex3DLine6Connected - ( - struct TTraceLine - *LineData /* line description */ - ); - -/*--------------------------------------------------------------------------*/ -extern int NextIndex3DLine6Connected - ( - struct TTraceLine - *LineData /* line description */ - ); - diff --git a/src/core/bilib/tsplinebasis.h b/src/core/bilib/tsplinebasis.h deleted file mode 100644 index d6e31ad..0000000 --- a/src/core/bilib/tsplinebasis.h +++ /dev/null @@ -1,14 +0,0 @@ -#ifndef _TSPLINEBASIS -#define _TSPLINEBASIS -/*--------------------------------------------------------------------------*/ -/** Type of spline basis. - Valid types are BasicSpline, CardinalSpline, DualSpline, and - OrthogonalSpline*/ -enum TSplineBasis -{ - BasicSpline, - CardinalSpline, - DualSpline, - OrthogonalSpline -}; -#endif diff --git a/src/core/bilib/ttimestamp.h b/src/core/bilib/ttimestamp.h deleted file mode 100644 index 3c37ec8..0000000 --- a/src/core/bilib/ttimestamp.h +++ /dev/null @@ -1,11 +0,0 @@ -/*--------------------------------------------------------------------------*/ -struct TTimeStamp -{ - double SecondsSinceProcessBirth; - double SecondsSince1904_01_01_00H00; - struct tm - UTCTime; - struct tm - LocalTime; -}; - diff --git a/src/core/bilib/ttraceline.h b/src/core/bilib/ttraceline.h deleted file mode 100644 index 41c6f2a..0000000 --- a/src/core/bilib/ttraceline.h +++ /dev/null @@ -1,12 +0,0 @@ -/*--------------------------------------------------------------------------*/ -struct TTraceLine -{ - long k[3]; /* index */ - int Quadrant; /* direction of propagation [0..26] \ {13} */ - int ModificationCode; /* which component will change */ - double Entry; /* intersection of the line entering the current voxel */ - double Exit; /* intersection of the line exiting the current voxel */ - double P[3]; /* point on line */ - double q[3]; /* direction of line */ -}; - diff --git a/src/core/bilib/wavelet.cc b/src/core/bilib/wavelet.cc deleted file mode 100644 index 03f7796..0000000 --- a/src/core/bilib/wavelet.cc +++ /dev/null @@ -1,229 +0,0 @@ -/* ------------------------------------------------------------------------- */ -/* Filename : wavelet.c */ -/* Author : Daniel Sage */ -/* Email : */ -/* Organization : EPFL/DMT/IOA/BIG */ -/* Date : 15 June 1999 */ -/* Version : */ -/* Online Help : */ -/* Demo File : */ -/* Doc File : */ -/* URL : */ -/* ------------------------------------------------------------------------- */ -/* Note : This file is automatically generated */ -/* Sat 02 Sep 2000 17:20:07 GMT-07:00 */ -/* ------------------------------------------------------------------------- */ - - -#include -#include -#include -#include "configs.h" -#include "messagedisplay.h" -#include "debug.h" -#include "error.h" -#include "wavelet.h" -#include "wavelettools.h" - - -/* ------------------------------------------------------------------------- */ -/* Declaration of static procedures */ -/* ------------------------------------------------------------------------- */ -/* None */ - -/* ------------------------------------------------------------------------- */ -/* Definition of extern procedures */ -/* ------------------------------------------------------------------------- */ - - -/* ------------------------------------------------------------------------- */ -/* Function: WaveletCheck */ -/* ------------------------------------------------------------------------- */ -extern int WaveletCheck( struct TWaveletStruct *Data) -{ - - if (Data == (struct TWaveletStruct *)NULL) { - WRITE_ERROR( WaveletCheck, "Invalid data pointer"); - return(ERROR); - } - - if (Data->Input == (double *)NULL) { - WRITE_ERROR( WaveletCheck, "Input is null pointer"); - return(ERROR); - } - - if (Data->NxInput <= 1L) { - WRITE_ERROR( WaveletCheck, "Input size should be greater than 1"); - return(ERROR); - } - - if ((Data->NxInput/2L)*2L != Data->NxInput) { /* The input length should be even */ - WRITE_ERROR( WaveletCheck, "Input size should be even"); - return(ERROR); - } - - if (Data->NyInput > 1L) - if ((Data->NyInput/2L)*2L != Data->NyInput) { /* The input length should be even */ - WRITE_ERROR( WaveletCheck, "Input size should be even"); - return(ERROR); - } - - if (Data->NzInput > 1L) - if ((Data->NzInput/2L)*2L != Data->NzInput) { /* The input length should be even */ - WRITE_ERROR( WaveletCheck, "Input size should be even"); - return(ERROR); - } - if (Data->Output == (double *)NULL) { - WRITE_ERROR( WaveletCheck, "Output is null pointer"); - return(ERROR); - } - - if ( (strcmp(Data->Operation, "Analysis")) && - (strcmp(Data->Operation, "Synthesis"))) { - WRITE_ERROR( WaveletCheck, "The Operation paramater is unknown."); - return(ERROR); - } - - if ( (strcmp(Data->Filter, "B-Spline")) && - (strcmp(Data->Filter, "Cardinal Spline")) && - (strcmp(Data->Filter, "Dual Spline")) && - (strcmp(Data->Filter, "Orthogonal Spline")) && - (strcmp(Data->Filter, "Orthonormal Spline")) && - (strcmp(Data->Filter, "Fractional Orthonormal Spline"))) { - WRITE_ERROR( WaveletCheck, "The Filter paramater is unknown."); - return(ERROR); - } - - if ( (strcmp(Data->BoundaryConditions, "Periodic")) && - (strcmp(Data->BoundaryConditions, "Mirror"))) { - WRITE_ERROR( WaveletCheck,"The BoundaryConditions parameter is unknown."); - return(ERROR); - } - - if ( (strcmp(Data->Order, "0")) && - (strcmp(Data->Order, "1")) && - (strcmp(Data->Order, "3")) && - (strcmp(Data->Order, "5"))) { - WRITE_ERROR( WaveletCheck, "The Order parameter is unknown."); - return(ERROR); - } - - return(!ERROR); - return(!ERROR); - -} - -/* ------------------------------------------------------------------------- */ -/* Function: WaveletSize */ -/* ------------------------------------------------------------------------- */ -extern int WaveletSize( struct TWaveletStruct *Data) -{ - - if (Data == (struct TWaveletStruct *)NULL) { - WRITE_ERROR( WaveletSize, "Invalid data pointer"); - return(ERROR); - } - - Data->NxOutput = Data->NxInput; - Data->NyOutput = Data->NyInput; - Data->NzOutput = Data->NzInput; - return(!ERROR); - -} - -/* ------------------------------------------------------------------------- */ -/* Function: Wavelet */ -/* ------------------------------------------------------------------------- */ -extern int Wavelet( struct TWaveletStruct *Data) -{ -int Status = !ERROR; -short Order, Filter, BoundaryConditions, Operation; - - if (Data == (struct TWaveletStruct *)NULL) { - WRITE_ERROR( Wavelet, "Invalid data pointer"); - return(ERROR); - } - - /* Convert the Order from string to short format */ - Order = -1; - if (!strcmp(Data->Order, "0")) Order = 0; - if (!strcmp(Data->Order, "1")) Order = 1; - if (!strcmp(Data->Order, "3")) Order = 3; - if (!strcmp(Data->Order, "5")) Order = 5; - if (Order == -1) { - MessageDisplay("ERROR - Unexpected Order"); - return( ERROR); - } - - /* Convert the Filter form string to short format */ - Filter = -1; - if (!strcmp(Data->Filter, "B-Spline")) Filter = 1; - if (!strcmp(Data->Filter, "Cardinal Spline")) Filter = 2; - if (!strcmp(Data->Filter, "Dual Spline")) Filter = 3; - if (!strcmp(Data->Filter, "Orthogonal Spline")) Filter = 4; - if (!strcmp(Data->Filter, "Orthonormal Spline")) Filter = 6; - if (!strcmp(Data->Filter, "Fractional Orthonormal Spline")) Filter = 5; - if (Filter == -1) { - MessageDisplay("ERROR - Unexpected Filter"); - return( ERROR); - } - - /* Convert the BoundaryConditions form string to short format */ - BoundaryConditions = -1; - if (!strcmp(Data->BoundaryConditions, "Mirror")) BoundaryConditions = 1; - if (!strcmp(Data->BoundaryConditions, "Periodic")) BoundaryConditions = 2; - if (BoundaryConditions == -1) { - MessageDisplay("ERROR - Unexpected BoundaryConditions"); - return( ERROR); - } - - /* Convert the Operation form string to short format */ - Operation = -1; - if (!strcmp(Data->Operation, "Analysis")) Operation = 1; - if (!strcmp(Data->Operation, "Synthesis")) Operation = 2; - if (Operation == -1) { - MessageDisplay("ERROR - Unexpected Operation"); - return( ERROR); - } - - /* Call the wavelet operation */ - if (Operation == 1) { - WaveletSplit_3D( Data->Input, - Data->Output, - Data->NxInput, Data->NyInput, Data->NzInput, - Filter, - Order, - Data->Alpha, - BoundaryConditions, - &Status); - if ( Status == ERROR) { - MessageDisplay("ERROR - In Wavelet analysis"); - return( ERROR); - } - } - - if (Operation == 2) { - WaveletMerge_3D( Data->Input, - Data->Output, - Data->NxInput, Data->NyInput, Data->NzInput, - Filter, - Order, - Data->Alpha, - BoundaryConditions, - &Status); - if ( Status == ERROR) { - MessageDisplay("ERROR - In Wavelet synthesis"); - return( ERROR); - } - } - - return(!ERROR); - - -} - -/* ------------------------------------------------------------------------- */ -/* Definition of static procedures */ -/* ------------------------------------------------------------------------- */ -/* None */ - diff --git a/src/core/bilib/wavelet.h b/src/core/bilib/wavelet.h deleted file mode 100644 index 2e58867..0000000 --- a/src/core/bilib/wavelet.h +++ /dev/null @@ -1,71 +0,0 @@ -/* ------------------------------------------------------------------------- */ -/* Filename : wavelet.h */ -/* Author : Daniel Sage */ -/* Email : */ -/* Organization : EPFL/DMT/IOA/BIG */ -/* Date : 15 June 1999 */ -/* Version : */ -/* Online Help : */ -/* Demo File : */ -/* Doc File : */ -/* URL : */ -/* ------------------------------------------------------------------------- */ -/* Note : This file is automatically generated */ -/* Sat 02 Sep 2000 17:20:08 GMT-07:00 */ -/* ------------------------------------------------------------------------- */ - - -/* ------------------------------------------------------------------------- */ -/* Defines */ -/* ------------------------------------------------------------------------- */ -/* None */ - -/* ------------------------------------------------------------------------- */ -/* Types */ -/* ------------------------------------------------------------------------- */ - -/** Wavelet transform job parameters.*/ -struct TWaveletStruct -{ - /** Pointer to input data */ - double *Input; - /** X size of the input data */ - long NxInput; - /** Y size of the input data */ - long NyInput; - /** Z size of the input data */ - long NzInput; - /** Pointer to output data */ - double *Output; - /** X size of the input data */ - long NxOutput; - /** Y size of the input data */ - long NyOutput; - /** Z size of the input data */ - long NzOutput; - /** Valid operations: "Analysis" (DWT) or "Synthesis" (IDWT) */ - const char *Operation; - /** Valid filters: - "B-Spline", "Cardinal Spline", "Dual Spline", - "Orthogonal Spline", "Orthonormal Spline", and - "Fractional Orthonormal Spline" */ - const char *Filter; - /** Valid boundaries: "Mirror" or "Periodic" */ - const char *BoundaryConditions; - /** For spline wavelets: "0", "1", "3", "5". */ - const char *Order; - /** For fractional spline wavelets. */ - double Alpha; -}; - -/* ------------------------------------------------------------------------- */ -/* Functions */ -/* ------------------------------------------------------------------------- */ -extern int WaveletCheck(struct TWaveletStruct *Data); -extern int WaveletSize(struct TWaveletStruct *Data); -/** Do the wavelet tranformation job. - It can be either forward (DWT="Analysis") or backwards - (IDWT="Synthesis") */ -extern int Wavelet(struct TWaveletStruct *Data); - - diff --git a/src/core/bilib/waveletfilters.cc b/src/core/bilib/waveletfilters.cc deleted file mode 100644 index b31d5be..0000000 --- a/src/core/bilib/waveletfilters.cc +++ /dev/null @@ -1,1081 +0,0 @@ -/* --------------------------------------------------------------------------- - -Filename : WaveletFilters.c - -Author : Michael Unser - -Organization : EPFL, Biomedical Imaging Group - -Date : Sept 1994 - -Purpose : - - This set of ANSI C subroutines will generate the filter - coefficients (upper half) for the symmetrical wavelet - filters for the various polynomial spline wavelet - transforms described in the following papers. - -Reference: - - [1] M. Unser, A. Aldroubi and M. Eden, "A family of polynomial spline - wavelet transforms," Signal Processing, vol. 30, no. 2, pp. 141-162, - January 1993. - - [2] M. Unser, A. Aldroubi and M. Eden, "On the asymptotic convergence - of B-spline wavelets to Gabor functions," IEEE Trans. Information Theory, - vol. 38, no. 2, pp. 864-872, March 1992. - -Convention: - - h:lowpass filter (analysis or synthesis depending on sign of Order) - g:highpass filter (analysis or synthesis depending on sign of Order) - ----------------------------------------------------------------------------- */ - -/* ------------------------------------------------------------------------- */ -/* Declaration of extern procedures */ -/* ------------------------------------------------------------------------- */ -#include "configs.h" -#include -#include -#include -#include "waveletfilters.h" - -/* ------------------------------------------------------------------------- */ -/* Declaration of static procedures */ -/* ------------------------------------------------------------------------- */ -static int GetCoefBSpline(double *h,double *g, short Order); -static int GetCoefCardinalSpline(double *h,double *g, short Order); -static int GetCoefDualSpline(double *h,double *g, short Order); -static int GetCoefOrthogonalSpline(double *h, double *g, short Order); -static int GetCoefOrthonormalSpline(double *h, double *g, short Order); -static int mallat_filters(double h[], short Order); - -/* ---------------------------------------------------------------------------- - Function: WaveletFiltersGetSize - - Purpose: Extern function that return the size of the filters - - Parameters: Filter: is a short that indicates the type of the filter - Its value should be: - 1 for "B-Spline" - 2 for "Cardinal Spline" - 3 for "Dual Spline" - 4 for "Orthogonal Spline" - 5 ----- in another file: "Fractional" - 6 for "Orthonormal Spline" - Order: is the order of the spline. - Its value should be: - 1, 3 or 5 for analysis - -1, -3 or -5 for synthesis - ng: output value, give the size of the highpass filter - nh: output value, give the size of the lowpass filter - ----------------------------------------------------------------------------- */ -extern int WaveletFiltersGetSize(short Filter, short Order, long *nh, long *ng) -{ - *ng = -1; - *nh = -1; - - switch( Filter) { - case 1: /* B-Spline */ - switch (Order) { - case 0: *ng = 1; *nh = 1; break; - case -1: *ng = 3; *nh = 2; break; - case 1: *ng = 14; *nh = 14; break; - case -3: *ng = 6; *nh = 3; break; - case 3: *ng = 28; *nh = 28; break; - case -5: *ng = 9; *nh = 4; break; - case 5: *ng = 49; *nh = 42; break; - default: *ng = -1; *nh = -1; return(ERROR); - } - break; - - case 2: /* Cardinal Spline */ - switch (Order) { - case 0: *ng = 1; *nh = 1; break; - case -1: *ng = 8; *nh = 2; break; - case 1: *ng = 14; *nh = 14; break; - case -3: *ng = 14; *nh = 14; break; - case 3: *ng = 25; *nh = 25; break; - case -5: *ng = 20; *nh = 20; break; - case 5: *ng = 35; *nh = 35; break; - default: *ng = -1; *nh = -1; return(ERROR); - } - break; - - case 3: /* Dual Spline */ - switch (Order) { - case 0: *ng = 1; *nh = 1; break; - case -1: *ng = 14; *nh = 14; break; - case 1: *ng = 3; *nh = 2; break; - case -3: *ng = 28; *nh = 28; break; - case 3: *ng = 6; *nh = 3; break; - case -5: *ng = 49; *nh = 42; break; - case 5: *ng = 9; *nh = 4; break; - default: *ng = -1; *nh = -1; return(ERROR); - } - break; - - case 4: /* Orthogonal Spline */ - switch (Order) { - case 0: *ng = 1; *nh = 1; break; - case 1: *ng = 12; *nh = 12; break; - case -1: *ng = 12; *nh = 12; break; - case 3: *ng = 21; *nh = 21; break; - case -3: *ng = 21; *nh = 21; break; - case 5: *ng = 30; *nh = 30; break; - case -5: *ng = 30; *nh = 30; break; - default: *ng = -1; *nh = -1; return(ERROR); - } - break; - - case 6: /* Orthonormal Spline */ - switch (Order) { - case 0: *ng = 1; *nh = 1; break; - case 1: *ng = 14; *nh = 14; break; - case -1: *ng = 14; *nh = 14; break; - case 3: *ng = 27; *nh = 27; break; - case -3: *ng = 27; *nh = 27; break; - case 5: *ng = 42; *nh = 42; break; - case -5: *ng = 42; *nh = 42; break; - default: *ng = -1; *nh = -1; return(ERROR); - } - break; - - default: - *ng = -1; *nh = -1; - return(ERROR); - } - - return(!ERROR); -} - -/* ---------------------------------------------------------------------------- - Function: WaveletFiltersGetCoef - - Purpose: Extern function to get the coefficient of the filter - - Parameters: Filter: is a short that indicates the type of the filter - Its value should be: - 1 for "B-Spline" - 2 for "Cardinal Spline" - 3 for "Dual Spline" - 4 for "Orthogonal Spline" - Order: is the order of the spline. - Its value should be: - 1, 3 or 5 for analysis - -1, -3 or -5 for synthesis - h: output value, array of coefficient lowpass filter - g: output value, array of coefficient highpass filter - - ----------------------------------------------------------------------------- */ -extern int WaveletFiltersGetCoef(short Filter, short Order, double *h, double *g) -{ -int ret; - - ret = ERROR; - - switch( Filter) { - - case 1: /* B-Spline */ - ret = GetCoefBSpline( h, g, Order); - break; - - case 2: /* Cardinal Spline */ - ret = GetCoefCardinalSpline( h, g, Order); - break; - - case 3: /* Dual Spline */ - ret = GetCoefDualSpline( h, g, Order); - break; - - case 4: /* Orthogonal Spline */ - ret = GetCoefOrthogonalSpline( h, g, Order); - break; - - case 6: /* Orthonormal Spline */ - ret = GetCoefOrthonormalSpline( h, g, Order); - break; - - default: - ret = ERROR; - } - - return(ret); - -} - - -/* ---------------------------------------------------------------------------- - Function: GetCoefBSpline - - Purpose: Specifies B-spline wavelet filters. - Order: signed order of the spline - > 0 = > Direct transform (analysis) - < 0 = > Indirect transform (synthesis) - - Reference: M. Unser, A. Aldroubi and M. Eden, "A family of polynomial - spline wavelet transforms," Signal Processing, vol. 30, no. 2, - pp. 141-162, January 1993. - ----------------------------------------------------------------------------- */ -static int GetCoefBSpline(double *h, double *g, short Order) -{ - switch (Order) { - case 0: - h[0] = 1.; - g[0] = -1.; - break; - - case -1: - h[0] = 1.; - h[1] = 0.5; - - g[0] = 0.833333; - g[1] = -0.5; - g[2] = 0.0833333; - break; - - case 1: - h[0] = 0.683013; - h[1] = 0.316987; - h[2] = -0.116025; - h[3] = -0.0849365; - h[4] = 0.0310889; - h[5] = 0.0227587; - h[6] = -0.00833025; - h[7] = -0.00609817; - h[8] = 0.00223208; - h[9] = 0.001634; - h[10] = -0.000598085; - h[11] = -0.000437829; - h[12] = 0.000160256; - h[13] = 0.000117316; - - g[0] = 0.866025; - g[1] = -0.316987; - g[2] = -0.232051; - g[3] = 0.0849365; - g[4] = 0.0621778; - g[5] = -0.0227587; - g[6] = -0.0166605; - g[7] = 0.00609817; - g[8] = 0.00446417; - g[9] = -0.001634; - g[10] = -0.00119617; - g[11] = 0.000437829; - g[12] = 0.000320513; - g[13] = -0.000117316; - break; - - case -3: - h[0] = 0.75; - h[1] = 0.5; - h[2] = 0.125; - - g[0] = 0.601786; - g[1] = -0.458383; - g[2] = 0.196032; - g[3] = -0.0415923; - g[4] = 0.0030754; - g[5] = -0.0000248016; - break; - - case 3: - h[0] = 0.893163; - h[1] = 0.400681; - h[2] = -0.282212; - h[3] = -0.232925; - h[4] = 0.129084; - h[5] = 0.126457; - h[6] = -0.0664208; - h[7] = -0.0679036; - h[8] = 0.0352261; - h[9] = 0.0363736; - h[10] = -0.0188157; - h[11] = -0.0194733; - h[12] = 0.0100667; - h[13] = 0.0104241; - h[14] = -0.00538793; - h[15] = -0.00557984; - h[16] = 0.00288398; - h[17] = 0.00298678; - h[18] = -0.00154373; - h[19] = -0.00159877; - h[20] = 0.000826327; - h[21] = 0.000855789; - h[22] = -0.000442316; - h[23] = -0.000458087; - h[24] = 0.000236763; - h[25] = 0.000245205; - h[26] = -0.000126735; - h[27] = -0.000131254; - - g[0] = 1.47539; - g[1] = -0.468423; - g[2] = -0.742098; - g[3] = 0.345771; - g[4] = 0.389746; - g[5] = -0.196794; - g[6] = -0.207691; - g[7] = 0.106776; - g[8] = 0.111058; - g[9] = -0.057331; - g[10] = -0.0594334; - g[11] = 0.0307097; - g[12] = 0.0318118; - g[13] = -0.0164409; - g[14] = -0.017028; - g[15] = 0.00880084; - g[16] = 0.00911475; - g[17] = -0.00471096; - g[18] = -0.00487894; - g[19] = 0.00252169; - g[20] = 0.0026116; - g[21] = -0.00134981; - g[22] = -0.00139794; - g[23] = 0.000722527; - g[24] = 0.000748289; - g[25] = -0.000386755; - g[26] = -0.000400545; - g[27] = 0.000207022; - break; - - case -5: - h[0] = 0.625; - h[1] = 0.46875; - h[2] = 0.1875; - h[3] = 0.03125; - - g[0] = 0.495856; - g[1] = -0.41119; - g[2] = 0.232144; - g[3] = -0.0863425; - g[4] = 0.0197985; - g[5] = -0.00246597; - g[6] = 0.000129072; - g[7] = 1.59864E-6; - g[8] = 7.82878E-10; - break; - - case 5: - h[0] = 1.24685; - h[1] = 0.488133; - h[2] = -0.563928; - h[3] = -0.406943; - h[4] = 0.301441; - h[5] = 0.282812; - h[6] = -0.180243; - h[7] = -0.189972; - h[8] = 0.114031; - h[9] = 0.126358; - h[10] = -0.0740051; - h[11] = -0.0837508; - h[12] = 0.0485563; - h[13] = 0.0554339; - h[14] = -0.0320051; - h[15] = -0.0366707; - h[16] = 0.0211357; - h[17] = 0.024253; - h[18] = -0.0139686; - h[19] = -0.0160387; - h[20] = 0.00923489; - h[21] = 0.0106061; - h[22] = -0.00610615; - h[23] = -0.00701356; - h[24] = 0.00403764; - h[25] = 0.00463785; - h[26] = -0.00266991; - h[27] = -0.00306686; - h[28] = 0.00176551; - h[29] = 0.00202801; - h[30] = -0.00116747; - h[31] = -0.00134105; - h[32] = 0.000772008; - h[33] = 0.000886792; - h[34] = -0.000510503; - h[35] = -0.000586404; - h[36] = 0.00033758; - h[37] = 0.000387766; - h[38] = -0.000223233; - h[39] = -0.000256412; - h[40] = 0.000147621; - h[41] = 0.000169549; - - g[0] = 2.86904; - g[1] = -0.692385; - g[2] = -1.9481; - g[3] = 0.812757; - g[4] = 1.25952; - g[5] = -0.636672; - g[6] = -0.821107; - g[7] = 0.448233; - g[8] = 0.539409; - g[9] = -0.30383; - g[10] = -0.355691; - g[11] = 0.202936; - g[12] = 0.234931; - g[13] = -0.134746; - g[14] = -0.155277; - g[15] = 0.0892529; - g[16] = 0.102659; - g[17] = -0.0590607; - g[18] = -0.0678791; - g[19] = 0.039066; - g[20] = 0.0448846; - g[21] = -0.025836; - g[22] = -0.0296803; - g[23] = 0.0170853; - g[24] = 0.0196264; - g[25] = -0.0112982; - g[26] = -0.0129783; - g[27] = 0.00747115; - g[28] = 0.00858208; - g[29] = -0.00494043; - g[30] = -0.00567504; - g[31] = 0.00326694; - g[32] = 0.00375272; - g[33] = -0.00216032; - g[34] = -0.00248155; - g[35] = 0.00142854; - g[36] = 0.00164097; - g[37] = -0.000944637; - g[38] = -0.00108513; - g[39] = 0.000624645; - g[40] = 0.000717581; - g[41] = -0.000413039; - g[42] = -0.000474542; - g[43] = 0.000273103; - g[44] = 0.000313844; - g[45] = -0.000180554; - g[46] = -0.000207602; - g[47] = 0.000119335; - g[48] = 0.000137384; - break; - - default: - h[0] = 1.; - g[0] = -1.; - return(ERROR); - } - - return(!ERROR); -} - -/* ---------------------------------------------------------------------------- - Function: GetCoefCardinalSpline - - Purpose: Specifies C-spline (or cardinal) wavelet filters. - Order: signed order of the spline - > 0 = > Direct transform (analysis) - < 0 = > Indirect transform (synthesis) ----------------------------------------------------------------------------- */ -static int GetCoefCardinalSpline(double *h, double *g, short Order) -{ - switch (Order) { - case 0: - h[0] = 1.; - g[0] = -1.; - break; - - case -1: - h[0] = 1.; - h[1] = 0.5; - - g[0] = 1.; - g[1] = -0.55051; - g[2] = 0; - g[3] = 0.0556128; - g[4] = 0; - g[5] = -0.00561804; - g[6] = 0; - g[7] = 0.000567537; - break; - - case 1: - h[0] = 0.683013; - h[1] = 0.316987; - h[2] = -0.116025; - h[3] = -0.0849365; - h[4] = 0.0310889; - h[5] = 0.0227587; - h[6] = -0.00833025; - h[7] = -0.00609817; - h[8] = 0.00223208; - h[9] = 0.001634; - h[10] = -0.000598085; - h[11] = -0.000437829; - h[12] = 0.000160256; - h[13] = 0.000117316; - - g[0] = 0.683013; - g[1] = -0.283494; - g[2] = -0.116025; - g[3] = 0.0424682; - g[4] = 0.0310889; - g[5] = -0.0113793; - g[6] = -0.00833025; - g[7] = 0.00304908; - g[8] = 0.00223208; - g[9] = -0.000816999; - g[10] = -0.000598085; - g[11] = 0.000218914; - g[12] = 0.000160256; - g[13] = -0.0000586579; - break; - - case -3: - h[0] = 1.; - h[1] = 0.600481; - h[2] = 0; - h[3] = -0.127405; - h[4] = 0; - h[5] = 0.034138; - h[6] = 0; - h[7] = -0.00914725; - h[8] = 0; - h[9] = 0.002451; - h[10] = 0; - h[11] = -0.000656743; - h[12] = 0; - h[13] = 0.000175974; - - g[0] = 1.; - g[1] = -0.603284; - g[2] = 0; - g[3] = 0.132403; - g[4] = 0; - g[5] = -0.037129; - g[6] = 0; - g[7] = 0.0102285; - g[8] = 0; - g[9] = -0.0028318; - g[10] = 0; - g[11] = 0.000782945; - g[12] = 0; - g[13] = -0.000216549; - break; - - case 3: - h[0] = 0.594902; - h[1] = 0.31431; - h[2] = -0.0816632; - h[3] = -0.0942586; - h[4] = 0.0541374; - h[5] = 0.0454105; - h[6] = -0.0307778; - h[7] = -0.0236728; - h[8] = 0.0166858; - h[9] = 0.0125975; - h[10] = -0.00895838; - h[11] = -0.00673388; - h[12] = 0.00479847; - h[13] = 0.00360339; - h[14] = -0.00256892; - h[15] = -0.00192868; - h[16] = 0.00137514; - h[17] = 0.00103237; - h[18] = -0.000736093; - h[19] = -0.000552606; - h[20] = 0.000394017; - h[21] = 0.000295799; - h[22] = -0.00021091; - h[23] = -0.000158335; - h[24] = 0.000112896; - - g[0] = 0.594902; - g[1] = -0.312645; - g[2] = -0.0816632; - g[3] = 0.0911067; - g[4] = 0.0541374; - g[5] = -0.0431604; - g[6] = -0.0307778; - g[7] = 0.0224984; - g[8] = 0.0166858; - g[9] = -0.0119658; - g[10] = -0.00895838; - g[11] = 0.00639584; - g[12] = 0.00479847; - g[13] = -0.00342242; - g[14] = -0.00256892; - g[15] = 0.00183182; - g[16] = 0.00137514; - g[17] = -0.000980518; - g[18] = -0.000736093; - g[19] = 0.00052485; - g[20] = 0.000394017; - g[21] = -0.000280942; - g[22] = -0.00021091; - g[23] = 0.000150382; - g[24] = 0.000112896; - break; - - case -5: - h[0] = 1.; - h[1] = 0.619879; - h[2] = 0; - h[3] = -0.167965; - h[4] = 0; - h[5] = 0.0686374; - h[6] = 0; - h[7] = -0.0293948; - h[8] = 0; - h[9] = 0.0126498; - h[10] = 0; - h[11] = -0.00544641; - h[12] = 0; - h[13] = 0.00234508; - h[14] = 0; - h[15] = -0.00100973; - h[16] = 0; - h[17] = 0.000434766; - h[18] = 0; - h[19] = -0.000187199; - - g[0] = 1.; - g[1] = -0.620075; - g[2] = 0; - g[3] = 0.16838; - g[4] = 0; - g[5] = -0.0689961; - g[6] = 0; - g[7] = 0.029608; - g[8] = 0; - g[9] = -0.0127622; - g[10] = 0; - g[11] = 0.00550431; - g[12] = 0; - g[13] = -0.00237399; - g[14] = 0; - g[15] = 0.00102392; - g[16] = 0; - g[17] = -0.000441621; - g[18] = 0; - g[19] = 0.000190474; - break; - - case 5: - h[0] = 0.564388; - h[1] = 0.316168; - h[2] = -0.0597634; - h[3] = -0.0998708; - h[4] = 0.0484525; - h[5] = 0.0539099; - h[6] = -0.0355614; - h[7] = -0.033052; - h[8] = 0.0246347; - h[9] = 0.0212024; - h[10] = -0.0166097; - h[11] = -0.0138474; - h[12] = 0.0110719; - h[13] = 0.00911006; - h[14] = -0.00734567; - h[15] = -0.0060115; - h[16] = 0.00486404; - h[17] = 0.00397176; - h[18] = -0.00321822; - h[19] = -0.00262545; - h[20] = 0.00212859; - h[21] = 0.00173587; - h[22] = -0.0014077; - h[23] = -0.0011478; - h[24] = 0.000930899; - h[25] = 0.000758982; - h[26] = -0.000615582; - h[27] = -0.000501884; - h[28] = 0.000407066; - h[29] = 0.000331877; - h[30] = -0.00026918; - h[31] = -0.000219459; - h[32] = 0.000178; - h[33] = 0.00014512; - h[34] = -0.000117706; - - g[0] = 0.564388; - g[1] = -0.316056; - g[2] = -0.0597634; - g[3] = 0.0996253; - g[4] = 0.0484525; - g[5] = -0.0536786; - g[6] = -0.0355614; - g[7] = 0.0328901; - g[8] = 0.0246347; - g[9] = -0.0210957; - g[10] = -0.0166097; - g[11] = 0.0137766; - g[12] = 0.0110719; - g[13] = -0.00906331; - g[14] = -0.00734567; - g[15] = 0.00598058; - g[16] = 0.00486404; - g[17] = -0.00395131; - g[18] = -0.00321822; - g[19] = 0.00261193; - g[20] = 0.00212859; - g[21] = -0.00172693; - g[22] = -0.0014077; - g[23] = 0.00114189; - g[24] = 0.000930899; - g[25] = -0.000755072; - g[26] = -0.000615582; - g[27] = 0.000499299; - g[28] = 0.000407066; - g[29] = -0.000330168; - g[30] = -0.00026918; - g[31] = 0.000218328; - g[32] = 0.000178; - g[33] = -0.000144373; - g[34] = -0.000117706; - break; - - default: - h[0] = 1.; - g[0] = -1.; - return(ERROR); - } - - return(!ERROR); -} - -/* ---------------------------------------------------------------------------- - Function: GetCoefDualSpline - - Purpose: Specifies Dual spline wavelet filters. - Order:order of the spline - ----------------------------------------------------------------------------- */ -static int GetCoefDualSpline(double *h, double *g, short Order) -{ - return( GetCoefBSpline(h, g, (short)(-Order))); -} - -/* ---------------------------------------------------------------------------- - Function: GetCoefOrthogonalSpline - - Purpose: Specifies O-spline (orthogonal or Battle-Lemarie) wavelet filters. - Order:order of the spline ----------------------------------------------------------------------------- */ -static int GetCoefOrthogonalSpline(double *h, double *g, short Order) -{ -short i; -long nh[1], ng[1]; - - if ( mallat_filters(h, (short)(abs(Order))) == ERROR) - return(ERROR); - - if ( WaveletFiltersGetSize( 4, Order, nh, ng) == ERROR) - return(ERROR); - - for (i = 0; i<*nh; i++) { - if (Order<0) h[i] = 2.*h[i]; - g[i] = pow(-1.,(double)i)*h[i]; - } - if (*nh == 1) g[0] = -1.; - - return(!ERROR); - } - - /* ---------------------------------------------------------------------------- - Function: mallat_filters - - Purpose: Initializes filter array for orthogonal spline - pyramid and wavelet transform. - - Michael Unser / BEIP MAY-92 ----------------------------------------------------------------------------- */ -static int mallat_filters(double h[], short Order) -{ - switch (Order) { - case 0: - h[0] = 1.; - break; - - case 1: - h[0] = 0.578163; - h[1] = 0.280931; - h[2] = -0.0488618; - h[3] = -0.0367309; - h[4] = 0.0120003; - h[5] = 0.00706442; - h[6] = -0.00274588; - h[7] = -0.00155701; - h[8] = 0.000652922; - h[9] = 0.000361781; - h[10] = -0.000158601; - h[11] = -0.0000867523; - break; - - case 3: - h[0] = 0.541736; - h[1] = 0.30683; - h[2] = -0.035498; - h[3] = -0.0778079; - h[4] = 0.0226846; - h[5] = 0.0297468; - h[6] = -0.0121455; - h[7] = -0.0127154; - h[8] = 0.00614143; - h[9] = 0.00579932; - h[10] = -0.00307863; - h[11] = -0.00274529; - h[12] = 0.00154624; - h[13] = 0.00133086; - h[14] = -0.000780468; - h[15] = -0.00065562; - h[16] = 0.000395946; - h[17] = 0.000326749; - h[18] = -0.000201818; - h[19] = -0.000164264; - h[20] = 0.000103307; - break; - - case 5: - h[0] = 0.528374; - h[1] = 0.312869; - h[2] = -0.0261771; - h[3] = -0.0914068; - h[4] = 0.0208414; - h[5] = 0.0433544; - h[6] = -0.0148537; - h[7] = -0.0229951; - h[8] = 0.00990635; - h[9] = 0.0128754; - h[10] = -0.00639886; - h[11] = -0.00746848; - h[12] = 0.00407882; - h[13] = 0.00444002; - h[14] = -0.00258816; - h[15] = -0.00268646; - h[16] = 0.00164132; - h[17] = 0.00164659; - h[18] = -0.00104207; - h[19] = -0.00101912; - h[20] = 0.000662836; - h[21] = 0.000635563; - h[22] = -0.000422485; - h[23] = -0.000398759; - h[24] = 0.000269842; - h[25] = 0.000251419; - h[26] = -0.000172685; - h[27] = -0.000159168; - h[28] = 0.000110709; - h[29] = 0.000101113; - break; - - default: - return(ERROR); - break; - } - - return(!ERROR); -} - - -/* ---------------------------------------------------------------------------- - Function: GetCoefOrthonormalSpline - - Purpose: Specifies Orthonormal-spline wavelet filters. - Order: signed order of the spline - > 0 = > Direct transform (analysis) - < 0 = > Indirect transform (synthesis) - ----------------------------------------------------------------------------- */ -static int GetCoefOrthonormalSpline(double *h, double *g, short Order) -{ - - switch (Order) { - case 0: - h[0] = 1.4142; - g[0] = -1.4142; - break; - - case -1: - case 1: - h[0]=0.81763; - h[1]=0.39729; - h[2]=-0.069099; - h[3]=-0.051944; - h[4]=0.016971; - h[5]=0.0099904; - h[6]=-0.0038832; - h[7]=-0.0022019; - h[8]=0.00092335; - h[9]=0.00051162; - h[10]=-0.00022429; - h[11]=-0.00012268; - h[12]=5.2436e-05; - h[13]=3.2179e-05; - - g[0]=0.81763; - g[1]=-0.39729; - g[2]=-0.069099; - g[3]=0.051944; - g[4]=0.016971; - g[5]=-0.0099904; - g[6]=-0.0038832; - g[7]=0.0022019; - g[8]=0.00092335; - g[9]=-0.00051162; - g[10]=-0.00022429; - g[11]=0.00012268; - g[12]=5.2436e-05; - g[13]=-3.2179e-05; - break; - - case -3: - case 3: - h[0]=0.76607; - h[1]=0.43389; - h[2]=-0.050198; - h[3]=-0.11003; - h[4]=0.032079; - h[5]=0.042065; - h[6]=-0.017175; - h[7]=-0.017981; - h[8]=0.0086847; - h[9]=0.0082009; - h[10]=-0.0043535; - h[11]=-0.0038821; - h[12]=0.0021866; - h[13]=0.001882; - h[14]=-0.0011037; - h[15]=-0.00092713; - h[16]=0.0005599; - h[17]=0.00046208; - h[18]=-0.00028536; - h[19]=-0.00023233; - h[20]=0.00014603; - h[21]=0.00011762; - h[22]=-7.4993e-05; - h[23]=-6.1546e-05; - h[24]=3.8497e-05; - h[25]=4.7661e-05; - h[26]=1.2733e-05; - - g[0]=-0.76607; - g[1]=0.43389; - g[2]=0.050198; - g[3]=-0.11003; - g[4]=-0.032079; - g[5]=0.042065; - g[6]=0.017175; - g[7]=-0.017981; - g[8]=-0.0086847; - g[9]=0.0082009; - g[10]=0.0043535; - g[11]=-0.0038821; - g[12]=-0.0021866; - g[13]=0.001882; - g[14]=0.0011037; - g[15]=-0.00092713; - g[16]=-0.0005599; - g[17]=0.00046208; - g[18]=0.00028536; - g[19]=-0.00023233; - g[20]=-0.00014603; - g[21]=0.00011762; - g[22]=7.4993e-05; - g[23]=-6.1546e-05; - g[24]=-3.8497e-05; - g[25]=4.7661e-05; - g[26]=-1.2733e-05; - break; - - case -5: - case 5: - h[0]=0.74729; - h[1]=0.4425; - h[2]=-0.037023; - h[3]=-0.12928; - h[4]=0.029477; - h[5]=0.061317; - h[6]=-0.021008; - h[7]=-0.032523; - h[8]=0.014011; - h[9]=0.01821; - h[10]=-0.0090501; - h[11]=-0.010563; - h[12]=0.0057688; - h[13]=0.0062796; - h[14]=-0.0036605; - h[15]=-0.0037995; - h[16]=0.0023214; - h[17]=0.0023288; - h[18]=-0.0014738; - h[19]=-0.0014414; - h[20]=0.00093747; - h[21]=0.00089889; - h[22]=-0.00059753; - h[23]=-0.00056398; - h[24]=0.00038165; - h[25]=0.00035559; - h[26]=-0.00024423; - h[27]=-0.00022512; - h[28]=0.00015658; - h[29]=0.00014301; - h[30]=-0.00010055; - h[31]=-9.1113e-05; - h[32]=6.4669e-05; - h[33]=5.8198e-05; - h[34]=-4.1649e-05; - h[35]=-3.7256e-05; - h[36]=2.729e-05; - h[37]=2.458e-05; - h[38]=-2.2593e-05; - h[39]=-3.5791e-05; - h[40]=-1.7098e-05; - h[41]=-2.9619e-06; - - g[0]=0.74729; - g[1]=-0.4425; - g[2]=-0.037023; - g[3]=0.12928; - g[4]=0.029477; - g[5]=-0.061317; - g[6]=-0.021008; - g[7]=0.032523; - g[8]=0.014011; - g[9]=-0.01821; - g[10]=-0.0090501; - g[11]=0.010563; - g[12]=0.0057688; - g[13]=-0.0062796; - g[14]=-0.0036605; - g[15]=0.0037995; - g[16]=0.0023214; - g[17]=-0.0023288; - g[18]=-0.0014738; - g[20]=0.00093747; - g[21]=-0.00089889; - g[22]=-0.00059753; - g[23]=0.00056398; - g[24]=0.00038165; - g[25]=-0.00035559; - g[26]=-0.00024423; - g[27]=0.00022512; - g[28]=0.00015658; - g[29]=-0.00014301; - g[30]=-0.00010055; - g[31]=9.1113e-05; - g[32]=6.4669e-05; - g[33]=-5.8198e-05; - g[34]=-4.1649e-05; - g[35]=3.7256e-05; - g[36]=2.729e-05; - g[37]=-2.458e-05; - g[38]=-2.2593e-05; - g[39]=3.5791e-05; - g[40]=-1.7098e-05; - g[41]=2.9619e-06; - break; - - default: - h[0] = 1.4142; - g[0] = -1.4142; - return(ERROR); - } - - return(!ERROR); -} diff --git a/src/core/bilib/waveletfilters.h b/src/core/bilib/waveletfilters.h deleted file mode 100644 index 2cea6dd..0000000 --- a/src/core/bilib/waveletfilters.h +++ /dev/null @@ -1,11 +0,0 @@ -/* ---------------------------------------------------------------------------- - Function: WaveletFilters.h - - Purpose: Header file for WaveletFilter.c ----------------------------------------------------------------------------- */ - -extern int WaveletFiltersGetSize(short Filter, short Order, long *nh, long *ng); -extern int WaveletFiltersGetCoef(short Filter, short Order, double *h, double *g); -extern int WaveletFiltersGetCoef_Fact(double Alpha, double *h, double *g); - - diff --git a/src/core/bilib/waveletfiltersfract.cc b/src/core/bilib/waveletfiltersfract.cc deleted file mode 100644 index 78396b4..0000000 --- a/src/core/bilib/waveletfiltersfract.cc +++ /dev/null @@ -1,486 +0,0 @@ -/* --------------------------------------------------------------------------- - -Filename : WaveletFilters_fract.c - -Author : Olivier Saudan - -Organization : EPFL, Biomedical Imaging Group - -Date : June 1999 - ----------------------------------------------------------------------------- */ - -#include -#include -#include -#include -#include - -#include "configs.h" -#include "error.h" -#include "waveletfiltersfract.h" -#include "messagedisplay.h" - -#define EPSILON 0.000001 - -#define ERR_MEM -1 - -static void Convolve121( double R[] , int l ); -static int FFT( double R[] , double I[] , int m , int* errcode ); -static double sinc( double x ); -static void SampleTau( double alpha , double dzeta , int N , double R[] , int nbsamples ); -static double EstimateSum( double f , double beta , int N ); -static int getFilterSize(double alpha); -static int getSumTerms(double alpha); - -/* ---------------------------------------------------------------------------- - Function: WaveletFiltersGetSize_Fract - - empirical relation ----------------------------------------------------------------------------- */ -extern int WaveletFiltersGetSize_Fract(double Alpha, long *nh, long *ng) -{ - -/* *ng=64L; - *nh=64L; - -*/ - *ng=*nh=getFilterSize(fabs(Alpha))+1; - return !ERROR; -} - - -/* ---------------------------------------------------------------------------- - Function: WaveletFiltersGetCoef_Fract - - Purpose: Extern function to get the coefficient of the filter, - Special routine for Fractional Orthonormal Spline - - Parameters: - h: output value, array of coefficient lowpass filter - g: output value, array of coefficient highpass filter - - ----------------------------------------------------------------------------- */ - -extern int WaveletFiltersGetCoef_Fract(double Alpha, double *h, double *g) -{ - static double *R, *I; - double dzeta,mulfact; - int i,n,m,sumTerms,size; - unsigned long t; - - Alpha=fabs(Alpha); - size=getFilterSize(Alpha); - m=(int)ceil(log((double)size)/log(2.0))+1; - n=1<=1.) - dzeta=Alpha-1.; - else - dzeta=Alpha+1.; - - - SampleTau( Alpha , dzeta , sumTerms , R , n ); - - for(i=0;idzeta) - { /* Must convolve with (1+z)^2 */ - R[size]=0; - Convolve121( R , size+1 ); - } - - mulfact=1./sqrt(2.0)/(double)n; - - for(i=0;i - BIG/IOA/DMT/EPFL - - History: - March 23, 1999 - Ver 1.0 : [OSA] Created, FFT() - -******************************************************************************/ - -/*----------------------------------------------------------------------------- - - FFT - Computes the FFT of a vector with 2^m points - Source: "Signaux et systemes", F.Pellandini, EPFL - - Author: Olivier Saudan - - Parameters: - R[] : real part of input and output vector - I[] : imaginary part of input and output vector - m : 2^m=number of points in vector - errcode : if not null, the error code is put there - - Returns : error code - - Error codes: - !ERROR (0): no error - ERR_MEM (-1): caanot allocate memory -*/ -int FFT( double R[] , double I[] , int m , int* errcode ) -{ - double* WnR, *WnI; /* WnR[k]+i*WnI[k] = exp(i*2*Pi/n)^k */ - double tr,ti; /* temporary complex value */ - int n; /* number of points (2^m) */ - int i,j,k,stepsize,shifter; - int i_j,i_j_s; /* i+j, i+j+stepsize */ - - n=1<>1; - while(k<=j) - { - j-=k; - k/=2; - } - j+=k; - } - - /* Perform the FFT */ - for(stepsize=1,shifter=m-1;stepsize - BIG/IOA/DMT/EPFL - - History: - March 23, 1999 - Ver 1.0 : [OSA] Created, EstimateSum(), sinc(), - SampleTau() - -******************************************************************************/ -/*----------------------------------------------------------------------------- - - EstimateSum - Estimates the infinite sum - - inf - ------- - \ 1 1 - \ --------- + --------- - / beta beta - / (k+f) (k-f) - ------- - k=1 - - Author: Olivier Saudan - - Parameters: - f: (-1,1) - beta: 2*alpha+2 - N: number of terms used to compute the sum. Time = O(N) - - Returns : the estimated value of the sum - - Note: Mathematically, the sum is divided into two sums. Each sum is - estimated using a correcting factor to speed up convergence. - The two correcting factors have been chosen so that the error - is minimal for f=[0,0.5] - -*/ -static double EstimateSum( double f , double beta , int N ) -{ - double sum; - int k; - - /* These are the two correcting factors */ - sum = 1./( (beta-1.)*pow( (double)N+f , beta-1. ) ) + - 1./( (beta-1.)*pow( (double)(N+1)-f , beta-1. ) ) ; - - for(k=1;k<=N;k++) - sum += 1./pow((double)k+f,beta) + 1./pow((double)k-f,beta); - - return sum; -} - -/*----------------------------------------------------------------------------- - - sinc - Computes sin(x)/x, calculating the limit when x is small - - Author: Olivier Saudan - - Note: When x is small, sin(x)/x -> 1 - 1/6 x^2 + O(x^4) - For x - - Parameters: - alpha : order of the fractional B-spline - dzeta : order of the h*(w) filter (usually alpha-1) - N : number of terms in sum (usually 20) - R[] : table where samples are stored (length of nbsamples) - nbsamples : number of samples - - Returns : - - - Notes: Tau(f) = Omega(alpha,f) * 2 * Khi(f)^dzeta - - __________ | -iw | dzeta - / APhi(f) | | 1 + e | - Tau(f) = _ / --------- 2 |-----------| - \/ APhi(2f) | 2 | - - \______ _______/ \_____ _____/ - \/ \/ - Omega(f) Khi(f) - - Note that if dzeta=alpha+1, Tau is the Fourier transform of the wavelet - We usually "remove" Khi^2 from it (this means dzeta=alpha-1) and convolve - the inverse fourier transform of Tau with {1/4;1/2;1/4} -*/ -void SampleTau( double alpha , double dzeta , int N , double R[] , int nbsamples ) -{ - double beta,PiFact,f; - int i; - - /* !!! We use the fact that: - - APhi(0)=1 - - APhi(f+k)=APhi(f) (1-Periodic) - - APhi(f)=APhi(-f) (Even function) - !!! */ - - /* These will be used often */ - beta=2.*alpha+2.; - PiFact=pow(PI,-beta); - - /* We first fill R[i] with APhi(f=i/nbsamples) */ - R[0] = 1.; /* The first is easy... */ - - /* We use symmetry, that is APhi(1-f)=APhi(f), that is - R[nbsamples-i] = R[i] for i=[1,nbsamples-1] */ - for(i=1;i<=nbsamples/2;i++) - { - f=(double)i/(double)nbsamples; - R[nbsamples-i] = R[i] = - pow( fabs(sinc(PI*f)) , beta ) + - pow( fabs(sin(PI*f)) , beta ) * PiFact * - EstimateSum(f,beta,N) ; - } - - /* Now we calculate sqrt(APhi(f)/APhi(2f)) for f=[0,0.5), that is - sqrt(R[i]/R[2*i]) for i=0..nbsamples/2-1. NB: For i=0, the result is 1 ! */ - for(i=1;i - - Parameters: - R[] : real part of filters (input and output) - l : length of convolution = (n/2)+1 if n=size of FFT result - - Note: - The convolution has been written to operate on the half of the filter - If you want to get the whole filter (symmetry), you have to copy, using - for example this code: - - for(i=1;i y1[nx/2] & y2[nx/2] - WaveletMerge_3D() y1[ny] & y2[ny] -> x[2*ny] - -Convention : - - v[nv] : lowpass filter, array of coefficients - w[nw] : highpass filter, array of coefficients - ----------------------------------------------------------------------------- */ - - -/* ------------------------------------------------------------------------- */ -/* Declaration of extern procedures */ -/* ------------------------------------------------------------------------- */ -#include -#include -#include -#include "configs.h" -#include "messagedisplay.h" -#include "minmax.h" -#include "getputd.h" -#include "getput.h" - -#include "wavelettools.h" -#include "waveletfilters.h" -#include "waveletfiltersfract.h" - -/* ------------------------------------------------------------------------- */ -/* Declaration of static procedures */ -/* ------------------------------------------------------------------------- */ -static int WaveletSplit_1D( - double x[], long nx, - double y1[], double y2[], long *ny, - double v[], long nv, - double w[], long nw, - short BoundaryConditions); - -static int WaveletMerge_1D( - double y1[],double y2[],long ny, - double x[],long *nx, - double v[],long nv, - double w[],long nw, - short BoundaryConditions); - -static void WaveletSplit_1DMirror( - double x[], long nx, - double y1[],double y2[], long *ny, - double v[], long nv, - double w[], long nw); - -static void WaveletSplit_1DPeriodic( - double x[], long nx, - double y1[],double y2[], long *ny, - double v[], long nv, - double w[], long nw); - -static void WaveletMerge_1DMirror( - double y1[],double y2[],long ny, - double x[],long *nx, - double v[],long nv, - double w[],long nw); - -static void WaveletMerge_1DPeriodic( - double y1[],double y2[],long ny, - double x[],long *nx, - double v[],long nv, - double w[],long nw); - -/* ---------------------------------------------------------------------------- - - Function: WaveletSplit_3D - - Purpose: Two channel filtering and down-sampling for 3D real signals. - Input[nz][ny][nx] -> output[nz][ny][nx] - The output is build with four sectors in the classical way to - show the wavelet transform - - Author: Daniel Sage, EPFL, Biomedical Imaging Group - ----------------------------------------------------------------------------- */ -extern int WaveletSplit_3D( - double *Input, - double *Output, - long nx, long ny, long nz, - short Filter, - short Order, - double Alpha, - short BoundaryConditions, - int *Status) -{ -long kx, ky, kz, nmax, nout, k, i, j, index, jindex, nx2, ny2, nz2, nxny, - idxbase; -double *FilterLowpass, *FilterHighpass; -long NbLowpass[1], NbHighpass[1]; -double *Low, *High, *LowLow, *LowHigh, *HighLow, *HighHigh; -double *x, *y1, *y2; - - nmax = MaxLong(MaxLong(nx, ny), nz); - nx2 = MaxLong(nx / 2L, 1L); - ny2 = MaxLong(ny / 2L, 1L); - nz2 = MaxLong(nz / 2L, 1L); - nxny = nx*ny; - - /* Get the size of the filter */ - if ( Filter != 5) { - if ( WaveletFiltersGetSize(Filter, Order, NbLowpass, NbHighpass) == ERROR) { - MessageDisplay("ERROR - Impossible to get the size of the filter"); - *Status = ERROR; - return( ERROR); - } - } - else { - if ( WaveletFiltersGetSize_Fract(Alpha, NbLowpass, NbHighpass) == ERROR) { - MessageDisplay("ERROR - Impossible to get the size of the filter"); - *Status = ERROR; - return( ERROR); - } - } - - /* Allocate the memory for the highpass filter */ - AllocateLineDouble( &FilterHighpass, *NbHighpass, Status); - if (*Status == ERROR) { - MessageDisplay( "ERROR - Unable to perform allocation"); - *Status = ERROR; - return( ERROR); - } - - /* Allocate the memory for the lowpass filter */ - AllocateLineDouble( &FilterLowpass, *NbLowpass, Status); - if (*Status == ERROR) { - MessageDisplay( "ERROR - Unable to perform allocation 22"); - FreeLineDouble(&FilterHighpass); - *Status = ERROR; - return( ERROR); - } - - /* Get the coefficient of the filters */ - if ( Filter != 5) { - if ( WaveletFiltersGetCoef( Filter, Order, FilterLowpass, FilterHighpass) == ERROR) { - MessageDisplay("ERROR - Impossible to get the coefficient of the filter"); - *Status = ERROR; - return( ERROR); - } - } - else { - if ( WaveletFiltersGetCoef_Fract( Alpha, FilterLowpass, FilterHighpass) == ERROR) { - MessageDisplay("ERROR - Impossible to get the coefficient of the filter"); - *Status = ERROR; - return( ERROR); - } - } - - /* Allocate the temporary vector */ - AllocateVolumeDouble( &Low, nx, ny, nz, Status); - if (*Status == ERROR) { - MessageDisplay( "ERROR - Unable to perform allocation"); - FreeLineDouble(&FilterHighpass); - FreeLineDouble(&FilterLowpass); - return( ERROR); - } - - AllocateVolumeDouble( &High, nx, ny, nz, Status); - if (*Status == ERROR) { - MessageDisplay( "ERROR - Unable to perform allocation"); - FreeLineDouble(&FilterHighpass); - FreeLineDouble(&FilterLowpass); - FreeVolumeDouble(&Low); - return( ERROR); - } - - AllocateVolumeDouble( &LowLow, nx, ny, nz, Status); - if (*Status == ERROR) { - MessageDisplay( "ERROR - Unable to perform allocation"); - FreeLineDouble(&FilterHighpass); - FreeLineDouble(&FilterLowpass); - FreeVolumeDouble(&Low); - FreeVolumeDouble(&High); - return( ERROR); - } - - AllocateVolumeDouble( &LowHigh, nx, ny, nz, Status); - if (*Status == ERROR) { - MessageDisplay( "ERROR - Unable to perform allocation"); - FreeLineDouble(&FilterHighpass); - FreeLineDouble(&FilterLowpass); - FreeVolumeDouble(&Low); - FreeVolumeDouble(&High); - FreeVolumeDouble(&LowLow); - return( ERROR); - } - - AllocateVolumeDouble( &HighLow, nx, ny, nz, Status); - if (*Status == ERROR) { - MessageDisplay( "ERROR - Unable to perform allocation"); - FreeLineDouble(&FilterHighpass); - FreeLineDouble(&FilterLowpass); - FreeVolumeDouble(&Low); - FreeVolumeDouble(&High); - FreeVolumeDouble(&LowLow); - FreeVolumeDouble(&LowHigh); - return( ERROR); - } - - AllocateVolumeDouble( &HighHigh, nx, ny, nz, Status); - if (*Status == ERROR) { - MessageDisplay( "ERROR - Unable to perform allocation"); - FreeLineDouble(&FilterHighpass); - FreeLineDouble(&FilterLowpass); - FreeVolumeDouble(&Low); - FreeVolumeDouble(&High); - FreeVolumeDouble(&LowLow); - FreeVolumeDouble(&LowHigh); - FreeVolumeDouble(&HighLow); - return( ERROR); - } - - AllocateLineDouble( &x, nmax, Status); - if (*Status == ERROR) { - MessageDisplay( "ERROR - Unable to perform allocation"); - FreeLineDouble(&FilterHighpass); - FreeLineDouble(&FilterLowpass); - FreeVolumeDouble(&Low); - FreeVolumeDouble(&High); - FreeVolumeDouble(&LowLow); - FreeVolumeDouble(&LowHigh); - FreeVolumeDouble(&HighLow); - FreeVolumeDouble(&HighHigh); - return( ERROR); - } - - AllocateLineDouble( &y1, nmax, Status); - if (*Status == ERROR) { - MessageDisplay( "ERROR - Unable to perform allocation"); - FreeLineDouble(&FilterHighpass); - FreeLineDouble(&FilterLowpass); - FreeVolumeDouble(&Low); - FreeVolumeDouble(&High); - FreeVolumeDouble(&LowLow); - FreeVolumeDouble(&LowHigh); - FreeVolumeDouble(&HighLow); - FreeVolumeDouble(&HighHigh); - FreeLineDouble(&x); - return( ERROR); - } - - AllocateLineDouble( &y2, nmax, Status); - if (*Status == ERROR) { - MessageDisplay( "ERROR - Unable to perform allocation"); - FreeLineDouble(&FilterHighpass); - FreeLineDouble(&FilterLowpass); - FreeVolumeDouble(&Low); - FreeVolumeDouble(&High); - FreeVolumeDouble(&LowLow); - FreeVolumeDouble(&LowHigh); - FreeVolumeDouble(&HighLow); - FreeVolumeDouble(&HighHigh); - FreeLineDouble(&x); - FreeLineDouble(&y1); - return( ERROR); - } - - /******************************************************************************/ - /* 1D */ - /******************************************************************************/ - - if (ny == 1 && nz==1) { - for ( i = 0L; i < nx; i++) x[i] = (double)Input[i]; - WaveletSplit_1D( x, nx, y1, y2, &nout, - FilterLowpass, *NbLowpass, - FilterHighpass, *NbHighpass, - BoundaryConditions); - for ( i = 0L; i < nx/2; i++) Output[i] = (double)y1[i]; - for ( i = 0L; i < nx2; i++) Output[i+nx2] = (double)y2[i]; - } - - /******************************************************************************/ - /* 2D */ - /******************************************************************************/ - - if (ny > 1) { - - /* y-processing */ - for (kz=0L;kz 1) - for (i=0L; i output[nx][ny] - The input should be provided with four sectors in the classical - way to show the wavelets transform - - Author: Daniel Sage, EPFL, Biomedical Imaging Group - ----------------------------------------------------------------------------- */ -extern int WaveletMerge_3D( - double *Input, - double *Output, - long nx, long ny, long nz, - short Filter, - short Order, - double Alpha, - short BoundaryConditions, - int *Status) -{ -long kx, ky, kz, nmax, nout, k, i, j, index, nx2, ny2, nz2, nxny, - idxbase; -double *FilterLowpass, *FilterHighpass; -long NbLowpass[1], NbHighpass[1]; -double *Low, *High, *LowLow, *LowHigh, *HighLow, *HighHigh; -double *x, *y1, *y2; - - nmax = MaxLong(MaxLong(nx, ny), nz); - nx2 = MaxLong(nx / 2L, 1L); - ny2 = MaxLong(ny / 2L, 1L); - nz2 = MaxLong(nz / 2L, 1L); - nxny=nx*ny; - - /* Get the size of the filter */ - if ( Filter != 5) { - if ( WaveletFiltersGetSize(Filter, (short)(-Order), NbLowpass, NbHighpass) == ERROR) { - MessageDisplay("ERROR - Impossible to get the size of the filter"); - *Status = ERROR; - return( ERROR); - } - } - else { - if ( WaveletFiltersGetSize_Fract(Alpha, NbLowpass, NbHighpass) == ERROR) { - MessageDisplay("ERROR - Impossible to get the size of the filter"); - *Status = ERROR; - return( ERROR); - } - } - - /* Allocate the memory for the highpass filter */ - AllocateLineDouble( &FilterHighpass, *NbHighpass, Status); - if (*Status == ERROR) { - MessageDisplay( "ERROR - Unable to perform allocation (FilterHighpass)"); - return( ERROR); - } - - /* Allocate the memory for the lowpass filter */ - AllocateLineDouble( &FilterLowpass, *NbLowpass, Status); - if (*Status == ERROR) { - MessageDisplay( "ERROR - Unable to perform allocation (FilterLowpass)"); - FreeLineDouble(&FilterHighpass); - return( ERROR); - } - - /* Get the coefficient of the filters */ - if ( Filter != 5) { - if ( WaveletFiltersGetCoef( Filter, (short)(-Order), FilterLowpass, FilterHighpass) == ERROR) { - MessageDisplay("ERROR - Impossible to get the coefficient of the filter"); - *Status = ERROR; - return( ERROR); - } - } - else { - if ( WaveletFiltersGetCoef_Fract( Alpha, FilterLowpass, FilterHighpass) == ERROR) { - MessageDisplay("ERROR - Impossible to get the coefficient of the filter"); - *Status = ERROR; - return( ERROR); - } - } - - - /* Allocate the temporary vector */ - AllocateVolumeDouble( &Low, nx, ny, nz, Status); - if (*Status == ERROR) { - MessageDisplay( "ERROR - Unable to perform allocation (Low)"); - FreeLineDouble(&FilterHighpass); - FreeLineDouble(&FilterLowpass); - return( ERROR); - } - - AllocateVolumeDouble( &High, nx, ny, nz, Status); - if (*Status == ERROR) { - MessageDisplay( "ERROR - Unable to perform allocation (High)"); - FreeLineDouble(&FilterHighpass); - FreeLineDouble(&FilterLowpass); - FreeVolumeDouble(&Low); - return( ERROR); - } - - AllocateVolumeDouble( &LowLow, nx, ny, nz, Status); - if (*Status == ERROR) { - MessageDisplay( "ERROR - Unable to perform allocation (LowLow)"); - FreeLineDouble(&FilterHighpass); - FreeLineDouble(&FilterLowpass); - FreeVolumeDouble(&Low); - FreeVolumeDouble(&High); - return( ERROR); - } - - AllocateVolumeDouble( &LowHigh, nx, ny, nz, Status); - if (*Status == ERROR) { - MessageDisplay( "ERROR - Unable to perform allocation (LowHigh)"); - FreeLineDouble(&FilterHighpass); - FreeLineDouble(&FilterLowpass); - FreeVolumeDouble(&Low); - FreeVolumeDouble(&High); - FreeVolumeDouble(&LowLow); - return( ERROR); - } - - AllocateVolumeDouble( &HighLow, nx, ny, nz, Status); - if (*Status == ERROR) { - MessageDisplay( "ERROR - Unable to perform allocation (HighLow)"); - FreeLineDouble(&FilterHighpass); - FreeLineDouble(&FilterLowpass); - FreeVolumeDouble(&Low); - FreeVolumeDouble(&High); - FreeVolumeDouble(&LowLow); - FreeVolumeDouble(&LowHigh); - return( ERROR); - } - - AllocateVolumeDouble( &HighHigh, nx, ny, nz, Status); - if (*Status == ERROR) { - MessageDisplay( "ERROR - Unable to perform allocation (HighHigh)"); - FreeLineDouble(&FilterHighpass); - FreeLineDouble(&FilterLowpass); - FreeVolumeDouble(&Low); - FreeVolumeDouble(&High); - FreeVolumeDouble(&LowLow); - FreeVolumeDouble(&LowHigh); - FreeVolumeDouble(&HighLow); - return( ERROR); - } - - AllocateLineDouble( &x, nmax, Status); - if (*Status == ERROR) { - MessageDisplay( "ERROR - Unable to perform allocation (x)"); - FreeLineDouble(&FilterHighpass); - FreeLineDouble(&FilterLowpass); - FreeVolumeDouble(&Low); - FreeVolumeDouble(&High); - FreeVolumeDouble(&LowLow); - FreeVolumeDouble(&LowHigh); - FreeVolumeDouble(&HighLow); - FreeVolumeDouble(&HighHigh); - *Status = ERROR; - return( ERROR); - } - - AllocateLineDouble( &y1, nmax, Status); - if (*Status == ERROR) { - MessageDisplay( "ERROR - Unable to perform allocation (y1)"); - FreeLineDouble(&FilterHighpass); - FreeLineDouble(&FilterLowpass); - FreeVolumeDouble(&Low); - FreeVolumeDouble(&High); - FreeVolumeDouble(&LowLow); - FreeVolumeDouble(&LowHigh); - FreeVolumeDouble(&HighLow); - FreeVolumeDouble(&HighHigh); - FreeLineDouble(&x); - return( ERROR); - } - - AllocateLineDouble( &y2, nmax, Status); - if (*Status == ERROR) { - MessageDisplay( "ERROR - Unable to perform allocation (y2)"); - FreeLineDouble(&FilterHighpass); - FreeLineDouble(&FilterLowpass); - FreeVolumeDouble(&Low); - FreeVolumeDouble(&High); - FreeVolumeDouble(&LowLow); - FreeVolumeDouble(&LowHigh); - FreeVolumeDouble(&HighLow); - FreeVolumeDouble(&HighHigh); - FreeLineDouble(&x); - FreeLineDouble(&y1); - return( ERROR); - } - - - /******************************************************************************/ - /* 3D */ - /******************************************************************************/ - - if (nz > 1) - for (i=0L; i 1) { - /* Extract component from the input */ - for (kz=0L;kz y1[nx/2] & y2[nx/2] - - - Author: Daniel Sage, EPFL, Biomedical Imaging Group - ----------------------------------------------------------------------------- */ -static int WaveletSplit_1D( - double x[], long nx, - double y1[], double y2[], long *ny, - double v[], long nv, - double w[], long nw, - short BoundaryConditions) -{ - - /* --- Check the parameters --- */ - - if (x == (double *)NULL) { - MessageDisplay("ERROR - Pointer of input is null"); - return(ERROR); - } - - if (nx <= 1) { - MessageDisplay("ERROR - Length of input should be greater than 1"); - return(ERROR); - } - - if ((nx/2L)*2L != nx) { /* The input length should be even */ - MessageDisplay("ERROR - Length of input should be even"); - return(ERROR); - } - - if (y1 == (double *)NULL) { - MessageDisplay("ERROR - Pointer to an output is null"); - return(ERROR); - } - - if (y2 == (double *)NULL) { - MessageDisplay("ERROR - Pointer to an output is null"); - return(ERROR); - } - - if (ny == (long *)NULL) { - MessageDisplay("ERROR - Pointer to an output is null"); - return(ERROR); - } - - if (v == (double *)NULL) { - MessageDisplay("ERROR - Pointer to the lowpass filter is null"); - return(ERROR); - } - - if (nv <= 0 ) { - MessageDisplay("ERROR - Length of the filter be greater than 0"); - return(ERROR); - } - - if (w == (double *)NULL) { - MessageDisplay("ERROR - Pointer to the highpass filter is null"); - return(ERROR); - } - - if (nw <= 0 ) { - MessageDisplay("ERROR - Length of the filter be greater than 0"); - return(ERROR); - } - - /* --- Call the processing function */ - - switch(BoundaryConditions) { - case 1: - WaveletSplit_1DMirror( x, nx,y1, y2, ny, v, nv, w, nw); - break; - case 2: - WaveletSplit_1DPeriodic( x, nx,y1, y2, ny, v, nv, w, nw); - break; - default: - MessageDisplay("ERROR - Boundary should be Periodic or Mirror"); - return(ERROR); - } - - return(!ERROR); -} - -/* ---------------------------------------------------------------------------- - - Function: WaveletMerge_1D - - Purpose: Two channel up-sampling and filtering for 1D real signals. - Interface to call the basic routines: - WaveletSplit_1DMirror() if BoundaryConditions is 1 - WaveletSplit_1DPeriodic() if BoundaryConditions is 2 - - lowpass filter: v[nv] - highpass filter: w[nw] - - y1[ny] & y2[ny] -> x[2*ny] - - Author: Daniel Sage, EPFL, Biomedical Imaging Group - ----------------------------------------------------------------------------- */ -static int WaveletMerge_1D( - double y1[],double y2[],long ny, - double x[],long *nx, - double v[],long nv, - double w[],long nw, - short BoundaryConditions) -{ - - /* --- Check the parameters --- */ - - if (y1 == (double *)NULL) { - MessageDisplay("ERROR - Pointer of input is null"); - return(ERROR); - } - - if (y2 == (double *)NULL) { - MessageDisplay("ERROR - Pointer of input is null"); - return(ERROR); - } - - if (ny <= 1) { - MessageDisplay("ERROR - Length of input should be greater than 1"); - return(ERROR); - } - - if (nx == (long *)NULL) { - MessageDisplay("ERROR - Pointer to an output is null"); - return(ERROR); - } - - if (nx == (long *)NULL) { - MessageDisplay("ERROR - Pointer to an output is null"); - return(ERROR); - } - - if (v == (double *)NULL) { - MessageDisplay("ERROR - Pointer to the lowpass filter is null"); - return(ERROR); - } - - if (nv <= 0 ) { - MessageDisplay("ERROR - Length of the filter be greater than 0"); - return(ERROR); - } - - if (w == (double *)NULL) { - MessageDisplay("ERROR - Pointer to the highpass filter is null"); - return(ERROR); - } - - if (nw <= 0 ) { - MessageDisplay("ERROR - Length of the filter be greater than 0"); - return(ERROR); - } - - /* --- Call the processing function */ - - switch(BoundaryConditions) { - case 1: - WaveletMerge_1DMirror( y1, y2, ny, x, nx, v, nv, w, nw); - break; - - case 2: - WaveletMerge_1DPeriodic( y1, y2, ny, x, nx, v, nv, w, nw); - break; - - default: - MessageDisplay("ERROR - Boundary should be Periodic or Mirror"); - return(ERROR); - } - - return(!ERROR); - -} - -/* ---------------------------------------------------------------------------- - - Function: WaveletSplit_1DMirror - - Purpose: Two channel filtering and down-sampling for 1D - real signals. The filters are symmetrical and the signal - is extended using mirror extrapolation. - - lowpass filter: v[nv] - highpass filter: w[nw] - - x[nx] -> y1[nx/2] & y2[nx/2] - - Author: Michael Unser, EPFL, Biomedical Imaging Group - - History: MU Oct 1992 tested - DS Dec 1998 renaming, double version - ----------------------------------------------------------------------------- */ -static void WaveletSplit_1DMirror( - double x[], long nx, - double y1[], double y2[], long *ny, - double v[], long nv, - double w[], long nw) -{ -double pix; -long i, j, k, nyy, n, j1, j2, kn; - - nyy = nx / 2L; - n = nyy * 2L; /* signal length */ - kn = 2L * n - 2L; /* Global period */ - - if ((nv<=1L)||(nw<=1L)) /* Haar transform */ - for (i=0L;in-1) j1=kn-j1; - } - if (j2>n-1) { - j2=j2 % kn; - if (j2>n-1) j2=kn-j2; - } - - pix=pix+v[k]*(x[j1]+x[j2]); - } - y1[i]=pix; - - j=j+1L; - pix=x[j]*w[0]; - for (k=1L;kn-1) j1=kn-j1; - } - if (j2>n-1) { - j2=j2 % kn; - if (j2>n-1L) j2=kn-j2; - } - - pix=pix+w[k]*(x[j1]+x[j2]); - } - y2[i]=pix; - } - *ny=nyy; -} - -/* ---------------------------------------------------------------------------- - - Function: WaveletSplit_1DPeriodic - - Purpose: Two channel filtering and down-sampling for 1D - real signals. The filters are symmetrical and the signal - is extended using periodic boundary conditions. - - lowpass filter: v[nv] - highpass filter: w[nw] - - x[nx] -> y1[nx/2] & y2[nx/2] - - Author: Michael Unser, EPFL, Biomedical Imaging Group - - History: MU Oct 1992 tested - DS Dec 1998 renaming, double version - ----------------------------------------------------------------------------- */ -static void WaveletSplit_1DPeriodic( - double x[], long nx, - double y1[], double y2[], long *ny, - double v[], long nv, - double w[], long nw) -{ -double pix; -long i, j, k, nyy, n, j1, j2, kn, knn; - - nyy=nx/2; - n=nyy*2; /* signal length */ - kn=n; /* Global period */ - knn=20*n; - - if ((nv<=1)||(nw<=1)) /* Haar transform */ - for (i=0;in-1) j2=j2 % kn; - pix=pix+v[k]*(x[j1]+x[j2]); - } - y1[i]=pix; - - j=j+1; - pix=x[j]*w[0]; - for (k=1;kn-1) j2=j2 % kn; - pix=pix+w[k]*(x[j1]+x[j2]); - } - y2[i]=pix; - } - *ny=nyy; -} - - -/* ---------------------------------------------------------------------------- - - Function: WaveletMerge_1DMirror - - Purpose: Two channel up-sampling and filtering for 1D - real signals. The filters are symmetrical and the - boundary conditions are mirror. - - lowpass filter: v[nv] - highpass filter: w[nw] - - y1[ny] & y2[ny] -> x[2*ny] - - Author: Michael Unser, EPFL, Biomedical Imaging Group - - History: MU Oct 1992 tested - MU Apr 1997 corrected boundary conditions) - DS Dec 1998 renaming, double version - ----------------------------------------------------------------------------- */ -static void WaveletMerge_1DMirror( - double y1[],double y2[],long ny, - double x[],long *nx, - double v[],long nv, - double w[],long nw) -{ -double pix1, pix2; -long i, j, k, kk, i1, i2, k01, k02, n, kn; - - *nx=ny*2; - k01=(nv/2)*2-1; - k02=(nw/2)*2-1; - n=ny; - kn=2*n-1; - - if ((nv<=1)||(nw<=1)) /* Haar transform */ - for (i=0;in-1) i1=kn-i1; - } - if (i2>n-1) { /* non-standard boundary */ - i2=(i2) % kn; - if (i2>n-1) i2=kn-i2; - } - /* NOTE : This is the correct boundary condition assuming that - the original image has an even size (2n) and the decimation - was performed according to the sequence 1,3,5,É,2n-1. */ - pix1=pix1+v[k]*(y1[i1]+y1[i2]); - } - - pix2=0.; - for (k=-k02;kn-1) i1=kn-1-i1; - } - if (i1>n-1) { /* standard boundary */ - i1=i1 % kn; - if (i1>n-1) i1=kn-1-i1; - } - /* NOTE : This is the correct boundary condition assuming that - the original image has an even size (2n) and the decimation - was performed according to the sequence 2,4,6,É,2n. */ - pix2=pix2+w[kk]*y2[i1]; - } - - x[j]=(pix1+pix2); - - j=j+1; - pix1=0.; - for (k=-k01;kn-1) i1=kn-i1; - } - if (i1>n-1) { /* non-standard boundary */ - i1=(i1) % kn; - if (i1>n-1) i1=kn-i1; - } - pix1=pix1+v[kk]*y1[i1]; - } - pix2=w[0]*y2[i]; - for (k=2;kn-1) i1=kn-1-i1; - } - if (i2>n-1) { /* standard boundary */ - i2=i2 % kn; - if (i2>n-1) i2=kn-1-i2; - } - pix2=pix2+w[k]*(y2[i1]+y2[i2]); - } - x[j]=(pix1+pix2); - } -} - -/* ---------------------------------------------------------------------------- - - Function: WaveletMerge_1DPeriodic - - Purpose: Two channel up-sampling and filtering for 1D - real signals. The filters are symmetrical and the - boundary conditions are periodic. - - lowpass filter: v[nv] - highpass filter: w[nw] - - y1[ny] & y2[ny] -> x[2*ny] - - Author: Michael Unser, EPFL, Biomedical Imaging Group - - History: MU Oct 1992 tested - DS Dec 1998 renaming, double version - - ----------------------------------------------------------------------------- */ -static void WaveletMerge_1DPeriodic( - double y1[],double y2[], long ny, - double x[], long *nx, - double v[],long nv, - double w[],long nw) -{ -double pix1, pix2; -long i, j, k, kk, i1, i2, k01, k02, n, kn, knn; - - *nx=ny*2; - k01=(nv/2)*2-1; - k02=(nw/2)*2-1; - n=ny; - kn=n; - knn=20*n; - - if ((nv<=1)||(nw<=1)) /* Haar transform */ - for (i=0;in-1) i2=i2 % kn; - - pix1=pix1+v[k]*(y1[i1]+y1[i2]); - } - - pix2=0.; - for (k=-k02;kn-1) i1=i1 % kn; - pix2=pix2+w[kk]*y2[i1]; - } - x[j]=(pix1+pix2); - - j=j+1; - pix1=0.; - for (k=-k01;kn-1) i1=i1 % kn; - pix1=pix1+v[kk]*y1[i1]; - } - pix2=w[0]*y2[i]; - for (k=2;kn-1) i2=i2 % kn; - pix2=pix2+w[k]*(y2[i1]+y2[i2]); - } - x[j]=(pix1+pix2); - } -} - - - diff --git a/src/core/bilib/wavelettools.h b/src/core/bilib/wavelettools.h deleted file mode 100644 index 845803d..0000000 --- a/src/core/bilib/wavelettools.h +++ /dev/null @@ -1,22 +0,0 @@ - - -extern int WaveletSplit_3D( - double *Input, - double *Output, - long nx, long ny, long nz, - short Filter, - short Order, - double Alpha, - short BoundaryConditions, - int *Status); - -extern int WaveletMerge_3D( - double *Input, - double *Output, - long nx, long ny, long nz, - short Filter, - short Order, - double Alpha, - short BoundaryConditions, - int *Status); - diff --git a/src/core/bilib/window.cc b/src/core/bilib/window.cc deleted file mode 100644 index e8136f2..0000000 --- a/src/core/bilib/window.cc +++ /dev/null @@ -1,297 +0,0 @@ -/***************************************************************************** - * System includes - ****************************************************************************/ -#include -#include - -/***************************************************************************** - * Toolbox defines - ****************************************************************************/ -#include "configs.h" -#include "debug.h" -#include "error.h" - -/***************************************************************************** - * Toolbox includes - ****************************************************************************/ -#include "messagedisplay.h" -#include "window.h" - -/***************************************************************************** - * Conditional includes - ****************************************************************************/ -#ifdef DEBUG -#include -#include -#endif - -/***************************************************************************** - * Declaration of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of static procedures - ****************************************************************************/ -/* None */ - -/***************************************************************************** - * Definition of extern procedures - ****************************************************************************/ -/*--------------------------------------------------------------------------*/ -extern double Bartlet - ( - double Argument, /* input */ - long WindowHalfLength /* half size H of the window */ - ) - -/* returns the value of a Bartlet (triangular) window evaluated at Argument */ -/* the width of the symmetric window is (2 * H) */ - -{ /* begin Bartlet */ - -#ifdef DEBUG -/**/int Status = !ERROR; -#endif - -/**/DEBUG_CHECK_RANGE_LONG(Bartlet, WindowHalfLength, 1L, LONG_MAX, Status, -/**/ "Invalid window half length (should be strictly positive)") -/**/DEBUG_WRITE_ENTERING(Bartlet, -/**/ "About to compute a Bartlet value") - -#ifdef DEBUG -/**/if (Status == ERROR) { -/**/ WRITE_ERROR(Bartlet, -/**/ "Unable to perform Bartlet because of invalid window length") -/**/ DEBUG_WRITE_LEAVING(Bartlet, "Done") -/**/ return(HUGE_VAL); -/**/} -#endif - Argument = fabs(Argument); - if (Argument < WindowHalfLength) { -/**/ DEBUG_WRITE_LEAVING(Bartlet, "Done") - return(1.0 - fabs(Argument) / (double)WindowHalfLength); - } - else { -/**/ DEBUG_WRITE_LEAVING(Bartlet, "Done") - return(0.0); - } -} /* end Bartlet */ - -/*--------------------------------------------------------------------------*/ -extern double Blackman - ( - double Argument, /* input */ - long WindowHalfLength /* half size H of the window */ - ) - -/* returns the value of a Blackman window evaluated at Argument */ -/* the width of the symmetric window is (2 * H) */ - -{ /* begin Blackman */ - -#ifdef DEBUG -/**/int Status = !ERROR; -#endif - -/**/DEBUG_CHECK_RANGE_LONG(Blackman, WindowHalfLength, 1L, LONG_MAX, Status, -/**/ "Invalid window half length (should be strictly positive)") -/**/DEBUG_WRITE_ENTERING(Blackman, -/**/ "About to compute a Blackman value") - -#ifdef DEBUG -/**/if (Status == ERROR) { -/**/ WRITE_ERROR(Blackman, -/**/ "Unable to perform Blackman because of invalid window length") -/**/ DEBUG_WRITE_LEAVING(Blackman, "Done") -/**/ return(HUGE_VAL); -/**/} -#endif - Argument = fabs(Argument); - if (Argument < WindowHalfLength) { -/**/ DEBUG_WRITE_LEAVING(Blackman, "Done") - return(3969.0 / 9304.0 + (1155.0 / 2326.0) - * cos(Argument * PI / (double)WindowHalfLength) + (715.0 / 9304.0) - * cos(Argument * (2.0 * PI) / (double)WindowHalfLength)); - } - else if (Argument == WindowHalfLength) { -/**/ DEBUG_WRITE_LEAVING(Blackman, "Done") - return(4.0 / 1163.0); - } - else { -/**/ DEBUG_WRITE_LEAVING(Blackman, "Done") - return(0.0); - } -} /* end Blackman */ - -/*--------------------------------------------------------------------------*/ -extern double Dirichlet - ( - double Argument, /* input */ - long WindowHalfLength /* half size H of the window */ - ) - -/* returns the value of a Dirichlet (rectangular) window evaluated at Argument */ -/* the width of the symmetric window is (2 * H) */ - -{ /* begin Dirichlet */ - -#ifdef DEBUG -/**/int Status = !ERROR; -#endif - -/**/DEBUG_CHECK_RANGE_LONG(Dirichlet, WindowHalfLength, 1L, LONG_MAX, Status, -/**/ "Invalid window half length (should be strictly positive)") -/**/DEBUG_WRITE_ENTERING(Dirichlet, -/**/ "About to compute a Dirichlet value") - -#ifdef DEBUG -/**/if (Status == ERROR) { -/**/ WRITE_ERROR(Dirichlet, -/**/ "Unable to perform Dirichlet because of invalid window length") -/**/ DEBUG_WRITE_LEAVING(Dirichlet, "Done") -/**/ return(HUGE_VAL); -/**/} -#endif - Argument = fabs(Argument); - if (Argument < WindowHalfLength) { -/**/ DEBUG_WRITE_LEAVING(Dirichlet, "Done") - return(1.0); - } - else if (Argument == WindowHalfLength) { -/**/ DEBUG_WRITE_LEAVING(Dirichlet, "Done") - return(0.5); - } - else { -/**/ DEBUG_WRITE_LEAVING(Dirichlet, "Done") - return(0.0); - } -} /* end Dirichlet */ - -/*--------------------------------------------------------------------------*/ -extern double HammingClassic - ( - double Argument, /* input */ - long WindowHalfLength /* half size H of the window */ - ) - -/* returns the value of a Hamming window evaluated at Argument */ -/* classic Hamming weights are used */ -/* the width of the symmetric window is (2 * H) */ - -{ /* begin HammingClassic */ - -#ifdef DEBUG -/**/int Status = !ERROR; -#endif - -/**/DEBUG_CHECK_RANGE_LONG(HammingClassic, WindowHalfLength, 1L, LONG_MAX, Status, -/**/ "Invalid window half length (should be strictly positive)") -/**/DEBUG_WRITE_ENTERING(HammingClassic, -/**/ "About to compute a Hamming value") - -#ifdef DEBUG -/**/if (Status == ERROR) { -/**/ WRITE_ERROR(HammingClassic, -/**/ "Unable to perform HammingClassic because of invalid window length") -/**/ DEBUG_WRITE_LEAVING(HammingClassic, "Done") -/**/ return(HUGE_VAL); -/**/} -#endif - if (Argument < WindowHalfLength) { -/**/ DEBUG_WRITE_LEAVING(HammingClassic, "Done") - return(0.54 + 0.46 * cos(Argument * PI / (double)WindowHalfLength)); - } - else if (Argument == WindowHalfLength) { -/**/ DEBUG_WRITE_LEAVING(HammingClassic, "Done") - return(0.04); - } - else { -/**/ DEBUG_WRITE_LEAVING(HammingClassic, "Done") - return(0.0); - } -} /* end HammingClassic */ - -/*--------------------------------------------------------------------------*/ -extern double HammingExact - ( - double Argument, /* input */ - long WindowHalfLength /* half size H of the window */ - ) - -/* returns the value of a Hamming window evaluated at Argument */ -/* optimal (non-classic) weights are used */ -/* the width of the symmetric window is (2 * H) */ - -{ /* begin HammingExact */ - -#ifdef DEBUG -/**/int Status = !ERROR; -#endif - -/**/DEBUG_CHECK_RANGE_LONG(HammingExact, WindowHalfLength, 1L, LONG_MAX, Status, -/**/ "Invalid window half length (should be strictly positive)") -/**/DEBUG_WRITE_ENTERING(HammingExact, -/**/ "About to compute an exact Hamming value") - -#ifdef DEBUG -/**/if (Status == ERROR) { -/**/ WRITE_ERROR(HammingExact, -/**/ "Unable to perform HammingExact because of invalid window length") -/**/ DEBUG_WRITE_LEAVING(HammingExact, "Done") -/**/ return(HUGE_VAL); -/**/} -#endif - if (Argument < WindowHalfLength) { -/**/ DEBUG_WRITE_LEAVING(HammingExact, "Done") - return(25.0 / 46.0 + (21.0 / 46.0) * cos(Argument * PI / (double)WindowHalfLength)); - } - else if (Argument == WindowHalfLength) { -/**/ DEBUG_WRITE_LEAVING(HammingExact, "Done") - return(1.0 / 23.0); - } - else { -/**/ DEBUG_WRITE_LEAVING(HammingExact, "Done") - return(0.0); - } -} /* end HammingExact */ - -/*--------------------------------------------------------------------------*/ -extern double Hanning - ( - double Argument, /* input */ - long WindowHalfLength /* half size H of the window */ - ) - -/* returns the value of a Hanning window evaluated at Argument */ -/* the width of the symmetric window is (2 * H) */ - -{ /* begin Hanning */ - -#ifdef DEBUG -/**/int Status = !ERROR; -#endif - -/**/DEBUG_CHECK_RANGE_LONG(Hanning, WindowHalfLength, 1L, LONG_MAX, Status, -/**/ "Invalid window half length (should be strictly positive)") -/**/DEBUG_WRITE_ENTERING(Hanning, -/**/ "About to compute a Hanning value") - -#ifdef DEBUG -/**/if (Status == ERROR) { -/**/ WRITE_ERROR(Hanning, -/**/ "Unable to perform Hanning because of invalid window length") -/**/ DEBUG_WRITE_LEAVING(Hanning, "Done") -/**/ return(HUGE_VAL); -/**/} -#endif - if (Argument < WindowHalfLength) { -/**/ DEBUG_WRITE_LEAVING(Hanning, "Done") - return(1.0 / 2.0 + (1.0 / 2.0) * cos(Argument * PI / (double)WindowHalfLength)); - } - else { -/**/ DEBUG_WRITE_LEAVING(Hanning, "Done") - return(0.0); - } -} /* end Hanning */ - diff --git a/src/core/bilib/window.h b/src/core/bilib/window.h deleted file mode 100644 index 13b8e28..0000000 --- a/src/core/bilib/window.h +++ /dev/null @@ -1,59 +0,0 @@ -/**@defgroup SignalProcWindows Signal processing windows - @ingroup BilibLibrary */ -//@{ -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Bartlet (triangular) window evaluated at Argument. - The width of the symmetric window is (2 * H) */ -extern double Bartlet - ( - double Argument, /* input */ - long WindowHalfLength /* half size H of the window */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Blackman window evaluated at Argument. - The width of the symmetric window is (2 * H) */ -extern double Blackman - ( - double Argument, /* input */ - long WindowHalfLength /* half size H of the window */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Dirichlet (rectangular) window evaluated at - Argument. The width of the symmetric window is (2 * H) */ -extern double Dirichlet - ( - double Argument, /* input */ - long WindowHalfLength /* half size H of the window */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Hamming window evaluated at Argument. - Classic Hamming weights are used. - The width of the symmetric window is (2 * H) */ -extern double HammingClassic - ( - double Argument, /* input */ - long WindowHalfLength /* half size H of the window */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Hamming window evaluated at Argument. - Optimal (non-classic) weights are used. - The width of the symmetric window is (2 * H) */ -extern double HammingExact - ( - double Argument, /* input */ - long WindowHalfLength /* half size H of the window */ - ); - -/*--------------------------------------------------------------------------*/ -/** Returns the value of a Hanning window evaluated at Argument. - The width of the symmetric window is (2 * H) */ -extern double Hanning - ( - double Argument, /* input */ - long WindowHalfLength /* half size H of the window */ - ); -//@} diff --git a/src/core/choose.h b/src/core/choose.h deleted file mode 100644 index 075fdd2..0000000 --- a/src/core/choose.h +++ /dev/null @@ -1,23 +0,0 @@ -#ifndef CORE_CHOOSE_H -#define CORE_CHOOSE_H - -namespace TypeHelpers { - -// TODO: write documentation & usage - -template -struct choose; - -template -struct choose { - typedef typeTrue type; -}; - -template -struct choose { - typedef typeFalse type; -}; - -}//end namespace TypeHelpers - -#endif diff --git a/src/core/comment_list.cpp b/src/core/comment_list.cpp deleted file mode 100644 index 0f4fbd7..0000000 --- a/src/core/comment_list.cpp +++ /dev/null @@ -1,51 +0,0 @@ -/*************************************************************************** - * - * Authors: David Strelak (davidstrelak@gmail.com) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include "comment_list.h" - -void CommentList::addComment(const String &comment, int visible, bool verbatim) -{ - comments.push_back(comment); - visibility.push_back(visible); - wikiVerbatim.push_back(verbatim); -} -void CommentList::addComment(const char * comment, bool verbatim) -{ - size_t t=0; - while(comment[t]=='+' && comment[t]!='\0') - t++; - addComment(comment+t,t,verbatim); -} - -void CommentList::clear() -{ - comments.clear(); - visibility.clear(); - wikiVerbatim.clear(); -} -size_t CommentList::size() const -{ - return comments.size(); -} diff --git a/src/core/comment_list.h b/src/core/comment_list.h deleted file mode 100644 index e61f90f..0000000 --- a/src/core/comment_list.h +++ /dev/null @@ -1,45 +0,0 @@ -/*************************************************************************** - * - * Authors: David Strelak (davidstrelak@gmail.com) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_COMMENT_LIST_H_ -#define CORE_COMMENT_LIST_H_ - -#include "xmipp_strings.h" - -/** Just a class for holding comments */ -class CommentList -{ -public: - StringVector comments; - std::vector visibility; - std::vector wikiVerbatim; - - void addComment(const String &comment, int visible = 0, bool wikiVerbatim=false); - void addComment(const char * comment, bool verbatim=false); - void clear(); - size_t size() const; -}; - -#endif /* CORE_COMMENT_LIST_H_ */ diff --git a/src/core/gcc_version.h b/src/core/gcc_version.h deleted file mode 100644 index d0d6fd8..0000000 --- a/src/core/gcc_version.h +++ /dev/null @@ -1,48 +0,0 @@ -/*************************************************************************** -* -* Authors: Sjors H.W. Scheres -* Roberto Marabini -* -* Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC -* -* This program is free software; you can redistribute it and/or modify -* it under the terms of the GNU General Public License as published by -* the Free Software Foundation; either version 2 of the License, or -* (at your option) any later version. -* -* This program is distributed in the hope that it will be useful, -* but WITHOUT ANY WARRANTY; without even the implied warranty of -* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -* GNU General Public License for more details. -* -* You should have received a copy of the GNU General Public License -* along with this program; if not, write to the Free Software -* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA -* 02111-1307 USA -* -* All comments concerning this program package may be sent to the -* e-mail address 'xmipp@cnb.csic.es' -***************************************************************************/ - -#ifndef CORE_GCC_VERSION_H -#define CORE_GCC_VERSION_H - -// If we do not use a GNU compiler, then set the GCC_VERSION to a very high number -#ifdef __GNUC__ -#define GCC_VERSION (__GNUC__ * 10000 \ - + __GNUC_MINOR__ * 100 \ - + __GNUC_PATCHLEVEL__) -#else -#define GCC_VERSION 999999 -#endif - -#if GCC_VERSION < 30300 -#include -#else -#include -#endif - - -#endif - - diff --git a/src/core/geometry.cpp b/src/core/geometry.cpp deleted file mode 100644 index 285ba3e..0000000 --- a/src/core/geometry.cpp +++ /dev/null @@ -1,1328 +0,0 @@ -/*************************************************************************** - * - * Authors: Carlos Oscar S. Sorzano (coss@cnb.csic.es) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include -#include - -#include "geometry.h" -#include "xmipp_funcs.h" -#include "transformations.h" -#include "bilib/kernel.h" - -/* ######################################################################### */ -/* Geometrical Operations */ -/* ######################################################################### */ - -/* Project a point to a plane ---------------------------------------------- */ -void Uproject_to_plane(const Matrix1D &point, - const Matrix1D &direction, double distance, - Matrix1D &result) -{ - - if (result.size() != 3) - result.resize(3); - double xx = distance - (XX(point) * XX(direction) + YY(point) * YY(direction) + - ZZ(point) * ZZ(direction)); - XX(result) = XX(point) + xx * XX(direction); - YY(result) = YY(point) + xx * YY(direction); - ZZ(result) = ZZ(point) + xx * ZZ(direction); -} - -/* Project a point to a plane ---------------------------------------------- */ -void Uproject_to_plane(const Matrix1D &r, - double rot, double tilt, double psi, Matrix1D &result) -{ - Matrix2D euler(3, 3); - Euler_angles2matrix(rot, tilt, psi, euler); - Uproject_to_plane(r, euler, result); -} - -/* Project a point to a plane ---------------------------------------------- */ -void Uproject_to_plane(const Matrix1D &r, - const Matrix2D &euler, Matrix1D &result) -{ - SPEED_UP_temps012; - if (VEC_XSIZE(result) != 3) - result.resize(3); - M3x3_BY_V3x1(result, euler, r); -} - -/* Spherical distance ------------------------------------------------------ */ -double spherical_distance(const Matrix1D &r1, const Matrix1D &r2) -{ - double r1r2 = XX(r1) * XX(r2) + YY(r1) * YY(r2) + ZZ(r1) * ZZ(r2); - double R1 = sqrt(XX(r1) * XX(r1) + YY(r1) * YY(r1) + ZZ(r1) * ZZ(r1)); - double R2 = sqrt(XX(r2) * XX(r2) + YY(r2) * YY(r2) + ZZ(r2) * ZZ(r2)); - double argument = r1r2 / (R1 * R2); - double ang = acos(CLIP(argument,-1.,1.)); - double retVal = ang*R1; - return retVal; -} - -/* Point to line distance -------------------------------------------------- */ -double point_line_distance_3D(const Matrix1D &p, - const Matrix1D &a, - const Matrix1D &v) - -{ - Matrix1D p_a(3); - - V3_MINUS_V3(p_a, p, a); - return (vectorProduct(p_a, v).module() / v.module()); -} - -/* Least-squares-fit a plane to an arbitrary number of (x,y,z) points - PLane described as Ax + By + C = z - where D = -1 - Returns -1 if A2+B2+C2 <<1 -*/ -void least_squares_plane_fit(FitPoint *IN_points, - int Npoints, - double &plane_a, - double &plane_b, - double &plane_c) -{ - double D = 0; - double E = 0; - double F = 0; - double G = 0; - double H = 0; - double I = 0; - double J = 0; - double K = 0; - double L = 0; - double W2 = 0; - double denom = 0; - const FitPoint * point; - - for (int i = 0; i < Npoints; i++) - { - point = &(IN_points[i]);//Can I copy just the address? - W2 = point->w * point->w; - D += point->x * point->x * W2 ; - E += point->x * point->y * W2 ; - F += point->x * W2 ; - G += point->y * point->y * W2 ; - H += point->y * W2 ; - I += 1 * W2 ; - J += point->x * point->z * W2 ; - K += point->y * point->z * W2 ; - L += point->z * W2 ; - } - - denom = F * F * G - 2 * E * F * H + D * H * H + E * E * I - D * G * I; - - // X axis slope - plane_a = (H * H * J - G * I * J + E * I * K + F * G * L - H * (F * K + E * L)) / denom; - // Y axis slope - plane_b = (E * I * J + F * F * K - D * I * K + D * H * L - F * (H * J + E * L)) / denom; - // Z axis intercept - plane_c = (F * G * J - E * H * J - E * F * K + D * H * K + E * E * L - D * G * L) / denom; -} - - -/* Least-squares-fit a plane to an image. - * - * Performs the same computation as least_squares_plane_fit function but it has been - * optimized removing redundant computations or moving computations to - * outer loop. - * - * Check least_squares_plane_fit function for a clearer code. -*/ -void least_squares_plane_fit_All_Points(const MultidimArray &Image, - double& plane_a, - double& plane_b, - double& plane_c) -{ - double D = 0; - double E = 0; - double F = 0; - double G = 0; - double H = 0; - double I = 0; - double J = 0; - double K = 0; - double L = 0; - double denom = 0; - int nIterations=0; - double sumjValues=0.0; - for (int j=STARTINGX(Image); j<=FINISHINGX(Image); ++j) - { - D += j*j; - sumjValues += j; - I += 1; - } - F = sumjValues; - - double *ref; - double sumElements; - for (int i=STARTINGY(Image); i<=FINISHINGY(Image); ++i) - { - nIterations++; - ref = &A2D_ELEM(Image, i, STARTINGX(Image)); - sumElements = 0.0; - for (int j=STARTINGX(Image); j<=FINISHINGX(Image); ++j) - { - J += j*(*ref); - sumElements += (*ref); - ref++; - } - K += i*sumElements; - L += sumElements; - E += sumjValues*i; - G += i*i*I; - H += i*I; - } - D = D*nIterations; - F = F*nIterations; - I = I*nIterations; - - denom = F * F * G - 2 * E * F * H + D * H * H + E * E * I - D * G * I; - - // X axis slope - plane_a = (H * H * J - G * I * J + E * I * K + F * G * L - H * (F * K + E * L)) / denom; - // Y axis slope - plane_b = (E * I * J + F * F * K - D * I * K + D * H * L - F * (H * J + E * L)) / denom; - // Z axis intercept - plane_c = (F * G * J - E * H * J - E * F * K + D * H * K + E * E * L - D * G * L) / denom; -} - -void least_squares_line_fit(const std::vector & IN_points, - double &line_a, - double &line_b) -{ - - double sumx = 0.; - double sumy = 0.; - double sumxy = 0.; - double sumxx = 0.; - double sumw = 0.; - double W2; - const fit_point2D * point; - - int n = IN_points.size(); - - for (int i = 0; i < n; i++) - { - point = &(IN_points[i]); - W2 = point->w * point->w; - sumx += point->x * point->w ; - sumy += point->y * point->w ; - sumxx += point->x * point->x * W2 ; - sumxy += point->x * point->y * W2 ; - sumw += point->w ; - } - line_a = (sumx*sumy - sumw*sumxy) / (sumx*sumx - sumw*sumxx) ; - line_b = (sumy - line_a*sumx) / sumw ; -} - -/* Bspline fitting --------------------------------------------------------- */ -/* See http://en.wikipedia.org/wiki/Weighted_least_squares */ -void Bspline_model_fitting(const std::vector &IN_points, - int SplineDegree, int l0, int lF, int m0, int mF, - double h_x, double h_y, double x0, double y0, - Bspline_model &result) -{ - // Initialize model - result.l0 = l0; - result.lF = lF; - result.m0 = m0; - result.mF = mF; - result.x0 = x0; - result.y0 = y0; - result.SplineDegree = SplineDegree; - result.h_x = h_x; - result.h_y = h_y; - result.c_ml.initZeros(mF - m0 + 1, lF - l0 + 1); - STARTINGY(result.c_ml) = m0; - STARTINGX(result.c_ml) = l0; - - // Modify the list of points to include the weight - int Npoints = IN_points.size(); - std::vector AUX_points = IN_points; - for (int i = 0; i < Npoints; ++i) - { - double sqrt_w = sqrt(AUX_points[i].w); - AUX_points[i].x *= sqrt_w; - AUX_points[i].y *= sqrt_w; - AUX_points[i].z *= sqrt_w; - } - - // Now solve the normal linear regression problem - // Ax=B - // A=system matrix - // x=B-spline coefficients - // B=vector of measured values - int Ncoeff = YSIZE(result.c_ml) * XSIZE(result.c_ml); - Matrix2D A(Npoints, Ncoeff); - Matrix1D B(Npoints); - for (int i = 0; i < Npoints; ++i) - { - B(i) = AUX_points[i].z; - double xarg = (AUX_points[i].x - x0) / h_x; - double yarg = (AUX_points[i].y - y0) / h_y; - for (int m = m0; m <= mF; ++m) - for (int l = l0; l <= lF; ++l) - { - double coeff=0.; - switch (SplineDegree) - { - case 2: - coeff = Bspline02(xarg - l) * Bspline02(yarg - m); - break; - case 3: - coeff = Bspline03(xarg - l) * Bspline03(yarg - m); - break; - case 4: - coeff = Bspline04(xarg - l) * Bspline04(yarg - m); - break; - case 5: - coeff = Bspline05(xarg - l) * Bspline05(yarg - m); - break; - case 6: - coeff = Bspline06(xarg - l) * Bspline06(yarg - m); - break; - case 7: - coeff = Bspline07(xarg - l) * Bspline07(yarg - m); - break; - case 8: - coeff = Bspline08(xarg - l) * Bspline08(yarg - m); - break; - case 9: - coeff = Bspline09(xarg - l) * Bspline09(yarg - m); - break; - } - A(i, (m - m0)*XSIZE(result.c_ml) + l - l0) = coeff; - } - } - - Matrix1D x = (A.transpose() * A).inv() * (A.transpose() * B); - for (int m = m0; m <= mF; ++m) - for (int l = l0; l <= lF; ++l) - result.c_ml(m, l) = x((m - m0) * XSIZE(result.c_ml) + l - l0); -} - -/* Rectangle enclosing ----------------------------------------------------- */ -void rectangle_enclosing(const Matrix1D &v0, const Matrix1D &vF, - const Matrix2D &V, Matrix1D &corner1, - Matrix1D &corner2) -{ - SPEED_UP_temps01; - Matrix1D v(2); - corner1.resize(2); - corner2.resize(2); - - // Store values for reusing input as output vectors - double XX_v0 = XX(v0); - double YY_v0 = YY(v0); - double XX_vF = XX(vF); - double YY_vF = YY(vF); - - VECTOR_R2(v, XX_v0, YY_v0); - M2x2_BY_V2x1(v, V, v); - XX(corner1) = XX(v); - XX(corner2) = XX(v); - YY(corner1) = YY(v); - YY(corner2) = YY(v); - -#define DEFORM_AND_CHOOSE_CORNERS2D \ - M2x2_BY_V2x1(v,V,v); \ - XX(corner1)=XMIPP_MIN(XX(corner1),XX(v)); \ - XX(corner2)=XMIPP_MAX(XX(corner2),XX(v)); \ - YY(corner1)=XMIPP_MIN(YY(corner1),YY(v)); \ - YY(corner2)=XMIPP_MAX(YY(corner2),YY(v)); - - VECTOR_R2(v, XX_vF, YY_v0); - DEFORM_AND_CHOOSE_CORNERS2D; - VECTOR_R2(v, XX_v0, YY_vF); - DEFORM_AND_CHOOSE_CORNERS2D; - VECTOR_R2(v, XX_vF, YY_vF); - DEFORM_AND_CHOOSE_CORNERS2D; -} - -/* Rectangle enclosing ----------------------------------------------------- */ -void box_enclosing(const Matrix1D &v0, const Matrix1D &vF, - const Matrix2D &V, Matrix1D &corner1, - Matrix1D &corner2) -{ - SPEED_UP_temps012; - Matrix1D v(3); - corner1.resize(3); - corner2.resize(3); - - // Store values for reusing input as output vectors - double XX_v0 = XX(v0); - double YY_v0 = YY(v0); - double ZZ_v0 = ZZ(v0); - double XX_vF = XX(vF); - double YY_vF = YY(vF); - double ZZ_vF = ZZ(vF); - - VECTOR_R3(v, XX_v0, YY_v0, ZZ_v0); - M3x3_BY_V3x1(v, V, v); - XX(corner1) = XX(v); - XX(corner2) = XX(v); - YY(corner1) = YY(v); - YY(corner2) = YY(v); - ZZ(corner1) = ZZ(v); - ZZ(corner2) = ZZ(v); - -#define DEFORM_AND_CHOOSE_CORNERS3D \ - M3x3_BY_V3x1(v,V,v); \ - XX(corner1)=XMIPP_MIN(XX(corner1),XX(v)); \ - XX(corner2)=XMIPP_MAX(XX(corner2),XX(v)); \ - YY(corner1)=XMIPP_MIN(YY(corner1),YY(v)); \ - YY(corner2)=XMIPP_MAX(YY(corner2),YY(v)); \ - ZZ(corner1)=XMIPP_MIN(ZZ(corner1),ZZ(v)); \ - ZZ(corner2)=XMIPP_MAX(ZZ(corner2),ZZ(v)); - - VECTOR_R3(v, XX_vF, YY_v0, ZZ_v0); - DEFORM_AND_CHOOSE_CORNERS3D; - VECTOR_R3(v, XX_v0, YY_vF, ZZ_v0); - DEFORM_AND_CHOOSE_CORNERS3D; - VECTOR_R3(v, XX_vF, YY_vF, ZZ_v0); - DEFORM_AND_CHOOSE_CORNERS3D; - VECTOR_R3(v, XX_v0, YY_v0, ZZ_vF); - DEFORM_AND_CHOOSE_CORNERS3D; - VECTOR_R3(v, XX_vF, YY_v0, ZZ_vF); - DEFORM_AND_CHOOSE_CORNERS3D; - VECTOR_R3(v, XX_v0, YY_vF, ZZ_vF); - DEFORM_AND_CHOOSE_CORNERS3D; - VECTOR_R3(v, XX_vF, YY_vF, ZZ_vF); - DEFORM_AND_CHOOSE_CORNERS3D; -} - -/* Point inside polygon ---------------------------------------------------- */ -bool point_inside_polygon(const std::vector< Matrix1D > &polygon, - const Matrix1D &point) -{ - size_t i, j; - bool retval = false; - for (i = 0, j = polygon.size() - 1; i < polygon.size(); j = i++) - { - if ((((YY(polygon[i]) <= YY(point)) && (YY(point) < YY(polygon[j]))) || - ((YY(polygon[j]) <= YY(point)) && (YY(point) < YY(polygon[i])))) && - (XX(point) < (XX(polygon[j]) - XX(polygon[i])) * - (YY(point) - YY(polygon[i])) / - (YY(polygon[j]) - YY(polygon[i])) + XX(polygon[i]))) - retval = !retval; - } - return retval; -} - -/* Affine transformation ---------------------------------------------------*/ -/* - * Given a point u = (ux, uy), its affine point, t = (tx,ty) is defined as t = Au + T, where, A is a 2x2 matrix, and T a translation vector - * An affinity is completely determined though three pairs of pois u-t {u1-t1, u2-t2, u3,t3}. - * This function makes uses of these three pairs and return the matrix A and the translation T - */ -void def_affinity(double u1x, double u1y, double u2x, double u2y, double u3x, double u3y, double t1x, - double t1y, double t2x, double t2y, double t3x, double t3y, Matrix2D &A, Matrix1D &T, Matrix2D &invW) -{ - double den = (u1x*u2y - u1y*u2x - u1x*u3y + u1y*u3x + u2x*u3y - u2y*u3x); - - //std::cout << "den" < t_vec; - t_vec.initZeros(6); - VEC_ELEM(t_vec,0) = t1x; - VEC_ELEM(t_vec,1) = t2x; - VEC_ELEM(t_vec,2) = t3x; - VEC_ELEM(t_vec,3) = t1y; - VEC_ELEM(t_vec,4) = t2y; - VEC_ELEM(t_vec,5) = t3y; - - double dettt = invW.det(); - //std::cout << "determinant" << dettt << std::endl; - - //Matrix1D sol = invW*t_vec; - //std::cout << "sol = " << sol << std::endl; - - if (fabs(dettt) < DBL_EPSILON ) - { - //std::cout << "I'm in if" << std::endl; - A.initZeros(2,2); - T.initZeros(2); - VEC_ELEM(T,0) = DBL_MAX ; - VEC_ELEM(T,1) = DBL_MAX ; - } - else - { - //std::cout << "I'm in else" << std::endl; - Matrix1D sol = invW*t_vec; - //std::cout << "sol = " << sol << std::endl; - - A.initZeros(2,2); - T.initZeros(2); - //std::cout << A << std::endl; - MAT_ELEM(A,0,0) = VEC_ELEM(sol,0); - MAT_ELEM(A,0,1) = VEC_ELEM(sol,1); - MAT_ELEM(A,1,0) = VEC_ELEM(sol,2); - MAT_ELEM(A,1,1) = VEC_ELEM(sol,3); - VEC_ELEM(T,0) = VEC_ELEM(sol,4); - VEC_ELEM(T,1) = VEC_ELEM(sol,5); - - //std::cout << "A ==" << sol << std::endl; - } -} - - - - -/* Area of a triangle ------------------------------------------------------ */ -/*Given the coordinates (x1,y1), (x2,y2), (x3,y3), of three points, this function calculates the area of the triangle*/ -double triangle_area(double x1, double y1, double x2, double y2, double x3, double y3) -{ - double trigarea = ((x2 - x1)*(y3 - y1) - (x3 - x1)*(y2 - y1))/2; - return (trigarea > 0) ? trigarea : -trigarea; -} - -/* Line Plane Intersection ------------------------------------------------- */ -/*Let ax+by+cz+D=0 the equation of your plane -(if your plane is defined by a normal vector N + one point M, then -(a,b,c) are the coordinates of the normal N, and d is calculated by using -the coordinates of M in the above equation). - -Let your line be defined by one point P(d,e,f) and a vector V(u,v,w), the -points on your line are those which verify - -x=d+lu -y=e+lv -z=f+lw -where l takes all real values. - -for this point to be on the plane, you have to have - -ax+by+cz+D=0, so, - -a(d+lu)+b(e+lv)+c(f+lw)+D=0 -that is - -l(au+bv+cw)=-(ad+be+cf+D) - -note that, if au+bv+cw=0, then your line is either in the plane, or -parallel to it... otherwise you get the value of l, and the intersection -has coordinates: -x=d+lu -y=e+lv -z=f+lw -where - -l = -(ad+be+cf+D)/(au+bv+cw) - -a= XX(normal_plane); -b= YY(normal_plane); -c= ZZ(normal_plane); -D= intersection_point; - -d=XX(point_line) -e=YY(point_line) -f=ZZ(point_line) - -u=XX(vector_line); -v=YY(vector_line); -w=ZZ(vector_line); - -XX(intersection_point)=x; -YY(intersection_point)=y; -ZZ(intersection_point)=z; - -return 0 if sucessful -return -1 if line parallel to plane -return +1 if line in the plane - -TEST data (1) - - point_line = (1,2,3) - vector_line = (2,3,4) - - normal_line= (5,6,7) - point_plane_at_x_y_zero = 0 - - Point of interesection (-0.35714,-0.035714,0.28571 -TEST data (2) - Same but change - vector_line = (-1.2,1.,0.) -TEST data (3) - Same but change - vector_line = (-1.2,1.,0.) - point_line = (0,0,0) -*/ -int line_plane_intersection(const Matrix1D normal_plane, - const Matrix1D vector_line, - Matrix1D &intersection_point, - const Matrix1D point_line, - double point_plane_at_x_y_zero) -{ - double l; - intersection_point.resize(3); - // if au+bv+cw=0, then your line is either in the plane, or - // parallel to it - if (ABS(dotProduct(normal_plane, vector_line)) < XMIPP_EQUAL_ACCURACY) - { - intersection_point = point_line + vector_line; - if (ABS(dotProduct(intersection_point, normal_plane) + - point_plane_at_x_y_zero) < XMIPP_EQUAL_ACCURACY) - return(1); - else - return(-1); - - } - //compute intersection - l = -1.0 * dotProduct(point_line, normal_plane) + - point_plane_at_x_y_zero; - l /= dotProduct(normal_plane, vector_line); - - intersection_point = point_line + l * vector_line; - return(0); -} - - -/* ######################################################################### */ -/* Euler Operations */ -/* ######################################################################### */ - -/* Euler angles --> matrix ------------------------------------------------- */ -template -void Euler_angles2matrix(T alpha, T beta, T gamma, - Matrix2D &A, bool homogeneous) -{ - static_assert(std::is_floating_point::value, "Only float and double are allowed as template parameters"); - - if (homogeneous) - { - A.initZeros(4,4); - MAT_ELEM(A,3,3)=1; - } - else - if (MAT_XSIZE(A) != 3 || MAT_YSIZE(A) != 3) - A.resizeNoCopy(3, 3); - - T ca = std::cos(DEG2RAD(alpha)); - T sa = std::sin(DEG2RAD(alpha)); - T cb = std::cos(DEG2RAD(beta)); - T sb = std::sin(DEG2RAD(beta)); - T cg = std::cos(DEG2RAD(gamma)); - T sg = std::sin(DEG2RAD(gamma)); - - T cc = cb * ca; - T cs = cb * sa; - T sc = sb * ca; - T ss = sb * sa; - - MAT_ELEM(A, 0, 0) = cg * cc - sg * sa; - MAT_ELEM(A, 0, 1) = cg * cs + sg * ca; - MAT_ELEM(A, 0, 2) = -cg * sb; - MAT_ELEM(A, 1, 0) = -sg * cc - cg * sa; - MAT_ELEM(A, 1, 1) = -sg * cs + cg * ca; - MAT_ELEM(A, 1, 2) = sg * sb; - MAT_ELEM(A, 2, 0) = sc; - MAT_ELEM(A, 2, 1) = ss; - MAT_ELEM(A, 2, 2) = cb; -} - -void Euler_anglesZXZ2matrix(double a, double b, double g, Matrix2D< double >& A, bool homogeneous) -{ - Matrix2D RZ1, RX2, RZ3; - rotation3DMatrix(a,'Z',RZ1,homogeneous); - rotation3DMatrix(b,'X',RX2,homogeneous); - rotation3DMatrix(g,'Z',RZ3,homogeneous); - A=RZ3*RX2*RZ1; -} - -/* Euler distance ---------------------------------------------------------- */ -double Euler_distanceBetweenMatrices(const Matrix2D &E1, - const Matrix2D &E2) -{ - double retval=0; - FOR_ALL_ELEMENTS_IN_MATRIX2D(E1) - retval+=MAT_ELEM(E1,i,j)*MAT_ELEM(E2,i,j); - return retval/3.0; -} - -template -T Euler_distanceBetweenAngleSets(T rot1, T tilt1, T psi1, - T rot2, T tilt2, T psi2, - bool only_projdir) -{ - static_assert(std::is_floating_point::value, "Only float and double are allowed as template parameters"); - - Matrix2D E1, E2; - Euler_angles2matrix(rot1, tilt1, psi1, E1, false); - return Euler_distanceBetweenAngleSets_fast(E1,rot2,tilt2,psi2,only_projdir,E2); -} - -template -T Euler_distanceBetweenAngleSets_fast(const Matrix2D &E1, - T rot2, T tilt2, T psi2, - bool only_projdir, Matrix2D &E2) -{ - static_assert(std::is_floating_point::value, "Only float and double are allowed as template parameters"); - - Euler_angles2matrix(rot2, tilt2, psi2, E2, false); - T aux=MAT_ELEM(E1,2,0)*MAT_ELEM(E2,2,0)+ - MAT_ELEM(E1,2,1)*MAT_ELEM(E2,2,1)+ - MAT_ELEM(E1,2,2)*MAT_ELEM(E2,2,2); - T axes_dist=std::acos(CLIP(aux, -1, 1)); - if (!only_projdir) - { - for (int i = 0; i < 2; i++) - { - T aux=MAT_ELEM(E1,i,0)*MAT_ELEM(E2,i,0)+ - MAT_ELEM(E1,i,1)*MAT_ELEM(E2,i,1)+ - MAT_ELEM(E1,i,2)*MAT_ELEM(E2,i,2); - T dist=acos(CLIP(aux, -1, 1)); - axes_dist += dist; - } - axes_dist /= 3.0; - } - return RAD2DEG(axes_dist); -} - - -/* Euler direction --------------------------------------------------------- */ -void Euler_direction(double alpha, double beta, double gamma, - Matrix1D &v) -{ - double ca, sa, cb, sb; - double sc, ss; - - v.resize(3); - alpha = DEG2RAD(alpha); - beta = DEG2RAD(beta); - - ca = cos(alpha); - cb = cos(beta); - sa = sin(alpha); - sb = sin(beta); - sc = sb * ca; - ss = sb * sa; - - v(0) = sc; - v(1) = ss; - v(2) = cb; -} - -/* Euler direction2angles ------------------------------- */ -//gamma is useless but I keep it for simmetry -//with Euler_direction -void Euler_direction2angles(Matrix1D &v0, - double &alpha, double &beta, double &gamma) -{ - double abs_ca, sb, cb; - double aux_alpha; - double aux_beta; - double error, newerror; - Matrix1D v_aux; - Matrix1D v; - - //if not normalized do it so - v.resize(3); - v = v0; - v.selfNormalize(); - - v_aux.resize(3); - cb = v(2); - - if (fabs((cb)) > 0.999847695)/*one degree */ - { - std::cerr << "\nWARNING: Routine Euler_direction2angles is not reliable\n" - "for small tilt angles. Up to 0.001 deg it should be OK\n" - "for most applications but you never know"; - } - - if (fabs((cb - 1.)) < FLT_EPSILON) - { - alpha = 0.; - beta = 0.; - } - else - {/*1*/ - - aux_beta = acos(cb); /* beta between 0 and PI */ - - - sb = sin(aux_beta); - - abs_ca = fabs(v(0)) / sb; - if (fabs((abs_ca - 1.)) < FLT_EPSILON) - aux_alpha = 0.; - else - aux_alpha = acos(abs_ca); - - v_aux(0) = sin(aux_beta) * cos(aux_alpha); - v_aux(1) = sin(aux_beta) * sin(aux_alpha); - v_aux(2) = cos(aux_beta); - - error = fabs(dotProduct(v, v_aux) - 1.); - alpha = aux_alpha; - beta = aux_beta; - - v_aux(0) = sin(aux_beta) * cos(-1. * aux_alpha); - v_aux(1) = sin(aux_beta) * sin(-1. * aux_alpha); - v_aux(2) = cos(aux_beta); - newerror = fabs(dotProduct(v, v_aux) - 1.); - if (error > newerror) - { - alpha = -1. * aux_alpha; - beta = aux_beta; - error = newerror; - } - - v_aux(0) = sin(-aux_beta) * cos(-1. * aux_alpha); - v_aux(1) = sin(-aux_beta) * sin(-1. * aux_alpha); - v_aux(2) = cos(-aux_beta); - newerror = fabs(dotProduct(v, v_aux) - 1.); - if (error > newerror) - { - alpha = -1. * aux_alpha; - beta = -1. * aux_beta; - error = newerror; - } - - v_aux(0) = sin(-aux_beta) * cos(aux_alpha); - v_aux(1) = sin(-aux_beta) * sin(aux_alpha); - v_aux(2) = cos(-aux_beta); - newerror = fabs(dotProduct(v, v_aux) - 1.); - - if (error > newerror) - { - alpha = aux_alpha; - beta = -1. * aux_beta; - } - }/*else 1 end*/ - gamma = 0.; - beta = RAD2DEG(beta); - alpha = RAD2DEG(alpha); -}/*Eulerdirection2angles end*/ - -/* Matrix --> Euler angles ------------------------------------------------- */ -#define CHECK -//#define DEBUG -void Euler_matrix2angles(const Matrix2D &A, double &alpha, - double &beta, double &gamma,bool homogeneous) -{ - double abs_sb, sign_sb; - - if (homogeneous) - if (MAT_XSIZE(A) != 4 || MAT_YSIZE(A) != 4) - REPORT_ERROR(ERR_MATRIX_SIZE, "Euler_matrix2angles: The Euler matrix is not 4x4"); - else - if (MAT_XSIZE(A) != 3 || MAT_YSIZE(A) != 3) - REPORT_ERROR(ERR_MATRIX_SIZE, "Euler_matrix2angles: The Euler matrix is not 3x3"); - - abs_sb = sqrt(A(0, 2) * A(0, 2) + A(1, 2) * A(1, 2)); - if (abs_sb > 16*FLT_EPSILON) - { - gamma = atan2(A(1, 2), -A(0, 2)); - alpha = atan2(A(2, 1), A(2, 0)); - if (ABS(sin(gamma)) < FLT_EPSILON) - sign_sb = SGN(-A(0, 2) / cos(gamma)); - // if (sin(alpha)0) ? SGN(A(2,1)):-SGN(A(2,1)); - else - sign_sb = (sin(gamma) > 0) ? SGN(A(1, 2)) : -SGN(A(1, 2)); - beta = atan2(sign_sb * abs_sb, A(2, 2)); - } - else - { - if (SGN(A(2, 2)) > 0) - { - // Let's consider the matrix as a rotation around Z - alpha = 0; - beta = 0; - gamma = atan2(-A(1, 0), A(0, 0)); - } - else - { - alpha = 0; - beta = PI; - gamma = atan2(A(1, 0), -A(0, 0)); - } - } - - gamma = RAD2DEG(gamma); - beta = RAD2DEG(beta); - alpha = RAD2DEG(alpha); - -#ifdef double - - Matrix2D Ap; - Euler_angles2matrix(alpha, beta, gamma, Ap); - if (A != Ap) - { - std::cout << "---\n"; - std::cout << "Euler_matrix2angles: I have computed angles " - " which doesn't match with the original matrix\n"; - std::cout << "Original matrix\n" << A; - std::cout << "Computed angles alpha=" << alpha << " beta=" << beta - << " gamma=" << gamma << std::endl; - std::cout << "New matrix\n" << Ap; - std::cout << "---\n"; - } -#endif - -#ifdef DEBUG - std::cout << "abs_sb " << abs_sb << std::endl; - std::cout << "A(1,2) " << A(1, 2) << " A(0,2) " << A(0, 2) << " gamma " - << gamma << std::endl; - std::cout << "A(2,1) " << A(2, 1) << " A(2,0) " << A(2, 0) << " alpha " - << alpha << std::endl; - std::cout << "sign sb " << sign_sb << " A(2,2) " << A(2, 2) - << " beta " << beta << std::endl; -#endif -} -#undef CHECK -#undef DEBUG - -#ifdef NEVERDEFINED -// Michael's method -void Euler_matrix2angles(Matrix2D A, double *alpha, double *beta, - double *gamma) -{ - double abs_sb; - - if (ABS(A(1, 1)) > FLT_EPSILON) - { - abs_sb = sqrt((-A(2, 2) * A(1, 2) * A(2, 1) - A(0, 2) * A(2, 0)) / A(1, 1)); - } - else if (ABS(A(0, 1)) > FLT_EPSILON) - { - abs_sb = sqrt((-A(2, 1) * A(2, 2) * A(0, 2) + A(2, 0) * A(1, 2)) / A(0, 1)); - } - else if (ABS(A(0, 0)) > FLT_EPSILON) - { - abs_sb = sqrt((-A(2, 0) * A(2, 2) * A(0, 2) - A(2, 1) * A(1, 2)) / A(0, 0)); - } - else - EXIT_ERROR(1, "Don't know how to extract angles"); - - if (abs_sb > FLT_EPSILON) - { - *beta = atan2(abs_sb, A(2, 2)); - *alpha = atan2(A(2, 1) / abs_sb, A(2, 0) / abs_sb); - *gamma = atan2(A(1, 2) / abs_sb, -A(0, 2) / abs_sb); - } - else - { - *alpha = 0; - *beta = 0; - *gamma = atan2(A(1, 0), A(0, 0)); - } - - *gamma = rad2deg(*gamma); - *beta = rad2deg(*beta); - *alpha = rad2deg(*alpha); -} -#endif -void Euler_Angles_after_compresion(const double rot, double tilt, double psi, - double &new_rot, double &new_tilt, double &new_psi, Matrix2D &D) -{ - Matrix1D w(3); - Matrix1D new_w(3); - Matrix2D D_1(3, 3); - - //if D has not inverse we are not in business - D_1 = D.inv(); - - Euler_direction(rot, tilt, psi, w); - if (fabs(w(2)) > 0.999847695)/*cos one degree */ - { - Euler_direction(rot, 10., psi, w); - new_w = (Matrix1D)(D_1 * w) / ((D_1 * w).module()); - Euler_direction2angles(new_w, new_rot, new_tilt, new_psi); - - Euler_direction(rot, tilt, psi, w); - new_w = (Matrix1D)((D_1 * w) / ((D_1 * w).module())); - new_tilt = SGN(new_tilt) * fabs(ACOSD(new_w(2))); - new_psi = psi; - - // so, for small tilt the value of the rot is not realiable - // doubleo overcome this problem I first calculate the rot for - // any arbitrary large tilt angle and the right rotation - // and then I calculate the new tilt. - // Please notice that the new_rotation is not a funcion of - // the old tilt angle so I can use any arbitrary tilt angle - } - else - { - new_w = (Matrix1D)(D_1 * w) / ((D_1 * w).module()); - Euler_direction2angles(new_w, new_rot, new_tilt, new_psi); - new_psi = psi; - } -} - -/* Euler up-down correction ------------------------------------------------ */ -void Euler_up_down(double rot, double tilt, double psi, - double &newrot, double &newtilt, double &newpsi) -{ - newrot = rot; - newtilt = tilt + 180; - newpsi = -(180 + psi); -} - -/* Same view, differently expressed ---------------------------------------- */ -void Euler_another_set(double rot, double tilt, double psi, - double &newrot, double &newtilt, double &newpsi) -{ - newrot = rot + 180; - newtilt = -tilt; - newpsi = -180 + psi; -} - -/* Euler mirror Y ---------------------------------------------------------- */ -void Euler_mirrorY(double rot, double tilt, double psi, - double &newrot, double &newtilt, double &newpsi) -{ - newrot = rot; - newtilt = tilt + 180; - newpsi = -psi; -} - -/* Euler mirror X ---------------------------------------------------------- */ -void Euler_mirrorX(double rot, double tilt, double psi, - double &newrot, double &newtilt, double &newpsi) -{ - newrot = rot; - newtilt = tilt + 180; - newpsi = 180 - psi; -} - -/* Euler mirror XY --------------------------------------------------------- */ -void Euler_mirrorXY(double rot, double tilt, double psi, - double &newrot, double &newtilt, double &newpsi) -{ - newrot = rot; - newtilt = tilt; - newpsi = 180 + psi; -} - -/* Apply a transformation matrix to Euler angles --------------------------- */ -void Euler_apply_transf(const Matrix2D &L, - const Matrix2D &R, - double rot, - double tilt, - double psi, - double &newrot, - double &newtilt, - double &newpsi) -{ - - Matrix2D euler(3, 3), temp; - Euler_angles2matrix(rot, tilt, psi, euler); - temp = L * euler * R; - Euler_matrix2angles(temp, newrot, newtilt, newpsi); -} - - -//void Euler_rotation3DMatrix(double rot, double tilt, double psi, Matrix2D &result) -//{ -// Euler_angles2matrix(rot, tilt, psi, result, true); -//} - -/* Rotate (3D) MultidimArray with 3 Euler angles ------------------------------------- */ -void Euler_rotate(const MultidimArray &V, double rot, double tilt, double psi, - MultidimArray &result) -{ - Matrix2D R; - Euler_angles2matrix(rot, tilt, psi, R, true); - applyGeometry(1, result, V, R, xmipp_transformation::IS_NOT_INV, xmipp_transformation::DONT_WRAP); -} -void Euler_rotate(const MultidimArrayGeneric &V, double rot, double tilt, double psi, - MultidimArray &result) -{ - Matrix2D R; - Euler_angles2matrix(rot, tilt, psi, R, true); -#define APPLYGEO(type) applyGeometry(1, result, *((MultidimArray *)V.im), R, xmipp_transformation::IS_NOT_INV, xmipp_transformation::DONT_WRAP); - SWITCHDATATYPE(V.datatype, APPLYGEO) -#undef APPLYGEO -} - -void computeCircleAroundE(const Matrix2D &E, - double angCircle, double angStep, std::vector &outputEulerAngles) -{ - outputEulerAngles.clear(); - - // Get the projection direction and a perpendicular direction - Matrix1D projectionDirection, perpendicular; - E.getRow(1,perpendicular); - E.getRow(2,projectionDirection); - Matrix2D newEt; - newEt = E.transpose(); - Matrix2D rotStep, sampling; - rotation3DMatrix(angCircle,perpendicular,rotStep,false); - rotation3DMatrix(angStep,projectionDirection,sampling,false); - - // Now rotate - newEt = rotStep*newEt; - for (double i = 0; i < 360; i += angStep) - { - newEt=sampling*newEt; - - // Normalize - for (int c=0; c<3; c++) - { - Matrix1D aux; - newEt.getCol(c,aux); - aux/=aux.module(); - newEt.setCol(c,aux); - } - Matrix2D newE=newEt.transpose(); - - double newrot, newtilt, newpsi; - Euler_matrix2angles(newE,newrot,newtilt,newpsi); - outputEulerAngles.push_back(newrot); - outputEulerAngles.push_back(newtilt); - outputEulerAngles.push_back(newpsi); - } -} - -/* ######################################################################### */ -/* Intersections */ -/* ######################################################################### */ - -/* Intersection with a unit sphere ----------------------------------------- */ -double intersection_unit_sphere( - const Matrix1D &u, // direction - const Matrix1D &r) // passing point -{ - - // Some useful constants - double A = XX(u) * XX(u) + YY(u) * YY(u) + ZZ(u) * ZZ(u); - double B = XX(r) * XX(u) + YY(r) * YY(u) + ZZ(r) * ZZ(u); - double C = XX(r) * XX(r) + YY(r) * YY(r) + ZZ(r) * ZZ(r) - 1.0; - double B2_AC = B * B - A * C; - - // A degenerate case? - if (A == 0) - { - if (B == 0) - return -1; // The ellipsoid doesn't intersect - return 0; // The ellipsoid is tangent at t=-C/2B - } - if (B2_AC < 0) - return -1; - - // A normal intersection - B2_AC = sqrt(B2_AC); - double t1 = (-B - B2_AC) / A; // The two parameters within the line for - double t2 = (-B + B2_AC) / A; // the solution - return ABS(t2 -t1); -} - -/* Intersection with a unit cylinder --------------------------------------- */ -double intersection_unit_cylinder( - const Matrix1D &u, // direction - const Matrix1D &r) // passing point -{ - // Intersect with an infinite cylinder of radius=ry - double A = XX(u) * XX(u) + YY(u) * YY(u); - double B = XX(r) * XX(u) + YY(r) * YY(u); - double C = XX(r) * XX(r) + YY(r) * YY(r) - 1; - - double B2_AC = B * B - A * C; - if (A == 0) - { - if (C > 0) - return 0; // Parallel ray outside the cylinder - else - return 1 / ZZ(u); // return height - } - else if (B2_AC < 0) - return 0; - B2_AC = sqrt(B2_AC); - - // Points at intersection - double t1 = (-B - B2_AC) / A; - double t2 = (-B + B2_AC) / A; - double z1 = ZZ(r) + t1 * ZZ(u); - double z2 = ZZ(r) + t2 * ZZ(u); - - // Check position of the intersecting points with respect to - // the finite cylinder, if any is outside correct it to the - // right place in the top or bottom of the cylinder - if (ABS(z1) >= 0.5) - t1 = (SGN(z1) * 0.5 - ZZ(r)) / ZZ(u); - if (ABS(z2) >= 0.5) - t2 = (SGN(z2) * 0.5 - ZZ(r)) / ZZ(u); - - return ABS(t1 -t2); -} - -/* Intersection with a unit cube ------------------------------------------- */ -double intersection_unit_cube( - const Matrix1D &u, // direction - const Matrix1D &r) // passing point -{ - double t1=0., t2=0., t; - int found_t = 0; - -#define ASSIGN_IF_GOOD_ONE \ - if (fabs(XX(r)+t*XX(u))-XMIPP_EQUAL_ACCURACY<=0.5 && \ - fabs(YY(r)+t*YY(u))-XMIPP_EQUAL_ACCURACY<=0.5 && \ - fabs(ZZ(r)+t*ZZ(u))-XMIPP_EQUAL_ACCURACY<=0.5) {\ - if (found_t==0) {found_t++; t1=t;} \ - else if (found_t==1) {found_t++; t2=t;} \ - } - - // Intersect with x=0.5 and x=-0.5 - if (XX(u) != 0) - { - t = (0.5 - XX(r)) / XX(u); - ASSIGN_IF_GOOD_ONE; - t = (-0.5 - XX(r)) / XX(u); - ASSIGN_IF_GOOD_ONE; - } - - // Intersect with y=0.5 and y=-0.5 - if (YY(u) != 0 && found_t != 2) - { - t = (0.5 - YY(r)) / YY(u); - ASSIGN_IF_GOOD_ONE; - t = (-0.5 - YY(r)) / YY(u); - ASSIGN_IF_GOOD_ONE; - } - - // Intersect with z=0.5 and z=-0.5 - if (ZZ(u) != 0 && found_t != 2) - { - t = (0.5 - ZZ(r)) / ZZ(u); - ASSIGN_IF_GOOD_ONE; - t = (-0.5 - ZZ(r)) / ZZ(u); - ASSIGN_IF_GOOD_ONE; - } - - if (found_t == 2) - return fabs(t1 -t2); - else - return 0; -} - -double Bspline_model::evaluate(double x, double y) const -{ - int SplineDegree_1 = SplineDegree - 1; - double x_arg = (x - x0) / h_x; - double y_arg = (y - y0) / h_y; - - int l1 = CLIP(CEIL(x_arg - SplineDegree_1), l0, lF); - int l2 = CLIP(l1 + SplineDegree, l0, lF); - int m1 = CLIP(CEIL(y_arg - SplineDegree_1), m0, mF); - int m2 = CLIP(m1 + SplineDegree, m0, mF); - double columns = 0.0; - for (int m = m1; m <= m2; m++) - { - double rows = 0.0; - for (int l = l1; l <= l2; l++) - { - double xminusl = x_arg - (double)l; - double Coeff = c_ml(m, l); - switch (SplineDegree) - { - case 2: - rows += Coeff * Bspline02(xminusl); - break; - case 3: - rows += Coeff * Bspline03(xminusl); - break; - case 4: - rows += Coeff * Bspline04(xminusl); - break; - case 5: - rows += Coeff * Bspline05(xminusl); - break; - case 6: - rows += Coeff * Bspline06(xminusl); - break; - case 7: - rows += Coeff * Bspline07(xminusl); - break; - case 8: - rows += Coeff * Bspline08(xminusl); - break; - case 9: - rows += Coeff * Bspline09(xminusl); - break; - } - } - - double yminusm = y_arg - (double)m; - switch (SplineDegree) - { - case 2: - columns += rows * Bspline02(yminusm); - break; - case 3: - columns += rows * Bspline03(yminusm); - break; - case 4: - columns += rows * Bspline04(yminusm); - break; - case 5: - columns += rows * Bspline05(yminusm); - break; - case 6: - columns += rows * Bspline06(yminusm); - break; - case 7: - columns += rows * Bspline07(yminusm); - break; - case 8: - columns += rows * Bspline08(yminusm); - break; - case 9: - columns += rows * Bspline09(yminusm); - break; - } - } - return columns; -} - -// explicit instantiation -template void Euler_angles2matrix(double, double, double, Matrix2D&, bool); -template void Euler_angles2matrix(float, float, float, Matrix2D&, bool); -template float Euler_distanceBetweenAngleSets( - float rot1, float tilt1, float psi1, float rot2, float tilt2, float psi2, - bool only_projdir); -template double Euler_distanceBetweenAngleSets( - double rot1, double tilt1, double psi1, double rot2, double tilt2, double psi2, - bool only_projdir); -template double Euler_distanceBetweenAngleSets_fast( - const Matrix2D &E1, double rot2, double tilt2, double psi2, - bool only_projdir, Matrix2D &E2); diff --git a/src/core/geometry.h b/src/core/geometry.h deleted file mode 100644 index 6c57b6b..0000000 --- a/src/core/geometry.h +++ /dev/null @@ -1,845 +0,0 @@ -/*************************************************************************** -* -* Authors: Carlos Oscar S. Sorzano (coss@cnb.csic.es) -* -* Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC -* -* This program is free software; you can redistribute it and/or modify -* it under the terms of the GNU General Public License as published by -* the Free Software Foundation; either version 2 of the License, or -* (at your option) any later version. -* -* This program is distributed in the hope that it will be useful, -* but WITHOUT ANY WARRANTY; without even the implied warranty of -* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -* GNU General Public License for more details. -* -* You should have received a copy of the GNU General Public License -* along with this program; if not, write to the Free Software -* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA -* 02111-1307 USA -* -* All comments concerning this program package may be sent to the -* e-mail address 'xmipp@cnb.csic.es' -***************************************************************************/ - -#ifndef CORE_GEOMETRY_H -#define CORE_GEOMETRY_H - -#include "multidim_array.h" -#include "multidim_array_generic.h" - -#ifndef FLT_EPSILON -#define FLT_EPSILON 1.19209e-07 -#endif - -#include -#include - -/// @defgroup Geometry Geometry -/// @ingroup DataLibrary -//@{ -/// @name Geometrical operations -/// @{ - -/** Project a point to a plane (direction vector, distance) - * - * Given the coordinates for a vector in R3, and a plane (defined by its - * direction vector and the minimum distance from the plane to the coordinate - * system origin). This function computes the perpendicular projection from the - * vector to the plane. This function has tried to be optimized in speed as it - * is used in core routines within huge loops, this is why the result is given - * as an argument, and why no check about the dimensionality of the vectors is - * performed. The routine performs faster if the result vector is already in R3. - * - * The following example projects the point P=(1,1,1) to the XY-plane storing - * the result in Pp (belonging to R3), the result is obviously Pp=(1,1,0). - * - * @code - * Matrix1D< double > Z = vectorR3(0, 0, 1), P = vector_R3(1, 1, 1), Pp(3); - * Uproject_to_plane(P,Z,0,Pp); - * std::cout << "After projecting: Pp=" << Pp.transpose() << std::endl; - * @endcode - * - * The starting U in the function name stands for the fact that the plane and - * the point are in the same reference system (called by default Universal). - * - * The result and point vectors can be the same one. - */ -void Uproject_to_plane(const Matrix1D< double >& point, - const Matrix1D< double >& direction, - double distance, - Matrix1D< double >& result); - -/** Project a vector to a plane (Euler angles) - * - * These planes are restricted to have 0 distance to the universal - * coordinate system. In this special case, a plane can be defined by 3 Euler - * angles (this is specially suited for projections, where the projection plane - * is defined by its 3 Euler angles). Then, the coordinate system associated to - * the 3 Euler angles (let's call its vectors X',Y',Z') defines a projection - * plane where Z' is the direction vector, and X'Y' are in-plane vectors. - * Actually, X' coincides with the X vector in the Matrix2D definition and Y' - * with the Y vector. - * - * The resulting vector is in R3, and the function has been optimized for speed, - * so the result is passed as a parameter. This function is based in the one - * which projects a point given the Euler matrix of the projection plane. If you - * are to project several points to the same plane, you should better use the - * project to plane function where you give the Euler matrix. - * - * The following example projects the point P=(1,1,1) to the XY-plane storing - * the result in Pp (belonging to R3), the result is obviously Pp=(1,1,0). - * - * @code - * Matrix1D< double > P = vectorR3(1, 1, 1), Pp(3); - * Uproject_to_plane(P, 0, 0, 0, Pp); - * std::cout << "After projecting: Pp=" << Pp.transpose() << std::endl; - * @endcode - * - * The starting U in the function name stands for the fact that the plane, and - * the point are in the same reference system (called by default Universal). - * - * The result and point vectors can be the same one. - */ -void Uproject_to_plane(const Matrix1D< double >& r, - double rot, - double tilt, - double psi, - Matrix1D< double >& result); - -/** Project a vector to a plane (Euler matrix) - * - * These planes are restricted to have 0 distance to the universal coordinate - * system. In this special case, a plane can be defined by 3 Euler angles (this - * is specially suited for projections, where the projection plane is defined by - * its 3 Euler angles). Then, the coordinate system associated to the 3 Euler - * angles (let's call its vectors X',Y',Z') defines a projection plane where Z' - * is the direction vector, and X'Y' are in-plane vectors. Actually, X' - * coincides with the X vector in the Matrix2D definition and Y' with the Y - * vector. - * - * The resulting vector is in R3, and the function has been optimized for speed, - * if the result vector is already 3 dimensional when entering the function, no - * resize is performed; and the result is passed as a parameter. If you are to - * project several points to the same plane, you should better use the project - * to plane function where you give the Euler matrix. - * - * The following example projects the point P=(1,1,1) to the XY-plane storing - * the result in Pp (belonging to R3), the result is obviously Pp=(1,1,0). - * - * @code - * Matrix1D< double > P = vectorR3(1, 1, 1), Pp(3); - * Matrix2D< double > euler; - * Euler_angles2matrix(0, 0, 0, euler); - * Uproject_to_plane(P, euler, Pp); - * std::cout << "After projecting: Pp=" << Pp.transpose() << std::endl; - * @endcode - * - * The starting U in the function name stands for the fact that the plane, and - * the point are in the same reference system (called by default Universal). - * - * The result and point vectors can be the same one. - */ -void Uproject_to_plane(const Matrix1D< double >& r, - const Matrix2D< double >& euler, - Matrix1D< double >& result); - -/** Spherical distance - * - * This function returns the distance over a sphere, not the straight line but - * the line which goes from one point to the other going over the surface of a - * sphere, supposing that both points lie on the same sphere. - */ -double spherical_distance(const Matrix1D< double >& r1, - const Matrix1D< double >& r2); - -/** Point to line distance in 3D - * - * Let a line in 3-D be specified by the point a and the vector v, this fuction - * returns the minimum distance of this line to the point p. - */ -double point_line_distance_3D(const Matrix1D< double >& p, - const Matrix1D< double >& a, - const Matrix1D< double >& v); - -/** Point to plane distance in 3D - * - * Let a plane in 3-D be specified by the point a and the perpendicular vector - * v, this fuction returns the minimum distance of this plane to the point p. - */ -inline double point_plane_distance_3D(const Matrix1D< double >& p, - const Matrix1D< double >& a, - const Matrix1D< double >& v) -{ - static Matrix1D< double > p_a(3); - - V3_MINUS_V3(p_a, p, a); - return (dotProduct(p_a, v) / v.module()); -} - -/** Structure of the points to do model fitting - */ -struct FitPoint -{ - /// x coordinate - double x; - /// y coordinate - double y; - /// z coordinate, assumed to be a function of x and y - double z; - /// Weight of the point in the Least-Squares problem - double w; -}; - -/** Least-squares-fit a plane to an arbitrary number of (x,y,z) points - * - * Plane described as Ax + By + C = z - * - * Points are defined using the struct - * - * @code - * struct fit_point - * { - * double x; - * double y; - * double z; - * double w; - * }; - * @endcode - * - * where w is a weighting factor. Set it to 1 if you do not want to use it - */ -void least_squares_plane_fit(FitPoint *IN_points, - int Npoints, - double& plane_A, - double& plane_B, - double& plane_C); - -/** Least-squares-fit a plane to an image - * - * Performs the same computation as least_squares_plane_fit but using - * a complete image instead of only a set of points. - */ -void least_squares_plane_fit_All_Points(const MultidimArray &Image, - double& plane_A, - double& plane_B, - double& plane_C); - -/** Structure of the points to do model fitting - */ -struct fit_point2D -{ - /// x coordinate - double x; - /// y coordinate (assumed to be a function of x) - double y; - /// Weight of the point in the Least-Squares problem - double w; -}; - -/** Least-squares-fit a line to an arbitrary number of (x,y) points - * - * Plane described as Ax + B = y - * - * Points are defined using the struct - * - * @code - * struct fit_point2D - * { - * double x; - * double y; - * double w; - * }; - * @endcode - * - * where w is a weighting factor. Set it to 1 if you do not want to use it - */ -void least_squares_line_fit(const std::vector< fit_point2D >& IN_points, - double& line_A, - double& line_B); - -/** Bspline model class - * - * When you fit a Bspline model this is the type returned. You can use it to - * evaluate it anywhere. - * - * The model is f(x,y)=sum_{l=l0}^{lF} {sum_{m=m0}^{mF} - * {c_{ml}Beta_n((x-x0)/h_x-l) Beta_n((y-y0)/h_y-m) } }. - * - * The parameter n is the Bspline degree. l0, lF, m0 and mF are the Bspline - * indexes. hx and hy are related to the extent of the Bspline. - */ -class Bspline_model -{ -public: - /// l0 - int l0; - /// lF; - int lF; - /// m0 - int m0; - /// mF; - int mF; - - /// x0 - double x0; - /// y0 - double y0; - - /// Order of the Bspline - int SplineDegree; - - /// Scale X - double h_x; - /// Scale Y - double h_y; - - /** Bspline coefficients, c_{ml} - * - * The logical indexes of this matrix go from Y=[m0...mF] and X=[l0...lF] - */ - MultidimArray< double > c_ml; - - /// Evaluate the model at the point (x,y) - double evaluate(double x, double y) const; -}; - -/** Least-squares fit of a B-spline 2D model - * - * For fitting a set of values that are distributed between (x0,y0) and (xF,yF) - * with a cubic Bspline centered on each corner, the right call is - * - * @code - * Bspline_model model; - * Bspline_model_fitting(list_of_points, 3, -1, 2, -1, 2, xF-x0, yF-y0, x0, - * y0, model); - * @endcode - * - * Once the model is returned you can evaluate it at any point simply by - * - * @code - * model.evaluate(x,y); - * @endcode - */ -void Bspline_model_fitting(const std::vector< FitPoint >& IN_points, - int SplineDegree, - int l0, - int lF, - int m0, - int mF, - double h_x, - double h_y, - double x0, - double y0, - Bspline_model& result); - -/** Rectangle which encloses a deformed rectangle - * - * Given a rectangle characterized by the top-left corner and the right-bottom - * corner, and given a matrix after which the rectangle is deformed. Which is - * the minimum rectangle which encloses the preceding one? This function is - * useful for stablishing for loops which will cover for sure the deformed - * rectangle. All vectors are supposed to be 2x1 and the deformation matrix is - * 2x2. The corner (x0,y0) goes to V*(x0,y0)' and (xF,yF) to V*(xf,yF)'. After - * that you can make a loop from corner1 to corner2. - * - * The v0 and vF vectors can be reused as outputs. - */ -void rectangle_enclosing(const Matrix1D< double >& v0, - const Matrix1D< double >& vF, - const Matrix2D< double >& V, - Matrix1D< double >& corner1, - Matrix1D< double >& corner2); - -/** Box which encloses a deformed box - * - * Given a box characterized by the top-left corner (most negative) and the - * right-bottom (most positive) corner, and given a matrix after which the box - * is deformed. Which is the minimum box which encloses the preceding one? This - * function is useful for stablishing for loops which will cover for sure the - * deformed box. All vectors are supposed to be 3x1 and the deformation matrix - * is 3x3. The corner (x0,y0,z0) goes to V*(x0,y0,z0)' and (xF,yF,zF) to - * V*(xf,yF,zF)'. After that you can make a loop from corner1 to corner2. - * - * The v0 and vF vectors can be reused as outputs. - */ -void box_enclosing(const Matrix1D< double >& v0, - const Matrix1D< double >& vF, - const Matrix2D< double >& V, - Matrix1D< double >& corner1, - Matrix1D< double >& corner2); - -/** Point inside polygon - * - * Given a polygon described by a list of points (the last one and the first one - * ust be the same), determine whether another point is inside the polygon or - * not. - */ -bool point_inside_polygon(const std::vector< Matrix1D< double > > & polygon, - const Matrix1D< double >& point); - -/** Affine transformation - * - */ -void def_affinity(double u1x, double u1y, double u2x, double u2y, double u3x, double u3y, double t1x, - double t1y, double t2x, double t2y, double t3x, double t3y, Matrix2D &A, Matrix1D &T, Matrix2D &invW); - - - -/** Area of a triangle - * Given the coordinates of three points this function calculates the area of the triangle - */ -double triangle_area(double x1, double y1, double x2, double y2, double x3, double y3); - -/** Line Plane Intersection - * - * Let ax+by+cz+D=0 be the equation of your plane (if your plane is defined by a - * normal vector N + one point M, then (a,b,c) are the coordinates of the normal - * N, and d is calculated by using the coordinates of M in the above equation). - * - * Let your line be defined by one point P(d,e,f) and a vector V(u,v,w), the - * points on your line are those which verify - * - * x = d + lu - * y = e + lv - * z = f + lw - * - * where l takes all real values. - * - * for this point to be on the plane, you have to have - * - * ax + by + cz + D = 0, so, - * - * a(d + lu) + b(e + lv) + c(f + lw) + D = 0 - * - * that is - * - * l(au + bv + cw) = -(ad + be + cf + D) - * - * note that, if au + bv + cw = 0, then your line is either in the plane, or - * parallel to it... otherwise you get the value of l, and the intersection has - * coordinates: - * - * x = d + lu - * y = e + lv - * z = f + lw - * - * where - * - * l = -(ad + be + cf + D) / (au + bv + cw) - * - * a = XX(normal_plane); - * b = YY(normal_plane); - * c = ZZ(normal_plane); - * D = intersection_point; - * - * d = XX(point_line) - * e = YY(point_line) - * f = ZZ(point_line) - * - * u = XX(vector_line); - * v = YY(vector_line); - * w = ZZ(vector_line); - * - * XX(intersection_point) = x; - * YY(intersection_point) = y; - * ZZ(intersection_point) = z; - * - * return 0 if successful - * return -1 if line parallel to plane - * return +1 if line in the plane - */ -int line_plane_intersection(const Matrix1D< double > normal_plane, - const Matrix1D< double > vector_line, - Matrix1D< double >& intersection_point, - const Matrix1D< double > point_line, - double point_plane_at_x_y_zero = 0.); -//@} - -/// @name Euler operations -/// @{ - -/** Getting the Euler angles to a range (0-360). - * No direction equivalence is applied, ie, there is no correction of the - * direction of projection making use that a view from the top is the same as a - * view from the bottom but reversed ... Just a wrapping of the angles is done - * until the angles fall in the specified ranges. The angles given must be - * variables and they are modified with the new values. - * - */ -#define EULER_CLIPPING(rot,tilt,psi) \ - rot = realWRAP(rot, 0, 360); \ - tilt = realWRAP(tilt, 0, 360); \ - psi = realWRAP(psi, 0, 360); - -/** Getting the Euler angles to a range (0-2*PI). - * - * The same as before but the angles are expressed in radians. - */ -#define EULER_CLIPPING_RAD(rot, tilt, psi) \ - rot = realWRAP(rot, 0, 2.0*PI); \ - tilt = realWRAP(tilt, 0, 2.0*PI); \ - psi = realWRAP(psi, 0, 2.0*PI); - -/** Euler angles --> Euler matrix. - * - * This function returns the transformation matrix associated to the 3 given - * Euler angles (in degrees). - * - * As an implementation note you might like to know that this function calls - * always to Matrix2D::resize - * - * See http://xmipp.cnb.csic.es/twiki/bin/view/Xmipp/EulerAngles for a - * description of the Euler angles. - */ -template -void Euler_angles2matrix(T a, T b, T g, Matrix2D& A, - bool homogeneous=false); - -/** Euler angles --> Euler matrix. - * - * This function returns the transformation matrix associated to the 3 given - * Euler angles (in degrees). - */ -void Euler_anglesZXZ2matrix(double a, double b, double g, Matrix2D< double >& A, - bool homogeneous=false); - -/** Distance between two Euler matrices. - * - * The distance is defined as 1/3*(X1.X2 + Y1.Y2 + Z1.Z2) - */ -double Euler_distanceBetweenMatrices(const Matrix2D &E1, - const Matrix2D &E2); - -/** Average distance between two angle sets. - * If the only_projdir is set, then only the projection direction is considered. - */ -template -T Euler_distanceBetweenAngleSets(T rot1, T tilt1, T psi1, - T rot2, T tilt2, T psi2, - bool only_projdir); - -/** Average distance between two angle sets. - * E1 must contain the Euler matrix corresponding to set1, E2 is used as - * an auxiliary variable for storing the second Euler matrix. - */ -template -T Euler_distanceBetweenAngleSets_fast(const Matrix2D &E1, - T rot2, T tilt2, T psi2, - bool only_projdir, Matrix2D &E2); - -/** Angles after compresion - * - * Let be two volumes f and g related by g(x,y,z) = f(D(x,y,z)) (where D is a - * lineal transformation) then the projection direction parallel to the vector w - * in f is going to be related with the projection direction parallel to the - * vector w_prime in g. Given the w Euler angles this routine provide the - * w_prime angles - */ -void Euler_Angles_after_compresion(const double rot, - double tilt, - double psi, - double& new_rot, - double& new_tilt, - double& new_psi, - Matrix2D< double >& D); - -/** Euler direction - * - * This function returns a vector parallel to the projection direction. - * Resizes v if needed - */ -void Euler_direction(double alpha, - double beta, - double gamma, - Matrix1D< double >& v); - -/** Euler direction2angles - * - * This function returns the 3 Euler angles associated to the direction given by - * the vector v. The 3rd Euler angle is set always to 0 - */ -void Euler_direction2angles(Matrix1D< double >& v, - double& alpha, - double& beta, - double& gamma); - -/** "Euler" matrix --> angles - * - * This function compute a set of Euler angles which result in an "Euler" matrix - * as the one given. See \ref Euler_angles2matrix to know more about how this - * matrix is computed and what each row means. The result angles are in degrees. - * Alpha, beta and gamma are respectively the first, second and third rotation - * angles. If the input matrix is not 3x3 then an exception is thrown, the - * function doesn't check that the Euler matrix is truly representing a - * coordinate system. - * - * @code - * Euler_matrix2angles(Euler, alpha, beta, gamma); - * @endcode - */ -void Euler_matrix2angles(const Matrix2D< double >& A, - double& alpha, - double& beta, - double& gamma,bool homogeneous=false); - -/** Up-Down projection equivalence - * - * As you know a projection view from a point has got its homologous from its - * diametrized point in the projection sphere. This function takes a projection - * defined by its 3 Euler angles and computes an equivalent set of Euler angles - * from which the view is exactly the same but in the other part of the sphere - * (if the projection is taken from the bottom then the new projection from the - * top, and viceversa). The defined projections are exactly the same except for - * a flip over X axis, ie, an up-down inversion. Exactly the correction - * performed is: - * - * @code - * newrot = rot; - * newtilt = tilt + 180; - * newpsi = -(180 + psi); - * @endcode - * - * @code - * Euler_up_down(rot, tilt, psi, newrot, newtilt, newpsi); - * @endcode - */ -void Euler_up_down(double rot, - double tilt, - double psi, - double& newrot, - double& newtilt, - double& newpsi); - -/** The same view but differently expressed - * - * As you know a projection view from a point can be expressed with different - * sets of Euler angles. This function gives you another expression of the Euler - * angles for this point of view. Exactly the operation performed is: - * - * @code - * newrot = rot + 180; - * newtilt = -tilt; - * newpsi = -180 + psi; - * @endcode - * - * @code - * Euler_another_set(rot, tilt, psi, newrot, newtilt, newpsi); - * @endcode - */ -void Euler_another_set(double rot, - double tilt, - double psi, - double& newrot, - double& newtilt, - double& newpsi); - -/** Mirror over Y axis - * - * Given a set of Euler angles this function returns a new set which define a - * mirrored (over Y axis) version of the former projection. - * - * @code - * -----> X X<------ - * | | - * | | - * | ======> | - * v v - * Y Y - * @endcode - * - * The operation performed is - * - * @code - * newrot = rot; - * newtilt = tilt + 180; - * newpsi = -psi; - * @endcode - * - * @code - * Euler_mirrorY(rot, tilt, psi, newrot, newtilt, newpsi); - * @endcode - */ -void Euler_mirrorY(double rot, - double tilt, - double psi, - double& newrot, - double& newtilt, - double& newpsi); - -/** Mirror over X axis - * - * Given a set of Euler angles this function returns a new set which define a - * mirrored (over X axis) version of the former projection. - * - * @code - * -----> X Y - * | ^ - * | | - * | ======> | - * v | - * Y -----> X - * @endcode - * - * The operation performed is - * - * @code - * newrot = rot; - * newtilt = tilt + 180; - * newpsi = 180 - psi; - * @endcode - * - * @code - * Euler_mirrorX(rot, tilt, psi, newrot, newtilt, newpsi); - * @endcode - */ -void Euler_mirrorX(double rot, - double tilt, - double psi, - double& newrot, - double& newtilt, - double& newpsi); - -/** Mirror over X and Y axes - * - * Given a set of Euler angles this function returns a new set which define a - * mirrored (over X and Y axes at the same time) version of the former - * projection. - * - * @code - * -----> X Y - * | ^ - * | | - * | ======> | - * v | - * Y X<----- - * @endcode - * - * The operation performed is - * - * @code - * newrot = rot; - * newtilt = tilt; - * newpsi = 180 + psi; - * @endcode - * - * @code - * Euler_mirrorX(rot, tilt, psi, newrot, newtilt, newpsi); - * @endcode - */ -void Euler_mirrorXY(double rot, - double tilt, - double psi, - double& newrot, - double& newtilt, - double& newpsi); - -/** Apply a geometrical transformation - * - * The idea behind this function is the following. 3 Euler angles define a point - * of view for a projection, but also a coordinate system. You might apply a - * geometrical transformation to this system, and then compute back what the - * Euler angles for the new system are. This could be used to "mirror" points of - * view, rotate them and all the stuff. The transformation matrix must be 3x3 - * but it must transform R3 vectors into R3 vectors (that is a normal 3D - * transformation matrix when vector coordinates are not homogeneous) and it - * will be applied in the sense: - * - * @code - * New Euler matrix = L * Old Euler matrix * R - * @endcode - * - * where you know that the Euler matrix rows represent the different system - * axes. See Euler_angles2matrix for more information about the Euler coordinate - * system. - * - * @code - * Matrix2D< double > R60 = rotation3DMatrix(60, 'Z'); - * R60.resize(3, 3); // Get rid of homogeneous part - * Matrix2D< double > I(3, 3); - * I.initIdentity(); - * Euler_apply_transf(I, R60, rot, tilt, psi, newrot, newtilt, newpsi); - * @endcode - */ -void Euler_apply_transf(const Matrix2D< double >& L, - const Matrix2D< double >& R, - double rot, - double tilt, - double psi, - double& newrot, - double& newtilt, - double& newpsi); - -/** Rotate a volume after 3 Euler angles - * - * Input and output volumes cannot be the same one. - */ -void Euler_rotate(const MultidimArray< double >& V, - double rot, - double tilt, - double psi, - MultidimArray< double >& result); - -/** Rotate a volume after 3 Euler angles - * - * Input and output volumes cannot be the same one. - */ -void Euler_rotate(const MultidimArrayGeneric &V, - double rot, - double tilt, - double psi, - MultidimArray &result); -/** Compute circle around Euler matrix - * - * Given an input Euler matrix, this function returns a set of Euler - * angles such that they sample a circle around the original projection - * direction (a sample every angStep). The projection directions in the - * circle are separated by angCircle. - * - * The output is in outputEulerAngles whose structure is - * (newrot1,newtilt1,newpsi1,newrot2,newtilt2,newpsi2,...) - */ -void computeCircleAroundE(const Matrix2D &E, - double angCircle, double angStep, std::vector &outputEulerAngles); -//@} - -/// @name Intersections -/// @{ - -/** Intersection of a ray with a unit sphere - * - * The sphere is centered at (0,0,0) and has got unit radius. The ray is defined - * by its direction (u) and a passing point (r). The function returns the length - * of the intersection. If the ray is tangent to the sphere the length is 0. See - * Ellipsoid to know how you can intersect any ray with any ellipsoid/sphere. - */ -double intersection_unit_sphere(const Matrix1D< double >& u, - const Matrix1D< double >& r); - -/** Intersection of a ray with a unit cylinder - * - * The cylinder is centered at (0,0,0), has got unit radius on the plane XY, and - * in Z goes from -h/2 to +h/2. The ray is defined by its direction (u) and a - * passing point (r). If the ray belongs to the lateral circular wall of the - * cylinder the length returned is h (h is computed as 1/ZZ(u), this is so - * because it is supposed that this intersection is computed after a coordinate - * transformation process from any cylinder to a unit one). - * - * See Cylinder to know how you can intersect any ray with any cylinder. - */ -double intersection_unit_cylinder(const Matrix1D< double >& u, - const Matrix1D< double >& r); - -/** Intersection of a ray with a unit cube - * - * The cube is centered at (0,0,0) and has got unit size length in all - * directions, i.e., the cube goes from (-0.5, -0.5, -0.5) to (0.5, 0.5, 0.5). - * The ray is defined by its direction (u) and a passing point (r). See Cube to - * know how you can intersect any ray with any cube. - */ -double intersection_unit_cube(const Matrix1D< double >& u, - const Matrix1D< double >& r); -//@} -//@} -#endif diff --git a/src/core/histogram.cpp b/src/core/histogram.cpp deleted file mode 100644 index e0909c6..0000000 --- a/src/core/histogram.cpp +++ /dev/null @@ -1,588 +0,0 @@ -/*************************************************************************** - * - * Authors: Carlos Oscar S. Sorzano (coss@cnb.csic.es) - * Arun Kulshreshth (arun_2000_iitd@yahoo.com) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ -#include -#include -#include -#include -#include - -#include "histogram.h" -#include "metadata_vec.h" -#include "metadata_row_vec.h" - -/* ------------------------------------------------------------------------- */ -/* HISTOGRAMS 1D */ -/* ------------------------------------------------------------------------- */ -/* Clear ------------------------------------------------------------------- */ -void Histogram1D::clear() -{ - hmin = 0; - hmax = 0; - step_size = 0; - istep_size = 0; - no_samples = 0; - MultidimArray::clear(); -} - -/* Assignment -------------------------------------------------------------- */ -Histogram1D & Histogram1D::operator =(const Histogram1D &H) -{ - if (this != &H) - { - this->MultidimArray::operator =(H); - hmin = H.hmin; - hmax = H.hmax; - step_size = H.step_size; - istep_size = H.istep_size; - no_samples = H.no_samples; - } - return *this; -} - -/* Another function for assignament ---------------------------------------- */ -void Histogram1D::assign(const Histogram1D &H) -{ - *this = H; -} -/* Initialize -------------------------------------------------------------- */ -void Histogram1D::init(double min_val, double max_val, int n_steps) -{ - hmin = min_val; - hmax = max_val; - step_size = (double) (max_val - min_val) / (double) n_steps; // CO: n_steps-1->n_steps - istep_size = 1.0 / step_size; - MultidimArray::initZeros(n_steps); - no_samples = 0; -} - -/* Insert value ------------------------------------------------------------ */ -//#define DEBUG -void Histogram1D::insert_value(double val) -{ - int i; - int Xdim=(int)XSIZE(*this); - - // The following code is equivalent to val2index(val, i); - if (val == hmax) - { - i = Xdim - 1; - ++DIRECT_A1D_ELEM(*this, i); - ++no_samples; - } - else - { - double aux = (val - hmin) * istep_size; - i = (int) aux; - - if (i < 0 || i >= Xdim) - return; // the value is outside our scope - - ++DIRECT_A1D_ELEM(*this, i); - ++no_samples; - } -#ifdef DEBUG - - std::cout << " hmin " << hmin << " hmax " << hmax << " value " << val - << " index " << i << " (step_size= " << step_size << ")" << std::endl; -#endif -} -#undef DEBUG - -/* std::cout << hist ------------------------------------------------------------ */ -std::ostream& operator <<(std::ostream &o, const Histogram1D &hist) -{ - MultidimArray aux; - aux.resize(hist.stepNo(), 2); - FOR_ALL_ELEMENTS_IN_ARRAY1D(hist) - { - hist.index2val(i, A2D_ELEM(aux, i, 0)); - A2D_ELEM(aux, i, 1) = A1D_ELEM(hist, i); - } - o << aux; - return o; -} - -/* Write to file ----------------------------------------------------------- */ -void Histogram1D::write(const FileName &fn, - MDLabel mdlValue, - MDLabel mdlCount) -{ - MetaDataVec auxMD; - MDRowVec row; - double auxD; - size_t auxT; - FOR_ALL_ELEMENTS_IN_ARRAY1D(*this) - { - index2val(i, auxD); - this->index2val(i, auxD); - row.setValue(mdlValue, auxD); - auxT=(size_t)A1D_ELEM(*this, i); - row.setValue(mdlCount, auxT); - auxMD.addRow(row); - } - auxMD.write(fn); - // std::ofstream fh; - // fh.open(fn.c_str(), std::ios::out); - // if (!fh) - // REPORT_ERROR(ERR_IO_NOTOPEN, (std::string)"Histogram1D::write: File " + fn + - // " cannot be openned for output"); - // fh << "; Value Count\n"; - // fh << *this; - // fh.close(); -} - -/* Percentil --------------------------------------------------------------- */ -/* This function returns the value of the variable under which the mass% of - the histogram is comprised */ -double Histogram1D::percentil(double percent_mass) -{ - int i = 0; - double acc = 0; - double required_mass; - double percentil_i; - double ret_val; - - // Check it is a correct mass - if (percent_mass > 100) - REPORT_ERROR(ERR_VALUE_INCORRECT, "Asked for a percentil greater than 100"); - - // Trivial cases - if (percent_mass == 0) - return (hmin); - if (percent_mass == 100) - return (hmax); - - // Any other case, find index of corresponding piece - required_mass = (double) no_samples * percent_mass / 100.0; - int N_diff_from_0 = 0; - while (acc < required_mass) - { - acc += A1D_ELEM(*this, i); - if (A1D_ELEM(*this, i) > 0) - N_diff_from_0++; - i++; - } - - // If the sum is just the one we want OK - if (acc == required_mass) - percentil_i = i; - // If there is only one sample different from 0 - // then there is no way of setting the threshold in the middle - // Let's put it at the beginning of the bin - else if (N_diff_from_0 == 1) - percentil_i = i - 1; - // If not, then go back a step and compute which fraction of the - // bar is needed to finish the required mass - else - { - /* CO: We cannot assure that there is at least what is supposed to be - above this threshold. Let's move to the safe side - i--; - acc -= A1D_ELEM(*this,i); - percentil_i=i+(required_mass-acc)/(double) A1D_ELEM(*this,i); */ - percentil_i = i - 1; - } - - // Now translate from index to range - index2val(percentil_i, ret_val); - return ret_val; -} - -/* Mass below -------------------------------------------------------------- */ -double Histogram1D::mass_below(double value) -{ - // Trivial cases - if (value <= hmin) - return 0; - if (value >= hmax) - return no_samples; - - // Any other case, find index of corresponding piece - int i = 0; - double acc = 0; - double current_value; - index2val(i, current_value); - while (current_value <= value) - { - acc += A1D_ELEM(*this, i); - i++; - index2val(i, current_value); - } - return acc; -} - -/* Entropy ----------------------------------------------------------------- */ -double Histogram1D::entropy() const -{ - MultidimArray p; - p.initZeros(XSIZE(*this)); - double pSum = 0; - FOR_ALL_ELEMENTS_IN_ARRAY1D(p) - { - A1D_ELEM(p,i) = A1D_ELEM(*this,i) + 1; - pSum += A1D_ELEM(p,i); - } - double entropy = 0; - double ipSum = 1.0 / pSum; - FOR_ALL_ELEMENTS_IN_ARRAY1D(p) - { - double pi = A1D_ELEM(p,i) * ipSum; - entropy -= pi * log(pi); - } - return entropy; -} - -void CDF::calculateCDF(MultidimArray &V, double probStep) -{ - double *ptr=&DIRECT_MULTIDIM_ELEM(V,0); - size_t N=MULTIDIM_SIZE(V); - std::sort(ptr,ptr+N); - minVal = ptr[0]; - maxVal = ptr[N-1]; - - int Nsteps=(int)round(1.0/probStep); - x.resizeNoCopy(Nsteps); - probXLessThanx.resizeNoCopy(Nsteps); - int i=0; - for (double p=probStep/2; p<1; p+=probStep, i++) - { - size_t idx=(size_t)round(p*N); - A1D_ELEM(probXLessThanx,i)=p; - A1D_ELEM(x,i)=ptr[idx]; - } -} - -#define INTERP(x,x0,y0,xF,yF) (y0+(x-x0)*(yF-y0)/(xF-x0)) - -double CDF::getProbability(double xi) -{ - if (xi>maxVal) - return 1; - else if (xiDIRECT_A1D_ELEM(x,N-1)) - return INTERP(xi,DIRECT_A1D_ELEM(x,N-1),DIRECT_A1D_ELEM(probXLessThanx,N-1),maxVal,1.0); - else - { - int iLeft=0; - int iRight=N-1; - while (iLeft<=iRight) - { - int iMiddle = iLeft+(iRight-iLeft)/2; - if (xi>=DIRECT_A1D_ELEM(x,iMiddle) && xi<=DIRECT_A1D_ELEM(x,iMiddle+1)) - { - if (DIRECT_A1D_ELEM(x,iMiddle)==DIRECT_A1D_ELEM(x,iMiddle+1)) - return 0.5*(DIRECT_A1D_ELEM(probXLessThanx,iMiddle)+DIRECT_A1D_ELEM(probXLessThanx,iMiddle+1)); - else - return INTERP(xi,DIRECT_A1D_ELEM(x,iMiddle), DIRECT_A1D_ELEM(probXLessThanx,iMiddle), - DIRECT_A1D_ELEM(x,iMiddle+1),DIRECT_A1D_ELEM(probXLessThanx,iMiddle+1)); - } - else if (xi p2) - error += p2; - else - error += p1; - } - v += step; - N++; - } - - // Normalise such that the result is the area of a probability function - error *= step / (hmax - hmin); - error /= N; -#ifdef DEBUG - - std::cout << "Total error = " << error << std::endl; -#endif - - return error; -} - -/* Kullback Leibler distance ----------------------------------------------- */ -double KLDistance(const Histogram1D& h1, const Histogram1D& h2) -{ - if (XSIZE(h1) != XSIZE(h2)) - REPORT_ERROR(ERR_MULTIDIM_SIZE,"KLDistance: Histograms of different sizes"); - - double retval = 0; - FOR_ALL_ELEMENTS_IN_ARRAY1D(h1) - if (A1D_ELEM(h2,i) >1e-180 && A1D_ELEM(h1,i) >1e-180) - retval += A1D_ELEM(h1,i) * log10(A1D_ELEM(h1,i) / A1D_ELEM(h2,i)); - return retval; -} - -/* ------------------------------------------------------------------------- */ -/* IRREGULAR HISTOGRAMS */ -/* ------------------------------------------------------------------------- */ -/* Initialization ---------------------------------------------------------- */ -void IrregularHistogram1D::init(const Histogram1D &hist, - const MultidimArray &bins) -{ - int steps_no = XSIZE(bins); - __binsRightLimits.initZeros(steps_no); - __hist.initZeros(steps_no); - - int k = 0; - for (int i = 0; i < steps_no; ++i) - { - hist.index2val(A1D_ELEM(bins,i), A1D_ELEM(__binsRightLimits,i)); - for (int j = k; j <= A1D_ELEM(bins,i); ++j) - A1D_ELEM(__hist,i) += A1D_ELEM(hist,j); - k = A1D_ELEM(bins,i) + 1; - } -} - -/* val2index --------------------------------------------------------------- */ -int IrregularHistogram1D::val2Index(double value) const -{ - int binsNo = XSIZE(__binsRightLimits); - /* Binary search is not interesting for small vectors - * However, we leave the code, just in case it is needed in the future - int ileft=1, iright=binsNo-1; - int iret=0; - if (value<=DIRECT_A1D_ELEM(__binsRightLimits,0)) - return =0; - else if (value>DIRECT_A1D_ELEM(__binsRightLimits,iright)) - return iright; - else - do - { - iret = (iright+ileft)/2; - if (value>DIRECT_A1D_ELEM(__binsRightLimits,iret)) - ileft=iret+1; - else - iright=iret; - if (value>DIRECT_A1D_ELEM(__binsRightLimits,iret-1) && - value<=DIRECT_A1D_ELEM(__binsRightLimits,iret)) - break; - else if (ileft == iright) - { - iret=ileft; - break; - } - } - while (true); - */ - - for (int i = 0; i < binsNo; ++i) - if (value <= DIRECT_A1D_ELEM(__binsRightLimits,i)) - return i; - - //In case the value is greater, we return the last bin - return binsNo - 1; -} - -/* Normalization ----------------------------------------------------------- */ -void IrregularHistogram1D::selfNormalize() -{ - __hist *= 1.0/__hist.sum(); -} - -/* Show -------------------------------------------------------------------- */ -std::ostream & operator <<(std::ostream &_out, - const IrregularHistogram1D &_hist) -{ - for (size_t i = 0; i < XSIZE(_hist.__binsRightLimits); i++) - _out << "\t" << _hist.__binsRightLimits(i) << "\t\t" << _hist.__hist(i) - << std::endl; - return _out; -} - -/* Get value --------------------------------------------------------------- */ -const Histogram1D& IrregularHistogram1D::getHistogram() const -{ - return __hist; -} - -/* ------------------------------------------------------------------------- */ -/* HISTOGRAMS 2D */ -/* ------------------------------------------------------------------------- */ -/* Clear ------------------------------------------------------------------- */ -void Histogram2D::clear() -{ - imin = 0; - imax = 0; - istep_size = 0; - jmin = 0; - jmax = 0; - jstep_size = 0; - no_samples = 0; - MultidimArray::clear(); -} - -/* Assignment -------------------------------------------------------------- */ -Histogram2D & Histogram2D::operator =(const Histogram2D &H) -{ - if (this != &H) - { - this->MultidimArray::operator =(H); - imin = H.imin; - imax = H.imax; - istep_size = H.istep_size; - jmin = H.jmin; - jmax = H.jmax; - jstep_size = H.jstep_size; - no_samples = H.no_samples; - } - return *this; -} - -/* Another function for assignment -------------------------------------------------------------- */ -void Histogram2D::assign(const Histogram2D &H) -{ - *this = H; -} - -/* Initialize -------------------------------------------------------------- */ -void Histogram2D::init(double imin_val, double imax_val, int in_steps, - double jmin_val, double jmax_val, int jn_steps) -{ - // V axis - imin = imin_val; - imax = imax_val; - istep_size = (double) (imax_val - imin_val) / (double) in_steps; - - // U axis - jmin = jmin_val; - jmax = jmax_val; - jstep_size = (double) (jmax_val - jmin_val) / (double) jn_steps; - - initZeros(in_steps, jn_steps); - no_samples = 0; -} - -/* Insert value ------------------------------------------------------------ */ -void Histogram2D::insert_value(double v, double u) -{ - int i, j; - val2index(v, u, i, j); - if (i == -1 || j == -1) - return; // it is outside our scope - int Xdim=(int)XSIZE(*this); - int Ydim=(int)YSIZE(*this); - i = CLIP(i, 0, Ydim); - j = CLIP(j, 0, Xdim); - A2D_ELEM(*this, i, j)++; - no_samples++; -} - -/* std::cout << hist ------------------------------------------------------------ */ -std::ostream& operator <<(std::ostream &o, const Histogram2D &hist) -{ - MultidimArray aux; - aux.resize(hist.IstepNo() * hist.JstepNo(), 3); - int n = 0; - FOR_ALL_ELEMENTS_IN_ARRAY2D(hist) - { - hist.index2val(i, j, A2D_ELEM(aux, n, 0), A2D_ELEM(aux, n, 1)); - A2D_ELEM(aux, n, 2) = A2D_ELEM(hist, i, j); - n++; - } - o << aux; - return o; -} - -/* Write to file ----------------------------------------------------------- */ -void Histogram2D::write(const FileName &fn) -{ - std::ofstream fh; - fh.open(fn.c_str(), std::ios::out); - if (!fh) - REPORT_ERROR(ERR_IO_NOTOPEN, (std::string)"histogram2D::write: File " + fn + " cannot be openned for output"); - fh << *this; - fh.close(); -} - -/* Compute histogram of multidim_array_generic ----------------------------- */ -void compute_hist(const MultidimArrayGeneric& array, Histogram1D& hist, - int no_steps) -{ - double min=0., max=0.; - array.computeDoubleMinMax(min, max); - compute_hist(array, hist, min, max, no_steps); -} - -void compute_hist(const MultidimArrayGeneric& v, Histogram1D& hist, double min, - double max, int no_steps) -{ - hist.init(min, max, no_steps); -#define COMPUTEHIST(type) compute_hist(MULTIDIM_ARRAY_TYPE(v,type),hist,min,max,no_steps); - - SWITCHDATATYPE(v.datatype,COMPUTEHIST) -#undef COMPUTEHIST -} diff --git a/src/core/histogram.h b/src/core/histogram.h deleted file mode 100644 index decc7ab..0000000 --- a/src/core/histogram.h +++ /dev/null @@ -1,1002 +0,0 @@ -/*************************************************************************** - * - * Authors: Carlos Oscar S. Sorzano (coss@cnb.csic.es) - * Arun Kulshreshth (arun_2000_iitd@yahoo.com) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_HISTOGRAM_H -#define CORE_HISTOGRAM_H - -#include "multidim_array.h" -#include "multidim_array_generic.h" -#include "metadata_label.h" - -/// @defgroup Histograms Histograms -/// @ingroup DataLibrary -//@{ -/** Histograms with 1 parameter - * - * This class of histograms are the usual ones where we want to count the number - * of elements within a certain range of a variable, then we make the histogram - * of that variable. The range is divided into small subranges within which the - * values will be grouped. Any value outside the global range will not be - * counted in the histogram. - * - * To see exactly which is the division between subranges let's have a look on - * the following example where an histogram between 0 and 2 is computed with - * 5 steps. - * - * @code - * [......) [.......] - * [ ) [ ] - * [ )[......) [ ] - * [ )[ ) [......)[ ] - * [ )[ )[......)[ )[ ] - * [ )[ )[ )[ )[ ] - * [ 0 )[ 1 )[ 2 )[ 3 )[ 4 ] - * [ )[ )[ )[ )[ ] - * |---------|---------|---------|---------| - * 0.0 0.5 1.0 1.5 2.0 - * @endcode - * - * The border points are 0.0, 0.4, 0.8, 1.2, 1.6 and 2.0. The brackets and - * parenthesis try to represent where the border point belongs to, and the - * numbers within the bars are the index of each bar whithin the histogram. The - * height of each bar is the number of times that a value within that subrange - * has been inserted. Be careful that this is not a probability density function - * (pdf), to be so it should be divided by the total number of values inserted. - * - * The simplest way of computing a histograms is the following: - * @code - * // Variable definition - * Histogram1D hist; - * MultidimArray A(50, 50); - * - * // Matrix initialisation - * A.init_random(0, 100); - * - * // Histogram calculation with 200 bins - * compute_hist(A, hist, 200); - * - * // Effective range computation - * double eff0 = hist.percentil(2.5); - * double effF = hist.percentil(97.5); - * - * @endcode - * - * The following example shows how to work with the histograms. In it we will - * compute which is the central range within which the 95% of the values of a - * matrix are comprised. This example could be even simplified by using the - * function compute_hist but it has been kept like this to show the idea behind - * the histograms - * - * @code - * // Variable definition - * Histogram1D hist; - * MultidimArray A(50, 50); - * double min_val, max_val; - * double eff0, effF; - * - * // Matrix initialisation - * A.init_random(0, 100); - * - * // Histogram initialisation - * min_val = A.min(); - * max_val = A.max(); - * hist.init(min_val, max_val, 200); - * - * // Histogram computation - * for (int i=STARTINGY(A); i<=FINISHINGY(A); i++) - * for (int j=STARTINGX(A); j<=FINISHINGX(A); j++) - * hist.insert_value(A2D_ELEM(A,i,j)); - * - * // Effective range computation - * eff0 = hist.percentil(2.5); - * effF = hist.percentil(97.5); - * - * std::cout << "The effective range goes from " << eff0 - * << " to " << effF << std::endl; - * @endcode - */ -class Histogram1D: public MultidimArray< double > -{ -public: - // Structure - double hmin; // minimum value of the histogram - double hmax; // maximum value of the histogram - double step_size; // size of step - double istep_size; - int no_samples; // No. of points inside the histogram - - /** Empty constructor - * - * Creates an empty histogram. Before using it you must - * initialise it with init. - * - * @code - * Histogram1D hist; - * @endcode - */ - Histogram1D() - { - clear(); - } - - /** Copy constructor - * - * Makes an exact copy of the given histogram into another histogram. - * - * @code - * Histogram1D hist2(hist1); - * @endcode - */ - Histogram1D(const Histogram1D& H) - { - clear(); - *this = H; - } - - /** Empties an histogram - * - * Remember to initialise it before using it again. - * - * @code - * hist.clear(); - * @endcode - */ - void clear(); - - /** Assignment */ - Histogram1D& operator=(const Histogram1D& H); - - /** Another function for assignament.*/ - void assign(const Histogram1D& H); - - /** Initialisation of the histogram - * - * This is the operation which allows the histogram to be used. This should - * be performed before inserting any value in it. The information given to - * this initialisation is the range within which the values will be counted, - * and the number of steps (discrete bars) in this range. If the value is - * outside this range it will not be taken into account although we have - * asked for its insertion in the histogram. - * - * @code - * hist.init(-3, 3, 100); - * // 100 steps in the range -3...3 - * @endcode - */ - void init(double min_val, double max_val, int n_steps); - - /** Insert a value within histogram - * - * The right interval is chosen according to the initialisation of the - * histogram and the count of elements in that interval is incremented by 1. - * If the value lies outside the global range of the histogram nothing is - * done. - * - * @code - * hist.insert_value(3); - * @endcode - */ - void insert_value(double val); - -/** Insert value as a macro */ -#define INSERT_VALUE(histogram,value) \ -{\ - if (value == histogram.hmax) { \ - size_t iii = XSIZE(histogram) - 1; \ - ++DIRECT_A1D_ELEM(histogram, iii); \ - ++histogram.no_samples; \ - } else { \ - size_t iii = (size_t) ((value - histogram.hmin) * histogram.istep_size); \ - if (iii >= 0 && iii < XSIZE(histogram)) \ - { \ - ++DIRECT_A1D_ELEM(histogram, iii); \ - ++histogram.no_samples; \ - } \ - } \ -} - - /** Returns the percentil value - * - * This function returns the value within the range for which a given - * percent mass of the total number of elements are below it. For instance, - * if we have 120 values distributed between 0 and 45, and we ask for the - * percentil of 60%, the returned value is that within 0 and 45 for which - * 120 * 0.6 = 72 elements are smaller than it. - * - * @code - * percentil60=hist.percentil(60); - * @endcode - */ - double percentil(double percent_mass); - - /** Mass below - * - * Returns the number of points which are below a certain value - */ - double mass_below(double value); - - /** Mass above - * - * Returns the number of points which are above a certain value - */ - double mass_above(double value) - { - return no_samples - mass_below(value); - } - - /** Show an histogram - * - * The first column is the value associated to each histogram measure. The - * second one is the histogram measure. - */ - friend std::ostream& operator<<(std::ostream& o, const Histogram1D& hist); - - /** Write an histogram to disk. - */ - void write(const FileName& fn, MDLabel=MDL_X, MDLabel=MDL_COUNT); - - /** Value --> Index - * - * Given a value it returns the code of the interval where it should be - * counted. If it is outside the global range of the histogram it returns - * -1 - * - * @code - * hist.val2index(12.3, interval_for_it); - * @endcode - */ - void val2index(double v, int& i) const - { - if (v == hmax) - i = XSIZE(*this) - 1; - else - { - double aux=(v - hmin) * istep_size; - i = (int) FLOOR(aux); - } - - if (i < 0 || i >= (int)XSIZE(*this)) - i = -1; - } - - /** Index --> Value - * - * Given the code of one interval, this function returns the value of its - * starting point (its left border point). If the intervals are defined as - * [a,b), this function returns a. - * - * @code - * hist.index2val(0, beginning_of_interval_0); - * @endcode - */ - inline void index2val(double i, double& v) const - { - v = hmin + i * step_size; - } - - /** Minimum value where the histogram is defined - * - * @code - * std::cout << "Minimum value for histogram " << hist.min() << std::endl; - * @endcode - */ - double hist_min() const - { - return hmin; - } - - /** Maximum value where the histogram is defined - * - * @code - * std::cout << "Maximum value for histogram " << hist.max() << std::endl; - * @endcode - */ - double hist_max() const - { - return hmax; - } - - /** Step size for the histogram - * - * @code - * std::cout << "Step size of the histogram " << hist.step() << std::endl; - * @endcode - */ - double step() const - { - return step_size; - } - - /** Number of steps in the histogram - * - * @code - * std::cout << "No. Steps in the histogram " << hist.stepNo() << std::endl; - * @endcode - */ - int stepNo() const - { - return XSIZE(*this); - } - - /** Number of samples introduced in the histogram - * - * @code - * std::cout << "No. Samples in the histogram " << hist.sampleNo() << std::endl; - * @endcode - */ - double sampleNo() const - { - return no_samples; - } - - /** Measure the entropy of this histogram. - * - * Before computing the entropy, the histogram is corrected with a Laplace - * correction. The entropy is computed as sum(-p*log(p)) - */ - double entropy() const; -}; - -/** Cumulative density function. - * This function computes a table with the cumulative density function*/ - class CDF - { - public: - MultidimArray x; - MultidimArray probXLessThanx; - double minVal, maxVal; - public: - /// Calculate the CDF of V with a probability step of 0.005 (p is between 0 and 1) - void calculateCDF(MultidimArray &V, double probStep=0.005); - - /// Get the probability Pr{V<=x} - double getProbability(double x); - }; - - -/** Irregular histogram. - * - * This class is initialized with a regular histogram and a set of bins. - * The class builds a new histogram in which the values within bins of - * the original histogram are gathered. - * The class provides the standard operations with histograms. */ -class IrregularHistogram1D -{ -public: - Histogram1D __hist; - MultidimArray __binsRightLimits; -public: - /// Initialize class - void init(const Histogram1D &oldHistogram, const MultidimArray &bins); - - /// Return the index corresponding to a certain value - int val2Index(double value) const; - - /// Normalize to be a probability density function - void selfNormalize(); - - /// Show - friend std::ostream & operator << (std::ostream &_out, - const IrregularHistogram1D &_h); - - /// Get value - inline double operator()(int i) const - { - return DIRECT_A1D_ELEM(__hist,i); - } - - /// Get histogram - const Histogram1D& getHistogram() const; -}; - -/** @name Functions related to histograms 1D */ -//@{ -/** Compute histogram of a vector within its minimum and maximum value - * - * Given an array as input, this function returns its histogram within the - * minimum and maximum of the array, in this way all the values in the array are - * counted. The array can be of any numerical type (short int, int, double, ...) - * and dimension. The number of steps must always be given. - * - * @code - * Histogram1D hist; - * compute_hist(v, hist, 100); - * @endcode - */ -template -void compute_hist(const MultidimArray& array, Histogram1D& hist, - int no_steps) -{ - double min=0, max=0; - array.computeDoubleMinMax(min, max); - compute_hist(array, hist, min, max, no_steps); -} - -/** Compute histogram of a MultidimArrayGeneric within its minimum and maximum value */ -void compute_hist(const MultidimArrayGeneric& array, Histogram1D& hist, - int no_steps); - -/** Compute histogram of a vector - */ -template -void compute_hist(const std::vector< T > &v, - Histogram1D& hist, - int no_steps = 100) -{ - hist.clear(); - int imax=v.size(); - if (imax==0) - return; - - // Compute minimum and maximum - double min, max; - min=max=v[0]; - for (int i=1; i -void compute_hist(const MultidimArray& v, Histogram1D& hist, - double min, double max, int no_steps) -{ - hist.init(min, max, no_steps); - T* ptr=&DIRECT_MULTIDIM_ELEM(v,0); - size_t nmax=(MULTIDIM_SIZE(v)/4)*4; - - double value; - for (size_t n=0; n -void compute_hist(const MultidimArray< T > - & v, Histogram1D& hist, - const Matrix1D< int >& corner1, - const Matrix1D< int >& corner2, - int no_steps = 100) -{ - double min, max; - v.computeDoubleMinMax(min, max, corner1, corner2); - hist.init(min, max, no_steps); - - Matrix1D< int > r(2); - FOR_ALL_ELEMENTS_IN_ARRAY2D_BETWEEN(corner1, corner2) - { - double value=v(r); - INSERT_VALUE(hist,value); - } -} - -/** Compute the detectability error between two pdf's - * - * The input histograms are expressed as probability density functions - * representing two different objects with the same parameter of variation, for - * instance, the protein and background both defined by a grey-level. The first - * histogram would be the histogram of the grey-levels associated to voxels - * which we know to belong to the protein area, while the second histogram is - * for the grey-level of voxels which we know to belong to the background. Then - * the intersection area between the both associated pdf's represents the - * probability of committing an error when classifying a voxel, ie, the - * probability of saying that a voxel is protein when it really is background - * and viceversa. This function allows you to compute this probability error - * when the two histograms are provided. Be careful that this probability - * usually has got a very low value. - * - * @code - * detect_error = detectability_error(hist1, hist2); - * @endcode - */ -double detectability_error(const Histogram1D& h1, const Histogram1D& h2); - -/** Compute the Kullback-Leibler distance between two pdf's - * - * The input histograms are expressed as probability density functions. - * - * @code - * distance = KLDistance(hist1, hist2); - * @endcode - */ -double KLDistance(const Histogram1D& h1, const Histogram1D& h2); - -/** Returns the effective range of a multidimensional array - * - * The effective range is defined as the difference of those two values - * comprising a given central percentage of the array histogram. This function - * is used to compute the range removing outliers. The default central - * percentage is 99.75%, although this value should be increased as the number - * of values in the array decreases. For the default, for instance, the 0.125% - * of the smaller values are left out as well as the 0.125% of the higher - * values. The range is given always as a double number. - * - * @code - * double range = v.effective_range(); - * // range for the 99.75% of the mass - * - * double range = v.effective_range(1); - * // range for the 99% of the mass - * @endcode - */ -template -double effective_range(const T& v, double percentil_out = 0.25) -{ - Histogram1D hist; - compute_hist(v, hist, 200) - ; - double min_val = hist.percentil(percentil_out / 2); - double max_val = hist.percentil(100 - percentil_out / 2); - return max_val - min_val; -} - -/** Clips the array values within the effective range - * - * Look at the documentation of effective_rage - */ -template -void reject_outliers(T& v, double percentil_out = 0.25) -{ - Histogram1D hist; - compute_hist(v, hist, 400); - double eff0 = hist.percentil(percentil_out / 2); - double effF = hist.percentil(100 - percentil_out / 2); - int i0, iF; - hist.val2index(eff0, i0); - hist.val2index(effF, iF); - if (iF == i0) { - hist.index2val(i0, eff0); - hist.index2val(i0 + 1, effF); - } - - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY(v) - if (DIRECT_MULTIDIM_ELEM(v,n) < eff0) - DIRECT_MULTIDIM_ELEM(v,n) = eff0; - else if (DIRECT_MULTIDIM_ELEM(v,n) > effF) - DIRECT_MULTIDIM_ELEM(v,n) = effF; -} - -/** Histogram equalization and re-quantization - * - * This function equalizes the histogram of the input multidimensional array, - * and re-quantize the input array to a specified number of bins. The output - * array is defined between 0 and bins-1. - */ -template -void histogram_equalization(MultidimArray - & v, int bins = 8) -{ - const int hist_steps = 200; - Histogram1D hist; - compute_hist(v, hist, hist_steps); - - // Compute the distribution function of the pdf - MultidimArray norm_sum(hist_steps); - DIRECT_A1D_ELEM(norm_sum,0) = DIRECT_A1D_ELEM(hist,0); - - for (int i = 1; i < hist_steps; i++) - DIRECT_A1D_ELEM(norm_sum,i) = DIRECT_A1D_ELEM(norm_sum,i - 1) + DIRECT_A1D_ELEM(hist,i); - norm_sum /= MULTIDIM_SIZE(v); - - // array to store the boundary pixels of bins - MultidimArray< double > div(bins - 1); - int index = 0; - - for (int current_bin = 1; current_bin < bins; current_bin++) - { - double current_value = (double) current_bin / bins; - while (DIRECT_A1D_ELEM(norm_sum,index) < current_value && index < FINISHINGX(norm_sum)) - index++; - hist.index2val((double) index, DIRECT_A1D_ELEM(div,current_bin - 1)); - } - - // requantize and equalize histogram - T* ptr=NULL; - unsigned long int n; - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(v,n,ptr) - { - T vi=*ptr; - if (vi < DIRECT_A1D_ELEM(div,0)) - *ptr = 0; - else if (vi > DIRECT_A1D_ELEM(div,bins - 2)) - *ptr = bins - 1; - else - { - index = 0; - while (vi > DIRECT_A1D_ELEM(div,index)) - index++; - *ptr = index; - } - } -} -//@} - -/** Histograms with 2 parameters - * - * The histogram with 2 parameters can be regarded as an approximation to the - * joint probability density function of two variables (just dividing the - * histogram by its total mass). Ie, the 2D histogram is the count of times that - * a certain combination of values in two variables has occurred. For example, - * this 2D histograms can be used to plot the projection distribution over the - * topological sphere, in such situation only the first two Euler angles are - * interesting and we could plot how many projections are there with first angle - * equal to 45 degrees and second equal to 0 degrees, and so on covering the whole range for - * each angle. - * - * The 2D histogram is defined, as in the 1D case, by the respective ranges for - * the two variables and the number of intervals on each range. The distribution - * and limits of intervals are just the 2D extension of the graph shown in - * histograms 1D. - * - */ -class Histogram2D : public MultidimArray< double > -{ -public: - // Structure - double imin; // minimum value of the i axis - double imax; // maximum value of the i axis - double istep_size; // size of step - double jmin; // minimum value of the j axis - double jmax; // maximum value of the j axis - double jstep_size; // size of step - int no_samples; // No. of points inside the histogram - - /** Empty constructor - * - * Creates an empty histogram. Before using it you must initialise it with - * init - * - * @code - * Histogram2D hist; - * @endcode - */ - Histogram2D() - { - clear(); - } - - /** Copy constructor - * - * Makes an exact copy of the given histogram into another histogram. - * - * @code - * Histogram2D hist2(hist1); - * @endcode - */ - Histogram2D(const Histogram2D& H) - { - *this = H; - } - - /** Empties an histogram - * - * Remember to initialise it before using it again. - * - * @code - * hist.clear(); - * @endcode - */ - void clear(); - - /** Assignment. - */ - Histogram2D& operator=(const Histogram2D& H); - - /** Another function for assigment. - */ - void assign(const Histogram2D& H); - - /** Initialisation of the histogram - * - * This is the operation which allows the histogram to be used. This should - * be performed before inserting any value in it. The information given to - * this initialisation is the range for each variable within which the - * values will be counted, and the number of steps (discrete bars) in these - * ranges.If the value is outside the defined ranges it will not be taken - * into account although we have asked for its insertion in the histogram. - * - * @code - * hist.init(0, 90, 100, 0, 360, 200); - * // 100 steps in the range V=0...90 and 200 steps for U=0...360 - * @endcode - */ - void init(double imin_val, double imax_val, int in_steps, - double jmin_val, double jmax_val, int jn_steps); - - /** Insert a value within histogram - * - * The right interval is chosen according to the initialisation of the - * histogram and the count of elements in that interval is incremented by 1. - * If the value lies outside the global range of the histogram nothing is - * done. Notice that two values are needed, these are the two values of the - * two variables in our example of the projection at with first Euler - * angle=45 and second=0, the insertion of this projection in the 2D - * histogram would be like in the following example. - * - * @code - * hist.insert_value(45, 0); - * @endcode - */ - void insert_value(double v, double u); - - /** Show an histogram - * - * The first column and second column are the (X,Y) coordinates of each - * histogram measure. The third one is the histogram measure. - */ - friend std::ostream& operator<<(std::ostream& o, const Histogram2D& hist); - - /** Write an histogram to disk - */ - void write(const FileName& fn); - - /** Value --> Index - * - * Given two values for the two variables it returns the code of the - * interval where it should be counted. If it is outside the global range of - * the histogram it returns -1 for that variable (i or j). The following - * example tells you that the interval corresponding to (45,0) is that with - * code (i,j), i.e, you could access to hist()(i,j) to know how many - * projections are there in the same interval as this projection. - * - * @code - * hist.val2index(45, 0, i, j); - * @endcode - */ - void val2index(double v, double u, int& i, int& j) const - { - if (v == imax) - i = IstepNo() - 1; - else - i = (int) FLOOR((v - imin) / istep_size); - - if (u == jmax) - j = JstepNo() - 1; - - j = (int) FLOOR((u - jmin) / jstep_size); - - if (i < 0 || i >= IstepNo()) - i = -1; - - if (j < 0 || j >= JstepNo()) - j = -1; - } - - /** Index --> Value - * - * Given the code of one interval, this function returns the value of its - * starting point (its left-top border point, ie, its lowest corner). If the - * intervals are defined as [v0,vF) and [u0,uF), this function returns the - * point (v0,u0) - * - * @code - * hist.index2val(5, 1, v, u); - * @endcode - */ - void index2val(double i, double j, double& v, double& u) const - { - v = imin + i * istep_size; - u = jmin + j * jstep_size; - } - - /** Minimum i value where the histogram is defined - * - * @code - * std::cout << "Minimum value for histogram " << hist.Imin() << std::endl; - * @endcode - */ - double Ihist_min() const - { - return imin; - } - - /** Maximum i value where the histogram is defined - * - * @code - * std::cout << "Maximum value for histogram " << hist.Imax() << std::endl; - * @endcode - */ - double Ihist_max() const - { - return imax; - } - - /** Step size in i for the histogram - * - * @code - * std::cout << "Step size of the histogram " << hist.Istep() << std::endl; - * @endcode - */ - double Istep() const - { - return istep_size; - } - - /** Number of steps in i in the histogram - * - * @code - * std::cout << "No. Steps in the histogram " << hist.IstepNo() << std::endl; - * @endcode - */ - int IstepNo() const - { - return YSIZE(*this); - } - - /** Minimum j value where the histogram is defined - * - * @code - * std::cout << "Minimum value for histogram " << hist.Jmin() << std::endl; - * @endcode - */ - double Jhist_min() const - { - return jmin; - } - - /** Maximum j value where the histogram is defined - * - * @code - * std::cout << "Maximum value for histogram " << hist.Jmax() << std::endl; - * @endcode - */ - double Jhist_max() const - { - return jmax; - } - - /** Step size in j for the histogram - * - * @code - * std::cout << "Step size of the histogram " << hist.Jstep() << std::endl; - * @endcode - */ - double Jstep() const - { - return jstep_size; - } - - /** Number of steps in j in the histogram - * - * @code - * std::cout << "No. Steps in the histogram " << hist.JstepNo() << std::endl; - * @endcode - */ - int JstepNo() const - { - return XSIZE(*this); - } - - /** Number of samples introduced in the histogram - * - * @code - * std::cout << "No. Samples in the histogram " << hist.sampleNo() << std::endl; - * @endcode - */ - int sampleNo() const - { - return no_samples; - } -}; - -/** @name Functions related to histograms 2D - * - * The vectors can be of any numerical type (short int, int, double, ...), but - * both of the same type. Vectors must be of the same shape, the first element - * of v1 and the first of v2 define the position were the first point will be - * inserted in the histogram, then the second of v1 and of v2, ... That is, the - * elements of v1 and v2 serve as coordinates within the histogram. The number - * of steps must always be given. - */ -//@{ -/** Compute histogram of two arrays within their minimum and maximum values - * - * Given two arrays as input, this function returns their joint histogram within - * the minimum and maximum of the arrays, in this way all the values in the - * arrays are counted. Both arrays must have the same shape - */ -template -void compute_hist(const T& v1, const T& v2, - Histogram2D& hist, int no_steps1, int no_steps2) -{ - double min1, max1; - v1.computeDoubleMinMax(min1, max1) - ; - - double min2, max2; - v2.computeDoubleMinMax(min2, max2); - - compute_hist(v1, v2, hist, min1, max1, min2, max2, no_steps1, no_steps2); -} - -/** Compute histogram of two arrays within given values - * - * Given two arrays as input, this function returns their joint histogram - * within the specified values, all the values lying outside are not counted - */ -template -void compute_hist(const MultidimArray - & v1, const MultidimArray& v2, - Histogram2D& hist, - double m1, double M1, double m2, double M2, int no_steps1, - int no_steps2) -{ - if (!v1.sameShape(v2)) - REPORT_ERROR(ERR_MULTIDIM_SIZE, "compute_hist: v1 and v2 are of different shape"); - - hist.init(m1, M1, no_steps1, m2, M2, no_steps2); - - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY(v1) - hist.insert_value(DIRECT_MULTIDIM_ELEM(v1, n), - DIRECT_MULTIDIM_ELEM(v2, n)); -} -//@} -//@} -#endif diff --git a/src/core/linear_system_helper.cpp b/src/core/linear_system_helper.cpp deleted file mode 100644 index 333b392..0000000 --- a/src/core/linear_system_helper.cpp +++ /dev/null @@ -1,364 +0,0 @@ -/*************************************************************************** - * - * Authors: David Strelak (davidstrelak@gmail.com) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include "linear_system_helper.h" -#include -#include -#include - -// Solve linear systems --------------------------------------------------- - // FIXME deprecated (use solveLinearSystem(WeightedLeastSquaresHelperMany &h, std::vector> &results)) -void solveLinearSystem(PseudoInverseHelper &h, Matrix1D &result) -{ - Matrix2D &A=h.A; - Matrix1D &b=h.b; - Matrix2D &AtA=h.AtA; - Matrix2D &AtAinv=h.AtAinv; - Matrix1D &Atb=h.Atb; - - // Compute AtA and Atb - int I=MAT_YSIZE(A); - int J=MAT_XSIZE(A); - AtA.initZeros(J,J); - Atb.initZeros(J); - for (int i=0; i> &results) -{ - const size_t sizeI = h.A.mdimy; - const size_t sizeJ = h.A.mdimx; - h.AtA.resizeNoCopy(sizeJ, sizeJ); - h.Atb.resizeNoCopy(sizeJ); - // compute AtA - h.At = h.A.transpose(); - // for each row of the output - for (size_t i = 0; i < sizeJ; ++i) - { - // for each column of the output (notice that we read row-wise from At) - for (size_t j = i; j < sizeJ; ++j) - { - double AtA_ij = 0; - // multiply elementwise row by row from At - for (size_t k = 0; k < sizeI; ++k) { - AtA_ij += h.At.mdata[i * sizeI + k] * h.At.mdata[j * sizeI + k]; - } - // AtA is symmetric, so we don't need to iterate over everything - h.AtA.mdata[i * sizeJ + j] = h.AtA.mdata[j * sizeJ + i] = AtA_ij; - } - } - // Compute the inverse of AtA - h.AtA.inv(h.AtAinv); // AtAinv is also square matrix, same size as AtA - - assert(results.size() == h.bs.size()); - auto res_it = results.begin(); - auto b_it = h.bs.begin(); - for (; res_it != results.end(); ++res_it, ++b_it) { - for (size_t i = 0; i < sizeJ; ++i) - { - double Atb_i = 0; - for (size_t k = 0; k < sizeI; ++k) { - Atb_i += h.A.mdata[k * sizeJ + i] * b_it->vdata[k]; - } - h.Atb.vdata[i] = Atb_i; - } - // Now multiply by Atb - res_it->initZeros(sizeJ); - for (size_t i = 0; i < sizeJ; i++) { - for (size_t j = 0; j < sizeJ; j++) { - res_it->vdata[i] += h.AtAinv.mdata[i * sizeJ +j] * h.Atb.vdata[j]; - } - } - } -} - -// Solve linear systems --------------------------------------------------- -void weightedLeastSquares(WeightedLeastSquaresHelper &h, Matrix1D &result) -{ - Matrix2D &A=h.A; - Matrix1D &b=h.b; - Matrix1D &w=h.w; - - // See http://en.wikipedia.org/wiki/Least_squares#Weighted_least_squares - FOR_ALL_ELEMENTS_IN_MATRIX1D(w) - { - double wii=sqrt(VEC_ELEM(w,i)); - VEC_ELEM(b,i)*=wii; - for (size_t j=0; j> &results) -{ - const size_t sizeW = h.w.vdim; - h.w_sqrt.resizeNoCopy(h.w); - // compute weights - for(size_t i = 0; i < sizeW; ++i) { - h.w_sqrt.vdata[i] = sqrt(h.w.vdata[i]); - } - // update the matrix - const size_t sizeX = h.A.mdimx; - for(size_t i = 0; i < sizeW; ++i) { - const size_t offset = i * sizeX; - const auto v = h.w_sqrt[i]; - for (size_t j = 0; j < sizeX; ++j) - h.A.mdata[offset + j] *= v; - } - // update values - for (auto &b : h.bs) { - for(size_t i = 0; i < sizeW; ++i) { - b.vdata[i] *= h.w_sqrt[i]; - } - } - solveLinearSystem(h, results); -} - -// Solve linear system with RANSAC ---------------------------------------- -//#define DEBUG -//#define DEBUG_MORE -double ransacWeightedLeastSquaresBasic(WeightedLeastSquaresHelper &h, Matrix1D &result, - double tol, int Niter, double outlierFraction) -{ - int N=MAT_YSIZE(h.A); // Number of equations - int M=MAT_XSIZE(h.A); // Number of unknowns - - // Initialize a vector with all equation indexes - std::vector eqIdx; - eqIdx.reserve(N); - for (int n=0; n &A=haux.A; - Matrix1D &b=haux.b; - - // Solve Niter randomly chosen equation systems - double bestError=1e38; - const int Mdouble=M*sizeof(double); - int minNewM=(int)((1.0-outlierFraction)*N-M); - if (minNewM<0) - minNewM=0; - - Matrix1D resultAux; - Matrix1D idxIn(N); - WeightedLeastSquaresHelper haux2; - for (int it=0; it A, AtA, AtAinv; - Matrix1D Atb, b, bpredicted; -}; - -/** Helper class for solving Weighted Least Squares */ -class WeightedLeastSquaresHelper: public PseudoInverseHelper -{ -public: - Matrix1D w; //Weights -}; - -class WeightedLeastSquaresHelperMany -{ -public: - Matrix2D A; - Matrix2D At; - std::vector> bs; - Matrix1D w; //Weights - Matrix1D w_sqrt; //Square roots of weights, will be computed - Matrix2D AtA; - Matrix2D AtAinv; - Matrix1D Atb; -}; - -/** Solve Linear system Ax=b with pseudoinverse. - * A and b must be set inside the PseudoInverseHelper, the rest of the - * fields in PseudoInverseHelper are used by this routine to avoid - * several allocation/deallocations - * DEPRECATED, use solveLinearSystem(WeightedLeastSquaresHelperMany &h, std::vector> &results) - * */ -// FIXME deprecated -void solveLinearSystem(PseudoInverseHelper &h, Matrix1D &result); - -/** Solve Linear system Ax=[b] with pseudoinverse. - * A and all 'b's must be set inside the helper */ -void solveLinearSystem(WeightedLeastSquaresHelperMany &h, std::vector> &result); - -/** Solve Weighted least square problem Ax=b with pseudoinverse and weights w. - * A, w and b must be set inside the WeightedLeastSquaresHelper, the rest of the - * fields in WeightedLeastSquaresHelper are used by this routine to avoid - * several allocation/deallocations. - * - * The normal equations of this problem are A^t W A x = A^t W b, - * where W is a diagonal matrix whose entries are in the vector w. - * - * DEPRECATED, use weightedLeastSquares(WeightedLeastSquaresHelperMany &h, std::vector> &results) - * */ -// FIXME deprecated -void weightedLeastSquares(WeightedLeastSquaresHelper &h, Matrix1D &result); - -/** Solve Weighted least square problem Ax=b with pseudoinverse and weights w for multiple b. - * A, w and all 'b's must be set inside the helper to avoid - * several allocation/deallocations. - * - * The normal equations of this problem are A^t W A x = A^t W b, - * where W is a diagonal matrix whose entries are in the vector w. */ -void weightedLeastSquares(WeightedLeastSquaresHelperMany &h, std::vector> &results); - -/** Solve Weighted least square problem Ax=b and weights w, with RANSAC. - * Tol is a tolerance value: if an equation is fulfilled with an error smaller than tol, - * then it is considered to fulfill the model. Niter is the number of RANSAC iterations to perform. - * The outlier fraction is the fraction of equations that, at maximum, can be considered as outliers. - */ -void ransacWeightedLeastSquares(WeightedLeastSquaresHelper &h, Matrix1D &result, - double tol, int Niter=10000, double outlierFraction=0.25, int Nthreads=1); - -#endif /* XMIPPCORE_CORE_LINEAR_SYSTEM_HELPER_H_ */ diff --git a/src/core/matrix1d.cpp b/src/core/matrix1d.cpp deleted file mode 100644 index 39e29c0..0000000 --- a/src/core/matrix1d.cpp +++ /dev/null @@ -1,916 +0,0 @@ -/*************************************************************************** - * - * Authors: Carlos Oscar S. Sorzano (coss@cnb.csic.es) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include "matrix1d.h" -#include "xmipp_filename.h" -#include "numerical_recipes.h" -#include -#include - -template -Matrix1D& Matrix1D::operator=(const Matrix1D& op1) -{ - if (&op1 != this) - { - resizeNoCopy(op1); - memcpy(vdata, op1.vdata, vdim * sizeof(T)); - row = op1.row; - } - - return *this; -} - -template -bool Matrix1D::operator==(const Matrix1D& op1) const -{ - if (row != op1.row) - return false; - - for (size_t i = 0; i < vdim; ++i) - if (!XMIPP_EQUAL_REAL(vdata[i], op1.vdata[i])) - return false; - return true; -} - -template -Matrix1D& Matrix1D::operator=(const std::vector& op1) -{ - resizeNoCopy(op1.size()); - memcpy(&vdata[0],&(op1[0]),vdim*sizeof(T)); - row = false; - return *this; -} - -template -void Matrix1D::clear() -{ - coreDeallocate(); - coreInit(); -} - -template -void Matrix1D::coreInit() -{ - vdim = 0; - row = false; - vdata = NULL; - destroyData = true; -} - -template -void Matrix1D::initConstant(T val) -{ - for (size_t j = 0; j < vdim; j++) - vdata[j] = val; -} - -template -void Matrix1D::initConstant(size_t Xdim, T val) -{ - if (vdim != Xdim) - resizeNoCopy(Xdim); - initConstant(val); -} - -template -void Matrix1D::enumerate() -{ - for (size_t j = 0; j < vdim; j++) - vdata[j] = j; -} - -template -bool Matrix1D::isAnyNaN() -{ - for (size_t j = 0; j < vdim; j++) - if (ISNAN(vdata[j])) - return true; - return false; -} - -template -Matrix1D Matrix1D::operator*(T op1) const -{ - Matrix1D tmp(*this); - T *ptr1 = &VEC_ELEM(tmp,0); - const T *ptr2 = &VEC_ELEM(*this,0); - size_t iBlockMax = vdim / 4; - for (size_t i = 0; i < iBlockMax; i++) - { - (*ptr1++) = (*ptr2++) * op1; - (*ptr1++) = (*ptr2++) * op1; - (*ptr1++) = (*ptr2++) * op1; - (*ptr1++) = (*ptr2++) * op1; - } - for (size_t i = iBlockMax * 4; i < vdim; ++i) - (*ptr1++) = (*ptr2++) * op1; - return tmp; -} - -template -Matrix1D Matrix1D::operator/(T op1) const -{ - Matrix1D tmp(*this); - T iop1 = 1 / op1; - T *ptr1 = &VEC_ELEM(tmp,0); - const T *ptr2 = &VEC_ELEM(*this,0); - size_t iBlockMax = vdim / 4; - for (size_t i = 0; i < iBlockMax; i++) - { - (*ptr1++) = (*ptr2++) * iop1; - (*ptr1++) = (*ptr2++) * iop1; - (*ptr1++) = (*ptr2++) * iop1; - (*ptr1++) = (*ptr2++) * iop1; - } - for (size_t i = iBlockMax * 4; i < vdim; ++i) - (*ptr1++) = (*ptr2++) * iop1; - return tmp; -} - -template -Matrix1D Matrix1D::operator+(T op1) const -{ - Matrix1D tmp(*this); - T *ptr1 = &VEC_ELEM(tmp,0); - const T *ptr2 = &VEC_ELEM(*this,0); - size_t iBlockMax = vdim / 4; - for (size_t i = 0; i < iBlockMax; i++) - { - (*ptr1++) = (*ptr2++) + op1; - (*ptr1++) = (*ptr2++) + op1; - (*ptr1++) = (*ptr2++) + op1; - (*ptr1++) = (*ptr2++) + op1; - } - for (size_t i = iBlockMax * 4; i < vdim; ++i) - (*ptr1++) = (*ptr2++) + op1; - return tmp; -} - -template -Matrix1D Matrix1D::operator-(T op1) const - { - Matrix1D tmp(*this); - T *ptr1 = &VEC_ELEM(tmp,0); - const T *ptr2 = &VEC_ELEM(*this,0); - size_t iBlockMax = vdim / 4; - for (size_t i = 0; i < iBlockMax; i++) - { - (*ptr1++) = (*ptr2++) - op1; - (*ptr1++) = (*ptr2++) - op1; - (*ptr1++) = (*ptr2++) - op1; - (*ptr1++) = (*ptr2++) - op1; - } - for (size_t i = iBlockMax * 4; i < vdim; ++i) - (*ptr1++) = (*ptr2++) - op1; - return tmp; - } - -template -void Matrix1D::operator+=(const Matrix1D& op1) const -{ - if (vdim != op1.vdim) - REPORT_ERROR(ERR_MATRIX_SIZE, "Not same sizes in vector summation"); - - T *ptr1 = &VEC_ELEM(*this,0); - const T *ptr2 = &VEC_ELEM(op1,0); - size_t iBlockMax = vdim / 4; - for (size_t i = 0; i < iBlockMax; i++) - { - (*ptr1++) += (*ptr2++); - (*ptr1++) += (*ptr2++); - (*ptr1++) += (*ptr2++); - (*ptr1++) += (*ptr2++); - } - for (size_t i = iBlockMax * 4; i < vdim; ++i) - (*ptr1++) += (*ptr2++); -} - -template -void Matrix1D::operator-=(const Matrix1D& op1) const -{ - if (vdim != op1.vdim) - REPORT_ERROR(ERR_MATRIX_SIZE, "Not same sizes in vector summation"); - - T *ptr1 = &VEC_ELEM(*this,0); - const T *ptr2 = &VEC_ELEM(op1,0); - size_t iBlockMax = vdim / 4; - for (size_t i = 0; i < iBlockMax; i++) - { - (*ptr1++) -= (*ptr2++); - (*ptr1++) -= (*ptr2++); - (*ptr1++) -= (*ptr2++); - (*ptr1++) -= (*ptr2++); - } - for (size_t i = iBlockMax * 4; i < vdim; ++i) - (*ptr1++) -= (*ptr2++); -} - -template -void Matrix1D::operator*=(T op1) -{ - T *ptr1 = &VEC_ELEM(*this,0); - size_t iBlockMax = vdim / 4; - for (size_t i = 0; i < iBlockMax; i++) - { - (*ptr1++) *= op1; - (*ptr1++) *= op1; - (*ptr1++) *= op1; - (*ptr1++) *= op1; - } - for (size_t i = iBlockMax * 4; i < vdim; ++i) - (*ptr1++) *= op1; -} - -template -void Matrix1D::operator/=(T op1) -{ - T iop1 = 1 / op1; - T * ptr1 = &VEC_ELEM(*this,0); - size_t iBlockMax = vdim / 4; - for (size_t i = 0; i < iBlockMax; i++) - { - (*ptr1++) *= iop1; - (*ptr1++) *= iop1; - (*ptr1++) *= iop1; - (*ptr1++) *= iop1; - } - for (size_t i = iBlockMax * 4; i < vdim; ++i) - (*ptr1++) *= iop1; -} - -template -void Matrix1D::operator+=(T op1) -{ - T *ptr1 = &VEC_ELEM(*this,0); - size_t iBlockMax = vdim / 4; - for (size_t i = 0; i < iBlockMax; i++) - { - (*ptr1++) += op1; - (*ptr1++) += op1; - (*ptr1++) += op1; - (*ptr1++) += op1; - } - for (size_t i = iBlockMax * 4; i < vdim; ++i) - (*ptr1++) += op1; -} - -template -void Matrix1D::operator-=(T op1) -{ - T *ptr1 = &VEC_ELEM(*this,0); - size_t iBlockMax = vdim / 4; - for (size_t i = 0; i < iBlockMax; i++) - { - (*ptr1++) -= op1; - (*ptr1++) -= op1; - (*ptr1++) -= op1; - (*ptr1++) -= op1; - } - for (size_t i = iBlockMax * 4; i < vdim; ++i) - (*ptr1++) -= op1; -} - -template -Matrix1D Matrix1D::operator*(const Matrix1D& op1) const -{ - Matrix1D tmp(op1); - T *ptr1 = &VEC_ELEM(tmp,0); - const T *ptr2 = &VEC_ELEM(*this,0); - const T *ptr3 = &VEC_ELEM(op1,0); - size_t iBlockMax = vdim / 4; - for (size_t i = 0; i < iBlockMax; i++) - { - (*ptr1++) = (*ptr2++) * (*ptr3++); - (*ptr1++) = (*ptr2++) * (*ptr3++); - (*ptr1++) = (*ptr2++) * (*ptr3++); - (*ptr1++) = (*ptr2++) * (*ptr3++); - } - for (size_t i = iBlockMax * 4; i < vdim; ++i) - (*ptr1++) = (*ptr2++) * (*ptr3++); - return tmp; -} - -template -Matrix1D Matrix1D::operator/(const Matrix1D& op1) const -{ - Matrix1D tmp(op1); - T *ptr1 = &VEC_ELEM(tmp,0); - const T *ptr2 = &VEC_ELEM(*this,0); - const T *ptr3 = &VEC_ELEM(op1,0); - size_t iBlockMax = vdim / 4; - for (size_t i = 0; i < iBlockMax; i++) - { - (*ptr1++) = (*ptr2++) / (*ptr3++); - (*ptr1++) = (*ptr2++) / (*ptr3++); - (*ptr1++) = (*ptr2++) / (*ptr3++); - (*ptr1++) = (*ptr2++) / (*ptr3++); - } - for (size_t i = iBlockMax * 4; i < vdim; ++i) - (*ptr1++) = (*ptr2++) / (*ptr3++); - return tmp; -} - -template -Matrix1D Matrix1D::operator+(const Matrix1D& op1) const -{ - Matrix1D tmp(op1); - T *ptr1 = &VEC_ELEM(tmp,0); - const T *ptr2 = &VEC_ELEM(*this,0); - const T *ptr3 = &VEC_ELEM(op1,0); - size_t iBlockMax = vdim / 4; - for (size_t i = 0; i < iBlockMax; i++) - { - (*ptr1++) = (*ptr2++) + (*ptr3++); - (*ptr1++) = (*ptr2++) + (*ptr3++); - (*ptr1++) = (*ptr2++) + (*ptr3++); - (*ptr1++) = (*ptr2++) + (*ptr3++); - } - for (size_t i = iBlockMax * 4; i < vdim; ++i) - (*ptr1++) = (*ptr2++) + (*ptr3++); - return tmp; -} - -template -Matrix1D Matrix1D::operator-(const Matrix1D& op1) const -{ - Matrix1D tmp(op1); - T *ptr1 = &VEC_ELEM(tmp,0); - const T *ptr2 = &VEC_ELEM(*this,0); - const T *ptr3 = &VEC_ELEM(op1,0); - size_t iBlockMax = vdim / 4; - for (size_t i = 0; i < iBlockMax; i++) - { - (*ptr1++) = (*ptr2++) - (*ptr3++); - (*ptr1++) = (*ptr2++) - (*ptr3++); - (*ptr1++) = (*ptr2++) - (*ptr3++); - (*ptr1++) = (*ptr2++) - (*ptr3++); - } - for (size_t i = iBlockMax * 4; i < vdim; ++i) - (*ptr1++) = (*ptr2++) - (*ptr3++); - return tmp; -} - -template -void Matrix1D::operator*=(const Matrix1D& op1) -{ - T *ptr1 = &VEC_ELEM(*this,0); - const T *ptr2 = &VEC_ELEM(op1,0); - size_t iBlockMax = vdim / 4; - for (size_t i = 0; i < iBlockMax; i++) - { - (*ptr1++) *= (*ptr2++); - (*ptr1++) *= (*ptr2++); - (*ptr1++) *= (*ptr2++); - (*ptr1++) *= (*ptr2++); - } - for (size_t i = iBlockMax * 4; i < vdim; ++i) - (*ptr1++) *= (*ptr2++); -} - -template -void Matrix1D::operator/=(const Matrix1D& op1) -{ - T *ptr1 = &VEC_ELEM(*this,0); - const T *ptr2 = &VEC_ELEM(op1,0); - size_t iBlockMax = vdim / 4; - for (size_t i = 0; i < iBlockMax; i++) - { - (*ptr1++) /= (*ptr2++); - (*ptr1++) /= (*ptr2++); - (*ptr1++) /= (*ptr2++); - (*ptr1++) /= (*ptr2++); - } - for (size_t i = iBlockMax * 4; i < vdim; ++i) - (*ptr1++) /= (*ptr2++); -} - -template -void Matrix1D::operator+=(const Matrix1D& op1) - { - T *ptr1 = &VEC_ELEM(*this,0); - const T *ptr2 = &VEC_ELEM(op1,0); - size_t iBlockMax = vdim / 4; - for (size_t i = 0; i < iBlockMax; i++) - { - (*ptr1++) += (*ptr2++); - (*ptr1++) += (*ptr2++); - (*ptr1++) += (*ptr2++); - (*ptr1++) += (*ptr2++); - } - for (size_t i = iBlockMax * 4; i < vdim; ++i) - (*ptr1++) += (*ptr2++); - } - -template -void Matrix1D::operator-=(const Matrix1D& op1) - { - T *ptr1 = &VEC_ELEM(*this,0); - const T *ptr2 = &VEC_ELEM(op1,0); - size_t iBlockMax = vdim / 4; - for (size_t i = 0; i < iBlockMax; i++) - { - (*ptr1++) -= (*ptr2++); - (*ptr1++) -= (*ptr2++); - (*ptr1++) -= (*ptr2++); - (*ptr1++) -= (*ptr2++); - } - for (size_t i = iBlockMax * 4; i < vdim; ++i) - (*ptr1++) -= (*ptr2++); - } - -template -Matrix1D Matrix1D::operator-() const -{ - Matrix1D tmp(*this); - T *ptr1 = &VEC_ELEM(tmp,0); - const T *ptr2 = &VEC_ELEM(*this,0); - size_t iBlockMax = vdim / 4; - for (size_t i = 0; i < iBlockMax; i++) - { - if constexpr (std::is_signed_v || std::is_floating_point_v) { - (*ptr1++) = -(*ptr2++); - (*ptr1++) = -(*ptr2++); - (*ptr1++) = -(*ptr2++); - (*ptr1++) = -(*ptr2++); - } else { - REPORT_ERROR( - ERR_TYPE_INCORRECT, - static_cast("Can not use unitary minus on unsigned datatypes")); - } - - } - for (size_t i = iBlockMax * 4; i < vdim; ++i) - if constexpr (std::is_signed_v || std::is_floating_point_v) { - (*ptr1++) = -(*ptr2++); - } else { - REPORT_ERROR( - ERR_TYPE_INCORRECT, - static_cast("Can not use unitary minus on unsigned datatypes")); - } - return tmp; -} - -template -void Matrix1D::selfCEIL() -{ - T *ptr1 = &VEC_ELEM(*this,0); - size_t iBlockMax = vdim / 4; - for (size_t i = 0; i < iBlockMax; i++) - { - *ptr1 = ceil(*ptr1); - ++ptr1; - *ptr1 = ceil(*ptr1); - ++ptr1; - *ptr1 = ceil(*ptr1); - ++ptr1; - *ptr1 = ceil(*ptr1); - ++ptr1; - } - for (size_t i = iBlockMax * 4; i < vdim; ++i) - { - *ptr1 = ceil(*ptr1); - ++ptr1; - } -} - -template -void Matrix1D::selfFLOOR() -{ - T *ptr1 = &VEC_ELEM(*this,0); - size_t iBlockMax = vdim / 4; - for (size_t i = 0; i < iBlockMax; i++) - { - *ptr1 = floor(*ptr1); - ++ptr1; - *ptr1 = floor(*ptr1); - ++ptr1; - *ptr1 = floor(*ptr1); - ++ptr1; - *ptr1 = floor(*ptr1); - ++ptr1; - } - for (size_t i = iBlockMax * 4; i < vdim; ++i) - { - *ptr1 = floor(*ptr1); - ++ptr1; - } -} - -template -void Matrix1D::selfROUND() -{ - T *ptr1 = &VEC_ELEM(*this,0); - size_t iBlockMax = vdim / 4; - for (size_t i = 0; i < iBlockMax; i++) - { - *ptr1 = round(*ptr1); - ++ptr1; - *ptr1 = round(*ptr1); - ++ptr1; - *ptr1 = round(*ptr1); - ++ptr1; - *ptr1 = round(*ptr1); - ++ptr1; - } - for (size_t i = iBlockMax * 4; i < vdim; ++i) - { - *ptr1 = round(*ptr1); - ++ptr1; - } -} - - /** Mean value of the vector */ -template -double Matrix1D::computeMean() const -{ - if (vdim == 0) - return 0; - - double sum = 0; - for (size_t j = 0; j < vdim; ++j) - sum+=VEC_ELEM(*this,j); - return sum/vdim; -} - -template -T Matrix1D::computeMax() const -{ - if (vdim == 0) - return 0; - - T maxval = VEC_ELEM(*this,0); - for (size_t j = 0; j < vdim; ++j) - if (VEC_ELEM(*this,j) > maxval) - maxval = VEC_ELEM(*this,j); - return maxval; -} - -template -void Matrix1D::computeMinMax(T &minval, T &maxval) const -{ - if (vdim == 0) - return; - - maxval = minval = VEC_ELEM(*this,0); - for (size_t j = 0; j < vdim; ++j) - { - T val=VEC_ELEM(*this,j); - if (val > maxval) - maxval = val; - else if (val -void Matrix1D::computeMeanAndStddev(double &mean, double &stddev) const -{ - mean=stddev=0; - if (vdim == 0) - return; - - double sum = 0, sum2 = 0; - for (size_t j = 0; j < vdim; ++j) - { - double val=VEC_ELEM(*this,j); - sum+=val; - sum2+=val*val; - } - mean=sum/vdim; - stddev=sum2/vdim-mean*mean; - if (stddev<0) - stddev=0; - else - stddev=sqrt(stddev); -} - -template -int Matrix1D::maxIndex() const -{ - if (vdim == 0) - return -1; - - int jmax = 0; - T maxval = VEC_ELEM(*this, 0); - for (size_t j = 0; j < vdim; ++j) - if (VEC_ELEM(*this,j) > maxval) - { - jmax = j; - maxval = VEC_ELEM(*this,j); - } - return jmax; -} - -template -int Matrix1D::minIndex() const -{ - if (vdim == 0) - return -1; - - int jmin = 0; - T minval = VEC_ELEM(*this, 0); - for (size_t j = 0; j < vdim; ++j) - if (VEC_ELEM(*this,j) < minval) - { - jmin = j; - minval = VEC_ELEM(*this,j); - } - return jmin; -} - -template -Matrix1D Matrix1D::transpose() const -{ - Matrix1D temp(*this); - temp.selfTranspose(); - return temp; -} - -template -double Matrix1D::sum(bool average) const -{ - double sum = 0; - const T *ptr1 = &VEC_ELEM(*this,0); - size_t iBlockMax = vdim / 4; - for (size_t i = 0; i < iBlockMax; i++) - { - sum += (*ptr1++); - sum += (*ptr1++); - sum += (*ptr1++); - sum += (*ptr1++); - } - for (size_t i = iBlockMax * 4; i < vdim; ++i) - sum += (*ptr1++); - if (average) - return sum / (double) vdim; - else - return sum; -} - -template -double Matrix1D::sum2() const -{ - double sum = 0; - const T *ptr1 = &VEC_ELEM(*this,0); - double val; - size_t iBlockMax = vdim / 4; - for (size_t i = 0; i < iBlockMax; i++) - { - val = *ptr1; - sum += val * val; - ++ptr1; - val = *ptr1; - sum += val * val; - ++ptr1; - val = *ptr1; - sum += val * val; - ++ptr1; - val = *ptr1; - sum += val * val; - ++ptr1; - } - for (size_t i = iBlockMax * 4; i < vdim; ++i) - { - val = *ptr1; - sum += val * val; - ++ptr1; - } - return sum; -} - -template -double Matrix1D::dotProduct(const Matrix1D &op1) const -{ - double sum = 0; - const T *ptr1 = &VEC_ELEM(*this,0); - const T *ptr2 = &VEC_ELEM(op1,0); - size_t iBlockMax = vdim / 4; - for (size_t i = 0; i < iBlockMax; i++) - { - sum += (*ptr1++) * (*ptr2++); - sum += (*ptr1++) * (*ptr2++); - sum += (*ptr1++) * (*ptr2++); - sum += (*ptr1++) * (*ptr2++); - } - for (size_t i = iBlockMax * 4; i < vdim; ++i) - sum += (*ptr1++) * (*ptr2++); - return sum; -} - -template -void Matrix1D::selfNormalize() -{ - double m = module(); - if (fabs(m) > XMIPP_EQUAL_ACCURACY) - { - T im = (T) (1.0 / m); - *this *= im; - } - else - initZeros(); -} - -template -void Matrix1D::selfReverse() -{ - for (int j = 0; j <= (int) (vdim - 1) / 2; j++) - { - T aux; - SWAP(vdata[j], vdata[vdim-1-j], aux); - } -} - -template -void Matrix1D::numericalDerivative(Matrix1D &result) const -{ - const double i12 = 1.0 / 12.0; - result.initZeros(*this); - for (int i = 2; i <= vdim - 2; i++) - if constexpr (std::is_signed_v || std::is_floating_point_v) { - result(i) = i12 - * (-(*this)(i + 2) + 8 * (*this)(i + 1) - 8 * (*this)(i - 1) - + (*this)(i + 2)); - } else { - REPORT_ERROR( - ERR_TYPE_INCORRECT, - static_cast("Can not use unitary minus on unsigned datatypes")); - } -} - -template -void Matrix1D::showWithGnuPlot(const std::string& xlabel, const std::string& title) -{ - FileName fn_tmp; - fn_tmp.initRandom(10); - Matrix1D::write(static_cast("PPP") + fn_tmp + ".txt"); - - std::ofstream fh_gplot; - fh_gplot.open( - (static_cast("PPP") + fn_tmp + ".gpl").c_str()); - if (!fh_gplot) - REPORT_ERROR( - ERR_UNCLASSIFIED, - static_cast("vector::showWithGnuPlot: Cannot open PPP") + fn_tmp + ".gpl for output"); - fh_gplot << "set xlabel \"" + xlabel + "\"\n"; - fh_gplot - << "plot \"PPP" + fn_tmp + ".txt\" title \"" + title - + "\" w l\n"; - fh_gplot << "pause 300 \"\"\n"; - fh_gplot.close(); - auto res = system( - (static_cast("(gnuplot PPP") + fn_tmp - + ".gpl; rm PPP" + fn_tmp + ".txt PPP" + fn_tmp - + ".gpl) &").c_str()); - if (0 != res) { - REPORT_ERROR( - ERR_UNCLASSIFIED, - "Something went wrong when working with GNUPlot. Please report this error to developers."); - } -} - -template -void Matrix1D::write(const FileName& fn) const -{ - std::ofstream out; - out.open(fn.c_str(), std::ios::out); - if (!out) - REPORT_ERROR( - ERR_IO_NOTOPEN, - static_cast< std::string >("Matrix1D::write: File " + fn + " cannot be opened for output")); - - out << *this; - out.close(); -} - -template -void Matrix1D::read(const FileName& fn) -{ - std::ifstream in; - in.open(fn.c_str(), std::ios::in); - - if (!in) - REPORT_ERROR( - ERR_IO_NOTOPEN, - static_cast< std::string >("MultidimArray::read: File " + fn + " not found")); - - in >> *this; - in.close(); -} - -template -void Matrix1D::edit() -{ - FileName nam; - nam.initRandom(15); - - nam = static_cast("PPP" + nam + ".txt"); - write - (nam); - - auto res = system( - (static_cast("xmipp_edit -i " + nam + " -remove &").c_str())); - if (0 != res) { - REPORT_ERROR( - ERR_UNCLASSIFIED, - "Something went wrong when working with xmipp_edit. Please report this error to developers."); - } -} - -template -T Matrix1D::computeMedian() const -{ - Matrix1D aux; - aux=*this; - std::nth_element(aux.vdata,aux.vdata+vdim/2,aux.vdata+vdim); - return VEC_ELEM(aux,vdim/2); -} -template -Matrix1D Matrix1D::sort() const -{ - Matrix1D temp(*this); - if (vdim == 0) - return temp; - - std::sort(temp.vdata, temp.vdata + temp.vdim); - return temp; -} - -template -void Matrix1D::indexSort(Matrix1D &indx) const -{ - Matrix1D< double > temp; - indx.clear(); - - if (VEC_XSIZE(*this) == 0) - return; - - if (VEC_XSIZE(*this) == 1) - { - indx.resizeNoCopy(1); - VEC_ELEM(indx,0) = 1; - return; - } - - // Initialise data - indx.resizeNoCopy(VEC_XSIZE(*this)); - typeCast(*this, temp); - - // Sort indexes - indexx(VEC_XSIZE(*this), MATRIX1D_ARRAY(temp)-1, MATRIX1D_ARRAY(indx)-1); -} - -Matrix1D vectorR2(double x, double y) -{ - Matrix1D result(2); - VEC_ELEM(result, 0) = x; - VEC_ELEM(result, 1) = y; - return result; -} - -Matrix1D vectorR3(double x, double y, double z) -{ - Matrix1D result(3); - VEC_ELEM(result, 0) = x; - VEC_ELEM(result, 1) = y; - VEC_ELEM(result, 2) = z; - return result; -} - -Matrix1D vectorR3(int x, int y, int z) -{ - Matrix1D result(3); - VEC_ELEM(result, 0) = x; - VEC_ELEM(result, 1) = y; - VEC_ELEM(result, 2) = z; - return result; -} - -// explicit instantiation -template class Matrix1D; -template class Matrix1D; -template class Matrix1D; -template class Matrix1D; -template class Matrix1D; -template class Matrix1D; diff --git a/src/core/matrix1d.h b/src/core/matrix1d.h deleted file mode 100644 index dc73e4a..0000000 --- a/src/core/matrix1d.h +++ /dev/null @@ -1,1251 +0,0 @@ -/*************************************************************************** - * - * Authors: Carlos Oscar S. Sorzano (coss@cnb.csic.es) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_MATRIX1D_H_ -#define CORE_MATRIX1D_H_ - -#include -#include -#include -#include "xmipp_error.h" -#include "xmipp_macros.h" - -class FileName; -template -class Matrix2D; - -/** @defgroup Vectors Matrix1D Vectors - * @ingroup DataLibrary - */ -//@{ -/** @name Vectors speed up macros - * - * This macros are defined to allow high speed in critical parts of your - * program. They shouldn't be used systematically as usually there is no - * checking on the correctness of the operation you are performing. Speed comes - * from three facts: first, they are macros and no function call is performed - * (although most of the critical functions are inline functions), there is no - * checking on the correctness of the operation (it could be wrong and you are - * not warned of it), and destination vectors are not returned saving time in - * the copy constructor and in the creation/destruction of temporary vectors. - */ -//@{ -/** Array access. - * This macro gives you access to the array (T) - */ -#define MATRIX1D_ARRAY(v) ((v).vdata) - -/** For all elements in the array - * This macro is used to generate loops for the vector in an easy manner. It - * defines an internal index 'i' which ranges the vector using its mathematical - * definition (ie, logical access). - * - * @code - * FOR_ALL_ELEMENTS_IN_MATRIX1D(v) - * { - * std::cout << v(i) << " "; - * } - * @endcode - */ -#define FOR_ALL_ELEMENTS_IN_MATRIX1D(v) \ - for (size_t i=0; i v(2); - * VECTOR_R2(v, 1, 2); - * @endcode - */ -#define VECTOR_R2(v, x, y) { \ - XX(v) = x; YY(v) = y; } - -/** Creates vector in R3 - * The vector must be created beforehand to the correct size. After this macro - * the vector is (x, y, z) in R3. - * - * @code - * MultidimArray< double > v(3); - * VECTOR_R2(v, 1, 2, 1); - * @endcode - */ -#define VECTOR_R3(v, x, y, z) { \ - XX(v) = x; YY(v) = y; ZZ(v) = z;} - -/** Adding two R2 vectors (a=b+c) - * @code - * MultidimArray< double > a(2), b(2), c(2); - * ...; - * V2_PLUS_V2(a, b, c); - * @endcode - */ -#define V2_PLUS_V2(a, b, c) { \ - XX(a) = XX(b) + XX(c); \ - YY(a) = YY(b) + YY(c); } - -/** Subtracting two R2 vectors (a=b-c) - * @code - * MultidimArray< double > a(2), b(2), c(2); - * ...; - * V2_MINUS_V2(a, b, c); - * @endcode - */ -#define V2_MINUS_V2(a, b, c) { \ - XX(a) = XX(b) - XX(c); \ - YY(a) = YY(b) - YY(c); } - -/** Adding/subtracting a constant to a R2 vector (a=b-k). - * @code - * MultidimArray< double > a(2), b(2); - * double k; - * ...; - * V2_PLUS_CT(a, b, k); - * - * MultidimArray< double > a(2), b(2); - * double k; - * ...; - * V2_PLUS_CT(a, b, -k); - * @endcode - */ -#define V2_PLUS_CT(a, b, k) { \ - XX(a) = XX(b) + (k); \ - YY(a) = YY(b) + (k); } - -/** Multiplying/dividing by a constant a R2 vector (a=b*k) - * @code - * MultidimArray< double > a(2), b(2); - * double k; - * ...; - * V2_BY_CT(a, b, k); - * - * MultidimArray< double > a(2), b(2); - * double k; - * ...; - * V2_BY_CT(a, b, 1/k); - * @endcode - */ -#define V2_BY_CT(a, b, k) { \ - XX(a) = XX(b) * (k); \ - YY(a) = YY(b) * (k); } - -/** Adding two R3 vectors (a=b+c) - * @code - * MultidimArray< double > a(3), b(3), c(3); - * ...; - * V3_PLUS_V3(a, b, c); - * @endcode - */ -#define V3_PLUS_V3(a, b, c) { \ - XX(a) = XX(b) + XX(c); \ - YY(a) = YY(b) + YY(c); \ - ZZ(a) = ZZ(b) + ZZ(c); } - -/** Subtracting two R3 vectors (a=b-c) - * @code - * MultidimArray< double > a(3), b(3), c(3); - * ...; - * V3_MINUS_V3(a, b, c); - * @endcode - */ -#define V3_MINUS_V3(a, b, c) { \ - XX(a) = XX(b) - XX(c); \ - YY(a) = YY(b) - YY(c); \ - ZZ(a) = ZZ(b) - ZZ(c); } - -/** Adding/subtracting a constant to a R3 vector (a=b-k) - * @code - * MultidimArray< double > a(3), b(3); - * double k; - * ...; - * V3_PLUS_CT(a, b, k); - * - * MultidimArray< double > a(3), b(3); - * double k; - * ...; - * V3_PLUS_CT(a, b, -k); - * @endcode - */ -#define V3_PLUS_CT(a, b, c) { \ - XX(a) = XX(b) + (c); \ - YY(a) = YY(b) + (c); \ - ZZ(a) = ZZ(b) + (c); } - -/** Multiplying/dividing by a constant a R3 vector (a=b*k) - * @code - * MultidimArray< double > a(3), b(3); - * double k; - * ...; - * V3_BY_CT(a, b, k); - * - * MultidimArray< double > a(3), b(3); - * double k; - * ...; - * V3_BY_CT(a, b, 1/k); - * @endcode - */ -#define V3_BY_CT(a, b, c) { \ - XX(a) = XX(b) * (c); \ - YY(a) = YY(b) * (c); \ - ZZ(a) = ZZ(b) * (c); } - -/** Direct access to vector element - */ -#define VEC_ELEM(v,i) ((v).vdata[(i)]) -#define dMi(v, i) ((v).vdata[(i)]) - -#define VEC_SWAP(v, i, j, aux) {aux = dMi(v, i); dMi(v, i) = dMi(v, j); dMi(v, j) = aux; } - -//@} - -/** Matrix1D class.*/ -template -class Matrix1D -{ -public: - /// The array itself - T* vdata; - - /// Destroy data - bool destroyData; - - /// Number of elements - size_t vdim; - - /// <0=column vector (default), 1=row vector - bool row; - - /// @name Constructors - //@{ - /** Empty constructor - * - * The empty constructor creates a vector with no memory associated, - * origin=0, size=0, no statistics, ... You can choose between a column - * vector (by default), or a row one. - * - * @code - * Matrix1D< double > v1; - * Matrix1D< double > v1(true); - * // both are examples of empty column vectors - * - * Matrix1D< int > v1(false); - * // empty row vector - * @endcode - */ - Matrix1D(bool column = true) - { - coreInit(); - row = !column; - } - - /** Dimension constructor - * - * The dimension constructor creates a vector with memory associated (but - * not assigned to anything, could be full of garbage) origin=0, size=the - * given one. You can choose between a column vector (by default), or a row - * one. - * - * @code - * Matrix1D< double > v1(6); - * Matrix1D< double > v1(6, 'y'); - * // both are examples of column vectors of dimensions 6 - * - * Matrix1D< int > v1('n'); - * // empty row vector - * @endcode - */ - template - Matrix1D(T1 dim, bool column = true) - { - coreInit(); - row = !column; - initZeros(dim); - } - - /** Copy constructor - * - * The created vector is a perfect copy of the input vector but with a - * different memory assignment. - * - * @code - * Matrix1D< double > v2(v1); - * @endcode - */ - Matrix1D(const Matrix1D& v) - { - coreInit(); - *this = v; - row = v.row; - } - - /** Destructor. - */ - ~Matrix1D() - { - coreDeallocate(); - } - - /** Assignment. - * - * You can build as complex assignment expressions as you like. Multiple - * assignment is allowed. - * - * @code - * v1 = v2 + v3; - * v1 = v2 = v3; - * @endcode - */ - Matrix1D& operator=(const Matrix1D& op1); - - /** Equals. - */ - bool operator==(const Matrix1D& op1) const; - - /** Assignment. - */ - Matrix1D& operator=(const std::vector& op1); - - /** Clear. - */ - void clear(); - - /** Core init. - * Initialize everything to 0 - */ - void coreInit(); - - /** Core allocate. - */ - inline void coreAllocate(int _vdim) - { - if (_vdim <= 0) - { - clear(); - return; - } - - vdim = _vdim; - vdata = new T[vdim]; - memset(vdata, 0, vdim * sizeof(T)); - if (vdata == NULL - ) - REPORT_ERROR(ERR_MEM_NOTENOUGH, "Allocate: No space left"); - } - - /** Core deallocate. - * Free all vdata. - */ - inline void coreDeallocate() - { - if (vdata != NULL && destroyData) - delete[] vdata; - vdata = NULL; - } - //@} - - ///@name Size and shape of Matrix1D - //@{ - /** Resize to a given size - * - * This function resize the actual array to the given size. The origin is - * not modified. If the actual array is larger than the pattern then the - * values outside the new size are lost, if it is smaller then 0's are - * added. An exception is thrown if there is no memory. - * - * @code - * V1.resize(3, 3, 2); - * @endcode - */ - inline void resize(size_t Xdim, bool copy = true) - { - if (Xdim == vdim) - return; - - if (Xdim <= 0) - { - clear(); - return; - } - - T * new_vdata; - try - { - new_vdata = new T[(size_t) Xdim]; //TODO: Kino: Valgrind points here there is something wrong, but I could'nt resolve - memset(new_vdata, 0, Xdim * sizeof(T)); - } - catch (std::bad_alloc &) - { - REPORT_ERROR(ERR_MEM_NOTENOUGH, "Allocate: No space left"); - } - - // Copy needed elements, fill with 0 if necessary - if (copy) - { - T zero=0; // Useful for complexes - for (size_t j = 0; j < Xdim; j++) - { - T *val=NULL; - if (j >= vdim) - val = &zero; - else - val = &vdata[j]; - new_vdata[j] = *val; - } - } - - // deallocate old vector - coreDeallocate(); - - // assign *this vector to the newly created - vdata = new_vdata; - vdim = Xdim; - - } - - /** Resize a single 1D image with no copy - */ - inline void resizeNoCopy(int Xdim) - { - resize(Xdim, false); - } - - /** Resize according to a pattern. - * - * This function resize the actual array to the same size - * as the input pattern. If the actual array is larger than the pattern - * then the trailing values are lost, if it is smaller then 0's are - * added at the end - * - * @code - * v2.resize(v1); - * // v2 has got now the same structure as v1 - * @endcode - */ - template - void resize(const Matrix1D &v) - { - if (vdim != v.vdim) - resize(v.vdim); - } - - /** Resize a single 1D image with no copy - */ - template - void resizeNoCopy(const Matrix1D &v) - { - if (vdim != v.vdim) - resize(v.vdim, false); - } - - /** Same shape. - * - * Returns true if this object has got the same shape (origin and size) - * than the argument - */ - template - bool sameShape(const Matrix1D& op) const - { - return (vdim == op.vdim); - } - - /** Returns the size of this vector - * - * @code - * int nn = a.size(); - * @endcode - */ - inline size_t size() const - { - return vdim; - } - - /** True if vector is a row. - * - * @code - * if (v.isRow()) - * std::cout << "v is a row vector\n"; - * @endcode - */ - inline int isRow() const - { - return row; - } - - /** True if vector is a column - * - * @code - * if (v.isCol()) - * std::cout << "v is a column vector\n"; - * @endcode - */ - inline int isCol() const - { - return !row; - } - - /** Forces the vector to be a row vector - * - * @code - * v.setRow(); - * @endcode - */ - inline void setRow() - { - row = true; - } - - /** Forces the vector to be a column vector - * - * @code - * v.setCol(); - * @endcode - */ - inline void setCol() - { - row = false; - } - //@} - - /// @name Initialization of Matrix1D values - //@{ - /** Same value in all components. - * - * The constant must be of a type compatible with the array type, ie, - * you cannot assign a double to an integer array without a casting. - * It is not an error if the array is empty, then nothing is done. - * - * @code - * v.initConstant(3.14); - * @endcode - */ - void initConstant(T val); - - /** Initialize to constant with a given size. - */ - void initConstant(size_t Xdim, T val); - - - /** Enumerate starting from 0 to size - */ - void enumerate(); - - /** Initialize to zeros with current size. - * - * All values are set to 0. The current size and origin are kept. It is not - * an error if the array is empty, then nothing is done. - * - * @code - * v.initZeros(); - * @endcode - */ - inline void initZeros() - { - memset(vdata, 0, vdim * sizeof(T)); - } - - /** Initialize to zeros with a given size. - */ - inline void initZeros(size_t Xdim) - { - if (vdim != Xdim) - resizeNoCopy(Xdim); - memset(vdata, 0, vdim * sizeof(T)); - } - - /** Initialize to zeros following a pattern. - * - * All values are set to 0, and the origin and size of the pattern are - * adopted. - * - * @code - * v2.initZeros(v1); - * @endcode - */ - template - inline void initZeros(const Matrix1D& op) - { - if (vdim != op.vdim) - resize(op); - memset(vdata, 0, vdim * sizeof(T)); - } - //@} - - /** Check if any element of the array is NaN. - */ - bool isAnyNaN(); - - /// @name Matrix1D operators - //@{ - /** v3 = v1 * k. - */ - Matrix1D operator*(T op1) const; - - /** v3 = v1 / k. - */ - Matrix1D operator/(T op1) const; - - /** v3 = v1 + k. - */ - Matrix1D operator+(T op1) const; - - /** v3 = v1 - k. - */ - Matrix1D operator-(T op1) const; - - /** v3 = k * v2. - */ - friend Matrix1D operator*(T op1, const Matrix1D& op2) - { - Matrix1D tmp(op2); - T *ptr1 = &VEC_ELEM(tmp,0); - const T *ptr2 = &VEC_ELEM(op2,0); - size_t iBlockMax = op2.vdim / 4; - for (size_t i = 0; i < iBlockMax; i++) - { - (*ptr1++) = (*ptr2++) * op1; - (*ptr1++) = (*ptr2++) * op1; - (*ptr1++) = (*ptr2++) * op1; - (*ptr1++) = (*ptr2++) * op1; - } - for (size_t i = iBlockMax * 4; i < op2.vdim; ++i) - (*ptr1++) = (*ptr2++) * op1; - return tmp; - } - - /** v3 = k / v2. - */ - friend Matrix1D operator/(T op1, const Matrix1D& op2) - { - Matrix1D tmp(op2); - T *ptr1 = &VEC_ELEM(tmp,0); - const T *ptr2 = &VEC_ELEM(op2,0); - size_t iBlockMax = op2.vdim / 4; - for (size_t i = 0; i < iBlockMax; i++) - { - (*ptr1++) = op1 / (*ptr2++); - (*ptr1++) = op1 / (*ptr2++); - (*ptr1++) = op1 / (*ptr2++); - (*ptr1++) = op1 / (*ptr2++); - } - for (size_t i = iBlockMax * 4; i < op2.vdim; ++i) - (*ptr1++) = op1 / (*ptr2++); - return tmp; - } - - /** v3 = k + v2. - */ - friend Matrix1D operator+(T op1, const Matrix1D& op2) - { - Matrix1D tmp(op2); - T *ptr1 = &VEC_ELEM(tmp,0); - const T *ptr2 = &VEC_ELEM(op2,0); - size_t iBlockMax = op2.vdim / 4; - for (size_t i = 0; i < iBlockMax; i++) - { - (*ptr1++) = (*ptr2++) + op1; - (*ptr1++) = (*ptr2++) + op1; - (*ptr1++) = (*ptr2++) + op1; - (*ptr1++) = (*ptr2++) + op1; - } - for (size_t i = iBlockMax * 4; i < op2.vdim; ++i) - (*ptr1++) = (*ptr2++) + op1; - return tmp; - } - - /** v3 = k - v2. - */ - friend Matrix1D operator-(T op1, const Matrix1D& op2) - { - Matrix1D tmp(op2); - T *ptr1 = &VEC_ELEM(tmp,0); - const T *ptr2 = &VEC_ELEM(op2,0); - size_t iBlockMax = op2.vdim / 4; - for (size_t i = 0; i < iBlockMax; i++) - { - (*ptr1++) = op1 - (*ptr2++); - (*ptr1++) = op1 - (*ptr2++); - (*ptr1++) = op1 - (*ptr2++); - (*ptr1++) = op1 - (*ptr2++); - } - for (size_t i = iBlockMax * 4; i < op2.vdim; ++i) - (*ptr1++) = op1 - (*ptr2++); - return tmp; - } - - /** Vector summation - * - * @code - * A += B; - * @endcode - */ - void operator+=(const Matrix1D& op1) const; - - /** Vector subtraction - * - * @code - * A -= B; - * @endcode - */ - void operator-=(const Matrix1D& op1) const; - - /** v3 *= k. - */ - void operator*=(T op1); - - /** v3 /= k. - */ - void operator/=(T op1); - - /** v3 += k. - */ - void operator+=(T op1); - - /** v3 -= k. - */ - void operator-=(T op1); - - /** v3 = v1 * v2. - */ - Matrix1D operator*(const Matrix1D& op1) const; - - /** v3 = v1 / v2. - */ - Matrix1D operator/(const Matrix1D& op1) const; - /** v3 = v1 + v2. - */ - Matrix1D operator+(const Matrix1D& op1) const; - - /** v3 = v1 - v2. - */ - Matrix1D operator-(const Matrix1D& op1) const; - - /** v3 *= v2. - */ - void operator*=(const Matrix1D& op1); - - /** v3 /= v2. - */ - void operator/=(const Matrix1D& op1); - - /** v3 += v2. - */ - void operator+=(const Matrix1D& op1); - - /** v3 -= v2. - */ - void operator-=(const Matrix1D& op1); - - /** Unary minus. - * - * It is used to build arithmetic expressions. You can make a minus - * of anything as long as it is correct semantically. - * - * @code - * v1 = -v2; - * v1 = -v2.transpose(); - * @endcode - */ - Matrix1D operator-() const; - - /** Vector by matrix - * - * Algebraic vector by matrix multiplication. This function is actually - * implemented in xmippMatrices2D - */ - Matrix1D operator*(const Matrix2D& M); - - /** Vector element access - * - * Returns the value of a vector logical position. In our example we could - * access from v(-2) to v(2). The elements can be used either by value or by - * reference. - * - * @code - * v(-2) = 1; - * val = v(-2); - * @endcode - */ - inline T& operator()(int i) const - { - return vdata[i]; - } - - inline T& operator [](int idx) { - return vdata[idx]; - } - - inline T operator [](int idx) const { - return vdata[idx]; - } - - /// @name Utilities for Matrix1D - //@{ - - /** Produce a vector suitable for working with Numerical Recipes - * - * This function must be used only as a preparation for routines which need - * that the first physical index is 1 and not 0 as it usually is in C. In - * fact the vector provided for Numerical recipes is exactly this same one - * but with the indexes changed. - * - * This function is not ported to Python. - */ - inline T* adaptForNumericalRecipes() const - { - return MATRIX1D_ARRAY(*this) - 1; - } - - /** Kill an array produced for Numerical Recipes. - * - * Nothing needs to be done in fact. - * - * This function is not ported to Python. - */ - void killAdaptationForNumericalRecipes(T* m) const - {} - - /** CEILING - * - * Applies a CEILING (look for the nearest larger integer) to each - * array element. - */ - void selfCEIL(); - - /** FLOOR - * - * Applies a FLOOR (look for the nearest larger integer) to each - * array element. - */ - void selfFLOOR(); - - /** ROUND - * - * Applies a ROUND (look for the nearest larger integer) to each - * array element. - */ - void selfROUND(); - - /** Sort 1D vector elements - * - * Sort in ascending order the vector elements. You can use the "reverse" - * function to sort in descending order. - * - * @code - * v2 = v1.sort(); - * @endcode - */ - Matrix1D sort() const; - - /** Gives a vector with the indexes for a sorted vector - * - * This function returns the indexes of a sorted vector. The input vector is - * not modified at all. For instance, if the input vector is [3 2 -1 0] the - * result of this function would be [3 4 2 1] meaning that the lowest value - * is at index 3, then comes the element at index 4, ... Note that - * indexes start at 1. - */ - void indexSort(Matrix1D &indx) const; - - /** Mean value of the vector */ - double computeMean() const; - - /** Maximum element */ - T computeMax() const; - - /** Minimum and maximum element */ - void computeMinMax(T &minval, T &maxval) const; - - /** Mean and stddev value of the vector */ - void computeMeanAndStddev(double &mean, double &stddev) const; - - /** Median of the vector */ - T computeMedian() const; - - /** Index for the maximum element. - * - * This function returns the index of the maximum element of an matrix1d. - * Returns -1 if the array is empty - */ - int maxIndex() const; - - /** Index for the minimum element. - * - * This function returns the index of the minimum element of an matrix1d. - * Returns -1 if the array is empty - */ - int minIndex() const; - - /** Algebraic transpose of vector - * - * You can use the transpose in as complex expressions as you like. The - * origin of the vector is not changed. - * - * @code - * v2 = v1.transpose(); - * @endcode - */ - Matrix1D transpose() const; - - /** Algebraic transpose of vector - * - * The same as before but the result is stored in this same object. - */ - inline void selfTranspose() - { - row = !row; - } - - /** Sum of vector values. - * - * This function returns the sum of all internal values. - * - * @code - * double sum = m.sum(); - * @endcode - */ - double sum(bool average = false) const; - - /** Sum of squared vector values. - * - * This function returns the sum of all internal values to the second - * power. - * - * @code - * double sum2 = m.sum2(); - * @endcode - */ - double sum2() const; - - /** Dot product <*this,op1>. - */ - double dotProduct(const Matrix1D &op1) const; - - /** Module of the vector - * - * This module is defined as the square root of the sum of the squared - * components. Euclidean norm of the vector. - * - * @code - * double mod = v.module(); - * @endcode - */ - inline double module() const - { - return sqrt(sum2()); - } - - /** Angle of the vector - * - * Supposing this vector is in R2 this function returns the angle of this - * vector with X axis, ie, atan2(YY(v), XX(v)) - */ - inline double angle() const - { - return atan2((double) YY(*this), (double) XX(*this)); - } - - /** Normalize this vector, store the result here - */ - void selfNormalize(); - - /** Reverse vector values, keep in this object. - */ - void selfReverse(); - - /** Show using gnuplot - * - * This function uses gnuplot to plot this vector. You must supply the - * xlabel and title. - */ - void showWithGnuPlot(const std::string& xlabel, const std::string& title); - - /** Compute numerical derivative - * - * The numerical derivative is of the same size as the input vector. - * However, the first two and the last two samples are set to 0, - * because the numerical method is not able to correctly estimate the - * derivative there. - */ - void numericalDerivative(Matrix1D &result) const; - - /** Read from an ASCII file. - * - * The array must be previously resized to the correct size. - */ - void read(const FileName& fn); - - /** Input from input stream. - * - * Actual size of the array is used to know how many values must be read. - * - * @code - * v.resize(3); - * std::cin >> v; - * @endcode - * - * This function is not ported to Python. - */ - // This function must be explicitly implemented outside - friend std::istream& operator>>(std::istream& in, Matrix1D& v) - { - for (int i = 0; i < VEC_XSIZE(v); i++) - in >> VEC_ELEM(v,i); - return in; - } - - /** Output to output stream.*/ - friend std::ostream& operator<<(std::ostream& ostrm, const Matrix1D& v) - { - if (v.vdim == 0) - ostrm << "NULL Array\n"; - else - ostrm << std::endl; - - double max_val = ABS(v.vdata[0]); - - for (size_t j = 0; j < v.vdim; j++) - { - max_val = XMIPP_MAX(max_val, v.vdata[j]); - } - - int prec = bestPrecision(max_val, 10); - - if (v.row) - for (size_t j = 0; j < v.vdim; j++) - { - ostrm << floatToString((double) v.vdata[j], 10, prec) - << std::endl; - } - else - for (size_t j = 0; j < v.vdim; j++) - { - ostrm << floatToString((double) v.vdata[j], 10, prec) << " "; - } - - return ostrm; - } - - /** Write to an ASCII file. - */ - void write(const FileName& fn) const; - - /** Edit with xmipp_editor. - * - * This function generates a random filename starting with PPP and - * edits it with xmipp_editor. After closing the editor the file is - * removed. - */ - void edit(); - //@} -}; - - - typedef Matrix1D DVector; - typedef Matrix1D IVector; - -/**@name Vector Related functions - * These functions are not methods of Matrix1D - */ -//@{ -/** Creates vector in R2. - * After this function the vector is (x,y) in R2. - * - * @code - * Matrix1D< double > v = vectorR2(1, 2); - * @endcode - */ -Matrix1D vectorR2(double x, double y); - -/** Creates vector in R3. - * After this function the vector is (x,y,z) in R3. - * - * @code - * Matrix1D< double > v = vectorR2(1, 2, 1); - * @endcode - */ -Matrix1D vectorR3(double x, double y, double z); - -/** Creates an integer vector in Z3. - */ -Matrix1D vectorR3(int x, int y, int z); - -/** Dot product. - * Given any two vectors in Rn (n-dimensional vector), this function returns the - * dot product of both. If the vectors are not of the same size or shape then an - * exception is thrown. The dot product is defined as the sum of the component - * by component multiplication. - * - * For the R3 vectors (V1x,V1y,V1z), (V2x, V2y, V2z) the result is V1x*V2x + - * V1y*V2y + V1z*V2z. - * - * @code - * Matrix1D< double > v1(1000); - * v1.init_random(0, 10, "gaussian"); - * std::cout << "The power of this vector should be 100 and is " << - * dotProduct(v1, v1) << std::endl; - * @endcode - */ -template -T dotProduct(const Matrix1D& v1, const Matrix1D& v2) -{ - if (!v1.sameShape(v2)) - REPORT_ERROR(ERR_MATRIX_SIZE, - "Dot product: vectors of different size or shape"); - - T accumulate = 0; - for (size_t j = 0; j < v1.vdim; j++) - accumulate += v1.vdata[j] * v2.vdata[j]; - return accumulate; -} - -/** Vector product in R3. - * This function takes two R3 vectors and compute their vectorial product. For - * two vectors (V1x,V1y,V1z), (V2x, V2y, V2z) the result is (V1y*V2z-V1z*v2y, - * V1z*V2x-V1x*V2z, V1x*V2y-V1y*V2x). Pay attention that this operator is not - * conmutative. An exception is thrown if the vectors are not of the same shape - * or they don't belong to R3. - * - * @code - * Matrix1D< T > X = vectorR3(1, 0, 0), Y = vector_R3(0, 1, 0); - * std::cout << "X*Y=Z=" << vectorProduct(X,Y).transpose() << std::endl; - * @endcode - */ -template -Matrix1D vectorProduct(const Matrix1D& v1, const Matrix1D& v2) -{ - if (v1.vdim != 3 || v2.vdim != 3) - REPORT_ERROR(ERR_MATRIX_SIZE, "Vector_product: vectors are not in R3"); - - if (v1.isRow() != v2.isRow()) - REPORT_ERROR(ERR_MATRIX_SIZE, - "Vector_product: vectors are of different shape"); - - Matrix1D result(3); - vectorProduct(v1, v2, result); - return result; -} - -/** Vector product in R3. - * This function computes the vector product of two R3 vectors. - * No check is performed, it is assumed that the output vector - * is already resized - * - */ -template -void vectorProduct(const Matrix1D& v1, const Matrix1D& v2, - Matrix1D &result) -{ - XX(result) = YY(v1) * ZZ(v2) - ZZ(v1) * YY(v2); - YY(result) = ZZ(v1) * XX(v2) - XX(v1) * ZZ(v2); - ZZ(result) = XX(v1) * YY(v2) - YY(v1) * XX(v2); -} - -/** Sort two vectors. - * v1 and v2 must be of the same shape, if not an exception is thrown. After - * calling this function all components in v1 are the minimum between the - * corresponding components in v1 and v2, and all components in v2 are the - * maximum. - * - * For instance, XX(v1)=MIN(XX(v1), XX(v2)), XX(v2)=MAX(XX(v1), XX(v2)). Notice - * that both vectors are modified. This function is very useful for sorting two - * corners. After calling it you can certainly perform a non-empty for (from - * corner1 to corner2) loop. - */ -template -void sortTwoVectors(Matrix1D& v1, Matrix1D& v2) -{ - T temp; - if (!v1.sameShape(v2)) - REPORT_ERROR(ERR_MATRIX_SIZE, - "sortTwoVectors: vectors are not of the same shape"); - - for (size_t j = 0; j < v1.vdim; j++) - { - temp = XMIPP_MIN(v1.vdata[j], v2.vdata[j]); - v2.vdata[j] = XMIPP_MAX(v1.vdata[j], v2.vdata[j]); - v1.vdata[j] = temp; - } -} - -/** Conversion from one type to another. - * If we have an integer array and we need a double one, we can use this - * function. The conversion is done through a type casting of each element - * If n >= 0, only the nth volumes will be converted, otherwise all NSIZE volumes - */ -template -void typeCast(const Matrix1D& v1, Matrix1D& v2) -{ - if (v1.vdim == 0) - { - v2.clear(); - return; - } - - v2.resizeNoCopy(v1.vdim); - for (size_t j = 0; j < v1.vdim; j++) - v2.vdata[j] = static_cast(v1.vdata[j]); -} - -/** Conversion from one type to another. - * In some cases, the two types are the same. So a faster way is simply by assignment. - */ -template -void typeCast(const Matrix1D& v1, Matrix1D& v2) -{ - v2 = v1; -} - -//@} -//@} -#endif /* MATRIX1D_H_ */ diff --git a/src/core/matrix2d.cpp b/src/core/matrix2d.cpp deleted file mode 100644 index 3561449..0000000 --- a/src/core/matrix2d.cpp +++ /dev/null @@ -1,1348 +0,0 @@ -/*************************************************************************** - * - * Authors: Sjors H.W. Scheres (scheres@cnb.csic.es) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include -#include -#include "alglib/linalg.h" -#include "numerical_recipes.h" -#include "matrix2d.h" -#include "bilib/linearalgebra.h" -#include "xmipp_filename.h" -#include "matrix1d.h" -#include "xmipp_funcs.h" -#include - -template -T Matrix2D::det() const -{ - // (see Numerical Recipes, Chapter 2 Section 5) - if (mdimx == 0 || mdimy == 0) - REPORT_ERROR(ERR_MATRIX_EMPTY, "determinant: Matrix is empty"); - - if (mdimx != mdimy) - REPORT_ERROR(ERR_MATRIX_SIZE, "determinant: Matrix is not squared"); - - for (size_t i = 0; i < mdimy; i++) - { - bool all_zeros = true; - for (size_t j = 0; j < mdimx; j++) - if (fabs(MAT_ELEM((*this),i, j)) > XMIPP_EQUAL_ACCURACY) - { - all_zeros = false; - break; - } - - if (all_zeros) - return 0; - } - - // Perform decomposition - Matrix1D< int > indx; - T d; - Matrix2D LU; - ludcmp(*this, LU, indx, d); - - // Calculate determinant - for (size_t i = 0; i < mdimx; i++) - d *= (T) MAT_ELEM(LU,i , i); - - return d; -} - -template -void Matrix2D::coreInit(const FileName &fn, int Ydim, int Xdim, size_t offset) -{ -#ifdef XMIPP_MMAP - - mdimx=Xdim; - mdimy=Ydim; - mdim=mdimx*mdimy; - destroyData=false; - mappedData=true; - fdMap = open(fn.c_str(), O_RDWR, S_IREAD | S_IWRITE); - if (fdMap == -1) - REPORT_ERROR(ERR_IO_NOTOPEN,fn); - const size_t pagesize=sysconf(_SC_PAGESIZE); - size_t offsetPages=(offset/pagesize)*pagesize; - size_t offsetDiff=offset-offsetPages; - if ( (mdataOriginal = (char*) mmap(0,Ydim*Xdim*sizeof(T)+offsetDiff, PROT_READ | PROT_WRITE, MAP_SHARED, fdMap, offsetPages)) == MAP_FAILED ) - REPORT_ERROR(ERR_MMAP_NOTADDR,(String)"mmap failed "+integerToString(errno)); - mdata=(T*)(mdataOriginal+offsetDiff); -#else - - REPORT_ERROR(ERR_MMAP,"Mapping not supported in Windows"); -#endif - -} - -template -void Matrix2D::read(const FileName &fn) -{ - std::ifstream fhIn; - fhIn.open(fn.c_str()); - if (!fhIn) - REPORT_ERROR(ERR_IO_NOTEXIST,fn); - FOR_ALL_ELEMENTS_IN_MATRIX2D(*this) - fhIn >> MAT_ELEM(*this,i,j); - fhIn.close(); -} - -template -void Matrix2D::write(const FileName &fn) const -{ - std::ofstream fhOut; - fhOut.open(fn.c_str()); - if (!fhOut) - REPORT_ERROR(ERR_IO_NOTOPEN,(std::string)"write: Cannot open "+fn+" for output"); - fhOut << *this; - fhOut.close(); -} - -#define VIA_BILIB -template -void svdcmp(const Matrix2D< T >& a, - Matrix2D< double >& u, - Matrix1D< double >& w, - Matrix2D< double >& v) -{ - // svdcmp only works with double - typeCast(a, u); - - // Set size of matrices - w.initZeros(u.mdimx); - v.initZeros(u.mdimx, u.mdimx); - - // Call to the numerical recipes routine -#ifdef VIA_NR - - svdcmp(u.mdata, - u.mdimy, u.mdimx, - w.vdata, - v.mdata); -#endif - -#ifdef VIA_BILIB - - int status; - SingularValueDecomposition(u.mdata, - u.mdimy, u.mdimx, - w.vdata, - v.mdata, - 5000, &status); -#endif -} -#undef VIA_NR -#undef VIA_BILIB - -/* Cholesky decomposition -------------------------------------------------- */ -void cholesky(const Matrix2D &M, Matrix2D &L) -{ - L=M; - Matrix1D p; - p.initZeros(MAT_XSIZE(M)); - choldc(L.adaptForNumericalRecipes2(), MAT_XSIZE(M), p.adaptForNumericalRecipes()); - FOR_ALL_ELEMENTS_IN_MATRIX2D(L) - if (i==j) - MAT_ELEM(L,i,j)=VEC_ELEM(p,i); - else if (i &u, Matrix1D &w, Matrix2D &v, - Matrix1D &b, Matrix1D &x) -{ - // Call to the numerical recipes routine. Results will be stored in X - svbksb(u.adaptForNumericalRecipes2(), - w.adaptForNumericalRecipes(), - v.adaptForNumericalRecipes2(), - u.mdimy, u.mdimx, - b.adaptForNumericalRecipes(), - x.adaptForNumericalRecipes()); -} - - - -void normalizeColumns(Matrix2D &A) -{ - if (MAT_YSIZE(A)<=1) - return; - - // Compute the mean and standard deviation of each column - Matrix1D avg, stddev; - avg.initZeros(MAT_XSIZE(A)); - stddev.initZeros(MAT_XSIZE(A)); - - FOR_ALL_ELEMENTS_IN_MATRIX2D(A) - { - double x=MAT_ELEM(A,i,j); - VEC_ELEM(avg,j)+=x; - VEC_ELEM(stddev,j)+=x*x; - } - - double iN=1.0/MAT_YSIZE(A); - FOR_ALL_ELEMENTS_IN_MATRIX1D(avg) - { - VEC_ELEM(avg,i)*=iN; - VEC_ELEM(stddev,i)=sqrt(fabs(VEC_ELEM(stddev,i)*iN - VEC_ELEM(avg,i)*VEC_ELEM(avg,i))); - if (VEC_ELEM(stddev,i)>XMIPP_EQUAL_ACCURACY) - VEC_ELEM(stddev,i)=1.0/VEC_ELEM(stddev,i); - else - VEC_ELEM(stddev,i)=0.0; - } - - // Now normalize - FOR_ALL_ELEMENTS_IN_MATRIX2D(A) - MAT_ELEM(A,i,j)=(MAT_ELEM(A,i,j)-VEC_ELEM(avg,j))*VEC_ELEM(stddev,j); -} - -void normalizeColumnsBetween0and1(Matrix2D &A) -{ - double maxValue,minValue; - A.computeMaxAndMin(maxValue,minValue); - double iMaxValue=1.0/(maxValue-minValue); - FOR_ALL_ELEMENTS_IN_MATRIX2D(A) - MAT_ELEM(A,i,j)=(MAT_ELEM(A,i,j)-minValue)*iMaxValue; -} - -void subtractColumnMeans(Matrix2D &A) -{ - if (MAT_YSIZE(A)<1) - return; - - // Compute the mean and standard deviation of each column - Matrix1D avg; - avg.initZeros(MAT_XSIZE(A)); - - FOR_ALL_ELEMENTS_IN_MATRIX2D(A) - VEC_ELEM(avg,j)+=MAT_ELEM(A,i,j); - - double iN=1.0/MAT_YSIZE(A); - FOR_ALL_ELEMENTS_IN_MATRIX1D(avg) - VEC_ELEM(avg,i)*=iN; - - // Now normalize - FOR_ALL_ELEMENTS_IN_MATRIX2D(A) - MAT_ELEM(A,i,j)=MAT_ELEM(A,i,j)-VEC_ELEM(avg,j); -} - -void schur(const Matrix2D &M, Matrix2D &O, Matrix2D &T) -{ - alglib::real_2d_array a, s; - a.setcontent(MAT_YSIZE(M),MAT_XSIZE(M),MATRIX2D_ARRAY(M)); - bool ok=rmatrixschur(a, MAT_YSIZE(M), s); - if (!ok) - REPORT_ERROR(ERR_NUMERICAL,"Could not perform Schur decomposition"); - O.resizeNoCopy(M); - T.resizeNoCopy(M); - FOR_ALL_ELEMENTS_IN_MATRIX2D(M) - { - MAT_ELEM(O,i,j)=s(i,j); - MAT_ELEM(T,i,j)=a(i,j); - } -} - -void generalizedEigs(const Matrix2D &A, const Matrix2D &B, Matrix1D &D, Matrix2D &P) -{ - int N=(int)MAT_YSIZE(A); - alglib::real_2d_array a, b, z; - a.setcontent(N,N,MATRIX2D_ARRAY(A)); - b.setcontent(N,N,MATRIX2D_ARRAY(B)); - alglib::real_1d_array d; - bool ok=smatrixgevd(a, N, true, b, true, true, 1, d, z); - if (!ok) - REPORT_ERROR(ERR_NUMERICAL,"Could not perform eigenvector decomposition"); - D.resizeNoCopy(N); - memcpy(&VEC_ELEM(D,0),d.getcontent(),N*sizeof(double)); - P.resizeNoCopy(A); - FOR_ALL_ELEMENTS_IN_MATRIX2D(P) - MAT_ELEM(P,i,j)=z(i,j); -} - -void firstEigs(const Matrix2D &A, size_t M, Matrix1D &D, Matrix2D &P, bool Pneeded) -{ - int N=(int)MAT_YSIZE(A); - alglib::real_2d_array a, z; - a.setcontent(N,N,MATRIX2D_ARRAY(A)); - alglib::real_1d_array d; - bool ok=smatrixevdi(a, N, Pneeded, false, N-M, N-1, d, z); - if (!ok) - REPORT_ERROR(ERR_NUMERICAL,"Could not perform eigenvector decomposition"); - - D.resizeNoCopy(M); - FOR_ALL_ELEMENTS_IN_MATRIX1D(D) - VEC_ELEM(D,i)=d(M-1-i); - if (Pneeded) - { - P.resizeNoCopy(N,M); - FOR_ALL_ELEMENTS_IN_MATRIX2D(P) - MAT_ELEM(P,i,j)=z(i,M-1-j); - } -} - -void lastEigs(const Matrix2D &A, size_t M, Matrix1D &D, Matrix2D &P) -{ - int N=(int)MAT_YSIZE(A); - alglib::real_2d_array a, z; - a.setcontent(N,N,MATRIX2D_ARRAY(A)); - alglib::real_1d_array d; - bool ok=smatrixevdi(a, N, true, false, 0, M-1, d, z); - if (!ok) - REPORT_ERROR(ERR_NUMERICAL,"Could not perform eigenvector decomposition"); - - D.resizeNoCopy(M); - FOR_ALL_ELEMENTS_IN_MATRIX1D(D) - VEC_ELEM(D,i)=d(M-1-i); - memcpy(&VEC_ELEM(D,0),d.getcontent(),M*sizeof(double)); - P.resizeNoCopy(N,M); - FOR_ALL_ELEMENTS_IN_MATRIX2D(P) - MAT_ELEM(P,i,j)=z(i,j); -} - -void eigsBetween(const Matrix2D &A, size_t I1, size_t I2, Matrix1D &D, Matrix2D &P) -{ - size_t M = I2 - I1 + 1; - int N=(int)MAT_YSIZE(A); - alglib::real_2d_array a, z; - a.setcontent(N,N,MATRIX2D_ARRAY(A)); - alglib::real_1d_array d; - - bool ok=smatrixevdi(a, N, true, false, I1, I2, d, z); - if (!ok) - REPORT_ERROR(ERR_NUMERICAL,"Could not perform eigenvector decomposition"); - - D.resizeNoCopy(M); - FOR_ALL_ELEMENTS_IN_MATRIX1D(D) - VEC_ELEM(D,i)=d(M-1-i); - memcpy(&VEC_ELEM(D,0),d.getcontent(),M*sizeof(double)); - P.resizeNoCopy(N,M); - FOR_ALL_ELEMENTS_IN_MATRIX2D(P) - MAT_ELEM(P,i,j)=z(i,j); -} - -void allEigs(const Matrix2D &A, std::vector< std::complex > &eigs) -{ - int N=(int)MAT_YSIZE(A); - alglib::real_2d_array a, vl, vr; - a.setcontent(N,N,MATRIX2D_ARRAY(A)); - alglib::real_1d_array wr, wi; - - bool ok=rmatrixevd(a, N, 0, wr, wi, vl, vr); - if (!ok) - REPORT_ERROR(ERR_NUMERICAL,"Could not perform eigenvector decomposition"); - eigs.clear(); - for (int n=0; n(wr(n),wi(n))); -} - -void connectedComponentsOfUndirectedGraph(const Matrix2D &G, Matrix1D &component) -{ - size_t N=MAT_XSIZE(G); - component.resizeNoCopy(N); - component.initConstant(-1); - - int nextComponent=0; - bool workDone=false; - std::queue toExplore; - do - { - workDone=false; - // Find next unvisited element - bool found=false; - size_t seed=0; - FOR_ALL_ELEMENTS_IN_MATRIX1D(component) - if (VEC_ELEM(component,i)<0) - { - seed=i; - found=true; - break; - } - - // If found, get its connected component - if (found) - { - int currentComponent=nextComponent; - nextComponent++; - - VEC_ELEM(component,seed)=currentComponent; - toExplore.push(seed); - while (toExplore.size()>0) - { - seed=toExplore.front(); - toExplore.pop(); - for (size_t j=seed+1; j0) - { - if (VEC_ELEM(component,j)<0) - { - VEC_ELEM(component,j)=currentComponent; - toExplore.push(j); - } - - } - } - workDone=true; - } - } while (workDone); -} - -void matrixOperation_AB(const Matrix2D &A, const Matrix2D &B, Matrix2D &C) -{ - C.initZeros(MAT_YSIZE(A), MAT_XSIZE(B)); - for (size_t i = 0; i < MAT_YSIZE(A); ++i) - for (size_t j = 0; j < MAT_XSIZE(B); ++j) - { - double aux=0.; - for (size_t k = 0; k < MAT_XSIZE(A); ++k) - aux += MAT_ELEM(A, i, k) * MAT_ELEM(B, k, j); - MAT_ELEM(C, i, j)=aux; - } -} - -void matrixOperation_Ax(const Matrix2D &A, const Matrix1D &x, Matrix1D &y) -{ - y.initZeros(MAT_YSIZE(A)); - for (size_t i = 0; i < MAT_YSIZE(A); ++i) - { - double aux=0.; - for (size_t k = 0; k < MAT_XSIZE(A); ++k) - aux += MAT_ELEM(A, i, k) * VEC_ELEM(x, k); - VEC_ELEM(y, i)=aux; - } -} - -void matrixOperation_AtA(const Matrix2D &A, Matrix2D &B) -{ - B.resizeNoCopy(MAT_XSIZE(A), MAT_XSIZE(A)); - for (size_t i = 0; i < MAT_XSIZE(A); ++i) - for (size_t j = i; j < MAT_XSIZE(A); ++j) - { - double aux=0.; - for (size_t k = 0; k < MAT_YSIZE(A); ++k) - aux += MAT_ELEM(A, k, i) * MAT_ELEM(A, k, j); - MAT_ELEM(B, j, i) = MAT_ELEM(B, i, j) = aux; - } -} - -void matrixOperation_AAt(const Matrix2D &A, Matrix2D &C) -{ - C.initZeros(MAT_YSIZE(A), MAT_YSIZE(A)); - for (size_t i = 0; i < MAT_YSIZE(A); ++i) - for (size_t j = i; j < MAT_YSIZE(A); ++j) - { - double aux=0.; - for (size_t k = 0; k < MAT_XSIZE(A); ++k) - aux += MAT_ELEM(A, i, k) * MAT_ELEM(A, j, k); - MAT_ELEM(C, j, i)=MAT_ELEM(C, i, j)=aux; - } -} - -void matrixOperation_ABt(const Matrix2D &A, const Matrix2D &B, Matrix2D &C) -{ - C.initZeros(MAT_YSIZE(A), MAT_YSIZE(B)); - for (size_t i = 0; i < MAT_YSIZE(A); ++i) - for (size_t j = 0; j < MAT_YSIZE(B); ++j) - { - double aux=0.; - for (size_t k = 0; k < MAT_XSIZE(A); ++k) - aux += MAT_ELEM(A, i, k) * MAT_ELEM(B, j, k); - MAT_ELEM(C, i, j)=aux; - } -} - -void matrixOperation_AtB(const Matrix2D &A, const Matrix2D &B, Matrix2D &C) -{ - C.resizeNoCopy(MAT_XSIZE(A), MAT_XSIZE(B)); - for (size_t i = 0; i < MAT_XSIZE(A); ++i) - for (size_t j = 0; j < MAT_XSIZE(B); ++j) - { - double aux=0.; - for (size_t k = 0; k < MAT_YSIZE(A); ++k) - aux += MAT_ELEM(A, k, i) * MAT_ELEM(B, k, j); - MAT_ELEM(C, i, j)=aux; - } -} - -void matrixOperation_Atx(const Matrix2D &A, const Matrix1D &x, Matrix1D &y) -{ - y.resizeNoCopy(MAT_XSIZE(A)); - for (size_t i = 0; i < MAT_XSIZE(A); ++i) - { - double aux=0.; - for (size_t k = 0; k < MAT_YSIZE(A); ++k) - aux += MAT_ELEM(A, k, i) * VEC_ELEM(x, k); - VEC_ELEM(y, i)=aux; - } -} - -void matrixOperation_AtBt(const Matrix2D &A, const Matrix2D &B, Matrix2D &C) -{ - C.initZeros(MAT_XSIZE(A), MAT_YSIZE(B)); - for (size_t i = 0; i < MAT_XSIZE(A); ++i) - for (size_t j = 0; j < MAT_YSIZE(B); ++j) - { - double aux=0.; - for (size_t k = 0; k < MAT_YSIZE(A); ++k) - aux += MAT_ELEM(A, k, i) * MAT_ELEM(B, j, k); - MAT_ELEM(C, i, j)=aux; - } -} - -void matrixOperation_XtAX_symmetric(const Matrix2D &X, const Matrix2D &A, Matrix2D &B) -{ - Matrix2D AX=A*X; - B.resizeNoCopy(MAT_XSIZE(X), MAT_XSIZE(X)); - for (size_t i = 0; i < MAT_XSIZE(X); ++i) - for (size_t j = i; j < MAT_XSIZE(X); ++j) - { - double aux=0.; - for (size_t k = 0; k < MAT_YSIZE(X); ++k) - aux += MAT_ELEM(X, k, i) * MAT_ELEM(AX, k, j); - MAT_ELEM(B, j, i) = MAT_ELEM(B, i, j) = aux; - } -} - -void matrixOperation_IplusA(Matrix2D &A) -{ - for (size_t i=0; i &A) -{ - FOR_ALL_ELEMENTS_IN_MATRIX2D(A) - if (i == j) - MAT_ELEM(A, i, j) = 1 - MAT_ELEM(A, i, j); - else - MAT_ELEM(A, i, j) = -MAT_ELEM(A, i, j); -} - -void eraseFirstColumn(Matrix2D &A) -{ - Matrix2D Ap; - Ap.resize(MAT_YSIZE(A),MAT_XSIZE(A)-1); - for (size_t i = 0; i < MAT_YSIZE(A); ++i) - memcpy(&MAT_ELEM(Ap,i,0),&MAT_ELEM(A,i,1),MAT_XSIZE(Ap)*sizeof(double)); - A=Ap; -} - -void keepColumns(Matrix2D &A, int j0, int jF) -{ - Matrix2D Ap; - Ap.resize(MAT_YSIZE(A),jF-j0+1); - for (size_t i = 0; i < MAT_YSIZE(A); ++i) - memcpy(&MAT_ELEM(Ap,i,0),&MAT_ELEM(A,i,j0),MAT_XSIZE(Ap)*sizeof(double)); - A=Ap; -} - -void orthogonalizeColumnsGramSchmidt(Matrix2D &M) -{ - for(size_t j1=0; j1 -void ludcmp(const Matrix2D& A, Matrix2D& LU, Matrix1D< int >& indx, T& d) -{ - LU = A; - if (VEC_XSIZE(indx)!=A.mdimx) - indx.resizeNoCopy(A.mdimx); - ludcmp(LU.adaptForNumericalRecipes2(), A.mdimx, - indx.adaptForNumericalRecipes(), &d); -} - -template -void lubksb(const Matrix2D& LU, Matrix1D< int >& indx, Matrix1D& b) -{ - lubksb(LU.adaptForNumericalRecipes2(), indx.size(), - indx.adaptForNumericalRecipes(), - b.adaptForNumericalRecipes()); -} - -template -void Matrix2D::computeRowMeans(Matrix1D &Xmr) const -{ - Xmr.initZeros(MAT_YSIZE(*this)); - FOR_ALL_ELEMENTS_IN_MATRIX2D(*this) - VEC_ELEM(Xmr,i)+=MAT_ELEM(*this,i,j); - Xmr*=1.0/MAT_XSIZE(*this); -} - -template -void Matrix2D::computeColMeans(Matrix1D &Xmr) const -{ - Xmr.initZeros(MAT_YSIZE(*this)); - FOR_ALL_ELEMENTS_IN_MATRIX2D(*this) - VEC_ELEM(Xmr,j)+=MAT_ELEM(*this,i,j); - Xmr*=1.0/MAT_YSIZE(*this); - } - -template<> -void Matrix2D::invAlgLib(Matrix2D& result, bool use_lu) const -{ - if (mdimx < 5) { - return this->inv(result); - } - - // copy data to alglib matrix - const auto N = this->mdimx; - alglib::real_2d_array a; - a.setlength(N, N); - for(size_t i = 0; i < N; ++i) { - auto dest = a.c_ptr()->ptr.pp_double[i]; - auto src = this->mdata + (i * N); - memcpy(dest, src, N * sizeof(double)); - } - - // compute inverse - alglib::ae_int_t info; - alglib::matinvreport rep; - if(use_lu) { - alglib::integer_1d_array pivots; - alglib::rmatrixlu(a, N, N, pivots); - alglib::rmatrixluinverse(a, pivots, info, rep); - } else { - alglib::rmatrixinverse(a, info, rep); // inplace inverse - } - if (1 != (int)info) { - REPORT_ERROR(ERR_NUMERICAL,"Could not perform matrix inversion using alglib"); - } - - // get result from alglib matrix - result.resizeNoCopy(*this); - for(size_t i = 0; i < N; ++i) { - auto src = a.c_ptr()->ptr.pp_double[i]; - auto dest = result.mdata + (i * N); - memcpy(dest, src, N * sizeof(double)); - } -} - - -template -void Matrix2D::inv(Matrix2D& result) const -{ - if (mdimx == 0 || mdimy == 0) - REPORT_ERROR(ERR_MATRIX_EMPTY, "Inverse: Matrix is empty"); - result.initZeros(mdimx, mdimy); - SPEED_UP_temps0; - if (mdimx==2) - { - M2x2_INV(result,*this); - } - else if (mdimx==3) - { - M3x3_INV(result,*this); - } - else if (mdimx==4) - { - M4x4_INV(result,*this); - } - else - { - // Perform SVD decomposition - Matrix2D< double > u, v; - Matrix1D< double > w; - svdcmp(*this, u, w, v); // *this = U * W * V^t - - double tol = computeMax() * XMIPP_MAX(mdimx, mdimy) * 1e-14; - - // Compute W^-1 - bool invertible = false; - FOR_ALL_ELEMENTS_IN_MATRIX1D(w) - { - if (fabs(VEC_ELEM(w,i)) > tol) - { - VEC_ELEM(w,i) = 1.0 / VEC_ELEM(w,i); - invertible = true; - } - else - VEC_ELEM(w,i) = 0.0; - } - - if (!invertible) - return; - - // Compute V*W^-1 - FOR_ALL_ELEMENTS_IN_MATRIX2D(v) - MAT_ELEM(v,i,j) *= VEC_ELEM(w,j); - - // Compute Inverse - for (size_t i = 0; i < mdimx; i++) - for (size_t j = 0; j < mdimy; j++) - for (size_t k = 0; k < mdimx; k++) - MAT_ELEM(result,i,j) += MAT_ELEM(v,i,k) * MAT_ELEM(u,j,k); - } -} - -template -void Matrix2D::eigs(Matrix2D &U, Matrix1D &W, Matrix2D &V, Matrix1D &indexes) const -{ - svdcmp(*this, U, W, V); - indexes.resizeNoCopy(W); - indexes.enumerate(); - - double dAux; - int iAux; - - FOR_ALL_ELEMENTS_IN_MATRIX1D(W) - { - for (int j = i; j > 0 && dMi(W, j) > dMi(W, j-1); --j) - { - VEC_SWAP(W, j, j-1, dAux); - VEC_SWAP(indexes, j, j-1, iAux); - } - } -} - -template -Matrix1D Matrix1D::operator*(const Matrix2D& M) -{ - Matrix1D result; - - if (VEC_XSIZE(*this) != MAT_YSIZE(M)) - REPORT_ERROR(ERR_MATRIX_SIZE, "Not compatible sizes in matrix by vector"); - - if (!isRow()) - REPORT_ERROR(ERR_MATRIX_DIM, "Vector is not a row"); - - result.initZeros(MAT_XSIZE(M)); - for (size_t j = 0; j < MAT_XSIZE(M); j++) - for (size_t i = 0; i < MAT_YSIZE(M); i++) - VEC_ELEM(result,j) += VEC_ELEM(*this,i) * MAT_ELEM(M,i, j); - - result.setRow(); - return result; -} - -template -Matrix1D Matrix2D::operator*(const Matrix1D& op1) const -{ - Matrix1D result; - - if (mdimx != VEC_XSIZE(op1)) - REPORT_ERROR(ERR_MATRIX_SIZE, "Not compatible sizes in matrix by vector"); - - if (!op1.isCol()) - REPORT_ERROR(ERR_MATRIX, "Vector is not a column"); - - result.initZeros(mdimy); - for (size_t i = 0; i < mdimy; i++) - for (size_t j = 0; j < mdimx; j++) - VEC_ELEM(result,i) += MAT_ELEM(*this,i, j) * VEC_ELEM(op1,j); - - result.setCol(); - return result; -} - -template -void Matrix2D::rowSum(Matrix1D &sum) const -{ - sum.initZeros(MAT_YSIZE(*this)); - FOR_ALL_ELEMENTS_IN_MATRIX2D(*this) - VEC_ELEM(sum,i)+=MAT_ELEM(*this,i,j); -} - -template -void Matrix2D::colSum(Matrix1D &sum) const -{ - sum.initZeros(MAT_XSIZE(*this)); - FOR_ALL_ELEMENTS_IN_MATRIX2D(*this) - VEC_ELEM(sum,j)+=MAT_ELEM(*this,i,j); -} - -template -void Matrix2D::rowEnergySum(Matrix1D &sum) const -{ - sum.initZeros(MAT_YSIZE(*this)); - FOR_ALL_ELEMENTS_IN_MATRIX2D(*this) - VEC_ELEM(sum,i)+=MAT_ELEM(*this,i,j)*MAT_ELEM(*this,i,j); -} - -template -void Matrix2D::fromVector(const Matrix1D& op1) -{ - // Null vector => Null matrix - if (op1.size() == 0) - { - clear(); - return; - } - - // Look at shape and copy values - if (op1.isRow()) - { - if (mdimy!=1 || mdimx!=VEC_XSIZE(op1)) - resizeNoCopy(1, VEC_XSIZE(op1)); - - for (size_t j = 0; j < VEC_XSIZE(op1); j++) - MAT_ELEM(*this,0, j) = VEC_ELEM(op1,j); - } - else - { - if (mdimy!=1 || mdimx!=VEC_XSIZE(op1)) - resizeNoCopy(VEC_XSIZE(op1), 1); - - for (size_t i = 0; i < VEC_XSIZE(op1); i++) - MAT_ELEM(*this, i, 0) = VEC_ELEM(op1,i); - } -} - -template -void Matrix2D::toVector(Matrix1D& op1) const -{ - // Null matrix => Null vector - if (mdimx == 0 || mdimy == 0) - { - op1.clear(); - return; - } - - // If matrix is not a vector, produce an error - if (!(mdimx == 1 || mdimy == 1)) - REPORT_ERROR(ERR_MATRIX_DIM, - "toVector: Matrix cannot be converted to vector"); - - // Look at shape and copy values - if (mdimy == 1) - { - // Row vector - if (VEC_XSIZE(op1)!=mdimx) - op1.resizeNoCopy(mdimx); - - memcpy(&VEC_ELEM(op1,0),&MAT_ELEM(*this,0,0),mdimx*sizeof(double)); - - op1.setRow(); - } - else - { - // Column vector - if (VEC_XSIZE(op1)!=mdimy) - op1.resizeNoCopy(mdimy); - - for (size_t i = 0; i < mdimy; i++) - VEC_ELEM(op1,i) = MAT_ELEM(*this,i, 0); - - op1.setCol(); - } -} - -template -void Matrix2D::getRow(size_t i, Matrix1D& v) const -{ - if (mdimx == 0 || mdimy == 0) - { - v.clear(); - return; - } - - if (i >= mdimy) - REPORT_ERROR(ERR_INDEX_OUTOFBOUNDS, "getRow: Matrix subscript (i) greater than matrix dimension"); - - if (VEC_XSIZE(v)!=mdimx) - v.resizeNoCopy(mdimx); - memcpy(&VEC_ELEM(v,0),&MAT_ELEM(*this,i,0),mdimx*sizeof(T)); - - v.setRow(); -} - -template -void Matrix2D::getCol(size_t j, Matrix1D& v) const -{ - if (mdimx == 0 || mdimy == 0) - { - v.clear(); - return; - } - - if (j >= mdimx) - REPORT_ERROR(ERR_INDEX_OUTOFBOUNDS,"getCol: Matrix subscript (j) greater than matrix dimension"); - - if (VEC_XSIZE(v)!=mdimy) - v.resizeNoCopy(mdimy); - for (size_t i = 0; i < mdimy; i++) - VEC_ELEM(v,i) = MAT_ELEM(*this,i, j); - - v.setCol(); -} - -template -void Matrix2D::setRow(size_t i, const Matrix1D& v) -{ - if (mdimx == 0 || mdimy == 0) - REPORT_ERROR(ERR_MATRIX_EMPTY, "setRow: Target matrix is empty"); - - if (i >= mdimy) - REPORT_ERROR(ERR_INDEX_OUTOFBOUNDS, "setRow: Matrix subscript (i) out of range"); - - if (VEC_XSIZE(v) != mdimx) - REPORT_ERROR(ERR_MATRIX_SIZE, - "setRow: Vector dimension different from matrix one"); - - if (!v.isRow()) - REPORT_ERROR(ERR_MATRIX_DIM, "setRow: Not a row vector in assignment"); - - memcpy(&MAT_ELEM(*this,i,0),&VEC_ELEM(v,0),mdimx*sizeof(double)); -} - -template -void Matrix2D::setCol(size_t j, const Matrix1D& v) -{ - if (mdimx == 0 || mdimy == 0) - REPORT_ERROR(ERR_MATRIX_EMPTY, "setCol: Target matrix is empty"); - - if (j>= mdimx) - REPORT_ERROR(ERR_INDEX_OUTOFBOUNDS, "setCol: Matrix subscript (j) out of range"); - - if (VEC_XSIZE(v) != mdimy) - REPORT_ERROR(ERR_MATRIX_SIZE, - "setCol: Vector dimension different from matrix one"); - - if (!v.isCol()) - REPORT_ERROR(ERR_MATRIX_DIM, "setCol: Not a column vector in assignment"); - - for (size_t i = 0; i < mdimy; i++) - MAT_ELEM(*this,i, j) = VEC_ELEM(v,i); -} - -template -void Matrix2D::getDiagonal(Matrix1D &d) const -{ - d.resizeNoCopy(MAT_XSIZE(*this)); - for (size_t i=0; i -Matrix2D& Matrix2D::operator=(const Matrix2D& op1) -{ - if (&op1 != this) - { - if (MAT_XSIZE(*this)!=MAT_XSIZE(op1) || - MAT_YSIZE(*this)!=MAT_YSIZE(op1)) - resizeNoCopy(op1); - memcpy(mdata,op1.mdata,op1.mdim*sizeof(T)); - } - - return *this; -} - -template -void Matrix2D::coreInit() -{ - mdimx=mdimy=mdim=0; - mdata=NULL; - mdataOriginal=NULL; - destroyData=true; - mappedData=false; - fdMap=-1; -} - -template -void Matrix2D::coreAllocate( int _mdimy, int _mdimx) -{ - if (_mdimy <= 0 ||_mdimx<=0) - { - clear(); - return; - } - - mdimx=_mdimx; - mdimy=_mdimy; - mdim=_mdimx*_mdimy; - mdata = new T [mdim]; - mdataOriginal = NULL; - mappedData=false; - fdMap=-1; - if (mdata == NULL) - REPORT_ERROR(ERR_MEM_NOTENOUGH, "coreAllocate: No space left"); -} - -template -void Matrix2D::coreDeallocate() -{ - if (mdata != NULL && destroyData) - delete[] mdata; - if (mappedData) - { -#ifdef XMIPP_MMAP - munmap(mdataOriginal,mdimx*mdimy*sizeof(T)); - close(fdMap); -#else - - REPORT_ERROR(ERR_MMAP,"Mapping not supported in Windows"); -#endif - - } - mdata=NULL; - mdataOriginal=NULL; -} - -template -void Matrix2D::resize(size_t Ydim, size_t Xdim, bool noCopy) -{ - - if (Xdim == mdimx && Ydim == mdimy) - return; - - if (Xdim <= 0 || Ydim <= 0) - { - clear(); - return; - } - - T * new_mdata; - size_t YXdim=Ydim*Xdim; - - try - { - new_mdata = new T [YXdim]; - } - catch (std::bad_alloc &) - { - REPORT_ERROR(ERR_MEM_NOTENOUGH, "Allocate: No space left"); - } - - // Copy needed elements, fill with 0 if necessary - if (!noCopy) - { - T zero=0; // Useful for complexes - for (size_t i = 0; i < Ydim; i++) - for (size_t j = 0; j < Xdim; j++) - { - T *val=NULL; - if (i >= mdimy) - val = &zero; - else if (j >= mdimx) - val = &zero; - else - val = &mdata[i*mdimx + j]; - new_mdata[i*Xdim+j] = *val; - } - } - else - memset(new_mdata,0,YXdim*sizeof(T)); - - // deallocate old vector - coreDeallocate(); - - // assign *this vector to the newly created - mdata = new_mdata; - mdimx = Xdim; - mdimy = Ydim; - mdim = Xdim * Ydim; - mappedData = false; -} - - -template -void Matrix2D::mapToFile(const FileName &fn, int Ydim, int Xdim, size_t offset) -{ - if (mdata!=NULL) - clear(); - -#ifdef XMIPP_MMAP - - coreInit(fn,Ydim,Xdim,offset); -#else - - resizeNoCopy(Ydim, Xdim); -#endif - -} - -template -void Matrix2D::submatrix(int i0, int j0, int iF, int jF) -{ - if (i0 < 0 || j0 < 0 || iF >= MAT_YSIZE(*this) || jF >= MAT_XSIZE(*this)) - REPORT_ERROR(ERR_INDEX_OUTOFBOUNDS,"Submatrix indexes out of bounds"); - Matrix2D result(iF - i0 + 1, jF - j0 + 1); - - FOR_ALL_ELEMENTS_IN_MATRIX2D(result) - MAT_ELEM(result, i, j) = MAT_ELEM(*this, i+i0, j+j0); - - *this = result; -} - -template -void Matrix2D::initRandom(size_t Ydim, size_t Xdim, double op1, double op2, RandomMode mode) -{ - if (mdimx!=Xdim || mdimy!=Ydim) - resizeNoCopy(Ydim, Xdim); - for (size_t j = 0; j < mdim; j++) - mdata[j] = static_cast< T > (mode == RND_UNIFORM ? rnd_unif(op1, op2) : rnd_gaus(op1, op2)); -} - -/** Initialize to gaussian numbers */ -template -void Matrix2D::initGaussian(int Ydim, int Xdim, double op1, double op2) -{ - initRandom(Ydim, Xdim, op1, op2, RND_GAUSSIAN); -} - - -template -void Matrix2D::initGaussian(int dim, double var) -{ - double center = ((double)dim)/2; - initZeros(dim, dim); - for (int i = 0; i < dim; i++) - for (int j = 0; j < dim; j++) - MAT_ELEM(*this,i,j) = std::exp(-( (i-center)*(i-center)+(j-center)*(j-center) )/(2*var*var)); -} - -template -Matrix2D Matrix2D::operator*(const Matrix2D& op1) const -{ - Matrix2D result; - if (mdimx != op1.mdimy) - REPORT_ERROR(ERR_MATRIX_SIZE, "Not compatible sizes in matrix multiplication"); - - result.initZeros(mdimy, op1.mdimx); - for (size_t i = 0; i < mdimy; i++) - for (size_t j = 0; j < op1.mdimx; j++) - for (size_t k = 0; k < mdimx; k++) - MAT_ELEM(result,i, j) += MAT_ELEM(*this,i, k) * MAT_ELEM(op1, k, j); - return result; -} - -template -Matrix2D Matrix2D::operator+(const Matrix2D& op1) const -{ - Matrix2D result; - if (mdimx != op1.mdimx || mdimy != op1.mdimy) - REPORT_ERROR(ERR_MATRIX_SIZE, "operator+: Not same sizes in matrix summation"); - - result.initZeros(mdimy, mdimx); - for (size_t i = 0; i < mdimy; i++) - for (size_t j = 0; j < mdimx; j++) - result(i, j) = (*this)(i, j) + op1(i, j); - - return result; -} - -template -void Matrix2D::operator+=(const Matrix2D& op1) const -{ - if (mdimx != op1.mdimx || mdimy != op1.mdimy) - REPORT_ERROR(ERR_MATRIX_SIZE, "operator+=: Not same sizes in matrix summation"); - - for (size_t i = 0; i < mdimy; i++) - for (size_t j = 0; j < mdimx; j++) - MAT_ELEM(*this,i, j) += MAT_ELEM(op1, i, j); -} - -template -Matrix2D Matrix2D::operator-(const Matrix2D& op1) const -{ - Matrix2D result; - if (mdimx != op1.mdimx || mdimy != op1.mdimy) - REPORT_ERROR(ERR_MATRIX_SIZE, "operator-: Not same sizes in matrix summation"); - - result.initZeros(mdimy, mdimx); - for (size_t i = 0; i < mdimy; i++) - for (size_t j = 0; j < mdimx; j++) - result(i, j) = (*this)(i, j) - op1(i, j); - - return result; -} - -template -void Matrix2D::operator-=(const Matrix2D& op1) const -{ - if (mdimx != op1.mdimx || mdimy != op1.mdimy) - REPORT_ERROR(ERR_MATRIX_SIZE, "operator-=: Not same sizes in matrix summation"); - - for (size_t i = 0; i < mdimy; i++) - for (size_t j = 0; j < mdimx; j++) - MAT_ELEM(*this,i, j) -= MAT_ELEM(op1, i, j); -} - -template -bool Matrix2D::equal(const Matrix2D& op, - double accuracy) const -{ - if (!sameShape(op)) - return false; - for (size_t i = 0; i < mdimy; i++) - for (size_t j = 0; j < mdimx; j++) - if (fabs( MAT_ELEM(*this,i,j) - MAT_ELEM(op,i,j) ) > accuracy) - { - //std::cerr << "DEBUG_ROB: MAT_ELEM(*this,i,j): " << MAT_ELEM(*this,i,j) << std::endl; - //std::cerr << "DEBUG_ROB: MAT_ELEM(op,i,j): " << MAT_ELEM(op,i,j) << std::endl; - return false; - } - return true; -} - -template -bool Matrix2D::equalAbs(const Matrix2D& op, - double accuracy) const -{ - if (!sameShape(op)) - return false; - for (size_t i = 0; i < mdimy; i++) - for (size_t j = 0; j < mdimx; j++) - if ( (fabs( MAT_ELEM(*this,i,j)) - fabs(MAT_ELEM(op,i,j)) )> accuracy) - { - //std::cerr << "DEBUG_ROB: MAT_ELEM(*this,i,j): " << MAT_ELEM(*this,i,j) << std::endl; - //std::cerr << "DEBUG_ROB: MAT_ELEM(op,i,j): " << MAT_ELEM(op,i,j) << std::endl; - return false; - } - return true; -} - -template -T Matrix2D::computeMax() const -{ - if (mdim <= 0) - return static_cast< T >(0); - - T maxval = mdata[0]; - for (size_t n = 0; n < mdim; n++) - if (mdata[n] > maxval) - maxval = mdata[n]; - return maxval; -} - -template -T Matrix2D::computeMin() const -{ - if (mdim <= 0) - return static_cast< T >(0); - - T minval = mdata[0]; - for (size_t n = 0; n < mdim; n++) - if (mdata[n] < minval) - minval = mdata[n]; - return minval; -} - -template -void Matrix2D::computeMaxAndMin(T &maxValue, T &minValue) const -{ - maxValue=minValue=0; - if (mdim <= 0) - return; - - maxValue = minValue = mdata[0]; - for (size_t n = 0; n < mdim; n++) - { - T val=mdata[n]; - if (val < minValue) - minValue = val; - else if (val > maxValue) - maxValue = val; - } -} - -template -T** Matrix2D::adaptForNumericalRecipes() const -{ - T** m = NULL; - ask_Tmatrix(m, 1, mdimy, 1, mdimx); - - for (int i = 0; i < mdimy; i++) - for (int j = 0; j < mdimx; j++) - m[i+1][j+1] = mdata[i*mdimx + j]; - - return m; -} - -template -void Matrix2D::loadFromNumericalRecipes(T** m, int Ydim, int Xdim) -{ - if (mdimx!=Xdim || mdimy!=Ydim) - resizeNoCopy(Ydim, Xdim); - - for (int i = 1; i <= Ydim; i++) - for (int j = 1; j <= Xdim; j++) - MAT_ELEM(*this,i - 1, j - 1) = m[i][j]; -} - -template -T Matrix2D::trace() const -{ - size_t d=std::min(MAT_XSIZE(*this),MAT_YSIZE(*this)); - T retval=0; - for (size_t i=0; i -Matrix2D Matrix2D::transpose() const -{ - Matrix2D result(mdimx, mdimy); - FOR_ALL_ELEMENTS_IN_MATRIX2D(result) - MAT_ELEM(result,i,j) = MAT_ELEM((*this),j,i); - return result; -} - -template -bool Matrix2D::isIdentity() const -{ - for (size_t i = 0; i < mdimy; i++) - for (size_t j = 0; j < mdimx; j++) - if (i != j) - { - if (MAT_ELEM(*this,i,j)!=0) - return false; - } - else - { - if (MAT_ELEM(*this,i,j)!=1) - return false; - } - return true; -} - -template void ludcmp(Matrix2D const&, Matrix2D&, Matrix1D&, double&); -template void lubksb(Matrix2D const&, Matrix1D&, Matrix1D&); -template void svdcmp(Matrix2D const&, Matrix2D&, Matrix1D&, Matrix2D&); -template void svdcmp(Matrix2D const&, Matrix2D&, Matrix1D&, Matrix2D&); -template Matrix1D Matrix1D::operator*(Matrix2D const&); -template class Matrix2D; -template class Matrix2D; -template class Matrix2D; -template class Matrix2D; diff --git a/src/core/matrix2d.h b/src/core/matrix2d.h deleted file mode 100644 index 5ecd06d..0000000 --- a/src/core/matrix2d.h +++ /dev/null @@ -1,1329 +0,0 @@ -/*************************************************************************** - * - * Authors: Carlos Oscar S. Sorzano (coss@cnb.csic.es) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_MATRIX2D_H_ -#define CORE_MATRIX2D_H_ - -#include -#include "xmipp_random_mode.h" -#include "xmipp_macros.h" -#include "xmipp_error.h" -#include "xmipp_strings.h" - -class FileName; - -#ifdef XMIPP_MMAP -#include -#endif - -template -class Matrix1D; - -// Forward declarations -template -class Matrix2D; - -template -void ludcmp(const Matrix2D& A, Matrix2D& LU, Matrix1D< int >& indx, T& d); - -template -void lubksb(const Matrix2D& LU, Matrix1D< int >& indx, Matrix1D& b); - -template -void svdcmp(const Matrix2D< T >& a, - Matrix2D< double >& u, - Matrix1D< double >& w, - Matrix2D< double >& v); - -void svbksb(Matrix2D< double >& u, - Matrix1D< double >& w, - Matrix2D< double >& v, - Matrix1D< double >& b, - Matrix1D< double >& x); - - -/** Cholesky decomposition. - * Given M, this function decomposes M as M=L*L^t where L is a lower triangular matrix. - * M must be positive semi-definite. - */ -void cholesky(const Matrix2D &M, Matrix2D &L); - -/** Schur decomposition. - * Given M, this function decomposes M as M = O*T*O' where O is an orthogonal matrix. - */ -void schur(const Matrix2D &M, Matrix2D &O, Matrix2D &T); - -/** @defgroup Matrices Matrix2D Matrices - * @ingroup DataLibrary - */ -//@{ -/** @name Matrices speed up macros */ -//@{ - -/** Array access. - * - * This macro gives you access to the array (T) - */ -#define MATRIX2D_ARRAY(m) ((m).mdata) - -/** For all elements in the array - * - * This macro is used to generate loops for the matrix in an easy way. It - * defines internal indexes 'i' and 'j' which ranges the matrix using its - * mathematical definition (ie, logical access). - * - * @code - * FOR_ALL_ELEMENTS_IN_MATRIX2D(m) - * { - * std::cout << m(i, j) << " "; - * } - * @endcode - */ -#define FOR_ALL_ELEMENTS_IN_MATRIX2D(m) \ - for (size_t i=0; i<(m).mdimy; i++) \ - for (size_t j=0; j<(m).mdimx; j++) - -/** Access to a matrix element - * v is the array, i and j define the element v_ij. - * - * @code - * MAT_ELEM(m, 0, 0) = 1; - * val = MAT_ELEM(m, 0, 0); - * @endcode - */ -#define MAT_ELEM(m,i,j) ((m).mdata[((size_t)i)*(m).mdimx+((size_t)j)]) - -/** X dimension of the matrix - */ -#define MAT_XSIZE(m) ((m).mdimx) - -/** Y dimension of the matrix - */ -#define MAT_YSIZE(m) ((m).mdimy) - -/** Total elements of the matrix - */ -#define MAT_SIZE(m) ((m).mdim) - -/** Matrix element: Element access - * - * This is just a redefinition - * of the function above - * @code - * dMij(m, -2, 1) = 1; - * val = dMij(m, -2, 1); - * @endcode - */ -#define dMij(m, i, j) MAT_ELEM(m, i, j) - -/** Matrix element: Element access - * - * This is just a redefinition - * of the function above - */ -#define dMn(m, n) ((m).mdata[(n)]) - -/** Matrix (3x3) by vector (3x1) (a=M*b) - * - * You must "load" the temporary variables, and create the result vector with - * the appropriate size. You can reuse the vector b to store the results (that - * is, M3x3_BY_V3x1(b, M, b);, is allowed). - * - * @code - * double example - * { - * SPEED_UP_temps; - * - * Matrix1D< double > a(3), b(3); - * Matrix2D< double > M(3, 3); - * - * M.init_random(0, 1); - * b.init_random(0, 1); - * M3x3_BY_V3x1(a, M, b); - * - * return a.sum(); - * } - * @endcode - */ -#define M3x3_BY_V3x1(a, M, b) { \ - spduptmp0 = dMn(M, 0) * XX(b) + dMn(M, 1) * YY(b) + dMn(M, 2) * ZZ(b); \ - spduptmp1 = dMn(M, 3) * XX(b) + dMn(M, 4) * YY(b) + dMn(M, 5) * ZZ(b); \ - spduptmp2 = dMn(M, 6) * XX(b) + dMn(M, 7) * YY(b) + dMn(M, 8) * ZZ(b); \ - XX(a) = spduptmp0; YY(a) = spduptmp1; ZZ(a) = spduptmp2; } - -/** Matrix (3x3) by Matrix (3x3) (A=B*C) - * - * You must "load" the temporary variables, and create the result vector with - * the appropriate size. You can reuse any of the multiplicands to store the - * results (that is, M3x3_BY_M3x3(A, A, B);, is allowed). - */ -#define M3x3_BY_M3x3(A, B, C) { \ - spduptmp0 = dMn(B,0) * dMn(C,0) + dMn(B,1) * dMn(C,3) + dMn(B,2) * dMn(C,6); \ - spduptmp1 = dMn(B,0) * dMn(C,1) + dMn(B,1) * dMn(C,4) + dMn(B,2) * dMn(C,7); \ - spduptmp2 = dMn(B,0) * dMn(C,2) + dMn(B,1) * dMn(C,5) + dMn(B,2) * dMn(C,8); \ - spduptmp3 = dMn(B,3) * dMn(C,0) + dMn(B,4) * dMn(C,3) + dMn(B,5) * dMn(C,6); \ - spduptmp4 = dMn(B,3) * dMn(C,1) + dMn(B,4) * dMn(C,4) + dMn(B,5) * dMn(C,7); \ - spduptmp5 = dMn(B,3) * dMn(C,2) + dMn(B,4) * dMn(C,5) + dMn(B,5) * dMn(C,8); \ - spduptmp6 = dMn(B,6) * dMn(C,0) + dMn(B,7) * dMn(C,3) + dMn(B,8) * dMn(C,6); \ - spduptmp7 = dMn(B,6) * dMn(C,1) + dMn(B,7) * dMn(C,4) + dMn(B,8) * dMn(C,7); \ - spduptmp8 = dMn(B,6) * dMn(C,2) + dMn(B,7) * dMn(C,5) + dMn(B,8) * dMn(C,8); \ - dMn(A, 0) = spduptmp0; \ - dMn(A, 1) = spduptmp1; \ - dMn(A, 2) = spduptmp2; \ - dMn(A, 3) = spduptmp3; \ - dMn(A, 4) = spduptmp4; \ - dMn(A, 5) = spduptmp5; \ - dMn(A, 6) = spduptmp6; \ - dMn(A, 7) = spduptmp7; \ - dMn(A, 8) = spduptmp8; } - -/** Matrix (2x2) by vector (2x1) (a=M*b) - * - * You must "load" the temporary variables, and create the result vector with - * the appropriate size. You can reuse the vector b to store the results (that - * is, M2x2_BY_V2x1(b, M, b);, is allowed). - * - * @code - * double example - * { - * SPEED_UP_temps; - * - * Matrix1D< double > a(2), b(2); - * Matrix2D< double > M(2, 2); - * - * M.init_random(0, 1); - * b.init_random(0, 1); - * - * M2x2_BY_V2x1(a, M, b); - * - * return a.sum(); - * } - * @endcode - */ -#define M2x2_BY_V2x1(a, M, b) { \ - spduptmp0 = dMn(M, 0) * XX(b) + dMn(M, 1) * YY(b); \ - spduptmp1 = dMn(M, 2) * XX(b) + dMn(M, 3) * YY(b); \ - XX(a) = spduptmp0; \ - YY(a) = spduptmp1; } - -/** Matrix (2x2) by constant (M2=M1*k) - * - * You must create the result matrix with the appropriate size. You can reuse - * the matrix M1 to store the results (that is, M2x2_BY_CT(M, M, k);, is - * allowed). - */ -#define M2x2_BY_CT(M2, M1, k) { \ - dMn(M2, 0) = dMn(M1, 0) * k; \ - dMn(M2, 1) = dMn(M1, 1) * k; \ - dMn(M2, 2) = dMn(M1, 2) * k; \ - dMn(M2, 3) = dMn(M1, 3) * k; } - -/** Matrix (3x3) by constant (M2=M1*k) - * - * You must create the result matrix with the appropriate size. You can reuse the - * matrix M1 to store the results (that is, M2x2_BY_CT(M, M, k);, is allowed). - */ -#define M3x3_BY_CT(M2, M1, k) { \ - dMn(M2, 0) = dMn(M1, 0) * k; \ - dMn(M2, 1) = dMn(M1, 1) * k; \ - dMn(M2, 2) = dMn(M1, 2) * k; \ - dMn(M2, 3) = dMn(M1, 3) * k; \ - dMn(M2, 4) = dMn(M1, 4) * k; \ - dMn(M2, 5) = dMn(M1, 5) * k; \ - dMn(M2, 6) = dMn(M1, 6) * k; \ - dMn(M2, 7) = dMn(M1, 7) * k; \ - dMn(M2, 8) = dMn(M1, 8) * k; } -/** Matrix (4x4) by constant (M2=M1*k) - * - * You must create the result matrix with the appropriate size. You can reuse the - * matrix M1 to store the results (that is, M2x2_BY_CT(M, M, k);, is allowed). - */ -#define M4x4_BY_CT(M2, M1, k) { \ - dMn(M2, 0) = dMn(M1, 0) * k; \ - dMn(M2, 1) = dMn(M1, 1) * k; \ - dMn(M2, 2) = dMn(M1, 2) * k; \ - dMn(M2, 3) = dMn(M1, 3) * k; \ - dMn(M2, 4) = dMn(M1, 4) * k; \ - dMn(M2, 5) = dMn(M1, 5) * k; \ - dMn(M2, 6) = dMn(M1, 6) * k; \ - dMn(M2, 7) = dMn(M1, 7) * k; \ - dMn(M2, 8) = dMn(M1, 8) * k; \ - dMn(M2, 9) = dMn(M1, 9) * k; \ - dMn(M2,10) = dMn(M1,10) * k; \ - dMn(M2,11) = dMn(M1,11) * k; \ - dMn(M2,12) = dMn(M1,12) * k; \ - dMn(M2,13) = dMn(M1,13) * k; \ - dMn(M2,14) = dMn(M1,14) * k; \ - dMn(M2,15) = dMn(M1,15) * k;} - -/** Inverse of a matrix (2x2) - * - * Input and output matrix cannot be the same one. The output is supposed to be - * already resized. - */ -#define M2x2_INV(Ainv, A) { \ - spduptmp0 = dMn(A,0) * dMn(A,3) - dMn(A,1) * dMn(A,2);\ - if (spduptmp0==0.0) \ - REPORT_ERROR(ERR_NUMERICAL,"2x2 matrix is not invertible"); \ - spduptmp0 = 1.0 / spduptmp0; \ - dMn(Ainv, 0) = dMn(A,3); \ - dMn(Ainv, 1) = -dMn(A,1); \ - dMn(Ainv, 2) = -dMn(A,2); \ - dMn(Ainv, 3) = dMn(A,0); \ - M2x2_BY_CT(Ainv, Ainv, spduptmp0); } - -/** Inverse of a matrix (3x3) - * - * Input and output matrix cannot be the same one. The output is supposed to be - * already resized. - */ -#define M3x3_INV(Ainv, A) { \ - dMn(Ainv, 0) = dMn(A,8)*dMn(A,4)-dMn(A,7)*dMn(A,5); \ - dMn(Ainv, 1) = -(dMn(A,8)*dMn(A,1)-dMn(A,7)*dMn(A,2)); \ - dMn(Ainv, 2) = dMn(A,5)*dMn(A,1)-dMn(A,4)*dMn(A,2); \ - dMn(Ainv, 3) = -(dMn(A,8)*dMn(A,3)-dMn(A,6)*dMn(A,5)); \ - dMn(Ainv, 4) = dMn(A,8)*dMn(A,0)-dMn(A,6)*dMn(A,2); \ - dMn(Ainv, 5) = -(dMn(A,5)*dMn(A,0)-dMn(A,3)*dMn(A,2)); \ - dMn(Ainv, 6) = dMn(A,7)*dMn(A,3)-dMn(A,6)*dMn(A,4); \ - dMn(Ainv, 7) = -(dMn(A,7)*dMn(A,0)-dMn(A,6)*dMn(A,1)); \ - dMn(Ainv, 8) = dMn(A,4)*dMn(A,0)-dMn(A,3)*dMn(A,1); \ - spduptmp0 = dMn(A,0)*dMn(Ainv,0)+dMn(A,3)*dMn(Ainv,1)+dMn(A,6)*dMn(Ainv,2); \ - if (spduptmp0==0.0) \ - REPORT_ERROR(ERR_NUMERICAL,"3x3 matrix is not invertible"); \ - spduptmp0 = 1.0 / spduptmp0; \ - M3x3_BY_CT(Ainv, Ainv, spduptmp0); } - -/** Inverse of a matrix (4x4) - * - * Input and output matrix cannot be the same one. The output is supposed to be - * already resized. - */ -#define M4x4_INV(Ainv, A) { \ - dMn(Ainv, 0) = dMn(A,5)*(dMn(A,10)*dMn(A,15)-dMn(A,11)*dMn(A,14))+\ - dMn(A,6)*(dMn(A,11)*dMn(A,13)-dMn(A,9) *dMn(A,15))+\ - dMn(A,7)*(dMn(A,9) *dMn(A,14)-dMn(A,10)*dMn(A,13));\ - dMn(Ainv, 1) = dMn(A,1)*(dMn(A,11)*dMn(A,14)-dMn(A,10)*dMn(A,15))+\ - dMn(A,2)*(dMn(A,9) *dMn(A,15)-dMn(A,11)*dMn(A,13))+\ - dMn(A,3)*(dMn(A,10)*dMn(A,13)-dMn(A,9) *dMn(A,14));\ - dMn(Ainv, 2) = dMn(A,1)*(dMn(A,6) *dMn(A,15)-dMn(A,7) *dMn(A,14))+\ - dMn(A,2)*(dMn(A,7) *dMn(A,13)-dMn(A,5) *dMn(A,15))+\ - dMn(A,3)*(dMn(A,5) *dMn(A,14)-dMn(A,6) *dMn(A,13));\ - dMn(Ainv, 3) = dMn(A,1)*(dMn(A,7) *dMn(A,10)-dMn(A,6) *dMn(A,11))+\ - dMn(A,2)*(dMn(A,5) *dMn(A,11)-dMn(A,7) *dMn(A,9))+\ - dMn(A,3)*(dMn(A,6) *dMn(A,9) -dMn(A,5) *dMn(A,10));\ - dMn(Ainv, 4) = dMn(A,4)*(dMn(A,11)*dMn(A,14)-dMn(A,10)*dMn(A,15))+\ - dMn(A,6)*(dMn(A,8) *dMn(A,15)-dMn(A,11)*dMn(A,12))+\ - dMn(A,7)*(dMn(A,10)*dMn(A,12)-dMn(A,8) *dMn(A,14));\ - dMn(Ainv, 5) = dMn(A,0)*(dMn(A,10)*dMn(A,15)-dMn(A,11)*dMn(A,14))+\ - dMn(A,2)*(dMn(A,11)*dMn(A,12)-dMn(A,8) *dMn(A,15))+\ - dMn(A,3)*(dMn(A,8) *dMn(A,14)-dMn(A,10)*dMn(A,12));\ - dMn(Ainv, 6) = dMn(A,0)*(dMn(A,7) *dMn(A,14)-dMn(A,6) *dMn(A,15))+\ - dMn(A,2)*(dMn(A,4) *dMn(A,15)-dMn(A,7) *dMn(A,12))+\ - dMn(A,3)*(dMn(A,6) *dMn(A,12)-dMn(A,4) *dMn(A,14));\ - dMn(Ainv, 7) = dMn(A,0)*(dMn(A,6) *dMn(A,11)-dMn(A,7) *dMn(A,10))+\ - dMn(A,2)*(dMn(A,7) *dMn(A,8) -dMn(A,4) *dMn(A,11))+\ - dMn(A,3)*(dMn(A,4) *dMn(A,10)-dMn(A,6) *dMn(A,8));\ - dMn(Ainv, 8) = dMn(A,4)*(dMn(A,9) *dMn(A,15)-dMn(A,11)*dMn(A,13))+\ - dMn(A,5)*(dMn(A,11)*dMn(A,12)-dMn(A,8) *dMn(A,15))+\ - dMn(A,7)*(dMn(A,8) *dMn(A,13)-dMn(A,9) *dMn(A,12));\ - dMn(Ainv, 9) = dMn(A,0)*(dMn(A,11)*dMn(A,13)-dMn(A,9) *dMn(A,15))+\ - dMn(A,1)*(dMn(A,8) *dMn(A,15)-dMn(A,11)*dMn(A,12))+\ - dMn(A,3)*(dMn(A,9) *dMn(A,12)-dMn(A,8) *dMn(A,13));\ - dMn(Ainv,10) = dMn(A,0)*(dMn(A,5) *dMn(A,15)-dMn(A,7) *dMn(A,13))+\ - dMn(A,1)*(dMn(A,7) *dMn(A,12)-dMn(A,4) *dMn(A,15))+\ - dMn(A,3)*(dMn(A,4) *dMn(A,13)-dMn(A,5) *dMn(A,12));\ - dMn(Ainv,11) = dMn(A,0)*(dMn(A,7) *dMn(A,9) -dMn(A,5) *dMn(A,11))+\ - dMn(A,1)*(dMn(A,4) *dMn(A,11)-dMn(A,7) *dMn(A,8))+\ - dMn(A,3)*(dMn(A,5) *dMn(A,8) -dMn(A,4) *dMn(A,9));\ - dMn(Ainv,12) = dMn(A,4)*(dMn(A,10)*dMn(A,13)-dMn(A,9) *dMn(A,14))+\ - dMn(A,5)*(dMn(A,8) *dMn(A,14)-dMn(A,10)*dMn(A,12))+\ - dMn(A,6)*(dMn(A,9) *dMn(A,12)-dMn(A,8) *dMn(A,13));\ - dMn(Ainv,13) = dMn(A,0)*(dMn(A,9) *dMn(A,14)-dMn(A,10)*dMn(A,13))+\ - dMn(A,1)*(dMn(A,10)*dMn(A,12)-dMn(A,8) *dMn(A,14))+\ - dMn(A,2)*(dMn(A,8) *dMn(A,13)-dMn(A,9) *dMn(A,12));\ - dMn(Ainv,14) = dMn(A,0)*(dMn(A,6) *dMn(A,13)-dMn(A,5) *dMn(A,14))+\ - dMn(A,1)*(dMn(A,4) *dMn(A,14)-dMn(A,6) *dMn(A,12))+\ - dMn(A,2)*(dMn(A,5) *dMn(A,12)-dMn(A,4) *dMn(A,13));\ - dMn(Ainv,15) = dMn(A,0)*(dMn(A,5) *dMn(A,10)-dMn(A,6) *dMn(A,9))+\ - dMn(A,1)*(dMn(A,6) *dMn(A,8) -dMn(A,4) *dMn(A,10))+\ - dMn(A,2)*(dMn(A,4) *dMn(A,9) -dMn(A,5) *dMn(A,8));\ - spduptmp0 = dMn(A,0)*(dMn(A,5)*(dMn(A,10)*dMn(A,15)-dMn(A,11)*dMn(A,14))\ - +dMn(A,6)*(dMn(A,11)*dMn(A,13)-dMn(A,9) *dMn(A,15))\ - +dMn(A,7)*(dMn(A,9) *dMn(A,14)-dMn(A,10)*dMn(A,13)))\ - +dMn(A,1)*(dMn(A,4)*(dMn(A,11)*dMn(A,14)-dMn(A,10)*dMn(A,15))\ - +dMn(A,6)*(dMn(A,8) *dMn(A,15)-dMn(A,11)*dMn(A,12))\ - +dMn(A,7)*(dMn(A,10)*dMn(A,12)-dMn(A,8) *dMn(A,14)))\ - +dMn(A,2)*(dMn(A,4)*(dMn(A,9) *dMn(A,15)-dMn(A,11)*dMn(A,13))\ - +dMn(A,5)*(dMn(A,11)*dMn(A,12)-dMn(A,8) *dMn(A,15))\ - +dMn(A,7)*(dMn(A,8) *dMn(A,13)-dMn(A,9) *dMn(A,12)))\ - +dMn(A,3)*(dMn(A,4)*(dMn(A,10)*dMn(A,13)-dMn(A,9) *dMn(A,14))\ - +dMn(A,5)*(dMn(A,8) *dMn(A,14)-dMn(A,10)*dMn(A,12))\ - +dMn(A,6)*(dMn(A,9) *dMn(A,12)-dMn(A,8) *dMn(A,13))); \ - if (spduptmp0==0.0) \ - REPORT_ERROR(ERR_NUMERICAL,"4x4 matrix is not invertible"); \ - spduptmp0 = 1.0 / spduptmp0; \ - M4x4_BY_CT(Ainv, Ainv, spduptmp0); } - -/** Matrix2D class */ -template -class Matrix2D -{ -public: - // The array itself - T* mdata; - - // Destroy data - bool destroyData; - - // Mapped data - bool mappedData; - - // File descriptor for mapped files - int fdMap; - - // Mapped data original pointer - char* mdataOriginal; - - // Number of elements in X - size_t mdimx; - - // Number of elements in Y - size_t mdimy; - - // Total number of elements - size_t mdim; - //@} - - /// @name Constructors - //@{ - /** Empty constructor - */ - Matrix2D() - { - coreInit(); - } - - Matrix2D(const FileName &fnMappedMatrix, int Ydim, int Xdim, size_t offset=0) - { - coreInit(fnMappedMatrix,Ydim,Xdim,offset); - } - - /** Dimension constructor - */ - Matrix2D(int Ydim, int Xdim) - { - coreInit(); - initZeros(Ydim, Xdim); - } - - /** Copy constructor - */ - Matrix2D(const Matrix2D& v) - { - coreInit(); - *this = v; - } - - /** Destructor. - */ - ~Matrix2D() - { - coreDeallocate(); - } - - /** Assignment. - * - * You can build as complex assignment expressions as you like. Multiple - * assignment is allowed. - * - * @code - * v1 = v2 + v3; - * v1 = v2 = v3; - * @endcode - */ - Matrix2D& operator=(const Matrix2D& op1); - //@} - - /// @name Core memory operations for Matrix2D - //@{ - /** Clear. - */ - void clear() - { - coreDeallocate(); - coreInit(); - } - - /** Method will convert Matrix2D matrix to float[3][3] */ - inline void convertTo(float out[3][3]) const { - for (int i = 0; i < 3; i++) { - for (int j = 0; j < 3; j++) { - out[i][j] = (*this)(i, j); - } - } - } - - /** Core init from mapped file. - * Offset is in bytes. */ - void coreInit(const FileName &fn, int Ydim, int Xdim, size_t offset=0); - - /** Core init. - * Initialize everything to 0 - */ - void coreInit(); - - /** Core allocate. - */ - void coreAllocate( int _mdimy, int _mdimx); - - /** Core deallocate. - * Free all mdata. - */ - void coreDeallocate(); - //@} - - /// @name Size and shape of Matrix2D - //@{ - /** Resize to a given size - */ - void resize(size_t Ydim, size_t Xdim, bool noCopy=false); - - /** Resize according to a pattern. - * - * This function resize the actual array to the same size and origin - * as the input pattern. If the actual array is larger than the pattern - * then the trailing values are lost, if it is smaller then 0's are - * added at the end - * - * @code - * v2.resize(v1); - * // v2 has got now the same structure as v1 - * @endcode - */ - template - void resize(const Matrix2D &v) - { - if (mdimx != v.mdimx || mdimy != v.mdimy) - resize(v.mdimy, v.mdimx); - } - - /** Resize to a given size (don't copy old elements) - */ - inline void resizeNoCopy(int Ydim, int Xdim) - { - resize(Ydim, Xdim, true); - } - - /** Resize according to a pattern. - * Do not copy old elements. - */ - template - inline void resizeNoCopy(const Matrix2D &v) - { - if (mdimx != v.mdimx || mdimy != v.mdimy) - resize(v.mdimy, v.mdimx, true); - } - - /** Map to file. - * The matrix is mapped to a file. The file is presumed to be already created with - * enough space for a matrix of size Ydim x Xdim. - * Offset is in bytes. - */ - void mapToFile(const FileName &fn, int Ydim, int Xdim, size_t offset=0); - - /** Extract submatrix and assign to this object. - */ - void submatrix(int i0, int j0, int iF, int jF); - - /** Same shape. - * - * Returns true if this object has got the same shape (origin and size) - * than the argument - */ - template - inline bool sameShape(const Matrix2D& op) const - { - return ((mdimx == op.mdimx) && (mdimy == op.mdimy)); - } - - /** X dimension - * - * Returns X dimension - */ - inline size_t Xdim() const - { - return mdimx; - } - - /** Y dimension - * - * Returns Y dimension - */ - inline size_t Ydim() const - { - return mdimy; - } - //@} - - /// @name Initialization of Matrix2D values - //@{ - /** Same value in all components. - * - * The constant must be of a type compatible with the array type, ie, - * you cannot assign a double to an integer array without a casting. - * It is not an error if the array is empty, then nothing is done. - * - * @code - * v.initConstant(3.14); - * @endcode - */ - inline void initConstant(T val) - { - for (size_t j = 0; j < mdim; j++) - mdata[j] = val; - } - - /** Initialize to zeros with a given size. - */ - inline void initConstant(size_t Ydim, size_t Xdim, T val) - { - if (mdimx!=Xdim || mdimy!=Ydim) - resizeNoCopy(Ydim, Xdim); - initConstant(val); - } - - /** Initialize to zeros with current size. - * - * All values are set to 0. The current size and origin are kept. It is not - * an error if the array is empty, then nothing is done. - * - * @code - * v.initZeros(); - * @endcode - */ - inline void initZeros() - { - memset(mdata,0,mdimx*mdimy*sizeof(T)); - } - - /** Initialize to zeros with a given size. - */ - inline void initZeros(size_t Ydim, size_t Xdim) - { - if (mdimx!=Xdim || mdimy!=Ydim) - resizeNoCopy(Ydim, Xdim); - memset(mdata,0,mdimx*mdimy*sizeof(T)); - } - - /** Initialize to zeros following a pattern. - * - * All values are set to 0, and the origin and size of the pattern are - * adopted. - * - * @code - * v2.initZeros(v1); - * @endcode - */ - template - void initZeros(const Matrix2D& op) - { - if (mdimx!=op.mdimx || mdimy!=op.mdimy) - resizeNoCopy(op); - memset(mdata,0,mdimx*mdimy*sizeof(T)); - } - - /** Initialize to random random numbers, uniform or gaussian - */ - void initRandom(size_t Ydim, size_t Xdim, double op1, double op2, RandomMode mode = RND_UNIFORM); - - /** Initialize to gaussian numbers */ - void initGaussian(int Ydim, int Xdim, double op1=0., double op2=1.); - - /** 2D Identity matrix of current size - * - * If actually the matrix is not squared then an identity matrix is - * generated of size (Xdim x Xdim). - * - * @code - * m.initIdentity(); - * @endcode - */ - inline void initIdentity() - { - initIdentity(MAT_XSIZE(*this)); - } - - /** 2D Identity matrix of a given size - * - * A (dim x dim) identity matrix is generated. - * - * @code - * m.initIdentity(3); - * @endcode - */ - inline void initIdentity(int dim) - { - initZeros(dim, dim); - for (int i = 0; i < dim; i++) - MAT_ELEM(*this,i,i) = 1; - } - /** 2D gaussian matrix of a given size and with a given variance. The amplitude of the Gaussian is set to 1. - * - * A (dim x dim) gaussian matrix is generated. - * - * @code - * m.initGaussian(3,1); - * @endcode - */ - void initGaussian(int dim, double var); - //@} - - /// @name Operators for Matrix2D - //@{ - - /** Matrix element access - */ - inline T& operator()(int i, int j) const - { - return MAT_ELEM((*this),i,j); - } - /** Parenthesis operator for phyton - */ - inline void setVal(T val,int y, int x) - { - MAT_ELEM((*this),y,x)=val; - } - /** Parenthesis operator for phyton - */ - inline T getVal( int y, int x) const - { - return MAT_ELEM((*this),y,x); - } - - /** v3 = v1 * k. - */ - inline Matrix2D operator*(T op1) const - { - Matrix2D tmp(*this); - for (size_t i=0; i < mdim; i++) - tmp.mdata[i] = mdata[i] * op1; - return tmp; - } - - /** v3 = v1 / k. - */ - inline Matrix2D operator/(T op1) const - { - Matrix2D tmp(*this); - for (size_t i=0; i < mdim; i++) - tmp.mdata[i] = mdata[i] / op1; - return tmp; - } - - /** v3 = k * v2. - */ - inline friend Matrix2D operator*(T op1, const Matrix2D& op2) - { - Matrix2D tmp(op2); - for (size_t i=0; i < op2.mdim; i++) - tmp.mdata[i] = op1 * op2.mdata[i]; - return tmp; - } - - /** v3 *= k. - */ - inline void operator*=(T op1) - { - for (size_t i=0; i < mdim; i++) - mdata[i] *= op1; - } - - /** v3 /= k. - */ - inline void operator/=(T op1) - { - for (size_t i=0; i < mdim; i++) - mdata[i] /= op1; - } - - /** Matrix by vector multiplication - * - * @code - * v2 = A*v1; - * @endcode - */ - Matrix1D operator*(const Matrix1D& op1) const; - - /** Matrix by Matrix multiplication - * - * @code - * C = A*B; - * @endcode - */ - Matrix2D operator*(const Matrix2D& op1) const; - - /** Matrix summation - * - * @code - * C = A + B; - * @endcode - */ - Matrix2D operator+(const Matrix2D& op1) const; - - /** Matrix summation - * - * @code - * A += B; - * @endcode - */ - void operator+=(const Matrix2D& op1) const; - - /** Matrix subtraction - * - * @code - * C = A - B; - * @endcode - */ - Matrix2D operator-(const Matrix2D& op1) const; - - /** Matrix subtraction - * - * @code - * A -= B; - * @endcode - */ - void operator-=(const Matrix2D& op1) const; - /** Equality. - * - * Returns true if this object has got the same shape (origin and size) - * than the argument and the same values (within accuracy). - */ - bool equal(const Matrix2D& op, - double accuracy = XMIPP_EQUAL_ACCURACY) const; - /** Equality. - * - * Returns true if this object has got the same shape (origin and size) - * than the argument and the same values (within accuracy and without SIGN). - */ - bool equalAbs(const Matrix2D& op, - double accuracy = XMIPP_EQUAL_ACCURACY) const; - //@} - - /// @name Utilities for Matrix2D - //@{ - /** Maximum of the values in the array. - * - * The returned value is of the same type as the type of the array. - */ - T computeMax() const; - - /** Minimum of the values in the array. - * - * The returned value is of the same type as the type of the array. - */ - T computeMin() const; - - /** Maximum and minimum of the values in the array. */ - void computeMaxAndMin(T &maxValue, T &minValue) const; - - /** Get row sum. */ - void rowSum(Matrix1D &sum) const; - - /** Get column sum. */ - void colSum(Matrix1D &sum) const; - - /** Get row energy sum. - * Sum of the squared values by row */ - void rowEnergySum(Matrix1D &sum) const; - - /** Produce a 2D array suitable for working with Numerical Recipes - * - * This function must be used only as a preparation for routines which need - * that the first physical index is 1 and not 0 as it usually is in C. New - * memory is needed to hold the new double pointer array. - */ - T** adaptForNumericalRecipes() const; - - /** Produce a 1D pointer suitable for working with Numerical Recipes (2) - * - * This function meets the same goal as the one before, however this one - * work with 2D arrays as a single pointer. The first element of the array - * is pointed by result[1*Xdim+1], and in general result[i*Xdim+j] - */ - inline T* adaptForNumericalRecipes2() const - { - return mdata - 1 - mdimx; - } - - /** Load 2D array from numerical recipes result. - */ - void loadFromNumericalRecipes(T** m, int Ydim, int Xdim); - - /** Kill a 2D array produced for numerical recipes - * - * The allocated memory is freed. - */ - inline void killAdaptationForNumericalRecipes(T** m) const - { - free_Tmatrix(m, 1, mdimy, 1, mdimx); - } - - /** Kill a 2D array produced for numerical recipes, 2. - * - * Nothing needs to be done. - */ - void killAdaptationForNumericalRecipes2(T** m) const - {} - - /** Read this matrix from file. - * The matrix is assumed to be already resized. - */ - void read(const FileName &fn); - - /** Write this matrix to file - */ - void write(const FileName &fn) const; - /** Show matrix - */ - friend std::ostream& operator<<(std::ostream& ostrm, const Matrix2D& v) - { - if (v.Xdim() == 0 || v.Ydim() == 0) - ostrm << "NULL matrix\n"; - else - { - ostrm << std::endl; - double max_val = v.computeMax(); - int prec = bestPrecision(max_val, 10); - - for (size_t i = 0; i < v.Ydim(); i++) - { - for (size_t j = 0; j < v.Xdim(); j++) - { - ostrm << floatToString((double) v(i, j), 10, prec) << ' '; - } - ostrm << std::endl; - } - } - - return ostrm; - } - - /** Makes a matrix from a vector - * - * The origin of the matrix is set such that it has one of the index origins - * (X or Y) to the same value as the vector, and the other set to 0 - * according to the shape. - * - * @code - * Matrix2D< double > m = fromVector(v); - * @endcode - */ - void fromVector(const Matrix1D& op1); - - /** Makes a vector from a matrix - * - * An exception is thrown if the matrix is not a single row or a single - * column. The origin of the vector is set according to the one of the - * matrix. - * - * @code - * Matrix1D< double > v; - * m.toVector(v); - * @endcode - */ - void toVector(Matrix1D& op1) const; - - /**Copy matrix to stl::vector - */ - void copyToVector(std::vector &v) - { - v.assign(mdata, mdata+mdim); - } - /**Copy stl::vector to matrix - */ - inline void copyFromVector(std::vector &v,int Xdim, int Ydim) - { - if (mdimx!=Xdim || mdimy!=Ydim) - resizeNoCopy(Ydim, Xdim); - copy( v.begin(), v.begin()+v.size(), mdata); - } - - /** Get row - * - * This function returns a row vector corresponding to the chosen - * row inside the nth 2D matrix, the numbering of the rows is also - * logical not physical. - * - * @code - * std::vector< double > v; - * m.getRow(-2, v); - * @endcode - */ - void getRow(size_t i, Matrix1D& v) const; - - /** Get Column - * - * This function returns a column vector corresponding to the - * chosen column. - * - * @code - * std::vector< double > v; - * m.getCol(-1, v); - * @endcode - */ - void getCol(size_t j, Matrix1D& v) const; - - /** Set Row - * - * This function sets a row vector corresponding to the chosen row in the 2D Matrix - * - * @code - * m.setRow(-2, m.row(1)); // Copies row 1 in row -2 - * @endcode - */ - void setRow(size_t i, const Matrix1D& v); - - /** Set Column - * - * This function sets a column vector corresponding to the chosen column - * inside matrix. - * - * @code - * m.setCol(0, (m.row(1)).transpose()); // Copies row 1 in column 0 - * @endcode - */ - void setCol(size_t j, const Matrix1D& v); - - /** Compute row means */ - void computeRowMeans(Matrix1D &Xmr) const; - - /** Compute row means */ - void computeColMeans(Matrix1D &Xmr) const; - - /** Set constant column. - * Set a given column to a constant value A(i,j)=val; - */ - inline void setConstantCol(size_t j, T v) - { - if (mdimx == 0 || mdimy == 0) - REPORT_ERROR(ERR_MATRIX_EMPTY, "setCol: Target matrix is empty"); - - if (j>= mdimx) - REPORT_ERROR(ERR_INDEX_OUTOFBOUNDS, "setCol: Matrix subscript (j) out of range"); - - for (size_t i = 0; i < mdimy; i++) - MAT_ELEM(*this,i, j) = v; - } - - /** Get diagonal. - * It is assumed that the matrix is squared - */ - void getDiagonal(Matrix1D &d) const; - - /** Trace - * Sum of the values in the diagonal - */ - T trace() const; - - /** Determinant of a matrix - * - * An exception is thrown if the matrix is not squared or it is empty. - * - * @code - * double det = m.det(); - * @endcode - */ - T det() const; - - ///determinat of 3x3 matrix - inline T det3x3() const - { - return ( - dMij(*this,0,0)*( dMij(*this,2,2)*dMij(*this,1,1)- - dMij(*this,2,1)*dMij(*this,1,2) )- - dMij(*this,1,0)*( dMij(*this,2,2)*dMij(*this,0,1)- - dMij(*this,2,1)*dMij(*this,0,2) )+ - dMij(*this,2,0)*( dMij(*this,1,2)*dMij(*this,0,1)- - dMij(*this,1,1)*dMij(*this,0,2) ) - ); - } - - /** Frobenius norm of a matrix */ - inline double norm() - { - double sum=0.; - FOR_ALL_ELEMENTS_IN_MATRIX2D(*this) - { - T aux=MAT_ELEM(*this,i,j); - sum+=aux*aux; - } - return sqrt(sum); - } - - /** Algebraic transpose of a Matrix - * - * You can use the transpose in as complex expressions as you like. The - * origin of the vector is not changed. - * - * @code - * v2 = v1.transpose(); - * @endcode - */ - Matrix2D transpose() const; - - /** Inverse of a matrix - * - * The matrix is inverted using a SVD decomposition. In fact the - * pseudoinverse is returned. - * - * @code - * Matrix2D< double > m1_inv; - * m1.inv(m1_inv); - * @endcode - */ - void inv(Matrix2D& result) const; - - /** Inverse of a matrix - * - * The matrix is inverted using a AlgLib. - * Set LU to use LU decomposition - * - * @code - * Matrix2D< double > m1_inv; - * m1.inv(m1_inv); - * @endcode - */ - void invAlgLib(Matrix2D& result, bool use_lu=false) const; - - /** Perform SVD decomposition - * *this = U * W * V^t - * */ - - void svd(Matrix2D &U, Matrix1D &W, Matrix2D &V) const - { - svdcmp(*this, U, W, V); - } - - /** Perform SVD decomposition and add an index vector - * with the descending order of singular values - */ - void eigs(Matrix2D &U, Matrix1D &W, Matrix2D &V, Matrix1D &indexes) const; - - /** Inverse of a matrix - */ - Matrix2D inv() const - { - Matrix2D result; - inv(result); - - return result; - } - - /** Inverse the current matrix - */ - void selfInverse() - { - Matrix2D auxMatrix(*this); - auxMatrix.inv(*this); - } - - /** True if the matrix is identity - * - * @code - * if (m.isIdentity()) - * std::cout << "The matrix is identity\n"; - * @endcode - */ - bool isIdentity() const; - //@} -}; - -typedef Matrix2D DMatrix; -typedef Matrix2D IMatrix; - -template -bool operator==(const Matrix2D& op1, const Matrix2D& op2) -{ - return op1.equal(op2); -} - -/**@name Matrix Related functions - * These functions are not methods of Matrix2D - */ -//@{ -/** LU Decomposition - */ -template -void ludcmp(const Matrix2D& A, Matrix2D& LU, Matrix1D< int >& indx, T& d); - - -/** LU Backsubstitution - */ -template -void lubksb(const Matrix2D& LU, Matrix1D< int >& indx, Matrix1D& b); - -/** SVD Backsubstitution - */ -void svbksb(Matrix2D< double >& u, - Matrix1D< double >& w, - Matrix2D< double >& v, - Matrix1D< double >& b, - Matrix1D< double >& x); - -//#define VIA_NR -#define VIA_BILIB -/** SVD Decomposition - */ -template -void svdcmp(const Matrix2D< T >& a, - Matrix2D< double >& u, - Matrix1D< double >& w, - Matrix2D< double >& v); - -/** Generalized eigenvector decomposition. - * Solves the problem Av=dBv. - * The decomposition is such that A=B P D P^-1. A and B must be square matrices of the same size. - */ -void generalizedEigs(const Matrix2D &A, const Matrix2D &B, Matrix1D &D, Matrix2D &P); - -/** First eigenvectors of a real, symmetric matrix. - * Solves the problem Av=dv. - * Only the eigenvectors of the largest M eigenvalues are returned as columns of P - */ -void firstEigs(const Matrix2D &A, size_t M, Matrix1D &D, Matrix2D &P, bool Pneeded=true); - -/** Last eigenvectors of a real, symmetric matrix. - * Solves the problem Av=dv. - * Only the eigenvectors of the smallest M eigenvalues are returned as columns of P - */ -void lastEigs(const Matrix2D &A, size_t M, Matrix1D &D, Matrix2D &P); - -/** Compute eigenvectors between two indexes of a real, symmetric matrix. - * Solves the problem Av=dv. - * Only the eigenvectors of the smallest eigenvalues between indexes I1 and I2 are returned as columns of P. Indexes start at 0. - */ -void eigsBetween(const Matrix2D &A, size_t I1, size_t I2, Matrix1D &D, Matrix2D &P); - -/** Compute all eigenvalues, even if they are complex */ -void allEigs(const Matrix2D &A, std::vector< std::complex > &eigs); - -/** Find connected components of a graph. - * Assuming that the matrix G represents an undirected graph (of size NxN), this function returns a vector (of size N) that indicates - * for each element which is the number of its connected component. - */ -void connectedComponentsOfUndirectedGraph(const Matrix2D &G, Matrix1D &component); - -/** Conversion from one type to another. - * - * If we have an integer array and we need a double one, we can use this - * function. The conversion is done through a type casting of each element - * If n >= 0, only the nth volumes will be converted, otherwise all NSIZE volumes - */ -template -void typeCast(const Matrix2D& v1, Matrix2D& v2) -{ - if (v1.mdim == 0) - { - v2.clear(); - return; - } - - if (v1.mdimx!=v2.mdimx || v1.mdimy!=v2.mdimy) - v2.resizeNoCopy(v1); - for (unsigned long int n = 0; n < v1.mdim; n++) - v2.mdata[n] = static_cast< T2 > (v1.mdata[n]); -} - -/** Conversion from one type to another. - * In some cases, the two types are the same. So a faster way is simply by assignment. - */ -template -void typeCast(const Matrix2D& v1, Matrix2D& v2) -{ - v2=v1; -} - -/** Gram Schmidt orthogonalization by columns */ -void orthogonalizeColumnsGramSchmidt(Matrix2D &M); - -/** Normalize columns. - * So that they have zero mean and unit variance. - */ -void normalizeColumns(Matrix2D &A); - -/** Normalize columns. - * So that the minimum is 0 and the maximum is 1 - */ -void normalizeColumnsBetween0and1(Matrix2D &A); - -/** Subtract mean of columns. - * So that they have zero mean. - */ -void subtractColumnMeans(Matrix2D &A); - -/** Matrix operation: B=A^t*A. */ -void matrixOperation_AtA(const Matrix2D &A, Matrix2D &B); - -/** Matrix operation: C=A*A^t. */ -void matrixOperation_AAt(const Matrix2D &A, Matrix2D &C); - -/** Matrix operation: C=A*B. */ -void matrixOperation_AB(const Matrix2D &A, const Matrix2D &B, Matrix2D &C); - -/** Matrix operation: y=A*x. */ -void matrixOperation_Ax(const Matrix2D &A, const Matrix1D &x, Matrix1D &y); - -/** Matrix operation: C=A*B^t. */ -void matrixOperation_ABt(const Matrix2D &A, const Matrix2D &B, Matrix2D &C); - -/** Matrix operation: C=A^t*B. */ -void matrixOperation_AtB(const Matrix2D &A, const Matrix2D &B, Matrix2D &C); - -/** Matrix operation: y=A^t*x. */ -void matrixOperation_Atx(const Matrix2D &A, const Matrix1D &x, Matrix1D &y); - -/** Matrix operation: C=A^t*Bt. */ -void matrixOperation_AtBt(const Matrix2D &A, const Matrix2D &B, Matrix2D &C); - -/** Matrix operation: B=X^t*A*X. - * We know that the result B must be symmetric */ -void matrixOperation_XtAX_symmetric(const Matrix2D &X, const Matrix2D &A, Matrix2D &B); - -/** Matrix operation: A=I+A */ -void matrixOperation_IplusA(Matrix2D &A); - -/** Matrix operation: A=I-A */ -void matrixOperation_IminusA(Matrix2D &A); - -/** Erase first column */ -void eraseFirstColumn(Matrix2D &A); - -/** Keep columns between j0 and jF */ -void keepColumns(Matrix2D &A, int j0, int jF); - -//@} -//@} - -#endif /* MATRIX2D_H_ */ diff --git a/src/core/metadata_base.cpp b/src/core/metadata_base.cpp deleted file mode 100644 index f5c7539..0000000 --- a/src/core/metadata_base.cpp +++ /dev/null @@ -1,657 +0,0 @@ -/*************************************************************************** - * - * Authors: Jan Horacek (xhorace4@fi.muni.cz) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include -#include -#include "metadata_base.h" -#include "xmipp_image.h" - -#include -#include -#ifdef XMIPP_MMAP -#include -#endif -#include "metadata_db.h" -#include "xmipp_funcs.h" - -// Get the blocks available -void getBlocksInMetaDataFile(const FileName &inFile, StringVector& blockList) -{ - if (!inFile.isMetaData()) - return; - if (inFile.getBlockName() != "") - return; - blockList.clear(); - String extFile = inFile.getExtension(); - - if (extFile == "xml") { - REPORT_ERROR(ERR_NOT_IMPLEMENTED, "getBlocksInMetaDataFile"); - } else if(extFile == "sqlite") { - getBlocksInMetaDataFileDB(inFile, blockList); - } else { //map file - int fd; - MetaDataDb mdAux; - mdAux.setMaxRows(1); - mdAux.read(inFile); - BUFFER_CREATE(bufferMap); - mapFile(inFile, bufferMap.begin, bufferMap.size, fd); - BUFFER_COPY(bufferMap, buffer); - BLOCK_CREATE(block); - String blockName; - while (mdAux.nextBlock(buffer, block)) { - BLOCK_NAME(block, blockName); - blockList.emplace_back(blockName); - } - - unmapFile(bufferMap.begin, bufferMap.size, fd); - } -} - -// Does the blocks exist -bool existsBlockInMetaDataFile(const FileName &inFileWithBlock) { - return existsBlockInMetaDataFile(inFileWithBlock.removeBlockName(), - inFileWithBlock.getBlockName()); -} - -bool existsBlockInMetaDataFile(const FileName &inFile, const String& inBlock) { - if (!inFile.isMetaData()) - return false; - if (!inFile.getBlockName().empty()) - return inBlock == inFile.getBlockName(); - - MetaDataDb MDaux(inFile); - //map file - int fd; - BUFFER_CREATE(bufferMap); - mapFile(inFile, bufferMap.begin, bufferMap.size, fd); - BUFFER_COPY(bufferMap, buffer); - BLOCK_CREATE(block); - String blockName; - bool result = false; - while (MDaux.nextBlock(buffer, block)) { - BLOCK_NAME(block, blockName); - if (inBlock == blockName) { - result = true; - break; - } - } - - unmapFile(bufferMap.begin, bufferMap.size, fd); - return result; -} - -MetaData::~MetaData() {} - -bool MetaData::setValueFromStr(const MDLabel label, const String &value, size_t id) { - addLabel(label); - MDObject mdValue(label); - mdValue.fromString(value); - this->setValue(mdValue, id); - return true; -} - -bool MetaData::getStrFromValue(const MDLabel label, String &strOut, size_t id) const { - MDObject mdValueOut(label); - if (!getValue(mdValueOut, id)) - return false; - strOut = mdValueOut.toString(); - return true; -} - -void MetaData::removeDisabled() { - if (containsLabel(MDL_ENABLED)) - removeObjects(MDValueLE(MDL_ENABLED, 0)); // Remove values -1 and 0 on MDL_ENABLED label -} - -WriteModeMetaData metadataModeConvert(String mode) { - toLower(mode); - if (mode.npos != mode.find("overwrite")) - return MD_OVERWRITE; - if (mode.npos != mode.find("append")) - return MD_APPEND; - REPORT_ERROR(ERR_ARG_INCORRECT,"metadataModeConvert: Invalid mode: "+mode); -} - -bool vectorContainsLabel(const std::vector& labelsVector, const MDLabel label) { - std::vector::const_iterator location; - location = std::find(labelsVector.begin(), labelsVector.end(), label); - return (location != labelsVector.end()); -} - -void MetaData::keepLabels(const std::vector &labels) { - auto active = this->getActiveLabels(); - for (const auto &l : active) { - if (!vectorContainsLabel(labels, l)) { - this->removeLabel(l); - } - } -} - -void MetaData::clear() { - _comment.clear(); - _fastStringSearch.clear(); - _fastStringSearchLabel = MDL_UNDEFINED; - - _isColumnFormat = true; - _inFile = FileName(); - _precision = 1000; - _parsedLines = 0; -} - -void MetaData::copyInfo(const MetaData& md) { - _comment = md._comment; - _fastStringSearch = md._fastStringSearch; - _fastStringSearchLabel = md._fastStringSearchLabel; - - _isColumnFormat = md._isColumnFormat; - _inFile = md._inFile; -} - -double MetaData::precision() const { - return 1./this->_precision; -} - -bool MetaData::nextBlock(mdBuffer &buffer, mdBlock &block) { - BLOCK_INIT(block); - if (buffer.size == 0) - return false; - // Search for data_ after a newline - block.begin = BUFFER_FIND(buffer, "data_", 5); - - if (block.begin) // data_ FOUND!!! - { - block.begin += 5; //Shift data_ - size_t n = block.begin - buffer.begin; - BUFFER_MOVE(buffer, n); - //Search for the end of line - char *newLine = BUFFER_FIND(buffer, "\n", 1); - //Calculate length of block name, counting after data_ - block.nameSize = newLine - buffer.begin; - //Search for next block if exists one - //use assign and check if not NULL at same time - if (!(block.end = BUFFER_FIND(buffer, "\ndata_", 6))) { - block.end = block.begin + buffer.size; } - else { - block.end += 1; // to include terminal \n - } - block.loop = BUFFER_FIND(buffer, "\nloop_", 6); - //If loop_ is not found or is found outside block - //scope, the block is in column format - if (block.loop) - { - if (block.loop < block.end) - block.loop += 6; // Shift \nloop_ - else - block.loop = NULL; - } - //Move buffer to end of block - n = block.end - buffer.begin; - BUFFER_MOVE(buffer, n); - return true; - } - - return false; -} - -/* This function will read the possible columns from the file - * and mark as MDL_UNDEFINED those who aren't valid labels - * or those who appears in the IgnoreLabels vector - * also set the activeLabels (for OLD doc files) - */ -void MetaData::_readColumns(std::istream& is, std::vector & columnValues, - const std::vector* desiredLabels) { - String token; - MDLabel label; - - while (is >> token) - if (token.find('(') == String::npos) - { - //label is not recognized, the MDValue will be created - //with MDL_UNDEFINED, which will be ignored while reading data - label = MDL::str2Label(token); - - // Try to read undefined labels as String using the buffer approach - if (label == MDL_UNDEFINED) - label = MDL::getNewAlias(token); - - if (desiredLabels != NULL && !vectorContainsLabel(*desiredLabels, label)) - label = MDL_UNDEFINED; //ignore if not present in desiredLabels - columnValues.emplace_back(new MDObject(label)); - if (label != MDL_UNDEFINED) - addLabel(label); - - } -} - -/* This function will read the possible columns from the file - * and mark as MDL_UNDEFINED those who aren't valid labels - * or those who appears in the IgnoreLabels vector - * also set the activeLabels (for new STAR files) - */ -void MetaData::_readColumnsStar(mdBlock &block, - std::vector & columnValues, - const std::vector* desiredLabels, - bool addColumns, - size_t id) { - char * end = block.end; - char * newline = NULL; - bool found_column; - MDLabel label; - char * iter = block.loop; - if (!_isColumnFormat) - { - iter = block.begin; - iter = END_OF_LINE() + 1; //this should point at first label, after data_XXX - } - - do - { - found_column = false; - while (iter[0] == '#') //Skip comment - iter = END_OF_LINE() + 1; - - //trim spaces and newlines at the beginning - while ( isspace(iter[0])) - ++iter; - - if (iter < end && iter[0] == '_') - { - found_column = true; - ++iter; //shift _ - std::stringstream ss; - newline = END_OF_LINE(); - //Last label and no data needs this check - if (newline == NULL) - newline = end; - String s(iter, newline - iter);//get current line - ss.str(s);//set the string of the stream - //Take the first token which is the label - //if the label contain spaces will fail - ss >> s; //get the first token, the label - label = MDL::str2Label(s); - if (label == MDL_UNDEFINED) - label = MDL::getNewAlias(s); - if (desiredLabels != NULL && !vectorContainsLabel(*desiredLabels, label)) - label = MDL_UNDEFINED; //ignore if not present in desiredLabels - - if (label != MDL_UNDEFINED) - addLabel(label); - - if (addColumns) - { - MDObject * _mdObject = new MDObject(label); - columnValues.emplace_back(_mdObject);//add the value here with a char - if(!_isColumnFormat) - _parseObject(ss, *_mdObject, id); - } - iter = newline + 1;//go to next line character - } - } - while (found_column) - ; - - // This condition fails for empty blocks - // if (iter < block.end) - if (iter <= block.end +1) - block.loop = iter; //Move loop pointer to position of last found column -} - -/* Helper function to parse an MDObject and set its value. - * The parsing will be from an input stream(istream) - * and if parsing fails, an error will be raised - */ -void MetaData::_parseObject(std::istream &is, MDObject &object, size_t id) { - object.fromStream(is); - if (is.fail()) { - String errorMsg = formatString("MetaData: Error parsing column '%s' value.", MDL::label2Str(object.label).c_str()); - object.failed = true; - std::cerr << "WARNING: " << errorMsg << std::endl; - //REPORT_ERROR(ERR_MD_BADLABEL, (String)"read: Error parsing data column, expecting " + MDL::label2Str(object.label)); - } else { - if (object.label != MDL_UNDEFINED) - setValue(object, id); - } -} - -/* This function parses rows data in START format - */ -void MetaData::_readRowsStar(mdBlock &block, std::vector & columnValues, - const std::vector *desiredLabels) { - String line; - std::stringstream ss; - size_t n = block.end - block.loop; - bool firstTime = true; - - if (n == 0) - return; - - char * buffer = new char[n]; - memcpy(buffer, block.loop, n); - char *iter = buffer, *end = iter + n, * newline = NULL; - _parsedLines = 0; //Check how many lines the md have - - while (iter < end) { //while there are data lines - //Adding \n position and check if NULL at the same time - if (!(newline = END_OF_LINE())) - newline = end; - line.assign(iter, newline - iter); - trim(line); - - if (!line.empty() && line[0] != '#') { - //_maxRows would be > 0 if we only want to read some - // rows from the md for performance reasons... - // anyway the number of lines will be counted in _parsedLines - if (_maxRows == 0 || _parsedLines < _maxRows) { - std::stringstream ss(line); - this->_parseObjects(ss, columnValues, desiredLabels, firstTime); - firstTime = false; - } - _parsedLines++; - } - iter = newline + 1; //go to next line - } - - delete[] buffer; -} - -void MetaData::_readRows(std::istream& is, std::vector& columnValues, bool useCommentAsImage) { - String line = ""; - while (!is.eof() && !is.fail()) { - // Move until the ';' or the first alphanumeric character - while (is.peek() != ';' && isspace(is.peek()) && !is.eof()) - is.ignore(1); - if (!is.eof()) { - if (is.peek() == ';') { //is a comment - is.ignore(1); //ignore the ';' - getline(is, line); - trim(line); - } else if (!isspace(is.peek())) { - size_t id = addObject(); - if (line != "") { //this is for old format files - if (!useCommentAsImage) - this->setValue(MDObject(MDL_STAR_COMMENT, line), id); - else - this->setValue(MDObject(MDL_IMAGE, line), id); - } - int nCol = columnValues.size(); - for (int i = 0; i < nCol; ++i) - this->_parseObject(is, *(columnValues[i]), id); - } - } - } -} - -void MetaData::readStar(const FileName &filename, const std::vector *desiredLabels, - const String &blockRegExp, bool decomposeStack) { - // First try to open the file as a metadata - size_t id; - FileName inFile = filename.removeBlockName(); - - if (!(isMetadataFile = inFile.isMetaData())) { //if not a metadata, try to read as image or stack - Image image; - if (decomposeStack) // If not decomposeStack it is no necessary to read the image header - image.read(filename, HEADER); - if (!decomposeStack || image().ndim == 1) { // single image; !decomposeStack must be first - id = this->addObject(); - MetaData::setValue(MDL_IMAGE, filename, id); - MetaData::setValue(MDL_ENABLED, 1, id); - } else { // stack - FileName fnTemp; - for (size_t i = 1; i <= image().ndim; ++i) { - fnTemp.compose(i, filename); - id = addObject(); - MetaData::setValue(MDL_IMAGE, fnTemp, id); - MetaData::setValue(MDL_ENABLED, 1, id); - } - } - return; - } - - std::ifstream is(inFile.c_str(), std::ios_base::in); - std::stringstream ss; - String line, token,_comment; - std::vector columnValues; - - getline(is, line); //get first line to identify the type of file - - if (is.fail()) - REPORT_ERROR(ERR_IO_NOTEXIST, formatString("MetaDataDb::read: File doesn't exists: %s", inFile.c_str()) ); - - bool useCommentAsImage = false; - this->_inFile = inFile; - bool oldFormat = true; - - is.seekg(0, std::ios::beg);//reset the stream position to the beginning to start parsing - - if (line.find(FileNameVersion) != String::npos || - filename.getExtension() == "xmd" || filename.getExtension() == "star") { - oldFormat = false; - _comment.clear(); - - // Skip comment parsing if we found the data key in the first line - if (line.find("data_") != 0) { - // Read comment - // is.ignore(256,'#');//format line - is.ignore(256, '\n');//skip first line - bool addspace = false; - while (1) { - getline(is, line); - trim(line); - if (line[0] == '#') - { - line[0] = ' '; - trim(line); - if (addspace) - _comment += " " + line; - else - _comment += line; - addspace = true; - } else - break; - } - this->setComment(_comment); - } - - //map file - int fd; - BUFFER_CREATE(bufferMap); - mapFile(inFile, bufferMap.begin, bufferMap.size, fd); - - BLOCK_CREATE(block); - regex_t re; - int rc = regcomp(&re, (blockRegExp+"$").c_str(), REG_EXTENDED|REG_NOSUB); - if (blockRegExp.size() && rc != 0) - REPORT_ERROR(ERR_ARG_INCORRECT, formatString("Pattern '%s' cannot be parsed: %s", - blockRegExp.c_str(), inFile.c_str())); - BUFFER_COPY(bufferMap, buffer); - bool firstBlock = true; - bool singleBlock = blockRegExp.find_first_of(".[*+")==String::npos; - - String blockName; - - while (nextBlock(buffer, block)) { - //startingPoint, remainingSize, firstData, secondData, firstloop)) - BLOCK_NAME(block, blockName); - if (blockRegExp.size() == 0 || regexec(&re, blockName.c_str(), (size_t) 0, NULL, 0) == 0) { - //Read column labels from the datablock that starts at firstData - //Label ends at firstloop - if ((_isColumnFormat = (block.loop != NULL))) { - _readColumnsStar(block, columnValues, desiredLabels, firstBlock); - // If block is empty, makes block.loop and block.end equal - if (block.loop == (block.end + 1)) - block.loop--; - _readRowsStar(block, columnValues, desiredLabels); - } else { - id = this->addObject(); - _parsedLines = 1; - this->_readColumnsStar(block, columnValues, desiredLabels, firstBlock, id); - } - firstBlock = false; - - if (singleBlock) - break; - } - } - - unmapFile(bufferMap.begin, bufferMap.size, fd); - regfree(&re); - if (firstBlock) - REPORT_ERROR(ERR_MD_BADBLOCK, formatString("Block: '%s': %s", - blockRegExp.c_str(), inFile.c_str())); - - } else if (line.find("Headerinfo columns:") != String::npos) { - // This looks like an old DocFile, parse header - std::cerr << "WARNING: ** You are using an old file format (DOCFILE) which is going " - << "to be deprecated in next Xmipp release **" << std::endl; - is.ignore(256, ':'); //ignore all until ':' to start parsing column labels - getline(is, line); - ss.str(line); - columnValues.emplace_back(new MDObject(MDL_UNDEFINED)); - columnValues.emplace_back(new MDObject(MDL_UNDEFINED)); - - this->addLabel(MDL_IMAGE); - this->_readColumns(ss, columnValues, desiredLabels); - useCommentAsImage = true; - - } else { - std::cerr << "WARNING: ** You are using an old file format (SELFILE) which is going " - << "to be deprecated in next Xmipp release **" << std::endl; - // I will assume that is an old SelFile, so only need to add two columns - columnValues.emplace_back(new MDObject(MDL_IMAGE));//addLabel(MDL_IMAGE); - columnValues.emplace_back(new MDObject(MDL_ENABLED));//addLabel(MDL_ENABLED); - } - - if (oldFormat) - this->_readRows(is, columnValues, useCommentAsImage); - - //free memory of column values - int nCols = columnValues.size(); - for (int i = 0; i < nCols; ++i) - delete columnValues[i]; - - is.close(); -} - -void MetaData::writeStar(const FileName &outFile, const String & blockName, WriteModeMetaData mode) const { - // Move to MetaData? -#ifdef XMIPP_MMAP - if (outFile.hasImageExtension()) - REPORT_ERROR(ERR_IO,"MetaData:writeStar Trying to write metadata with image extension"); - - struct stat file_status; - int fd; - char *map = NULL; - char *tailMetadataFile = NULL; // auxiliary variable to keep metadata file tail in memory - size_t size=-1; - char *target, * target2 = NULL; - - //check if file exists or not block name has been given - //in our format no two identical data_xxx strings may exists - if (mode == MD_APPEND) { - if (blockName.empty() || !outFile.exists()) - mode = MD_OVERWRITE; - else { - //does blockname exists? - //remove it from file in this case - // get length of file: - if(stat(outFile.c_str(), &file_status) != 0) - REPORT_ERROR(ERR_IO_NOPATH,"MetaData:writeStar can not get filesize for file "+outFile); - size = file_status.st_size; - if (size == 0) - mode = MD_OVERWRITE; - } - - if (mode == MD_APPEND) { //size=0 for /dev/stderr - fd = open(outFile.c_str(), O_RDWR, S_IREAD | S_IWRITE); - if (fd == -1) - REPORT_ERROR(ERR_IO_NOPATH,"MetaData:writeStar can not read file named "+outFile); - - map = (char *) mmap(0, size, PROT_READ | PROT_WRITE, MAP_SHARED, fd, 0); - if (map == MAP_FAILED) - REPORT_ERROR(ERR_MEM_BADREQUEST,"MetaData:writeStar can not map memory "); - - // Is this a metadata formatted FILE - if(strncmp(map,FileNameVersion.c_str(),FileNameVersion.length()) != 0) { - mode = MD_OVERWRITE; - } else { - //block name - String _szBlockName = formatString("\ndata_%s\n", blockName.c_str()); - size_t blockNameSize = _szBlockName.size(); - - //search for the string - target = (char *) _memmem(map, size, _szBlockName.c_str(), blockNameSize); - - if (target != NULL) - { - target2 = (char *) _memmem(target+1, size - (target - map), "\ndata_", 6); - - if (target2 != NULL) - { - //target block is not the last one, so we need to - //copy file from target2 to auxiliary memory and truncate - tailMetadataFile = (char *) malloc( ((map + size) - target2)); - memmove(tailMetadataFile,target2, (map + size) - target2); - } - if (ftruncate(fd, target - map+1)==-1) //truncate rest of the file - REPORT_ERROR(ERR_UNCLASSIFIED,"Cannot truncate file"); - } - } - close(fd); - - if (munmap(map, size) == -1) - REPORT_ERROR(ERR_MEM_NOTDEALLOC, "MetaData:writeStar, Can not unmap memory"); - } - } - - std::ios_base::openmode openMode = (mode == MD_OVERWRITE) ? std::ios_base::out : std::ios_base::app; - std::ofstream ofs(outFile.c_str(), openMode); - - write(ofs, blockName, mode); - - if (tailMetadataFile != NULL) { - //append memory buffer to file - //may a cat a buffer to a ofstream - ofs.write(tailMetadataFile,(map + size) - target2); - free(tailMetadataFile); - } - ofs.close(); - -#else - - REPORT_ERROR(ERR_MMAP,"Mapping not supported in Windows"); -#endif -} - -void MetaData::append(const FileName &outFile) const -{ - if (outFile.exists()) - { - std::ofstream ofs(outFile.c_str(), std::ios_base::app); - _writeRows(ofs); - ofs.close(); - } - else - write(outFile); -} diff --git a/src/core/metadata_base.h b/src/core/metadata_base.h deleted file mode 100644 index 4243795..0000000 --- a/src/core/metadata_base.h +++ /dev/null @@ -1,811 +0,0 @@ -/*************************************************************************** - * - * Authors: J.M. de la Rosa Trevin (jmdelarosa@cnb.csic.es) - * Jan Horacek (xhorace4@fi.muni.cz) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -/** - * This file defines abstract class MetaData which defines an API for all - * MetaData implementations. - */ - -#ifndef CORE_METADATA_H -#define CORE_METADATA_H - -#include -#include -#include -#include -#include - -#include "xmipp_error.h" -#include "xmipp_filename.h" -#include "metadata_label.h" -#include "metadata_writemode.h" -#include "metadata_base_it.h" -#include "metadata_static.h" -#include "metadata_query.h" -#include "choose.h" - -/** @defgroup MetaData Metadata Stuff - * @ingroup DataLibrary - * @{ - */ - -#define BAD_OBJID 0 -#define BAD_INDEX -1 - -#define FILENAME_XMIPP_STAR "# XMIPP_STAR_1" -#define FILENAME_XMIPP_SQLITE "SQLite format 3" -#define DEFAULT_BLOCK_NAME "noname" - -// FIXME: deprecated -// Preffered iterating is on right side of these macros -#define FOR_ALL_OBJECTS_IN_METADATA(__md) for (size_t objId : __md.ids()) - -// FIXME: deprecated -#define FOR_ALL_ROWS_IN_METADATA(__md) for (auto& row : __md) - -#define END_OF_LINE() ((char*) memchr (iter, '\n', end-iter)) - -/** Which are the blocks available in a metadata */ -void getBlocksInMetaDataFile(const FileName &inFile, StringVector& blockList); -bool existsBlockInMetaDataFile(const FileName &inFile, const String& inBlock); -bool existsBlockInMetaDataFile(const FileName &inFileWithBlock); - -class MDValueGenerator; - -/** Struct to hold a char * pointer and a size - * this will be useful for parsing metadata - */ -typedef struct { - char * begin; - size_t size; -} -mdBuffer; - -/// Some macros to use the buffer -#define BUFFER_CREATE(b) mdBuffer b; b.begin = nullptr; b.size = 0 -#define BUFFER_COPY(b1, b2) mdBuffer b2; b2.begin = b1.begin; b2.size = b1.size -#define BUFFER_MOVE(b, n) b.begin += n; b.size -= n -#define BUFFER_FIND(b, str, n) (char*) _memmem(b.begin, b.size, str, n) - -typedef struct { - char * begin; //Position of _dataXXX on buffer - size_t nameSize; //Number of charater of block name, counting after _data - char * end; //Position just before next _dataXXX or end of buffer - char * loop; //Position of _loop if exists, NULL otherwise -} -mdBlock; -/// Some macros to use the block pointers -#define BLOCK_CREATE(b) mdBlock b; b.begin = b.end = b.loop = nullptr; b.nameSize = 0 -#define BLOCK_INIT(b) b.begin = b.end = b.loop = nullptr; b.nameSize = 0 -#define BLOCK_NAME(b, s) s.assign(b.begin, b.nameSize) - -class ObjectDoesNotExist: public std::logic_error { -public: - ObjectDoesNotExist(MDLabel label, size_t id) : std::logic_error("Label '" + MDL::label2Str(label) + " does not exist for id " + std::to_string(id)) {}; - ObjectDoesNotExist(size_t id, const FileName &fn) : std::logic_error("Row with id " + std::to_string(id) + " does not exist" + (fn.isEmpty() ? "" : " in " + fn)) {}; -}; - -class NotImplemented : public std::logic_error { -public: - NotImplemented(const std::string& str) : std::logic_error(str) {}; -}; - -class ColumnDoesNotExist : public std::logic_error { -public: - ColumnDoesNotExist(MDLabel label, const FileName &fn) : std::logic_error("Column '" + MDL::label2Str(label) + " does not exist" + (fn.isEmpty() ? "" : " in " + fn)) {}; - ColumnDoesNotExist(const std::string &msg) : std::logic_error(msg) {}; -}; - - -/** - * Definition of API of all MetaDatas. - * - * ### General information about metadata - * - * MetaData* class(es) implement a way to store metadata in xmipp programs. - * - MetaData is represented as as a database-like table. - * - Each intersection of row and column contains MDObject instance. - * - Each row has its label MDLabel. - * - Columns of all rows are same. - * - Metadata could be loaded from file, stored to file, iterated over, rows - * can be added, removed, changed etc. - * - * There was a single original database (MetaDataDb) implementation of MetaData - * till 2021, when MetaData were split into MetaDataDb & MetaDataVec - * with aim to achive higner speeds via saving metadata in std::vectors instead - * of sql database. - * - * Current MetaData implementation: - * 1. metadata_base.(h|cpp): common MetaData API definition - * 2. metadata_vec.(h|cpp): vector MetaData implementation - * 3. metadata_db.(h|cpp): old datababse MetaData implementation - * - * ### MetaDataBase - * - * MetaData class cannot be instantiated however it could be passed to functions - * as reference or pointer where only common MetaData functions are required: - * - `void foo(MetaData&);` - * - `void boo(MetaData*);` - * - * This code doesn't compile: - * `void roo(MetaData& md) { md.someDbSpeficicOperation(); }` - * - * This code compiles: - * `void roo(MetaDataDb& md) { md.someDbSpeficicOperation(); }` - * - * ### Iterating over MetaData - * - * You can iterate directly over abstract MetaData as well as over specific MetaData*. - * You can iterate over: - * 1. Ids of rows (arbitrary size_t): `for (size_t id : md.ids())` - * 2. Rows: `for (const MDRow& row : md)` - * - * ### Useful information - * - * - See metadata.h file for general info about Metadata. - * - Never rely on any properties of IDs! That is, do NOT assume that IDs are - * e.g. continuous or that they are ascending. - * - There is a hierarchy of MDRow classes copying MetaData hierarchy: MDRow, MDRowVec, MDRowSql. - * If you need row-specific function, do a dynamic cast: - * `for (const MDRow& row : md) { const MDRowVec& rowv = dynamic_cast(row); }` - * You need to make sure type of md is MetaDataVec (otherwise exception is thrown). - */ -class MetaData { -private: - bool _isColumnFormat; // Format for the file, column or row formatted -protected: - /* Allows a fast search for pairs where the value is - * a string, i.e. looking for filenames which is quite usual. - */ - std::map _fastStringSearch; - MDLabel _fastStringSearchLabel; - String _comment; ///< A general comment for the MetaData file - ///comment is wraped in char_max length lines -#define line_max 70 - - - int _precision = 1000; - - /**Input file name - * Where does this MetaData come from/go to be stored? - */ - FileName _inFile; - - /** This two variables will be used to read the metadata information (labels and size) - * or maybe a few rows only - */ - size_t _maxRows = 0, _parsedLines = 0; - - void copyInfo(const MetaData& md); - double precision() const; - - virtual void readStar(const FileName &filename, const std::vector *desiredLabels, - const String &blockRegExp, bool decomposeStack); - - virtual void _readColumns(std::istream& is, std::vector & columnValues, - const std::vector* desiredLabels = nullptr); - - virtual void _readColumnsStar(mdBlock &block, - std::vector & columnValues, - const std::vector* desiredLabels, - bool addColumns = true, - size_t id = BAD_OBJID); - - /* Helper function to parse an MDObject and set its value. - * The parsing will be from an input stream(istream) - * and if parsing fails, an error will be raised - */ - virtual void _parseObject(std::istream &is, MDObject &object, size_t id = BAD_OBJID); - - virtual void _parseObjects(std::istream &is, std::vector & columnValues, - const std::vector *desiredLabels, bool firstTime) = 0; - - /* This function will be used to parse the rows data - * having read the columns labels before and setting which are desired - * the useCommentAsImage is for compatibility with old DocFile format - * where the image were in comments - */ - virtual void _readRows(std::istream& is, std::vector& columnValues, bool useCommentAsImage); - - /** This function will be used to parse the rows data in START format - * @param[out] columnValues MDRow with values to fill in - * @param pchStart pointer to the position of '_loop' in memory - * @param pEnd pointer to the position of the next '_data' in memory - * @param maxRows if this number if greater than 0, only this number of rows will be parsed. - */ - virtual void _readRowsStar(mdBlock &block, std::vector & columnValues, - const std::vector *desiredLabels); - -public: - /** Filename used in the read command, useful to write Error messages - * - */ - bool isMetadataFile; - - /** @name Constructors - * @{ - */ - - /** Empty Constructor. - * - * The MetaData is created with no data stored on it. You can fill in it programmatically - * or by a later reading from a MetaData file or old Xmipp formatted type. - * if labels vectors is passed this labels are created on metadata - */ - MetaData() = default; - virtual ~MetaData(); - - /**Clear all data - */ - virtual void clear(); - /** @} */ - - /** @name Getters and setters - * @{ - */ - - /**Return true if the metadata is in column format. - */ - virtual bool isColumnFormat() const { return _isColumnFormat; } - - /** Prevent from parsing all rows from the metadata. - * When reading from file, only maxRows will be read. - */ - virtual void setMaxRows(size_t maxRows=0) { _maxRows = maxRows; } - - /** Return the number of lines in the metadata file. - * Serves to know the number of items even is read with - * maxRows != 0 - */ - virtual size_t getParsedLines() { return _parsedLines; } - - /**Set precision (number of decimal digits) use by operator == when comparing - * metadatas with double data. "2" is a good value for angles - */ - virtual void setPrecission(int _precision) { this->_precision = (int)pow (10,_precision); } - - /** Set to false for row format (parameter files). - * set to true for column format (this is the default) (docfiles) - */ - virtual void setColumnFormat(bool column) { _isColumnFormat = column; } - - /** Export medatada to xml file. - * - */ - virtual void writeXML(const FileName fn, const FileName blockname, WriteModeMetaData mode) const = 0; - - /** Write metadata in text file as plain data without header. - * - */ - virtual void writeText(const FileName fn, const std::vector* desiredLabels) const = 0; - - virtual void writeStar(const FileName &outFile, const String & blockName, WriteModeMetaData mode) const; - - /**Get Header Comment. - * the comment will appear in second line. - */ - virtual String getComment() const { return this->_comment; } - - /**Set Header Comment. - * the comment will appear in second line - */ - virtual void setComment(const String &newComment = "No comment") { this->_comment = newComment; } - - /**Get metadata filename. - */ - virtual FileName getFilename() const { return this->_inFile; } - - /**Set metadata filename. - */ - virtual void setFilename(const FileName &_filename) { this->_inFile = _filename; } - - /**Get safe access to active labels. - */ - virtual std::vector getActiveLabels() const = 0; - - /**Get maximum string length of column values. - */ - virtual int getMaxStringLength(const MDLabel thisLabel) const = 0; - - /** @} */ - - /** @name MetaData Manipulation - * @{ - */ - - /** Set the value of all objects in an specified column (both value and column are specified in mdValueIn) - */ - virtual bool setValueCol(const MDObject &mdValueIn) = 0; - - /**Set the value of all objects in an specified column. - * @code - * MetaData md; - * md.setValueCol(MDL_IMAGE, "images/image00011.xmp"); - * @endcode - */ - template - bool setValueCol(const MDLabel label, const T &valueIn) { - return setValueCol(MDObject(label, valueIn)); - } - - /** Set the value for some label. - * to the object that has id 'objectId' - * or to 'activeObject' if is objectId=-1. - * This is one of the most used functions to programatically - * fill a metadata. - * @code - * MetaData md; - * size_t id = md.addObject(); - * md.setValue(MDL_IMAGE, "images/image00011.xmp",id); - * md.setValue(MDL_ANGLE_ROT, 0.,id); - * @endcode - */ - template - bool setValue(const MDLabel label, const T &valueIn, size_t id) { - return setValue(MDObject(label, valueIn), id); - } - - virtual size_t addRow(const MDRow &row) = 0; - - MetaData& operator=(const MetaData &md) { - if (&md == this) { - return *this; - } - this->clear(); - this->copyInfo(md); - for (const auto& row : md) - this->addRow(row); - return *this; - }; - - /** This functions are using MDObject for set real values - * there is an explicit function signature - * foreach type supported in Metadata. - * This is done for some type checking of Metadata labels - * and values - */ - virtual bool setValue(const MDObject &mdValueIn, size_t id) = 0; - virtual bool getValue(MDObject &mdValueOut, size_t id) const = 0; - // FIXME: deprecated; this function should return MDObject, it is const-unsafe - - /** Get the value of some label. - * from the object that has id 'objectId' - * or from 'activeObject' if objectId=-1. - * @code - * MetaData md; - * md.read("images.xmd"); - * FileName imageFn; * - * FOR_ALL_OBJECTS_IN_METADATA(md) - * { - * md.getValue(MDL_IMAGE, imageFn); - * std::out << "Image: " << imageFn); - * } - * @endcode - */ - template - T getValue(const MDLabel label, size_t id) const { - MDObject mdValueOut(label); - if (!getValue(mdValueOut, id)) - throw ObjectDoesNotExist(label, id); - return mdValueOut.getValue2(T()); - } - - template - bool getValue(const MDLabel label, T &valueOut, size_t id) const { - MDObject mdValueOut(label); - if (!getValue(mdValueOut, id)) - return false; - valueOut = mdValueOut.getValue2(T()); - return true; - } - - template - const T& getValueOrAbort(const MDLabel label, size_t id) const { - return getValue(label, id); - } - - template - T& getValueOrAbort(const MDLabel label, size_t id) { - return getValue(label, id); - } - - template - void getValueOrAbort(const MDLabel label, T &valueOut, size_t id) const { // FIXME: deprecated - if (!getValue(label, valueOut,id)) - REPORT_ERROR(ERR_ARG_MISSING,(String)"Cannot find label: " + MDL::label2Str(label)); - } - - template - const T getValueOrDefault(const MDLabel label, size_t id, const T &_default) const { - MDObject mdValueOut(label); - if (!getValue(mdValueOut, id)) - return _default; - return mdValueOut.getValue2(T()); - } - - template - T getValueOrDefault(const MDLabel label, size_t id, T &_default) { - MDObject mdValueOut(label); - if (!getValue(mdValueOut, id)) - return _default; - return mdValueOut.getValue2(T()); - } - - template - void getValueOrDefault(const MDLabel label, T &valueOut, size_t id, const T1 &_default) const { // FIXME: deprecated - if (!getValue(label, valueOut,id)) - valueOut = (T) _default; - } - - /** Get all values of a column as a vector. - */ - template - std::vector getColumnValues(const MDLabel label) const { - std::vector result; - MDObject mdValueOut(label); - std::vector objectsId; - findObjects(objectsId); - size_t n = objectsId.size(); - result.reserve(n); - for (size_t i = 0; i < n; ++i) { - if (!getValue(mdValueOut, objectsId[i])) - throw std::logic_error("Column does not exist!"); - result.emplace_back(mdValueOut.getValue2(T())); - } - return result; - } - - // FIXME: deprecated - template - void getColumnValues(const MDLabel label, std::vector& out) const { - out = this->getColumnValues(label); - } - - // FIXME: add proper return value - virtual bool getRowValues(size_t id, std::vector &values) const = 0; - - /** Get all values of a column as a vector. - */ - // FIXME: add proper return value - virtual void getColumnValues(const MDLabel label, std::vector &valuesOut) const = 0; - - /** Set all values of a column as a vector. - * The input vector must have the same size as the Metadata. - */ - template - void setColumnValues(const MDLabel label, const std::vector &valuesIn) { - if (valuesIn.size() != size()) - REPORT_ERROR(ERR_MD_OBJECTNUMBER, "Input vector must be of the same size as the metadata"); - size_t n = 0; - for (size_t objId : this->ids()) - this->setValue(label, valuesIn[n++], objId); - } - - virtual void setColumnValues(const std::vector &valuesIn) = 0; - - virtual std::unique_ptr getRow(size_t id) = 0; - virtual std::unique_ptr getRow(size_t id) const = 0; - - /** Set label values from string representation. - */ - virtual bool setValueFromStr(const MDLabel label, const String &value, size_t id); - - /** Get string representation from label value. - */ - virtual bool getStrFromValue(const MDLabel label, String &strOut, size_t id) const; - - /**Check whether the metadata is empty. - */ - virtual bool isEmpty() const { return size() == 0; } - - /**Number of objects contained in the metadata. - */ - virtual size_t size() const = 0; - - /** Check whether a label is contained in metadata. - */ - virtual bool containsLabel(const MDLabel label) const = 0; - - /** Add a new label to the metadata. - * By default the label is added at the end, - * if the position is specified and is between 0 and n-1 - * the new label is inserted at that position. - */ - virtual bool addLabel(const MDLabel label, int pos = -1) = 0; - - /** Remove a label from the metadata. - * The data is still in the table. If you want to remove the data, - * make a copy of the MetaData. - */ - virtual bool removeLabel(const MDLabel label) = 0; - - /** Remove all the labels from the metadata but the - * ones given in labels vector. - */ - void keepLabels(const std::vector &labels); - - /** Adds a new, empty object to the objects map. If objectId == -1 - * the new ID will be that for the last object inserted + 1, else - * the given objectId is used. If there is already an object whose - * objectId == input objectId, just removes it and creates an empty - * one - */ - virtual size_t addObject() = 0; - - /** Import objects from another metadata. - * @code - * //Import object 1000 from metadata B into metadata A - * A.importObject(B, 1000); - * //Import all objects with rotational angle greater that 60 - * A.importObjects(B, MDValuesGT(MDL_ANGLE_ROT, 60)); - * //Import all objects - * A.importObjects(B); - * @endcode - */ - virtual void importObject(const MetaData &md, const size_t id, bool doClear=true) = 0; - virtual void importObjects(const MetaData &md, const std::vector &objectsToAdd, bool doClear=true) = 0; - virtual void importObjects(const MetaData &md, const MDQuery &query, bool doClear=true) = 0; - - /** Remove the object with this id. - * Returns true if the object was removed or false if - * the object did not exist - */ - virtual bool removeObject(size_t id) = 0; - - /** Removes the collection of objects of given vector id's - * NOTE: The iterator will point to the first object after any of these - * operations - */ - virtual void removeObjects(const std::vector &toRemove) = 0; - - /** Removes objects from metadata. - * return the number of deleted rows - * if not query, all objectes are removed - * Queries can be used in the same way - * as in the importObjects function - */ - virtual int removeObjects(const MDQuery&) = 0; - virtual int removeObjects() = 0; - - /** @} */ - - /** @name Iteration functions - * @{ - */ - - /** Return the object id of the first element in metadata. */ - virtual size_t firstRowId() const = 0; - virtual size_t firstObject(const MDQuery&) const = 0; - - /** Goto last metadata object.*/ - virtual size_t lastRowId() const = 0; - - /** @name Search operations - * @{ - */ - - /** Find all objects that match a query. - * if called without query, all objects are returned - * if limit is provided only return a maximun of 'limit' - */ - virtual void findObjects(std::vector &objectsOut, const MDQuery &query) const = 0; - virtual void findObjects(std::vector &objectsOut, int limit = -1) const = 0; - - virtual size_t countObjects(const MDQuery&) const = 0; - virtual bool containsObject(size_t objectId) const = 0; - virtual bool containsObject(const MDQuery&) const = 0; - - /** @} */ - - /** @name I/O functions - * @{ - */ - - virtual void _writeRows(std::ostream &os) const = 0; - - virtual void write(const FileName &outFile, WriteModeMetaData mode=MD_OVERWRITE) const = 0; - virtual void write(std::ostream &os, const String & blockName="",WriteModeMetaData mode=MD_OVERWRITE) const = 0; - virtual void print() const { this->write(std::cout); } - - /** Append data lines to file. - * This function can be used to add new data to - * an existing metadata. Now should be used with - * files with only one metadata, maybe can be extended later. - * For now it will not check any compatibility beetween the - * existent metadata and the new data to append. - */ - void append(const FileName &outFile) const; - - /** Read data from file. Guess the blockname from the filename - * @code - * inFilename="first@md1.doc" -> filename = md1.doc, blockname = first - * @endcode - */ - virtual void read(const FileName &inFile, const std::vector *desiredLabels = nullptr, bool decomposeStack=true) = 0; - /** @} */ - - /** @name Set Operations - * @{ - */ - - /**Remove rows with MDL_ENABLED = -1 if this label is present - */ - virtual void removeDisabled(); - - /** Select random subset */ - virtual void selectRandomSubset(const MetaData &mdIn, size_t numberOfObjects, - const MDLabel sortLabel=MDL_OBJID) = 0; - - /** Select some part from Metadata. - * Select elements from input Metadata - * at some starting position - * if the numberOfObjects is -1, all objects - * will be returned from startPosition to the end. - */ - virtual void selectPart(const MetaData &mdIn, size_t startPosition, size_t numberOfObjects, - const MDLabel sortLabel=MDL_OBJID) = 0; - - /** @} */ - - /** @name Iterators - * @{ - */ - friend struct MDBaseRowIterator; - friend struct MDBaseRowIterator; - - /* To allow iteration over abstract MetaData, there is a hierarchy of iterators. - - MDBaseRowIterator, MDVecRowIterator, MDDbRowIterator - - MDBaseIdIterator, MDVecIdIterator, MDDbIdIterator - * Plus there are rowIterator & idIterator, which are common for all instances - * and just hold unique_ptr to appropriate implementation. - */ - template - struct rowIterator { - private: - std::unique_ptr> impl; - public: - rowIterator(std::unique_ptr> impl) : impl(std::move(impl)) {} - rowIterator(rowIterator const& right) : impl(std::move(right.impl->clone())) {} - rowIterator& operator=(rowIterator const& right) { - impl = std::move(right.impl->clone()); - return *this; - } - rowIterator& operator++() { - impl->increment(); - return *this; - } - bool operator==(const rowIterator& other) const { return *(other.impl) == *(this->impl); } - bool operator!=(const rowIterator& other) const { return !(*this == other); } - typename TypeHelpers::choose::type operator*() const { return **impl; } - }; - - using iterator = rowIterator; - using const_iterator = rowIterator; - - virtual iterator begin() = 0; - virtual iterator end() = 0; - - virtual const_iterator begin() const = 0; - virtual const_iterator end() const = 0; - - - template - struct idIterator { - private: - std::unique_ptr> impl; - public: - idIterator(std::unique_ptr> impl) : impl(std::move(impl)) {} - idIterator(idIterator const& right) : impl(std::move(right.impl->clone())) {} - idIterator& operator=(idIterator const& right) { - impl = std::move(right.impl->clone()); - return *this; - } - idIterator& operator++() { - impl->increment(); - return *this; - } - bool operator==(const idIterator& other) const { return *(other.impl) == *(this->impl); } - bool operator!=(const idIterator& other) const { return !(*this == other); } - size_t operator*() const { return **impl; } - }; - - using id_iterator = idIterator; - using id_const_iterator = idIterator; - - // This proxy allows to implement non-const & const iterator in one templated class. - template - struct IdIteratorProxy { - typename TypeHelpers::choose::type _md; - - IdIteratorProxy(typename TypeHelpers::choose::type md) : _md(md) { } - typename TypeHelpers::choose::type begin() { return _md.id_begin(); }; - typename TypeHelpers::choose::type end() { return _md.id_end(); }; - }; - - virtual id_iterator id_begin() = 0; - virtual id_iterator id_end() = 0; - - virtual id_const_iterator id_begin() const = 0; - virtual id_const_iterator id_end() const = 0; - - virtual IdIteratorProxy ids() { return IdIteratorProxy(*this); }; - virtual IdIteratorProxy ids() const { return IdIteratorProxy(*this); }; - - /** @} */ - - /** Fill column with constant value - */ - virtual void fillConstant(MDLabel label, const String &value) = 0; - - /** Fill column with random value - * mode should be: uniform, gaussian or student - * op1, op2 and op2 are interpreted for each mode: - * uniform: op1 and op2 are the limits of the interval - * gaussian: op1 and op2 are mean and std - * student: same as gaussian and use op3 - */ - virtual void fillRandom(MDLabel label, const String &mode, double op1, double op2, double op3=0.) = 0; - - /** Fill lineal, starting at some value and with some step */ - virtual void fillLinear(MDLabel label, double initial, double step) = 0; - - /** Copy all values from one column to another. - * Source column should exist - */ - virtual void copyColumn(MDLabel labelDest, MDLabel labelSrc) = 0; - - /** Same as previous, but copy to another metadata */ - virtual void copyColumnTo(MetaData& md, MDLabel labelDest, MDLabel labelSrc) = 0; - - /** Rename column. - * - */ - virtual void renameColumn(MDLabel oldLabel, MDLabel newLabel) = 0; - - /** Rename several columns. This is an expensive operations so if several - * columns need to be changed do it using this function instead one by one - */ - virtual void renameColumn(const std::vector &oldLabel, - const std::vector &newLabel) = 0; - - virtual bool nextBlock(mdBuffer &buffer, mdBlock &block); -};//class MetaData - -/** print metadata - * - */ -std::ostream& operator<<(std::ostream& o, const MetaData & mD); - -/** @} */ - -/** Convert string to write mode metadata enum. - * - */ -WriteModeMetaData metadataModeConvert (String mode); - -bool vectorContainsLabel(const std::vector& labelsVector, const MDLabel label); - -#endif diff --git a/src/core/metadata_base_it.h b/src/core/metadata_base_it.h deleted file mode 100644 index 03cd080..0000000 --- a/src/core/metadata_base_it.h +++ /dev/null @@ -1,57 +0,0 @@ -/*************************************************************************** - * - * Authors: Jan Horacek (xhorace4@fi.muni.cz) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -/** Definitions of API of MetaData iterators (abstract classes). */ - -#ifndef IT_BASE_METADATA_H -#define IT_BASE_METADATA_H - -#include -#include "metadata_row_base.h" -#include "choose.h" - -/** Iterates over metadata rows */ -template -struct MDBaseRowIterator { - virtual ~MDBaseRowIterator() {} - virtual std::unique_ptr clone() = 0; - virtual void increment() = 0; - virtual bool operator==(const MDBaseRowIterator& other) const = 0; - virtual bool operator!=(const MDBaseRowIterator& other) const { return !(*this == other); } - virtual typename TypeHelpers::choose::type operator*() = 0; -}; - -/** Iterates over metadata ids */ -template -struct MDBaseIdIterator { - virtual ~MDBaseIdIterator() {} - virtual std::unique_ptr clone() = 0; - virtual void increment() = 0; - virtual bool operator==(const MDBaseIdIterator& other) const = 0; - virtual bool operator!=(const MDBaseIdIterator& other) const { return !(*this == other); } - virtual size_t operator*() = 0; -}; - -#endif diff --git a/src/core/metadata_db.cpp b/src/core/metadata_db.cpp deleted file mode 100644 index 68986d3..0000000 --- a/src/core/metadata_db.cpp +++ /dev/null @@ -1,1730 +0,0 @@ -/************************************************************************** - * - * Authors: J.R. Bilbao-Castro (jrbcast@ace.ual.es) - * Jan Horacek (xhorace4@fi.muni.cz) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include -#include -#include -#include - -#include "metadata_db.h" -#include "xmipp_image.h" -#include "metadata_sql.h" -#include "metadata_generator.h" -#include "xmipp_funcs.h" - - -//-----Constructors and related functions ------------ -void MetaDataDb::_clear(bool onlyData) -{ - if (onlyData) - { - myMDSql->deleteObjects(); - } - else - { - MetaData::clear(); - _activeLabels.clear(); - myMDSql->clearMd(); - } -}//close clear - -void MetaDataDb::clear() -{ - init({}); -} - -void MetaDataDb::init(const std::vector &labelsVector) -{ - _clear(); - _maxRows = 0; //by default read all rows - _parsedLines = 0; //no parsed line; - _activeLabels = labelsVector; - //Create table in database - myMDSql->createMd(); - _precision = 100; - isMetadataFile = false; -}//close init - -void MetaDataDb::copyMetadata(const MetaDataDb &md, bool copyObjects) -{ - if (this == &md) //not sense to copy same metadata - return; - init(md._activeLabels); - copyInfo(md); - if (!md._activeLabels.empty()) - { - if (copyObjects) - md.myMDSql->copyObjects(this); - } - else - { - int n = md.size(); - for (int i = 0; i < n; i++) - addObject(); - } -} - -bool MetaDataDb::setValue(const MDObject &mdValueIn, size_t id) -{ - if (id == BAD_OBJID) - { - REPORT_ERROR(ERR_MD_NOACTIVE, "setValue: please provide objId other than -1"); - exit(1); - } - //add label if not exists, this is checked in addlabel - addLabel(mdValueIn.label); - return myMDSql->setObjectValue(id, mdValueIn); -} - -bool MetaDataDb::setValueCol(const MDObject &mdValueIn) -{ - //add label if not exists, this is checked in addlabel - addLabel(mdValueIn.label); - return myMDSql->setObjectValue(mdValueIn); -} - -bool MetaDataDb::getValue(MDObject &mdValueOut, size_t id) const -{ - if (!containsLabel(mdValueOut.label)) - return false; - - if (id == BAD_OBJID) - REPORT_ERROR(ERR_MD_NOACTIVE, "getValue: please provide objId other than -1"); - - return myMDSql->getObjectValue(id, mdValueOut); -} - -void MetaDataDb::getColumnValues(const MDLabel label, std::vector &valuesOut) const -{ - MDObject mdValueOut(label); - std::vector objectsId; - findObjects(objectsId); - size_t n = objectsId.size(); - valuesOut.resize(n,mdValueOut); - for (size_t i = 0; i < n; ++i) - { - getValue(mdValueOut, objectsId[i]); - valuesOut[i] = mdValueOut; - } -} - -void MetaDataDb::setColumnValues(const std::vector &valuesIn) -{ - bool addObjects=false; - if (size()==0) - addObjects=true; - if (valuesIn.size()!=size() && !addObjects) - REPORT_ERROR(ERR_MD_OBJECTNUMBER,"Input vector must be of the same size as the metadata"); - if (!addObjects) - { - size_t n = 0; - for (size_t objId : this->ids()) - setValue(valuesIn[n++], objId); - } - else - { - size_t nmax=valuesIn.size(); - for (size_t n=0; nbindStatement( id)) - { - success = false; - } - - return success; -} - -bool MetaDataDb::initGetRow(bool addWhereClause) const -{ - bool success=true; - - // Prepare statement. - if (!myMDSql->initializeSelect( addWhereClause, this->_activeLabels)) - { - success = false; - } - - return success; -} - -bool MetaDataDb::execGetRow(MDRow &row) const -{ - std::vector mdValues; - mdValues.reserve(this->_activeLabels.size()); - - row.clear(); - - bool success = myMDSql->getObjectsValues(this->_activeLabels, mdValues); - if (success) - for (const auto &obj : mdValues) - row.setValue(obj); - - return success; -} - -void MetaDataDb::finalizeGetRow(void) const -{ - myMDSql->finalizePreparedStmt(); -} - -std::vector MetaDataDb::getObjectsForActiveLabels() const { - // get active labels - std::vector values; - const auto &labels = this->_activeLabels; - values.reserve(labels.size()); - for (auto &l : labels) { - values.emplace_back(l); - } - return values; -} - -bool MetaDataDb::getAllRows(std::vector &rows) const -{ - std::vector> rawRows; - rawRows.reserve(this->size()); - auto columns = getObjectsForActiveLabels(); - if ( ! sqlUtils::select(myMDSql->db, - myMDSql->tableName(myMDSql->tableId), - columns, - rawRows)) return false; - - rows.clear(); - const auto noOfRows = rawRows.size(); - rows.resize(noOfRows); - for (size_t i = 0; i < noOfRows; ++i) { - auto &row = rows.at(i); - const auto &vals = rawRows.at(i); - // fill the row - for (auto &v : vals) { - row.setValue(v); - } - } - return true; -} - -std::unique_ptr MetaDataDb::getRow(size_t id) { - std::unique_ptr row(new MDRowSql()); - if (!getRow(*row, id)) - return nullptr; - return std::move(row); -} - -std::unique_ptr MetaDataDb::getRow(size_t id) const { - std::unique_ptr row(new MDRowSql()); - if (!getRow(*row, id)) - return nullptr; - return std::move(row); -} - -MDRowSql MetaDataDb::getRowSql(size_t id) { - MDRowSql row; - if (!getRow(row, id)) - throw ObjectDoesNotExist(id, getFilename()); - return row; -} - -const MDRowSql MetaDataDb::getRowSql(size_t id) const { - MDRowSql row; - if (!getRow(row, id)) - throw ObjectDoesNotExist(id, getFilename()); - return row; -} - -bool MetaDataDb::getRow(MDRowSql &row, size_t id) const -{ - if (id == BAD_OBJID) - REPORT_ERROR(ERR_MD_NOACTIVE, "getValue: please provide objId other than -1"); - // clear whatever is there now - row.clear(); - // get active labels - auto values = getObjectsForActiveLabels(); - // get values from the row - if ( ! sqlUtils::select(id, - myMDSql->db, - myMDSql->tableName(myMDSql->tableId), - values)) return false; - // fill them - for (auto &v : values) - row.setValue(v); - return true; -} - -bool MetaDataDb::getRow2(MDRow &row, size_t id) const -{ - bool success=true; - - // Clear row. - row.clear(); - - // Initialize SELECT. - success = this->initGetRow( true); - if (success) - { - bindValue( id); - - // Execute SELECT. - success = execGetRow( row); - - // Finalize SELECT. - finalizeGetRow(); - } - - return(success); -} - -bool MetaDataDb::setRow(const MDRow &row, size_t id) -{ - if (row.empty()) { - return true; - } - addMissingLabels(row); - - // create mask of valid labels - std::vector labels; - labels.reserve(row.size()); - for (const MDObject* obj : row) { - labels.emplace_back(obj->label); - } - // extract values to be added - std::vector vals; - vals.reserve(row.size()); - for (const auto &l : labels) { - vals.emplace_back(row.getObject(l)); - } - // update values to db - return sqlUtils::update(vals, MDSql::db, - myMDSql->tableName(myMDSql->tableId), id); -} - - -bool MetaDataDb::initAddRow(const MDRow &row) -{ - int j=0; // Loop counter. - bool success=true; // Return value. - std::vector labels; // Columns labels. - std::vector mdValues; // Vector to store values. - - // Set vector size. - labels.resize(row.size()); - - // Get labels. - j=0; - for (const MDObject* obj : row) { - addLabel(obj->label); - labels[j] = obj->label; - j++; - } - labels.resize(j); - - // Prepare statement (mdValues is not used). - if (!myMDSql->initializeInsert( &labels, mdValues)) - { - std::cerr << "initAddRow: error executing myMDSql->initializeInsert" << std::endl; - success = false; - } - - return success; -} - - -bool MetaDataDb::execAddRow(const MDRow &row) -{ - int j = 0; - bool success = true; - std::vector mdValues; - - // Set values vector size. - mdValues.resize(row.size()); - - // Get values to insert. - j = 0; - for (const MDObject* obj : row) { - addLabel(obj->label); - mdValues[j] = row.getObject(obj->label); - j++; - } - mdValues.resize(j); - - // Execute statement. - if (!myMDSql->setObjectValues( -1, mdValues)) - { - std::cerr << "execAddRow: error executing myMDSql->setObjectValues" << std::endl; - success = false; - } - - return(success); -} - -void MetaDataDb::finalizeAddRow(void) -{ - myMDSql->finalizePreparedStmt(); -} - -size_t MetaDataDb::addRow(const MDRow &row) -{ - size_t id = addObject(); - for (auto obj : row) - if (obj->label != MDL_FIRST_LABEL) - setValue(*obj, id); - - return id; -} - -bool MetaDataDb::getRowValues(size_t id, std::vector &values) const { - for (auto &v : values) { - if (!containsLabel(v.label)) - return false; - } - if (id == BAD_OBJID) - REPORT_ERROR(ERR_MD_NOACTIVE, "getValue: please provide objId other than -1"); - return sqlUtils::select(id, - myMDSql->db, - myMDSql->tableName(myMDSql->tableId), - values); -} - -void MetaDataDb::addRowOpt(const MDRowSql &row) -{ - addRows({row}); -} - -void MetaDataDb::addMissingLabels(const MDRow &row) { - // find missing labels - std::vector missingLabels; - auto definedLabels = row.labels(); - for (const auto &l : definedLabels){ - if ( ! containsLabel(l)) { - missingLabels.emplace_back(l); - } - } - // add missing labels - if ( ! missingLabels.empty()) { - sqlUtils::addColumns(missingLabels, - myMDSql->db, - myMDSql->tableName(myMDSql->tableId)); - this->_activeLabels.insert(this->_activeLabels.end(), missingLabels.begin(), missingLabels.end()); - } -} - -void MetaDataDb::addRows(const std::vector &rows) -{ - const auto noOfRows = rows.size(); - if (0 == noOfRows) { - return; - } - const auto &firstRow = rows.at(0); - - // assuming all rows are using the same labels - addMissingLabels(firstRow); - - // create mask of valid labels - std::vector labels; - labels.reserve(firstRow.size()); - for (const MDObject* obj : firstRow) - labels.emplace_back(obj->label); - const auto noOfLabels = labels.size(); - - // extract values to be added - std::vector> records; - records.reserve(noOfRows); - for (const auto &r : rows) { - records.emplace_back(std::vector()); - auto &vals = records.back(); - vals.reserve(noOfLabels); - for (const auto &l : labels) { - vals.emplace_back(r.getObject(l)); - } - } - // insert values to db - sqlUtils::insert(records, myMDSql->db, - myMDSql->tableName(myMDSql->tableId)); -} - - -size_t MetaDataDb::addRow2(const MDRow &row) -{ - size_t id = BAD_OBJID; - - // Initialize INSERT. - if (initAddRow( row)) - { - // Execute INSERT. - if (execAddRow( row)) - { - // Get last inserted row id. - id = myMDSql->getObjId(); - } - - // Finalize INSERT. - finalizeAddRow(); - } - - return(id); -} - -MetaDataDb::MetaDataDb() -{ - myMDSql = new MDSql(this); - init({}); -}//close MetaData default Constructor - -MetaDataDb::MetaDataDb(const MetaData &md) { - myMDSql = new MDSql(this); - init({}); - MetaData::operator=(md); -} - -MetaDataDb::MetaDataDb(const std::vector &labelsVector) -{ - myMDSql = new MDSql(this); - init(labelsVector); -}//close MetaData default Constructor - -MetaDataDb::MetaDataDb(const FileName &fileName, const std::vector &desiredLabels) -{ - myMDSql = new MDSql(this); - init(desiredLabels); - read(fileName, desiredLabels.empty() ? nullptr : &desiredLabels); -}//close MetaData from file Constructor - -MetaDataDb::MetaDataDb(const MetaDataDb &md) -{ - myMDSql = new MDSql(this); - copyMetadata(md); -}//close MetaData copy Constructor - -MetaDataDb& MetaDataDb::operator=(const MetaDataDb &md) -{ - copyMetadata(md); - return *this; -} - -MetaDataDb::~MetaDataDb() -{ - _clear(); - delete myMDSql; -}//close MetaData Destructor - -//-------- Getters and Setters ---------- - -int MetaDataDb::getMaxStringLength(const MDLabel thisLabel) const -{ - if (!containsLabel(thisLabel)) - return -1; - - return myMDSql->columnMaxLength(thisLabel); -} - -size_t MetaDataDb::size() const -{ - return myMDSql->size(); -} - -bool MetaDataDb::addLabel(const MDLabel label, int pos) -{ - if (containsLabel(label)) - return false; - if (pos < 0 || pos >= (int)this->_activeLabels.size()) - this->_activeLabels.emplace_back(label); - else - this->_activeLabels.insert(this->_activeLabels.begin() + pos, label); - myMDSql->addColumn(label); - return true; -} - -bool MetaDataDb::removeLabel(const MDLabel label) -{ - std::vector::iterator location; - location = std::find(this->_activeLabels.begin(), this->_activeLabels.end(), label); - - if (location == this->_activeLabels.end()) - return false; - - this->_activeLabels.erase(location); - return true; -} - -size_t MetaDataDb::addObject() -{ - return (size_t)myMDSql->addRow(); -} - -void MetaDataDb::importObject(const MetaData &md, const size_t id, bool doClear) -{ - // Currently supports importing only from MetaDataDb - assert(dynamic_cast(&md) != nullptr); - - const MetaDataDb& mdd = dynamic_cast(md); - MDValueEQ query(MDL_OBJID, id); - mdd.myMDSql->copyObjects(this, &query); -} - -void MetaDataDb::importObjects(const MetaData &md, const std::vector &objectsToAdd, bool doClear) -{ - const std::vector& labels = md.getActiveLabels(); - init(labels); - copyInfo(md); - int size = objectsToAdd.size(); - for (int i = 0; i < size; i++) - importObject(md, objectsToAdd[i]); -} - -void MetaDataDb::importObjects(const MetaData &md, const MDQuery &query, bool doClear) -{ - // Currently supports importing only from MetaDataDb - assert(dynamic_cast(&md) != nullptr); - - const MetaDataDb& mdd = dynamic_cast(md); - this->_importObjectsDb(mdd, query, doClear); -} - -void MetaDataDb::_importObjectsDb(const MetaDataDb &md, const MDQuery &query, bool doClear) -{ - if (doClear) - { - //Copy all structure and info from the other metadata - init(md._activeLabels); - copyInfo(md); - } - else - { - //If not clear, ensure that the have the same labels - for (size_t i = 0; i < md._activeLabels.size(); i++) - addLabel(md._activeLabels[i]); - } - md.myMDSql->copyObjects(this, &query); -} - -bool MetaDataDb::removeObject(size_t id) { - int removed = removeObjects(MDValueEQ(MDL_OBJID, id)); - return (removed > 0); -} - -void MetaDataDb::removeObjects(const std::vector &toRemove) -{ - int size = toRemove.size(); - for (int i = 0; i < size; i++) - removeObject(toRemove[i]); -} - -int MetaDataDb::removeObjects(const MDQuery &query) -{ - int removed = myMDSql->deleteObjects(&query); - return removed; -} - -int MetaDataDb::removeObjects() -{ - int removed = myMDSql->deleteObjects(); - return removed; -} - -void MetaDataDb::addIndex(MDLabel label) const -{ - std::vector labels(1); - labels[0]=label; - addIndex(labels); -} -void MetaDataDb::addIndex(const std::vector &desiredLabels) const -{ - - myMDSql->indexModify(desiredLabels, true); -} - -void MetaDataDb::removeIndex(MDLabel label) -{ - std::vector labels(1); - labels[0]=label; - removeIndex(labels); -} - -void MetaDataDb::removeIndex(const std::vector &desiredLabels) -{ - myMDSql->indexModify(desiredLabels, false); -} - -void MetaDataDb::addItemId() -{ - addLabel(MDL_ITEM_ID); - fillLinear(MDL_ITEM_ID,1,1); -} - -void MetaDataDb::removeItemId() -{ - removeLabel(MDL_ITEM_ID); -} - -//----------Iteration functions ------------------- - -size_t MetaDataDb::firstRowId() const -{ - return myMDSql->firstRow(); -} - -size_t MetaDataDb::firstObject(const MDQuery & query) const -{ - std::vector ids; - findObjects(ids, query); - size_t id = ids.size() == 1 ? ids[0] : BAD_OBJID; - return id; -} - -size_t MetaDataDb::lastRowId() const -{ - return myMDSql->lastRow(); -} - -//-------------Search functions------------------- -void MetaDataDb::findObjects(std::vector &objectsOut, const MDQuery &query) const -{ - objectsOut.clear(); - myMDSql->selectObjects(objectsOut, &query); -} - -void MetaDataDb::findObjects(std::vector &objectsOut, int limit) const -{ - objectsOut.clear(); - MDQuery query(limit); - myMDSql->selectObjects(objectsOut, &query); -} - -size_t MetaDataDb::countObjects(const MDQuery &query) const -{ - std::vector objects; - findObjects(objects, query); - return objects.size(); -} - -bool MetaDataDb::containsObject(size_t objectId) const -{ - return containsObject(MDValueEQ(MDL_OBJID, objectId)); -} - -bool MetaDataDb::containsObject(const MDQuery &query) const -{ - std::vector objects; - findObjects(objects, query); - return objects.size() > 0; -} - -//--------------IO functions ----------------------- -#include -#include -#ifdef XMIPP_MMAP -#include -#endif - -void MetaDataDb::write(const FileName &_outFile, WriteModeMetaData mode) const -{ - String blockName; - FileName outFile; - FileName extFile; - - blockName=_outFile.getBlockName(); - if (blockName.empty()) - blockName = DEFAULT_BLOCK_NAME; - outFile = _outFile.removeBlockName(); - extFile = _outFile.getExtension(); - - if (extFile=="xml") - { - writeXML(outFile, blockName, mode); - } - else if(extFile=="sqlite") - { - writeDB(outFile, blockName, mode); - } - else - { - writeStar(outFile, blockName, mode); - } -} - -void MetaDataDb::_writeRows(std::ostream &os) const -{ - - auto sortedLabels = this->_activeLabels; - std::sort(sortedLabels.begin(), sortedLabels.end()); - for (const auto& row : *this) - { - for (size_t i = 0; i < sortedLabels.size(); i++) - { - if (sortedLabels[i] != MDL_STAR_COMMENT) - { - os.width(1); - row.getObject(sortedLabels[i])->toStream(os, true); - os << " "; - } - } - - os << '\n'; - } -} - -void MetaDataDb::write(std::ostream &os,const String &blockName, WriteModeMetaData mode ) const -{ - if(mode==MD_OVERWRITE) - os << FileNameVersion << " * "// << (isColumnFormat ? "column" : "row") - << '\n' //write which type of format (column or row) and the path; - << WordWrap(this->_comment, line_max); //write md comment in the 2nd comment line of header - //write data block - String _szBlockName("data_"); - _szBlockName += blockName; - - if (this->isColumnFormat()) - { - //write md columns in 3rd comment line of the header - os << _szBlockName << '\n'; - os << "loop_" << '\n'; - auto sortedLabels = this->_activeLabels; - std::sort(sortedLabels.begin(), sortedLabels.end()); - for (size_t i = 0; i < sortedLabels.size(); i++) - { - const auto &label = sortedLabels.at(i); - if (label != MDL_STAR_COMMENT) - { - os << " _" << MDL::label2Str(label) << '\n'; - } - } - _writeRows(os); - - //Put the activeObject to the first, if exists - } - else //rowFormat - { - os << _szBlockName << '\n'; - - // Get first object. In this case (row format) there is a single object - size_t id = firstRowId(); - - if (id != BAD_OBJID) - { - auto sortedLabels = this->_activeLabels; - std::sort(sortedLabels.begin(), sortedLabels.end()); - for (size_t i = 0; i < sortedLabels.size(); i++) - { - const auto &label = sortedLabels.at(i); - if (label != MDL_STAR_COMMENT) - { - MDObject mdValue(label); - os << " _" << MDL::label2Str(label) << " "; - myMDSql->getObjectValue(id, mdValue); - mdValue.toStream(os); - os << '\n'; - } - } - } - - } -}//write - - -void MetaDataDb::_parseObjects(std::istream &is, std::vector &columnValues, const std::vector *desiredLabels, bool firstTime) -{ - size_t i=0; // Loop counter. - size_t size=0; // Column values vector size. - - // Columns loop. - size = columnValues.size(); - for (i=0; ifromStream(is); - if (is.fail()) - { - String errorMsg = formatString("MetaData: Error parsing column '%s' value.", MDL::label2Str(columnValues[i]->label).c_str()); - columnValues[i]->failed = true; - std::cerr << "WARNING: " << errorMsg << std::endl; - //REPORT_ERROR(ERR_MD_BADLABEL, (String)"read: Error parsing data column, expecting " + MDL::label2Str(object.label)); - } - else - { - if (firstTime) - { - // Check if current column label exists. - if (columnValues[i]->label != MDL_UNDEFINED) - { - // If there are no desired labels then add all. - bool reallyAdd=false; - if (desiredLabels==NULL) - { - reallyAdd=true; - } - else - { - // Check if current column belongs to desired labels. - for (size_t j=0; jsize(); ++j) - { - if ((*desiredLabels)[j]==columnValues[i]->label) - { - reallyAdd=true; - break; - } - } - } - - // Add label if not exists. - if (reallyAdd) - { - addLabel(columnValues[i]->label); - } - } - } - } - } - - // Insert elements in DB. - myMDSql->setObjectValues( -1, columnValues, desiredLabels); -} - - - -void MetaDataDb::read(const FileName &_filename, - const std::vector *desiredLabels, - bool decomposeStack) -{ - String blockName; - FileName inFile; - - blockName=_filename.getBlockName(); - // if (blockName.empty()) - // blockName = DEFAULT_BLOCK_NAME; - inFile = _filename.removeBlockName(); - String extFile = _filename.getExtension(); - blockName=escapeForRegularExpressions(blockName); - - _clear(); - myMDSql->createMd(); - this->setColumnFormat(true); - - if (extFile=="xml") - readXML(inFile, desiredLabels, blockName, decomposeStack); - else if(extFile=="sqlite") - readDB(inFile, desiredLabels, blockName, decomposeStack); - else - readStar(_filename, desiredLabels, blockName, decomposeStack); -} - - -void MetaDataDb::readPlain(const FileName &inFile, const String &labelsString, const String &separator) -{ - constexpr size_t LINE_LENGTH = 1024; - clear(); - std::vector labels; - MDL::str2LabelVector(labelsString, labels); - - char lineBuffer[LINE_LENGTH]; - String line; - std::ifstream is(inFile.c_str(), std::ios_base::in); - size_t lineCounter = 0; - size_t columnsNumber = labels.size(); - size_t objId; - StringVector parts; - - while (is.getline(lineBuffer, LINE_LENGTH)) - { - ++lineCounter; - line.assign(lineBuffer); - trim(line); - if (line[0]=='#') // This is an old Xmipp comment - continue; - if (!line.empty()) - { - std::stringstream ss(line); - objId = addObject(); - for (size_t i = 0; i < columnsNumber; ++i) - { - MDObject obj(labels[i]); - _parseObject(ss, obj, objId); - setValue(obj, objId); - } - } - } -} - -void MetaDataDb::addPlain(const FileName &inFile, const String &labelsString, const String &separator) -{ - MetaDataDb md2; - md2.readPlain(inFile, labelsString); - merge(md2); -} - -bool MetaDataDb::existsBlock(const FileName &_inFile) -{ -#ifdef XMIPP_MMAP - String blockName; - FileName outFile; - - blockName=_inFile.getBlockName(); - outFile = _inFile.removeBlockName(); - - struct stat file_status; - int fd; - char *map; - - //check if file exists or not block name has been given - //in our format no two identical data_xxx strings may exists - - if (blockName.empty() || !outFile.exists()) - return false; - else - { - //does blockname exists? - //remove it from file in this case - // get length of file: - if(stat(outFile.c_str(), &file_status) != 0) - REPORT_ERROR(ERR_IO_NOPATH,"Metadata:existsBlock can not get filesize for file "+outFile); - size_t size = file_status.st_size; - if(size!=0)//size=0 for /dev/stderr - { - fd = open(outFile.c_str(), O_RDWR, S_IREAD | S_IWRITE); - if (fd == -1) - REPORT_ERROR(ERR_IO_NOPATH,"Metadata:existsBlock can not read file named "+outFile); - - map = (char *) mmap(0, size, PROT_READ | PROT_WRITE, MAP_SHARED, fd, 0); - if (map == MAP_FAILED) - REPORT_ERROR(ERR_MEM_BADREQUEST,"Metadata:existsBlock can not map memory "); - - // Is this a START formatted FILE - String _szBlockName = (String)("\ndata_") + blockName; - size_t blockNameSize = _szBlockName.size(); - close(fd); - bool found=_memmem(map, size, _szBlockName.data(), blockNameSize) != NULL; - if (munmap(map, size) == -1) - REPORT_ERROR(ERR_MEM_NOTDEALLOC,"metadata:write, Can not unmap memory"); - return found; - } - return false; - } -#else - REPORT_ERROR(ERR_MMAP,"Mapping not supported in Windows"); -#endif -} -void MetaDataDb::readXML(const FileName &filename, - const std::vector *desiredLabels, - const String & blockRegExp, - bool decomposeStack) -{ - REPORT_ERROR(ERR_NOT_IMPLEMENTED,"readXML not implemented yet"); -} - -void MetaDataDb::readDB(const FileName &filename, - const std::vector *desiredLabels, - const String & blockRegExp, - bool decomposeStack)//what is decompose stack for? -{ - myMDSql->copyTableFromFileDB(blockRegExp, filename, desiredLabels, _maxRows); -} - -/* This function parses rows data in START format - */ -void MetaDataDb::_readRowsStar(mdBlock &block, std::vector & columnValues, - const std::vector *desiredLabels) { - String line; - std::stringstream ss; - size_t n = block.end - block.loop; - bool firstTime = true; - - if (n == 0) - return; - - char * buffer = new char[n]; - memcpy(buffer, block.loop, n); - char *iter = buffer, *end = iter + n, * newline = NULL; - _parsedLines = 0; //Check how many lines the md have - - if (myMDSql->initializeInsert( desiredLabels, columnValues)) - { - while (iter < end) { //while there are data lines - //Adding \n position and check if NULL at the same time - if (!(newline = END_OF_LINE())) - newline = end; - line.assign(iter, newline - iter); - trim(line); - - if (!line.empty() && line[0] != '#') { - //_maxRows would be > 0 if we only want to read some - // rows from the md for performance reasons... - // anyway the number of lines will be counted in _parsedLines - if (_maxRows == 0 || _parsedLines < _maxRows) { - std::stringstream ss(line); - this->_parseObjects(ss, columnValues, desiredLabels, firstTime); - firstTime = false; - } - _parsedLines++; - } - iter = newline + 1; //go to next line - } - - myMDSql->finalizePreparedStmt(); - } - - delete[] buffer; -} - -/*This function will read the md data if is in row format */ -void MetaDataDb::_readRowFormat(std::istream& is) { - String line, token; - MDLabel label; - - size_t objectID = addObject(); - - // Read data and fill structures accordingly - while (getline(is, line, '\n')) - { - if (line[0] == '#' || line[0] == '\0' || line[0] == ';') - continue; - - // Parse labels - std::stringstream os(line); - - os >> token; - label = MDL::str2Label(token); - MDObject value(label); - os >> value; - if (label != MDL_UNDEFINED) - setValue(value, objectID); - } -} - -void MetaDataDb::merge(const MetaData &md2) -{ - if (size() != md2.size()) - REPORT_ERROR(ERR_MD, "Size of two metadatas should coincide for merging."); - - for (const auto& row : md2) - this->setRow(row, row.id()); -} - -#define SET_AND_FILL() generator.label=label; generator.fill(*this) - -void MetaDataDb::fillExpand(MDLabel label) -{ - //aggregate metadata by label (that is, avoid repetitions - MetaDataDb mdCTFs; - mdCTFs.distinct(*this,label); - //read file-metadatas in new metadata - MetaDataDb ctfModel; - FileName fn; - MDRowSql row; - - for (size_t id : mdCTFs.ids()) - { - if (mdCTFs.getValue(label, fn, id)) - { - ctfModel.read(fn); - if (ctfModel.isEmpty()) - REPORT_ERROR(ERR_VALUE_INCORRECT, "Only can expand non empty metadatas"); - ctfModel.getRow(row, ctfModel.firstRowId()); - mdCTFs.setRow(row, id); - } - } - //join - MetaDataDb md(*this); - join1(md, mdCTFs, label); -} - -void MetaDataDb::fillConstant(MDLabel label, const String &value) -{ - MDConstGenerator generator(value); - SET_AND_FILL(); -} - -void MetaDataDb::fillRandom(MDLabel label, const String &mode, double op1, double op2, double op3) -{ - MDRandGenerator generator(op1, op2, mode, op3); - SET_AND_FILL(); -} - -void MetaDataDb::fillLinear(MDLabel label, double initial, double step) -{ - MDLinealGenerator generator(initial, step); - SET_AND_FILL(); -} - -void MetaDataDb::copyColumn(MDLabel labelDest, MDLabel labelSrc) -{ - String srcName = MDL::label2Str(labelSrc); - if (!containsLabel(labelSrc)) - REPORT_ERROR(ERR_ARG_MISSING, formatString("Source label: '%s' doesn't exist on metadata", srcName.c_str())); - addLabel(labelDest); - - String destName = MDL::label2Str(labelDest); - String cmd = formatString("%s=%s", destName.c_str(), srcName.c_str()); - operate(cmd); -} - -void MetaDataDb::copyColumnTo(MetaData &md, MDLabel labelDest, MDLabel labelSrc) -{ - if (!containsLabel(labelSrc)) - REPORT_ERROR(ERR_ARG_MISSING, formatString("Source label: '%s' doesn't exist on metadata", - (MDL::label2Str(labelSrc)).c_str())); - md.addLabel(labelDest); - std::vector values; - getColumnValues(labelSrc, values); - md.setColumnValues(values); -} - -void MetaDataDb::renameColumn(MDLabel oldLabel, MDLabel newLabel) -{ - if (!containsLabel(oldLabel)) - REPORT_ERROR(ERR_ARG_MISSING, formatString("Source label: '%s' doesn't exist on metadata", - (MDL::label2Str(oldLabel)).c_str())); - std::vector vOldLabel(1); - vOldLabel[0]=oldLabel; - std::vector vNewLabel(1); - vNewLabel[0]=newLabel; - renameColumn(vOldLabel,vNewLabel); -} - -void MetaDataDb::renameColumn(const std::vector &vOldLabel, - const std::vector &vNewLabel) -{ - myMDSql->renameColumn(vOldLabel,vNewLabel); -} - -void MetaDataDb::aggregateSingle(MDObject &mdValueOut, AggregateOperation op, - MDLabel aggregateLabel) - -{ - mdValueOut.setValue(myMDSql->aggregateSingleDouble(op,aggregateLabel)); -} - -void MetaDataDb::aggregateSingleSizeT(MDObject &mdValueOut, AggregateOperation op, - MDLabel aggregateLabel) - -{ - mdValueOut.setValue(myMDSql->aggregateSingleSizeT(op,aggregateLabel)); -} - - -double MetaDataDb::getColumnMax(MDLabel column) -{ - MDObject result(column); - aggregateSingle(result, AGGR_MAX, column); - return result.getValue2(double()); -} - -double MetaDataDb::getColumnMin(MDLabel column) -{ - MDObject result(column); - aggregateSingle(result, AGGR_MIN, column); - return result.getValue2(double()); -} - - -void MetaDataDb::aggregateSingleInt(MDObject &mdValueOut, AggregateOperation op, - MDLabel aggregateLabel) - -{ - size_t aux = myMDSql->aggregateSingleSizeT(op,aggregateLabel); - int aux2 = (int) aux; - mdValueOut.setValue(aux2); -} - -void MetaDataDb::aggregate(const MetaDataDb &mdIn, AggregateOperation op, - MDLabel aggregateLabel, MDLabel operateLabel, MDLabel resultLabel) -{ - std::vector labels(2); - std::vector operateLabels(1); - labels[0] = aggregateLabel; - labels[1] = resultLabel; - operateLabels[0]=operateLabel; - init(labels); - std::vector ops(1); - ops[0] = op; - mdIn.myMDSql->aggregateMd(this, ops, operateLabels); -} - -void MetaDataDb::aggregate(const MetaDataDb &mdIn, const std::vector &ops, - const std::vector &operateLabels, - const std::vector &resultLabels) -{ - if (resultLabels.size() - ops.size() != 1) - REPORT_ERROR(ERR_MD, "Labels vectors should contain one element more than operations"); - init(resultLabels); - mdIn.myMDSql->aggregateMd(this, ops, operateLabels); -} - -void MetaDataDb::aggregateGroupBy(const MetaDataDb &mdIn, - AggregateOperation op, - const std::vector &groupByLabels, - MDLabel operateLabel, - MDLabel resultLabel) -{ - std::vector labels; - labels = groupByLabels; - labels.emplace_back(resultLabel); - init(labels); - mdIn.myMDSql->aggregateMdGroupBy(this, op, groupByLabels, operateLabel, resultLabel); -} - -//-------------Set Operations ---------------------- -void MetaDataDb::_setOperates(const MetaDataDb &mdIn, - const MDLabel label, - SetOperation operation) -{ - std::vector labels; - labels.emplace_back(label); - _setOperates(mdIn,labels,operation); -} - -void MetaDataDb::_setOperates(const MetaDataDb &mdIn, - const std::vector &labels, - SetOperation operation) -{ - if (this == &mdIn) //not sense to operate on same metadata - REPORT_ERROR(ERR_MD, "Couldn't perform this operation on input metadata"); - if (size() == 0 && mdIn.size() == 0) - REPORT_ERROR(ERR_MD, "Couldn't perform this operation if both metadata are empty"); - //Add labels to be sure are present - for (size_t i = 0; i < mdIn._activeLabels.size(); i++) - addLabel(mdIn._activeLabels[i]); - - mdIn.myMDSql->setOperate(this, labels, operation); -} - -void MetaDataDb::_setOperatesLabel(const MetaDataDb &mdIn, - const MDLabel label, - SetOperation operation) -{ - if (this == &mdIn) //not sense to operate on same metadata - REPORT_ERROR(ERR_MD, "Couldn't perform this operation on input metadata"); - if (mdIn.size() == 0) - REPORT_ERROR(ERR_MD, "Couldn't perform this operation if both metadata are empty"); - //Add label to be sure is present in output - addLabel(label); - std::vector labels; - labels.emplace_back(label); - mdIn.myMDSql->setOperate(this, labels, operation); -} - -void MetaDataDb::_setOperates(const MetaDataDb &mdInLeft, - const MetaDataDb &mdInRight, - const std::vector &labelsLeft, - const std::vector &labelsRight, - SetOperation operation) -{ - if (this == &mdInLeft || this == &mdInRight) //not sense to operate on same metadata - REPORT_ERROR(ERR_MD, "Couldn't perform this operation on input metadata"); - //Add labels to be sure are present - for (size_t i = 0; i < mdInLeft._activeLabels.size(); i++) - addLabel(mdInLeft._activeLabels[i]); - for (size_t i = 0; i < mdInRight._activeLabels.size(); i++) - { - bool found=false; - for (size_t j=0; jsetOperate(&mdInLeft, &mdInRight, labelsLeft,labelsRight, operation); -} - -void MetaDataDb::unionDistinct(const MetaDataDb &mdIn, const MDLabel label) -{ - if(mdIn.isEmpty()) - return; - _setOperates(mdIn, label, UNION_DISTINCT); -} - -void MetaDataDb::unionAll(const MetaDataDb &mdIn) -{ - if(mdIn.isEmpty()) - return; - _setOperates(mdIn, MDL_UNDEFINED, UNION);//label not needed for unionAll operation -} - - -void MetaDataDb::intersection(const MetaDataDb &mdIn, const MDLabel label) -{ - if(mdIn.isEmpty()) - clear(); - else - _setOperates(mdIn, label, INTERSECTION); -} - -void MetaDataDb::removeDuplicates(MetaDataDb &MDin, MDLabel label) -{ - if(MDin.isEmpty()) - return; - _setOperates(MDin, label, REMOVE_DUPLICATE); -} - -void MetaDataDb::distinct(MetaDataDb &MDin, MDLabel label) -{ - if(MDin.isEmpty()) - return; - _setOperatesLabel(MDin, label, DISTINCT); -} - -void MetaDataDb::subtraction(const MetaDataDb &mdIn, const MDLabel label) -{ - if(mdIn.isEmpty()) - return; - _setOperates(mdIn, label, SUBSTRACTION); -} - -void MetaDataDb::join1(const MetaDataDb &mdInLeft, const MetaDataDb &mdInRight, const MDLabel label, JoinType type) -{ - join2(mdInLeft, mdInRight, label, label, type); -} - -void MetaDataDb::join2(const MetaDataDb &mdInLeft, const MetaDataDb &mdInRight, const MDLabel labelLeft, - const MDLabel labelRight, JoinType type) -{ - clear(); - std::vector labelsLeft, labelsRight; - labelsLeft.emplace_back(labelLeft); - labelsRight.emplace_back(labelRight); - _setOperates(mdInLeft, mdInRight, labelsLeft,labelsRight, (SetOperation)type); -} - -void MetaDataDb::join1(const MetaDataDb &mdInLeft, const MetaDataDb &mdInRight, const std::vector &labels, JoinType type) -{ - join2(mdInLeft, mdInRight, labels, labels, type); -} - -void MetaDataDb::join2(const MetaDataDb &mdInLeft, const MetaDataDb &mdInRight, const std::vector &labelsLeft, - const std::vector &labelsRight, JoinType type) -{ - clear(); - _setOperates(mdInLeft, mdInRight, labelsLeft,labelsRight, (SetOperation)type); -} - -void MetaDataDb::joinNatural(const MetaDataDb &mdInLeft, const MetaDataDb &mdInRight) -{ - join2(mdInLeft, mdInRight, MDL_UNDEFINED, MDL_UNDEFINED, NATURAL); -} - -void MetaDataDb::operate(const String &expression) -{ - if (!myMDSql->operate(expression)) - REPORT_ERROR(ERR_MD, "MetaDataDb::operate: error doing operation"); -} - -void MetaDataDb::replace(const MDLabel label, const String &oldStr, const String &newStr) -{ - String labelStr = MDL::label2Str(label); - String expression = formatString("%s=replace(%s,'%s', '%s')", - labelStr.c_str(), labelStr.c_str(), oldStr.c_str(), newStr.c_str()); - if (!myMDSql->operate(expression)) - REPORT_ERROR(ERR_MD, "MetaDataDb::replace: error doing operation"); -} - -void MetaDataDb::randomize(const MetaDataDb &MDin) -{ - std::random_device rd; - auto g = std::mt19937(rd()); - std::vector objects; - MDin.myMDSql->selectObjects(objects); - std::shuffle(objects.begin(), objects.end(), g); - importObjects(MDin, objects); -} - -void MetaDataDb::sort(MetaDataDb &MDin, const MDLabel sortLabel,bool asc, int limit, int offset) -{ - if (MDin.containsLabel(sortLabel)) - { - init(MDin._activeLabels); - copyInfo(MDin); - //if you sort just once the index will not help much - addIndex(sortLabel); - MDQuery query(limit, offset, sortLabel,asc); - MDin.myMDSql->copyObjects(this, &query); - } - else - *this=MDin; -} - -void MetaDataDb::sort(MetaDataDb &MDin, const String &sortLabel,bool asc, int limit, int offset) -{ - // Check if the label has semicolon - size_t ipos=sortLabel.find(':'); - MDLabelType type = MDL::labelType(sortLabel); - if (ipos!=String::npos || type == LABEL_VECTOR_DOUBLE || type == LABEL_VECTOR_SIZET) - { - if(limit != -1 || offset != 0) - REPORT_ERROR(ERR_ARG_INCORRECT,"Limit and Offset are not implemented for vector sorting."); - - MDLabel label; - size_t column; - if (ipos!=String::npos) - { - // Check that the label is a vector field - std::vector< String > results; - splitString(sortLabel,":",results); - column=textToInteger(results[1]); - MDLabelType type = MDL::labelType(results[0]); - if (type != LABEL_VECTOR_DOUBLE || type != LABEL_VECTOR_SIZET) - REPORT_ERROR(ERR_ARG_INCORRECT,"Column specifications cannot be used with non-vector labels"); - label = MDL::str2Label(results[0]); - } - else - { - label = MDL::str2Label(sortLabel); - column = 0; - } - - // Get the column values - MultidimArray v; - v.resizeNoCopy(MDin.size()); - std::vector vectorValues; - int i = 0; - for (size_t id : MDin.ids()) - { - MDin.getValue(label, vectorValues, id); - if (column >= vectorValues.size()) - REPORT_ERROR(ERR_MULTIDIM_SIZE,"Trying to access to inexistent column in vector"); - DIRECT_A1D_ELEM(v, i) = vectorValues[column]; - i++; - } - - // Sort - MultidimArray idx; - v.indexSort(idx); - - // Construct output Metadata - init(MDin._activeLabels); - copyInfo(MDin); - size_t id; - FOR_ALL_DIRECT_ELEMENTS_IN_ARRAY1D(idx) - { - MDRowSql row; - MDin.getRow(row,DIRECT_A1D_ELEM(idx,i)); - id = addObject(); - setRow(row, id); - } - } - else - { - sort(MDin, MDL::str2Label(sortLabel),asc, limit, offset); - } -} - -void MetaDataDb::split(size_t n, std::vector &results, const MDLabel sortLabel) -{ - size_t mdSize = size(); - if (n > mdSize) - REPORT_ERROR(ERR_MD, "MetaDataDb::split: Couldn't split a metadata in more parts than its size"); - - results.clear(); - results.resize(n); - for (size_t i = 0; i < n; i++) - { - MetaDataDb &md = results.at(i); - md._selectSplitPart(*this, n, i, mdSize, sortLabel); - } -} - -void MetaDataDb::_selectSplitPart(const MetaDataDb &mdIn, - int n, int part, size_t mdSize, - const MDLabel sortLabel) -{ - size_t first, last, n_images; - n_images = divide_equally(mdSize, n, part, first, last); - init(mdIn._activeLabels); - copyInfo(mdIn); - mdIn.myMDSql->copyObjects(this, new MDQuery(n_images, first, sortLabel)); -} - -void MetaDataDb::selectSplitPart(const MetaData &mdIn, size_t n, size_t part, const MDLabel sortLabel) -{ - if (dynamic_cast(&mdIn) != nullptr) - return _selectSplitPart(dynamic_cast(mdIn), n, part, sortLabel); - throw std::logic_error("Not yet implemented"); // TODO: use universal functions just on MetaData -} - -void MetaDataDb::_selectSplitPart(const MetaDataDb &mdIn, size_t n, size_t part, const MDLabel sortLabel) -{ - size_t mdSize = mdIn.size(); - if (n > mdSize) - REPORT_ERROR(ERR_MD, "selectSplitPart: Couldn't split a metadata in more parts than its size"); - if (part < 0 || part >= n) - REPORT_ERROR(ERR_MD, "selectSplitPart: 'part' should be between 0 and n-1"); - _selectSplitPart(mdIn, n, part, mdSize, sortLabel); - -} - -void MetaDataDb::selectRandomSubset(const MetaData &mdIn, size_t numberOfObjects, const MDLabel sortLabel) -{ - if (dynamic_cast(&mdIn) != nullptr) - return _selectRandomSubset(dynamic_cast(mdIn), numberOfObjects, sortLabel); - throw std::logic_error("Not yet implemented"); // TODO: use universal functions just on MetaData -} - -void MetaDataDb::_selectRandomSubset(const MetaDataDb &mdIn, size_t numberOfObjects, const MDLabel sortLabel) -{ - clear(); - - MetaDataDb mdAux, mdAux2; - mdAux.randomize(mdIn); - mdAux2.selectPart(mdAux, 0, numberOfObjects); - sort(mdAux2,sortLabel); -} - -void MetaDataDb::selectPart(const MetaData &mdIn, size_t startPosition, size_t numberOfObjects, - const MDLabel sortLabel) -{ - if (dynamic_cast(&mdIn) != nullptr) - return _selectPart(dynamic_cast(mdIn), startPosition, numberOfObjects, sortLabel); - throw std::logic_error("Not yet implemented"); // TODO: use universal functions just on MetaData -} - -void MetaDataDb::_selectPart(const MetaDataDb &mdIn, size_t startPosition, size_t numberOfObjects, - const MDLabel sortLabel) -{ - size_t mdSize = mdIn.size(); - if (startPosition < 0 || startPosition >= mdSize) - REPORT_ERROR(ERR_MD, "selectPart: 'startPosition' should be between 0 and size()-1"); - init(mdIn._activeLabels); - copyInfo(mdIn); - mdIn.myMDSql->copyObjects(this, new MDQuery(numberOfObjects, startPosition, sortLabel)); -} - -void MetaDataDb::makeAbsPath(const MDLabel label) -{ - - String aux_string; - String aux_string_path; - char buffer[1024]; - - if (!getcwd(buffer, 1023)) - REPORT_ERROR(ERR_UNCLASSIFIED,"Cannot get the current directory"); - String path_str(buffer); - path_str += "/"; - getValue(label, aux_string, firstRowId()); - - if (aux_string[0] == '/') - return; - - FileName auxFile; - for (size_t id : this->ids()) - { - aux_string_path = path_str; - getValue(label, auxFile, id); - - if (auxFile.isInStack()) - { - size_t id = auxFile.find('@',0); - auxFile.insert(id+1,aux_string_path); - setValue(label, auxFile, id); - } - else - { - auxFile.addPrefix(aux_string_path); - setValue(label, auxFile, id); - } - } -} - -void MetaDataDb::writeDB(const FileName fn, const FileName blockname, WriteModeMetaData mode) const -{ - if(mode==MD_OVERWRITE) - unlink(fn.c_str()); - myMDSql->copyTableToFileDB(blockname,fn); -} - -void MetaDataDb::writeXML(const FileName fn, const FileName blockname, WriteModeMetaData mode) const -{ - //fixme - ////THIS SHOULD BE IMPLEMENTED USING AN XML LIBRARY THAT HANDLES THE FILE PROPERLY - if(mode!=MD_OVERWRITE) - REPORT_ERROR(ERR_NOT_IMPLEMENTED,"XML is only implemented for overwrite mode"); - std::ofstream ofs(fn.c_str(), std::ios_base::out|std::ios_base::trunc); - size_t size = this->_activeLabels.size(); - ofs << "<" << blockname << ">"<< '\n'; - for (size_t id : this->ids()) - { - ofs << "_activeLabels[i] != MDL_STAR_COMMENT) - { - ofs << MDL::label2Str(this->_activeLabels[i]) << "=\""; - MDObject mdValue(this->_activeLabels[i]); - //ofs.width(1); - myMDSql->getObjectValue(id, mdValue); - mdValue.toStream(ofs, true); - ofs << "\" "; - } - } - ofs << " />" << '\n'; - } - ofs << ""<< '\n'; -} - -void MetaDataDb::writeText(const FileName fn, const std::vector* desiredLabels) const -{ - std::ofstream ofs(fn.c_str(), std::ios_base::trunc|std::ios_base::out); - - if (desiredLabels != NULL) - { - MetaDataDb mdAux(*this); - mdAux._activeLabels = *desiredLabels; - mdAux._writeRows(ofs); - } - else - _writeRows(ofs); - ofs.close(); -} - -void MetaDataDb::metadataToVec(std::vector &vd) -{ - for (const auto& row : *this) - vd.emplace_back(dynamic_cast(row)); -} - -void MetaDataDb::vecToMetadata(const std::vector &rowMetadata) -{ - const MDRowSql row; - - for (size_t i=0;iaddRow(rowMetadata[i]); -} - -bool MetaDataDb::operator==(const MetaDataDb& op) const -{ - return myMDSql->equals(*(op.myMDSql)); -} - -std::ostream& operator<<(std::ostream& o, const MetaData & mD) -{ - mD.write(o); - return o; -} diff --git a/src/core/metadata_db.h b/src/core/metadata_db.h deleted file mode 100644 index 14a8f56..0000000 --- a/src/core/metadata_db.h +++ /dev/null @@ -1,856 +0,0 @@ -/*************************************************************************** - * - * Authors: J.M. de la Rosa Trevin (jmdelarosa@cnb.csic.es) - * Jan Horacek (xhorace4@fi.muni.cz) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_METADATA_DB_H -#define CORE_METADATA_DB_H - -#include -#include -#include "utils/memory_utils.h" -#include "metadata_base.h" -#include "metadata_label.h" -#include "metadata_object.h" -#include "metadata_row_base.h" -#include "metadata_static.h" -#include "metadata_sql.h" -#include "metadata_sql_operations.h" -#include "utils/sql_utils.h" -#include "xmipp_error.h" -#include "xmipp_filename.h" -#include "metadata_writemode.h" - - -/** Original database implementation of MetaData. - * MetaData are stored in SQL database. - * Some database-specific commands are available in this implementation only. - * - * ### Notes - * 1. It's quite fast to iterate over ids. - * 2. It's slow to iterate over rows. - * 3. Best practices: - */ -class MetaDataDb : public MetaData { -protected: - /** This variables should only be used by MDSql - * for handling db status of metadata - */ - /** The table id to do db operations */ - friend class MDSql; - MDSql * myMDSql; - - /** What labels have been read from a docfile/metadata file - * and/or will be stored on a new metadata file when "save" is - * called - **/ - std::vector _activeLabels; - - /** Init, do some initializations tasks, used in constructors - * @ingroup MetaDataConstructors - */ - void init(const std::vector &labelsVector); - - /** Copy all data from another metadata - * @ingroup MetaDataConstructors - */ - void copyMetadata(const MetaDataDb &md, bool copyObjects = true); - - /** This have the same logic of the public one, - * but doesn't perform any range(which implies do a size()) checks. - */ - void _selectSplitPart(const MetaDataDb &mdIn, - int n, int part, size_t mdSize, - const MDLabel sortLabel); - - void _selectSplitPart(const MetaDataDb &mdIn, - size_t n, size_t part, - const MDLabel sortLabel=MDL_OBJID); - - void _selectRandomSubset(const MetaDataDb &mdIn, size_t numberOfObjects, const MDLabel sortLabel=MDL_OBJID); - - void _selectPart(const MetaDataDb &mdIn, size_t startPosition, size_t numberOfObjects, - const MDLabel sortLabel=MDL_OBJID); - - /** This function is for generalize the sets operations - * of unionDistinct, intersection, subtraction - * which can be expressed in terms of - * ADD, SUBSTRACT of intersection part - */ - void _setOperates(const MetaDataDb &mdIn, const MDLabel label, SetOperation operation); - void _setOperates(const MetaDataDb &mdIn, const std::vector &labels, SetOperation operation); - void _setOperates(const MetaDataDb &mdInLeft, - const MetaDataDb &mdInRight, - const std::vector &labelsLeft, - const std::vector &labelsRight, - SetOperation operation); - /** This function is for generalize the sets operations - * in which the output has a single label - * a vector of labels instead of a single label may be implemented in the future - */ - void _setOperatesLabel(const MetaDataDb &mdIn, const MDLabel label, SetOperation operation); - /** clear data and table structure */ - void _clear(bool onlyData=false); - - void _readRowsStar(mdBlock &block, std::vector & columnValues, - const std::vector *desiredLabels) override; - - /** Some private reading functions */ - void _readRowFormat(std::istream& is); - - void _parseObjects(std::istream &is, std::vector & columnValues, - const std::vector *desiredLabels, bool firstTime) override; - - /** - * Get a vector of (empty) objects for each active label - */ - std::vector getObjectsForActiveLabels() const; - - void _importObjectsDb(const MetaDataDb &md, const MDQuery &query, bool doClear=true); - void _importObjectsGeneral(const MetaData &md, const MDQuery &query, bool doClear=true); - -public: - /** @name Constructors - * @{ - */ - - /** Empty Constructor. - * - * The MetaDataDb is created with no data stored on it. You can fill in it programmatically - * or by a later reading from a MetaDataDb file or old Xmipp formatted type. - * if labels vectors is passed this labels are created on metadata - */ - MetaDataDb(); - MetaDataDb(const std::vector &labelsVector); - MetaDataDb(const MetaData &md); - - /** From File Constructor. - * - * The MetaData is created and data is read from provided FileName. Optionally, a vector - * of labels can be provided to read just those required labels - */ - MetaDataDb(const FileName &fileName, const std::vector &desiredLabels = {}); - - /** Copy constructor - * - * Created a new metadata by copying all data from an existing MetaData object. - */ - MetaDataDb(const MetaDataDb &md); - - /** Assignment operator - * - * Copies MetaDataDb from an existing MetaData object. - */ - MetaDataDb& operator=(const MetaDataDb &md); - - /** Destructor - * - * Frees all used memory and destroys object. - */ - virtual ~MetaDataDb(); - - /**Clear all data - */ - void clear() override; - /** @} */ - - /** @name Getters and setters - * @{ - */ - - MDSql * getDatabase() { return myMDSql; } - - /** Export medatada to xml file. - * - */ - void writeXML(const FileName fn, const FileName blockname, WriteModeMetaData mode) const override; - - /** Write metadata in sqlite3 file. - * - */ - void writeDB(const FileName fn, const FileName blockname, WriteModeMetaData mode) const; - - /** Write metadata in text file as plain data without header. - * - */ - void writeText(const FileName fn, const std::vector* desiredLabels) const override; - - /**Get maximum string length of column values. - */ - int getMaxStringLength( const MDLabel thisLabel) const override; - - /** @} */ - - /** @name MetaData Manipulation - * @{ - */ - - - /** Set the value of all objects in an specified column (both value and column are specified in mdValueIn) - */ - bool setValueCol(const MDObject &mdValueIn) override; - - template - bool setValueCol(const MDLabel label, const T &valueIn) { - return MetaData::setValueCol(label, valueIn); - } - - //private: - /** This functions are using MDObject for set real values - * there is an explicit function signature - * foreach type supported in Metadata. - * This is done for some type checking of Metadata labels - * and values - */ - bool setValue(const MDObject &mdValueIn, size_t id) override; - - - template - bool setValue(const MDLabel label, const T &valueIn, size_t id) { - return MetaData::setValue(label, valueIn, id); - } - - bool getValue(MDObject &mdValueOut, size_t id) const override; - bool getRowValues(size_t id, std::vector &values) const override; - - template - bool getValue(const MDLabel label, T &valueOut, size_t id) const { - return MetaData::getValue(label, valueOut, id); - } - - /** Get all values of a column as a vector. - */ - void getColumnValues(const MDLabel label, std::vector &valuesOut) const override; - - template - std::vector getColumnValues(const MDLabel label) const { - return MetaData::getColumnValues(label); - } - - template - void getColumnValues(const MDLabel label, std::vector &valuesOut) const { - return MetaData::getColumnValues(label, valuesOut); - } - - /** Get all values of a column as a vector. - */ - template - bool getColumnValuesOpt(const MDLabel label, std::vector &values) const; - - /** Get all values of a column as a vector. - */ - void setColumnValues(const std::vector &valuesIn) override; - - template - void setColumnValues(const MDLabel label, const std::vector &valuesIn) { - return MetaData::setColumnValues(label, valuesIn); - } - - /** Get all values of an MetaData row of an specified objId*/ - bool bindValue(size_t id) const; - - bool initGetRow(bool addWhereClause) const; - bool execGetRow(MDRow &row) const; - void finalizeGetRow(void) const; - - std::unique_ptr getRow(size_t id) override; - std::unique_ptr getRow(size_t id) const override; - - MDRowSql getRowSql(size_t id); - const MDRowSql getRowSql(size_t id) const; - - bool getRow(MDRowSql &row, size_t id) const; // FIXME: deprecated, use getRow above - - bool getAllRows(std::vector &rows) const; - bool getRow2(MDRow &row, size_t id) const; - - /** Copy all the values in the input row in the current metadata*/ - bool setRow(const MDRow &row, size_t id); - - /** Add a new Row and set values, return the objId of newly added object */ - bool initAddRow(const MDRow &row); - bool execAddRow(const MDRow &row); - void finalizeAddRow(void); - size_t addRow(const MDRow &row) override; - void addRowOpt(const MDRowSql &row); - void addRows(const std::vector &rows); - void addMissingLabels(const MDRow &row); - size_t addRow2(const MDRow &row); - - /**Number of objects contained in the metadata. - */ - size_t size() const override; - - bool containsLabel(const MDLabel label) const override { - return vectorContainsLabel(this->_activeLabels, label); - } - - std::vector getActiveLabels() const override { - return this->_activeLabels; - } - - /** Add a new label to the metadata. - * By default the label is added at the end, - * if the position is specified and is between 0 and n-1 - * the new label is inserted at that position. - */ - bool addLabel(const MDLabel label, int pos = -1) override; - - /** Remove a label from the metadata. - * The data is still in the table. If you want to remove the data, - * make a copy of the MetaData. - */ - bool removeLabel(const MDLabel label) override; - - /** Adds a new, empty object to the objects map. If objectId == -1 - * the new ID will be that for the last object inserted + 1, else - * the given objectId is used. If there is already an object whose - * objectId == input objectId, just removes it and creates an empty - * one - */ - size_t addObject() override; - - /** Import objects from another metadata. - * @code - * //Import object 1000 from metadata B into metadata A - * A.importObject(B, 1000); - * //Import all objects with rotational angle greater that 60 - * A.importObjects(B, MDValuesGT(MDL_ANGLE_ROT, 60)); - * //Import all objects - * A.importObjects(B); * - * @endcode - */ - void importObject(const MetaData &md, const size_t id, bool doClear=true) override; - void importObjects(const MetaData &md, const std::vector &objectsToAdd, bool doClear=true) override; - void importObjects(const MetaData &md, const MDQuery &query, bool doClear=true) override; - - /** Remove the object with this id. - * Returns true if the object was removed or false if - * the object did not exist - */ - bool removeObject(size_t id) override; - - /** Removes the collection of objects of given vector id's - * NOTE: The iterator will point to the first object after any of these - * operations - */ - void removeObjects(const std::vector &toRemove) override; - - /** Removes objects from metadata. - * return the number of deleted rows - * if not query, all objectes are removed - * Queries can be used in the same way - * as in the importObjects function - */ - int removeObjects(const MDQuery &query) override; - int removeObjects() override; - - /** Add and remove indexes for fast search - * in other labels, but insert are more expensive - */ - void addIndex(MDLabel label) const; - void addIndex(const std::vector &desiredLabels) const; - void removeIndex(MDLabel label); - void removeIndex(const std::vector &desiredLabels); - - /** Add item id. - * From 1 to last. - */ - void addItemId(); - - /** Remove item id.*/ - void removeItemId(); - - /** @} */ - - /** @name Iteration functions - * @{ - */ - - size_t firstRowId() const override; - size_t firstObject(const MDQuery&) const override; - size_t lastRowId() const override; - - /** @name Search operations - * @{ - */ - - /** Find all objects that match a query. - * if called without query, all objects are returned - * if limit is provided only return a maximun of 'limit' - */ - void findObjects(std::vector &objectsOut, const MDQuery &query) const override; - void findObjects(std::vector &objectsOut, int limit = -1) const override; - - size_t countObjects(const MDQuery &query) const override; - bool containsObject(size_t objectId) const override; - bool containsObject(const MDQuery &query) const override; - - /** @} */ - - /** @name I/O functions - * @{ - */ - - /** Write rows data to disk. */ - void _writeRows(std::ostream &os) const override; - - /** Write metadata to disk. Guess blockname from filename - * @code - * outFilename="first@md1.doc" -> filename = md1.doc, blockname = first - * @endcode - */ - void write(const FileName &outFile, WriteModeMetaData mode=MD_OVERWRITE) const override; - void write(std::ostream &os, const String & blockName="",WriteModeMetaData mode=MD_OVERWRITE) const override; - - /** Check if block exists in metadata file - * input full parh block@filename - * return false if metadata block does not exits - */ - bool existsBlock(const FileName &_inFile); - - /** Read metadata from xml file - * - */ - void readXML(const FileName &inFile, - const std::vector *desiredLabels= NULL, - const String & blockRegExp=DEFAULT_BLOCK_NAME, - bool decomposeStack=true); - - /** Read metadata from sqlite file - * - */ - void readDB(const FileName &inFile, - const std::vector *desiredLabels= NULL, - const String & blockRegExp=DEFAULT_BLOCK_NAME, - bool decomposeStack=true); - - /** Read data from file. Guess the blockname from the filename - * @code - * inFilename="first@md1.doc" -> filename = md1.doc, blockname = first - * @endcode - */ - void read(const FileName &inFile, const std::vector *desiredLabels = NULL, bool decomposeStack=true) override; - /** @} */ - - /** Try to read a metadata from plain text with some columns. - * Labels for each columns should be provided in an string separated by spaces. - * Return false if couldn't read - */ - void readPlain(const FileName &inFile, const String &labelsString, const String &separator = " "); - /** Same as readPlain, but instead of cleanning data, the - * readed values will be added. If there are common columns in metadata - * and the plain text, the lattest will be setted - */ - void addPlain(const FileName &inFile, const String &labelsString, const String &separator=" "); - - /** @name Set Operations - * @{ - */ - - /** Aggregate metadata objects, - * result in calling metadata object (except for aggregateSingle) - * thisLabel label is used for aggregation, second. Valid operations are: - * - * MDL_AVG: The avg function returns the average value of all operationLabel within a group. - The result of avg is always a floating point value as long as at there - is at least one non-NULL input even if all inputs are integers. - The result of avg is NULL if and only if there are no non-NULL inputs. - - AGGR_COUNT: The count function returns a count of the number of times that operationLabel is in a group. - - AGGR_MAX The max aggregate function returns the maximum value of all values in the group. - - AGGR_MIN The min aggregate function returns the minimum value of all values in the group. - - AGGRL_SUM The total aggregate functions return sum of all values in the group. - If there are no non-NULL input rows then returns 0.0. - - - */ - - void aggregate(const MetaDataDb &mdIn, AggregateOperation op, - MDLabel aggregateLabel, MDLabel operateLabel, MDLabel resultLabel); - void aggregate(const MetaDataDb &mdIn, const std::vector &ops, - const std::vector &operateLabels, const std::vector &resultLabels); - void aggregateGroupBy(const MetaDataDb &mdIn, - AggregateOperation op, - const std::vector &groupByLabels, - MDLabel operateLabel, - MDLabel resultLabel); - /** This function performs aggregation operations. - without grouping. (i.e. absolute maximum of a metadata column) - for double - */ - void aggregateSingle(MDObject &mdValueOut, AggregateOperation op, - MDLabel aggregateLabel); - /** This function performs aggregation operations. - without grouping. (i.e. absolute maximum of a metadata column) - for int - */ - void aggregateSingleInt(MDObject &mdValueOut, AggregateOperation op, - MDLabel aggregateLabel); - /** This function performs aggregation operations. - without grouping. (i.e. absolute maximum of a metadata column) - for size_t - */ - void aggregateSingleSizeT(MDObject &mdValueOut, AggregateOperation op, - MDLabel aggregateLabel); - - - - /** Returns Max and Min values from a column in metadata - * These functions can only be used for labels of type double - */ - double getColumnMax(MDLabel column); - - double getColumnMin(MDLabel column); - - - /** Union of elements in two Metadatas, without duplicating. - * Result in calling metadata object - * union is a reserved word so I called this method unionDistinct - */ - void unionDistinct(const MetaDataDb &mdIn, const MDLabel label=MDL_OBJID); - - /** Union of all elements in two Metadata, duplicating common elements. - * Result in calling metadata object - * Repetition are allowed - */ - void unionAll(const MetaDataDb &mdIn); - - /** Merge of two Metadata. - * This function reads another metadata and add all columns values. - * The size of the two Metadatas should be the same. If there are - * common columns, the values in md2 will be setted. - */ - void merge(const MetaData &md2); - - /** Intersects two Metadatas. - * Result in "calling" Metadata - */ - void intersection(const MetaDataDb &mdIn, const MDLabel label); - - /** Subtract two Metadatas. - * Result in "calling" metadata - */ - void subtraction(const MetaDataDb &mdIn, const MDLabel label); - - /** Return only distinct (different) values of column label. - * Result in "calling" metadata with a single column - */ - void distinct(MetaDataDb &MDin, MDLabel label); - - /** Join two Metadatas - * Result in "calling" metadata - */ - void join1(const MetaDataDb &mdInLeft, const MetaDataDb &mdInRight, const MDLabel label, JoinType type=LEFT); - - /** Join two Metadatas - * Result in "calling" metadata. join may be done using different labels in each metadata - */ - void join2(const MetaDataDb &mdInLeft, const MetaDataDb &mdInRight, const MDLabel labelLeft, const MDLabel labelRight , JoinType type=LEFT); - - /** Join two Metadatas - * Result in "calling" metadata - */ - void join1(const MetaDataDb &mdInLeft, const MetaDataDb &mdInRight, const std::vector &labels, JoinType type=LEFT); - - /** Join two Metadatas - * Result in "calling" metadata. join may be done using different labels in each metadata - */ - void join2(const MetaDataDb &mdInLeft, const MetaDataDb &mdInRight, const std::vector &labelsLeft, const std::vector &labelsRight, - JoinType type=LEFT); - - /** Join two Metadatas using all common labels (NATURAL_JOIN) - */ - void joinNatural(const MetaDataDb &mdInLeft, const MetaDataDb &mdInRight); - - /** Basic operations on columns data. - * Mainly perform replacements on string values and - * basic algebraic operations on numerical ones. - */ - void operate(const String &expression); - - /** Replace an string in some column(label). - * The type of the column should be string. This function is a shortcut - * of the more genereal function operate - */ - void replace(const MDLabel label, const String &oldStr, const String &newStr); - - /** Randomize a metadata. - * MDin is input and the "randomized" - * result will be in the "calling" Metadata. - */ - void randomize(const MetaDataDb &MDin); - - /**Remove duplicate entries for attribute in label - */ - void removeDuplicates(MetaDataDb &MDin, MDLabel label=MDL_UNDEFINED); - - /* - * Sort a Metadata by a label. - * Sort the content of MDin comparing - * the label supplied, the result will - * be in the "calling" MetaData. - * Limit fixes the maximum number of returned rows - * Offset skips the first N rows - */ - void sort(MetaDataDb &MDin, - const MDLabel sortLabel, - bool asc=true, - int limit=-1, - int offset=0); - - - /* - * Sort a Metadata by a label. - * Sort the content of MDin comparing - * the label supplied, the result will - * be in the "calling" MetaData. - * If the input label is a vector field, - * you may supply label:col, to sort by that column, - * e.g., NMADisplacements:0 - * Limit fixes the maximum number of returned rows - * Offset skips the first N rows - * - */ - void sort(MetaDataDb &MDin, const String &sortLabel, bool asc=true, int limit=-1, int offset=0); - - /** Split Metadata in several Metadatas. - * The Metadata will be divided in 'n' - * almost equally parts and the result will - * be a vector of Metadatas. The "calling" - * Metadata will no be modified. - * @code - * // Divide the images metadata in 10 metadatas. - * std::vector imagesGroups; - * imageMD.split(10, imagesGroups); - * @endcode - */ - void split(size_t n, std::vector &results, - const MDLabel sortLabel=MDL_OBJID); - - /** Take a part from MetaData. - * This function is equivallent to divide - * the input MetaData in n parts and take one. - * The result will be in "calling" MetaData. - */ - void selectSplitPart(const MetaData &mdIn, - size_t n, size_t part, - const MDLabel sortLabel=MDL_OBJID); - - /** Select random subset */ - void selectRandomSubset(const MetaData &mdIn, size_t numberOfObjects, const MDLabel sortLabel=MDL_OBJID) override; - - /** Select some part from Metadata. - * Select elements from input Metadata - * at some starting position - * if the numberOfObjects is -1, all objects - * will be returned from startPosition to the end. - */ - void selectPart(const MetaData &mdIn, size_t startPosition, size_t numberOfObjects, - const MDLabel sortLabel=MDL_OBJID) override; - - /** Makes filenames with absolute paths - * - */ - void makeAbsPath(const MDLabel label=MDL_IMAGE); - - /** @} */ - - template - struct MDDbRowIterator : public MDBaseRowIterator { - private: - typename TypeHelpers::choose::type _mdd; - typename TypeHelpers::choose::type _row; - std::vector _ids; - size_t _i; - bool _finalized = false; - - public: - MDDbRowIterator(typename TypeHelpers::choose::type &mdd, size_t _i) - : _mdd(mdd), _i(_i) { - mdd.myMDSql->selectObjects(_ids); - if (this->_i >= _ids.size()) - return; - - _mdd.initGetRow(false); - - _mdd.execGetRow(this->_row); - this->_row.set_id(this->_ids[this->_i]); - if (this->_i+1 == _ids.size()) { - _mdd.finalizeGetRow(); - _finalized = true; - } - } - - virtual ~MDDbRowIterator() { - if (!_finalized) - _mdd.finalizeGetRow(); - } - - std::unique_ptr> clone() override { - return memoryUtils::make_unique>(_mdd, _i); - } - - void increment() override { - if (this->_i >= _ids.size()) - return; - - this->_i++; - - if (this->_i >= _ids.size()) - return; - - this->_mdd.execGetRow(this->_row); - this->_row.set_id(this->_ids[this->_i]); - - if (this->_i == _ids.size()) { - _mdd.finalizeGetRow(); - _finalized = true; - } - } - - bool operator==(const MDBaseRowIterator& other) const override { - const MDDbRowIterator* dri = dynamic_cast*>(&other); - if (dri != nullptr) - return this->_i == dri->_i; - return false; - } - - typename TypeHelpers::choose::type operator*() override { return _row; } - }; - - iterator begin() override { - return {memoryUtils::make_unique>(*this, 0)}; - } - iterator end() override { - return {memoryUtils::make_unique>(*this, this->size())}; - } - - const_iterator begin() const override { - return {memoryUtils::make_unique>(*this, 0)}; - } - const_iterator end() const override { - return {memoryUtils::make_unique>(*this, this->size())}; - } - - - template - struct MDDbIdIterator : public MDBaseIdIterator { - private: - const MetaDataDb& _mdd; - bool _last; - const MDQuery* _pQuery; - std::vector _ids; - size_t _i; - - public: - MDDbIdIterator(const MetaDataDb& mdd, bool last = false, const MDQuery* pQuery = nullptr) - : _mdd(mdd), _last(last), _pQuery(pQuery) { - mdd.myMDSql->selectObjects(_ids, pQuery); - _i = last ? this->_ids.size() : 0; - } - - bool operator==(const MDBaseIdIterator& other) const override { - const MDDbIdIterator* dri = dynamic_cast*>(&other); - if (dri != nullptr) - return this->_i == dri->_i; - return false; - } - - size_t operator*() override { return _ids[_i]; } - - void increment() override { this->_i++; } - - std::unique_ptr> clone() override { - return memoryUtils::make_unique>(_mdd, _last, _pQuery); - } - }; - - id_iterator id_begin() override { - return {memoryUtils::make_unique>(*this)}; - } - - id_iterator id_end() override { - return {memoryUtils::make_unique>(*this, true)}; - } - - id_const_iterator id_begin() const override { - return {memoryUtils::make_unique>(*this)}; - } - - id_const_iterator id_end() const override { - return {memoryUtils::make_unique>(*this, true)}; - } - - /** Expand Metadata with metadata pointed by label - * Given a metadata md1, with a column containing the name of another column metdata file mdxx - * add the columns in mdxx to md1 - */ - void fillExpand(MDLabel label); - - void fillConstant(MDLabel label, const String &value) override; - void fillRandom(MDLabel label, const String &mode, double op1, double op2, double op3=0.) override; - void fillLinear(MDLabel label, double initial, double step) override; - - void copyColumn(MDLabel labelDest, MDLabel labelSrc) override; - void copyColumnTo(MetaData& md, MDLabel labelDest, MDLabel labelSrc) override; - - void renameColumn(MDLabel oldLabel, MDLabel newLabel) override; - void renameColumn(const std::vector &oldLabel, - const std::vector &newLabel) override; - - void metadataToVec(std::vector &vd); - void vecToMetadata(const std::vector &rowMetadata); - - /** 'is equal to' (equality).*/ - bool operator==(const MetaDataDb& op) const; -} -;//class MetaData - -/** print metadata - * - */ -std::ostream& operator<<(std::ostream& o, const MetaData & mD); - -/** Convert string to write mode metadata enum. - * - */ -WriteModeMetaData metadataModeConvert (String mode); - -template -bool MetaDataDb::getColumnValuesOpt(const MDLabel label, std::vector &values) const { - if (!containsLabel(label)) - return false; - return sqlUtils::select(label, - myMDSql->db, - myMDSql->tableName(myMDSql->tableId), - values); -} - -/** @} */ - -#endif diff --git a/src/core/metadata_extension.cpp b/src/core/metadata_extension.cpp deleted file mode 100644 index 7f69a11..0000000 --- a/src/core/metadata_extension.cpp +++ /dev/null @@ -1,568 +0,0 @@ -/* - * metadata_extension.h - * - * Created on: May 12, 2010 - * Author: roberto - */ -#include "metadata_extension.h" -#include "xmipp_image_extension.h" -#include "xmipp_fftw.h" -#include "xmipp_image_generic.h" -#include "matrix2d.h" -#include "metadata_sql.h" - -#ifndef __linux__ -#define MAXDOUBLE __DBL_MAX__ -#endif - - -/*---------- Statistics --------------------------------------- */ -void getStatistics(const MetaData &md, Image & _ave, Image & _sd, bool apply_geo, bool wrap, MDLabel image_label) -{ - bool first = true; - int n = 0; - - // Calculate Mean - if (md.isEmpty()) - REPORT_ERROR(ERR_MD_OBJECTNUMBER, "There is no selected images in Metadata."); - - Image image, tmpImg; - FileName fnImg; - ApplyGeoParams params; - params.wrap = wrap; - for (size_t id : md.ids()) - { - int enabled; - md.getValueOrDefault(MDL_ENABLED, enabled, id, 1); // default = enabled - if (enabled < 1) - continue; - - md.getValue(image_label, fnImg, id); - if (apply_geo) - image.readApplyGeo(fnImg, md, id, params); - else - image.read(fnImg); - if (first) - { - _ave = image; - first = false; - } - else - _ave() += image(); - n++; - } - - if (n > 0) - _ave() /= n; - _sd = _ave; - _sd().initZeros(); - // Calculate SD - for (size_t id : md.ids()) - { - int enabled; - md.getValueOrDefault(MDL_ENABLED, enabled, id, 1); // default = enabled - if (enabled < 1) - continue; - - md.getValue(image_label, fnImg, id); - if (apply_geo) - image.readApplyGeo(fnImg, md, id, params); - else - image.read(fnImg); - tmpImg() = ((image() - _ave())); - tmpImg() *= tmpImg(); - _sd() += tmpImg(); - } - _sd() /= (n - 1); - _sd().selfSQRT(); -} - -/* Write all images in a MetaData to a binary stack (usually .stk or .mrcs) */ - -void writeMdToStack(const MetaData &md, const FileName &fnStack, bool apply_geo, bool wrap, MDLabel image_label) -{ - size_t i = 0; - - if (md.isEmpty()) - REPORT_ERROR(ERR_MD_OBJECTNUMBER, "writeMdToStack: input MetaData is empty!!!"); - - ImageGeneric image; - FileName fnImg; - ApplyGeoParams params; - params.wrap = wrap; - int enabled; - bool containsEnabled = md.containsLabel(MDL_ENABLED); - - int mode = WRITE_OVERWRITE; - - for (size_t id : md.ids()) - { - if (containsEnabled) - md.getValue(MDL_ENABLED, enabled, id); - else - enabled = 1; - - if (enabled == 1) - { - i++; - - md.getValue(image_label, fnImg, id); - - if (apply_geo) - image.readApplyGeo(fnImg, md, id, params); - else - image.read(fnImg); - image.write(fnStack, i, false, mode); - mode = WRITE_APPEND; - } - } -} /* function writeMdToStack */ - - -/*---------- Statistics --------------------------------------- */ - -Matrix2D getMatrix(char* matrix) -{ - // Parse the string values as floats - std::stringstream ss(matrix); - double values[16]; - for (int i = 0; i < 16; i++) - ss >> values[i]; - - //build the matrix from the parsed values - - - Matrix2D transformM(3, 3); - dMij(transformM, 0, 2) = 0; - dMij(transformM, 1, 2) = 0; - dMij(transformM, 2, 0) = 0; - dMij(transformM, 2, 1) = 0; - dMij(transformM, 2, 2) = 1; - dMij(transformM, 0, 0) = values[0]; // cosine - dMij(transformM, 0, 1) = values[1]; // sine - dMij(transformM, 1, 0) = values[4]; // -sine - dMij(transformM, 1, 1) = values[5]; // cosine - dMij(transformM, 0, 2) = values[3]; // shiftx; - dMij(transformM, 1, 2) = values[7]; // shifty; - return transformM; -} - -void getAverageApplyGeo(const MetaData &md, MultidimArray & _ave, MDLabel image_label) -{ - bool first = true; - int n = 0; - - // Calculate Mean - if (md.isEmpty()) - return; - - Image image; - FileName fnImg; - - for (size_t id : md.ids()) - { - int enabled; - md.getValueOrDefault(MDL_ENABLED, enabled, id, 1); // default = enabled - if (enabled < 1) - continue; - - md.getValue(image_label, fnImg, id); - image.readApplyGeo(fnImg, md, id); - - if (first) - { - _ave = image(); - first = false; - } - _ave += image(); - n++; - } - - if (n > 0) - _ave /= n; -} - -/*---------- Statistics --------------------------------------- */ -void getStatistics(const MetaData &md, double& _ave, double& _sd, double& _min, - double& _max, bool apply_geo, MDLabel image_label) -{ - _min = MAXDOUBLE; - _max = -MAXDOUBLE; - _ave = _sd = 0; - int n = 0; - - // Calculate Mean - if (md.isEmpty()) - REPORT_ERROR(ERR_MD_OBJECTNUMBER, "There is no selected images in Metadata."); - - ImageGeneric image; - double min, max, avg, stddev; - FileName fnImg; - for (size_t id : md.ids()) - { - int enabled; - md.getValueOrDefault(MDL_ENABLED, enabled, id, 1); // default = enabled - if (enabled < 1) - continue; - - md.getValue(image_label, fnImg, id); - if (apply_geo) - image.readApplyGeo(fnImg, md, id); - else - image.read(fnImg, DATA, ALL_IMAGES, true); - image().computeStats(avg, stddev, min, max); - - if (min < _min) - _min = min; - if (max > _max) - _max = max; - - _ave += avg; - _sd += stddev; - - n++; - } - - _ave /= n; - _sd /= n; -} - -/* Get Fourier statistics ------------------------------------------------- */ -void getFourierStatistics(MetaDataDb &MDin, double sam, MetaData &MDout, - bool do_dpr, double max_sam, MDLabel image_label) -{ - MetaDataDb MDaux; - std::vector vMD; - MDaux.randomize(MDin); - MDaux.split(2,vMD,image_label); - MetaDataDb &MD1 = vMD.at(0); - MetaDataDb &MD2 = vMD.at(1); - - Image I1, I2, Id; - getStatistics(MD1,I1,Id,true, image_label); - getStatistics(MD2,I2,Id,true, image_label); - I1().setXmippOrigin(); - I2().setXmippOrigin(); - - MultidimArray freq, frc, dpr, frc_noise, ssnr, error_l2; - frc_dpr(I1(), I2(), sam, freq, frc, frc_noise, dpr,error_l2,do_dpr); - - MDout.clear(); - FOR_ALL_ELEMENTS_IN_ARRAY1D(freq) - { - if (i>0) - { - size_t id=MDout.addObject(); - if(max_sam >=0 && ((1./dAi(freq, i)) tokens; - tokenize(line, tokens, " \t"); - switch (tokens.size()) - { - case 0: - break; - case 1: - id = md.addObject(); - md.setValue(MDL_IMAGE,tokens[0], id); - break; - case 2: - id = md.addObject(); - md.setValue(MDL_IMAGE,tokens[0], id); - md.setValue(MDL_IMAGE1,tokens[1], id); - break; - default: - REPORT_ERROR(ERR_MD_OBJECTNUMBER, - (String)"Invalid number of objects in line:"+line); - } - } - fhIn.close(); - } -} - -/* Substitute ------------------------------------------------------------- */ -void substituteOriginalImages(const FileName &fn, const FileName &fnOrig, const FileName &fnOut, - MDLabel label, bool skipFirstBlock) -{ - // Read the original files - MetaDataVec mdorig(fnOrig); - if (mdorig.containsLabel(MDL_ENABLED)) - mdorig.removeObjects(MDValueEQ(MDL_ENABLED, -1)); - StringVector filesOrig; - mdorig.getColumnValues(MDL_IMAGE, filesOrig); - mdorig.clear(); // Save memory - FileName auxFn; - - // Read the blocks available - StringVector blocks; - getBlocksInMetaDataFile(fn, blocks); - - // Delete the output file if it exists - fnOut.deleteFile(); - - // Process each block - for (size_t b=0; b -#include -#include -#include -#include - -#define BLOCKROW 1 -#define BLOCKCOLUNM 2 -#define BLOCKMIXED 3 -#define BLOCKDIFFERENCE 30 -/** @defgroup MetaDataExtension Extension to Metadata Stuff - * @ingroup DataLibrary - * @{ - */ -/** Get the image statistics of a metadata. - * Note that the mean and stddev are images, not values.*/ -void getStatistics(const MetaData &md, Image & _ave, Image & _sd, bool apply_geo, bool wrap, MDLabel image_label=MDL_IMAGE); - -/** Write images in MetaData into a stack */ -void writeMdToStack(const MetaData &md, const FileName &fnStack, bool apply_geo, bool wrap, MDLabel image_label=MDL_IMAGE); - -/** Get the average of a Metadata applying the header. - * The md is not cleaned from disabled images (this option makes the call faster). - */ -void getAverageApplyGeo(const MetaData &md, MultidimArray & _ave, MDLabel image_label=MDL_IMAGE); - -/** Get the image statistics of a metadata. - */ -void getStatistics(const MetaData &md, double& _ave, double& _sd, double& _min, - double& _max, bool apply_geo, MDLabel image_label=MDL_IMAGE); - -/** Get Fourier statistics */ -void getFourierStatistics(MetaDataDb &MDin, double sam, MetaData &Mdout, - bool do_dpr, double max_sam, MDLabel image_label=MDL_IMAGE); - -/** Get image size - */ -void getImageSize(const MetaData &md, size_t &Xdim, size_t &Ydim, size_t &Zdim, size_t &Ndim, MDLabel image_label=MDL_IMAGE); - -/** Get image size and data type */ -void getImageInfo(const MetaData &md, size_t &Xdim, size_t &Ydim, size_t &Zdim, size_t &Ndim, DataType &datatype, MDLabel image_label=MDL_IMAGE); - -void getImageInfo(const MetaData &md, ImageInfo &imgInfo, MDLabel image_label=MDL_IMAGE); - -/** Get image size and data type of a Metadata file */ -void getImageSizeFromFilename(const FileName &filename, size_t &Xdim, size_t &Ydim, size_t &Zdim, size_t &Ndim, MDLabel image_label=MDL_IMAGE); - -/// compare two image files -bool compareImage(const FileName &filename1, const FileName &filename2); - -/// compare if same dimensions -bool compareImageSize(const FileName &filename1, const FileName &filename2); - -/** Compare two metadata files */ -bool compareTwoMetadataFiles(const FileName &fn1, const FileName &fn2); - - -/** Maximum length of the filenames inside */ -int maxFileNameLength(const MetaData &md, MDLabel image_label=MDL_IMAGE); - -/** Choose a part of the metadata for MPI */ -void mpiSelectPart(MetaDataDb &md, int rank, int size, int &num_img_tot); - -/** Read a 1 or two column list of micrographs. - * Two column files are interpreted as Random Conical Tilt pairs. - */ -void readMetaDataWithTwoPossibleImages(const FileName &fn, MetaData &md); - -/** Substitute original images. - * This function substitutes the images in a given label of the metadata by - * a set of original images. The substituted images are supposed to be in a stack produced - * by processing the original images. The substitution is performed in all blocks. - */ -void substituteOriginalImages(const FileName &fn, const FileName &fnOrig, const FileName &fnOut, - MDLabel label, bool skipFirstBlock); - -/**convert bsoft metadas to xmipp style - * - */ -void bsoftRemoveLoopBlock(const FileName &_inFile, const FileName &block); - -/** undo bsoftRemoveLoopBlock actions - * - */ -void bsoftRestoreLoopBlock(const FileName &_inFile, const FileName &block); - -Matrix2D getMatrix(char* matrix); - -MDRowVec firstRow(const FileName &fnMetadata); -//@} - -#endif /* METADATA_EXTENSION_H_ */ diff --git a/src/core/metadata_generator.cpp b/src/core/metadata_generator.cpp deleted file mode 100644 index 6e6bdf7..0000000 --- a/src/core/metadata_generator.cpp +++ /dev/null @@ -1,115 +0,0 @@ -/*************************************************************************** - * - * Authors: J.M. de la Rosa Trevin (jmdelarosa@cnb.csic.es) - * Jan Horacek (xhorace4@fi.muni.cz) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include "metadata_generator.h" -#include "xmipp_funcs.h" - -inline double MDRandGenerator::getRandValue() { - switch (mode) - { - case GTOR_UNIFORM: - return rnd_unif(op1, op2); - case GTOR_GAUSSIAN: - return rnd_gaus(op1, op2); - case GTOR_STUDENT: - return rnd_student_t(op3, op1, op2); - default: - REPORT_ERROR(ERR_ARG_INCORRECT,"Unknown random type"); - } -} - -MDRandGenerator::MDRandGenerator(double op1, double op2, const String &mode, double op3) { - static bool randomized = false; - - if (!randomized)//initialize random seed just once - { - randomize_random_generator(); - randomized = true; - } - this->op1 = op1; - this->op2 = op2; - this->op3 = op3; - if (mode == "uniform") - this->mode = GTOR_UNIFORM; - else if (mode == "gaussian") - this->mode = GTOR_GAUSSIAN; - else if (mode == "student") - this->mode = GTOR_STUDENT; - else - REPORT_ERROR(ERR_PARAM_INCORRECT, formatString("Unknown random type '%s'", mode.c_str())); - -} - -void MDRandGenerator::fillValue(MetaData &md, size_t objId) { - double aux = getRandValue(); - md.setValue(label, aux, objId); -} - -MDConstGenerator::MDConstGenerator(const String &value) { - this->value = value; -} - -void MDConstGenerator::fillValue(MetaData &md, size_t objId) { - md.setValueFromStr(label, value, objId); -} - -MDLinealGenerator::MDLinealGenerator(double initial, double step) { - this->initValue = initial; - this->step = step; - counter = 0; -} - -void MDLinealGenerator::fillValue(MetaData &md, size_t objId) { - double value = initValue + step * counter++; - if (MDL::isInt(label)) - md.setValue(label, (int)value, objId); - else if ( MDL::isLong(label)) - md.setValue(label, (size_t)value, objId); - else - md.setValue(label, value, objId); -} - -/* Class to generate values for columns of a metadata*/ -void MDValueGenerator::fill(MetaData &md) { - for (size_t id: md.ids()) - fillValue(md, id); -} - -#ifdef NEVERDEFINED -/* Class to fill columns with another metadata in row format */ -void MDExpandGenerator::fillValue(MetaData &md, size_t objId) { - if (md.getValue(label, fn, objId)) - { - expMd.read(fn); - if (expMd.isColumnFormat() || expMd.isEmpty()) - REPORT_ERROR(ERR_VALUE_INCORRECT, "Only can expand non empty and row formatted metadatas"); - expMd.getRow(row, expMd.firstObject()); - md.setRow(row, objId); - } - else - REPORT_ERROR(ERR_MD_BADLABEL, formatString("Can't expand missing label '%s'", MDL::label2Str(label).c_str())); -} -#endif diff --git a/src/core/metadata_generator.h b/src/core/metadata_generator.h deleted file mode 100644 index 95d749e..0000000 --- a/src/core/metadata_generator.h +++ /dev/null @@ -1,96 +0,0 @@ -/*************************************************************************** - * - * Authors: J.M. de la Rosa Trevin (jmdelarosa@cnb.csic.es) - * Jan Horacek (xhorace4@fi.muni.cz) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_METADATA_GENERATOR_H -#define CORE_METADATA_GENERATOR_H - -#include "metadata_base.h" - -/** Class to generate values for columns of a metadata*/ -class MDValueGenerator { -public: - MDLabel label; //label to which generate values - - /* Destructor*/ - virtual ~MDValueGenerator() - {} - - /* Method to be implemented in concrete generators */ - virtual void fillValue(MetaData &md, size_t objId) = 0; - /* Fill whole metadata */ - void fill(MetaData &md); -};//end of class MDValueGenerator - -///////// Some concrete generators //////////////// -typedef enum { GTOR_UNIFORM, GTOR_GAUSSIAN, GTOR_STUDENT } RandMode; - -/** MDGenerator to generate random values on columns */ -class MDRandGenerator: public MDValueGenerator { -protected: - double op1, op2, op3; - RandMode mode; - - inline double getRandValue(); -public: - MDRandGenerator(double op1, double op2, const String &mode, double op3=0.); - void fillValue(MetaData &md, size_t objId); -};//end of class MDRandGenerator - -/** Class to fill columns with constant values */ -class MDConstGenerator: public MDValueGenerator { -public: - String value; - - MDConstGenerator(const String &value); - void fillValue(MetaData &md, size_t objId); -};//end of class MDConstGenerator - -#ifdef NEVERDEFINED -/** Class to fill columns with another metadata in row format */ -class MDExpandGenerator: public MDValueGenerator { -public: - MetaData expMd; - FileName fn; - MDRow row; - - void fillValue(MetaData &md, size_t objId); -};//end of class MDExpandGenerator -#endif - -/** Class to fill columns with a lineal serie */ -class MDLinealGenerator: public MDValueGenerator { -public: - double initValue, step; - size_t counter; - - MDLinealGenerator(double initial, double step); - void fillValue(MetaData &md, size_t objId); -};//end of class MDExpandGenerator - - -/** @} */ - -#endif diff --git a/src/core/metadata_label.h b/src/core/metadata_label.h deleted file mode 100644 index 690ebbe..0000000 --- a/src/core/metadata_label.h +++ /dev/null @@ -1,1010 +0,0 @@ -/*************************************************************************** - * - * Authors: J.M. De la Rosa Trevin (jmdelarosa@cnb.csic.es) - * Jan Horacek (xhorace4@fi.muni.cz) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_METADATALABEL_H -#define CORE_METADATALABEL_H - -#include -#include "xmipp_strings.h" -#include - -class MDLabelData; -class MDObject; -class MDLabelStaticInit; - -/** @addtogroup MetaData - * @{ - */ - -/** Enumerate all posible labels to use in MetaData. - */ -enum MDLabel -{ - MDL_UNDEFINED = -1, - MDL_FIRST_LABEL, ///< The label MDL_OBJID is special and should not be used - MDL_OBJID = MDL_FIRST_LABEL, ///< object id (int), NOTE: This label is special and shouldn't be used - MDL_GATHER_ID, /// Special label to be used when gathering MDs in MpiMetadataPrograms - - MDL_ANGLE_PSI, ///< Psi angle of an image (double,degrees) - MDL_ANGLE_PSI2, ///< Psi angle of an image (double,degrees) - MDL_ANGLE_PSI3, ///< Psi angle of an image (double,degrees) - MDL_ANGLE_PSI_DIFF, ///< difference between psi angles (double,degrees) - MDL_ANGLE_ROT, ///< Rotation angle of an image (double,degrees) - MDL_ANGLE_ROT2, ///< Rotation angle of an image (double,degrees) - MDL_ANGLE_ROT3, ///< Rotation angle of an image (double,degrees) - MDL_ANGLE_ROT_DIFF, ///< difference between rot angles (double,degrees) - MDL_ANGLE_TILT, ///< Tilting angle of an image (double,degrees) - MDL_ANGLE_TILT2, ///< Tilting angle of an image (double,degrees) - MDL_ANGLE_TILT3, ///< Tilting angle of an image (double,degrees) - MDL_ANGLE_TILT_DIFF, ///< difference between tilt angles (double,degrees) - MDL_ANGLE_DIFF0, ///< difference between two angles (double,degrees) - MDL_ANGLE_DIFF, ///< difference between two angles (double,degrees) - MDL_ANGLE_DIFF2, ///< difference between two angles (double,degrees) - MDL_ANGLE_Y, ///< Angle between y-axis and tilt-axis (double, degrees) for untilted micrographs - MDL_ANGLE_Y2, ///< Angle between y-axis and tilt-axis (double, degrees) for tilted micrographs - MDL_ANGLE_TEMPERATURE, ///< Angular temperature (double,degrees) - MDL_APPLY_SHIFT,/// (double) - MDL_OPTICALFLOW_MEANY, /// (double) - MDL_OPTICALFLOW_STDX, /// (double) - MDL_OPTICALFLOW_STDY, /// (double) - - MDL_PARTICLE_ID, ///< Particle unique identifier for reference. (The MDL_ITEM_ID should be used when particle list) - MDL_PHANTOM_BGDENSITY, ///< Phantom background density (double) - MDL_PHANTOM_FEATURE_CENTER, ///< Center of the feature (vector double) - MDL_PHANTOM_FEATURE_DENSITY, ///< The density of the feature (double) - MDL_PHANTOM_FEATURE_OPERATION, ///< Operation in case of overlapping features (+,-) - MDL_PHANTOM_FEATURE_SPECIFIC, ///< Specific parameters for a feature (vector double) - MDL_PHANTOM_FEATURE_TYPE, ///< Type of the feature (Sphere, Blob, ...) (std::string) - MDL_PHANTOM_SCALE, ///< Number which will multiply all features (double) - - MDL_MACRO_CMD, //ImageJ macro command on picker - MDL_MACRO_CMD_ARGS, //ImageJ macro args on picker - MDL_COLOR, ///< Color for particle picking - MDL_PICKING_TEMPLATES, ///< Number of templates - MDL_PICKING_STATE, ///< State for particle picking - MDL_PICKING_MICROGRAPH_STATE, ///< Micrograph state for particle picking - MDL_PICKING_AUTOPICKPERCENT, - MDL_PICKING_PARTICLE_SIZE, ///< Particle size for particle picking - MDL_PICKING_AUTOPARTICLES_SIZE, ///< Number of automatic particles picked - MDL_PICKING_MANUALPARTICLES_SIZE, ///< Number of manual particles picked - MDL_PMAX, ///< Maximum value of normalized probability function (now called "Pmax/sumP") (double) - MDL_POINTSASYMETRICUNIT, /// < Number of non-redundant projections directions (size_t) - - MDL_PRJ_DIMENSIONS, // X,Y dimensions for the generated projections - MDL_PRJ_ANGFILE, ///< File for generated angles - MDL_PRJ_PSI_NOISE, /// < Psi angle dev and mean noise (vector double) - MDL_PRJ_PSI_RANDSTR, /// < Type of randomness for Psi (std::string) - MDL_PRJ_PSI_RANGE, /// < Psi angle range (vector double) - MDL_PRJ_ROT_NOISE , /// < Rotational angle dev and mean noise (vector double) - MDL_PRJ_ROT_RANDSTR, /// < Type of randomness for Rotational (std::string) - MDL_PRJ_ROT_RANGE, - MDL_PRJ_TILT_NOISE, /// < Tilt angle dev and mean noise (vector double) - MDL_PRJ_TILT_RANDSTR, /// < Type of randomness for Tilt (std::string) - MDL_PRJ_TILT_RANGE, // Vector with the initial and final tilt angle values, and step size - MDL_PRJ_VOL, // Volume file name to generate projections from - - MDL_PROGRAM,// < program name - MDL_USER,// < user name - - MDL_DIMENSIONS_3D, // X,Y,Z dimensions - MDL_DIMENSIONS_2D, // X,Y dimensions - MDL_PSD, ///< A Power Spectrum Density file name (std::string) - MDL_PSD_ENHANCED, ///< A enhanced Power Spectrum Density file name (std::string) - MDL_RANDOMSEED, ///< Seed for random number generator - MDL_REF3D, ///< 3D Class to which the image belongs (int) - MDL_REF, ///< Class to which the image belongs (int) - MDL_REF2, ///< Store a second class (int) - MDL_REFMD, ///< Name of Metadata file for all references(string) - MDL_ASSIGNED_DIR_REF_CC, ///< correlation of references assigned by two methods - - MDL_RESIDUE, //threshold - MDL_VOLUME_SCORE_SUM_TH, ///< Score corresponding to the sum of cc-threshold with cc>threshold - MDL_VOLUME_SCORE_MEAN, ///< Score corresponding to the mean of cc with cc>threshold - MDL_VOLUME_SCORE_MIN, ///< Score corresponding to the min of cc with cc>threshold - MDL_VOLUME_SCORE1,/// < Score 1 for volumes - MDL_VOLUME_SCORE2,/// < Score 2 for volumes - MDL_VOLUME_SCORE3,/// < Score 3 for volumes - MDL_VOLUME_SCORE4,/// < Score 4 for volumes - MDL_WEIGHT, ///< Weight assigned to the image (double) - MDL_WEIGHT_P, ///< Weight assigned to the image accordint to its clusterability with a significance with respect noise (double) - MDL_WEIGHT_CONTINUOUS2, ///< Weight due to angular continuous assignment - MDL_WEIGHT_JUMPER0, ///< Weight due to angular jumping - MDL_WEIGHT_JUMPER, ///< Weight due to angular jumping - MDL_WEIGHT_JUMPER2, ///< Weight due to angular jumping - MDL_WEIGHT_REALCORR, ///< Weight due correlation between two images/subtomos - MDL_WEIGHT_PHASECORR, ///< Weight due phase correlation between two images/subtomos - MDL_WEIGHT_SIGNIFICANT, ///< Weight due to Angular significance - MDL_WEIGHT_SSNR, ///< Weight due to SSNR - MDL_WEIGHT_PRECISION_ALIGNABILITY, ///< Weight due to Alignability Precision - MDL_WEIGHT_ALIGNABILITY, ///< Weight due to Alignability Precision and Accuracy - MDL_WEIGHT_ACCURACY_ALIGNABILITY, ///< Weight due to Alignability Accuracy - MDL_WEIGHT_PRECISION_MIRROR, ///< Weight due to Mirror Precision - MDL_WROBUST, ///< Weight of t-student distribution in robust Maximum likelihood - MDL_X, ///< X component (double) - MDL_XCOOR, ///< X component (int) - MDL_XCOOR_TILT, ///< X component in tilted micrograph (int) - MDL_XSIZE, ///< X size (int) - MDL_Y, ///< Y component (double) - MDL_YCOOR, ///< Y component (int) - MDL_YCOOR_TILT, ///< Y component in tilted micrograph (int) - MDL_YSIZE, ///< Y size (int) - MDL_Z, ///< Z component (double) - MDL_ZCOOR, ///< Z component (int) - MDL_ZSCORE, ///< Global Z Score (double) - MDL_ZSCORE_DEEPLEARNING1, ///< Z Score (double) - MDL_GOOD_REGION_SCORE, ///< Z Score (double) - MDL_ZSCORE_HISTOGRAM, ///< Z Score (double) - MDL_ZSCORE_RESMEAN, ///< Z Score of the mean of the residuals (double) - MDL_ZSCORE_RESVAR, ///< Z Score of the stddev of the residuals (double) - MDL_ZSCORE_RESCOV, ///< Z Score of the covariance matrix of the residuals (double) - MDL_ZSCORE_SHAPE1, ///< Z Score (double) - MDL_ZSCORE_SHAPE2, ///< Z Score (double) - MDL_ZSCORE_SNR1, ///< Z Score (double) - MDL_ZSCORE_SNR2, ///< Z Score (double) - MDL_ZSIZE, ///< Z size (int) - - /** RELION labels */ - RLN_AREA_ID, ///< ID for the area (or field of view). If one does not use (tilt) series, area would be the same as micrograph... - RLN_AREA_NAME, ///< Name for the area (or field of view). If one does not use (tilt) series, area would be the same as micrograph... - RLN_COMMENT, // The RLN_COMMENT is handled specially as well - - RLN_CTF_BFACTOR, ///< B-factor - RLN_CTF_SCALEFACTOR, ///< linear scale-factor - RLN_CTF_SAMPLING_RATE, ///< Sampling rate - RLN_CTF_VOLTAGE, ///< Microscope voltage (kV) - RLN_CTF_DEFOCUSU, ///< Defocus U (Angstroms) - RLN_CTF_DEFOCUSV, ///< Defocus V (Angstroms) - RLN_CTF_DEFOCUS_ANGLE, ///< Defocus angle (degrees) - RLN_CTF_CS, ///< Spherical aberration - RLN_CTF_CA, ///< Chromatic aberration - RLN_CTF_DETECTOR_PIXEL_SIZE, ///< Pixel size for detector as used in CTF-determination - RLN_CTF_ENERGY_LOSS, ///< Energy loss - RLN_CTF_FOM, ///< ctffind3 FOM (CC) for quality of CTF-fit - RLN_CTF_IMAGE, ///< name of an image describing the CTF model - RLN_CTF_LENS_STABILITY, ///< Lens stability - RLN_CTF_MAGNIFICATION, ///< Magnification used for CTF-determination - RLN_CTF_MAXRES, ///< Maximum resolution with Thon rings - RLN_CTF_CONVERGENCE_CONE, ///< Convergence cone - RLN_CTF_LONGITUDINAL_DISPLACEMENT, ///< Longitudinal displacement - RLN_CTF_TRANSVERSAL_DISPLACEMENT, ///< Transversal displacemente - RLN_CTF_Q0, ///< Amplitude contrast - RLN_CTF_K, ///< CTF gain - RLN_CTF_VALUE, ///< CTF value - RLN_CTF_VALIDATIONSCORE, ///< Gctf-based validation score for CTF fit - RLN_CTF_PHASESHIFT, ///< Phase-shift from a phase-plate (in degrees) - - RLN_IMAGE_NAME, - RLN_IMAGE_RECONSTRUCT_NAME, - RLN_IMAGE_ID, - RLN_IMAGE_ENABLED, - RLN_IMAGE_DATATYPE, - RLN_IMAGE_DIMENSIONALITY, - RLN_IMAGE_BEAMTILT_X, - RLN_IMAGE_BEAMTILT_Y, - RLN_IMAGE_BEAMTILT_GROUP, - RLN_IMAGE_COORD_X, - RLN_IMAGE_COORD_Y, - RLN_IMAGE_COORD_Z, - RLN_IMAGE_FRAME_NR, - RLN_IMAGE_MAGNIFICATION_CORRECTION, - RLN_IMAGE_NORM_CORRECTION, - RLN_IMAGE_ORI_NAME, - RLN_IMAGE_SAMPLINGRATE, - RLN_IMAGE_SAMPLINGRATE_X, - RLN_IMAGE_SAMPLINGRATE_Y, - RLN_IMAGE_SAMPLINGRATE_Z, - RLN_IMAGE_SIZE, - RLN_IMAGE_SIZEX, - RLN_IMAGE_SIZEY, - RLN_IMAGE_SIZEZ, - RLN_IMAGE_STATS_MIN, - RLN_IMAGE_STATS_MAX, - RLN_IMAGE_STATS_AVG, - RLN_IMAGE_STATS_STDDEV, - RLN_IMAGE_STATS_SKEW, - RLN_IMAGE_STATS_KURT, - RLN_IMAGE_WEIGHT, - - RLN_MASK_NAME, - - RLN_MATRIX_1_1, - RLN_MATRIX_1_2, - RLN_MATRIX_1_3, - RLN_MATRIX_2_1, - RLN_MATRIX_2_2, - RLN_MATRIX_2_3, - RLN_MATRIX_3_1, - RLN_MATRIX_3_2, - RLN_MATRIX_3_3, - - RLN_MICROGRAPH_ID, - RLN_MICROGRAPH_MOVIE_NAME, - RLN_MICROGRAPH_NAME, - RLN_MICROGRAPH_NAME_WODOSE, - RLN_MICROGRAPH_TILT_ANGLE, - RLN_MICROGRAPH_TILT_AXIS_DIRECTION, - RLN_MICROGRAPH_TILT_AXIS_OUTOFPLANE, - - RLN_MLMODEL_ACCURACY_ROT, - RLN_MLMODEL_ACCURACY_TRANS, - RLN_MLMODEL_AVE_PMAX, - RLN_MLMODEL_CURRENT_RESOLUTION, - RLN_MLMODEL_CURRENT_SIZE, - RLN_MLMODEL_DATA_VS_PRIOR_REF, - RLN_MLMODEL_DIMENSIONALITY, - RLN_MLMODEL_DIMENSIONALITY_DATA, - RLN_MLMODEL_DIFF2_HALVES_REF, - RLN_MLMODEL_ESTIM_RESOL_REF, - RLN_MLMODEL_FOURIER_COVERAGE_REF, - RLN_MLMODEL_FOURIER_COVERAGE_TOTAL_REF, - RLN_MLMODEL_FSC_HALVES_REF, - RLN_MLMODEL_GROUP_NAME, - RLN_MLMODEL_GROUP_NO, - RLN_MLMODEL_GROUP_NR_PARTICLES, - RLN_MLMODEL_GROUP_SCALE_CORRECTION, - RLN_MLMODEL_HELICAL_NR_ASU, - RLN_MLMODEL_HELICAL_TWIST, - RLN_MLMODEL_HELICAL_TWIST_MIN, - RLN_MLMODEL_HELICAL_TWIST_MAX, - RLN_MLMODEL_HELICAL_TWIST_INITIAL_STEP, - RLN_MLMODEL_HELICAL_RISE, - RLN_MLMODEL_HELICAL_RISE_MIN, - RLN_MLMODEL_HELICAL_RISE_MAX, - RLN_MLMODEL_HELICAL_RISE_INITIAL_STEP, - RLN_MLMODEL_IS_HELIX, - RLN_MLMODEL_INTERPOLATOR, - RLN_MLMODEL_LL, - RLN_MLMODEL_MINIMUM_RADIUS_NN_INTERPOLATION, - RLN_MLMODEL_NORM_CORRECTION_AVG, - RLN_MLMODEL_NR_BODIES, - RLN_MLMODEL_NR_CLASSES, - RLN_MLMODEL_NR_GROUPS, - RLN_MLMODEL_ORIGINAL_SIZE, - RLN_MLMODEL_ORIENTABILITY_CONTRIBUTION, - RLN_MLMODEL_PADDING_FACTOR, - RLN_MLMODEL_PDF_CLASS, - RLN_MLMODEL_PRIOR_OFFX_CLASS, - RLN_MLMODEL_PRIOR_OFFY_CLASS, - RLN_MLMODEL_PDF_ORIENT, - RLN_MLMODEL_PIXEL_SIZE, - RLN_MLMODEL_POWER_REF, - RLN_MLMODEL_PRIOR_MODE, - RLN_MLMODEL_SGD_GRADIENT_IMAGE, - RLN_MLMODEL_SIGMA_OFFSET, - RLN_MLMODEL_SIGMA_ROT, - RLN_MLMODEL_SIGMA_TILT, - RLN_MLMODEL_SIGMA_PSI, - RLN_MLMODEL_REF_IMAGE, - RLN_MLMODEL_SIGMA2_NOISE, - RLN_MLMODEL_SIGMA2_REF, - RLN_MLMODEL_SSNR_REF, - RLN_MLMODEL_TAU2_FUDGE_FACTOR, - RLN_MLMODEL_TAU2_REF, - - RLN_OPTIMISER_ACCURACY_ROT, - RLN_OPTIMISER_ACCURACY_TRANS, - RLN_OPTIMISER_ADAPTIVE_FRACTION, - RLN_OPTIMISER_ADAPTIVE_OVERSAMPLING, - RLN_OPTIMISER_AUTO_LOCAL_HP_ORDER, - RLN_OPTIMISER_AVAILABLE_MEMORY, - RLN_OPTIMISER_BEST_RESOL_THUS_FAR, - RLN_OPTIMISER_CHANGES_OPTIMAL_OFFSETS, - RLN_OPTIMISER_CHANGES_OPTIMAL_ORIENTS, - RLN_OPTIMISER_CHANGES_OPTIMAL_CLASSES, - RLN_OPTIMISER_COARSE_SIZE, - RLN_OPTIMISER_DATA_ARE_CTF_PHASE_FLIPPED, - RLN_OPTIMISER_DATA_ARE_CTF_PREMULTIPLIED, - RLN_OPTIMISER_DATA_STARFILE, - RLN_OPTIMISER_DO_AUTO_REFINE, - RLN_OPTIMISER_DO_ONLY_FLIP_CTF_PHASES, - RLN_OPTIMISER_DO_CORRECT_CTF, - RLN_OPTIMISER_DO_CORRECT_MAGNIFICATION, - RLN_OPTIMISER_DO_CORRECT_NORM, - RLN_OPTIMISER_DO_CORRECT_SCALE, - RLN_OPTIMISER_DO_HELICAL_REFINE, - RLN_OPTIMISER_DO_REALIGN_MOVIES, - RLN_OPTIMISER_DO_MAP, - RLN_OPTIMISER_DO_SGD, - RLN_OPTIMISER_DO_SOLVENT_FLATTEN, - RLN_OPTIMISER_DO_SKIP_ALIGN, - RLN_OPTIMISER_DO_SKIP_ROTATE, - RLN_OPTIMISER_DO_SPLIT_RANDOM_HALVES, - RLN_OPTIMISER_DO_ZERO_MASK, - RLN_OPTIMISER_FIX_SIGMA_NOISE, - RLN_OPTIMISER_FIX_SIGMA_OFFSET, - RLN_OPTIMISER_FIX_TAU, - RLN_OPTIMISER_HAS_CONVERGED, - RLN_OPTIMISER_HAS_HIGH_FSC_AT_LIMIT, - RLN_OPTIMISER_HAS_LARGE_INCR_SIZE_ITER_AGO, - RLN_OPTIMISER_HELICAL_TWIST_INITIAL, - RLN_OPTIMISER_HELICAL_RISE_INITIAL, - RLN_OPTIMISER_HELICAL_Z_PERCENTAGE, - RLN_OPTIMISER_HELICAL_TUBE_INNER_DIAMETER, - RLN_OPTIMISER_HELICAL_TUBE_OUTER_DIAMETER, - RLN_OPTIMISER_HELICAL_SYMMETRY_LOCAL_REFINEMENT, - RLN_OPTIMISER_HELICAL_SIGMA_DISTANCE, - RLN_OPTIMISER_HIGHRES_LIMIT_SGD, - RLN_OPTIMISER_IGNORE_HELICAL_SYMMETRY, - RLN_OPTIMISER_HELICAL_KEEP_TILT_PRIOR_FIXED, - RLN_OPTIMISER_HIGHRES_LIMIT_EXP, - RLN_OPTIMISER_IGNORE_CTF_UNTIL_FIRST_PEAK, - RLN_OPTIMISER_INCR_SIZE, - RLN_OPTIMISER_ITERATION_NO, - RLN_OPTIMISER_LOCAL_SYMMETRY_FILENAME, - RLN_OPTIMISER_LOWRES_JOIN_RANDOM_HALVES, - RLN_OPTIMISER_MAGNIFICATION_RANGE, - RLN_OPTIMISER_MAGNIFICATION_STEP, - RLN_OPTIMISER_MAX_COARSE_SIZE, - RLN_OPTIMISER_MAX_NR_POOL, - RLN_OPTIMISER_MODEL_STARFILE, - RLN_OPTIMISER_MODEL_STARFILE2, - RLN_OPTIMISER_NR_ITERATIONS, - RLN_OPTIMISER_NR_ITER_WO_RESOL_GAIN, - RLN_OPTIMISER_NR_ITER_WO_HIDDEN_VAR_CHANGES, - RLN_OPTIMISER_OUTPUT_ROOTNAME, - RLN_OPTIMISER_PARTICLE_DIAMETER, - RLN_OPTIMISER_RADIUS_MASK_3D_MAP, - RLN_OPTIMISER_RADIUS_MASK_EXP_PARTICLES, - RLN_OPTIMISER_RANDOM_SEED, - RLN_OPTIMISER_REFS_ARE_CTF_CORRECTED, - RLN_OPTIMISER_SAMPLING_STARFILE, - RLN_OPTIMISER_SGD_MU, - RLN_OPTIMISER_SGD_SIGMA2FUDGE_INI, - RLN_OPTIMISER_SGD_SIGMA2FUDGE_HALFLIFE, - RLN_OPTIMISER_SGD_SUBSET_START, - RLN_OPTIMISER_SGD_SUBSET_SIZE, - RLN_OPTIMISER_SGD_WRITE_EVERY_SUBSET, - RLN_OPTIMISER_SGD_MAX_SUBSETS, - RLN_OPTIMISER_SGD_STEPSIZE, - RLN_OPTIMISER_SMALLEST_CHANGES_OPT_CLASSES, - RLN_OPTIMISER_SMALLEST_CHANGES_OPT_OFFSETS, - RLN_OPTIMISER_SMALLEST_CHANGES_OPT_ORIENTS, - RLN_OPTIMISER_SOLVENT_MASK_NAME, - RLN_OPTIMISER_SOLVENT_MASK2_NAME, - RLN_OPTIMISER_TAU_SPECTRUM_NAME, - RLN_OPTIMISER_USE_TOO_COARSE_SAMPLING, - RLN_OPTIMISER_WIDTH_MASK_EDGE, - - RLN_ORIENT_FLIP, - RLN_ORIENT_ID, - RLN_ORIENT_ORIGIN_X, - RLN_ORIENT_ORIGIN_X_PRIOR, - RLN_ORIENT_ORIGIN_Y, - RLN_ORIENT_ORIGIN_Y_PRIOR, - RLN_ORIENT_ORIGIN_Z, - RLN_ORIENT_ORIGIN_Z_PRIOR, - RLN_ORIENT_ROT, - RLN_ORIENT_ROT_PRIOR, - RLN_ORIENT_TILT, - RLN_ORIENT_TILT_PRIOR, - RLN_ORIENT_PSI, - RLN_ORIENT_PSI_PRIOR, - RLN_ORIENT_PSI_PRIOR_FLIP_RATIO, - - RLN_PARTICLE_AUTOPICK_FOM, - RLN_PARTICLE_CLASS, - RLN_PARTICLE_DLL, - RLN_PARTICLE_ID, - RLN_PARTICLE_FOM, - RLN_PARTICLE_KL_DIVERGENCE, - RLN_PARTICLE_MOVIE_RUNNING_AVG, - RLN_PARTICLE_RANDOM_SUBSET, - RLN_PARTICLE_NAME, - RLN_PARTICLE_ORI_NAME, - RLN_PARTICLE_NR_SIGNIFICANT_SAMPLES, - RLN_PARTICLE_NR_FRAMES, - RLN_PARTICLE_NR_FRAMES_AVG, - - RLN_PARTICLE_PMAX, - - RLN_PARTICLE_HELICAL_TUBE_ID, - RLN_PARTICLE_HELICAL_TUBE_PITCH, - RLN_PARTICLE_HELICAL_TRACK_LENGTH, - - RLN_PIPELINE_JOB_COUNTER, - RLN_PIPELINE_NODE_NAME, - RLN_PIPELINE_NODE_TYPE, - RLN_PIPELINE_PROCESS_ALIAS, - RLN_PIPELINE_PROCESS_NAME, - RLN_PIPELINE_PROCESS_TYPE, - RLN_PIPELINE_PROCESS_STATUS, - RLN_PIPELINE_EDGE_FROM, - RLN_PIPELINE_EDGE_TO, - RLN_PIPELINE_EDGE_PROCESS, - - RLN_POSTPROCESS_AMPLCORR_MASKED, - RLN_POSTPROCESS_AMPLCORR_UNMASKED, - RLN_POSTPROCESS_BFACTOR, - RLN_POSTPROCESS_DPR_MASKED, - RLN_POSTPROCESS_DPR_UNMASKED, - RLN_POSTPROCESS_FINAL_RESOLUTION, - RLN_POSTPROCESS_FSC_GENERAL, - RLN_POSTPROCESS_FSC_TRUE, - RLN_POSTPROCESS_FSC_MASKED, - RLN_POSTPROCESS_FSC_UNMASKED, - RLN_POSTPROCESS_FSC_RANDOM_MASKED, - RLN_POSTPROCESS_GUINIER_FIT_CORRELATION, - RLN_POSTPROCESS_GUINIER_FIT_INTERCEPT, - RLN_POSTPROCESS_GUINIER_FIT_SLOPE, - RLN_POSTPROCESS_GUINIER_VALUE_IN, - RLN_POSTPROCESS_GUINIER_VALUE_INVMTF, - RLN_POSTPROCESS_GUINIER_VALUE_WEIGHTED, - RLN_POSTPROCESS_GUINIER_VALUE_SHARPENED, - RLN_POSTPROCESS_GUINIER_VALUE_INTERCEPT, - RLN_POSTPROCESS_GUINIER_RESOL_SQUARED, - RLN_POSTPROCESS_MTF_VALUE, ///< Detector MTF value - - RLN_SAMPLING_IS_3D, - RLN_SAMPLING_IS_3D_TRANS, - RLN_SAMPLING_HEALPIX_ORDER, - RLN_SAMPLING_HELICAL_OFFSET_STEP, - RLN_SAMPLING_LIMIT_TILT, - RLN_SAMPLING_OFFSET_RANGE, - RLN_SAMPLING_OFFSET_STEP, - RLN_SAMPLING_PERTURB, - RLN_SAMPLING_PERTURBATION_FACTOR, - RLN_SAMPLING_PRIOR_MODE, - RLN_SAMPLING_PSI_STEP, - RLN_SAMPLING_SIGMA_ROT, - RLN_SAMPLING_SIGMA_TILT, - RLN_SAMPLING_SIGMA_PSI, - RLN_SAMPLING_SYMMETRY, - - RLN_SELECTED, - RLN_SELECT_PARTICLES_ZSCORE, - RLN_SORTED_IDX, - RLN_STARFILE_MOVIE_PARTICLES, - RLN_PERFRAME_CUMULATIVE_WEIGHT, - RLN_PERFRAME_RELATIVE_WEIGHT, - - RLN_RESOLUTION, - RLN_RESOLUTION_ANGSTROM, - RLN_RESOLUTION_INVPIXEL, - RLN_SPECTRAL_IDX, - - /** Buffer labels to read generic labels */ - BUFFER_LABELS_START, - BUFFER_01, - BUFFER_02, - BUFFER_03, - BUFFER_04, - BUFFER_05, - BUFFER_06, - BUFFER_07, - BUFFER_08, - BUFFER_09, - BUFFER_10, - BUFFER_11, - BUFFER_12, - BUFFER_13, - BUFFER_14, - BUFFER_15, - BUFFER_16, - BUFFER_17, - BUFFER_18, - BUFFER_19, - BUFFER_20, - BUFFER_21, - BUFFER_22, - BUFFER_23, - BUFFER_24, - BUFFER_25, - BUFFER_26, - BUFFER_27, - BUFFER_28, - BUFFER_29, - BUFFER_30, - BUFFER_31, - BUFFER_32, - BUFFER_33, - BUFFER_34, - BUFFER_35, - BUFFER_36, - BUFFER_37, - BUFFER_38, - BUFFER_39, - BUFFER_40, - BUFFER_41, - BUFFER_42, - BUFFER_43, - BUFFER_44, - BUFFER_45, - BUFFER_46, - BUFFER_47, - BUFFER_48, - BUFFER_49, - BUFFER_50, - BUFFER_51, - BUFFER_52, - BUFFER_53, - BUFFER_54, - BUFFER_55, - BUFFER_56, - BUFFER_57, - BUFFER_58, - BUFFER_59, - BUFFER_60, - BUFFER_61, - BUFFER_62, - BUFFER_63, - BUFFER_64, - BUFFER_65, - BUFFER_66, - BUFFER_67, - BUFFER_68, - BUFFER_69, - BUFFER_70, - BUFFER_71, - BUFFER_72, - BUFFER_73, - BUFFER_74, - BUFFER_75, - BUFFER_76, - BUFFER_77, - BUFFER_78, - BUFFER_79, - BUFFER_80, - BUFFER_81, - BUFFER_82, - BUFFER_83, - BUFFER_84, - BUFFER_85, - BUFFER_86, - BUFFER_87, - BUFFER_88, - BUFFER_89, - BUFFER_90, - BUFFER_91, - BUFFER_92, - BUFFER_93, - BUFFER_94, - BUFFER_95, - BUFFER_96, - BUFFER_97, - BUFFER_98, - BUFFER_99, - - MDL_LAST_LABEL // **** NOTE ****: Do keep this label always at the end,it is here for looping purposes -};//close enum Label - -typedef std::vector MDLabelVector; - -/** Macro for iterate over all labels */ -#define FOR_ALL_LABELS() for (int _label = MDL_FIRST_LABEL; _label < MDL_LAST_LABEL; ++_label) - -/** Possible types of the values of labels */ -enum MDLabelType -{ - LABEL_NOTYPE = -1, - LABEL_INT, - LABEL_BOOL, - LABEL_DOUBLE, - LABEL_STRING, - LABEL_VECTOR_DOUBLE, - LABEL_SIZET, - LABEL_VECTOR_SIZET, - LABEL_VECTOR_FLOAT -}; - -/** Possible types of the values of labels */ -enum MDLabelTag -{ - TAGLABEL_NOTAG = 0, - TAGLABEL_TEXTFILE=0x1, - TAGLABEL_METADATA=0x3, - TAGLABEL_CTFPARAM=0x5, - TAGLABEL_IMAGE=0x8, - TAGLABEL_VOLUME=0x10, - TAGLABEL_STACK=0x20, - TAGLABEL_MICROGRAPH=0x48, - TAGLABEL_PSD=0x88 -}; - -/**Just an utility function */ -bool vectorContainsLabel(const std::vector& labelsVector, const MDLabel label); - -//Just an struct to store type and string alias -class MDLabelData -{ -public: - MDLabelType type; - String str; - int tags; - //Default constructor - MDLabelData() - { - type = LABEL_NOTYPE; - tags=TAGLABEL_NOTAG; - } - - MDLabelData(MDLabelType t, const String &s, int tags) - { - type = t; - str = s; - this->tags=tags; - } -} -;//close class MDLabelData - -/** Explicit instantiation */ -#ifndef __APPLE__ -template class std::vector -; -#endif - -#endif diff --git a/src/core/metadata_object.cpp b/src/core/metadata_object.cpp deleted file mode 100644 index 03478c6..0000000 --- a/src/core/metadata_object.cpp +++ /dev/null @@ -1,654 +0,0 @@ -/*************************************************************************** - * - * Authors: J.M. De la Rosa Trevin (jmdelarosa@cnb.csic.es) - * Jan Horacek (xhorace4@fi.muni.cz) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include -#include -#include -#include "metadata_object.h" -#include "metadata_static.h" -#include "xmipp_error.h" -#include "xmipp_macros.h" -#include - -#define DOUBLE2STREAM(d) \ - if (withFormat) {\ - (os) << std::setw(12); \ - (os) << (((d) != 0. && ABS(d) < 0.001) ? std::scientific : std::fixed);\ - } os << d; - -#define INT2STREAM(i) \ - if (withFormat) os << std::setw(20); \ - os << i; - //this must have 20 since SIZE_MAX = 18446744073709551615 size - - -void MDObject::copy(const MDObject &obj) -{ - if ((type == LABEL_STRING) && (data.stringValue != nullptr)) - { - delete data.stringValue; - data.stringValue = nullptr; - } - else if ((type == LABEL_VECTOR_DOUBLE) && (data.vectorValue != nullptr)) - { - delete data.vectorValue; - data.vectorValue = nullptr; - } - else if ((type == LABEL_VECTOR_SIZET) && (data.vectorValueLong != nullptr)) - { - delete data.vectorValueLong; - data.vectorValueLong = nullptr; - } - - label = obj.label; - failed = obj.failed; - type = obj.type; - chr = obj.chr; - - if (type == LABEL_STRING) - data.stringValue = new String(*(obj.data.stringValue)); - else if (type == LABEL_VECTOR_DOUBLE) - data.vectorValue = new std::vector(*(obj.data.vectorValue)); - else if (type == LABEL_VECTOR_SIZET) - data.vectorValueLong = new std::vector(*(obj.data.vectorValueLong)); - else - data = obj.data; -} - -MDObject::MDObject(const MDObject & obj) -{ - copy(obj); -} - -MDObject & MDObject::operator = (const MDObject &obj) -{ - copy(obj); - return *this; -} - -inline void MDObject::labelTypeCheck(MDLabelType checkingType) const -{ - if (this->type != checkingType) - { - std::stringstream ss; - ss << "Mismatch Label (" << MDL::label2Str(label) - << ") and value type(" << MDL::labelType2Str(checkingType) << ")"; - REPORT_ERROR(ERR_MD_BADLABEL, ss.str()); - } -} - -//Just a simple constructor with the label -//don't do any type checking as have not value yet -MDObject::MDObject(MDLabel label) -{ - this->label = label; - failed = false; - chr = _SPACE; - if (label != MDL_UNDEFINED) - { - type = MDL::labelType(label); - if (type == LABEL_STRING) - data.stringValue = new String; - else if (type == LABEL_VECTOR_DOUBLE) - data.vectorValue = new std::vector; - else if (type == LABEL_VECTOR_SIZET) - data.vectorValueLong = new std::vector; - } - else - type = LABEL_NOTYPE; -} - -/// Macro to do some basic initialization -#define MDOBJECT_INIT() this->label = label; this->type = MDL::labelType(label); this->failed = false; this->chr = _SPACE; - -///Constructors for each Label supported type -///these constructor will do the labels type checking -MDObject::MDObject(MDLabel label, const int &v) -{ - MDOBJECT_INIT(); - this->setValue(v); -} -MDObject::MDObject(MDLabel label, const double &v) -{ - MDOBJECT_INIT(); - this->setValue(v); -} -MDObject::MDObject(MDLabel label, const bool &v) -{ - MDOBJECT_INIT(); - this->setValue(v); -} -MDObject::MDObject(MDLabel label, const String &v) -{ - MDOBJECT_INIT(); - this->data.stringValue = new String(); - this->setValue(v); -} -MDObject::MDObject(MDLabel label, const std::vector &v) -{ - MDOBJECT_INIT(); - this->data.vectorValue = new std::vector(); - this->setValue(v); -} -MDObject::MDObject(MDLabel label, const std::vector &v) -{ - MDOBJECT_INIT(); - this->data.vectorValueLong = new std::vector(); - this->setValue(v); -} -MDObject::MDObject(MDLabel label, const size_t &v) -{ - MDOBJECT_INIT(); - this->setValue(v); -} - -MDObject::~MDObject() -{ - if (type == LABEL_STRING) - delete data.stringValue; - else if (type == LABEL_VECTOR_DOUBLE) - delete data.vectorValue; - else if (type == LABEL_VECTOR_SIZET) - delete data.vectorValueLong; -} - -//These getValue2 also do a compilation type checking -//when expanding templates functions and only -//will allow the supported types -//TODO: think if the type check if needed here - -int& MDObject::getValue2(int) { - labelTypeCheck(LABEL_INT); - return this->data.intValue; -} - -const int& MDObject::getValue2(int ) const { - labelTypeCheck(LABEL_INT); - return this->data.intValue; -} - -double& MDObject::getValue2(double) { - labelTypeCheck(LABEL_DOUBLE); - return this->data.doubleValue; -} - -const double& MDObject::getValue2(double) const { - labelTypeCheck(LABEL_DOUBLE); - return this->data.doubleValue; -} - -bool& MDObject::getValue2(bool) { - labelTypeCheck(LABEL_BOOL); - return this->data.boolValue; -} - -const bool& MDObject::getValue2(bool) const { - labelTypeCheck(LABEL_BOOL); - return this->data.boolValue; -} - -String& MDObject::getValue2(String) { - labelTypeCheck(LABEL_STRING); - return *(this->data.stringValue); -} - -const String& MDObject::getValue2(String) const { - labelTypeCheck(LABEL_STRING); - return *(this->data.stringValue); -} - -std::vector& MDObject::getValue2(std::vector) { - labelTypeCheck(LABEL_VECTOR_DOUBLE); - return *(this->data.vectorValue); -} - -const std::vector& MDObject::getValue2(std::vector) const { - labelTypeCheck(LABEL_VECTOR_DOUBLE); - return *(this->data.vectorValue); -} - -std::vector& MDObject::getValue2(std::vector) { - labelTypeCheck(LABEL_VECTOR_FLOAT); - return *(this->data.vectorValueFloat); -} - -const std::vector& MDObject::getValue2(std::vector) const { - labelTypeCheck(LABEL_VECTOR_FLOAT); - return *(this->data.vectorValueFloat); -} - -std::vector& MDObject::getValue2(std::vector) { - labelTypeCheck(LABEL_VECTOR_SIZET); - return *(this->data.vectorValueLong); -} - -const std::vector& MDObject::getValue2(std::vector) const { - labelTypeCheck(LABEL_VECTOR_SIZET); - return *(this->data.vectorValueLong); -} - -size_t& MDObject::getValue2(size_t) { - labelTypeCheck(LABEL_SIZET); - return this->data.longintValue; -} - -const size_t& MDObject::getValue2(size_t) const { - labelTypeCheck(LABEL_SIZET); - return this->data.longintValue; -} - -float MDObject::getValue2(float) { - return getValue2(0.); // double -} - -float MDObject::getValue2(float) const { - return getValue2(0.); // double -} - -void MDObject::setValue(const int &iv) -{ - labelTypeCheck(LABEL_INT); - this->data.intValue = iv; -} - -void MDObject::setValue(const double &dv) -{ - labelTypeCheck(LABEL_DOUBLE); - this->data.doubleValue = safeDouble(dv); -} - -void MDObject::setValue(const bool &bv) -{ - labelTypeCheck(LABEL_BOOL); - this->data.boolValue = bv; -} - -void MDObject::setValue(const String &sv) -{ - labelTypeCheck(LABEL_STRING); - *(this->data.stringValue) = sv; -} - -void MDObject::setValue(const std::vector &vv) -{ - labelTypeCheck(LABEL_VECTOR_DOUBLE); - const auto size = vv.size(); - this->data.vectorValue->resize(size); - for (size_t i = 0; i < size; ++i) { - this->data.vectorValue->operator[](i) = safeDouble(vv[i]); - } -} - -void MDObject::setValue(const std::vector &vv) -{ - labelTypeCheck(LABEL_VECTOR_FLOAT); - const auto size = vv.size(); - this->data.vectorValueFloat->resize(size); - for (size_t i = 0; i < size; ++i) { - this->data.vectorValueFloat->operator[](i) = safeFloat(vv[i]); - } -} - -void MDObject::setValue(const std::vector &vv) -{ - labelTypeCheck(LABEL_VECTOR_SIZET); - *(this->data.vectorValueLong) = vv; -} - -void MDObject::setValue(const size_t &lv) -{ - labelTypeCheck(LABEL_SIZET); - this->data.longintValue = lv; -} - -void MDObject::setValue(const float &floatvalue) -{ - setValue((double) floatvalue); -} - -void MDObject::setValue(const char* &charvalue) -{ - setValue(String(charvalue)); -} - -void MDObject::toStream(std::ostream &os, bool withFormat, bool isSql, bool escape) const -{ - if (label == MDL_UNDEFINED) //if undefine label, store as a literal string - os << data.stringValue; - else - switch (MDL::labelType(label)) - { - case LABEL_BOOL: //bools are int in sqlite3 - os << data.boolValue; - break; - case LABEL_INT: - INT2STREAM(data.intValue); - break; - case LABEL_SIZET: - INT2STREAM(data.longintValue); - break; - case LABEL_DOUBLE: - DOUBLE2STREAM(data.doubleValue); - break; - case LABEL_STRING: - { - char c = _SPACE; - if (escape) - { - if (isSql || data.stringValue->find_first_of(_DQUOT) != String::npos) - c = _QUOT; - else if (data.stringValue->find_first_of(_QUOT) != String::npos) - c = _DQUOT; - else if (data.stringValue->find_first_of(_SPACE) != String::npos) - c = _QUOT; - else if (data.stringValue->empty()) - c = _QUOT; - } - if (c == _SPACE) - os << *(data.stringValue); - else - os << c << *(data.stringValue) << c; - } - break; - case LABEL_VECTOR_DOUBLE: - { - std::vector &vectorDouble = *(data.vectorValue); - if (escape) - os << _QUOT << " "; - size_t size = vectorDouble.size(); - for (size_t i = 0; i < size; i++) - { - double v = vectorDouble[i]; - DOUBLE2STREAM(v); - os << " "; - } - if (escape) - os << _QUOT; - } - break; - case LABEL_VECTOR_SIZET: - { - std::vector &vector = *(data.vectorValueLong); - if (escape) - os << _QUOT << " "; - size_t size = vector.size(); - for (size_t i = 0; i < size; i++) - os << vector[i] << " "; - if (escape) - os << _QUOT; - } - break; - case LABEL_NOTYPE: - if (escape) os << _QUOT; - os << "No type"; - if (escape) os << _QUOT; - break; - }//close switch -}//close function toStream - -String MDObject::toString(bool withFormat, bool isSql) const -{ - if (type == LABEL_STRING) - { - return isSql ? formatString("'%s'", data.stringValue->c_str()) : *data.stringValue; - } - std::stringstream ss; - toStream(ss, withFormat, isSql, isSql); - - return ss.str(); -} - -//bool MDValue::fromStream(std::istream &is) -std::ostream& operator<< (std::ostream& os, const MDObject &value) -{ - value.toStream(os); - return os; -} - -//bool MDValue::fromStream(std::istream &is) -std::istream& operator>> (std::istream& is, MDObject &value) -{ - value.fromStream(is); - return is; -} - -bool MDObject::fromStream(std::istream &is, bool fromString) -{ - if (label == MDL_UNDEFINED) //if undefine label, store as a literal string - { - String s; - is >> s; - } - else - { - //NOTE: int, bool and long(size_t) are read as double for compatibility with old doc files - double d; - size_t value; - switch (type) - { - case LABEL_BOOL: //bools are int in sqlite3 - is >> d; - data.boolValue = (bool) ((int)d); - break; - case LABEL_INT: - is >> d; - data.intValue = (int) d; - break; - case LABEL_SIZET: - is >> d; - data.longintValue = (size_t) d; - break; - case LABEL_DOUBLE: - { - std::string tmp; - is >> tmp; - - char* end = nullptr; - data.doubleValue = std::strtod(tmp.c_str(), &end); - - if (end != tmp.c_str() + tmp.size()) - { - // Set failure flag - is.setstate(std::ios::failbit); - } - } - break; - case LABEL_STRING: - { - data.stringValue->clear(); - String s; - is >> s; - char chr = s[0]; - if (chr == _QUOT || chr == _DQUOT) - { - s = s.substr(1, s.size() - 1); //remove first char ' - while (s.find_last_of(chr) == String::npos) - { - data.stringValue->append(s + " "); - is >> s; - } - s = s.substr(0, s.size() - 1); //remove last char ' - } - data.stringValue->append(s); - } - break; - case LABEL_VECTOR_DOUBLE: - if (!fromString) - is.ignore(256, _QUOT); - //if (data.vectorValue == NULL) - // data.vectorValue = new std::vector; - data.vectorValue->clear(); - while (is >> d) //This will stop at ending "]" - data.vectorValue->emplace_back(d); - if (!fromString) - { - is.clear(); //this is for clear the fail state after found ']' - is.ignore(256, _QUOT); //ignore the ending ']' - } - break; - case LABEL_VECTOR_SIZET: - if (!fromString) - is.ignore(256, _QUOT); - //if (data.vectorValue == NULL) - // data.vectorValue = new std::vector; - data.vectorValueLong->clear(); - while (is >> value) //This will stop at ending "]" - data.vectorValueLong->emplace_back(value); - if (!fromString) - { - is.clear(); //this is for clear the fail state after found ']' - is.ignore(256, _QUOT); //ignore the ending ']' - } - break; - case LABEL_NOTYPE: - break; - } - } - return is.good(); -} - -bool MDObject::fromString(const String& str) -{ - if (type == LABEL_STRING) - *data.stringValue = str; - std::stringstream ss(str); - return fromStream(ss, true); -} - -bool MDObject::fromChar(const char * szChar) -{ - std::stringstream ss(szChar); - return fromStream(ss); -} - -bool MDObject::operator==(const MDObject &obj) const { - return this->eq(obj, 0); -} - -bool MDObject::eq(const MDObject &obj, double epsilon) const { - // FIXME: allow to compare e.g. int & double & longint - if (this->label != obj.label) - return false; - - if (this->type != obj.type) - throw std::logic_error("MDObject: cannot compare == objects of different type"); - - switch (this->type) { - case LABEL_INT: - return this->data.intValue == obj.data.intValue; - - case LABEL_BOOL: - return this->data.boolValue == obj.data.boolValue; - - case LABEL_SIZET: - return this->data.longintValue == obj.data.longintValue; - - case LABEL_DOUBLE: - return std::abs(this->data.doubleValue - obj.data.doubleValue) <= epsilon; - - case LABEL_STRING: - return *(this->data.stringValue) == *(obj.data.stringValue); - - case LABEL_VECTOR_DOUBLE: - if (this->data.vectorValue->size() != obj.data.vectorValue->size()) - return false; - for (size_t i = 0; i < this->data.vectorValue->size(); i++) - if (std::abs((*this->data.vectorValue)[i] - (*obj.data.vectorValue)[i]) > epsilon) - return false; - return true; - - case LABEL_VECTOR_SIZET: - return *(this->data.vectorValueLong) == *(obj.data.vectorValueLong); - - default: - throw std::logic_error("MDObject: unknown data type"); - }; -} - -bool MDObject::operator<=(const MDObject &obj) const { - // FIXME: allow to compare e.g. int & double & longint - if (this->type == LABEL_INT) - return this->data.intValue <= obj.data.intValue; - if (this->type == LABEL_BOOL) - return this->data.boolValue <= obj.data.boolValue; - if (this->type == LABEL_SIZET) - return this->data.longintValue <= obj.data.longintValue; - if (this->type == LABEL_DOUBLE) - return this->data.doubleValue <= obj.data.doubleValue; - if (this->type == LABEL_STRING) - return this->data.stringValue->compare(*obj.data.stringValue) <= 0; - - throw std::logic_error("MDObject: cannot compare this type on <="); -} - -bool MDObject::operator!=(const MDObject &obj) const { - return !(*this == obj); -} - -bool MDObject::operator>=(const MDObject &obj) const { - return (!(*this <= obj) || (*this == obj)); -} - -bool MDObject::operator<(const MDObject &obj) const { - return ((*this <= obj) && (*this != obj)); -} - -bool MDObject::operator>(const MDObject &obj) const { - return ((*this >= obj) && (*this != obj)); -} - -double MDObject::safeDouble(const double v) const { - if (std::isnan(v)) { - // when saving NaN to sqlite3 db, the actually inserted value is sth very close to zero (0) - // this was causing incompatibilities between (non)sqlite versions of metadata - std::cerr << "Warning: trying to work with NaN in MDObject with label " << MDL::label2Str(this->label) - << ". Using std::numeric_limits::min() instead for backward compatilibity.\n"; - return std::numeric_limits::min(); - } - return v; - } - -float MDObject::safeFloat(const float v) const { - if (std::isnan(v)) { - // when saving NaN to sqlite3 db, the actually inserted value is sth very close to zero (0) - // this was causing incompatibilities between (non)sqlite versions of metadata - std::cerr << "Warning: trying to work with NaN in MDObject with label " << MDL::label2Str(this->label) - << ". Using std::numeric_limits::min() instead for backward compatilibity.\n"; - return std::numeric_limits::min(); - } - return v; - } - -//MDObject & MDRow::operator [](MDLabel label) -//{ -// for (iterator it = begin(); it != end(); ++it) -// if ((*it)->label == label) -// return *(*it); -// MDObject * pObj = new MDObject(label); -// emplace_back(pObj); -// -// return *pObj; -//} diff --git a/src/core/metadata_object.h b/src/core/metadata_object.h deleted file mode 100644 index 32ac857..0000000 --- a/src/core/metadata_object.h +++ /dev/null @@ -1,174 +0,0 @@ -/*************************************************************************** - * - * Authors: J.M. De la Rosa Trevin (jmdelarosa@cnb.csic.es) - * Jan Horacek (xhorace4@fi.muni.cz) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * Institute of Computer Science MUNI - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_METADATA_OBJECT_H -#define CORE_METADATA_OBJECT_H - -#include "metadata_label.h" - -#define _SPACE ' ' -#define _QUOT '\'' -#define _DQUOT '"' - -/** Union to store values */ -typedef union -{ - bool boolValue; - int intValue; - size_t longintValue; - double doubleValue; - String * stringValue; - std::vector * vectorValue; - std::vector * vectorValueLong; - std::vector * vectorValueFloat; -} ObjectData; - -/** MDObject stores single MetaData value. - * Each column in each metadata row contains MDObject. - * It can contain multiple types of data (see ObjectData). - */ -class MDObject -{ -public: - - ObjectData data = {0}; - bool failed; // Set to True if the parsing from Star files fails - char chr; //literal char for string, could be SPACE, QUOT or DQUOT - - void labelTypeCheck(MDLabelType checkingType) const; - void copy(const MDObject &obj); - - MDLabel label; - MDLabelType type = LABEL_INT; - /** Copy constructor */ - MDObject(const MDObject & obj); - /** Assign operator */ - MDObject & operator = (const MDObject &obj); - //Just a simple constructor with the label - //don't do any type checking as have not value yet - MDObject(MDLabel label); - ///Constructors for each Label supported type - ///these constructor will do the labels type checking - MDObject(MDLabel label, const int &intValue); - MDObject(MDLabel label, const double &doubleValue); - MDObject(MDLabel label, const bool &boolValue); - MDObject(MDLabel label, const String &stringValue); - MDObject(MDLabel label, const std::vector &vectorValue); - MDObject(MDLabel label, const std::vector &vectorValueFloat); - MDObject(MDLabel label, const std::vector &vectorValueLong); - MDObject(MDLabel label, const size_t &longintValue); - - /** - * Do not use MDObject constructor with floats, use double. - * Floats are banned from metadata class. - */ - MDObject(MDLabel label, const float &floatValue) = delete; - - /** - * Do not use MDObject constructor with char, use string. - * Chars are banned from metadata class. - */ - MDObject(MDLabel label, const char * &charValue) = delete; - - /// Destructor - ~MDObject(); - - //These getValue2 also do a compilation type checking - //when expanding templates functions and only - //will allow the supported types - //TODO: think if the type check if needed here - - // ******* WARNING ******* - // Methods below were orignally marked 'getValue', however they - // took value via parameter and set value to parameter. This behavior has - // changed. To force the programmer to read value from return type (no - // from parameter), mehotds were temporary renamed, because compiler would - // not otherwise fail. When whole xmipp is compiled and all occurenced of - // old 'getValue' are replaced with 'getValue2', these methods could be - // renamed back to 'getValue'. - - const int& getValue2(int) const; - const double& getValue2(double) const; - const bool& getValue2(bool) const; - const String& getValue2(String) const; - const std::vector& getValue2(std::vector) const; - const std::vector& getValue2(std::vector) const; - const std::vector& getValue2(std::vector) const; - const size_t& getValue2(size_t) const; - float getValue2(float) const; - - int& getValue2(int); - double& getValue2(double); - bool& getValue2(bool); - String& getValue2(String); - std::vector& getValue2(std::vector); - std::vector& getValue2(std::vector); - std::vector& getValue2(std::vector); - size_t& getValue2(size_t); - float getValue2(float); - - /** - * Do not use getValue2 with char, use string. - * chars are banned from metadata class. - */ - void getValue2(char*) const = delete; - - void setValue(const int &iv); - void setValue(const double &dv); - void setValue(const bool &bv); - void setValue(const String &sv); - void setValue(const std::vector &vv); - void setValue(const std::vector &vv); - void setValue(const std::vector &vv); - void setValue(const size_t &lv); - void setValue(const float &floatvalue); - void setValue(const char* &charvalue); - void toStream(std::ostream &os, bool withFormat = false, bool isSql=false, bool escape=true) const; - String toString(bool withFormat = false, bool isSql=false) const; - bool fromStream(std::istream &is, bool fromString=false); - friend std::istream& operator>> (std::istream& is, MDObject &value); - friend std::ostream& operator<< (std::ostream& is, const MDObject &value); - bool fromString(const String &str); - bool fromChar(const char * str); - - bool eq(const MDObject &obj, double epsilon) const; - bool operator == (const MDObject &obj) const; - bool operator != (const MDObject &obj) const; - bool operator <= (const MDObject &obj) const; - bool operator >= (const MDObject &obj) const; - bool operator < (const MDObject &obj) const; - bool operator > (const MDObject &obj) const; - - friend class MDSql; - -private: - double safeDouble(const double v) const; - float safeFloat(const float v) const; -} -; //close class MDObject - -#endif diff --git a/src/core/metadata_query.cpp b/src/core/metadata_query.cpp deleted file mode 100644 index 8080829..0000000 --- a/src/core/metadata_query.cpp +++ /dev/null @@ -1,34 +0,0 @@ -#include "metadata_query.h" - -String MDQuery::limitString() const -{ - if (limit == -1 && offset > 0) - REPORT_ERROR(ERR_MD_SQL, "Sqlite does not support OFFSET without LIMIT"); - std::stringstream ss; - if (limit != -1) - ss << " LIMIT " << limit << " "; - if (offset > 0) - ss << " OFFSET " << offset << " "; - return ss.str(); -} - -String MDValueRange::queryStringFunc() const -{ - std::stringstream ss; - ss << "(" << query1->queryStringFunc() << " AND " << query2->queryStringFunc() << ")"; - return ss.str(); -} - -String MDMultiQuery::queryStringFunc() const -{ - if (queries.size() > 0) - { - std::stringstream ss; - ss << "(" << queries[0]->queryStringFunc() << ") "; - for (size_t i = 1; i < queries.size(); i++) - ss << operations[i] << " (" << queries[i]->queryStringFunc() << ") "; - - return ss.str(); - } - return " "; -} diff --git a/src/core/metadata_query.h b/src/core/metadata_query.h deleted file mode 100644 index 2522806..0000000 --- a/src/core/metadata_query.h +++ /dev/null @@ -1,366 +0,0 @@ -/*************************************************************************** - * - * Authors: J.M. De la Rosa Trevin (jmdelarosa@cnb.csic.es) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_METADATAQUERY_H -#define CORE_METADATAQUERY_H - -#include - -#include "metadata_label.h" -#include "xmipp_error.h" -#include "metadata_static.h" - - -/** This is the base class for queries on MetaData. - * It is abstract, so it can not be instanciated. Queries will be very - * helpful for performing several tasks on MetaData like importing, searching - * or removing objects. - */ -class MDQuery -{ -public: - int limit; ///< If distint of -1 the results will be limited to this value - int offset; ///< If distint of 0, offset elements will be discarded - MDLabel orderLabel; ///< Label to which apply sort of the results - bool asc; - - /** Constructor. */ - MDQuery(int limit = -1, int offset = 0, MDLabel orderLabel = MDL_OBJID,bool asc=true) - { - this->limit = limit; - this->offset = offset; - this->orderLabel = orderLabel; - this->asc=asc; - } - - /** Destructor */ - virtual ~MDQuery() {} - - /** Return the ORDER BY string to be used in SQL query */ - String orderByString() const - { - return (String)" ORDER BY " + MDL::label2Str(orderLabel) + (asc ? " ASC" : " DESC"); - } - - /** Return the LIMIT string to be used in SQL */ - String limitString() const; - - /** Return the WHERE string to be used in SQL query */ - String whereString() const - { - String queryString = this->queryStringFunc(); - return (queryString == " ") ? " " : " WHERE " + queryString + " "; - } - - /** Return the query string, should be overrided in subclasses */ - virtual String queryStringFunc() const - { - return " "; - } -} -;//End of class MDQuery - -/** @} */ - -/** Enumeration of all posible relational queries operations */ -enum RelationalOp -{ - EQ, ///< Equal - NE, ///< Not equal - GT, ///< Greater than - LT, ///< Less than - GE, ///< Greater equal - LE ///< Less equal -}; - -/** Subclass of MDQuery and base for all relational queries. - * This kind of query can be used to compare some LABEL values - * in a column of the MetaData with an specified VALUE. - * @see RelationalOp for possible relational operations. - */ -class MDValueRelational: public MDQuery -{ -public: - MDObject *value; - RelationalOp op; - - template - MDValueRelational(MDLabel label, const T &value, RelationalOp op, int limit = -1, int offset = 0, MDLabel orderLabel = MDL_OBJID):MDQuery(limit, offset, orderLabel) - { - this->op = op; - this->value = new MDObject(label, value); - } - - MDValueRelational(const MDObject &value, RelationalOp op, int limit = -1, int offset = 0, MDLabel orderLabel = MDL_OBJID):MDQuery(limit, offset, orderLabel) - { - this->op = op; - this->value = new MDObject(value); - } - - ~MDValueRelational() - { - delete this->value; - } - - String opString() const - { - switch (op) - { - case EQ: - return "="; - case NE: - return "!="; - case GT: - return ">"; - case LT: - return "<"; - case GE: - return ">="; - case LE: - return "<="; - default: - REPORT_ERROR(ERR_ARG_INCORRECT,"Unknown binary operator"); - } - } - - virtual String queryStringFunc() const - { - return (value == NULL) ? " " : MDL::label2Str(value->label) + opString() + value->toString(false, true); - } - - template - void setValue(T &value) - { - this->value->setValue(value); - } -} -;//end of class MDValueRelational - -/** Query if MetaData column values are equal to some specific value. - * @code - * ///Remove all images that are disabled - * MetaData md1, md2; - * md1.removeObjects(MDValueEQ(MDL_ENABLED, -1)); - * ///Import objects from md2 to md1 which rot angle is 0. - * md1.importObjects(md2, MDValueEQ(MDL_ANGLE_ROT, 0.)); - * @endcode - */ -class MDValueEQ: public MDValueRelational -{ -public: - template - MDValueEQ(MDLabel label, const T &value, int limit = -1, int offset = 0, MDLabel orderLabel = MDL_OBJID) - :MDValueRelational(label, value, EQ, limit, offset, orderLabel) - {} -} -;//end of class MDValueEQ - -/** Query if MetaData column values are distint than some specific value. - * @see MDValueEQ for examples of use. - */ -class MDValueNE: public MDValueRelational -{ -public: - template - MDValueNE(MDLabel label, const T &value, int limit = -1, int offset = 0, MDLabel orderLabel = MDL_OBJID) - :MDValueRelational(label, value, NE, limit, offset, orderLabel) - {} -} -;//end of class MDValueNE - -/** Query if MetaData column values are greater equal than some specific value. - * @see MDValueEQ for examples of use. - */ -class MDValueGE: public MDValueRelational -{ -public: - template - MDValueGE(MDLabel label, const T &valueMin, int limit = -1,int offset = 0, MDLabel orderLabel = MDL_OBJID) - :MDValueRelational(label, valueMin, GE, limit, offset, orderLabel) - {} -} -;//end of class MDValueGE - -/** Query if MetaData column values are greater than some specific value. - * @see MDValueEQ for examples of use. - */ -class MDValueGT: public MDValueRelational -{ -public: - template - MDValueGT(MDLabel label, const T &valueMin, int limit = -1,int offset = 0, MDLabel orderLabel = MDL_OBJID) - :MDValueRelational(label, valueMin, GT, limit, offset, orderLabel) - {} -} -;//end of class MDValueGT - -/** Query if MetaData column values are less or equal than some specific value. - * @see MDValueEQ for examples of use. - */ -class MDValueLE: public MDValueRelational -{ -public: - template - MDValueLE(MDLabel label, const T &valueMax, int limit = -1,int offset = 0, MDLabel orderLabel = MDL_OBJID) - :MDValueRelational(label, valueMax, LE, limit, offset, orderLabel) - {} -} -;//end of class MDValueLE - -/** Query if MetaData column values are less than some specific value. - * @see MDValueEQ for examples of use. - */ -class MDValueLT: public MDValueRelational -{ -public: - template - MDValueLT(MDLabel label, const T &valueMax, int limit = -1,int offset = 0, MDLabel orderLabel = MDL_OBJID) - :MDValueRelational(label, valueMax, LT, limit, offset, orderLabel) - {} -} -;//end of class MDValueLT - -/**This subclass of Query will test if a label have a value within a minimum and maximum. - * @code - * //Remove all images with rotational angle between 100 and 200 - * MetaData md; - * md.removeObjects(MDValueRange(MDL_ANGLE_ROT, 100., 200.)); - * @endcode - */ -class MDValueRange: public MDQuery -{ - MDValueRelational *query1, *query2; -public: - MDValueRange() - { - query1=query2=NULL; - } - template - MDValueRange(MDLabel label, const T &valueMin, const T &valueMax, - int limit = -1, int offset = 0, MDLabel orderLabel = MDL_OBJID):MDQuery(limit, offset, orderLabel) - { - query1 = new MDValueRelational(label, valueMin, GE); - query2 = new MDValueRelational(label, valueMax, LE); - } - - MDValueRange(const MDObject &o1, const MDObject &o2, - int limit = -1, int offset = 0, MDLabel orderLabel = MDL_OBJID):MDQuery(limit, offset, orderLabel) - { - if (o1.label != o2.label) - REPORT_ERROR(ERR_VALUE_INCORRECT, "Labels should be the same"); - query1 = new MDValueRelational(o1, GE); - query2 = new MDValueRelational(o2, LE); - - } - virtual String queryStringFunc() const; - - ~MDValueRange() - { - delete query1; - delete query2; - } -} -;//end of class MDValueRange - -/**This subclass of Query will select those entries that satisfy an expression. - * @code - * //Remove all images with rotational angle between 100 and 200 - * MetaData md; - * md.removeObjects(MDExpression("angleRot > 100 AND angleRot < 200")); - * @endcode - */ -class MDExpression: public MDQuery -{ - String sExpression; -public: - MDExpression() - { - sExpression = " 1=1 "; - } - MDExpression(String _sExpression, - int limit = -1, - int offset = 0, - MDLabel orderLabel = MDL_OBJID):MDQuery(limit, offset, orderLabel) - { - sExpression=_sExpression; - } - - virtual String queryStringFunc() const - { - return sExpression; - } - -} -;//end of class MDExpression - -/** Query several conditions using AND and OR. - * This kind of query if useful if you want to check - * two conditions at the same time, for example, import - * all images that are enabled and have rotational angle greater than 100. - * @code - * MetaData md1, md2; - * MDValueEQ eq(MDL_ENABLED, 1); - * MDValueGT gt(MDL_ANGLE_ROT, 100.); - * MDMultiQuery multi; - * //The first query added has the same effect doing with AND or OR - * multi.addAndQuery(eq); - * multi.addAndQuery(gt); - * - * md1.importObjects(md2, multi); - * @endcode - */ -class MDMultiQuery: public MDQuery -{ -public: - std::vector queries; - std::vector operations; - - MDMultiQuery(int limit = -1, int offset = 0, MDLabel orderLabel = MDL_OBJID):MDQuery(limit, offset, orderLabel) - { - clear(); - } - void addAndQuery(MDQuery &query) - { - queries.emplace_back(&query); - operations.emplace_back("AND"); - } - void addOrQuery(MDQuery &query) - { - queries.emplace_back(&query); - operations.emplace_back("OR"); - } - - void clear() - { - queries.clear(); - operations.clear(); - } - - virtual String queryStringFunc() const; - -} -;//end of class MDMultiQuery - -#endif diff --git a/src/core/metadata_row_base.h b/src/core/metadata_row_base.h deleted file mode 100644 index 073e873..0000000 --- a/src/core/metadata_row_base.h +++ /dev/null @@ -1,205 +0,0 @@ -/*************************************************************************** - * - * Authors: J.M. De la Rosa Trevin (jmdelarosa@cnb.csic.es) - * Jan Horacek (xhorace4@fi.muni.cz) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * Institute of Computer Science MUNI - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_METADATA_ROW_BASE_H -#define CORE_METADATA_ROW_BASE_H - -#include "metadata_label.h" -#include "metadata_object.h" -#include "choose.h" -#include - -/** Get value */ -// template -// void getValueOrAbort(MDLabel label, T &d) const -// { -// if (!getValue(label, d)) -// REPORT_ERROR(ERR_ARG_MISSING,(String)"Cannot find label: " + MDL::label2Str(label) ); -// //formatString("%d",label) ); -// } -//weite function as macro since MDL::label2Str is not availale at class compilation time -#define rowGetValueOrAbort(__row,__label, __d)\ - if (!__row.getValue(__label, __d))\ - REPORT_ERROR(ERR_ARG_MISSING,(String)"Cannot find label: " + MDL::label2Str(__label) ); - - -/** Common API of all metadata rows (abstract class). - * Classes like MDRowVec & MDRowSql implement this API. - */ -class MDRow { -public: - /* Row could be attached to metadata (contains pointers to MetaData) or detached - * from metadata (contains data itself). To detach row, call this method. - */ - virtual void detach() {} - - virtual bool empty() const = 0; - virtual int size() const = 0; /** Return number of labels present */ - virtual void clear() = 0; - - virtual MDRow& operator = (const MDRow&) = 0; - virtual ~MDRow() = default; - - virtual size_t id() const { - return getObject(MDL_OBJID)->getValue2(size_t()); - } - - virtual bool containsLabel(MDLabel label) const = 0; - virtual std::vector labels() const = 0; - virtual void addLabel(MDLabel label) = 0; - - /** Reset the values of the labels related to - * geometry to their default values - */ - virtual void resetGeo(bool addLabels = true) { - setValue(MDL_ORIGIN_X, 0., addLabels); - setValue(MDL_ORIGIN_Y, 0., addLabels); - setValue(MDL_ORIGIN_Z, 0., addLabels); - setValue(MDL_SHIFT_X, 0., addLabels); - setValue(MDL_SHIFT_Y, 0., addLabels); - setValue(MDL_SHIFT_Z, 0., addLabels); - setValue(MDL_ANGLE_ROT, 0., addLabels); - setValue(MDL_ANGLE_TILT,0., addLabels); - setValue(MDL_ANGLE_PSI, 0., addLabels); - setValue(MDL_WEIGHT, 1., addLabels); - setValue(MDL_FLIP, false, addLabels); - setValue(MDL_SCALE, 1., addLabels); - } - - virtual MDObject* getObject(MDLabel label) = 0; - virtual const MDObject* getObject(MDLabel label) const = 0; - - template - T& getValue(MDLabel label) { - MDObject* ptr = getObject(label); - if (ptr == nullptr) - throw std::logic_error("Object does not exist!"); - return ptr->getValue2(T()); - } - - template - const T& getValue(MDLabel label) const { - const MDObject* ptr = getObject(label); - if (ptr == nullptr) - throw std::logic_error("Object does not exist!"); - return ptr->getValue2(T()); - } - - template - bool getValue(MDLabel label, T &d) const { // FIXME: deprecated - auto *obj = getObject(label); - if (obj == nullptr) - return false; - d = obj->getValue2(T()); - return true; - } - - bool getValue(MDObject &object) const { // FIXME: deprecated - const MDObject* ptr = this->getObject(object.label); - if (ptr != nullptr) - object = *ptr; - return (ptr != nullptr); - } - - template - const T& getValueOrDefault(MDLabel label, const T& def) const { - const MDObject* ptr = getObject(label); - if (ptr == nullptr) - return def; - return ptr->getValue2(T()); - } - - template - T& getValueOrDefault(MDLabel label, const T& def) { - const MDObject* ptr = getObject(label); - if (ptr == nullptr) - return def; - return ptr->getValue2(T()); - } - - template - void getValueOrDefault(MDLabel label, T &d, T1 def) const { // FIXME: deprecated - if (!getValue(label, d)) - d = (T) def; - } - - template - void setValue(MDLabel label, const T &d, bool addLabel = true) { - if (this->containsLabel(label) || addLabel) - this->setValue(MDObject(label, d)); - } - - virtual void setValue(const MDObject &object) = 0; - - virtual void setValueFromStr(MDLabel label, const String &value) { - MDObject mdValue(label); - mdValue.fromString(value); - setValue(mdValue); - } - - friend std::ostream& operator << (std::ostream &out, const MDRow &row); - - template - class iterator_ptr { - size_t i; - const MDRow* row; - - public: - iterator_ptr(size_t i, const MDRow& row) : i(i), row(&row) {} - iterator_ptr(iterator_ptr const& right) : i(right.i), row(right.row) {} - iterator_ptr& operator=(iterator_ptr const& right) { - i = right.i; - row = right.row; - return *this; - } - iterator_ptr& operator++() { - ++i; - return *this; - } - typename TypeHelpers::choose::type operator*() const { - return row->iteratorValue(i); - } - bool operator==(const iterator_ptr& other) const { return other.i == this->i; } - bool operator!=(const iterator_ptr& other) const { return !(*this == other); } - }; - - using iterator = iterator_ptr; - using const_iterator = iterator_ptr; - - iterator begin() { return iterator_ptr(0, *this); } - iterator end() { return iterator_ptr(this->size(), *this); } - - const_iterator begin() const { return iterator_ptr(0, *this); } - const_iterator end() const { return iterator_ptr(this->size(), *this); } - -private: - - virtual MDObject* iteratorValue(size_t i) = 0; - virtual const MDObject* iteratorValue(size_t i) const = 0; -}; - -#endif diff --git a/src/core/metadata_row_sql.cpp b/src/core/metadata_row_sql.cpp deleted file mode 100644 index 692cd26..0000000 --- a/src/core/metadata_row_sql.cpp +++ /dev/null @@ -1,162 +0,0 @@ -/*************************************************************************** - * - * Authors: J.M. De la Rosa Trevin (jmdelarosa@cnb.csic.es) - * Jan Horacek (xhorace4@fi.muni.cz) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include -#include -#include "metadata_row_sql.h" - -MDRowSql::MDRowSql() { - _size = 0; - _objects.fill(nullptr); -} - -MDRowSql::MDRowSql(const MDRowSql &row) { - _size = 0; - _objects.fill(nullptr); - copy(row); -} - -MDRowSql& MDRowSql::operator = (const MDRowSql &row) { - copy(row); - return *this; -} - -MDRow& MDRowSql::operator = (const MDRow& row) { - *this = dynamic_cast(row); - return *this; -} - -MDRowSql::MDRowSql(const std::vector &values) { - _objects.fill(nullptr); - for (size_t i = 0; i < values.size(); i++) { - _objects[values[i].label] = new MDObject(values[i]); - _order[i] = values[i].label; - } -} - -MDRowSql::~MDRowSql() { - for (int _label = MDL_FIRST_LABEL; _label < MDL_LAST_LABEL; ++_label) { - if (_objects[_label] != nullptr) - delete _objects[_label]; - } -} - -bool MDRowSql::empty() const { - return _size == 0; -} - -int MDRowSql::size() const { - return _size; -} - -void MDRowSql::clear() { - _size = 0; - for (int _label = MDL_FIRST_LABEL; _label < MDL_LAST_LABEL; ++_label) { - if (_objects[_label] != nullptr) - delete _objects[_label]; - _objects[_label] = nullptr; - } -} - -bool MDRowSql::containsLabel(MDLabel label) const { - return _objects[label] != nullptr; -} - -std::vector MDRowSql::labels() const { - std::vector res; - res.reserve(_size); - for (size_t i = 0; i < _size; ++i) { - const MDLabel &label = _order[i]; - if (containsLabel(label)) - res.emplace_back(label); - } - return res; -} - -void MDRowSql::addLabel(MDLabel label) { - if (_objects[label] == nullptr) { - _objects[label] = new MDObject(label); - _order[_size] = label; - ++_size; - } -} - -const MDObject *MDRowSql::getObject(MDLabel label) const { - return _objects[label]; -} - -MDObject *MDRowSql::getObject(MDLabel label) { - return _objects[label]; -} - -void MDRowSql::setValue(const MDObject &object) { - int _label = object.label; - if (_objects[_label] == nullptr) { - _objects[_label] = new MDObject(object); - _order[_size] = object.label; - ++_size; - } else - _objects[_label]->copy(object); -} - -void MDRowSql::copy(const MDRowSql &row) { - //Copy existing MDObjects from row - //and delete unexisting ones - _size = row._size; - MDObject ** ptrObjectsLabel=&(_objects[0]); - MDObject * const * ptrRowObjectsLabel=&(row._objects[0]); - for (int _label = MDL_FIRST_LABEL; _label < MDL_LAST_LABEL; ++_label) { - if (*ptrRowObjectsLabel == nullptr) { - delete *ptrObjectsLabel; - *ptrObjectsLabel = nullptr; - } else { - if (*ptrObjectsLabel == nullptr) - *ptrObjectsLabel = new MDObject(*(*ptrRowObjectsLabel)); - else - (*ptrObjectsLabel)->copy(*(*ptrRowObjectsLabel)); - } - ++ptrObjectsLabel; - ++ptrRowObjectsLabel; - } - //copy the order of labels - _order = row._order; -} - -MDObject* MDRowSql::iteratorValue(size_t i) { - return _objects[_order[i]]; -} - -const MDObject* MDRowSql::iteratorValue(size_t i) const { - return _objects[_order[i]]; -} - -std::ostream& operator << (std::ostream &out, const MDRowSql &row) { - for (size_t i = 0; i < row._size; ++i) { - row._objects[row._order[i]]->toStream(out); - out << " "; - } - return out; -} diff --git a/src/core/metadata_row_sql.h b/src/core/metadata_row_sql.h deleted file mode 100644 index f2b2bb2..0000000 --- a/src/core/metadata_row_sql.h +++ /dev/null @@ -1,103 +0,0 @@ -/*************************************************************************** - * - * Authors: J.M. De la Rosa Trevin (jmdelarosa@cnb.csic.es) - * Jan Horacek (xhorace4@fi.muni.cz) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * Institute of Computer Science MUNI - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_METADATA_ROW_SQL_H -#define CORE_METADATA_ROW_SQL_H - -#include "metadata_row_base.h" - -#include - -/** Class for holding an entire row of MDObject in MetaDataDb. */ -class MDRowSql : public MDRow { -private: - // Reserve space for the maximum different labels - // this will allow constant access to each object indexing by labels - std::array _objects; // label to object; nullptr if none - std::array _order; // index to label (_order[0] = label for column 0) - size_t _size; // Number of active labels - size_t _id; - - void copy(const MDRowSql &row); - MDObject* iteratorValue(size_t i) override; - const MDObject* iteratorValue(size_t i) const override; - -public: - MDRowSql(); - ~MDRowSql(); - MDRowSql(const MDRowSql &row); - MDRowSql(const std::vector &values); - MDRow& operator = (const MDRow&) override; - MDRowSql& operator = (const MDRowSql &row); - - size_t id() const override { return this->_id; } - void set_id(size_t id) { this->_id = id; } - - bool empty() const override; - int size() const override; - void clear() override; - - bool containsLabel(MDLabel label) const override; - std::vector labels() const override; - void addLabel(MDLabel label) override; - - MDObject *getObject(MDLabel label) override; - const MDObject *getObject(MDLabel label) const override; - - void setValue(const MDObject &object) override; - - friend std::ostream& operator << (std::ostream &out, const MDRowSql &row); - - // Templated functions from base class must be retemplated - - template - T& getValue(MDLabel label) { return MDRow::getValue(label); } - - template - const T& getValue(MDLabel label) const { return MDRow::getValue(label); } - - template - bool getValue(MDLabel label, T &d) const { // FIXME: deprecated - return MDRow::getValue(label, d); - } - - template - const T& getValueOrDefault(MDLabel label, const T& def) const { return MDRow::getValueOrDefault(label, def); } - - template - T& getValueOrDefault(MDLabel label, const T& def) { return MDRow::getValueOrDefault(label, def); } - - template - void getValueOrDefault(MDLabel label, T &d, T1 def) const { // FIXME: deprecated - return MDRow::getValueOrDefault(label, d, def); - } - - template - void setValue(MDLabel label, const T &d, bool addLabel = true) { return MDRow::setValue(label, d, addLabel); } -}; - -#endif diff --git a/src/core/metadata_row_vec.cpp b/src/core/metadata_row_vec.cpp deleted file mode 100644 index 3e4addf..0000000 --- a/src/core/metadata_row_vec.cpp +++ /dev/null @@ -1,231 +0,0 @@ -/*************************************************************************** - * - * Authors: Jan Horacek (xhorace4@fi.muni.cz) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include -#include -#include -#include "metadata_row_vec.h" - -MDRowVec::MDRowVec() - : _col_to_label(nullptr), _no_columns(nullptr), _in_metadata(false) { - _row = new std::vector(); - _label_to_col = new std::array(); - std::fill(_label_to_col->begin(), _label_to_col->end(), -1); -} - -MDRowVec::MDRowVec(std::vector& row, size_t rowi, std::array& label_to_col, - std::vector& col_to_label, size_t& no_columns) - : _row(&row), _rowi(rowi), _label_to_col(&label_to_col), _col_to_label(&col_to_label), - _no_columns(&no_columns), _in_metadata(true) - {} - -MDRowVec::MDRowVec(const std::vector& row, size_t rowi, const std::array& label_to_col, - const std::vector& col_to_label, const size_t& no_columns) - : _row(const_cast*>(&row)), - _rowi(rowi), - _label_to_col(const_cast*>(&label_to_col)), - _col_to_label(const_cast*>(&col_to_label)), - _no_columns(const_cast(&no_columns)), - _in_metadata(true) - // This is very nasty hack. I was unable to solve situation nicely. - // Creator of the object must pay close attention to create 'const MDRowVec' when instantiating from - // const MetaData. This should be ok as crator is only in MetaDataVec. - {} - -MDRowVec::MDRowVec(const MDRowVec &other) - : _rowi(other._rowi), _col_to_label(other._col_to_label), _no_columns(other._no_columns), - _in_metadata(other._in_metadata) - { - if (_in_metadata) { - _row = other._row; - _label_to_col = other._label_to_col; - } else { - _row = new std::vector(*(other._row)); - _label_to_col = new std::array(*(other._label_to_col)); - } -} - -MDRowVec MDRowVec::deepCopy(const MDRowVec& row) { - MDRowVec newRow(row); - if (newRow._in_metadata) - newRow.detach(); - return newRow; -} - -void MDRowVec::detach() { - if (!this->_in_metadata) - return; - - this->_in_metadata = false; - this->_row = new std::vector(*(this->_row)); - this->_label_to_col = new std::array(*(this->_label_to_col)); - this->_col_to_label = nullptr; - this->_no_columns = nullptr; -} - -MDRowVec &MDRowVec::operator = (const MDRowVec &other) { - if (this == &other) - return *this; - - if (!_in_metadata) { - delete _row; - delete _label_to_col; - } - - _rowi = other._rowi; - _no_columns = other._no_columns; - _in_metadata = other._in_metadata; - _col_to_label = other._col_to_label; - - if (_in_metadata) { - _row = other._row; - _label_to_col = other._label_to_col; - } else { - _row = new std::vector(*(other._row)); - _label_to_col = new std::array(*(other._label_to_col)); - } - - return *this; -} - -MDRow& MDRowVec::operator = (const MDRow& row) { - *this = dynamic_cast(row); - return *this; -} - -MDRowVec::~MDRowVec() { - if (!_in_metadata) { - delete _row; - delete _label_to_col; - } -} - -bool MDRowVec::empty() const { - return _row->size() == 0; -} - -int MDRowVec::size() const { - return _row->size(); -} - -void MDRowVec::clear() { - _row->clear(); - if (!_in_metadata) - std::fill(_label_to_col->begin(), _label_to_col->end(), -1); -} - -bool MDRowVec::containsLabel(MDLabel label) const { - return (*_label_to_col)[label] >= 0; -} - -std::vector MDRowVec::labels() const { - std::vector res; - res.reserve(_row->size()); - for (const auto mdObj: *_row) - res.emplace_back(mdObj.label); - return res; -} - -void MDRowVec::addLabel(MDLabel label) { - // Warning: not adding to all rows! - if ((*_label_to_col)[label] < 0) - newCol(label); -} - -size_t MDRowVec::newCol(const MDLabel label) { - size_t i; - if (_no_columns != nullptr) - i = (*_no_columns)++; - else - i = _row->size(); - - if (_col_to_label != nullptr) { - while (_row->size() < i) { - size_t j = _row->size(); - _row->emplace_back(MDObject((*_col_to_label).at(j))); - } - if (i < (*_col_to_label).size()) { - (*_col_to_label).at(i) = label; - } else { - assert(i == (*_col_to_label).size()); - (*_col_to_label).push_back(label); - } - } - - assert(_row->size() == i); - (*_label_to_col).at(label) = i; - _row->emplace_back(MDObject(label)); - return i; -} - -MDObject *MDRowVec::getObject(MDLabel label) { - if ((*_label_to_col)[label] < 0) - return nullptr; - if ((*_label_to_col)[label] >= static_cast(_row->size())) - return nullptr; - return &_row->at((*_label_to_col)[label]); -} - -const MDObject *MDRowVec::getObject(MDLabel label) const { - if ((*_label_to_col)[label] < 0) - return nullptr; - if ((*_label_to_col)[label] >= static_cast(_row->size())) - return nullptr; - return &_row->at((*_label_to_col)[label]); -} - -void MDRowVec::setValue(const MDObject &object) { - MDLabel _label = object.label; - int coli = (*_label_to_col)[_label]; - if (coli < 0) { - size_t i = newCol(_label); - (*_row)[i] = object; - } else { - while (_row->size() <= coli) { - size_t j = _row->size(); - _row->emplace_back(MDObject((*_col_to_label)[j])); - } - - (*_row)[(*_label_to_col)[_label]] = object; - } -} - -MDObject* MDRowVec::iteratorValue(size_t i) { - return &(*_row)[i]; -} - -const MDObject* MDRowVec::iteratorValue(size_t i) const { - return &(*_row)[i]; -} - -std::ostream& operator << (std::ostream &out, const MDRowVec &row) { - for (int i = 0; i < row.size(); ++i) { - (*(row._row))[i].toStream(out); - out << " "; - } - return out; -} - -bool MDRowVec::inMetadata() const { return _in_metadata; } diff --git a/src/core/metadata_row_vec.h b/src/core/metadata_row_vec.h deleted file mode 100644 index ea122c7..0000000 --- a/src/core/metadata_row_vec.h +++ /dev/null @@ -1,120 +0,0 @@ -/*************************************************************************** - * - * Authors: Jan Horacek (xhorace4@fi.muni.cz) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * Institute of Computer Science MUNI - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_METADATA_ROW_VEC_H -#define CORE_METADATA_ROW_VEC_H - -#include "metadata_row_base.h" - -#include - -/** Class for holding an entire row of MDObject in MetaDataVec. - * Row could be attached to OR detached from metadata - * - Detached row: holds its own _row & _label_to_col. When copied, content of - * these objects is copied, not just pointer. - * - Attached row: _row and _label_to_col points directly to Metadata object. - * When copied, just pointers are copied. Assumed to be read-only. - * - * ### Notes - * 1. It's fast to create MDRowVec from MetaDataVec row, because only pointers - * are initialized. No data are copied. - * 2. Adding MDRowVec to MetaDataVec requires copying whole row. - */ -class MDRowVec : public MDRow { -private: - std::vector* _row; - size_t _rowi; - std::array* _label_to_col; - std::vector* _col_to_label; - size_t* _no_columns; // global number of columns in whole MetaData - bool _in_metadata; - - MDObject* iteratorValue(size_t i) override; - const MDObject* iteratorValue(size_t i) const override; - size_t newCol(const MDLabel); - -public: - static MDRowVec deepCopy(const MDRowVec&); - - MDRowVec(); - MDRowVec(std::vector& row, size_t rowi, std::array& label_to_col, - std::vector& col_to_label, size_t& no_columns); - MDRowVec(const std::vector& row, size_t rowi, const std::array& label_to_col, - const std::vector& col_to_label, const size_t& no_columns); - MDRowVec(const MDRowVec&); - MDRowVec& operator = (const MDRowVec&); - MDRow& operator = (const MDRow& row); - virtual ~MDRowVec(); - - void detach() override; - - bool empty() const override; - int size() const override; - void clear() override; - bool inMetadata() const; - - bool containsLabel(MDLabel label) const override; - std::vector labels() const override; - void addLabel(MDLabel label) override; - - MDObject *getObject(MDLabel label) override; - const MDObject *getObject(MDLabel label) const override; - - void setValue(const MDObject &object) override; - - friend std::ostream& operator << (std::ostream &out, const MDRowVec &row); - - // Templated functions from based class must be retemplated - - template - T& getValue(MDLabel label) { return MDRow::getValue(label); } - - template - const T& getValue(MDLabel label) const { return MDRow::getValue(label); } - - template - bool getValue(MDLabel label, T &d) const { // FIXME: deprecated - return MDRow::getValue(label, d); - } - - template - const T& getValueOrDefault(MDLabel label, const T& def) const { return MDRow::getValueOrDefault(label, def); } - - template - T& getValueOrDefault(MDLabel label, const T& def) { return MDRow::getValueOrDefault(label, def); } - - template - void getValueOrDefault(MDLabel label, T &d, T1 def) const { // FIXME: deprecated - return MDRow::getValueOrDefault(label, d, def); - } - - template - void setValue(MDLabel label, const T &d, bool addLabel = true) { return MDRow::setValue(label, d, addLabel); } - - friend class MetaDataVec; -}; - -#endif diff --git a/src/core/metadata_sql.cpp b/src/core/metadata_sql.cpp deleted file mode 100644 index 365b26d..0000000 --- a/src/core/metadata_sql.cpp +++ /dev/null @@ -1,1603 +0,0 @@ -/*************************************************************************** - * - * Authors: J.M. De la Rosa Trevin (jmdelarosa@cnb.csic.es) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include -#include -#include -#include "metadata_sql.h" -#include "xmipp_threads.h" -#include "xmipp_filename.h" -#include "metadata_db.h" - -//#define DEBUG - -//This is needed for static memory allocation -int MDSql::table_counter = 0; -sqlite3 *MDSql::db; -MDSqlStaticInit MDSql::initialization; -char *MDSql::errmsg; -const char *MDSql::zLeftover; -int MDSql::rc; -Mutex sqlMutex; //Mutex to syncronize db access - -std::stringstream MDSql::preparedStream; // Stream. -sqlite3_stmt * MDSql::preparedStmt; - -void sqlite_regexp(sqlite3_context* context, int argc, sqlite3_value** values) { - int ret; - regex_t regex; - char* reg = (char*)sqlite3_value_text(values[0]); - char* text = (char*)sqlite3_value_text(values[1]); - - if ( argc != 2 || reg == 0 || text == 0) { - sqlite3_result_error(context, "SQL function regexp() called with invalid arguments.\n", -1); - return; - } - - ret = regcomp(®ex, reg, REG_EXTENDED | REG_NOSUB); - if ( ret != 0 ) { - sqlite3_result_error(context, "error compiling regular expression", -1); - return; - } - - ret = regexec(®ex, text , 0, NULL, 0); - regfree(®ex); - - sqlite3_result_int(context, (ret != REG_NOMATCH)); -} - -int getBlocksInMetaDataFileDB(const FileName &inFile, StringVector& blockList) -{ - char **results; - int rows; - int columns; - int rc; - - sqlite3 *db1; - String sql = (String)"SELECT name FROM sqlite_master\ - WHERE type='table';"; - if ((rc=sqlite3_open(inFile.c_str(), &db1))) - REPORT_ERROR(ERR_MD_SQL,formatString("Error opening database code: %d message: %s",rc,sqlite3_errmsg(db1))); - if ((rc=sqlite3_get_table (db1, sql.c_str(), &results, &rows, &columns, NULL)) != SQLITE_OK) - REPORT_ERROR(ERR_MD_SQL,formatString("Error accessing table code: %d message: %s. SQL command %s",rc,sqlite3_errmsg(db1),sql.c_str())); - //For tables, the type field will always be 'table' and the name field will - //be the name of the table. So to get a list of all tables in the database, - - if (rows < 1) - { - std::cerr << "Empty Metadata" <>>> creating md with table id: " << tableId << std::endl; - sqlMutex.unlock(); - myMd = md; - myCache = new MDCache(); - beThreadSafe = false; - -} - -MDSql::~MDSql() -{ - delete myCache; -} - -bool MDSql::createMd() -{ - sqlMutex.lock(); - //std::cerr << "creating md" <_activeLabels)); - //std::cerr << "leave creating md" <clear(); - bool result = dropTable(); - //std::cerr << "leave clearing md" <addRowStmt; - //sqlite3_stmt * stmt = NULL; - - if (stmt == NULL) - { - std::stringstream ss; - ss << "INSERT INTO " << tableName(tableId) << " DEFAULT VALUES;"; - sqlite3_prepare_v2(db, ss.str().c_str(), -1, &stmt, &zLeftover); -//#define DEBUG -#ifdef DEBUG - std::cerr << "DEBUG_JM: addRow: " << ss.str() < &oldLabel, const std::vector &newlabel) -{ - //1 Create an new table that matches your original table, - // but with the changed columns. - bool result; - std::vector v1(myMd->_activeLabels); - std::vector::const_iterator itOld; - std::vector::const_iterator itNew; - for( itOld = oldLabel.begin(), itNew = newlabel.begin(); - itOld < oldLabel.end(); - ++itOld, ++itNew ) - std::replace(v1.begin(), v1.end(), *itOld, *itNew); - - int oldTableId = tableId; - sqlMutex.lock(); - tableId = getUniqueId(); - createTable(&v1); - sqlMutex.unlock(); - //2 Now we can copy the original data to the new table: - String oldLabelString=" objID"; - String newLabelString=" objID"; - for(std::vector::const_iterator it = (myMd->_activeLabels) - .begin(); - it != (myMd->_activeLabels).end(); - ++it) - oldLabelString += ", " + MDL::label2StrSql(*it); - for(std::vector - ::const_iterator it = v1.begin(); - it != v1.end(); - ++it) - newLabelString += ", " + MDL::label2StrSql(*it); - std::stringstream sqlCommand; - sqlCommand << " INSERT INTO " + tableName(tableId) - << " ("+ newLabelString +") " - << " SELECT " + oldLabelString - << " FROM " + tableName(oldTableId) ; - execSingleStmt(sqlCommand); - //drop old table - sqlCommand.str(std::string()); - sqlCommand << "DROP TABLE " << tableName(oldTableId); - execSingleStmt(sqlCommand); - //rename new table - sqlCommand.str(std::string()); - sqlCommand << " ALTER TABLE " << tableName(tableId) - << " RENAME TO " << tableName(oldTableId); - result = execSingleStmt(sqlCommand); - tableId=oldTableId; - myMd->_activeLabels=v1; - return result; -} - -size_t MDSql::size(void) -{ - std::stringstream ss; - ss << "SELECT COUNT(*) FROM "<< tableName(tableId) << ";"; - return execSingleIntStmt(ss); -} - -template bool MDSql::setObjectValues(int id, const std::vector &columnValues, const std::vector *desiredLabels); -template bool MDSql::setObjectValues(int id, const std::vector &columnValues, const std::vector *desiredLabels); - -template -bool MDSql::setObjectValues(int id, const std::vector &columnValues, const std::vector *desiredLabels) -{ - bool r = true; // Return value. - int rc; - size_t columnCount = 0; - - // Add values. - if (desiredLabels == nullptr) - { - bindValue(this->preparedStmt, 1, *(columnValues[0])); - for (size_t i=1; ipreparedStmt, i+1, *(columnValues[i])); - columnCount = columnValues.size(); - } - // Add only desired columns. - else - { - for (size_t i=0; isize() ;i++) - { - for (size_t j=0; jlabel == (*desiredLabels)[i]) - { - bindValue(this->preparedStmt, i+1, *(columnValues[j])); - break; - } - } - } - columnCount = desiredLabels->size(); - } - - // id != -1 means there is a WHERE clause in the query sentence and id must be added. - if (id != -1) - sqlite3_bind_int(this->preparedStmt, columnCount, id); - - // Execute statement. - rc = sqlite3_step( this->preparedStmt); - if (rc != SQLITE_OK && rc != SQLITE_ROW && rc != SQLITE_DONE) - { - std::cerr << "MDSql::setObjectValue(MDObject): " << std::endl - << " " << this->preparedStream.str() << std::endl - <<" code: " << rc << " error: " << sqlite3_errmsg(db) << std::endl; - r = false; - } - - // Reset statement and bindings. - sqlite3_clear_bindings(this->preparedStmt); - sqlite3_reset(this->preparedStmt); - - return r; -} - -void MDSql::finalizePreparedStmt(void) -{ - if (this->preparedStmt != NULL) - { - sqlite3_finalize( this->preparedStmt); - this->preparedStmt = NULL; - } -} - -//set column with a given value -bool MDSql::setObjectValue(const MDObject &value) -{ - bool r = true; - int rc; - MDLabel column = value.label; - std::stringstream ss; - sqlite3_stmt * stmt; - ss << "UPDATE " << tableName(tableId) - << " SET " << MDL::label2StrSql(column) << "=?;"; - rc = sqlite3_prepare_v2(db, ss.str().c_str(), -1, &stmt, &zLeftover); - bindValue(stmt, 1, value); - rc = sqlite3_step(stmt); - if (rc != SQLITE_OK && rc != SQLITE_ROW && rc != SQLITE_DONE) - { - std::cerr << "MDSql::setObjectValue(MDObject): " << std::endl - << " " << ss.str() << std::endl - <<" code: " << rc << " error: " << sqlite3_errmsg(db) << std::endl; - r = false; - } - sqlite3_finalize(stmt); - return r; -} - -bool MDSql::setObjectValue(const int objId, const MDObject &value) -{ - bool r = true; - int rc; - MDLabel column = value.label; - std::stringstream ss; - //Check cached statements for setObjectValue - sqlite3_stmt * &stmt = myCache->setValueCache[column]; - //sqlite3_stmt * stmt = NULL; - if (stmt == NULL)//if not exists create the stmt - { - std::string sep = (MDL::isString(column) || MDL::isVector(column)) ? "'" : ""; - ss << "UPDATE " << tableName(tableId) - << " SET " << MDL::label2StrSql(column) << "=? WHERE objID=?;"; -//#define DEBUG -#ifdef DEBUG - std::cerr << "DEBUG_JM: setObjectValue: " << ss.str() << std::endl; - -#endif - - sqlite3_prepare_v2(db, ss.str().c_str(), -1, &stmt, &zLeftover); - } - sqlite3_reset(stmt); - bindValue(stmt, 1, value); - sqlite3_bind_int(stmt, 2, objId); - rc = sqlite3_step(stmt); - if (rc != SQLITE_OK && rc != SQLITE_ROW && rc != SQLITE_DONE) - { - std::cerr << "MDSql::setObjectValue: " << std::endl - << " " << ss.str() << std::endl - <<" code: " << rc << " error: " << sqlite3_errmsg(db) << std::endl; - r = false; - } - - return r; -} - -bool MDSql::initializeSelect( bool addWhereObjId, const std::vector &labels) -{ - bool createdOK=true; // Return value. - std::stringstream ss; // Sentence string. - - // Initialize SELECT sentence. - ss << "SELECT "; - - // Add columns names. - if (labels.size() > 0) - { - // Add columns names. - ss << MDL::label2StrSql(labels[0]); - for (size_t i=1; ipreparedStmt, &zLeftover) != SQLITE_OK) - { - createdOK = false; - printf( "could not prepare statement: %s\n", sqlite3_errmsg(db) ); - this->preparedStmt = NULL; - } - - return(createdOK); -} - -bool MDSql::initializeInsert(const std::vector *labels, const std::vector &values) -{ - int i=0; // Loop counter. - int length=0; // # labels. - bool createdOK=true; // Return value. - - // Clear preparedStream. - this->preparedStream.str(std::string()); - - // Initialize SQL sentence. - this->preparedStream << "INSERT INTO " << tableName(tableId); - - // Add columns. - this->preparedStream << " ("; - - // Execute branch if "labels" size is not zero. - if (labels != NULL) - { - length = labels->size(); - this->preparedStream << MDL::label2StrSql((*labels)[0]); - for (i=1; ipreparedStream << "," << MDL::label2StrSql((*labels)[i]); - } - } - // Execute branch if "values" size is not zero. - else if ((length = values.size()) > 0) - { - this->preparedStream << MDL::label2StrSql((*values[0]).label); - for (i=1; ipreparedStream << "," << MDL::label2StrSql((*values[i]).label); - } - } - - // Add one '?' character for each label. - this->preparedStream << ") VALUES (?"; - for (i=1; ipreparedStream << ",?"; - } - this->preparedStream << ");"; - - // Prepare statement. - if (sqlite3_prepare_v2(db, this->preparedStream.str().c_str(), -1, &this->preparedStmt, &zLeftover) != SQLITE_OK) - { - printf( "initializeInsert: could not prepare statement: %s\n", sqlite3_errmsg(db) ); - this->preparedStmt = NULL; - createdOK = false; - } - - return(createdOK); -} - -bool MDSql::getObjectsValues(const std::vector &labels, std::vector &values) -{ - bool ret=true; // Return value. - - // Execute statement. - if (sqlite3_step(this->preparedStmt) == SQLITE_ROW) - { - const auto noOfLabels = labels.size(); - for (size_t i=0; i < noOfLabels; i++) - { - if (labels[i] != MDL_STAR_COMMENT) - { - values.emplace_back(labels[i]); - auto &value = values.back(); - extractValue(this->preparedStmt, i, value); - } - } - } - // If no row retrieved then return false. - else - { - ret = false; - } - - return(ret); -} - -bool MDSql::getObjectValue(const int objId, MDObject &value) -{ - if (beThreadSafe) { sqlMutex.lock(); } - std::stringstream ss; - MDLabel column = value.label; - sqlite3_stmt * &stmt = myCache->getValueCache[column]; - - if (stmt == NULL)//prepare stmt if not exists - { - //std::cerr << "Creating cache " << ++count < &objectsOut, const MDQuery *queryPtr) -{ - std::stringstream ss; - sqlite3_stmt *stmt; - objectsOut.clear(); - - ss << "SELECT objID FROM " << tableName(tableId); - if (queryPtr != NULL) - { - ss << queryPtr->whereString(); - ss << queryPtr->orderByString(); - ss << queryPtr->limitString(); - } - sqlite3_prepare_v2(db, ss.str().c_str(), -1, &stmt, &zLeftover); -#ifdef DEBUG - - std::cerr << "selectObjects: " << ss.str() <whereString(); - - if (execSingleStmt(ss)) - { - return sqlite3_changes(db); - } - return 0; - -} - -size_t MDSql::copyObjects(MetaDataDb *mdPtrOut, const MDQuery *queryPtr) const -{ - return copyObjects(mdPtrOut->myMDSql, queryPtr); -} - -size_t MDSql::copyObjects(MDSql * sqlOut, const MDQuery *queryPtr) const -{ - //NOTE: Is assumed that the destiny table has - // the same columns that the source table, if not - // the INSERT will fail - std::stringstream ss, ss2; - ss << "INSERT INTO " << tableName(sqlOut->tableId); - //Add columns names to the insert and also to select - //* couldn't be used because maybe are duplicated objID's - std::string sep = " "; - int size = myMd->_activeLabels.size(); - - for (int i = 0; i < size; i++) - { - ss2 << sep << MDL::label2StrSql( myMd->_activeLabels[i]); - sep = ", "; - } - ss << "(" << ss2.str() << ") SELECT " << ss2.str(); - ss << " FROM " << tableName(tableId); - if (queryPtr != NULL) - { - ss << queryPtr->whereString(); - ss << queryPtr->orderByString(); - ss << queryPtr->limitString(); - } - if (sqlOut->execSingleStmt(ss)) - { - return sqlite3_changes(db); - } - return 0; -} - -void MDSql::aggregateMd(MetaDataDb *mdPtrOut, - const std::vector &operations, - const std::vector &operateLabel) -{ - std::stringstream ss; - std::stringstream ss2; - std::string aggregateStr = MDL::label2StrSql(mdPtrOut->_activeLabels[0]); - ss << "INSERT INTO " << tableName(mdPtrOut->myMDSql->tableId) - << "(" << aggregateStr; - ss2 << aggregateStr; - //Start iterating on second label, first is the - //aggregating one - for (size_t i = 0; i < operations.size(); i++) - { - ss << ", " << MDL::label2StrSql(mdPtrOut->_activeLabels[i+1]); - ss2 << ", " ; - switch (operations[i]) - { - case AGGR_COUNT: - ss2 << "COUNT"; - break; - case AGGR_MAX: - ss2 << "MAX"; - break; - case AGGR_MIN: - ss2 << "MIN"; - break; - case AGGR_SUM: - ss2 << "SUM"; - break; - case AGGR_AVG: - ss2 << "AVG"; - break; - default: - REPORT_ERROR(ERR_MD_SQL, "Invalid aggregate operation."); - } - ss2 << "(" << MDL::label2StrSql(operateLabel[i]) - << ") AS " << MDL::label2StrSql(mdPtrOut->_activeLabels[i+1]); - } - ss << ") SELECT " << ss2.str(); - ss << " FROM " << tableName(tableId); - ss << " GROUP BY " << aggregateStr; - ss << " ORDER BY " << aggregateStr << ";"; - //std::cerr << "ss " << ss.str() < &groupByLabels , - MDLabel operateLabel, - MDLabel resultLabel) -{ - std::stringstream ss; - std::stringstream ss2; - std::stringstream groupByStr; - - groupByStr << MDL::label2StrSql(groupByLabels[0]); - for (size_t i = 1; i < groupByLabels.size(); i++) - groupByStr << ", " << MDL::label2StrSql(groupByLabels[i]); - - ss << "INSERT INTO " << tableName(mdPtrOut->myMDSql->tableId) << "(" - << groupByStr.str() << ", " << MDL::label2StrSql(resultLabel) << ")"; - - ss2 << groupByStr.str() << ", "; - switch (operation) - { - case AGGR_COUNT: - ss2 << "COUNT"; - break; - case AGGR_MAX: - ss2 << "MAX"; - break; - case AGGR_MIN: - ss2 << "MIN"; - break; - case AGGR_SUM: - ss2 << "SUM"; - break; - case AGGR_AVG: - ss2 << "AVG"; - break; - default: - REPORT_ERROR(ERR_MD_SQL, "Invalid aggregate operation."); - } - ss2 << "(" << MDL::label2StrSql(operateLabel); - ss2 << ") AS " << MDL::label2StrSql(resultLabel); - - ss << " SELECT " << ss2.str(); - ss << " FROM " << tableName(tableId); - ss << " GROUP BY " << groupByStr.str(); - ss << " ORDER BY " << groupByStr.str() << ";"; - - //std::cerr << "ss " << ss.str() < &columns, bool create) -{ - std::stringstream ss,index_name,index_column; - std::string sep1=" "; - std::string sep2=" "; - for (size_t i = 0; i < columns.size(); i++) - { - index_name << sep1 << tableName(tableId) << "_" - << MDL::label2Str(columns.at(i)); - sep1 = "_"; - index_column << sep2 << MDL::label2StrSql(columns.at(i)); - sep2 = ", "; - } - - if (create) - { - ss << "CREATE INDEX IF NOT EXISTS " << index_name.str() << "_INDEX " - << " ON " << tableName(tableId) << " (" << index_column.str() << ")"; - } - else - { - ss << "DROP INDEX IF EXISTS " << index_name.str() << "_INDEX "; - } - execSingleStmt(ss); -} - -size_t MDSql::firstRow() -{ - std::stringstream ss; - ss << "SELECT COALESCE(MIN(objID), -1) AS MDSQL_FIRST_ID FROM " - << tableName(tableId) << ";"; - return execSingleIntStmt(ss); -} - -size_t MDSql::lastRow() -{ - std::stringstream ss; - ss << "SELECT COALESCE(MAX(objID), -1) AS MDSQL_LAST_ID FROM " - << tableName(tableId) << ";"; - return execSingleIntStmt(ss); -} - -size_t MDSql::nextRow(size_t currentRow) -{ - std::stringstream ss; - ss << "SELECT COALESCE(MIN(objID), -1) AS MDSQL_NEXT_ID FROM " - << tableName(tableId) - << " WHERE objID>" << currentRow << ";"; - return execSingleIntStmt(ss); -} - -size_t MDSql::previousRow(size_t currentRow) -{ - std::stringstream ss; - ss << "SELECT COALESCE(MAX(objID), -1) AS MDSQL_PREV_ID FROM " - << tableName(tableId) - << " WHERE objID<" << currentRow << ";"; - return execSingleIntStmt(ss); -} - -int MDSql::columnMaxLength(MDLabel column) -{ - std::stringstream ss; - ss << "SELECT MAX(COALESCE(LENGTH("<< MDL::label2StrSql(column) - <<"), -1)) AS MDSQL_STRING_LENGTH FROM " - << tableName(tableId) << ";"; - return execSingleIntStmt(ss); -} - -void MDSql::setOperate(MetaDataDb *mdPtrOut, const std::vector &columns, SetOperation operation) -{ - std::stringstream ss, ss2; - bool execStmt = true; - int size; - std::string sep = " "; - std::vector * labelVector; - - switch (operation) - { - case UNION: - copyObjects(mdPtrOut->myMDSql); - execStmt = false; - break; - - case UNION_DISTINCT: //unionDistinct - //Create string with columns list - size = mdPtrOut->_activeLabels.size(); - //std::cerr << "LABEL" << MDL::label2StrSql(column) <_activeLabels[i]); - sep = ", "; - } - ss << "INSERT INTO " << tableName(mdPtrOut->myMDSql->tableId) - << " (" << ss2.str() << ")" - << " SELECT " << ss2.str() - << " FROM " << tableName(tableId) - << " WHERE "; - for (size_t j=0; j0) - ss << " AND "; - ss << MDL::label2StrSql(columns[j]) - << " NOT IN (SELECT " << MDL::label2StrSql(columns[j]) - << " FROM " << tableName(mdPtrOut->myMDSql->tableId) << ") "; - } - ss << ";"; - break; - - case DISTINCT: - case REMOVE_DUPLICATE: - //Create string with columns list - size = mdPtrOut->_activeLabels.size(); - sep = ' '; - labelVector = &(mdPtrOut->_activeLabels); - for (int i = 0; i < size; i++) - { - ss2 << sep << MDL::label2StrSql( labelVector->at(i)); - sep = ", "; - } - if (operation == DISTINCT || columns[0] == MDL_UNDEFINED) - { - ss << "INSERT INTO " << tableName(mdPtrOut->myMDSql->tableId) - << " (" << ss2.str() << ")" - << " SELECT DISTINCT " << ss2.str() - << " FROM " << tableName(tableId) << ";"; - } - else { - // We need this special case for the REMOVE_DUPLICATE because when using a subset - // of labels as key, the rest of values are taken randomly. - // The following query ensures that the first ocurrence of the first group of rows - // is used to take the remaining values - ss << "INSERT INTO " << tableName(mdPtrOut->myMDSql->tableId) - << " (ObjId," << ss2.str() << ")" - << " SELECT M.* FROM (SELECT " << MDL::label2StrSql(columns[0]) << ", MIN(ObjId) AS first " - << " FROM " << tableName(tableId) << " GROUP BY " << MDL::label2StrSql(columns[0]) - << " ) foo JOIN " << tableName(tableId) << " M ON foo.first = M.ObjId;"; - } - break; - - case INTERSECTION: - case SUBSTRACTION: - ss << "DELETE FROM " << tableName(mdPtrOut->myMDSql->tableId) - << " WHERE "; - for (size_t j=0; j0) - ss << " AND "; - ss << MDL::label2StrSql(columns[j]); - if (operation == INTERSECTION) - ss << " NOT"; - ss << " IN (SELECT " << MDL::label2StrSql(columns[j]) - << " FROM " << tableName(tableId) << ") "; - } - ss << ";"; - break; - default: - REPORT_ERROR(ERR_ARG_INCORRECT,"Cannot use this operation for a set operation"); - } - //std::cerr << "ss " << ss.str() < v1(myMd->_activeLabels),v2(op.myMd->_activeLabels); - std::sort(v1.begin(),v1.end()); - std::sort(v2.begin(),v2.end()); - - if(v1 != v2) - return (false); - int size = myMd->_activeLabels.size(); - std::stringstream sqlQuery,ss2,ss2Group; - - ss2 << MDL::label2StrSql(MDL_OBJID); - ss2Group << MDL::label2StrSql(MDL_OBJID); - int precision = myMd->_precision; - for (int i = 0; i < size; i++) - { - //when metadata is double compare - if(MDL::isDouble(myMd->_activeLabels[i])) - { - ss2 << ", CAST (" << MDL::label2StrSql( myMd->_activeLabels[i]) - << "*" << precision - << " as INTEGER) as " << MDL::label2StrSql( myMd->_activeLabels[i]); - - } - else - { - ss2 << ", " << MDL::label2StrSql( myMd->_activeLabels[i]); - } - ss2Group<< ", " << MDL::label2StrSql( myMd->_activeLabels[i]); - } - sqlQuery - << "SELECT count(*) FROM (" - << "SELECT count(*) as result\ - FROM\ - (\ - SELECT " << ss2.str() << "\ - FROM " << tableName(tableId) - << " UNION ALL \ - SELECT " << ss2.str() << "\ - FROM " << tableName(op.tableId) - << ") tmp" - << " GROUP BY " << ss2Group.str() - << " HAVING COUNT(*) <> 2" - << ") tmp1"; - return (execSingleIntStmt(sqlQuery)==0); -} - -void MDSql::setOperate(const MetaDataDb *mdInLeft, - const MetaDataDb *mdInRight, - const std::vector &columnsLeft, - const std::vector &columnsRight, - SetOperation operation) -{ - std::stringstream ss, ss2, ss3; - size_t size; - std::string join_type = "", sep = ""; - switch (operation) - { - case INNER_JOIN: - join_type = " INNER "; - break; - case LEFT_JOIN: - join_type = " LEFT OUTER "; - break; - case OUTER_JOIN: - join_type = " OUTER "; - break; - case NATURAL_JOIN: - /* We do not want natural join but natural join except for the obj-ID column */ - join_type = " INNER "; - break; - default: - REPORT_ERROR(ERR_ARG_INCORRECT,"Cannot use this operation for a set operation"); - } - if(operation==NATURAL_JOIN) - { - std::vector intersectLabels; - std::vector::const_iterator left, right; - for (right=(mdInRight->_activeLabels).begin(); - right!=(mdInRight->_activeLabels).end(); - ++right) - for (left=(mdInLeft->_activeLabels).begin(); - left!=(mdInLeft->_activeLabels).end(); - ++left) - { - if (*left == *right) - { - String labelStr = MDL::label2StrSql(*left); - intersectLabels.push_back(*left); - } - } - if (0 == intersectLabels.size()) { - REPORT_ERROR(ERR_MD_SQL, "No matching columns in the tables"); - } - mdInRight->addIndex(intersectLabels); - mdInLeft->addIndex(intersectLabels); - } - else - { - if (columnsRight.size()==1) - { - mdInRight->addIndex(columnsRight[0]); - mdInLeft->addIndex(columnsLeft[0]); - } - } - size = myMd->_activeLabels.size(); - size_t sizeLeft = mdInLeft->_activeLabels.size(); - - for (size_t i = 0; i < size; i++) - { - ss2 << sep << MDL::label2StrSql( myMd->_activeLabels[i]); - ss3 << sep; - if (i < sizeLeft && mdInLeft->_activeLabels[i] == myMd->_activeLabels[i]) - ss3 << tableName(mdInLeft->myMDSql->tableId) << "."; - else - ss3 << tableName(mdInRight->myMDSql->tableId) << "."; - ss3 << MDL::label2StrSql( myMd->_activeLabels[i]); - sep = ", "; - } - ss << "INSERT INTO " << tableName(tableId) - << " (" << ss2.str() << ")" - << " SELECT " << ss3.str() - << " FROM " << tableName(mdInLeft->myMDSql->tableId) - << join_type << " JOIN " << tableName(mdInRight->myMDSql->tableId); - - if (operation != NATURAL_JOIN) - { - ss << " ON ("; - for (size_t j=0; j0) - ss << " AND "; - ss << tableName(mdInLeft->myMDSql->tableId) << "." << MDL::label2StrSql(columnsLeft[j]) - << "=" << tableName(mdInRight->myMDSql->tableId) << "." << MDL::label2StrSql(columnsRight[j]); - } - ss << ") "; - } - else - { - sep = " "; - ss << " WHERE "; - for (size_t i = 0; i < mdInRight->_activeLabels.size(); i++) - for (size_t j = 0; j < sizeLeft; j++) - { - if(mdInRight->_activeLabels[i] == mdInLeft->_activeLabels[j]) - { - ss << sep - << tableName(mdInRight->myMDSql->tableId) << "." - << MDL::label2StrSql(mdInRight->_activeLabels[i]) - << " = " - << tableName(mdInLeft->myMDSql->tableId) << "." - << MDL::label2StrSql(mdInLeft->_activeLabels[j]); - sep = " AND "; - } - } - } - ss << ";"; - // std::cerr << "ss:" << ss.str() << std::endl; - // for (int j = 0; j < sizeLeft; j++) - // std::cerr << "mdInRight->activeLabels:" << mdInRight->activeLabels[0] << std::endl; - // for (int j = 0; j < sizeLeft; j++) - // std::cerr << "mdInLeft->activeLabels:" << mdInLeft->activeLabels[1] << std::endl; - execSingleStmt(ss); - //std::cerr << "ss:" << ss.str() << std::endl; - //dumpToFile("kk.sqlite"); - //exit(0); -} - -bool MDSql::operate(const String &expression) -{ - std::stringstream ss; - ss << "UPDATE " << tableName(tableId) << " SET " << expression; - - return execSingleStmt(ss); -} - -void MDSql::dumpToFile(const FileName &fileName) -{ - sqlite3 *pTo; - sqlite3_backup *pBackup; - - sqlCommitTrans(); - rc = sqlite3_open(fileName.c_str(), &pTo); - if( rc==SQLITE_OK ) - { - pBackup = sqlite3_backup_init(pTo, "main", db, "main"); - if( pBackup ) - { - sqlite3_backup_step(pBackup, -1); - sqlite3_backup_finish(pBackup); - } - rc = sqlite3_errcode(pTo); - } - else - REPORT_ERROR(ERR_MD_SQL, "dumpToFile: error opening db file"); - sqlite3_close(pTo); - sqlBeginTrans(); -} - -void MDSql::copyTableFromFileDB(const FileName blockname, - const FileName filename, - const std::vector *desiredLabels, - const size_t maxRows - ) -{ - char **results; - int rows; - int columns; - char *Labels; - int rc; - - sqlite3 *db1; - if (sqlite3_open(filename.c_str(), &db1)) - REPORT_ERROR(ERR_MD_SQL,formatString("Error opening database code: %d message: %s",rc,sqlite3_errmsg(db1))); - String _blockname; - String sql; - if(blockname.empty()) - { - sql = (String)"SELECT name FROM sqlite_master\ - WHERE type='table' LIMIT 1;"; - if ((rc=sqlite3_get_table (db1, sql.c_str(), &results, &rows, &columns, NULL)) != SQLITE_OK) - REPORT_ERROR(ERR_MD_SQL,formatString("Error accessing table code: %d message: %s. SQL command %s",rc,sqlite3_errmsg(db1),sql.c_str())); - else - _blockname=(String)results[1]; - } - else - _blockname=blockname; - sql = (String)"PRAGMA table_info(" + _blockname +")"; - if (sqlite3_get_table (db1, sql.c_str(), &results, &rows, &columns, NULL) != SQLITE_OK) - REPORT_ERROR(ERR_MD_SQL,formatString("Error accessing table code: %d message: %s. SQL command %s",rc,sqlite3_errmsg(db1),sql.c_str())); - //This pragma returns one row for each column in the named table. - //Columns in the result set include the column name, - //data type, whether or not the column can be NULL, and the default value for the column. - - String activeLabel; - MDLabel label; - if (rows < 1) - std::cerr << "Empty Metadata" <_activeLabels = *desiredLabels; - for(std::vector::const_iterator it = desiredLabels-> - begin(); - it != desiredLabels->end(); - ++it) - { - activeLabel += *it + " ,"; - } - } - else - { - - activeLabel="*"; - for (int i = 1; i <= rows; i++) - { - Labels = results[(i * columns) + 1]; - label = MDL::str2Label(Labels); - - if (label == MDL_UNDEFINED) - { - if(strcmp(Labels,"objID")) - std::cerr << (String)"WARNING: Ignoring unknown column: " + Labels << std::endl; - } - else - { - myMd->_activeLabels.push_back(label); - } - } - } - sqlite3_free_table (results); - sqlite3_close(db1); - - //Copy table to memory - //tableName(tableId); - sqlCommitTrans(); - dropTable(); - createMd(); - - String sqlCommand = formatString("ATTACH database '%s' AS load;", filename.c_str()); - - if (sqlite3_exec(db, sqlCommand.c_str(), NULL, NULL, &errmsg) != SQLITE_OK) - { - std::cerr << "Couldn't attach or create table: " << errmsg << std::endl; - return; - } - String selectCmd = formatString("SELECT %s FROM load.%s", activeLabel.c_str(), _blockname.c_str()); - sqlCommand = formatString("INSERT INTO %s %s", tableName(tableId).c_str(), selectCmd.c_str()); - - if (maxRows) - { - std::stringstream ss; - ss << "SELECT COUNT(objId) FROM load." << _blockname; - myMd->_parsedLines = execSingleIntStmt(ss); - //std::cerr << ss.str() << " = " << myMd->_parsedLines << std::endl; - - sqlCommand += formatString(" LIMIT %lu", maxRows); - } - - if (sqlite3_exec(db, sqlCommand.c_str(),NULL,NULL,&errmsg) != SQLITE_OK) - { - std::cerr << (String)"Couldn't write table: " << tableName(tableId) - << " " << errmsg << std::endl - << "sqlcommand " << sqlCommand << std::endl; - return; - } - sqlite3_exec(db, "DETACH load",NULL,NULL,&errmsg); - sqlBeginTrans(); -} - -void MDSql::copyTableToFileDB(const FileName blockname, const FileName &fileName) -{ - sqlCommitTrans(); - String _blockname; - if(blockname.empty()) - _blockname=DEFAULT_BLOCK_NAME; - else - _blockname=blockname; - String sqlCommand = (String)"ATTACH database '" + fileName+"' as save"; - sqlCommand += (String)";drop table if exists save." + blockname; - if (sqlite3_exec(db, sqlCommand.c_str(),NULL,NULL,&errmsg) != SQLITE_OK) - { - std::cerr << "Couldn't attach or create table: " << errmsg << std::endl; - return; - } - - sqlCommand = (String)"create table save." +blockname - +" as select * from main."+tableName(tableId); - //do not know how to create indexes in attached table - // sqlCommand += (String)";CREATE INDEX IF NOT EXISTS save.obj_Id_INDEX ON " - // + "save." +blockname +"(objID)"; - if (sqlite3_exec(db, sqlCommand.c_str(),NULL,NULL,&errmsg) != SQLITE_OK) - { - std::cerr << (String)"Couldn't write table: " << blockname - << " " << errmsg << std::endl; - return; - } - sqlite3_exec(db, "DETACH save",NULL,NULL,&errmsg); - sqlBeginTrans(); -} - -bool MDSql::sqlBegin() -{ - if (table_counter > 0) - return true; - //std::cerr << "entering sqlBegin" < * labelsVector, bool withObjID) -{ - std::stringstream ss; - ss << "CREATE TABLE " << tableName(tableId) << "("; - std::string sep = ""; - if (withObjID) - { - ss << "objID INTEGER PRIMARY KEY ASC AUTOINCREMENT"; - sep = ", "; - } - if (labelsVector != NULL) - { - for (size_t i = 0; i < labelsVector->size(); i++) - { - ss << sep << MDL::label2SqlColumn(labelsVector->at(i)); - sep = ", "; - } - } - ss << ");"; - return execSingleStmt(ss); -} - -void MDSql::prepareStmt(const std::stringstream &ss, sqlite3_stmt *stmt) -{ - const char * zLeftover; - sqlite3_prepare_v2(db, ss.str().c_str(), -1, &stmt, &zLeftover); -} - -bool MDSql::execSingleStmt(const std::stringstream &ss) -{ - - sqlite3_stmt * stmt; - sqlite3_prepare_v2(db, ss.str().c_str(), -1, &stmt, &zLeftover); - -//#define DEBUG -#ifdef DEBUG - - std::cerr << "execSingleStmt, stmt: '" << ss.str() << "'" <str().c_str())); - return true; -} - -size_t MDSql::execSingleIntStmt(const std::stringstream &ss) -{ - int rc; - sqlite3_stmt * stmt; - sqlite3_prepare_v2(db, ss.str().c_str(), -1, &stmt, &zLeftover); - rc = sqlite3_step(stmt); - size_t result = sqlite3_column_int(stmt, 0); - - if (rc != SQLITE_OK && rc != SQLITE_ROW && rc != SQLITE_DONE) - { - std::cerr << "MDSql::execSingleIntStmt: error executing statement, code " << rc <preparedStmt); - sqlite3_reset(this->preparedStmt); - - // Bind object id. - if (sqlite3_bind_int(this->preparedStmt, 1, id) != SQLITE_OK) - { - success = false; - } - - return(success); -} - -int MDSql::bindValue(sqlite3_stmt *stmt, const int position, const MDObject &valueIn) -{ - //First reset the statement - //rc = sqlite3_reset(stmt); - //std::cerr << "rc after reset: " << rc <c_str(), -1, SQLITE_TRANSIENT); - case LABEL_VECTOR_DOUBLE: - case LABEL_VECTOR_SIZET: - return sqlite3_bind_text(stmt, position, valueIn.toString(false, true).c_str(), -1, SQLITE_TRANSIENT); - default: - REPORT_ERROR(ERR_ARG_INCORRECT,"Do not know how to handle this type"); - } - } -} - -void MDSql::extractValue(sqlite3_stmt *stmt, const int position, MDObject &valueOut) -{ - switch (valueOut.type) - { - case LABEL_BOOL: //bools are int in sqlite3 - valueOut.data.boolValue = sqlite3_column_int(stmt, position) == 1; - break; - case LABEL_INT: - valueOut.data.intValue = sqlite3_column_int(stmt, position); - break; - case LABEL_SIZET: - valueOut.data.longintValue = sqlite3_column_int(stmt, position); - break; - case LABEL_DOUBLE: - valueOut.data.doubleValue = sqlite3_column_double(stmt, position); - break; - case LABEL_STRING: - { - std::stringstream ss; - ss << sqlite3_column_text(stmt, position); - valueOut.data.stringValue->assign(ss.str()); - - break; - } - case LABEL_VECTOR_DOUBLE: - case LABEL_VECTOR_SIZET: - { - std::stringstream ss; - ss << sqlite3_column_text(stmt, position); - valueOut.fromStream(ss); - break; - } - default: - REPORT_ERROR(ERR_ARG_INCORRECT,"Do not know how to extract a value of type " + valueOut.type); - } -} - -MDCache::MDCache() -{ - this->addRowStmt = NULL; - this->iterStmt = NULL; -} - -MDCache::~MDCache() -{ - clear(); -} - -void MDCache::clear() -{ - //Clear cached statements - std::map::iterator it; - //FIXME: This is a bit dirty here...should be moved to MDSQl - for (it = setValueCache.begin(); it != setValueCache.end(); it++) - sqlite3_finalize(it->second); - setValueCache.clear(); - - for (it = getValueCache.begin(); it != getValueCache.end(); it++) - sqlite3_finalize(it->second); - getValueCache.clear(); - - if (iterStmt != NULL) - { - sqlite3_finalize(iterStmt); - iterStmt = NULL; - } - - if (addRowStmt != NULL) - { - sqlite3_finalize(addRowStmt); - addRowStmt = NULL; - } -} diff --git a/src/core/metadata_sql.h b/src/core/metadata_sql.h deleted file mode 100644 index 1f9741f..0000000 --- a/src/core/metadata_sql.h +++ /dev/null @@ -1,345 +0,0 @@ -/*************************************************************************** - * - * Authors: J.M. De la Rosa Trevin (jmdelarosa@cnb.csic.es) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -/* SQL helpers for MetaDataDb */ - -#ifndef CORE_METADATASQL_H -#define CORE_METADATASQL_H - -#include "xmipp_strings.h" -#include "metadata_label.h" -#include "xmipp_error.h" -#include "metadata_sql_operations.h" -#include "metadata_static.h" -#include "metadata_query.h" - -class MDSqlStaticInit; -class MDQuery; -class MetaDataDb; -class MDCache; -class FileName; -class sqlite3_stmt; -class sqlite3_context; -class sqlite3_value; -class sqlite3; - -/** @addtogroup MetaData - * @{ - */ - -//#include "metadata.h" - -/* return number of tables from a metadata file saved as sqlite */ -int getBlocksInMetaDataFileDB(const FileName &inFile, StringVector& blockList); - -/*support for the REGEXP operator in sqlite*/ -void sqlite_regexp(sqlite3_context* context, int argc, sqlite3_value** values); - -/** This class will manage SQL database interactions. - * This class is designed to used inside a MetaData. - */ -class MDSql -{ -public: - static void dumpToFile(const FileName &fileName); - static void sqlTimeOut(int miliSeconds); - - /**This library will provide common mathematical and string functions in -SQL queries using the operating system libraries or provided -definitions. It includes the following functions: - -Math: acos, asin, atan, atn2, atan2, acosh, asinh, atanh, difference, -degrees, radians, cos, sin, tan, cot, cosh, sinh, tanh, coth, exp, -log, log10, power, sign, sqrt, square, ceil, floor, pi. - -String: replicate, charindex, leftstr, rightstr, ltrim, rtrim, trim, -replace, reverse, proper, padl, padr, padc, strfilter. - -Aggregate: stdev, variance, mode, median, lower_quartile, -upper_quartile. - * - * - */ - static bool activateMathExtensions(void); - - /* activate regular expressions in sql */ - static bool activateRegExtensions(void); - -/** activate UNSAFED Multi-thread mode - * SQLite support three different threading modes: - -Single-thread. In this mode, all mutexes are disabled and SQLite is unsafe to use in more than a single thread at once. - -Multi-thread. In this mode, SQLite can be safely used by multiple threads provided that no single database connection is used simultaneously in two or more threads. - -Serialized. In serialized mode, SQLite can be safely used by multiple threads with no restriction. - - */ - bool deactivateThreadMuting(void); - /** activate SAFED serialized mode mode -*/ - bool activateThreadMuting(void); - -private: - /** write metadata in sqlite table - * - */ - void copyTableToFileDB(const FileName blockname, const FileName &fileName); - - /** read metadata from sqlite table - * - */ - void copyTableFromFileDB(const FileName blockname, - const FileName filename, - const std::vector *desiredLabels, - const size_t maxRows=0 - ); - /** This will create the table to store the metada objects. - * Will return false if the mdId table is already present. - */ - bool createMd(); - - /** This function will drop the entire table. - * For use the metada again, a call to createMd() should be done. - */ - bool clearMd(); - - size_t getObjId(); - - /**Add a new row and return the objId(rowId). - */ - size_t addRow(); - - /** Add a new column to a metadata. - */ - bool addColumn(MDLabel column); - - /** Rename Column - * SQLite itself does not support it. So some hacking is needed here - */ - bool renameColumn(const std::vector &oldLabel, const std::vector &newlabel); - - /** Insert a new register inserting input columns. - */ - // T is either "const MDObject*" or "MDObject*" - template - bool setObjectValues(int id, const std::vector &columnValues, const std::vector *desiredLabels=NULL); - - /**Set the value of an object in an specified column. - */ - bool setObjectValue(const int objId, const MDObject &value); - - /**Set the value of all objects in an specified column. - */ - bool setObjectValue(const MDObject &value); - - /** Get the values of several objects. - */ - bool getObjectsValues(const std::vector &labels, std::vector &values); - - /** Get the value of an object. - */ - bool getObjectValue(const int objId, MDObject &value); - - /** This function will select some elements from table. - * The 'limit' is the maximum number of object - * returned, if is -1, all will be returned - * Also a query could be specified for selecting objects - * if no query is provided by default all are returned - */ - void selectObjects(std::vector &objectsOut, const MDQuery *queryPtr = NULL); - - /** return metadata size - * - */ - size_t size(void); - /** This function will delete elements that match the query. - * If not query is provided, all rows are deleted - */ - size_t deleteObjects(const MDQuery *queryPtr = NULL); - - /** Copy the objects from a metada to other. - * return the number of objects copied - * */ - size_t copyObjects(MDSql * sqlOut, - const MDQuery *queryPtr = NULL) const; - size_t copyObjects(MetaDataDb * mdPtrOut, - const MDQuery *queryPtr = NULL) const; - - /** This function performs aggregation operations. - */ - void aggregateMd(MetaDataDb *mdPtrOut, - const std::vector &operations, - const std::vector &operateLabel); - - /** This function performs aggregation operations grouped by several labels. - */ - void aggregateMdGroupBy(MetaDataDb *mdPtrOut, - const AggregateOperation operation, - const std::vector &groupByLabels , - const MDLabel operateLabel, - const MDLabel resultLabel); - - /** This function performs aggregation operations. - without grouping. (i.e. absolute maximum of a metadata column) - for double - */ - double aggregateSingleDouble(const AggregateOperation operation, - MDLabel operateLabel); - - - /** This function performs aggregation operations. - without grouping. (i.e. absolute maximum of a metadata column) - for size_t - */ - size_t aggregateSingleSizeT(const AggregateOperation operation, - MDLabel operateLabel); - - /** This function will be used to create o delete an index over a column. - *Those indexes will improve searchs, but inserts will become expensives - */ - void indexModify(const std::vector &columns, bool create=true); - - /** Some iteration methods - */ - size_t firstRow(); - size_t lastRow(); - size_t nextRow(size_t currentRow); - size_t previousRow(size_t currentRow); - - int columnMaxLength(MDLabel column); - - /**Functions to implement set operations */ - void setOperate(MetaDataDb *mdPtrOut, const std::vector &columns, SetOperation operation); - void setOperate(const MetaDataDb *mdInLeft, const MetaDataDb *mdInRight, const std::vector &columnsLeft, - const std::vector &columnsRight, SetOperation operation); - /** Function to dump DB to file */ - bool operate(const String &expression); - - /** If true, all queries to database will be synchronized by mutex */ - // FIXME this should not be necessary, as sqlite is build with multi-thread support. However, multiple access - // to database from multiple threads causes application crash - bool beThreadSafe; - - - /** Constructor of MDSql - * Now each MD should have an instance - * of this class to interact with the DB - */ - MDSql(MetaDataDb *md); - ~MDSql(); - - static int table_counter; - static sqlite3 *db; - - static MDSqlStaticInit initialization; //Just for initialization - - ///Just call this function once, at static initialization - static bool sqlBegin(); - static void sqlEnd(); - static bool sqlBeginTrans(); - static bool sqlCommitTrans(); - /** Return an unique id for each metadata - * this function should be called once for each - * metada and the id will be used for operations - */ - int getUniqueId(); - - bool dropTable(); - bool createTable(const std::vector * labelsVector = NULL, bool withObjID=true); - bool insertValues(double a, double b); - bool initializeSelect( bool addWhereObjId, const std::vector &labels); - bool initializeInsert(const std::vector *labels, const std::vector &values); - void finalizePreparedStmt(void); - void prepareStmt(const std::stringstream &ss, sqlite3_stmt *stmt); - bool execSingleStmt(const std::stringstream &ss); - bool execSingleStmt(sqlite3_stmt *&stmt, const std::stringstream *ss = NULL); - size_t execSingleIntStmt(const std::stringstream &ss); - double execSingleDoubleStmt(const std::stringstream &ss); - - String tableName(const int tableId) const; - - bool bindStatement( size_t id); - int bindValue(sqlite3_stmt *stmt, const int position, const MDObject &valueIn); - void extractValue(sqlite3_stmt *stmt, const int position, MDObject &valueOut); - - static char *errmsg; - static const char *zLeftover; - static int rc; - static sqlite3_stmt *stmt; - - static std::stringstream preparedStream; // Stream. - static sqlite3_stmt * preparedStmt; // SQL statement. - - ///Non-static attributes - int tableId; - MetaDataDb *myMd; - MDCache *myCache; - - friend class MDSqlStaticInit; - friend class MetaDataDb; - friend class MDIterator; - ///similar to "operator" - bool equals(const MDSql &op); - -} -;//close class MDSql - - -/** Class to store some cached sql statements. - */ -class MDCache -{ -public: - sqlite3_stmt *iterStmt; - std::map getValueCache; - std::map setValueCache; - sqlite3_stmt *addRowStmt; - - MDCache(); - ~MDCache(); - void clear(); -}; - -/** Just to work as static constructor for initialize database. - */ -class MDSqlStaticInit -{ -private: - MDSqlStaticInit() - { - MDSql::sqlBegin(); - }//close constructor - - ~MDSqlStaticInit() - { - MDSql::sqlEnd(); - }//close destructor - - friend class MDSql; -} -;//close class MDSqlStaticInit - -#endif diff --git a/src/core/metadata_sql_operations.h b/src/core/metadata_sql_operations.h deleted file mode 100644 index 78c4d8c..0000000 --- a/src/core/metadata_sql_operations.h +++ /dev/null @@ -1,47 +0,0 @@ -/*************************************************************************** - * - * Authors: David Strelak (davidstrelak@gmail.com) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_METADATA_SQL_OPERATIONS_H_ -#define CORE_METADATA_SQL_OPERATIONS_H_ - -/** Posible Aggregation Operations in a MetaData */ -enum AggregateOperation -{ - AGGR_COUNT, AGGR_MAX, AGGR_MIN, AGGR_SUM, AGGR_AVG -}; - -/** Posible Set Operations with MetaData */ -enum SetOperation -{ - UNION, UNION_DISTINCT, INTERSECTION, SUBSTRACTION, INNER_JOIN, LEFT_JOIN, OUTER_JOIN,NATURAL_JOIN,REMOVE_DUPLICATE, DISTINCT -}; - -/** Enumeration of JOIN types for this operation */ -enum JoinType -{ - INNER=INNER_JOIN, LEFT=LEFT_JOIN, OUTER=OUTER_JOIN,NATURAL=NATURAL_JOIN -}; - -#endif /* CORE_METADATA_SQL_OPERATIONS_H_ */ diff --git a/src/core/metadata_static.cpp b/src/core/metadata_static.cpp deleted file mode 100644 index 2b3ec2f..0000000 --- a/src/core/metadata_static.cpp +++ /dev/null @@ -1,325 +0,0 @@ -/*************************************************************************** - * - * Authors: J.M. De la Rosa Trevin (jmdelarosa@cnb.csic.es) - * Jan Horacek (xhorace4@fi.muni.cz) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include -#include "metadata_static.h" -#include "xmipp_error.h" - -//This is needed for static memory allocation -MDLabelData * MDL::data[MDL_LAST_LABEL+1]; -std::map MDL::names; -MDLabelStaticInit MDL::initialization; //Just for initialization -MDLabel MDL::bufferIndex; - -void MDL::addLabel(const MDLabel label, const MDLabelType type, const String &name, int tags) -{ - if (names.find(name) != names.end()) - REPORT_ERROR(ERR_ARG_INCORRECT, formatString("MDL::addLabel, label '%s' already exists.", name.c_str())); - - data[label] = new MDLabelData(type, name, tags); - names[name] = label; -} - -/** - * Extra alias can be defined through the environment var XMIPP_EXTRA_ALIASES - * the syntax is the following - * XMIPP_EXTRA_ALIASES='anglePsi=otherAnglePsi;shiftX=otherShiftX;shiftY:otherShift' - * The = sign will add a label, and the alias name will replace the current one (replace=True) - * if the : sign is used, only a normal alias will added - */ -void MDL::addExtraAliases() -{ - const char * extra_aliases = getenv("XMIPP_EXTRA_ALIASES"); - - if (extra_aliases) - { - StringVector sv, pair; - String eq = "=", co = ":"; - tokenize(extra_aliases, sv, ";"); - MDLabel label; - bool replace; - - for (std::vector::iterator it = sv.begin(); it != sv.end(); ++it) - { - if (it->find(eq) != it->npos) - { - tokenize(*it, pair, "="); - replace = true; - } - else if (it->find(co) != it->npos) - { - tokenize(*it, pair, co); - replace = false; - } - else - REPORT_ERROR(ERR_ARG_INCORRECT, "Invalid pair separator, use = or :"); - label = MDL::str2Label(pair[0]); - // Add the label alias - if (label != MDL_UNDEFINED) - addLabelAlias(label, pair[1], replace); - else - REPORT_ERROR(ERR_ARG_INCORRECT, - formatString("Invalid label name: %s found in environment var XMIPP_EXTRA_ALIASES", pair[0].c_str())); - } - } -} - -void MDL::addLabelAlias(const MDLabel label, const String &alias, bool replace, - MDLabelType type) -{ - names[alias] = label; - if (replace) - { - data[label]->str = alias; - if (type != LABEL_NOTYPE) - data[label]->type = type; - } -} - -MDLabel MDL::getNewAlias(const String &alias, MDLabelType type) -{ - MDLabel newLabel = MDL::bufferIndex; - - if (newLabel == MDL_LAST_LABEL) - REPORT_ERROR(ERR_ARG_INCORRECT, "Not more buffer labels to use!!!"); - - addLabelAlias(newLabel, alias, true, type); - MDL::bufferIndex = (MDLabel)((int)newLabel + 1); - - return newLabel; -} - -void MDL::resetBufferIndex() -{ - MDL::bufferIndex = BUFFER_01; -} - -void MDL::str2LabelVector(const String &labelsStr, std::vector &labels) -{ - labels.clear(); - StringVector parts; - splitString(labelsStr, " ", parts); - for (size_t i = 0; i < parts.size(); ++i) - if (MDL::isValidLabel(parts[i])) - labels.push_back(MDL::str2Label(parts[i])); - else - REPORT_ERROR(ERR_PARAM_INCORRECT, formatString("Unknown label '%s' received.", parts[i].c_str())); -} - -MDLabel MDL::str2Label(const String &labelName) -{ - if (names.find(labelName) == names.end()) - return MDL_UNDEFINED; - return names[labelName]; -} - -String MDL::label2Str(const MDLabel &label) -{ - return (isValidLabel(label)) ? data[(int)label]->str : ""; -} - -String MDL::label2StrSql(const MDLabel label) -{ - String labelSqlite = "\"" + label2Str(label) + "\""; - return labelSqlite; -} - -String MDL::label2SqlColumn(const MDLabel label) -{ - std::stringstream ss; - ss << MDL::label2StrSql(label) << " "; - - switch (MDL::labelType(label)) - { - case LABEL_BOOL: //bools are int in sqlite3 - case LABEL_INT: - case LABEL_SIZET: - ss << "INTEGER"; - break; - case LABEL_DOUBLE: - ss << "REAL"; - break; - case LABEL_STRING: - ss << "TEXT"; - break; - case LABEL_VECTOR_DOUBLE: - case LABEL_VECTOR_SIZET: - ss << "TEXT"; - break; - case LABEL_NOTYPE: - ss << "NO_TYPE"; - break; - } - return ss.str(); -} - -String MDL::labelType2Str(MDLabelType type) -{ - switch (type) - { - case LABEL_STRING: - return "STRING"; - case LABEL_DOUBLE: - return "DOUBLE"; - case LABEL_INT: - return "INT"; - case LABEL_BOOL: - return "BOOL"; - case LABEL_VECTOR_DOUBLE: - return "VECTOR(DOUBLE)"; - case LABEL_SIZET: - return "SIZE_T"; - case LABEL_VECTOR_SIZET: - return "VECTOR(SIZE_T)"; - case LABEL_NOTYPE: - return "NO_TYPE"; - } - return "UNKNOWN"; -} - -bool MDL::isInt(const MDLabel label) -{ - return (data[label]->type == LABEL_INT); -} - -bool MDL::isLong(const MDLabel label) -{ - return (data[label]->type == LABEL_SIZET); -} - -bool MDL::isBool(const MDLabel label) -{ - return (data[label]->type == LABEL_BOOL); -} - -bool MDL::isString(const MDLabel label) -{ - return (data[label]->type == LABEL_STRING); -} - -bool MDL::isDouble(const MDLabel label) -{ - return (data[label]->type == LABEL_DOUBLE); -} - -bool MDL::isVector(const MDLabel label) -{ - return (data[label]->type == LABEL_VECTOR_DOUBLE); -} - -bool MDL::isVectorLong(const MDLabel label) -{ - return (data[label]->type == LABEL_VECTOR_SIZET); -} - -bool MDL::isValidLabel(const MDLabel &label) -{ - return label > MDL_UNDEFINED && - label < MDL_LAST_LABEL && - data[label] != NULL; -} - -bool MDL::isValidLabel(const String &labelName) -{ - return isValidLabel(str2Label(labelName)); -} - -MDLabelType MDL::labelType(const MDLabel label) -{ - return data[label]->type; -} - -MDLabelType MDL::labelType(const String &labelName) -{ - return data[str2Label(labelName)]->type; -} - -std::map& MDL::getLabelDict() -{ - return names; -} - -bool MDL::hasTag(const MDLabel label, const int tags) -{ - return data[label]->tags & tags; -} - -bool MDL::isTextFile(const MDLabel label) -{ - return data[label]->tags & TAGLABEL_TEXTFILE; -} - -bool MDL::isMetadata(const MDLabel label) -{ - return data[label]->tags & TAGLABEL_METADATA; -} - -bool MDL::isCtfParam(const MDLabel label) -{ - return data[label]->tags & TAGLABEL_CTFPARAM; -} - -bool MDL::isImage(const MDLabel label) -{ - return data[label]->tags & TAGLABEL_IMAGE; -} - -bool MDL::isStack(const MDLabel label) -{ - return data[label]->tags & TAGLABEL_STACK; -} - -bool MDL::isMicrograph(const MDLabel label) -{ - return data[label]->tags & TAGLABEL_MICROGRAPH; -} - -bool MDL::isPSD(const MDLabel label) -{ - return data[label]->tags & TAGLABEL_PSD; -} - -MDRowSql MDL::emptyHeaderSql() { - MDRowSql row; - row.resetGeo(); - row.setValue(MDL_ANGLE_ROT, 0.); - row.setValue(MDL_ANGLE_TILT,0.); - return row; -} - -MDRowVec MDL::emptyHeaderVec() { - MDRowVec row; - row.resetGeo(); - row.setValue(MDL_ANGLE_ROT, 0.); - row.setValue(MDL_ANGLE_TILT,0.); - return row; -} - -void MDL::emptifyHeader(MDRow& row) { - row.resetGeo(); - row.setValue(MDL_ANGLE_ROT, 0.); - row.setValue(MDL_ANGLE_TILT,0.); -} diff --git a/src/core/metadata_static.h b/src/core/metadata_static.h deleted file mode 100644 index 814436e..0000000 --- a/src/core/metadata_static.h +++ /dev/null @@ -1,1195 +0,0 @@ -/*************************************************************************** - * - * Authors: J.M. De la Rosa Trevin (jmdelarosa@cnb.csic.es) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_METADATA_STATIC_H -#define CORE_METADATA_STATIC_H - -#include "metadata_label.h" -#include "metadata_row_sql.h" -#include "metadata_row_vec.h" - -/** Static class to group some functions with labels. - * This class holds several function to work with labels. - * Also performs the static initialization of the labels data. - */ -class MDL -{ -public: - /** @name String conversions - * @{ - */ - /** Converts an string to MDLabel */ - static void str2LabelVector(const String &labelsStr, std::vector &labels); - static MDLabel str2Label(const String &labelName); - /** Converts MDLabel to string */ - static String label2Str(const MDLabel &label); - /** Same as label2Str but escaping with '' to use in Sqlite. */ - static String label2StrSql(const MDLabel label); - /** Converts MDLabel to string representing SQL column*/ - static String label2SqlColumn(const MDLabel label); - /** Return the type of the label as String */ - static String labelType2Str(MDLabelType type); - /** @} */ - - /** @name Type checks - * Several label type checks - * @{ - */ - static bool isInt(const MDLabel label); - static bool isLong(const MDLabel label); - static bool isBool(const MDLabel label); - static bool isString(const MDLabel label); - static bool isDouble(const MDLabel label); - static bool isVector(const MDLabel label); - static bool isVectorLong(const MDLabel label); - static bool isValidLabel(const MDLabel &label); - static bool isValidLabel(const String &labelName); - static MDLabelType labelType(const MDLabel label); - static MDLabelType labelType(const String &labelName); - static bool hasTag(const MDLabel label, const int tags); - static bool isTextFile(const MDLabel label); - static bool isMetadata(const MDLabel label); - static bool isCtfParam(const MDLabel label); - static bool isImage(const MDLabel label); - static bool isVolume(const MDLabel label); - static bool isStack(const MDLabel label); - static bool isMicrograph(const MDLabel label); - static bool isPSD(const MDLabel label); - static std::map& getLabelDict(); - /** @} */ - - /** Add an alias for an existing label. - * Params: - * label: The label id to create the alias to - * alias: The new alternative string name (alias) - * replace: If true, then new alias name will be used as the label - * string for writing back to file - * type: if provided, the label type will be replaced (only used with - * replace=True) - * - * NOTE: Be aware that this function is not thread safe, so do not use - * it concurrently from different threads. - */ - static void addLabelAlias(MDLabel label, const String &alias, - bool replace=false, MDLabelType type=LABEL_NOTYPE); - - /** Get an alias of an available BUFFER label with the provided name. - * Params: - * alias: The name to create the alias from BUFFER label - * type: if provided, the label type will be replaced - */ - static MDLabel getNewAlias(const String &alias, MDLabelType type=LABEL_NOTYPE); - - /** Reset the counter of buffer labels. - * Use this function with care, since when you change the alias, the existing - * metadata could change and write wrong values to file. - */ - static void resetBufferIndex(); - - static MDRowSql emptyHeaderSql(); - static MDRowVec emptyHeaderVec(); - static void emptifyHeader(MDRow&); - -private: - //Array of MDLabelData pointers - static MDLabelData * data[MDL_LAST_LABEL+1]; - static std::map names; - static MDLabelStaticInit initialization; //Just for initialization - static MDLabel bufferIndex; // Index that will be used to return next label alias - - /** Add predefined labels to be used in metadata */ - static void addLabel(MDLabel label, MDLabelType type, const String &name, int tags=TAGLABEL_NOTAG); - /** This function will read extra label alias from XMIPP_LABEL_ALIASES var environment */ - static void addExtraAliases(); - friend class MDLabelStaticInit; - -};//close class MLD definition - - -/** Just to work as static constructor for initialize labels data. - */ -class MDLabelStaticInit -{ -private: - MDLabelStaticInit() - { - //Just to be safe, initialize all data to null - for (int i = (int)MDL_FIRST_LABEL; i <= (int)MDL_LAST_LABEL; ++i) - MDL::data[i] = NULL; - - ///==== Add labels entries from here in the SAME ORDER as declared in ENUM ========== - //The label MDL_OBJID is special and should not be used - MDL::addLabel(MDL_OBJID, LABEL_SIZET, "objId"); - //The label MDL_GATHER_ID is special and should not be used - MDL::addLabel(MDL_GATHER_ID, LABEL_SIZET, "gatherId"); - - //MDL::addLabel(MDL_ANGLE_COMPARISON, LABEL_VECTOR_DOUBLE, "angle_comparison"); - //MDL::addLabelAlias(MDL_ANGLE_COMPARISON, "angleComparison"); //3.0 - - MDL::addLabel(MDL_ANGLE_PSI, LABEL_DOUBLE, "anglePsi"); - MDL::addLabelAlias(MDL_ANGLE_PSI, "psi"); - MDL::addLabel(MDL_ANGLE_PSI2, LABEL_DOUBLE, "anglePsi2"); - MDL::addLabelAlias(MDL_ANGLE_PSI2, "psi2"); - MDL::addLabel(MDL_ANGLE_PSI3, LABEL_DOUBLE, "anglePsi3"); - MDL::addLabelAlias(MDL_ANGLE_PSI3, "psi3"); - MDL::addLabel(MDL_ANGLE_PSI_DIFF, LABEL_DOUBLE, "anglePsiDiff"); - MDL::addLabel(MDL_ANGLE_ROT, LABEL_DOUBLE, "angleRot"); - MDL::addLabelAlias(MDL_ANGLE_ROT, "rot"); - MDL::addLabel(MDL_ANGLE_ROT2, LABEL_DOUBLE, "angleRot2"); - MDL::addLabelAlias(MDL_ANGLE_ROT2, "rot2"); - MDL::addLabel(MDL_ANGLE_ROT3, LABEL_DOUBLE, "angleRot3"); - MDL::addLabelAlias(MDL_ANGLE_ROT3, "rot3"); - MDL::addLabel(MDL_ANGLE_ROT_DIFF, LABEL_DOUBLE, "angleRotDiff"); - MDL::addLabel(MDL_ANGLE_TILT, LABEL_DOUBLE, "angleTilt"); - MDL::addLabelAlias(MDL_ANGLE_TILT, "tilt"); - MDL::addLabel(MDL_ANGLE_TILT2, LABEL_DOUBLE, "angleTilt2"); - MDL::addLabelAlias(MDL_ANGLE_TILT2, "tilt2"); - MDL::addLabel(MDL_ANGLE_TILT3, LABEL_DOUBLE, "angleTilt3"); - MDL::addLabelAlias(MDL_ANGLE_TILT3, "tilt3"); - MDL::addLabel(MDL_ANGLE_TILT_DIFF, LABEL_DOUBLE, "angleTiltDiff"); - MDL::addLabel(MDL_ANGLE_DIFF0, LABEL_DOUBLE, "angleDiff0"); - MDL::addLabel(MDL_ANGLE_DIFF, LABEL_DOUBLE, "angleDiff"); - MDL::addLabel(MDL_ANGLE_DIFF2, LABEL_DOUBLE, "angleDiff2"); - MDL::addLabel(MDL_ANGLE_Y, LABEL_DOUBLE, "angleY"); - MDL::addLabel(MDL_ANGLE_Y2, LABEL_DOUBLE, "angleY2"); - MDL::addLabel(MDL_ANGLE_TEMPERATURE, LABEL_DOUBLE, "angleTemp"); - - MDL::addLabel(MDL_APPLY_SHIFT, LABEL_BOOL, "applyShift"); - MDL::addLabel(MDL_AVG, LABEL_DOUBLE, "avg"); - MDL::addLabel(MDL_AVG_CHANGES_ORIENTATIONS, LABEL_DOUBLE, "avgChanOrient"); - MDL::addLabel(MDL_AVG_CHANGES_OFFSETS, LABEL_DOUBLE, "avgChanOffset"); - MDL::addLabel(MDL_AVG_CHANGES_CLASSES, LABEL_DOUBLE, "avgChanClass"); - MDL::addLabel(MDL_AVGPMAX, LABEL_DOUBLE, "avgPMax"); - - MDL::addLabel(MDL_BFACTOR, LABEL_DOUBLE, "bFactor"); - MDL::addLabel(MDL_BGMEAN, LABEL_DOUBLE, "bgMean"); - MDL::addLabel(MDL_BLOCK_NUMBER, LABEL_INT, "blockNumber"); - - MDL::addLabel(MDL_CL2D_CHANGES, LABEL_INT, "cl2dChanges"); - MDL::addLabel(MDL_CL2D_SIMILARITY, LABEL_DOUBLE, "cl2dSimilarity"); - MDL::addLabel(MDL_CLASS_COUNT, LABEL_SIZET, "classCount"); - MDL::addLabelAlias(MDL_CLASS_COUNT, "class_count"); //3.0 - MDL::addLabel(MDL_CLASS_PERCENTAGE, LABEL_DOUBLE, "classPercentage"); - MDL::addLabel(MDL_CLASSIFICATION_DATA, LABEL_VECTOR_DOUBLE, "classificationData"); - MDL::addLabelAlias(MDL_CLASSIFICATION_DATA, "ClassificationData"); - MDL::addLabel(MDL_CLASSIFICATION_DATA_SIZE, LABEL_SIZET, "classificationDatasize"); - MDL::addLabelAlias(MDL_CLASSIFICATION_DATA_SIZE, "ClassificationDataSize"); - MDL::addLabel(MDL_CLASSIFICATION_DPR_05, LABEL_DOUBLE, "classificationDPR05"); - MDL::addLabelAlias(MDL_CLASSIFICATION_DPR_05, "ClassificationDPR05"); - MDL::addLabel(MDL_CLASSIFICATION_FRC_05, LABEL_DOUBLE, "classificationFRC05"); - MDL::addLabelAlias(MDL_CLASSIFICATION_FRC_05, "ClassificationFRC05"); - MDL::addLabel(MDL_CLASSIFICATION_INTRACLASS_DISTANCE, LABEL_DOUBLE, "classificationIntraclassDistance"); - MDL::addLabelAlias(MDL_CLASSIFICATION_INTRACLASS_DISTANCE, "ClassificationIntraclassDistance"); - MDL::addLabel(MDL_COLOR, LABEL_INT, "color"); - MDL::addLabel(MDL_COMMENT, LABEL_STRING, "comment"); - MDL::addLabel(MDL_COST, LABEL_DOUBLE, "cost"); - MDL::addLabel(MDL_COST_PERCENTILE, LABEL_DOUBLE, "costPerc"); - MDL::addLabel(MDL_COORD_CONSENSUS_SCORE, LABEL_DOUBLE, "CoordConsScore"); - MDL::addLabel(MDL_COUNT2, LABEL_SIZET, "count2"); - MDL::addLabel(MDL_COUNT, LABEL_SIZET, "count"); - MDL::addLabel(MDL_CORR_DENOISED_PROJECTION, LABEL_DOUBLE, "corrDenoisedProjection"); - MDL::addLabel(MDL_CORR_DENOISED_NOISY, LABEL_DOUBLE, "corrDenoisedNoisy"); - MDL::addLabel(MDL_CORRELATION_IDX, LABEL_DOUBLE, "corrIdx"); - MDL::addLabel(MDL_CORRELATION_MASK, LABEL_DOUBLE, "corrMask"); - MDL::addLabel(MDL_CORRELATION_WEIGHT, LABEL_DOUBLE, "corrWeight"); - - MDL::addLabel(MDL_CLASS_INTERSECTION_SIZE_PVALUE, LABEL_DOUBLE, "classIntersectionSizePValue"); - MDL::addLabel(MDL_CLASS_INTERSECTION_RELATIVE_SIZE_PVALUE, LABEL_DOUBLE, "classIntersectionRelativeSizePValue"); - - MDL::addLabel(MDL_CRYSTAL_CELLX, LABEL_INT, "crystalCellx"); - MDL::addLabel(MDL_CRYSTAL_CELLY, LABEL_INT, "crystalCelly"); - MDL::addLabel(MDL_CRYSTAL_DISAPPEAR_THRE, LABEL_DOUBLE, "crystalDisthresh"); - MDL::addLabel(MDL_CRYSTAL_LATTICE_A, LABEL_VECTOR_DOUBLE, "crystalLatticeA"); - MDL::addLabel(MDL_CRYSTAL_LATTICE_B, LABEL_VECTOR_DOUBLE, "crystalLatticeB"); - MDL::addLabel(MDL_CRYSTAL_ORTHO_PRJ, LABEL_BOOL, "crystalOrthoProj"); - MDL::addLabel(MDL_CRYSTAL_PROJ, LABEL_BOOL, "crystalProj"); - MDL::addLabel(MDL_CRYSTAL_SHFILE, LABEL_STRING, "crystalShiftFile"); - MDL::addLabel(MDL_CRYSTAL_SHIFTX, LABEL_DOUBLE, "crystalShiftX"); - MDL::addLabel(MDL_CRYSTAL_SHIFTY, LABEL_DOUBLE, "crystalShiftY"); - MDL::addLabel(MDL_CRYSTAL_SHIFTZ, LABEL_DOUBLE, "crystalShiftZ"); - MDL::addLabel(MDL_CRYSTAL_NOISE_SHIFT,LABEL_VECTOR_DOUBLE, "crystalNoiseShift"); - MDL::addLabel(MDL_CTF_BG_BASELINE, LABEL_DOUBLE, "ctfBgBaseline"); - MDL::addLabelAlias(MDL_CTF_BG_BASELINE, "CTFBG_Baseline");//3.0 - MDL::addLabel(MDL_CTF_BG_GAUSSIAN2_ANGLE, LABEL_DOUBLE, "ctfBgGaussian2Angle"); - MDL::addLabelAlias(MDL_CTF_BG_GAUSSIAN2_ANGLE, "CTFBG_Gaussian2_Angle"); //3.0 - MDL::addLabel(MDL_CTF_BG_R1, LABEL_DOUBLE, "ctfBgR1"); - MDL::addLabel(MDL_CTF_BG_R2, LABEL_DOUBLE, "ctfBgR2"); - MDL::addLabel(MDL_CTF_BG_R3, LABEL_DOUBLE, "ctfBgR3"); - - MDL::addLabel(MDL_CTF_DATA_PHASE_FLIPPED, LABEL_BOOL, "ctfPhaseFlipped"); - MDL::addLabel(MDL_CTF_CORRECTED, LABEL_BOOL, "ctfCorrected"); - MDL::addLabel(MDL_CTF_X0, LABEL_DOUBLE, "ctfX0"); - MDL::addLabel(MDL_CTF_XF, LABEL_DOUBLE, "ctfXF"); - MDL::addLabel(MDL_CTF_Y0, LABEL_DOUBLE, "ctfY0"); - MDL::addLabel(MDL_CTF_YF, LABEL_DOUBLE, "ctfYF"); - MDL::addLabel(MDL_CTF_DEFOCUS_PLANEUA, LABEL_DOUBLE, "ctfDefocusPlaneUA"); - MDL::addLabel(MDL_CTF_DEFOCUS_PLANEUB, LABEL_DOUBLE, "ctfDefocusPlaneUB"); - MDL::addLabel(MDL_CTF_DEFOCUS_PLANEUC, LABEL_DOUBLE, "ctfDefocusPlaneUC"); - MDL::addLabel(MDL_CTF_DEFOCUS_PLANEVA, LABEL_DOUBLE, "ctfDefocusPlaneVA"); - MDL::addLabel(MDL_CTF_DEFOCUS_PLANEVB, LABEL_DOUBLE, "ctfDefocusPlaneVB"); - MDL::addLabel(MDL_CTF_DEFOCUS_PLANEVC, LABEL_DOUBLE, "ctfDefocusPlaneVC"); - - - MDL::addLabel(MDL_CTF_BG_GAUSSIAN2_CU, LABEL_DOUBLE, "ctfBgGaussian2CU"); - MDL::addLabel(MDL_CTF_BG_GAUSSIAN2_CV, LABEL_DOUBLE, "ctfBgGaussian2CV"); - MDL::addLabel(MDL_CTF_BG_GAUSSIAN2_K, LABEL_DOUBLE, "ctfBgGaussian2K"); - MDL::addLabel(MDL_CTF_BG_GAUSSIAN2_SIGMAU, LABEL_DOUBLE, "ctfBgGaussian2SigmaU"); - MDL::addLabel(MDL_CTF_BG_GAUSSIAN2_SIGMAV, LABEL_DOUBLE, "ctfBgGaussian2SigmaV"); - MDL::addLabel(MDL_CTF_BG_GAUSSIAN_ANGLE, LABEL_DOUBLE, "ctfBgGaussianAngle"); - MDL::addLabel(MDL_CTF_BG_GAUSSIAN_CU, LABEL_DOUBLE, "ctfBgGaussianCU"); - MDL::addLabel(MDL_CTF_BG_GAUSSIAN_CV, LABEL_DOUBLE, "ctfBgGaussianCV"); - MDL::addLabel(MDL_CTF_BG_GAUSSIAN_K, LABEL_DOUBLE, "ctfBgGaussianK"); - MDL::addLabel(MDL_CTF_BG_GAUSSIAN_SIGMAU, LABEL_DOUBLE, "ctfBgGaussianSigmaU"); - MDL::addLabel(MDL_CTF_BG_GAUSSIAN_SIGMAV, LABEL_DOUBLE, "ctfBgGaussianSigmaV"); - MDL::addLabel(MDL_CTF_PHASE_SHIFT, LABEL_DOUBLE, "ctfVPPphaseshift"); - MDL::addLabel(MDL_CTF_VPP_RADIUS, LABEL_DOUBLE, "ctfVPPRadius"); - - MDL::addLabelAlias(MDL_CTF_BG_GAUSSIAN2_CU, "CTFBG_Gaussian2_CU");//3.0 - MDL::addLabelAlias(MDL_CTF_BG_GAUSSIAN2_CV, "CTFBG_Gaussian2_CV");//3.0 - MDL::addLabelAlias(MDL_CTF_BG_GAUSSIAN2_K, "CTFBG_Gaussian2_K");//3.0 - MDL::addLabelAlias(MDL_CTF_BG_GAUSSIAN2_SIGMAU, "CTFBG_Gaussian2_SigmaU");//3.0 - MDL::addLabelAlias(MDL_CTF_BG_GAUSSIAN2_SIGMAV, "CTFBG_Gaussian2_SigmaV");//3.0 - MDL::addLabelAlias(MDL_CTF_BG_GAUSSIAN_ANGLE, "CTFBG_Gaussian_Angle");//3.0 - MDL::addLabelAlias(MDL_CTF_BG_GAUSSIAN_CU, "CTFBG_Gaussian_CU");//3.0 - MDL::addLabelAlias(MDL_CTF_BG_GAUSSIAN_CV, "CTFBG_Gaussian_CV");//3.0 - MDL::addLabelAlias(MDL_CTF_BG_GAUSSIAN_K, "CTFBG_Gaussian_K");//3.0 - MDL::addLabelAlias(MDL_CTF_BG_GAUSSIAN_SIGMAU, "CTFBG_Gaussian_SigmaU");//3.0 - MDL::addLabelAlias(MDL_CTF_BG_GAUSSIAN_SIGMAV, "CTFBG_Gaussian_SigmaV");//3.0 - - MDL::addLabel(MDL_CTF_BG_SQRT_ANGLE, LABEL_DOUBLE, "ctfBgSqrtAngle"); - MDL::addLabel(MDL_CTF_BG_SQRT_K, LABEL_DOUBLE, "ctfBgSqrtK"); - MDL::addLabel(MDL_CTF_BG_SQRT_U, LABEL_DOUBLE, "ctfBgSqrtU"); - MDL::addLabel(MDL_CTF_BG_SQRT_V, LABEL_DOUBLE, "ctfBgSqrtV"); - MDL::addLabelAlias(MDL_CTF_BG_SQRT_ANGLE, "CTFBG_Sqrt_Angle");//3.0 - MDL::addLabelAlias(MDL_CTF_BG_SQRT_K, "CTFBG_Sqrt_K");//3.0 - MDL::addLabelAlias(MDL_CTF_BG_SQRT_U, "CTFBG_Sqrt_U");//3.0 - MDL::addLabelAlias(MDL_CTF_BG_SQRT_V, "CTFBG_Sqrt_V"); //3.0 - - MDL::addLabel(MDL_CONTINUOUS_X, LABEL_DOUBLE, "continuousX"); - MDL::addLabel(MDL_CONTINUOUS_Y, LABEL_DOUBLE, "continuousY"); - MDL::addLabel(MDL_CONTINUOUS_FLIP, LABEL_BOOL, "continuousFlip"); - MDL::addLabel(MDL_CONTINUOUS_GRAY_A, LABEL_DOUBLE, "continuousA"); - MDL::addLabel(MDL_CONTINUOUS_GRAY_B, LABEL_DOUBLE, "continuousB"); - MDL::addLabel(MDL_CONTINUOUS_SCALE_ANGLE, LABEL_DOUBLE, "continuousScaleAngle"); - MDL::addLabel(MDL_CONTINUOUS_SCALE_X, LABEL_DOUBLE, "continuousScaleX"); - MDL::addLabel(MDL_CONTINUOUS_SCALE_Y, LABEL_DOUBLE, "continuousScaleY"); - MDL::addLabel(MDL_CTF_CA, LABEL_DOUBLE, "ctfChromaticAberration"); - MDL::addLabel(MDL_CTF_CONVERGENCE_CONE, LABEL_DOUBLE, "ctfConvergenceCone"); - MDL::addLabel(MDL_CTF_CRIT_NONASTIGMATICVALIDITY, LABEL_DOUBLE, "ctfCritNonAstigmaticValidty"); - MDL::addLabel(MDL_CTF_CRIT_DAMPING, LABEL_DOUBLE, "ctfCritDamping"); - MDL::addLabel(MDL_CTF_CRIT_FIRSTZEROAVG, LABEL_DOUBLE, "ctfCritFirstZero"); - MDL::addLabel(MDL_CTF_CRIT_FIRSTZERODISAGREEMENT, LABEL_DOUBLE, "ctfCritDisagree"); - MDL::addLabel(MDL_CTF_CRIT_MAXFREQ, LABEL_DOUBLE, "ctfCritMaxFreq"); - MDL::addLabel(MDL_CTF_CRIT_FIRSTZERORATIO, LABEL_DOUBLE, "ctfCritfirstZeroRatio"); - MDL::addLabel(MDL_CTF_CRIT_FIRSTMINIMUM_FIRSTZERO_RATIO, LABEL_DOUBLE, "ctfCritFirstMinFirstZeroRatio"); - MDL::addLabel(MDL_CTF_CRIT_FIRSTMINIMUM_FIRSTZERO_DIFF_RATIO, LABEL_DOUBLE, "ctfCritCtfMargin"); - MDL::addLabel(MDL_CTF_CRIT_FITTINGCORR13, LABEL_DOUBLE, "ctfCritCorr13"); - MDL::addLabel(MDL_CTF_CRIT_FITTINGSCORE, LABEL_DOUBLE, "ctfCritFitting"); - MDL::addLabel(MDL_CTF_CRIT_ICENESS, LABEL_DOUBLE, "ctfCritIceness"); - MDL::addLabel(MDL_CTF_CRIT_NORMALITY, LABEL_DOUBLE, "ctfCritNormality"); - MDL::addLabel(MDL_CTF_CRIT_PSDCORRELATION90, LABEL_DOUBLE, "ctfCritPsdCorr90"); - MDL::addLabel(MDL_CTF_CRIT_PSDPCA1VARIANCE, LABEL_DOUBLE, "ctfCritPsdPCA1"); - MDL::addLabel(MDL_CTF_CRIT_PSDPCARUNSTEST, LABEL_DOUBLE, "ctfCritPsdPCARuns"); - MDL::addLabel(MDL_CTF_CRIT_PSDRADIALINTEGRAL, LABEL_DOUBLE, "ctfCritPsdInt"); - MDL::addLabel(MDL_CTF_CRIT_PSDVARIANCE, LABEL_DOUBLE, "ctfCritPsdStdQ"); - MDL::addLabel(MDL_CTF_CS, LABEL_DOUBLE, "ctfSphericalAberration"); - MDL::addLabel(MDL_CTF_DEFOCUSA, LABEL_DOUBLE, "ctfDefocusA");//average defocus - MDL::addLabel(MDL_CTF_DEFOCUS_ANGLE, LABEL_DOUBLE, "ctfDefocusAngle"); - MDL::addLabel(MDL_CTF_DEFOCUSU, LABEL_DOUBLE, "ctfDefocusU"); - MDL::addLabel(MDL_CTF_DEFOCUSV, LABEL_DOUBLE, "ctfDefocusV"); - MDL::addLabel(MDL_CTF_DEFOCUS_CHANGE, LABEL_DOUBLE, "ctfDefocusChange"); - MDL::addLabel(MDL_CTF_DEFOCUS_R2, LABEL_DOUBLE, "ctfDefocusR2"); - MDL::addLabel(MDL_CTF_DEFOCUS_RESIDUAL, LABEL_DOUBLE, "ctfDefocusResidual"); - MDL::addLabel(MDL_CTF_DEFOCUS_COEFS, LABEL_VECTOR_DOUBLE, "ctfDefocusCoeficients"); - MDL::addLabel(MDL_CTF_DIMENSIONS, LABEL_VECTOR_DOUBLE, "ctfDimensions"); - MDL::addLabel(MDL_CTF_DOWNSAMPLE_PERFORMED, LABEL_DOUBLE, "CtfDownsampleFactor"); - MDL::addLabel(MDL_CTF_ENERGY_LOSS, LABEL_DOUBLE, "ctfEnergyLoss"); - MDL::addLabel(MDL_CTF_ENVELOPE, LABEL_DOUBLE, "ctfEnvelope"); - MDL::addLabel(MDL_CTF_ENVELOPE_PLOT, LABEL_STRING, "ctfEnvelopePlot"); - MDL::addLabel(MDL_CTF_GROUP, LABEL_INT, "ctfGroup"); - MDL::addLabel(MDL_CTF_INPUTPARAMS, LABEL_STRING, "ctfInputParams", TAGLABEL_TEXTFILE); - MDL::addLabel(MDL_CTF_K, LABEL_DOUBLE, "ctfK"); - MDL::addLabel(MDL_CTF_ENV_R0, LABEL_DOUBLE, "ctfEnvR0"); - MDL::addLabel(MDL_CTF_ENV_R1, LABEL_DOUBLE, "ctfEnvR1"); - MDL::addLabel(MDL_CTF_ENV_R2, LABEL_DOUBLE, "ctfEnvR2"); - MDL::addLabel(MDL_CTF_LAMBDA, LABEL_DOUBLE, "ctfLambda"); - MDL::addLabel(MDL_CTF_LENS_STABILITY, LABEL_DOUBLE, "ctfLensStability"); - MDL::addLabel(MDL_CTF_LONGITUDINAL_DISPLACEMENT, LABEL_DOUBLE, "ctfLongitudinalDisplacement"); - MDL::addLabel(MDL_CTF_MODEL2, LABEL_STRING, "ctfModel2", TAGLABEL_CTFPARAM); - MDL::addLabel(MDL_CTF_MODEL, LABEL_STRING, "ctfModel", TAGLABEL_CTFPARAM); - MDL::addLabel(MDL_CTF_Q0, LABEL_DOUBLE, "ctfQ0"); - MDL::addLabel(MDL_CTF_SAMPLING_RATE, LABEL_DOUBLE, "ctfSamplingRate"); - MDL::addLabel(MDL_CTF_SAMPLING_RATE_Z, LABEL_DOUBLE, "ctfSamplingRateZ"); - MDL::addLabel(MDL_CTF_TRANSVERSAL_DISPLACEMENT, LABEL_DOUBLE, "ctfTransversalDisplacement"); - MDL::addLabel(MDL_CTF_VOLTAGE, LABEL_DOUBLE, "ctfVoltage"); - MDL::addLabel(MDL_CTF_XRAY_LENS_TYPE, LABEL_STRING, "ctfXrayLensType"); - MDL::addLabel(MDL_CTF_XRAY_OUTER_ZONE_WIDTH, LABEL_DOUBLE, "ctfXrayOuterZoneWidth"); - MDL::addLabel(MDL_CTF_XRAY_ZONES_NUMBER, LABEL_DOUBLE, "ctfXrayZonesN"); - MDL::addLabel(MDL_CUMULATIVE_SSNR, LABEL_DOUBLE, "cumulativeSSNR"); - - MDL::addLabelAlias(MDL_CTF_CA, "CTF_Chromatic_aberration"); //3.0 - MDL::addLabelAlias(MDL_CTF_CONVERGENCE_CONE, "CTF_Convergence_cone"); //3.0 - MDL::addLabelAlias(MDL_CTF_CRIT_DAMPING, "CTFCrit_damping"); //3.0 - MDL::addLabelAlias(MDL_CTF_CRIT_FIRSTZEROAVG, "CTFCrit_firstZero"); //3.0 - MDL::addLabelAlias(MDL_CTF_CRIT_FIRSTZERODISAGREEMENT, "CTFCrit_disagree"); //3.0 - MDL::addLabelAlias(MDL_CTF_CRIT_FIRSTZERORATIO, "CTFCrit_firstZeroRatio"); //3.0 - MDL::addLabelAlias(MDL_CTF_CRIT_FITTINGCORR13, "CTFCrit_Corr13"); //3.0 - MDL::addLabelAlias(MDL_CTF_CRIT_FITTINGSCORE, "CTFCrit_Fitting"); //3.0 - MDL::addLabelAlias(MDL_CTF_CRIT_NORMALITY, "CTFCrit_Normality"); //3.0 - MDL::addLabelAlias(MDL_CTF_CRIT_PSDCORRELATION90, "CTFCrit_psdcorr90"); //3.0 - MDL::addLabelAlias(MDL_CTF_CRIT_PSDPCA1VARIANCE, "CTFCrit_PSDPCA1"); //3.0 - MDL::addLabelAlias(MDL_CTF_CRIT_PSDPCARUNSTEST, "CTFCrit_PSDPCARuns"); //3.0 - MDL::addLabelAlias(MDL_CTF_CRIT_PSDRADIALINTEGRAL, "CTFCrit_psdint"); //3.0 - MDL::addLabelAlias(MDL_CTF_CRIT_PSDVARIANCE, "CTFCrit_PSDStdQ"); //3.0 - MDL::addLabelAlias(MDL_CTF_CS, "CTF_Spherical_aberration"); //3.0 - MDL::addLabelAlias(MDL_CTF_DEFOCUSA, "CTF_Defocus_A"); //3.0//average defocus - MDL::addLabelAlias(MDL_CTF_DEFOCUS_ANGLE, "CTF_Defocus_angle"); //3.0 - MDL::addLabelAlias(MDL_CTF_DEFOCUSU, "CTF_Defocus_U"); //3.0 - MDL::addLabelAlias(MDL_CTF_DEFOCUSV, "CTF_Defocus_V"); //3.0 - MDL::addLabelAlias(MDL_CTF_DIMENSIONS, "CTF_Xray_dimensions"); //3.0 - MDL::addLabelAlias(MDL_CTF_DOWNSAMPLE_PERFORMED, "CTFDownsampleFactor"); //3.0 - MDL::addLabelAlias(MDL_CTF_ENERGY_LOSS, "CTF_Energy_loss"); //3.0 - MDL::addLabelAlias(MDL_CTF_GROUP, "CTFGroup"); //3.0 - MDL::addLabelAlias(MDL_CTF_INPUTPARAMS, "CTFInputParams"); //3.0 - MDL::addLabelAlias(MDL_CTF_K, "CTF_K"); //3.0 - MDL::addLabelAlias(MDL_CTF_LAMBDA, "CTF_Xray_lambda"); //3.0 - MDL::addLabelAlias(MDL_CTF_LENS_STABILITY, "CTF_Lens_stability"); //3.0 - MDL::addLabelAlias(MDL_CTF_LONGITUDINAL_DISPLACEMENT, "CTF_Longitudinal_displacement"); //3.0 - MDL::addLabelAlias(MDL_CTF_MODEL2, "CTFModel2"); //3.0 - MDL::addLabelAlias(MDL_CTF_MODEL, "CTFModel"); //3.0 - MDL::addLabelAlias(MDL_CTF_Q0, "CTF_Q0"); //3.0 - MDL::addLabelAlias(MDL_CTF_SAMPLING_RATE, "CTF_Sampling_rate"); //3.0 - MDL::addLabelAlias(MDL_CTF_SAMPLING_RATE_Z, "CTF_Sampling_rate_z"); //3.0 - MDL::addLabelAlias(MDL_CTF_TRANSVERSAL_DISPLACEMENT, "CTF_Transversal_displacement"); //3.0 - MDL::addLabelAlias(MDL_CTF_VOLTAGE, "CTF_Voltage"); //3.0 - MDL::addLabelAlias(MDL_CTF_XRAY_LENS_TYPE, "CTF_Xray_lens_type"); //3.0 - MDL::addLabelAlias(MDL_CTF_XRAY_OUTER_ZONE_WIDTH, "CTF_Xray_OuterZoneWidth"); //3.0 - MDL::addLabelAlias(MDL_CTF_XRAY_ZONES_NUMBER, "CTF_Xray_ZonesN"); //3.0 - - MDL::addLabel(MDL_DATATYPE, LABEL_INT, "datatype"); - MDL::addLabel(MDL_DEFGROUP, LABEL_INT, "defocusGroup"); - MDL::addLabel(MDL_DIMENSIONS_2D, LABEL_VECTOR_DOUBLE, "dimensions2D"); - MDL::addLabel(MDL_DIMENSIONS_3D, LABEL_VECTOR_DOUBLE, "dimensions3D"); - MDL::addLabel(MDL_DIMRED, LABEL_VECTOR_DOUBLE, "dimredCoeffs"); - MDL::addLabel(MDL_DIRECTION, LABEL_VECTOR_DOUBLE, "direction"); - MDL::addLabel(MDL_DM3_IDTAG, LABEL_INT, "dm3IdTag"); - MDL::addLabel(MDL_DM3_NODEID, LABEL_INT, "dm3NodeId"); - MDL::addLabel(MDL_DM3_NUMBER_TYPE, LABEL_INT, "dm3NumberType"); - MDL::addLabel(MDL_DM3_PARENTID, LABEL_INT, "dm3ParentID"); - MDL::addLabel(MDL_DM3_SIZE, LABEL_INT, "dm3Size"); - MDL::addLabel(MDL_DM3_TAGCLASS, LABEL_STRING, "dm3TagClass"); - MDL::addLabel(MDL_DM3_TAGNAME, LABEL_STRING, "dm3TagName"); - MDL::addLabel(MDL_DM3_VALUE, LABEL_VECTOR_DOUBLE, "dm3Value"); - MDL::addLabel(MDL_DOSE, LABEL_DOUBLE, "dose"); - - MDL::addLabel(MDL_ENABLED, LABEL_INT, "enabled"); - - //MDL_EXECUTION_DATE so far an string but may change... - MDL::addLabel(MDL_DATE, LABEL_STRING, "date"); - MDL::addLabel(MDL_TIME, LABEL_DOUBLE, "time"); - - MDL::addLabel(MDL_FLIP, LABEL_BOOL, "flip"); - MDL::addLabelAlias(MDL_FLIP, "Flip"); - MDL::addLabel(MDL_FOM, LABEL_DOUBLE, "fom"); - MDL::addLabel(MDL_FRAME_ID, LABEL_SIZET, "frameId"); - - MDL::addLabel(MDL_GRAPH_DISTANCE2MAX, LABEL_DOUBLE, "distance2MaxGraph"); - MDL::addLabel(MDL_GRAPH_DISTANCE2MAX_PREVIOUS, LABEL_DOUBLE, "distance2MaxGraphPrevious"); - MDL::addLabel(MDL_GRAPH_CC, LABEL_DOUBLE, "graphCC"); - MDL::addLabel(MDL_GRAPH_CC_PREVIOUS, LABEL_DOUBLE, "graphCCPrevious"); - MDL::addLabel(MDL_HALF1, LABEL_STRING, "half1"); - MDL::addLabel(MDL_HALF2, LABEL_STRING, "half2"); - MDL::addLabel(MDL_ASSIGNED_DIR_REF_CC, LABEL_DOUBLE, "assignedDirRefCC"); - - MDL::addLabel(MDL_IDX, LABEL_SIZET, "index"); - MDL::addLabel(MDL_IMAGE1, LABEL_STRING, "image1", TAGLABEL_IMAGE); - MDL::addLabel(MDL_IMAGE2, LABEL_STRING, "image2", TAGLABEL_IMAGE); - MDL::addLabel(MDL_IMAGE3, LABEL_STRING, "image3", TAGLABEL_IMAGE); - MDL::addLabel(MDL_IMAGE4, LABEL_STRING, "image4", TAGLABEL_IMAGE); - MDL::addLabel(MDL_IMAGE5, LABEL_STRING, "image5", TAGLABEL_IMAGE); - - MDL::addLabelAlias(MDL_IMAGE1, "associatedImage1"); //3.0 - MDL::addLabelAlias(MDL_IMAGE2, "associatedImage2"); //3.0 - MDL::addLabelAlias(MDL_IMAGE3, "associatedImage3"); //3.0 - MDL::addLabelAlias(MDL_IMAGE4, "associatedImage4"); //3.0 - MDL::addLabelAlias(MDL_IMAGE5, "associatedImage5"); //3.0 - - MDL::addLabel(MDL_IMAGE, LABEL_STRING, "image", TAGLABEL_IMAGE); - MDL::addLabel(MDL_IMAGE_COVARIANCE, LABEL_STRING, "imageCovariance", TAGLABEL_IMAGE); - MDL::addLabel(MDL_IMAGE_IDX, LABEL_SIZET, "imageIndex"); - MDL::addLabel(MDL_IMAGE_ORIGINAL, LABEL_STRING, "imageOriginal", TAGLABEL_IMAGE); - MDL::addLabel(MDL_IMAGE_REF, LABEL_STRING, "imageRef", TAGLABEL_IMAGE); - MDL::addLabel(MDL_IMAGE_RESIDUAL, LABEL_STRING, "imageResidual", TAGLABEL_IMAGE); - MDL::addLabel(MDL_IMAGE_TILTED, LABEL_STRING, "imageTilted", TAGLABEL_IMAGE); - - MDL::addLabelAlias(MDL_IMAGE_ORIGINAL, "original_image"); //3.0 - MDL::addLabelAlias(MDL_IMAGE_TILTED, "tilted_image"); //3.0 - - MDL::addLabel(MDL_IMED, LABEL_DOUBLE, "imedValue"); - - MDL::addLabel(MDL_IMGMD, LABEL_STRING, "imageMetaData", TAGLABEL_METADATA); - MDL::addLabel(MDL_INTSCALE, LABEL_DOUBLE, "intScale"); - - MDL::addLabel(MDL_ITEM_ID, LABEL_SIZET, "itemId"); - MDL::addLabel(MDL_ITER, LABEL_INT, "iterationNumber"); - - MDL::addLabel(MDL_KERDENSOM_FUNCTIONAL, LABEL_DOUBLE, "kerdensomFunctional"); - MDL::addLabel(MDL_KERDENSOM_REGULARIZATION, LABEL_DOUBLE, "kerdensomRegularization"); - MDL::addLabel(MDL_KERDENSOM_SIGMA, LABEL_DOUBLE, "kerdensomSigma"); - - MDL::addLabel(MDL_KEYWORDS, LABEL_STRING, "keywords"); - MDL::addLabel(MDL_KSTEST, LABEL_DOUBLE, "kstest"); - MDL::addLabel(MDL_LL, LABEL_DOUBLE, "logLikelihood"); - MDL::addLabelAlias(MDL_LL, "LL"); - MDL::addLabel(MDL_LOCAL_ALIGNMENT_PATCHES, LABEL_VECTOR_SIZET, "localAlignmentPatches"); - MDL::addLabel(MDL_LOCAL_ALIGNMENT_COEFFS_X, LABEL_VECTOR_DOUBLE, "localAlignmentCoeffsX"); - MDL::addLabel(MDL_LOCAL_ALIGNMENT_COEFFS_Y, LABEL_VECTOR_DOUBLE, "localAlignmentCoeffsY"); - MDL::addLabel(MDL_LOCAL_ALIGNMENT_CONF_2_5_PERC, LABEL_DOUBLE, "localAlignmnentConf25Perc"); - MDL::addLabel(MDL_LOCAL_ALIGNMENT_CONF_97_5_PERC, LABEL_DOUBLE, "localAlignmnentConf955Perc"); - MDL::addLabel(MDL_LOCAL_ALIGNMENT_CONTROL_POINTS, LABEL_VECTOR_SIZET, "localAlignmentControlPoints"); - MDL::addLabel(MDL_LOCAL_AVERAGE, LABEL_DOUBLE, "localAverage"); - MDL::addLabel(MDL_MACRO_CMD, LABEL_STRING, "macroCmd"); - MDL::addLabel(MDL_MACRO_CMD_ARGS, LABEL_STRING, "macroCmdArgs"); - MDL::addLabel(MDL_MAGNIFICATION, LABEL_DOUBLE, "magnification"); - MDL::addLabel(MDL_MAPTOPOLOGY, LABEL_STRING, "mapTopology"); - MDL::addLabel(MDL_MASK, LABEL_STRING, "mask", TAGLABEL_IMAGE); - MDL::addLabel(MDL_MAXCC, LABEL_DOUBLE, "maxCC"); - MDL::addLabel(MDL_MAXCC_PERCENTILE, LABEL_DOUBLE, "maxCCPerc"); - MDL::addLabel(MDL_MAX, LABEL_DOUBLE, "max"); - MDL::addLabel(MDL_MAXCC_PREVIOUS, LABEL_DOUBLE, "maxCCprevious"); - MDL::addLabel(MDL_MICROGRAPH_ID, LABEL_SIZET, "micrographId"); - MDL::addLabel(MDL_MICROGRAPH, LABEL_STRING, "micrograph", TAGLABEL_MICROGRAPH); - MDL::addLabel(MDL_MICROGRAPH_MOVIE_ID, LABEL_SIZET, "micrographMovieId"); - MDL::addLabel(MDL_MICROGRAPH_MOVIE, LABEL_STRING, "movie", TAGLABEL_MICROGRAPH); - MDL::addLabel(MDL_MICROGRAPH_PARTICLES, LABEL_STRING, "micrographParticles", TAGLABEL_MICROGRAPH); - MDL::addLabel(MDL_MICROGRAPH_ORIGINAL, LABEL_STRING, "micrographOriginal", TAGLABEL_MICROGRAPH); - MDL::addLabel(MDL_MICROGRAPH_TILTED, LABEL_STRING, "micrographTilted", TAGLABEL_MICROGRAPH); - MDL::addLabel(MDL_MICROGRAPH_TILTED_ORIGINAL, LABEL_STRING, "micrographTiltedOriginal", TAGLABEL_MICROGRAPH); - MDL::addLabel(MDL_MIN, LABEL_DOUBLE, "min"); - MDL::addLabel(MDL_MIRRORFRAC, LABEL_DOUBLE, "mirrorFraction"); - MDL::addLabel(MDL_MISSINGREGION_NR, LABEL_INT, "missingRegionNumber"); - MDL::addLabelAlias(MDL_MISSINGREGION_NR, "Wedge"); - MDL::addLabel(MDL_MISSINGREGION_THX0, LABEL_DOUBLE, "missingRegionThetaX0"); - MDL::addLabel(MDL_MISSINGREGION_THXF, LABEL_DOUBLE, "missingRegionThetaXF"); - - MDL::addLabel(MDL_MLF_CTF, LABEL_DOUBLE, "mlfCtf"); - MDL::addLabel(MDL_MLF_WIENER, LABEL_DOUBLE, "mlfWiener"); - MDL::addLabel(MDL_MLF_SIGNAL, LABEL_DOUBLE, "mlfSignal"); - MDL::addLabel(MDL_MLF_NOISE, LABEL_DOUBLE, "mlfNoise"); - - MDL::addLabel(MDL_MISSINGREGION_THY0, LABEL_DOUBLE, "missingRegionThetaY0"); - MDL::addLabel(MDL_MISSINGREGION_THYF, LABEL_DOUBLE, "missingRegionThetaYF"); - MDL::addLabel(MDL_MISSINGREGION_TYPE, LABEL_STRING, "missingRegionType"); - MDL::addLabel(MDL_MODELFRAC, LABEL_DOUBLE, "modelFraction"); - MDL::addLabel(MDL_NEIGHBORHOOD_RADIUS, LABEL_DOUBLE, "neighborhoodRadius"); - MDL::addLabel(MDL_NEIGHBOR, LABEL_SIZET, "neighbor"); - MDL::addLabel(MDL_NEIGHBORS, LABEL_VECTOR_SIZET, "neighbors"); - MDL::addLabel(MDL_NMA, LABEL_VECTOR_DOUBLE, "nmaDisplacements"); - MDL::addLabelAlias(MDL_NMA, "NMADisplacements");//3.0 - MDL::addLabel(MDL_NMA_ATOMSHIFT, LABEL_DOUBLE, "nmaAtomShift"); - MDL::addLabel(MDL_NMA_COLLECTIVITY, LABEL_DOUBLE, "nmaCollectivity"); - MDL::addLabel(MDL_NMA_ENERGY, LABEL_DOUBLE, "nmaEnergy"); - MDL::addLabel(MDL_NMA_MINRANGE, LABEL_DOUBLE, "nmaMin"); - MDL::addLabel(MDL_NMA_MAXRANGE, LABEL_DOUBLE, "nmaMax"); - MDL::addLabel(MDL_NMA_MODEFILE, LABEL_STRING, "nmaModefile", TAGLABEL_TEXTFILE); - MDL::addLabelAlias(MDL_NMA_MODEFILE, "NMAModefile");//3.0 - MDL::addLabel(MDL_NMA_SCORE, LABEL_DOUBLE, "nmaScore"); - MDL::addLabel(MDL_NMA_EIGENVAL, LABEL_DOUBLE, "nmaEigenval"); - MDL::addLabel(MDL_NOISE_ANGLES, LABEL_VECTOR_DOUBLE, "noiseAngles"); - MDL::addLabel(MDL_NOISE_COORD, LABEL_VECTOR_DOUBLE, "noiseCoord"); - MDL::addLabel(MDL_NOISE_PARTICLE_COORD, LABEL_VECTOR_DOUBLE, "noiseParticleCoord"); - MDL::addLabel(MDL_NOISE_PIXEL_LEVEL, LABEL_VECTOR_DOUBLE, "noisePixelLevel"); - MDL::addLabel(MDL_ORDER, LABEL_SIZET, "order_"); - MDL::addLabel(MDL_ORIGIN_X, LABEL_DOUBLE, "originX"); - MDL::addLabel(MDL_ORIGIN_Y, LABEL_DOUBLE, "originY"); - MDL::addLabel(MDL_ORIGIN_Z, LABEL_DOUBLE, "originZ"); - MDL::addLabel(MDL_PARTICLE_ID, LABEL_SIZET, "particleId"); - MDL::addLabel(MDL_PHANTOM_BGDENSITY, LABEL_DOUBLE, "phantomBGDensity"); - MDL::addLabel(MDL_PHANTOM_FEATURE_CENTER, LABEL_VECTOR_DOUBLE, "featureCenter"); - MDL::addLabel(MDL_PHANTOM_FEATURE_DENSITY, LABEL_DOUBLE, "featureDensity"); - MDL::addLabel(MDL_PHANTOM_FEATURE_OPERATION, LABEL_STRING, "featureOperation"); - MDL::addLabel(MDL_PHANTOM_FEATURE_SPECIFIC, LABEL_VECTOR_DOUBLE, "featureSpecificVector"); - MDL::addLabel(MDL_PHANTOM_FEATURE_TYPE, LABEL_STRING, "featureType"); - MDL::addLabel(MDL_PHANTOM_SCALE, LABEL_DOUBLE, "phantomScale"); - - MDL::addLabel(MDL_OPTICALFLOW_MEANX, LABEL_DOUBLE, "opticalMeanX"); - MDL::addLabel(MDL_OPTICALFLOW_MEANY, LABEL_DOUBLE, "opticalMeanY"); - MDL::addLabel(MDL_OPTICALFLOW_STDX, LABEL_DOUBLE, "opticalStdX"); - MDL::addLabel(MDL_OPTICALFLOW_STDY, LABEL_DOUBLE, "opticalStdY"); - - MDL::addLabel(MDL_PICKING_STATE, LABEL_STRING, "pickingState"); - MDL::addLabelAlias(MDL_PICKING_STATE, "picking_state");//3.0 - MDL::addLabel(MDL_PICKING_MICROGRAPH_STATE, LABEL_STRING, "pickingMicrographState"); - MDL::addLabelAlias(MDL_PICKING_MICROGRAPH_STATE, "micrograph_state");//3.0 - MDL::addLabel(MDL_PICKING_PARTICLE_SIZE, LABEL_INT, "particleSize"); - MDL::addLabel(MDL_PICKING_AUTOPICKPERCENT, LABEL_INT, "autopickPercent"); - MDL::addLabel(MDL_PICKING_TEMPLATES, LABEL_INT, "templatesNum"); - MDL::addLabel(MDL_PICKING_AUTOPARTICLES_SIZE, LABEL_INT, "autoParticlesNum"); - MDL::addLabel(MDL_PICKING_MANUALPARTICLES_SIZE, LABEL_INT, "manualParticlesNum"); - - MDL::addLabel(MDL_PMAX, LABEL_DOUBLE, "pMax"); - MDL::addLabelAlias(MDL_PMAX, "Pmax"); - MDL::addLabelAlias(MDL_PMAX, "sumP"); - MDL::addLabel(MDL_POINTSASYMETRICUNIT, LABEL_SIZET, "pointsAsymmetricUnit"); - MDL::addLabelAlias(MDL_POINTSASYMETRICUNIT, "pointsasymmetricUnit"); - MDL::addLabel(MDL_PRJ_ANGFILE, LABEL_STRING, "projAngleFile"); - MDL::addLabelAlias(MDL_PRJ_ANGFILE, "angleFile");//3.0 - MDL::addLabel(MDL_PRJ_DIMENSIONS, LABEL_VECTOR_DOUBLE, "projDimensions"); - MDL::addLabel(MDL_PRJ_PSI_NOISE, LABEL_VECTOR_DOUBLE, "projPsiNoise"); - MDL::addLabel(MDL_PRJ_PSI_RANDSTR, LABEL_STRING, "projPsiRandomness"); - MDL::addLabel(MDL_PRJ_PSI_RANGE, LABEL_VECTOR_DOUBLE, "projPsiRange"); - MDL::addLabel(MDL_PRJ_ROT_NOISE, LABEL_VECTOR_DOUBLE, "projRotNoise"); - MDL::addLabel(MDL_PRJ_ROT_RANDSTR, LABEL_STRING, "projRotRandomness"); - MDL::addLabel(MDL_PRJ_ROT_RANGE, LABEL_VECTOR_DOUBLE, "projRotRange"); - MDL::addLabel(MDL_PRJ_TILT_NOISE, LABEL_VECTOR_DOUBLE, "projTiltNoise"); - MDL::addLabel(MDL_PRJ_TILT_RANDSTR, LABEL_STRING, "projTiltRandomness"); - MDL::addLabel(MDL_PRJ_TILT_RANGE, LABEL_VECTOR_DOUBLE, "projTiltRange"); - MDL::addLabel(MDL_PRJ_VOL, LABEL_STRING, "projVolume", TAGLABEL_VOLUME); - - MDL::addLabel(MDL_PROGRAM, LABEL_STRING, "program"); - MDL::addLabel(MDL_USER, LABEL_STRING, "user"); - - MDL::addLabel(MDL_PSD_ENHANCED, LABEL_STRING, "psdEnhanced", TAGLABEL_IMAGE); - MDL::addLabelAlias(MDL_PSD_ENHANCED, "enhancedPowerSpectrum");//3.0 - MDL::addLabel(MDL_PSD, LABEL_STRING, "psd", TAGLABEL_PSD); - MDL::addLabelAlias(MDL_PSD, "powerSpectrum");//3.0 - MDL::addLabel(MDL_RANDOMSEED, LABEL_INT, "randomSeed"); - MDL::addLabel(MDL_REF2, LABEL_INT, "ref2"); - MDL::addLabel(MDL_REF3D, LABEL_INT, "ref3d"); - MDL::addLabel(MDL_REF, LABEL_INT, "ref"); - MDL::addLabelAlias(MDL_REF, "Ref"); - MDL::addLabel(MDL_REFMD, LABEL_STRING, "referenceMetaData", TAGLABEL_METADATA); - - MDL::addLabel(MDL_RESIDUE, LABEL_INT, "residue"); - MDL::addLabel(MDL_RESOLUTION_ANISOTROPY, LABEL_DOUBLE, "resolutionAnisotropy"); - MDL::addLabel(MDL_RESOLUTION_DPR, LABEL_DOUBLE, "resolutionDPR"); - MDL::addLabel(MDL_RESOLUTION_ERRORL2, LABEL_DOUBLE, "resolutionErrorL2"); - MDL::addLabel(MDL_RESOLUTION_FSO, LABEL_DOUBLE, "resolutionFSO"); - MDL::addLabel(MDL_RESOLUTION_FRC, LABEL_DOUBLE, "resolutionFRC"); - MDL::addLabel(MDL_RESOLUTION_FRCRANDOMNOISE, LABEL_DOUBLE, "resolutionFRCRandomNoise"); - MDL::addLabel(MDL_RESOLUTION_FREQ, LABEL_DOUBLE, "resolutionFreqFourier"); - MDL::addLabel(MDL_RESOLUTION_FREQ2, LABEL_DOUBLE, "resolutionFreqFourier2"); - MDL::addLabel(MDL_RESOLUTION_FREQREAL, LABEL_DOUBLE, "resolutionFreqReal"); - MDL::addLabel(MDL_RESOLUTION_LOCAL_RESIDUE, LABEL_DOUBLE, "localresolutionResidue"); - MDL::addLabel(MDL_RESOLUTION_LOG_STRUCTURE_FACTOR, LABEL_DOUBLE, "resolutionLogStructure"); - MDL::addLabel(MDL_RESOLUTION_STRUCTURE_FACTOR, LABEL_DOUBLE, "resolutionStructure"); - MDL::addLabel(MDL_RESOLUTION_SSNR, LABEL_DOUBLE, "resolutionSSNR"); - MDL::addLabel(MDL_RESOLUTION_RFACTOR, LABEL_DOUBLE, "resolutionRfactor"); - - MDL::addLabelAlias(MDL_RESOLUTION_DPR, "DPR"); - MDL::addLabelAlias(MDL_RESOLUTION_ERRORL2, "Error_l2"); - MDL::addLabelAlias(MDL_RESOLUTION_FRC, "FRC"); - MDL::addLabelAlias(MDL_RESOLUTION_FRCRANDOMNOISE, "FRC_random_noise"); - MDL::addLabelAlias(MDL_RESOLUTION_FREQ, "Resol_Inverse_Ang"); - MDL::addLabelAlias(MDL_RESOLUTION_FREQREAL, "Resol_Ang"); - - MDL::addLabel(MDL_SAMPLINGRATE, LABEL_DOUBLE, "samplingRate"); - MDL::addLabel(MDL_SAMPLINGRATE_ORIGINAL, LABEL_DOUBLE, "samplingRateOriginal"); - MDL::addLabel(MDL_SAMPLINGRATE_X, LABEL_DOUBLE, "samplingRateX"); - MDL::addLabel(MDL_SAMPLINGRATE_Y, LABEL_DOUBLE, "samplingRateY"); - MDL::addLabel(MDL_SAMPLINGRATE_Z, LABEL_DOUBLE, "samplingRateZ"); - - MDL::addLabelAlias(MDL_SAMPLINGRATE, "sampling_rate"); //3.0 - MDL::addLabelAlias(MDL_SAMPLINGRATE_ORIGINAL, "sampling_rate_original"); //3.0 - MDL::addLabelAlias(MDL_SAMPLINGRATE_X, "sampling_rateX"); //3.0 - MDL::addLabelAlias(MDL_SAMPLINGRATE_Y, "sampling_rateY"); //3.0 - MDL::addLabelAlias(MDL_SAMPLINGRATE_Z, "sampling_rateZ"); //3.0 - - MDL::addLabel(MDL_SCALE, LABEL_DOUBLE, "scale"); - MDL::addLabel(MDL_SCORE_BY_PCA_RESIDUAL_PROJ, LABEL_DOUBLE, "scoreByPcaResidualProj"); - MDL::addLabel(MDL_SCORE_BY_PCA_RESIDUAL_EXP, LABEL_DOUBLE, "scoreByPcaResidualExp"); - MDL::addLabel(MDL_SCORE_BY_PCA_RESIDUAL, LABEL_DOUBLE, "scoreByPcaResidual"); - MDL::addLabel(MDL_SCORE_BY_ALIGNABILITY, LABEL_DOUBLE, "scoreByAlignability"); - MDL::addLabel(MDL_SCORE_BY_ALIGNABILITY_PRECISION, LABEL_DOUBLE, "scoreByAlignabilityPrecision"); - MDL::addLabel(MDL_SCORE_BY_ALIGNABILITY_ACCURACY, LABEL_DOUBLE, "scoreByAlignabilityAccuracy"); - MDL::addLabel(MDL_SCORE_BY_ALIGNABILITY_PRECISION_EXP, LABEL_DOUBLE, "scoreByAlignabilityPrecisionExp"); - MDL::addLabel(MDL_SCORE_BY_ALIGNABILITY_PRECISION_REF, LABEL_DOUBLE, "scoreByAlignabilityPrecisionRef"); - MDL::addLabel(MDL_SCORE_BY_ALIGNABILITY_ACCURACY_EXP, LABEL_DOUBLE, "scoreByAlignabilityAccuracyExp"); - MDL::addLabel(MDL_SCORE_BY_ALIGNABILITY_ACCURACY_REF, LABEL_DOUBLE, "scoreByAlignabilityAccuracyRef"); - - MDL::addLabel(MDL_SCORE_BY_ALIGNABILITY_NOISE, LABEL_DOUBLE, "scoreByAlignabilityNoise"); - MDL::addLabel(MDL_SCORE_BY_EMPTINESS, LABEL_DOUBLE, "scoreEmptiness"); - MDL::addLabel(MDL_SCORE_BY_ENTROPY, LABEL_VECTOR_DOUBLE, "entropyFeatures"); - MDL::addLabel(MDL_SCORE_BY_GRANULO, LABEL_VECTOR_DOUBLE, "granuloFeatures"); - MDL::addLabel(MDL_SCORE_BY_HISTDIST, LABEL_VECTOR_DOUBLE, "histdistFeatures"); - MDL::addLabel(MDL_SCORE_BY_LBP, LABEL_VECTOR_DOUBLE, "lbpFeatures"); - MDL::addLabel(MDL_SCORE_BY_MIRROR, LABEL_DOUBLE, "scoreByMirror"); - MDL::addLabel(MDL_SCORE_BY_RAMP, LABEL_VECTOR_DOUBLE, "rampCoefficients"); - MDL::addLabel(MDL_SCORE_BY_SCREENING, LABEL_VECTOR_DOUBLE, "screenFeatures"); - MDL::addLabel(MDL_SCORE_BY_VARIANCE, LABEL_VECTOR_DOUBLE, "varianceFeatures"); - MDL::addLabel(MDL_SCORE_BY_VAR, LABEL_DOUBLE, "scoreByVariance"); - MDL::addLabel(MDL_SCORE_BY_GINI, LABEL_DOUBLE, "scoreByGiniCoeff"); - MDL::addLabel(MDL_SCORE_BY_ZERNIKE, LABEL_VECTOR_DOUBLE, "zernikeMoments"); - MDL::addLabel(MDL_SCORE_BY_ZSCORE, LABEL_DOUBLE, "scoreByZScore"); - - MDL::addLabelAlias(MDL_SCALE, "Scale"); - MDL::addLabel(MDL_SELFILE, LABEL_STRING, "selfile", TAGLABEL_METADATA); - MDL::addLabel(MDL_SERIE, LABEL_STRING, "serie"); - - MDL::addLabel(MDL_SHIFT_X, LABEL_DOUBLE, "shiftX"); - MDL::addLabelAlias(MDL_SHIFT_X, "Xoff"); - MDL::addLabel(MDL_SHIFT_X2, LABEL_DOUBLE, "shiftX2"); - MDL::addLabel(MDL_SHIFT_X3, LABEL_DOUBLE, "shiftX3"); - MDL::addLabel(MDL_SHIFT_X_DIFF, LABEL_DOUBLE, "shiftXDiff"); - MDL::addLabel(MDL_SHIFT_Y, LABEL_DOUBLE, "shiftY"); - MDL::addLabelAlias(MDL_SHIFT_Y, "Yoff"); - MDL::addLabel(MDL_SHIFT_Y2, LABEL_DOUBLE, "shiftY2"); - MDL::addLabel(MDL_SHIFT_Y3, LABEL_DOUBLE, "shiftY3"); - MDL::addLabel(MDL_SHIFT_Y_DIFF, LABEL_DOUBLE, "shiftYDiff"); - MDL::addLabel(MDL_SHIFT_Z, LABEL_DOUBLE, "shiftZ"); - MDL::addLabel(MDL_SHIFT_Z2, LABEL_DOUBLE, "shiftZ2"); - MDL::addLabel(MDL_SHIFT_Z3, LABEL_DOUBLE, "shiftZ3"); - MDL::addLabelAlias(MDL_SHIFT_Z, "Zoff"); - MDL::addLabel(MDL_SHIFT_DIFF0, LABEL_DOUBLE, "shiftDiff0"); - MDL::addLabel(MDL_SHIFT_DIFF, LABEL_DOUBLE, "shiftDiff"); - MDL::addLabel(MDL_SHIFT_DIFF2, LABEL_DOUBLE, "shiftDiff2"); - MDL::addLabel(MDL_SIGMANOISE, LABEL_DOUBLE, "sigmaNoise"); - MDL::addLabel(MDL_SIGMAOFFSET, LABEL_DOUBLE, "sigmaOffset"); - MDL::addLabel(MDL_SIGNALCHANGE, LABEL_DOUBLE, "signalChange"); - MDL::addLabel(MDL_SPH_COEFFICIENTS, LABEL_VECTOR_DOUBLE, "sphCoefficients"); - MDL::addLabel(MDL_SPH_DEFORMATION, LABEL_DOUBLE, "sphDeformation"); - MDL::addLabel(MDL_SPH_TSNE_COEFF1D, LABEL_DOUBLE, "sphTsne1D"); - MDL::addLabel(MDL_SPH_TSNE_COEFF2D, LABEL_VECTOR_DOUBLE, "sphTsne2D"); - MDL::addLabel(MDL_STDDEV, LABEL_DOUBLE, "stddev"); - MDL::addLabel(MDL_STAR_COMMENT, LABEL_STRING, "starComment"); - MDL::addLabel(MDL_SUBTOMOID, LABEL_SIZET, "subtomogramId"); - MDL::addLabel(MDL_SUBTRACTION_R2, LABEL_DOUBLE, "R2subtraction"); - MDL::addLabel(MDL_SUBTRACTION_B, LABEL_DOUBLE, "Bsubtraction"); - MDL::addLabel(MDL_SUBTRACTION_BETA0, LABEL_DOUBLE, "B0subtraction"); - MDL::addLabel(MDL_SUBTRACTION_BETA1, LABEL_DOUBLE, "B1subtraction"); - MDL::addLabel(MDL_SUM, LABEL_DOUBLE, "sum"); - MDL::addLabel(MDL_SUMWEIGHT, LABEL_DOUBLE, "sumWeight"); - MDL::addLabel(MDL_SYMNO, LABEL_INT, "symNo"); - - - MDL::addLabel(MDL_TILTPARTICLEID, LABEL_SIZET, "tiltParticleId"); - MDL::addLabel(MDL_TOMOGRAM_VOLUME, LABEL_STRING, "tomogramVolume", TAGLABEL_IMAGE); - MDL::addLabel(MDL_TOMOGRAMMD, LABEL_STRING, "tomogramMetadata", TAGLABEL_METADATA); - MDL::addLabel(MDL_TSID, LABEL_STRING, "tiltSeriesId"); - - MDL::addLabel(MDL_TRANSFORM_MATRIX, LABEL_STRING, "transformMatrix"); - - MDL::addLabel(MDL_TEST_SIZE, LABEL_INT, "testSize"); - - MDL::addLabel(MDL_VOLUME_SCORE_SUM, LABEL_DOUBLE, "volScoreSum"); - MDL::addLabel(MDL_VOLUME_SCORE_MEAN, LABEL_DOUBLE, "volScoreMean"); - MDL::addLabel(MDL_VOLUME_SCORE_MIN, LABEL_DOUBLE, "volScoreMin"); - MDL::addLabel(MDL_VOLUME_SCORE_SUM_TH, LABEL_DOUBLE, "volScoreSumTh"); - MDL::addLabel(MDL_VOLUME_SCORE1, LABEL_DOUBLE, "volScore1"); - MDL::addLabel(MDL_VOLUME_SCORE2, LABEL_DOUBLE, "volScore2"); - MDL::addLabel(MDL_VOLUME_SCORE3, LABEL_DOUBLE, "volScore3"); - MDL::addLabel(MDL_VOLUME_SCORE4, LABEL_DOUBLE, "volScore4"); - MDL::addLabel(MDL_WEIGHT, LABEL_DOUBLE, "weight"); - MDL::addLabel(MDL_WEIGHT_P, LABEL_DOUBLE, "weight_clusterability"); - MDL::addLabelAlias(MDL_WEIGHT, "Weight"); - MDL::addLabel(MDL_WEIGHT_CONTINUOUS2, LABEL_DOUBLE, "weightContinuous2"); - MDL::addLabel(MDL_WEIGHT_JUMPER0, LABEL_DOUBLE, "weightJumper0"); - MDL::addLabel(MDL_WEIGHT_JUMPER, LABEL_DOUBLE, "weightJumper"); - MDL::addLabel(MDL_WEIGHT_JUMPER2, LABEL_DOUBLE, "weightJumper2"); - MDL::addLabel(MDL_WEIGHT_REALCORR, LABEL_DOUBLE, "weightRealCorr"); - MDL::addLabel(MDL_WEIGHT_PHASECORR, LABEL_DOUBLE, "weightPhaseCorr"); - MDL::addLabel(MDL_WEIGHT_SIGNIFICANT, LABEL_DOUBLE, "weightSignificant"); - MDL::addLabel(MDL_WEIGHT_SSNR, LABEL_DOUBLE, "weightSSNR"); - - MDL::addLabel(MDL_WEIGHT_PRECISION_ALIGNABILITY, LABEL_DOUBLE, "weightPrecisionAlignability"); - MDL::addLabel(MDL_WEIGHT_ACCURACY_ALIGNABILITY, LABEL_DOUBLE, "weightAccuracyAlignability"); - MDL::addLabel(MDL_WEIGHT_ALIGNABILITY, LABEL_DOUBLE, "weightAlignability"); - MDL::addLabel(MDL_WEIGHT_PRECISION_MIRROR, LABEL_DOUBLE, "weightPrecisionMirror"); - - MDL::addLabel(MDL_WROBUST, LABEL_DOUBLE, "wRobust"); - MDL::addLabel(MDL_XCOOR, LABEL_INT, "xcoor"); - MDL::addLabel(MDL_XCOOR_TILT, LABEL_INT, "xcoorTilt"); - - MDL::addLabel(MDL_X, LABEL_DOUBLE, "x"); - MDL::addLabel(MDL_XSIZE, LABEL_SIZET, "xSize"); - MDL::addLabel(MDL_YCOOR, LABEL_INT, "ycoor"); - MDL::addLabel(MDL_YCOOR_TILT, LABEL_INT, "ycoorTilt"); - MDL::addLabel(MDL_Y, LABEL_DOUBLE, "y"); - MDL::addLabel(MDL_YSIZE, LABEL_SIZET, "ySize"); - MDL::addLabel(MDL_ZCOOR, LABEL_INT, "zcoor"); - MDL::addLabel(MDL_Z, LABEL_DOUBLE, "z"); - MDL::addLabel(MDL_ZSCORE, LABEL_DOUBLE, "zScore"); - MDL::addLabel(MDL_ZSCORE_HISTOGRAM, LABEL_DOUBLE, "zScoreHistogram"); - MDL::addLabel(MDL_ZSCORE_RESMEAN, LABEL_DOUBLE, "zScoreResMean"); - MDL::addLabel(MDL_ZSCORE_RESVAR, LABEL_DOUBLE, "zScoreResVar"); - MDL::addLabel(MDL_ZSCORE_RESCOV, LABEL_DOUBLE, "zScoreResCov"); - MDL::addLabel(MDL_ZSCORE_SHAPE1, LABEL_DOUBLE, "zScoreShape1"); - MDL::addLabel(MDL_ZSCORE_SHAPE2, LABEL_DOUBLE, "zScoreShape2"); - MDL::addLabel(MDL_ZSCORE_SNR1, LABEL_DOUBLE, "zScoreSNR1"); - MDL::addLabel(MDL_ZSCORE_SNR2, LABEL_DOUBLE, "zScoreSNR2"); - MDL::addLabel(MDL_ZSCORE_DEEPLEARNING1, LABEL_DOUBLE, "zScoreDeepLearning1"); - MDL::addLabel(MDL_GOOD_REGION_SCORE, LABEL_DOUBLE, "goodRegionScore"); - MDL::addLabel(MDL_ZSIZE, LABEL_SIZET, "zSize"); - - MDL::addLabelAlias(MDL_XCOOR, "Xcoor");//3.0 - MDL::addLabelAlias(MDL_XCOOR, ""); - MDL::addLabelAlias(MDL_XCOOR_TILT, "XcoorTilt");//3.0 - - MDL::addLabelAlias(MDL_X, "X"); //3.0 - MDL::addLabelAlias(MDL_XSIZE, "Xsize"); //3.0 - MDL::addLabelAlias(MDL_YCOOR, "Ycoor"); //3.0 - MDL::addLabelAlias(MDL_YCOOR, ""); - MDL::addLabelAlias(MDL_YCOOR_TILT, "YcoorTilt"); //3.0 - MDL::addLabelAlias(MDL_Y, "Y"); //3.0 - MDL::addLabelAlias(MDL_YSIZE, "Ysize"); //3.0 - MDL::addLabelAlias(MDL_ZCOOR, "Zcoor"); //3.0 - MDL::addLabelAlias(MDL_Z, "Z"); //3.0 - MDL::addLabelAlias(MDL_ZSCORE, "Zscore"); //3.0 - MDL::addLabelAlias(MDL_ZSIZE, "Zsize"); //3.0 - - - /*Relion labels */ - MDL::addLabel(RLN_AREA_ID, LABEL_SIZET, "rlnAreaId"); - MDL::addLabel(RLN_AREA_NAME, LABEL_STRING, "rlnAreaName"); - - MDL::addLabel(RLN_CTF_BFACTOR, LABEL_DOUBLE, "rlnBfactor"); - MDL::addLabel(RLN_CTF_SCALEFACTOR, LABEL_DOUBLE, "rlnCtfScalefactor"); - MDL::addLabel(RLN_CTF_VOLTAGE, LABEL_DOUBLE, "rlnVoltage"); - MDL::addLabel(RLN_CTF_DEFOCUSU, LABEL_DOUBLE, "rlnDefocusU"); - MDL::addLabel(RLN_CTF_DEFOCUSV, LABEL_DOUBLE, "rlnDefocusV"); - MDL::addLabel(RLN_CTF_DEFOCUS_ANGLE, LABEL_DOUBLE, "rlnDefocusAngle"); - MDL::addLabel(RLN_CTF_CS, LABEL_DOUBLE, "rlnSphericalAberration"); - MDL::addLabel(RLN_CTF_CA, LABEL_DOUBLE, "rlnChromaticAberration"); - MDL::addLabel(RLN_CTF_DETECTOR_PIXEL_SIZE, LABEL_DOUBLE, "rlnDetectorPixelSize"); - MDL::addLabel(RLN_CTF_ENERGY_LOSS, LABEL_DOUBLE, "rlnEnergyLoss"); - MDL::addLabel(RLN_CTF_FOM, LABEL_DOUBLE, "rlnCtfFigureOfMerit"); - MDL::addLabel(RLN_CTF_IMAGE, LABEL_STRING, "rlnCtfImage", TAGLABEL_IMAGE); - MDL::addLabel(RLN_CTF_LENS_STABILITY, LABEL_DOUBLE, "rlnLensStability"); - MDL::addLabel(RLN_CTF_MAGNIFICATION, LABEL_DOUBLE, "rlnMagnification"); - MDL::addLabel(RLN_CTF_MAXRES, LABEL_DOUBLE, "rlnCtfMaxResolution"); - MDL::addLabel(RLN_CTF_CONVERGENCE_CONE, LABEL_DOUBLE, "rlnConvergenceCone"); - MDL::addLabel(RLN_CTF_LONGITUDINAL_DISPLACEMENT, LABEL_DOUBLE, "rlnLongitudinalDisplacement"); - MDL::addLabel(RLN_CTF_TRANSVERSAL_DISPLACEMENT, LABEL_DOUBLE, "rlnTransversalDisplacement"); - MDL::addLabel(RLN_CTF_Q0, LABEL_DOUBLE, "rlnAmplitudeContrast"); - MDL::addLabel(RLN_CTF_VALIDATIONSCORE, LABEL_DOUBLE, "rlnCtfValidationScore"); - MDL::addLabel(RLN_CTF_VALUE, LABEL_DOUBLE, "rlnCtfValue"); - MDL::addLabel(RLN_CTF_PHASESHIFT, LABEL_DOUBLE, "rlnPhaseShift"); - - MDL::addLabel(RLN_IMAGE_NAME, LABEL_STRING, "rlnImageName", TAGLABEL_IMAGE); - MDL::addLabel(RLN_IMAGE_RECONSTRUCT_NAME, LABEL_STRING, "rlnReconstructImageName", TAGLABEL_IMAGE); - MDL::addLabel(RLN_IMAGE_ID, LABEL_SIZET, "rlnImageId"); - MDL::addLabel(RLN_IMAGE_ENABLED, LABEL_BOOL, "rlnEnabled"); - MDL::addLabel(RLN_IMAGE_DATATYPE, LABEL_INT, "rlnDataType"); - // Label rlnImageDimensionality is originally rlnDataDimensionality, which is - // duplicated for other label. A relion bug??? - MDL::addLabel(RLN_IMAGE_DIMENSIONALITY, LABEL_INT, "rlnImageDimensionality"); - MDL::addLabel(RLN_IMAGE_BEAMTILT_X, LABEL_DOUBLE, "rlnBeamTiltX"); - MDL::addLabel(RLN_IMAGE_BEAMTILT_Y, LABEL_DOUBLE, "rlnBeamTiltY"); - MDL::addLabel(RLN_IMAGE_BEAMTILT_GROUP, LABEL_STRING, "rlnBeamTiltGroupName"); - MDL::addLabel(RLN_IMAGE_COORD_X, LABEL_DOUBLE, "rlnCoordinateX"); - MDL::addLabel(RLN_IMAGE_COORD_Y, LABEL_DOUBLE, "rlnCoordinateY"); - MDL::addLabel(RLN_IMAGE_COORD_Z, LABEL_DOUBLE, "rlnCoordinateZ"); - MDL::addLabel(RLN_IMAGE_FRAME_NR, LABEL_INT, "rlnMovieFrameNumber"); - MDL::addLabel(RLN_IMAGE_MAGNIFICATION_CORRECTION, LABEL_DOUBLE, "rlnMagnificationCorrection"); - MDL::addLabel(RLN_IMAGE_NORM_CORRECTION, LABEL_DOUBLE, "rlnNormCorrection"); - MDL::addLabel(RLN_IMAGE_ORI_NAME, LABEL_STRING, "rlnImageOriginalName", TAGLABEL_IMAGE); - MDL::addLabel(RLN_IMAGE_SAMPLINGRATE, LABEL_DOUBLE, "rlnSamplingRate"); - MDL::addLabel(RLN_IMAGE_SAMPLINGRATE_X, LABEL_DOUBLE, "rlnSamplingRateX"); - MDL::addLabel(RLN_IMAGE_SAMPLINGRATE_Y, LABEL_DOUBLE, "rlnSamplingRateY"); - MDL::addLabel(RLN_IMAGE_SAMPLINGRATE_Z, LABEL_DOUBLE, "rlnSamplingRateZ"); - MDL::addLabel(RLN_IMAGE_SIZE, LABEL_INT, "rlnImageSize"); - MDL::addLabel(RLN_IMAGE_SIZEX, LABEL_INT, "rlnImageSizeX"); - MDL::addLabel(RLN_IMAGE_SIZEY, LABEL_INT, "rlnImageSizeY"); - MDL::addLabel(RLN_IMAGE_SIZEZ, LABEL_INT, "rlnImageSizeZ"); - MDL::addLabel(RLN_IMAGE_STATS_MIN, LABEL_DOUBLE, "rlnMinimumValue"); - MDL::addLabel(RLN_IMAGE_STATS_MAX, LABEL_DOUBLE, "rlnMaximumValue"); - MDL::addLabel(RLN_IMAGE_STATS_AVG, LABEL_DOUBLE, "rlnAverageValue"); - MDL::addLabel(RLN_IMAGE_STATS_STDDEV, LABEL_DOUBLE, "rlnStandardDeviationValue"); - MDL::addLabel(RLN_IMAGE_STATS_SKEW, LABEL_DOUBLE, "rlnSkewnessValue"); - MDL::addLabel(RLN_IMAGE_STATS_KURT, LABEL_DOUBLE, "rlnKurtosisExcessValue"); - MDL::addLabel(RLN_IMAGE_WEIGHT, LABEL_DOUBLE, "rlnImageWeight"); - - MDL::addLabel(RLN_MASK_NAME, LABEL_STRING, "rlnMaskName"); - - MDL::addLabel(RLN_MATRIX_1_1, LABEL_DOUBLE, "rlnMatrix_1_1"); - MDL::addLabel(RLN_MATRIX_1_2, LABEL_DOUBLE, "rlnMatrix_1_2"); - MDL::addLabel(RLN_MATRIX_1_3, LABEL_DOUBLE, "rlnMatrix_1_3"); - MDL::addLabel(RLN_MATRIX_2_1, LABEL_DOUBLE, "rlnMatrix_2_1"); - MDL::addLabel(RLN_MATRIX_2_2, LABEL_DOUBLE, "rlnMatrix_2_2"); - MDL::addLabel(RLN_MATRIX_2_3, LABEL_DOUBLE, "rlnMatrix_2_3"); - MDL::addLabel(RLN_MATRIX_3_1, LABEL_DOUBLE, "rlnMatrix_3_1"); - MDL::addLabel(RLN_MATRIX_3_2, LABEL_DOUBLE, "rlnMatrix_3_2"); - MDL::addLabel(RLN_MATRIX_3_3, LABEL_DOUBLE, "rlnMatrix_3_3"); - - MDL::addLabel(RLN_MICROGRAPH_ID, LABEL_SIZET, "rlnMicrographId"); - MDL::addLabel(RLN_MICROGRAPH_MOVIE_NAME, LABEL_STRING, "rlnMicrographMovieName", TAGLABEL_IMAGE); - MDL::addLabel(RLN_MICROGRAPH_NAME, LABEL_STRING, "rlnMicrographName", TAGLABEL_IMAGE); - MDL::addLabel(RLN_MICROGRAPH_NAME_WODOSE, LABEL_STRING, "rlnMicrographNameNoDW", TAGLABEL_IMAGE); - MDL::addLabel(RLN_MICROGRAPH_TILT_ANGLE, LABEL_DOUBLE, "rlnMicrographTiltAngle"); - MDL::addLabel(RLN_MICROGRAPH_TILT_AXIS_DIRECTION, LABEL_DOUBLE, "rlnMicrographTiltAxisDirection"); - MDL::addLabel(RLN_MICROGRAPH_TILT_AXIS_OUTOFPLANE, LABEL_DOUBLE, "rlnMicrographTiltAxisOutOfPlane"); - - MDL::addLabel(RLN_MLMODEL_ACCURACY_ROT, LABEL_DOUBLE, "rlnAccuracyRotations"); - MDL::addLabel(RLN_MLMODEL_ACCURACY_TRANS, LABEL_DOUBLE, "rlnAccuracyTranslations"); - MDL::addLabel(RLN_MLMODEL_AVE_PMAX, LABEL_DOUBLE, "rlnAveragePmax"); - MDL::addLabel(RLN_MLMODEL_CURRENT_RESOLUTION, LABEL_DOUBLE, "rlnCurrentResolution"); - MDL::addLabel(RLN_MLMODEL_CURRENT_SIZE, LABEL_INT, "rlnCurrentImageSize"); - MDL::addLabel(RLN_MLMODEL_DATA_VS_PRIOR_REF, LABEL_DOUBLE, "rlnSsnrMap"); - MDL::addLabel(RLN_MLMODEL_DIMENSIONALITY, LABEL_INT, "rlnReferenceDimensionality"); - MDL::addLabel(RLN_MLMODEL_DIMENSIONALITY_DATA, LABEL_INT, "rlnDataDimensionality"); - MDL::addLabel(RLN_MLMODEL_DIFF2_HALVES_REF, LABEL_DOUBLE, "rlnDiff2RandomHalves"); - MDL::addLabel(RLN_MLMODEL_ESTIM_RESOL_REF, LABEL_DOUBLE, "rlnEstimatedResolution"); - MDL::addLabel(RLN_MLMODEL_FOURIER_COVERAGE_REF, LABEL_DOUBLE, "rlnFourierCompleteness"); - MDL::addLabel(RLN_MLMODEL_FOURIER_COVERAGE_TOTAL_REF, LABEL_DOUBLE, "rlnOverallFourierCompleteness"); - MDL::addLabel(RLN_MLMODEL_FSC_HALVES_REF, LABEL_DOUBLE, "rlnGoldStandardFsc"); - MDL::addLabel(RLN_MLMODEL_GROUP_NAME, LABEL_STRING, "rlnGroupName"); - MDL::addLabel(RLN_MLMODEL_GROUP_NO, LABEL_SIZET, "rlnGroupNumber"); - MDL::addLabel(RLN_MLMODEL_GROUP_NR_PARTICLES, LABEL_SIZET, "rlnGroupNrParticles"); - MDL::addLabel(RLN_MLMODEL_GROUP_SCALE_CORRECTION, LABEL_DOUBLE, "rlnGroupScaleCorrection"); - MDL::addLabel(RLN_MLMODEL_HELICAL_NR_ASU, LABEL_INT, "rlnNrHelicalAsymUnits"); - MDL::addLabel(RLN_MLMODEL_HELICAL_TWIST, LABEL_DOUBLE, "rlnHelicalTwist"); - MDL::addLabel(RLN_MLMODEL_HELICAL_TWIST_MIN, LABEL_DOUBLE, "rlnHelicalTwistMin"); - MDL::addLabel(RLN_MLMODEL_HELICAL_TWIST_MAX, LABEL_DOUBLE, "rlnHelicalTwistMax"); - MDL::addLabel(RLN_MLMODEL_HELICAL_TWIST_INITIAL_STEP, LABEL_DOUBLE, "rlnHelicalTwistInitialStep"); - MDL::addLabel(RLN_MLMODEL_HELICAL_RISE, LABEL_DOUBLE, "rlnHelicalRise"); - MDL::addLabel(RLN_MLMODEL_HELICAL_RISE_MIN, LABEL_DOUBLE, "rlnHelicalRiseMin"); - MDL::addLabel(RLN_MLMODEL_HELICAL_RISE_MAX, LABEL_DOUBLE, "rlnHelicalRiseMax"); - MDL::addLabel(RLN_MLMODEL_HELICAL_RISE_INITIAL_STEP, LABEL_DOUBLE, "rlnHelicalRiseInitialStep"); - MDL::addLabel(RLN_MLMODEL_INTERPOLATOR, LABEL_INT, "rlnFourierSpaceInterpolator"); - MDL::addLabel(RLN_MLMODEL_IS_HELIX, LABEL_BOOL, "rlnIsHelix"); - MDL::addLabel(RLN_MLMODEL_LL, LABEL_DOUBLE, "rlnLogLikelihood"); - MDL::addLabel(RLN_MLMODEL_MINIMUM_RADIUS_NN_INTERPOLATION, LABEL_INT, "rlnMinRadiusNnInterpolation"); - MDL::addLabel(RLN_MLMODEL_NORM_CORRECTION_AVG, LABEL_DOUBLE, "rlnNormCorrectionAverage"); - MDL::addLabel(RLN_MLMODEL_NR_BODIES, LABEL_INT, "rlnNrBodies"); - MDL::addLabel(RLN_MLMODEL_NR_CLASSES, LABEL_INT, "rlnNrClasses"); - MDL::addLabel(RLN_MLMODEL_NR_GROUPS, LABEL_INT, "rlnNrGroups"); - MDL::addLabel(RLN_MLMODEL_ORIENTABILITY_CONTRIBUTION, LABEL_DOUBLE, "rlnSpectralOrientabilityContribution"); - MDL::addLabel(RLN_MLMODEL_ORIGINAL_SIZE, LABEL_INT, "rlnOriginalImageSize"); - MDL::addLabel(RLN_MLMODEL_PADDING_FACTOR, LABEL_DOUBLE, "rlnPaddingFactor"); - MDL::addLabel(RLN_MLMODEL_PDF_CLASS, LABEL_DOUBLE, "rlnClassDistribution"); - MDL::addLabel(RLN_MLMODEL_PRIOR_OFFX_CLASS, LABEL_DOUBLE, "rlnClassPriorOffsetX"); - MDL::addLabel(RLN_MLMODEL_PRIOR_OFFY_CLASS, LABEL_DOUBLE, "rlnClassPriorOffsetY"); - MDL::addLabel(RLN_MLMODEL_PDF_ORIENT, LABEL_DOUBLE, "rlnOrientationDistribution"); - MDL::addLabel(RLN_MLMODEL_PIXEL_SIZE, LABEL_DOUBLE, "rlnPixelSize"); - MDL::addLabel(RLN_MLMODEL_POWER_REF, LABEL_DOUBLE, "rlnReferenceSpectralPower"); - MDL::addLabel(RLN_MLMODEL_PRIOR_MODE, LABEL_INT, "rlnOrientationalPriorMode"); - MDL::addLabel(RLN_MLMODEL_REF_IMAGE, LABEL_STRING, "rlnReferenceImage", TAGLABEL_IMAGE); - MDL::addLabel(RLN_MLMODEL_SGD_GRADIENT_IMAGE, LABEL_STRING, "rlnSGDGradientImage"); - MDL::addLabel(RLN_MLMODEL_SIGMA_OFFSET, LABEL_DOUBLE, "rlnSigmaOffsets"); - MDL::addLabel(RLN_MLMODEL_SIGMA2_NOISE, LABEL_DOUBLE, "rlnSigma2Noise"); - MDL::addLabel(RLN_MLMODEL_SIGMA2_REF, LABEL_DOUBLE, "rlnReferenceSigma2"); - MDL::addLabel(RLN_MLMODEL_SIGMA_ROT, LABEL_DOUBLE, "rlnSigmaPriorRotAngle"); - MDL::addLabel(RLN_MLMODEL_SIGMA_TILT, LABEL_DOUBLE, "rlnSigmaPriorTiltAngle"); - MDL::addLabel(RLN_MLMODEL_SIGMA_PSI, LABEL_DOUBLE, "rlnSigmaPriorPsiAngle"); - MDL::addLabel(RLN_MLMODEL_SSNR_REF, LABEL_DOUBLE, "rlnSignalToNoiseRatio"); - MDL::addLabel(RLN_MLMODEL_TAU2_FUDGE_FACTOR, LABEL_DOUBLE, "rlnTau2FudgeFactor"); - MDL::addLabel(RLN_MLMODEL_TAU2_REF, LABEL_DOUBLE, "rlnReferenceTau2"); - - MDL::addLabel(RLN_OPTIMISER_ACCURACY_ROT, LABEL_DOUBLE, "rlnOverallAccuracyRotations"); - MDL::addLabel(RLN_OPTIMISER_ACCURACY_TRANS, LABEL_DOUBLE, "rlnOverallAccuracyTranslations"); - MDL::addLabel(RLN_OPTIMISER_ADAPTIVE_FRACTION, LABEL_DOUBLE, "rlnAdaptiveOversampleFraction"); - MDL::addLabel(RLN_OPTIMISER_ADAPTIVE_OVERSAMPLING, LABEL_INT, "rlnAdaptiveOversampleOrder"); - MDL::addLabel(RLN_OPTIMISER_AUTO_LOCAL_HP_ORDER, LABEL_INT, "rlnAutoLocalSearchesHealpixOrder"); - MDL::addLabel(RLN_OPTIMISER_AVAILABLE_MEMORY, LABEL_DOUBLE, "rlnAvailableMemory"); - MDL::addLabel(RLN_OPTIMISER_BEST_RESOL_THUS_FAR, LABEL_DOUBLE, "rlnBestResolutionThusFar"); - MDL::addLabel(RLN_OPTIMISER_COARSE_SIZE, LABEL_INT, "rlnCoarseImageSize"); - MDL::addLabel(RLN_OPTIMISER_CHANGES_OPTIMAL_OFFSETS, LABEL_DOUBLE, "rlnChangesOptimalOffsets"); - MDL::addLabel(RLN_OPTIMISER_CHANGES_OPTIMAL_ORIENTS, LABEL_DOUBLE, "rlnChangesOptimalOrientations"); - MDL::addLabel(RLN_OPTIMISER_CHANGES_OPTIMAL_CLASSES, LABEL_DOUBLE, "rlnChangesOptimalClasses"); - MDL::addLabel(RLN_OPTIMISER_DATA_ARE_CTF_PHASE_FLIPPED, LABEL_BOOL, "rlnCtfDataArePhaseFlipped"); - MDL::addLabel(RLN_OPTIMISER_DATA_ARE_CTF_PREMULTIPLIED, LABEL_BOOL, "rlnCtfDataAreCtfPremultiplied"); - MDL::addLabel(RLN_OPTIMISER_DATA_STARFILE, LABEL_STRING, "rlnExperimentalDataStarFile", TAGLABEL_METADATA); - MDL::addLabel(RLN_OPTIMISER_DO_AUTO_REFINE, LABEL_BOOL, "rlnDoAutoRefine"); - MDL::addLabel(RLN_OPTIMISER_DO_CORRECT_CTF, LABEL_BOOL, "rlnDoCorrectCtf"); - MDL::addLabel(RLN_OPTIMISER_DO_CORRECT_MAGNIFICATION, LABEL_BOOL, "rlnDoCorrectMagnification"); - MDL::addLabel(RLN_OPTIMISER_DO_CORRECT_NORM, LABEL_BOOL, "rlnDoCorrectNorm"); - MDL::addLabel(RLN_OPTIMISER_DO_CORRECT_SCALE, LABEL_BOOL, "rlnDoCorrectScale"); - MDL::addLabel(RLN_OPTIMISER_DO_HELICAL_REFINE, LABEL_BOOL, "rlnDoHelicalRefine"); - MDL::addLabel(RLN_OPTIMISER_DO_MAP, LABEL_BOOL, "rlnDoMapEstimation"); - MDL::addLabel(RLN_OPTIMISER_DO_ONLY_FLIP_CTF_PHASES, LABEL_BOOL, "rlnDoOnlyFlipCtfPhases"); - MDL::addLabel(RLN_OPTIMISER_DO_REALIGN_MOVIES, LABEL_BOOL, "rlnDoRealignMovies"); - MDL::addLabel(RLN_OPTIMISER_DO_SGD, LABEL_BOOL, "rlnDoStochasticGradientDescent"); - MDL::addLabel(RLN_OPTIMISER_DO_SOLVENT_FLATTEN, LABEL_BOOL, "rlnDoSolventFlattening"); - MDL::addLabel(RLN_OPTIMISER_DO_SKIP_ALIGN, LABEL_BOOL, "rlnDoSkipAlign"); - MDL::addLabel(RLN_OPTIMISER_DO_SKIP_ROTATE, LABEL_BOOL, "rlnDoSkipRotate"); - MDL::addLabel(RLN_OPTIMISER_DO_SPLIT_RANDOM_HALVES, LABEL_BOOL, "rlnDoSplitRandomHalves"); - MDL::addLabel(RLN_OPTIMISER_DO_ZERO_MASK, LABEL_BOOL, "rlnDoZeroMask"); - MDL::addLabel(RLN_OPTIMISER_FIX_SIGMA_NOISE, LABEL_BOOL, "rlnFixSigmaNoiseEstimates"); - MDL::addLabel(RLN_OPTIMISER_FIX_SIGMA_OFFSET ,LABEL_BOOL, "rlnFixSigmaOffsetEstimates"); - MDL::addLabel(RLN_OPTIMISER_FIX_TAU, LABEL_BOOL, "rlnFixTauEstimates"); - MDL::addLabel(RLN_OPTIMISER_HAS_CONVERGED, LABEL_BOOL, "rlnHasConverged"); - MDL::addLabel(RLN_OPTIMISER_HAS_HIGH_FSC_AT_LIMIT, LABEL_BOOL, "rlnHasHighFscAtResolLimit"); - MDL::addLabel(RLN_OPTIMISER_HAS_LARGE_INCR_SIZE_ITER_AGO, LABEL_INT, "rlnHasLargeSizeIncreaseIterationsAgo"); - MDL::addLabel(RLN_OPTIMISER_HELICAL_TWIST_INITIAL, LABEL_DOUBLE, "rlnHelicalTwistInitial"); - MDL::addLabel(RLN_OPTIMISER_HELICAL_RISE_INITIAL, LABEL_DOUBLE, "rlnHelicalRiseInitial"); - MDL::addLabel(RLN_OPTIMISER_HELICAL_Z_PERCENTAGE, LABEL_DOUBLE, "rlnHelicalCentralProportion"); - MDL::addLabel(RLN_OPTIMISER_HELICAL_TUBE_INNER_DIAMETER, LABEL_DOUBLE, "rlnHelicalMaskTubeInnerDiameter"); - MDL::addLabel(RLN_OPTIMISER_HELICAL_TUBE_OUTER_DIAMETER, LABEL_DOUBLE, "rlnHelicalMaskTubeOuterDiameter"); - MDL::addLabel(RLN_OPTIMISER_HELICAL_SYMMETRY_LOCAL_REFINEMENT, LABEL_BOOL, "rlnHelicalSymmetryLocalRefinement"); - MDL::addLabel(RLN_OPTIMISER_HELICAL_SIGMA_DISTANCE, LABEL_DOUBLE, "rlnHelicalSigmaDistance"); - MDL::addLabel(RLN_OPTIMISER_IGNORE_HELICAL_SYMMETRY, LABEL_BOOL, "rlnIgnoreHelicalSymmetry"); - MDL::addLabel(RLN_OPTIMISER_HELICAL_KEEP_TILT_PRIOR_FIXED, LABEL_BOOL, "rlnHelicalKeepTiltPriorFixed"); - MDL::addLabel(RLN_OPTIMISER_HIGHRES_LIMIT_EXP, LABEL_DOUBLE, "rlnHighresLimitExpectation"); - MDL::addLabel(RLN_OPTIMISER_HIGHRES_LIMIT_SGD, LABEL_DOUBLE, "rlnHighresLimitSGD"); - MDL::addLabel(RLN_OPTIMISER_IGNORE_CTF_UNTIL_FIRST_PEAK, LABEL_BOOL, "rlnDoIgnoreCtfUntilFirstPeak"); - MDL::addLabel(RLN_OPTIMISER_INCR_SIZE, LABEL_INT, "rlnIncrementImageSize"); - MDL::addLabel(RLN_OPTIMISER_ITERATION_NO, LABEL_INT, "rlnCurrentIteration"); - MDL::addLabel(RLN_OPTIMISER_LOCAL_SYMMETRY_FILENAME, LABEL_STRING, "rlnLocalSymmetryFile"); - MDL::addLabel(RLN_OPTIMISER_LOWRES_JOIN_RANDOM_HALVES, LABEL_DOUBLE, "rlnJoinHalvesUntilThisResolution"); - MDL::addLabel(RLN_OPTIMISER_MAGNIFICATION_RANGE, LABEL_DOUBLE, "rlnMagnificationSearchRange"); - MDL::addLabel(RLN_OPTIMISER_MAGNIFICATION_STEP, LABEL_DOUBLE, "rlnMagnificationSearchStep"); - MDL::addLabel(RLN_OPTIMISER_MAX_COARSE_SIZE, LABEL_INT, "rlnMaximumCoarseImageSize"); - MDL::addLabel(RLN_OPTIMISER_MAX_NR_POOL, LABEL_INT, "rlnMaxNumberOfPooledParticles"); - MDL::addLabel(RLN_OPTIMISER_MODEL_STARFILE, LABEL_STRING, "rlnModelStarFile", TAGLABEL_METADATA); - MDL::addLabel(RLN_OPTIMISER_MODEL_STARFILE2, LABEL_STRING, "rlnModelStarFile2", TAGLABEL_METADATA); - MDL::addLabel(RLN_OPTIMISER_NR_ITERATIONS, LABEL_INT, "rlnNumberOfIterations"); - MDL::addLabel(RLN_OPTIMISER_NR_ITER_WO_RESOL_GAIN, LABEL_INT, "rlnNumberOfIterWithoutResolutionGain"); - MDL::addLabel(RLN_OPTIMISER_NR_ITER_WO_HIDDEN_VAR_CHANGES, LABEL_INT, "rlnNumberOfIterWithoutChangingAssignments"); - MDL::addLabel(RLN_OPTIMISER_OUTPUT_ROOTNAME, LABEL_STRING, "rlnOutputRootName"); - MDL::addLabel(RLN_OPTIMISER_PARTICLE_DIAMETER, LABEL_DOUBLE, "rlnParticleDiameter"); - MDL::addLabel(RLN_OPTIMISER_RADIUS_MASK_3D_MAP, LABEL_INT, "rlnRadiusMaskMap"); - MDL::addLabel(RLN_OPTIMISER_RADIUS_MASK_EXP_PARTICLES, LABEL_INT, "rlnRadiusMaskExpImages"); - MDL::addLabel(RLN_OPTIMISER_RANDOM_SEED, LABEL_INT, "rlnRandomSeed"); - MDL::addLabel(RLN_OPTIMISER_REFS_ARE_CTF_CORRECTED, LABEL_BOOL, "rlnRefsAreCtfCorrected"); - MDL::addLabel(RLN_OPTIMISER_SGD_MU, LABEL_DOUBLE, "rlnSgdMuFactor"); - MDL::addLabel(RLN_OPTIMISER_SGD_SIGMA2FUDGE_INI, LABEL_DOUBLE, "rlnSgdSigma2FudgeInitial"); - MDL::addLabel(RLN_OPTIMISER_SGD_SIGMA2FUDGE_HALFLIFE, LABEL_SIZET, "rlnSgdSigma2FudgeHalflife"); - MDL::addLabel(RLN_OPTIMISER_SGD_SUBSET_START, LABEL_INT, "rlnSgdNextSubset"); - MDL::addLabel(RLN_OPTIMISER_SGD_SUBSET_SIZE, LABEL_SIZET, "rlnSgdSubsetSize"); - MDL::addLabel(RLN_OPTIMISER_SGD_WRITE_EVERY_SUBSET, LABEL_INT, "rlnSgdWriteEverySubset"); - MDL::addLabel(RLN_OPTIMISER_SGD_MAX_SUBSETS, LABEL_SIZET, "rlnSgdMaxSubsets"); - MDL::addLabel(RLN_OPTIMISER_SGD_STEPSIZE, LABEL_DOUBLE, "rlnSgdStepsize"); - - - MDL::addLabel(RLN_OPTIMISER_SMALLEST_CHANGES_OPT_CLASSES, LABEL_INT, "rlnSmallestChangesClasses"); - MDL::addLabel(RLN_OPTIMISER_SMALLEST_CHANGES_OPT_OFFSETS, LABEL_DOUBLE, "rlnSmallestChangesOffsets"); - MDL::addLabel(RLN_OPTIMISER_SMALLEST_CHANGES_OPT_ORIENTS, LABEL_DOUBLE, "rlnSmallestChangesOrientations"); - MDL::addLabel(RLN_OPTIMISER_SAMPLING_STARFILE, LABEL_STRING, "rlnOrientSamplingStarFile", TAGLABEL_METADATA); - MDL::addLabel(RLN_OPTIMISER_SOLVENT_MASK_NAME, LABEL_STRING, "rlnSolventMaskName", TAGLABEL_IMAGE); - MDL::addLabel(RLN_OPTIMISER_SOLVENT_MASK2_NAME, LABEL_STRING, "rlnSolventMask2Name", TAGLABEL_IMAGE); - MDL::addLabel(RLN_OPTIMISER_TAU_SPECTRUM_NAME, LABEL_STRING, "rlnTauSpectrumName"); - MDL::addLabel(RLN_OPTIMISER_USE_TOO_COARSE_SAMPLING, LABEL_BOOL, "rlnUseTooCoarseSampling"); - MDL::addLabel(RLN_OPTIMISER_WIDTH_MASK_EDGE, LABEL_INT, "rlnWidthMaskEdge"); - - MDL::addLabel(RLN_ORIENT_FLIP, LABEL_BOOL, "rlnIsFlip"); - MDL::addLabel(RLN_ORIENT_ID, LABEL_SIZET, "rlnOrientationsID"); - MDL::addLabel(RLN_ORIENT_ORIGIN_X, LABEL_DOUBLE, "rlnOriginX"); - MDL::addLabel(RLN_ORIENT_ORIGIN_X_PRIOR, LABEL_DOUBLE, "rlnOriginXPrior"); - MDL::addLabel(RLN_ORIENT_ORIGIN_Y, LABEL_DOUBLE, "rlnOriginY"); - MDL::addLabel(RLN_ORIENT_ORIGIN_Y_PRIOR, LABEL_DOUBLE, "rlnOriginYPrior"); - MDL::addLabel(RLN_ORIENT_ORIGIN_Z, LABEL_DOUBLE, "rlnOriginZ"); - MDL::addLabel(RLN_ORIENT_ORIGIN_Z_PRIOR, LABEL_DOUBLE, "rlnOriginZPrior"); - MDL::addLabel(RLN_ORIENT_ROT, LABEL_DOUBLE, "rlnAngleRot"); - MDL::addLabel(RLN_ORIENT_ROT_PRIOR, LABEL_DOUBLE, "rlnAngleRotPrior"); - MDL::addLabel(RLN_ORIENT_TILT, LABEL_DOUBLE, "rlnAngleTilt"); - MDL::addLabel(RLN_ORIENT_TILT_PRIOR, LABEL_DOUBLE, "rlnAngleTiltPrior"); - MDL::addLabel(RLN_ORIENT_PSI, LABEL_DOUBLE, "rlnAnglePsi"); - MDL::addLabel(RLN_ORIENT_PSI_PRIOR, LABEL_DOUBLE, "rlnAnglePsiPrior"); - MDL::addLabel(RLN_ORIENT_PSI_PRIOR_FLIP_RATIO, LABEL_DOUBLE, "rlnAnglePsiFlipRatio"); - - MDL::addLabel(RLN_PARTICLE_AUTOPICK_FOM, LABEL_DOUBLE, "rlnAutopickFigureOfMerit"); - MDL::addLabel(RLN_PARTICLE_CLASS, LABEL_INT, "rlnClassNumber"); - MDL::addLabel(RLN_PARTICLE_DLL, LABEL_DOUBLE, "rlnLogLikeliContribution"); - MDL::addLabel(RLN_PARTICLE_ID, LABEL_SIZET, "rlnParticleId"); - MDL::addLabel(RLN_PARTICLE_FOM, LABEL_DOUBLE, "rlnParticleFigureOfMerit"); - MDL::addLabel(RLN_PARTICLE_HELICAL_TUBE_ID, LABEL_INT, "rlnHelicalTubeID"); - MDL::addLabel(RLN_PARTICLE_HELICAL_TUBE_PITCH, LABEL_DOUBLE, "rlnHelicalTubePitch"); - MDL::addLabel(RLN_PARTICLE_HELICAL_TRACK_LENGTH, LABEL_DOUBLE, "rlnHelicalTrackLength"); - MDL::addLabel(RLN_PARTICLE_KL_DIVERGENCE, LABEL_DOUBLE, "rlnKullbackLeibnerDivergence"); - MDL::addLabel(RLN_PARTICLE_MOVIE_RUNNING_AVG, LABEL_INT, "rlnMovieFramesRunningAverage"); - MDL::addLabel(RLN_PARTICLE_NAME, LABEL_STRING, "rlnParticleName", TAGLABEL_IMAGE); - MDL::addLabel(RLN_PARTICLE_NR_SIGNIFICANT_SAMPLES, LABEL_INT, "rlnNrOfSignificantSamples"); /**< particle, Number of orientations contributing to weights*/ - MDL::addLabel(RLN_PARTICLE_NR_FRAMES, LABEL_INT, "rlnNrOfFrames"); - MDL::addLabel(RLN_PARTICLE_NR_FRAMES_AVG, LABEL_INT, "rlnAverageNrOfFrames"); - MDL::addLabel(RLN_PARTICLE_ORI_NAME, LABEL_STRING, "rlnOriginalParticleName", TAGLABEL_IMAGE); - MDL::addLabel(RLN_PARTICLE_PMAX, LABEL_DOUBLE, "rlnMaxValueProbDistribution"); /**< particle, Maximum value of probability distribution */ - MDL::addLabel(RLN_PARTICLE_RANDOM_SUBSET, LABEL_INT, "rlnRandomSubset"); - - MDL::addLabel(RLN_PIPELINE_EDGE_FROM, LABEL_STRING , "rlnPipeLineEdgeFromNode"); - MDL::addLabel(RLN_PIPELINE_EDGE_TO, LABEL_STRING ,"rlnPipeLineEdgeToNode"); - MDL::addLabel(RLN_PIPELINE_EDGE_PROCESS, LABEL_STRING ,"rlnPipeLineEdgeProcess"); - MDL::addLabel(RLN_PIPELINE_JOB_COUNTER, LABEL_INT, "rlnPipeLineJobCounter"); - MDL::addLabel(RLN_PIPELINE_NODE_NAME, LABEL_STRING , "rlnPipeLineNodeName"); - MDL::addLabel(RLN_PIPELINE_NODE_TYPE, LABEL_INT, "rlnPipeLineNodeType"); - MDL::addLabel(RLN_PIPELINE_PROCESS_ALIAS, LABEL_STRING , "rlnPipeLineProcessAlias"); - MDL::addLabel(RLN_PIPELINE_PROCESS_NAME, LABEL_STRING , "rlnPipeLineProcessName"); - MDL::addLabel(RLN_PIPELINE_PROCESS_TYPE, LABEL_INT, "rlnPipeLineProcessType"); - MDL::addLabel(RLN_PIPELINE_PROCESS_STATUS, LABEL_INT, "rlnPipeLineProcessStatus"); - - MDL::addLabel(RLN_POSTPROCESS_AMPLCORR_MASKED, LABEL_DOUBLE, "rlnAmplitudeCorrelationMaskedMaps"); - MDL::addLabel(RLN_POSTPROCESS_AMPLCORR_UNMASKED, LABEL_DOUBLE, "rlnAmplitudeCorrelationUnmaskedMaps"); - MDL::addLabel(RLN_POSTPROCESS_BFACTOR, LABEL_DOUBLE, "rlnBfactorUsedForSharpening"); - MDL::addLabel(RLN_POSTPROCESS_DPR_MASKED, LABEL_DOUBLE, "rlnDifferentialPhaseResidualMaskedMaps"); - MDL::addLabel(RLN_POSTPROCESS_DPR_UNMASKED, LABEL_DOUBLE, "rlnDifferentialPhaseResidualUnmaskedMaps"); - MDL::addLabel(RLN_POSTPROCESS_FINAL_RESOLUTION, LABEL_DOUBLE, "rlnFinalResolution"); - MDL::addLabel(RLN_POSTPROCESS_FSC_GENERAL, LABEL_DOUBLE, "rlnFourierShellCorrelation"); - MDL::addLabel(RLN_POSTPROCESS_FSC_TRUE, LABEL_DOUBLE, "rlnFourierShellCorrelationCorrected"); - MDL::addLabel(RLN_POSTPROCESS_FSC_MASKED, LABEL_DOUBLE, "rlnFourierShellCorrelationMaskedMaps"); - MDL::addLabel(RLN_POSTPROCESS_FSC_UNMASKED, LABEL_DOUBLE, "rlnFourierShellCorrelationUnmaskedMaps"); - MDL::addLabel(RLN_POSTPROCESS_FSC_RANDOM_MASKED, LABEL_DOUBLE, "rlnCorrectedFourierShellCorrelationPhaseRandomizedMaskedMaps"); - MDL::addLabel(RLN_POSTPROCESS_GUINIER_FIT_INTERCEPT, LABEL_DOUBLE, "rlnFittedInterceptGuinierPlot"); - MDL::addLabel(RLN_POSTPROCESS_GUINIER_FIT_SLOPE, LABEL_DOUBLE, "rlnFittedSlopeGuinierPlot"); - MDL::addLabel(RLN_POSTPROCESS_GUINIER_FIT_CORRELATION, LABEL_DOUBLE, "rlnCorrelationFitGuinierPlot"); - MDL::addLabel(RLN_POSTPROCESS_GUINIER_VALUE_IN, LABEL_DOUBLE, "rlnLogAmplitudesOriginal"); - MDL::addLabel(RLN_POSTPROCESS_GUINIER_VALUE_INVMTF, LABEL_DOUBLE, "rlnLogAmplitudesMTFCorrected"); - MDL::addLabel(RLN_POSTPROCESS_GUINIER_VALUE_WEIGHTED, LABEL_DOUBLE, "rlnLogAmplitudesWeighted"); - MDL::addLabel(RLN_POSTPROCESS_GUINIER_VALUE_SHARPENED, LABEL_DOUBLE, "rlnLogAmplitudesSharpened"); - MDL::addLabel(RLN_POSTPROCESS_GUINIER_VALUE_INTERCEPT, LABEL_DOUBLE, "rlnLogAmplitudesIntercept"); - MDL::addLabel(RLN_POSTPROCESS_GUINIER_RESOL_SQUARED, LABEL_DOUBLE, "rlnResolutionSquared"); - MDL::addLabel(RLN_POSTPROCESS_MTF_VALUE, LABEL_DOUBLE, "rlnMtfValue"); - - MDL::addLabel(RLN_SAMPLING_IS_3D, LABEL_BOOL, "rlnIs3DSampling"); - MDL::addLabel(RLN_SAMPLING_IS_3D_TRANS, LABEL_BOOL, "rlnIs3DTranslationalSampling"); - MDL::addLabel(RLN_SAMPLING_HEALPIX_ORDER, LABEL_INT, "rlnHealpixOrder"); - MDL::addLabel(RLN_SAMPLING_HELICAL_OFFSET_STEP, LABEL_DOUBLE, "rlnHelicalOffsetStep"); - MDL::addLabel(RLN_SAMPLING_LIMIT_TILT, LABEL_DOUBLE, "rlnTiltAngleLimit"); - MDL::addLabel(RLN_SAMPLING_OFFSET_RANGE, LABEL_DOUBLE, "rlnOffsetRange"); - MDL::addLabel(RLN_SAMPLING_OFFSET_STEP, LABEL_DOUBLE, "rlnOffsetStep"); - MDL::addLabel(RLN_SAMPLING_PERTURB, LABEL_DOUBLE, "rlnSamplingPerturbInstance"); - MDL::addLabel(RLN_SAMPLING_PERTURBATION_FACTOR, LABEL_DOUBLE, "rlnSamplingPerturbFactor"); - MDL::addLabel(RLN_SAMPLING_PSI_STEP, LABEL_DOUBLE, "rlnPsiStep"); - MDL::addLabel(RLN_SAMPLING_SYMMETRY, LABEL_STRING, "rlnSymmetryGroup"); - - MDL::addLabel(RLN_SELECTED, LABEL_BOOL, "rlnSelected"); - MDL::addLabel(RLN_SELECT_PARTICLES_ZSCORE, LABEL_DOUBLE, "rlnParticleSelectZScore"); - MDL::addLabel(RLN_SORTED_IDX, LABEL_SIZET, "rlnSortedIndex"); - MDL::addLabel(RLN_STARFILE_MOVIE_PARTICLES, LABEL_STRING, "rlnStarFileMovieParticles"); - MDL::addLabel(RLN_PERFRAME_CUMULATIVE_WEIGHT, LABEL_DOUBLE, "rlnPerFrameCumulativeWeight"); - MDL::addLabel(RLN_PERFRAME_RELATIVE_WEIGHT, LABEL_DOUBLE, "rlnPerFrameRelativeWeight"); - MDL::addLabel(RLN_RESOLUTION, LABEL_DOUBLE, "rlnResolution"); - MDL::addLabel(RLN_RESOLUTION_ANGSTROM, LABEL_DOUBLE, "rlnAngstromResolution"); - MDL::addLabel(RLN_RESOLUTION_INVPIXEL, LABEL_DOUBLE, "rlnResolutionInversePixel"); - MDL::addLabel(RLN_SPECTRAL_IDX, LABEL_INT, "rlnSpectralIndex"); - - MDL::addLabelAlias(RLN_CTF_BFACTOR, "rlnCtfBfactor"); //Relion-2.0 - - /** Buffer labels */ - MDL::addLabel(BUFFER_01, LABEL_STRING, "buffer_01"); - MDL::addLabel(BUFFER_02, LABEL_STRING, "buffer_02"); - MDL::addLabel(BUFFER_03, LABEL_STRING, "buffer_03"); - MDL::addLabel(BUFFER_04, LABEL_STRING, "buffer_04"); - MDL::addLabel(BUFFER_05, LABEL_STRING, "buffer_05"); - MDL::addLabel(BUFFER_06, LABEL_STRING, "buffer_06"); - MDL::addLabel(BUFFER_07, LABEL_STRING, "buffer_07"); - MDL::addLabel(BUFFER_08, LABEL_STRING, "buffer_08"); - MDL::addLabel(BUFFER_09, LABEL_STRING, "buffer_09"); - MDL::addLabel(BUFFER_10, LABEL_STRING, "buffer_10"); - MDL::addLabel(BUFFER_11, LABEL_STRING, "buffer_11"); - MDL::addLabel(BUFFER_12, LABEL_STRING, "buffer_12"); - MDL::addLabel(BUFFER_13, LABEL_STRING, "buffer_13"); - MDL::addLabel(BUFFER_14, LABEL_STRING, "buffer_14"); - MDL::addLabel(BUFFER_15, LABEL_STRING, "buffer_15"); - MDL::addLabel(BUFFER_16, LABEL_STRING, "buffer_16"); - MDL::addLabel(BUFFER_17, LABEL_STRING, "buffer_17"); - MDL::addLabel(BUFFER_18, LABEL_STRING, "buffer_18"); - MDL::addLabel(BUFFER_19, LABEL_STRING, "buffer_19"); - MDL::addLabel(BUFFER_20, LABEL_STRING, "buffer_20"); - MDL::addLabel(BUFFER_21, LABEL_STRING, "buffer_21"); - MDL::addLabel(BUFFER_22, LABEL_STRING, "buffer_22"); - MDL::addLabel(BUFFER_23, LABEL_STRING, "buffer_23"); - MDL::addLabel(BUFFER_24, LABEL_STRING, "buffer_24"); - MDL::addLabel(BUFFER_25, LABEL_STRING, "buffer_25"); - MDL::addLabel(BUFFER_26, LABEL_STRING, "buffer_26"); - MDL::addLabel(BUFFER_27, LABEL_STRING, "buffer_27"); - MDL::addLabel(BUFFER_28, LABEL_STRING, "buffer_28"); - MDL::addLabel(BUFFER_29, LABEL_STRING, "buffer_29"); - MDL::addLabel(BUFFER_30, LABEL_STRING, "buffer_30"); - MDL::addLabel(BUFFER_31, LABEL_STRING, "buffer_31"); - MDL::addLabel(BUFFER_32, LABEL_STRING, "buffer_32"); - MDL::addLabel(BUFFER_33, LABEL_STRING, "buffer_33"); - MDL::addLabel(BUFFER_34, LABEL_STRING, "buffer_34"); - MDL::addLabel(BUFFER_35, LABEL_STRING, "buffer_35"); - MDL::addLabel(BUFFER_36, LABEL_STRING, "buffer_36"); - MDL::addLabel(BUFFER_37, LABEL_STRING, "buffer_37"); - MDL::addLabel(BUFFER_38, LABEL_STRING, "buffer_38"); - MDL::addLabel(BUFFER_39, LABEL_STRING, "buffer_39"); - MDL::addLabel(BUFFER_40, LABEL_STRING, "buffer_40"); - MDL::addLabel(BUFFER_41, LABEL_STRING, "buffer_41"); - MDL::addLabel(BUFFER_42, LABEL_STRING, "buffer_42"); - MDL::addLabel(BUFFER_43, LABEL_STRING, "buffer_43"); - MDL::addLabel(BUFFER_44, LABEL_STRING, "buffer_44"); - MDL::addLabel(BUFFER_45, LABEL_STRING, "buffer_45"); - MDL::addLabel(BUFFER_46, LABEL_STRING, "buffer_46"); - MDL::addLabel(BUFFER_47, LABEL_STRING, "buffer_47"); - MDL::addLabel(BUFFER_48, LABEL_STRING, "buffer_48"); - MDL::addLabel(BUFFER_49, LABEL_STRING, "buffer_49"); - MDL::addLabel(BUFFER_50, LABEL_STRING, "buffer_50"); - MDL::addLabel(BUFFER_51, LABEL_STRING, "buffer_51"); - MDL::addLabel(BUFFER_52, LABEL_STRING, "buffer_52"); - MDL::addLabel(BUFFER_53, LABEL_STRING, "buffer_53"); - MDL::addLabel(BUFFER_54, LABEL_STRING, "buffer_54"); - MDL::addLabel(BUFFER_55, LABEL_STRING, "buffer_55"); - MDL::addLabel(BUFFER_56, LABEL_STRING, "buffer_56"); - MDL::addLabel(BUFFER_57, LABEL_STRING, "buffer_57"); - MDL::addLabel(BUFFER_58, LABEL_STRING, "buffer_58"); - MDL::addLabel(BUFFER_59, LABEL_STRING, "buffer_59"); - MDL::addLabel(BUFFER_60, LABEL_STRING, "buffer_60"); - MDL::addLabel(BUFFER_61, LABEL_STRING, "buffer_61"); - MDL::addLabel(BUFFER_62, LABEL_STRING, "buffer_62"); - MDL::addLabel(BUFFER_63, LABEL_STRING, "buffer_63"); - MDL::addLabel(BUFFER_64, LABEL_STRING, "buffer_64"); - MDL::addLabel(BUFFER_65, LABEL_STRING, "buffer_65"); - MDL::addLabel(BUFFER_66, LABEL_STRING, "buffer_66"); - MDL::addLabel(BUFFER_67, LABEL_STRING, "buffer_67"); - MDL::addLabel(BUFFER_68, LABEL_STRING, "buffer_68"); - MDL::addLabel(BUFFER_69, LABEL_STRING, "buffer_69"); - MDL::addLabel(BUFFER_70, LABEL_STRING, "buffer_70"); - MDL::addLabel(BUFFER_71, LABEL_STRING, "buffer_71"); - MDL::addLabel(BUFFER_72, LABEL_STRING, "buffer_72"); - MDL::addLabel(BUFFER_73, LABEL_STRING, "buffer_73"); - MDL::addLabel(BUFFER_74, LABEL_STRING, "buffer_74"); - MDL::addLabel(BUFFER_75, LABEL_STRING, "buffer_75"); - MDL::addLabel(BUFFER_76, LABEL_STRING, "buffer_76"); - MDL::addLabel(BUFFER_77, LABEL_STRING, "buffer_77"); - MDL::addLabel(BUFFER_78, LABEL_STRING, "buffer_78"); - MDL::addLabel(BUFFER_79, LABEL_STRING, "buffer_79"); - MDL::addLabel(BUFFER_80, LABEL_STRING, "buffer_80"); - MDL::addLabel(BUFFER_81, LABEL_STRING, "buffer_81"); - MDL::addLabel(BUFFER_82, LABEL_STRING, "buffer_82"); - MDL::addLabel(BUFFER_83, LABEL_STRING, "buffer_83"); - MDL::addLabel(BUFFER_84, LABEL_STRING, "buffer_84"); - MDL::addLabel(BUFFER_85, LABEL_STRING, "buffer_85"); - MDL::addLabel(BUFFER_86, LABEL_STRING, "buffer_86"); - MDL::addLabel(BUFFER_87, LABEL_STRING, "buffer_87"); - MDL::addLabel(BUFFER_88, LABEL_STRING, "buffer_88"); - MDL::addLabel(BUFFER_89, LABEL_STRING, "buffer_89"); - MDL::addLabel(BUFFER_90, LABEL_STRING, "buffer_90"); - MDL::addLabel(BUFFER_91, LABEL_STRING, "buffer_91"); - MDL::addLabel(BUFFER_92, LABEL_STRING, "buffer_92"); - MDL::addLabel(BUFFER_93, LABEL_STRING, "buffer_93"); - MDL::addLabel(BUFFER_94, LABEL_STRING, "buffer_94"); - MDL::addLabel(BUFFER_95, LABEL_STRING, "buffer_95"); - MDL::addLabel(BUFFER_96, LABEL_STRING, "buffer_96"); - MDL::addLabel(BUFFER_97, LABEL_STRING, "buffer_97"); - MDL::addLabel(BUFFER_98, LABEL_STRING, "buffer_98"); - MDL::addLabel(BUFFER_99, LABEL_STRING, "buffer_99"); - - // Add user-defined label aliases for allow use Xmipp-MetaData - // with other labels - MDL::addExtraAliases(); - MDL::bufferIndex = BUFFER_01; - } - - ~MDLabelStaticInit() - { - //Free memory allocated for labels data - for (int i = MDL_FIRST_LABEL; i < MDL_LAST_LABEL; ++i) - delete MDL::data[i]; - } - friend class MDL; -}; -/** @} */ - -#endif diff --git a/src/core/metadata_vec.cpp b/src/core/metadata_vec.cpp deleted file mode 100644 index 86338b7..0000000 --- a/src/core/metadata_vec.cpp +++ /dev/null @@ -1,983 +0,0 @@ -/************************************************************************** - i - * Authors: J.R. Bilbao-Castro (jrbcast@ace.ual.es) - * Jan Horacek (xhorace4@fi.muni.cz) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include -#include -#include -#include -#include "metadata_vec.h" -#include "metadata_generator.h" -#include "xmipp_image.h" - -#include -#include -#ifdef XMIPP_MMAP -#include -#endif -#include "xmipp_funcs.h" - -MetaDataVec::MetaDataVec() { - init({}); -} - -MetaDataVec::MetaDataVec(const std::vector &labelsVector) { - init(labelsVector); -} - -MetaDataVec::MetaDataVec(const FileName &fileName, const std::vector &desiredLabels) { - init(desiredLabels); - read(fileName); -} - -MetaDataVec::MetaDataVec(const FileName &fileName) { - init({}); - read(fileName); -} - -MetaDataVec::MetaDataVec(const MetaData &md) { - init({}); - MetaData::operator=(md); -} - - -void MetaDataVec::init(const std::vector &labelsVector) { - this->clear(); - _label_to_col[MDL_OBJID] = 0; - _col_to_label.push_back(MDL_OBJID); - size_t col = 1; - for (const auto label : labelsVector) { - if (label != MDL_OBJID) { - _label_to_col[label] = col; - _col_to_label.push_back(label); - col++; - } - } - _no_columns = col; -} - -int MetaDataVec::_labelIndex(MDLabel label) const { - return this->_label_to_col[label]; -} - -const MDObject& MetaDataVec::_getObject(size_t i, MDLabel label) const { - return this->_getObject(this->_rows.at(i), label); -} - -MDObject& MetaDataVec::_getObject(size_t i, MDLabel label) { - return this->_getObject(this->_rows.at(i), label); -} - -const MDObject& MetaDataVec::_getObject(const MetaDataVecRow& row, MDLabel label) const { - int labelIndex = this->_labelIndex(label); - if ((labelIndex < 0) || (static_cast(labelIndex) >= row.size())) - throw ColumnDoesNotExist(label, getFilename()); - return row.at(labelIndex); -} - -MDObject& MetaDataVec::_getObject(MetaDataVecRow& row, MDLabel label) const { - int labelIndex = this->_labelIndex(label); - if (labelIndex < 0) - throw ColumnDoesNotExist(label, getFilename()); - return row.at(labelIndex); -} - -int MetaDataVec::_rowIndex(size_t id) const { - if (this->_id_to_index.find(id) == this->_id_to_index.end()) - return -1; - return this->_id_to_index.at(id); -} - -size_t MetaDataVec::_rowIndexSafe(size_t id) const { - int i = this->_rowIndex(id); - if (i == -1) - throw ObjectDoesNotExist(id, getFilename()); - return i; -} - -void MetaDataVec::read(const FileName &filename, const std::vector *desiredLabels, bool decomposeStack) { - String blockName; - FileName inFile; - - blockName = filename.getBlockName(); - inFile = filename.removeBlockName(); - String extFile = filename.getExtension(); - blockName = escapeForRegularExpressions(blockName); - - this->clear(); - this->setColumnFormat(true); - - if (extFile == "xml") - this->readXML(_inFile, desiredLabels, blockName, decomposeStack); - else if (extFile == "sqlite") - throw NotImplemented("Reading from .sqlite file into MetaDataVec not implemented!"); - else - this->readStar(filename, desiredLabels, blockName, decomposeStack); -} - -void MetaDataVec::write(const FileName &outFile, WriteModeMetaData mode) const { - String blockName; - FileName extFile; - FileName _outFile; - - blockName = outFile.getBlockName(); - if (blockName.empty()) - blockName = DEFAULT_BLOCK_NAME; - _outFile = outFile.removeBlockName(); - extFile = outFile.getExtension(); - - if (extFile == "xml") { - writeXML(_outFile, blockName, mode); - } else if (extFile == "sqlite") { - throw NotImplemented("Writing to .sqlite file from MetaDataVec not implemented!"); - } else { - writeStar(_outFile, blockName, mode); - } -} - -void MetaDataVec::writeXML(const FileName fn, const FileName blockname, WriteModeMetaData mode) const { - // FIXME: implement - throw NotImplemented("writeXML not implemented"); -} - -void MetaDataVec::writeText(const FileName fn, const std::vector* desiredLabels) const { - // FIXME: implement - throw NotImplemented("writeText not immplemented"); -} - -void MetaDataVec::clear() { - MetaData::clear(); - this->_rows.clear(); - std::fill(this->_label_to_col.begin(), this->_label_to_col.end(), -1); - this->_col_to_label.clear(); - this->_id_to_index.clear(); - this->_no_columns = 0; - this->_next_id = 1; -} - -void MetaDataVec::_setRow(const MDRow &row, size_t index) { - if (dynamic_cast(&row) != nullptr) { - // No not change same row - const MDRowVec& mdRowVec = dynamic_cast(row); - if ((mdRowVec._in_metadata) && (mdRowVec._rowi == index) && (mdRowVec._row == &this->_rows[index])) - return; - } - - size_t newRowSize = 0; - for (size_t labeli = 0; labeli < MDL_LAST_LABEL; ++labeli) { - MDLabel label = static_cast(labeli); - if (row.containsLabel(label)) { - if (!this->containsLabel(label)) - newRowSize = this->size(); - else if (this->_label_to_col[label]+1 > newRowSize) - newRowSize = this->_label_to_col[label]+1; - } - } - - for (size_t column = 0; (column < this->_col_to_label.size()) && (column < newRowSize); ++column) - if ((this->_col_to_label[column] != MDL_OBJID) && (!row.containsLabel(this->_col_to_label[column]))) - throw ColumnDoesNotExist("New row does not contain required MetaData column: "+ - MDL::label2Str(this->_col_to_label[column])+"!"); - - for (size_t labeli = 0; labeli < MDL_LAST_LABEL; ++labeli) { - MDLabel label = static_cast(labeli); - if (row.containsLabel(label) && !this->containsLabel(label)) - this->addLabel(label); - } - - MetaDataVecRow& editRow = this->_rows[index]; - editRow.clear(); - - for (size_t coli = 0; coli < this->_no_columns; coli++) - editRow.push_back({this->_col_to_label[coli]}); - - for (size_t labeli = 0; labeli < MDL_LAST_LABEL; ++labeli) { - MDLabel label = static_cast(labeli); - if (row.containsLabel(label)) { - size_t ourCol = _label_to_col[label]; - row.getValue(editRow[ourCol]); - } - } -} - -size_t MetaDataVec::addRow(const MDRow &row) { - /* Id: - * When ‹row› does not contain MDL_OBJID column, it is created from ‹this->_nextId› - * When ‹row› contains id which is NOT present in Metadata, id is kept. - * When ‹row› contains id which IS present in Metadata, id is changed from ‹this->_nextId›. - * When ‹this->_nextId› is present in MetaData, assert fails. This should not happen. - */ - - MetaDataVecRow newRow; - _rows.emplace_back(newRow); - this->_setRow(row, _rows.size()-1); - - if ((!row.containsLabel(MDL_OBJID)) || (row.getValue(MDL_OBJID) == BAD_OBJID)) { - MetaDataVecRow& _row = this->_rows[_rows.size()-1]; - if (!this->containsLabel(MDL_OBJID)) - this->addLabel(MDL_OBJID); - this->_expand(_row, MDL_OBJID); - _row[this->_labelIndex(MDL_OBJID)] = MDObject(MDL_OBJID, this->_next_id); - } - - size_t rowId = getRowId(_rows.size()-1); - - if (this->_id_to_index.find(rowId) != this->_id_to_index.end()) { - MetaDataVecRow& _row = this->_rows[_rows.size()-1]; - _row[this->_labelIndex(MDL_OBJID)] = MDObject(MDL_OBJID, this->_next_id); - rowId = this->_next_id; - } - - assert(this->_id_to_index.find(rowId) == this->_id_to_index.end()); - - if (rowId >= this->_next_id) - this->_next_id = rowId+1; - this->_id_to_index[rowId] = _rows.size()-1; - return rowId; -} - -void MetaDataVec::addRows(const std::vector &rows) { - for (const auto row : rows) - this->addRow(row); -} - -int MetaDataVec::getMaxStringLength(const MDLabel thisLabel) const { - return 255; -} - -bool MetaDataVec::setValueCol(const MDObject &mdValueIn) { - const auto &label = mdValueIn.label; - int labelIndex = this->_labelIndex(label); - if (labelIndex < 0) { - this->addLabel(label); - labelIndex = this->_labelIndex(label); - for (auto &r : _rows) _expand(r, labelIndex); - } - for (auto &r : _rows) r[labelIndex] = mdValueIn; - return true; -} - -bool MetaDataVec::setValue(const MDObject &mdValueIn, size_t id) { - if (!this->containsLabel(mdValueIn.label)) - this->addLabel(mdValueIn.label); - - MetaDataVecRow& row = this->_rows[this->_rowIndexSafe(id)]; - this->_expand(row, mdValueIn.label); - - row[this->_labelIndex(mdValueIn.label)] = mdValueIn; - return true; -} - -bool MetaDataVec::getValue(MDObject &mdValueOut, size_t id) const { - try { - mdValueOut = this->_getObject(this->_rowIndexSafe(id), mdValueOut.label); - } catch (const ColumnDoesNotExist&) { - return false; - } - return true; -} - -MDObject &MetaDataVec::getValue(MDLabel label, size_t id) { - return this->_getObject(this->_rowIndexSafe(id), label); -} - -const MDObject &MetaDataVec::getValue(MDLabel label, size_t id) const { - return this->_getObject(this->_rowIndexSafe(id), label); -} - -std::unique_ptr MetaDataVec::getRow(size_t id) { - int i = this->_rowIndex(id); - if (i < 0) - return nullptr; - return memoryUtils::make_unique( - this->_rows[i], i, this->_label_to_col, this->_col_to_label, this->_no_columns - ); -} - -std::unique_ptr MetaDataVec::getRow(size_t id) const { - int i = this->_rowIndex(id); - if (i < 0) - return nullptr; - return memoryUtils::make_unique( - this->_rows[i], i, this->_label_to_col, this->_col_to_label, this->_no_columns - ); -} - -MDRowVec MetaDataVec::getRowVec(size_t id) { - size_t i = this->_rowIndexSafe(id); - return MDRowVec(this->_rows[i], i, this->_label_to_col, this->_col_to_label, this->_no_columns); -} - -const MDRowVec MetaDataVec::getRowVec(size_t id) const { - size_t i = this->_rowIndexSafe(id); - return MDRowVec(this->_rows[i], i, this->_label_to_col, this->_col_to_label, this->_no_columns); -} - -void MetaDataVec::getRow(MDRowVec &row, size_t id) { - size_t i = this->_rowIndexSafe(id); - row = MDRowVec(this->_rows[i], i, this->_label_to_col, this->_col_to_label, this->_no_columns); -} - -bool MetaDataVec::getRowValues(size_t id, std::vector &values) const { - int i = this->_rowIndex(id); - if (i < 0) - return false; - values = this->_rows[i]; - return true; -} - -size_t MetaDataVec::getRowId(size_t i) const { - return this->_getObject(i, MDL_OBJID).getValue2(size_t()); -} - -size_t MetaDataVec::getRowId(const MetaDataVecRow& row) const { - int labelIndex = _labelIndex(MDL_OBJID); - if (labelIndex < 0) - throw ColumnDoesNotExist(MDL_OBJID, getFilename()); - return row.at(labelIndex).getValue2(size_t()); -} - -void MetaDataVec::getColumnValues(const MDLabel label, std::vector &valuesOut) const { - valuesOut.clear(); - int labelIndex = this->_labelIndex(label); - if (labelIndex < 0) - throw ColumnDoesNotExist(label, getFilename()); - for (const auto& vecRow : this->_rows) - valuesOut.emplace_back(vecRow.at(labelIndex)); -} - -void MetaDataVec::setColumnValues(const std::vector &valuesIn) { - for (size_t i = 0; i < std::min(valuesIn.size(), this->_rows.size()); i++) { - int labelIndex = this->_labelIndex(valuesIn[i].label); - if (labelIndex < 0) - this->addLabel(valuesIn[i].label); - labelIndex = this->_labelIndex(valuesIn[i].label); - if (labelIndex < 0) - throw ColumnDoesNotExist(valuesIn[i].label, getFilename()); - this->_expand(this->_rows[i], valuesIn[i].label); - this->_rows[i][labelIndex] = valuesIn[i]; - } -} - -bool MetaDataVec::setRow(const MDRow &row, size_t id) { - this->_setRow(row, this->_rowIndexSafe(id)); - return true; -} - -bool MetaDataVec::isEmpty() const { - return this->_rows.empty(); -} - -size_t MetaDataVec::size() const { - return this->_rows.size(); -} - -bool MetaDataVec::containsLabel(const MDLabel label) const { - return this->_labelIndex(label) > -1; -} - -bool MetaDataVec::addLabel(const MDLabel label, int pos) { - if (pos != -1) - throw NotImplemented("addLabel to -1 not implemented"); - if (this->_label_to_col[label] != -1) - return true; - - this->_no_columns++; - size_t column = this->_no_columns-1; - this->_label_to_col[label] = column; - this->_col_to_label.emplace_back(label); - return true; -} - -bool MetaDataVec::removeLabel(const MDLabel label) { - if (this->_label_to_col[label] == -1) - return false; - int column = this->_label_to_col[label]; - - for (auto& vecRow : this->_rows) - if (static_cast(vecRow.size()) > column) - vecRow.erase(vecRow.begin()+column); // this is expensive - - // FIXME: test this properly - this->_label_to_col[label] = -1; - for (size_t i = 0; i < MDL_LAST_LABEL; i++) { - if (this->_label_to_col[i] > column) { - this->_label_to_col[i]--; - this->_col_to_label[this->_label_to_col[i]] = MDLabel(i); - } - } - this->_no_columns--; - return true; -} - -size_t MetaDataVec::addObject() { - MDRowVec row; - row.setValue(MDObject(MDL_OBJID, this->_next_id)); - return this->addRow(row); -} - -void MetaDataVec::importObject(const MetaData &md, const size_t id, bool doClear) { - if (doClear) { - this->clear(); - this->copyInfo(md); - } - - std::unique_ptr row = md.getRow(id); - if (row == nullptr) - return; - - MDRowVec newRow; - for (const MDObject* obj : *row) - if (obj->label != MDL_OBJID) - newRow.setValue(*obj); - this->addRow(newRow); -} - -void MetaDataVec::importObjects(const MetaData &md, const std::vector &objectsToAdd, bool doClear) { - if (doClear) { - this->clear(); - this->copyInfo(md); - } - - for (size_t objId : objectsToAdd) - this->importObject(md, objId, false); -} - -void MetaDataVec::importObjects(const MetaData &md, const MDQuery &query, bool doClear) { - // FIXME: move this to MetaData? - std::vector ids; - md.findObjects(ids, query); - this->importObjects(md, ids, doClear); -} - -bool MetaDataVec::removeObject(size_t id) { - int i = this->_rowIndex(id); - if (i < 0) - return false; - - this->_id_to_index.erase(id); - this->_rows.erase(this->_rows.begin()+i); - - for (size_t j = i; j < this->_rows.size(); j++) - this->_id_to_index[this->getRowId(j)]--; - - return true; -} - -void MetaDataVec::removeObjects(const std::vector &toRemove) { - for (size_t id : toRemove) - this->removeObject(id); -} - -int MetaDataVec::removeObjects() { - size_t count = this->size(); - this->clear(); - return count; -} - -int MetaDataVec::removeObjects(const MDQuery& query) { - // FIXME: move this to MetaData? - std::vector ids; - this->findObjects(ids, query); - this->removeObjects(ids); - return true; -} - -size_t MetaDataVec::firstRowId() const { - return this->getRowId(0); -} - -size_t MetaDataVec::lastRowId() const { - return this->getRowId(this->size()-1); -} - -bool MetaDataVec::_match(const MetaDataVecRow& row, const MDQuery& query) const { - if (dynamic_cast(&query) != nullptr) { - // Process MDMultiQuery - const MDMultiQuery& mq = dynamic_cast(query); - if (mq.operations.size() == 0) - return true; // emptuy query matches always - String operation = mq.operations[0]; - for (const auto& op : mq.operations) - assert(op == operation); // support only all same operations - for (const auto& q : mq.queries) { - if ((operation == "AND") && (!this->_match(row, *q))) - return false; - else if ((operation == "OR") && (this->_match(row, *q))) - return true; - } - return (operation == "AND"); // false for "OR", true for "AND" - } - - if (dynamic_cast(&query) == nullptr) - throw NotImplemented("_match for this type of query not implemented"); - // MDValueRange, MDExpression, MDMultiQuery not implemented yet - // MDExpression will probably never be supported as it is raw SQL expression - - const MDValueRelational& rel = dynamic_cast(query); - - if (rel.value == nullptr) - return false; - - size_t labeli = this->_labelIndex(rel.value->label); - if (labeli >= row.size()) - return false; - - const MDObject& mdObj = row[labeli]; - - if (rel.op == RelationalOp::EQ) - return *(rel.value) == mdObj; - if (rel.op == RelationalOp::NE) - return *(rel.value) != mdObj; - if (rel.op == RelationalOp::GT) // FIXME: check if < & > are not swapped - return *(rel.value) < mdObj; - if (rel.op == RelationalOp::GE) - return *(rel.value) <= mdObj; - if (rel.op == RelationalOp::LT) - return *(rel.value) > mdObj; - if (rel.op == RelationalOp::LE) - return *(rel.value) >= mdObj; - - throw std::logic_error("MetaDataVec::_match: unknown operator"); -} - -size_t MetaDataVec::firstObject(const MDQuery& query) const { - // FIXME: should first be first in _rows order or ids order? - for (const MetaDataVecRow& row : this->_rows) - if (this->_match(row, query)) - return this->getRowId(row); - return BAD_OBJID; -} - -void MetaDataVec::findObjects(std::vector &objectsOut, const MDQuery &query) const { - // FIXME: should first be first in _rows order or ids order? - objectsOut.clear(); - for (const MetaDataVecRow& row : this->_rows) - if (this->_match(row, query)) - objectsOut.emplace_back(this->getRowId(row)); -} - -void MetaDataVec::findObjects(std::vector &objectsOut, int limit) const { - objectsOut.clear(); - for (size_t i = 0; i < std::min(limit, this->size()); i++) - objectsOut.emplace_back(this->getRowId(this->_rows[i])); -} - -size_t MetaDataVec::countObjects(const MDQuery& query) const { - size_t count = 0; - for (const MetaDataVecRow& row : this->_rows) - if (this->_match(row, query)) - count++; - return count; -} - -bool MetaDataVec::containsObject(size_t objectId) const { - return this->_rowIndex(objectId) > -1; -} - -bool MetaDataVec::containsObject(const MDQuery& query) const { - for (const MetaDataVecRow& row : this->_rows) - if (this->_match(row, query)) - return true; - return false; -} - -bool MetaDataVec::containsObject(size_t objectId) { - return this->_id_to_index.find(objectId) != this->_id_to_index.end(); -} - - -void MetaDataVec::_writeRows(std::ostream &os) const { - for (const MetaDataVecRow& row : this->_rows) { - for (size_t i = 0; i < MDL_LAST_LABEL; i++) { - const MDLabel label = static_cast(i); - if ((label != MDL_STAR_COMMENT) && (label != MDL_OBJID) && (this->_label_to_col[i] > -1)) { - os.width(1); - if (this->_labelIndex(label) < static_cast(row.size())) - this->_getObject(row, label).toStream(os, true); - else - throw ColumnDoesNotExist(label, getFilename()); - os << " "; - } - } - os << '\n'; - } -} - -void MetaDataVec::write(std::ostream &os, const String &blockName, WriteModeMetaData mode) const { - if (mode==MD_OVERWRITE) - os << FileNameVersion << " * "// << (isColumnFormat ? "column" : "row") - << '\n' // write which type of format (column or row) and the path; - << WordWrap(this->_comment, line_max); // write md comment in the 2nd comment line of header - - // write data block - String _szBlockName("data_"); - _szBlockName += blockName; - - if (this->isColumnFormat()) { - // write md columns in 3rd comment line of the header - os << _szBlockName << '\n'; - os << "loop_" << '\n'; - for (size_t i = 0; i < MDL_LAST_LABEL; i++) - if ((i != MDL_STAR_COMMENT) && (i != MDL_OBJID) && (this->_label_to_col[i] > -1)) - os << " _" << MDL::label2Str(static_cast(i)) << '\n'; - _writeRows(os); - - //Put the activeObject to the first, if exists - } else { // row format - os << _szBlockName << '\n'; - - // Print single object - assert(this->_rows.size() == 1); - - for (size_t i = 0; i < MDL_LAST_LABEL; i++) { - const MDLabel label = static_cast(i); - if ((label != MDL_STAR_COMMENT) && (label != MDL_OBJID) && (this->_label_to_col[i] > -1)) { - os << " _" << MDL::label2Str(label) << " "; - if (this->_labelIndex(label) < static_cast(this->_rows[0].size())) - this->_getObject(this->_rows[0], label).toStream(os); - else - throw ColumnDoesNotExist(label, getFilename()); - os << '\n'; - } - } - } -} - -void MetaDataVec::_parseObjects(std::istream &is, std::vector &columnValues, - const std::vector *desiredLabels, bool firstTime) { - for (size_t i = 0; i < columnValues.size(); i++) { - columnValues[i]->fromStream(is); - - if (is.fail()) { - String errorMsg = formatString("MetaData: Error parsing column '%s' value.", - MDL::label2Str(columnValues[i]->label).c_str()); - columnValues[i]->failed = true; - std::cerr << "WARNING: " << errorMsg << std::endl; - //REPORT_ERROR(ERR_MD_BADLABEL, (String)"read: Error parsing data column, expecting " + MDL::label2Str(object.label)); - } else if (firstTime) { - // Check if current column label exists. - if (columnValues[i]->label != MDL_UNDEFINED) { - // If there are no desired labels then add all. - bool reallyAdd=false; - if (desiredLabels == NULL) { - reallyAdd = true; - } else { - // Check if current column belongs to desired labels. - for (size_t j = 0; j < desiredLabels->size(); ++j) { - if ((*desiredLabels)[j] == columnValues[i]->label) { - reallyAdd = true; - break; - } - } - } - - // Add label if not exists. - if (reallyAdd) - this->addLabel(columnValues[i]->label); - } - } - } - - // Insert elements in DB. - MDRowVec newRow; - for (size_t i = 0; i < columnValues.size(); i++) - if (columnValues[i] != nullptr) - newRow.setValue(*columnValues[i]); - this->addRow(newRow); -} - -void MetaDataVec::readXML(const FileName &inFile, const std::vector *desiredLabels, const String & blockRegExp, bool decomposeStack) { - REPORT_ERROR(ERR_NOT_IMPLEMENTED, "readXML not implemented yet"); -} - -void MetaDataVec::readPlain(const FileName &inFile, const String &labelsString, const String &separator) { - // TODO - throw NotImplemented("readPlain not implemented"); -} - -void MetaDataVec::addPlain(const FileName &inFile, const String &labelsString, const String &separator) { - // TODO - throw NotImplemented("addPlain not implemented"); -} - -double MetaDataVec::getColumnMax(MDLabel column) { - // TODO - throw NotImplemented("getColumnMax not implemented"); -} - -double MetaDataVec::getColumnMin(MDLabel column) { - // TODO - throw NotImplemented("getColumnMin not implemented"); -} - -void MetaDataVec::replace(const MDLabel label, const String &oldStr, const String &newStr) { - // TODO - throw NotImplemented("replace not implemented"); -} - -void MetaDataVec::randomize(const MetaData &MDin) { - *this = MDin; - std::random_device rd; - auto g = std::mt19937(rd()); - std::shuffle(this->_rows.begin(), this->_rows.end(), g); - this->_recalc_id_to_index(); -} - -void MetaDataVec::_recalc_id_to_index() { - this->_id_to_index.clear(); - for (size_t i = 0; i < this->_rows.size(); i++) - this->_id_to_index[this->getRowId(i)] = i; -} - -void MetaDataVec::removeDuplicates(MetaData &MDin, MDLabel label) { - *this = MDin; // FIXME: maybe join? - std::vector new_rows; - for (const auto& row : this->_rows) { - if (!this->_contains(new_rows, row)) - new_rows.emplace_back(row); - } - this->_rows = new_rows; -} - -bool MetaDataVec::_contains(const std::vector& rows, const MetaDataVecRow& row) const { - for (const auto& _row : rows) - if (this->_rowsEq(row, _row)) - return true; - return false; -} - -bool MetaDataVec::_rowsEq(const MetaDataVecRow& a, const MetaDataVecRow& b) const { - for (size_t label = 0; label < MDL_LAST_LABEL; label++) { - if ((label == MDL_COMMENT) || (label == MDL_OBJID)) - continue; - - int labeli = this->_labelIndex(static_cast(label)); - if (labeli > -1) { // label is active - if ((static_cast(labeli) < a.size()) != - (static_cast(labeli) < b.size())) - return false; // item present in one row, but not other - if (static_cast(labeli) >= a.size()) - continue; // label not present in both rows - if (!a[labeli].eq(b[labeli], this->precision())) - return false; // MDObjects are diffrent - } - } - return true; -} - -void MetaDataVec::sort(const MetaDataVec &MDin, const MDLabel sortLabel, bool asc, int limit, int offset) { - *this = MDin; - - int label_index = this->_labelIndex(sortLabel); - if (label_index > -1) { - std::sort(this->_rows.begin(), this->_rows.end(), - [label_index, asc](const MetaDataVecRow &a, const MetaDataVecRow &b) { - if (asc) - return a[label_index] < b[label_index]; - return a[label_index] > b[label_index]; - } - ); - - this->_rows.erase(this->_rows.begin(), this->_rows.begin()+offset); - if ((limit > 0) && (limit < this->_rows.size())) - this->_rows.erase(this->_rows.begin()+limit, this->_rows.end()); - - this->_recalc_id_to_index(); - - } -} - -void MetaDataVec::sort(MetaDataVec &MDin, const String &sortLabel, bool asc, int limit, int offset) { - // TODO - throw NotImplemented("sort not implemented"); -} - -void MetaDataVec::split(size_t parts, std::vector &results, const MDLabel sortLabel) const { - if (parts > this->size()) - REPORT_ERROR(ERR_MD, "MetaDataDb::split: Couldn't split a metadata in more parts than its size"); - - MetaDataVec sorted; - if (sortLabel == MDL_UNDEFINED) - sorted = *this; - else - sorted.sort(*this, sortLabel); - - results.clear(); - results.resize(parts); - for (size_t i = 0; i < parts; i++) { - MetaDataVec &md = results[i]; - size_t firsti, lasti; - divide_equally(sorted.size(), parts, i, firsti, lasti); - for (size_t j = firsti; j <= lasti; j++) - md.addRow(sorted.getRowVec(sorted.getRowId(j))); - } -} - -void MetaDataVec::selectRandomSubset(const MetaData &mdIn, size_t numberOfObjects, const MDLabel sortLabel) { - // TODO - throw NotImplemented("selectRandomSubset not implemented"); -} - -void MetaDataVec::selectPart(const MetaData &mdIn, size_t startPosition, size_t numberOfObjects, - const MDLabel sortLabel) { - this->sort(mdIn, sortLabel, true, numberOfObjects, startPosition); -} - -/*void makeAbsPath(const MDLabel label=MDL_IMAGE);*/ - - -void MetaDataVec::fillConstant(MDLabel label, const String &value) { - // FIXME: move to MetaData and use common MDGenerator? - MDConstGenerator generator(value); - generator.label = label; - generator.fill(*this); -} - -void MetaDataVec::fillRandom(MDLabel label, const String &mode, double op1, double op2, double op3) { - // FIXME: move to MetaData and use common MDGenerator? - MDRandGenerator generator(op1, op2, mode, op3); - generator.label = label; - generator.fill(*this); -} - -void MetaDataVec::fillLinear(MDLabel label, double initial, double step) { - // FIXME: move to MetaData and use common MDGenerator? - MDLinealGenerator generator(initial, step); - generator.label = label; - generator.fill(*this); -} - -void MetaDataVec::_expand(MetaDataVecRow& row, const MDLabel label) { - int labeli = this->_labelIndex(label); - if (labeli < 0) - this->addLabel(label); - this->_expand(row, this->_labelIndex(label)); -} - -void MetaDataVec::_expand(MetaDataVecRow& row, size_t labeli) { - // In assert: all labels to labeli (including) must be present in - // this->_col_to_label. - - if (labeli < row.size()) - return; // space for label already present - - for (size_t i = row.size(); i <= labeli; i++) - row.emplace_back(MDObject(this->_col_to_label.at(i))); -} - -void MetaDataVec::copyColumn(MDLabel labelDest, MDLabel labelSrc) { - int labelsrci = this->_labelIndex(labelSrc); - int labeldesti = this->_labelIndex(labelDest); - if (labelsrci < 0) - return; - if (labeldesti < 0) - this->addLabel(labelDest); - labeldesti = this->_labelIndex(labelDest); - - for (MetaDataVecRow& row : this->_rows) { - if (static_cast(labeldesti) >= row.size()) - this->_expand(row, labeldesti); - - if (static_cast(labelsrci) < row.size()) { - row[labeldesti] = row[labelsrci]; - row[labeldesti].label = labelDest; - } - // else row[labeldesti] is empty MDObject (from previous if) - } -} - -void MetaDataVec::copyColumnTo(MetaData& md, MDLabel labelDest, MDLabel labelSrc) { - // TODO - throw NotImplemented("copyColumnTo not implemented"); -} - -void MetaDataVec::renameColumn(MDLabel oldLabel, MDLabel newLabel) { - assert(!this->containsLabel(newLabel)); - int labeloldi = this->_labelIndex(oldLabel); - if (labeloldi < 0) - throw ColumnDoesNotExist(oldLabel, getFilename()); - - this->_label_to_col[newLabel] = labeloldi; - this->_label_to_col[oldLabel] = -1; - this->_col_to_label[labeloldi] = newLabel; - - for (auto& row : this->_rows) { - if (labeloldi < static_cast(row.size())) - row[labeloldi].label = newLabel; - } -} - -void MetaDataVec::renameColumn(const std::vector &oldLabel, - const std::vector &newLabel) { - // TODO - throw NotImplemented("renameColumn not implemented"); -} - - -bool MetaDataVec::operator==(const MetaDataVec& op) const { - // This comparison ignores order of labels and row ids, everything else must be same. - - if (this->_rows.size() != op._rows.size()) - return false; - - for (size_t labeli = 0; labeli < MDL_LAST_LABEL; labeli++) - if ((this->_label_to_col[labeli] > -1) != (op._label_to_col[labeli] > -1)) - return false; - - for (size_t i = 0; i < this->_rows.size(); i++) { - for (size_t labeli = 0; labeli < MDL_LAST_LABEL; labeli++) { - if ((labeli == MDL_COMMENT) || (labeli == MDL_OBJID)) - continue; - - int thisLabelColI = this->_label_to_col[labeli]; - int opLabelColI = op._label_to_col[labeli]; - if (thisLabelColI > -1) { - if ((static_cast(thisLabelColI) < this->_rows[i].size()) != - (static_cast(opLabelColI) < op._rows[i].size())) - return false; // item present in one row, but not other - if (static_cast(thisLabelColI) >= this->_rows[i].size()) - continue; // label not present in both rows - if (!this->_rows[i][thisLabelColI].eq(op._rows[i][opLabelColI], this->precision())) - return false; // MDObjects are diffrent - } - } - } - - return true; // all rows same → ok -} - -std::vector MetaDataVec::getActiveLabels() const { - std::vector out; - for (size_t i = MDL_GATHER_ID; i < MDL_LAST_LABEL; i++) // ignore MDL_FIRST_LABEL = MDL_OBJID - if (this->_label_to_col[i] > -1) - out.emplace_back(static_cast(i)); - return out; -} - -std::ostream& operator<<(std::ostream& o, const MetaDataVec& md) { - md.write(o); - return o; -} diff --git a/src/core/metadata_vec.h b/src/core/metadata_vec.h deleted file mode 100644 index c06a1a8..0000000 --- a/src/core/metadata_vec.h +++ /dev/null @@ -1,576 +0,0 @@ -/*************************************************************************** - * - * Authors: Jan Horacek (xhorace4@fi.muni.cz) - * - * Institute of Computer Science MUNI - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef VEC_METADATA_H -#define VEC_METADATA_H - -#include -#include -#include -#include "memory.h" -#include "metadata_base.h" -#include "metadata_base_it.h" -#include "utils/memory_utils.h" - -using MetaDataVecRow = std::vector; - - -/** Fast in-memory storage of metadata in std::vector. - * MetaDataVec implements MetaData API (see metadata_base.h). - * - * ### Notes - * 1. It's fast to iterate either over rows or over ids. - */ -class MetaDataVec: public MetaData { -protected: - std::vector _rows; - std::array _label_to_col; // -1 = no mapping - std::vector _col_to_label; - size_t _no_columns = 0; - std::unordered_map _id_to_index; - size_t _next_id = 1; - - /** Init, do some initializations tasks, used in constructors - * @ingroup MetaDataConstructors - */ - void init(const std::vector& labelsVector); - - /** clear data and table structure */ - void _clear(bool onlyData=false); - - /** - * Get a vector of (empty) objects for each active label - */ - std::vector getObjectsForActiveLabels() const; - - int _labelIndex(MDLabel label) const; - const MDObject& _getObject(size_t i, MDLabel label) const; - MDObject& _getObject(size_t i, MDLabel label); - const MDObject& _getObject(const MetaDataVecRow&, MDLabel) const; - MDObject& _getObject(MetaDataVecRow&, MDLabel) const; - int _rowIndex(size_t id) const; - size_t _rowIndexSafe(size_t id) const; - - void _setRow(const MDRow &row, size_t index); - bool _match(const MetaDataVecRow&, const MDQuery&) const; - size_t getRowId(const MetaDataVecRow&) const; - - // Expand row to fit label in. - void _expand(MetaDataVecRow&, const MDLabel); - void _expand(MetaDataVecRow&, size_t labeli); - - void _parseObjects(std::istream &is, std::vector & columnValues, - const std::vector *desiredLabels, bool firstTime) override; - - void _recalc_id_to_index(); - - bool _contains(const std::vector&, const MetaDataVecRow&) const; - bool _rowsEq(const MetaDataVecRow& a, const MetaDataVecRow& b) const; - -public: - /** @name Constructors - * @{ - */ - - /** Empty Constructor. - * - * The MetaData is created with no data stored on it. You can fill in it programmatically - * or by a later reading from a MetaData file or old Xmipp formatted type. - * if labels vectors is passed this labels are created on metadata - */ - MetaDataVec(); - MetaDataVec(const std::vector &labelsVector); - - /** From File Constructor. - * - * The MetaData is created and data is read from provided FileName. Optionally, a vector - * of labels can be provided to read just those required labels - */ - MetaDataVec(const FileName &fileName, const std::vector &desiredLabels); - MetaDataVec(const FileName &fileName); - - /** Copy constructor - * - * Created a new metadata by copying all data from an existing MetaData object. - */ - MetaDataVec(const MetaData &md); - MetaDataVec(const MetaDataVec &md) = default; - - virtual ~MetaDataVec() {} - - /**Clear all data - */ - void clear() override; - /** @} */ - - /** @name Getters and setters - * @{ - */ - std::vector getActiveLabels() const override; - - /** Export medatada to xml file. - * - */ - void writeXML(const FileName fn, const FileName blockname, WriteModeMetaData mode) const override; - - /** Write metadata in text file as plain data without header. - * - */ - void writeText(const FileName fn, const std::vector* desiredLabels) const override; - - /** @} */ - - /** @name MetaData Manipulation - * @{ - */ - - size_t addRow(const MDRow &row) override; - void addRows(const std::vector &rows); - - - int getMaxStringLength(const MDLabel thisLabel) const override; - - /** Set the value of all objects in an specified column (both value and column are specified in mdValueIn) - */ - bool setValueCol(const MDObject &mdValueIn) override; - - template - bool setValueCol(const MDLabel label, const T &valueIn) { - return MetaData::setValueCol(label, valueIn); - } - - /** This functions are using MDObject for set real values - * there is an explicit function signature - * foreach type supported in Metadata. - * This is done for some type checking of Metadata labels - * and values - */ - bool setValue(const MDObject &mdValueIn, size_t id); - - template - bool setValue(const MDLabel label, const T &valueIn, size_t id) { - return MetaData::setValue(label, valueIn, id); - } - - bool getValue(MDObject &mdValueOut, size_t id) const override; - MDObject &getValue(MDLabel, size_t id); - const MDObject &getValue(MDLabel, size_t id) const; - - template - bool getValue(const MDLabel label, T &valueOut, size_t id) const { - return MetaData::getValue(label, valueOut, id); - } - - template - T getValue(const MDLabel label, size_t id) { - return this->getValue(label, id).getValue2(T()); - } - - template - const T getValue(const MDLabel label, size_t id) const { - return this->getValue(label, id).getValue2(T()); - } - - std::unique_ptr getRow(size_t id) override; - std::unique_ptr getRow(size_t id) const override; - - MDRowVec getRowVec(size_t id); - const MDRowVec getRowVec(size_t id) const; - - void getRow(MDRowVec &row, size_t id); // FIXME: deprecated, use getRow above - - bool getRowValues(size_t id, std::vector &values) const override; - size_t getRowId(size_t i) const; - void getColumnValues(const MDLabel label, std::vector &valuesOut) const override; - void setColumnValues(const std::vector &valuesIn) override; - - template - void setColumnValues(const MDLabel label, const std::vector &valuesIn) { - return MetaData::setColumnValues(label, valuesIn); - } - - bool setRow(const MDRow &row, size_t id); - - template - std::vector getColumnValues(const MDLabel label) const { - return MetaData::getColumnValues(label); - } - - template - void getColumnValues(const MDLabel label, std::vector &valuesOut) const { - return MetaData::getColumnValues(label, valuesOut); - } - - /**Check whether the metadata is empty. - */ - bool isEmpty() const override; - - /**Number of objects contained in the metadata. - */ - size_t size() const override; - - /** Check whether a label is contained in metadata. - */ - bool containsLabel(const MDLabel label) const override; - - size_t firstRowId() const override; - size_t firstObject(const MDQuery&) const override; - size_t lastRowId() const override; - - /** @} */ - - /** @name MetaData Manipulation - * @{ - */ - - /** Add a new label to the metadata. - * By default the label is added at the end, - * if the position is specified and is between 0 and n-1 - * the new label is inserted at that position. - */ - bool addLabel(const MDLabel label, int pos = -1) override; - - /** Remove a label from the metadata. - * The data is still in the table. If you want to remove the data, - * make a copy of the MetaData. - */ - bool removeLabel(const MDLabel label) override; - - /** Adds a new, empty object to the objects map. If objectId == -1 - * the new ID will be that for the last object inserted + 1, else - * the given objectId is used. If there is already an object whose - * objectId == input objectId, just removes it and creates an empty - * one - */ - size_t addObject() override; - - /** Import objects from another metadata. - * @code - * //Import object 1000 from metadata B into metadata A - * A.importObject(B, 1000); - * //Import all objects with rotational angle greater that 60 - * A.importObjects(B, MDValuesGT(MDL_ANGLE_ROT, 60)); - * //Import all objects - * A.importObjects(B); - * @endcode - */ - void importObject(const MetaData &md, const size_t id, bool doClear=true) override; - void importObjects(const MetaData &md, const std::vector &objectsToAdd, bool doClear=true) override; - void importObjects(const MetaData &md, const MDQuery &query, bool doClear=true) override; - - /** Remove the object with this id. - * Returns true if the object was removed or false if - * the object did not exist - */ - bool removeObject(size_t id) override; - - /** Removes the collection of objects of given vector id's - * NOTE: The iterator will point to the first object after any of these - * operations - */ - void removeObjects(const std::vector &toRemove) override; - - /** Removes objects from metadata. - * return the number of deleted rows - * if not query, all objectes are removed - * Queries can be used in the same way - * as in the importObjects function - */ - int removeObjects() override; - int removeObjects(const MDQuery&) override; - - /** @name Search operations - * @{ - */ - - /** Find all objects that match a query. - * if called without query, all objects are returned - * if limit is provided only return a maximun of 'limit' - */ - void findObjects(std::vector &objectsOut, const MDQuery &query) const override; - void findObjects(std::vector &objectsOut, int limit = -1) const override; - - size_t countObjects(const MDQuery&) const override; - bool containsObject(size_t objectId) const override; - bool containsObject(const MDQuery&) const override; - - /** Find if the object with this id is present in the metadata - */ - bool containsObject(size_t objectId); - - /** @} */ - - /** @name I/O functions - * @{ - */ - - /** Write rows data to disk. */ - void _writeRows(std::ostream &os) const override; - - /** Write metadata to disk. Guess blockname from filename - * @code - * outFilename="first@md1.doc" -> filename = md1.doc, blockname = first - * @endcode - */ - void write(const FileName &outFile, WriteModeMetaData mode=MD_OVERWRITE) const; - - - /** Write metadata to out stream - */ - void write(std::ostream &os, const String & blockName="",WriteModeMetaData mode=MD_OVERWRITE) const; - - /** Read metadata from xml file - * - */ - void readXML(const FileName &inFile, - const std::vector *desiredLabels = nullptr, - const String & blockRegExp=DEFAULT_BLOCK_NAME, - bool decomposeStack=true); - - /** Read data from file. Guess the blockname from the filename - * @code - * inFilename="first@md1.doc" -> filename = md1.doc, blockname = first - * @endcode - */ - void read(const FileName &inFile, const std::vector *desiredLabels = nullptr, bool decomposeStack = true) override; - /** @} */ - - /** Try to read a metadata from plain text with some columns. - * Labels for each columns should be provided in an string separated by spaces. - * Return false if couldn't read - */ - void readPlain(const FileName &inFile, const String &labelsString, const String &separator = " "); - /** Same as readPlain, but instead of cleanning data, the - * readed values will be added. If there are common columns in metadata - * and the plain text, the lattest will be setted - */ - void addPlain(const FileName &inFile, const String &labelsString, const String &separator=" "); - - - /** Returns Max and Min values from a column in metadata - * These functions can only be used for labels of type double - */ - double getColumnMax(MDLabel column); - - double getColumnMin(MDLabel column); - - - /** Replace an string in some column(label). - * The type of the column should be string. This function is a shortcut - * of the more genereal function operate - */ - void replace(const MDLabel label, const String &oldStr, const String &newStr); - - /** Randomize a metadata. - * MDin is input and the "randomized" - * result will be in the "calling" Metadata. - */ - void randomize(const MetaData &MDin); - - /**Remove duplicate entries for attribute in label - */ - void removeDuplicates(MetaData &MDin, MDLabel label=MDL_UNDEFINED); - - /* - * Sort a Metadata by a label. - * Sort the content of MDin comparing - * the label supplied, the result will - * be in the "calling" MetaData. - * Limit fixes the maximum number of returned rows - * Offset skips the first N rows - */ - void sort(const MetaDataVec &MDin, - const MDLabel sortLabel, - bool asc=true, - int limit=-1, - int offset=0); - - - /* - * Sort a Metadata by a label. - * Sort the content of MDin comparing - * the label supplied, the result will - * be in the "calling" MetaData. - * If the input label is a vector field, - * you may supply label:col, to sort by that column, - * e.g., NMADisplacements:0 - * Limit fixes the maximum number of returned rows - * Offset skips the first N rows - * - */ - void sort(MetaDataVec &MDin, const String &sortLabel, bool asc=true, int limit=-1, int offset=0); - - /** Split Metadata in several Metadatas. - * The Metadata will be divided in 'n' - * almost equally parts and the result will - * be a vector of Metadatas. The "calling" - * Metadata will no be modified. - * @code - * // Divide the images metadata in 10 metadatas. - * std::vector imagesGroups; - * imageMD.split(10, imagesGroups); - * @endcode - */ - void split(size_t n, std::vector &results, - const MDLabel sortLabel=MDL_OBJID) const; - - /** Select random subset */ - void selectRandomSubset(const MetaData &mdIn, size_t numberOfObjects, const MDLabel sortLabel=MDL_OBJID) override; - - /** Select some part from Metadata. - * Select elements from input Metadata - * at some starting position - * if the numberOfObjects is -1, all objects - * will be returned from startPosition to the end. - */ - void selectPart(const MetaData &mdIn, size_t startPosition, size_t numberOfObjects, - const MDLabel sortLabel=MDL_OBJID) override; - - /** Makes filenames with absolute paths - * - */ - void makeAbsPath(const MDLabel label=MDL_IMAGE); - - /** @} */ - - /** @name Iterators - * @{ - */ - - template - struct MDVecRowIterator : public MDBaseRowIterator { - private: - typename TypeHelpers::choose::type _mdv; - size_t _i; - using RowType = typename TypeHelpers::choose::type; - std::unique_ptr _row; - - public: - MDVecRowIterator(typename TypeHelpers::choose::type &mdv, size_t i) - : _mdv(mdv), _i(i) { - if (_i < _mdv.size()) - _row.reset(new RowType(mdv._rows.at(i), i, mdv._label_to_col, mdv._col_to_label, mdv._no_columns)); - else - _row = nullptr; - } - - std::unique_ptr> clone() override { - return memoryUtils::make_unique>(_mdv, _i); - } - - void increment() override { - _i++; - if (_i < _mdv.size()) - _row.reset(new RowType(_mdv._rows.at(_i), _i, _mdv._label_to_col, _mdv._col_to_label, _mdv._no_columns)); - else - _row = nullptr; - } - - bool operator==(const MDBaseRowIterator& other) const override { - const MDVecRowIterator* vri = dynamic_cast*>(&other); - if (vri != nullptr) - return _i == vri->_i; - return false; - } - - typename TypeHelpers::choose::type operator*() override { return *_row; } - }; - - iterator begin() override { - return {memoryUtils::make_unique>(*this, 0)}; - } - iterator end() override { - return {memoryUtils::make_unique>(*this, this->size())}; - } - - const_iterator begin() const override { - return {memoryUtils::make_unique>(*this, 0)}; - } - const_iterator end() const override { - return {memoryUtils::make_unique>(*this, this->size())}; - } - - - template - struct MDVecIdIterator : public MDBaseIdIterator { - private: - const MetaDataVec& _mdv; - size_t _i; - - public: - MDVecIdIterator(const MetaDataVec& mdv, size_t i) - : _mdv(mdv), _i(i) {} - - bool operator==(const MDBaseIdIterator& other) const override { - const MDVecIdIterator* dri = dynamic_cast*>(&other); - if (dri != nullptr) - return this->_i == dri->_i; - return false; - } - - size_t operator*() override { return _mdv.getRowId(_i); } - - void increment() override { this->_i++; } - - std::unique_ptr> clone() override { - return memoryUtils::make_unique>(_mdv, _i); - } - }; - - id_iterator id_begin() override { - return {memoryUtils::make_unique>(*this, 0)}; - } - - id_iterator id_end() override { - return {memoryUtils::make_unique>(*this, this->size())}; - } - - id_const_iterator id_begin() const override { - return {memoryUtils::make_unique>(*this, 0)}; - } - - id_const_iterator id_end() const override { - return {memoryUtils::make_unique>(*this, this->size())}; - } - - /** @} */ - - void fillConstant(MDLabel label, const String &value) override; - void fillRandom(MDLabel label, const String &mode, double op1, double op2, double op3=0.) override; - void fillLinear(MDLabel label, double initial, double step) override; - - void copyColumn(MDLabel labelDest, MDLabel labelSrc) override; - void copyColumnTo(MetaData& md, MDLabel labelDest, MDLabel labelSrc) override; - - void renameColumn(MDLabel oldLabel, MDLabel newLabel) override; - void renameColumn(const std::vector &oldLabel, - const std::vector &newLabel) override; - - bool operator==(const MetaDataVec& op) const; -};//class MetaDataVec - -std::ostream& operator<<(std::ostream& o, const MetaDataVec& md); - -#endif diff --git a/src/core/metadata_writemode.h b/src/core/metadata_writemode.h deleted file mode 100644 index b16a103..0000000 --- a/src/core/metadata_writemode.h +++ /dev/null @@ -1,38 +0,0 @@ -/*************************************************************************** - * - * Authors: David Strelak (davidstrelak@gmail.com) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_METADATA_WRITEMODE_H_ -#define CORE_METADATA_WRITEMODE_H_ - -/** Write mode - */ -typedef enum -{ - MD_OVERWRITE, //forget about the old file and overwrite it - MD_APPEND //append a data_ at the file end or replace an existing one -} WriteModeMetaData; - - -#endif /* CORE_METADATA_WRITEMODE_H_ */ diff --git a/src/core/multidim_array.cpp b/src/core/multidim_array.cpp deleted file mode 100644 index 9eac731..0000000 --- a/src/core/multidim_array.cpp +++ /dev/null @@ -1,1182 +0,0 @@ -/*************************************************************************** - * - * Authors: Carlos Oscar S. Sorzano (coss@cnb.csic.es) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include -#include -#include "bilib/kernel.h" -#include "matrix2d.h" -#include "multidim_array.h" -#include "multidim_array_base.h" -#include "numerical_recipes.h" -#include "xmipp_funcs.h" -#include "xmipp_filename.h" -#include "utils/half.hpp" - -template -void MultidimArray::getSliceAsMatrix(size_t k, Matrix2D &m) const -{ -// there's wrong bracket somewhere, and I don't want to think about it now -// m.resizeNoCopy(YSIZE(*this),XSIZE(*this)); -// memcpy(&MAT_ELEM(m,0,0),&A3D_ELEM(*this,k,0,0),YSIZE(*this),XSIZE(*this)*sizeof(double)); - REPORT_ERROR(ERR_NOT_IMPLEMENTED,"Please contact developers"); -} - -template -MultidimArray& MultidimArray::operator=(const Matrix2D& op1) -{ - resizeNoCopy(MAT_YSIZE(op1), MAT_XSIZE(op1)); - memcpy(data,MATRIX2D_ARRAY(op1), MAT_SIZE(op1)*sizeof(T)); - - return *this; -} - -template -void MultidimArray::copy(Matrix2D& op1) const -{ - op1.resizeNoCopy(YSIZE(*this), XSIZE(*this)); - memcpy(MATRIX2D_ARRAY(op1), MULTIDIM_ARRAY(*this), MULTIDIM_SIZE(*this)*sizeof(T)); -} - - - -// Window in 2D ----------------------------------------------------------- -template -void window2D(const MultidimArray &Ibig, MultidimArray &Ismall, - size_t y0, size_t x0, size_t yF, size_t xF) -{ - Ismall.resizeNoCopy(yF - y0 + 1, xF - x0 + 1); - STARTINGY(Ismall) = y0; - STARTINGX(Ismall) = x0; - /* - FOR_ALL_ELEMENTS_IN_ARRAY2D(Ismall) - A2D_ELEM(Ismall, i, j) = A2D_ELEM(Ibig, i, j); - */ - size_t sizeToCopy=XSIZE(Ismall)*sizeof(T); - for (int y=y0; y<=yF; y++) - memcpy( &A2D_ELEM(Ismall,y,STARTINGX(Ismall)), &A2D_ELEM(Ibig,y,STARTINGX(Ismall)), sizeToCopy); -} - -template void window2D(const MultidimArray &Ibig, MultidimArray &Ismall, size_t y0, size_t x0, size_t yF, size_t xF); -template void window2D(const MultidimArray &Ibig, MultidimArray &Ismall, size_t y0, size_t x0, size_t yF, size_t xF); - -// Show a complex array --------------------------------------------------- -template<> -std::ostream& operator<<(std::ostream& ostrm, - const MultidimArray< std::complex >& v) -{ - if (v.xdim == 0) - ostrm << "NULL MultidimArray\n"; - else - ostrm << std::endl; - - for (size_t l = 0; l < NSIZE(v); l++) - { - if (NSIZE(v)>1) - ostrm << "Image No. " << l << std::endl; - for (int k = STARTINGZ(v); k <= FINISHINGZ(v); k++) - { - if (ZSIZE(v)>1) - ostrm << "Slice No. " << k << std::endl; - for (int i = STARTINGY(v); i <= FINISHINGY(v); i++) - { - for (int j = STARTINGX(v); j <= FINISHINGX(v); j++) - ostrm << A3D_ELEM(v, k, i, j) << ' '; - ostrm << std::endl; - } - } - } - - return ostrm; -} - -template<> -void MultidimArray< std::complex< double > >::computeDoubleMinMax(double& minval, double& maxval) const -{ - REPORT_ERROR(ERR_NOT_IMPLEMENTED,"MultidimArray::computeDoubleMinMax not implemented for complex."); -} -template<> -void MultidimArray< std::complex< double > >::computeDoubleMinMaxRange(double& minval, double& maxval, size_t pos, size_t size) const -{ - REPORT_ERROR(ERR_NOT_IMPLEMENTED,"MultidimArray::computeDoubleMinMax not implemented for complex."); -} -template<> -void MultidimArray< std::complex< double > >::rangeAdjust(std::complex< double > minF, std::complex< double > maxF) -{ - REPORT_ERROR(ERR_NOT_IMPLEMENTED,"MultidimArray::rangeAdjust not implemented for complex."); -} - -template<> -double MultidimArray< std::complex< double > >::computeAvg() const -{ - REPORT_ERROR(ERR_NOT_IMPLEMENTED,"MultidimArray::computeAvg not implemented for complex."); -} - -template<> -void MultidimArray< std::complex< double > >::maxIndex(size_t &lmax, int& kmax, int& imax, int& jmax) const -{ - REPORT_ERROR(ERR_NOT_IMPLEMENTED,"MultidimArray::maxIndex not implemented for complex."); -} - -// void MultidimArray::selfNormalizeInterval(double minPerc, double maxPerc, int Npix) -// { -// std::vector randValues; // Vector with random chosen values - -// for(int i=0, i -bool operator==(const MultidimArray< std::complex< double > >& op1, const MultidimArray< std::complex< double > >& op2) -{ - double accuracy = XMIPP_EQUAL_ACCURACY; - if (! op1.sameShape(op2) || op1.data==NULL || op2.data == NULL) - return false; - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY(op1) - if ( fabs(DIRECT_MULTIDIM_ELEM(op1,n).real() - - DIRECT_MULTIDIM_ELEM(op2,n).real() > accuracy) - || - fabs(DIRECT_MULTIDIM_ELEM(op1,n).imag() - - DIRECT_MULTIDIM_ELEM(op2,n).imag() > accuracy) - ) - return false; - return true; -} - -template<> -void MultidimArray< std::complex< double > >::getReal(MultidimArray & realImg) const -{ - if (NZYXSIZE(*this) == 0) - { - realImg.clear(); - return; - } - - realImg.resizeNoCopy(*this); - double * ptr1 = (double*) MULTIDIM_ARRAY(*this); - - // Unroll the loop - const size_t unroll=4; - size_t nmax=(NZYXSIZE(*this)/unroll)*unroll; - for (size_t n=0; n(*ptr1++); - ptr1++; - DIRECT_MULTIDIM_ELEM(realImg, n+1) = static_cast(*(ptr1++)); - ptr1++; - DIRECT_MULTIDIM_ELEM(realImg, n+2) = static_cast(*(ptr1++)); - ptr1++; - DIRECT_MULTIDIM_ELEM(realImg, n+3) = static_cast(*(ptr1++)); - ptr1++; - } - // Do the remaining elements - for (size_t n=nmax; n(*ptr1++); - ptr1++; - } - -} - -template<> -void MultidimArray< std::complex< double > >::getImag(MultidimArray & imagImg) const -{ - if (NZYXSIZE(*this) == 0) - { - imagImg.clear(); - return; - } - - imagImg.resizeNoCopy(*this); - double * ptr1 = (double*) MULTIDIM_ARRAY(*this); - - // Unroll the loop - const size_t unroll=4; - size_t nmax=(NZYXSIZE(*this)/unroll)*unroll; - for (size_t n=0; n(*(++ptr1)); - ptr1++; - DIRECT_MULTIDIM_ELEM(imagImg, n+1) = static_cast(*(++ptr1)); - ptr1++; - DIRECT_MULTIDIM_ELEM(imagImg, n+2) = static_cast(*(++ptr1)); - ptr1++; - DIRECT_MULTIDIM_ELEM(imagImg, n+3) = static_cast(*(++ptr1)); - ptr1++; - } - // Do the remaining elements - for (size_t n=nmax; n(*(++ptr1)); - ptr1++; - } - -} - - -template<> -double MultidimArray::interpolatedElement2D(double x, double y, double outside_value) const -{ - double dx0 = floor(x); - int x0=(int)dx0; - double fx = x - dx0; - int x1 = x0 + 1; - double dy0 = floor(y); - int y0=(int)dy0; - double fy = y - dy0; - int y1 = y0 + 1; - - int i0=STARTINGY(*this); - int j0=STARTINGX(*this); - int iF=FINISHINGY(*this); - int jF=FINISHINGX(*this); - - /* Next code avoids checking two times some variables that are doubles. - * The code before was: - ASSIGNVAL2D(d00,y0,x0); - ASSIGNVAL2D(d01,y0,x1); - ASSIGNVAL2D(d10,y1,x0); - ASSIGNVAL2D(d11,y1,x1); - */ - double d00, d10, d11, d01, *ref; - if ((x0 >= j0) && (x1 <= jF) && (y0 >= i0) && (y1 <= iF)) - { - ref = &A2D_ELEM(*this, y0, x0); - d00 = (*ref++); - d01 = (*ref); - ref = &A2D_ELEM(*this, y1, x0); - d10 = (*ref++); - d11 = (*ref); - } - else - { - bool outX0,outX1,outY0,outY1; - outX0 = (x0 < j0) || (x0 > jF); - outX1 = (x1 < j0) || (x1 > jF); - outY0 = (y0 < i0) || (y0 > iF); - outY1 = (y1 < i0) || (y1 > iF); - - if (outY0) - { - d00 = outside_value; - d01 = outside_value; - d10 = outside_value; - d11 = outside_value; - } - else if(outY1) - { - d10 = outside_value; - d11 = outside_value; - - if (outX0) - { - d00 = outside_value; - d01 = outside_value; - } - else - { - d00 = A2D_ELEM(*this, y0, x0); - if (outX1) - { - d01 = outside_value; - } - else - { - d01 = A2D_ELEM(*this, y0, x1); - } - } - } - else - { - if (outX0) - { - d00 = outside_value; - d10 = outside_value; - d01 = outside_value; - d11 = outside_value; - } - else - { - if (outX1) - { - d01 = outside_value; - d11 = outside_value; - } - else - { - d01 = A2D_ELEM(*this, y0, x1); - d11 = A2D_ELEM(*this, y1, x1); - } - - d00 = A2D_ELEM(*this, y0, x0); - d10 = A2D_ELEM(*this, y1, x0); - } - } - } - - double d0 = LIN_INTERP(fx, d00, d01); - double d1 = LIN_INTERP(fx, d10, d11); - return LIN_INTERP(fy, d0, d1); -} - -void sincos(const MultidimArray &x, MultidimArray &s, MultidimArray &c) -{ - s.resizeNoCopy(x); - c.resizeNoCopy(x); - double *ptr=NULL; - double *ptrS=MULTIDIM_ARRAY(s); - double *ptrC=MULTIDIM_ARRAY(c); - size_t n; - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(x,n,ptr) - sincos(*ptr, ptrS++,ptrC++); -} - - -void planeFit(const MultidimArray &z, const MultidimArray &x, const MultidimArray &y, - double &p0, double &p1, double &p2) -{ - if (MULTIDIM_SIZE(z)!=MULTIDIM_SIZE(y) || MULTIDIM_SIZE(z)!=MULTIDIM_SIZE(x)) - REPORT_ERROR(ERR_MULTIDIM_SIZE,"Not all vectors are of the same size"); - if (MULTIDIM_SIZE(z) < 10) - REPORT_ERROR(ERR_MULTIDIM_SIZE, "Not enough elements to compute Least Squares plane fit"); - - double m11=0, m12=0, m13=0, m21=0, m22=0, m23=0, m31=0, m32=0, m33=0; - double b1=0, b2=0, b3=0; - - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY(z) - { - double X=DIRECT_MULTIDIM_ELEM(x,n); - double Y=DIRECT_MULTIDIM_ELEM(y,n); - double Z=DIRECT_MULTIDIM_ELEM(z,n); - m11+=X*X; - m12+=X*Y; - m13+=X; - - m22+=Y*Y; - m23+=Y; - - b1+=X*Z; - b2+=Y*Z; - b3+=Z; - } - m21=m12; - m31=m13; - m32=m23; - m33=MULTIDIM_SIZE(z); - - Matrix2D A(3, 3); - Matrix1D b(3); - Matrix1D c(3); - - A(0,0)=m11; - A(0,1)=m12; - A(0,2)=m13; - A(1,0)=m21; - A(1,1)=m22; - A(1,2)=m23; - A(2,0)=m31; - A(2,1)=m32; - A(2,2)=m33; - - b(0)=b1; - b(1)=b2; - b(2)=b3; - - c = A.inv() * b; - p0 = c(2); - p2 = c(1); - p1 = c(0); -} - -template -T MultidimArray::interpolatedElementBSpline3D(double x, double y, double z, - int SplineDegree) const -{ - int SplineDegree_1 = SplineDegree - 1; - - // Logical to physical - z -= STARTINGZ(*this); - y -= STARTINGY(*this); - x -= STARTINGX(*this); - - int l1 = (int)ceil(x - SplineDegree_1); - int l2 = l1 + SplineDegree; - - int m1 = (int)ceil(y - SplineDegree_1); - int m2 = m1 + SplineDegree; - - int n1 = (int)ceil(z - SplineDegree_1); - int n2 = n1 + SplineDegree; - - double zyxsum = 0.0; - double aux; - int Xdim=(int)XSIZE(*this); - int Ydim=(int)YSIZE(*this); - int Zdim=(int)ZSIZE(*this); - for (int nn = n1; nn <= n2; nn++) - { - int equivalent_nn=nn; - if (nn<0) - equivalent_nn=-nn-1; - else if (nn>=Zdim) - equivalent_nn=2*Zdim-nn-1; - double yxsum = 0.0; - for (int m = m1; m <= m2; m++) - { - int equivalent_m=m; - if (m<0) - equivalent_m=-m-1; - else if (m>=Ydim) - equivalent_m=2*Ydim-m-1; - double xsum = 0.0; - for (int l = l1; l <= l2; l++) - { - double xminusl = x - (double) l; - int equivalent_l=l; - if (l<0) - equivalent_l=-l-1; - else if (l>=Xdim) - equivalent_l=2*Xdim-l-1; - double Coeff = (double) DIRECT_A3D_ELEM(*this, - equivalent_nn,equivalent_m,equivalent_l); - switch (SplineDegree) - { - case 2: - xsum += Coeff * Bspline02(xminusl); - break; - case 3: - BSPLINE03(aux,xminusl); - xsum += Coeff * aux; - break; - case 4: - xsum += Coeff * Bspline04(xminusl); - break; - case 5: - xsum += Coeff * Bspline05(xminusl); - break; - case 6: - xsum += Coeff * Bspline06(xminusl); - break; - case 7: - xsum += Coeff * Bspline07(xminusl); - break; - case 8: - xsum += Coeff * Bspline08(xminusl); - break; - case 9: - xsum += Coeff * Bspline09(xminusl); - break; - } - } - - double yminusm = y - (double) m; - switch (SplineDegree) - { - case 2: - yxsum += xsum * Bspline02(yminusm); - break; - case 3: - BSPLINE03(aux,yminusm); - yxsum += xsum * aux; - break; - case 4: - yxsum += xsum * Bspline04(yminusm); - break; - case 5: - yxsum += xsum * Bspline05(yminusm); - break; - case 6: - yxsum += xsum * Bspline06(yminusm); - break; - case 7: - yxsum += xsum * Bspline07(yminusm); - break; - case 8: - yxsum += xsum * Bspline08(yminusm); - break; - case 9: - yxsum += xsum * Bspline09(yminusm); - break; - } - } - - double zminusn = z - (double) nn; - switch (SplineDegree) - { - case 2: - zyxsum += yxsum * Bspline02(zminusn); - break; - case 3: - BSPLINE03(aux,zminusn); - zyxsum += yxsum * aux; - break; - case 4: - zyxsum += yxsum * Bspline04(zminusn); - break; - case 5: - zyxsum += yxsum * Bspline05(zminusn); - break; - case 6: - zyxsum += yxsum * Bspline06(zminusn); - break; - case 7: - zyxsum += yxsum * Bspline07(zminusn); - break; - case 8: - zyxsum += yxsum * Bspline08(zminusn); - break; - case 9: - zyxsum += yxsum * Bspline09(zminusn); - break; - } - } - - return (T) zyxsum; -} - -template -T MultidimArray::interpolatedElementBSpline2D(double x, double y, int SplineDegree) const -{ - int SplineDegree_1 = SplineDegree - 1; - - // Logical to physical - y -= STARTINGY(*this); - x -= STARTINGX(*this); - - int l1 = (int)ceil(x - SplineDegree_1); - int l2 = l1 + SplineDegree; - int m1 = (int)ceil(y - SplineDegree_1); - int m2 = m1 + SplineDegree; - - double columns = 0.0; - double aux; - int Ydim=(int)YSIZE(*this); - int Xdim=(int)XSIZE(*this); - for (int m = m1; m <= m2; m++) - { - int equivalent_m=m; - if (m<0) - equivalent_m=-m-1; - else if (m>=Ydim) - equivalent_m=2*Ydim-m-1; - double rows = 0.0; - for (int l = l1; l <= l2; l++) - { - double xminusl = x - (double) l; - int equivalent_l=l; - if (l<0) - equivalent_l=-l-1; - else if (l>=Xdim) - equivalent_l=2*Xdim-l-1; - double Coeff = DIRECT_A2D_ELEM(*this, equivalent_m,equivalent_l); - switch (SplineDegree) - { - case 2: - rows += Coeff * Bspline02(xminusl); - break; - - case 3: - BSPLINE03(aux,xminusl); - rows += Coeff * aux; - break; - - case 4: - rows += Coeff * Bspline04(xminusl); - break; - - case 5: - rows += Coeff * Bspline05(xminusl); - break; - - case 6: - rows += Coeff * Bspline06(xminusl); - break; - - case 7: - rows += Coeff * Bspline07(xminusl); - break; - - case 8: - rows += Coeff * Bspline08(xminusl); - break; - - case 9: - rows += Coeff * Bspline09(xminusl); - break; - } - } - - double yminusm = y - (double) m; - switch (SplineDegree) - { - case 2: - columns += rows * Bspline02(yminusm); - break; - - case 3: - BSPLINE03(aux,yminusm); - columns += rows * aux; - break; - - case 4: - columns += rows * Bspline04(yminusm); - break; - - case 5: - columns += rows * Bspline05(yminusm); - break; - - case 6: - columns += rows * Bspline06(yminusm); - break; - - case 7: - columns += rows * Bspline07(yminusm); - break; - - case 8: - columns += rows * Bspline08(yminusm); - break; - - case 9: - columns += rows * Bspline09(yminusm); - break; - } - } - return (T) columns; -} - -template -T MultidimArray::interpolatedElementBSpline2D_Degree3(double x, double y) const -{ - bool firstTime=true; // Inner loop first time execution flag. - double *ref; - - // Logical to physical - y -= STARTINGY(*this); - x -= STARTINGX(*this); - - int l1 = (int)ceil(x - 2); - int l2 = l1 + 3; - int m1 = (int)ceil(y - 2); - int m2 = m1 + 3; - - double columns = 0.0; - double aux; - int Ydim=(int)YSIZE(*this); - int Xdim=(int)XSIZE(*this); - - int equivalent_l_Array[LOOKUP_TABLE_LEN]; // = new int [l2 - l1 + 1]; - double aux_Array[LOOKUP_TABLE_LEN];// = new double [l2 - l1 + 1]; - - for (int m = m1; m <= m2; m++) - { - int equivalent_m=m; - if (m<0) - equivalent_m=-m-1; - else if (m>=Ydim) - equivalent_m=2*Ydim-m-1; - double rows = 0.0; - int index=0; - ref = &DIRECT_A2D_ELEM(*this, equivalent_m,0); - for (int l = l1; l <= l2; l++) - { - int equivalent_l; - // Check if it is first time executing inner loop. - if (firstTime) - { - double xminusl = x - (double) l; - equivalent_l=l; - if (l<0) - { - equivalent_l=-l-1; - } - else if (l>=Xdim) - { - equivalent_l=2*Xdim-l-1; - } - - equivalent_l_Array[index] = equivalent_l; - BSPLINE03(aux,xminusl); - aux_Array[index] = aux; - index++; - } - else - { - equivalent_l = equivalent_l_Array[index]; - aux = aux_Array[index]; - index++; - } - - //double Coeff = DIRECT_A2D_ELEM(*this, equivalent_m,equivalent_l); - double Coeff = ref[equivalent_l]; - rows += Coeff * aux; - } - - // Set first time inner flag is executed to false. - firstTime = false; - - double yminusm = y - (double) m; - BSPLINE03(aux,yminusm); - columns += rows * aux; - } - - return (T) columns; -} - -template -T MultidimArray::interpolatedElementBSpline1D(double x, int SplineDegree) const -{ - int SplineDegree_1 = SplineDegree - 1; - - // Logical to physical - x -= STARTINGX(*this); - - int l1 = (int)ceil(x - SplineDegree_1); - int l2 = l1 + SplineDegree; - int Xdim=(int)XSIZE(*this); - double sum = 0.0; - for (int l = l1; l <= l2; l++) - { - double xminusl = x - (double) l; - int equivalent_l=l; - if (l<0) - equivalent_l=-l-1; - else if (l>=Xdim) - equivalent_l=2*Xdim-l-1; - double Coeff = (double) DIRECT_A1D_ELEM(*this, equivalent_l); - double aux; - switch (SplineDegree) - { - case 2: - sum += Coeff * Bspline02(xminusl); - break; - - case 3: - BSPLINE03(aux,xminusl); - sum += Coeff * aux; - break; - - case 4: - sum += Coeff * Bspline04(xminusl); - break; - - case 5: - sum += Coeff * Bspline05(xminusl); - break; - - case 6: - sum += Coeff * Bspline06(xminusl); - break; - - case 7: - sum += Coeff * Bspline07(xminusl); - break; - - case 8: - sum += Coeff * Bspline08(xminusl); - break; - - case 9: - sum += Coeff * Bspline09(xminusl); - break; - } - } - return (T) sum; -} - -template -void MultidimArray::initRandom(double op1, double op2, RandomMode mode) -{ - T* ptr=NULL; - size_t n; - if (mode == RND_UNIFORM) - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(*this,n,ptr) - *ptr = static_cast< T >(rnd_unif(op1, op2)); - else if (mode == RND_GAUSSIAN) - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(*this,n,ptr) - *ptr = static_cast< T >(rnd_gaus(op1, op2)); - else - REPORT_ERROR(ERR_VALUE_INCORRECT, - formatString("InitRandom: Mode not supported")); -} - -template -void MultidimArray::addNoise(double op1, - double op2, - const String& mode, - double df) const -{ - T* ptr=NULL; - size_t n; - if (mode == "uniform") - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(*this,n,ptr) - *ptr += static_cast< T >(rnd_unif(op1, op2)); - else if (mode == "gaussian") - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(*this,n,ptr) - *ptr += static_cast< T >(rnd_gaus(op1, op2)); - else if (mode == "student") - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(*this,n,ptr) - *ptr += static_cast< T >(rnd_student_t(df, op1, op2)); - else - REPORT_ERROR(ERR_VALUE_INCORRECT, - formatString("AddNoise: Mode not supported (%s)", mode.c_str())); -} - -template -FILE* MultidimArray::mmapFile(T* &_data, size_t nzyxDim) const -{ -#ifdef XMIPP_MMAP - FILE* fMap = tmpfile(); - int Fd = fileno(fMap); - - if ((lseek(Fd, nzyxDim*sizeof(T)-1, SEEK_SET) == -1) || (::write(Fd,"",1) == -1)) - { - fclose(fMap); - REPORT_ERROR(ERR_IO_NOWRITE,"MultidimArray::resize: Error 'stretching' the map file."); - } - if ( (_data = (T*) mmap(0,nzyxDim*sizeof(T), PROT_READ | PROT_WRITE, MAP_SHARED, Fd, 0)) == (void*) MAP_FAILED ) - REPORT_ERROR(ERR_MMAP_NOTADDR,formatString("MultidimArray::resize: mmap failed. Error %s", strerror(errno))); - - return fMap; -#else - - REPORT_ERROR(ERR_MMAP,"Mapping not supported in Windows"); -#endif - -} - -template -void MultidimArray::indexSort(MultidimArray< int > &indx) const -{ - checkDimension(1); - - MultidimArray< double > temp; - indx.clear(); - - if (xdim == 0) - return; - - if (xdim == 1) - { - indx.resizeNoCopy(1); - DIRECT_A1D_ELEM(indx,0) = 1; - return; - } - - // Initialise data - indx.resizeNoCopy(xdim); - typeCast(*this, temp); - - // Sort indexes - double* temp_array = temp.adaptForNumericalRecipes1D(); - int* indx_array = indx.adaptForNumericalRecipes1D(); - indexx(XSIZE(*this), temp_array, indx_array); -} - -template -void MultidimArray::selfNormalizeInterval(double minPerc, double maxPerc, int Npix) -{ - std::vector randValues; // Vector with random chosen values - - for(int i=0; i -void MultidimArray::showWithGnuPlot(const String& xlabel, const String& title) -{ - checkDimension(1); - - FileName fn_tmp; - fn_tmp.initRandom(10); - const char * fnStr = fn_tmp.c_str(); - MultidimArray::write(formatString("PPP%s.txt", fnStr)); - - std::ofstream fh_gplot; - fh_gplot.open(formatString("PPP%s.gpl", fnStr).c_str()); - if (!fh_gplot) - REPORT_ERROR(ERR_IO_NOTOPEN, - formatString("vector::showWithGnuPlot: Cannot open PPP%s.gpl for output", fnStr)); - fh_gplot << "set xlabel \"" + xlabel + "\"\n"; - fh_gplot << "plot \"PPP" + fn_tmp + ".txt\" title \"" + title + - "\" w l\n"; - fh_gplot << "pause 300 \"\"\n"; - fh_gplot.close(); - if (0 != system(formatString("(gnuplot PPP%s.gpl; rm PPP%s.txt PPP%s.gpl) &", fnStr, fnStr, fnStr).c_str()) ) { - REPORT_ERROR(ERR_IO, "Cannot open gnuplot"); - } -} - -template -void MultidimArray::edit() -{ - FileName nam; - nam.initRandom(15); - - nam = formatString("PPP%s.txt", nam.c_str()); - write(nam); - - if (0 != system(formatString("xmipp_edit -i %s -remove &", nam.c_str()).c_str())) { - REPORT_ERROR(ERR_IO, "Cannot open xmipp_edit"); - } -} - -template -void MultidimArray::write(const FileName& fn) const -{ - std::ofstream out; - out.open(fn.c_str(), std::ios::out); - if (!out) - REPORT_ERROR(ERR_IO_NOTOPEN, - formatString("MultidimArray::write: File %s cannot be opened for output", fn.c_str())); - - out << *this; - out.close(); -} - -template -void MultidimArray::resize(size_t Ndim, size_t Zdim, size_t Ydim, size_t Xdim, bool copy) -{ - if (Ndim*Zdim*Ydim*Xdim == nzyxdimAlloc && data != NULL) - { - ndim = Ndim; - xdim = Xdim; - ydim = Ydim; - zdim = Zdim; - yxdim = Ydim * Xdim; - zyxdim = Zdim * yxdim; - nzyxdim = Ndim * zyxdim; - return; - } - else if (!destroyData) - REPORT_ERROR(ERR_MULTIDIM_SIZE, "Cannot resize array when accessing through alias."); - - if (Xdim <= 0 || Ydim <= 0 || Zdim <= 0 || Ndim <= 0) - { - clear(); - return; - } - - // data can be NULL while xdim etc are set to non-zero values - // (This can happen for reading of images...) - // In that case, initialize data to zeros. - if (NZYXSIZE(*this) > 0 && data == NULL) - { - ndim = Ndim; - xdim = Xdim; - ydim = Ydim; - zdim = Zdim; - yxdim = Ydim * Xdim; - zyxdim = Zdim * yxdim; - nzyxdim = Ndim * zyxdim; - - coreAllocate(); - return; - } - - // Ask for memory - size_t YXdim=(size_t)Ydim*Xdim; - size_t ZYXdim=YXdim*Zdim; - size_t NZYXdim=ZYXdim*Ndim; - FILE* new_mFd=NULL; - - T * new_data=NULL; - - try - { - if (mmapOn) - new_mFd = mmapFile(new_data, NZYXdim); - else - new_data = new T [NZYXdim]; - - memset(new_data,0,NZYXdim*sizeof(T)); - } - catch (std::bad_alloc &) - { - if (!mmapOn) - { - setMmap(true); - resize(Ndim, Zdim, Ydim, Xdim, copy); - return; - } - else - { - std::ostringstream sstream; - sstream << "Allocate: No space left to allocate "; - sstream << (NZYXdim * sizeof(T)/1024/1024/1024) ; - sstream << "Gb." ; - REPORT_ERROR(ERR_MEM_NOTENOUGH, sstream.str()); - } - } - // Copy needed elements, fill with 0 if necessary - if (copy) - { - const auto nCopy = std::min(Ndim, NSIZE(*this)); - const auto zCopy = std::min(Zdim, ZSIZE(*this)); - const auto yCopy = std::min(Ydim, YSIZE(*this)); - const auto xCopy = std::min(Xdim, XSIZE(*this)); - const auto xCopyBytes = xCopy*sizeof(T); - - for (size_t l = 0; l < nCopy; ++l) - for (size_t k = 0; k < zCopy; ++k) - for (size_t i = 0; i < yCopy; ++i) - memcpy( - new_data + l*ZYXdim + k*YXdim + i*Xdim, - data + l*zyxdim + k*yxdim + i*xdim, - xCopyBytes - ); - } - - // deallocate old array - coreDeallocate(); - - // assign *this vector to the newly created - data = new_data; - ndim = Ndim; - xdim = Xdim; - ydim = Ydim; - zdim = Zdim; - yxdim = Ydim * Xdim; - zyxdim = Zdim * yxdim; - nzyxdim = Ndim * zyxdim; - mFd = new_mFd; - nzyxdimAlloc = nzyxdim; -} - -template -void MultidimArray::sort(MultidimArray &result) const -{ - result = *this; - std::sort(result.data, result.data + result.nzyxdim); -} - -template -void MultidimArray::computeMedian_within_binary_mask(const MultidimArray< int >& mask, double& median) const -{ - std::vector bgI; - - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY(*this) - { - if (DIRECT_MULTIDIM_ELEM(mask, n) != 0) - { - double aux = DIRECT_MULTIDIM_ELEM(*this, n); - bgI.push_back(aux); - } - } - - std::sort(bgI.begin(), bgI.end()); - if (bgI.size() % 2 != 0) - median = bgI[bgI.size() / 2]; - else - median = (bgI[(bgI.size() - 1) / 2] + bgI[bgI.size() / 2]) / 2.0; -} - -template -void MultidimArray::randomSubstitute(T oldv, - T avgv, - T sigv, - double accuracy, - MultidimArray * mask) -{ - T* ptr=NULL; - size_t n; - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(*this,n,ptr) - if (mask == NULL || DIRECT_MULTIDIM_ELEM(*mask,n) > 0 ) - if (ABS(*ptr - oldv) <= accuracy) - *ptr = rnd_gaus(avgv, sigv); -} - -// explicit instantiation -template class MultidimArray; - -// mmapFile -template FILE* MultidimArray::mmapFile(bool*&, unsigned long) const; -template FILE* MultidimArray::mmapFile(float*&, unsigned long) const; -template FILE* MultidimArray::mmapFile(char*&, unsigned long) const; -template FILE* MultidimArray::mmapFile(int*&, unsigned long) const; -template FILE* MultidimArray::mmapFile(long*&, unsigned long) const; -template FILE* MultidimArray::mmapFile(short*&, unsigned long) const; -template FILE* MultidimArray::mmapFile(unsigned char*&, unsigned long) const; -template FILE* MultidimArray::mmapFile(unsigned int*&, unsigned long) const; -template FILE* MultidimArray::mmapFile(unsigned long*&, unsigned long) const; -template FILE* MultidimArray::mmapFile(unsigned short*&, unsigned long) const; -template FILE* MultidimArray>::mmapFile(std::complex*&, unsigned long) const; -template FILE* MultidimArray::mmapFile(half_float::half*&, unsigned long) const; - -// resize -template void MultidimArray::resize(unsigned long, unsigned long, unsigned long, unsigned long, bool); -template void MultidimArray::resize(unsigned long, unsigned long, unsigned long, unsigned long, bool); -template void MultidimArray::resize(unsigned long, unsigned long, unsigned long, unsigned long, bool); -template void MultidimArray::resize(unsigned long, unsigned long, unsigned long, unsigned long, bool); -template void MultidimArray::resize(unsigned long, unsigned long, unsigned long, unsigned long, bool); -template void MultidimArray::resize(unsigned long, unsigned long, unsigned long, unsigned long, bool); -template void MultidimArray::resize(unsigned long, unsigned long, unsigned long, unsigned long, bool); -template void MultidimArray::resize(unsigned long, unsigned long, unsigned long, unsigned long, bool); -template void MultidimArray::resize(unsigned long, unsigned long, unsigned long, unsigned long, bool); -template void MultidimArray::resize(unsigned long, unsigned long, unsigned long, unsigned long, bool); -template void MultidimArray>::resize(unsigned long, unsigned long, unsigned long, unsigned long, bool); -template void MultidimArray::resize(unsigned long, unsigned long, unsigned long, unsigned long, bool); - -// index sort -template void MultidimArray::indexSort(MultidimArray&) const; -template void MultidimArray::indexSort(MultidimArray&) const; - -// init random -template void MultidimArray::initRandom(double, double, RandomMode); -template void MultidimArray::initRandom(double, double, RandomMode); -template void MultidimArray::initRandom(double, double, RandomMode); -template void MultidimArray::initRandom(double, double, RandomMode); -template void MultidimArray::initRandom(double, double, RandomMode); -template void MultidimArray::initRandom(double, double, RandomMode); -template void MultidimArray::initRandom(double, double, RandomMode); -template void MultidimArray::initRandom(double, double, RandomMode); -template void MultidimArray::initRandom(double, double, RandomMode); -template void MultidimArray::initRandom(double, double, RandomMode); - -// write -template void MultidimArray::write(FileName const&) const; diff --git a/src/core/multidim_array.h b/src/core/multidim_array.h deleted file mode 100644 index 50fa748..0000000 --- a/src/core/multidim_array.h +++ /dev/null @@ -1,4076 +0,0 @@ -/*************************************************************************** - * - * Authors: Carlos Oscar S. Sorzano (coss@cnb.csic.es) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_MULTIDIM_ARRAY_H -#define CORE_MULTIDIM_ARRAY_H - -#include "xmipp_macros.h" // to define XMIPP_MMAP -#ifdef XMIPP_MMAP -#include -#endif -#include -#include "matrix1d.h" -#include "xmipp_random_mode.h" -#include "multidim_array_base.h" -#include "xmipp_memory.h" -#include "axis_view.h" - -template -class Matrix2D; - -extern int bestPrecision(float F, int _width); -extern String floatToString(float F, int _width, int _prec); - -/// @defgroup MultidimensionalArrays Multidimensional Arrays -/// @ingroup DataLibrary -//@{ - - -// Forward declarations ==================================================== -template -class MultidimArray; - -template -void coreArrayByScalar(const MultidimArray& op1, const T& op2, - MultidimArray& result, char operation); - -template -void coreScalarByArray(const T& op1, const MultidimArray& op2, - MultidimArray& result, char operation); - -template -void coreArrayByArray(const MultidimArray& op1, const MultidimArray& op2, - MultidimArray& result, char operation); -template -void selfCoreArrayByArrayMask(const MultidimArray& op1, const MultidimArray& op2, - MultidimArray& result, char operation, - const MultidimArray *mask); - - - - - -template -class MultidimArray: public MultidimArrayBase -{ -public: - /* The array itself. - The array is always a 3D array (Z,Y,X). For vectors the size of the array - is (1,1,X) and for matrices (1,Y,X). The pixel (i,j) (y,x) is at the - position data[i*Xdim+j] or data[y*Xdim+x] - */ - T* data; - -public: - /// @name Constructors - //@{ - - /** Empty constructor. - * The empty constructor creates an array with no memory associated, - * size=0. - */ - MultidimArray() - { - coreInit(); - } - - /** - * Size constructor with 4D size and already allocated data. - */ - MultidimArray(size_t Ndim, size_t Zdim, size_t Ydim, size_t Xdim, T *data) { - this->coreInit(); - this->setDimensions(Xdim, Ydim, Zdim, Ndim); - this->data = data; - this->nzyxdimAlloc = this->nzyxdim; - this->destroyData = false; - } - - - /** Size constructor with 4D size. - * The Size constructor creates an array with memory associated, - * and fills it with zeros. - */ - MultidimArray(size_t Ndim, int Zdim, int Ydim, int Xdim) - { - coreInit(); - coreAllocate(Ndim, Zdim, Ydim, Xdim); - } - - /** Size constructor with 3D size. - * The Size constructor creates an array with memory associated, - * and fills it with zeros. - */ - MultidimArray( int Zdim, int Ydim, int Xdim) - { - coreInit(); - coreAllocate(1UL, Zdim, Ydim, Xdim); - } - - /** Size constructor with 2D size. - * The Size constructor creates an array with memory associated, - * and fills it with zeros. - */ - MultidimArray(int Ydim, int Xdim) - { - coreInit(); - coreAllocate(1UL, 1, Ydim, Xdim); - } - - /** Size constructor with 1D size. - * The Size constructor creates an array with memory associated, - * and fills it with zeros. - */ - MultidimArray(int Xdim) - { - coreInit(); - coreAllocate(1UL, 1, 1, Xdim); - } - - /** Copy constructor - * - * The created volume is a perfect copy of the input array but with a - * different memory assignment. - * - * @code - * MultidimArray< double > V2(V1); - * @endcode - */ - MultidimArray(const MultidimArray& V) - { - coreInit(); - *this = V; - } - - /** Move constructor - * - * The created volume is a perfect copy of the input array but with a - * different memory assignment. - * - * @code - * MultidimArray< double > V2(V1); - * @endcode - */ - MultidimArray(MultidimArray&& V) noexcept - { - coreInit(); - swap(V); - } - - /** Copy constructor from a Matrix1D. - * The Size constructor creates an array with memory associated, - * and fills it with zeros. - */ - MultidimArray(const Matrix1D& V) - { - coreInit(); - coreAllocate(1, 1, 1, V.size()); - for (size_t i = 0; i < V.size(); i++) - DIRECT_A1D_ELEM(*this,i) = VEC_ELEM(V,i); - } - - /** Constructor from vector 1D - * This will create a MultidimArray 1D - * the size and elements will be copied from - * the std::vector - */ - MultidimArray(const std::vector &vector) - { - coreInit(); - coreAllocate(1, 1, 1, vector.size()); - for (size_t i = 0; i < vector.size(); i++) - DIRECT_A1D_ELEM(*this,i) = vector[i]; - } - - - /** Destructor. - */ - virtual ~MultidimArray() - { - coreDeallocate(); - } - - /** Clear. - */ - void clear() - { - coreDeallocate(); - coreInit(); - } - //@} - - /// @name Core memory operations - //@{ - - /** Core init. - * Initialize everything to 0 - */ - void coreInit() noexcept - { - xdim = yxdim = zyxdim = nzyxdim = 0; - ydim = zdim = ndim = 0; - zinit = yinit = xinit = 0; - data = NULL; - nzyxdimAlloc = 0; - destroyData = true; - mmapOn = false; - mFd = NULL; - } - - void swap(MultidimArray& other) noexcept - { - std::swap(xdim, other.xdim); - std::swap(ydim, other.ydim); - std::swap(zdim, other.zdim); - std::swap(ndim, other.ndim); - std::swap(yxdim, other.yxdim); - std::swap(zyxdim, other.zyxdim); - std::swap(nzyxdim, other.nzyxdim); - std::swap(xinit, other.xinit); - std::swap(yinit, other.yinit); - std::swap(zinit, other.zinit); - std::swap(data, other.data); - std::swap(nzyxdimAlloc, other.nzyxdimAlloc); - std::swap(destroyData, other.destroyData); - std::swap(mmapOn, other.mmapOn); - std::swap(mFd, other.mFd); - } - - /** Core allocate with dimensions. - */ - void coreAllocate(size_t _ndim, int _zdim, int _ydim, int _xdim) - { - if (_ndim <= 0 || _zdim <= 0 || _ydim<=0 || _xdim<=0) - { - clear(); - return; - } - if(data!=NULL) - REPORT_ERROR(ERR_MEM_NOTDEALLOC, "do not allocate space for an image if you have not deallocate it first"); - - ndim=_ndim; - zdim=_zdim; - ydim=_ydim; - xdim=_xdim; - yxdim=(size_t)ydim*xdim; - zyxdim=yxdim*zdim; - nzyxdim=zyxdim*ndim; - - coreAllocate(); - } - - /** Core allocate without dimensions. - * - * It is supposed the dimensions are set previously with setXdim(x), setYdim(y) - * setZdim(z), setNdim(n) or with setDimensions(Xdim, Ydim, Zdim, Ndim); - * - */ - void coreAllocate() - { - if(data!=NULL) - REPORT_ERROR(ERR_MEM_NOTDEALLOC, "do not allocate space for an image if you have not deallocate it first"); - - if (mmapOn) - mFd = mmapFile(data, nzyxdim); - else - { - try - { - data = new T [nzyxdim]; - if (data == NULL) - { - setMmap(true); - mFd = mmapFile(data, nzyxdim); - } - } - catch (std::bad_alloc &) - { - setMmap(true); - mFd = mmapFile(data, nzyxdim); - } - } - memset(data,0,nzyxdim*sizeof(T)); - nzyxdimAlloc = nzyxdim; - } - - /** Core allocate without dimensions. - * - * It is supposed the dimensions are set previously with setXdim(x), setYdim(y) - * setZdim(z), setNdim(n) or with setDimensions(Xdim, Ydim, Zdim, Ndim); - * - */ - void coreAllocateReuse() - { - if(data != NULL && nzyxdim <= nzyxdimAlloc) - return; - else if (nzyxdim > nzyxdimAlloc) - coreDeallocate(); - - if (mmapOn) - mFd = mmapFile(data, nzyxdim); - else - { - data = new T [nzyxdim]; - if (data == NULL) - REPORT_ERROR(ERR_MEM_NOTENOUGH, "Allocate: No space left"); - } - memset(data,0,nzyxdim*sizeof(T)); - nzyxdimAlloc = nzyxdim; - } - - /* Create a temporary file to mmap the data. - */ - FILE* mmapFile(T* &_data, size_t nzyxDim) const; - - /** Core deallocate. - * Free all data. - */ - void coreDeallocate() noexcept - { - if (data != NULL && destroyData) - { - if (mmapOn) - { -#ifdef XMIPP_MMAP - munmap(data,nzyxdimAlloc*sizeof(T)); - fclose(mFd); -#else - - REPORT_ERROR(ERR_MMAP,"Mapping not supported in Windows"); -#endif - - } - else - delete[] data; - } - data = NULL; - destroyData = true; - nzyxdimAlloc = 0; - } - - /** Alias a multidimarray. - * - * Treat the multidimarray as if it were a volume. The data is not copied - * into new memory, but a pointer to the multidimarray is copied. - * You should not make any operation on this volume such that the - * memory locations are changed - */ - void alias(const MultidimArray &m) - { - coreDeallocate(); - copyShape(m); - this->data=m.data; - this->nzyxdimAlloc = this->nzyxdim; - this->destroyData = false; - } - - /** Alias a row in an image. - * - * Treat the multidimarray as if it were a single slice. The data is not copied - * into new memory, but a pointer to the selected slice in the multidimarray is copied. - * You should not make any operation on this volume such that the - * memory locations are changed. - * Select_slice starts at 0 towards Zsize. - */ - void aliasRow(const MultidimArray &m, size_t select_row) - { - if (select_row >= YSIZE(m)) - REPORT_ERROR(ERR_MULTIDIM_SIZE, "aliasRow: Selected row cannot be higher than Y size."); - - coreDeallocate(); - setDimensions(XSIZE(m),1, 1, 1); - this->data = m.data + XSIZE(m)*select_row; - this->nzyxdimAlloc = this->nzyxdim; - this->destroyData = false; - } - - /** Alias a slice in a multidimarray. - * - * Treat the multidimarray as if it were a single slice. The data is not copied - * into new memory, but a pointer to the selected slice in the multidimarray is copied. - * You should not make any operation on this volume such that the - * memory locations are changed. - * Select_slice starts at 0 towards Zsize. - */ - void aliasSlice(const MultidimArray &m, size_t select_slice) - { - if (select_slice >= ZSIZE(m)) - REPORT_ERROR(ERR_MULTIDIM_SIZE, "aliasSlice: Selected slice cannot be higher than Z size."); - - coreDeallocate(); - setDimensions(XSIZE(m), YSIZE(m), 1, 1); - this->data = m.data + XSIZE(m)*YSIZE(m)*(select_slice); - this->nzyxdimAlloc = this->nzyxdim; - this->destroyData = false; - } - - /** Alias an image in a stack. - * - * Treat the multidimarray as if it were a single slice. The data is not copied - * into new memory, but a pointer to the selected image in the multidimarray is copied. - * You should not make any operation on this volume such that the - * memory locations are changed. - * Select_slice starts at 0 towards Nsize. - */ - void aliasImageInStack(const MultidimArray &m, size_t select_image) - { - if (select_image >= NSIZE(m)) - REPORT_ERROR(ERR_MULTIDIM_SIZE, "aliasImageInStack: Selected image cannot be higher than N size."); - if (ZSIZE(m)!=1) - REPORT_ERROR(ERR_MULTIDIM_SIZE, "aliasImageInStack: This function is not meant for volumes"); - - coreDeallocate(); - setDimensions(XSIZE(m), YSIZE(m), 1, 1); - this->data = m.data + XSIZE(m)*YSIZE(m)*(select_image); - this->nzyxdimAlloc = this->nzyxdim; - this->destroyData = false; - } - - - - //@} - - /// @name Size - //@{ - - /* These "using" declarations must be done due to c++ cannot overload methods that have been - * declared in base class. - */ - using MultidimArrayBase::resizeNoCopy; - using MultidimArrayBase::resize; - using MultidimArrayBase::maxIndex; - - /** Resize to a given size - * - * This function resize the actual array to the given size. The origin is - * not modified. If the actual array is larger than the pattern then the - * values outside the new size are lost, if it is smaller then 0's are - * added. An exception is thrown if there is no memory. - * - * @code - * V1.resize(3, 3, 2); - * @endcode - */ - void resize(size_t Ndim, size_t Zdim, size_t Ydim, size_t Xdim, bool copy=true); - - /** Resize according to a pattern. - * - * This function resize the actual array to the same size and origin - * as the input pattern. If the actual array is larger than the pattern - * then the trailing values are lost, if it is smaller then 0's are - * added at the end - * - * @code - * v2.resize(v1); - * // v2 has got now the same structure as v1 - * @endcode - */ - template - void resize(const MultidimArray &v, bool copy = true) - { - if (NSIZE(*this) != NSIZE(v) || XSIZE(*this) != XSIZE(v) || - YSIZE(*this) != YSIZE(v) || ZSIZE(*this) != ZSIZE(v) || data==NULL) - resize(NSIZE(v), ZSIZE(v), YSIZE(v), XSIZE(v), copy); - - STARTINGX(*this) = STARTINGX(v); - STARTINGY(*this) = STARTINGY(v); - STARTINGZ(*this) = STARTINGZ(v); - } - - /** Resize according to a pattern with no copy. - */ - template - void resizeNoCopy(const MultidimArray &v) - { - if (NSIZE(*this) != NSIZE(v) || XSIZE(*this) != XSIZE(v) || - YSIZE(*this) != YSIZE(v) || ZSIZE(*this) != ZSIZE(v) || data==NULL) - resize(NSIZE(v), ZSIZE(v), YSIZE(v), XSIZE(v), false); - - STARTINGX(*this) = STARTINGX(v); - STARTINGY(*this) = STARTINGY(v); - STARTINGZ(*this) = STARTINGZ(v); - } - - /** Check dimension. - * - * returns true if the dimension is equal to the argument and false otherwise - * It also prints an error message in the latter case. - */ -#define checkDimension(dim) checkDimensionWithDebug(dim,__FILE__,__LINE__) - void checkDimensionWithDebug(int dim, const char *file, int line) const - { - if (getDim() != dim) - { - std::cerr<<" Check for dimension: " << dim <ndim >1) - REPORT_ERROR(ERR_MULTIDIM_DIM,"stack windowing not implemented"); - if (this->zdim >1) - {//call 3Dwindow - selfWindow( z0, y0, x0, - zF, yF, xF, - init_value); - } - else if (this->ydim >1) - {//call 2Dwindow - selfWindow( y0, x0, - yF, xF, - init_value); - - } - else if (this->xdim >1) - {//call 1Dwindow - selfWindow( x0, xF, init_value); - } - } - - template - void window(MultidimArray &result, int n0,int z0, int y0, int x0, - int nF,int zF, int yF, int xF, - T1 init_value = 0) const - { - if (this->ndim >1) - REPORT_ERROR(ERR_MULTIDIM_DIM,"stack windowing not implemented"); - if (this->zdim >1) - {//call 3Dwindow - window(result, z0, y0, x0, - zF, yF, xF, - init_value); - } - else if (this->ydim >1) - {//call 2Dwindow - window(result, y0, x0, - yF, xF, - init_value); - } - else if (this->xdim >1) - {//call 1Dwindow - window(result, x0, xF, init_value); - } - } - - /** Put a 3D selfWindow to the nth volume - * - * The volume is windowed within the two positions given to this function. - * Indexes always refer to logical indexes. If a position is outside the - * actual matrix range then the matrix is padded init_value until the - * new position is reached. In the following example suppose that m1 - * is the following and that the origin is (-1,-1,-1). - * - * @code - * slice 0 - * [01 02 03 [ - * 04 05 06 04 05 06 0 - * 07 08 09] 07 08 09 0] - * - * -----> - * - * slice 1 - * [11 12 13 [ - * 14 15 16 14 15 16 0 - * 17 18 19] 17 18 19 0] - * @endcode - * - * @code - * V1.selfWindow(0, 0, -1, 1, 1, 2); - * @endcode - */ - template - void window(MultidimArray &result, int z0, int y0, int x0, int zF, int yF, int xF, - T1 init_value = 0) const - { - result.resizeNoCopy(zF - z0 + 1, yF - y0 + 1, xF - x0 + 1); - STARTINGZ(result) = z0; - STARTINGY(result) = y0; - STARTINGX(result) = x0; - - FOR_ALL_ELEMENTS_IN_ARRAY3D(result) - if ((k >= STARTINGZ(*this) && k <= FINISHINGZ(*this)) && - (i >= STARTINGY(*this) && i <= FINISHINGY(*this)) && - (j >= STARTINGX(*this) && j <= FINISHINGX(*this))) - A3D_ELEM(result, k, i, j) = (T1) A3D_ELEM(*this, k, i, j); - else - A3D_ELEM(result, k, i, j) = init_value; - } - - /** 3D Self window */ - void selfWindow(int z0, int y0, int x0, int zF, int yF, int xF, - T init_value = 0) - { - if (z0 == STARTINGZ(*this) && zF == FINISHINGZ(*this) && - y0 == STARTINGY(*this) && yF == FINISHINGY(*this) && - x0 == STARTINGX(*this) && xF == FINISHINGX(*this)) - return; - - MultidimArray result; - window(result,z0,y0,x0,zF,yF,xF,init_value); - *this=result; - } - - /** Put a 2D selfWindow to the nth matrix - * - * The matrix is windowed within the two positions given to this function. - * Indexes always refer to logical indexes. If a position is outside the - * actual matrix range then the matrix is padded with init_value until the - * new position is reached. In the following examples suppose that m1 is the - * following and that the origin is (-1,-1). - * - * @code - * [1 2 3 [1 2 3 0 - * m1 = 4 5 6 ---> m1 = 4 5 6 0 - * 7 8 9] 7 8 9 0] - * - * @endcode - * - * @code - * m1.selfWindow(-1, -1, 1, 2); - * @endcode - */ - template - void window(MultidimArray &result, int y0, int x0, int yF, int xF, - T1 init_value = 0) const - { - result.resizeNoCopy(yF - y0 + 1, xF - x0 + 1); - STARTINGY(result) = y0; - STARTINGX(result) = x0; - - FOR_ALL_ELEMENTS_IN_ARRAY2D(result) - if (j >= STARTINGX(*this) && j <= FINISHINGX(*this) && - i >= STARTINGY(*this) && i <= FINISHINGY(*this)) - A2D_ELEM(result, i, j) = A2D_ELEM(*this, i, j); - else - A2D_ELEM(result, i, j) = init_value; - } - - /** 2D Self window */ - void selfWindow(int y0, int x0, int yF, int xF, - T init_value = 0) - { - MultidimArray result; - window(result,y0,x0,yF,xF,init_value); - *this=result; - } - - /** Put a 1D selfWindow to the nth vector - * - * The vector is windowed within the two indexes given to this function. - * Indexes always refer to logical indexes. If an index is outside the - * actual vector range then the vector is padded winit_value. In the - * following examples suppose that v1=[-2 -1 0 1 2] and that the origin is - * -2. - * - * @code - * v1.selfWindow(-1, 2); // v1=[-1 0 1 2]; v1.startingX() == -1 - * - * v1.selfWindow(-3, 1); // v1=[0 -2 -1 0 1]; v1.startingX() == -3 - * @endcode - */ - template - void window(MultidimArray &result, int x0, int xF, T1 init_value = 0) const - { - result.resizeNoCopy(xF - x0 + 1); - STARTINGX(result) = x0; - - FOR_ALL_ELEMENTS_IN_ARRAY1D(result) - if (i >= STARTINGX(*this) && i <= FINISHINGX(*this)) - A1D_ELEM(result, i) = A1D_ELEM(*this, i); - else - A1D_ELEM(result, i) = init_value; - } - - /** 1D Self window */ - void selfWindow(int x0, int xF, - T init_value = 0) - { - MultidimArray result; - window(result,x0,xF,init_value); - *this=result; - } - - /** Make a patch with the input array in the given positions */ - void patch(MultidimArray patchArray, int x, int y) - { - int n = XSIZE(patchArray)*sizeof(T); - - for (size_t i=0; i < YSIZE(patchArray); ++i) - memcpy(&dAij(*this, y+i, x), &dAij(patchArray, i, 0), n); - } - - //@} - - ///@name Access to the pixel values - //@{ - - /** Volume element access via double vector. - * - * Returns the value of a matrix logical position, but this time the - * element position is determined by a R3 vector. The elements can be used - * either by value or by reference. An exception is thrown if the index is - * outside the logical range. Pay attention in the following example that - * we are accessing the same element as in the previous function but, now - * we have to give first the X position because we are building first a - * vector of the form (x,y,z). - * - * @code - * V(vectorR3(1, -2, 0)) = 1; - * val = V(vectorR3(1, -2, 0)); - * @endcode - */ - T& operator()(const Matrix1D< double >& v) const - { - switch (VEC_XSIZE(v)) - { - case 1: - return A1D_ELEM((*this), ROUND(XX(v))); - case 2: - return A2D_ELEM((*this), ROUND(YY(v)), ROUND(XX(v))); - case 3: - return A3D_ELEM((*this), ROUND(ZZ(v)), ROUND(YY(v)), ROUND(XX(v))); - default: - REPORT_ERROR(ERR_ARG_INCORRECT,"Cannot handle indexes with dimension larger than 3"); - } - } - - /** Volume element access via integer vector. - */ - T& operator()(const Matrix1D< int >& v) const - { - switch (VEC_XSIZE(v)) - { - case 1: - return A1D_ELEM((*this), XX(v)); - case 2: - return A2D_ELEM((*this), YY(v), XX(v)); - case 3: - return A3D_ELEM((*this), ZZ(v), YY(v), XX(v)); - default: - REPORT_ERROR(ERR_ARG_INCORRECT,"Cannot handle indexes with dimension larger than 3"); - } - } - - /** 4D element access via index. - * - * Returns the value of a matrix logical position. In our example we could - * access from v(0, 0,-2,-1) to v(0, 1,2,1). The elements can be used either by - * value or by reference. An exception is thrown if the index is outside - * the logical range. Be careful that the argument order is (Z,Y,X). - * - * @code - * V(0, 0, -2, 1) = 1; - * val = V(0, 0, -2, 1); - * @endcode - */ - inline T& operator()(size_t n, int k, int i, int j) const - { - return NZYX_ELEM(*this, n, k, i, j); - } - - /** 3D element access via index. - * - * Returns the value of a matrix logical position. In our example we could - * access from v(0,-2,-1) to v(1,2,1). The elements can be used either by - * value or by reference. An exception is thrown if the index is outside - * the logical range. Be careful that the argument order is (Z,Y,X). - * - * @code - * V(0, -2, 1) = 1; - * val = V(0, -2, 1); - * @endcode - */ - inline T& operator()(int k, int i, int j) const - { - return A3D_ELEM(*this, k, i, j); - } - - /** Matrix element access via index - * - * Returns the value of a matrix logical position. In our example we could - * access from v(-2,-1) to v(2,1). The elements can be used either by value - * or by reference. An exception is thrown if the index is outside the - * logical range. The first argument is the Y position and the second the X - * position. - * - * @code - * m(-2, 1) = 1; - * val = m(-2, 1); - * @endcode - */ - inline T& operator()(int i, int j) const - { - return A2D_ELEM(*this, i, j); - } - - /** Vector element access - * - * Returns the value of a vector logical position. In our example we could - * access from v(-2) to v(2). The elements can be used either by value or by - * reference. An exception is thrown if the index is outside the logical - * range. - * - * @code - * v(-2) = 1; - * val = v(-2); - * @endcode - */ - inline T& operator()(int i) const - { - return A1D_ELEM(*this, i); - } - - inline T& operator[](size_t i) const - { - return data[i]; - } - - - /** Return the void pointer to the internal data array - */ - void* getArrayPointer() const - { - return (void*) data; - - } - - /** Copy an image from a stack to another - * - * Copy image image n from this MDA to image n2 in MDA M. - * @code - * V.getImage(0, m, 3); - * @endcode - */ - void getImage(size_t n, MultidimArray& M, size_t n2 = 0) const - { - if (XSIZE(*this) == 0) - { - M.clear(); - return; - } - - if (n > NSIZE(*this)) - REPORT_ERROR(ERR_INDEX_OUTOFBOUNDS," Multidimarray getImage: n larger than NSIZE"); - - if (ZSIZE(*this) != ZSIZE(M) || YSIZE(*this) != YSIZE(M) || XSIZE(*this) != XSIZE(M)) - { - if (n2 == 0) - M.resizeNoCopy(*this); - else - REPORT_ERROR(ERR_MULTIDIM_SIZE, "MultidimArray::getImage: Target dimensions do not match source dimensions."); - } - - if (n2 > NSIZE(M)) - REPORT_ERROR(ERR_INDEX_OUTOFBOUNDS," Multidimarray getImage: n larger than MultidimArray target NSIZE"); - - - FOR_ALL_DIRECT_ELEMENTS_IN_ARRAY3D(M) - DIRECT_NZYX_ELEM(M, n2, k, i, j) = DIRECT_NZYX_ELEM(*this, n, k, i, j); - - STARTINGX(M) = STARTINGX(*this); - STARTINGY(M) = STARTINGY(*this); - STARTINGZ(M) = STARTINGZ(*this); - } - - /** 2D Slice access for reading. - * - * This function returns a slice (a 2D matrix) corresponding to the chosen - * slice inside the nth 3D matrix, the numbering of the slices is also logical not - * physical. This function differs from the previous one in that this one - * cuts and assign in a single step instead of in two steps, as in - * the previous example. - * - * @code - * V.slice(0, m); - * @endcode - */ - template - void getSlice(int k, MultidimArray& M, char axis = 'Z', bool reverse = false, size_t n = 0) const - { - if (XSIZE(*this) == 0) - { - M.clear(); - return; - } - - T* ptr=NULL; - switch (axis) - { - case 'Z': - if (k < STARTINGZ(*this) || k > FINISHINGZ(*this)) - REPORT_ERROR(ERR_INDEX_OUTOFBOUNDS, - "Slice: Multidim subscript (k) out of range"); - - M.resize(1, 1, YSIZE(*this), XSIZE(*this),false); - k = k - STARTINGZ(*this); - - if (reverse) - { - int zEnd = ZSIZE(*this) - 1; - FOR_ALL_DIRECT_ELEMENTS_IN_ARRAY2D(M) - DIRECT_A2D_ELEM(M, i, j) = (T1) DIRECT_NZYX_ELEM(*this, n, k, zEnd-i, j); - } - else - { - ptr=&(DIRECT_NZYX_ELEM(*this, n, k, 0, 0)); - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY(M) - DIRECT_MULTIDIM_ELEM(M, n) = (T1) *(ptr++); - } - - STARTINGX(M) = STARTINGX(*this); - STARTINGY(M) = STARTINGY(*this); - break; - case 'Y': - if (k < STARTINGY(*this) || k > FINISHINGY(*this)) - REPORT_ERROR(ERR_INDEX_OUTOFBOUNDS, - "Slice: Multidim subscript (i) out of range"); - - k = k - STARTINGY(*this); - M.resizeNoCopy(ZSIZE(*this), XSIZE(*this)); - - if (reverse) - { - int zEnd = ZSIZE(*this) - 1; - FOR_ALL_DIRECT_ELEMENTS_IN_ARRAY2D(M) - DIRECT_A2D_ELEM(M, i, j) = (T1) DIRECT_NZYX_ELEM(*this, n, zEnd-i, k, j); - } - else - { - FOR_ALL_DIRECT_ELEMENTS_IN_ARRAY2D(M) - DIRECT_A2D_ELEM(M, i, j) = (T1) DIRECT_NZYX_ELEM(*this, n, i, k, j); - } - - STARTINGX(M) = STARTINGX(*this); - STARTINGY(M) = STARTINGZ(*this); - break; - case 'X': - if (k < STARTINGX(*this) || k > FINISHINGX(*this)) - REPORT_ERROR(ERR_INDEX_OUTOFBOUNDS, - "Slice: Multidim subscript (j) out of range"); - - k = k - STARTINGX(*this); - M.resizeNoCopy(YSIZE(*this), ZSIZE(*this)); - - if (reverse) - { - int zEnd = ZSIZE(*this) - 1; - FOR_ALL_DIRECT_ELEMENTS_IN_ARRAY2D(M) - DIRECT_A2D_ELEM(M, i, j) = (T1) DIRECT_NZYX_ELEM(*this, n, zEnd-j, i, k); - } - else - { - FOR_ALL_DIRECT_ELEMENTS_IN_ARRAY2D(M) - DIRECT_A2D_ELEM(M, i, j) = (T1) DIRECT_NZYX_ELEM(*this, n, j, i, k); - } - - STARTINGX(M) = STARTINGY(*this); - STARTINGY(M) = STARTINGZ(*this); - break; - default: - REPORT_ERROR(ERR_VALUE_INCORRECT, - formatString("Slice: not supported axis %c", axis)); - } - } - - /** Get Z slice as matrix */ - void getSliceAsMatrix(size_t k, Matrix2D &m) const; - - - /** Return the data aliased as a row vector in a Matrix1D - */ - void getAliasAsRowVector(Matrix1D &m) const - { - m.vdim = NZYXSIZE(*this); - m.destroyData = false; - m.row = true; - m.vdata = data; - } - - /** Slice access for writing. - * - * This function sets a 2D matrix corresponding to the chosen slice inside the nth - * volume, the numbering of the slices is also logical not physical. - * - * @code - * // Copies slice 0 in slice 1 - * V.setSlice(1, (V.slice(0))); - * @endcode - */ - template - void setSlice(int k, const MultidimArray& v, size_t n=0) - { - if (xdim == 0) - return; - - if (k < STARTINGZ(*this) || k > FINISHINGZ(*this)) - REPORT_ERROR(ERR_INDEX_OUTOFBOUNDS,formatString( - "setSlice: MultidimArray subscript (k=%d) out of range [%d, %d]", - k,STARTINGZ(*this),FINISHINGZ(*this))); - - if (v.rowNumber() != YSIZE(*this) || v.colNumber() != XSIZE(*this)) - REPORT_ERROR(ERR_MULTIDIM_DIM, - "setSlice: MultidimArray dimensions different from the matrix ones"); - - k-=STARTINGZ(*this); - T *ptr=&(DIRECT_NZYX_ELEM(*this, n, k, 0, 0)); - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY(v) - *(ptr++) = (T) DIRECT_MULTIDIM_ELEM(v, n); - } - - /** Reslice the volume aliging any X or Y direction with Z axis - * - * @param face Select the face to become the new Z direction - * @param out The resliced volume is returned - * @param flip Invert the positions of Z planes, keeping the X-Y orientation - * @param n Select the number of image in case of stacks - */ - - template - void reslice(MultidimArray& out, AxisView face, bool flip = false, size_t n = 0) const - { - ArrayDim aDim, aDimOut; - getDimensions(aDim); - - char axis='Z'; - bool reverse=false; - - aDimOut = aDim; - - if (face == VIEW_Y_NEG || face == VIEW_Y_POS) - { - axis = 'Y'; - aDimOut.ydim = aDim.zdim; - aDimOut.zdim = aDim.ydim; - reverse = (face == VIEW_Y_NEG); - } - else if (face == VIEW_X_NEG || face == VIEW_X_POS) - { - axis = 'X'; - aDimOut.xdim = aDim.zdim; - aDimOut.zdim = aDim.xdim; - reverse = (face == VIEW_X_NEG); - } - - flip = flip^reverse; - - out.resize(aDimOut, false); - - MultidimArray imTemp; - - int index; - - for (size_t k = 0; k < aDimOut.zdim; k++) - { - imTemp.aliasSlice(out, k); - index = k + (aDimOut.zdim - 1 - 2*k) * (int)flip; - this->getSlice(index, imTemp, axis, !reverse); - } - } - - /** Reslice the current volume - * - * @param face Select the face to become the new Z direction - * @param flip Invert the positions of Z planes, keeping the X-Y orientation - * @param n Select the number of image in case of stacks - */ - void reslice(AxisView face, bool flip = false, size_t n = 0) - { - MultidimArray mTemp; - reslice(mTemp, face, flip, n); - *this = mTemp; - } - - /** Get Column - * - * This function returns a column vector corresponding to the - * chosen column. - * - * @code - * std::vector< double > v; - * m.getCol(-1, v); - * @endcode - */ - void getCol(size_t j, MultidimArray& v) const - { - if (xdim == 0 || ydim == 0) - { - v.clear(); - return; - } - - if (j >= xdim) - REPORT_ERROR(ERR_INDEX_OUTOFBOUNDS,"getCol: Matrix subscript (j) greater than matrix dimension"); - - v.resizeNoCopy(ydim); - for (size_t i = 0; i < ydim; i++) - DIRECT_A1D_ELEM(v,i) = DIRECT_A2D_ELEM(*this,i, j); - } - - /** Set Column - * - * This function sets a column vector corresponding to the chosen column - * inside matrix. - * - * @code - * m.setCol(0, (m.row(1)).transpose()); // Copies row 1 in column 0 - * @endcode - */ - void setCol(size_t j, const MultidimArray& v) - { - if (xdim == 0 || ydim == 0) - REPORT_ERROR(ERR_MULTIDIM_EMPTY, "setCol: Target matrix is empty"); - - if (j>= xdim) - REPORT_ERROR(ERR_INDEX_OUTOFBOUNDS, "setCol: Matrix subscript (j) out of range"); - - if (v.xdim != ydim) - REPORT_ERROR(ERR_MULTIDIM_SIZE, - "setCol: Vector dimension different from matrix one"); - - for (size_t i = 0; i < ydim; i++) - DIRECT_A2D_ELEM(*this,i, j) = DIRECT_A1D_ELEM(v,i); - } - - /** Get row - * - * This function returns a row vector corresponding to the chosen - * row inside the nth 2D matrix, the numbering of the rows is also - * logical not physical. - * - * @code - * std::vector< double > v; - * m.getRow(-2, v); - * @endcode - */ - void getRow(size_t i, MultidimArray& v) const - { - if (xdim == 0 || ydim == 0) - { - v.clear(); - return; - } - - if (i >= ydim) - REPORT_ERROR(ERR_INDEX_OUTOFBOUNDS, "getRow: Matrix subscript (i) greater than matrix dimension"); - - v.resizeNoCopy(xdim); - memcpy(&A1D_ELEM(v,0),&A2D_ELEM(*this,i,0),xdim*sizeof(T)); - } - - /** Set Row - * - * This function sets a row vector corresponding to the chosen row in the 2D Matrix - * - * @code - * m.setRow(-2, m.row(1)); // Copies row 1 in row -2 - * @endcode - */ - void setRow(int i, const MultidimArray& v) - { - if (xdim == 0 || ydim == 0) - REPORT_ERROR(ERR_MULTIDIM_EMPTY, "setRow: Target matrix is empty"); - - if (i < 0 || i >= ydim) - REPORT_ERROR(ERR_INDEX_OUTOFBOUNDS, "setRow: Matrix subscript (i) out of range"); - - if (v.xdim != xdim) - REPORT_ERROR(ERR_MULTIDIM_SIZE, - "setRow: Vector dimension different from matrix one"); - - memcpy(&A2D_ELEM(*this,i,0),&A1D_ELEM(v,0),xdim*sizeof(T)); - } - - void getReal(MultidimArray< double > & realImg) const - { - REPORT_ERROR(ERR_TYPE_INCORRECT, "MultidimArray: Non complex datatype."); - } - - void getImag(MultidimArray< double > & imagImg) const - { - REPORT_ERROR(ERR_TYPE_INCORRECT, "MultidimArray: Non complex datatype."); - } - - - /** 3D Logical to physical index translation. - * - * This function returns the physical position of a logical one. - * - * @code - * m.toPhysical(k_log, i_log, j_log, k_phys, i_phys, j_phys); - * @endcode - */ - void toPhysical(int k_log, int i_log, int j_log, - int& k_phys, int& i_phys, int& j_phys) const - { - k_phys = k_log - STARTINGZ(*this); - i_phys = i_log - STARTINGY(*this); - j_phys = j_log - STARTINGX(*this); - } - - /** 3D Physical to logical index translation. - * - * This function returns the logical position of a physical one. - * - * @code - * m.toLogical(i_phys, j_phys, i_log, j_log); - * @endcode - */ - void toLogical(int k_phys, int i_phys, int j_phys, - int& k_log, int& i_log, int& j_log) const - { - k_log = k_phys + STARTINGZ(*this); - i_log = i_phys + STARTINGY(*this); - j_log = j_phys + STARTINGX(*this); - } - - /** 2D Logical to physical index translation - * - * This function returns the physical position of a logical one. - * - * @code - * m.toPhysical(i_log, j_log, i_phys, j_phys); - * @endcode - */ - void toPhysical(int i_log, int j_log, int& i_phys, int& j_phys) const - { - i_phys = i_log - STARTINGY(*this); - j_phys = j_log - STARTINGX(*this); - } - - /** 2D Physical to logical index translation - * - * This function returns the logical position of a physical one. - * - * @code - * m.toLogical(i_phys, j_phys, i_log, j_log); - * @endcode - */ - void toLogical(int i_phys, int j_phys, int &i_log, int& j_log) const - { - i_log = i_phys + STARTINGY(*this); - j_log = j_phys + STARTINGX(*this); - } - - /** 1D Logical to physical index translation - * - * This function returns the physical position of a logical one. - * - * @code - * v.toPhysical(i_log, i_phys); - * @endcode - */ - void toPhysical(int i_log, int& i_phys) const - { - i_phys = i_log - STARTINGX(*this); - } - - /** 1D Physical to logical index translation. - * - * This function returns the logical position of a physical one. - * - * @code - * v.toLogical(i_phys, i_log); - * @endcode - */ - void toLogical(int i_phys, int& i_log) const - { - i_log = i_phys + STARTINGX(*this); - } - - /** Interpolates the value of the nth 3D matrix M at the point (x,y,z). - * - * (x,y,z) are in logical coordinates. - */ - T interpolatedElement3D(double x, double y, double z, T outside_value = (T) 0) const - { - int x0 = FLOOR(x); - double fx = x - x0; - int x1 = x0 + 1; - - int y0 = FLOOR(y); - double fy = y - y0; - int y1 = y0 + 1; - - int z0 = FLOOR(z); - double fz = z - z0; - int z1 = z0 + 1; - - double doutside_value=outside_value; - double d000 = (OUTSIDE3D(z0, y0, x0)) ? doutside_value : A3D_ELEM(*this, z0, y0, x0); - double d001 = (OUTSIDE3D(z0, y0, x1)) ? doutside_value : A3D_ELEM(*this, z0, y0, x1); - double d010 = (OUTSIDE3D(z0, y1, x0)) ? doutside_value : A3D_ELEM(*this, z0, y1, x0); - double d011 = (OUTSIDE3D(z0, y1, x1)) ? doutside_value : A3D_ELEM(*this, z0, y1, x1); - double d100 = (OUTSIDE3D(z1, y0, x0)) ? doutside_value : A3D_ELEM(*this, z1, y0, x0); - double d101 = (OUTSIDE3D(z1, y0, x1)) ? doutside_value : A3D_ELEM(*this, z1, y0, x1); - double d110 = (OUTSIDE3D(z1, y1, x0)) ? doutside_value : A3D_ELEM(*this, z1, y1, x0); - double d111 = (OUTSIDE3D(z1, y1, x1)) ? doutside_value : A3D_ELEM(*this, z1, y1, x1); - - double dx00 = LIN_INTERP(fx, d000, d001); - double dx01 = LIN_INTERP(fx, d100, d101); - double dx10 = LIN_INTERP(fx, d010, d011); - double dx11 = LIN_INTERP(fx, d110, d111); - double dxy0 = LIN_INTERP(fy, dx00, dx10); - double dxy1 = LIN_INTERP(fy, dx01, dx11); - - return (T) LIN_INTERP(fz, dxy0, dxy1); - } - - /** Interpolates the value of the nth 2D matrix M at the point (x,y) - * - * Bilinear interpolation. (x,y) are in logical coordinates. - */ - T interpolatedElement2D(double x, double y, T outside_value = (T) 0) const - { - int x0 = floor(x); - double fx = x - x0; - int x1 = x0 + 1; - int y0 = floor(y); - double fy = y - y0; - int y1 = y0 + 1; - - int i0=STARTINGY(*this); - int j0=STARTINGX(*this); - int iF=FINISHINGY(*this); - int jF=FINISHINGX(*this); - -#define ASSIGNVAL2D(d,i,j) \ - if ((j) < j0 || (j) > jF || (i) < i0 || (i) > iF) \ - d=outside_value;\ - else \ - d=A2D_ELEM(*this, i, j); - - double d00, d10, d11, d01; - ASSIGNVAL2D(d00,y0,x0); - ASSIGNVAL2D(d01,y0,x1); - ASSIGNVAL2D(d10,y1,x0); - ASSIGNVAL2D(d11,y1,x1); - - double d0 = LIN_INTERP(fx, d00, d01); - double d1 = LIN_INTERP(fx, d10, d11); - return (T) LIN_INTERP(fy, d0, d1); - } - - /** Non-divergent version of interpolatedElement2D - * - * works only for outside_value = 0 - * does not break vectorization - */ - T interpolatedElement2DOutsideZero(double x, double y) const - { - int x0 = floor(x); - double fx = x - x0; - int x1 = x0 + 1; - int y0 = floor(y); - double fy = y - y0; - int y1 = y0 + 1; - - int i0=STARTINGY(*this); - int j0=STARTINGX(*this); - int iF=FINISHINGY(*this); - int jF=FINISHINGX(*this); - - int b; -#define ASSIGNVAL2DNODIV(d,i,j) \ - b = ((j) < j0 || (j) > jF || (i) < i0 || (i) > iF); \ - b ? d=0 : d=A2D_ELEM(*this, i, j); - - double d00, d10, d11, d01; - ASSIGNVAL2DNODIV(d00,y0,x0); - ASSIGNVAL2DNODIV(d01,y0,x1); - ASSIGNVAL2DNODIV(d10,y1,x0); - ASSIGNVAL2DNODIV(d11,y1,x1); - - double d0 = LIN_INTERP(fx, d00, d01); - double d1 = LIN_INTERP(fx, d10, d11); - return (T) LIN_INTERP(fy, d0, d1); - } - - /** Interpolates the value of the nth 1D matrix M at the point (x) - * - * Bilinear interpolation. (x) is in logical coordinates. - */ - T interpolatedElement1D(double x, T outside_value = (T) 0) const - { - int x0 = floor(x); - double fx = x - x0; - int x1 = x0 + 1; - - int j0=STARTINGX(*this); - int jF=FINISHINGX(*this); - -#define ASSIGNVAL1D(d,j) \ - if ((j) < j0 || (j) > jF) \ - d=outside_value;\ - else \ - d=A1D_ELEM(*this, j); - - double d0, d1; - ASSIGNVAL1D(d0,x0); - ASSIGNVAL1D(d1,x1); - - return (T) LIN_INTERP(fx, d0, d1); - } - - /** Interpolates the value of the nth 3D matrix M at the point (x,y,z) knowing - * that this image is a set of B-spline coefficients. - * - * (x,y,z) are in logical coordinates. - */ - T interpolatedElementBSpline3D(double x, double y, double z, - int SplineDegree = 3) const; - - /** Interpolates the value of the nth 2D matrix M at the point (x,y) knowing - * that this image is a set of B-spline coefficients - * - * (x,y) are in logical coordinates - * - * To interpolate using splines you must first produce the Bspline - * coefficients. An example to interpolate an image at (0.5,0.5) using - * splines would be: - * - * @code - * MultidimArray< double > Bspline_coeffs; - * myImage.produceSplineCoefficients(Bspline_coeffs, 3); - * interpolated_value = Bspline_coeffs.interpolatedElementBSpline(0.5, - * 0.5,3); - * @endcode - */ - T interpolatedElementBSpline2D(double x, double y, int SplineDegree = 3) const; - - T interpolatedElementBSpline2D_Degree3(double x, double y) const; - - /** Interpolates the value of the nth 1D vector M at the point (x) knowing - * that this vector is a set of B-spline coefficients - * - * (x) is in logical coordinates - * - * To interpolate using splines you must first produce the Bspline - * coefficients. An example to interpolate a vector at (0.5) using - * splines would be: - * - * @code - * MultidimArray< double > Bspline_coeffs; - * myVector.produceSplineCoefficients(Bspline_coeffs, 3); - * interpolated_value = Bspline_coeffs.interpolatedElementBSpline(0.5,3); - * @endcode - */ - T interpolatedElementBSpline1D(double x, int SplineDegree = 3) const; - //@} - - /// @name Statistics functions - //@{ - - /** Print statistics in current line. - * - * No end of line character is written after this print out. - * - * @code - * a.computeStats(); - * std::cout << "Statistics of variable a "; - * a.printStats(); - * std::cout << std::endl; - * @endcode - */ - void printStats(std::ostream& out = std::cout) const - { - T minval, maxval; - double avgval, devval; - - computeStats(avgval, devval, minval, maxval); - - out.setf(std::ios::showpoint); - int old_prec = out.precision(7); - - out << " min= "; - out.width(9); - out << minval; - out << " max= "; - out.width(9); - out << maxval; - out << " avg= "; - out.width(9); - out << avgval; - out << " dev= "; - out.width(9); - out << devval; - - out.precision(old_prec); - } - - /** Maximum of the values in the array. - * - * The returned value is of the same type as the type of the array. - */ - T computeMax() const - { - if (NZYXSIZE(*this) <= 0) - return static_cast< T >(0); - - T maxval = data[0]; - - T* ptr=NULL; - size_t n; - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(*this,n,ptr) - if (*ptr > maxval) - maxval = *ptr; - - return maxval; - } - - /** 1D Indices for the maximum element. - * - * This function just calls to the 4D function - */ - void maxIndex(int& jmax) const - { - size_t zeroLong=0; - int zeroInt=0; - maxIndex(zeroLong,zeroInt,zeroInt,jmax); - } - - /** Minimum of the values in the array. - * - * The returned value is of the same type as the type of the array. - */ - T computeMin() const - { - if (NZYXSIZE(*this) <= 0) - return static_cast< T >(0); - - T minval = data[0]; - - T* ptr=NULL; - size_t n; - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(*this,n,ptr) - if (*ptr < minval) - minval = *ptr; - - return minval; - } - - /** 4D Indices for the minimum element. - * - * This function returns the index of the minimum element of an array. - * array(l,k,i,j). Returns -1 if the array is empty - */ - void minIndex(int &lmin, int& kmin, int& imin, int& jmin) const - { - if (XSIZE(*this) == 0) - { - lmin = kmin = imin = jmin = -1; - return; - } - - kmin = STARTINGZ(*this); - imin = STARTINGY(*this); - jmin = STARTINGX(*this); - lmin = 0; - size_t n=0; - T minval = DIRECT_MULTIDIM_ELEM(*this, n); - - FOR_ALL_NZYX_ELEMENTS_IN_MULTIDIMARRAY(*this) - { - T val=DIRECT_MULTIDIM_ELEM(*this,n); - if (val > minval) - { - minval = val; - lmin = l; - kmin = k; - imin = i; - jmin = j; - } - ++n; - } - } - - /** 3D Indices for the minimum element. - * - * This function just calls to the 4D function - */ - void minIndex(int& kmin, int& imin, int& jmin) const - { - int zeroInt=0; - minIndex(zeroInt,kmin,imin,jmin); - } - - /** 2D Indices for the minimum element. - * - * This function just calls to the 4D function - */ - void minIndex(int& imin, int& jmin) const - { - int zeroInt=0; - minIndex(zeroInt,zeroInt,imin,jmin); - } - - /** 1D Indices for the minimum element. - * - * This function just calls to the 4D function - */ - void minIndex(int& jmin) const - { - int zeroInt=0; - minIndex(zeroInt,zeroInt,zeroInt,jmin); - } - - /** 4D Indices for the maximum element. - * - * This function returns the index of the maximum element of an array. - * array(l,k,i,j). Returns -1 if the array is empty - */ - void maxIndex(size_t &lmax, int& kmax, int& imax, int& jmax) const - { - if (XSIZE(*this) == 0) - { - lmax = kmax = imax = jmax = -1; - return; - } - - kmax = STARTINGZ(*this); - imax = STARTINGY(*this); - jmax = STARTINGX(*this); - lmax = 0; - size_t n=0; - T maxval = DIRECT_MULTIDIM_ELEM(*this, n); - - FOR_ALL_NZYX_ELEMENTS_IN_MULTIDIMARRAY(*this) - { - T val=DIRECT_MULTIDIM_ELEM(*this, n); - if (val > maxval) - { - maxval = val; - lmax = l; - kmax = k; - imax = i; - jmax = j; - } - ++n; - } - } - - /** Minimum and maximum of the values in the array. - * - * As doubles. - */ - void computeDoubleMinMax(double& minval, double& maxval) const - { - if (NZYXSIZE(*this) <= 0) - return; - - T* ptr=NULL; - size_t n; - T Tmin=DIRECT_MULTIDIM_ELEM(*this,0); - T Tmax=Tmin; - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(*this,n,ptr) - { - T val=*ptr; - if (val < Tmin) - Tmin = val; - else if (val > Tmax) - Tmax = val; - } - minval = static_cast< double >(Tmin); - maxval = static_cast< double >(Tmax); - } - - /** Minimum and maximum of the values in the array. - * - * As doubles. - */ - void computeDoubleMinMaxRange(double& minval, double& maxval,size_t offset, size_t size) const - { - if (NZYXSIZE(*this) <= 0) - return; - - minval = maxval = static_cast< double >(data[offset]); - - T* ptr=NULL; - T val; - size_t n; - - for (n=offset,ptr=data+offset; n(val); - else if (val > maxval) - maxval = static_cast< double >(val); - } - } - - /** Average of the values in the array. - * - * The returned value is always double, independently of the type of the - * array. - */ - double computeAvg() const - { - if (NZYXSIZE(*this) <= 0) - return 0; - - double sum = 0; - - T* ptr=NULL; - size_t n; - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(*this,n,ptr) - sum += static_cast< double >(*ptr); - - return sum / NZYXSIZE(*this); - } - - /** Standard deviation of the values in the array. - * - * Be careful that the standard deviation and NOT the variance is returned. - * The returned value is always double, independently of the type of the - * array. - */ - double computeStddev() const - { - if (NZYXSIZE(*this) <= 1) - return 0; - - double avg = 0, stddev = 0; - - T* ptr=NULL; - size_t n; - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(*this,n,ptr) - { - double val=static_cast< double >(*ptr); - avg += val; - stddev += val * val; - } - - avg /= NZYXSIZE(*this); - stddev = stddev / NZYXSIZE(*this) - avg * avg; - stddev *= NZYXSIZE(*this) / (NZYXSIZE(*this) - 1); - - // Foreseeing numerical instabilities - stddev = sqrt(static_cast((ABS(stddev)))); - - return stddev; - } - - /** Compute statistics. - * - * The average, standard deviation, minimum and maximum value are - * returned. - */ - void computeStats(double& avg, double& stddev, T& minval, T& maxval) const - { - if (NZYXSIZE(*this) <= 0) - return; - - avg = 0; - stddev = 0; - - minval = maxval = data[0]; - - T* ptr=NULL; - size_t n; - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(*this,n,ptr) - { - T Tval=*ptr; - double val=Tval; - avg += val; - stddev += val * val; - - if (Tval > maxval) - maxval = Tval; - else if (Tval < minval) - minval = Tval; - } - - avg /= NZYXSIZE(*this); - - if (NZYXSIZE(*this) > 1) - { - stddev = stddev / NZYXSIZE(*this) - avg * avg; - stddev *= NZYXSIZE(*this) / (NZYXSIZE(*this) - 1); - - // Foreseeing numerical instabilities - stddev = sqrt(static_cast< double >(ABS(stddev))); - } - else - stddev = 0; - } - - /** Compute statistics. - * - * The average, standard deviation, minimum and maximum value are - * returned. - */ - template - void computeAvgStdev(U& avg, U& stddev) const - { - static_assert( - std::is_same::value || std::is_same::value, - "U must be a floating presiont type"); - if (NZYXSIZE(*this) <= 0) - return; - - avg = 0; - stddev = 0; - const size_t nMax = nzyxdim; - for (size_t n = 0; n < nMax; ++n) - { - U v = (U)data[n]; - avg += v; - stddev += v * v; - } - - avg /= NZYXSIZE(*this); - - if (NZYXSIZE(*this) > 1) - { - stddev = stddev / NZYXSIZE(*this) - avg * avg; - stddev *= NZYXSIZE(*this) / (NZYXSIZE(*this) - 1); - - // Foreseeing numerical instabilities - stddev = sqrt(fabs(stddev)); - } - else - stddev = 0; - } - - /** Compute statistics in the active area - * - * Only the statistics for values in the overlapping between the mask and the - * volume for those the mask is not 0 are computed. - */ - void computeAvgStdev_within_binary_mask(const MultidimArray< int >& mask, - double& avg, double& stddev) const - { - double sum1 = 0; - double sum2 = 0; - double N = 0; - - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY(*this) - { - if (DIRECT_MULTIDIM_ELEM(mask, n) != 0) - { - ++N; - double aux=DIRECT_MULTIDIM_ELEM(*this, n); - sum1 += aux; - sum2 += aux*aux; - } - } - - // average and standard deviation - avg = sum1 / N; - if (N > 1) - stddev = sqrt(fabs(sum2 / N - avg * avg) * N / (N - 1)); - else - stddev = 0; - } - - void computeMedian_within_binary_mask(const MultidimArray< int >& mask, double& median) const; - - /** Compute statistics within 2D region of 2D image. - * - * The 2D region is specified by two corners. - * Note that this function only works for the 0th image in a multi-image array... - */ - void computeStats(double& avg, - double& stddev, - T& min_val, - T& max_val, - Matrix1D< int >& corner1, - Matrix1D< int >& corner2, - size_t n = 0) - { - (*this).checkDimension(2); - min_val = max_val = NZYX_ELEM((*this), n, 0, YY(corner1), XX(corner1)); - - Matrix1D< double > r(3); - double N = 0, sum = 0, sum2 = 0; - - FOR_ALL_ELEMENTS_IN_ARRAY2D_BETWEEN(corner1, corner2) - { - sum += (*this)(r); - sum2 += (*this)(r) * (*this)(r); - N++; - - if ((*this)(r) < min_val) - min_val = (*this)(r); - else if ((*this)(r) > max_val) - max_val = (*this)(r); - } - - if (N != 0) - { - avg = sum / N; - stddev = sqrt(sum2 / N - avg * avg); - } - else - { - avg = stddev = 0; - } - } - - /** Median - * - * Calculate the median element. - * - * @code - * med = v1.computeMedian(); - * @endcode - */ - double computeMedian() const - { - if (XSIZE(*this) == 0) - return 0; - - if (XSIZE(*this) == 1) - return DIRECT_MULTIDIM_ELEM(*this,0); - - // Initialise data - MultidimArray temp; - this->sort(temp); - - // Get median - if (NZYXSIZE(*this)%2==0) - return 0.5*(DIRECT_MULTIDIM_ELEM(temp,NZYXSIZE(*this)/2-1)+ - DIRECT_MULTIDIM_ELEM(temp,NZYXSIZE(*this)/2 )); - else - return DIRECT_MULTIDIM_ELEM(temp,NZYXSIZE(*this)/2); - } - - /** Adjust the range of the array to a given one. - * - * A linear operation is performed on the values of the array such that - * after it, the values of the array are comprissed between the two values - * set. The actual array is modified itself - * - * @code - * v.rangeAdjust(0, 1); - * // The array is now ranging from 0 to 1 - * @endcode - */ - void rangeAdjust(T minF, T maxF) - { - if (NZYXSIZE(*this) <= 0) - return; - - double min0=0., max0=0.; - computeDoubleMinMax(min0, max0); - - // If max0==min0, it means that the vector is a constant one, so the - // only possible transformation is to a fixed minF - double slope; - if (max0 != min0) - slope = static_cast< double >(maxF - minF) / - static_cast< double >(max0 - min0); - else - slope = 0; - - T* ptr=NULL; - size_t n; - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(*this,n,ptr) - *ptr = minF + static_cast< T >(slope * - static_cast< double >(*ptr - min0)); - } - - /** Adjust the range of the array to a given one within a mask. - * - * A linear operation is performed on the values of the array such that - * after it, the values of the array are comprissed between the two values - * set. The actual array is modified itself. The linear transformation - * is computed within the mask, but it is applied everywhere. - * - * @code - * v.rangeAdjust(0, 1, mask); - * // The array is now ranging from 0 to 1 - * @endcode - */ - // This function must be explicitly implemented outside - void rangeAdjust(T minF, T maxF, MultidimArray &mask) - { - if (MULTIDIM_SIZE(*this) <= 0) - return; - - double min0=0., max0=0.; - bool first=true; - T* ptr=NULL; - size_t n; - int * ptrMask=MULTIDIM_ARRAY(mask); - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(*this,n,ptr) - { - if (*ptrMask) - { - T val= *ptr; - if (first) - { - min0=max0=(double)val; - first=false; - } - else - { - min0=XMIPP_MIN(min0,val); - max0=XMIPP_MAX(max0,val); - } - } - ptrMask++; - } - - // If max0==min0, it means that the vector is a constant one, so the - // only possible transformation is to a fixed minF - double slope; - if (max0 != min0) - slope = static_cast< double >(maxF - minF) / - static_cast< double >(max0 - min0); - else - slope = 0; - - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(*this,n,ptr) - *ptr = minF + static_cast< T >(slope * - static_cast< double >(*ptr - min0)); - } - - /** Adjust the range of the array to the range of another array in - a least squares sense. - * - * A linear operation is performed on the values of the array such that - * after it, the values of the self array are as similar as possible - * (L2 sense) to the values of the array shown as sample - */ - - //As written this will only work for T=double - //nevertheless since this is used is better - //to use T than double or will create problem for int multidim arrays - void rangeAdjust(const MultidimArray &example, - const MultidimArray *mask=NULL) - { - if (NZYXSIZE(*this) <= 0) - return; - - double avgExample=0., stddevExample=0., avgThis, stddevThis; - if (mask!=NULL) - { - example.computeAvgStdev_within_binary_mask(*mask,avgExample,stddevExample); - computeAvgStdev_within_binary_mask(*mask,avgThis,stddevThis); - } - else - { - computeAvgStdev(avgThis,stddevThis); - example.computeAvgStdev(avgExample,stddevExample); - } - - // y=a+bx - double b=stddevThis>0? stddevExample/stddevThis:0; - double a=avgExample-avgThis*b; - - size_t n; - T *ptr=NULL; - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(*this,n,ptr) - *ptr = static_cast< T >(a+b * static_cast< double > (*ptr)); - } - - /** Adjust the average and stddev of the array to given values. - * - * A linear operation is performed on the values of the array such - * that after it, the average and standard deviation of the array - * are the two values set. The actual array is modified itself - * - * @code - * v.statisticsAdjust(0,1); - * // The array has got now 0 mean and stddev=1 - * @endcode - */ - // This function must be explicitly implemented outside. - template - void statisticsAdjust(U avgF, U stddevF) - { - static_assert( - std::is_same::value || std::is_same::value, - "U must be a floating presiont type"); - U avg0 = 0; - U stddev0 = 0; - - if (NZYXSIZE(*this) == 0) - return; - - computeAvgStdev(avg0, stddev0); - - U a = (stddev0 != 0) ? (stddevF / stddev0) : 0; - U b = avgF - a * avg0; - - T* ptr=&DIRECT_MULTIDIM_ELEM(*this,0); - size_t nmax=(nzyxdim/4)*4; - for (size_t n=0; n(a * (*(ptr )) + b); - *(ptr+1)= static_cast< T >(a * (*(ptr+1)) + b); - *(ptr+2)= static_cast< T >(a * (*(ptr+2)) + b); - *(ptr+3)= static_cast< T >(a * (*(ptr+3)) + b); - } - for (size_t n=nmax; n(a * (*(ptr )) + b); - } - //@} - - /** @name Array "by" array operations. - * - * These are operations that are performed between 2 arrays of the - * SAME type (two integer vectors, two double matrices, ...). If they - * are not of the same type you can convert one of the arrays to the - * desired type using the function typeCast. The result must have been - * defined to be of the same type as the operands. - * - * In this kind of operations each element of array 1 is operated with its - * homologous in array 2, it is very important that both have got the - * same size and starting origins. The result has also got the same - * shape as the two operated arrays and its former content is lost. - */ - //@{ - - /** Core array by array operation. - * - * It assumes that the result is already resized. - */ - inline friend void coreArrayByArray(const MultidimArray& op1, - const MultidimArray& op2, MultidimArray& result, - char operation) - { - T* ptrResult=NULL; - T* ptrOp1=NULL; - T* ptrOp2=NULL; - size_t n; - // Loop unrolling - const size_t unroll=4; - size_t nmax=unroll*(op1.nzyxdim/unroll); - switch (operation) - { - case '+': - for (n=0, ptrResult=result.data, ptrOp1=op1.data,ptrOp2=op2.data; - n& op1, - const MultidimArray& op2, MultidimArray& result, - char operation, const MultidimArray* mask) - { - T* ptrResult=NULL; - T* ptrOp1=NULL; - T* ptrOp2=NULL; - T* ptrMask=NULL; - T zero; - zero = T(0); - size_t n; - switch (operation) - { - case '+': - for (n=0, ptrResult=result.data, ptrOp1=op1.data,ptrOp2=op2.data, - ptrMask=mask->data; - ndata; - ndata; - ndata; - n x=b - * above: if x >a => x=b - * below: if x x=b - * range: if x x=a and if x>b => x=b - * soft: if abs(x) x=0 else x=sgn(x)*(abs(x)-a) - * - * @code - * v.threshold("abs_above", 10, 10); - * // any value whose absolute value is above 10 will be substituted by - * // -10 (if it is negative) or 10 (if it is positive) - * - * v.threshold("abs_below", 0.1, 0); - * // any value whose absolute value is below 0.1 will be substituted by - * // -0 (if it is negative) or 0 (if it is positive) - * - * v.threshold("above", 10, 10); - * // any value above 10 will be substituted by 10 - * - * v.threshold("below", -10, -10); - * // any value below -10 will be substituted by -10 - * - * v.threshold("range", 0, 1); - * // v is "saturated" by values 0 and 1, any value outside this range - * // will be substituted by its nearest border - * @endcode - */ - void threshold(const String& type, - T a, - T b=0, - MultidimArray * mask = NULL ) - { - int mode; - - if (type == "abs_above") - mode = 1; - else if (type == "abs_below") - mode = 2; - else if (type == "above") - mode = 3; - else if (type == "below") - mode = 4; - else if (type == "range") - mode = 5; - else if (type == "soft") - mode = 6; - else - REPORT_ERROR(ERR_VALUE_INCORRECT, - formatString("Threshold: mode not supported (%s)", type.c_str() )); - - T* ptr=NULL; - size_t n; - T ma=-a; - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(*this,n,ptr) - { - if (mask == NULL || DIRECT_MULTIDIM_ELEM(*mask,n) > 0 ) - { - switch (mode) - { - case 1: - if (ABS(*ptr) > a) - *ptr = SGN(*ptr) * b; - break; - case 2: - if (ABS(*ptr) < a) - *ptr = SGN(*ptr) * b; - break; - case 3: - if (*ptr > a) - *ptr = b; - break; - case 4: - if (*ptr < a) - *ptr = b; - break; - case 5: - if (*ptr < a) - *ptr = a; - else if (*ptr > b) - *ptr = b; - break; - case 6: - if (*ptra) - *ptr-=a; - else - *ptr=0; - } - } - } - } - - /** Count with threshold. - * - * This function returns the number of elements meeting the threshold - * condition. - */ - size_t countThreshold(const String& type, - T a, - T b, - MultidimArray * mask = NULL ) - { - int mode; - - if (type == "abs_above") - mode = 1; - else if (type == "abs_below") - mode = 2; - else if (type == "above") - mode = 3; - else if (type == "below") - mode = 4; - else if (type == "range") - mode = 5; - else - REPORT_ERROR(ERR_VALUE_INCORRECT, - formatString("CountThreshold: mode not supported (%s)", type.c_str())); - - size_t ret = 0; - - T* ptr=NULL; - size_t n; - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(*this,n,ptr) - if (mask == NULL || DIRECT_MULTIDIM_ELEM(*mask,n) > 0 ) - { - switch (mode) - { - case 1: - if (ABS(*ptr) > a) - ret++; - break; - case 2: - if (ABS(*ptr) < a) - ret++; - break; - case 3: - if (*ptr > a) - ret++; - break; - case 4: - if (*ptr < a) - ret++; - break; - case 5: - if (*ptr >= a && *ptr <= b) - ret++; - break; - } - } - return ret; - } - - /** Substitute a value by another. - * - * Substitute an old value by a new one. The accuracy is used to say if - * the value in the array is equal to the old value. Set it to 0 for - * perfect accuracy. - */ - void substitute(T oldv, - T newv, - double accuracy = XMIPP_EQUAL_ACCURACY, - MultidimArray * mask = NULL ) - { - T* ptr=NULL; - size_t n; - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(*this,n,ptr) - if (mask == NULL || DIRECT_MULTIDIM_ELEM(*mask,n) > 0 ) - if (ABS(*ptr - oldv) <= accuracy) - *ptr = newv; - } - - /** Substitute a given value by a sample from a Gaussian distribution. - * - * Substitute a given value by a sample from a Gaussian distribution. - * The accuracy is used to say if the value in the array is equal - * to the old value. Set it to 0 for perfect accuracy. - */ - void randomSubstitute(T oldv, - T avgv, - T sigv, - double accuracy = XMIPP_EQUAL_ACCURACY, - MultidimArray * mask = NULL ); - - /** Binarize. - * - * This functions substitutes all values in a volume which are greater - * than val+accuracy by 1 and the rest are set to 0. Use threshold to get a - * very powerful binarization. - */ - void binarize(double val = 0, - double accuracy = XMIPP_EQUAL_ACCURACY, - MultidimArray * mask = NULL ) - { - T* ptr=NULL; - size_t n; - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(*this,n,ptr) - if (mask == NULL || DIRECT_MULTIDIM_ELEM(*mask,n) > 0 ) - { - if (*ptr <= val + accuracy) - *ptr = 0; - else - *ptr = 1; - } - } - - /** Binarize using a range - * - * This functions substitutes all values in a volume which are in the range between valMin - * and valMax by 1 and the rest are set to 0. - */ - void binarizeRange(double valMin = 0, double valMax = 255, - MultidimArray * mask = NULL ) - { - T* ptr=NULL; - size_t n; - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(*this,n,ptr) - if (mask == NULL || DIRECT_MULTIDIM_ELEM(*mask,n) > 0 ) - { - if ( (*ptr < valMax) && (*ptr > valMin) ) - *ptr = 1; - else - *ptr = 0; - } - } - - /** ROUND - * - * Applies a ROUND (look for the nearest integer) to each array element. - */ - void selfROUND() - { - T* ptr=NULL; - size_t n; - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(*this,n,ptr) - *ptr = ROUND(*ptr); - } - - /** CEILING - * - * Applies a CEILING (look for the nearest larger integer) to each - * array element. - */ - void selfCEIL() - { - T* ptr=NULL; - size_t n; - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(*this,n,ptr) - *ptr = CEIL(*ptr); - } - - /** FLOOR - * - * Applies a FLOOR (look for the nearest larger integer) to each - * array element. - */ - void selfFLOOR() - { - T* ptr=NULL; - size_t n; - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(*this,n,ptr) - *ptr = FLOOR(*ptr); - } - - /** ABS - * - * Applies an ABS (absolute value) to each array element. - */ - void selfABS() - { - T* ptr=NULL; - size_t n; - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(*this,n,ptr) - *ptr = ABS(*ptr); - } - - /** Normalize the percentil interval values between -1 to 1 - * the normalization is done over a Npix number of pixels chosen at random - * - * v_sorted(minPerc) = -1 - * v_sorted(maxPerc) = 1 - */ - void selfNormalizeInterval(double minPerc=0.25, double maxPerc=0.75, int Npix=1000); - - /** MAX - * - * Each component of the result is the maximum of the correspoing - * components of the two input arrays. They must have the same shape, if - * not an exception is thrown - */ - friend void MultidimArrayMax(const MultidimArray& v1, const MultidimArray& v2, - MultidimArray& result) - { - if (!v1.sameShape(v2)) - REPORT_ERROR(ERR_MULTIDIM_SIZE, "MAX: arrays of different shape"); - - result.resizeNoCopy(v1); - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY(result) - DIRECT_MULTIDIM_ELEM(result,n) = XMIPP_MAX( - DIRECT_MULTIDIM_ELEM(v1,n), - DIRECT_MULTIDIM_ELEM(v2,n)); - } - - /** MIN - * - * Each component of the result is the minimum of the correspoing - * components of the two input arrays. They must have the same shape, if - * not an exception is thrown - */ - friend void MultidimArrayMIN(const MultidimArray& v1, const MultidimArray& v2, - MultidimArray& result) - { - if (!v1.sameShape(v2)) - REPORT_ERROR(ERR_MULTIDIM_SIZE, "MIN: arrays of different shape"); - - result.resizeNoCopy(v1); - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY(result) - DIRECT_MULTIDIM_ELEM(result,n) = XMIPP_MIN( - DIRECT_MULTIDIM_ELEM(v1,n), - DIRECT_MULTIDIM_ELEM(v2,n)); - } - - /** Sqrt. - * - * Each component of the result is the square root of the original - * component. - */ - void selfSQRT() - { - T* ptr=NULL; - size_t n; - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(*this,n,ptr) - *ptr = static_cast< T >(sqrt(static_cast< double >(*ptr))); - } - - /** Sum of matrix values. - * - * This function returns the sum of all internal values. - * - * @code - * double sum = m.sum(); - * @endcode - */ - double sum() const - { - double sum = 0; - T* ptr=NULL; - size_t n; - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(*this,n,ptr) - sum += *ptr; - return sum; - } - - /** Sum of squared vector values. - * - * This function returns the sum of all internal values to the second - * power. - * - * @code - * double sum2 = m.sum2(); - * @endcode - */ - double sum2() const - { - double sum = 0; - - // Unroll the loop - const size_t unroll=4; - size_t nmax=(NZYXSIZE(*this)/unroll)*unroll; - T* ptr = MULTIDIM_ARRAY(*this); - for (size_t n=0; n(log10(static_cast< double >(*ptr))); - } - - /** Log. - * - * Each component of the result is the log of the original components. - */ - void selfLog() - { - T* ptr=NULL; - size_t n; - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(*this,n,ptr) - *ptr = static_cast< T >(log(static_cast< double >(*ptr))); - } - - /** Reverse matrix values over X axis, keep in this object. - * - * Maybe better with an example: - * - *Odd case - * @code - * slice 0 - * [01 02 03 [07 08 09 - * 04 05 06 04 05 06 - * 07 08 09] 01 02 03] - * - * -----> - * - * slice 1 - * [11 12 13 [17 18 19 - * 14 15 16 14 15 16 - * 17 18 19] 11 12 13] - * @endcode - * - *Even case - * @code - * slice 0 - * [01 02 03 04 [01 04 03 02 - * 05 06 06 07 05 07 06 06 - * 08 09 10 11 08 11 10 09 - * 12 13 14 15] 12 15 14 13] - * - * @endcode - */ - void selfReverseX() - { - size_t xsize=XSIZE(*this); - size_t halfSizeX = (xsize-2)/2; - size_t xsize_1=xsize-1; - for (size_t k = 0; k < ZSIZE(*this); k++) - for (size_t i = 0; i < YSIZE(*this); i++) - for (size_t j = 0; j <=halfSizeX; j++) - { - T aux; - T& d1=DIRECT_ZYX_ELEM(*this, k, i, j); - T& d2=DIRECT_ZYX_ELEM(*this, k, i, xsize_1 - j); - SWAP(d1,d2,aux); - } - STARTINGX(*this) = -FINISHINGX(*this); - } - - /** Reverse matrix values over Y axis, keep in this object. - * - * Maybe better with an example: - * - * @code - * slice 0 - * [01 02 03 [07 08 09 - * 04 05 06 04 05 06 - * 07 08 09] 01 02 03] - * - * @endcode - * - */ - void selfReverseY() - { - size_t ysize=YSIZE(*this); - size_t halfSizeY = (ysize-2)/2; - size_t ysize_1=ysize-1; - for (size_t k = 0; k < ZSIZE(*this); k++) - for (size_t i = 0; i <= halfSizeY; i++) - for (size_t j = 0; j < XSIZE(*this); j++) - { - T aux; - T& d1=DIRECT_ZYX_ELEM(*this, k, i, j); - T& d2=DIRECT_ZYX_ELEM(*this, k, ysize_1 - i, j); - SWAP(d1,d2,aux); - } - STARTINGY(*this) = -FINISHINGY(*this); - } - - /** Reverse matrix values over Z axis, keep result in this object. - * - - * - */ - void selfReverseZ() - { - size_t zsize=ZSIZE(*this); - size_t halfSizeZ = (zsize-2)/2; - size_t zsize_1=zsize-1; - for (size_t k = 0; k <= halfSizeZ; k++) - for (size_t i = 0; i & profile) const - { - checkDimension(2); - profile.initZeros(N); - double tx_step = (double)(xF - x0) / (N - 1); - double ty_step = (double)(yF - y0) / (N - 1); - double tx = x0, ty = y0; - - for (int i = 0; i < N; i++) - { - profile(i) = interpolatedElement2D(tx, ty); - tx += tx_step; - ty += ty_step; - } - } - - /** Show using gnuplot - * - * This function uses gnuplot to plot this vector. You must supply the - * xlabel, ylabel, and title. - */ - void showWithGnuPlot(const String& xlabel, const String& title); - - /** Edit with xmipp_editor. - * - * This function generates a random filename starting with PPP and - * edits it with xmipp_editor. After closing the editor the file is - * removed. - */ - void edit(); - - /** Write to an ASCII file. - */ - void write(const FileName& fn) const; - //@} - - /// @name Operators - /// @{ - - /** Assignment. - * - * You can build as complex assignment expressions as you like. Multiple - * assignment is allowed. - * - * @code - * v1 = v2 + v3; - * v1 = v2 = v3; - * @endcode - * - * This function is ported to Python as assign. - */ - MultidimArray& operator=(const MultidimArray& op1) - { - if (&op1 != this) - { - if (data == NULL || !sameShape(op1)) - resizeNoCopy(op1); - memcpy(data,op1.data,MULTIDIM_SIZE(op1)*sizeof(T)); - } - return *this; - } - - /** Move assignment. - * - * You can build as complex assignment expressions as you like. Multiple - * assignment is allowed. - * - * @code - * v1 = v2 + v3; - * v1 = v2 = v3; - * @endcode - */ - MultidimArray& operator=(MultidimArray&& other) noexcept - { - if (&other != this) - { - coreDeallocate(); - coreInit(); - swap(other); - } - return *this; - } - - /** Assignment. - * - * You can build as complex assignment expressions as you like. Multiple - * assignment is allowed. - * - * @code - * v1 = v2 + v3; - * v1 = v2 = v3; - * @endcode - * - * This function is ported to Python as assign. - */ - MultidimArray& operator=(const Matrix2D& op1); - - /** Unary minus. - * - * It is used to build arithmetic expressions. You can make a minus - * of anything as long as it is correct semantically. - * - * @code - * v1 = -v2; - * v1 = -v2.transpose(); - * @endcode - */ - MultidimArray operator-() const - { - MultidimArray tmp(*this); - T* ptr; - size_t n; - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(tmp,n,ptr) - *ptr = -(*ptr); - return tmp; - } - - /** Input from input stream. - * - * Actual size of the array is used to know how many values must be read. - * - * @code - * v.<3); - * std::cin >> v; - * @endcode - * - * This function is not ported to Python. - */ - friend std::istream& operator>>(std::istream& in, MultidimArray& v) - { - T* ptr; - size_t n; - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(v,n,ptr) - in >> *ptr; - return in; - } - - void copy(Matrix2D& op1) const; - - /** Equality. - * - * Returns true if this object has got the same shape (origin and size) - * than the argument and the same values (within accuracy). - */ - bool equal(const MultidimArray& op, - double accuracy = XMIPP_EQUAL_ACCURACY) const - { - if (!sameShape(op) || data==NULL || op.data == NULL) - return false; - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY(*this) - { - if (fabs(DIRECT_MULTIDIM_ELEM(*this,n) - - DIRECT_MULTIDIM_ELEM(op,n)) > accuracy) - return false; - } - return true; - } - //@} -}; - - - -/// @name Functions for all multidimensional arrays -/// @{ - -/** Conversion from one type to another. - * - * If we have an integer array and we need a double one, we can use this - * function. The conversion is done through a type casting of each element - * If n >= 0, only the nth volumes will be converted, otherwise all NSIZE volumes - */ -template -void typeCast(const MultidimArray& v1, MultidimArray& v2) -{ - if (NZYXSIZE(v1) == 0) - { - v2.clear(); - return; - } - - v2.resizeNoCopy(v1); - T1* ptr1 = MULTIDIM_ARRAY(v1); - - // Unroll the loop - const size_t unroll=4; - size_t nmax=(NZYXSIZE(v1)/unroll)*unroll; - for (size_t n=0; n(*ptr1); - DIRECT_MULTIDIM_ELEM(v2,n+1) = static_cast< T2 >(*(ptr1+1)); - DIRECT_MULTIDIM_ELEM(v2,n+2) = static_cast< T2 >(*(ptr1+2)); - DIRECT_MULTIDIM_ELEM(v2,n+3) = static_cast< T2 >(*(ptr1+3)); - } - // Do the remaining elements - for (size_t n=nmax; n(*ptr1); -} - -template -void typeCastComplex(const MultidimArray& v1, MultidimArray >& v2) -{ - if (NZYXSIZE(v1) == 0) - { - v2.clear(); - return; - } - - v2.resizeNoCopy(v1); - T1* ptr1 = MULTIDIM_ARRAY(v1); - double * ptr2 = (double*) MULTIDIM_ARRAY(v2); - - // Unroll the loop - const size_t unroll=4; - size_t nmax=(NZYXSIZE(v1)/unroll)*unroll; - for (size_t n=0; n(*ptr1); - *(ptr2++) = 0; - *(ptr2++) = static_cast< double >(*(ptr1+1)); - *(ptr2++) = 0; - *(ptr2++) = static_cast< double >(*(ptr1+2)); - *(ptr2++) = 0; - *(ptr2++) = static_cast< double >(*(ptr1+3)); - *(ptr2++) = 0; - } - // Do the remaining elements - for (size_t n=nmax; n(*ptr1); - *(ptr2++) = 0; - } -} - -/** Conversion from one type to another. - * In some cases, the two types are the same. So a faster way is simply by assignment. - */ -template -void typeCast(const MultidimArray& v1, MultidimArray& v2) -{ - v2=v1; -} - -/** Assignment. - */ -template -void typeCast(const MultidimArray& v1, Matrix1D &v2) -{ - v2.resizeNoCopy(XSIZE(v1)); - memcpy(&VEC_ELEM(v2,0),&DIRECT_A1D_ELEM(v1,0),MULTIDIM_SIZE(v1)*sizeof(T)); - v2.row=false; -} - - -/** MultidimArray equality.*/ -template -bool operator==(const MultidimArray& op1, const MultidimArray& op2) -{ - return op1.equal(op2); -} - -/** MultidimArray inequality.*/ -template -bool operator!=(const MultidimArray& op1, const MultidimArray& op2) -{ - return !(op1==op2); -} - -/** Reduce both volumes to a common size. - * - * Search the range of logical indexes for which both volumes have got valid - * values, and cut both to that size, the corresponding origin is automatically - * computed. - * - * @code - * MultidimArray< double > V1(4, 5, 3); - * V1.startingX() = -2; - * V1.startingY() = -2; - * V1.startingZ() = -2; - * - * MultidimArray< double > V2(4, 2, 3); - * V2.startingX() = 0; - * V2.startingY() = 0; - * V2.startingZ() = 0; - * - * // V1 and V2 range from (0,0,0)=(z,y,x) to (1,1,0) - * cutToCommonSize(V1, V2); - * @endcode - */ -template -void cutToCommonSize(MultidimArray& V1, MultidimArray& V2) -{ - int z0 = XMIPP_MAX(STARTINGZ(V1), STARTINGZ(V2)); - int zF = XMIPP_MIN(FINISHINGZ(V1), FINISHINGZ(V2)); - int y0 = XMIPP_MAX(STARTINGY(V1), STARTINGY(V2)); - int yF = XMIPP_MIN(FINISHINGY(V1), FINISHINGY(V2)); - int x0 = XMIPP_MAX(STARTINGX(V1), STARTINGX(V2)); - int xF = XMIPP_MIN(FINISHINGX(V1), FINISHINGX(V2)); - - V1.window(z0, y0, x0, zF, yF, xF); - V2.window(z0, y0, x0, zF, yF, xF); -} - - -/** Get Sin and Cos of vector x. - */ -void sincos(const MultidimArray &x, MultidimArray &s, MultidimArray &c); - -/** Obtains the plane parameters z=p0+p1*x+p2*y. - */ -void planeFit(const MultidimArray &z, const MultidimArray &x, const MultidimArray &y, - double &p0, double &p1, double &p2); - -/* - mod Modulus after division. - mod(x,y) is x - n.*y where n = floor(x./y) if y ~= 0. If y is not an - integer and the quotient x./y is within roundoff error of an integer, - then n is that integer. The inputs x and y must be real arrays of the - same size, or real scalars. - - By convention: - MOD(x, m, 0) is m = x. - MOD(x,m,x) is m = 0. - MOD(x,m,y), for x~=y and y~=0, m has the same sign as y. - */ -template -void mod(const MultidimArray &x, MultidimArray &m, double y) -{ - m.resizeNoCopy(x); - double *ptr=NULL; - double *ptrm=MULTIDIM_ARRAY(m); - size_t n; - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(x,n,ptr) - *(ptrm++) = (*ptr) - std::floor((*ptr)/(y))*(y); -} - -/** Output to output stream. - * This function is not ported to Python. - */ -template -std::ostream& operator<< (std::ostream& ostrm, const MultidimArray& v) -{ - if (v.xdim == 0) - ostrm << "NULL Array\n"; - else - ostrm << std::endl; - - double max_val = ABS(DIRECT_A3D_ELEM(v , 0, 0, 0)); - - T* ptr; - size_t n; - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY_ptr(v,n,ptr) - max_val = XMIPP_MAX(max_val, ABS(*ptr)); - - int prec = bestPrecision(max_val, 10); - - if (YSIZE(v)==1 && ZSIZE(v)==1) - { - for (int j = STARTINGX(v); j <= FINISHINGX(v); j++) - ostrm << floatToString((double) A3D_ELEM(v, 0, 0, j), 10, prec) - << std::endl; - } - else - { - for (size_t l = 0; l < NSIZE(v); l++) - { - if (NSIZE(v)>1) - ostrm << "Image No. " << l << std::endl; - for (int k = STARTINGZ(v); k <= FINISHINGZ(v); k++) - { - if (ZSIZE(v)>1) - ostrm << "Slice No. " << k << std::endl; - for (int i = STARTINGY(v); i <= FINISHINGY(v); i++) - { - for (int j = STARTINGX(v); j <= FINISHINGX(v); j++) - { - ostrm << floatToString((double) A3D_ELEM(v, k, i, j), 10, prec) << ' '; - } - ostrm << std::endl; - } - } - } - } - - return ostrm; -} - -/** Extract piece from image. - * No check on boundaries are performed. - */ -template -void window2D(const MultidimArray &Ibig, MultidimArray &Ismall, - size_t y0, size_t x0, size_t yF, size_t xF); - -/** correlationIndex nD - * @ingroup Filters - */ -template -double correlationIndex(const MultidimArray< T >& x, - const MultidimArray< T >& y, - const MultidimArray< int >* mask = NULL, - MultidimArray< double >* Contributions = NULL) -{ - SPEED_UP_tempsInt; - - double retval = 0, aux; - double mean_x, mean_y; - double stddev_x, stddev_y; - - long N = 0; - - if (mask == NULL) - { - x.computeAvgStdev(mean_x, stddev_x); - y.computeAvgStdev(mean_y, stddev_y); - } - else - { - x.computeAvgStdev_within_binary_mask(*mask, mean_x,stddev_x); - y.computeAvgStdev_within_binary_mask(*mask, mean_y,stddev_y); - } - if (ABS(stddev_x) -std::ostream& operator<<(std::ostream& ostrm, const MultidimArray< std::complex >& v); -template<> -void MultidimArray< std::complex< double > >::computeDoubleMinMax(double& minval, double& maxval) const; -template<> -void MultidimArray< std::complex< double > >::computeDoubleMinMaxRange(double& minval, double& maxval, size_t pos, size_t size) const; -template<> -void MultidimArray< std::complex< double > >::rangeAdjust(std::complex< double > minF, std::complex< double > maxF); -template<> -double MultidimArray< std::complex< double > >::computeAvg() const; -template<> -void MultidimArray< std::complex< double > >::maxIndex(size_t &lmax, int& kmax, int& imax, int& jmax) const; -template<> -bool operator==(const MultidimArray< std::complex< double > >& op1, - const MultidimArray< std::complex< double > >& op2); -template<> -double MultidimArray::interpolatedElement2D(double x, double y, double outside_value) const; -template<> -void MultidimArray< std::complex< double > >::getReal(MultidimArray & realImg) const; -template<> -void MultidimArray< std::complex< double > >::getImag(MultidimArray & imagImg) const; - -//@} -#endif diff --git a/src/core/multidim_array_base.cpp b/src/core/multidim_array_base.cpp deleted file mode 100644 index dfdc627..0000000 --- a/src/core/multidim_array_base.cpp +++ /dev/null @@ -1,304 +0,0 @@ -/*************************************************************************** - * - * Authors: David Strelak (davidstrelak@gmail.com) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include "multidim_array_base.h" -#include "xmipp_error.h" -#include "xmipp_macros.h" -#include "matrix1d.h" - -void MultidimArrayBase::setNdim(int Ndim) -{ - ndim = Ndim; - nzyxdim=zyxdim*ndim; -} - -/** Sets new Z dimension. - * - * Note that the dataArray is NOT resized. This should be done separately with coreAllocate() - * - */ -void MultidimArrayBase::setZdim(int Zdim) -{ - zdim = Zdim; - zyxdim=yxdim*zdim; - nzyxdim=zyxdim*ndim; -} - -/** Sets new Y dimension. - * - * Note that the dataArray is NOT resized. This should be done separately with coreAllocate() - * - */ -void MultidimArrayBase::setYdim(int Ydim) -{ - ydim = Ydim; - yxdim=(size_t)ydim*xdim; - zyxdim=yxdim*zdim; - nzyxdim=zyxdim*ndim; -} - -/** Sets new X dimension. - * - * Note that the dataArray is NOT resized. This should be done separately with coreAllocate() - * - */ -void MultidimArrayBase::setXdim(int Xdim) -{ - xdim = Xdim; - yxdim=(size_t)ydim*xdim; - zyxdim=yxdim*zdim; - nzyxdim=zyxdim*ndim; -} - -/** Sets new 4D dimensions. - * Note that the dataArray is NOT resized. This should be done separately with coreAllocate() - */ -void MultidimArrayBase::setDimensions(int Xdim, int Ydim, int Zdim, size_t Ndim) -{ - if (((size_t)Xdim)*Ydim*Zdim*Ndim < 1) - REPORT_ERROR(ERR_MULTIDIM_SIZE, "Dimensions' size cannot be zero nor negative."); - ndim=Ndim; - zdim=Zdim; - ydim=Ydim; - xdim=Xdim; - yxdim=ydim*xdim; - zyxdim=zdim*yxdim; - nzyxdim=ndim*zyxdim; -} - -/** Sets new 4D dimensions. - * Note that the dataArray is NOT resized. This should be done separately with coreAllocate() - */ -void MultidimArrayBase::setDimensions(ArrayDim &newDim) -{ - if (newDim.ndim*newDim.zdim*newDim.ydim*newDim.xdim < 1) - REPORT_ERROR(ERR_MULTIDIM_SIZE, "Dimensions' size cannot be zero nor negative."); - ndim = newDim.ndim; - zdim = newDim.zdim; - ydim = newDim.ydim; - xdim = newDim.xdim; - - newDim.yxdim = yxdim = ydim*xdim; - newDim.zyxdim = zyxdim = zdim*yxdim; - newDim.nzyxdim = nzyxdim = ndim*zyxdim; -} - -/** Returns the multidimArray N,Z, Y and X dimensions. - * - * @code - * V.getDimensions(Xdim, Ydim, Zdim, Ndim); - * @endcode - */ -void MultidimArrayBase::getDimensions(size_t& Xdim, size_t& Ydim, size_t& Zdim, size_t &Ndim) const -{ - Xdim = xdim; - Ydim = ydim; - Zdim = zdim; - Ndim = ndim; -} - -void MultidimArrayBase::getDimensions(ArrayDim &adim) const -{ - adim.xdim = xdim; - adim.ydim = ydim; - adim.zdim = zdim; - adim.ndim = ndim; - adim.yxdim = yxdim; - adim.zyxdim = zyxdim; - adim.nzyxdim = nzyxdim; -} - -ArrayDim MultidimArrayBase::getDimensions() const -{ - ArrayDim adim; - adim.xdim = xdim; - adim.ydim = ydim; - adim.zdim = zdim; - adim.ndim = ndim; - adim.yxdim = yxdim; - adim.zyxdim = zyxdim; - adim.nzyxdim = nzyxdim; - - return adim; -} - -/** Get dimensions. - * - * Returns the size of the object in a 4D vector. If the object is a matrix - * or a vector, then the higher order dimensions will be set to 1, ie, - * (Xdim, 1, 1) or (Xdim, Ydim, 1). - * - * This function is not ported to Python. - */ -void MultidimArrayBase::getDimensions(int* size) const -{ - size[0] = xdim; - size[1] = ydim; - size[2] = zdim; - size[3] = ndim; -} - -/** Returns the total size of the multidimArray - * - * @code - * if (V.getSize() > 1) ... - * @endcode - */ -size_t MultidimArrayBase::getSize() const -{ - return nzyxdim; -} - -/** Resize the multidimarray from an ArrayDim struct - * - */ -void MultidimArrayBase::resize(ArrayDim &adim, bool copy) -{ - setDimensions(adim); - resize(adim.ndim, adim.zdim, adim.ydim, adim.xdim, copy); -} - -/** Copy the shape parameters - * - */ -void MultidimArrayBase::copyShape(const MultidimArrayBase &m) -{ - ndim=m.ndim; - zdim=m.zdim; - ydim=m.ydim; - xdim=m.xdim; - yxdim=m.yxdim; - zyxdim=m.zyxdim; - nzyxdim=m.nzyxdim; - zinit=m.zinit; - yinit=m.yinit; - xinit=m.xinit; -} - -void MultidimArrayBase::setXmippOrigin() -{ - zinit = FIRST_XMIPP_INDEX(zdim); - yinit = FIRST_XMIPP_INDEX(ydim); - xinit = FIRST_XMIPP_INDEX(xdim); -} - -void MultidimArrayBase::resetOrigin() -{ - zinit = yinit = xinit = 0; -} - -void MultidimArrayBase::moveOriginTo(int k, int i, int j) -{ - zinit = k + FIRST_XMIPP_INDEX(zdim); - yinit = i + FIRST_XMIPP_INDEX(ydim); - xinit = j + FIRST_XMIPP_INDEX(xdim); -} - -void MultidimArrayBase::moveOriginTo(int i, int j) -{ - yinit = i + FIRST_XMIPP_INDEX(ydim); - xinit = j + FIRST_XMIPP_INDEX(xdim); -} - -/** IsCorner (in 2D or 3D matrix) - * - * TRUE if the logical index given is a corner of the definition region of this - * array. - */ -bool MultidimArrayBase::isCorner(const Matrix1D< double >& v) const -{ - - if (v.size() < 2) - REPORT_ERROR(ERR_MATRIX_SIZE, "isCorner: index vector has got not enough components"); - - else if (ZSIZE(*this)==1) - return ((XX(v) == STARTINGX(*this) && YY(v) == STARTINGY(*this)) || - (XX(v) == STARTINGX(*this) && YY(v) == FINISHINGY(*this)) || - (XX(v) == FINISHINGX(*this) && YY(v) == STARTINGY(*this)) || - (XX(v) == FINISHINGX(*this) && YY(v) == FINISHINGY(*this))); - else if (ZSIZE(*this)>1) - return ((XX(v) == STARTINGX(*this) && YY(v) == STARTINGY(*this) && ZZ(v) == STARTINGZ(*this)) || - (XX(v) == STARTINGX(*this) && YY(v) == FINISHINGY(*this) && ZZ(v) == STARTINGZ(*this)) || - (XX(v) == FINISHINGX(*this) && YY(v) == STARTINGY(*this) && ZZ(v) == STARTINGZ(*this)) || - (XX(v) == FINISHINGX(*this) && YY(v) == FINISHINGY(*this) && ZZ(v) == STARTINGZ(*this)) || - (XX(v) == STARTINGX(*this) && YY(v) == STARTINGY(*this) && ZZ(v) == FINISHINGZ(*this)) || - (XX(v) == STARTINGX(*this) && YY(v) == FINISHINGY(*this) && ZZ(v) == FINISHINGZ(*this)) || - (XX(v) == FINISHINGX(*this) && YY(v) == STARTINGY(*this) && ZZ(v) == FINISHINGZ(*this)) || - (XX(v) == FINISHINGX(*this) && YY(v) == FINISHINGY(*this) && ZZ(v) == FINISHINGZ(*this))); - else - REPORT_ERROR(ERR_MATRIX_SIZE, formatString("isCorner: index vector has too many components. dimV= %lu matrix dim = %i", v.size(), XSIZE(*this))); -} - -/** Outside - * - * TRUE if the logical index given is outside the definition region of this - * array. - */ -bool MultidimArrayBase::outside(const Matrix1D &r) const -{ - if (r.size() < 1) - { - REPORT_ERROR(ERR_MATRIX_SIZE, "Outside: index vector has not got enough components"); - } - else if (r.size()==1) - { - return (XX(r) < STARTINGX(*this) || XX(r) > FINISHINGX(*this)); - } - else if (r.size()==2) - { - return (XX(r) < STARTINGX(*this) || XX(r) > FINISHINGX(*this) || - YY(r) < STARTINGY(*this) || YY(r) > FINISHINGY(*this)); - } - else if (r.size()==3) - { - return (XX(r) < STARTINGX(*this) || XX(r) > FINISHINGX(*this) || - YY(r) < STARTINGY(*this) || YY(r) > FINISHINGY(*this) || - ZZ(r) < STARTINGZ(*this) || ZZ(r) > FINISHINGZ(*this)); - } - else - REPORT_ERROR(ERR_MATRIX_SIZE,"Outside: index vector has too many components"); -} - -void MultidimArrayBase::printShape(std::ostream& out) const -{ - if (NSIZE(*this) > 1) - out << " Number of images = "<1) - out<< " Size(Z,Y,X): " << ZSIZE(*this) << "x" << YSIZE(*this) << "x" << XSIZE(*this) - << " k=[" << STARTINGZ(*this) << ".." << FINISHINGZ(*this) << "]" - << " i=[" << STARTINGY(*this) << ".." << FINISHINGY(*this) << "]" - << " j=[" << STARTINGX(*this) << ".." << FINISHINGX(*this) << "]"; - else if (YSIZE(*this)>1) - out<< " Size(Y,X): " << YSIZE(*this) << "x" << XSIZE(*this) - << " i=[" << STARTINGY(*this) << ".." << FINISHINGY(*this) << "]" - << " j=[" << STARTINGX(*this) << ".." << FINISHINGX(*this) << "]"; - else if (XSIZE(*this)>1) - out<< " Size(X): " << XSIZE(*this) - << " j=[" << STARTINGX(*this) << ".." << FINISHINGX(*this) << "]"; - else - out << " Empty MultidimArray!"; - out<<"\n"; -} diff --git a/src/core/multidim_array_base.h b/src/core/multidim_array_base.h deleted file mode 100644 index f576a58..0000000 --- a/src/core/multidim_array_base.h +++ /dev/null @@ -1,1078 +0,0 @@ -/*************************************************************************** - * - * Authors: David Strelak (davidstrelak@gmail.com) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef XMIPPCORE_CORE_MULTIDIM_ARRAY_BASE_H_ -#define XMIPPCORE_CORE_MULTIDIM_ARRAY_BASE_H_ - -#include -#include -#include "xmipp_array_dim.h" -#include "xmipp_array_coord.h" - -template -class Matrix1D; - -/** @name MultidimArraysSpeedUp Speed up macros - * - * This macros are defined to allow high speed in critical parts of your - * program. They shouldn't be used systematically as usually there is no - * checking on the correctness of the operation you are performing. Speed comes - * from three facts: first, they are macros and no function call is performed - * (although most of the critical functions are inline functions), there is no - * checking on the correctness of the operation (it could be wrong and you are - * not warned of it), and destination vectors are not returned saving time in - * the copy constructor and in the creation/destruction of temporary vectors. - */ -//@{ -/** Returns the first X valid logical index - */ -#define STARTINGX(v) ((v).xinit) - -/** Returns the last X valid logical index - */ -#define FINISHINGX(v) ((v).xinit + (int)(v).xdim - 1) - -/** Returns the first Y valid logical index - */ -#define STARTINGY(v) ((v).yinit) - -/** Returns the last Y valid logical index - */ -#define FINISHINGY(v) ((v).yinit + (int)(v).ydim - 1) - -/** Returns the first Z valid logical index - */ -#define STARTINGZ(v) ((v).zinit) - -/** Returns the last Z valid logical index - */ -#define FINISHINGZ(v) ((v).zinit + (int)(v).zdim - 1) - -/** Check if x is inside logical bounds - */ -#define INSIDEX(v, x) ((x) >= STARTINGX(v) && (x) <= FINISHINGX(v)) -/** Check if y is inside logical bounds - */ -#define INSIDEY(v, y) ((y) >= STARTINGY(v) && (y) <= FINISHINGY(v)) -/** Check if z is inside logical bounds - */ -#define INSIDEZ(v, z) ((z) >= STARTINGZ(v) && (z) <= FINISHINGZ(v)) -/** Check if a position x, y is inside the logical index bounds - */ -#define INSIDEXY(v, x, y) (INSIDEX(v, x) && INSIDEY(v, y)) -/** Check if a position x, y is inside the logical index bounds - */ -#define INSIDEXYZ(v, x, y, z) (INSIDEX(v, x) && INSIDEY(v, y) && INSIDEZ(v,z)) - -/** Access to X dimension (size) - */ -#define XSIZE(v) ((v).xdim) - -/** Access to Y dimension (size) - */ -#define YSIZE(v) ((v).ydim) - -/** Access to Z dimension (size) - */ -#define ZSIZE(v) ((v).zdim) - -/** Access to N dimension (size) - */ -#define NSIZE(v) ((v).ndim) - -/** Access to XY dimension (Ysize*Xsize) - */ -#define YXSIZE(v) ((v).yxdim) - -/** Access to XYZ dimension (Zsize*Ysize*Xsize) - */ -#define ZYXSIZE(v) ((v).zyxdim) - -/** Access to XYZN dimension (Nsize*Zsize*Ysize*Xsize) - */ -#define MULTIDIM_SIZE(v) ((v).nzyxdim) - -/** Access to XYZN dimension (Nsize*Zsize*Ysize*Xsize) - */ -#define NZYXSIZE(v) ((v).nzyxdim) - -/** Array access. - * - * This macro gives you access to the array (T **) - */ -#ifndef MULTIDIM_ARRAY -#define MULTIDIM_ARRAY(v) ((v).data) -#endif - -/** Access to a direct element. - * v is the array, l is the image, k is the slice, i is the Y index and j is the X index. - * i and j) within the slice. - */ -#define DIRECT_NZYX_ELEM(v, l, k, i, j) ((v).data[(l)*ZYXSIZE(v)+(k)*YXSIZE(v)+((i)*XSIZE(v))+(j)]) - -/** Access to a direct element. - * v is the array, l is the image, k is the slice, i is the Y index and j is the X index. - * i and j) within the slice. - */ -#define DIRECT_ZYX_ELEM(v, k, i, j) ((v).data[(k)*YXSIZE(v)+((i)*XSIZE(v))+(j)]) - -/** Access to a direct element. - * v is the array, l is the image, k =0, i is the Y index and j is the X index. - * i and j) within the slice. - */ -#define DIRECT_N_YX_ELEM(v, l, i, j) ((v).data[(l)*ZYXSIZE(v) +((i)*XSIZE(v))+(j)]) -/** Access to a direct element. - * v is the array, l is the image, k =0, i = 0 and j is the X index. - * i and j) within the slice. - */ -#define DIRECT_N__X_ELEM(v, l, j) ((v).data[(l)*ZYXSIZE(v)+(j)]) - -/** Multidim element: Logical access. - */ -#define NZYX_ELEM(v, l, k, i, j) \ - DIRECT_NZYX_ELEM((v), (l), (k) - STARTINGZ(v), (i) - STARTINGY(v), (j) - STARTINGX(v)) - -/** Access to a direct element. - * v is the array, k is the slice and n is the number of the pixel (combined i and j) - * within the slice. - */ -#define DIRECT_MULTIDIM_ELEM(v,n) ((v).data[(n)]) - -/** For all direct elements in the array - * - * This macro is used to generate loops for the array in an easy manner. It - * defines an internal index 'n' which goes over the slices and 'n' that - * goes over the pixels in each slice. - * - * @code - * FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY(v) - * { - * std::cout << DIRECT_MULTIDIM_ELEM(v,n) << " "; - * } - * @endcode - */ -#define FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY(v) \ - for (size_t n=0; n V1(10, 10, 10), V2(20, 20, 20); - * V1.setXmippOrigin(); - * V2.setXmippOrigin(); - * - * FOR_ALL_ELEMENTS_IN_COMMON_IN_ARRAY3D(V1, V2) - * { - * // ... - * } - * @endcode - */ -#define FOR_ALL_ELEMENTS_IN_COMMON_IN_ARRAY3D(V1, V2) \ - ispduptmp0 = XMIPP_MAX(STARTINGZ(V1), STARTINGZ(V2)); \ - ispduptmp1 = XMIPP_MIN(FINISHINGZ(V1),FINISHINGZ(V2)); \ - ispduptmp2 = XMIPP_MAX(STARTINGY(V1), STARTINGY(V2)); \ - ispduptmp3 = XMIPP_MIN(FINISHINGY(V1),FINISHINGY(V2)); \ - ispduptmp4 = XMIPP_MAX(STARTINGX(V1), STARTINGX(V2)); \ - ispduptmp5 = XMIPP_MIN(FINISHINGX(V1),FINISHINGX(V2)); \ - for (int k=ispduptmp0; k<=ispduptmp1; ++k) \ - for (int i=ispduptmp2; i<=ispduptmp3; ++i) \ - for (int j=ispduptmp4; j<=ispduptmp5; ++j) - -/** For all direct elements in the array. - * - * This macro is used to generate loops for the volume in an easy way. It - * defines internal indexes 'k','i' and 'j' which ranges the volume using its - * physical definition. - * - * @code - * FOR_ALL_DIRECT_ELEMENTS_IN_ARRAY3D(V) - * { - * std::cout << DIRECT_A3D_ELEM(m, k, i, j) << " "; - * } - * @endcode - */ -#define FOR_ALL_DIRECT_ELEMENTS_IN_ARRAY3D(V) \ - for (size_t k=0; k m1(10, 10), m2(20, 20); - * m1.setXmippOrigin(); - * m2.setXmippOrigin(); - * - * FOR_ALL_ELEMENTS_IN_COMMON_IN_ARRAY2D(m1, m2) - * { - * ... - * } - * @endcode - */ -#define FOR_ALL_ELEMENTS_IN_COMMON_IN_ARRAY2D(m1, m2) \ - ispduptmp2 = XMIPP_MAX(STARTINGY(m1), STARTINGY(m2)); \ - ispduptmp3 = XMIPP_MIN(FINISHINGY(m1), FINISHINGY(m2)); \ - ispduptmp4 = XMIPP_MAX(STARTINGX(m1), STARTINGX(m2)); \ - ispduptmp5 = XMIPP_MIN(FINISHINGX(m1), FINISHINGX(m2)); \ - for (int i=ispduptmp2; i<=ispduptmp3; ++i) \ - for (int j=ispduptmp4; j<=ispduptmp5; ++j) - -/** For all elements in the array between corners. - * - * This macro is used to generate loops for a volume in an easy manner. Then - * ZZ(r), YY(r) and XX(r) range from - * - * (int) ZZ(corner1) to (int)ZZ(corner2), - * (int) YY(corner1) to (int)YY(corner2), - * (int) XX(corner1) to (int) XX(corner2) (included limits) respectively. - * - * Notice that corner1 and corner2 need only be MultidimArray. - * - * @code - * MultidimArray< double > corner1(3), corner2(3), r(3); - * XX(corner1) = -1; XX(corner2) = 1; - * YY(corner1) = -2; YY(corner2) = 2; - * ZZ(corner1) = -3; ZZ(corner2) = 3; - * - * FOR_ALL_ELEMENTS_IN_ARRAY3D_BETWEEN(corner1, corner2) - * { - * std::cout << v(r) << " "; - * } - * @endcode - */ -#define FOR_ALL_ELEMENTS_IN_ARRAY3D_BETWEEN(corner1, corner2) \ - for (ZZ(r)=ZZ((corner1)); ZZ(r)<=ZZ((corner2)); ++ZZ(r)) \ - for (YY(r)=YY((corner1)); YY(r)<=YY((corner2)); ++YY(r)) \ - for (XX(r)=XX((corner1)); XX(r)<=XX((corner2)); ++XX(r)) - -/** For all elements in the array between corners - * - * This macro is used to generate loops for a matrix in an easy manner. It needs - * an externally defined MultidimArray< double > r(2). Then YY(r) and XX(r) range - * from (int) YY(corner1) to (int)YY(corner2), (int) XX(corner1) to (int) - * XX(corner2) (included limits) respectively. Notice that corner1 and corner2 - * need only be MultidimArray. - * - * @code - * MultidimArray< double > corner1(2), corner2(2); - * MultidimArray< int > r(2); - * XX(corner1) = -1; - * XX(corner2) = 1; - * YY(corner1) = -2; - * YY(corner2) = 2; - * - * FOR_ALL_ELEMENTS_IN_ARRAY2D_BETWEEN(corner1, corner2) - * { - * std::cout << v(r) << " "; - * } - * @endcode - */ -#define FOR_ALL_ELEMENTS_IN_ARRAY2D_BETWEEN(corner1, corner2) \ - for (YY(r)=YY((corner1)); YY(r)<=YY((corner2)); ++YY(r)) \ - for (XX(r)=XX((corner1)); XX(r)<=XX((corner2)); ++XX(r)) - -/** For all elements in the array between corners - * - * This macro is used to generate loops for a vector in an easy manner. It needs - * an externally defined MultidimArray< double > r(1). Then XX(r) ranges from - * (int) XX(corner1) to (int) XX(corner2) (included limits) (notice that corner1 - * and corner2 need only to be MultidimArray). - * - * @code - * MultidimArray< double > corner1(1), corner2(1), r(1); - * XX(corner1) = -1; - * XX(corner2) = 1; - * FOR_ALL_ELEMENTS_IN_ARRAY1D_BETWEEN(corner1, corner2) - * { - * std::cout << v(XX(r)) << " "; - * } - * @endcode - */ -#define FOR_ALL_ELEMENTS_IN_ARRAY1D_BETWEEN(corner1, corner2) \ - for (XX(r)=(int) XX((corner1)); XX(r)<=(int) XX((corner2)); ++XX(r)) - -/** For all elements in the array, accessed physically - * - * This macro is used to generate loops for the matrix in an easy way using - * physical indexes. It defines internal indexes 'i' and 'j' which ranges the - * matrix using its physical definition. - * - * @code - * FOR_ALL_DIRECT_ELEMENTS_IN_ARRAY2D(m) - * { - * std::cout << DIRECT_A2D_ELEM(m, i, j) << " "; - * } - * @endcode - */ -#define FOR_ALL_DIRECT_ELEMENTS_IN_ARRAY2D(m) \ - for (size_t i=0; i v1(10), v2(20); - * v1.setXmippOrigin(); - * v2.setXmippOrigin(); - * - * FOR_ALL_ELEMENTS_IN_COMMON_IN_ARRAY1D(v1, v2) - * { - * ... - * } - * @endcode - */ -#define FOR_ALL_ELEMENTS_IN_COMMON_IN_ARRAY1D(v1, v2) \ - ispduptmp4 = XMIPP_MAX(STARTINGX(v1), STARTINGX(v2)); \ - ispduptmp5 = XMIPP_MIN(FINISHINGX(v1), FINISHINGX(v2)); \ - for (int i=ispduptmp4; i<=ispduptmp5; ++i) - -/** For all elements in the array, accessed physically - * - * This macro is used to generate loops for the vector in an easy way using - * physical indexes. It defines internal the index 'i' which ranges the vector - * using its physical definition. - * - * @code - * FOR_ALL_DIRECT_ELEMENTS_IN_ARRAY1D(v) - * { - * std::cout << DIRECT_A2D_ELEM(v, i) << " "; - * } - * @endcode - */ -#define FOR_ALL_DIRECT_ELEMENTS_IN_ARRAY1D(v) \ - for (size_t i=0; i FINISHINGX(*this) || \ - (i) < STARTINGY(*this) || (i) > FINISHINGY(*this)) - -/** Macro to check whether a point is inside or outside a given matrix. */ -#define OUTSIDE3D(k, i,j) \ - ((j) < STARTINGX(*this) || (j) > FINISHINGX(*this) || \ - (i) < STARTINGY(*this) || (i) > FINISHINGY(*this) || \ - (k) < STARTINGZ(*this) || (k) > FINISHINGZ(*this)) -//@} - -// Look up table lenght to be used in interpolation. -#define LOOKUP_TABLE_LEN 6 - - -/** Template class for Xmipp arrays. - * This class provides physical and logical access. -*/ -class MultidimArrayBase -{ -public: - // Destroy data - bool destroyData; - - // Number of images - size_t ndim; - - // Number of elements in Z - size_t zdim; - - // Number of elements in Y - size_t ydim; - - // Number of elements in X - size_t xdim; - - // Number of elements in YX - size_t yxdim; - - // Number of elements in ZYX - size_t zyxdim; - - // Number of elements in NZYX - size_t nzyxdim; - - // Z init - int zinit; - - // Y init - int yinit; - - // X init - int xinit; - - //Alloc memory or map to a file - bool mmapOn; - //Mapped file handler - FILE* mFd; - // Number of elements in NZYX in allocated memory - size_t nzyxdimAlloc; -public: - virtual ~MultidimArrayBase() - {} - - // Virtual declarations to be used from MultidimArrayGeneric - virtual void clear() = 0; - virtual void selfReverseX() = 0; - virtual void selfReverseY() = 0; - virtual void selfReverseZ() = 0; - virtual double computeAvg() const = 0; - virtual void computeDoubleMinMaxRange(double& minval, double& maxval,size_t offset, size_t size) const = 0; - virtual void maxIndex(size_t &lmax, int& kmax, int& imax, int& jmax) const = 0; - virtual void coreAllocateReuse() = 0; - virtual void coreDeallocate()= 0; - - /* return the value of the data pointer - */ - virtual void * getArrayPointer() const = 0; - - /// @name Size - //@{ - - /** Sets new N dimension. - * - * Note that the dataArray is NOT resized. This should be done separately with coreAllocate() - */ - void setNdim(int Ndim); - - /** Sets new Z dimension. - * - * Note that the dataArray is NOT resized. This should be done separately with coreAllocate() - * - */ - void setZdim(int Zdim); - - /** Sets new Y dimension. - * - * Note that the dataArray is NOT resized. This should be done separately with coreAllocate() - * - */ - void setYdim(int Ydim); - - /** Sets new X dimension. - * - * Note that the dataArray is NOT resized. This should be done separately with coreAllocate() - * - */ - void setXdim(int Xdim); - - /** Sets new 4D dimensions. - * Note that the dataArray is NOT resized. This should be done separately with coreAllocate() - */ - void setDimensions(int Xdim, int Ydim, int Zdim, size_t Ndim); - - /** Sets new 4D dimensions. - * Note that the dataArray is NOT resized. This should be done separately with coreAllocate() - */ - void setDimensions(ArrayDim &newDim); - - /** Get the array dimensions. - */ - void getDimensions(size_t& Xdim, size_t& Ydim, size_t& Zdim, size_t &Ndim) const; - void getDimensions(ArrayDim &idim) const; - ArrayDim getDimensions() const; - - - /** Get dimensions. - * - * Returns the size of the object in a 4D vector. If the object is a matrix - * or a vector, then the higher order dimensions will be set to 1, ie, - * (Xdim, 1, 1) or (Xdim, Ydim, 1). - * - * This function is not ported to Python. - */ - void getDimensions(int* size) const; - - /** Returns the total size of the multidimArray - * - * @code - * if (V.getSize() > 1) ... - * @endcode - */ - size_t getSize() const; - - /** Resize to a given size - * - * This function resize the actual array to the given size. The origin is - * not modified. If the actual array is larger than the pattern then the - * values outside the new size are lost, if it is smaller then 0's are - * added. An exception is thrown if there is no memory. - * - * @code - * V1.resize(3, 3, 2); - * @endcode - */ - virtual void resize(size_t Ndim, size_t Zdim, size_t Ydim, size_t Xdim, bool copy=true) = 0; - - /** Resize a single 3D image - * - * This function assumes n is 1 - * @code - * V1.resize(3, 3, 2); - * @endcode - */ - void resize(size_t Zdim, size_t Ydim, size_t Xdim) - { - resize(1, Zdim, Ydim, Xdim); - } - - /** Resize a single 2D image - * - * This function assumes n and z are 1 - * @code - * V1.resize(3, 2); - * @endcode - */ - void resize(size_t Ydim, size_t Xdim) - { - resize(1, 1, Ydim, Xdim); - } - - /** Resize a single 1D image - * - * This function assumes n and z and y are 1 - * @code - * V1.resize(2); - * @endcode - */ - void resize(size_t Xdim) - { - resize(1, 1, 1, Xdim); - } - - /** Resize an image using the dimensions - * from an ArrayDim structure. - */ - void resize(ArrayDim &adim, bool copy=true); - - /** Resize with no copy a single 3D image - */ - void resizeNoCopy(size_t Ndim, size_t Zdim, size_t Ydim, size_t Xdim) - { - resize(Ndim, Zdim, Ydim, Xdim, false); - } - - /** Resize with no copy a single 3D image - */ - void resizeNoCopy(size_t Zdim, size_t Ydim, size_t Xdim) - { - resize(1, Zdim, Ydim, Xdim, false); - } - - /** Resize a single 2D image with no copy - */ - void resizeNoCopy(size_t Ydim, size_t Xdim) - { - resize(1, 1, Ydim, Xdim, false); - } - - /** Resize a single 1D image with no copy - */ - void resizeNoCopy(size_t Xdim) - { - resize(1, 1, 1, Xdim, false); - } - - /** Returns Y dimension. - */ - inline size_t rowNumber() const - { - return ydim; - } - - /** Returns X dimension. - */ - inline size_t colNumber() const - { - return xdim; - } - - /** Copy the shape parameters - * - */ - void copyShape(const MultidimArrayBase &m); - - /** Same shape. - * - * Returns true if this object has got the same shape (origin and size) - * than the argument - */ - inline bool sameShape(const MultidimArrayBase &op) const - { - return (NSIZE(*this) == NSIZE(op) && - XSIZE(*this) == XSIZE(op) && - YSIZE(*this) == YSIZE(op) && - ZSIZE(*this) == ZSIZE(op) && - STARTINGX(*this) == STARTINGX(op) && - STARTINGY(*this) == STARTINGY(op) && - STARTINGZ(*this) == STARTINGZ(op)); - } - - /** Set logical origin in Xmipp fashion. - * - * This function adjust the starting points in the array such that the - * center of the array is defined in the Xmipp fashion. - * - * @code - * V.setXmippOrigin(); - * @endcode - */ - void setXmippOrigin(); - - /** Reset logical origin to zeros. - * - * This function adjust the starting points in the array such - * that upper left corner begins in zero. - * - * @code - * V.resetOrigin(); - * @endcode - */ - void resetOrigin(); - - /** Move origin to. - * - * This function adjust logical indexes such that the Xmipp origin of the - * array moves to the specified position. For instance, an array whose x - * indexes go from -1 to 1, if we move the origin to 4, then the x indexes - * go from 3 to 5. This is very useful for convolution operations where you - * only need to move the logical starting of the array. - * - */ - void moveOriginTo(int k, int i, int j); - - /** Move origin to. - * - * This function adjust logical indexes such that the Xmipp origin of the - * array moves to the specified position. For instance, an array whose x - * indexes go from -1 to 1, if we move the origin to 4, then the x indexes - * go from 3 to 5. This is very useful for convolution operations where you - * only need to move the logical starting of the array. - * - */ - void moveOriginTo(int i, int j); - - /** Returns the first valid logical Z index. - */ - inline int startingZ() const - { - return zinit; - } - - /** Returns the last valid logical Z index. - */ - inline int finishingZ() const - { - return zinit + zdim - 1; - } - - /** Returns the first valid logical Y index. - */ - inline int startingY() const - { - return yinit; - } - - /** Returns the last valid logical Y index. - */ - inline int finishingY() const - { - return yinit + ydim - 1; - } - - /** Returns the first valid logical X index. - */ - inline int startingX() const - { - return xinit; - } - - /** Returns the last valid logical X index. - */ - inline int finishingX() const - { - return xinit + xdim - 1; - } - - /** IsCorner (in 2D or 3D matrix) - * - * TRUE if the logical index given is a corner of the definition region of this - * array. - */ - bool isCorner(const Matrix1D< double >& v) const; - - /** Outside for 3D matrices - * - * TRUE if the logical index given is outside the definition region of this - * array. - */ - inline bool outside(int k, int i, int j) const - { - return (j < STARTINGX(*this) || j > FINISHINGX(*this) || - i < STARTINGY(*this) || i > FINISHINGY(*this) || - k < STARTINGZ(*this) || k > FINISHINGZ(*this)); - } - - /** Outside for 2D matrices - * - * TRUE if the logical index given is outside the definition region of this - * array. - */ - inline bool outside(int i, int j) const - { - return (j < STARTINGX(*this) || j > FINISHINGX(*this) || - i < STARTINGY(*this) || i > FINISHINGY(*this)); - } - - /** Outside for 1D matrices - * - * TRUE if the logical index given is outside the definition region of this - * array. - */ - inline bool outside(int i) const - { - return (i < STARTINGX(*this) || i > FINISHINGX(*this)); - } - - /** Outside - * - * TRUE if the logical index given is outside the definition region of this - * array. - */ - bool outside(const Matrix1D &r) const; - - //@} - - - /** Returns the multidimArray dimension. - * - * @code - * int dim = V.getDim(); - * @endcode - */ - inline int getDim() const - { - if (NZYXSIZE(*this) < 1) - return 0; - if (NSIZE(*this) > 1) - return 4; - if (ZSIZE(*this) > 1) - return 3; - if (YSIZE(*this) > 1) - return 2; - return 1; - } - - /** Sets mmap. - * - * Sets on/off mmap flag to allocate memory in a file. - * - */ - void setMmap(bool mmap) - { - coreDeallocate(); - mmapOn = mmap; - } - - void maxIndex(ArrayCoord &pos) const - { - maxIndex(pos.n, pos.z, pos.y, pos.x); - } - - /** 3D Indices for the maximum element. - * - * This function just calls to the 4D function - */ - void maxIndex(int& kmax, int& imax, int& jmax) const - { - size_t dum; - maxIndex(dum, kmax, imax, jmax); - } - - /** 2D Indices for the maximum element. - * - * This function just calls to the 4D function - */ - void maxIndex(int& imax, int& jmax) const - { - size_t dum; - int idum; - maxIndex(dum, idum, imax, jmax); - } - - /** 1D Indices for the maximum element. - * - * This function just calls to the 4D function - */ - void maxIndex(int& jmax) const - { - size_t dum; - int idum; - maxIndex(dum, idum, idum, jmax); - } - - /** Print shape of multidimensional array. - * - * This function shows the size, starting and finishing indexes of the - * given array. No end of line is printed neither at the beginning nor - * the end. - * - * @code - * v.printShape(); - * - * std::ofstream fh; - * ...; - * v.printShape(fh); - * @endcode - */ - void printShape(std::ostream& out = std::cout) const; -}; - -#endif /* XMIPPCORE_CORE_MULTIDIM_ARRAY_BASE_H_ */ diff --git a/src/core/multidim_array_generic.cpp b/src/core/multidim_array_generic.cpp deleted file mode 100644 index a36e5a5..0000000 --- a/src/core/multidim_array_generic.cpp +++ /dev/null @@ -1,170 +0,0 @@ -/*************************************************************************** - * Authors: Joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include "multidim_array_generic.h" - -MultidimArrayGeneric::MultidimArrayGeneric(MultidimArrayBase* array, DataType _datatype) -{ - im = array; - datatype = _datatype; - destroyData = false; -} - -MultidimArrayGeneric::MultidimArrayGeneric(MultidimArrayGeneric &mdim, int select_slice) -{ - init(); - setDatatype(mdim.datatype); - -#define ALIAS(type) ((MultidimArray*)(im))->aliasSlice(*((MultidimArray*)mdim.im), select_slice); - - SWITCHDATATYPE(mdim.datatype, ALIAS) -#undef ALIAS -} - -MultidimArrayGeneric::~MultidimArrayGeneric() -{ - if (im != NULL && destroyData) - delete im; -} -void MultidimArrayGeneric::init() -{ - im = NULL; - datatype = DT_Unknown; - destroyData = true; -} - -void MultidimArrayGeneric::clear() -{ - if (im != NULL && destroyData) - { - im->clear(); - delete im; - init(); - } -} - -void MultidimArrayGeneric::link(MultidimArrayBase* array) -{ - im = array; - destroyData = false; -} - - -void MultidimArrayGeneric::setDatatype(DataType imgType) -{ - clear(); - datatype = imgType; - destroyData = true; - - switch (datatype) - { - case DT_Float: - { - MultidimArray *imT = new MultidimArray; - im = imT; - } - break; - case DT_UInt: - { - MultidimArray *imT = new MultidimArray; - im = imT; - } - break; - case DT_Int: - { - MultidimArray *imT = new MultidimArray; - im = imT; - } - break; - case DT_UShort: - { - MultidimArray *imT = new MultidimArray; - im = imT; - } - break; - case DT_Short: - { - MultidimArray *imT = new MultidimArray; - im = imT; - } - break; - case DT_UHalfByte: - case DT_UChar: - { - MultidimArray *imT = new MultidimArray; - im = imT; - } - break; - case DT_SChar: - { - MultidimArray *imT = new MultidimArray; - im = imT; - } - break; - case DT_Unknown: - REPORT_ERROR(ERR_IMG_UNKNOWN,""); - default: - REPORT_ERROR(ERR_NOT_IMPLEMENTED, "Datatype not implemented."); - } -} - -bool MultidimArrayGeneric::operator==(const MultidimArrayGeneric &mdA) const -{ - if (datatype != mdA.datatype) - { - return false; - - } - -#define COMPARE(type) return ( ((MultidimArray*)im)->equal(*(MultidimArray*)mdA.im) ); - SWITCHDATATYPE(datatype,COMPARE) -#undef COMPARE -} - - -bool MultidimArrayGeneric::equal(const MultidimArrayGeneric &op, - double accuracy) const -{ - if (datatype != op.datatype) - { - return false; - } - -#define COMPARE(type) return ((MultidimArray*)im)->equal(*(MultidimArray*)op.im,accuracy); - SWITCHDATATYPE(datatype,COMPARE) -#undef COMPARE -} - - - -void MultidimArrayGeneric::aliasSlice(MultidimArrayGeneric &mdim, int select_slice) -{ - setDatatype(mdim.datatype); - -#define ALIAS(type) ((MultidimArray*)(im))->aliasSlice(*((MultidimArray*)mdim.im), select_slice); - - SWITCHDATATYPE(mdim.datatype, ALIAS) -#undef ALIAS -} diff --git a/src/core/multidim_array_generic.h b/src/core/multidim_array_generic.h deleted file mode 100644 index 990b024..0000000 --- a/src/core/multidim_array_generic.h +++ /dev/null @@ -1,525 +0,0 @@ -/*************************************************************************** - * Authors: Joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_MULTIDIM_ARRAY_GENERIC_H_ -#define CORE_MULTIDIM_ARRAY_GENERIC_H_ - -#include "xmipp_datatype.h" -#include "multidim_array.h" -#include "utils/half.hpp" - -/* Switch among different datatypes. - * - * This macro replicates the code for the different data type options. - * - *@code - * - *#define MYFUNC(type) getSlice(k, *(MultidimArray*)image, axis, n) - * - *SWITCHDATATYPE(datatype,MYFUNC) - * - *@endcode - */ -#define SWITCHDATATYPE(datatype,OP) \ - switch (datatype)\ - {\ - case DT_Double:\ - {OP(double)};\ - break;\ - case DT_Float:\ - {OP(float)};\ - break;\ - case DT_UInt:\ - {OP(unsigned int)};\ - break;\ - case DT_Int:\ - {OP(int)};\ - break;\ - case DT_Short:\ - {OP(short)};\ - break;\ - case DT_UShort:\ - {OP(unsigned short)};\ - break;\ - case DT_SChar:\ - {OP(char)};\ - break;\ - case DT_UHalfByte:\ - case DT_UChar:\ - {OP(unsigned char)};\ - break;\ - case DT_Long:\ - {OP(long)};\ - break;\ - case DT_ULong:\ - {OP(unsigned long)};\ - break;\ - case DT_HalfFloat:\ - {OP(half_float::half)};\ - break;\ - default:\ - REPORT_ERROR(ERR_ARG_INCORRECT,"Do not know how to handle this type at this point");\ - } - -/// @addtogroup MultidimensionalArrays - -//@{ - -/** @name MultidimArrayGenericSpeedUp Speed up macros */ -/** Array access. - * - * This macros gives you access to the array (T **) - */ -//@{ -#ifndef MULTIDIM_ARRAY_BASE -#define MULTIDIM_ARRAY_BASE(v) (*((v).data->im)) -#endif - -#ifndef MULTIDIM_ARRAY_GENERIC -#define MULTIDIM_ARRAY_GENERIC(v) (*((v).data)) -#endif - -#ifndef MULTIDIM_ARRAY_TYPE -#define MULTIDIM_ARRAY_TYPE(v, type) (*((MultidimArray*)(v.im))) -#endif - -/** - * MultidimArrayGeneric class to handle arrays with independence of the data type - */ -class MultidimArrayGeneric -{ -public: - DataType datatype; - MultidimArrayBase *im; - -protected: - // Flag to allow destroy MultidimArrayBase im data. - bool destroyData; - -public: - - /* Empty constructor */ - MultidimArrayGeneric() - { - init(); - } - - /** - * Constructor with pointer to array to be linked and datatype definition of - * the linked array. - */ - MultidimArrayGeneric(MultidimArrayBase* array, DataType _datatype); - - /* Get an aliasSlice of the selected slice from the multidimarray - */ - MultidimArrayGeneric(MultidimArrayGeneric &mdim, int select_slice); - - /** - * Destructor. - */ - ~MultidimArrayGeneric(); - - /* Initialize - */ - void init(); - - /* Clear the MultidimArrayBase and others - */ - void clear(); - - /* Set the datatype of the multidimarray object - */ - void setDatatype(DataType imgType); - - /* Return mdim pointing to a specific slice inside this mda generic - */ - void aliasSlice(MultidimArrayGeneric &mdim, int select_slice); - - /** - * Link the internal array base to a specific multidimarray object. - */ - void link(MultidimArrayBase* array); - - /** - * Call the resize function of the linked array. - */ - void resize(size_t Ndim, int Zdim, int Ydim, int Xdim, bool copy=true) - { - im->resize(Ndim,Zdim,Ydim,Xdim,copy); - } - - /** Change the internal size, the allocated memory is the same, - so make sure that you are not changing the total size */ - void setDimensions(int Xdim, int Ydim, int Zdim, size_t Ndim) - { - im->setDimensions(Xdim,Ydim,Zdim,Ndim); - } - - void resize(ArrayDim &adim, bool copy=true) - { - im->resize(adim, copy); - } - - void resize(MultidimArrayGeneric &mdim, bool copy=true) - { - ArrayDim adim; - mdim.getDimensions(adim); - im->resize(adim, copy); - } - - /** Reverse matrix values over X axis, keep in this object. */ - void selfReverseX() - { - im->selfReverseX(); - } - /** Reverse matrix values over Y axis, keep in this object. */ - void selfReverseY() - { - im->selfReverseY(); - } - /** Reverse matrix values over Z axis, keep in this object. */ - void selfReverseZ() - { - im->selfReverseZ(); - } - - /** - * Return a pointer to internal multidimarray casted to template T. - */ - template - void getArrayPointer(T* &M) const - { -#define GETMULTIDIMARRAY(type) M = (T*) (((MultidimArray*) im)->data); - SWITCHDATATYPE(datatype,GETMULTIDIMARRAY) -#undef GETMULTIDIMARRAY - - } - - void * getArrayPointer() const - { - void *res; -#define GETMULTIDIMARRAY(type) res = (void *) (((MultidimArray*) im)->data); - SWITCHDATATYPE(datatype,GETMULTIDIMARRAY) -#undef GETMULTIDIMARRAY - return res; - } - - /** - * Return a pointer to internal multidimarray casted to template T. - */ - template - void getMultidimArrayPointer(MultidimArray* &M) const - { -#define GETMULTIDIMARRAY(type) M = (MultidimArray*) ((MultidimArray*) im); - SWITCHDATATYPE(datatype,GETMULTIDIMARRAY) -#undef GETMULTIDIMARRAY - - } - - /** Get a Window from the image*/ - void window(MultidimArrayGeneric &result, int z0, int y0, int x0, - int zF, int yF, int xF, - double init_value = 0.) const - { -#define WINDOW(type) _window(*((MultidimArray*)(result.im)), z0,y0,x0,zF,yF,xF,init_value); - SWITCHDATATYPE(result.datatype,WINDOW) -#undef WINDOW - - } - - template - void _window(MultidimArray &result, int z0, int y0, int x0, - int zF, int yF, int xF, - double init_value = 0.) const - { -#define WINDOW(type) ((MultidimArray*)im)->window(result, z0,y0,x0,zF,yF,xF,(T)init_value); - SWITCHDATATYPE(datatype,WINDOW) -#undef WINDOW - - } - - void selfWindow(int z0, int y0, int x0, - int zF, int yF, int xF, - double init_value = 0.) - { - if (im->mmapOn) - REPORT_ERROR(ERR_MMAP, "Cannot resize the image when it is mapped to file."); - -#define WINDOW(type) ((MultidimArray*)im)->selfWindow(z0,y0,x0,zF,yF,xF,(type)init_value); - - SWITCHDATATYPE(datatype,WINDOW) -#undef WINDOW - - } - - void patch(MultidimArrayGeneric &patchArray, int x, int y) - { -#define PATCH(type) ((MultidimArray*)im)->patch(*((MultidimArray*)(patchArray.im)), x, y); - SWITCHDATATYPE(datatype, PATCH) -#undef PATCH - - } - - /** - * Copy a specific slice of the linked array. - */ - template - void getSlice(int k, MultidimArray &M, char axis = 'Z', bool reverse = false, size_t n = 0) const - { -#define GETSLICE(type) ((MultidimArray*) im)->getSlice(k, M, axis, reverse, n); - SWITCHDATATYPE(datatype,GETSLICE) -#undef GETSLICE - - } - - /** - * Copy a specific slice of the linked array. - */ - void getSlice(int k, MultidimArrayGeneric* M, char axis = 'Z', bool reverse = false, size_t n = 0) const - { -#define GETSLICE(type) getSlice(k, *(MultidimArray*)M->im, axis, reverse, n); - SWITCHDATATYPE(M->datatype,GETSLICE) -#undef GETSLICE - - } - - /** - * Set a specific slice of the linked array. - */ - template - void setSlice(int k, const MultidimArray & v, size_t n = 0) - { -#define SETSLICE(type) ((MultidimArray*) im)->setSlice(k, v, n); - - SWITCHDATATYPE(datatype,SETSLICE) - -#undef SETSLICE - - } - - /** - * Set a specific slice of the linked array. - */ - void setSlice(int k, const MultidimArrayGeneric* v, size_t n = 0) - { -#define SETSLICE(type) setSlice(k,*(MultidimArray*) v->im, n); - SWITCHDATATYPE(v->datatype,SETSLICE); -#undef SETSLICE - - } - - /** - * Get the dimensions of the linked array. - */ - void getDimensions(size_t& Xdim, size_t& Ydim, size_t& Zdim, size_t &Ndim) const - { - im->getDimensions(Xdim,Ydim,Zdim,Ndim); - } - - void getDimensions(size_t& Xdim, size_t& Ydim, size_t& Zdim) const - { - size_t Ndim; - im->getDimensions(Xdim,Ydim,Zdim,Ndim); - } - - void getDimensions(size_t& Xdim, size_t& Ydim) const - { - size_t Zdim, Ndim; - im->getDimensions(Xdim,Ydim,Zdim,Ndim); - } - - void getDimensions(ArrayDim &adim) - { - im->getDimensions(adim); - } - - /** - * Set Xmipp origin. - */ - inline void setXmippOrigin() - { - im->setXmippOrigin(); - } - - void maxIndex(ArrayCoord &pos) - { - im->maxIndex(pos); - } - - /** Compute average */ - double computeAvg() const - { - return im->computeAvg(); - } - - /** Compute statistics. - * - * The average, standard deviation, minimum and maximum value are - * returned. - */ - void computeStats(double& avg, double& stddev, double& minval, double& maxval) const - { -#define COMPUTESTATS(type) type Tminval(0); \ - type Tmaxval(0); \ - ((MultidimArray*)(im))->computeStats(avg, stddev, Tminval, Tmaxval);\ - minval = Tminval;\ - maxval = Tmaxval; - - SWITCHDATATYPE(datatype, COMPUTESTATS) -#undef COMPUTESTATS - - } - - /** Compute minimum and maximum as double values. - */ - void computeDoubleMinMax(double& minval, double& maxval) const - { -#define COMPUTESDOUBLEMINMAX(type) ((MultidimArray*)(im))->computeDoubleMinMax(minval, maxval); - SWITCHDATATYPE(datatype, COMPUTESDOUBLEMINMAX) -#undef COMPUTESDOUBLEMINMAX - - } - - /** - * Range adjust using an example - */ - void rangeAdjust(const MultidimArrayGeneric &example, const MultidimArray *mask=NULL) - { -#define RANGEADJUST(type) ((MultidimArray*)(im))->rangeAdjust(*(MultidimArray*)(example.im),mask); - SWITCHDATATYPE(datatype,RANGEADJUST) -#undef RANGEADJUST - } - - /** Assignment **/ - MultidimArrayGeneric& operator=(const MultidimArrayGeneric& input) - { - if (&input != this && input.datatype != DT_Unknown) - { - setDatatype(input.datatype); - *im = *input.im; - } - return *this; - } - - /** *= **/ - void operator*=(double op1) - { -#define OPERATORTIMESEQUAL(type) *((MultidimArray*)(im)) *= (type)op1; - SWITCHDATATYPE(datatype,OPERATORTIMESEQUAL) -#undef OPERATORTIMESEQUAL - } - - /** += **/ - void operator+=(const MultidimArrayGeneric& op1) - { -#define OPERATORPLUSEQUAL(type) *((MultidimArray*)(im)) += *((MultidimArray*)(op1.im)); - SWITCHDATATYPE(datatype,OPERATORPLUSEQUAL) -#undef OPERATORPLUSEQUAL - } - - /** Get constant access */ - double operator()(size_t n, int k, int i, int j) const - { - double ret; -#define GETVALUE(type) ret = NZYX_ELEM(*(MultidimArray*)im,n,k,i,j); - SWITCHDATATYPE(datatype,GETVALUE) -#undef GETVALUE - return ret; - } - /** - * equal operator - */ - bool operator==(const MultidimArrayGeneric &mdA) const; - - /** Equality. - * - * Returns true if this object has got the same shape (origin and size) - * than the argument and the same values (within accuracy). - */ - bool equal(const MultidimArrayGeneric &op, - double accuracy = XMIPP_EQUAL_ACCURACY) const; - - /** Get constant access */ - double operator()(int i, int j) const - { - double ret; -#define GETVALUE(type) ret = A2D_ELEM(*(MultidimArray*)im,i,j); - SWITCHDATATYPE(datatype,GETVALUE) -#undef GETVALUE - return ret; - } - - /** Get array */ - MultidimArrayBase & operator()() - { - return *im; - } - - /** Get array */ - const MultidimArrayBase & operator()() const - { - return *im; - } - - - /** Copy the image in MultidimarrayGeneric to a specific T MultidimArray - */ - template - void getImage(MultidimArray &M) const - { -#define TYPECAST(type) typeCast(*(MultidimArray*)(im), M); - SWITCHDATATYPE(datatype, TYPECAST) -#undef TYPECAST - - } - - /** Copy in MultidimarrayGeneric an image from a specific T MultidimArray - */ - template - void setImage(MultidimArray &M) - { -#define TYPECAST(type) typeCast(M, *(MultidimArray*)(im)); - SWITCHDATATYPE(datatype, TYPECAST) -#undef TYPECAST - - } - - /** Get window. - */ - template - void window(MultidimArray &result, int n0,int z0, int y0, int x0, - int nF,int zF, int yF, int xF, - T1 init_value = 0) const - { -#define WINDOW(type) ((MultidimArray*)(im))->window(result, n0, z0, y0, x0, nF, zF, yF, xF, init_value); - SWITCHDATATYPE(datatype, WINDOW) -#undef WINDOW - - } -} -; -//@} -//@} -#endif /* MULTIDIM_ARRAY_GENERIC_H_ */ diff --git a/src/core/numerical_recipes.cpp b/src/core/numerical_recipes.cpp deleted file mode 100644 index 3d098e2..0000000 --- a/src/core/numerical_recipes.cpp +++ /dev/null @@ -1,9426 +0,0 @@ -/*************************************************************************** - * - * Authors: Carlos Oscar S. Sorzano (coss@cnb.csic.es) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include -#include -#include -#include -#include -#include "numerical_recipes.h" - - -/* NUMERICAL UTILITIES ----------------------------------------------------- */ -void nrerror(const char error_text[]) -{ - fprintf(stderr, "Numerical Recipes run-time error...\n"); - fprintf(stderr, "%s\n", error_text); - fprintf(stderr, "...now exiting to system...\n"); - exit(1); -} -#define NRSIGN(a,b) ((b) >= 0.0 ? fabs(a) : -fabs(a)) - -/* RANDOM NUMBERS ---------------------------------------------------------- */ -#define M1 259200 -#define IA1 7141 -#define IC1 54773 -#define RM1 (1.0/M1) -#define M2 134456 -#define IA2 8121 -#define IC2 28411 -#define RM2 (1.0/M2) -#define M3 243000 -#define IA3 4561 -#define IC3 51349 - -/* Chapter 7 Section 1: UNIFORM RANDOM NUMBERS */ -double ran1(int *idum) -{ - static long ix1, ix2, ix3; - static double r[98]; - double temp; - static int iff = 0; - int j; - - if (*idum < 0 || iff == 0) - { - iff = 1; - ix1 = (IC1 - (*idum)) % M1; - ix1 = (IA1 * ix1 + IC1) % M1; - ix2 = ix1 % M2; - ix1 = (IA1 * ix1 + IC1) % M1; - ix3 = ix1 % M3; - for (j = 1;j <= 97;j++) - { - ix1 = (IA1 * ix1 + IC1) % M1; - ix2 = (IA2 * ix2 + IC2) % M2; - r[j] = (ix1 + ix2 * RM2) * RM1; - } - *idum = 1; - } - ix1 = (IA1 * ix1 + IC1) % M1; - ix2 = (IA2 * ix2 + IC2) % M2; - ix3 = (IA3 * ix3 + IC3) % M3; - j = 1 + ((97 * ix3) / M3); - if (j > 97 || j < 1) - nrerror("RAN1: This cannot happen."); - temp = r[j]; - r[j] = (ix1 + ix2 * RM2) * RM1; - return temp; -} - -#undef M1 -#undef IA1 -#undef IC1 -#undef RM1 -#undef M2 -#undef IA2 -#undef IC2 -#undef RM2 -#undef M3 -#undef IA3 -#undef IC3 - -/* Chapter 7 Section 3: GAUSSIAN RANDOM NUMBERS */ -double gasdev(int *idum) -{ - static int iset = 0; - static double gset; - double fac, r, v1, v2; - - if (iset == 0) - { - do - { - v1 = 2.0 * ran1(idum) - 1.0; - v2 = 2.0 * ran1(idum) - 1.0; - r = v1 * v1 + v2 * v2; - } - while (r >= 1.0); - fac = sqrt(-2.0 * log(r) / r); - gset = v1 * fac; - iset = 1; - return v2*fac; - } - else - { - iset = 0; - return gset; - } -} - -// t-distribution (nor Numerical Recipes, but Mathematics of Computation, vol. 62, 779-781. -// I downloaded sem-code from http://ideas.repec.org/c/ega/comcod/200703.html -// Sjors May 2008 -double tdev(double nu, int *idum) -{ - static int iset = 0; - static double gset; - double fac, r, v1, v2; - - if (iset == 0) - { - do - { - v1 = 2.0 * ran1(idum) - 1.0; - v2 = 2.0 * ran1(idum) - 1.0; - r = v1 * v1 + v2 * v2; - } - while (r >= 1.0); - fac = sqrt(nu*(pow(r,-2.0/nu) -1.0)/r); - gset = v1 * fac; - iset = 1; - return v2*fac; - } - else - { - iset = 0; - return gset; - } -} - - -// Kolmogorov-Smirnov test -void ksone(double data[], int n, double(*func)(double), double * d, double * prob) -{ - std::sort(data, data + n); - double fn, ff, en, dt, fo=0.; - en = (double)n; - *d = 0.; - for (int j=1; j<=n; j++) - { - fn = j / en; - ff = (*func)(data[j]); - dt = XMIPP_MAX(fabs(fo - ff), fabs(fn - ff)); - if (dt> *d) - *d = dt; - fo = fn; - } - *prob = probks(sqrt(en)*(*d)); -} - -// Calculate KS-confidence level -double probks(double alam) -{ - int j; - double a2, fac=2.0, sum=0.0, term, termbf=0.0; - double EPS1=0.001, EPS2=1.0e-8; - - a2 = -2.0 * alam * alam; - for (j = 1; j<= 100; j++) - { - term = fac * exp(a2*j*j); - sum += term; - if (fabs(term) <= EPS1*termbf || fabs(term) <= EPS2*sum) - return sum; - fac = -fac; - termbf = fabs(term); - } - return 1.0; - -} - -/* SORTING ----------------------------------------------------------------- */ -/* Chapter 8, Section 3: Indexing */ -void indexx(int n, double arrin[], int indx[]) -{ - int l, j, ir, indxt, i; - double q; - - for (j = 1;j <= n;j++) - indx[j] = j; - l = (n >> 1) + 1; - ir = n; - for (;;) - { - if (l > 1) - q = arrin[(indxt=indx[--l])]; - else - { - q = arrin[(indxt=indx[ir])]; - indx[ir] = indx[1]; - if (--ir == 1) - { - indx[1] = indxt; - return; - } - } - i = l; - j = l << 1; - while (j <= ir) - { - if (j < ir && arrin[indx[j]] < arrin[indx[j+1]]) - j++; - if (q < arrin[indx[j]]) - { - indx[i] = indx[j]; - j += (i = j); - } - else - j = ir + 1; - } - indx[i] = indxt; - } -} - -/* BESSEL FUNCTIONS -------------------------------------------------------- */ -/* CO: They may not come in the numerical recipes but it is not a bad - idea to put them here, in fact they come from Gabor's group in Feb'84 */ -double bessj0(double x) -{ - double ax, z; - double xx, y, ans, ans1, ans2; - - if ((ax = fabs(x)) < 8.0) - { - y = x * x; - ans1 = 57568490574.0 + y * (-13362590354.0 + - y * (651619640.7 - + y * (-11214424.18 + - y * (77392.33017 + - y * (-184.9052456))))); - ans2 = 57568490411.0 + y * (1029532985.0 + - y * (9494680.718 - + y * (59272.64853 + - y * (267.8532712 + - y * 1.0)))); - ans = ans1 / ans2; - } - else - { - z = 8.0 / ax; - y = z * z; - xx = ax - 0.785398164; - ans1 = 1.0 + y * (-0.1098628627e-2 + y * (0.2734510407e-4 - + y * (-0.2073370639e-5 + y * 0.2093887211e-6))); - ans2 = -0.1562499995e-1 + y * (0.1430488765e-3 - + y * (-0.6911147651e-5 + y * (0.7621095161e-6 - - y * 0.934935152e-7))); - ans = sqrt(0.636619772 / ax) * (cos(xx) * ans1 - z * sin(xx) * ans2); - } - return ans; -} - -/*............................................................................*/ -double bessi0(double x) -{ - double y, ax, ans; - if ((ax = fabs(x)) < 3.75) - { - y = x / 3.75; - y *= y; - ans = 1.0 + y * (3.5156229 + y * (3.0899424 + y * (1.2067492 - + y * (0.2659732 + y * (0.360768e-1 + y * 0.45813e-2))))); - } - else - { - y = 3.75 / ax; - ans = (exp(ax) / sqrt(ax)) * (0.39894228 + y * (0.1328592e-1 - + y * (0.225319e-2 + y * (-0.157565e-2 + y * (0.916281e-2 - + y * (-0.2057706e-1 + y * (0.2635537e-1 + y * (-0.1647633e-1 - + y * 0.392377e-2)))))))); - } - return ans; -} - -/*............................................................................*/ -double bessi1(double x) -{ - double ax, ans; - double y; - if ((ax = fabs(x)) < 3.75) - { - y = x / 3.75; - y *= y; - ans = ax * (0.5 + y * (0.87890594 + y * (0.51498869 + y * (0.15084934 - + y * (0.2658733e-1 + y * (0.301532e-2 + y * 0.32411e-3)))))); - } - else - { - y = 3.75 / ax; - ans = 0.2282967e-1 + y * (-0.2895312e-1 + y * (0.1787654e-1 - - y * 0.420059e-2)); - ans = 0.39894228 + y * (-0.3988024e-1 + y * (-0.362018e-2 - + y * (0.163801e-2 + y * (-0.1031555e-1 + y * ans)))); - ans *= (exp(ax) / sqrt(ax)); - } - return x < 0.0 ? -ans : ans; -} - -/* General Bessel functions ------------------------------------------------ */ -double chebev(double a, double b, double c[], int m, double x) -{ - double d = 0.0, dd = 0.0, sv, y, y2; - int j; - - if ((x - a)*(x - b) > 0.0) - nrerror("x not in range in routine chebev"); - y2 = 2.0 * (y = (2.0 * x - a - b) / (b - a)); - for (j = m - 1;j >= 1;j--) - { - sv = d; - d = y2 * d - dd + c[j]; - dd = sv; - } - return y*d - dd + 0.5*c[0]; -} -#define NUSE1 5 -#define NUSE2 5 - -void beschb(double x, double *gam1, double *gam2, double *gampl, double *gammi) -{ - double xx; - static double c1[] = - { - -1.142022680371172e0, 6.516511267076e-3, - 3.08709017308e-4, -3.470626964e-6, 6.943764e-9, - 3.6780e-11, -1.36e-13 - }; - static double c2[] = - { - 1.843740587300906e0, -0.076852840844786e0, - 1.271927136655e-3, -4.971736704e-6, -3.3126120e-8, - 2.42310e-10, -1.70e-13, -1.0e-15 - }; - - xx = 8.0 * x * x - 1.0; - *gam1 = chebev(-1.0, 1.0, c1, NUSE1, xx); - *gam2 = chebev(-1.0, 1.0, c2, NUSE2, xx); - *gampl = *gam2 - x * (*gam1); - *gammi = *gam2 + x * (*gam1); -} - -#undef NUSE1 -#undef NUSE2 - -#define EPS 1.0e-16 -#define FPMIN 1.0e-30 -#define MAXIT 10000 -#define XMIN 2.0 -void bessjy(double x, double xnu, double *rj, double *ry, double *rjp, double *ryp) -{ - int i, isign, l, nl; - double a, b, br, bi, c, cr, ci, d, del, del1, den, di, dlr, dli, dr, e, f, fact, fact2, - fact3, ff, gam, gam1, gam2, gammi, gampl, h, p, pimu, pimu2, q, r, rjl, - rjl1, rjmu, rjp1, rjpl, rjtemp, ry1, rymu, rymup, rytemp, sum, sum1, - temp, w, x2, xi, xi2, xmu, xmu2; - - if (x <= 0.0 || xnu < 0.0) - nrerror("bad arguments in bessjy"); - nl = (x < XMIN ? (int)(xnu + 0.5) : XMIPP_MAX(0, (int)(xnu - x + 1.5))); - xmu = xnu - nl; - xmu2 = xmu * xmu; - xi = 1.0 / x; - xi2 = 2.0 * xi; - w = xi2 / PI; - isign = 1; - h = xnu * xi; - if (h < FPMIN) - h = FPMIN; - b = xi2 * xnu; - d = 0.0; - c = h; - for (i = 1;i <= MAXIT;i++) - { - b += xi2; - d = b - d; - if (fabs(d) < FPMIN) - d = FPMIN; - c = b - 1.0 / c; - if (fabs(c) < FPMIN) - c = FPMIN; - d = 1.0 / d; - del = c * d; - h = del * h; - if (d < 0.0) - isign = -isign; - if (fabs(del - 1.0) < EPS) - break; - } - if (i > MAXIT) - nrerror("x too large in bessjy; try asymptotic expansion"); - rjl = isign * FPMIN; - rjpl = h * rjl; - rjl1 = rjl; - rjp1 = rjpl; - fact = xnu * xi; - for (l = nl;l >= 1;l--) - { - rjtemp = fact * rjl + rjpl; - fact -= xi; - rjpl = fact * rjtemp - rjl; - rjl = rjtemp; - } - if (rjl == 0.0) - rjl = EPS; - f = rjpl / rjl; - if (x < XMIN) - { - x2 = 0.5 * x; - pimu = PI * xmu; - fact = (fabs(pimu) < EPS ? 1.0 : pimu / sin(pimu)); - d = -log(x2); - e = xmu * d; - fact2 = (fabs(e) < EPS ? 1.0 : sinh(e) / e); - beschb(xmu, &gam1, &gam2, &gampl, &gammi); - ff = 2.0 / PI * fact * (gam1 * cosh(e) + gam2 * fact2 * d); - e = exp(e); - p = e / (gampl * PI); - q = 1.0 / (e * PI * gammi); - pimu2 = 0.5 * pimu; - fact3 = (fabs(pimu2) < EPS ? 1.0 : sin(pimu2) / pimu2); - r = PI * pimu2 * fact3 * fact3; - c = 1.0; - d = -x2 * x2; - sum = ff + r * q; - sum1 = p; - for (i = 1;i <= MAXIT;i++) - { - ff = (i * ff + p + q) / (i * i - xmu2); - c *= (d / i); - p /= (i - xmu); - q /= (i + xmu); - del = c * (ff + r * q); - sum += del; - del1 = c * p - i * del; - sum1 += del1; - if (fabs(del) < (1.0 + fabs(sum))*EPS) - break; - } - if (i > MAXIT) - nrerror("bessy series failed to converge"); - rymu = -sum; - ry1 = -sum1 * xi2; - rymup = xmu * xi * rymu - ry1; - rjmu = w / (rymup - f * rymu); - } - else - { - a = 0.25 - xmu2; - p = -0.5 * xi; - q = 1.0; - br = 2.0 * x; - bi = 2.0; - fact = a * xi / (p * p + q * q); - cr = br + q * fact; - ci = bi + p * fact; - den = br * br + bi * bi; - dr = br / den; - di = -bi / den; - dlr = cr * dr - ci * di; - dli = cr * di + ci * dr; - temp = p * dlr - q * dli; - q = p * dli + q * dlr; - p = temp; - for (i = 2;i <= MAXIT;i++) - { - a += 2 * (i - 1); - bi += 2.0; - dr = a * dr + br; - di = a * di + bi; - if (fabs(dr) + fabs(di) < FPMIN) - dr = FPMIN; - fact = a / (cr * cr + ci * ci); - cr = br + cr * fact; - ci = bi - ci * fact; - if (fabs(cr) + fabs(ci) < FPMIN) - cr = FPMIN; - den = dr * dr + di * di; - dr /= den; - di /= -den; - dlr = cr * dr - ci * di; - dli = cr * di + ci * dr; - temp = p * dlr - q * dli; - q = p * dli + q * dlr; - p = temp; - if (fabs(dlr - 1.0) + fabs(dli) < EPS) - break; - } - if (i > MAXIT) - nrerror("cf2 failed in bessjy"); - gam = (p - f) / q; - rjmu = sqrt(w / ((p - f) * gam + q)); - rjmu = NRSIGN(rjmu, rjl); - rymu = rjmu * gam; - rymup = rymu * (p + q / gam); - ry1 = xmu * xi * rymu - rymup; - } - fact = rjmu / rjl; - *rj = rjl1 * fact; - *rjp = rjp1 * fact; - for (i = 1;i <= nl;i++) - { - rytemp = (xmu + i) * xi2 * ry1 - rymu; - rymu = ry1; - ry1 = rytemp; - } - *ry = rymu; - *ryp = xnu * xi * rymu - ry1; -} -#undef EPS -#undef FPMIN -#undef MAXIT -#undef XMIN - -/*............................................................................*/ -double bessi0_5(double x) -{ - return (x == 0) ? 0 : sqrt(2 / (PI*x))*sinh(x); -} -double bessi1_5(double x) -{ - return (x == 0) ? 0 : sqrt(2 / (PI*x))*(cosh(x) - sinh(x) / x); -} -double bessi2(double x) -{ - return (x == 0) ? 0 : bessi0(x) - ((2*1) / x) * bessi1(x); -} -double bessi2_5(double x) -{ - return (x == 0) ? 0 : bessi0_5(x) - ((2*1.5) / x) * bessi1_5(x); -} -double bessi3(double x) -{ - return (x == 0) ? 0 : bessi1(x) - ((2*2) / x) * bessi2(x); -} -double bessi3_5(double x) -{ - return (x == 0) ? 0 : bessi1_5(x) - ((2*2.5) / x) * bessi2_5(x); -} -double bessi4(double x) -{ - return (x == 0) ? 0 : bessi2(x) - ((2*3) / x) * bessi3(x); -} -double bessj1_5(double x) -{ - double rj, ry, rjp, ryp; - bessjy(x, 1.5, &rj, &ry, &rjp, &ryp); - return rj; -} -double bessj3_5(double x) -{ - double rj, ry, rjp, ryp; - bessjy(x, 3.5, &rj, &ry, &rjp, &ryp); - return rj; -} - -/* Special functions ------------------------------------------------------- */ -double gammln(double xx) -{ - double x, tmp, ser; - static double cof[6] = - { - 76.18009173, -86.50532033, 24.01409822, - -1.231739516, 0.120858003e-2, -0.536382e-5 - }; - int j; - - x = xx - 1.0; - tmp = x + 5.5; - tmp -= (x + 0.5) * log(tmp); - ser = 1.0; - for (j = 0;j <= 5;j++) - { - x += 1.0; - ser += cof[j] / x; - } - return -tmp + log(2.50662827465*ser); -} - - -double betai(double a, double b, double x) -{ - double bt; - if (x < 0.0 || x > 1.0) - nrerror("Bad x in routine BETAI"); - if (x == 0.0 || x == 1.0) - bt = 0.0; - else - bt = exp(gammln(a + b) - gammln(a) - gammln(b) + a * log(x) + b * log(1.0 - x)); - if (x < (a + 1.0) / (a + b + 2.0)) - return bt*betacf(a, b, x) / a; - else - return 1.0 -bt*betacf(b, a, 1.0 - x) / b; - -} - -#define ITMAX 100 -#define EPS 3.0e-7 -double betacf(double a, double b, double x) -{ - double qap, qam, qab, em, tem, d; - double bz, bm = 1.0, bp, bpp; - double az = 1.0, am = 1.0, ap, app, aold; - int m; - - qab = a + b; - qap = a + 1.0; - qam = a - 1.0; - bz = 1.0 - qab * x / qap; - for (m = 1;m <= ITMAX;m++) - { - em = (double) m; - tem = em + em; - d = em * (b - em) * x / ((qam + tem) * (a + tem)); - ap = az + d * am; - bp = bz + d * bm; - d = -(a + em) * (qab + em) * x / ((qap + tem) * (a + tem)); - app = ap + d * az; - bpp = bp + d * bz; - aold = az; - am = ap / bpp; - bm = bp / bpp; - az = app / bpp; - bz = 1.0; - if (fabs(az - aold) < (EPS*fabs(az))) - return az; - } - nrerror("a or b too big, or ITMAX too small in BETACF"); - return 0; -} -#undef ITMAX -#undef EPS - -/* Optimization ------------------------------------------------------------ */ -#undef MAX -#undef SIGN -#define GOLD 1.618034 -#define GLIMIT 100.0 -#define TINY 1.0e-20 -#define MAX(a,b) ((a) > (b) ? (a) : (b)) -#define SIGN(a,b) ((b) > 0.0 ? fabs(a) : -fabs(a)) -#define SHFT(a,b,c,d) (a)=(b);(b)=(c);(c)=(d); -#define F1DIM(x,f) {\ - for (int j = 1; j<=ncom; j++) \ - xt[j] = pcom[j] + x * xicom[j]; \ - f = (*func)(xt,prm);} - -void mnbrak(double *ax, double *bx, double *cx, - double *fa, double *fb, double *fc, double(*func)(double *, void*), - void *prm, int ncom, double *pcom, double *xicom) -{ - double ulim, u, r, q, fu, dum; - std::vector buffer(ncom); - auto *xt= buffer.data()-1; - - F1DIM(*ax,*fa); - F1DIM(*bx,*fb); - if (*fb > *fa) - { - SHFT(dum, *ax, *bx, dum) - SHFT(dum, *fb, *fa, dum) - } - *cx = (*bx) + GOLD * (*bx - *ax); - F1DIM(*cx,*fc); - while (*fb > *fc) - { - r = (*bx - *ax) * (*fb - *fc); - q = (*bx - *cx) * (*fb - *fa); - u = (*bx) - ((*bx - *cx) * q - (*bx - *ax) * r) / - (2.0 * SIGN(MAX(fabs(q - r), TINY), q - r)); - ulim = (*bx) + GLIMIT * (*cx - *bx); - if ((*bx - u)*(u - *cx) > 0.0) - { - F1DIM(u,fu); - if (fu < *fc) - { - *ax = (*bx); - *bx = u; - *fa = (*fb); - *fb = fu; - return; - } - else if (fu > *fb) - { - *cx = u; - *fc = fu; - return; - } - u = (*cx) + GOLD * (*cx - *bx); - F1DIM(u,fu); - } - else if ((*cx - u)*(u - ulim) > 0.0) - { - F1DIM(u,fu); - if (fu < *fc) - { - SHFT(*bx, *cx, u, *cx + GOLD*(*cx - *bx)) - double aux; - F1DIM(u,aux); - SHFT(*fb, *fc, fu, aux) - } - } - else if ((u - ulim)*(ulim - *cx) >= 0.0) - { - u = ulim; - F1DIM(u,fu); - } - else - { - u = (*cx) + GOLD * (*cx - *bx); - F1DIM(u,fu); - } - SHFT(*ax, *bx, *cx, u) - SHFT(*fa, *fb, *fc, fu) - } -} - -#undef GOLD -#undef GLIMIT -#undef TINY -#undef MAX - -#define ITMAX 100 -#define CGOLD 0.3819660 -#define ZEPS 1.0e-10 -double brent(double ax, double bx, double cx, double(*func)(double *,void*), - void *prm, double tol, double *xmin, - int ncom, double *pcom, double *xicom) -{ - int iter; - double a, b, d, etemp, fu, fv, fw, fx, p, q, r, tol1, tol2, u, v, w, x, xm; - double e = 0.0; - std::vector buffer(ncom); - auto *xt= buffer.data()-1; - - a = (ax < cx ? ax : cx); - b = (ax > cx ? ax : cx); - x = w = v = bx; - F1DIM(x,fx); - fw = fv = fx; - for (iter = 1;iter <= ITMAX;iter++) - { - xm = 0.5 * (a + b); - tol2 = 2.0 * (tol1 = tol * fabs(x) + ZEPS); - if (fabs(x - xm) <= (tol2 - 0.5*(b - a))) - { - *xmin = x; - return fx; - } - if (fabs(e) > tol1) - { - r = (x - w) * (fx - fv); - q = (x - v) * (fx - fw); - p = (x - v) * q - (x - w) * r; - q = 2.0 * (q - r); - if (q > 0.0) - p = -p; - q = fabs(q); - etemp = e; - e = d; - if (fabs(p) >= fabs(0.5*q*etemp) || p <= q*(a - x) || p >= q*(b - x)) - d = CGOLD * (e = (x >= xm ? a - x : b - x)); - else - { - d = p / q; - u = x + d; - if (u - a < tol2 || b - u < tol2) - d = SIGN(tol1, xm - x); - } - } - else - { - d = CGOLD * (e = (x >= xm ? a - x : b - x)); - } - u = (fabs(d) >= tol1 ? x + d : x + SIGN(tol1, d)); - F1DIM(u,fu); - if (fu <= fx) - { - if (u >= x) - a = x; - else - b = x; - SHFT(v, w, x, u) - SHFT(fv, fw, fx, fu) - } - else - { - if (u < x) - a = u; - else - b = u; - if (fu <= fw || w == x) - { - v = w; - w = u; - fv = fw; - fw = fu; - } - else if (fu <= fv || v == x || v == w) - { - v = u; - fv = fu; - } - } - } - nrerror("Too many iterations in brent"); - *xmin = x; - return fx; -} -#undef ITMAX -#undef CGOLD -#undef ZEPS -#undef SHFT -#undef F1DIM - -#define TOL 2.0e-4 -void linmin(double *p, double *xi, int n, double &fret, - double(*func)(double *, void*), void *prm) -{ - int j; - double xx, xmin, fx, fb, fa, bx, ax; - - int ncom = n; - std::vector buffer(2*n); - auto *pcom= buffer.data()-1; - auto *xicom= pcom + n; - for (j = 1;j <= n;j++) - { - pcom[j] = p[j]; - xicom[j] = xi[j]; - } - ax = 0.0; - xx = 1.0; - bx = 2.0; - mnbrak(&ax, &xx, &bx, &fa, &fx, &fb, func, prm, ncom, pcom, xicom); - fret = brent(ax, xx, bx, func, prm, TOL, &xmin, ncom, pcom, xicom); - for (j = 1;j <= n;j++) - { - xi[j] *= xmin; - p[j] += xi[j]; - } -} -#undef TOL - -#define ITMAX 200 -void powell(double *p, double *xi, int n, double ftol, int &iter, - double &fret, double(*func)(double *, void *), void *prm, - bool show) -{ - int i, ibig, j; - double t, fptt, fp, del; - std::vector buffer(3*n); - auto *pt= buffer.data()-1; - auto *ptt= pt + n; - auto *xit= ptt + n; - bool different_from_0; - - fret = (*func)(p,prm); - for (j = 1;j <= n;j++) - pt[j] = p[j]; - - for (iter = 1;;(iter)++) - { - /* By coss ----- */ - if (show) - { - std::cout << iter << " (" << p[1]; - for (int co = 2; co <= n; co++) - std::cout << "," << p[co]; - std::cout << ")--->" << fret << std::endl; - } - /* ------------- */ - - fp = fret; - ibig = 0; - del = 0.0; - for (i = 1;i <= n;i++) - { - different_from_0 = false; // CO - for (j = 1;j <= n;j++) - { - xit[j] = xi[j*n+i]; - if (xit[j] != 0) - different_from_0 = true; - } - if (different_from_0) - { - fptt = fret; - linmin(p, xit, n, fret, func, prm); - if (fabs(fptt - fret) > del) - { - del = fabs(fptt - fret); - ibig = i; - } - /* By coss ----- */ - if (show) - { - std::cout << " ("; - if (i == 1) - std::cout << "***"; - std::cout << p[1]; - for (int co = 2; co <= n; co++) - { - std::cout << ","; - if (co == i) - std::cout << "***"; - std::cout << p[co]; - } - std::cout << ")--->" << fret << std::endl; - } - /* ------------- */ - } - } - if (2.0*fabs(fp - fret) <= ftol*(fabs(fp) + fabs(fret)) || n==1) return; - if (iter == ITMAX) - nrerror("Too many iterations in routine POWELL"); - for (j = 1;j <= n;j++) - { - ptt[j] = 2.0 * p[j] - pt[j]; - xit[j] = p[j] - pt[j]; - pt[j] = p[j]; - } - fptt = (*func)(ptt,prm); - if (fptt < fp) - { -#define SQR(a) ((a)*(a)) - t = 2.0 * (fp - 2.0 * fret + fptt) * SQR(fp - fret - del) - del * SQR(fp - fptt); - if (t < 0.0) - { - linmin(p, xit, n, fret, func, prm); - for (j = 1;j <= n;j++) - xi[j*n+ibig] = xit[j]; - } - } - } -} -#undef ITMAX -#undef SQR - -/* Non linear least squares ------------------------------------------------ */ -// These routines have been taken from -// http://users.utu.fi/vesoik/userdocs/programs/libpet -// and they implement an algorithm of Lawson-Hanson of -// nonnegative least squares - -/* Example of use: - double a[]={ 5, 0, -2, - 0, 3, 0, - 1, 1, -1, - -1, 1, -1, - 9, 9, -9}; - double b[]={1, 9, -1}; - double x[5]; - double rnorm; - int i; - - int success=nnls(a,3,5,b,x,&rnorm,NULL,NULL,NULL); - printf("success=%d\n",success); - printf("rnorm=%d\n",rnorm); - for (i=0; i<5; i++) - printf("%f\n",x[i]); - - In this case: x=0 2.666 0 0 0.111 - - This program resolves A^t*x=b subject to x>=0. - In terms of basis vectors, the rows of A are the basis axes, b is - the vector we want to represent in the subspace spanned by the rows of A - and x are the nonnegative coordinates of the representation of b in A. -*/ - -/***************************************************************************** - * - * Compute orthogonal rotation matrix: - * (C, S) so that (C, S)(A) = (sqrt(A**2+B**2)) - * (-S,C) (-S,C)(B) ( 0 ) - * Compute sig = sqrt(A**2+B**2): - * sig is computed last to allow for the possibility that sig may be in - * the same location as A or B. - */ -void _nnls_g1(double a, double b, double *cterm, double *sterm, double *sig) -{ - double d1, xr, yr; - - if (fabs(a) > fabs(b)) - { - xr = b / a; - d1 = xr; - yr = sqrt(d1 * d1 + 1.); - d1 = 1. / yr; - *cterm = (a >= 0.0 ? fabs(d1) : -fabs(d1)); - *sterm = (*cterm) * xr; - *sig = fabs(a) * yr; - } - else if (b != 0.) - { - xr = a / b; - d1 = xr; - yr = sqrt(d1 * d1 + 1.); - d1 = 1. / yr; - *sterm = (b >= 0.0 ? fabs(d1) : -fabs(d1)); - *cterm = (*sterm) * xr; - *sig = fabs(b) * yr; - } - else - { - *sig = 0.; - *cterm = 0.; - *sterm = 1.; - } -} /* _nnls_g1 */ -/****************************************************************************/ - -/***************************************************************************** - * - * Construction and/or application of a single Householder transformation: - * Q = I + U*(U**T)/B - * - * Function returns 0 if successful, or >0 in case of erroneous parameters. - * - */ -int _nnls_h12( - int mode, - /* mode=1 to construct and apply a Householder transformation, or - mode=2 to apply a previously constructed transformation */ - int lpivot, /* Index of the pivot element */ - int l1, int m, - /* Transformation is constructed to zero elements indexed from l1 to M */ - double *u, int u_dim1, double *up, - /* With mode=1: On entry, u[] must contain the pivot vector. - On exit, u[] and up contain quantities defining the vector u[] of - the Householder transformation. */ - /* With mode=2: On entry, u[] and up should contain quantities previously - computed with mode=1. These will not be modified. */ - /* u_dim1 is the storage increment between elements. */ - double *cm, - /* On entry, cm[] must contain the matrix (set of vectors) to which the - Householder transformation is to be applied. On exit, cm[] will contain - the set of transformed vectors */ - int ice, /* Storage increment between elements of vectors in cm[] */ - int icv, /* Storage increment between vectors in cm[] */ - int ncv /* Nr of vectors in cm[] to be transformed; - if ncv<=0, then no operations will be done on cm[] */ -) -{ - double d1, d2, b, clinv, cl, sm; - int incr, k, j, i2, i3, i4; - - /* Check parameters */ - if (mode != 1 && mode != 2) - return(1); - if (m < 1 || u == NULL || u_dim1 < 1 || cm == NULL) - return(2); - if (lpivot < 0 || lpivot >= l1 || l1 >= m) - return(0); - /* Function Body */ - cl = (d1 = u[lpivot*u_dim1], fabs(d1)); - if (mode == 2) - { /* Apply transformation I+U*(U**T)/B to cm[] */ - if (cl <= 0.) - return(0); - } - else - { /* Construct the transformation */ - for (j = l1; j < m; j++) - { /* Computing MAX */ - d2 = (d1 = u[j*u_dim1], fabs(d1)); - if (d2 > cl) - cl = d2; - } - if (cl <= 0.) - return(0); - clinv = 1.0 / cl; - /* Computing 2nd power */ - d1 = u[lpivot*u_dim1] * clinv; - sm = d1 * d1; - for (j = l1; j < m; j++) - { - d1 = u[j*u_dim1] * clinv; - sm += d1 * d1; - } - cl *= sqrt(sm); - if (u[lpivot*u_dim1] > 0.) - cl = -cl; - *up = u[lpivot*u_dim1] - cl; - u[lpivot*u_dim1] = cl; - } - if (ncv <= 0) - return(0); - b = (*up) * u[lpivot*u_dim1]; - /* b must be nonpositive here; if b>=0., then return */ - if (b >= 0.) - return(0); - b = 1.0 / b; - i2 = 1 - icv + ice * lpivot; - incr = ice * (l1 - lpivot); - for (j = 0; j < ncv; j++) - { - i2 += icv; - i3 = i2 + incr; - i4 = i3; - sm = cm[i2-1] * (*up); - for (k = l1; k < m; k++) - { - sm += cm[i3-1] * u[k*u_dim1]; - i3 += ice; - } - if (sm != 0.0) - { - sm *= b; - cm[i2-1] += sm * (*up); - for (k = l1; k < m; k++) - { - cm[i4-1] += sm * u[k*u_dim1]; - i4 += ice; - } - } - } - return(0); -} /* _nnls_h12 */ - -/***************************************************************************** - * Algorithm NNLS (Non-negative least-squares) - * - * Given an m by n matrix A, and an m-vector B, computes an n-vector X, - * that solves the least squares problem - * A * X = B , subject to X>=0 - * - * Function returns 0 if successful, 1, if iteration count exceeded 3*N, - * or 2 in case of invalid problem dimensions or memory allocation error. - * - * Instead of pointers for working space, NULL can be given to let this - * function to allocate and free the required memory. - */ -int nnls( - double *a, int m, int n, - /* On entry, a[n][m] contains the m by n matrix A. On exit, a[][] contains - the product matrix Q*A, where Q is an m by n orthogonal matrix generated - implicitly by this function.*/ - double *b, - /* On entry, b[] must contain the m-vector B. - On exit, b[] contains Q*B */ - double *x, - /* On exit, x[] will contain the solution vector */ - double *rnorm, - /* On exit, rnorm contains the Euclidean norm of the residual vector */ - double *wp, /* An n-array of working space, w[]. */ - /* On exit, w[] will contain the dual solution vector. - w[i]=0.0 for all i in set p and w[i]<=0.0 for all i in set z. */ - double *zzp, /* An m-array of working space, zz[]. */ - int *indexp /* An n-array of working space, index[]. */ -) -{ - int pfeas, ret = 0, iz, jz, iz1, iz2, npp1, *index; - double d1, d2, sm, up, ss, *w, *zz; - int iter, k, j = 0, l, itmax, izmax = 0, nsetp, ii, jj = 0, ip; - double temp, wmax, t, alpha, asave, dummy, unorm, ztest, cc; - - - /* Check the parameters and data */ - if (m <= 0 || n <= 0 || a == NULL || b == NULL || x == NULL) - return(2); - /* Allocate memory for working space, if required */ - if (wp != NULL) - w = wp; - else - w = (double*)calloc(n, sizeof(double)); - if (zzp != NULL) - zz = zzp; - else - zz = (double*)calloc(m, sizeof(double)); - if (indexp != NULL) - index = indexp; - else - index = (int*)calloc(n, sizeof(int)); - if (w == NULL || zz == NULL || index == NULL) - return(2); - - /* Initialize the arrays INDEX[] and X[] */ - for (k = 0; k < n; k++) - { - x[k] = 0.; - index[k] = k; - } - iz2 = n - 1; - iz1 = 0; - nsetp = 0; - npp1 = 0; - - /* Main loop; quit if all coeffs are already in the solution or */ - /* if M cols of A have been triangularized */ - iter = 0; - itmax = n * 3; - while (iz1 <= iz2 && nsetp < m) - { - /* Compute components of the dual (negative gradient) vector W[] */ - for (iz = iz1; iz <= iz2; iz++) - { - j = index[iz]; - sm = 0.; - for (l = npp1; l < m; l++) - sm += a[j*m+l] * b[l]; - w[j] = sm; - } - - while (1) - { - /* Find largest positive W[j] */ - for (wmax = 0., iz = iz1; iz <= iz2; iz++) - { - j = index[iz]; - if (w[j] > wmax) - { - wmax = w[j]; - izmax = iz; - } - } - - /* Terminate if wmax<=0.; */ - /* it indicates satisfaction of the Kuhn-Tucker conditions */ - if (wmax <= 0.0) - break; - iz = izmax; - j = index[iz]; - - /* The sign of W[j] is ok for j to be moved to set P. */ - /* Begin the transformation and check new diagonal element to avoid */ - /* near linear dependence. */ - asave = a[j*m+npp1]; - _nnls_h12(1, npp1, npp1 + 1, m, &a[j*m+0], 1, &up, &dummy, 1, 1, 0); - unorm = 0.; - if (nsetp != 0) - for (l = 0; l < nsetp; l++) - { - d1 = a[j*m+l]; - unorm += d1 * d1; - } - unorm = sqrt(unorm); - d2 = unorm + (d1 = a[j*m+npp1], fabs(d1)) * 0.01; - if ((d2 - unorm) > 0.) - { - /* Col j is sufficiently independent. Copy B into ZZ, update ZZ */ - /* and solve for ztest ( = proposed new value for X[j] ) */ - for (l = 0; l < m; l++) - zz[l] = b[l]; - _nnls_h12(2, npp1, npp1 + 1, m, &a[j*m+0], 1, &up, zz, 1, 1, 1); - ztest = zz[npp1] / a[j*m+npp1]; - /* See if ztest is positive */ - if (ztest > 0.) - break; - } - - /* Reject j as a candidate to be moved from set Z to set P. Restore */ - /* A[npp1,j], set W[j]=0., and loop back to test dual coeffs again */ - a[j*m+npp1] = asave; - w[j] = 0.; - } /* while(1) */ - if (wmax <= 0.0) - break; - - /* Index j=INDEX[iz] has been selected to be moved from set Z to set P. */ - /* Update B and indices, apply householder transformations to cols in */ - /* new set Z, zero subdiagonal elts in col j, set W[j]=0. */ - for (l = 0; l < m; ++l) - b[l] = zz[l]; - index[iz] = index[iz1]; - index[iz1] = j; - iz1++; - nsetp = npp1 + 1; - npp1++; - if (iz1 <= iz2) - for (jz = iz1; jz <= iz2; jz++) - { - jj = index[jz]; - _nnls_h12(2, nsetp - 1, npp1, m, &a[j*m+0], 1, &up, - &a[jj*m+0], 1, m, 1); - } - if (nsetp != m) - for (l = npp1; l < m; l++) - a[j*m+l] = 0.; - w[j] = 0.; - /* Solve the triangular system; store the solution temporarily in Z[] */ - for (l = 0; l < nsetp; l++) - { - ip = nsetp - (l + 1); - if (l != 0) - for (ii = 0; ii <= ip; ii++) - zz[ii] -= a[jj*m+ii] * zz[ip+1]; - jj = index[ip]; - zz[ip] /= a[jj*m+ip]; - } - - /* Secondary loop begins here */ - while (++iter < itmax) - { - /* See if all new constrained coeffs are feasible; if not, compute alpha */ - for (alpha = 2.0, ip = 0; ip < nsetp; ip++) - { - l = index[ip]; - if (zz[ip] <= 0.) - { - t = -x[l] / (zz[ip] - x[l]); - if (alpha > t) - { - alpha = t; - jj = ip - 1; - } - } - } - - /* If all new constrained coeffs are feasible then still alpha==2. */ - /* If so, then exit from the secondary loop to main loop */ - if (alpha == 2.0) - break; - /* Use alpha (0. itmax) - { - ret = 1; - break; - } - for (ip = 0; ip < nsetp; ip++) - { - k = index[ip]; - x[k] = zz[ip]; - } - } /* end of main loop */ - /* Compute the norm of the final residual vector */ - sm = 0.; - if (npp1 < m) - for (k = npp1; k < m; k++) - sm += (b[k] * b[k]); - else - for (j = 0; j < n; j++) - w[j] = 0.; - *rnorm = sqrt(sm); - /* Free working space, if it was allocated here */ - if (wp == NULL) - free(w); - if (zzp == NULL) - free(zz); - if (indexp == NULL) - free(index); - return(ret); -} /* nnls_ */ -/****************************************************************************/ -/****************************************************************************/ -/* - nnlsWght() - - Algorithm for weighting the problem that is given to nnls-algorithm. - Square roots of weights are used because in nnls the difference - w*A-w*b is squared. - Algorithm returns zero if successful, 1 if arguments are inappropriate. - -*/ -int nnlsWght(int N, int M, double *A, double *b, double *weight) -{ - int n, m; - double *w; - - /* Check the arguments */ - if (N < 1 || M < 1 || A == NULL || b == NULL || weight == NULL) - return(1); - - /* Allocate memory */ - w = (double*)malloc(M * sizeof(double)); - if (w == NULL) - return(2); - - /* Check that weights are not zero and get the square roots of them to w[] */ - for (m = 0; m < M; m++) - { - if (weight[m] <= 1.0e-20) - w[m] = 0.0; - else - w[m] = sqrt(weight[m]); - } - - /* Multiply rows of matrix A and elements of vector b with weights*/ - for (m = 0; m < M; m++) - { - for (n = 0; n < N; n++) - { - A[n*M+m] *= w[m]; - } - b[m] *= w[m]; - } - - free(w); - return(0); -} -/****************************************************************************/ - -/* Singular value descomposition ------------------------------------------- */ -/* Copied from Bilib library (linearalgebra.h) */ -double Pythag(double a, double b) -{ - double absa, absb; - absa = fabs(a); - absb = fabs(b); - if (absb < absa) - return(absa * sqrt(1.0 + absb * absb / (absa * absa))); - else - return((absb == 0.0) ? (0.0) : (absb * sqrt(1.0 + absa * absa / (absb * absb)))); -} - -#define SVDMAXITER 1000 -void svdcmp(double *U, int Lines, int Columns, double *W, double *V) -{ - double Norm, Scale; - double c, f, g, h, s; - double x, y, z; - long i, its, j, jj, k, l = 0L, nm = 0L; - bool Flag; - int MaxIterations = SVDMAXITER; - - std::vector buffer(Columns*Columns); - auto *rv1= buffer.data(); - g = Scale = Norm = 0.0; - for (i = 0L; (i < Columns); i++) - { - l = i + 1L; - rv1[i] = Scale * g; - g = s = Scale = 0.0; - if (i < Lines) - { - for (k = i; (k < Lines); k++) - { - Scale += fabs(U[k * Columns + i]); - } - if (Scale != 0.0) - { - for (k = i; (k < Lines); k++) - { - U[k * Columns + i] /= Scale; - s += U[k * Columns + i] * U[k * Columns + i]; - } - f = U[i * Columns + i]; - g = (0.0 <= f) ? (-sqrt(s)) : (sqrt(s)); - h = f * g - s; - U[i * Columns + i] = f - g; - for (j = l; (j < Columns); j++) - { - for (s = 0.0, k = i; (k < Lines); k++) - { - s += U[k * Columns + i] * U[k * Columns + j]; - } - f = s / h; - for (k = i; (k < Lines); k++) - { - U[k * Columns + j] += f * U[k * Columns + i]; - } - } - for (k = i; (k < Lines); k++) - { - U[k * Columns + i] *= Scale; - } - } - } - W[i] = Scale * g; - g = s = Scale = 0.0; - if ((i < Lines) && (i != (Columns - 1L))) - { - for (k = l; (k < Columns); k++) - { - Scale += fabs(U[i * Columns + k]); - } - if (Scale != 0.0) - { - for (k = l; (k < Columns); k++) - { - U[i * Columns + k] /= Scale; - s += U[i * Columns + k] * U[i * Columns + k]; - } - f = U[i * Columns + l]; - g = (0.0 <= f) ? (-sqrt(s)) : (sqrt(s)); - h = f * g - s; - U[i * Columns + l] = f - g; - for (k = l; (k < Columns); k++) - { - rv1[k] = U[i * Columns + k] / h; - } - for (j = l; (j < Lines); j++) - { - for (s = 0.0, k = l; (k < Columns); k++) - { - s += U[j * Columns + k] * U[i * Columns + k]; - } - for (k = l; (k < Columns); k++) - { - U[j * Columns + k] += s * rv1[k]; - } - } - for (k = l; (k < Columns); k++) - { - U[i * Columns + k] *= Scale; - } - } - } - Norm = ((fabs(W[i]) + fabs(rv1[i])) < Norm) ? (Norm) : (fabs(W[i]) + fabs(rv1[i])); - } - for (i = Columns - 1L; (0L <= i); i--) - { - if (i < (Columns - 1L)) - { - if (g != 0.0) - { - for (j = l; (j < Columns); j++) - { - V[j * Columns + i] = U[i * Columns + j] / (U[i * Columns + l] * g); - } - for (j = l; (j < Columns); j++) - { - for (s = 0.0, k = l; (k < Columns); k++) - { - s += U[i * Columns + k] * V[k * Columns + j]; - } - for (k = l; (k < Columns); k++) - { - if (s != 0.0) - { - V[k * Columns + j] += s * V[k * Columns + i]; - } - } - } - } - for (j = l; (j < Columns); j++) - { - V[i * Columns + j] = V[j * Columns + i] = 0.0; - } - } - V[i * Columns + i] = 1.0; - g = rv1[i]; - l = i; - } - for (i = (Lines < Columns) ? (Lines - 1L) : (Columns - 1L); (0L <= i); i--) - { - l = i + 1L; - g = W[i]; - for (j = l; (j < Columns); j++) - { - U[i * Columns + j] = 0.0; - } - if (g != 0.0) - { - g = 1.0 / g; - for (j = l; (j < Columns); j++) - { - for (s = 0.0, k = l; (k < Lines); k++) - { - s += U[k * Columns + i] * U[k * Columns + j]; - } - f = s * g / U[i * Columns + i]; - for (k = i; (k < Lines); k++) - { - if (f != 0.0) - { - U[k * Columns + j] += f * U[k * Columns + i]; - } - } - } - for (j = i; (j < Lines); j++) - { - U[j * Columns + i] *= g; - } - } - else - { - for (j = i; (j < Lines); j++) - { - U[j * Columns + i] = 0.0; - } - } - U[i * Columns + i] += 1.0; - } - for (k = Columns - 1L; (0L <= k); k--) - { - for (its = 1L; (its <= MaxIterations); its++) - { - Flag = true; - for (l = k; (0L <= l); l--) - { - nm = l - 1L; - if ((fabs(rv1[l]) + Norm) == Norm) - { - Flag = false; - break; - } - if ((fabs(W[nm]) + Norm) == Norm) - { - break; - } - } - if (Flag) - { - c = 0.0; - s = 1.0; - for (i = l; (i <= k); i++) - { - f = s * rv1[i]; - rv1[i] *= c; - if ((fabs(f) + Norm) == Norm) - { - break; - } - g = W[i]; - h = Pythag(f, g); - W[i] = h; - h = 1.0 / h; - c = g * h; - s = -f * h; - for (j = 0L; (j < Lines); j++) - { - y = U[j * Columns + nm]; - z = U[j * Columns + i]; - U[j * Columns + nm] = y * c + z * s; - U[j * Columns + i] = z * c - y * s; - } - } - } - z = W[k]; - if (l == k) - { - if (z < 0.0) - { - W[k] = -z; - for (j = 0L; (j < Columns); j++) - { - V[j * Columns + k] = -V[j * Columns + k]; - } - } - break; - } - if (its == MaxIterations) return; - x = W[l]; - nm = k - 1L; - y = W[nm]; - g = rv1[nm]; - h = rv1[k]; - f = ((y - z) * (y + z) + (g - h) * (g + h)) / (2.0 * h * y); - g = Pythag(f, 1.0); - f = ((x - z) * (x + z) + h * ((y / (f + ((0.0 <= f) ? (fabs(g)) - : (-fabs(g))))) - h)) / x; - c = s = 1.0; - for (j = l; (j <= nm); j++) - { - i = j + 1L; - g = rv1[i]; - y = W[i]; - h = s * g; - g = c * g; - z = Pythag(f, h); - rv1[j] = z; - c = f / z; - s = h / z; - f = x * c + g * s; - g = g * c - x * s; - h = y * s; - y *= c; - for (jj = 0L; (jj < Columns); jj++) - { - x = V[jj * Columns + j]; - z = V[jj * Columns + i]; - V[jj * Columns + j] = x * c + z * s; - V[jj * Columns + i] = z * c - x * s; - } - z = Pythag(f, h); - W[j] = z; - if (z != 0.0) - { - z = 1.0 / z; - c = f * z; - s = h * z; - } - f = c * g + s * y; - x = c * y - s * g; - for (jj = 0L; (jj < Lines); jj++) - { - y = U[jj * Columns + j]; - z = U[jj * Columns + i]; - U[jj * Columns + j] = y * c + z * s; - U[jj * Columns + i] = z * c - y * s; - } - } - rv1[l] = 0.0; - rv1[k] = f; - W[k] = x; - } - } -} - -void svbksb(double *u, double *w, double *v, int m, int n, double *b, double *x) -{ - int jj, j, i; - double s; - - std::vector buffer(n); - auto *tmp= buffer.data()-1; - for (j = 1;j <= n;j++) - { - s = 0.0; - if (w[j]) - { - for (i = 1;i <= m;i++) - s += u[i*n+j] * b[i]; - s /= w[j]; - } - tmp[j] = s; - } - for (j = 1;j <= n;j++) - { - s = 0.0; - for (jj = 1;jj <= n;jj++) - s += v[j*n+jj] * tmp[jj]; - x[j] = s; - } -} - -// CFSQP ------------------------------------------------------------------- - -#ifndef TRUE -#define TRUE 1 -#endif -#ifndef FALSE -#define FALSE 0 -#endif -int x_is_new = TRUE; - -/* Declare and initialize user-accessible stopping criterion */ -double objeps = -1.e0; -double objrep = -1.e0; -double gLgeps = -1.e0; -extern int nstop; - -/* CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - !!!! NOTICE !!!! - -1. The routines contained in this file are due to Prof. K.Schittkowski - of the University of Bayreuth, Germany (modification of routines - due to Prof. MJD Powell at the University of Cambridge). They can - be freely distributed. - -2. A few minor modifications were performed at the University of - Maryland. They are marked in the code by "umd". - - A.L. Tits, J.L. Zhou, and - Craig Lawrence - University of Maryland - - *********************************************************************** - - - - SOLUTION OF QUADRATIC PROGRAMMING PROBLEMS - - - - QL0001 SOLVES THE QUADRATIC PROGRAMMING PROBLEM - - MINIMIZE .5*X'*C*X + D'*X - SUBJECT TO A(J)*X + B(J) = 0 , J=1,...,ME - A(J)*X + B(J) >= 0 , J=ME+1,...,M - XL <= X <= XU - -HERE C MUST BE AN N BY N SYMMETRIC AND POSITIVE MATRIX, D AN N-DIMENSIONAL -VECTOR, A AN M BY N MATRIX AND B AN M-DIMENSIONAL VECTOR. THE ABOVE -SITUATION IS INDICATED BY IWAR(1)=1. ALTERNATIVELY, I.E. IF IWAR(1)=0, -THE OBJECTIVE FUNCTION MATRIX CAN ALSO BE PROVIDED IN FACTORIZED FORM. -IN THIS CASE, C IS AN UPPER TRIANGULAR MATRIX. - -THE SUBROUTINE REORGANIZES SOME DATA SO THAT THE PROBLEM CAN BE SOLVED -BY A MODIFICATION OF AN ALGORITHM PROPOSED BY POWELL (1983). - - -USAGE: - - QL0001(M,ME,MMAX,N,NMAX,MNN,C,D,A,B,XL,XU,X,U,IOUT,IFAIL,IPRINT, - WAR,LWAR,IWAR,LIWAR) - - - DEFINITION OF THE PARAMETERS: - - M : TOTAL NUMBER OF CONSTRAINTS. - ME : NUMBER OF EQUALITY CONSTRAINTS. - MMAX : ROW DIMENSION OF A. MMAX MUST BE AT LEAST ONE AND GREATER - THAN M. - N : NUMBER OF VARIABLES. - NMAX : ROW DIMENSION OF C. NMAX MUST BE GREATER OR EQUAL TO N. - MNN : MUST BE EQUAL TO M + N + N. - C(NMAX,NMAX): OBJECTIVE FUNCTION MATRIX WHICH SHOULD BE SYMMETRIC AND - POSITIVE DEFINITE. IF IWAR(1) = 0, C IS SUPPOSED TO BE THE - CHOLESKEY-FACTOR OF ANOTHER MATRIX, I.E. C IS UPPER - TRIANGULAR. - D(NMAX) : CONTAINS THE CONSTANT VECTOR OF THE OBJECTIVE FUNCTION. - A(MMAX,NMAX): CONTAINS THE DATA MATRIX OF THE LINEAR CONSTRAINTS. - B(MMAX) : CONTAINS THE CONSTANT DATA OF THE LINEAR CONSTRAINTS. - XL(N),XU(N): CONTAIN THE LOWER AND UPPER BOUNDS FOR THE VARIABLES. - X(N) : ON RETURN, X CONTAINS THE OPTIMAL SOLUTION VECTOR. - U(MNN) : ON RETURN, U CONTAINS THE LAGRANGE MULTIPLIERS. THE FIRST - M POSITIONS ARE RESERVED FOR THE MULTIPLIERS OF THE M - LINEAR CONSTRAINTS AND THE SUBSEQUENT ONES FOR THE - MULTIPLIERS OF THE LOWER AND UPPER BOUNDS. ON SUCCESSFUL - TERMINATION, ALL VALUES OF U WITH RESPECT TO INEQUALITIES - AND BOUNDS SHOULD BE GREATER OR EQUAL TO ZERO. - IOUT : INTEGER INDICATING THE DESIRED OUTPUT UNIT NUMBER, I.E. - ALL WRITE-STATEMENTS START WITH 'WRITE(IOUT,... '. - IFAIL : SHOWS THE TERMINATION REASON. - IFAIL = 0 : SUCCESSFUL RETURN. - IFAIL = 1 : TOO MANY ITERATIONS (MORE THAN 40*(N+M)). - IFAIL = 2 : ACCURACY INSUFFICIENT TO SATISFY CONVERGENCE - CRITERION. - IFAIL = 5 : LENGTH OF A WORKING ARRAY IS TOO SHORT. - IFAIL > 10 : THE CONSTRAINTS ARE INCONSISTENT. - IPRINT : OUTPUT CONTROL. - IPRINT = 0 : NO OUTPUT OF QL0001. - IPRINT > 0 : BRIEF OUTPUT IN ERROR CASES. - WAR(LWAR) : REAL WORKING ARRAY. THE LENGTH LWAR SHOULD BE GRATER THAN - 3*NMAX*NMAX/2 + 10*NMAX + 2*MMAX. - IWAR(LIWAR): INTEGER WORKING ARRAY. THE LENGTH LIWAR SHOULD BE AT - LEAST N. - IF IWAR(1)=0 INITIALLY, THEN THE CHOLESKY DECOMPOSITION - WHICH IS REQUIRED BY THE DUAL ALGORITHM TO GET THE FIRST - UNCONSTRAINED MINIMUM OF THE OBJECTIVE FUNCTION, IS - PERFORMED INTERNALLY. OTHERWISE, I.E. IF IWAR(1)=1, THEN - IT IS ASSUMED THAT THE USER PROVIDES THE INITIAL FAC- - TORIZATION BY HIMSELF AND STORES IT IN THE UPPER TRIAN- - GULAR PART OF THE ARRAY C. - - A NAMED COMMON-BLOCK /CMACHE/EPS MUST BE PROVIDED BY THE USER, - WHERE EPS DEFINES A GUESS FOR THE UNDERLYING MACHINE PRECISION. - - - AUTHOR: K. SCHITTKOWSKI, - MATHEMATISCHES INSTITUT, - UNIVERSITAET BAYREUTH, - 8580 BAYREUTH, - GERMANY, F.R. - - - VERSION: 1.4 (MARCH, 1987) -*/ -/* f2c.h -- Standard Fortran to C header file */ - -/** barf [ba:rf] 2. "He suggested using FORTRAN, and everybody barfed." - - - From The Shogakukan DICTIONARY OF NEW ENGLISH (Second edition) */ - -#ifndef F2C_INCLUDE -#define F2C_INCLUDE - -typedef int integer; -typedef char *address; -typedef short int shortint; -typedef float cfsqpreal; -typedef double doublereal; -typedef struct -{ - cfsqpreal r, i; -} -cfsqpcomplex; -typedef struct -{ - doublereal r, i; -} -doublecomplex; -typedef long int logical; -typedef short int shortlogical; - -#define TRUE_ (1) -#define FALSE_ (0) - -/* Extern is for use with -E */ -#ifndef Extern -#define Extern extern -#endif - -/* I/O stuff */ - -#ifdef f2c_i2 -/* for -i2 */ -typedef short flag; -typedef short ftnlen; -typedef short ftnint; -#else -typedef long flag; -typedef long ftnlen; -typedef long ftnint; -#endif - -/*external read, write*/ -typedef struct -{ - flag cierr; - ftnint ciunit; - flag ciend; - char *cifmt; - ftnint cirec; -} -cilist; - -/*internal read, write*/ -typedef struct -{ - flag icierr; - char *iciunit; - flag iciend; - char *icifmt; - ftnint icirlen; - ftnint icirnum; -} -icilist; - -/*open*/ -typedef struct -{ - flag oerr; - ftnint ounit; - char *ofnm; - ftnlen ofnmlen; - char *osta; - char *oacc; - char *ofm; - ftnint orl; - char *oblnk; -} -olist; - -/*close*/ -typedef struct -{ - flag cerr; - ftnint cunit; - char *csta; -} -cllist; - -/*rewind, backspace, endfile*/ -typedef struct -{ - flag aerr; - ftnint aunit; -} -alist; - -/* inquire */ -typedef struct -{ - flag inerr; - ftnint inunit; - char *infile; - ftnlen infilen; - ftnint *inex; /*parameters in standard's order*/ - ftnint *inopen; - ftnint *innum; - ftnint *innamed; - char *inname; - ftnlen innamlen; - char *inacc; - ftnlen inacclen; - char *inseq; - ftnlen inseqlen; - char *indir; - ftnlen indirlen; - char *infmt; - ftnlen infmtlen; - char *inform; - ftnint informlen; - char *inunf; - ftnlen inunflen; - ftnint *inrecl; - ftnint *innrec; - char *inblank; - ftnlen inblanklen; -} -inlist; - -#define VOID void - -union Multitype { /* for multiple entry points */ - shortint h; - integer i; - cfsqpreal r; - doublereal d; - cfsqpcomplex cc; - doublecomplex z; -}; - -typedef union Multitype Multitype; - -typedef long Long; - -struct Vardesc -{ /* for Namelist */ - char *name; - char *addr; - Long *dims; - int type; -}; -typedef struct Vardesc Vardesc; - -struct Namelist -{ - char *name; - Vardesc **vars; - int nvars; -}; -typedef struct Namelist Namelist; - -#define abs(x) ((x) >= 0 ? (x) : -(x)) -#define dabs(x) (doublereal)abs(x) -#define min(a,b) ((a) <= (b) ? (a) : (b)) -#define max(a,b) ((a) >= (b) ? (a) : (b)) -#define dmin(a,b) (doublereal)min(a,b) -#define dmax(a,b) (doublereal)max(a,b) - -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef int /* Unknown procedure type */ (*U_fp)(...); -typedef shortint(*J_fp)(...); -typedef integer(*I_fp)(...); -typedef cfsqpreal(*R_fp)(...); -typedef doublereal(*D_fp)(...), (*E_fp)(...); -typedef /* Complex */ VOID(*C_fp)(...); -typedef /* Double Complex */ VOID(*Z_fp)(...); -typedef logical(*L_fp)(...); -typedef shortlogical(*K_fp)(...); -typedef /* Character */ VOID(*H_fp)(...); -typedef /* Subroutine */ int(*S_fp)(...); -#else -typedef int /* Unknown procedure type */ (*U_fp)(); -typedef shortint(*J_fp)(); -typedef integer(*I_fp)(); -typedef cfsqpreal(*R_fp)(); -typedef doublereal(*D_fp)(), (*E_fp)(); -typedef /* Complex */ VOID(*C_fp)(); -typedef /* Double Complex */ VOID(*Z_fp)(); -typedef logical(*L_fp)(); -typedef shortlogical(*K_fp)(); -typedef /* Character */ VOID(*H_fp)(); -typedef /* Subroutine */ int(*S_fp)(); -#endif -/* E_fp is for real functions when -R is not specified */ -typedef VOID C_f; /* complex function */ -typedef VOID H_f; /* character function */ -typedef VOID Z_f; /* double complex function */ -typedef doublereal E_f; /* real function with -R not specified */ - -/* undef any lower-case symbols that your C compiler predefines, e.g.: */ - -/* asolano: confuses Portland Group compiler, doesn't seem to affect anything */ -#define Skip_f2c_Undefs - -#ifndef Skip_f2c_Undefs -#undef cray -#undef gcos -#undef mc68010 -#undef mc68020 -#undef mips -#undef pdp11 -#undef sgi -#undef sparc -#undef sun -#undef sun2 -#undef sun3 -#undef sun4 -#undef u370 -#undef u3b -#undef u3b2 -#undef u3b5 -#undef unix -#undef vax -#endif -#endif - - - -/* Common Block Declarations */ - -struct Tcmache -{ - doublereal eps; -} -cmache_; - -#define cmache_1 cmache_ - -/* umd */ -/* -ql0002_ is declared here to provide ANSI C compliance. -(Thanks got to Martin Wauchope for providing this correction) -*/ -#ifdef __STDC__ - -int ql0002_(integer *n, integer *m, integer *meq, integer *mmax, - integer *mn, integer *mnn, integer *nmax, - logical *lql, - doublereal *a, doublereal *b, doublereal *grad, - doublereal *g, doublereal *xl, doublereal *xu, doublereal *x, - integer *nact, integer *iact, integer *maxit, - doublereal *vsmall, - integer *info, - doublereal *diag, doublereal *w, - integer *lw); -#else -int ql0002_(); -#endif -/* umd */ -/* -When the fortran code was f2c converted, the use of fortran COMMON -blocks was no longer available. Thus an additional variable, eps1, -was added to the parameter list to account for this. -*/ -/* umd */ -/* -Two alternative definitions are provided in order to give ANSI -compliance. -*/ -#ifdef __STDC__ -int ql0001_(int *m, int *me, int *mmax, int *n, int *nmax, int *mnn, - double *c, double *d, double *a, double *b, double *xl, - double *xu, double *x, double *u, int *iout, int *ifail, - int *iprint, double *war, int *lwar, int *iwar, int *liwar, - double *eps1) -#else -/* Subroutine */ -int ql0001_(m, me, mmax, n, nmax, mnn, c, d, a, b, xl, xu, x, - u, iout, ifail, iprint, war, lwar, iwar, liwar, eps1) -integer *m, *me, *mmax, *n, *nmax, *mnn; -doublereal *c, *d, *a, *b, *xl, *xu, *x, *u; -integer *iout, *ifail, *iprint; -doublereal *war; -integer *lwar, *iwar, *liwar; -doublereal *eps1; -#endif -{ - /* System generated locals */ - integer c_dim1, c_offset, a_dim1, a_offset, i__1; - - /* Builtin functions */ - /* integer s_wsfe(), do_fio(), e_wsfe(); */ - - /* Local variables */ - static doublereal diag; - /* extern int ql0002_(); */ - static integer nact, info; - static doublereal zero; - static integer i, j, maxit; - static doublereal qpeps; - static integer in, mn, lw; - static logical lql; - static integer inw1, inw2; - - /* INTRINSIC FUNCTIONS: DSQRT */ - - /* Parameter adjustments */ - --iwar; - --war; - --u; - --x; - --xu; - --xl; - --b; - a_dim1 = *mmax; - a_offset = a_dim1 + 1; - a -= a_offset; - --d; - c_dim1 = *nmax; - c_offset = c_dim1 + 1; - c -= c_offset; - - /* Function Body */ - cmache_1.eps = *eps1; - - /* CONSTANT DATA */ - - /* ################################################################# */ - - if (fabs(c[*nmax + *nmax * c_dim1]) == 0.e0) - { - c[*nmax + *nmax * c_dim1] = cmache_1.eps; - } - - /* umd */ - /* This prevents a subsequent more major modification of the Hessian */ - /* matrix in the important case when a minmax problem (yielding a */ - /* singular Hessian matrix) is being solved. */ - /* ----UMCP, April 1991, Jian L. Zhou */ - /* ################################################################# */ - - lql = FALSE_; - if (iwar[1] == 1) - { - lql = TRUE_; - } - zero = 0.; - maxit = (*m + *n) * 40; - qpeps = cmache_1.eps; - inw1 = 1; - inw2 = inw1 + *mmax; - - /* PREPARE PROBLEM DATA FOR EXECUTION */ - - if (*m <= 0) - { - goto L20; - } - in = inw1; - i__1 = *m; - for (j = 1; j <= i__1; ++j) - { - war[in] = -b[j]; - /* L10: */ - ++in; - } -L20: - lw = *nmax * 3 * *nmax / 2 + *nmax * 10 + *m; - if (inw2 + lw > *lwar) - { - goto L80; - } - if (*liwar < *n) - { - goto L81; - } - if (*mnn < *m + *n + *n) - { - goto L82; - } - mn = *m + *n; - - /* CALL OF QL0002 */ - - ql0002_(n, m, me, mmax, &mn, mnn, nmax, &lql, &a[a_offset], &war[inw1], & - d[1], &c[c_offset], &xl[1], &xu[1], &x[1], &nact, &iwar[1], & - maxit, &qpeps, &info, &diag, &war[inw2], &lw); - - /* TEST OF MATRIX CORRECTIONS */ - - *ifail = 0; - if (info == 1) - { - goto L40; - } - if (info == 2) - { - goto L90; - } - if (info < 0) - { - goto L70; - } - - /* REORDER MULTIPLIER */ - - i__1 = *mnn; - for (j = 1; j <= i__1; ++j) - { - /* L50: */ - u[j] = zero; - } - in = inw2 - 1; - if (nact == 0) - { - goto L30; - } - i__1 = nact; - for (i = 1; i <= i__1; ++i) - { - j = iwar[i]; - u[j] = war[in + i]; - /* L60: */ - } -L30: - return 0; - - /* ERROR MESSAGES */ - -L70: - *ifail = -info + 10; - /* - if (*iprint > 0 && nact > 0) { - io___18.ciunit = *iout; - s_wsfe(&io___18); - i__1 = -info; - do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); - i__2 = nact; - for (i = 1; i <= i__2; ++i) { - do_fio(&c__1, (char *)&iwar[i], (ftnlen)sizeof(integer)); - } - e_wsfe(); - } - */ - return 0; -L80: - *ifail = 5; - /* - if (*iprint > 0) { - io___19.ciunit = *iout; - s_wsfe(&io___19); - e_wsfe(); - } - */ - return 0; -L81: - *ifail = 5; - /* - if (*iprint > 0) { - io___20.ciunit = *iout; - s_wsfe(&io___20); - e_wsfe(); - } - */ - return 0; -L82: - *ifail = 5; - /* - if (*iprint > 0) { - io___21.ciunit = *iout; - s_wsfe(&io___21); - e_wsfe(); - } - */ - return 0; -L40: - *ifail = 1; - /* - if (*iprint > 0) { - io___22.ciunit = *iout; - s_wsfe(&io___22); - do_fio(&c__1, (char *)&maxit, (ftnlen)sizeof(integer)); - e_wsfe(); - } - */ - return 0; -L90: - *ifail = 2; - /* - if (*iprint > 0) { - io___23.ciunit = *iout; - s_wsfe(&io___23); - e_wsfe(); - } - */ - return 0; - - /* FORMAT-INSTRUCTIONS */ - -} /* ql0001_ */ - - -/* umd -Two alternative definitions are provided in order to give ANSI -compliance. -(Thanks got to Martin Wauchope for providing this correction) -*/ -#ifdef __STDC__ -int ql0002_(integer *n, integer *m, integer *meq, integer *mmax, - integer *mn, integer *mnn, integer *nmax, - logical *lql, - doublereal *a, doublereal *b, doublereal *grad, - doublereal *g, doublereal *xl, doublereal *xu, doublereal *x, - integer *nact, integer *iact, integer *maxit, - doublereal *vsmall, - integer *info, - doublereal *diag, doublereal *w, - integer *lw) -#else -/* Subroutine */ int ql0002_(n, m, meq, mmax, mn, mnn, nmax, lql, a, b, grad, - g, xl, xu, x, nact, iact, maxit, vsmall, info, diag, w, lw) -integer *n, *m, *meq, *mmax, *mn, *mnn, *nmax; -logical *lql; -doublereal *a, *b, *grad, *g, *xl, *xu, *x; -integer *nact, *iact, *maxit; -doublereal *vsmall; -integer *info; -doublereal *diag, *w; -integer *lw; -#endif -{ - /* System generated locals */ - integer a_dim1, a_offset, g_dim1, g_offset, i__1, i__2, i__3, i__4; - doublereal d__1, d__2, d__3, d__4; - - /* Builtin functions */ - /* umd */ - /* double sqrt(); */ - - /* Local variables */ - static doublereal onha, xmag, suma, sumb, sumc, temp, step, zero; - static integer iwwn; - static doublereal sumx, sumy; - static integer i, j, k; - static doublereal fdiff; - static integer iflag, jflag, kflag, lflag; - static doublereal diagr; - static integer ifinc, kfinc, jfinc, mflag, nflag; - static doublereal vfact, tempa; - static integer iterc, itref; - static doublereal cvmax, ratio, xmagr; - static integer kdrop; - static logical lower; - static integer knext, k1; - static doublereal ga, gb; - static integer ia, id; - static doublereal fdiffa; - static integer ii, il, kk, jl, ir, nm, is, iu, iw, ju, ix, iz, nu, iy; - - static doublereal parinc, parnew; - static integer ira, irb, iwa; - static doublereal one; - static integer iwd, iza; - static doublereal res; - static integer iwr, iws; - static doublereal sum; - static integer iww, iwx, iwy; - static doublereal two; - static integer iwz; - - - /* WHETHER THE CONSTRAINT IS ACTIVE. */ - - - /* AUTHOR: K. SCHITTKOWSKI, */ - /* MATHEMATISCHES INSTITUT, */ - /* UNIVERSITAET BAYREUTH, */ - /* 8580 BAYREUTH, */ - /* GERMANY, F.R. */ - - /* AUTHOR OF ORIGINAL VERSION: */ - /* M.J.D. POWELL, DAMTP, */ - /* UNIVERSITY OF CAMBRIDGE, SILVER STREET */ - /* CAMBRIDGE, */ - /* ENGLAND */ - - - /* REFERENCE: M.J.D. POWELL: ZQPCVX, A FORTRAN SUBROUTINE FOR CONVEX */ - /* PROGRAMMING, REPORT DAMTP/1983/NA17, UNIVERSITY OF */ - /* CAMBRIDGE, ENGLAND, 1983. */ - - - /* VERSION : 2.0 (MARCH, 1987) */ - - - /************************************************************************ - ***/ - - - /* INTRINSIC FUNCTIONS: DMAX1,DSQRT,DABS,DMIN1 */ - - - /* INITIAL ADDRESSES */ - - /* Parameter adjustments */ - --w; - --iact; - --x; - --xu; - --xl; - g_dim1 = *nmax; - g_offset = g_dim1 + 1; - g -= g_offset; - --grad; - --b; - a_dim1 = *mmax; - a_offset = a_dim1 + 1; - a -= a_offset; - - /* Function Body */ - iwz = *nmax; - iwr = iwz + *nmax * *nmax; - iww = iwr + *nmax * (*nmax + 3) / 2; - iwd = iww + *nmax; - iwx = iwd + *nmax; - iwa = iwx + *nmax; - - /* SET SOME CONSTANTS. */ - - zero = 0.; - one = 1.; - two = 2.; - onha = 1.5; - vfact = 1.; - - /* SET SOME PARAMETERS. */ - /* NUMBER LESS THAN VSMALL ARE ASSUMED TO BE NEGLIGIBLE. */ - /* THE MULTIPLE OF I THAT IS ADDED TO G IS AT MOST DIAGR TIMES */ - /* THE LEAST MULTIPLE OF I THAT GIVES POSITIVE DEFINITENESS. */ - /* X IS RE-INITIALISED IF ITS MAGNITUDE IS REDUCED BY THE */ - /* FACTOR XMAGR. */ - /* A CHECK IS MADE FOR AN INCREASE IN F EVERY IFINC ITERATIONS, */ - /* AFTER KFINC ITERATIONS ARE COMPLETED. */ - - diagr = two; - xmagr = .01; - ifinc = 3; - kfinc = max(10, *n); - - /* FIND THE RECIPROCALS OF THE LENGTHS OF THE CONSTRAINT NORMALS. */ - /* RETURN IF A CONSTRAINT IS INFEASIBLE DUE TO A ZERO NORMAL. */ - - *nact = 0; - if (*m <= 0) - { - goto L45; - } - i__1 = *m; - for (k = 1; k <= i__1; ++k) - { - sum = zero; - i__2 = *n; - for (i = 1; i <= i__2; ++i) - { - /* L10: */ - /* Computing 2nd power */ - d__1 = a[k + i * a_dim1]; - sum += d__1 * d__1; - } - if (sum > zero) - { - goto L20; - } - if (b[k] == zero) - { - goto L30; - } - *info = -k; - if (k <= *meq) - { - goto L730; - } - if (b[k] <= 0.) - { - goto L30; - } - else - { - goto L730; - } -L20: - sum = one / sqrt(sum); -L30: - ia = iwa + k; - /* L40: */ - w[ia] = sum; - } -L45: - i__1 = *n; - for (k = 1; k <= i__1; ++k) - { - ia = iwa + *m + k; - /* L50: */ - w[ia] = one; - } - - /* IF NECESSARY INCREASE THE DIAGONAL ELEMENTS OF G. */ - - if (!(*lql)) - { - goto L165; - } - *diag = zero; - i__1 = *n; - for (i = 1; i <= i__1; ++i) - { - id = iwd + i; - w[id] = g[i + i * g_dim1]; - /* Computing MAX */ - d__1 = *diag, d__2 = *vsmall - w[id]; - *diag = max(d__1, d__2); - if (i == *n) - { - goto L60; - } - ii = i + 1; - i__2 = *n; - for (j = ii; j <= i__2; ++j) - { - /* Computing MIN */ - d__1 = w[id], d__2 = g[j + j * g_dim1]; - ga = -min(d__1, d__2); - gb = (d__1 = w[id] - g[j + j * g_dim1], abs(d__1)) + (d__2 = g[i - + j * g_dim1], abs(d__2)); - if (gb > zero) - { - /* Computing 2nd power */ - d__1 = g[i + j * g_dim1]; - ga += d__1 * d__1 / gb; - } - /* L55: */ - *diag = max(*diag, ga); - } -L60: - ; - } - if (*diag <= zero) - { - goto L90; - } -L70: - *diag = diagr * *diag; - i__1 = *n; - for (i = 1; i <= i__1; ++i) - { - id = iwd + i; - /* L80: */ - g[i + i * g_dim1] = *diag + w[id]; - } - - /* FORM THE CHOLESKY FACTORISATION OF G. THE TRANSPOSE */ - /* OF THE FACTOR WILL BE PLACED IN THE R-PARTITION OF W. */ - -L90: - ir = iwr; - i__1 = *n; - for (j = 1; j <= i__1; ++j) - { - ira = iwr; - irb = ir + 1; - i__2 = j; - for (i = 1; i <= i__2; ++i) - { - temp = g[i + j * g_dim1]; - if (i == 1) - { - goto L110; - } - i__3 = ir; - for (k = irb; k <= i__3; ++k) - { - ++ira; - /* L100: */ - temp -= w[k] * w[ira]; - } -L110: - ++ir; - ++ira; - if (i < j) - { - w[ir] = temp / w[ira]; - } - /* L120: */ - } - if (temp < *vsmall) - { - goto L140; - } - /* L130: */ - w[ir] = sqrt(temp); - } - goto L170; - - /* INCREASE FURTHER THE DIAGONAL ELEMENT OF G. */ - -L140: - w[j] = one; - sumx = one; - k = j; -L150: - sum = zero; - ira = ir - 1; - i__1 = j; - for (i = k; i <= i__1; ++i) - { - sum -= w[ira] * w[i]; - /* L160: */ - ira += i; - } - ir -= k; - --k; - w[k] = sum / w[ir]; - /* Computing 2nd power */ - d__1 = w[k]; - sumx += d__1 * d__1; - if (k >= 2) - { - goto L150; - } - *diag = *diag + *vsmall - temp / sumx; - goto L70; - - /* STORE THE CHOLESKY FACTORISATION IN THE R-PARTITION */ - /* OF W. */ - -L165: - ir = iwr; - i__1 = *n; - for (i = 1; i <= i__1; ++i) - { - i__2 = i; - for (j = 1; j <= i__2; ++j) - { - ++ir; - /* L166: */ - w[ir] = g[j + i * g_dim1]; - } - } - - /* SET Z THE INVERSE OF THE MATRIX IN R. */ - -L170: - nm = *n - 1; - i__2 = *n; - for (i = 1; i <= i__2; ++i) - { - iz = iwz + i; - if (i == 1) - { - goto L190; - } - i__1 = i; - for (j = 2; j <= i__1; ++j) - { - w[iz] = zero; - /* L180: */ - iz += *n; - } -L190: - ir = iwr + (i + i * i) / 2; - w[iz] = one / w[ir]; - if (i == *n) - { - goto L220; - } - iza = iz; - i__1 = nm; - for (j = i; j <= i__1; ++j) - { - ir += i; - sum = zero; - i__3 = iz; - i__4 = *n; - for (k = iza; i__4 < 0 ? k >= i__3 : k <= i__3; k += i__4) - { - sum += w[k] * w[ir]; - /* L200: */ - ++ir; - } - iz += *n; - /* L210: */ - w[iz] = -sum / w[ir]; - } -L220: - ; - } - - /* SET THE INITIAL VALUES OF SOME VARIABLES. */ - /* ITERC COUNTS THE NUMBER OF ITERATIONS. */ - /* ITREF IS SET TO ONE WHEN ITERATIVE REFINEMENT IS REQUIRED. */ - /* JFINC INDICATES WHEN TO TEST FOR AN INCREASE IN F. */ - - iterc = 1; - itref = 0; - jfinc = -kfinc; - - /* SET X TO ZERO AND SET THE CORRESPONDING RESIDUALS OF THE */ - /* KUHN-TUCKER CONDITIONS. */ - -L230: - iflag = 1; - iws = iww - *n; - i__2 = *n; - for (i = 1; i <= i__2; ++i) - { - x[i] = zero; - iw = iww + i; - w[iw] = grad[i]; - if (i > *nact) - { - goto L240; - } - w[i] = zero; - is = iws + i; - k = iact[i]; - if (k <= *m) - { - goto L235; - } - if (k > *mn) - { - goto L234; - } - k1 = k - *m; - w[is] = xl[k1]; - goto L240; -L234: - k1 = k - *mn; - w[is] = -xu[k1]; - goto L240; -L235: - w[is] = b[k]; -L240: - ; - } - xmag = zero; - vfact = 1.; - if (*nact <= 0) - { - goto L340; - } - else - { - goto L280; - } - - /* SET THE RESIDUALS OF THE KUHN-TUCKER CONDITIONS FOR GENERAL X. */ - -L250: - iflag = 2; - iws = iww - *n; - i__2 = *n; - for (i = 1; i <= i__2; ++i) - { - iw = iww + i; - w[iw] = grad[i]; - if (*lql) - { - goto L259; - } - id = iwd + i; - w[id] = zero; - i__1 = *n; - for (j = i; j <= i__1; ++j) - { - /* L251: */ - w[id] += g[i + j * g_dim1] * x[j]; - } - i__1 = i; - for (j = 1; j <= i__1; ++j) - { - id = iwd + j; - /* L252: */ - w[iw] += g[j + i * g_dim1] * w[id]; - } - goto L260; -L259: - i__1 = *n; - for (j = 1; j <= i__1; ++j) - { - /* L261: */ - w[iw] += g[i + j * g_dim1] * x[j]; - } -L260: - ; - } - if (*nact == 0) - { - goto L340; - } - i__2 = *nact; - for (k = 1; k <= i__2; ++k) - { - kk = iact[k]; - is = iws + k; - if (kk > *m) - { - goto L265; - } - w[is] = b[kk]; - i__1 = *n; - for (i = 1; i <= i__1; ++i) - { - iw = iww + i; - w[iw] -= w[k] * a[kk + i * a_dim1]; - /* L264: */ - w[is] -= x[i] * a[kk + i * a_dim1]; - } - goto L270; -L265: - if (kk > *mn) - { - goto L266; - } - k1 = kk - *m; - iw = iww + k1; - w[iw] -= w[k]; - w[is] = xl[k1] - x[k1]; - goto L270; -L266: - k1 = kk - *mn; - iw = iww + k1; - w[iw] += w[k]; - w[is] = -xu[k1] + x[k1]; -L270: - ; - } - - /* PRE-MULTIPLY THE VECTOR IN THE S-PARTITION OF W BY THE */ - /* INVERS OF R TRANSPOSE. */ - -L280: - ir = iwr; - il = iws + 1; - iu = iws + *nact; - i__2 = iu; - for (i = il; i <= i__2; ++i) - { - sum = zero; - if (i == il) - { - goto L300; - } - ju = i - 1; - i__1 = ju; - for (j = il; j <= i__1; ++j) - { - ++ir; - /* L290: */ - sum += w[ir] * w[j]; - } -L300: - ++ir; - /* L310: */ - w[i] = (w[i] - sum) / w[ir]; - } - - /* SHIFT X TO SATISFY THE ACTIVE CONSTRAINTS AND MAKE THE */ - /* CORRESPONDING CHANGE TO THE GRADIENT RESIDUALS. */ - - i__2 = *n; - for (i = 1; i <= i__2; ++i) - { - iz = iwz + i; - sum = zero; - i__1 = iu; - for (j = il; j <= i__1; ++j) - { - sum += w[j] * w[iz]; - /* L320: */ - iz += *n; - } - x[i] += sum; - if (*lql) - { - goto L329; - } - id = iwd + i; - w[id] = zero; - i__1 = *n; - for (j = i; j <= i__1; ++j) - { - /* L321: */ - w[id] += g[i + j * g_dim1] * sum; - } - iw = iww + i; - i__1 = i; - for (j = 1; j <= i__1; ++j) - { - id = iwd + j; - /* L322: */ - w[iw] += g[j + i * g_dim1] * w[id]; - } - goto L330; -L329: - i__1 = *n; - for (j = 1; j <= i__1; ++j) - { - iw = iww + j; - /* L331: */ - w[iw] += sum * g[i + j * g_dim1]; - } -L330: - ; - } - - /* FORM THE SCALAR PRODUCT OF THE CURRENT GRADIENT RESIDUALS */ - /* WITH EACH COLUMN OF Z. */ - -L340: - kflag = 1; - goto L930; -L350: - if (*nact == *n) - { - goto L380; - } - - /* SHIFT X SO THAT IT SATISFIES THE REMAINING KUHN-TUCKER */ - /* CONDITIONS. */ - - il = iws + *nact + 1; - iza = iwz + *nact * *n; - i__2 = *n; - for (i = 1; i <= i__2; ++i) - { - sum = zero; - iz = iza + i; - i__1 = iww; - for (j = il; j <= i__1; ++j) - { - sum += w[iz] * w[j]; - /* L360: */ - iz += *n; - } - /* L370: */ - x[i] -= sum; - } - *info = 0; - if (*nact == 0) - { - goto L410; - } - - /* UPDATE THE LAGRANGE MULTIPLIERS. */ - -L380: - lflag = 3; - goto L740; -L390: - i__2 = *nact; - for (k = 1; k <= i__2; ++k) - { - iw = iww + k; - /* L400: */ - w[k] += w[iw]; - } - - /* REVISE THE VALUES OF XMAG. */ - /* BRANCH IF ITERATIVE REFINEMENT IS REQUIRED. */ - -L410: - jflag = 1; - goto L910; -L420: - if (iflag == itref) - { - goto L250; - } - - /* DELETE A CONSTRAINT IF A LAGRANGE MULTIPLIER OF AN */ - /* INEQUALITY CONSTRAINT IS NEGATIVE. */ - - kdrop = 0; - goto L440; -L430: - ++kdrop; - if (w[kdrop] >= zero) - { - goto L440; - } - if (iact[kdrop] <= *meq) - { - goto L440; - } - nu = *nact; - mflag = 1; - goto L800; -L440: - if (kdrop < *nact) - { - goto L430; - } - - /* SEEK THE GREATEAST NORMALISED CONSTRAINT VIOLATION, DISREGARDING */ - - /* ANY THAT MAY BE DUE TO COMPUTER ROUNDING ERRORS. */ - -L450: - cvmax = zero; - if (*m <= 0) - { - goto L481; - } - i__2 = *m; - for (k = 1; k <= i__2; ++k) - { - ia = iwa + k; - if (w[ia] <= zero) - { - goto L480; - } - sum = -b[k]; - i__1 = *n; - for (i = 1; i <= i__1; ++i) - { - /* L460: */ - sum += x[i] * a[k + i * a_dim1]; - } - sumx = -sum * w[ia]; - if (k <= *meq) - { - sumx = abs(sumx); - } - if (sumx <= cvmax) - { - goto L480; - } - temp = (d__1 = b[k], abs(d__1)); - i__1 = *n; - for (i = 1; i <= i__1; ++i) - { - /* L470: */ - temp += (d__1 = x[i] * a[k + i * a_dim1], abs(d__1)); - } - tempa = temp + abs(sum); - if (tempa <= temp) - { - goto L480; - } - temp += onha * abs(sum); - if (temp <= tempa) - { - goto L480; - } - cvmax = sumx; - res = sum; - knext = k; -L480: - ; - } -L481: - i__2 = *n; - for (k = 1; k <= i__2; ++k) - { - lower = TRUE_; - ia = iwa + *m + k; - if (w[ia] <= zero) - { - goto L485; - } - sum = xl[k] - x[k]; - if (sum < 0.) - { - goto L482; - } - else if (sum == 0) - { - goto L485; - } - else - { - goto L483; - } -L482: - sum = x[k] - xu[k]; - lower = FALSE_; -L483: - if (sum <= cvmax) - { - goto L485; - } - cvmax = sum; - res = -sum; - knext = k + *m; - if (lower) - { - goto L485; - } - knext = k + *mn; -L485: - ; - } - - /* TEST FOR CONVERGENCE */ - - *info = 0; - if (cvmax <= *vsmall) - { - goto L700; - } - - /* RETURN IF, DUE TO ROUNDING ERRORS, THE ACTUAL CHANGE IN */ - /* X MAY NOT INCREASE THE OBJECTIVE FUNCTION */ - - ++jfinc; - if (jfinc == 0) - { - goto L510; - } - if (jfinc != ifinc) - { - goto L530; - } - fdiff = zero; - fdiffa = zero; - i__2 = *n; - for (i = 1; i <= i__2; ++i) - { - sum = two * grad[i]; - sumx = abs(sum); - if (*lql) - { - goto L489; - } - id = iwd + i; - w[id] = zero; - i__1 = *n; - for (j = i; j <= i__1; ++j) - { - ix = iwx + j; - /* L486: */ - w[id] += g[i + j * g_dim1] * (w[ix] + x[j]); - } - i__1 = i; - for (j = 1; j <= i__1; ++j) - { - id = iwd + j; - temp = g[j + i * g_dim1] * w[id]; - sum += temp; - /* L487: */ - sumx += abs(temp); - } - goto L495; -L489: - i__1 = *n; - for (j = 1; j <= i__1; ++j) - { - ix = iwx + j; - temp = g[i + j * g_dim1] * (w[ix] + x[j]); - sum += temp; - /* L490: */ - sumx += abs(temp); - } -L495: - ix = iwx + i; - fdiff += sum * (x[i] - w[ix]); - /* L500: */ - fdiffa += sumx * (d__1 = x[i] - w[ix], abs(d__1)); - } - *info = 2; - sum = fdiffa + fdiff; - if (sum <= fdiffa) - { - goto L700; - } - temp = fdiffa + onha * fdiff; - if (temp <= sum) - { - goto L700; - } - jfinc = 0; - *info = 0; -L510: - i__2 = *n; - for (i = 1; i <= i__2; ++i) - { - ix = iwx + i; - /* L520: */ - w[ix] = x[i]; - } - - /* FORM THE SCALAR PRODUCT OF THE NEW CONSTRAINT NORMAL WITH EACH */ - /* COLUMN OF Z. PARNEW WILL BECOME THE LAGRANGE MULTIPLIER OF */ - /* THE NEW CONSTRAINT. */ - -L530: - ++iterc; - if (iterc <= *maxit) - { - goto L531; - } - *info = 1; - goto L710; -L531: - iws = iwr + (*nact + *nact * *nact) / 2; - if (knext > *m) - { - goto L541; - } - i__2 = *n; - for (i = 1; i <= i__2; ++i) - { - iw = iww + i; - /* L540: */ - w[iw] = a[knext + i * a_dim1]; - } - goto L549; -L541: - i__2 = *n; - for (i = 1; i <= i__2; ++i) - { - iw = iww + i; - /* L542: */ - w[iw] = zero; - } - k1 = knext - *m; - if (k1 > *n) - { - goto L545; - } - iw = iww + k1; - w[iw] = one; - iz = iwz + k1; - i__2 = *n; - for (i = 1; i <= i__2; ++i) - { - is = iws + i; - w[is] = w[iz]; - /* L543: */ - iz += *n; - } - goto L550; -L545: - k1 = knext - *mn; - iw = iww + k1; - w[iw] = -one; - iz = iwz + k1; - i__2 = *n; - for (i = 1; i <= i__2; ++i) - { - is = iws + i; - w[is] = -w[iz]; - /* L546: */ - iz += *n; - } - goto L550; -L549: - kflag = 2; - goto L930; -L550: - parnew = zero; - - /* APPLY GIVENS ROTATIONS TO MAKE THE LAST (N-NACT-2) SCALAR */ - /* PRODUCTS EQUAL TO ZERO. */ - - if (*nact == *n) - { - goto L570; - } - nu = *n; - nflag = 1; - goto L860; - - /* BRANCH IF THERE IS NO NEED TO DELETE A CONSTRAINT. */ - -L560: - is = iws + *nact; - if (*nact == 0) - { - goto L640; - } - suma = zero; - sumb = zero; - sumc = zero; - iz = iwz + *nact * *n; - i__2 = *n; - for (i = 1; i <= i__2; ++i) - { - ++iz; - iw = iww + i; - suma += w[iw] * w[iz]; - sumb += (d__1 = w[iw] * w[iz], abs(d__1)); - /* L563: */ - /* Computing 2nd power */ - d__1 = w[iz]; - sumc += d__1 * d__1; - } - temp = sumb + abs(suma) * .1; - tempa = sumb + abs(suma) * .2; - if (temp <= sumb) - { - goto L570; - } - if (tempa <= temp) - { - goto L570; - } - if (sumb > *vsmall) - { - goto L5; - } - goto L570; -L5: - sumc = sqrt(sumc); - ia = iwa + knext; - if (knext <= *m) - { - sumc /= w[ia]; - } - temp = sumc + abs(suma) * .1; - tempa = sumc + abs(suma) * .2; - if (temp <= sumc) - { - goto L567; - } - if (tempa <= temp) - { - goto L567; - } - goto L640; - - /* CALCULATE THE MULTIPLIERS FOR THE NEW CONSTRAINT NORMAL */ - /* EXPRESSED IN TERMS OF THE ACTIVE CONSTRAINT NORMALS. */ - /* THEN WORK OUT WHICH CONTRAINT TO DROP. */ - -L567: - lflag = 4; - goto L740; -L570: - lflag = 1; - goto L740; - - /* COMPLETE THE TEST FOR LINEARLY DEPENDENT CONSTRAINTS. */ - -L571: - if (knext > *m) - { - goto L574; - } - i__2 = *n; - for (i = 1; i <= i__2; ++i) - { - suma = a[knext + i * a_dim1]; - sumb = abs(suma); - if (*nact == 0) - { - goto L581; - } - i__1 = *nact; - for (k = 1; k <= i__1; ++k) - { - kk = iact[k]; - if (kk <= *m) - { - goto L568; - } - kk -= *m; - temp = zero; - if (kk == i) - { - temp = w[iww + kk]; - } - kk -= *n; - if (kk == i) - { - temp = -w[iww + kk]; - } - goto L569; -L568: - iw = iww + k; - temp = w[iw] * a[kk + i * a_dim1]; -L569: - suma -= temp; - /* L572: */ - sumb += abs(temp); - } -L581: - if (suma <= *vsmall) - { - goto L573; - } - temp = sumb + abs(suma) * .1; - tempa = sumb + abs(suma) * .2; - if (temp <= sumb) - { - goto L573; - } - if (tempa <= temp) - { - goto L573; - } - goto L630; -L573: - ; - } - lflag = 1; - goto L775; -L574: - k1 = knext - *m; - if (k1 > *n) - { - k1 -= *n; - } - i__2 = *n; - for (i = 1; i <= i__2; ++i) - { - suma = zero; - if (i != k1) - { - goto L575; - } - suma = one; - if (knext > *mn) - { - suma = -one; - } -L575: - sumb = abs(suma); - if (*nact == 0) - { - goto L582; - } - i__1 = *nact; - for (k = 1; k <= i__1; ++k) - { - kk = iact[k]; - if (kk <= *m) - { - goto L579; - } - kk -= *m; - temp = zero; - if (kk == i) - { - temp = w[iww + kk]; - } - kk -= *n; - if (kk == i) - { - temp = -w[iww + kk]; - } - goto L576; -L579: - iw = iww + k; - temp = w[iw] * a[kk + i * a_dim1]; -L576: - suma -= temp; - /* L577: */ - sumb += abs(temp); - } -L582: - temp = sumb + abs(suma) * .1; - tempa = sumb + abs(suma) * .2; - if (temp <= sumb) - { - goto L578; - } - if (tempa <= temp) - { - goto L578; - } - goto L630; -L578: - ; - } - lflag = 1; - goto L775; - - /* BRANCH IF THE CONTRAINTS ARE INCONSISTENT. */ - -L580: - *info = -knext; - if (kdrop == 0) - { - goto L700; - } - parinc = ratio; - parnew = parinc; - - /* REVISE THE LAGRANGE MULTIPLIERS OF THE ACTIVE CONSTRAINTS. */ - -L590: - if (*nact == 0) - { - goto L601; - } - i__2 = *nact; - for (k = 1; k <= i__2; ++k) - { - iw = iww + k; - w[k] -= parinc * w[iw]; - if (iact[k] > *meq) - { - /* Computing MAX */ - d__1 = zero, d__2 = w[k]; - w[k] = max(d__1, d__2); - } - /* L600: */ - } -L601: - if (kdrop == 0) - { - goto L680; - } - - /* DELETE THE CONSTRAINT TO BE DROPPED. */ - /* SHIFT THE VECTOR OF SCALAR PRODUCTS. */ - /* THEN, IF APPROPRIATE, MAKE ONE MORE SCALAR PRODUCT ZERO. */ - - nu = *nact + 1; - mflag = 2; - goto L800; -L610: - iws = iws - *nact - 1; - nu = min(*n, nu); - i__2 = nu; - for (i = 1; i <= i__2; ++i) - { - is = iws + i; - j = is + *nact; - /* L620: */ - w[is] = w[j + 1]; - } - nflag = 2; - goto L860; - - /* CALCULATE THE STEP TO THE VIOLATED CONSTRAINT. */ - -L630: - is = iws + *nact; -L640: - sumy = w[is + 1]; - step = -res / sumy; - parinc = step / sumy; - if (*nact == 0) - { - goto L660; - } - - /* CALCULATE THE CHANGES TO THE LAGRANGE MULTIPLIERS, AND REDUCE */ - /* THE STEP ALONG THE NEW SEARCH DIRECTION IF NECESSARY. */ - - lflag = 2; - goto L740; -L650: - if (kdrop == 0) - { - goto L660; - } - temp = one - ratio / parinc; - if (temp <= zero) - { - kdrop = 0; - } - if (kdrop == 0) - { - goto L660; - } - step = ratio * sumy; - parinc = ratio; - res = temp * res; - - /* UPDATE X AND THE LAGRANGE MULTIPIERS. */ - /* DROP A CONSTRAINT IF THE FULL STEP IS NOT TAKEN. */ - -L660: - iwy = iwz + *nact * *n; - i__2 = *n; - for (i = 1; i <= i__2; ++i) - { - iy = iwy + i; - /* L670: */ - x[i] += step * w[iy]; - } - parnew += parinc; - if (*nact >= 1) - { - goto L590; - } - - /* ADD THE NEW CONSTRAINT TO THE ACTIVE SET. */ - -L680: - ++(*nact); - w[*nact] = parnew; - iact[*nact] = knext; - ia = iwa + knext; - if (knext > *mn) - { - ia -= *n; - } - w[ia] = -w[ia]; - - /* ESTIMATE THE MAGNITUDE OF X. THEN BEGIN A NEW ITERATION, */ - /* RE-INITILISING X IF THIS MAGNITUDE IS SMALL. */ - - jflag = 2; - goto L910; -L690: - if (sum < xmagr * xmag) - { - goto L230; - } - if (itref <= 0) - { - goto L450; - } - else - { - goto L250; - } - - /* INITIATE ITERATIVE REFINEMENT IF IT HAS NOT YET BEEN USED, */ - /* OR RETURN AFTER RESTORING THE DIAGONAL ELEMENTS OF G. */ - -L700: - if (iterc == 0) - { - goto L710; - } - ++itref; - jfinc = -1; - if (itref == 1) - { - goto L250; - } -L710: - if (!(*lql)) - { - return 0; - } - i__2 = *n; - for (i = 1; i <= i__2; ++i) - { - id = iwd + i; - /* L720: */ - g[i + i * g_dim1] = w[id]; - } -L730: - return 0; - - - /* THE REMAINIG INSTRUCTIONS ARE USED AS SUBROUTINES. */ - - - /* ******************************************************************** */ - - - - /* CALCULATE THE LAGRANGE MULTIPLIERS BY PRE-MULTIPLYING THE */ - /* VECTOR IN THE S-PARTITION OF W BY THE INVERSE OF R. */ - -L740: - ir = iwr + (*nact + *nact * *nact) / 2; - i = *nact; - sum = zero; - goto L770; -L750: - ira = ir - 1; - sum = zero; - if (*nact == 0) - { - goto L761; - } - i__2 = *nact; - for (j = i; j <= i__2; ++j) - { - iw = iww + j; - sum += w[ira] * w[iw]; - /* L760: */ - ira += j; - } -L761: - ir -= i; - --i; -L770: - iw = iww + i; - is = iws + i; - w[iw] = (w[is] - sum) / w[ir]; - if (i > 1) - { - goto L750; - } - if (lflag == 3) - { - goto L390; - } - if (lflag == 4) - { - goto L571; - } - - /* CALCULATE THE NEXT CONSTRAINT TO DROP. */ - -L775: - kdrop = 0; - if (*nact == 0) - { - goto L791; - } - i__2 = *nact; - for (k = 1; k <= i__2; ++k) - { - if (iact[k] <= *meq) - { - goto L790; - } - iw = iww + k; - if (res * w[iw] >= zero) - { - goto L790; - } - temp = w[k] / w[iw]; - if (kdrop == 0) - { - goto L780; - } - if (abs(temp) >= abs(ratio)) - { - goto L790; - } -L780: - kdrop = k; - ratio = temp; -L790: - ; - } -L791: - switch ((int)lflag) - { - case 1: - goto L580; - case 2: - goto L650; - } - - - /* ******************************************************************** */ - - - - /* DROP THE CONSTRAINT IN POSITION KDROP IN THE ACTIVE SET. */ - -L800: - ia = iwa + iact[kdrop]; - if (iact[kdrop] > *mn) - { - ia -= *n; - } - w[ia] = -w[ia]; - if (kdrop == *nact) - { - goto L850; - } - - /* SET SOME INDICES AND CALCULATE THE ELEMENTS OF THE NEXT */ - /* GIVENS ROTATION. */ - - iz = iwz + kdrop * *n; - ir = iwr + (kdrop + kdrop * kdrop) / 2; -L810: - ira = ir; - ir = ir + kdrop + 1; - /* Computing MAX */ - d__3 = (d__1 = w[ir - 1], abs(d__1)), d__4 = (d__2 = w[ir], abs(d__2)); - temp = max(d__3, d__4); - /* Computing 2nd power */ - d__1 = w[ir - 1] / temp; - /* Computing 2nd power */ - d__2 = w[ir] / temp; - sum = temp * sqrt(d__1 * d__1 + d__2 * d__2); - ga = w[ir - 1] / sum; - gb = w[ir] / sum; - - /* EXCHANGE THE COLUMNS OF R. */ - - i__2 = kdrop; - for (i = 1; i <= i__2; ++i) - { - ++ira; - j = ira - kdrop; - temp = w[ira]; - w[ira] = w[j]; - /* L820: */ - w[j] = temp; - } - w[ir] = zero; - - /* APPLY THE ROTATION TO THE ROWS OF R. */ - - w[j] = sum; - ++kdrop; - i__2 = nu; - for (i = kdrop; i <= i__2; ++i) - { - temp = ga * w[ira] + gb * w[ira + 1]; - w[ira + 1] = ga * w[ira + 1] - gb * w[ira]; - w[ira] = temp; - /* L830: */ - ira += i; - } - - /* APPLY THE ROTATION TO THE COLUMNS OF Z. */ - - i__2 = *n; - for (i = 1; i <= i__2; ++i) - { - ++iz; - j = iz - *n; - temp = ga * w[j] + gb * w[iz]; - w[iz] = ga * w[iz] - gb * w[j]; - /* L840: */ - w[j] = temp; - } - - /* REVISE IACT AND THE LAGRANGE MULTIPLIERS. */ - - iact[kdrop - 1] = iact[kdrop]; - w[kdrop - 1] = w[kdrop]; - if (kdrop < *nact) - { - goto L810; - } -L850: - --(*nact); - switch ((int)mflag) - { - case 1: - goto L250; - case 2: - goto L610; - } - - - /* ******************************************************************** */ - - - - /* APPLY GIVENS ROTATION TO REDUCE SOME OF THE SCALAR */ - /* PRODUCTS IN THE S-PARTITION OF W TO ZERO. */ - -L860: - iz = iwz + nu * *n; -L870: - iz -= *n; -L880: - is = iws + nu; - --nu; - if (nu == *nact) - { - goto L900; - } - if (w[is] == zero) - { - goto L870; - } - /* Computing MAX */ - d__3 = (d__1 = w[is - 1], abs(d__1)), d__4 = (d__2 = w[is], abs(d__2)); - temp = max(d__3, d__4); - /* Computing 2nd power */ - d__1 = w[is - 1] / temp; - /* Computing 2nd power */ - d__2 = w[is] / temp; - sum = temp * sqrt(d__1 * d__1 + d__2 * d__2); - ga = w[is - 1] / sum; - gb = w[is] / sum; - w[is - 1] = sum; - i__2 = *n; - for (i = 1; i <= i__2; ++i) - { - k = iz + *n; - temp = ga * w[iz] + gb * w[k]; - w[k] = ga * w[k] - gb * w[iz]; - w[iz] = temp; - /* L890: */ - --iz; - } - goto L880; -L900: - switch ((int)nflag) - { - case 1: - goto L560; - case 2: - goto L630; - } - - - /* ******************************************************************** */ - - - - /* CALCULATE THE MAGNITUDE OF X AN REVISE XMAG. */ - -L910: - sum = zero; - i__2 = *n; - for (i = 1; i <= i__2; ++i) - { - sum += (d__1 = x[i], abs(d__1)) * vfact * ((d__2 = grad[i], abs(d__2)) - + (d__3 = g[i + i * g_dim1] * x[i], abs(d__3))); - if (*lql) - { - goto L920; - } - if (sum < 1e-30) - { - goto L920; - } - vfact *= 1e-10; - sum *= 1e-10; - xmag *= 1e-10; -L920: - ; - } - /* L925: */ - xmag = max(xmag, sum); - switch ((int)jflag) - { - case 1: - goto L420; - case 2: - goto L690; - } - - - /* ******************************************************************** */ - - - - /* PRE-MULTIPLY THE VECTOR IN THE W-PARTITION OF W BY Z TRANSPOSE. */ - -L930: - jl = iww + 1; - iz = iwz; - i__2 = *n; - for (i = 1; i <= i__2; ++i) - { - is = iws + i; - w[is] = zero; - iwwn = iww + *n; - i__1 = iwwn; - for (j = jl; j <= i__1; ++j) - { - ++iz; - /* L940: */ - w[is] += w[iz] * w[j]; - } - } - switch ((int)kflag) - { - case 1: - goto L350; - case 2: - goto L550; - } - return 0; -} /* ql0002_ */ - -#ifdef uNdEfInEd -comments from the converter: -(stderr from f2c) -ql0001: -ql0002: -#endif - - -#define DMAX1(a, b) ((a) > (b) ? (a) : (b)) -#define DMIN1(a, b) ((a) < (b) ? (a) : (b)) -#ifndef TRUE -#define TRUE 1 -#endif -#ifndef FALSE -#define FALSE 0 -#endif -#define NONE 0 -#define OBJECT 1 -#define CONSTR 2 - -/***************************************************************/ -/* Global Variables and Data Structures */ -/***************************************************************/ - -struct _objective -{ - double val; - double *grad; - double mult; - double mult_L; /* mode A=1 */ - int act_sip; /* SIP */ -}; - -struct _constraint -{ - double val; - double *grad; - double mult; - int act_sip; /* SIP */ - int d1bind; /* SR constraints */ -}; - -struct _parameter -{ - double *x; - double *bl; - double *bu; - double *mult; - void *cd; /* Client data pointer */ -}; - -struct _violation -{ /* SIP */ - int type; - int index; -}; - -double bgbnd, tolfea; -int nstop, maxit; - -struct Tglob_info -{ - int nnineq, M, ncallg, ncallf, mode, modec; - int tot_actf_sip, tot_actg_sip, nfsip, ncsipl, ncsipn; /* SIP */ -} -glob_info; - -struct Tglob_prnt -{ - int iprint, info, ipd, iter, initvl, iter_mod; - FILE *io; -} -glob_prnt; - -struct Tglob_grd -{ - double epsmac, rteps, udelta, valnom; -} -glob_grd; - -struct Tglob_log -{ - int dlfeas, local, update, first, rhol_is1, d0_is0, get_ne_mult; -} -glob_log; - -/* User-accessible stopping criterion (see cfsqpusr.h) */ -extern double objeps; -extern double objrep; -extern double gLgeps; -extern int x_is_new; - -/* Workspace */ -int *iw; -double *w; -int lenw, leniw; - -/***************************************************************/ -/* Memory Utilities */ -/***************************************************************/ - -#ifdef __STDC__ -static int *make_iv(int); -static double *make_dv(int); -static double **make_dm(int, int); -static void free_iv(int *); -static void free_dv(double *); -static void free_dm(double **, int); -static double *convert(double **, int, int); -#else -static int *make_iv(); -static double *make_dv(); -static double **make_dm(); -static void free_iv(); -static void free_dv(); -static void free_dm(); -static double *convert(); -#endif - -/***************************************************************/ -/* Utility Subroutines */ -/***************************************************************/ - -#ifdef __STDC__ -int -ql0001_(int *, int *, int *, int *, int *, int *, double *, double *, - double *, double *, double *, double *, double *, double *, - int *, int *, int *, double *, int *, int *, int *, double *); -static void diagnl(int, double, double **); -static void error(const char string[], int *); -static void -estlam(int, int, int *, double, double **, double *, double *, double *, - struct _constraint *, double *, double *, double *, double *); -static double *colvec(double **, int, int); -static double scaprd(int, double *, double *); -static double smallNumber(); -static int fuscmp(double, double); -static int indexs(int, int); -static void matrcp(int, double **, int, double **); -static void matrvc(int, int, double **, double *, double *); -static void nullvc(int, double *); -static void -resign(int, int, double *, double *, double *, struct _constraint *, - double *, int, int); -static void sbout1(FILE *, int, const char *, double, double *, int, int); -static void sbout2(FILE *, int, int, const char *, const char *, double *); -static void shift(int, int, int *); -static double -slope(int, int, int, int, int, struct _objective *, double *, double *, - double *, double, double, int, double *, int); -static int element(int *, int, int); -#else -int ql0001_(); /* QLD Subroutine */ -static void diagnl(); -static void error(); -static void estlam(); -static double *colvec(); -static double scaprd(); -static double smallNumber(); -static int fuscmp(); -static int indexs(); -static void matrcp(); -static void matrvc(); -static void nullvc(); -static void resign(); -static void sbout1(); -static void sbout2(); -static void shift(); -static double slope(); -static int element(); -#endif - -/**************************************************************/ -/* Gradients - Finite Difference */ -/**************************************************************/ - -#ifdef __STDC__ -void grobfd(int, int, double *, double *, void(*)(int, int, - double *, double *, void *), void *); -void grcnfd(int, int, double *, double *, void(*)(int, int, - double *, double *, void *), void *); -#else -void grobfd(); -void grcnfd(); -#endif - -/**************************************************************/ -/* Main routines for optimization - */ -/**************************************************************/ - -#ifdef __STDC__ -static void -cfsqp1(int, int, int, int, int, int, int, int, int, int, int *, int, - int, int, int, double, double, int *, int *, struct _parameter *, - struct _constraint *, struct _objective *, double *, - void(*)(int, int, double *, double *, void *), - void(*)(int, int, double *, double *, void *), - void(*)(int, int, double *, double *, - void(*)(int, int, double *, double *, void *), void *), - void(*)(int, int, double *, double *, - void(*)(int, int, double *, double *, void *), void *)); -static void -check(int, int, int, int *, int, int, int, int, int, int, int, int *, double, - double, struct _parameter *); -static void -initpt(int, int, int, int, int, int, int, struct _parameter *, - struct _constraint *, void(*)(int, int, double *, double *, void *), - void(*)(int, int, double *, double *, - void(*)(int, int, double *, double *, void *), void *)); -static void -dir(int, int, int, int, int, int, int, int, int, int, int, int, double *, - double, double, double *, double *, double, double *, double *, int *, - int *, int *, int *, int *, int *, struct _parameter *, double *, - double *, struct _constraint *, struct _objective *, double *, - double *, double *, double *, double *, double *, double **, double *, - double *, double *, double *, double **, double **, double *, - double *, struct _violation *, void(*)(int, int, double *, double *, - void *), void(*)(int, int, double *, double *, void *)); -static void -step1(int, int, int, int, int, int, int, int, int, int, int, int *, int *, int *, - int *, int *, int *, int *, int *, int, double, struct _objective *, - double *, double *, double *, double *, double *, double *, double *, - double *, double *, double *, double *, struct _constraint *, - double *, double *, struct _violation *viol, - void(*)(int, int, double *, double *, void *), - void(*)(int, int, double *, double *, void *), void *); -static void -hessian(int, int, int, int, int, int, int, int, int, int, int, int *, int, - double *, struct _parameter *, struct _objective *, - double, double *, double *, double *, double *, double *, - struct _constraint *, double *, int *, int *, double *, - double *, double *, double **, double *, double, int *, - double *, double *, void(*)(int, int, double *, double *, void *), - void(*)(int, int, double *, double *, void *), - void(*)(int, int, double *, double *, - void(*)(int, int, double *, double *, void *), void *), - void(*)(int, int, double *, double *, - void(*)(int, int, double *, double *, void *), void *), - double **, double *, double *, struct _violation *); -static void -out(int, int, int, int, int, int, int, int, int, int, int, int *, double *, - struct _constraint *, struct _objective *, double, - double, double, double, double, int); -static void -update_omega(int, int, int, int *, int, int, int, int, double, double, - struct _constraint *, struct _objective *, double *, - struct _violation *, void(*)(int, int, double *, double *, - void *), void(*)(int, int, double *, double *, void *), - void(*)(int, int, double *, double *, - void(*)(int, int, double *, double *, void *), void *), - void(*)(int, int, double *, double *, - void(*)(int, int, double *, double *, void *), void *), - void *, int); -#else -static void cfsqp1(); -static void check(); -static void initpt(); -static void dir(); -static void step1(); -static void hessian(); -static void out(); -static void update_omega(); -#endif - -#ifdef __STDC__ -static void -dealloc(int, int, double *, int *, int *, struct _constraint *cs, - struct _parameter *); -#else -static void dealloc(); -#endif - -#ifdef __STDC__ -void -cfsqp(int nparam, int nf, int nfsr, int nineqn, int nineq, int neqn, - int neq, int ncsrl, int ncsrn, int *mesh_pts, - int mode, int iprint, int miter, int *inform, double bigbnd, - double eps, double epseqn, double udelta, double *bl, double *bu, - double *x, double *f, double *g, double *lambda, - void(*obj)(int, int, double *, double *, void *), - void(*constr)(int, int, double *, double *, void *), - void(*gradob)(int, int, double *, double *, - void(*)(int, int, double *, double *, void *), void *), - void(*gradcn)(int, int, double *, double *, - void(*)(int, int, double *, double *, void *), void *), - void *cd) -#else -void -cfsqp(nparam, nf, nfsr, nineqn, nineq, neqn, neq, ncsrl, ncsrn, mesh_pts, - mode, iprint, miter, inform, bigbnd, eps, epseqn, udelta, bl, bu, x, - f, g, lambda, obj, constr, gradob, gradcn, cd) -int nparam, nf, nfsr, neqn, nineqn, nineq, neq, ncsrl, ncsrn, mode, -iprint, miter, *mesh_pts, *inform; -double bigbnd, eps, epseqn, udelta; -double *bl, *bu, *x, *f, *g, *lambda; -void(* obj)(), (* constr)(), (* gradob)(), (* gradcn)(); -void *cd; -#endif - -/*--------------------------------------------------------------------- -* Brief specification of various arrays and parameters in the calling -* sequence. See manual for a more detailed description. -* -* nparam : number of variables -* nf : number of objective functions (count each set of sequentially -* related objective functions once) -* nfsr : number of sets of sequentially related objectives (possibly -* zero) -* nineqn : number of nonlinear inequality constraints -* nineq : total number of inequality constraints -* neqn : number of nonlinear equality constraints -* neq : total number of equality constraints -* ncsrl : number of sets of linear sequentially related inequality -* constraints -* ncsrn : number of sets of nonlinear sequentially related inequality -* constraints -* mesh_pts : array of integers giving the number of actual objectives/ -* constraints in each sequentially related objective or -* constraint set. The order is as follows: -* (i) objective sets, (ii) nonlinear constraint sets, -* (iii) linear constraint sets. If one or no sequentially -* related constraint or objectives sets are present, the -* user may simply pass the address of an integer variable -* containing the appropriate number (possibly zero). -* mode : mode=CBA specifies job options as described below: -* A = 0 : ordinary minimax problems -* = 1 : ordinary minimax problems with each individual -* function replaced by its absolute value, ie, -* an L_infty problem -* B = 0 : monotone decrease of objective function -* after each iteration -* = 1 : monotone decrease of objective function after -* at most four iterations -* C = 1 : default operation. -* = 2 : requires that constraints always be evaluated -* before objectives during the line search. -* iprint : print level indicator with the following options- -* iprint=0: no normal output, only error information -* (this option is imposed during phase 1) -* iprint=1: a final printout at a local solution -* iprint=2: a brief printout at the end of each iteration -* iprint=3: detailed information is printed out at the end -* of each iteration (for debugging purposes) -* For iprint=2 or 3, the information may be printed at -* iterations that are multiples of 10, instead of every -* iteration. This may be done by adding the desired number -* of iterations to skip printing to the desired iprint value -* as specified above. e.g., sending iprint=23 would give -* the iprint=3 information once every 20 iterations. -* miter : maximum number of iterations allowed by the user to solve -* the problem -* inform : status report at the end of execution -* inform= 0:normal termination -* inform= 1:no feasible point found for linear constraints -* inform= 2:no feasible point found for nonlinear constraints -* inform= 3:no solution has been found in miter iterations -* inform= 4:stepsize smaller than machine precision before -* a successful new iterate is found -* inform= 5:failure in attempting to construct d0 -* inform= 6:failure in attempting to construct d1 -* inform= 7:inconsistent input data -* inform= 8:new iterate essentially identical to previous -* iterate, though stopping criterion not satisfied. -* inform= 9:penalty parameter too large, unable to satisfy -* nonlinear equality constraint -* bigbnd : plus infinity -* eps : stopping criterion. Execution stopped when the norm of the -* Newton direction vector is smaller than eps -* epseqn : tolerance of the violation of nonlinear equality constraints -* allowed by the user at an optimal solution -* udelta : perturbation size in computing gradients by finite -* difference. The actual perturbation is determined by -* sign(x_i) X max{udelta, rteps X max{1, |x_i|}} for each -* component of x, where rteps is the square root of machine -* precision. -* bl : array of dimension nparam,containing lower bound of x -* bu : array of dimension nparam,containing upper bound of x -* x : array of dimension nparam,containing initial guess in input -* and final iterate at the end of execution -* f : array of dimension sufficient enough to hold the value of -* all regular objective functions and the value of all -* members of the sequentially related objective sets. -* (dimension must be at least 1) -* g : array of dimension sufficient enough to hold the value of -* all regular constraint functions and the value of all -* members of the sequentially related constraint sets. -* (dimension must be at least 1) -* lambda : array of dimension nparam+dim(f)+dim(g), containing -* Lagrange multiplier values at x in output. (A concerns the -* mode, see above). The first nparam positions contain the -* multipliers associated with the simple bounds, the next -* dim(g) positions contain the multipliers associated with -* the constraints. The final dim(f) positions contain the -* multipliers associated with the objective functions. The -* multipliers are in the order they were specified in the -* user-defined objective and constraint functions. -* obj : Pointer to function that returns the value of objective -* functions, one upon each call -* constr : Pointer to function that returns the value of constraints -* one upon each call -* gradob : Pointer to function that computes gradients of f, -* alternatively it can be replaced by grobfd to compute -* finite difference approximations -* gradcn : Pointer to function that computes gradients of g, -* alternatively it can be replaced by grcnfd to compute -* finite difference approximations -* cd : Void pointer that may be used by the user for the passing of -* "client data" (untouched by CFSQP) -* -*---------------------------------------------------------------------- -* -* -* CFSQP Version 2.5b -* -* Craig Lawrence, Jian L. Zhou -* and Andre Tits -* Institute for Systems Research -* and -* Electrical Engineering Department -* University of Maryland -* College Park, Md 20742 -* -* June, 1997 -* -* -* The purpose of CFSQP is to solve general nonlinear constrained -* minimax optimization problems of the form -* -* (A=0 in mode) minimize max_i f_i(x) for i=1,...,n_f -* or -* (A=1 in mode) minimize max_j |f_i(x)| for i=1,...,n_f -* s.t. bl <= x <= bu -* g_j(x) <= 0, for j=1,...,nineqn -* A_1 x - B_1 <= 0 -* -* h_i(x) = 0, for i=1,...,neqn -* A_2 x - B_2 = 0 -* -* CFSQP is also able to efficiently handle problems with large sets of -* sequentially related objectives or constraints, see the manual for -* details. -* -* -* Conditions for External Use -* =========================== -* -* 1. The CFSQP routines may not be distributed to third parties. -* Interested parties should contact the authors directly. -* 2. If modifications are performed on the routines, these -* modifications will be communicated to the authors. The -* modified routines will remain the sole property of the authors. -* 3. Due acknowledgment must be made of the use of the CFSQP -* routines in research reports or publications. Whenever -* such reports are released for public access, a copy should -* be forwarded to the authors. -* 4. The CFSQP routines may only be used for research and -* development, unless it has been agreed otherwise with the -* authors in writing. -* -* Copyright (c) 1993-1997 by Craig T. Lawrence, Jian L. Zhou, and -* Andre L. Tits -* All Rights Reserved. -* -* -* Enquiries should be directed to: -* -* Prof. Andre L. Tits -* Electrical Engineering Dept. -* and Systems Research Center -* University of Maryland -* College Park, Md 20742 -* U. S. A. -* -* Phone : 301-405-3669 -* Fax : 301-405-6707 -* E-mail: andre@eng.umd.edu -* -* References: -* [1] E. Panier and A. Tits, `On Combining Feasibility, Descent and -* Superlinear Convergence In Inequality Constrained Optimization', -* Mathematical Programming, Vol. 59(1993), 261-276. -* [2] J. F. Bonnans, E. Panier, A. Tits and J. Zhou, `Avoiding the -* Maratos Effect by Means of a Nonmonotone Line search: II. -* Inequality Problems - Feasible Iterates', SIAM Journal on -* Numerical Analysis, Vol. 29, No. 4, 1992, pp. 1187-1202. -* [3] J.L. Zhou and A. Tits, `Nonmonotone Line Search for Minimax -* Problems', Journal of Optimization Theory and Applications, -* Vol. 76, No. 3, 1993, pp. 455-476. -* [4] C.T. Lawrence, J.L. Zhou and A. Tits, `User's Guide for CFSQP -* Version 2.5: A C Code for Solving (Large Scale) Constrained -* Nonlinear (Minimax) Optimization Problems, Generating Iterates -* Satisfying All Inequality Constraints,' Institute for -* Systems Research, University of Maryland,Technical Report -* TR-94-16r1, College Park, MD 20742, 1997. -* [5] C.T. Lawrence and A.L. Tits, `Nonlinear Equality Constraints -* in Feasible Sequential Quadratic Programming,' Optimization -* Methods and Software, Vol. 6, March, 1996, pp. 265-282. -* [6] J.L. Zhou and A.L. Tits, `An SQP Algorithm for Finely -* Discretized Continuous Minimax Problems and Other Minimax -* Problems With Many Objective Functions,' SIAM Journal on -* Optimization, Vol. 6, No. 2, May, 1996, pp. 461--487. -* [7] C. T. Lawrence and A. L. Tits, `Feasible Sequential Quadratic -* Programming for Finely Discretized Problems from SIP,' -* To appear in R. Reemtsen, J.-J. Ruckmann (eds.): Semi-Infinite -* Programming, in the series Nonconcex Optimization and its -* Applications. Kluwer Academic Publishers, 1997. -* -*********************************************************************** -*/ -{ - int i, ipp, j, ncnstr, nclin, nctotl, nob, nobL, modem=0, nn, - nppram, nrowa, ncsipl1, ncsipn1, nfsip1; - int feasbl, feasb, prnt, Linfty=0; - int *indxob, *indxcn, *mesh_pts1; - double *signeq; - double xi, gi, gmax, dummy, epskt; - struct _constraint *cs; /* pointer to array of constraints */ - struct _objective *ob; /* pointer to array of objectives */ - struct _parameter *param; /* pointer to parameter structure */ - struct _parameter _param; - - /* Make adjustments to parameters for SIP constraints */ - glob_info.tot_actf_sip = glob_info.tot_actg_sip = 0; - mesh_pts = mesh_pts - 1; - glob_info.nfsip = nfsr; - glob_info.ncsipl = ncsrl; - glob_info.ncsipn = ncsrn; - nf = nf - nfsr; - nfsip1 = nfsr; - nfsr = 0; - for (i = 1; i <= nfsip1; i++) - nfsr = nfsr + mesh_pts[i]; - nf = nf + nfsr; - nineqn = nineqn - ncsrn; - nineq = nineq - ncsrl - ncsrn; - ncsipl1 = ncsrl; - ncsipn1 = ncsrn; - ncsrl = 0; - ncsrn = 0; - if (ncsipn1) - for (i = 1; i <= ncsipn1; i++) - ncsrn = ncsrn + mesh_pts[nfsip1+i]; - if (ncsipl1) - for (i = 1; i <= ncsipl1; i++) - ncsrl = ncsrl + mesh_pts[nfsip1+ncsipn1+i]; - nineqn = nineqn + ncsrn; - nineq = nineq + ncsrn + ncsrl; - /* Create array of constraint structures */ - cs = (struct _constraint *)calloc(nineq + neq + 1, - sizeof(struct _constraint)); - for (i = 1; i <= nineq + neq; i++) - { - cs[i].grad = make_dv(nparam); - cs[i].act_sip = FALSE; - cs[i].d1bind = FALSE; - } - /* Create parameter structure */ - _param.x = make_dv(nparam + 1); - _param.bl = make_dv(nparam); - _param.bu = make_dv(nparam); - _param.mult = make_dv(nparam + 1); - param = &_param; - - /* Initialize, compute the machine precision, etc. */ - bl = bl - 1; - bu = bu - 1; - x = x - 1; - for (i = 1; i <= nparam; i++) - { - param->x[i] = x[i]; - param->bl[i] = bl[i]; - param->bu[i] = bu[i]; - } - param->cd = cd; /* Initialize client data */ - dummy = 0.e0; - f = f - 1; - g = g - 1; - lambda = lambda - 1; - glob_prnt.iter = 0; - nstop = 1; - nn = nineqn + neqn; - glob_grd.epsmac = smallNumber(); - tolfea = glob_grd.epsmac * 1.e2; - bgbnd = bigbnd; - glob_grd.rteps = sqrt(glob_grd.epsmac); - glob_grd.udelta = udelta; - glob_log.rhol_is1 = FALSE; - glob_log.get_ne_mult = FALSE; - signeq = make_dv(neqn); - - nob = 0; - gmax = -bgbnd; - glob_prnt.info = 0; - glob_prnt.iprint = iprint % 10; - ipp = iprint; - glob_prnt.iter_mod = DMAX1(iprint - iprint % 10, 1); - glob_prnt.io = stdout; - ncnstr = nineq + neq; - glob_info.nnineq = nineq; - if (glob_prnt.iprint > 0) - { - fprintf(glob_prnt.io, - "\n\n CFSQP Version 2.5b (Released June 1997) \n"); - fprintf(glob_prnt.io, - " Copyright (c) 1993 --- 1997 \n"); - fprintf(glob_prnt.io, - " C.T. Lawrence, J.L. Zhou \n"); - fprintf(glob_prnt.io, - " and A.L. Tits \n"); - fprintf(glob_prnt.io, - " All Rights Reserved \n\n"); - } - /*-----------------------------------------------------*/ - /* Check the input data */ - /*-----------------------------------------------------*/ - check(nparam, nf, nfsr, &Linfty, nineq, nineqn, neq, neqn, - ncsrl, ncsrn, mode, &modem, eps, bgbnd, param); - if (glob_prnt.info == 7) - { - *inform = glob_prnt.info; - return; - } - - maxit = DMAX1(DMAX1(miter, 10 * DMAX1(nparam, ncnstr)), 1000); - feasb = TRUE; - feasbl = TRUE; - prnt = FALSE; - nppram = nparam + 1; - - /*-----------------------------------------------------*/ - /* Check whether x is within bounds */ - /*-----------------------------------------------------*/ - for (i = 1; i <= nparam; i++) - { - xi = param->x[i]; - if (param->bl[i] <= xi && param->bu[i] >= xi) - continue; - feasbl = FALSE; - break; - } - nclin = ncnstr - nn; - /*-----------------------------------------------------*/ - /* Check whether linear constraints are feasbile */ - /*-----------------------------------------------------*/ - if (nclin != 0) - { - for (i = 1; i <= nclin; i++) - { - j = i + nineqn; - if (j <= nineq) - { - constr(nparam, j, (param->x) + 1, &gi, param->cd); - if (gi > glob_grd.epsmac) - feasbl = FALSE; - } - else - { - constr(nparam, j + neqn, (param->x) + 1, &gi, param->cd); - if (fabs(gi) > glob_grd.epsmac) - feasbl = FALSE; - } - cs[j].val = gi; - } - } - /*-------------------------------------------------------*/ - /* Generate a new point if infeasible */ - /*-------------------------------------------------------*/ - if (!feasbl) - { - if (glob_prnt.iprint > 0) - { - fprintf(glob_prnt.io, - " The given initial point is infeasible for inequality\n"); - fprintf(glob_prnt.io, - " constraints and linear equality constraints:\n"); - sbout1(glob_prnt.io, nparam, " ", dummy, - param->x, 2, 1); - prnt = TRUE; - } - nctotl = nparam + nclin; - lenw = 2 * nparam * nparam + 10 * nparam + 2 * nctotl + 1; - leniw = DMAX1(2 * nparam + 2 * nctotl + 3, 2 * nclin + 2 * nparam + 6); - /*-----------------------------------------------------*/ - /* Attempt to generate a point satisfying all linear */ - /* constraints. */ - /*-----------------------------------------------------*/ - nrowa = DMAX1(nclin, 1); - iw = make_iv(leniw); - w = make_dv(lenw); - initpt(nparam, nineqn, neq, neqn, nclin, nctotl, nrowa, param, - &cs[nineqn], constr, gradcn); - free_iv(iw); - free_dv(w); - if (glob_prnt.info != 0) - { - *inform = glob_prnt.info; - return; - } - } - indxob = make_iv(DMAX1(nineq + neq, nf)); - indxcn = make_iv(nineq + neq); -L510: - if (glob_prnt.info != -1) - { - for (i = 1; i <= nineqn; i++) - { - constr(nparam, i, (param->x) + 1, &(cs[i].val), param->cd); - if (cs[i].val > 0.e0) - feasb = FALSE; - } - glob_info.ncallg = nineqn; - if (!feasb) - { - /* Create array of objective structures for Phase 1 */ - ob = (struct _objective *)calloc(nineqn + 1, - sizeof(struct _objective)); - for (i = 1; i <= nineqn; i++) - { - ob[i].grad = make_dv(nparam); - ob[i].act_sip = FALSE; - } - for (i = 1; i <= nineqn; i++) - { - nob++; - indxob[nob] = i; - ob[nob].val = cs[i].val; - gmax = DMAX1(gmax, ob[nob].val); - } - for (i = 1; i <= nineq - nineqn; i++) - indxcn[i] = nineqn + i; - for (i = 1; i <= neq - neqn; i++) - indxcn[i+nineq-nineqn] = nineq + neqn + i; - goto L605; - } - } - - /* Create array of objective structures for Phase 2 and */ - /* initialize. */ - ob = (struct _objective *)calloc(nf + 1, sizeof(struct _objective)); - for (i = 1; i <= nf; i++) - { - ob[i].grad = make_dv(nparam); - ob[i].act_sip = FALSE; - } - for (i = 1; i <= nineqn; i++) - { - indxcn[i] = i; - } - for (i = 1; i <= neq - neqn; i++) - cs[i+nineq+neqn].val = cs[i+nineq].val; - for (i = 1; i <= neqn; i++) - { - j = i + nineq; - constr(nparam, j, (param->x) + 1, &(cs[j].val), param->cd); - indxcn[nineqn+i] = j; - } - for (i = 1; i <= nineq - nineqn; i++) - indxcn[i+nn] = nineqn + i; - for (i = 1; i <= neq - neqn; i++) - indxcn[i+nineq+neqn] = nineq + neqn + i; - glob_info.ncallg += neqn; - - L605: - if (glob_prnt.iprint > 0 && feasb && !prnt) - { - fprintf(glob_prnt.io, - "The given initial point is feasible for inequality\n"); - fprintf(glob_prnt.io, - " constraints and linear equality constraints:\n"); - sbout1(glob_prnt.io, nparam, " ", dummy, - param->x, 2, 1); - prnt = TRUE; - } - if (nob == 0) - { - if (glob_prnt.iprint > 0) - { - if (glob_prnt.info != 0) - { - fprintf(glob_prnt.io, - "To generate a feasible point for nonlinear inequality\n"); - fprintf(glob_prnt.io, - "constraints and linear equality constraints, "); - fprintf(glob_prnt.io, "ncallg = %10d\n", glob_info.ncallg); - if (ipp == 0) - fprintf(glob_prnt.io, " iteration %26d\n", - glob_prnt.iter); - if (ipp > 0) - fprintf(glob_prnt.io, " iteration %26d\n", - glob_prnt.iter - 1); - if (ipp == 0) - glob_prnt.iter++; - } - if (feasb && !feasbl) - { - fprintf(glob_prnt.io, - "Starting from the generated point feasible for\n"); - fprintf(glob_prnt.io, - "inequality constraints and linear equality constraints:\n"); - sbout1(glob_prnt.io, nparam, " ", - dummy, param->x, 2, 1); - - } - if (glob_prnt.info != 0 || !prnt || !feasb) - { - fprintf(glob_prnt.io, - "Starting from the generated point feasible for\n"); - fprintf(glob_prnt.io, - "inequality constraints and linear equality constraints:\n"); - sbout1(glob_prnt.io, nparam, " ", - dummy, param->x, 2, 1); - } - } - feasb = TRUE; - feasbl = TRUE; - } - if (ipp > 0 && !feasb && !prnt) - { - fprintf(glob_prnt.io, - " The given initial point is infeasible for inequality\n"); - fprintf(glob_prnt.io, - " constraints and linear equality constraints:\n"); - sbout1(glob_prnt.io, nparam, " ", dummy, - param->x, 2, 1); - prnt = TRUE; - } - if (nob == 0) - nob = 1; - if (feasb) - { - nob = nf; - glob_prnt.info = 0; - glob_prnt.iprint = iprint % 10; - ipp = iprint; - glob_prnt.iter_mod = DMAX1(iprint - iprint % 10, 1); - glob_info.mode = modem; - epskt = eps; - if (Linfty) - nobL = 2 * nob; - else - nobL = nob; - if (nob != 0 || neqn != 0) - goto L910; - fprintf(glob_prnt.io, - "current feasible iterate with no objective specified\n"); - *inform = glob_prnt.info; - for (i = 1; i <= nineq + neq; i++) - g[i] = cs[i].val; - dealloc(nineq, neq, signeq, indxcn, indxob, cs, param); - free((char *) ob); - return; - } - ipp = 0; - glob_info.mode = 0; - nobL = nob; - glob_prnt.info = -1; - epskt = 1.e-10; - L910: - nctotl = nppram + ncnstr + DMAX1(nobL, 1); - leniw = 2 * (ncnstr + DMAX1(nobL, 1)) + 2 * nppram + 6; - lenw = 2 * nppram * nppram + 10 * nppram + 6 * (ncnstr + DMAX1(nobL, 1) + 1); - glob_info.M = 4; - if (modem == 1 && nn == 0) - glob_info.M = 3; - - param->x[nparam+1] = gmax; - if (feasb) - { - for (i = 1; i <= neqn; i++) - { - if (cs[i+nineq].val > 0.e0) - signeq[i] = -1.e0; - else - signeq[i] = 1.e0; - } - } - if (!feasb) - { - ncsipl1 = ncsrl; - ncsipn1 = 0; - nfsip1 = ncsrn; - mesh_pts1 = &mesh_pts[nfsr]; - } - else - { - ncsipl1 = ncsrl; - ncsipn1 = ncsrn; - nfsip1 = nfsr; - mesh_pts1 = mesh_pts; - } - /*---------------------------------------------------------------*/ - /* either attempt to generate a point satisfying all */ - /* constraints or try to solve the original problem */ - /*---------------------------------------------------------------*/ - nrowa = DMAX1(ncnstr + DMAX1(nobL, 1), 1); - w = make_dv(lenw); - iw = make_iv(leniw); - - cfsqp1(miter, nparam, nob, nobL, nfsip1, nineqn, neq, neqn, ncsipl1, ncsipn1, - mesh_pts1, ncnstr, nctotl, nrowa, feasb, epskt, epseqn, indxob, - indxcn, param, cs, ob, signeq, obj, constr, gradob, gradcn); - - free_iv(iw); - free_dv(w); - if (glob_prnt.info == -1) - { /* Successful phase 1 termination */ - for (i = 1; i <= nob; i++) - cs[i].val = ob[i].val; - nob = 0; - for (i = 1; i <= nineqn; i++) - free_dv(ob[i].grad); - free((char *) ob); - goto L510; - } - if (glob_prnt.info != 0) - { - if (feasb) - { - for (i = 1; i <= nparam; i++) - x[i] = param->x[i]; - for (i = 1; i <= nineq + neq; i++) - g[i] = cs[i].val; - *inform = glob_prnt.info; - dealloc(nineq, neq, signeq, indxcn, indxob, cs, param); - for (i = 1; i <= nf; i++) - { - f[i] = ob[i].val; - free_dv(ob[i].grad); - } - free((char *) ob); - return; - } - glob_prnt.info = 2; - fprintf(glob_prnt.io, - "Error: No feasible point is found for nonlinear inequality\n"); - fprintf(glob_prnt.io, - "constraints and linear equality constraints\n"); - *inform = glob_prnt.info; - dealloc(nineq, neq, signeq, indxcn, indxob, cs, param); - for (i = 1; i <= nineqn; i++) - free_dv(ob[i].grad); - free((char *) ob); - return; - } - /* Successful phase 2 termination */ - *inform = glob_prnt.info; - for (i = 1; i <= nparam; i++) - { - x[i] = param->x[i]; - lambda[i] = param->mult[i]; - } - for (i = 1; i <= nineq + neq; i++) - { - g[i] = cs[i].val; - lambda[i+nparam] = cs[i].mult; - } - for (i = 1; i <= nf; i++) - { - f[i] = ob[i].val; - lambda[i+nparam+nineq+neq] = ob[i].mult; - free_dv(ob[i].grad); - } - /* If just one objective, set multiplier=1 */ - if (nf == 1) - lambda[1+nparam+nineq+neq] = 1.e0; - free((char *) ob); - dealloc(nineq, neq, signeq, indxcn, indxob, cs, param); - return; -} - -/***************************************************************/ -/* Free allocated memory */ -/***************************************************************/ - -#ifdef __STDC__ -static void -dealloc(int nineq, int neq, double *signeq, int *indxob, - int *indxcn, struct _constraint *cs, struct _parameter *param) -#else -static void -dealloc(nineq, neq, signeq, indxob, indxcn, cs, param) -int nineq, neq; -double *signeq; -int *indxob, *indxcn; -struct _constraint *cs; -struct _parameter *param; -#endif -{ - int i; - - free_dv(param->x); - free_dv(param->bl); - free_dv(param->bu); - free_dv(param->mult); - free_dv(signeq); - free_iv(indxob); - free_iv(indxcn); - for (i = 1; i <= nineq + neq; i++) - free_dv(cs[i].grad); - free((char *) cs); -} -/************************************************************/ -/* CFSQP : Main routine */ -/************************************************************/ - - -#ifdef __STDC__ -static void -dealloc1(int, int, double **, double **, double **, double *, double *, - double *, double *, double *, double *, double *, double *, - double *, double *, double *, double *, int *, int *, int *); -#else -static void dealloc1(); -#endif - -#ifdef __STDC__ -static void -cfsqp1(int miter, int nparam, int nob, int nobL, int nfsip, int nineqn, - int neq, int neqn, int ncsipl, int ncsipn, int *mesh_pts, int ncnstr, - int nctotl, int nrowa, int feasb, double epskt, double epseqn, - int *indxob, int *indxcn, struct _parameter *param, - struct _constraint *cs, struct _objective *ob, - double *signeq, void(*obj)(int, int, double *, double *, void *), - void(*constr)(int, int, double *, double *, void *), - void(*gradob)(int, int, double *, double *, - void(*)(int, int, double *, double *, void *), void *), - void(*gradcn)(int, int, double *, double *, - void(*)(int, int, double *, double *, void *), void *)) -#else -static void -cfsqp1(miter, nparam, nob, nobL, nfsip, nineqn, neq, neqn, ncsipl, ncsipn, - mesh_pts, ncnstr, nctotl, nrowa, feasb, epskt, epseqn, indxob, - indxcn, param, cs, ob, signeq, obj, constr, gradob, gradcn) -int miter, nparam, nob, nobL, nfsip, nineqn, neq, neqn, ncnstr, -nctotl, nrowa, feasb, ncsipl, ncsipn, *mesh_pts; -int *indxob, *indxcn; -double epskt, epseqn; -double *signeq; -struct _constraint *cs; -struct _objective *ob; -struct _parameter *param; -void(* obj)(), (* constr)(), (* gradob)(), (* gradcn)(); -#endif -{ - int i, iskp, nfs, ncf, ncg, nn, nstart, nrst, ncnst1; - int *iact, *iskip, *istore; - double Cbar, Ck, dbar, fmax, fM, fMp, steps, d0nm, dummy, - sktnom, scvneq, grdftd, psf; - double *di, *d, *gm, *grdpsf, *penp, *bl, *bu, *clamda, - *cvec, *psmu, *span, *backup; - double **hess, **hess1, **a; - double *tempv; - struct _violation *viol; - struct _violation _viol; - - /* Allocate memory */ - - hess = make_dm(nparam, nparam); - hess1 = make_dm(nparam + 1, nparam + 1); - a = make_dm(nrowa, nparam + 2); - di = make_dv(nparam + 1); - d = make_dv(nparam + 1); - gm = make_dv(4 * neqn); - grdpsf = make_dv(nparam); - penp = make_dv(neqn); - bl = make_dv(nctotl); - bu = make_dv(nctotl); - clamda = make_dv(nctotl + nparam + 1); - cvec = make_dv(nparam + 1); - psmu = make_dv(neqn); - span = make_dv(4); - backup = make_dv(nob + ncnstr); - iact = make_iv(nob + nineqn + neqn); - iskip = make_iv(glob_info.nnineq + 1); - istore = make_iv(nineqn + nob + neqn); - - viol = &_viol; - viol->index = 0; - viol->type = NONE; - - glob_prnt.initvl = 1; - glob_log.first = TRUE; - nrst = glob_prnt.ipd = 0; - dummy = 0.e0; - scvneq = 0.e0; - steps = 0.e0; - sktnom = 0.e0; - d0nm = 0.e0; - if (glob_prnt.iter == 0) - diagnl(nparam, 1.e0, hess); - if (feasb) - { - glob_log.first = TRUE; - if (glob_prnt.iter > 0) - glob_prnt.iter--; - if (glob_prnt.iter != 0) - diagnl(nparam, 1.e0, hess); - } - Ck = Cbar = 1.e-2; - dbar = 5.e0; - nstart = 1; - glob_info.ncallf = 0; - nstop = 1; - nfs = 0; - if (glob_info.mode != 0) - nfs = glob_info.M; - if (feasb) - { - nn = nineqn + neqn; - ncnst1 = ncnstr; - } - else - { - nn = 0; - ncnst1 = ncnstr - nineqn - neqn; - } - scvneq = 0.e0; - for (i = 1; i <= ncnst1; i++) - { - glob_grd.valnom = cs[indxcn[i]].val; - backup[i] = glob_grd.valnom; - if (feasb && i > nineqn && i <= nn) - { - gm[i-nineqn] = glob_grd.valnom * signeq[i-nineqn]; - scvneq = scvneq + fabs(glob_grd.valnom); - } - if (feasb && i <= nn) - { - iact[i] = indxcn[i]; - istore[i] = 0; - if (i > nineqn) - penp[i-nineqn] = 2.e0; - } - gradcn(nparam, indxcn[i], (param->x) + 1, (cs[indxcn[i]].grad) + 1, - constr, param->cd); - } - nullvc(nparam, grdpsf); - psf = 0.e0; - if (feasb && neqn != 0) - resign(nparam, neqn, &psf, grdpsf, penp, cs, signeq, 12, 12); - fmax = -bgbnd; - for (i = 1; i <= nob; i++) - { - if (!feasb) - { - glob_grd.valnom = ob[i].val; - iact[i] = i; - istore[i] = 0; - gradcn(nparam, indxob[i], (param->x) + 1, (ob[i].grad) + 1, constr, - param->cd); - } - else - { - iact[nn+i] = i; - istore[nn+i] = 0; - obj(nparam, i, (param->x) + 1, &(ob[i].val), param->cd); - glob_grd.valnom = ob[i].val; - backup[i+ncnst1] = glob_grd.valnom; - gradob(nparam, i, (param->x) + 1, (ob[i].grad) + 1, obj, param->cd); - glob_info.ncallf++; - if (nobL != nob) - fmax = DMAX1(fmax, -ob[i].val); - } - fmax = DMAX1(fmax, ob[i].val); - } - if (feasb && nob == 0) - fmax = 0.e0; - fM = fmax; - fMp = fmax - psf; - span[1] = fM; - - if (glob_prnt.iprint >= 3 && glob_log.first) - { - for (i = 1; i <= nob; i++) - { - if (feasb) - { - if (nob > 1) - { - tempv = ob[i].grad; - sbout2(glob_prnt.io, nparam, i, "gradf(j,", ")", tempv); - } - if (nob == 1) - { - tempv = ob[1].grad; - sbout1(glob_prnt.io, nparam, "gradf(j) ", - dummy, tempv, 2, 2); - } - continue; - } - tempv = ob[i].grad; - sbout2(glob_prnt.io, nparam, indxob[i], "gradg(j,", ")", tempv); - } - if (ncnstr != 0) - { - for (i = 1; i <= ncnst1; i++) - { - tempv = cs[indxcn[i]].grad; - sbout2(glob_prnt.io, nparam, indxcn[i], "gradg(j,", ")", tempv); - } - if (neqn != 0) - { - sbout1(glob_prnt.io, nparam, "grdpsf(j) ", dummy, - grdpsf, 2, 2); - sbout1(glob_prnt.io, neqn, "P ", dummy, - penp, 2, 2); - } - } - for (i = 1; i <= nparam; i++) - { - tempv = colvec(hess, i, nparam); - sbout2(glob_prnt.io, nparam, i, "hess (j,", ")", tempv); - free_dv(tempv); - } - } - - /*----------------------------------------------------------* - * Main loop of the algorithm * - *----------------------------------------------------------*/ - - nstop = 1; - for (;;) - { - out(miter, nparam, nob, nobL, nfsip, nineqn, nn, nineqn, ncnst1, - ncsipl, ncsipn, mesh_pts, param->x, cs, ob, fM, fmax, steps, - sktnom, d0nm, feasb); - if (nstop == 0) - { - if (!feasb) - { - dealloc1(nparam, nrowa, a, hess, hess1, di, d, gm, - grdpsf, penp, bl, bu, clamda, cvec, psmu, span, backup, - iact, iskip, istore); - return; - } - for (i = 1; i <= ncnst1; i++) - cs[i].val = backup[i]; - for (i = 1; i <= nob; i++) - ob[i].val = backup[i+ncnst1]; - for (i = 1; i <= neqn; i++) - cs[glob_info.nnineq+i].mult = signeq[i] * psmu[i]; - dealloc1(nparam, nrowa, a, hess, hess1, di, d, gm, - grdpsf, penp, bl, bu, clamda, cvec, psmu, span, backup, - iact, iskip, istore); - return; - } - if (!feasb && glob_prnt.iprint == 0) - glob_prnt.iter++; - /* Update the SIP constraint set Omega_k */ - if ((ncsipl + ncsipn) != 0 || nfsip) - update_omega(nparam, ncsipl, ncsipn, mesh_pts, nineqn, nob, nobL, - nfsip, steps, fmax, cs, ob, param->x, viol, - constr, obj, gradob, gradcn, param->cd, feasb); - /* Compute search direction */ - dir(nparam, nob, nobL, nfsip, nineqn, neq, neqn, nn, ncsipl, ncsipn, - ncnst1, feasb, &steps, epskt, epseqn, &sktnom, &scvneq, Ck, &d0nm, - &grdftd, indxob, indxcn, iact, &iskp, iskip, istore, param, di, d, - cs, ob, &fM, &fMp, &fmax, &psf, grdpsf, penp, a, bl, bu, clamda, cvec, - hess, hess1, backup, signeq, viol, obj, constr); - if (nstop == 0 && !glob_log.get_ne_mult) - continue; - glob_log.first = FALSE; - if (!glob_log.update && !glob_log.d0_is0) - { - /* Determine step length */ - step1(nparam, nob, nobL, nfsip, nineqn, neq, neqn, nn, ncsipl, ncsipn, - ncnst1, &ncg, &ncf, indxob, indxcn, iact, &iskp, iskip, istore, - feasb, grdftd, ob, &fM, &fMp, &fmax, &psf, penp, &steps, &scvneq, - bu, param->x, di, d, cs, backup, signeq, viol, obj, constr, - param->cd); - if (nstop == 0) - continue; - } - /* Update the Hessian */ - hessian(nparam, nob, nfsip, nobL, nineqn, neq, neqn, nn, ncsipn, ncnst1, - nfs, &nstart, feasb, bu, param, ob, fmax, &fM, &fMp, &psf, grdpsf, - penp, cs, gm, indxob, indxcn, bl, clamda, di, hess, d, steps, &nrst, - signeq, span, obj, constr, gradob, gradcn, hess1, cvec, psmu, viol); - if (nstop == 0 || glob_info.mode == 0) - continue; - if (d0nm > dbar) - Ck = DMAX1(0.5e0 * Ck, Cbar); - if (d0nm <= dbar && !glob_log.dlfeas && - !glob_log.rhol_is1) - Ck = 10.e0 * Ck; - } -} - -/*******************************************************************/ -/* Free up memory used by CFSQP1 */ -/*******************************************************************/ - -#ifdef __STDC__ -static void -dealloc1(int nparam, int nrowa, double **a, double **hess, double **hess1, - double *di, double *d, double *gm, double *grdpsf, double *penp, - double *bl, double *bu, double *clamda, double *cvec, double *psmu, - double *span, double *backup, int *iact, int *iskip, int *istore) -#else -static void -dealloc1(nparam, nrowa, a, hess, hess1, di, d, gm, grdpsf, penp, bl, bu, clamda, - cvec, psmu, span, backup, iact, iskip, istore) -int nparam, nrowa; -double **a, **hess, **hess1; -double *di, *d, *gm, *grdpsf, *penp, *bl, *bu, *clamda, *cvec, *psmu, *span, -*backup; -int *iact, *iskip, *istore; -#endif -{ - free_dm(a, nrowa); - free_dm(hess, nparam); - free_dm(hess1, nparam + 1); - free_dv(di); - free_dv(d); - free_dv(gm); - free_dv(grdpsf); - free_dv(penp); - free_dv(bl); - free_dv(bu); - free_dv(clamda); - free_dv(cvec); - free_dv(psmu); - free_dv(span); - free_dv(backup); - free_iv(iact); - free_iv(iskip); - free_iv(istore); -} -/************************************************************/ -/* CFSQP - Check the input data */ -/************************************************************/ - - -#ifdef __STDC__ -static void -check(int nparam, int nf, int nfsip, int *Linfty, int nineq, - int nnl, int neq, int neqn, int ncsipl, int ncsipn, int mode, - int *modem, double eps, double bigbnd, struct _parameter *param) -#else -static void -check(nparam, nf, nfsip, Linfty, nineq, nnl, neq, neqn, ncsipl, ncsipn, - mode, modem, eps, bigbnd, param) -int nparam, nf, nfsip, nineq, nnl, neq, neqn, ncsipl, ncsipn, mode, *modem, -*Linfty; -double bigbnd, eps; -struct _parameter *param; -#endif -{ - int i; - double bli, bui; - - if (nparam <= 0) - error("nparam should be positive! ", - &glob_prnt.info); - if (nf < 0) - error("nf should not be negative! ", - &glob_prnt.info); - if (nineq < 0) - error("nineq should not be negative! ", - &glob_prnt.info); - if (nineq >= 0 && nnl >= 0 && nineq < nnl) - error("nineq should be no smaller then nnl! ", - &glob_prnt.info); - if (neqn < 0) - error("neqn should not be negative! ", - &glob_prnt.info); - if (neq < neqn) - error("neq should not be smaller then neqn ", - &glob_prnt.info); - if (nf < nfsip) - error("nf should not be smaller then nfsip ", - &glob_prnt.info); - if (nineq < ncsipn + ncsipl) - error("ncsrl+ncsrn should not be larger then nineq", - &glob_prnt.info); - if (nparam <= neq - neqn) - error("Must have nparam > number of linear equalities", - &glob_prnt.info); - if (glob_prnt.iprint < 0 || glob_prnt.iprint > 3) - error("iprint mod 10 should be 0,1,2 or 3! ", - &glob_prnt.info); - if (eps <= glob_grd.epsmac) - { - error("eps should be bigger than epsmac! ", - &glob_prnt.info); - fprintf(glob_prnt.io, - "epsmac = %22.14e which is machine dependent.\n", - glob_grd.epsmac); - } - if (!(mode == 100 || mode == 101 || mode == 110 || mode == 111 - || mode == 200 || mode == 201 || mode == 210 || mode == 211)) - error("mode is not properly specified! ", - &glob_prnt.info); - if (glob_prnt.info != 0) - { - fprintf(glob_prnt.io, - "Error: Input parameters are not consistent.\n"); - return; - } - for (i = 1; i <= nparam; i++) - { - bli = param->bl[i]; - bui = param->bu[i]; - if (bli > bui) - { - fprintf(glob_prnt.io, - "lower bounds should be smaller than upper bounds\n"); - glob_prnt.info = 7; - } - if (glob_prnt.info != 0) - return; - if (bli < (-bigbnd)) - param->bl[i] = -bigbnd; - if (bui > bigbnd) - param->bu[i] = bigbnd; - } - if (mode >= 200) - { - i = mode - 200; - glob_info.modec = 2; - } - else - { - i = mode - 100; - glob_info.modec = 1; - } - if (i < 10) - *modem = 0; - else - { - *modem = 1; - i -= 10; - } - if (!i) - *Linfty = FALSE; - else - *Linfty = TRUE; -} -/****************************************************************/ -/* CFSQP : Generate a feasible point satisfying simple */ -/* bounds and linear constraints. */ -/****************************************************************/ - - -#ifdef __STDC__ -static void -initpt(int nparam, int nnl, int neq, int neqn, int nclin, int nctotl, - int nrowa, struct _parameter *param, struct _constraint *cs, - void(*constr)(int, int, double *, double *, void *), - void(*gradcn)(int, int, double *, double *, - void(*)(int, int, double *, double *, void *), void *)) -#else -static void -initpt(nparam, nnl, neq, neqn, nclin, nctotl, nrowa, param, cs, - constr, gradcn) -int nparam, nnl, neq, neqn, nclin, nctotl, nrowa; -struct _constraint *cs; -struct _parameter *param; -void(* constr)(), (* gradcn)(); -#endif -{ - int i, j, infoql, mnn, temp1, iout, zero; - double x0i, *atemp, *htemp; - double *x, *bl, *bu, *cvec, *clamda, *bj; - double **a, **hess; - - hess = make_dm(nparam, nparam); - a = make_dm(nrowa, nparam); - x = make_dv(nparam); - bl = make_dv(nctotl); - bu = make_dv(nctotl); - cvec = make_dv(nparam); - clamda = make_dv(nctotl + nparam + 1); - bj = make_dv(nclin); - - glob_prnt.info = 1; - for (i = 1; i <= nclin; i++) - { - glob_grd.valnom = cs[i].val; - j = i + nnl; - if (j <= glob_info.nnineq) - gradcn(nparam, j, (param->x) + 1, cs[i].grad + 1, constr, param->cd); - else - gradcn(nparam, j + neqn, (param->x) + 1, cs[i].grad + 1, constr, - param->cd); - } - for (i = 1; i <= nparam; i++) - { - x0i = param->x[i]; - bl[i] = param->bl[i] - x0i; - bu[i] = param->bu[i] - x0i; - cvec[i] = 0.e0; - } - for (i = nclin; i >= 1; i--) - bj[nclin-i+1] = -cs[i].val; - for (i = nclin; i >= 1; i--) - for (j = 1; j <= nparam; j++) - a[nclin-i+1][j] = -cs[i].grad[j]; - diagnl(nparam, 1.e0, hess); - nullvc(nparam, x); - - iout = 6; - zero = 0; - mnn = nrowa + 2 * nparam; - iw[1] = 1; - temp1 = neq - neqn; - htemp = convert(hess, nparam, nparam); - atemp = convert(a, nrowa, nparam); - - ql0001_(&nclin, &temp1, &nrowa, &nparam, &nparam, &mnn, (htemp + 1), - (cvec + 1), (atemp + 1), (bj + 1), (bl + 1), (bu + 1), (x + 1), (clamda + 1), - &iout, &infoql, &zero, (w + 1), &lenw, (iw + 1), &leniw, - &glob_grd.epsmac); - - free_dv(htemp); - free_dv(atemp); - if (infoql == 0) - { - for (i = 1; i <= nparam; i++) - param->x[i] = param->x[i] + x[i]; - x_is_new = TRUE; - for (i = 1; i <= nclin; i++) - { - j = i + nnl; - if (j <= glob_info.nnineq) - constr(nparam, j, (param->x) + 1, - &(cs[i].val), param->cd); - else - constr(nparam, j + neqn, (param->x) + 1, &(cs[i].val), param->cd); - } - glob_prnt.info = 0; - } - if (glob_prnt.info == 1 && glob_prnt.iprint != 0) - { - fprintf(glob_prnt.io, - "\n Error: No feasible point is found for the"); - fprintf(glob_prnt.io, " linear constraints.\n"); - } - free_dm(a, nrowa); - free_dm(hess, nparam); - free_dv(x); - free_dv(bl); - free_dv(bu); - free_dv(cvec); - free_dv(clamda); - free_dv(bj); - return; -} -/****************************************************************/ -/* CFSQP : Update the SIP "active" objective and constraint */ -/* sets Omega_k and Xi_k. */ -/****************************************************************/ - - -#ifdef __STDC__ -static void -update_omega(int nparam, int ncsipl, int ncsipn, int *mesh_pts, - int nineqn, int nob, int nobL, int nfsip, double steps, - double fmax, struct _constraint *cs, struct _objective *ob, - double *x, struct _violation *viol, - void(*constr)(int, int, double *, double *, void *), - void(*obj)(int, int, double *, double *, void *), - void(*gradob)(int, int, double *, double *, - void(*)(int, int, double *, double *, void *), void *), - void(*gradcn)(int, int, double *, double *, - void(*)(int, int, double *, double *, void *), void *), - void *cd, int feasb) -#else -static void -update_omega(nparam, ncsipl, ncsipn, mesh_pts, nineqn, nob, nobL, nfsip, - steps, fmax, cs, ob, x, viol, constr, obj, gradob, gradcn, cd, feasb) -int nparam, ncsipl, ncsipn, *mesh_pts, nineqn, nobL, nob, nfsip, feasb; -double *x, steps, fmax; -struct _constraint *cs; -struct _objective *ob; -struct _violation *viol; -void(* constr)(); -void(* obj)(); -void(* gradob)(); -void(* gradcn)(); -void *cd; -#endif -{ - int i, j, i_max, index, offset, nineq, display; - double epsilon, g_max, fprev, fnow, fnext, fmult; - - epsilon = 1.e0; - glob_info.tot_actf_sip = glob_info.tot_actg_sip = 0; - nineq = glob_info.nnineq; - if (glob_prnt.iter % glob_prnt.iter_mod) - display = FALSE; - else - display = TRUE; - /* Clear previous constraint sets */ - for (i = 1; i <= ncsipl; i++) - cs[nineq-ncsipl+i].act_sip = FALSE; - for (i = 1; i <= ncsipn; i++) - cs[nineqn-ncsipn+i].act_sip = FALSE; - /* Clear previous objective sets */ - for (i = nob - nfsip + 1; i <= nob; i++) - ob[i].act_sip = FALSE; - - /*--------------------------------------------------*/ - /* Update Constraint Sets Omega_k */ - /*--------------------------------------------------*/ - - if (ncsipn != 0) - { - offset = nineqn - ncsipn; - for (i = 1; i <= glob_info.ncsipn; i++) - { - for (j = 1; j <= mesh_pts[glob_info.nfsip+i]; j++) - { - offset++; - if (j == 1) - { - if (cs[offset].val >= -epsilon && - cs[offset].val >= cs[offset+1].val) - { - cs[offset].act_sip = TRUE; - glob_info.tot_actg_sip++; - if (cs[offset].mult == 0.e0 && !glob_log.first) - { - glob_grd.valnom = cs[offset].val; - gradcn(nparam, offset, x + 1, cs[offset].grad + 1, constr, - cd); - } - continue; - } - } - else if (j == mesh_pts[glob_info.nfsip+i]) - { - if (cs[offset].val >= -epsilon && - cs[offset].val > cs[offset-1].val) - { - cs[offset].act_sip = TRUE; - glob_info.tot_actg_sip++; - if (cs[offset].mult == 0.e0 && !glob_log.first) - { - glob_grd.valnom = cs[offset].val; - gradcn(nparam, offset, x + 1, cs[offset].grad + 1, constr, - cd); - } - continue; - } - } - else - { - if (cs[offset].val >= -epsilon && cs[offset].val > - cs[offset-1].val && cs[offset].val >= - cs[offset+1].val) - { - cs[offset].act_sip = TRUE; - glob_info.tot_actg_sip++; - if (cs[offset].mult == 0.e0 && !glob_log.first) - { - glob_grd.valnom = cs[offset].val; - gradcn(nparam, offset, x + 1, cs[offset].grad + 1, constr, - cd); - } - continue; - } - } - if (cs[offset].val >= -glob_grd.epsmac) - { - cs[offset].act_sip = TRUE; - glob_info.tot_actg_sip++; - if (cs[offset].mult == 0.e0 && !glob_log.first) - { - glob_grd.valnom = cs[offset].val; - gradcn(nparam, offset, x + 1, cs[offset].grad + 1, constr, cd); - } - continue; - } - if (cs[offset].mult > 0.e0) - { - cs[offset].act_sip = TRUE; - glob_info.tot_actg_sip++; - } - /* Add if binding for d1 */ - if (cs[offset].d1bind) - { - cs[offset].act_sip = TRUE; - glob_info.tot_actg_sip++; - if (cs[offset].mult == 0.e0 && !glob_log.first) - { - glob_grd.valnom = cs[offset].val; - gradcn(nparam, offset, x + 1, cs[offset].grad + 1, constr, cd); - } - } - - } - } - } - if (ncsipl != 0) - { - /* Don't need to get gradients */ - offset = nineq - ncsipl; - for (i = 1; i <= glob_info.ncsipl; i++) - { - if (feasb) - index = glob_info.nfsip + glob_info.ncsipn + i; - else - index = glob_info.ncsipn + i; - for (j = 1; j <= mesh_pts[index]; j++) - { - offset++; - if (j == 1) - { - if (cs[offset].val >= -epsilon && - cs[offset].val >= cs[offset+1].val) - { - cs[offset].act_sip = TRUE; - glob_info.tot_actg_sip++; - continue; - } - } - else - if (j == mesh_pts[index]) - { - if (cs[offset].val >= -epsilon && - cs[offset].val > cs[offset-1].val) - { - cs[offset].act_sip = TRUE; - glob_info.tot_actg_sip++; - continue; - } - } - else - { - if (cs[offset].val >= -epsilon && cs[offset].val > - cs[offset-1].val && cs[offset].val >= - cs[offset+1].val) - { - cs[offset].act_sip = TRUE; - glob_info.tot_actg_sip++; - continue; - } - } - if (cs[offset].val >= -glob_grd.epsmac || - cs[offset].mult > 0.e0 || cs[offset].d1bind) - { - cs[offset].act_sip = TRUE; - glob_info.tot_actg_sip++; - } - } - } - } - /* Include some extra points during 1st iteration */ - /* (gradients are already evaluated for first iteration) */ - /* Current heuristics: maximizers and end-points. */ - if (glob_log.first) - { - if (feasb) - { - offset = nineqn - ncsipn; - for (i = 1; i <= glob_info.ncsipn; i++) - { - i_max = ++offset; - g_max = cs[i_max].val; - if (!cs[i_max].act_sip) - { /* add first point */ - cs[i_max].act_sip = TRUE; - glob_info.tot_actg_sip++; - } - for (j = 2;j <= mesh_pts[glob_info.nfsip+i];j++) - { - offset++; - if (cs[offset].val > g_max) - { - i_max = offset; - g_max = cs[i_max].val; - } - } - if (!cs[i_max].act_sip) - { - cs[i_max].act_sip = TRUE; - glob_info.tot_actg_sip++; - } - if (!cs[offset].act_sip) - { /* add last point */ - cs[offset].act_sip = TRUE; - glob_info.tot_actg_sip++; - } - } - } - offset = nineq - ncsipl; - for (i = 1; i <= glob_info.ncsipl; i++) - { - i_max = ++offset; - g_max = cs[i_max].val; - if (!cs[i_max].act_sip) - { /* add first point */ - cs[i_max].act_sip = TRUE; - glob_info.tot_actg_sip++; - } - if (feasb) - index = glob_info.nfsip + glob_info.ncsipn + i; - else - index = glob_info.ncsipn + i; - for (j = 2;j <= mesh_pts[index]; j++) - { - offset++; - if (cs[offset].val > g_max) - { - i_max = offset; - g_max = cs[i_max].val; - } - } - if (!cs[i_max].act_sip) - { - cs[i_max].act_sip = TRUE; - glob_info.tot_actg_sip++; - } - if (!cs[offset].act_sip) - { /* add last point */ - cs[offset].act_sip = TRUE; - glob_info.tot_actg_sip++; - } - } - } - - /* If necessary, append xi_bar */ - if (steps < 1.e0 && viol->type == CONSTR) - { - i = viol->index; - if (!cs[i].act_sip) - { - cs[i].act_sip = TRUE; - glob_info.tot_actg_sip++; - } - } - if (glob_prnt.iprint >= 2 && display) - fprintf(glob_prnt.io, " |Xi_k| for g %26d\n", - glob_info.tot_actg_sip); - - for (i = 1; i <= ncsipl; i++) - cs[nineq-ncsipl+i].d1bind = FALSE; - for (i = 1; i <= ncsipn; i++) - cs[nineqn-ncsipn+i].d1bind = FALSE; - - /*---------------------------------------------------------*/ - /* Update Objective Set Omega_k */ - /*---------------------------------------------------------*/ - - if (nfsip) - { - offset = nob - nfsip; - if (feasb) - index = glob_info.nfsip; - else - index = glob_info.ncsipn; - for (i = 1; i <= index; i++) - { - for (j = 1; j <= mesh_pts[i]; j++) - { - offset++; - if (nobL > nob) - { - fnow = fabs(ob[offset].val); - fmult = DMAX1(fabs(ob[offset].mult), - fabs(ob[offset].mult_L)); - } - else - { - fnow = ob[offset].val; - fmult = ob[offset].mult; - } - if (j == 1) - { - if (nobL > nob) - fnext = fabs(ob[offset+1].val); - else - fnext = ob[offset+1].val; - if ((fnow >= fmax - epsilon) && fnow >= fnext) - { - ob[offset].act_sip = TRUE; - glob_info.tot_actf_sip++; - if (fmult == 0.e0 && !glob_log.first) - { - glob_grd.valnom = ob[offset].val; - if (feasb) - gradob(nparam, offset, x + 1, - ob[offset].grad + 1, obj, cd); - else - gradcn(nparam, offset, x + 1, ob[offset].grad + 1, - constr, cd); - } - continue; - } - } - else if (j == mesh_pts[i]) - { - if (nobL > nob) - fprev = fabs(ob[offset-1].val); - else - fprev = ob[offset-1].val; - if ((fnow >= fmax - epsilon) && fnow > fprev) - { - ob[offset].act_sip = TRUE; - glob_info.tot_actf_sip++; - if (fmult == 0.e0 && !glob_log.first) - { - glob_grd.valnom = ob[offset].val; - if (feasb) - gradob(nparam, offset, x + 1, - ob[offset].grad + 1, obj, cd); - else - gradcn(nparam, offset, x + 1, ob[offset].grad + 1, - constr, cd); - } - continue; - } - } - else - { - if (nobL > nob) - { - fprev = fabs(ob[offset-1].val); - fnext = fabs(ob[offset+1].val); - } - else - { - fprev = ob[offset-1].val; - fnext = ob[offset+1].val; - } - if ((fnow >= fmax - epsilon) && fnow > fprev && - fnow >= fnext) - { - ob[offset].act_sip = TRUE; - glob_info.tot_actf_sip++; - if (fmult == 0.e0 && !glob_log.first) - { - glob_grd.valnom = ob[offset].val; - if (feasb) - gradob(nparam, offset, x + 1, - ob[offset].grad + 1, obj, cd); - else - gradcn(nparam, offset, x + 1, ob[offset].grad + 1, - constr, cd); - } - continue; - } - } - if (fnow >= fmax - glob_grd.epsmac && !ob[offset].act_sip) - { - ob[offset].act_sip = TRUE; - glob_info.tot_actf_sip++; - if (fmult == 0.e0 && !glob_log.first) - { - glob_grd.valnom = ob[offset].val; - if (feasb) - gradob(nparam, offset, x + 1, - ob[offset].grad + 1, obj, cd); - else - gradcn(nparam, offset, x + 1, ob[offset].grad + 1, - constr, cd); - } - continue; - } - if (fmult != 0.e0 && !ob[offset].act_sip) - { - ob[offset].act_sip = TRUE; - glob_info.tot_actf_sip++; - continue; - } - } - } - /* Addition of objectives for first iteration. */ - /* Current heuristics: maximizers and end-points */ - if (glob_log.first) - { - offset = nob - nfsip; - if (feasb) - index = glob_info.nfsip; - else - index = glob_info.ncsipn; - for (i = 1; i <= index; i++) - { - i_max = ++offset; - if (nobL == nob) - g_max = ob[i_max].val; - else - g_max = fabs(ob[i_max].val); - if (!ob[i_max].act_sip) - { /* add first point */ - ob[i_max].act_sip = TRUE; - glob_info.tot_actf_sip++; - } - for (j = 2;j <= mesh_pts[i];j++) - { - offset++; - if (nobL == nob) - fnow = ob[offset].val; - else - fnow = fabs(ob[offset].val); - if (fnow > g_max) - { - i_max = offset; - g_max = fnow; - } - } - if (!ob[i_max].act_sip) - { - ob[i_max].act_sip = TRUE; - glob_info.tot_actf_sip++; - } - if (!ob[offset].act_sip) - { /* add last point */ - ob[offset].act_sip = TRUE; - glob_info.tot_actf_sip++; - } - } - } - - /* If necessary, append omega_bar */ - if (steps < 1.e0 && viol->type == OBJECT) - { - i = viol->index; - if (!ob[i].act_sip) - { - ob[i].act_sip = TRUE; - glob_info.tot_actf_sip++; - } - } - if (glob_prnt.iprint >= 2 && display) - fprintf(glob_prnt.io, " |Omega_k| for f %26d\n", - glob_info.tot_actf_sip); - } - viol->type = NONE; - viol->index = 0; - return; -} -/*******************************************************************/ -/* CFSQP : Computation of the search direction */ -/*******************************************************************/ - - -#ifdef __STDC__ -static void -dqp(int, int, int, int, int, int, int, int, int, int, int, int, int, - int, int, int *, struct _parameter *, double *, int, - struct _objective *, double, double *, struct _constraint *, - double **, double *, double *, double *, double *, - double **, double **, double *, double, int); -static void -di1(int, int, int, int, int, int, int, int, int, int, int, int, int *, - int, struct _parameter *, double *, struct _objective *, - double, double *, struct _constraint *, double *, - double *, double *, double *, double **, double *, double); -#else -static void dqp(); -static void di1(); -#endif - -#ifdef __STDC__ -static void -dir(int nparam, int nob, int nobL, int nfsip, int nineqn, int neq, int neqn, - int nn, int ncsipl, int ncsipn, int ncnstr, - int feasb, double *steps, double epskt, double epseqn, - double *sktnom, double *scvneq, double Ck, double *d0nm, - double *grdftd, int *indxob, int *indxcn, int *iact, int *iskp, - int *iskip, int *istore, struct _parameter *param, double *di, - double *d, struct _constraint *cs, struct _objective *ob, - double *fM, double *fMp, double *fmax, double *psf, double *grdpsf, - double *penp, double **a, double *bl, double *bu, double *clamda, - double *cvec, double **hess, double **hess1, - double *backup, double *signeq, struct _violation *viol, - void(*obj)(int, int, double *, double *, void *), - void(*constr)(int, int, double *, double *, void *)) -#else -static void -dir(nparam, nob, nobL, nfsip, nineqn, neq, neqn, nn, ncsipl, ncsipn, ncnstr, - feasb, steps, epskt, epseqn, sktnom, scvneq, Ck, d0nm, - grdftd, indxob, indxcn, iact, iskp, iskip, istore, param, di, d, cs, ob, - fM, fMp, fmax, psf, grdpsf, penp, a, bl, bu, clamda, cvec, hess, hess1, - backup, signeq, viol, obj, constr) -int nparam, nob, nobL, nfsip, nineqn, neq, neqn, nn, ncsipl, ncsipn, ncnstr, -*iskp, feasb; -int *indxob, *indxcn, *iact, *iskip, *istore; -double *steps, epskt, epseqn, *sktnom, Ck, *d0nm, *grdftd, *fM, *fMp, -*fmax, *psf, *scvneq; -double *di, *d, *grdpsf, *penp, **a, *bl, *bu, *clamda, *cvec, **hess, -**hess1, *backup, *signeq; -struct _constraint *cs; -struct _objective *ob; -struct _parameter *param; -struct _violation *viol; -void(* obj)(), (* constr)(); -#endif -{ - int i, j, k, kk, ncg, ncf, nqprm0, nclin0, nctot0, infoqp, nqprm1, ncl, - nclin1=0, ncc, nff, nrowa0, nrowa1, ninq, nobb, nobbL, - nncn, ltem1, ltem2, display, need_d1; - double fmxl, vv, dx, dmx, dnm1, dnm, v0, v1, vk=0., temp1, temp2, theta, - rhol, rhog, rho, grdfd0, grdfd1, dummy, grdgd0, grdgd1, thrshd, - sign, *adummy, dnmtil, *tempv; - - ncg = ncf = *iskp = 0; - ncl = glob_info.nnineq - nineqn; - glob_log.local = glob_log.update = FALSE; - glob_log.rhol_is1 = FALSE; - thrshd = tolfea; - adummy = make_dv(1); - adummy[1] = 0.e0; - dummy = 0.e0; - temp1 = temp2 = 0.e0; - if (glob_prnt.iter % glob_prnt.iter_mod) - display = FALSE; - else - display = TRUE; - need_d1 = TRUE; - - if (nobL <= 1) - { - nqprm0 = nparam; - nclin0 = ncnstr; - } - else - { - nqprm0 = nparam + 1; - nclin0 = ncnstr + nobL; - } - nctot0 = nqprm0 + nclin0; - vv = 0.e0; - nrowa0 = DMAX1(nclin0, 1); - for (i = 1; i <= ncnstr; i++) - { - if (feasb) - { - if (i > nineqn && i <= glob_info.nnineq) - iskip[glob_info.nnineq+2-i] = i; - iw[i] = i; - } - else - { - if (i <= ncl) - iskip[ncl+2-i] = nineqn + i; - if (i <= ncl) - iw[i] = nineqn + i; - if (i > ncl) - iw[i] = nineqn + neqn + i; - } - } - for (i = 1; i <= nob; i++) - iw[ncnstr+i] = i; - nullvc(nparam, cvec); - glob_log.d0_is0 = FALSE; - dqp(nparam, nqprm0, nob, nobL, nfsip, nineqn, neq, neqn, nn, ncsipl, ncsipn, - ncnstr, nctot0, nrowa0, nineqn, &infoqp, param, di, feasb, ob, - *fmax, grdpsf, cs, a, cvec, bl, bu, clamda, hess, hess1, di, vv, 0); - if (infoqp != 0) - { - glob_prnt.info = 5; - if (!feasb) - glob_prnt.info = 2; - nstop = 0; - free_dv(adummy); - return; - } - /*-------------------------------------------------------------*/ - /* Reorder indexes of constraints & objectives */ - /*-------------------------------------------------------------*/ - if (nn > 1) - { - j = 1; - k = nn; - for (i = nn; i >= 1; i--) - { - if (fuscmp(cs[indxcn[i]].mult, thrshd)) - { - iact[j] = indxcn[i]; - j++; - } - else - { - iact[k] = indxcn[i]; - k--; - } - } - } - if (nobL > 1) - { - j = nn + 1; - k = nn + nob; - for (i = nob; i >= 1; i--) - { - kk = nqprm0 + ncnstr; - ltem1 = fuscmp(ob[i].mult, thrshd); - ltem2 = (nobL != nob) && (fuscmp(ob[i].mult_L, thrshd)); - if (ltem1 || ltem2) - { - iact[j] = i; - j++; - } - else - { - iact[k] = i; - k--; - } - } - } - if (nob > 0) - vv = ob[iact[nn+1]].val; - *d0nm = sqrt(scaprd(nparam, di, di)); - if (glob_log.first && nclin0 == 0) - { - dx = sqrt(scaprd(nparam, param->x, param->x)); - dmx = DMAX1(dx, 1.e0); - if (*d0nm > dmx) - { - for (i = 1; i <= nparam; i++) - di[i] = di[i] * dmx / (*d0nm); - *d0nm = dmx; - } - } - matrvc(nparam, nparam, hess, di, w); - if (nn == 0) - *grdftd = -scaprd(nparam, w, di); - *sktnom = sqrt(scaprd(nparam, w, w)); - if (((*d0nm <= epskt) || ((gLgeps > 0.e0) && (*sktnom <= gLgeps))) && - (neqn == 0 || *scvneq <= epseqn)) - { - /* We are finished! */ - nstop = 0; - if (feasb && glob_log.first && neqn != 0) - { - /* Finished, but still need to estimate nonlinear equality - constraint multipliers */ - glob_log.get_ne_mult = TRUE; - glob_log.d0_is0 = TRUE; - } - if (!feasb) - glob_prnt.info = 2; - free_dv(adummy); - if (glob_prnt.iprint < 3 || !display) - return; - if (nobL <= 1) - nff = 1; - if (nobL > 1) - nff = 2; - sbout1(glob_prnt.io, nparam, "multipliers for x ", dummy, - param->mult, 2, 2); - if (ncnstr != 0) - { - fprintf(glob_prnt.io, "\t\t\t %s\t %22.14e\n", - " for g ", cs[1].mult); - for (j = 2; j <= ncnstr; j++) - fprintf(glob_prnt.io, " \t\t\t\t\t\t %22.14e\n", cs[j].mult); - } - if (nobL > 1) - { - fprintf(glob_prnt.io, "\t\t\t %s\t %22.14e\n", - " for f ", ob[1].mult); - for (j = 2; j <= nob; j++) - fprintf(glob_prnt.io, " \t\t\t\t\t\t %22.14e\n", ob[j].mult); - } - return; - } - if (glob_prnt.iprint >= 3 && display) - { - sbout1(glob_prnt.io, nparam, "d0 ", dummy, di, 2, 2); - sbout1(glob_prnt.io, 0, "d0norm ", *d0nm, adummy, 1, 2); - sbout1(glob_prnt.io, 0, "ktnorm ", *sktnom, adummy, 1, 2); - } - if (neqn != 0 && *d0nm <= DMIN1(0.5e0*epskt, (0.1e-1)*glob_grd.rteps) - && *scvneq > epseqn) - { - /* d0 is "zero", but equality constraints not satisfied */ - glob_log.d0_is0 = TRUE; - return; - } - /*--------------------------------------------------------------*/ - /* Single objective without nonlinear constraints requires */ - /* no d1 and dtilde; multi-objectives without nonlinear */ - /* constraints requires no d1. */ - /*--------------------------------------------------------------*/ - if (nn != 0) - *grdftd = slope(nob, nobL, neqn, nparam, feasb, ob, grdpsf, - di, d, *fmax, dummy, 0, adummy, 0); - - if (nn == 0 && nobL <= 1) - { - for (i = 1; i <= nparam; i++) - d[i] = 0.e0; - dnmtil = 0.e0; - free_dv(adummy); - return; - } - if (nn == 0) - { - dnm = *d0nm; - rho = 0.e0; - rhog = 0.e0; - goto L310; - } - /*-------------------------------------------------------------*/ - /* compute modified first order direction d1 */ - /*-------------------------------------------------------------*/ - - /* First check that it is necessary */ - if (glob_info.mode == 1) - { - vk = DMIN1(Ck * (*d0nm) * (*d0nm), *d0nm); - need_d1 = FALSE; - for (i = 1; i <= nn; i++) - { - tempv = cs[indxcn[i]].grad; - grdgd0 = scaprd(nparam, tempv, di); - temp1 = vk + cs[indxcn[i]].val + grdgd0; - if (temp1 > 0.e0) - { - need_d1 = TRUE; - break; - } - } - } - if (need_d1) - { - nqprm1 = nparam + 1; - if (glob_info.mode == 0) - nclin1 = ncnstr + DMAX1(nobL, 1); - if (glob_info.mode == 1) - nclin1 = ncnstr; - nrowa1 = DMAX1(nclin1, 1); - ninq = glob_info.nnineq; - di1(nparam, nqprm1, nob, nobL, nfsip, nineqn, neq, neqn, ncnstr, - ncsipl, ncsipn, nrowa1, &infoqp, glob_info.mode, - param, di, ob, *fmax, grdpsf, cs, cvec, bl, bu, clamda, - hess1, d, *steps); - if (infoqp != 0) - { - glob_prnt.info = 6; - if (!feasb) - glob_prnt.info = 2; - nstop = 0; - free_dv(adummy); - return; - } - dnm1 = sqrt(scaprd(nparam, d, d)); - if (glob_prnt.iprint >= 3 && display) - { - sbout1(glob_prnt.io, nparam, "d1 ", dummy, d, 2, 2); - sbout1(glob_prnt.io, 0, "d1norm ", dnm1, adummy, 1, 2); - } - } - else - { - dnm1 = 0.e0; - for (i = 1; i <= nparam; i++) - d[i] = 0.e0; - } - if (glob_info.mode != 1) - { - v0 = pow(*d0nm, 2.1); - v1 = DMAX1(0.5e0, pow(dnm1, 2.5)); - rho = v0 / (v0 + v1); - rhog = rho; - } - else - { - rhol = 0.e0; - if (need_d1) - { - for (i = 1; i <= nn; i++) - { - tempv = cs[indxcn[i]].grad; - grdgd0 = scaprd(nparam, tempv, di); - grdgd1 = scaprd(nparam, tempv, d); - temp1 = vk + cs[indxcn[i]].val + grdgd0; - temp2 = grdgd1 - grdgd0; - if (temp1 <= 0.e0) - continue; - if (fabs(temp2) < glob_grd.epsmac) - { - rhol = 1.e0; - glob_log.rhol_is1 = TRUE; - break; - } - rhol = DMAX1(rhol, -temp1 / temp2); - if (temp2 < 0.e0 && rhol < 1.e0) - continue; - rhol = 1.e0; - glob_log.rhol_is1 = TRUE; - break; - } - } - theta = 0.2e0; - if (rhol == 0.e0) - { - rhog = rho = 0.e0; - dnm = *d0nm; - goto L310; - } - if (nobL > 1) - { - rhog = slope(nob, nobL, neqn, nparam, feasb, ob, grdpsf, - di, d, *fmax, theta, glob_info.mode, adummy, 0); - rhog = DMIN1(rhol, rhog); - } - else - { - grdfd0 = *grdftd; - if (nob == 1) - grdfd1 = scaprd(nparam, ob[1].grad, d); - else - grdfd1 = 0.e0; - grdfd1 = grdfd1 - scaprd(nparam, grdpsf, d); - temp1 = grdfd1 - grdfd0; - temp2 = (theta - 1.e0) * grdfd0 / temp1; - if (temp1 <= 0.e0) - rhog = rhol; - else - rhog = DMIN1(rhol, temp2); - } - rho = rhog; - if (*steps == 1.e0 && rhol < 0.5e0) - rho = rhol; - } - for (i = 1; i <= nparam; i++) - { - if (rho != rhog) - cvec[i] = di[i]; - di[i] = (1.e0 - rho) * di[i] + rho * d[i]; - } - dnm = sqrt(scaprd(nparam, di, di)); - if (!(glob_prnt.iprint < 3 || glob_info.mode == 1 || nn == 0) && display) - { - sbout1(glob_prnt.io, 0, "rho ", rho, adummy, 1, 2); - sbout1(glob_prnt.io, nparam, "d ", dummy, di, 2, 2); - sbout1(glob_prnt.io, 0, "dnorm ", dnm, adummy, 1, 2); - } -L310: - for (i = 1; i <= nob; i++) - bl[i] = ob[i].val; - if (rho != 1.e0) - { - if (!(glob_prnt.iprint != 3 || glob_info.mode == 0 || nn == 0) - && display) - { - sbout1(glob_prnt.io, 0, "Ck ", Ck, adummy, 1, 2); - sbout1(glob_prnt.io, 0, "rhol ", rho, adummy, 1, 2); - sbout1(glob_prnt.io, nparam, "dl ", dummy, di, 2, 2); - sbout1(glob_prnt.io, 0, "dlnorm ", dnm, adummy, 1, 2); - } - if (glob_info.mode != 0) - { - glob_log.local = TRUE; - step1(nparam, nob, nobL, nfsip, nineqn, neq, neqn, nn, ncsipl, ncsipn, - ncnstr, &ncg, &ncf, indxob, indxcn, iact, iskp, iskip, istore, - feasb, *grdftd, ob, fM, fMp, fmax, psf, penp, steps, scvneq, bu, - param->x, di, d, cs, backup, signeq, viol, obj, constr, param->cd); - if (!glob_log.update) - nstop = 1; - else - { - free_dv(adummy); - return; - } - glob_log.local = FALSE; - if (rho != rhog && nn != 0) - for (i = 1; i <= nparam; i++) - di[i] = (1 - rhog) * cvec[i] + rhog * d[i]; - dnm = sqrt(scaprd(nparam, di, di)); - } - } - if (!(glob_prnt.iprint < 3 || glob_info.mode == 0 || nn == 0) && - display) - { - sbout1(glob_prnt.io, 0, "rhog ", rhog, adummy, 1, 2); - sbout1(glob_prnt.io, nparam, "dg ", dummy, di, 2, 2); - sbout1(glob_prnt.io, 0, "dgnorm ", dnm, adummy, 1, 2); - } - if (rho != 0.e0) - *grdftd = slope(nob, nobL, neqn, nparam, feasb, ob, - grdpsf, di, d, *fmax, theta, 0, bl, 1); - if (glob_info.mode != 1 || rho != rhog) - for (i = 1; i <= nparam; i++) - bu[i] = param->x[i] + di[i]; - x_is_new = TRUE; - if (rho != rhog) - ncg = 0; - ncc = ncg + 1; - fmxl = -bgbnd; - ninq = nncn = ncg; - j = 0; - /*--------------------------------------------------------------*/ - /* iskip[1]-iskip[iskp] store the indexes of linear inequality*/ - /* constraints that are not to be used to compute d~ */ - /* iskip[nnineq-nineqn+1]-iskip[nnineq-ncn+1-iskp] store */ - /* those that are to be used to compute d~ */ - /*--------------------------------------------------------------*/ - for (i = ncc; i <= ncnstr; i++) - { - if (i <= nn) - kk = iact[i]; - else - kk = indxcn[i]; - if (kk > nineqn && kk <= glob_info.nnineq) - { - iskip[ncl+1-j] = kk; - j++; - } - if (kk <= glob_info.nnineq) - { - tempv = cs[kk].grad; - temp1 = dnm * sqrt(scaprd(nparam, tempv, tempv)); - temp2 = cs[kk].mult; - } - if (temp2 != 0.e0 || cs[kk].val >= (-0.2e0*temp1) || - kk > glob_info.nnineq) - { - ninq++; - iw[ninq] = kk; - if (feasb && kk <= nineqn) - istore[kk] = 1; - constr(nparam, kk, bu + 1, &(cs[kk].val), param->cd); - if (!feasb || (feasb && (kk > glob_info.nnineq + neqn))) - continue; - if (kk <= nineqn) - nncn = ninq; - fmxl = DMAX1(fmxl, cs[kk].val); - if (feasb && (kk <= nineqn || (kk > glob_info.nnineq - && kk <= (glob_info.nnineq + neqn)))) - glob_info.ncallg++; - if (fabs(fmxl) > bgbnd) - { - for (i = 1; i <= nparam; i++) - d[i] = 0.e0; - dnmtil = 0.e0; - nstop = 1; - free_dv(adummy); - return; - } - continue; - } - if (kk <= nineqn) - continue; - (*iskp)++; - iskip[*iskp] = kk; - j--; - } - if ((neqn != 0) && (feasb)) - resign(nparam, neqn, psf, grdpsf, penp, cs, signeq, 10, 20); - ninq -= neq; - /* if (!feasb) ninq+=neqn; BUG??? */ - if (ncg != 0) - for (i = 1; i <= ncg; i++) - { - iw[i] = iact[i]; - istore[iact[i]] = 1; - fmxl = DMAX1(fmxl, cs[iact[i]].val); - if (fabs(fmxl) > bgbnd) - { - for (i = 1; i <= nparam; i++) - d[i] = 0.e0; - dnmtil = 0.e0; - nstop = 1; - free_dv(adummy); - return; - } - } - if (nobL <= 1) - { - iw[1+ninq+neq] = 1; - nobb = nob; - goto L1110; - } - if (rho != rhog) - ncf = 0; - nff = ncf + 1; - nobb = ncf; - sign = 1.e0; - fmxl = -bgbnd; - if (ob[iact[nn+1]].mult < 0.e0) - sign = -1.e0; - for (i = nff; i <= nob; i++) - { - kk = iact[nn+i]; - if (!feasb) - kk = iact[i]; - if (feasb) - k = nn + 1; - if (!feasb) - k = 1; - for (j = 1; j <= nparam; j++) - w[nparam+j] = sign * ob[iact[k]].grad[j] - ob[kk].grad[j]; - temp1 = fabs(ob[kk].val - sign * vv); - temp2 = dnm * sqrt(scaprd(nparam, &w[nparam], &w[nparam])); - if (temp1 != 0.e0 && temp2 != 0.e0) - { - temp1 = temp1 / temp2; - temp2 = ob[kk].mult; - if (temp2 == 0.e0 && temp1 > 0.2e0) - continue; - } - nobb++; - iw[nobb+ninq+neq] = kk; - if (feasb) - istore[nineqn+kk] = 1; - else - istore[kk] = 1; - if (!feasb) - { - constr(nparam, indxob[kk], bu + 1, &(ob[kk].val), param->cd); - glob_info.ncallg++; - } - else - { - obj(nparam, kk, bu + 1, &(ob[kk].val), param->cd); - glob_info.ncallf++; - if (nobL != nob) - fmxl = DMAX1(fmxl, -ob[kk].val); - } - fmxl = DMAX1(fmxl, ob[kk].val); - if (fabs(fmxl) > bgbnd) - { - for (i = 1; i <= nparam; i++) - d[i] = 0.e0; - dnmtil = 0.e0; - nstop = 1; - free_dv(adummy); - return; - } - } - if (ncf != 0) - { - for (i = 1; i <= ncf; i++) - { - iw[ninq+neq+i] = iact[i+nn]; - istore[nineqn+iact[i+nn]] = 1; - fmxl = DMAX1(fmxl, ob[iact[i+nn]].val); - if (nobL != nob) - fmxl = DMAX1(fmxl, -ob[iact[i+nn]].val); - if (fabs(fmxl) > bgbnd) - { - for (i = 1; i <= nparam; i++) - d[i] = 0.e0; - dnmtil = 0.e0; - nstop = 1; - free_dv(adummy); - return; - } - } - } - L1110: - matrvc(nparam, nparam, hess, di, cvec); - vv = -DMIN1(0.01e0 * dnm, pow(dnm, 2.5)); - /*--------------------------------------------------------------*/ - /* compute a correction dtilde to d=(1-rho)d0+rho*d1 */ - /*--------------------------------------------------------------*/ - if (nobL != nob) - nobbL = 2 * nobb; - if (nobL == nob) - nobbL = nobb; - if (nobbL <= 1) - { - nqprm0 = nparam; - nclin0 = ninq + neq; - } - else - { - nqprm0 = nparam + 1; - nclin0 = ninq + neq + nobbL; - } - nctot0 = nqprm0 + nclin0; - nrowa0 = DMAX1(nclin0, 1); - i = ninq + neq; - nstop = 1; - dqp(nparam, nqprm0, nobb, nobbL, nfsip, nncn, neq, neqn, nn, ncsipl, ncsipn, i, - nctot0, nrowa0, nineqn, &infoqp, param, di, feasb, ob, fmxl, - grdpsf, cs, a, cvec, bl, bu, clamda, hess, hess1, d, vv, 1); - dnmtil = sqrt(scaprd(nparam, d, d)); - if (infoqp != 0 || dnmtil > dnm) - { - for (i = 1; i <= nparam; i++) - d[i] = 0.e0; - dnmtil = 0.e0; - nstop = 1; - free_dv(adummy); - return; - } - if (dnmtil != 0.e0) - for (i = 1; i <= nineqn + nob; i++) - istore[i] = 0; - if (glob_prnt.iprint < 3 || !display) - { - free_dv(adummy); - return; - } - sbout1(glob_prnt.io, nparam, "dtilde ", dummy, d, 2, 2); - sbout1(glob_prnt.io, 0, "dtnorm ", dnmtil, adummy, 1, 2); - free_dv(adummy); - return; -} - -/*******************************************************************/ -/* job=0: compute d0 */ -/* job=1: compute d~ */ -/*******************************************************************/ -#ifdef __STDC__ -static void -dqp(int nparam, int nqpram, int nob, int nobL, int nfsip, int nineqn, - int neq, int neqn, int nn, int ncsipl, int ncsipn, int ncnstr, - int nctotl, int nrowa, int nineqn_tot, int *infoqp, - struct _parameter *param, double *di, int feasb, struct _objective *ob, - double fmax, double *grdpsf, struct _constraint *cs, - double **a, double *cvec, double *bl, double *bu, double *clamda, - double **hess, double **hess1, double *x, - double vv, int job) -#else -static void -dqp(nparam, nqpram, nob, nobL, nfsip, nineqn, neq, neqn, nn, ncsipl, ncsipn, - ncnstr, nctotl, nrowa, nineqn_tot, infoqp, param, di, feasb, ob, - fmax, grdpsf, cs, a, cvec, bl, bu, clamda, hess, hess1, x, vv, job) -int nparam, nqpram, nob, nobL, nfsip, nineqn, neq, neqn, nn, ncsipl, ncsipn, -ncnstr, nctotl, nrowa, nineqn_tot, *infoqp, job, feasb; -double fmax, vv; -double *di, *grdpsf, **a, *cvec, *bl, *bu, *clamda, **hess, **hess1, *x; -struct _constraint *cs; -struct _objective *ob; -struct _parameter *param; -#endif -{ - int i, ii, j, jj, ij, k, iout, mnn, nqnp, zero, temp1, temp2, ncnstr_used, - numf_used=0; - int *iw_hold; - double x0i, xdi=0., *bj, *htemp, *atemp; - - iout = 6; - bj = make_dv(nrowa); - iw_hold = make_iv(nrowa); - for (i = 1; i <= nparam; i++) - { - x0i = param->x[i]; - if (job == 1) - xdi = di[i]; - if (job == 0) - xdi = 0.e0; - bl[i] = param->bl[i] - x0i - xdi; - bu[i] = param->bu[i] - x0i - xdi; - cvec[i] = cvec[i] - grdpsf[i]; - } - if (nobL > 1) - { - bl[nqpram] = -bgbnd; - bu[nqpram] = bgbnd; - } - ii = ncnstr - nn; - /*---------------------------------------------------------------*/ - /* constraints are assigned to a in reverse order */ - /*---------------------------------------------------------------*/ - k = 0; - for (i = 1; i <= ncnstr; i++) - { - jj = iw[ncnstr+1-i]; - if ((jj > glob_info.nnineq) || (jj <= nineqn_tot - ncsipn) || - ((jj > nineqn_tot) && (jj <= glob_info.nnineq - ncsipl)) || - cs[jj].act_sip) - { - k++; - x0i = vv; - if (i <= (neq - neqn) || (i > neq && i <= (ncnstr - nineqn))) - x0i = 0.e0; - if (!feasb) - x0i = 0.e0; - bj[k] = x0i - cs[jj].val; - for (j = 1; j <= nparam; j++) - a[k][j] = -cs[jj].grad[j]; - if (nobL > 1) - a[k][nqpram] = 0.e0; - iw_hold[k] = jj; - } - } - ncnstr_used = k; - /*---------------------------------------------------------------*/ - /* Assign objectives for QP */ - /*---------------------------------------------------------------*/ - if (nobL == 1) - { - for (i = 1; i <= nparam; i++) - cvec[i] = cvec[i] + ob[1].grad[i]; - } - else if (nobL > 1) - { - numf_used = nob - nfsip + glob_info.tot_actf_sip; - if (job && nfsip) - { /* compute # objectives used for dtilde */ - numf_used = 0; - for (i = 1; i <= nob; i++) - if (ob[iw[ncnstr+i]].act_sip) - numf_used++; - } - for (i = 1; i <= nob; i++) - { - ij = ncnstr + i; - if ((i <= nob - nfsip) || ob[iw[ij]].act_sip) - { - k++; - iw_hold[k] = iw[ij]; /* record which are used */ - bj[k] = fmax - ob[iw[ij]].val; - if (nobL > nob) - bj[k+numf_used] = fmax + ob[iw[ij]].val; - for (j = 1; j <= nparam; j++) - { - a[k][j] = -ob[iw[ij]].grad[j]; - if (nobL > nob) - a[k+numf_used][j] = ob[iw[ij]].grad[j]; - } - a[k][nqpram] = 1.e0; - if (nobL > nob) - a[k+numf_used][nqpram] = 1.e0; - } - } - cvec[nqpram] = 1.e0; - if (nobL > nob) - k = k + numf_used; /* k=# rows for a */ - } /* =# constraints for QP */ - matrcp(nparam, hess, nparam + 1, hess1); - nullvc(nqpram, x); - - iw[1] = 1; - zero = 0; - temp1 = neq - neqn; - temp2 = nparam + 1; - mnn = k + 2 * nqpram; - htemp = convert(hess1, nparam + 1, nparam + 1); - atemp = convert(a, nrowa, nqpram); - - ql0001_(&k, &temp1, &nrowa, &nqpram, &temp2, &mnn, (htemp + 1), - (cvec + 1), (atemp + 1), (bj + 1), (bl + 1), (bu + 1), (x + 1), - (clamda + 1), &iout, infoqp, &zero, (w + 1), &lenw, (iw + 1), &leniw, - &glob_grd.epsmac); - - free_dv(htemp); - free_dv(atemp); - if (*infoqp != 0 || job == 1) - { - free_iv(iw_hold); - free_dv(bj); - return; - } - - /*---------------------------------------------------------------*/ - /* Save multipliers from the computation of d0 */ - /*---------------------------------------------------------------*/ - nullvc(nqpram, param->mult); - if (ncsipl + ncsipn) - for (i = 1; i <= ncnstr; i++) - cs[i].mult = 0.e0; - if (nfsip) - for (i = 1; i <= nob; i++) - { - ob[i].mult = 0.e0; - ob[i].mult_L = 0.e0; - } - for (i = 1; i <= nqpram; i++) - { - ii = k + i; - if (clamda[ii] == 0.e0 && clamda[ii+nqpram] == 0.e0) - continue; - else if (clamda[ii] != 0.e0) - clamda[ii] = -clamda[ii]; - else - clamda[ii] = clamda[ii+nqpram]; - } - nqnp = nqpram + ncnstr; - for (i = 1; i <= nqpram; i++) /* Simple bounds */ - param->mult[i] = clamda[k+i]; - if (nctotl > nqnp) - { /* Objectives */ - for (i = 1; i <= numf_used; i++) - { - ij = ncnstr_used + i; - if (nobL != nob) - { - ii = k - 2 * numf_used + i; - ob[iw_hold[ij]].mult = clamda[ii] - clamda[ii+numf_used]; - ob[iw_hold[ij]].mult_L = clamda[ii+numf_used]; - } - else - { - ii = k - numf_used + i; - ob[iw_hold[ij]].mult = clamda[ii]; - } - } - } - for (i = 1; i <= ncnstr_used; i++) /* Constraints */ - cs[iw_hold[i]].mult = clamda[i]; - free_iv(iw_hold); - free_dv(bj); - return; -} - -/****************************************************************/ -/* Computation of first order direction d1 */ -/****************************************************************/ -#ifdef __STDC__ -static void -di1(int nparam, int nqpram, int nob, int nobL, int nfsip, int nineqn, - int neq, int neqn, int ncnstr, int ncsipl, int ncsipn, - int nrowa, int *infoqp, int mode, struct _parameter *param, - double *d0, struct _objective *ob, double fmax, double - *grdpsf, struct _constraint *cs, double *cvec, double *bl, double *bu, - double *clamda, double **hess1, double *x, double steps) -#else -static void -di1(nparam, nqpram, nob, nobL, nfsip, nineqn, neq, neqn, ncnstr, ncsipl, - ncsipn, nrowa, infoqp, mode, param, d0, ob, fmax, grdpsf, cs, - cvec, bl, bu, clamda, hess1, x, steps) -int nparam, nqpram, nob, nobL, nfsip, nineqn, neq, neqn, ncnstr, -nrowa, *infoqp, mode, ncsipl, ncsipn; -double fmax, steps; -double *d0, *grdpsf, *cvec, *bl, *bu, *clamda, **hess1, *x; -struct _constraint *cs; -struct _objective *ob; -struct _parameter *param; -#endif -{ - int i, k, ii, jj, iout, j, mnn, zero, temp1, temp3, ncnstr_used, numf_used=0; - int *iw_hold; - double x0i, eta, *atemp, *htemp, **a, *bj; - - if ((ncsipl + ncsipn) != 0) - nrowa = nrowa - (ncsipl + ncsipn) + glob_info.tot_actg_sip; - if (nfsip) - { - if (nobL > nob) - nrowa = nrowa - 2 * nfsip + 2 * glob_info.tot_actf_sip; - else - nrowa = nrowa - nfsip + glob_info.tot_actf_sip; - } - nrowa = DMAX1(nrowa, 1); - a = make_dm(nrowa, nqpram); - bj = make_dv(nrowa); - iw_hold = make_iv(nrowa); - iout = 6; - if (mode == 0) - eta = 0.1e0; - if (mode == 1) - eta = 3.e0; - for (i = 1; i <= nparam; i++) - { - x0i = param->x[i]; - bl[i] = param->bl[i] - x0i; - bu[i] = param->bu[i] - x0i; - if (mode == 0) - cvec[i] = -eta * d0[i]; - if (mode == 1) - cvec[i] = 0.e0; - } - bl[nqpram] = -bgbnd; - bu[nqpram] = bgbnd; - cvec[nqpram] = 1.e0; - ii = ncnstr - nineqn; - k = 0; - for (i = 1; i <= ncnstr; i++) - { - jj = ncnstr + 1 - i; - if ((jj > glob_info.nnineq) || (jj <= nineqn - ncsipn) || - ((jj > nineqn) && (jj <= glob_info.nnineq - ncsipl)) || - cs[jj].act_sip) - { - k++; - bj[k] = -cs[jj].val; - for (j = 1; j <= nparam; j++) - a[k][j] = -cs[jj].grad[j]; - a[k][nqpram] = 0.e0; - if ((i > (neq - neqn) && i <= neq) || i > ii) - a[k][nqpram] = 1.e0; - iw_hold[k] = jj; - } - } - ncnstr_used = k; - - if (mode != 1) - { - numf_used = nob - nfsip + glob_info.tot_actf_sip; - for (i = 1; i <= nob; i++) - { - if ((i <= nob - nfsip) || ob[i].act_sip) - { - k++; - bj[k] = fmax - ob[i].val; - for (j = 1; j <= nparam; j++) - { - a[k][j] = -ob[i].grad[j] + grdpsf[j]; - if (nobL > nob) - a[k+numf_used][j] = ob[i].grad[j] + grdpsf[j]; - } - a[k][nqpram] = 1.e0; - if (nobL > nob) - a[k+numf_used][nqpram] = 1.e0; - } - } - if (nob == 0) - { - k++; - bj[k] = fmax; - for (j = 1; j <= nparam; j++) - a[k][j] = grdpsf[j]; - a[k][nqpram] = 1.e0; - } - } - diagnl(nqpram, eta, hess1); - nullvc(nqpram, x); - hess1[nqpram][nqpram] = 0.e0; - - iw[1] = 1; - zero = 0; - temp1 = neq - neqn; - if (nobL > nob) - temp3 = k + numf_used; - else - temp3 = k; - mnn = temp3 + 2 * nqpram; - htemp = convert(hess1, nparam + 1, nparam + 1); - atemp = convert(a, nrowa, nqpram); - - ql0001_(&temp3, &temp1, &nrowa, &nqpram, &nqpram, &mnn, (htemp + 1), - (cvec + 1), (atemp + 1), (bj + 1), (bl + 1), (bu + 1), (x + 1), - (clamda + 1), &iout, infoqp, &zero, (w + 1), &lenw, (iw + 1), &leniw, - &glob_grd.epsmac); - - free_dv(htemp); - free_dv(atemp); - free_dm(a, nrowa); - free_dv(bj); - /* Determine binding constraints */ - if (ncsipl + ncsipn) - { - for (i = 1; i <= ncnstr_used; i++) - if (clamda[i] > 0.e0) - cs[iw_hold[i]].d1bind = TRUE; - } - free_iv(iw_hold); - return; -} -/*****************************************************************/ -/* CFSQP : Armijo or nonmonotone line search, with some */ -/* ad hoc strategies to decrease the number of */ -/* function evaluations as much as possible. */ -/*****************************************************************/ - - -#ifdef __STDC__ -static void -step1(int nparam, int nob, int nobL, int nfsip, int nineqn, int neq, int neqn, - int nn, int ncsipl, int ncsipn, int ncnstr, int *ncg, int *ncf, - int *indxob, int *indxcn, int *iact, int *iskp, int *iskip, - int *istore, int feasb, double grdftd, struct _objective *ob, - double *fM, double *fMp, double *fmax, double *psf, double *penp, - double *steps, double *scvneq, double *xnew, double *x, double *di, - double *d, struct _constraint *cs, double *backup, double *signeq, - struct _violation *sip_viol, - void(*obj)(int, int, double *, double *, void *), - void(*constr)(int, int, double *, double *, void *), void *cd) -#else -static void -step1(nparam, nob, nobL, nfsip, nineqn, neq, neqn, nn, ncsipl, ncsipn, ncnstr, - ncg, ncf, indxob, indxcn, iact, iskp, iskip, istore, feasb, grdftd, ob, - fM, fMp, fmax, psf, penp, steps, scvneq, xnew, x, di, d, cs, backup, - signeq, sip_viol, obj, constr, cd) -int nparam, nob, nobL, nfsip, nineqn, neq, neqn, nn, ncsipl, ncsipn, ncnstr, -*ncg, *ncf, feasb, *iskp; -int *indxob, *indxcn, *iact, *iskip, *istore; -double grdftd, *fM, *fMp, *fmax, *steps, *scvneq, *psf; -double *xnew, *x, *di, *d, *penp, *backup, *signeq; -struct _constraint *cs; -struct _objective *ob; -struct _violation *sip_viol; -void(* obj)(), (* constr)(); -void *cd; -#endif -{ - int i, ii, ij, jj, itry, ikeep, j, job, nlin, mnm, ltem1, ltem2, reform, - fbind, cdone, fdone, eqdone, display, sipldone; - double prod1, prod, dummy, fmax1=0., tolfe, ostep, temp, **adummy, fii; - - nlin = glob_info.nnineq - nineqn; - itry = ii = jj = 1; - ostep = *steps = 1.e0; - fbind = cdone = fdone = eqdone = FALSE; - dummy = 0.e0; - sipldone = (ncsipl == 0); - if (glob_log.local) - glob_log.dlfeas = FALSE; - ikeep = nlin - *iskp; - prod1 = (0.1e0) * grdftd; /* alpha = 0.1e0 */ - tolfe = 0.e0; /* feasibility tolerance */ - adummy = make_dm(1, 1); - adummy[1][1] = 0.e0; - if (glob_prnt.iter % glob_prnt.iter_mod) - display = FALSE; - else - display = TRUE; - if (glob_prnt.iprint >= 3 && display) - sbout1(glob_prnt.io, 0, "directional deriv ", grdftd, *(adummy + 1), - 1, 2); - w[1] = *fM; - for (;;) - { - reform = TRUE; - if (glob_prnt.iprint >= 3 && display) - fprintf(glob_prnt.io, "\t\t\t trial number %22d\n", - itry); - prod = prod1 * (*steps); - if (!feasb || (nobL > 1)) - prod = prod + tolfe; - for (i = 1; i <= nparam; i++) - { - if (glob_log.local) - xnew[i] = x[i] + (*steps) * di[i]; - else - xnew[i] = x[i] + (*steps) * di[i] + d[i] * (*steps) * (*steps); - } - x_is_new = TRUE; - if (glob_prnt.iprint >= 3 && display) - { - sbout1(glob_prnt.io, 0, "trial step ", *steps, - *(adummy + 1), 1, 2); - sbout1(glob_prnt.io, nparam, "trial point ", - dummy, xnew, 2, 2); - } - - /* Generate an upper bound step size using the linear constraints - not used in the computation of dtilde */ - if (*iskp != 0) - { - ostep = *steps; - for (i = ii; i <= *iskp; i++) - { - ij = iskip[i]; - constr(nparam, ij, xnew + 1, &(cs[ij].val), cd); - if (glob_prnt.iprint >= 3 && display) - { - if (i == 1) - fprintf(glob_prnt.io, - "\t\t\t trial constraints %d \t %22.14e\n", ij, - cs[ij].val); - if (i != 1) - fprintf(glob_prnt.io, - "\t\t\t\t\t %d \t %22.14e\n", ij, cs[ij].val); - } - if (cs[ij].val <= tolfe) - continue; - ii = i; - if (ncsipl && ii > glob_info.nnineq - ncsipl) - { - sip_viol->type = CONSTR; - sip_viol->index = ij; - } - else - { - sip_viol->type = NONE; /* non-SIP constraint violated */ - sip_viol->index = 0; - } - goto L1120; - } - *iskp = 0; - } - - /* Refine the upper bound using the linear SI constraints not - in Omega_k */ - if (!sipldone) - { - for (i = jj; i <= ncsipl; i++) - { - ij = glob_info.nnineq - ncsipl + i; - if (cs[ij].act_sip || element(iskip, nlin - ikeep, ij)) - continue; - constr(nparam, ij, xnew + 1, &(cs[ij].val), cd); - if (glob_prnt.iprint >= 3 && display) - { - if (i == 1) - fprintf(glob_prnt.io, - "\t\t\t trial constraints %d \t %22.14e\n", ij, - cs[ij].val); - if (i != 1) - fprintf(glob_prnt.io, - "\t\t\t\t\t %d \t %22.14e\n", ij, cs[ij].val); - } - if (cs[ij].val <= tolfe) - continue; - jj = i; - sip_viol->type = CONSTR; - sip_viol->index = ij; - goto L1120; - } - sipldone = TRUE; - } - if (nn == 0) - goto L310; - - /* Check nonlinear constraints */ - if (!glob_log.local && fbind) - goto L315; - do - { - for (i = 1; i <= nn; i++) - { - *ncg = i; - ii = iact[i]; - ij = glob_info.nnineq + neqn; - if (!((ii <= glob_info.nnineq && istore[ii] == 1) || - (ii > glob_info.nnineq && ii <= ij && eqdone))) - { - temp = 1.e0; - if (ii > glob_info.nnineq && ii <= ij) - temp = signeq[ii-glob_info.nnineq]; - constr(nparam, ii, xnew + 1, &(cs[ii].val), cd); - cs[ii].val *= temp; - glob_info.ncallg++; - } - if (glob_prnt.iprint >= 3 && display) - { - if (i == 1 && ikeep == nlin) - fprintf(glob_prnt.io, - "\t\t\t trial constraints %d \t %22.14e\n", ii, - cs[ii].val); - if (i != 1 || ikeep != nlin) - fprintf(glob_prnt.io, - "\t\t\t\t\t %d \t %22.14e\n", ii, cs[ii].val); - } - if (!(glob_log.local || cs[ii].val <= tolfe)) - { - shift(nn, ii, iact); - if (ncsipn && ii > nineqn - ncsipn) - { - sip_viol->type = CONSTR; - sip_viol->index = ii; - } - else - { - sip_viol->type = NONE; /* non-SIP constraint violated */ - sip_viol->index = 0; - } - goto L1110; - } - if (glob_log.local && cs[ii].val > tolfe) - { - if (ncsipn && ii > nineqn - ncsipn) - { - sip_viol->type = CONSTR; - sip_viol->index = ii; - } - else - { - sip_viol->type = NONE; /* non-SIP constraint violated */ - sip_viol->index = 0; - } - goto L1500; - } - } -L310: - cdone = eqdone = TRUE; - if (glob_log.local) - glob_log.dlfeas = TRUE; /* dl is feasible */ -L315: - if (fdone) - break; - if (nob > 0) - fmax1 = -bgbnd; - else - fmax1 = 0.e0; - for (i = 0; i <= nob; i++) - { - if (nob != 0 && i == 0) - continue; - *ncf = i; - ii = iact[nn+i]; - if (feasb) - { - if (!(eqdone || neqn == 0)) - { - for (j = 1; j <= neqn; j++) - constr(nparam, glob_info.nnineq + j, xnew + 1, - &(cs[glob_info.nnineq+j].val), cd); - glob_info.ncallg += neqn; - } - if (neqn != 0) - { - if (eqdone) - job = 20; - if (!eqdone) - job = 10; - resign(nparam, neqn, psf, *(adummy + 1), penp, cs, signeq, - job, 10); - } - if (istore[nineqn+ii] != 1 && i != 0) - { - obj(nparam, ii, xnew + 1, &(ob[ii].val), cd); - glob_info.ncallf++; - } - if (i == 0) - fii = 0.e0; - else - fii = ob[ii].val; - if (i == 0 && glob_prnt.iprint >= 3 && display) - fprintf(glob_prnt.io, - "\t\t\t trial penalty term \t %22.14e\n", -*psf); - if (i == 1 && glob_prnt.iprint >= 3 && display) - fprintf(glob_prnt.io, - "\t\t\t trial objectives %d \t %22.14e\n", - ii, fii - *psf); - if (i > 1 && glob_prnt.iprint >= 3 && display) - fprintf(glob_prnt.io, - "\t\t\t\t\t %d \t %22.14e\n", ii, fii - *psf); - } - else - { - if (istore[ii] != 1) - { - constr(nparam, indxob[ii], xnew + 1, &(ob[ii].val), cd); - glob_info.ncallg++; - } - if (ob[ii].val > tolfe) - reform = FALSE; - if (i == 1 && glob_prnt.iprint > 2 && display) - fprintf(glob_prnt.io, - "\t\t\t trial objectives %d \t %22.14e\n", - indxob[ii], ob[ii].val); - if (i != 1 && glob_prnt.iprint > 2 && display) - fprintf(glob_prnt.io, - "\t\t\t\t\t %d \t %22.14e\n", indxob[ii], - ob[ii].val); - fii = ob[ii].val; - } - fmax1 = DMAX1(fmax1, fii); - if (nobL != nob) - fmax1 = DMAX1(fmax1, -fii); - if (!feasb && reform) - continue; - if (!glob_log.local) - { - if ((fii - *psf) > (*fMp + prod)) - { - fbind = TRUE; - shift(nob, ii, &iact[nn]); - if (nfsip && ii > nob - nfsip) - { - sip_viol->type = OBJECT; - sip_viol->index = ii; - } - else - { - sip_viol->type = NONE; - sip_viol->index = 0; - } - goto L1110; - } - if (nobL == nob || (-fii - *psf) <= (*fMp + prod)) - continue; - fbind = TRUE; - shift(nob, ii, &iact[nn]); - if (nfsip && ii > nob - nfsip) - { - sip_viol->type = OBJECT; - sip_viol->index = ii; - } - else - { - sip_viol->type = NONE; - sip_viol->index = 0; - } - goto L1110; - } - ltem1 = (fii - *psf) > (*fMp + prod); - ltem2 = (nobL != nob) && ((-fii - *psf) > (*fMp + prod)); - if (ltem1 || ltem2) - goto L1500; - } - fbind = FALSE; - fdone = eqdone = TRUE; - } - while (!cdone); - if (ostep == *steps) - mnm = ikeep + neq - neqn; - if (ostep != *steps) - mnm = ncnstr - nn; - for (i = 1; i <= mnm; i++) - { - ii = indxcn[i+nn]; - if (ikeep != nlin && ostep == *steps) - { - if (i <= ikeep) - ii = iskip[nlin+2-i]; - else - ii = indxcn[nn+i-ikeep+nlin]; - } - constr(nparam, ii, xnew + 1, &(cs[ii].val), cd); - } - *scvneq = 0.e0; - for (i = 1; i <= ncnstr; i++) - { - if (i > glob_info.nnineq && i <= (glob_info.nnineq + neqn)) - *scvneq = *scvneq - cs[i].val; - backup[i] = cs[i].val; - } - for (i = 1; i <= nob; i++) - backup[i+ncnstr] = ob[i].val; - if (!feasb && reform) - { - for (i = 1; i <= nparam; i++) - x[i] = xnew[i]; - nstop = 0; - goto L1500; - } - if (glob_log.local) - *ncg = ncnstr; - if (glob_log.local) - glob_log.update = TRUE; - *fM = fmax1; - *fMp = fmax1 - *psf; - *fmax = fmax1; - for (i = 1; i <= nn; i++) - iact[i] = indxcn[i]; - for (i = 1; i <= nob; i++) - iact[nn+i] = i; - goto L1500; - L1110: - cdone = fdone = eqdone = reform = FALSE; - L1120: - itry++; - if (glob_info.modec == 2) - fbind = FALSE; - if (*steps >= 1.e0) - for (i = 1; i <= nob + nineqn; i++) - istore[i] = 0; - *steps = *steps * 0.5e0; - if (*steps < glob_grd.epsmac) - break; - } - glob_prnt.info = 4; - nstop = 0; - L1500: - free_dm(adummy, 1); - if (*steps < 1.e0) - return; - for (i = 1; i <= nob + nineqn; i++) - istore[i] = 0; - return; -} -/******************************************************************/ -/* CFSQP : Update the Hessian matrix using BFGS formula with */ -/* Powell's modification. */ -/******************************************************************/ - - -#ifdef __STDC__ -static void -hessian(int nparam, int nob, int nfsip, int nobL, int nineqn, int neq, - int neqn, int nn, int ncsipn, int ncnstr, int nfs, int *nstart, - int feasb, double *xnew, struct _parameter *param, - struct _objective *ob, double fmax, double *fM, double *fMp, - double *psf, double *grdpsf, double *penp, struct _constraint *cs, - double *gm, int *indxob, int *indxcn, double *delta, double *eta, - double *gamma, double **hess, double *hd, double steps, int *nrst, - double *signeq, double *span, - void(*obj)(int, int, double *, double *, void *), - void(*constr)(int, int, double *, double *, void *), - void(*gradob)(int, int, double *, double *, - void(*)(int, int, double *, double *, void *), void *), - void(*gradcn)(int, int, double *, double *, - void(*)(int, int, double *, double *, void *), void *), - double **phess, double *psb, double *psmu, - struct _violation *sip_viol) -#else -static void -hessian(nparam, nob, nfsip, nobL, nineqn, neq, neqn, nn, ncsipn, ncnstr, - nfs, nstart, feasb, xnew, param, ob, fmax, fM, fMp, psf, grdpsf, penp, - cs, gm, indxob, indxcn, delta, eta, gamma, hess, hd, steps, nrst, signeq, - span, obj, constr, gradob, gradcn, phess, psb, psmu, sip_viol) -int nparam, nob, nobL, nineqn, neq, neqn, nn, nfsip, ncsipn, ncnstr, -nfs, *nstart, feasb, *nrst; -int *indxob, *indxcn; -double steps, *psf, fmax, *fM, *fMp; -double *xnew, *grdpsf, *penp, *gm, *delta, *eta, *gamma, -**hess, *hd, *signeq, *span, **phess, *psb, *psmu; -struct _constraint *cs; -struct _objective *ob; -struct _parameter *param; -struct _violation *sip_viol; -void(* obj)(), (* constr)(), (* gradob)(), (* gradcn)(); -#endif -{ - int i, j, k, ifail, np, mnm, done, display; - double dhd, gammd, etad, dummy, theta, signgj=1., psfnew, delta_s; - double *tempv; - - /* Check to see whether user-accessible stopping criterion - is satisfied. The check of gLgeps is made just after - computing d0 */ - - if (!glob_log.get_ne_mult) - { - if (feasb && nstop && !neqn) - if ((fabs(w[1] - fmax) <= objeps) || - (fabs(w[1] - fmax) <= objrep*fabs(w[1]))) - nstop = 0; - if (!nstop) - { - for (i = 1; i <= nparam; i++) - param->x[i] = xnew[i]; - x_is_new = TRUE; - return; - } - } - - delta_s = glob_grd.rteps; /* SIP */ - if (glob_prnt.iter % glob_prnt.iter_mod) - display = FALSE; - else - display = TRUE; - psfnew = 0.e0; - glob_prnt.ipd = 0; - done = FALSE; - dummy = 0.e0; - nullvc(nparam, delta); - nullvc(nparam, eta); - for (j = 1; j <= 2; j++) - { - nullvc(nparam, gamma); - if (nobL > 1) - { - for (i = 1; i <= nparam; i++) - { - hd[i] = 0.e0; - for (k = 1; k <= nob; k++) - hd[i] = hd[i] + ob[k].grad[i] * ob[k].mult; - } - } - if (feasb) - { - if (nineqn != 0) - { - for (i = 1; i <= nparam; i++) - { - gamma[i] = 0.e0; - for (k = 1; k <= nineqn; k++) - gamma[i] = gamma[i] + cs[k].grad[i] * cs[k].mult; - } - } - if (neqn != 0) - { - for (i = 1; i <= nparam; i++) - { - eta[i] = 0.e0; - for (k = 1; k <= neqn; k++) - eta[i] = eta[i] + cs[glob_info.nnineq+k].grad[i] * - cs[glob_info.nnineq+k].mult; - } - } - } - for (i = 1; i <= nparam; i++) - { - if (nobL > 1) - { - if (done) - psb[i] = hd[i] + param->mult[i] + gamma[i]; - gamma[i] = gamma[i] + hd[i] - grdpsf[i] + eta[i]; - } - else if (nobL == 1) - { - if (done) - psb[i] = ob[1].grad[i] + param->mult[i] + gamma[i]; - gamma[i] = gamma[i] + ob[1].grad[i] - grdpsf[i] + eta[i]; - } - else if (nobL == 0) - { - if (done) - psb[i] = param->mult[i] + gamma[i]; - gamma[i] = gamma[i] - grdpsf[i] + eta[i]; - } - if (!done) - delta[i] = gamma[i]; - } - if (!done && !glob_log.d0_is0) - { - if (nn != 0) - { - for (i = 1; i <= nn; i++) - { - if ((feasb) && (i > nineqn)) - signgj = signeq[i-nineqn]; - if ((!feasb) || (i <= nineqn)) - signgj = 1.e0; - if ((feasb) && (ncsipn) && (i > nineqn - ncsipn) && - (cs[indxcn[i]].mult == 0.e0)) - continue; - glob_grd.valnom = cs[indxcn[i]].val * signgj; - gradcn(nparam, indxcn[i], xnew + 1, cs[indxcn[i]].grad + 1, - constr, param->cd); - } - resign(nparam, neqn, psf, grdpsf, penp, cs, signeq, 11, 11); - } - for (i = 1; i <= nob; i++) - { - glob_grd.valnom = ob[i].val; - if ((i <= nob - nfsip) || (i > nob - nfsip && - ((ob[i].mult != 0.e0) || (ob[i].mult_L != 0.e0)))) - { - if (feasb) - gradob(nparam, i, xnew + 1, ob[i].grad + 1, obj, param->cd); - else - gradcn(nparam, indxob[i], xnew + 1, ob[i].grad + 1, - constr, param->cd); - } - } - done = TRUE; - } - if (glob_log.d0_is0) - done = TRUE; - } - if (!glob_log.d0_is0) - { - if (!(feasb && steps < delta_s && ((sip_viol->type == OBJECT && - !ob[sip_viol->index].act_sip) || (sip_viol->type == CONSTR && - !cs[sip_viol->index].act_sip)))) - { - if (*nrst < (5*nparam) || steps > 0.1e0) - { - (*nrst)++; - for (i = 1; i <= nparam; i++) - { - gamma[i] = gamma[i] - delta[i]; - delta[i] = xnew[i] - param->x[i]; - } - matrvc(nparam, nparam, hess, delta, hd); - dhd = scaprd(nparam, delta, hd); - if (sqrt(scaprd(nparam, delta, delta)) <= glob_grd.epsmac) - { - /* xnew too close to x!! */ - nstop = 0; - glob_prnt.info = 8; - return; - } - gammd = scaprd(nparam, delta, gamma); - if (gammd >= (0.2e0*dhd)) - theta = 1.e0; - else - theta = 0.8e0 * dhd / (dhd - gammd); - for (i = 1; i <= nparam; i++) - eta[i] = hd[i] * (1.e0 - theta) + theta * gamma[i]; - etad = theta * gammd + (1.e0 - theta) * dhd; - for (i = 1; i <= nparam; i++) - { - for (j = i; j <= nparam; j++) - { - hess[i][j] = hess[i][j] - hd[i] * hd[j] / dhd + - eta[i] * eta[j] / etad; - hess[j][i] = hess[i][j]; - } - } - } - else - { - *nrst = 0; - diagnl(nparam, 1.e0, hess); - } - } - for (i = 1; i <= nparam; i++) - param->x[i] = xnew[i]; - x_is_new = TRUE; - } - if (neqn != 0 && (feasb)) - { - i = glob_info.nnineq - nineqn; - if (i != 0) - { - for (j = 1; j <= nparam; j++) - { - gamma[j] = 0.e0; - for (k = 1; k <= i; k++) - gamma[j] = gamma[j] + cs[k+nineqn].grad[j] * - cs[nineqn+k].mult; - } - for (i = 1; i <= nparam; i++) - psb[i] = psb[i] + gamma[i]; - } - i = neq - neqn; - if (i != 0) - { - for (j = 1; j <= nparam; j++) - { - gamma[j] = 0.e0; - for (k = 1; k <= i; k++) - gamma[j] = gamma[j] + cs[k+neqn+glob_info.nnineq].grad[j] * - cs[glob_info.nnineq+neqn+k].mult; - } - for (i = 1; i <= nparam; i++) - psb[i] = psb[i] + gamma[i]; - } - /* Update penalty parameters for nonlinear equality constraints */ - estlam(nparam, neqn, &ifail, bgbnd, phess, delta, eta, - gamma, cs, psb, hd, xnew, psmu); - if (glob_log.get_ne_mult) - return; - for (i = 1; i <= neqn; i++) - { - if (ifail != 0 || glob_log.d0_is0) - penp[i] = 2.e0 * penp[i]; - else - { - etad = psmu[i] + penp[i]; - if (etad < 1.e0) - penp[i] = DMAX1((1.e0 - psmu[i]), (2.e0 * penp[i])); - } - if (penp[i] > bgbnd) - { - nstop = 0; - glob_prnt.info = 9; - return; - } - } - resign(nparam, neqn, psf, grdpsf, penp, cs, signeq, 20, 12); - *fMp = *fM - *psf; - } - if (nfs != 0) - { - (*nstart)++; - np = indexs(*nstart, nfs); - span[np] = fmax; - for (i = 1; i <= neqn; i++) - gm[(np-1)*neqn+i] = cs[glob_info.nnineq+i].val; - if (neqn != 0) - { - psfnew = 0.e0; - for (i = 1; i <= neqn; i++) - psfnew = psfnew + gm[i]*penp[i]; - } - *fM = span[1]; - *fMp = span[1] - psfnew; - mnm = DMIN1(*nstart, nfs); - for (i = 2; i <= mnm; i++) - { - if (neqn != 0) - { - psfnew = 0.e0; - for (j = 1; j <= neqn; j++) - psfnew = psfnew + gm[(i-1)*neqn +j]*penp[j]; - } - *fM = DMAX1(*fM, span[i]); - *fMp = DMAX1(*fMp, span[i] - psfnew); - } - } - if (glob_prnt.iprint < 3 || !display) - return; - for (i = 1; i <= nob; i++) - { - if (!feasb) - { - sbout2(glob_prnt.io, nparam, indxob[i], "gradg(j,", - ")", ob[i].grad); - continue; - } - if (nob > 1) - sbout2(glob_prnt.io, nparam, i, "gradf(j,", ")", - ob[i].grad); - if (nob == 1) - sbout1(glob_prnt.io, nparam, "gradf(j) ", - dummy, ob[1].grad, 2, 2); - } - if (ncnstr != 0) - { - for (i = 1; i <= ncnstr; i++) - { - tempv = cs[indxcn[i]].grad; - sbout2(glob_prnt.io, nparam, indxcn[i], "gradg(j,", ")", tempv); - } - if (neqn != 0) - { - sbout1(glob_prnt.io, nparam, "grdpsf(j) ", - dummy, grdpsf, 2, 2); - sbout1(glob_prnt.io, neqn, "P ", dummy, - penp, 2, 2); - sbout1(glob_prnt.io, neqn, "psmu ", dummy, - psmu, 2, 2); - } - } - sbout1(glob_prnt.io, nparam, "multipliers for x ", dummy, - param->mult, 2, 2); - if (ncnstr != 0) - { - fprintf(glob_prnt.io, "\t\t\t %s\t %22.14e\n", - " for g ", cs[1].mult); - for (j = 2; j <= ncnstr; j++) - fprintf(glob_prnt.io, " \t\t\t\t\t\t %22.14e\n", cs[j].mult); - } - if (nobL > 1) - { - fprintf(glob_prnt.io, "\t\t\t %s\t %22.14e\n", - " for f ", ob[1].mult); - for (j = 2; j <= nob; j++) - fprintf(glob_prnt.io, " \t\t\t\t\t\t %22.14e\n", ob[j].mult); - } - for (i = 1; i <= nparam; i++) - { - tempv = colvec(hess, i, nparam); - sbout2(glob_prnt.io, nparam, i, "hess (j,", ")", tempv); - free_dv(tempv); - } - return; -} -/**************************************************************/ -/* CFSQP : Output */ -/**************************************************************/ - - -#ifdef __STDC__ -static void -out(int miter, int nparam, int nob, int nobL, int nfsip, int ncn, - int nn, int nineqn, int ncnstr, int ncsipl, int ncsipn, - int *mesh_pts, double *x, struct _constraint *cs, - struct _objective *ob, double fM, double fmax, - double steps, double sktnom, double d0norm, int feasb) -#else -static void -out(miter, nparam, nob, nobL, nfsip, ncn, nn, nineqn, ncnstr, ncsipl, ncsipn, - mesh_pts, x, cs, ob, fM, fmax, steps, sktnom, d0norm, feasb) -int miter, nparam, nob, nobL, nfsip, ncn, nn, ncnstr, feasb, -ncsipl, ncsipn, nineqn, *mesh_pts; -double fM, fmax, steps, sktnom, d0norm; -double *x; -struct _constraint *cs; -struct _objective *ob; -#endif -{ - int i, j, index, display, offset; - double SNECV, dummy, *adummy, gmax; - - adummy = make_dv(1); - adummy[1] = 0.e0; - dummy = 0.e0; - if (glob_prnt.iter >= miter && nstop != 0) - { - glob_prnt.info = 3; - nstop = 0; - if (glob_prnt.iprint == 0) - goto L9000; - } - if (glob_prnt.iprint == 0 && glob_prnt.iter < miter) - { - glob_prnt.iter++; - goto L9000; - } - if ((glob_prnt.info > 0 && glob_prnt.info < 3) || glob_prnt.info == 7) - goto L120; - if (glob_prnt.iprint == 1 && nstop != 0) - { - glob_prnt.iter++; - if (glob_prnt.initvl == 0) - goto L9000; - if (feasb && nob > 0) - { - fprintf(glob_prnt.io, " objectives\n"); - for (i = 1; i <= nob - nfsip; i++) - { - if (nob == nobL) - fprintf(glob_prnt.io, " \t\t\t %22.14e\n", ob[i].val); - else - fprintf(glob_prnt.io, " \t\t\t %22.14e\n", fabs(ob[i].val)); - } - if (nfsip) - { - offset = nob - nfsip; - for (i = 1; i <= glob_info.nfsip; i++) - { - if (nob == nobL) - gmax = ob[++offset].val; - else - gmax = fabs(ob[++offset].val); - for (j = 2; j <= mesh_pts[i]; j++) - { - offset++; - if (nob == nobL && ob[offset].val > gmax) - gmax = ob[offset].val; - else if (nob != nobL && fabs(ob[offset].val) > gmax) - gmax = fabs(ob[offset].val); - } - fprintf(glob_prnt.io, " \t\t\t %22.14e\n", gmax); - } - } - } - if (glob_info.mode == 1 && glob_prnt.iter > 1 && feasb) - sbout1(glob_prnt.io, 0, "objective max4 ", fM, adummy, 1, 1); - if (nob > 1) - sbout1(glob_prnt.io, 0, "objmax ", fmax, adummy, 1, 1); - if (ncnstr == 0) - fprintf(glob_prnt.io, "\n"); - else - { - fprintf(glob_prnt.io, " constraints\n"); - for (i = 1; i <= nineqn - ncsipn; i++) - fprintf(glob_prnt.io, " \t\t\t %22.14e\n", cs[i].val); - if (ncsipn) - { - offset = nineqn - ncsipn; - for (i = 1; i <= glob_info.ncsipn; i++) - { - gmax = cs[++offset].val; - for (j = 2; j <= mesh_pts[glob_info.nfsip+i]; j++) - { - offset++; - if (cs[offset].val > gmax) - gmax = cs[offset].val; - } - fprintf(glob_prnt.io, " \t\t\t %22.14e\n", gmax); - } - } - for (i = nineqn + 1; i <= glob_info.nnineq - ncsipl; i++) - fprintf(glob_prnt.io, " \t\t\t %22.14e\n", cs[i].val); - if (ncsipl) - { - offset = glob_info.nnineq - ncsipl; - for (i = 1; i <= glob_info.ncsipl; i++) - { - gmax = cs[++offset].val; - if (feasb) - index = glob_info.nfsip + glob_info.ncsipn + i; - else - index = glob_info.ncsipn + i; - for (j = 2; j <= mesh_pts[index]; j++) - { - offset++; - if (cs[offset].val > gmax) - gmax = cs[offset].val; - } - fprintf(glob_prnt.io, " \t\t\t %22.14e\n", gmax); - } - } - for (i = glob_info.nnineq + 1; i <= ncnstr; i++) - fprintf(glob_prnt.io, " \t\t\t %22.14e\n", cs[i].val); - } - if (ncnstr != 0) - fprintf(glob_prnt.io, "\n"); - goto L9000; - } - if (glob_prnt.iprint == 1 && nstop == 0) - fprintf(glob_prnt.io, " iteration %26d\n", - glob_prnt.iter); - if (glob_prnt.iprint <= 2 && nstop == 0) - fprintf(glob_prnt.io, " inform %26d\n", - glob_prnt.info); - if (glob_prnt.iprint == 1 && nstop == 0 && (ncsipl + ncsipn) != 0) - fprintf(glob_prnt.io, " |Xi_k| %26d\n", - glob_info.tot_actg_sip); - if (glob_prnt.iprint == 1 && nstop == 0 && nfsip != 0) - fprintf(glob_prnt.io, " |Omega_k| %26d\n", - glob_info.tot_actf_sip); - glob_prnt.iter++; - if (!((glob_prnt.iter) % glob_prnt.iter_mod)) - display = TRUE; - else - display = (nstop == 0); - if (glob_prnt.iter_mod != 1 && display) - fprintf(glob_prnt.io, "\n iteration %26d\n", - glob_prnt.iter - 1); - if (glob_prnt.initvl == 0 && display) - sbout1(glob_prnt.io, nparam, "x ", dummy, x, 2, 1); - if (display) - { - if (nob > 0) - { - fprintf(glob_prnt.io, " objectives\n"); - for (i = 1; i <= nob - nfsip; i++) - { - if (nob == nobL) - fprintf(glob_prnt.io, " \t\t\t %22.14e\n", ob[i].val); - else - fprintf(glob_prnt.io, " \t\t\t %22.14e\n", - fabs(ob[i].val)); - } - } - if (nfsip) - { - offset = nob - nfsip; - if (feasb) - index = glob_info.nfsip; - else - index = glob_info.ncsipn; - for (i = 1; i <= index; i++) - { - if (nob == nobL) - gmax = ob[++offset].val; - else - gmax = fabs(ob[++offset].val); - for (j = 2; j <= mesh_pts[i]; j++) - { - offset++; - if (nob == nobL && ob[offset].val > gmax) - gmax = ob[offset].val; - else if (nob != nobL && fabs(ob[offset].val) > gmax) - gmax = fabs(ob[offset].val); - } - fprintf(glob_prnt.io, " \t\t\t %22.14e\n", gmax); - } - } - } - if (glob_info.mode == 1 && glob_prnt.iter > 1 && display) - sbout1(glob_prnt.io, 0, "objective max4 ", fM, adummy, 1, 1); - if (nob > 1 && display) - sbout1(glob_prnt.io, 0, "objmax ", fmax, adummy, 1, 1); - if (ncnstr != 0 && display) - { - fprintf(glob_prnt.io, " constraints\n"); - for (i = 1; i <= nineqn - ncsipn; i++) - fprintf(glob_prnt.io, " \t\t\t %22.14e\n", cs[i].val); - if (ncsipn) - { - offset = nineqn - ncsipn; - for (i = 1; i <= glob_info.ncsipn; i++) - { - gmax = cs[++offset].val; - for (j = 2; j <= mesh_pts[glob_info.nfsip+i]; j++) - { - offset++; - if (cs[offset].val > gmax) - gmax = cs[offset].val; - } - fprintf(glob_prnt.io, " \t\t\t %22.14e\n", gmax); - } - } - for (i = nineqn + 1; i <= glob_info.nnineq - ncsipl; i++) - fprintf(glob_prnt.io, " \t\t\t %22.14e\n", cs[i].val); - if (ncsipl) - { - offset = glob_info.nnineq - ncsipl; - for (i = 1; i <= glob_info.ncsipl; i++) - { - gmax = cs[++offset].val; - if (feasb) - index = glob_info.nfsip + glob_info.ncsipn + i; - else - index = glob_info.ncsipn + i; - for (j = 2; j <= mesh_pts[index]; - j++) - { - offset++; - if (cs[offset].val > gmax) - gmax = cs[offset].val; - } - fprintf(glob_prnt.io, " \t\t\t %22.14e\n", gmax); - } - } - for (i = glob_info.nnineq + 1; i <= ncnstr; i++) - fprintf(glob_prnt.io, " \t\t\t %22.14e\n", cs[i].val); - if (feasb) - { - SNECV = 0.e0; - for (i = glob_info.nnineq + 1; i <= glob_info.nnineq + nn - nineqn; i++) - SNECV = SNECV + fabs(cs[i].val); - if (glob_prnt.initvl == 0 && (nn - nineqn) != 0) - sbout1(glob_prnt.io, 0, "SNECV ", - SNECV, adummy, 1, 1); - } - } - if (glob_prnt.iter <= 1 && display) - { - fprintf(glob_prnt.io, " \n"); - fprintf(glob_prnt.io, " iteration %26d\n", - glob_prnt.iter); - goto L9000; - } - if (glob_prnt.iprint >= 2 && glob_prnt.initvl == 0 && display) - sbout1(glob_prnt.io, 0, "step ", steps, adummy, 1, 1); - if (glob_prnt.initvl == 0 && display && - (nstop == 0 || glob_prnt.info != 0 || glob_prnt.iprint == 2)) - { - sbout1(glob_prnt.io, 0, "d0norm ", d0norm, adummy, 1, 1); - sbout1(glob_prnt.io, 0, "ktnorm ", sktnom, adummy, 1, 1); - } - if (glob_prnt.initvl == 0 && feasb && display) - fprintf(glob_prnt.io, " ncallf %26d\n", - glob_info.ncallf); - if (glob_prnt.initvl == 0 && (nn != 0 || !feasb) && display) - fprintf(glob_prnt.io, " ncallg %26d\n", - glob_info.ncallg); - if (glob_prnt.iprint >= 3 && glob_prnt.iter_mod != 1 && nstop != 0 - && !(glob_prnt.iter % glob_prnt.iter_mod)) - fprintf(glob_prnt.io, - "\n The following was calculated during iteration %5d:\n", - glob_prnt.iter); - if (nstop != 0 && (glob_prnt.iter_mod == 1)) - fprintf(glob_prnt.io, "\n iteration %26d\n", - glob_prnt.iter); -L120: - if (nstop != 0 || glob_prnt.iprint == 0) - goto L9000; - fprintf(glob_prnt.io, "\n"); - if (glob_prnt.iprint >= 3) - fprintf(glob_prnt.io, " inform %26d\n", - glob_prnt.info); - if (glob_prnt.info == 0) - fprintf(glob_prnt.io, - "\nNormal termination: You have obtained a solution !!\n"); - if (glob_prnt.info == 0 && sktnom > 0.1e0) - fprintf(glob_prnt.io, - "Warning: Norm of Kuhn-Tucker vector is large !!\n"); - if (glob_prnt.info == 3) - { - fprintf(glob_prnt.io, - "\nWarning: Maximum iterations have been reached before\n"); - fprintf(glob_prnt.io, "obtaining a solution !!\n\n"); - } - if (glob_prnt.info == 4) - { - fprintf(glob_prnt.io, - "\nError : Step size has been smaller than the computed\n"); - fprintf(glob_prnt.io, "machine precision !!\n\n"); - } - if (glob_prnt.info == 5) - fprintf(glob_prnt.io, - "\nError: Failure in constructing d0 !!\n\n"); - if (glob_prnt.info == 6) - fprintf(glob_prnt.io, - "\nError: Failure in constructing d1 !!\n\n"); - if (glob_prnt.info == 8) - { - fprintf(glob_prnt.io, - "\nError: The new iterate is numerically equivalent to the\n"); - fprintf(glob_prnt.io, - "previous iterate, though the stopping criterion is not \n"); - fprintf(glob_prnt.io, "satisfied\n"); - } - if (glob_prnt.info == 9) - { - fprintf(glob_prnt.io, - "\nError: Could not satisfy nonlinear equality constraints -\n"); - fprintf(glob_prnt.io, " Penalty parameter too large\n"); - } - fprintf(glob_prnt.io, "\n"); -L9000: - free_dv(adummy); - glob_prnt.initvl = 0; - return; -} -/*************************************************************/ -/* CFSQP : Computation of gradients of objective */ -/* functions by forward finite differences */ -/*************************************************************/ - - -#ifdef __STDC__ -void grobfd(int nparam, int j, double *x, double *gradf, - void(*obj)(int, int, double *, double *, void *), void *cd) -#else -void grobfd(nparam, j, x, gradf, obj, cd) -int nparam, j; -double *x, *gradf; -void(*obj)(); -void *cd; -#endif -{ - int i; - double xi, delta; - - for (i = 0; i <= nparam - 1; i++) - { - xi = x[i]; - delta = DMAX1(glob_grd.udelta, - glob_grd.rteps * DMAX1(1.e0, fabs(xi))); - if (xi < 0.e0) - delta = -delta; - if (!(glob_prnt.ipd == 1 || j != 1 || glob_prnt.iprint < 3)) - { - /* formats are not set yet... */ - if (i == 0) - fprintf(glob_prnt.io, "\tdelta(i)\t %22.14f\n", delta); - if (i != 0) - fprintf(glob_prnt.io, "\t\t\t %22.14f\n", delta); - } - x[i] = xi + delta; - x_is_new = TRUE; - (*obj)(nparam, j, x, &gradf[i], cd); - gradf[i] = (gradf[i] - glob_grd.valnom) / delta; - x[i] = xi; - x_is_new = TRUE; - } - return; -} - -/***********************************************************/ -/* CFSQP : Computation of gradients of constraint */ -/* functions by forward finite differences */ -/***********************************************************/ - -#ifdef __STDC__ -void grcnfd(int nparam, int j, double *x, double *gradg, - void(*constr)(int, int, double *, double *, void *), void *cd) -#else -void grcnfd(nparam, j, x, gradg, constr, cd) -int nparam, j; -double *x, *gradg; -void(*constr)(); -void *cd; -#endif -{ - int i; - double xi, delta; - - for (i = 0; i <= nparam - 1; i++) - { - xi = x[i]; - delta = DMAX1(glob_grd.udelta, - glob_grd.rteps * DMAX1(1.e0, fabs(xi))); - if (xi < 0.e0) - delta = -delta; - if (!(j != 1 || glob_prnt.iprint < 3)) - { - /* formats are not set yet... */ - if (i == 0) - fprintf(glob_prnt.io, "\tdelta(i)\t %22.14f\n", delta); - if (i != 0) - fprintf(glob_prnt.io, "\t\t\t %22.14f\n", delta); - glob_prnt.ipd = 1; - } - x[i] = xi + delta; - x_is_new = TRUE; - (*constr)(nparam, j, x, &gradg[i], cd); - gradg[i] = (gradg[i] - glob_grd.valnom) / delta; - x[i] = xi; - x_is_new = TRUE; - } - return; -} -/************************************************************/ -/* Utility functions used by CFSQP - */ -/* Available functions: */ -/* diagnl error estlam */ -/* colvec scaprd small */ -/* fool matrvc matrcp */ -/* nullvc resign sbout1 */ -/* sbout2 shift slope */ -/* fuscmp indexs element */ -/************************************************************/ - - -#ifdef __STDC__ -static void fool(double, double, double *); -#else -static void fool(); -#endif - -/************************************************************/ -/* Set a=diag*I, a diagonal matrix */ -/************************************************************/ - -#ifdef __STDC__ -static void diagnl(int nrowa, double diag, double **a) -#else -static void diagnl(nrowa, diag, a) -int nrowa; -double **a, diag; -#endif -{ - int i, j; - - for (i = 1; i <= nrowa; i++) - { - for (j = i; j <= nrowa; j++) - { - a[i][j] = 0.e0; - a[j][i] = 0.e0; - } - a[i][i] = diag; - } - return; -} - -/***********************************************************/ -/* Display error messages */ -/***********************************************************/ - -#ifdef __STDC__ -static void error(const char string[], int *inform) -#else -static void error(string, inform) -const char string[]; -int *inform; -#endif -{ - if (glob_prnt.iprint > 0) - fprintf(stderr, "%s\n", string); - *inform = 7; - return; -} - -/***********************************************************/ -/* Compute an estimate of multipliers for updating */ -/* penalty parameter (nonlinear equality constraints) */ -/***********************************************************/ - -#ifdef __STDC__ -static void -estlam(int nparam, int neqn, int *ifail, double bigbnd, double **hess, - double *cvec, double *a, double *b, struct _constraint *cs, - double *psb, double *bl, double *bu, double *x) -#else -static void -estlam(nparam, neqn, ifail, bigbnd, hess, cvec, a, b, cs, psb, bl, bu, x) -int nparam, neqn, *ifail; -double bigbnd, **hess, *cvec, *a, *b, *psb, *bl, *bu, *x; -struct _constraint *cs; -#endif -{ - int i, j, zero, one, lwar2, mnn, iout; - double *ctemp; - - for (i = 1; i <= neqn; i++) - { - bl[i] = (-bigbnd); - bu[i] = bigbnd; - cvec[i] = scaprd(nparam, cs[i+glob_info.nnineq].grad, psb); - x[i] = 0.e0; - for (j = i; j <= neqn; j++) - { - hess[i][j] = scaprd(nparam, cs[i+glob_info.nnineq].grad, - cs[j+glob_info.nnineq].grad); - hess[j][i] = hess[i][j]; - } - } - zero = 0; - one = 1; - iw[1] = 1; - mnn = 2 * neqn; - ctemp = convert(hess, neqn, neqn); - lwar2 = lenw - 1; - iout = 6; - - ql0001_(&zero, &zero, &one, &neqn, &neqn, &mnn, (ctemp + 1), (cvec + 1), - (a + 1), (b + 1), (bl + 1), (bu + 1), (x + 1), (w + 1), &iout, ifail, - &zero, (w + 3), &lwar2, (iw + 1), &leniw, &glob_grd.epsmac); - - free_dv(ctemp); - return; -} - -/**************************************************************/ -/* Extract a column vector from a matrix */ -/**************************************************************/ - -#ifdef __STDC__ -static double *colvec(double **a, int col, int nrows) -#else -static double *colvec(a, col, nrows) -double **a; -int col, nrows; -#endif -{ - double *temp; - int i; - - temp = make_dv(nrows); - for (i = 1;i <= nrows;i++) - temp[i] = a[i][col]; - return temp; -} - -/************************************************************/ -/* Compute the scalar product z=x'y */ -/************************************************************/ - -#ifdef __STDC__ -static double scaprd(int n, double *x, double *y) -#else -static double scaprd(n, x, y) -double *x, *y; -int n; -#endif -{ - int i; - double z; - - z = 0.e0; - for (i = 1;i <= n;i++) - z = z + x[i] * y[i]; - return z; -} - -/***********************************************************/ -/* Used by smallNumber() */ -/***********************************************************/ - -#ifdef __STDC__ -static void fool(double x, double y, double *z) -#else -static void fool(x, y, z) -double x, y, *z; -#endif -{ - *z = x * y + y; - return; -} - -/**********************************************************/ -/* Computes the machine precision */ -/**********************************************************/ - -static double smallNumber() -{ - double one, two, z, tsmall; - - one = 1.e0; - two = 2.e0; - tsmall = one; - do - { - tsmall = tsmall / two; - fool(tsmall, one, &z); - } - while (z > 1.e0); - return tsmall*two*two; -} - -/**********************************************************/ -/* Compares value with threshold to see if exceeds */ -/**********************************************************/ - -#ifdef __STDC__ -static int fuscmp(double val, double thrshd) -#else -static int fuscmp(val, thrshd) -double val, thrshd; -#endif -{ - int temp; - - if (fabs(val) <= thrshd) - temp = FALSE; - else - temp = TRUE; - return temp; -} - -/**********************************************************/ -/* Find the residue of i with respect to nfs */ -/**********************************************************/ - -#ifdef __STDC__ -static int indexs(int i, int nfs) -#else -static int indexs(i, nfs) -int i, nfs; -#endif -{ - int mm = i; - - while (mm > nfs) - mm -= nfs; - return mm; -} - -/*********************************************************/ -/* Copies matrix a to matrix b */ -/*********************************************************/ - -#ifdef __STDC__ -static void matrcp(int ndima, double **a, int ndimb, double **b) -#else -static void matrcp(ndima, a, ndimb, b) -double **a, **b; -int ndima, ndimb; -#endif -{ - int i, j; - - for (i = 1; i <= ndima; i++) - for (j = 1; j <= ndima; j++) - b[i][j] = a[i][j]; - if (ndimb <= ndima) - return; - for (i = 1; i <= ndimb; i++) - { - b[ndimb][i] = 0.e0; - b[i][ndimb] = 0.e0; - } - return; -} - -/*******************************************************/ -/* Computes y=ax */ -/*******************************************************/ - -#ifdef __STDC__ -static void matrvc(int la, int na, double **a, double *x, double *y) -#else -static void matrvc(la, na, a, x, y) -double **a, *x, *y; -int la, na; -#endif -{ - int i, j; - double yi; - - for (i = 1; i <= la; i++) - { - yi = 0.e0; - for (j = 1; j <= na; j++) - yi = yi + a[i][j] * x[j]; - y[i] = yi; - } - return; -} - -/******************************************************/ -/* Set x=0 */ -/******************************************************/ - -#ifdef __STDC__ -static void nullvc(int nparam, double *x) -#else -static void nullvc(nparam, x) -int nparam; -double *x; -#endif -{ - int i; - - for (i = 1; i <= nparam; i++) - x[i] = 0.e0; - return; -} - -/*********************************************************/ -/* job1=10: g*signeq, job1=11: gradg*signeq, */ -/* job1=12: job1=10&11 */ -/* job1=20: do not change sign */ -/* job2=10: psf, job2=11: grdpsf, */ -/* job2=12: job2=10&11 */ -/* job2=20: do not change sign */ -/*********************************************************/ - -#ifdef __STDC__ -static void -resign(int n, int neqn, double *psf, double *grdpsf, double *penp, - struct _constraint *cs, double *signeq, int job1, int job2) -#else -static void -resign(n, neqn, psf, grdpsf, penp, cs, signeq, job1, job2) -int job1, job2, n, neqn; -double *psf, *grdpsf, *penp, *signeq; -struct _constraint *cs; -#endif -{ - int i, j, nineq; - - nineq = glob_info.nnineq; - if (job2 == 10 || job2 == 12) - *psf = 0.e0; - for (i = 1; i <= neqn; i++) - { - if (job1 == 10 || job1 == 12) - cs[i+nineq].val = - signeq[i] * cs[i+nineq].val; - if (job2 == 10 || job2 == 12) - *psf = *psf + cs[i+nineq].val * penp[i]; - if (job1 == 10 || job1 == 20) - continue; - for (j = 1; j <= n; j++) - cs[i+nineq].grad[j] = cs[i+nineq].grad[j] * signeq[i]; - } - if (job2 == 10 || job2 == 20) - return; - nullvc(n, grdpsf); - for (i = 1; i <= n; i++) - for (j = 1; j <= neqn; j++) - grdpsf[i] = grdpsf[i] + cs[j+nineq].grad[i] * penp[j]; - return; -} - -/**********************************************************/ -/* Write output to file */ -/**********************************************************/ - -#ifdef __STDC__ -static void -sbout1(FILE *io, int n, const char *s1, double z, double *z1, int job, int level) -#else -static void sbout1(io, n, s1, z, z1, job, level) -FILE *io; -int n, job, level; -double z, *z1; -const char *s1; -#endif -{ - int j; - - if (job != 2) - { - if (level == 1) - fprintf(io, " %s\t %22.14e\n", s1, z); - if (level == 2) - fprintf(io, "\t\t\t %s\t %22.14e\n", s1, z); - return; - } - if (n == 0) - return; - if (level == 1) - fprintf(io, " %s\t %22.14e\n", s1, z1[1]); - if (level == 2) - fprintf(io, "\t\t\t %s\t %22.14e\n", s1, z1[1]); - for (j = 2; j <= n; j++) - { - if (level == 1) - fprintf(io, " \t\t\t %22.14e\n", z1[j]); - if (level == 2) - fprintf(io, " \t\t\t\t\t\t %22.14e\n", z1[j]); - } - return; -} - -/*********************************************************/ -/* Write output to file */ -/*********************************************************/ - -#ifdef __STDC__ -static void -sbout2(FILE *io, int n, int i, const char *s1, const char *s2, double *z) -#else -static void sbout2(io, n, i, s1, s2, z) -FILE *io; -int n, i; -double *z; -const char *s1, *s2; -#endif -{ - int j; - - fprintf(io, "\t\t\t %8s %5d %1s\t %22.14e\n", s1, i, s2, z[1]); - for (j = 2; j <= n; j++) - fprintf(io, "\t\t\t\t\t\t %22.14e\n", z[j]); - return; -} - -/*********************************************************/ -/* Extract ii from iact and push in front */ -/*********************************************************/ - -#ifdef __STDC__ -static void shift(int n, int ii, int *iact) -#else -static void shift(n, ii, iact) -int n, ii, *iact; -#endif -{ - int j, k; - - if (ii == iact[1]) - return; - for (j = 1; j <= n; j++) - { - if (ii != iact[j]) - continue; - for (k = j; k >= 2; k--) - iact[k] = iact[k-1]; - break; - } - if (n != 0) - iact[1] = ii; - return; -} - -/****************************************************************/ -/* job=0 : Compute the generalized gradient of the minimax */ -/* job=1 : Compute rhog in mode = 1 */ -/****************************************************************/ - -#ifdef __STDC__ -static double -slope(int nob, int nobL, int neqn, int nparam, int feasb, - struct _objective *ob, double *grdpsf, double *x, double *y, - double fmax, double theta, int job, double *prev, int old) -#else -static double -slope(nob, nobL, neqn, nparam, feasb, ob, grdpsf, x, y, fmax, theta, job, - prev, old) -int nob, nobL, neqn, nparam, job, feasb, old; -double fmax, theta; -double *grdpsf, *x, *y, * prev; -struct _objective *ob; -#endif -{ - int i; - double slope1, rhs, rhog, grdftx, grdfty, diff, grpstx, grpsty; - double tslope; - - tslope = -bgbnd; - if (feasb && nob == 0) - tslope = 0.e0; - if (neqn == 0 || !feasb) - { - grpstx = 0.e0; - grpsty = 0.e0; - } - else - { - grpstx = scaprd(nparam, grdpsf, x); - grpsty = scaprd(nparam, grdpsf, y); - } - for (i = 1; i <= nob; i++) - { - if (old) - slope1 = prev[i] + scaprd(nparam, ob[i].grad, x); - else - slope1 = ob[i].val + scaprd(nparam, ob[i].grad, x); - tslope = DMAX1(tslope, slope1); - if (nobL != nob) - tslope = DMAX1(tslope, -slope1); - } - tslope = tslope - fmax - grpstx; - if (job == 0) - return tslope; - rhs = theta * tslope + fmax; - rhog = 1.e0; - for (i = 1; i <= nob; i++) - { - grdftx = scaprd(nparam, ob[i].grad, x) - grpstx; - grdfty = scaprd(nparam, ob[i].grad, y) - grpsty; - diff = grdfty - grdftx; - if (diff <= 0.e0) - continue; - rhog = DMIN1(rhog, (rhs - ob[i].val - grdftx) / diff); - if (nobL != nob) - rhog = DMIN1(rhog, -(rhs + ob[i].val + grdftx) / diff); - } - tslope = rhog; - return tslope; -} - -/************************************************************/ -/* Determine whether index is in set */ -/************************************************************/ - -#ifdef __STDC__ -static int element(int *set, int length, int index) -#else -static int element(set, length, index) -int *set; -int length, index; -#endif -{ - int i, temp; - - temp = 0; - for (i = 1; i <= length; i++) - { - if (set[i] == 0) - break; - if (set[i] == index) - { - temp = 1; - return temp; - } - } - return temp; -} -/*************************************************************/ -/* Memory allocation utilities for CFSQP */ -/* */ -/* All vectors and matrices are intended to */ -/* be subscripted from 1 to n, NOT 0 to n-1. */ -/* The addreses returned assume this convention. */ -/*************************************************************/ - - -/*************************************************************/ -/* Create double precision vector */ -/*************************************************************/ - -#ifdef __STDC__ -static double * -make_dv(int len) -#else -static double * -make_dv(len) -int len; -#endif -{ - double *v; - - if (!len) - len = 1; - v = (double *)calloc(len, sizeof(double)); - if (!v) - { - fprintf(stderr, "Run-time error in make_dv"); - exit(1); - } - return --v; -} - -/*************************************************************/ -/* Create integer vector */ -/*************************************************************/ - -#ifdef __STDC__ -static int * -make_iv(int len) -#else -static int * -make_iv(len) -int len; -#endif -{ - int *v; - - if (!len) - len = 1; - v = (int *)calloc(len, sizeof(int)); - if (!v) - { - fprintf(stderr, "Run-time error in make_iv"); - exit(1); - } - return --v; -} - -/*************************************************************/ -/* Create a double precision matrix */ -/*************************************************************/ - -#ifdef __STDC__ -static double ** -make_dm(int rows, int cols) -#else -static double ** -make_dm(rows, cols) -int rows, cols; -#endif -{ - double **temp; - int i; - - if (rows == 0) - rows = 1; - if (cols == 0) - cols = 1; - temp = (double **)calloc(rows, sizeof(double *)); - if (!temp) - { - fprintf(stderr, "Run-time error in make_dm"); - exit(1); - } - temp--; - for (i = 1; i <= rows; i++) - { - temp[i] = (double *)calloc(cols, sizeof(double)); - if (!temp[i]) - { - fprintf(stderr, "Run-time error in make_dm"); - exit(1); - } - temp[i]--; - } - return temp; -} - -/*************************************************************/ -/* Free a double precision vector */ -/*************************************************************/ - -#ifdef __STDC__ -static void -free_dv(double *v) -#else -static void -free_dv(v) -double *v; -#endif -{ - free((char *)(v + 1)); -} - -/*************************************************************/ -/* Free an integer vector */ -/*************************************************************/ - -#ifdef __STDC__ -static void -free_iv(int *v) -#else -static void -free_iv(v) -int *v; -#endif -{ - free((char *)(v + 1)); -} - -/*************************************************************/ -/* Free a double precision matrix */ -/*************************************************************/ - -#ifdef __STDC__ -static void -free_dm(double **m, int rows) -#else -static void -free_dm(m, rows) -double **m; -int rows; -#endif -{ - int i; - - if (!rows) - rows = 1; - for (i = 1; i <= rows; i++) - free((char *)(m[i] + 1)); - free((char *)(m + 1)); -} - -/*************************************************************/ -/* Converts matrix a into a form that can easily be */ -/* passed to a FORTRAN subroutine. */ -/*************************************************************/ - -#ifdef __STDC__ -static double * -convert(double **a, int m, int n) -#else -static double * -convert(a, m, n) -double **a; -int m, n; -#endif -{ - double *temp; - int i, j; - - temp = make_dv(m * n); - - for (i = 1; i <= n; i++) /* loop through columns */ - for (j = 1; j <= m; j++) /* loop through row */ - temp[(m*(i-1)+j)] = a[j][i]; - - return temp; -} - - -// Wavelets ---------------------------------------------------------------- - -void wtn(double a[], unsigned long nn[], int ndim, int isign, - void(*wtstep)(double [], unsigned long, int)) -{ - unsigned long i1, i2, i3, k, n, nnew, nprev = 1, nt, ntot = 1; - int idim; - - for (idim = 1;idim <= ndim;idim++) - ntot *= nn[idim]; - std::vector buffer(ntot); - auto *wksp= buffer.data()-1; - for (idim = 1;idim <= ndim;idim++) - { - n = nn[idim]; - nnew = n * nprev; - if (n > 4) - { - for (i2 = 0;i2 < ntot;i2 += nnew) - { - for (i1 = 1;i1 <= nprev;i1++) - { - for (i3 = i1 + i2, k = 1;k <= n;++k, i3 += nprev) - wksp[k] = a[i3]; - if (isign >= 0) - { - for (nt = n;nt >= 4;nt >>= 1) - (*wtstep)(wksp, nt, isign); - } - else - { - for (nt = 4;nt <= n;nt <<= 1) - (*wtstep)(wksp, nt, isign); - } - - for (i3 = i1 + i2, k = 1;k <= n;++k, i3 += nprev) - a[i3] = wksp[k]; - } - } - } - nprev = nnew; - } -} - -typedef struct -{ - unsigned int ncof, ioff, joff; - double *cc, *cr; -} -wavefilt; - -wavefilt wfilt; - -void pwtset(int n) -{ - int k; - float sig = -1.0; - static double c2[3] = - { - 0.0, 0.707106781186547, 0.707106781186547 - }; - static double c4[5] = - { - 0.0, 0.4829629131445341, 0.8365163037378079, - 0.2241438680420134, -0.1294095225512604 - }; - static double c12[13] = - { - 0.0, 0.111540743350, 0.494623890398, 0.751133908021, - 0.315250351709, -0.226264693965, -0.129766867567, - 0.097501605587, 0.027522865530, -0.031582039318, - 0.000553842201, 0.004777257511, -0.001077301085 - }; - static double c20[21] = - { - 0.0, 0.026670057901, 0.188176800078, 0.527201188932, - 0.688459039454, 0.281172343661, -0.249846424327, - -0.195946274377, 0.127369340336, 0.093057364604, - -0.071394147166, -0.029457536822, 0.033212674059, - 0.003606553567, -0.010733175483, 0.001395351747, - 0.001992405295, -0.000685856695, -0.000116466855, - 0.000093588670, -0.000013264203 - }; - static double c2r[2], c4r[5], c12r[13], c20r[21]; - - wfilt.ncof = n; - if (n == 2) - { - wfilt.cc = c2; - wfilt.cr = c2r; - } - else if (n == 4) - { - wfilt.cc = c4; - wfilt.cr = c4r; - } - else if (n == 12) - { - wfilt.cc = c12; - wfilt.cr = c12r; - } - else if (n == 20) - { - wfilt.cc = c20; - wfilt.cr = c20r; - } - else - nrerror("unimplemented value n in pwtset"); - for (k = 1;k <= n;k++) - { - wfilt.cr[wfilt.ncof+1-k] = sig * wfilt.cc[k]; - sig = -sig; - } - wfilt.ioff = wfilt.joff = -(n >> 1); -} - -void pwt(double a[], unsigned long n, int isign) -{ - double ai, ai1; - unsigned long i, ii, jf, jr, k, n1, ni, nj, nh, nmod; - - if (n < 4) - return; - std::vector buffer(n, 0.0); - auto *wksp= buffer.data()-1; - nmod = wfilt.ncof * n; - n1 = n - 1; - nh = n >> 1; - if (isign >= 0) - { - for (ii = 1, i = 1;i <= n;i += 2, ii++) - { - ni = i + nmod + wfilt.ioff; - nj = i + nmod + wfilt.joff; - double &aux1=wksp[ii]; - double &aux2=wksp[ii+nh]; - unsigned long kmax=4*(wfilt.ncof/4); - // Loop unrolling (every 4 coefficients) - for (k = 1;k <= kmax;k+=4) - { - unsigned long k_1=k+1; - unsigned long k_2=k+2; - unsigned long k_3=k+3; - jf = n1 & (ni + k); - jr = n1 & (nj + k); - aux1 += wfilt.cc[k] * a[jf+1]; - aux2 += wfilt.cr[k] * a[jr+1]; - unsigned long jf_1 = n1 & (ni + k_1); - unsigned long jr_1 = n1 & (nj + k_1); - aux1 += wfilt.cc[k_1] * a[jf_1+1]; - aux2 += wfilt.cr[k_1] * a[jr_1+1]; - unsigned long jf_2 = n1 & (ni + k_2); - unsigned long jr_2 = n1 & (nj + k_2); - aux1 += wfilt.cc[k_2] * a[jf_2+1]; - aux2 += wfilt.cr[k_2] * a[jr_2+1]; - unsigned long jf_3 = n1 & (ni + k_3); - unsigned long jr_3 = n1 & (nj + k_3); - aux1 += wfilt.cc[k_3] * a[jf_3+1]; - aux2 += wfilt.cr[k_3] * a[jr_3+1]; - } - // The rest of coefficients - for (k = kmax+1;k <= wfilt.ncof;++k) - { - jf = n1 & (ni + k); - jr = n1 & (nj + k); - aux1 += wfilt.cc[k] * a[jf+1]; - aux2 += wfilt.cr[k] * a[jr+1]; - } - } - } - else - { - for (ii = 1, i = 1;i <= n;i += 2, ii++) - { - ai = a[ii]; - ai1 = a[ii+nh]; - ni = i + nmod + wfilt.ioff; - nj = i + nmod + wfilt.joff; - for (k = 1;k <= wfilt.ncof;k++) - { - jf = (n1 & (ni + k)) + 1; - jr = (n1 & (nj + k)) + 1; - wksp[jf] += wfilt.cc[k] * ai; - wksp[jr] += wfilt.cr[k] * ai1; - } - } - } - memcpy(&a[1],&wksp[1],n*sizeof(double)); -} - -/* Gamma function ---------------------------------------------------------- */ -#define ITMAX 100 -#define EPS 3.0e-7 - -void gser(double *gamser, double a, double x, double *gln) -{ - int n; - double sum, del, ap; - - *gln = gammln(a); - if (x <= 0.0) - { - if (x < 0.0) - nrerror("x less than 0 in routine gser"); - *gamser = 0.0; - return; - } - else - { - ap = a; - del = sum = 1.0 / a; - for (n = 1;n <= ITMAX;n++) - { - ++ap; - del *= x / ap; - sum += del; - if (fabs(del) < fabs(sum)*EPS) - { - *gamser = sum * exp(-x + a * log(x) - (*gln)); - return; - } - } - nrerror("a too large, ITMAX too small in routine gser"); - return; - } -} -#undef ITMAX -#undef EPS - -#define ITMAX 100 -#define EPS 3.0e-7 -#define FPMIN 1.0e-30 - -void gcf(double *gammcf, double a, double x, double *gln) -{ - int i; - double an, b, c, d, del, h; - - *gln = gammln(a); - b = x + 1.0 - a; - c = 1.0 / FPMIN; - d = 1.0 / b; - h = d; - for (i = 1;i <= ITMAX;i++) - { - an = -i * (i - a); - b += 2.0; - d = an * d + b; - if (fabs(d) < FPMIN) - d = FPMIN; - c = b + an / c; - if (fabs(c) < FPMIN) - c = FPMIN; - d = 1.0 / d; - del = d * c; - h *= del; - if (fabs(del - 1.0) < EPS) - break; - } - if (i > ITMAX) - nrerror("a too large, ITMAX too small in gcf"); - *gammcf = exp(-x + a * log(x) - (*gln)) * h; -} -#undef ITMAX -#undef EPS -#undef FPMIN - -double gammp(double a, double x) -{ - double gamser, gammcf, gln; - - if (x < 0.0 || a <= 0.0) - nrerror("Invalid arguments in routine gammp"); - if (x < (a + 1.0)) - { - gser(&gamser, a, x, &gln); - return gamser; - } - else - { - gcf(&gammcf, a, x, &gln); - return 1.0 -gammcf; - } -} - -/* Solving linear equation systems via Cholesky ---------------------------- */ -void choldc(double *a, int n, double *p) -{ - int i, j, k; - double sum; - - for (i = 1;i <= n;i++) - { - for (j = i;j <= n;j++) - { - for (sum = a[i*n+j], k = i - 1;k >= 1;k--) - sum -= a[i*n+k] * a[j*n+k]; - if (i == j) - { - if (sum <= 0.0) - nrerror("choldc failed"); - p[i] = sqrt(sum); - } - else - a[j*n+i] = sum / p[i]; - } - } -} - -void cholsl(double *a, int n, double *p, double *b, double *x) -{ - int i, k; - double sum; - - for (i = 1;i <= n;i++) - { - for (sum = b[i], k = i - 1;k >= 1;k--) - sum -= a[i*n+k] * x[k]; - x[i] = sum / p[i]; - } - for (i = n;i >= 1;i--) - { - for (sum = x[i], k = i + 1;k <= n;k++) - sum -= a[k*n+i] * x[k]; - x[i] = sum / p[i]; - } -} - -/* Polynomial interpolation ------------------------------------------------ */ -void polint(double *xa, double *ya, int n, double x, double &y, double &dy) -{ - int i, m, ns = 1; - double den, dif, dift, ho, hp, w; - dif = fabs(x - xa[1]); - std::vector buffer(2*n); - auto *c= buffer.data()-1; - auto *d= c + n; - for (i = 1;i <= n;i++) - { - if ((dift = fabs(x - xa[i])) < dif) - { - ns = i; - dif = dift; - } - c[i] = ya[i]; - d[i] = ya[i]; - } - y = ya[ns--]; - for (m = 1;m < n;m++) - { - for (i = 1;i <= n - m;i++) - { - ho = xa[i] - x; - hp = xa[i+m] - x; - w = c[i+1] - d[i]; - if ((den = ho - hp) == 0.0) - { - nrerror("error in routine polint\n"); - } - den = w / den; - d[i] = hp * den; - c[i] = ho * den; - } - y += (dy = (2 * ns < (n - m) ? c[ns+1] : d[ns--])); - } -} diff --git a/src/core/numerical_recipes.h b/src/core/numerical_recipes.h deleted file mode 100644 index 197ca21..0000000 --- a/src/core/numerical_recipes.h +++ /dev/null @@ -1,343 +0,0 @@ -/*************************************************************************** - * - * Authors: Carlos Oscar S. Sorzano (coss@cnb.csic.es) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ -/*****************************************************************************/ -/* Variable and prototype definitions for the Numerical Core */ -/*****************************************************************************/ -#ifndef CORE__NUMERICAL_HH -#define CORE__NUMERICAL_HH - -#include -#include "xmipp_memory.h" -#include "xmipp_macros.h" -#include -#include - -//@defgroup NumericalRecipes Functions from the Numerical Recipes -//@ingroup DataLibrary -//@{ - -// Utilities -------------------------------------------------------------- -void nrerror(const char error_text[]); - -// Random numbers --------------------------------------------------------- -double ran1(int *idum); // Uniform random -double gasdev(int *idum); // Gaussian random -double tdev(double nu, int *idum); // t-student random - -// Cumulative distribution functions and Kolmogorov-Smirnov test -void ksone(double data[], int n, double(*func)(double), double * d, double * prob); // Chapter 13.5 -double probks(double alam); // Chapter 13.5 - -// FFT --------------------------------------------------------------------- -void four1(double data[], int nn, int isign); // Complex FFT 1D -void realft(double data[], int n, int isign); // Real FFT 1D -void fourn(double data[], int nn[], int ndim, int isign); // Complex FFT 2D,3D,... - -// Sorting ----------------------------------------------------------------- -void indexx(int n, double arrin[], int indx[]); // Sorting indexes - -// Bessel functions -------------------------------------------------------- -double bessj0(double x); -double bessj3_5(double x); -double bessj1_5(double x); - -double bessi0(double x); -double bessi1(double x); -double bessi0_5(double x); -double bessi1_5(double x); -double bessi2(double x); -double bessi3(double x); -double bessi2_5(double x); -double bessi3_5(double x); -double bessi4(double x); - -// Special functions ------------------------------------------------------- -double gammln(double xx); -double gammp(double a, double x); -double betacf(double a, double b, double x); -double betai(double a, double b, double x); -inline double sinc(double x) -{ - if (fabs(x)<0.0001) - return 1; - else - { - double arg=PI*x; - return sin(arg)/arg; - } -} -inline size_t fact(int num) -{ - size_t value = 1; - if (num !=1 && num != 0) - { - for (int i = num; i > 0; --i) - value *= i; - } - return value; - -} - -inline size_t binom(int n, int k) -{ - size_t factor=1; - for (int i = n; i > (n-k); --i) - factor *= i; - return factor/fact(k); -} - -// Singular value descomposition of matrix a (numerical recipes, chapter 2-6 for details) -void svdcmp(double *a, int m, int n, double *w, double *v); -void svbksb(double *u, double *w, double *v, int m, int n, double *b, double *x); - -// ------------------------------------------------------------------------- -void convlv(double *data, int n, double *respns, int m, int isign, double *ans); -void realft(double *data, int n, int isign); -void twofft(double *data1, double *data2, double *fft1, double *fft2, int n); -void four1(double *data, int nn, int isign); - -// Optimization ------------------------------------------------------------ -void powell(double *p, double *xi, int n, double ftol, int &iter, - double &fret, double(*func)(double *, void *), void *prm, - bool show); - -// These two routines have been taken from -// http://users.utu.fi/vesoik/userdocs/programs/libpet -// and they implement an algorithm of Lawson-Hanson of -// nonnegative least squares -int nnls(double *a, int m, int n, double *b, double *x, - double *rnorm, double *w, double *zz, int *index); -int nnlsWght(int N, int M, double *A, double *b, double *weight); - -// CFSQP ------------------------------------------------------------------- -// These routines are from -// http://www.aemtechnology.com/aemdesign/downloadfsqp.htm -// They implement the CFSQP algorithm -/* Declare and initialize user-accessible flag indicating */ -/* whether x sent to user functions has been changed within */ -/* CFSQP. */ -// Gradients - Finite Difference -void grobfd(int, int, double *, double *, void(*)(int, int, - double *, double *, void *), void *); -void grcnfd(int, int, double *, double *, void(*)(int, int, - double *, double *, void *), void *); - -// CFSQP -void cfsqp(int, int, int, int, int, int, int, int, int, int *, int, int, - int, int *, double, double, double, double, double *, - double *, double *, double *, double *, double *, - void(*)(int, int, double *, double *, void *), - void(*)(int, int, double *, double *, void *), - void(*)(int, int, double *, double *, - void(*)(int, int, double *, double *, void *), void *), - void(*)(int, int, double *, double *, - void(*)(int, int, double *, double *, void *), void *), - void *); - -// Wavelets ---------------------------------------------------------------- -void wtn(double a[], unsigned long nn[], int ndim, int isign, - void(*wtstep)(double [], unsigned long, int)); -void pwtset(int n); -void pwt(double a[], unsigned long n, int isign); - -// Working with matrices --------------------------------------------------- -// LU decomposition -#define TINY 1.0e-20; -/* Chapter 2 Section 3: LU DECOMPOSITION */ -template -void ludcmp(T *a, int n, int *indx, T *d) -{ - int i, imax=0, j, k; - T big, dum, sum, temp; - - std::vector buffer(n); - auto *vv= buffer.data()-1; - *d = (T)1.0; - for (i = 1;i <= n;i++) - { - big = (T)0.0; - for (j = 1;j <= n;j++) - if ((temp = (T)fabs((double)a[i*n+j])) > big) - big = temp; - if (big == (T)0.0) - nrerror("Singular matrix in routine LUDCMP"); - vv[i] = (T)1.0 / big; - } - for (j = 1;j <= n;j++) - { - for (i = 1;i < j;i++) - { - sum = a[i*n+j]; - for (k = 1;k < i;k++) - sum -= a[i*n+k] * a[k*n+j]; - a[i*n+j] = sum; - } - big = (T)0.0; - for (i = j;i <= n;i++) - { - sum = a[i*n+j]; - for (k = 1;k < j;k++) - sum -= a[i*n+k] * a[k*n+j]; - a[i*n+j] = sum; - if ((dum = vv[i] * (T)fabs((double)sum)) >= big) - { - big = dum; - imax = i; - } - } - if (j != imax) - { - for (k = 1;k <= n;k++) - { - dum = a[imax*n+k]; - a[imax*n+k] = a[j*n+k]; - a[j*n+k] = dum; - } - *d = -(*d); - vv[imax] = vv[j]; - } - indx[j] = imax; - if (a[j*n+j] == 0.0) - a[j*n+j] = (T) TINY; - if (j != n) - { - dum = (T)1.0 / (a[j*n+j]); - for (i = j + 1;i <= n;i++) - a[i*n+j] *= dum; - } - } -} -#undef TINY - -// Solve Ax=b -/* Chapter 2 Section 3: LU BACKWARD-FORWARD SUBSTITUTION */ -template -void lubksb(T *a, int n, int *indx, T b[]) -{ - int i, ii = 0, ip, j; - T sum; - - for (i = 1;i <= n;i++) - { - ip = indx[i]; - sum = b[ip]; - b[ip] = b[i]; - if (ii) - for (j = ii;j <= i - 1;j++) - sum -= a[i*n+j] * b[j]; - else if (sum) - ii = i; - b[i] = sum; - } - for (i = n;i >= 1;i--) - { - sum = b[i]; - for (j = i + 1;j <= n;j++) - sum -= a[i*n+j] * b[j]; - b[i] = sum / a[i*n+i]; - } -} - -/* Chapter 2, Section 1. Gauss-Jordan equation system resolution ----------- */ -// Solve Ax=b (b=matrix) -template -void gaussj(T *a, int n, T *b, int m) -{ - T temp; - int i, icol=0, irow=0, j, k, l, ll; - T big, dum; - double pivinv; - - std::vector buffer(3*n); - auto *indxc= buffer.data()-1; - auto *indxr= indxc + n; - auto *ipiv= indxr + n; - for (j = 1;j <= n;j++) - ipiv[j] = 0; - for (i = 1;i <= n;i++) - { - big = (T)0; - for (j = 1;j <= n;j++) - if (ipiv[j] != 1) - for (k = 1;k <= n;k++) - { - if (ipiv[k] == 0) - { - if (fabs((double)a[j*n+k]) >= (double) big) - { - big = ABS(a[j*n+k]); - irow = j; - icol = k; - } - } - else if (ipiv[k] > 1) - nrerror("GAUSSJ: Singular Matrix-1"); - } - ++(ipiv[icol]); - if (irow != icol) - { - for (l = 1;l <= n;l++) - SWAP(a[irow*n+l], a[icol*n+l], temp) - for (l = 1;l <= m;l++) - SWAP(b[irow*n+l], b[icol*n+l], temp) - } - indxr[i] = irow; - indxc[i] = icol; - if (a[icol*n+icol] == 0.0) - nrerror("GAUSSJ: Singular Matrix-2"); - pivinv = 1.0f / a[icol*n+icol]; - a[icol*n+icol] = (T)1; - for (l = 1;l <= n;l++) - a[icol*n+l] = (T)(pivinv * a[icol*n+l]); - for (l = 1;l <= m;l++) - b[icol*n+l] = (T)(pivinv * b[icol*n+l]); - for (ll = 1;ll <= n;ll++) - if (ll != icol) - { - dum = a[ll*n+icol]; - a[ll*n+icol] = (T)0; - for (l = 1;l <= n;l++) - a[ll*n+l] -= a[icol*n+l] * dum; - for (l = 1;l <= m;l++) - b[ll*n+l] -= b[icol*n+l] * dum; - } - } - for (l = n;l >= 1;l--) - { - if (indxr[l] != indxc[l]) - for (k = 1;k <= n;k++) - SWAP(a[k*n+indxr[l]], a[k*n+indxc[l]], temp); - } -} - -// Cholesky factorization -void choldc(double *a, int n, double *p); -// Cholesky backsubstitution -void cholsl(double *a, int n, double *p, double *b, double *x); -// Polynomial interpolation -void polint(double *xa, double *ya, int n, double x, double &y, double &dy); -//@} - -#endif \ No newline at end of file diff --git a/src/core/optional.h b/src/core/optional.h deleted file mode 100644 index ee9828b..0000000 --- a/src/core/optional.h +++ /dev/null @@ -1,99 +0,0 @@ -/* - * optional.h - * - * Created on: Dec 12, 2018 - * Author: david - */ - -#ifndef CORE_OPTIONAL_H_ -#define CORE_OPTIONAL_H_ - -#if __cplusplus >= 201703L -#include -namespace core{ -using std::optional; -} -#else - -#include -#include - -namespace core { - -template -class optional { -public: - optional() : - p(new payload()) { - } - ; - optional(const T &&t) : - p(new payload_full(t)) { - } - ; - - optional(const T &t) : - p(new payload_full(t)) { - } - ; - - optional(const optional &&o) { - delete p; - this->p = o.p; - } - - optional& operator=(optional &&o) { - if (this != &o) { - delete p; - this->p = o.p; - o.p = nullptr; - } - return *this; - } - - ~optional() { - delete p; - p = nullptr; - } - - constexpr explicit operator bool() const { - return p->has_value; - } - - constexpr bool has_value() const { - return p->has_value; - } - - inline T& value() const { - assert(p->has_value); - return static_cast(p)->t; - } - -private: - - struct payload { - explicit payload(bool has_value = false) : - has_value(has_value) { - } - ; - const bool has_value; - }; - - struct payload_full: public payload { - explicit payload_full(const T &t) : - payload(true), t(std::move(t)) { - } - ; - - T t; - }; - - payload *p; - -}; -// optional - -}// namespace - -#endif -#endif /* CORE_OPTIONAL_H_ */ diff --git a/src/core/rerunable_program.h b/src/core/rerunable_program.h deleted file mode 100644 index ff2c040..0000000 --- a/src/core/rerunable_program.h +++ /dev/null @@ -1,86 +0,0 @@ -/*************************************************************************** - * - * Authors: David Strelak (davidstrelak@gmail.com) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#pragma once - -#include "metadata_db.h" -#include "metadata_vec.h" -#include "xmipp_filename.h" - -/** - * This class adds rerun functionality to Xmipp program. - * Program is expected to store the progres in the MetaData file stored in the - *file system. In case of failure or interruption, this file can be loaded and - *the program will automatically pick up where it left. - **/ -class Rerunable { -protected: - /** - * @fn name of the file where intermediary results will be stored - **/ - Rerunable(const FileName &fn) : fnDone(fn) {} - - /** - * This method will fill remove processed records from the md. - * Md will not be changed if no data has been processed. - **/ - virtual void createWorkFiles(bool resume, MetaData *md) { - if (nullptr == md) { - REPORT_ERROR(ERR_MD, - "Null pointer passed. " - "If you can reproduce this, please contact developers."); - } - if (resume && fnDone.exists()) { - MetaDataDb done(fnDone); - auto *toDo = dynamic_cast(md); - if (nullptr == toDo) { - MetaDataDb tmp(*md); - tmp.subtraction(done, MDL_IMAGE); - *md = tmp; - } else { - toDo->subtraction(done, MDL_IMAGE); - } - } else // if not exists create metadata only with headers - { - MetaDataVec mdDone; - for (const auto &l : this->getLabelsForEmpty()) { - mdDone.addLabel(l); - } - mdDone.write(fnDone); - } - } - - /** - * Returns labels to be used in the empty progres MetaData file - **/ - virtual std::vector getLabelsForEmpty() = 0; - - const FileName &getFileName() const { return this->fnDone; } - - void setFileName(const FileName &fn) { fnDone = fn; } - -private: - FileName fnDone; -}; diff --git a/src/core/rwDM3.cpp b/src/core/rwDM3.cpp deleted file mode 100644 index f7213ca..0000000 --- a/src/core/rwDM3.cpp +++ /dev/null @@ -1,636 +0,0 @@ -/*************************************************************************** - * Authors: Joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include "xmipp_image_base.h" -#include "metadata_vec.h" -#include "xmipp_funcs.h" - -///@defgroup DM3 DM3 File format -///@ingroup ImageFormats - -/** DM3 Header - * @ingroup DM3 -*/ -struct DM3head -{ - int fileVersion; - int fileLength; - int byteOrder; - char sorted; - char open; - int nTags; - MetaDataVec tags; - int nIm; -}; - -/** DM3 Data Header - * @ingroup DM3 -*/ -struct DM3dataHead -{ - double CalibrationOffsetX; //CalibrationOffsetX - double pixelWidth; //CalibrationDeltaX - int CalibrationElementX; //CalibrationElementX - double CalibrationOffsetY; //CalibrationOffsetY - double pixelHeight; //CalibrationDeltaY - int CalibrationElementY; //CalibrationElementY - short int dataType; //DataType - int imageWidth; //ArraySizeX - int imageHeight; //ArraySizeY - short int dataTypeSize; - size_t headerSize; - bool flip; -}; - -/** DM3 Determine DM3 datatype - * @ingroup DM3 -*/ -DataType datatypeDM3(int nType) -{ - DataType datatype; - - switch(nType) - { - case 2: // (02h = 2 i2* signed (short) - datatype = DT_Short; - break; - case 3: // 03h = 3 i4* signed (long) - datatype = DT_Int; - break; - case 4: // 04h = 4 i2* unsigned (ushort) or unicode string - datatype = DT_UShort; - break; - case 5: // 05h = 5 i4* unsigned (ulong) - datatype = DT_UInt; - break; - case 6: // 06h = 6 f4* (float) - datatype = DT_Float; - break; - case 7: // 07h = 7 f8* (double) - datatype = DT_Double; - break; - case 8: // 08h = 8 i1 (boolean) - datatype = DT_Bool; - break; - case 9: // 0ah = 10 i1 - datatype = DT_SChar; - break; - case 10: // 0ah = 10 i1 - datatype = DT_SChar; - break; - default: - datatype = DT_Unknown; - break; - } - return datatype; -} - -/** DM3 Low level reader - * @ingroup DM3 -*/ -void FREADTagValueDM3(double *fieldValue,int numberType,int n,FILE* fimg, bool swap) -{ - DataType datatype = datatypeDM3(numberType); - size_t datatypesize=gettypesize(datatype); - - xmippFREAD(fieldValue, datatypesize, n, fimg, swap); - - switch(numberType) - { - case 2: // (02h = 2 i2* signed (short) - { - short* sValue = (short*) fieldValue; - *fieldValue = (double) *sValue; - break; - } - case 3: // 03h = 3 i4* signed (long) - { - int* iValue = (int*) fieldValue; - *fieldValue = (double) *iValue; - break; - } - case 4: // 04h = 4 i2* unsigned (ushort) or unicode string - { - unsigned short* usValue = (unsigned short*) fieldValue; - *fieldValue = (double) *usValue; - break; - } - case 5: // 05h = 5 i4* unsigned (ulong) - { - unsigned int* uiValue = (unsigned int*) fieldValue; - *fieldValue = (double) *uiValue; - break; - } - case 6: // 06h = 6 f4* (float) - { - float* fValue = (float*) fieldValue; - *fieldValue = (double) *fValue; - break; - } - case 7: // 07h = 7 f8* (double) - { - // double* caca = (double*) fieldValue; - break; - } - case 8: // 08h = 8 i1 (boolean) - { - bool* bValue = (bool*) fieldValue; - *fieldValue = (double) *bValue; - break; - } - case 9: // 0ah = 10 i1 - case 10: // 0ah = 10 i1 - { - char* cValue = (char*) fieldValue; - *fieldValue = (double) *cValue; - break; - } - default: - { - break; - } - } -} - -/** DM3 Tag reader - * @ingroup DM3 -*/ -double readTagDM3(FILE *fimg, DM3head *header, int parentId, int &nodeId, bool isLE, bool swap) -{ - /* Header Tag ============================================================== */ - unsigned char cdTag; - unsigned short int ltName; - - xmippFREAD(&cdTag,sizeof (unsigned char),1,fimg,false); // Identification tag: 20 = tag dir, 21 = tag - xmippFREAD(<Name,sizeof(unsigned short int), 1,fimg,isLE); // Length of the tag name - int idTag = int(cdTag); - - std::string stagName; - - char * tagName = new char[ltName+1]; - xmippFREAD(tagName,1,ltName,fimg,false); // Tag name - tagName[ltName] = '\0'; - stagName = tagName; - delete [] tagName; - - size_t id = header->tags.addObject(); - - nodeId++; - header->tags.setValue(MDL_DM3_NODEID, nodeId, id); - header->tags.setValue(MDL_DM3_PARENTID, parentId, id); - header->tags.setValue(MDL_DM3_IDTAG, idTag, id); - header->tags.setValue(MDL_DM3_TAGNAME, stagName, id); - - /* Reading tags ===================================================================*/ - if (idTag == 20) // Tag directory - { - unsigned char dummy; - int nTags; - xmippFREAD(&dummy,sizeof(unsigned char),1,fimg,false); // 1 = sorted (normally = 1) - xmippFREAD(&dummy,sizeof(unsigned char),1,fimg,false); // 0 = closed, 1 = open (normally = 0) - xmippFREAD(&nTags,sizeof(int),1,fimg,isLE); // number of tags in tag directory - - - header->tags.setValue(MDL_DM3_TAGCLASS,(std::string) "Dir", id); - header->tags.setValue(MDL_DM3_SIZE, nTags, id); - - parentId = nodeId; - for (int n=1;n<=nTags;n++) // Rest of directories - { - readTagDM3(fimg, header, parentId, nodeId, isLE, swap); - } - return 0; - } - else if (idTag == 21) // Tag - { - unsigned int nnum; - char buf[4]; // to read %%%% symbols - - xmippFREAD(&buf,1,4,fimg,false); // To read %%%% symbols - xmippFREAD(&nnum,sizeof(unsigned int),1,fimg,isLE); // Size of info array - - int * info; - info = new int[nnum]; - xmippFREAD(info,sizeof(unsigned int),nnum,fimg,isLE); // Reading of Info - - /* Tag classification =======================================*/ - - if (nnum == 1) // Single entry tag - { - header->tags.setValue(MDL_DM3_TAGCLASS,(std::string) "Single", id); - - double tagValue = 0; - - FREADTagValueDM3(&tagValue,info[0],1,fimg,swap); - - std::vector vtagValue(1); - vtagValue.assign(1,tagValue); - - header->tags.setValue(MDL_DM3_NUMBER_TYPE, info[0], id); - header->tags.setValue(MDL_DM3_VALUE, vtagValue, id); - delete []info; - return tagValue; - } - else if(nnum == 3 && info[0]==20) // Tag array - { - /*nnum = 3 - info(0) = 20 - info(1) = number type for all values - info(2) = info(nnum) = size of array*/ - - header->tags.setValue(MDL_DM3_TAGCLASS,(std::string) "Array", id); - - header->tags.setValue(MDL_DM3_NUMBER_TYPE, info[1], id); - header->tags.setValue(MDL_DM3_SIZE, info[nnum-1], id); - std::vector vtagValue(1); - vtagValue.assign(1,(double) ftell(fimg)); - - header->tags.setValue(MDL_DM3_VALUE, vtagValue, id); - - // Jump the array values - int k; - if(info[1] == 2 || info[1] == 4) - k = 2; - else if(info[1] == 3 || info[1] == 5 || info[1] == 6) - k = 4; - else if(info[1] == 10 ) - k = 1; - else - REPORT_ERROR(ERR_ARG_INCORRECT,formatString("unsupported value info[1]=%d, read at %d",info[1],ftell(fimg))); - - fseek( fimg, ftell(fimg)+(info[nnum-1])*k , SEEK_SET ); - delete []info; - return 0; - } - else if (info[0]==20 && info[1] == 15) // Tag Group array - { - /*nnum = size of array - info(0) = 20 (array) - info(1) = 15 (group) - info(2) = 0 (always 0) - info(3) = number of values in group - info(2*i+3) = number type for value i - info(nnum) = size of info array*/ - - header->tags.setValue(MDL_DM3_TAGCLASS, (std::string) "GroupArray", id); - header->tags.setValue(MDL_DM3_SIZE, info[3], id); - int nBytes=0, k; - double fieldValue; - for (int n=1;n<=info[3];n++) - { - fieldValue=0; - FREADTagValueDM3(&fieldValue,info[3+2*n],1,fimg,swap); - - if(info[3+2*n] == 2 || info[3+2*n] == 4) - k = 2; - else if(info[3+2*n] == 3 || info[3+2*n] == 5) - k = 4; - else if(info[3+2*n] == 10 ) - k = 1; - nBytes+=k; - } - - // Jump the array values - fseek( fimg, ftell(fimg)+(info[nnum-1]-1)*nBytes , SEEK_SET ); - delete []info; - return 0; - } - else if (info[0] == 15) // Tag Group (struct) - { - /* info[1] = length group name (always =0) - info[2] = number of entries in group */ - /*nnum = size of info array - info(1) = 0fh - info(3) = number of values in group - info(2*i+3) = number type for value i - Other info entries are always zero*/ - - header->tags.setValue(MDL_DM3_TAGCLASS, (std::string) "Group", id); - header->tags.setValue(MDL_DM3_SIZE, info[2], id); - std::vector vtagValue(info[2]); - for (int n=1;n<=info[2];n++) - { - double fieldValue=0; - FREADTagValueDM3(&fieldValue,info[2+2*n],1,fimg,swap); - vtagValue.assign(n,fieldValue); - } - header->tags.setValue(MDL_DM3_VALUE, vtagValue, id); - delete []info; - return 0; - } - delete []info; - } - return 0; -} - -/** DM3 Get DM3 parent - * @ingroup DM3 -*/ -int parentDM3(MetaData &MD, int nodeId, int depth = 1) -{ - for (int n = 0; n < depth; n++) - { - MD.getValue(MDL_DM3_PARENTID, nodeId, MD.firstObject(MDValueEQ(MDL_DM3_NODEID, nodeId))); - - if (nodeId == 0) - break; - } - return nodeId; -} - -/** DM3 Go to tag - * @ingroup DM3 -*/ -size_t gotoTagDM3(MetaData &MD, int &nodeId, const std::string &tagsList) -{ - std::string tag; - std::vector vTags; - splitString(tagsList,",",vTags, false); - size_t id=0; - - MDValueEQ queryParentId(MDL_DM3_PARENTID,-1), queryTagname(MDL_DM3_TAGNAME,tag); - MDMultiQuery queries; - - queries.addAndQuery(queryParentId); - queries.addAndQuery(queryTagname); - - for (size_t n = 0; n < vTags.size(); n++) - { - tag = vTags[n]; - - queryParentId.setValue(nodeId); - queryTagname.setValue(tag); - id = MD.firstObject(queries); - if (id != BAD_OBJID) - { - MD.getValue(MDL_DM3_NODEID, nodeId, id); - } - } - return id; -} - -int space; -/** DM3 Print DM3 node - * @ingroup DM3 -*/ -void printDM3node(const MetaData &MD, size_t id) -{ - std::string tag; - MD.getValue(MDL_DM3_TAGNAME, tag, id); - - int nodeId; - MD.getValue(MDL_DM3_NODEID, nodeId, id); - - for (int i = 0; i < space; i++) - std::cout << " "; - - std::cout << tag << std::endl; - - std::vector vObjs; - MD.findObjects(vObjs, MDValueEQ(MDL_DM3_PARENTID, nodeId)); - - space += 3; - - for (size_t i = 0; i < vObjs.size(); i++) - printDM3node(MD, vObjs[i]); - - space -= 3; - -} - -/** DM3 Print DM3 header - * @ingroup DM3 -*/ -void printDM3(const MetaData &MD) -{ - std::vector vObjs; - space = 0; - MD.findObjects(vObjs,MDValueEQ(MDL_DM3_PARENTID, 0)); - - for (size_t i = 0; i < vObjs.size(); i++) - printDM3node(MD, vObjs[i]); -} - - -int ImageBase::writeDM3(size_t img_select, bool isStack, int mode) -{ - REPORT_ERROR(ERR_IO_NOWRITE, "ERROR: writeDM3 is not implemented."); -} - -/** DM3 Reader - * @ingroup DM3 -*/ -int ImageBase::readDM3(size_t select_img,bool isStack) -{ -#undef DEBUG - //#define DEBUG -#ifdef DEBUG - printf("DEBUG readDM3: Reading DM3 file\n"); -#endif - - DM3head * header = new DM3head; - int dummy; - - // Check Machine endianness - bool isLE = IsLittleEndian(); - - xmippFREAD(&header->fileVersion, sizeof(int), 1, fimg, isLE); - xmippFREAD(&dummy, sizeof(int), 1, fimg, isLE); - xmippFREAD(&header->byteOrder, sizeof(int), 1, fimg, isLE); - - // Set Endianess - swap = (isLE^header->byteOrder); - - if ( header->fileVersion!=3 ) - REPORT_ERROR(ERR_IO_NOREAD, "readDM3: Input file is not Digital Micrograph 3 format."); - - xmippFREAD(&header->sorted, sizeof(char), 1, fimg, false); - xmippFREAD(&header->open, sizeof(char), 1, fimg, false); - xmippFREAD(&header->nTags, sizeof(int), 1, fimg, isLE); - - header->tags.addLabel(MDL_DM3_NODEID); - header->tags.addLabel(MDL_DM3_PARENTID); - header->tags.addLabel(MDL_DM3_IDTAG); - header->tags.addLabel(MDL_DM3_TAGNAME); - header->tags.addLabel(MDL_DM3_TAGCLASS); - header->tags.addLabel(MDL_DM3_SIZE); - header->tags.addLabel(MDL_DM3_NUMBER_TYPE); - header->tags.addLabel(MDL_DM3_VALUE); - - int nodeID = 0, parentID = 0; - - for (int n=1;n<=header->nTags;n++) - readTagDM3(fimg, header, parentID, nodeID, isLE, swap); - - //#define DEBUG -#ifdef DEBUG - - header->tags.write("images.txt"); - printDM3(header->tags); -#endif - - - //std::vector vIm; - //header->tags.findObjects(vIm, ); - - header->nIm = 0; - std::vector dataHeaders; - DM3dataHead dhRef; - - std::vector vValue; - int iValue; - size_t id; - //Initialize query for later use - MDValueEQ queryNodeId(MDL_DM3_NODEID, -1); - - std::vector objIdsDataType; - header->tags.findObjects(objIdsDataType, MDValueEQ(MDL_DM3_TAGNAME,(String)"DataType")); - - for (size_t objId : objIdsDataType) - // Read all the image headers - //for (int n = 0; n < vIm.size(); n++) - { - //header->tags.goToObject(vIm[n]); - header->tags.getValue(MDL_DM3_VALUE, vValue, objId); - - if (vValue[0] != 23) //avoid thumb images - { - dataHeaders.push_back(dhRef); - - parentID = parentDM3(header->tags, objId, 2); - - nodeID = parentID; - id = gotoTagDM3(header->tags, nodeID, "ImageData,Data"); - header->tags.getValue(MDL_DM3_NUMBER_TYPE, iValue, id); - dataHeaders[header->nIm].dataType = (short int) iValue; - - header->tags.getValue(MDL_DM3_VALUE, vValue, id); - dataHeaders[header->nIm].headerSize = (size_t) vValue[0]; - - nodeID = parentID; - gotoTagDM3(header->tags, nodeID, "ImageData,Dimensions"); - nodeID++; - queryNodeId.setValue(nodeID); - id = header->tags.firstObject(queryNodeId); - header->tags.getValue(MDL_DM3_VALUE, vValue, id); - dataHeaders[header->nIm].imageWidth = (int) vValue[0]; - - nodeID++; - queryNodeId.setValue(nodeID); - id = header->tags.firstObject(queryNodeId); - header->tags.getValue(MDL_DM3_VALUE, vValue, id); - dataHeaders[header->nIm].imageHeight = (int) vValue[0]; - - nodeID++; - queryNodeId.setValue(nodeID); - id = header->tags.firstObject(queryNodeId); - header->tags.getValue(MDL_DM3_VALUE, vValue, id); - dataHeaders[header->nIm].dataTypeSize = (short int) vValue[0]; - - nodeID = parentID; - id = gotoTagDM3(header->tags, nodeID, "ImageTags,Acquisition,Frame,CCD,Pixel Size (um)"); - // header->tags.nextObject(); - if (id != BAD_OBJID) - { - header->tags.getValue(MDL_DM3_VALUE, vValue, id); - dataHeaders[header->nIm].pixelHeight = vValue[0]*1e4; - dataHeaders[header->nIm].pixelWidth = vValue[1]*1e4; - } - - //TODO: Do I have to include FLIP?!?!? which? vertical or horizontal? - header->nIm++; - } - - } - - if (dataHeaders.size() == 0) - REPORT_ERROR(ERR_IMG_NOREAD,formatString("readDM3: Image information not found in file %s",filename.c_str())); - - int _xDim,_yDim; - size_t _nDim; - _xDim = dataHeaders[0].imageWidth; - _yDim = dataHeaders[0].imageHeight; - _nDim = header->nIm; - - // Map the parameters - if (select_img > _nDim) - REPORT_ERROR(ERR_INDEX_OUTOFBOUNDS, formatString("readDM3: Image number %lu exceeds stack size %lu", select_img, _nDim)); - else if (select_img == ALL_IMAGES) - { - // Check images dimensions. Need to be the same - for (size_t i = 1; i < _nDim ; i++) - { - if (dataHeaders[0].imageHeight != dataHeaders[i].imageHeight || \ - dataHeaders[0].imageWidth != dataHeaders[i].imageWidth || \ - dataHeaders[0].dataType != dataHeaders[i].dataType) - REPORT_ERROR(ERR_IMG_NOREAD, "readDM3: images in DM3 file with different \ - dimensions and data types are not currently supported. Try to read them individually."); - } - //FIXME: Code is not totally implemented to load automatically multiple images if they have same size. - if (_nDim > 1) - REPORT_ERROR(ERR_IO_NOREAD, "readDM3: Reading multiple \ - images at once in DM3 file are not currently supported. Try to read them individually."); - } - else - _nDim = 1; - - setDimensions(_xDim, _yDim, 1, _nDim); - - size_t imgStart = IMG_INDEX(select_img); - size_t imgEnd = (select_img != ALL_IMAGES) ? imgStart + 1 : _nDim; - - DataType datatype = datatypeDM3(dataHeaders[0].dataType); - - MDMainHeader.setValue(MDL_SAMPLINGRATE_X,(double)dataHeaders[0].pixelWidth); - MDMainHeader.setValue(MDL_SAMPLINGRATE_Y,(double)dataHeaders[0].pixelHeight); - MDMainHeader.setValue(MDL_DATATYPE,(int)datatype); - - if (dataMode == HEADER) // Stop reading if not necessary - { - delete header; - return 0; - } - - MD.clear(); - for (size_t i = 0; i < imgEnd-imgStart; i++) - MD.push_back(std::unique_ptr(new MDRowVec(MDL::emptyHeaderVec()))); - offset = dataHeaders[imgStart].headerSize; - delete header; - - if( dataMode < DATA ) - return 0; - -#undef DEBUG -#ifdef DEBUG - - MDMainHeader.write(std::cerr); - MD.write(std::cerr); -#endif - - size_t pad = 0; - readData(fimg, select_img, datatype, pad); - - return(0); -} diff --git a/src/core/rwDM3.h b/src/core/rwDM3.h deleted file mode 100644 index ad13779..0000000 --- a/src/core/rwDM3.h +++ /dev/null @@ -1,42 +0,0 @@ -/*************************************************************************** - * Authors: Joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_RWDM3_H_ -#define CORE_RWDM3_H_ - -///@defgroup DM3 DM3 File format -///@ingroup ImageFormats - -/** DM3 Reader - * @ingroup DM3 -*/ -int readDM3(size_t img_select,bool isStack=false); - -/** DM3 Writer - * @ingroup DM3 -*/ -int writeDM3(size_t img_select, bool isStack=false, int mode=WRITE_OVERWRITE); - -#endif /* RWDM3_H_ */ diff --git a/src/core/rwDM4.cpp b/src/core/rwDM4.cpp deleted file mode 100644 index 53fa8af..0000000 --- a/src/core/rwDM4.cpp +++ /dev/null @@ -1,679 +0,0 @@ -/*************************************************************************** - * Authors: Joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include "xmipp_image_base.h" -#include "metadata_vec.h" -#include "xmipp_funcs.h" - -///@defgroup DM4 DM4 File format -///@ingroup ImageFormats - -/** DM4 Header - * @ingroup DM4 -*/ -struct DM4head -{ - int fileVersion; - int fileLength; - int byteOrder; - char sorted; - char open; - int nTags; - MetaDataVec tags; - int nIm; -}; - -/** DM4 Data Header - * @ingroup DM4 -*/ -struct DM4dataHead -{ - double CalibrationOffsetX; //CalibrationOffsetX - double pixelWidth; //CalibrationDeltaX - int CalibrationElementX; //CalibrationElementX - double CalibrationOffsetY; //CalibrationOffsetY - double pixelHeight; //CalibrationDeltaY - int CalibrationElementY; //CalibrationElementY - short int dataType; //DataType - int imageWidth; //ArraySizeX - int imageHeight; //ArraySizeY - int imageDepth; //ArraySizeZ - short int dataTypeSize; - size_t headerSize; - bool flip; -}; - -/** DM4 Determine DM4 datatype - * @ingroup DM4 -*/ -DataType datatypeDM4(int nType) -{ - DataType datatype; - - switch(nType) - { - case 2: // (02h = 2 i2* signed (short) - datatype = DT_Short; - break; - case 3: // 03h = 3 i4* signed (long) - datatype = DT_Int; - break; - case 4: // 04h = 4 i2* unsigned (ushort) or unicode string - datatype = DT_UShort; - break; - case 5: // 05h = 5 i4* unsigned (ulong) - datatype = DT_UInt; - break; - case 6: // 06h = 6 f4* (float) - datatype = DT_Float; - break; - case 7: // 07h = 7 f8* (double) - datatype = DT_Double; - break; - case 8: // 08h = 8 i1 (boolean) - datatype = DT_Bool; - break; - case 9: // 0ah = 10 i1 - datatype = DT_SChar; - break; - case 10: // 0ah = 10 i1 - datatype = DT_SChar; - break; - case 11: // 0ah = 10 i1 - datatype = DT_ULong; - break; - case 12: // 0ah = 10 i1 - datatype = DT_Long; - break; - default: - datatype = DT_Unknown; - break; - } - return datatype; -} - -/** DM4 Low level reader - * @ingroup DM4 -*/ -void FREADTagValueDM4(double *fieldValue,int numberType,int n,FILE* fimg, bool swap) -{ - DataType datatype = datatypeDM4(numberType); - size_t datatypesize=gettypesize(datatype); - - xmippFREAD(fieldValue, datatypesize, n, fimg, swap); - - switch(numberType) - { - case 2: // (02h = 2 i2* signed (short) - { - short* sValue = (short*) fieldValue; - *fieldValue = (double) *sValue; - break; - } - case 3: // 03h = 3 i4* signed (long) - { - int* iValue = (int*) fieldValue; - *fieldValue = (double) *iValue; - break; - } - case 4: // 04h = 4 i2* unsigned (ushort) or unicode string - { - unsigned short* usValue = (unsigned short*) fieldValue; - *fieldValue = (double) *usValue; - break; - } - case 5: // 05h = 5 i4* unsigned (ulong) - { - unsigned int* uiValue = (unsigned int*) fieldValue; - *fieldValue = (double) *uiValue; - break; - } - case 6: // 06h = 6 f4* (float) - { - float* fValue = (float*) fieldValue; - *fieldValue = (double) *fValue; - break; - } - case 7: // 07h = 7 f8* (double) - { - // double* caca = (double*) fieldValue; - break; - } - case 8: // 08h = 8 i1 (boolean) - { - bool* bValue = (bool*) fieldValue; - *fieldValue = (double) *bValue; - break; - } - case 9: // 0ah = 10 i1 - case 10: // 0ah = 10 i1 - { - char* cValue = (char*) fieldValue; - *fieldValue = (double) *cValue; - break; - } - case 11: // 0ah = 10 i1 - { - unsigned long* cValue = (unsigned long*) fieldValue; - *fieldValue = (double) *cValue; - break; - } - case 12: // 0ah = 10 i1 - { - long* cValue = (long*) fieldValue; - *fieldValue = (double) *cValue; - break; - } - default: - { - break; - } - } -} - -/** DM4 Tag reader - * @ingroup DM4 -*/ -double readTagDM4(FILE *fimg, DM4head *header, int parentId, int &nodeId, bool isLE, bool swap) -{ - /* Header Tag ============================================================== */ - unsigned char cdTag; - unsigned short int ltName; - - xmippFREAD(&cdTag,sizeof (unsigned char),1,fimg,false); // Identification tag: 20 = tag dir, 21 = tag - xmippFREAD(<Name,sizeof(unsigned short int), 1,fimg,isLE); // Length of the tag name - int idTag = int(cdTag); - - std::string stagName; - - if (ltName > 0) - { - char * tagName = new char[ltName+1]; - xmippFREAD(tagName,1,ltName,fimg,false); // Tag name - tagName[ltName] = '\0'; - stagName = tagName; - delete [] tagName; - } - - /*total bytes in tag/tag directory including all sub-directories - * (new for DM4). Actually, we don't use it*/ - fseek(fimg, 8, SEEK_CUR); - - size_t id = header->tags.addObject(); - - nodeId++; - header->tags.setValue(MDL_DM3_NODEID, nodeId, id); - header->tags.setValue(MDL_DM3_PARENTID, parentId, id); - header->tags.setValue(MDL_DM3_IDTAG, idTag, id); - header->tags.setValue(MDL_DM3_TAGNAME, stagName, id); - - /* Reading tags ===================================================================*/ - if (idTag == 20) // Tag directory - { - unsigned char dummy; - int nTags; - xmippFREAD(&dummy,sizeof(unsigned char),1,fimg,false); // 1 = sorted (normally = 1) - xmippFREAD(&dummy,sizeof(unsigned char),1,fimg,false); // 0 = closed, 1 = open (normally = 0) - - xmippFREAD(&nTags,sizeof(long),1,fimg,isLE); // number of tags in tag directory - - - header->tags.setValue(MDL_DM3_TAGCLASS,(std::string) "Dir", id); - header->tags.setValue(MDL_DM3_SIZE, nTags, id); - - parentId = nodeId; - for (int n=1;n<=nTags;n++) // Rest of directories - { - readTagDM4(fimg, header, parentId, nodeId, isLE, swap); - } - return 0; - } - else if (idTag == 21) // Tag - { - unsigned int nnum; - char buf[4]; // to read %%%% symbols - - xmippFREAD(&buf,1,4,fimg,false); // To read %%%% symbols - xmippFREAD(&nnum,sizeof(long),1,fimg,isLE); // Size of info array - - size_t * info; - info = new size_t[nnum]; - xmippFREAD(info,sizeof(long),nnum,fimg,isLE); // Reading of Info - - /* Tag classification =======================================*/ - - if (nnum == 1) // Single entry tag - { - header->tags.setValue(MDL_DM3_TAGCLASS,(std::string) "Single", id); - - double tagValue = 0; - - FREADTagValueDM4(&tagValue,info[0],1,fimg,swap); - - std::vector vtagValue(1); - vtagValue.assign(1,tagValue); - - header->tags.setValue(MDL_DM3_NUMBER_TYPE, (int) info[0], id); - header->tags.setValue(MDL_DM3_VALUE, vtagValue, id); - delete []info; - return tagValue; - } - else if(nnum == 3 && info[0]==20) // Tag array - { - /*nnum = 3 - info(0) = 20 - info(1) = number type for all values - info(2) = info(nnum) = size of array*/ - - header->tags.setValue(MDL_DM3_TAGCLASS,(std::string) "Array", id); - - header->tags.setValue(MDL_DM3_NUMBER_TYPE, (int)info[1], id); - header->tags.setValue(MDL_DM3_SIZE, (int) info[nnum-1], id); - std::vector vtagValue(1); - vtagValue.assign(1,(double) ftell(fimg)); - - header->tags.setValue(MDL_DM3_VALUE, vtagValue, id); - - // Jump the array values - int k; - if(info[1] == 2 || info[1] == 4) - k = 2; - else if(info[1] == 3 || info[1] == 5 || info[1] == 6) - k = 4; - else if(info[1] == 10 ) - k = 1; - else - REPORT_ERROR(ERR_ARG_INCORRECT,formatString("unsupported value info[1]=%d, read at %d",info[1],ftell(fimg))); - - fseek( fimg, ftell(fimg)+(info[nnum-1])*k , SEEK_SET ); - delete []info; - return 0; - } - else if (info[0]==20 && info[1] == 15) // Tag Group array - { - /*nnum = size of array - info(0) = 20 (array) - info(1) = 15 (group) - info(2) = 0 (always 0) - info(3) = number of values in group - info(2*i+3) = number type for value i - info(nnum) = size of info array*/ - - header->tags.setValue(MDL_DM3_TAGCLASS, (std::string) "GroupArray", id); - header->tags.setValue(MDL_DM3_SIZE, (int)info[3], id); - int nBytes=0, k; - double fieldValue; - for (int n=1;n<=info[3];n++) - { - fieldValue=0; - FREADTagValueDM4(&fieldValue,info[3+2*n],1,fimg,swap); - - if(info[3+2*n] == 2 || info[3+2*n] == 4) - k = 2; - else if(info[3+2*n] == 3 || info[3+2*n] == 5) - k = 4; - else if(info[3+2*n] == 10 ) - k = 1; - nBytes+=k; - } - - // Jump the array values - fseek( fimg, ftell(fimg)+(info[nnum-1]-1)*nBytes , SEEK_SET ); - delete []info; - return 0; - } - else if (info[0] == 15) // Tag Group (struct) - { - /* info[1] = length group name (always =0) - info[2] = number of entries in group */ - /*nnum = size of info array - info(1) = 0fh - info(3) = number of values in group - info(2*i+3) = number type for value i - Other info entries are always zero*/ - - header->tags.setValue(MDL_DM3_TAGCLASS, (std::string) "Group", id); - header->tags.setValue(MDL_DM3_SIZE,(int) info[2], id); - std::vector vtagValue((int)info[2]); - for (int n=1;n<=info[2];n++) - { - double fieldValue=0; - FREADTagValueDM4(&fieldValue,info[2+2*n],1,fimg,swap); - vtagValue.assign(n,fieldValue); - } - header->tags.setValue(MDL_DM3_VALUE, vtagValue, id); - delete []info; - return 0; - } - delete []info; - } - return 0; -} - -/** DM4 Get DM4 parent - * @ingroup DM4 -*/ -int parentDM4(MetaData &MD, int nodeId, int depth = 1) -{ - for (int n = 0; n < depth; n++) - { - MD.getValue(MDL_DM3_PARENTID, nodeId, MD.firstObject(MDValueEQ(MDL_DM3_NODEID, nodeId))); - - if (nodeId == 0) - break; - } - return nodeId; -} - -/** DM4 Go to tag - * @ingroup DM4 -*/ -size_t gotoTagDM4(MetaData &MD, int &nodeId, const std::string &tagsList) -{ - std::string tag; - std::vector vTags; - splitString(tagsList,",",vTags, false); - size_t id=0; - - MDValueEQ queryParentId(MDL_DM3_PARENTID,-1), queryTagname(MDL_DM3_TAGNAME,tag); - MDMultiQuery queries; - - queries.addAndQuery(queryParentId); - queries.addAndQuery(queryTagname); - - for (size_t n = 0; n < vTags.size(); n++) - { - tag = vTags[n]; - - queryParentId.setValue(nodeId); - queryTagname.setValue(tag); - id = MD.firstObject(queries); - if (id != BAD_OBJID) - { - MD.getValue(MDL_DM3_NODEID, nodeId, id); - } - } - return id; -} - -int spaceDM4; -/** DM4 Print DM4 node - * @ingroup DM4 -*/ -void printDM4node(const MetaData &MD, size_t id) -{ - std::string tag; - MD.getValue(MDL_DM3_TAGNAME, tag, id); - - int nodeId; - MD.getValue(MDL_DM3_NODEID, nodeId, id); - - for (int i = 0; i < spaceDM4; i++) - std::cout << " "; - - std::cout << tag << std::endl; - - std::vector vObjs; - MD.findObjects(vObjs, MDValueEQ(MDL_DM3_PARENTID, nodeId)); - - spaceDM4 += 3; - - for (size_t i = 0; i < vObjs.size(); i++) - printDM4node(MD, vObjs[i]); - - spaceDM4 -= 3; - -} - -/** DM4 Print DM4 header - * @ingroup DM4 -*/ -void printDM4(const MetaData &MD) -{ - std::vector vObjs; - spaceDM4 = 0; - MD.findObjects(vObjs,MDValueEQ(MDL_DM3_PARENTID, 0)); - - for (size_t i = 0; i < vObjs.size(); i++) - printDM4node(MD, vObjs[i]); -} - -/** DM4 Reader - * @ingroup DM4 -*/ -int ImageBase::readDM4(size_t select_img,bool isStack) -{ -#undef DEBUG - //#define DEBUG -#ifdef DEBUG - printf("DEBUG readDM4: Reading DM4 file\n"); -#endif - - DM4head * header = new DM4head; - int dummy; - - // Check Machine endianness - bool isLE = IsLittleEndian(); - - xmippFREAD(&header->fileVersion, sizeof(int), 1, fimg, isLE); - xmippFREAD(&dummy, sizeof(long), 1, fimg, isLE); - xmippFREAD(&header->byteOrder, sizeof(int), 1, fimg, isLE); - - // Set Endianess - swap = (isLE^header->byteOrder); - - if ( header->fileVersion!=4 ) - REPORT_ERROR(ERR_IO_NOREAD, "readDM4: Input file is not Digital Micrograph 3 format."); - - xmippFREAD(&header->sorted, sizeof(char), 1, fimg, false); - xmippFREAD(&header->open, sizeof(char), 1, fimg, false); - xmippFREAD(&header->nTags, sizeof(long), 1, fimg, isLE); - - header->tags.addLabel(MDL_DM3_NODEID); - header->tags.addLabel(MDL_DM3_PARENTID); - header->tags.addLabel(MDL_DM3_IDTAG); - header->tags.addLabel(MDL_DM3_TAGNAME); - header->tags.addLabel(MDL_DM3_TAGCLASS); - header->tags.addLabel(MDL_DM3_SIZE); - header->tags.addLabel(MDL_DM3_NUMBER_TYPE); - header->tags.addLabel(MDL_DM3_VALUE); - - int nodeID = 0, parentID = 0; - - for (int n=1;n<=header->nTags;n++) - readTagDM4(fimg, header, parentID, nodeID, isLE, swap); - -//#define DEBUG -#ifdef DEBUG - - header->tags.write("images.txt"); - printDM4(header->tags); -#endif - - - //std::vector vIm; - //header->tags.findObjects(vIm, ); - - header->nIm = 0; - std::vector dataHeaders; - DM4dataHead dhRef; - - std::vector vValue; - int iValue; - - //Initialize query for later use - MDValueEQ queryNodeId(MDL_DM3_NODEID, -1); - - std::vector objIdsDataType; - header->tags.findObjects(objIdsDataType, MDValueEQ(MDL_DM3_TAGNAME,(String)"DataType")); - - for (size_t objId : objIdsDataType) - // Read all the image headers - //for (int n = 0; n < vIm.size(); n++) - { - //header->tags.goToObject(vIm[n]); - header->tags.getValue(MDL_DM3_VALUE, vValue, objId); - - if (vValue[0] != 23) //avoid thumb images - { - dataHeaders.push_back(dhRef); - - parentID = parentDM4(header->tags, objId, 2); - - size_t id; - nodeID = parentID; - id = gotoTagDM4(header->tags, nodeID, "ImageData,Data"); - header->tags.getValue(MDL_DM3_NUMBER_TYPE, iValue, id); - dataHeaders[header->nIm].dataType = (short int) iValue; - - header->tags.getValue(MDL_DM3_VALUE, vValue, id); - dataHeaders[header->nIm].headerSize = (size_t) vValue[0]; - - nodeID = parentID; - id = gotoTagDM4(header->tags, nodeID, "ImageData,Dimensions"); - - int nDims; - header->tags.getValue(MDL_DM3_SIZE, nDims, id); - - nodeID++; - queryNodeId.setValue(nodeID); - id = header->tags.firstObject(queryNodeId); - header->tags.getValue(MDL_DM3_VALUE, vValue, id); - dataHeaders[header->nIm].imageWidth = (int) vValue[0]; - - nodeID++; - queryNodeId.setValue(nodeID); - id = header->tags.firstObject(queryNodeId); - header->tags.getValue(MDL_DM3_VALUE, vValue, id); - dataHeaders[header->nIm].imageHeight = (int) vValue[0]; - - if (nDims ==3 ) - { - nodeID++; - queryNodeId.setValue(nodeID); - id = header->tags.firstObject(queryNodeId); - header->tags.getValue(MDL_DM3_VALUE, vValue, id); - dataHeaders[header->nIm].imageDepth = (int) vValue[0]; - } else - dataHeaders[header->nIm].imageDepth = 1; - - nodeID++; - queryNodeId.setValue(nodeID); - id = header->tags.firstObject(queryNodeId); - header->tags.getValue(MDL_DM3_VALUE, vValue, id); - dataHeaders[header->nIm].dataTypeSize = (short int) vValue[0]; - - nodeID = parentID; - id = gotoTagDM4(header->tags, nodeID, "ImageTags,Acquisition,Frame,CCD,Pixel Size (um)"); - // header->tags.nextObject(); - if (id != BAD_OBJID) - { - header->tags.getValue(MDL_DM3_VALUE, vValue, id); - dataHeaders[header->nIm].pixelHeight = vValue[0]*1e4; - dataHeaders[header->nIm].pixelWidth = vValue[1]*1e4; - } - - //TODO: Do I have to include FLIP?!?!? which? vertical or horizontal? - header->nIm++; - } - - } - - if (dataHeaders.size() == 0) - REPORT_ERROR(ERR_IMG_NOREAD,formatString("readDM4: Image information not found in file %s",filename.c_str())); - - int _xDim,_yDim, _zDim; - size_t _nDim; - _xDim = dataHeaders[0].imageWidth; - _yDim = dataHeaders[0].imageHeight; - _zDim = 1; - _nDim = dataHeaders[0].imageDepth; - //_nDim = header->nIm; - - // Map the parameters - if (select_img > _nDim) - REPORT_ERROR(ERR_INDEX_OUTOFBOUNDS, formatString("readDM4: Image number %lu exceeds stack size %lu", select_img, _nDim)); - else if (select_img == ALL_IMAGES) - { -// // Check images dimensions. Need to be the same -// for (size_t i = 1; i < _nDim ; i++) -// { -// if (dataHeaders[0].imageHeight != dataHeaders[i].imageHeight || \ -// dataHeaders[0].imageWidth != dataHeaders[i].imageWidth || \ -// dataHeaders[0].dataType != dataHeaders[i].dataType) -// REPORT_ERROR(ERR_IMG_NOREAD, "readDM4: images in DM4 file with different \ -// dimensions and data types are not currently supported. Try to read them individually."); -// } -// //FIXME: Code is not totally implemented to load automatically multiple images if they have same size. -// //if (_nDim > 1) -// // REPORT_ERROR(ERR_IO_NOREAD, "readDM4: Reading multiple \ -// images at once in DM4 file are not currently supported. Try to read them individually."); - } - else - _nDim = 1; - - setDimensions(_xDim, _yDim, _zDim, _nDim); - - size_t imgStart = IMG_INDEX(select_img); - size_t imgEnd = (select_img != ALL_IMAGES) ? imgStart + 1 : _nDim; - - DataType datatype = datatypeDM4(dataHeaders[0].dataType); - - MDMainHeader.setValue(MDL_SAMPLINGRATE_X,(double)dataHeaders[0].pixelWidth); - MDMainHeader.setValue(MDL_SAMPLINGRATE_Y,(double)dataHeaders[0].pixelHeight); - MDMainHeader.setValue(MDL_DATATYPE,(int)datatype); - - if (dataMode == HEADER) // Stop reading if not necessary - { - delete header; - return 0; - } - - MD.clear(); - for (size_t i = 0; i < imgEnd-imgStart; i++) - MD.push_back(std::unique_ptr(new MDRowVec(MDL::emptyHeaderVec()))); - offset = dataHeaders[0].headerSize; - delete header; - - if( dataMode < DATA ) - return 0; - -#undef DEBUG -#ifdef DEBUG - - MDMainHeader.write(std::cerr); - MD.write(std::cerr); -#endif - - size_t pad = 0; - readData(fimg, select_img, datatype, pad); - - return(0); -} - -int ImageBase::writeDM4(size_t img_select, bool isStack, int mode) -{ - REPORT_ERROR(ERR_IO_NOWRITE, "ERROR: writeDM4 is not implemented."); -} diff --git a/src/core/rwDM4.h b/src/core/rwDM4.h deleted file mode 100644 index 4c54ab9..0000000 --- a/src/core/rwDM4.h +++ /dev/null @@ -1,42 +0,0 @@ -/*************************************************************************** - * Authors: Joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef RWDM4_H_ -#define RWDM4_H_ - -///@defgroup DM4 DM4 File format -///@ingroup ImageFormats - -/** DM4 Reader - * @ingroup DM4 -*/ -int readDM4(size_t img_select,bool isStack=false); - -/** DM4 Writer - * @ingroup DM4 -*/ -int writeDM4(size_t img_select, bool isStack=false, int mode=WRITE_OVERWRITE); - -#endif /* RWDM4_H_ */ diff --git a/src/core/rwEER.cpp b/src/core/rwEER.cpp deleted file mode 100644 index 65a2bb9..0000000 --- a/src/core/rwEER.cpp +++ /dev/null @@ -1,670 +0,0 @@ -/*************************************************************************** - * - * Authors: Oier Lauzirika Zarrabeitia (olauzirika@cnb.csic.es) - * Martin Salinas Anton (martin.salinas@cnb.csic.es) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ -/*************************************************************************** - * - * Author: "Sjors H.W. Scheres" - * MRC Laboratory of Molecular Biology - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * This complete copyright notice must be included in any revised version of the - * source code. Additional authorship citations may be added, but existing - * author citations must be preserved. - ***************************************************************************/ - -#include -#include -#include -#include - -#include "multidim_array.h" -#include "xmipp_error.h" -#include "xmipp_filename.h" -#include "xmipp_image_base.h" -#include "metadata_vec.h" - -#ifdef TIMING - #define RCTIC(label) (EERtimer.tic(label)) - #define RCTOC(label) (EERtimer.toc(label)) - - Timer EERtimer; - int TIMING_READ_EER = EERtimer.setNew("read EER"); - int TIMING_BUILD_INDEX = EERtimer.setNew("build index"); - int TIMING_UNPACK_RLE = EERtimer.setNew("unpack RLE"); - int TIMING_RENDER_ELECTRONS = EERtimer.setNew("render electrons"); -#else - #define RCTIC(label) - #define RCTOC(label) -#endif - -class EERRenderer { - private: - - FileName fn_movie; - - bool ready; - bool is_legacy; - bool is_7bit; - bool read_data; - - std::vector frame_starts, frame_sizes; - unsigned char* buf; - - static const char EER_FOOTER_OK[]; - static const char EER_FOOTER_ERR[]; - static const int EER_IMAGE_WIDTH, EER_IMAGE_HEIGHT, EER_IMAGE_PIXELS; - static const unsigned int EER_LEN_FOOTER; - static const uint16_t TIFF_COMPRESSION_EER8bit, TIFF_COMPRESSION_EER7bit; - - int eer_upsampling; - int nframes; - int preread_start, preread_end; - long long file_size; - - void readLegacy(FILE *fh) - { - /* Load everything first */ - RCTIC(TIMING_READ_EER); - buf = (unsigned char*)malloc(file_size); - if (buf == NULL) - REPORT_ERROR(ERR_MEM_NOTENOUGH, "Failed to allocate the buffer."); - if (fread(buf, sizeof(char), file_size, fh) != file_size) - REPORT_ERROR(ERR_IO_SIZE, "EERRenderer::readLegacy: Failed to read the expected size from " + fn_movie); - RCTOC(TIMING_READ_EER); - - /* Build frame index */ - RCTIC(TIMING_BUILD_INDEX); - long long pos = file_size; - while (pos > 0) - { - pos -= EER_LEN_FOOTER; - if (strncmp(EER_FOOTER_OK, (char*)buf + pos, EER_LEN_FOOTER) == 0) - { - pos -= 8; - long long frame_size = *(long long*)(buf + pos) * sizeof(long long); - pos -= frame_size; - frame_starts.push_back(pos); - frame_sizes.push_back(frame_size); - #ifdef DEBUG_EER - printf("Frame: LAST-%5d Start at: %08d Frame size: %lld\n", frame_starts.size(), pos, frame_size); - #endif - } - else // if (strncmp(EER_FOOTER_ERR, (char*)buf + pos, EER_LEN_FOOTER) == 0) - { - REPORT_ERROR(ERR_DOCFILE, "Broken frame in file " + fn_movie); - } - } - std::reverse(frame_starts.begin(), frame_starts.end()); - std::reverse(frame_sizes.begin(), frame_sizes.end()); - RCTOC(TIMING_BUILD_INDEX); - - nframes = frame_starts.size(); - read_data = true; - } - - void lazyReadFrames() - { - #pragma omp critical(EERRenderer_lazyReadFrames) - { - if (!read_data) // cannot return from within omp critical - { - TIFF *ftiff = TIFFOpen(fn_movie.c_str(), "r"); - - frame_starts.resize(nframes, 0); - frame_sizes.resize(nframes, 0); - buf = (unsigned char*)malloc(file_size); // This is big enough - if (buf == NULL) - REPORT_ERROR(ERR_MEM_NOTENOUGH, "Failed to allocate the buffer for " + fn_movie); - long long pos = 0; - - // Read everything - for (int frame = 0; frame < nframes; frame++) - { - if ((preread_start > 0 && frame < preread_start) || - (preread_end > 0 && frame > preread_end)) - continue; - - TIFFSetDirectory(ftiff, frame); - const int nstrips = TIFFNumberOfStrips(ftiff); - frame_starts[frame] = pos; - - for (int strip = 0; strip < nstrips; strip++) - { - const int strip_size = TIFFRawStripSize(ftiff, strip); - if (pos + strip_size >= file_size) - REPORT_ERROR(ERR_LOGIC_ERROR, "EER: buffer overflow when reading raw strips."); - - TIFFReadRawStrip(ftiff, strip, buf + pos, strip_size); - pos += strip_size; - frame_sizes[frame] += strip_size; - } - #ifdef DEBUG_EER - printf("EER in TIFF: Read frame %d from %s, nstrips = %d, current pos in buffer = %lld / %lld\n", frame, fn_movie.c_str(), nstrips, pos, file_size); - #endif - } - - TIFFClose(ftiff); - - read_data = true; - } - } - } - - template - void render16K(MultidimArray &image, std::vector &positions, std::vector &symbols, int n_electrons) - { - for (int i = 0; i < n_electrons; i++) - { - int x = ((positions[i] & 4095) << 2) | (symbols[i] & 3); // 4095 = 111111111111b, 3 = 00000011b - int y = ((positions[i] >> 12) << 2) | ((symbols[i] & 12) >> 2); // 4096 = 2^12, 12 = 00001100b - DIRECT_A2D_ELEM(image, y, x)++; - } - } - - template - void render8K(MultidimArray &image, std::vector &positions, std::vector &symbols, int n_electrons) - { - for (int i = 0; i < n_electrons; i++) - { - int x = ((positions[i] & 4095) << 1) | ((symbols[i] & 2) >> 1); // 4095 = 111111111111b, 2 = 00000010b - int y = ((positions[i] >> 12) << 1) | ((symbols[i] & 8) >> 3); // 4096 = 2^12, 8 = 00001000b - DIRECT_A2D_ELEM(image, y, x)++; - } - } - - template - void render4K(MultidimArray &image, std::vector &positions, std::vector &symbols, int n_electrons) - { - for (int i = 0; i < n_electrons; i++) - { - int x = positions[i] & 4095; // 4095 = 111111111111b - int y = positions[i] >> 12; // 4096 = 2^12 - DIRECT_A2D_ELEM(image, y, x)++; - } - } - - static TIFFErrorHandler prevTIFFWarningHandler; - - public: - - EERRenderer() - { - ready = false; - read_data = false; - buf = NULL; - preread_start = -1; - preread_end = -1; - eer_upsampling = 2; - } - - ~EERRenderer() - { - if (buf != NULL) - free(buf); - } - - //TODO: Implement proper copy constructors. Currently, they are disabled to prevent memory corruption. - EERRenderer(const EERRenderer&) - { - REPORT_ERROR(ERR_NOT_IMPLEMENTED, "Copy constructor for EERRenderer not implemented yet."); - } - - EERRenderer& operator=(const EERRenderer&) - { - REPORT_ERROR(ERR_NOT_IMPLEMENTED, "Copy assignment operator for EERRenderer not implemented yet."); - } - - // Wrapper to the default TIFF warning handler to suppress EER private tag warnings - static void TIFFWarningHandler(const char* module, const char* fmt, va_list ap) - { - // Silence warnings for private tags - if (strcmp("Unknown field with tag %d (0x%x) encountered", fmt) == 0) - return; - - if (prevTIFFWarningHandler != NULL) - prevTIFFWarningHandler(module, fmt, ap); - } - - static void silenceTIFFWarnings() - { - if (prevTIFFWarningHandler == NULL) - { - // Thread safety issue: - // Calling this simultaneously is safe but - TIFFErrorHandler prev = TIFFSetWarningHandler(EERRenderer::TIFFWarningHandler); - - // we have to make sure prevTIFFWarningHandler does NOT become our own TIFFWarningHandler - // to avoid an infinite loop. - if (prev != EERRenderer::TIFFWarningHandler) - prevTIFFWarningHandler = prev; - } - } - - // 1-indexed - void setFramesOfInterest(int start, int end) - { - if (is_legacy) - return; - - if (read_data) - REPORT_ERROR(ERR_LOGIC_ERROR, "Logic error in EERRenderer::setFramesOfInterest(). This must be set before rendering."); - preread_start = start - 1; - preread_end = end - 1; - } - - void read(const FileName &_fn_movie, int eer_upsampling) - { - if (ready) - REPORT_ERROR(ERR_LOGIC_ERROR, "Logic error: you cannot recycle EERRenderer for multiple files (now)"); - - if (eer_upsampling == 1 || eer_upsampling == 2 || eer_upsampling == 3) - this->eer_upsampling = eer_upsampling; - else - { - std::cerr << "EERRenderer::read: eer_upsampling = " << eer_upsampling << std::endl; - REPORT_ERROR(ERR_PARAM_INCORRECT, "EERRenderer::read: eer_upsampling must be 1, 2 or 3."); - } - - fn_movie = _fn_movie; - - // First of all, check the file size - FILE *fh = fopen(fn_movie.c_str(), "r"); - if (fh == NULL) - REPORT_ERROR(ERR_IO_NOTOPEN, "Failed to open " + fn_movie); - - fseek(fh, 0, SEEK_END); - file_size = ftell(fh); - fseek(fh, 0, SEEK_SET); - - silenceTIFFWarnings(); - - // Try reading as TIFF - TIFF *ftiff = TIFFOpen(fn_movie.c_str(), "r"); - - if (ftiff == NULL) - { - is_legacy = true; - is_7bit = false; - readLegacy(fh); - } - else - { - is_legacy = false; - - // Check width & size - int width, height; - uint16_t compression = 0; - TIFFGetField(ftiff, TIFFTAG_IMAGEWIDTH, &width); - TIFFGetField(ftiff, TIFFTAG_IMAGELENGTH, &height); - TIFFGetField(ftiff, TIFFTAG_COMPRESSION, &compression); - - #ifdef DEBUG_EER - printf("EER in TIFF: %s size = %ld, width = %d, height = %d, compression = %d\n", fn_movie.c_str(), file_size, width, height, compression); - #endif - - // TIA can write an EER file whose first page is a sum and compressoin == 1. - // This is not supported (yet). EPU never writes such movies. - if (compression == EERRenderer::TIFF_COMPRESSION_EER8bit) - is_7bit = false; - else if (compression == EERRenderer::TIFF_COMPRESSION_EER7bit) - is_7bit = true; - else - REPORT_ERROR(ERR_PARAM_INCORRECT, "Unknown compression scheme for EER " + integerToString(compression)); - - if (width != EER_IMAGE_WIDTH || height != EER_IMAGE_HEIGHT) - REPORT_ERROR(ERR_PARAM_INCORRECT, "Currently we support only 4096x4096 pixel EER movies."); - - // Find the number of frames - nframes = TIFFNumberOfDirectories(ftiff); - TIFFClose(ftiff); - #ifdef DEBUG_EER - printf("EER in TIFF: %s nframes = %d\n", fn_movie.c_str(), nframes); - #endif - } - - fclose(fh); - ready = true; - } - - int getNFrames() - { - if (!ready) - REPORT_ERROR(ERR_LOGIC_ERROR, "EERRenderer::getNFrames called before ready."); - - return nframes; - } - - int getWidth() - { - if (!ready) - REPORT_ERROR(ERR_LOGIC_ERROR, "EERRenderer::getNFrames called before ready."); - - return EER_IMAGE_WIDTH << (eer_upsampling - 1); - } - - int getHeight() - { - if (!ready) - REPORT_ERROR(ERR_LOGIC_ERROR, "EERRenderer::getNFrames called before ready."); - - return EER_IMAGE_HEIGHT << (eer_upsampling - 1); - } - - // Frame indices are 1-indexed. - // image is cleared. - // This function is thread-safe (except for timing). - // It is caller's responsibility to make sure type T does not overflow. - template - long long renderFrames(int frame_start, int frame_end, MultidimArray &image) - { - if (!ready) - REPORT_ERROR(ERR_LOGIC_ERROR, "EERRenderer::renderNFrames called before ready."); - - lazyReadFrames(); - - if (frame_start < 0 || frame_start >= getNFrames() || - frame_end < frame_start || frame_end >= getNFrames()) - { - std::cerr << "EERRenderer::renderFrames(frame_start = " << frame_start << ", frame_end = " << frame_end << "), NFrames = " << getNFrames() << std::endl; - REPORT_ERROR(ERR_PARAM_INCORRECT, "Invalid frame range was requested."); - } - - long long total_n_electron = 0; - - std::vector positions; - std::vector symbols; - image.initZeros(getHeight(), getWidth()); - - for (int iframe = frame_start; iframe <= frame_end; iframe++) - { - RCTIC(TIMING_UNPACK_RLE); - if ((preread_start > 0 && iframe < preread_start) || - (preread_end > 0 && iframe > preread_end)) - { - std::cerr << "EERRenderer::renderFrames(frame_start = " << frame_start + 1 << ", frame_end = " << frame_end + 1<< "), NFrames = " << getNFrames() << " preread_start = " << preread_start + 1 << " prered_end = " << preread_end + 1<< std::endl; - REPORT_ERROR(ERR_LOGIC_ERROR, "Tried to render frames outside pre-read region"); - } - - long long pos = frame_starts[iframe]; - unsigned int n_pix = 0, n_electron = 0; - const int max_electrons = frame_sizes[iframe] * 2; // at 4 bits per electron (very permissive bound!) - if (positions.size() < max_electrons) - { - positions.resize(max_electrons); - symbols.resize(max_electrons); - } - - if (is_7bit) - { - unsigned int bit_pos = 0; // 4 K * 4 K * 11 bit << 2 ** 32 - unsigned char p, s; - - while (true) - { - // Fetch 32 bits and unpack up to 2 chunks of 7 + 4 bits. - // This is faster than unpack 7 and 4 bits sequentially. - // Since the size of buf is larger than the actual size by the TIFF header size, - // it is always safe to read ahead. - - long long first_byte = pos + (bit_pos >> 3); - const unsigned int bit_offset_in_first_byte = bit_pos & 7; // 7 = 00000111 (same as % 8) - const unsigned int chunk = (*(unsigned int*)(buf + first_byte)) >> bit_offset_in_first_byte; - - p = (unsigned char)(chunk & 127); // 127 = 01111111 - bit_pos += 7; // TODO: we can remove this for further speed. - n_pix += p; - if (n_pix >= EER_IMAGE_PIXELS) break; - if (p == 127) continue; // this should be rare. - - s = (unsigned char)((chunk >> 7) & 15) ^ 0x0A; // 15 = 00001111; See below for 0x0A - bit_pos += 4; - positions[n_electron] = n_pix; - symbols[n_electron] = s; - n_electron++; - n_pix++; - - p = (unsigned char)((chunk >> 11) & 127); // 127 = 01111111 - bit_pos += 7; - n_pix += p; - if (n_pix >= EER_IMAGE_PIXELS) break; - if (p == 127) continue; - - s = (unsigned char)((chunk >> 18) & 15) ^ 0x0A; // 15 = 00001111; See below for 0x0A - bit_pos += 4; - positions[n_electron] = n_pix; - symbols[n_electron] = s; - n_electron++; - n_pix++; - } - } - else - { - // unpack every two symbols = 12 bit * 2 = 24 bit = 3 byte - // high <- |bbbbBBBB|BBBBaaaa|AAAAAAAA| -> low - // With SIMD intrinsics at the SSSE3 level, we can unpack 10 symbols (120 bits) simultaneously. - unsigned char p1, p2, s1, s2; - - const long long pos_limit = frame_starts[iframe] + frame_sizes[iframe]; - // Because there is a footer, it is safe to go beyond the limit by two bytes. - while (pos < pos_limit) - { - // symbol is bit tricky. 0000YyXx; Y and X must be flipped. - p1 = buf[pos]; - s1 = (buf[pos + 1] & 0x0F) ^ 0x0A; // 0x0F = 00001111, 0x0A = 00001010 - - p2 = (buf[pos + 1] >> 4) | (buf[pos + 2] << 4); - s2 = (buf[pos + 2] >> 4) ^ 0x0A; - - // Note the order. Add p before checking the size and placing a new electron. - n_pix += p1; - if (n_pix >= EER_IMAGE_PIXELS) break; - if (p1 < 255) - { - positions[n_electron] = n_pix; - symbols[n_electron] = s1; - n_electron++; - n_pix++; - } - - n_pix += p2; - if (n_pix >= EER_IMAGE_PIXELS) break; - if (p2 < 255) - { - positions[n_electron] = n_pix; - symbols[n_electron] = s2; - n_electron++; - n_pix++; - } - #ifdef DEBUG_EER_DETAIL - printf("%d: %u %u, %u %u %d\n", pos, p1, s1, p2, s2, n_pix); - #endif - pos += 3; - } - } - - if (n_pix != EER_IMAGE_PIXELS) - { - std::cerr << "WARNING: The number of pixels is not right in " + fn_movie + " frame " + integerToString(iframe + 1) + ". Probably this frame is corrupted. This frame is skipped." << std::endl; - continue; - } - - RCTOC(TIMING_UNPACK_RLE); - - RCTIC(TIMING_RENDER_ELECTRONS); - if (eer_upsampling == 3) - render16K(image, positions, symbols, n_electron); - else if (eer_upsampling == 2) - render8K(image, positions, symbols, n_electron); - else if (eer_upsampling == 1) - render4K(image, positions, symbols, n_electron); - else - REPORT_ERROR(ERR_LOGIC_ERROR, "Invalid EER upsample"); - RCTOC(TIMING_RENDER_ELECTRONS); - - total_n_electron += n_electron; - #ifdef DEBUG_EER - printf("Decoded %lld electrons / %d pixels from frame %5d.\n", n_electron, n_pix, iframe); - #endif - } - #ifdef DEBUG_EER - printf("Decoded %lld electrons in total.\n", total_n_electron); - #endif - - #ifdef TIMING - EERtimer.printTimes(false); - #endif - - return total_n_electron; - } - - static bool isEER(const FileName &fn_movie) - { - FileName ext = fn_movie.getExtension(); - return (ext == "eer" || ext == "ecc"); - } -}; - -const char EERRenderer::EER_FOOTER_OK[] = "ThermoFisherECComprOK000"; -const char EERRenderer::EER_FOOTER_ERR[] = "ThermoFisherECComprERR00"; -const int EERRenderer::EER_IMAGE_WIDTH = 4096; -const int EERRenderer::EER_IMAGE_HEIGHT = 4096; -const int EERRenderer::EER_IMAGE_PIXELS = EERRenderer::EER_IMAGE_WIDTH * EERRenderer::EER_IMAGE_HEIGHT; -const unsigned int EERRenderer::EER_LEN_FOOTER = 24; -const uint16_t EERRenderer::TIFF_COMPRESSION_EER8bit = 65000; -const uint16_t EERRenderer::TIFF_COMPRESSION_EER7bit = 65001; - -TIFFErrorHandler EERRenderer::prevTIFFWarningHandler = NULL; - -int ImageBase::readEER(size_t select_img) { - int upsampling = 1; - StringVector info; - DataType datatype; - size_t found = filename.find_first_of("#"); - FileName infolist = filename.substr(found + 1); - filename = filename.substr(0, found); - splitString(infolist, ",", info, false); - - if (info.size() < 3) - REPORT_ERROR(ERR_ARG_MISSING, (String) "Cannot open file " + filename + - ". Not enough header arguments."); - - const int fractioning = std::atoi(info[0].c_str()); - if (fractioning < 1) - { - REPORT_ERROR(ERR_PARAM_INCORRECT, "Incorrect fractioning value (must be greater than zero)"); - } - if (select_img > fractioning) { - REPORT_ERROR(ERR_PARAM_INCORRECT, (String) "Incorrect frame number selected (" + std::to_string(select_img) + "). Number of frames is " + std::to_string(fractioning) + "."); - } - - int _xDim,_yDim,_zDim; - size_t _nDim; - if (info[1] == "4K") - { - _xDim = _yDim = 4096; - } - else if (info[1] == "8K") - { - _xDim = _yDim = 8192; - } - else { - REPORT_ERROR(ERR_PARAM_INCORRECT, "Incorrect output size. Valid sizes are: 4K, 8K."); - } - - _zDim = 1; - _nDim = select_img > 0 ? 1 : fractioning; - setDimensions(_xDim, _yDim, _zDim, _nDim); - mdaBase->coreAllocateReuse(); - - if(info[2] == "uint8") - datatype = DT_UChar; - else if (info[2] == "uint16") - datatype = DT_UShort; - else - REPORT_ERROR(ERR_PARAM_INCORRECT, "Incorrect output data type. Valid types are: uint8, uint16."); - - MDMainHeader.setValue(MDL_SAMPLINGRATE_X,(double) -1); - MDMainHeader.setValue(MDL_SAMPLINGRATE_Y,(double) -1); - MDMainHeader.setValue(MDL_DATATYPE,(int)datatype); - - MD.clear(); - MD.push_back(std::unique_ptr(new MDRowVec(MDL::emptyHeaderVec()))); - - if( dataMode < DATA ) - return 0; - - EERRenderer renderer; - renderer.read(dataFName, upsampling); - - MultidimArray buffer; - const auto nEerFrames = renderer.getNFrames(); - const auto step = nEerFrames / fractioning; - if (select_img > 0) - { - // Render single frame - if (select_img > fractioning) - { - REPORT_ERROR(ERR_LOGIC_ERROR, "Requested frame greater than the fractioning"); - } - else - { - - buffer.resizeNoCopy(_yDim, _xDim); - const auto first = (select_img-1)*step; - const auto last = first + step - 1; - renderer.renderFrames(first, last, buffer); - } - } - else - { - // Render the whole movie - buffer.resizeNoCopy(fractioning, 1, _yDim, _xDim); - MultidimArray frameAlias; - for(size_t i = 0; i < fractioning; ++i) - { - frameAlias.aliasImageInStack(buffer, i); - const auto first = i*step; - const auto last = first + step - 1; - renderer.renderFrames(first, last, frameAlias); - } - } - - setPage2T( - 0UL, reinterpret_cast(MULTIDIM_ARRAY(buffer)), - DT_Int, - MULTIDIM_SIZE(buffer) - ); - - return 0; -} diff --git a/src/core/rwEER.h b/src/core/rwEER.h deleted file mode 100644 index ade99a5..0000000 --- a/src/core/rwEER.h +++ /dev/null @@ -1,51 +0,0 @@ -/*************************************************************************** - * - * Authors: Oier Lauzirika Zarrabeitia (olauzirika@cnb.csic.es) - * Martin Salinas Anton (martin.salinas@cnb.csic.es) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ -/*************************************************************************** - * - * Author: "Sjors H.W. Scheres" - * MRC Laboratory of Molecular Biology - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * This complete copyright notice must be included in any revised version of the - * source code. Additional authorship citations may be added, but existing - * author citations must be preserved. - ***************************************************************************/ - -#ifndef CORE_RWEER_H -#define CORE_RWEER_H - -int readEER(size_t select_img); - -#endif /* RWEER_H_ */ diff --git a/src/core/rwEM.cpp b/src/core/rwEM.cpp deleted file mode 100644 index 69f7fbb..0000000 --- a/src/core/rwEM.cpp +++ /dev/null @@ -1,152 +0,0 @@ -/*************************************************************************** - * Authors: Joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include "xmipp_image_base.h" -#include "xmipp_error.h" -#include "xmipp_funcs.h" -#include "metadata_static.h" - -#define EMHEADERSIZE 512 // size of EM file header - -int ImageBase::readEM(size_t select_img, bool isStack) -{ - // EM File formats does not support stacks - if (select_img > FIRST_IMAGE & !isStack) - REPORT_ERROR(ERR_ARG_INCORRECT, "readEM: EM file format does not support stacks."); - - EMHead header; - - if ( fread( &header, EMHEADERSIZE, 1, fimg ) != 1 ) - REPORT_ERROR(ERR_IO_NOREAD, formatString("rwEM: cannot read EM main header from file %s" - ". Error message: %s", filename.c_str() ,strerror(errno))); - - // endian: If machine is SGI, OS-9 or MAC: Big Endian, otherwise Litle Endian - // Check Machine endianess - bool isLE = IsLittleEndian(); - - if (header.machine == 0 || header.machine == 3 || header.machine == 5) - swap = isLE; - else if (header.machine == 1 || header.machine == 2 || header.machine == 4 || header.machine == 6) - swap = !isLE; - else - REPORT_ERROR(ERR_IMG_UNKNOWN, "rwEM: Unknown source machine to determine Endianness"); - - if (swap) - swapPage((char *) &header, EMHEADERSIZE - 256, DT_UInt); // EMHEADERSIZE - 256 is to exclude userdata from swapping - - // Setting image dimensions - - ArrayDim aDim; - if (isStack) - { - if ( select_img > header.zdim ) - REPORT_ERROR(ERR_INDEX_OUTOFBOUNDS, formatString("readEM: %s Image number %lu exceeds stack size %lu", this->filename.c_str(), select_img, header.zdim)); - - aDim.ndim = (select_img > ALL_IMAGES)? 1 : header.zdim; - aDim.zdim = 1; - } - else - { - aDim.ndim = 1; - aDim.zdim = header.zdim; - } - - aDim.xdim = header.xdim; - aDim.ydim= header.ydim; - - replaceNsize = aDim.ndim; - setDimensions(aDim); - - - DataType datatype; - switch (header.datatype) - { - case 1: - datatype = DT_SChar; - break; - case 2: - datatype = DT_Short; - break; - case 4: - datatype = DT_Int; - break; - case 3: - case 5: - datatype = DT_Float; - break; - case 8: - datatype = DT_CFloat; - break; - case 9: - datatype = DT_CDouble; - break; - default: - REPORT_ERROR(ERR_ARG_INCORRECT, formatString("readEM: Unknown datatype value: %c", header.datatype)); - break; - } - MDMainHeader.setValue(MDL_DATATYPE,(int)datatype); - - offset = EMHEADERSIZE; - - // If only header is read: return - if (dataMode==HEADER || (dataMode == _HEADER_ALL && aDim.ndim > 1)) // Stop reading if not necessary - return 0; - - size_t imgStart = IMG_INDEX(select_img); - size_t imgEnd = (select_img != ALL_IMAGES) ? imgStart + 1 : aDim.ndim; - - MD.clear(); - for (size_t i = 0; i < imgEnd-imgStart; i++) - MD.push_back(std::unique_ptr(new MDRowVec(MDL::emptyHeaderVec()))); - - /* As MRC does not support stacks, we use the geometry stored in the header - for any image when we simulate the file is a stack.*/ - if (dataMode == _HEADER_ALL || dataMode == _DATA_ALL) - { - for ( size_t i = 0; i < imgEnd - imgStart; ++i ) - { - MD[i]->setValue(MDL_SHIFT_X, 0.); - MD[i]->setValue(MDL_SHIFT_Y, 0.); - MD[i]->setValue(MDL_SHIFT_Z, 0.); - MD[i]->setValue(MDL_ORIGIN_X, 0.); - MD[i]->setValue(MDL_ORIGIN_Y, 0.); - MD[i]->setValue(MDL_ORIGIN_Z, 0.); - } - } - - if ( dataMode < DATA ) // Don't read the individual header and the data if not necessary - return 0; - - readData(fimg, select_img, datatype, 0); - - return(0); -} - - -int ImageBase::writeEM(size_t select_img, bool isStack, int mode) -{ - REPORT_ERROR(ERR_IO_NOWRITE, "ERROR: writeEM is not implemented."); - return(-1); -} diff --git a/src/core/rwEM.h b/src/core/rwEM.h deleted file mode 100644 index 8878108..0000000 --- a/src/core/rwEM.h +++ /dev/null @@ -1,133 +0,0 @@ -/*************************************************************************** - * Authors: Joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_RWEM_H_ -#define CORE_RWEM_H_ - -///defgroup EM EM File format -///@ingroup ImageFormats - -/** Information obtained from: - * http://www.biochem.mpg.de/doc_tom/TOM_Release_2008/IOfun/tom_isemfile.html - */ - -typedef struct -{ - char machine; - /** Machine: Value: - OS-9 0 - VAX 1 - Convex 2 - SGI 3 - Mac 5 - PC 6 */ - char gPurpose; //> General purpose. On OS-9 system: 0 old version 1 is new version - char unused; //> Not used in standard EM-format, if this byte is 1 the header is abandoned. - char datatype; - /** Data TypeCoding: - * Image Type: No. of Bytes: Value: - byte 1 1 - short 2 2 - long int 4 4 - float 4 5 - complex 8 8 - double 8 9 */ - //> Three long integers (3x4 bytes) are image size in x, y, z Dimension - int xdim; - int ydim; - int zdim; - char comment[80]; //> 80 Characters as comment - long int params[40]; //> 40 long integers (4 x 40 bytes) are user defined parameters - /** The parameters are coded as follwing: - No. | Name | Value | Factor | Comment - 1 U Volt 1000 accelerating voltage - 2 COE ???m 1000 Cs of objective lense - 3 APE mrad 1000 aperture - 4 VE x 1 end magnification - 5 VN - 1000 postmagnification of CCD - 6 ET s 1000 exposure time in seconds - 7 XG - 1 pixelsize in object-plane - 8 DG nm 1000 EM-Code: - EM420=1; - CM12=2; - CM200=3; - CM120/Biofilter=4; - CM300=5; - CM300/Tecnai=6; - extern=0; - 9 APD nm 1000 photometer aperture - 10 L nm 1000 phys_pixel_size * nr_of_pixels - 11 DF Angstr. 1 defocus, underfocus is neg. - 12 FA Angstr. 1 astigmatism - 13 PHI deg/1000 1000 angle of astigmatism - 14 DR Angstr. 1 drift in Angstr. - 15 DELT deg/1000 1000 direction of drift - 16 DDF Angstr. 1 focusincr. for focus-series - 17 X0 - 1 obsolete - 18 Y0 - 1 obsolete - 19 KW deg/1000 1000 tiltangle - 20 KR deg/1000 1000 axis perpend. to tiltaxis - 21 - Angstr. 1 - 22 SC ASCII 1 - 23 - - - - 24 - pixel 1 internal: subframe X0 - 25 - pixel 1 internal: subframe Y0 - 26 - Angstr. 1000 internal: resolution - 27 - - - internal: density - 28 - - - internal: contrast - 29 - - - internal: unknown - 30 SP - 1000 mass centre X - 31 SP - 1000 mass centre Y - 32 SP - 1000 mass centre Z - 33 H - 1000 height - 34 - - 1000 internal: unknown - 35 D1 - 1000 width 'Dreistrahlbereich' - 36 D2 - 1000 width 'Achrom. Ring' - 37 - - 1 internal: lambda - 38 - - 1 internal: delta theta - 39 - - 1 internal: unknown - 40 - - 1 internal: unknown */ - char userdata[256]; //> 256 Byte with userdata, i.e. the username -} -EMHead; - -/** Read image from EM file format - * - * @param select_img Index number of selected image - * @return - */ -int readEM(size_t select_img, bool isStack=false); - -/** Write image to EM file format - * - * @param select_img Number of selected image to write - * @param isStack Force to write as stack if possible - * @param mode Write file type: overwrite, replace, append.... - * @return - */ -int writeEM(size_t select_img = ALL_IMAGES, bool isStack=false, int mode=WRITE_OVERWRITE); - - -#endif /* RWEM_H_ */ diff --git a/src/core/rwHDF5.cpp b/src/core/rwHDF5.cpp deleted file mode 100644 index d832921..0000000 --- a/src/core/rwHDF5.cpp +++ /dev/null @@ -1,324 +0,0 @@ -/*************************************************************************** - * Authors: Joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include "xmipp_image_base.h" -#include "xmipp_hdf5.h" -#include "multidim_array_base.h" -#include "metadata_static.h" -#include "xmipp_funcs.h" - - -DataType ImageBase::datatypeH5(hid_t h5datatype) -{ - H5T_sign_t h5sign = H5Tget_sign(h5datatype); - - // if (h5sign == H5T_SGN_ERROR) - // REPORT_ERROR(ERR_IO, "datatypeHDF5: Integer sign error in dataset."); - bool sign = (h5sign > H5T_SGN_NONE); - size_t size = H5Tget_size(h5datatype); - - DataType dt; - switch(H5Tget_class(h5datatype)) - { - case H5T_FLOAT: - { - switch(size) - { - case 4: - dt = DT_Float; - break; - case 8: - dt = DT_Double; - break; - default: - REPORT_ERROR(ERR_IO_SIZE, "datatypeHDF5: bad datatype size"); - } - } - break; - case H5T_INTEGER: - { - switch(size) - { - case 1: - dt = (sign)? DT_SChar : DT_UChar; - break; - case 2: - dt = (sign)? DT_Short : DT_UShort; - break; - case 4: - dt = (sign)? DT_Int : DT_UInt; - break; - case 8: - dt = (sign)? DT_Long : DT_ULong; - break; - default: - REPORT_ERROR(ERR_IO_SIZE, "datatypeHDF5: bad datatype size"); - } - } - break; - case H5T_NO_CLASS: - default: - dt = DT_Unknown; - break; - } - return dt; -} - -hid_t ImageBase::H5Datatype(DataType datatype) -{ - switch (datatype) - { - case DT_Float: - return H5T_NATIVE_FLOAT; - case DT_ULong: - return H5T_NATIVE_ULONG; - case DT_Long: - return H5T_NATIVE_LONG; - case DT_UInt: - return H5T_NATIVE_UINT; - case DT_Int: - return H5T_NATIVE_INT; - case DT_UShort: - return H5T_NATIVE_USHORT; - case DT_Short: - return H5T_NATIVE_SHORT; - case DT_UChar: - return H5T_NATIVE_UCHAR; - case DT_SChar: - return H5T_NATIVE_CHAR; - case DT_Double: - return H5T_NATIVE_DOUBLE; - default: - REPORT_ERROR(ERR_NOT_IMPLEMENTED, formatString("rwHDF5: %s datatype not implemented for " \ - " HDF5 datatype", datatype2Str(datatype).c_str())); - break; - } - -} - -class readHDF5Data { -public: - hid_t dataset; /* Dataset and datatype identifiers */ - hid_t filespace; - hsize_t dims[4]; // We are not going to support more than 4 dimensions, at this moment. - hsize_t nobjEman; - hid_t cparms; - int rank; - ~readHDF5Data() { - H5Pclose(cparms); - H5Sclose(filespace); - H5Dclose(dataset); - } -}; - -int ImageBase::readHDF5(size_t select_img) -{ - H5infoProvider provider = getProvider(fhdf5); // Provider name - - String dsname = filename.getBlockName(); - readHDF5Data d; - - // Setting default dataset name - if (dsname.empty()) - { - dsname = provider.second; - - switch (provider.first) - { - case EMAN: // Images in stack are stored in separated groups - hid_t grpid; - grpid = H5Gopen(fhdf5,"/MDF/images/", H5P_DEFAULT); - /*herr_t err = */ - H5Gget_num_objs(grpid, &d.nobjEman); - dsname = formatString(dsname.c_str(), IMG_INDEX(select_img)); - H5Gclose(grpid); - break; - default: - break; - } - } - else - { - switch (provider.first) - { - case EMAN: // Images in stack are stored in separated groups - d.nobjEman=1; - break; - default: - break; - } - } - - d.dataset = H5Dopen2(fhdf5, dsname.c_str(), H5P_DEFAULT); - - if( d.dataset < 0) - REPORT_ERROR(ERR_IO_NOTEXIST, formatString("readHDF5: Dataset '%s' not found",dsname.c_str())); - - d.cparms = H5Dget_create_plist(d.dataset); /* Get properties handle first. */ - - // Get dataset rank and dimension. - d.filespace = H5Dget_space(d.dataset); /* Get filespace handle first. */ - // rank = H5Sget_simple_extent_ndims(filespace); - int rank = H5Sget_simple_extent_dims(d.filespace, d.dims, NULL); - - // Offset only set when it is possible to access to data directly - offset = (H5D_CONTIGUOUS == H5Pget_layout(d.cparms))? H5Dget_offset(d.dataset) : 0; - - hid_t h5datatype = H5Dget_type(d.dataset); - - // Reading byte order - switch(H5Tget_order(h5datatype)) - { - case H5T_ORDER_ERROR: - REPORT_ERROR(ERR_IO, "readHDF5: error reading endianness."); - break; - case H5T_ORDER_LE: - swap = IsBigEndian(); - break; - case H5T_ORDER_BE: - swap = IsLittleEndian(); - break; - default: - REPORT_ERROR(ERR_IO, "readHDF5: unknown endianness type, maybe mixed types."); - break; - } - - DataType datatype = datatypeH5(h5datatype); - MDMainHeader.setValue(MDL_DATATYPE,(int) datatype); - - bool isStack = false; - // Setting isStack depending on provider - switch (provider.first) - { - case MISTRAL: // rank 3 arrays are stacks - isStack = true; - break; - // case EMAN: // Images in stack are stored in separated groups - default: - break; - } - - ArrayDim aDim; - size_t nDimFile; - aDim.xdim = d.dims[rank-1]; - aDim.ydim = (rank>1)?d.dims[rank-2]:1; - aDim.zdim = (rank>3 || (rank==3 && !isStack))?d.dims[rank-3]:1; - if ( provider.first == EMAN ) - nDimFile = d.nobjEman; - else - nDimFile = ( rank<3 || !isStack )?1:d.dims[0] ; - - if (select_img > nDimFile) - REPORT_ERROR(ERR_INDEX_OUTOFBOUNDS, formatString("readHDF5 (%s): Image number %lu exceeds stack size %lu", filename.c_str(), select_img, nDimFile)); - - aDim.ndim = replaceNsize = (select_img == ALL_IMAGES)? nDimFile :1 ; - setDimensions(aDim); - - //Read header only - if(dataMode == HEADER || (dataMode == _HEADER_ALL && aDim.ndim > 1)) - return 0; - - - // EMAN stores each image in a separate dataset - if ( provider.first == EMAN ) - select_img = 1; - - size_t imgStart = IMG_INDEX(select_img); - size_t imgEnd = (select_img != ALL_IMAGES) ? imgStart + 1 : aDim.ndim; - - MD.clear(); - for (size_t i = 0; i < imgEnd-imgStart; i++) - MD.push_back(std::unique_ptr(new MDRowVec(MDL::emptyHeaderVec()))); - - if (dataMode < DATA) // Don't read data if not necessary but read the header - return 0; - - if ( H5Pget_layout(d.cparms) == H5D_CONTIGUOUS ) //We can read it directly - readData(fimg, select_img, datatype, 0); - else // We read it by hyperslabs - { - // Allocate memory for image data (Assume xdim, ydim, zdim and ndim are already set - //if memory already allocated use it (no resize allowed) - mdaBase->coreAllocateReuse(); - - hsize_t offset[4]; // Hyperslab offset in the file - hsize_t count[4]; // Size of the hyperslab in the file - - // Define the offset and count of the hyperslab to be read. - - switch (rank) - { - case 4: - count[0] = 1; - case 3: - // if (stack) - count[rank-3] = aDim.zdim; - offset[rank-2] = 0; - case 2: - count[rank-2] = aDim.ydim; - offset[rank-2] = 0; - break; - } - count[rank-1] = aDim.xdim; - offset[rank-1] = 0; - - aDim.xdim = d.dims[rank-1]; - aDim.ydim = (rank>1)?d.dims[rank-2]:1; - aDim.zdim = (rank == 4)?d.dims[1]:1; - - // Define the memory space to read a hyperslab. - hid_t memspace = H5Screate_simple(rank,count,NULL); - - size_t data = (size_t) this->mdaBase->getArrayPointer(); - size_t pad = aDim.zyxdim*gettypesize(myT()); - - - for (size_t idx = imgStart, imN = 0; idx < imgEnd; ++idx, ++imN) - { - - // Set the offset of the hyperslab to be read - offset[0] = idx; - - if ( H5Sselect_hyperslab(d.filespace, H5S_SELECT_SET, offset, NULL, - count, NULL) < 0 ) - REPORT_ERROR(ERR_IO_NOREAD, formatString("readHDF5: Error selecting hyperslab %d from filename %s", - imgStart, filename.c_str())); - - // Read - if ( H5Dread(d.dataset, H5Datatype(myT()), memspace, d.filespace, - H5P_DEFAULT, (void*)(data + pad*imN)) < 0 ) - REPORT_ERROR(ERR_IO_NOREAD,formatString("readHDF5: Error reading hyperslab %d from filename %s", - imgStart, filename.c_str())); - } - H5Sclose(memspace); - } - - return 0; -} - -int ImageBase::writeHDF5(size_t select_img, bool isStack, int mode, String bitDepth, CastWriteMode castMode) -{ - REPORT_ERROR(ERR_NOT_IMPLEMENTED, "writeHDF5: Not implemented yet."); -} diff --git a/src/core/rwHDF5.h b/src/core/rwHDF5.h deleted file mode 100644 index bfa424d..0000000 --- a/src/core/rwHDF5.h +++ /dev/null @@ -1,52 +0,0 @@ -/*************************************************************************** - * Authors: Joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_RWHDF5_H_ -#define CORE_RWHDF5_H_ - - -///@defgroup HDF5 HDF5 File format -///@ingroup ImageFormats -//@{ - - -/** Determine datatype of a HDF5 dataset. - * @ingroup TIFF - */ -DataType datatypeH5(hid_t dataset); - -hid_t H5Datatype(DataType datatype); - - -/** Read Images from HDF5 container files. - */ -int readHDF5(size_t select_img); - -/** Write Images to HDF5 container files. - */ -int writeHDF5(size_t select_img, bool isStack=false, int mode=WRITE_OVERWRITE, String bitDepth="", CastWriteMode castMode = CW_CAST); - -//@} -#endif /* RWHDF5_H_ */ diff --git a/src/core/rwIMAGIC.cpp b/src/core/rwIMAGIC.cpp deleted file mode 100644 index ce8f6a0..0000000 --- a/src/core/rwIMAGIC.cpp +++ /dev/null @@ -1,506 +0,0 @@ -/*************************************************************************** - * Authors: Joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include "xmipp_image_base.h" -#include "xmipp_error.h" -#include "metadata_static.h" -#include "multidim_array_base.h" -#include - -/* - * rwIMAGIC.h - * - * Created on: May 17, 2010 - * Author: roberto - */ -/* - Base on rwIMAGIC.h - Header file for reading and writing Image Science's Imagic files - Format: 2D image file format for the program Imagic (Image Science) - Author: Bernard Heymann - Created: 19990424 Modified: 20011030 -*/ - -#define IMAGICSIZE 1024 // Size of the IMAGIC header for each image - -#ifndef SIZEOF_INT -#define SIZEOF_INT sizeof(int) -#endif - -///@defgroup Imagic Imagic File format -///@ingroup ImageFormats - -/** Imagic Header - * @ingroup Imagic -*/ -struct IMAGIChead -{ // file header for IMAGIC data - int imn; // 0 image location number (1,2,...) - int ifn; // 1 # images following, only of importance in the first location - int ierror; // 2 error code: error if >0 - int nhfr; // 3 # header records per image - int ndate; // 4 creation day - int nmonth; // 5 creation month - int nyear; // 6 creation year - int nhour; // 7 creation hour - int nminut; // 8 creation minute - int nsec; // 9 creation second - int npix2; // 10 # 4-byte reals in image - int npixel; // 11 # image elements - int ixlp; // 12 lines per image (Y) - int iylp; // 13 pixels per line (X) - char type[4]; // 14 image type - int ixold; // 15 top-left X coordinate - int iyold; // 16 top-left Y coordinate - float avdens; // 17 average - float sigma; // 18 standard deviation - float varian; // 19 variance - float oldavd; // 20 old average - float densmax; // 21 maximum - float densmin; // 22 minimum - // double sum; // 23+24 sum of densities - // double squares; // 25+26 sum of squares - float dummy[4]; // 23-26 dummy place holder - char lastpr[8]; // 27+28 last program writing file - char name[80]; // 29-48 image name - float extra_1[8]; // 49-56 additional parameters - float eman_alt; // 57 EMAN: equiv to psi & PFT omega - float eman_az; // 58 EMAN: equiv to theta - float eman_phi; // 59 EMAN: equiv to phi - float extra_2[69]; // 60-128 additional parameters - float euler_alpha; // 129 Euler angles: psi - float euler_beta; // 130 theta - float euler_gamma; // 131 phi - float proj_weight; // 132 weight of each projection - float extra_3[66]; // 133-198 additional parameters - char history[228]; // 199-255 history -} ; - -/************************************************************************ -@Function: readIMAGIC -@Description: - Reading an IMAGIC image format. -@Algorithm: - A 2D file format for the IMAGIC package. - The header is stored in a separate file with extension ".hed" and - a fixed size of 1024 bytes per image. - The image data is stored in a single block in a file with the - extension ".img". - Byte order determination: Year and hour values - must be less than 256*256. - Data types: PACK = byte, INTG = short, REAL = float, - RECO,COMP = complex float. - Transform type: Centered (COMP data type) - RECO is not a transform - Note that the x and y dimensions are interchanged (actually a display issue). -@Arguments: - Bimage* p the image structure. - int select image selection in multi-image file (-1 = all images). -@Returns: - int error code (<0 means failure). -**************************************************************************/ -/** Imagic reader - * @ingroup Imagic -*/ -int ImageBase::readIMAGIC(size_t select_img) -{ -#undef DEBUG - //#define DEBUG -#ifdef DEBUG - printf("DEBUG readIMAGIC: Reading Imagic file\n"); -#endif - - IMAGIChead* header = new IMAGIChead; - - if ( fread( header, IMAGICSIZE, 1, fhed ) < 1 ) - REPORT_ERROR(ERR_IO_NOREAD,(String)"readIMAGIC: header file of " + filename + " cannot be read"); - - // Determine byte order and swap bytes if from little-endian machine - if ( (swap = (( abs(header->nyear) > SWAPTRIG ) || ( header->ixlp > SWAPTRIG ))) ) - swapPage((char *) header, IMAGICSIZE - 916, DT_Float); // IMAGICSIZE - 916 is to exclude labels from swapping - - DataType datatype=DT_Float; - - if ( strstr(header->type,"PACK") ) - datatype = DT_UChar; - else if ( strstr(header->type,"INTG") ) - datatype = DT_Short; - else if ( strstr(header->type,"REAL") ) - datatype = DT_Float; - else if ( strstr(header->type,"RECO") ) - { - datatype = DT_CFloat; // Complex data - transform = NoTransform; - } - else if ( strstr(header->type,"COMP") ) - { - datatype = DT_CFloat; // Complex transform data - transform = Centered; - } - - // Set min-max values and other statistical values - if ( header->sigma == 0 && header->varian != 0 ) - header->sigma = std::sqrt(header->varian); - if ( header->densmax == 0 && header->densmin == 0 && header->sigma != 0 ) - { - header->densmin = header->avdens - header->sigma; - header->densmax = header->avdens + header->sigma; - } - - offset = 0; // separate header file - - MDMainHeader.setValue(MDL_MIN,(double)header->densmin); - MDMainHeader.setValue(MDL_MAX,(double)header->densmax); - MDMainHeader.setValue(MDL_AVG,(double)header->avdens); - MDMainHeader.setValue(MDL_STDDEV,(double)header->sigma); - MDMainHeader.setValue(MDL_SAMPLINGRATE_X,(double)1.); - MDMainHeader.setValue(MDL_SAMPLINGRATE_Y,(double)1.); - MDMainHeader.setValue(MDL_SAMPLINGRATE_Z,(double)1.); - MDMainHeader.setValue(MDL_DATATYPE,(int)datatype); - - int _xDim,_yDim,_zDim; - size_t _nDim; - _xDim = (int) header->iylp; - _yDim = (int) header->ixlp; - _zDim = (int) 1; - _nDim = (size_t) header->ifn + 1 ; - - if ( select_img > _nDim ) - REPORT_ERROR(ERR_INDEX_OUTOFBOUNDS, formatString("readImagic: Image number %lu exceeds stack size %lu", select_img, _nDim)); - - if( select_img != ALL_IMAGES ) - _nDim = 1; - - replaceNsize = _nDim; - setDimensions(_xDim, _yDim, _zDim, _nDim ); - - if (dataMode == HEADER || (dataMode == _HEADER_ALL && _nDim > 1)) // Stop reading if not necessary - { - delete header; - return 0; - } - - // Get the header information - fseek( fhed, IMG_INDEX(select_img) * IMAGICSIZE, SEEK_SET ); - - MD.clear(); - for (size_t i = 0; i < _nDim; i++) - MD.push_back(std::unique_ptr(new MDRowVec(MDL::emptyHeaderVec()))); - - double daux=1.; - for ( size_t i = 0; i < _nDim; ++i ) - { - if ( fread( header, IMAGICSIZE, 1, fhed ) < 1 ) - return(-2); - { - if ( swap ) - swapPage((char *) header, IMAGICSIZE - 916, DT_Float); - - if (dataMode == _HEADER_ALL || dataMode == _DATA_ALL) - { - MD[i]->setValue(MDL_SHIFT_X, (double)-1. * header->ixold); - MD[i]->setValue(MDL_SHIFT_Y, (double)-1. * header->iyold); - MD[i]->setValue(MDL_SHIFT_Z, 0.); - MD[i]->setValue(MDL_ANGLE_ROT, (double)-1. * header->euler_alpha); - MD[i]->setValue(MDL_ANGLE_TILT,(double)-1. * header->euler_beta); - MD[i]->setValue(MDL_ANGLE_PSI, (double)-1. * header->euler_gamma); - MD[i]->setValue(MDL_WEIGHT, 1.); - MD[i]->setValue(MDL_SCALE, daux); - } - } - } - delete header; - - if (dataMode < DATA) // Don't read the individual header and the data if not necessary - return 0; - - size_t pad = 0; - readData(fimg, select_img, datatype, pad ); - - return(0); -} - -/************************************************************************ -@Function: writeIMAGIC -@Description: - Writing an IMAGIC image format. -@Algorithm: - A file format for the IMAGIC package. -@Arguments: - Bimage* the image structure. -@Returns: - int error code (<0 means failure). -**************************************************************************/ -/** Imagic Writer - * @ingroup Imagic -*/ -int ImageBase::writeIMAGIC(size_t select_img, int mode, const String &bitDepth, CastWriteMode castMode) -{ -#undef DEBUG - //#define DEBUG -#ifdef DEBUG - printf("DEBUG writeIMAGIC: Reading Imagic file\n"); -#endif - - IMAGIChead header; - - // Cast T to datatype without convert data - DataType wDType, myTypeID = myT(); - - if (bitDepth == "") - { - switch(myTypeID) - { - case DT_Double: - case DT_Float: - case DT_Int: - case DT_UInt: - wDType = DT_Float; - strncpy(header.type,"REAL", sizeof(header.type)); - break; - case DT_UShort: - castMode = CW_CONVERT; - /* no break */ - case DT_Short: - wDType = DT_Short; - strncpy(header.type,"INTG", sizeof(header.type)); - break; - case DT_SChar: - castMode = CW_CONVERT; - /* no break */ - case DT_UChar: - wDType = DT_UChar; - strncpy(header.type,"PACK", sizeof(header.type)); - break; - case DT_CFloat: - case DT_CDouble: - wDType = DT_CFloat; - strncpy(header.type,"COMP", sizeof(header.type)); - break; - default: - wDType = DT_Unknown; - (void)wDType; // to suppress dead assignment warning - REPORT_ERROR(ERR_TYPE_INCORRECT, "ERROR: Unsupported data type by IMAGIC format."); - } - } - else //Convert to other data type - { - // Default Value - wDType = (bitDepth == "default") ? DT_Float : datatypeRAW(bitDepth); - - switch (wDType) - { - case DT_UChar: - strncpy(header.type,"PACK", sizeof(header.type)); - break; - case DT_Short: - strncpy(header.type,"INTG", sizeof(header.type)); - break; - case DT_Float: - (strncpy)(header.type,"REAL", sizeof(header.type)); - break; - case DT_CFloat: - strncpy(header.type,"COMP", sizeof(header.type)); - break; - default: - REPORT_ERROR(ERR_TYPE_INCORRECT,"ERROR: incorrect IMAGIC bits depth value."); - } - } - - if (mmapOnWrite) - { - MDMainHeader.setValue(MDL_DATATYPE,(int) wDType); - if (!checkMmapT(wDType)) - { - if (dataMode < DATA && castMode == CW_CAST) // This means ImageGeneric wants to know which DataType must use in mapFile2Write - return 0; - else //Mapping is an extra. When not available, go on and do not report an error. - { - /* In this case we cannot map the file because required and feasible datatypes are - * not compatible. Then we denote to MapFile2Write the same incoming datatype to - * keep using this Image object as usual, without mapping on write. - */ - mmapOnWrite = false; - dataMode = DATA; - MDMainHeader.setValue(MDL_DATATYPE,(int) myTypeID); - - // In case Image size great then, at least, map the multidimarray - if (mdaBase->nzyxdim*gettypesize(myTypeID) > tiff_map_min_size) - mdaBase->setMmap(true); - - // Allocate memory for image data (Assume xdim, ydim, zdim and ndim are already set - //if memory already allocated use it (no resize allowed) - mdaBase->coreAllocateReuse(); - - return 0; - } - } - else - dataMode = DATA; - } - - size_t Xdim, Ydim, Zdim, Ndim; - getDimensions(Xdim, Ydim, Zdim, Ndim); - - if (Zdim > 1) - REPORT_ERROR(ERR_MULTIDIM_DIM, "writeIMAGIC: Imagic format does not support volumes."); - - size_t datasize, datasize_n; - datasize_n = (size_t)Xdim*Ydim*Zdim; - datasize = datasize_n * gettypesize(wDType); - - // fill in the file header - header.nhfr = 1; - header.npix2 = Xdim*Ydim; - header.npixel = header.npix2; - header.iylp = Xdim; - header.ixlp = Ydim; - - time_t timer; - time ( &timer ); - tm* t = localtime(&timer); - - header.ndate = t->tm_mday; - header.nmonth = t->tm_mon + 1; - header.nyear = t->tm_year; - header.nhour = t->tm_hour; - header.nminut = t->tm_min; - header.nsec = t->tm_sec; - - double aux; - - if (!MDMainHeader.empty()) - { -#define SET_MAIN_HEADER_VALUE(field, label) MDMainHeader.getValueOrDefault(label, aux, 0.); header.field = (float)aux - SET_MAIN_HEADER_VALUE(densmin, MDL_MIN); - SET_MAIN_HEADER_VALUE(densmax, MDL_MAX); - SET_MAIN_HEADER_VALUE(avdens, MDL_AVG); - SET_MAIN_HEADER_VALUE(sigma, MDL_STDDEV); - header.varian = header.sigma*header.sigma; - } - - memcpy(header.lastpr, "Xmipp", 5); - memcpy(header.name, filename.c_str(), 80); - - size_t imgStart = IMG_INDEX(select_img); - - header.ifn = replaceNsize - 1 ; - header.imn = 1; - - if ( mode == WRITE_APPEND ) - { - imgStart = replaceNsize; - header.ifn = replaceNsize + Ndim - 1 ; - } - else if( mode == WRITE_REPLACE && imgStart + Ndim > replaceNsize) - header.ifn = imgStart + Ndim - 1; - else if (Ndim > replaceNsize) - header.ifn = Ndim - 1; - - /* - * BLOCK HEADER IF NEEDED - */ - FileLock flockHead, flockImg; - flockHead.lock(fhed); - flockImg.lock(fimg); - - if (replaceNsize == 0) // Header written first time - { - if ( swapWrite ) - { - IMAGIChead headTemp = header; - swapPage((char *) &headTemp, IMAGICSIZE - 916, DT_Float); - fwrite( &headTemp, IMAGICSIZE, 1, fhed ); - } - fwrite( &header, IMAGICSIZE, 1, fhed ); - } - else if( header.ifn + 1 > (int)replaceNsize && imgStart > 0 ) // Update number of images when needed - { - fseek( fhed, sizeof(int), SEEK_SET); - if ( swapWrite ) - { - int ifnswp = header.ifn; - swapPage((char *) &ifnswp, SIZEOF_INT, DT_Int); - fwrite(&(ifnswp),SIZEOF_INT,1,fhed); - } - else - fwrite(&(header.ifn),SIZEOF_INT,1,fhed); - } - - // Jump to the selected imgStart position - fseek(fimg, datasize * imgStart, SEEK_SET); - fseek(fhed, IMAGICSIZE * imgStart, SEEK_SET); - - auto it = MD.begin(); - - for (size_t i = 0; i < Ndim; ++i, ++it) - { - header.iyold=header.ixold=0; - header.euler_alpha=header.euler_beta=header.euler_gamma=0.; - - // Write the individual image header - if (it != MD.end() && (dataMode == _HEADER_ALL || dataMode == _DATA_ALL)) - { -#define SET_HEADER_VALUEInt(field, label) (*it)->getValueOrDefault((label), (aux), 0); header.field = -(int)(aux) -#define SET_HEADER_VALUEDouble(field, label) (*it)->getValueOrDefault((label), (aux), 0.); header.field = -(float)(aux) - - SET_HEADER_VALUEInt(ixold, MDL_SHIFT_X); - SET_HEADER_VALUEInt(iyold, MDL_SHIFT_Y); - SET_HEADER_VALUEDouble(euler_alpha, MDL_ANGLE_ROT); - SET_HEADER_VALUEDouble(euler_beta, MDL_ANGLE_TILT); - SET_HEADER_VALUEDouble(euler_gamma, MDL_ANGLE_PSI); - } - // Update index number of image - header.imn = imgStart + i + 1; - - if ( swapWrite ) - swapPage((char *) &header, IMAGICSIZE - 916, DT_Float); - fwrite( &header, IMAGICSIZE, 1, fhed ); - - if (dataMode >= DATA) - { - if (mmapOnWrite && Ndim == 1) // Can map one image at a time only - { - mappedOffset = ftell(fimg); - mappedSize = mappedOffset + datasize; - fseek(fimg, datasize-1, SEEK_CUR); - fputc(0, fimg); - } - else - writeData(fimg, i*datasize_n, wDType, datasize_n, castMode); - } - else - fseek(fimg, datasize, SEEK_CUR); - } - - //Unlock - flockHead.unlock(); - flockImg.unlock(); - - if (mmapOnWrite) - mmapFile(); - - return(0); -} diff --git a/src/core/rwIMAGIC.h b/src/core/rwIMAGIC.h deleted file mode 100644 index 3ff26ab..0000000 --- a/src/core/rwIMAGIC.h +++ /dev/null @@ -1,65 +0,0 @@ -/* - * rwIMAGIC.h - * - * Created on: May 17, 2010 - * Author: roberto - */ -/* - Base on rwIMAGIC.h - Header file for reading and writing Image Science's Imagic files - Format: 2D image file format for the program Imagic (Image Science) - Author: Bernard Heymann - Created: 19990424 Modified: 20011030 -*/ - -#ifndef CORE_RWIMAGIC_H_ -#define CORE_RWIMAGIC_H_ - -///@defgroup Imagic Imagic File format -///@ingroup ImageFormats - -/************************************************************************ -@Function: readIMAGIC -@Description: - Reading an IMAGIC image format. -@Algorithm: - A 2D file format for the IMAGIC package. - The header is stored in a separate file with extension ".hed" and - a fixed size of 1024 bytes per image. - The image data is stored in a single block in a file with the - extension ".img". - Byte order determination: Year and hour values - must be less than 256*256. - Data types: PACK = byte, INTG = short, REAL = float, - RECO,COMP = complex float. - Transform type: Centered (COMP data type) - RECO is not a transform - Note that the x and y dimensions are interchanged (actually a display issue). -@Arguments: - Bimage* p the image structure. - int select image selection in multi-image file (-1 = all images). -@Returns: - int error code (<0 means failure). -**************************************************************************/ -/** Imagic reader - * @ingroup Imagic -*/ -int readIMAGIC(size_t img_select); - -/************************************************************************ -@Function: writeIMAGIC -@Description: - Writing an IMAGIC image format. -@Algorithm: - A file format for the IMAGIC package. -@Arguments: - Bimage* the image structure. -@Returns: - int error code (<0 means failure). -**************************************************************************/ -/** Imagic Writer - * @ingroup Imagic -*/ -int writeIMAGIC(size_t img_select = ALL_IMAGES, int mode=WRITE_OVERWRITE, const String &bitDepth="", CastWriteMode castMode = CW_CAST); - -#endif /* RWIMAGIC_H_ */ diff --git a/src/core/rwINF.cpp b/src/core/rwINF.cpp deleted file mode 100644 index a9a8cb8..0000000 --- a/src/core/rwINF.cpp +++ /dev/null @@ -1,282 +0,0 @@ -/*************************************************************************** - * Authors: Joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include "xmipp_image_base.h" -#include "args.h" -#include "metadata_static.h" -#include "xmipp_funcs.h" -#include "multidim_array_base.h" - -///@defgroup INF INF File format -///@ingroup ImageFormats - -// I/O prototypes -/** INF Reader - * @ingroup INF -*/ -int ImageBase::readINF(size_t select_img,bool isStack) -{ -#undef DEBUG - //#define DEBUG -#ifdef DEBUG - printf("DEBUG readINF: Reading INF file\n"); -#endif - - int _xDim,_yDim,_zDim, __depth; - size_t _nDim; - bool __is_signed; - - _xDim = textToInteger(getParameter(fhed, "Xdim")); - _yDim = textToInteger(getParameter(fhed, "Ydim")); - __depth = textToInteger(getParameter(fhed, "bitspersample")); - if (checkParameter(fhed, "offset")) - offset = textToInteger(getParameter(fhed, "offset")); - else - offset = 0; - if (checkParameter(fhed, "is_signed")) - __is_signed = (getParameter(fhed, "is_signed") == "true" || - getParameter(fhed, "is_signed") == "TRUE"); - else - __is_signed = false; - if (checkParameter(fhed, "endianess") && - (getParameter(fhed, "endianess") == "big" || getParameter(fhed, "endianess") == "BIG")) - swap = true; - else - swap = false; - - if (IsBigEndian()) - swap = !swap; - - _zDim = 1; - _nDim = 1; - - DataType datatype; - switch ( __depth ) - { - case 8: - if (__is_signed) - datatype = DT_SChar; - else - datatype = DT_UChar; - break; - case 16: - if (__is_signed) - datatype = DT_Short; - else - datatype = DT_UShort; - break; - case 32: - datatype = DT_Float; - break; - default: - REPORT_ERROR(ERR_TYPE_INCORRECT, "rwINF::read: depth is not 8, 16 nor 32"); - } - - MDMainHeader.setValue(MDL_SAMPLINGRATE_X,(double) -1); - MDMainHeader.setValue(MDL_SAMPLINGRATE_Y,(double) -1); - MDMainHeader.setValue(MDL_DATATYPE,(int)datatype); - - // Map the parameters - setDimensions(_xDim, _yDim, _zDim, _nDim); - - size_t imgStart = IMG_INDEX(select_img); - size_t imgEnd = (select_img != ALL_IMAGES) ? imgStart + 1 : _nDim; - - if (dataMode == HEADER || (dataMode == _HEADER_ALL && _nDim > 1)) // Stop reading if not necessary - return 0; - - MD.clear(); - for (size_t i = 0; i < imgEnd-imgStart; i++) - MD.push_back(std::unique_ptr(new MDRowVec(MDL::emptyHeaderVec()))); - - //#define DEBUG -#ifdef DEBUG - - MDMainHeader.write(std::cerr); - MD.write(std::cerr); -#endif - - if( dataMode < DATA ) - return 0; - - size_t pad = 0; - readData(fimg, select_img, datatype, pad); - return(0); -} - -/** INF Writer - * @ingroup INF -*/ -int ImageBase::writeINF(size_t select_img, bool isStack, int mode, String bitDepth, CastWriteMode castMode) -{ - //#define DEBUG -#ifdef DEBUG - printf("DEBUG writeINF: Writing INF file\n"); - printf("DEBUG writeINF: File %s\n", filename.c_str()); -#endif -#undef DEBUG - - size_t Xdim, Ydim, Zdim, Ndim; - getDimensions(Xdim, Ydim, Zdim, Ndim); - - int _depth; - bool _is_signed = false; - - // Volumes and stacks are not supported - if (Zdim > 1 || Ndim > 1) - REPORT_ERROR(ERR_INDEX_OUTOFBOUNDS, "rwINF::write does not support neither volumes nor stacks."); - - if (mode == WRITE_APPEND) - REPORT_ERROR(ERR_ARG_INCORRECT, "rwINF::write only can overwrite or replace image files," - "not append."); - - DataType wDType,myTypeID = myT(); - - if (bitDepth != "") - { - myTypeID = (bitDepth == "default") ? DT_Float : datatypeRAW(bitDepth); - } - - switch(myTypeID) - { - case DT_Double: - case DT_UInt: - case DT_Int: - if (bitDepth != "") - REPORT_ERROR(ERR_TYPE_INCORRECT,"ERROR: incorrect RAW bits depth value."); - case DT_Float: - wDType = DT_Float; - break; - case DT_UShort: - wDType = DT_UShort; - _is_signed = false; - break; - case DT_Short: - wDType = DT_Short; - _is_signed = true; - break; - case DT_UChar: - wDType = DT_UChar; - _is_signed = false; - break; - case DT_SChar: - wDType = DT_SChar; - _is_signed = true; - break; - default: - wDType = DT_Unknown; - (void)wDType; // to suppress dead assignment warning - REPORT_ERROR(ERR_TYPE_INCORRECT,(std::string)"ERROR: Unsupported data type by RAW format."); - } - - if (mmapOnWrite) - { - MDMainHeader.setValue(MDL_DATATYPE,(int) wDType); - if (!checkMmapT(wDType)) - { - if (dataMode < DATA && castMode == CW_CAST) // This means ImageGeneric wants to know which DataType must use in mapFile2Write - return 0; - else //Mapping is an extra. When not available, go on and do not report an error. - { - /* In this case we cannot map the file because required and feasible datatypes are - * not compatible. Then we denote to MapFile2Write the same incoming datatype to - * keep using this Image object as usual, without mapping on write. - */ - mmapOnWrite = false; - dataMode = DATA; - MDMainHeader.setValue(MDL_DATATYPE,(int) myTypeID); - - // In case Image size great then, at least, map the multidimarray - if (mdaBase->nzyxdim*gettypesize(myTypeID) > tiff_map_min_size) - mdaBase->setMmap(true); - - // Allocate memory for image data (Assume xdim, ydim, zdim and ndim are already set - //if memory already allocated use it (no resize allowed) - mdaBase->coreAllocateReuse(); - - return 0; - } - } - else - dataMode = DATA; - } - - _depth = gettypesize(wDType); - - //locking - - // Lock Header file - FileLock flock; - flock.lock(fhed); - - /* Write INF file ==================================*/ - fprintf(fhed,"# Bits per sample\n"); - fprintf(fhed,"bitspersample= %d\n",_depth*8); - fprintf(fhed,"# Samples per pixel\n"); - fprintf(fhed,"samplesperpixel= 1\n"); - fprintf(fhed,"# Image width\n"); - fprintf(fhed,"Xdim= %d\n", (int)Xdim); - fprintf(fhed,"# Image length\n"); - fprintf(fhed,"Ydim= %d\n",(int)Ydim); - fprintf(fhed,"# offset in bytes (zero by default)\n"); - fprintf(fhed,"offset= 0\n"); - fprintf(fhed,"# Is a signed or Unsigned int (by default true)\n"); - if (_is_signed) - fprintf(fhed,"is_signed= true\n"); - else - fprintf(fhed,"is_signed= false\n"); - fprintf(fhed,"# Byte order\n"); - if ( swapWrite^IsBigEndian() ) - fprintf(fhed,"endianess= big\n"); - else - fprintf(fhed,"endianess= little\n"); - - //Unlock Header file - flock.unlock(); - - /* Write Image file ==================================*/ - size_t datasize_n, datasize; - datasize_n = Xdim*Ydim*Zdim; - datasize = datasize_n * gettypesize(wDType); - - // Lock Image file - flock.lock(fimg); - - if (mmapOnWrite) - { - mappedOffset = 0; - mappedSize = mappedOffset + datasize; - fseek(fimg, datasize-1, SEEK_SET); - fputc(0, fimg); - mmapFile(); - } - else - writeData(fimg, 0, wDType, datasize_n, castMode); - - // Unlock Image file - flock.unlock(); - - return(0); -} diff --git a/src/core/rwINF.h b/src/core/rwINF.h deleted file mode 100644 index 5b3b1de..0000000 --- a/src/core/rwINF.h +++ /dev/null @@ -1,43 +0,0 @@ -/*************************************************************************** - * Authors: Joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_RWINF_H_ -#define CORE_RWINF_H_ - -///@defgroup INF INF File format -///@ingroup ImageFormats - -// I/O prototypes -/** INF Reader - * @ingroup INF -*/ -int readINF(size_t img_select,bool isStack=false); - -/** INF Writer - * @ingroup INF -*/ -int writeINF(size_t img_select, bool isStack=false, int mode=WRITE_OVERWRITE, String bitDepth="", CastWriteMode castMode = CW_CAST); - -#endif /* RWINF_H_ */ diff --git a/src/core/rwJPEG.cpp b/src/core/rwJPEG.cpp deleted file mode 100644 index 0e268ac..0000000 --- a/src/core/rwJPEG.cpp +++ /dev/null @@ -1,220 +0,0 @@ -/*************************************************************************** - * Authors: Joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include "xmipp_image_base.h" -#include "jpeglib.h" -#include "xmipp_error.h" -#include "multidim_array_base.h" -#include "metadata_static.h" - -//#include - -int ImageBase::readJPEG(size_t select_img) -{ - struct jpeg_decompress_struct cinfo; - struct jpeg_error_mgr jerr; - - cinfo.err = jpeg_std_error(&jerr); - jpeg_create_decompress(&cinfo); - - jpeg_stdio_src(&cinfo, fimg); - jpeg_read_header(&cinfo, TRUE); - - MDMainHeader.setValue(MDL_MIN,0.); - MDMainHeader.setValue(MDL_MAX,0.); - MDMainHeader.setValue(MDL_AVG,0.); - MDMainHeader.setValue(MDL_STDDEV,0.); - MDMainHeader.setValue(MDL_SAMPLINGRATE_X,1.); - MDMainHeader.setValue(MDL_SAMPLINGRATE_Y,1.); - MDMainHeader.setValue(MDL_SAMPLINGRATE_Z,1.); - MDMainHeader.setValue(MDL_DATATYPE,(int) DT_UChar); - - ArrayDim aDim; - aDim.xdim = cinfo.image_width; - aDim.ydim = cinfo.image_height; - aDim.zdim = 1; - aDim.ndim = 1; - - setDimensions(aDim); - - replaceNsize = aDim.ndim; - - //Read header only - if (dataMode == HEADER || (dataMode == _HEADER_ALL )) // Stop reading if not necessary - { - jpeg_destroy_decompress(&cinfo); - return 0; - } - - /* As we cannot mmap a TIFF File, when this option is passed we are going to mmap - * the multidimarray of Image - */ - - if (mmapOnRead) - { - mmapOnRead = false; - if (aDim.nzyxdim*gettypesize(DT_UChar) > tiff_map_min_size) - mdaBase->setMmap(true); - } - - // Allocate memory for image data (Assume xdim, ydim, zdim and ndim are already set - //if memory already allocated use it (no resize allowed) - mdaBase->coreAllocateReuse(); - - MD.clear(); - for (size_t i = 0; i < aDim.ndim; i++) - MD.push_back(std::unique_ptr(new MDRowVec(MDL::emptyHeaderVec()))); - - /* Start decompression jpeg here */ - jpeg_start_decompress( &cinfo ); - - /* allocate memory to hold the uncompressed image */ - char * buffer = new char [aDim.xdim]; - /* now actually read the jpeg into the raw buffer */ - JSAMPROW row_pointer[1]; - row_pointer[0] = new unsigned char [aDim.xdim*cinfo.num_components]; - /* read one scan line at a time */ - while( cinfo.output_scanline < cinfo.image_height ) - { - jpeg_read_scanlines( &cinfo, row_pointer, 1 ); - for(size_t i=0; igetDimensions(aDim); - - // Volumes are not supported - if (aDim.zdim > 1) - REPORT_ERROR(ERR_MULTIDIM_DIM, "rwJPEG: volumes are not supported."); - - //Selection of output datatype - DataType myTypeID = myT(); - - if (mmapOnWrite) - { - /* As we cannot mmap a JPEG File, when this option is passed we are going to mmap - * the multidimarray of Image - */ - mmapOnWrite = false; - dataMode = DATA; - MDMainHeader.setValue(MDL_DATATYPE,(int) myTypeID); - - if (aDim.nzyxdim*gettypesize(myTypeID) > tiff_map_min_size) - mdaBase->setMmap(true); - - // Allocate memory for image data (Assume xdim, ydim, zdim and ndim are already set - //if memory already allocated use it (no resize allowed) - - mdaBase->coreAllocateReuse(); - - return 0; - } - - jpeg_compress_struct cinfo; - jpeg_error_mgr jerr; - - // struct jpeg_destination_mgr dmgr; - // - // /* create our in-memory output buffer to hold the jpeg */ - // JOCTET * out_buffer = new JOCTET[aDim.xdim * aDim.ydim]; - // - // /* here is the magic */ - // dmgr.init_destination = init_buffer; - // dmgr.empty_output_buffer = empty_buffer; - // dmgr.term_destination = term_buffer; - // dmgr.next_output_byte = out_buffer; - // dmgr.free_in_buffer = aDim.xdim * aDim.ydim; - - cinfo.err = jpeg_std_error(&jerr); - jpeg_create_compress(&cinfo); - - jpeg_stdio_dest(&cinfo, fimg); - - /* Set JPEG image properties */ - cinfo.image_width = aDim.xdim; /* image width and height, in pixels */ - cinfo.image_height = aDim.ydim; - cinfo.input_components = 1; /* # of color components per pixel */ - cinfo.in_color_space = JCS_GRAYSCALE; /* colorspace of input image */ - - jpeg_set_defaults(&cinfo); - - jpeg_start_compress(&cinfo, TRUE); - - JSAMPROW row_pointer[1]; /* pointer to a single row */ - row_pointer[0] = new unsigned char [aDim.xdim]; - char * buffer = (char*) row_pointer[0]; - double min0, max0; - mdaBase->computeDoubleMinMaxRange(min0, max0, 0, aDim.xdim*aDim.ydim); - - - while (cinfo.next_scanline < cinfo.image_height) - { - getCastConvertPageFromT((cinfo.next_scanline)*cinfo.image_width, buffer, - DT_UChar, cinfo.image_width, min0, max0, castMode); - - jpeg_write_scanlines(&cinfo, row_pointer, 1); - } - - jpeg_finish_compress(&cinfo); - jpeg_destroy_compress(&cinfo); - delete[] row_pointer[0]; - - // fwrite(out_buffer, cinfo.dest->next_output_byte - out_buffer,1 ,fimg); - - return(0); -} diff --git a/src/core/rwJPEG.h b/src/core/rwJPEG.h deleted file mode 100644 index 385e67b..0000000 --- a/src/core/rwJPEG.h +++ /dev/null @@ -1,32 +0,0 @@ -/*************************************************************************** - * Authors: Joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_RWJPEG_H_ -#define CORE_RWJPEG_H_ - -int readJPEG(size_t select_img); - -int writeJPEG(size_t select_img, bool isStack=false, int mode=WRITE_OVERWRITE, String bitDepth="", CastWriteMode castMode = CW_CONVERT); -#endif /* RWJPEG_H_ */ diff --git a/src/core/rwMRC.cpp b/src/core/rwMRC.cpp deleted file mode 100644 index eeb37f7..0000000 --- a/src/core/rwMRC.cpp +++ /dev/null @@ -1,694 +0,0 @@ -/*************************************************************************** - * Authors: Joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include "xmipp_image_base.h" -#include "xmipp_error.h" -#include "xmipp_memory.h" - -#include "metadata_static.h" -#include "multidim_array_base.h" -#include "xmipp_funcs.h" - -#include -/* - Base on rwMRC.h - Header file for reading and writing MRC files - Format: 3D crystallographic image file format for the MRC package - Author: Bernard Heymann - Created: 19990321 Modified: 20030723 -*/ - - -#define MRCSIZE 1024 // Minimum size of the MRC header (when nsymbt = 0) - -///@defgroup MRC MRC File format -///@ingroup ImageFormats - -/** MRC Old Header - * @ingroup MRC - * see: http://www.ccpem.ac.uk/mrc_format/mrc2014.php for details -*/ -struct MRCheadold -{ // file header for MRC data - int nx; // 0 0 image size - int ny; // 1 4 - int nz; // 2 8 - int mode; // 3 0=uchar,1=short,2=float - int nxStart; // 4 unit cell offset - int nyStart; // 5 - int nzStart; // 6 - int mx; // 7 unit cell size in voxels - int my; // 8 - int mz; // 9 - float a; // 10 40 cell dimensions in A - float b; // 11 - float c; // 12 - float alpha; // 13 cell angles in degrees - float beta; // 14 - float gamma; // 15 - int mapc; // 16 column axis - int mapr; // 17 row axis - int maps; // 18 section axis - float amin; // 19 minimum density value - float amax; // 20 80 maximum density value - float amean; // 21 average density value - int ispg; // 22 space group number - int nsymbt; // 23 bytes used for sym. ops. table - float extra[25]; // 24 user-defined info - float xOrigin; // 49 phase origin (pixels) or origin of subvolume (A) - float yOrigin; // 50 - float zOrigin; // 51 - char map[4]; // 52 character string 'MAP ' to identify file type - int machst; // 53 machine stamp encoding byte ordering of data - float rms; // 54 rms deviation of map from mean density - int nlabl; // 55 number of labels used - char labels[10][80]; // 56-255 10 80-character labels -} ; - -/** MRC Header - * @ingroup MRC -*/ -struct MRChead -{ // file header for MRC data - int32_t nx; // 0 0 image size - int32_t ny; // 1 4 - int32_t nz; // 2 8 - int32_t mode; // 3 0=char,1=short,2=float,6=uint16 - int32_t nxStart; // 4 unit cell offset - int32_t nyStart; // 5 - int32_t nzStart; // 6 - int32_t mx; // 7 unit cell size in voxels - int32_t my; // 8 - int32_t mz; // 9 1=Image or images stack, if volume mz=nz. - // If ispg=401 then nz=number of volumes in stack * volume z dimension - // mz=volume zdim - float a; // 10 40 cell dimensions in A - float b; // 11 - float c; // 12 - float alpha; // 13 cell angles in degrees - float beta; // 14 - float gamma; // 15 - int32_t mapc; // 16 column axis - int32_t mapr; // 17 row axis - int32_t maps; // 18 section axis - float amin; // 19 minimum density value - float amax; // 20 80 maximum density value - float amean; // 21 average density value - int32_t ispg; // 22 space group number 0=Image/stack,1=Volume,401=volumes stack - int32_t nsymbt; // 23 bytes used for sym. ops. table - float extra[25]; // 24 user-defined info - float xOrigin; // 49 phase origin in pixels FIXME: is in pixels or [L] units? - float yOrigin; // 50 - float zOrigin; // 51 - char map[4]; // 52 identifier for map file ("MAP ") - char machst[4]; // 53 machine stamp - float arms; // 54 RMS deviation - int32_t nlabl; // 55 number of labels used - char labels[800]; // 56-255 10 80-character labels -} ; - -int ImageBase::readMRC(size_t start_img, size_t batch_size, bool isStack /* = false */) -{ - -#undef DEBUG - //#define DEBUG -#ifdef DEBUG - printf("DEBUG readMRC: Reading MRC file\n"); -#endif - - std::unique_ptr< MRChead > header( new MRChead() ); - - int errCode = 0; - - if ( fread( header.get(), MRCSIZE, 1, fimg ) < 1 ) - return(-2); - - // Determine byte order and swap bytes if from little-endian machine - if ( (swap = (( abs( header->mode ) > SWAPTRIG ) || ( abs(header->nz) > SWAPTRIG ))) ) - { -#ifdef DEBUG - fprintf(stderr, "Warning: Swapping header byte order for 4-byte types\n"); -#endif - - swapPage((char *) header.get(), MRCSIZE - 800, DT_Float); // MRCSIZE - 800 is to exclude labels from swapping - } - - // Convert VAX floating point types if necessary - // if ( header->amin > header->amax ) - // REPORT_ERROR(ERR_IMG_NOREAD,"readMRC: amin > max: VAX floating point conversion unsupported"); - - size_t _xDim,_yDim,_zDim,_nDim; - size_t _nDimSet; - - _xDim = header->nx; - _yDim = header->ny; - _zDim = header->nz; - - // Reading and storing axis order - axisOrder[0] = 0; - axisOrder[1] = 4 - header->maps; - axisOrder[2] = 4 - header->mapr; - axisOrder[3] = 4 - header->mapc; - - bool isVolStk = (header->ispg > 400); - - /* isStack is already true if file uses our customized "mrcs" extension. In this case - * we ignore the stack behavior in header. If format is forced through ":" flag suffix, - * then we also ignore the stack behavior in header */ - if ( !isStack && (isVolStk || !filename.contains(":"))) - isStack = ((header->ispg == 0 || isVolStk ) && (header->nsymbt == 0)); - - // std::cout << "isStack = " << isStack << std::endl; - - if(isStack) - { - if (isVolStk) - { - _nDim = _zDim / header->mz; - _zDim = header->mz; - } - else - { - _nDim = _zDim;// When isStack slices in Z are supposed to be a stack of images - _zDim = 1; - } - - if (batch_size == ALL_IMAGES) { - _nDimSet = _nDim - start_img + 1; - } else { - _nDimSet = std::min( start_img + batch_size - 1, _nDim ) - start_img + 1; - } - - - if ( start_img > _nDim ) - REPORT_ERROR(ERR_INDEX_OUTOFBOUNDS, formatString("readMRC: %s Image number %lu exceeds stack size %lu", this->filename.c_str(), start_img, _nDim)); - - } - else // If the reading is not like a stack, then the select_img is not taken into account and must be selected the only image - { - start_img = 1; - _nDim = 1; - _nDimSet = 1; - } - - DataType datatype; - switch ( header->mode ) - { - case 0: - datatype = DT_SChar; - break; - case 1: - datatype = DT_Short; - break; - case 2: - datatype = DT_Float; - break; - case 3: - datatype = DT_CShort; - break; - case 4: - datatype = DT_CFloat; - break; - case 6: - datatype = DT_UShort; - break; - case 12: - datatype = DT_HalfFloat; - break; - case 101: - datatype = DT_UHalfByte; - break; - - default: - datatype = DT_Unknown; - errCode = -1; - break; - } - - replaceNsize = _nDim; - setDimensions(_xDim, _yDim, _zDim, _nDimSet); - - - offset = MRCSIZE + header->nsymbt; - size_t datasize_n; - datasize_n = _xDim*_yDim*_zDim; - - // If mode is any of the fourier transforms (3,4) - if ( header->mode > 2 && header->mode < 5 ) - { - transform = CentHerm; - fseek(fimg, 0, SEEK_END); - if ( ftell(fimg) > offset + 0.8*datasize_n*gettypesize(datatype) ) - _xDim = (2 * (_xDim - 1)); - if ( header->mx%2 == 1 ) - _xDim += 1; // Quick fix for odd x-size maps - setDimensions(_xDim, _yDim, _zDim, _nDim); - } - - MDMainHeader.setValue(MDL_MIN,(double)header->amin); - MDMainHeader.setValue(MDL_MAX,(double)header->amax); - MDMainHeader.setValue(MDL_AVG,(double)header->amean); - MDMainHeader.setValue(MDL_STDDEV,(double)header->arms); - MDMainHeader.setValue(MDL_DATATYPE,(int)datatype); - - double sampling; - MDMainHeader.getValueOrDefault(MDL_SAMPLINGRATE_X, sampling, 1.0); - if ( header->mx && header->a!=0 && sampling == 1.0)//ux - MDMainHeader.setValue(MDL_SAMPLINGRATE_X,(double)header->a/header->mx); - MDMainHeader.getValueOrDefault(MDL_SAMPLINGRATE_Y, sampling, 1.0); - if ( header->my && header->b!=0 && sampling == 1.0)//yx - MDMainHeader.setValue(MDL_SAMPLINGRATE_Y,(double)header->b/header->my); - MDMainHeader.getValueOrDefault(MDL_SAMPLINGRATE_Z, sampling, 1.0); - if ( header->mz && header->c!=0 && sampling == 1.0)//zx - MDMainHeader.setValue(MDL_SAMPLINGRATE_Z,(double)header->c/header->mz); - - if (dataMode==HEADER || (dataMode == _HEADER_ALL && _nDim > 1)) // Stop reading if not necessary - { - readData(NULL, 0, DT_Unknown, 0); // To consider axis ordering. Will not read actual data - return errCode; - } - - const size_t imgStart = IMG_INDEX(start_img); - const size_t imgEnd = start_img + _nDimSet - 1; - - MD.clear(); - for (size_t i = 0; i < imgEnd-imgStart; i++) - MD.push_back(std::unique_ptr(new MDRowVec(MDL::emptyHeaderVec()))); - - /* As MRC does not support stacks, we use the geometry stored in the header - for any image when we simulate the file is a stack.*/ - if (dataMode == _HEADER_ALL || dataMode == _DATA_ALL) - { - double aux; - for ( size_t i = 0; i < imgEnd - imgStart; ++i ) - { - MD[i]->setValue(MDL_SHIFT_X, (double) -header->nxStart); - MD[i]->setValue(MDL_SHIFT_Y, (double) -header->nyStart); - MD[i]->setValue(MDL_SHIFT_Z, (double) -header->nzStart); - - // We include auto detection of MRC2000 or CCP4 style origin based on http://situs.biomachina.org/fmap.pdf - if (header->xOrigin != 0) - MD[i]->setValue(MDL_ORIGIN_X, (double)-header->xOrigin); - else if (header->nxStart != 0 && MDMainHeader.getValue(MDL_SAMPLINGRATE_X,aux)) - MD[i]->setValue(MDL_ORIGIN_X, -header->nxStart/aux); - - if (header->yOrigin !=0) - MD[i]->setValue(MDL_ORIGIN_Y, (double)-header->yOrigin); - else if(header->nyStart !=0 && MDMainHeader.getValue(MDL_SAMPLINGRATE_Y,aux)) - MD[i]->setValue(MDL_ORIGIN_Y, -header->nyStart/aux); - - if (header->zOrigin != 0) - MD[i]->setValue(MDL_ORIGIN_Z, (double)-header->zOrigin); - else if(header->nzStart !=0 && MDMainHeader.getValue(MDL_SAMPLINGRATE_Z,aux)) - MD[i]->setValue(MDL_ORIGIN_Z, -header->nzStart/aux); - } - } - - if ( dataMode < DATA ) // Don't read the individual header and the data if not necessary - { - readData(NULL, 0, DT_Unknown, 0); // To consider axis ordering. Will not read actual data - return errCode; - } - - // Lets read the data - - // 4-bits mode: Here is the magic to expand the compressed images - if (datatype == DT_UHalfByte){ - readData4bit(fimg, start_img, datatype, 0); - } - else{ - readData(fimg, start_img, datatype, 0); - } - - return errCode; -} - -// I/O prototypes -/** MRC Reader - * @ingroup MRC -*/ -int ImageBase::readMRC(size_t select_img, bool isStack /* = false*/) -{ -#undef DEBUG - //#define DEBUG -#ifdef DEBUG - printf("DEBUG readMRC: Reading MRC file\n"); -#endif - - if (select_img == ALL_IMAGES) { - return readMRC(1, ALL_IMAGES, isStack); - } - return readMRC(select_img, 1, isStack); -} - -/** MRC Writer - * @ingroup MRC -*/ -int ImageBase::writeMRC(size_t select_img, bool isStack, int mode, const String &bitDepth, CastWriteMode castMode) -{ - MRChead* header = (MRChead *) askMemory(sizeof(MRChead)); - - // Cast T to datatype - DataType wDType,myTypeID = myT(); - - if (bitDepth == "") - { - castMode = CW_CAST; - switch(myTypeID) - { - case DT_Double: - case DT_Float: - case DT_Int: - case DT_UInt: - wDType = DT_Float; - header->mode = 2; - break; - case DT_UShort: - wDType = DT_UShort; - header->mode = 6; - break; - case DT_Short: - wDType = DT_Short; - header->mode = 1; - break; - case DT_SChar: - castMode = CW_CONVERT; - /* no break */ - case DT_UChar: - wDType = DT_UChar; - header->mode = 0; - break; - case DT_CFloat: - case DT_CDouble: - wDType = DT_CFloat; - header->mode = 4; - break; - case DT_HalfFloat: - wDType = DT_HalfFloat; - header->mode = 12; - break; - //case DT_UHalfByte: - default: - wDType = DT_Unknown; - (void)wDType; // to suppress dead assignment warning - REPORT_ERROR(ERR_TYPE_INCORRECT,(std::string)"ERROR: Unsupported data type by MRC format."); - } - } - else //Convert to other data type - { - // Default Value - wDType = (bitDepth == "default") ? DT_Float : datatypeRAW(bitDepth); - - switch (wDType) - { - case DT_Double: - case DT_Int: - case DT_UInt: - case DT_Float: - header->mode = 2; - break; - case DT_UChar: - header->mode = 0; - break; - case DT_UShort: - header->mode = 6; - break; - case DT_Short: - header->mode = 1; - break; - case DT_CFloat: - case DT_CDouble: - header->mode = 4; - break; - case DT_HalfFloat: - header->mode = 12; - break; - default: - REPORT_ERROR(ERR_TYPE_INCORRECT,"ERROR: incorrect MRC bits depth value."); - } - } - - if (mmapOnWrite) - { - MDMainHeader.setValue(MDL_DATATYPE,(int) wDType); - if (!checkMmapT(wDType)) - { - if (dataMode < DATA && castMode == CW_CAST) // This means ImageGeneric wants to know which DataType must use in mapFile2Write - return 0; - else //Mapping is an extra. When not available, go on and do not report an error. - { - /* In this case we cannot map the file because required and feasible datatypes are - * not compatible. Then we denote to MapFile2Write the same incoming datatype to - * keep using this Image object as usual, without mapping on write. - */ - mmapOnWrite = false; - dataMode = DATA; - MDMainHeader.setValue(MDL_DATATYPE,(int) myTypeID); - - // In case Image size great then, at least, map the multidimarray - if (mdaBase->nzyxdim*gettypesize(wDType) > tiff_map_min_size) - mdaBase->setMmap(true); - - // Allocate memory for image data (Assume xdim, ydim, zdim and ndim are already set - //if memory already allocated use it (no resize allowed) - mdaBase->coreAllocateReuse(); - - return 0; - } - } - else - dataMode = DATA; - } - - - /* - if ( transform != NoTransform ) - img_convert_fourier(p, CentHerm); - */ - - // Map the parameters - strncpy(header->map, "MAP ", 4); - // FIXME TO BE DONE WITH rwCCP4!! - //set_CCP4_machine_stamp(header->machst); - char* machine_stamp; - machine_stamp = (char *)(header->machst); - if(IsLittleEndian()) - { - machine_stamp[0] = 68; - machine_stamp[1] = 65; - } - else - { - machine_stamp[0] = machine_stamp[1] = 17; - } - // case LittleVAX: - // machine_stamp[0] = 34; - // machine_stamp[1] = 65; - // break; - - size_t Xdim, Ydim, Zdim, Ndim; - getDimensions(Xdim, Ydim, Zdim, Ndim); - - /** - * header->a,b,c info is related to sampling rate, so it is - * only written when writing header, so it is initialized to - * number of voxels to avoid a mistaken value. - * If sampling is provided a, b and c are overwritten bellow - **/ - - header->mx = header->nx = Xdim; - header->my = header->ny = Ydim; - header->mz = header->nz = Zdim; - - // Obtaining sampling rate for each dimension and calculating cube size - // By default sampling rate is 1.0 if no real value was found - double sampling; - MDMainHeader.getValueOrDefault(MDL_SAMPLINGRATE_X, sampling, 1.0); - header->a = (float)(Xdim * sampling); - MDMainHeader.getValueOrDefault(MDL_SAMPLINGRATE_Y, sampling, 1.0); - header->b = (float)(Ydim * sampling); - MDMainHeader.getValueOrDefault(MDL_SAMPLINGRATE_Z, sampling, 1.0); - header->c = (float)(Zdim * sampling); - - if ( transform == CentHerm ) - header->nx = Xdim/2 + 1; // If a transform, physical storage is nx/2 + 1 - - header->alpha = 90.; - header->beta = 90.; - header->gamma = 90.; - - // header->mx = 0;//(int) (ua/ux + 0.5); - // header->my = 0;//(int) (ub/uy + 0.5); - // header->mz = 0;//(int) (uc/uz + 0.5); - header->mapc = 1; - header->mapr = 2; - header->maps = 3; - double aux,aux2; - - // header->a = 0.;// ua; - // header->b = 0.;// ub; - // header->c = 0.;// uc; - - if (!MDMainHeader.empty()) - { -#define SET_MAIN_HEADER_VALUE(field, label) MDMainHeader.getValueOrDefault(label, aux, 0.); header->field = (float)aux - SET_MAIN_HEADER_VALUE(amin, MDL_MIN); - SET_MAIN_HEADER_VALUE(amax, MDL_MAX); - SET_MAIN_HEADER_VALUE(amean, MDL_AVG); - SET_MAIN_HEADER_VALUE(arms, MDL_STDDEV); - - if ((dataMode == _HEADER_ALL || dataMode == _DATA_ALL)) - { -#define SET_HEADER_SHIFT(field, label) MD[0]->getValueOrDefault(label, aux, 0.); header->field = -(int) round(aux) - SET_HEADER_SHIFT(nxStart, MDL_SHIFT_X); - SET_HEADER_SHIFT(nyStart, MDL_SHIFT_Y); - SET_HEADER_SHIFT(nzStart, MDL_SHIFT_Z); -#define SET_HEADER_ORIGIN(field, label1, label2) MD[0]->getValueOrDefault(label1, aux, 0.);MDMainHeader.getValueOrDefault(label2, aux2, 0.);\ - header->field = (float) (aux * aux2) - - SET_HEADER_ORIGIN(xOrigin, MDL_ORIGIN_X, MDL_SAMPLINGRATE_X); - SET_HEADER_ORIGIN(yOrigin, MDL_ORIGIN_Y, MDL_SAMPLINGRATE_Y); - SET_HEADER_ORIGIN(zOrigin, MDL_ORIGIN_Z, MDL_SAMPLINGRATE_Z); - -#define SET_HEADER_CELL_DIM(field, label1, dimSize) MDMainHeader.getValueOrDefault(label1, aux, 0.);\ - header->field = (float) (aux * dimSize) - - SET_HEADER_CELL_DIM(a, MDL_SAMPLINGRATE_X, Xdim); - SET_HEADER_CELL_DIM(b, MDL_SAMPLINGRATE_Y, Ydim); - SET_HEADER_CELL_DIM(c, MDL_SAMPLINGRATE_Z, Zdim); - } - else - { - header->nxStart = header->nyStart = header->nzStart = 0; - header->xOrigin = header->yOrigin = header->zOrigin = 0; - } - } - - header->nsymbt = 0; - header->nlabl = 10; // or zero? - //strncpy(header->labels, p->label.c_str(), 799); - - offset = MRCSIZE + header->nsymbt; - size_t datasize, datasize_n; - datasize_n = Xdim*Ydim*Zdim; - datasize = datasize_n * gettypesize(wDType); - - //#define DEBUG -#ifdef DEBUG - - printf("DEBUG rwMRC: Offset = %ld, Datasize_n = %ld\n", offset, datasize_n); -#endif - - size_t imgStart = 0; - - if (Ndim > 1 || filename.contains(":mrcs")) // If format is forced through ":" flag suffix, then ignore the stack behavior in header - isStack = true; - - bool isVolStk = isStack && Zdim > 1; - size_t nDimHeader = Ndim; - - if (isStack) - { - imgStart = IMG_INDEX(select_img); - - if( mode == WRITE_APPEND ) - { - imgStart = replaceNsize; - nDimHeader = replaceNsize + Ndim; - } - else if( mode == WRITE_REPLACE && select_img + Ndim - 1 > replaceNsize) - { - nDimHeader = select_img + Ndim - 1; - } - // else if (Ndim > replaceNsize) - // nDimHeader = Ndim; - - - if (isVolStk) - { - header->ispg = 401; - header->mz = Zdim; - header->nz = Zdim * nDimHeader; - } - else - { - header->ispg = 0; - header->nz = nDimHeader; - } - } - else // To set in the header that the file is a volume not a stack - header->ispg = (Zdim>1)? 1:0; - - //locking - FileLock flock; - flock.lock(fimg); - - // Write header when needed - if(!isStack || replaceNsize < nDimHeader) - { - if ( swapWrite ) - swapPage((char *) header, MRCSIZE - 800, DT_Float); - fwrite( header, MRCSIZE, 1, fimg ); - } - freeMemory(header, sizeof(MRChead) ); - - // Jump to the selected imgStart position - fseek( fimg,offset + (datasize)*imgStart, SEEK_SET); - - size_t imgEnd = (isStack)? Ndim : 1; - - if (checkMmapT(wDType) && !mmapOnWrite && dataMode >= DATA) { - writeData(fimg, 0, wDType, datasize_n * imgEnd, castMode); - } else { - for ( size_t i = 0; i < imgEnd; i++ ) - { - // If to also write the image data or jump its size - if (dataMode >= DATA) - { - if (mmapOnWrite && Ndim == 1) // Can map one image at a time only - { - mappedOffset = ftell(fimg); - mappedSize = mappedOffset + datasize; - fseek(fimg, datasize-1, SEEK_CUR); - fputc(0, fimg); - } - else - writeData(fimg, i*datasize_n, wDType, datasize_n, castMode); - } - else - fseek(fimg, datasize, SEEK_CUR); - } - } - - - - // Unlock the file - flock.unlock(); - - if (mmapOnWrite) - mmapFile(); - - return(0); -} diff --git a/src/core/rwMRC.h b/src/core/rwMRC.h deleted file mode 100644 index 0356558..0000000 --- a/src/core/rwMRC.h +++ /dev/null @@ -1,27 +0,0 @@ -/* - Base on rwMRC.h - Header file for reading and writing MRC files - Format: 3D crystallographic image file format for the MRC package - Author: Bernard Heymann - Created: 19990321 Modified: 20030723 -*/ - -#ifndef CORE_RWMRC_H -#define CORE_RWMRC_H - -///@defgroup MRC MRC File format -///@ingroup ImageFormats - -// I/O prototypes -/** MRC Reader - * @ingroup MRC -*/ -int readMRC(size_t select_img, bool isStack = false); -int readMRC(size_t start_img, size_t batch_size, bool isStack = false); - -/** MRC Writer - * @ingroup MRC -*/ -int writeMRC(size_t select_img, bool isStack=false, int mode=WRITE_OVERWRITE, const String &bitDepth="", CastWriteMode castMode = CW_CAST); - -#endif diff --git a/src/core/rwPIF.cpp b/src/core/rwPIF.cpp deleted file mode 100644 index dbe5956..0000000 --- a/src/core/rwPIF.cpp +++ /dev/null @@ -1,165 +0,0 @@ -/*************************************************************************** - * Authors: Joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include "xmipp_image_base.h" -#include "xmipp_error.h" -#include "xmipp_funcs.h" -#include "metadata_static.h" - -#define PIFHEADERSIZE sizeof(PIFDataHeader) // size of EM file header - -int ImageBase::readPIF(size_t select_img) -{ - PIFMainHeader mainHeader; - if ( fread( &mainHeader, PIFHEADERSIZE, 1, fimg ) != 1 ) - REPORT_ERROR(ERR_IO_NOREAD, formatString("rwPIF: cannot read Spider main header from file %s" - ". Error message: %s", filename.c_str() ,strerror(errno))); - - // Check Machine endianness - bool isLE = IsLittleEndian(); - - // Determine byte order and swap bytes if from different-endian machine - swap = (isLE == mainHeader.endianNess); - - if (swap) - swapPage((char *) &mainHeader, PIFHEADERSIZE, DT_Int); - - - DataType datatype; - switch (mainHeader.mode) - { - case 0: - datatype = DT_SChar; - break; - case 1: - case 7: // Actually it's floatint*2, but it isn't moved to float - datatype = DT_Short; - break; - case 2: - case 46: // This case is not documented, but I think this is floatInt*4 - datatype = DT_Int; // We aren't moving to float actually - break; - case 3: - case 8: // Actually it's complex floatint*2, but it isn't moved to float - datatype = DT_CShort; - break; - case 4: - datatype = DT_CInt; // We aren't moving to float actually - break; - case 9: - datatype = DT_Float; - break; - case 10: - datatype = DT_CFloat; - break; - case 97: - REPORT_ERROR(ERR_NOT_IMPLEMENTED, "readPIF: Reading from colormap datatype file not implemented.\n" - "If you're interested in this feature, please contact us at xmipp@cnb.csic.es \n" - "and send us an example image file to help implementing."); - break; - default: - REPORT_ERROR(ERR_NOT_IMPLEMENTED, formatString("readPIF: Reading from datatype code %d file not implemented.\n" - "If you're interested in this feature, please contact us at xmipp@cnb.csic.es \n" - "and send us an example image file to help implementing.", mainHeader.mode)); - break; - } - MDMainHeader.setValue(MDL_DATATYPE,(int)datatype); - - - // Check selected image - if (select_img > (size_t)mainHeader.numImages) - REPORT_ERROR(ERR_INDEX_OUTOFBOUNDS, formatString("readPIF (%s): Image number %lu exceeds stack size %lu" ,filename.c_str(),select_img, mainHeader.numImages)); - - // Setting image dimensions - ArrayDim aDim; - - aDim.ndim = (select_img == ALL_IMAGES)? mainHeader.numImages : 1; - aDim.zdim = mainHeader.nz; - aDim.ydim = mainHeader.ny; - aDim.xdim = mainHeader.nx; - - replaceNsize = aDim.ndim; - - setDimensions(aDim); - - - size_t imgStart = IMG_INDEX(select_img); - size_t datatypeSize = gettypesize(datatype); - offset = PIFHEADERSIZE*2;// + (aDimFile.zyxdim*datatypeSize + PIFHEADERSIZE)*imgStart; - - if (dataMode == HEADER || (dataMode == _HEADER_ALL && aDim.ndim > 1)) // Stop reading if not necessary - return 0; - - size_t imgEnd = (select_img != ALL_IMAGES) ? imgStart + 1 : aDim.ndim; - - size_t imageSize = PIFHEADERSIZE + aDimFile.zyxdim*datatypeSize; - size_t pad = PIFHEADERSIZE; - size_t headerOffset = PIFHEADERSIZE; - - MD.clear(); - for (size_t i = 0; i < imgEnd-imgStart; i++) - MD.push_back(std::unique_ptr(new MDRowVec(MDL::emptyHeaderVec()))); - - PIFDataHeader dataHeader; - - for (size_t n = 0, i = imgStart; i < imgEnd; ++i, ++n ) - { - if (fseek( fimg, headerOffset + i*imageSize, SEEK_SET ) != 0)//fseek return 0 on success - REPORT_ERROR(ERR_IO, formatString("rwPIF: error seeking %lu to read image %lu", headerOffset, i)); - - if ( fread( &dataHeader, PIFHEADERSIZE, 1, fimg ) != 1 ) - REPORT_ERROR(ERR_IO_NOREAD, formatString("rwPIF: cannot read PIF image %lu header", i)); - - if ( swap ) - swapPage((char *) &dataHeader, PIFHEADERSIZE, DT_Int); - - if (dataMode == _HEADER_ALL || dataMode == _DATA_ALL) - { - MD[n]->setValue(MDL_ORIGIN_X, (double)dataHeader.nxstart); - MD[n]->setValue(MDL_ORIGIN_Y, (double)dataHeader.nystart); - MD[n]->setValue(MDL_ORIGIN_Z, (double)dataHeader.nzstart); - MD[n]->setValue(MDL_ANGLE_ROT, (double)dataHeader.alpha); - MD[n]->setValue(MDL_ANGLE_TILT, (double)dataHeader.beta); - MD[n]->setValue(MDL_ANGLE_PSI, (double)dataHeader.gamma); - MD[n]->setValue(MDL_SAMPLINGRATE_X, (double)dataHeader.xlength/aDim.xdim); - MD[n]->setValue(MDL_SAMPLINGRATE_Y, (double)dataHeader.ylength/aDim.ydim); - MD[n]->setValue(MDL_SAMPLINGRATE_Z, (double)dataHeader.zlength/aDim.zdim); - } - } - - if (dataMode < DATA) // Don't read data if not necessary but read the header - return 0; - - //offset should point to the begin of the data - readData(fimg, select_img, datatype, pad ); - - return(0); -} - -int ImageBase::writePIF(size_t select_img, bool isStack, int mode) -{ - REPORT_ERROR(ERR_IO_NOWRITE, "ERROR: writePIF is not implemented."); - return(-1); -} diff --git a/src/core/rwPIF.h b/src/core/rwPIF.h deleted file mode 100644 index 2b12a4e..0000000 --- a/src/core/rwPIF.h +++ /dev/null @@ -1,172 +0,0 @@ -/*************************************************************************** - * Authors: Joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_RWPIF_H_ -#define CORE_RWPIF_H_ - -///defgroup PIF Portable Image Format for EM Data File format -///@ingroup ImageFormats - -/** Information obtained from: - * http://cryoem.ucsd.edu/programDocs/pif.pdf - */ - - -typedef struct -{ - // One time file header - 60 bytes -->> 512 total - long int file_id; //> BYTE*8 Magic bytes - First 4 bytes ignored. - char realScaleFactor[16]; //> char[16] How to convert floatInt*4 into real*4 - int numImages; //> int*4 Number of images in this file - int endianNess; - /** int*4 What endian type of machine created this file - 0 = VAX/DECstation - (Little) - 1 = SGI etc... (Big) */ - char genProgram[32]; //> Program used to generate this file with version number - int htype; - /** int*4- Possible values: - 1 - all projections have the same number of pixels and the same depth (number of bits per pixel) - 0 - otherwise */ - int nx; //> int*4 Number of columns - int ny; //> int*4 Number of rows - int nz; //> int*4 Number of sections - int mode; - /** int*4 EM data type e.g. - 0 = byte*1 - Zeiss scans - 1 = int*2 - 2 = floatInt*4 - 3 = complex int*2 - 4 = complex floatInt*4 - 5 = Structure Factors - 6 = Boxed data unfloated with background value placed past radius of box. - 7 = floatInt*2 - 8 = complex floatInt*2 - 9 = float*4 - 10 = complex float*4 - 20 = MAP floatInt*2 - 21 = MAP floatInt*4 - 22 = MAP floatInt*4 PFTS rot*4 dimension - 31 = Structure Factors Amp/Phase floatInt*4 - 32 = Structure Factors Apart/Bpart floatInt*4 - 88 = Accumulated TIF's in int*2 (st2pif) - 97 = DEPTHCUED etc... */ - int futureUse[107]; //> 428 Bytes Save some space for use later. -} -PIFMainHeader; - -typedef struct -{ - int nx; //> int*4 Number of columns - int ny; //> int*4 Number of rows - int nz; //> int*4 Number of sections - int mode; - /** int*4 EM data type e.g. - 0 = byte*1 - Zeiss scans - 1 = int*2 - 2 = floatInt*4 - 3 = complex int*2 - 4 = complex floatInt*4 - 5 = Structure Factors - 6 = Boxed data unfloated with background value placed past radius of box. - 7 = floatInt*2 - 8 = complex floatInt*2 - 9 = float*4 - 10 = complex float*4 - 20 = MAP floatInt*2 - 21 = MAP floatInt*4 - 22 = MAP floatInt*4 PFTS rot*4 dimension - 31 = Structure Factors Amp/Phase floatInt*4 - 32 = Structure Factors Apart/Bpart floatInt*4 - 88 = Accumulated TIF's in int*2 (st2pif) - 97 = DEPTHCUED etc... */ - int bkgnd; //> int*4 Background value - int packRadius; //> int*4 Radius of boxed image - int nxstart; //> int*4 Number of first col in map - int nystart; //> int*4 Number of first row in map - int nzstart; //> int*4 Number of first section in map - int mx; //> int*4 Number of intervals along x - int my; //> int*4 Number of intervals along y - int mz; //> int*4 Number of intervals along z - float xlength; //> floatInt*4 Cell Dimensions (Angstroms) - float ylength; //> floatInt*4 " - float zlength; //> floatInt*4 " - float alpha; //> floatInt*4 Cell Angles (degrees) - float beta; //> floatInt*4 " - float gamma; //> floatInt*4 " - int mapc; //> int*4 Which axis is col(1,2,3 =x,y,z) - int mapr; //> int*4 Which axis is row(1,2,3 =x,y,z) - int maps; //> int*4 Which axis is sections(1,2,3 = x,y,z) - float min; //> floatInt*4 Min density value - float max; //> floatInt*4 Max density value - float mean; //> floatInt*4 Mean density value - float stdDev; //> floatInt*4 StdDev of GrayLevels - int ispg; //> int*4 Space group number - int nsymbt; //> int*4 Number of bytes for symmetry ops - float xorigin; //> floatInt*4 x origin - float yorigin; //> floatInt*4 y origin - char titleDescription[80]; //> User defined description - char timeStamp[32]; //> Date/time data last modified - char microGraphDesignation[16]; //> Unique Micrograph Number - char scanNumber[8]; //> Scan Number of Micrograph - float aoverb; //> floatInt*4 AOVERB - float map_abang; //> floatInt*4 MAP_ABANG - float dela; //> floatInt*4 DELA - float delb; //> floatInt*4 DELB - float delc; //> floatInt*4 DELC - int t_matrix[6]; //> t_matrix (array of 6 ints) - float dthe; //> floatInt*4 dthe - float dphi_90; //> floatInt*4 dphi_90 - float symmetry; //> floatInt*4 symmetry - int binFactor; //> int*4 Image compression factor - float a_star; //> floatInt*4 emsf3dbt/emmap3dt stuff - float b_star; //> floatInt*4 - float c_star; //> floatInt*4 - float alp_star; //> floatInt*4 - float bet_star; //> floatInt*4 - float gam_star; //> floatInt*4 - float pixelSize; //> floatInt*4 From em3dr - int futureUse[40]; //> int*4 (160 bytes) Save some space for use later -} -PIFDataHeader; - -/** Read image from PIF file format - * - * @param select_img Index number of selected image - * @return - */ -int readPIF(size_t select_img); - -/** Write image to PIF file format - * - * @param select_img Number of selected image to write - * @param isStack Force to write as stack if possible - * @param mode Write file type: overwrite, replace, append.... - * @return - */ -int writePIF(size_t select_img = ALL_IMAGES, bool isStack=false, int mode=WRITE_OVERWRITE); - - -#endif /* RWPIF_H_ */ diff --git a/src/core/rwRAW.cpp b/src/core/rwRAW.cpp deleted file mode 100644 index bb56a28..0000000 --- a/src/core/rwRAW.cpp +++ /dev/null @@ -1,142 +0,0 @@ -/*************************************************************************** - * Authors: Joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include "xmipp_image_base.h" -#include "rwRAW.h" -#include "xmipp_error.h" -#include "metadata_static.h" - -DataType ImageBase::datatypeRAW(String strDT) -{ - DataType datatype; - - if(strDT=="uint8") - datatype = DT_UChar; - else if (strDT=="int8") - datatype = DT_SChar; - else if (strDT=="uint16") - datatype = DT_UShort; - else if (strDT=="int16") - datatype = DT_Short; - else if (strDT=="uint32") - datatype = DT_UInt; - else if (strDT=="int32") - datatype = DT_Int; - else if (strDT=="long") - datatype = DT_Long; - else if (strDT=="float") - datatype = DT_Float; - else if (strDT=="double") - datatype = DT_Double; - else if (strDT=="cint16") - datatype = DT_CShort; - else if (strDT=="cint32") - datatype = DT_CInt; - else if (strDT=="cfloat") - datatype = DT_CFloat; - else if (strDT=="cdouble") - datatype = DT_CDouble; - else if (strDT=="bool") - datatype = DT_Bool; - else - datatype = DT_Unknown; - - return datatype; -} - - -int ImageBase::readRAW(size_t select_img, bool isStack) -{ -#undef DEBUG - //#define DEBUG -#ifdef DEBUG - printf("DEBUG readRAW: Reading RAW file\n"); -#endif - - int _xDim,_yDim,_zDim; - size_t _nDim; - int rPos; - - size_t found; - FileName infolist; - StringVector info; - DataType datatype; - - found = filename.find_first_of("#"); - infolist = filename.substr(found+1); - filename = filename.substr(0,found); - infolist.toLowercase(); - splitString(infolist,",",info, false); - - if (info.size() < 4) - REPORT_ERROR(ERR_ARG_MISSING, (String) " Cannot open file " + filename + - ". Not enough header arguments."); - - _xDim = textToInteger(info[0]); - _yDim = textToInteger(info[1]); - - if (atoi(info[3].c_str()) == 0 && info[3]!="0") // Check if zdim is not included - { - rPos = 2; - _zDim = 1; - } - else - { - rPos = 3; - _zDim = textToInteger(info[2]); - } - - offset = (size_t)textToInteger(info[rPos]); - datatype = datatypeRAW(info[rPos+1]); - _nDim = 1; - - // Check the reverse argument - swap = (info.back() == "r"); - - // Map the parameters - setDimensions(_xDim, _yDim, _zDim, _nDim); - - MDMainHeader.setValue(MDL_SAMPLINGRATE_X,(double) -1); - MDMainHeader.setValue(MDL_SAMPLINGRATE_Y,(double) -1); - MDMainHeader.setValue(MDL_DATATYPE,(int)datatype); - - if (dataMode==HEADER || (dataMode == _HEADER_ALL && _nDim > 1)) // Stop reading if not necessary - return 0; - - size_t imgStart = IMG_INDEX(select_img); - size_t imgEnd = (select_img != ALL_IMAGES) ? imgStart + 1 : _nDim; - - MD.clear(); - for (size_t i = 0; i < imgEnd-imgStart; i++) - MD.push_back(std::unique_ptr(new MDRowVec(MDL::emptyHeaderVec()))); - - if( dataMode < DATA ) - return 0; - - size_t pad = 0; - readData(fimg, select_img, datatype, pad); - - return(0); -} diff --git a/src/core/rwRAW.h b/src/core/rwRAW.h deleted file mode 100644 index dbd0f8e..0000000 --- a/src/core/rwRAW.h +++ /dev/null @@ -1,49 +0,0 @@ -/*************************************************************************** - * Authors: Joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_RWRAW_H_ -#define CORE_RWRAW_H_ - -///@defgroup RAW1 RAW Data type -///@ingroup ImageFormats - -// I/O prototypes -/** RAW Reader - * @ingroup RAW1 -*/ - -DataType datatypeRAW(String strDT); - -///@defgroup RAW RAW File format -///@ingroup ImageFormats - -// I/O prototypes -/** RAW Reader - * @ingroup RAW1 -*/ - -int readRAW(size_t select_img,bool isStack=false); - -#endif /* RWINF_H_ */ diff --git a/src/core/rwSPE.cpp b/src/core/rwSPE.cpp deleted file mode 100644 index bbea163..0000000 --- a/src/core/rwSPE.cpp +++ /dev/null @@ -1,87 +0,0 @@ -/*************************************************************************** - * Authors: Joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include "xmipp_image_base.h" -#include "xmipp_error.h" -#include "metadata_static.h" -#include "xmipp_funcs.h" - -///@defgroup SPE Princeton Instruments File Format -///@ingroup ImageFormats - -// I/O prototypes -/** SPE Reader - * @ingroup SPE -*/ -int ImageBase::readSPE(size_t select_img,bool isStack) -{ - - int _xDim,_yDim,_zDim; - size_t _nDim; - - short int aux; - fseek(fimg,42,SEEK_SET); - xmippFREAD(&aux, sizeof(short int), 1, fimg, swap ); - _xDim = aux; - fseek(fimg,656,SEEK_SET); - xmippFREAD(&aux, sizeof(short int), 1, fimg, swap ); - _yDim = aux; - - _zDim = 1; - _nDim = 1; - - // Map the parameters - setDimensions(_xDim, _yDim, _zDim, _nDim); - - offset = 4100; - DataType datatype = DT_UShort; - - MDMainHeader.setValue(MDL_SAMPLINGRATE_X,(double) -1); - MDMainHeader.setValue(MDL_SAMPLINGRATE_Y,(double) -1); - MDMainHeader.setValue(MDL_DATATYPE,(int)datatype); - - if (dataMode==HEADER) // Stop reading if not necessary - return 0; - - size_t imgStart = IMG_INDEX(select_img); - size_t imgEnd = (select_img != ALL_IMAGES) ? imgStart + 1 : _nDim; - - MD.clear(); - for (size_t i = 0; i < imgEnd-imgStart; i++) - MD.push_back(std::unique_ptr(new MDRowVec(MDL::emptyHeaderVec()))); - if( dataMode < DATA ) - return 0; - - size_t pad = 0; - - readData(fimg, select_img, datatype, pad); - - return(0); -} - -int ImageBase::writeSPE(size_t select_img, bool isStack, int mode) -{ - REPORT_ERROR(ERR_IMG_NOWRITE, "writeSPE is not implemented."); -} diff --git a/src/core/rwSPE.h b/src/core/rwSPE.h deleted file mode 100644 index 2d2c8fa..0000000 --- a/src/core/rwSPE.h +++ /dev/null @@ -1,42 +0,0 @@ -/*************************************************************************** - * Authors: Joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_RWSPE_H_ -#define CORE_RWSPE_H_ - -///@defgroup SPE Princeton Instruments File Format -///@ingroup ImageFormats - -// I/O prototypes -/** SPE Reader - * @ingroup SPE -*/ -int readSPE(size_t select_img,bool isStack=false); - -/** SPE Writer - * @ingroup SPE -*/ -int writeSPE(size_t select_img, bool isStack=false, int mode=WRITE_OVERWRITE); -#endif /* RWSPE_H_ */ diff --git a/src/core/rwSPIDER.cpp b/src/core/rwSPIDER.cpp deleted file mode 100644 index 3d1b4c5..0000000 --- a/src/core/rwSPIDER.cpp +++ /dev/null @@ -1,600 +0,0 @@ -/*************************************************************************** - * Authors: Joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include -#include "xmipp_image_base.h" -#include "xmipp_memory.h" -#include "metadata_static.h" -#include "multidim_array_base.h" - - -/* - Based on rwSPIDER.h - Header file for reading and writing SPIDER files - Format: 3D image file format for the SPIDER package - Author: Bernard Heymann - Created: 19990410 Modified: 20010928 -*/ - - -#define SPIDERSIZE 1024 // Minimum size of the SPIDER header (variable) -///@defgroup Spider Spider File format -///@ingroup ImageFormats - -/** Spider Header - * @ingroup Spider -*/ -struct SPIDERhead -{ // file header for SPIDER data - float nslice; // 0 slices in volume (image = 1) - float nrow; // 1 rows per slice - float irec; // 2 # records in file (unused) - float nhistrec; // 3 (obsolete) - float iform; // 4 file type specifier - float imami; // 5 max/min flag (=1 if calculated) - float fmax; // 6 maximum - float fmin; // 7 minimum - float av; // 8 average - float sig; // 9 standard deviation (=-1 if not calculated) - float ihist; // 10 (obsolete) - float nsam; // 11 pixels per row - float labrec; // 12 # records in header - float iangle; // 13 flag: tilt angles filled - float phi; // 14 tilt angles - float theta; // 15 - float gamma; // 16 (=psi) - float xoff; // 17 translation - float yoff; // 18 - float zoff; // 19 - float scale; // 20 scaling - float labbyt; // 21 # bytes in header - float lenbyt; // 22 record length in bytes (row length) - float istack; // 23 indicates stack of images - float inuse; // 24 indicates this image in stack is used (not used) - float maxim; // 25 max image in stack used - float imgnum; // 26 number of current image - float unused[2]; // 27-28 (unused) - float kangle; // 29 flag: additional angles set - float phi1; // 30 additional angles - float theta1; // 31 - float psi1; // 32 - float phi2; // 33 - float theta2; // 34 - float psi2; // 35 - - double fGeo_matrix[3][3]; // x9 = 72 bytes: Geometric info - float fAngle1; // angle info - - float fr1; - float fr2; // lift up cosine mask parameters - - /** Fraga 23/05/97 For Radon transforms **/ - float RTflag; // 1=RT, 2=FFT(RT) - float Astart; - float Aend; - float Ainc; - float Rsigma; // 4*7 = 28 bytes - float Tstart; - float Tend; - float Tinc; // 4*3 = 12, 12+28 = 40B - - /** Sjors Scheres 17/12/04 **/ - float weight; // For Maximum-Likelihood refinement - float flip; // 0=no flipping operation (false), 1=flipping (true) - - char fNada2[576]; // empty 700-76-40=624-40-8= 576 bytes - - char cdat[12]; // 211-213 creation date - char ctim[8]; // 214-215 creation time - char ctit[160]; // 216-255 title -} ; - -/************************************************************************ -@Function: readSPIDER -@Description: - Reading a SPIDER image file format. -@Algorithm: - A 3D multi-image format used in electron microscopy. - Header size: 1024 bytes (not same as data offset!). - Data offset: sizeof(float)*x_size*ceil(1024/x_size) - File format extensions: .spi - Byte order determination: File type and third dimension values - must be less than 256*256. - Data type: only float. - Transform type: Hermitian - The x-dimension contains the x-size - of the full transform - A multi-image file has a global header followed by a header and data - for each sub-image. -@Arguments: - Bimage* p the image structure. - size_t select_img image selection in multi-image file (-1 = all images). -@Returns: - int error code (<0 means failure). -**************************************************************************/ -/** Spider Reader - * @ingroup Spider -*/ -#include "metadata_label.h" -#include -#include - -int ImageBase::readSPIDER(size_t start_img, size_t batch_size) { -#undef DEBUG - //#define DEBUG -#ifdef DEBUG - printf("DEBUG readSPIDER: Reading Spider file, start_img = %lu, batch_size = %lu\n", start_img, batch_size); -#endif -#undef DEBUG - - // SPIDERhead* header = new SPIDERhead; - std::unique_ptr header( new SPIDERhead() ); - if ( fread( header.get(), SPIDERSIZE, 1, fimg ) != 1 ) - REPORT_ERROR(ERR_IO_NOREAD, formatString("rwSPIDER: cannot read Spider main header from file %s" - ". Error message: %s", filename.c_str() ,strerror(errno))); - - // Determine byte order and swap bytes if from different-endian machine - if ( (swap = (( fabs(header->nslice) > SWAPTRIG ) || ( fabs(header->iform) > 1000 ) || - ( fabs(header->nslice) < 1 ))) ) - swapPage((char *) header.get(), SPIDERSIZE - 180, DT_Float); - - if(header->labbyt != header->labrec*header->lenbyt) - REPORT_ERROR(ERR_IO_NOTFILE,formatString("Invalid Spider file: %s", filename.c_str())); - - offset = (size_t) header->labbyt; - DataType datatype = DT_Float; - - MDMainHeader.setValue(MDL_MIN,(double)header->fmin); - MDMainHeader.setValue(MDL_MAX,(double)header->fmax); - MDMainHeader.setValue(MDL_AVG,(double)header->av); - MDMainHeader.setValue(MDL_STDDEV,(double)header->sig); - MDMainHeader.setValue(MDL_SAMPLINGRATE_X,(double)header->scale); - MDMainHeader.setValue(MDL_SAMPLINGRATE_Y,(double)header->scale); - MDMainHeader.setValue(MDL_SAMPLINGRATE_Z,(double)header->scale); - MDMainHeader.setValue(MDL_DATATYPE,(int)datatype); - - bool isStack = ( header->istack > 0 ); - int _xDim,_yDim,_zDim; - size_t _nDim, _nDimSet; - _xDim = (int) header->nsam; - _yDim = (int) header->nrow; - _zDim = (int) header->nslice; - _nDim = (isStack)? (size_t)(header->maxim) : 1; - - if (_xDim < 1 || _yDim < 1 || _zDim < 1 || _nDim < 1) - REPORT_ERROR(ERR_IO_NOTFILE,formatString("Invalid Spider file: %s", filename.c_str())); - - replaceNsize = _nDim; - - /************ - * BELLOW HERE DO NOT USE HEADER BUT LOCAL VARIABLES - */ - - // Map the parameters, REad the whole object (-1) or a slide - // Only handle stacks of images not of volumes - - if(!isStack) { - _nDimSet = 1; - } - else if (batch_size == ALL_IMAGES) { - _nDimSet = _nDim - start_img + 1; - } else { - _nDimSet = std::min( start_img + batch_size - 1, _nDim ) - start_img + 1; - } - - setDimensions(_xDim, _yDim, _zDim, _nDimSet); - - //image is in stack? and set right initial and final image - const size_t header_size = offset; - - if ( isStack) - { - if ( start_img > _nDim ) - REPORT_ERROR(ERR_INDEX_OUTOFBOUNDS, formatString("readSpider (%s): Image number %lu exceeds stack size %lu" ,filename.c_str(),start_img, _nDim)); - offset += offset; - } - - if (dataMode == HEADER || (dataMode == _HEADER_ALL && _nDimSet > 1)) // Stop reading if not necessary - { - return 0; - } - - const size_t datasize_n = _xDim*_yDim*_zDim; - const size_t image_size = header_size + datasize_n*sizeof(float); - const size_t pad = (size_t) header->labbyt; - const size_t imgStart = IMG_INDEX(start_img); - const size_t imgEnd = start_img + _nDimSet - 1; - // printf( "start_img = %lu, batch_size = %lu, _nDim = %lu, _nDimSet = %lu, imgEnd = %lu\n", start_img, batch_size, _nDim, _nDimSet, imgEnd ); - size_t img_seek = header_size + imgStart * image_size; - - MD.clear(); - for (size_t i = 0; i < imgEnd-imgStart; i++) - MD.push_back(std::unique_ptr(new MDRowVec(MDL::emptyHeaderVec()))); - double daux; - - //std::cerr << formatString("DEBUG_JM: header_size: %10lu, datasize_n: %10lu, image_size: %10lu, imgStart: %10lu, img_seek: %10lu", - // header_size, datasize_n, image_size, imgStart, img_seek) <xoff; - MD[n]->setValue(MDL_SHIFT_X, daux); - daux = (double)header->yoff; - MD[n]->setValue(MDL_SHIFT_Y, daux); - daux = (double)header->zoff; - MD[n]->setValue(MDL_SHIFT_Z, daux); - daux = (double)header->phi; - MD[n]->setValue(MDL_ANGLE_ROT, daux); - daux = (double)header->theta; - MD[n]->setValue(MDL_ANGLE_TILT, daux); - daux = (double)header->gamma; - MD[n]->setValue(MDL_ANGLE_PSI, daux); - daux = (double)header->weight; - MD[n]->setValue(MDL_WEIGHT, daux); - bool baux = (header->flip == 1); - MD[n]->setValue(MDL_FLIP, baux); - daux = (double) header->scale; - if (daux==0.) - daux=1.0; - MD[n]->setValue(MDL_SCALE, daux); - } - } - - if (dataMode < DATA) // Don't read data if not necessary but read the header - return 0; - -#ifdef DEBUG - std::cerr<<"DEBUG readSPIDER: header_size = "<nzyxdim*gettypesize(wDType) > tiff_map_min_size) - mdaBase->setMmap(true); - - // Allocate memory for image data (Assume xdim, ydim, zdim and ndim are already set - //if memory already allocated use it (no resize allowed) - mdaBase->coreAllocateReuse(); - - return 0; - } - } - else - dataMode = DATA; - } - - size_t Xdim, Ydim, Zdim, Ndim; - getDimensions(Xdim, Ydim, Zdim, Ndim); - - size_t datasize, datasize_n; - datasize_n = (size_t)Xdim*Ydim*Zdim; - datasize = datasize_n * gettypesize(wDType); - - // Filling the main header - float lenbyt = gettypesize(wDType)*Xdim; // Record length (in bytes) - float labrec = floor(SPIDERSIZE/lenbyt); // # header records - if ( fmod(SPIDERSIZE,lenbyt) != 0 ) - labrec++; - float labbyt = labrec*lenbyt; // Size of header in bytes - offset = (size_t) labbyt; - - SPIDERhead* header = (SPIDERhead *) askMemory((int)labbyt*sizeof(char)); - - // Map the parameters - header->lenbyt = lenbyt; // Record length (in bytes) - header->labrec = labrec; // # header records - header->labbyt = labbyt; // Size of header in bytes - - header->irec = labrec + floor((datasize_n*gettypesize(wDType))/lenbyt + 0.999999); // Total # records - header->nsam = Xdim; - header->nrow = Ydim; - header->nslice = Zdim; - - // If a transform, then the physical storage in x is only half+1 - if ( transform == Hermitian ) - { - size_t xstore = (size_t)(Xdim * 0.5 + 1); - header->nsam = 2*xstore; - } - - // #define DEBUG -#ifdef DEBUG - printf("DEBUG writeSPIDER: Size: %g %g %g %d %g\n", - header->nsam, - header->nrow, - header->nslice, - Ndim, - header->maxim); -#endif -#undef DEBUG - - if ( Zdim < 2 ) - { - // 2D image or 2D Fourier transform - header->iform = ( transform == NoTransform ) ? 1 : -12 + (int)header->nsam%2; - } - else - { - // 3D volume or 3D Fourier transform - header->iform = ( transform == NoTransform )? 3 : -22 + (int)header->nsam%2; - } - double aux; - bool baux; - header->imami = 0;//never trust max/min - - - if (!MDMainHeader.empty()) - { -#define SET_MAIN_HEADER_VALUE(field, label, aux) MDMainHeader.getValueOrDefault(label, aux, 0.); header->field = (float)aux - SET_MAIN_HEADER_VALUE(fmin, MDL_MIN, aux); - SET_MAIN_HEADER_VALUE(fmax, MDL_MAX, aux); - SET_MAIN_HEADER_VALUE(av, MDL_AVG, aux); - SET_MAIN_HEADER_VALUE(sig, MDL_STDDEV, aux); - } - - - if (Ndim == 1 && mode != WRITE_APPEND && !isStack && !MD.empty()) - { - if ((dataMode == _HEADER_ALL || dataMode == _DATA_ALL)) - { -#define SET_HEADER_VALUE(field, label, aux) MD[0]->getValueOrDefault((label), (aux), 0.); header->field = (float)(aux) - SET_HEADER_VALUE(xoff, MDL_SHIFT_X, aux); - SET_HEADER_VALUE(yoff, MDL_SHIFT_Y, aux); - SET_HEADER_VALUE(zoff, MDL_SHIFT_Z, aux); - SET_HEADER_VALUE(phi, MDL_ANGLE_ROT, aux); - SET_HEADER_VALUE(theta, MDL_ANGLE_TILT, aux); - SET_HEADER_VALUE(gamma, MDL_ANGLE_PSI, aux); - SET_HEADER_VALUE(weight, MDL_WEIGHT, aux); - SET_HEADER_VALUE(flip, MDL_FLIP, baux); - SET_HEADER_VALUE(scale, MDL_SCALE, aux); - } - else - { - header->xoff = header->yoff = header->zoff =\ - header->phi = header->theta = header->gamma = header->weight = 0.; - header->scale = 1.; - } - } - - //else end - // Set time and date - /* - time_t timer; - time ( &timer ); - tm* t = localtime(&timer); - while ( t->tm_year > 100 ) - t->tm_year -= 100; - sprintf(header->ctim, "%02d:%02d:%02d", t->tm_hour, t->tm_min, t->tm_sec); - sprintf(header->cdat, "%02d-%02d-%02d", t->tm_mday, t->tm_mon, t->tm_year); - */ - -#ifdef DEBUG - - printf("DEBUG writeSPIDER: Date and time: %s %s\n", header->cdat, header->ctim); - printf("DEBUG writeSPIDER: Text label: %s\n", header->ctit); - printf("DEBUG writeSPIDER: Header size: %g\n", header->labbyt); - printf("DEBUG writeSPIDER: Header records and record length: %g %g\n", header->labrec, header->lenbyt); - printf("DEBUG writeSPIDER: Data size: %ld\n", datasize); - printf("DEBUG writeSPIDER: Data offset: %ld\n", offset); - printf("DEBUG writeSPIDER: File %s\n", filename.c_str()); -#endif - - - // Only write mainheader when new file or number of images in stack changed - bool writeMainHeaderReplace = false; - header->maxim = replaceNsize; - size_t imgStart = (mode == WRITE_APPEND)? replaceNsize : IMG_INDEX(select_img); - size_t newNsize = imgStart + Ndim; - - if (Ndim > 1 || mode == WRITE_APPEND || isStack) - { - header->istack = 2; - header->inuse = 1; - - if( mode == WRITE_APPEND ) - { - writeMainHeaderReplace = true; - header->maxim += Ndim; - } - else if(newNsize > replaceNsize) - { - writeMainHeaderReplace = true; - header->maxim = newNsize; - } - } - else - { - header->istack = 0; - header->inuse = 0; - header->maxim = 1; - writeMainHeaderReplace=true; - } - - //locking the file - FileLock flock; - flock.lock(fimg); - - // Write main header - if( mode == WRITE_OVERWRITE || - mode == WRITE_APPEND || - writeMainHeaderReplace || - newNsize > replaceNsize) //header must change - { - if ( swapWrite ) - swapPage((char *) header, SPIDERSIZE - 180, DT_Float); - fwrite( header, offset, 1, fimg ); - } - - // write single image if not stack - if ( Ndim == 1 && !isStack) - { - if (dataMode >= DATA) // Image is not written if only is modifying the header - { - if (mmapOnWrite) - { - mappedOffset = ftell(fimg); - mappedSize = mappedOffset + datasize; - fseek(fimg, datasize-1, SEEK_CUR); - fputc(0, fimg); - } - else - writeData(fimg, 0, wDType, datasize_n, CW_CAST); - } - } - else // Jump to the selected imgStart position - { - fseek( fimg,offset + (offset+datasize)*imgStart, SEEK_SET); - - //for ( size_t i=0; ixoff = header->yoff = header->zoff =\ - header->phi = header->theta = header->gamma = header->weight = 0.; - header->scale = 1.; - } - //do not need to unlock because we are in the overwrite case - if ( swapWrite ) - swapPage((char *) header, SPIDERSIZE - 180, DT_Float); - fwrite( header, offset, 1, fimg ); - if (dataMode >= DATA) - { - if (mmapOnWrite && Ndim == 1) // Can map one image at a time only - { - mappedOffset = ftell(fimg); - mappedSize = mappedOffset + datasize; - fseek(fimg, datasize-1, SEEK_CUR); - fputc(0, fimg); - } - else - writeData(fimg, i*datasize_n, wDType, datasize_n, CW_CAST); - } - else - fseek(fimg, datasize, SEEK_CUR); - } - } - //I guess I do not need to unlock since we are going to close the file - flock.unlock(); - - if (mmapOnWrite) - mmapFile(); - - freeMemory(header, (int)labbyt*sizeof(char)); - - return(0); -} diff --git a/src/core/rwSPIDER.h b/src/core/rwSPIDER.h deleted file mode 100644 index b5914f0..0000000 --- a/src/core/rwSPIDER.h +++ /dev/null @@ -1,142 +0,0 @@ -/* - Based on rwSPIDER.h - Header file for reading and writing SPIDER files - Format: 3D image file format for the SPIDER package - Author: Bernard Heymann - Created: 19990410 Modified: 20010928 -*/ - -#ifndef CORE_RWSPIDER_H -#define CORE_RWSPIDER_H - -#define SPIDERSIZE 1024 // Minimum size of the SPIDER header (variable) -///@defgroup Spider Spider File format -///@ingroup ImageFormats - -/** Spider Header - * @ingroup Spider -*/ -struct SPIDERhead -{ // file header for SPIDER data - float nslice; // 0 slices in volume (image = 1) - float nrow; // 1 rows per slice - float irec; // 2 # records in file (unused) - float nhistrec; // 3 (obsolete) - float iform; // 4 file type specifier - float imami; // 5 max/min flag (=1 if calculated) - float fmax; // 6 maximum - float fmin; // 7 minimum - float av; // 8 average - float sig; // 9 standard deviation (=-1 if not calculated) - float ihist; // 10 (obsolete) - float nsam; // 11 pixels per row - float labrec; // 12 # records in header - float iangle; // 13 flag: tilt angles filled - float phi; // 14 tilt angles - float theta; // 15 - float gamma; // 16 (=psi) - float xoff; // 17 translation - float yoff; // 18 - float zoff; // 19 - float scale; // 20 scaling - float labbyt; // 21 # bytes in header - float lenbyt; // 22 record length in bytes (row length) - float istack; // 23 indicates stack of images - float inuse; // 24 indicates this image in stack is used (not used) - float maxim; // 25 max image in stack used - float imgnum; // 26 number of current image - float unused[2]; // 27-28 (unused) - float kangle; // 29 flag: additional angles set - float phi1; // 30 additional angles - float theta1; // 31 - float psi1; // 32 - float phi2; // 33 - float theta2; // 34 - float psi2; // 35 - - double fGeo_matrix[3][3]; // x9 = 72 bytes: Geometric info - float fAngle1; // angle info - - float fr1; - float fr2; // lift up cosine mask parameters - - /** Fraga 23/05/97 For Radon transforms **/ - float RTflag; // 1=RT, 2=FFT(RT) - float Astart; - float Aend; - float Ainc; - float Rsigma; // 4*7 = 28 bytes - float Tstart; - float Tend; - float Tinc; // 4*3 = 12, 12+28 = 40B - - /** Sjors Scheres 17/12/04 **/ - float weight; // For Maximum-Likelihood refinement - float flip; // 0=no flipping operation (false), 1=flipping (true) - - char fNada2[576]; // empty 700-76-40=624-40-8= 576 bytes - - char cdat[12]; // 211-213 creation date - char ctim[8]; // 214-215 creation time - char ctit[160]; // 216-255 title -} ; - -/************************************************************************ -@Function: readSPIDER -@Description: - Reading a SPIDER image file format. -@Algorithm: - A 3D multi-image format used in electron microscopy. - Header size: 1024 bytes (not same as data offset!). - Data offset: sizeof(float)*x_size*ceil(1024/x_size) - File format extensions: .spi - Byte order determination: File type and third dimension values - must be less than 256*256. - Data type: only float. - Transform type: Hermitian - The x-dimension contains the x-size - of the full transform - A multi-image file has a global header followed by a header and data - for each sub-image. -@Arguments: - Bimage* p the image structure. - size_t select_img image selection in multi-image file (-1 = all images). -@Returns: - int error code (<0 means failure). -**************************************************************************/ -/** Spider Reader - * @ingroup Spider -*/ -int readSPIDER(size_t select_img); - -/************************************************************************ -@Function: readSPIDER -@Description: - Reading a SPIDER image file format in batches. -@Arguments: - size_t start_img Number of first image in the batch. - size_t batch_size Specifies how many sub-images will be read. - If batch_size = ALL_IMAGES, then images from `start_img` to the last one will be read. -@Returns: - int error code (<0 means failure). -**************************************************************************/ -/** Spider Reader - * @ingroup Spider -*/ -int readSPIDER(size_t start_img, size_t batch_size); - -/************************************************************************ -@Function: writeSPIDER -@Description: - Writing a SPIDER image file format. -@Algorithm: - A 3D image format used in electron microscopy. -@Arguments: -@Returns: - int error code (<0 means failure). -**************************************************************************/ -/** Spider Writer - * @ingroup Spider -*/ -int writeSPIDER(size_t select_img = ALL_IMAGES, bool isStack=false, int mode=WRITE_OVERWRITE); -#endif diff --git a/src/core/rwTIA.cpp b/src/core/rwTIA.cpp deleted file mode 100644 index d840468..0000000 --- a/src/core/rwTIA.cpp +++ /dev/null @@ -1,257 +0,0 @@ -/*************************************************************************** - * Authors: Joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include "xmipp_image_base.h" -#include "xmipp_error.h" -#include "xmipp_memory.h" -#include "xmipp_funcs.h" -#include "metadata_static.h" - -#define TIASIZE 30 // Size of the TIA header without pDATA_OFFSET - -///@defgroup TIA TIA File format -///@ingroup ImageFormats - -/** TIA Header - * @ingroup TIA -*/ -struct TIAhead -{ - short int endianess; - short int SeriesID; - short int SeriesVersion; - int DATA_TYPE_ID; - int TagTypeID; - int TotalNumberElements; - int NUMBER_IMAGES; - int OFFSET_ARRAY_OFFSET; - int numberdimensions; - int * pDATA_OFFSET; -}; - -#define TIAdataSIZE 50 // Size of the TIA data header to be read - -/** TIA Data Header - * @ingroup TIA -*/ -struct TIAdataHead -{ - double CalibrationOffsetX; //CalibrationOffsetX - double PIXEL_WIDTH; //CalibrationDeltaX - int CalibrationElementX; //CalibrationElementX - double CalibrationOffsetY; //CalibrationOffsetY - double PIXEL_HEIGHT; //CalibrationDeltaY - int CalibrationElementY; //CalibrationElementY - short int DATA_TYPE; //DataType - int IMAGE_WIDTH; //ArraySizeX - int IMAGE_HEIGHT; //ArraySizeY - short int DATA_TYPE_SIZE; - std::string DATA_TYPE_SIZE_STRING; - bool isSigned; -}; - -// I/O prototypes -/** TIA Reader - * @ingroup TIA -*/ -int ImageBase::readTIA(int select_img,bool isStack) -{ - TIAhead * header = new TIAhead; - - xmippFREAD(&header->endianess, sizeof(short int), 1, fimg, swap ); - - // Set Endianess - if (header->endianess == 18761) - swap = 0; - else - swap = 1; - if (IsBigEndian()) - swap = !swap; - - xmippFREAD(&header->SeriesID, sizeof(short int), 1, fimg, swap ); - xmippFREAD(&header->SeriesVersion, sizeof(short int), 1, fimg, swap); - xmippFREAD(&header->DATA_TYPE_ID, sizeof(int), 1, fimg, swap); - xmippFREAD(&header->TagTypeID, sizeof(int), 1, fimg, swap ); - xmippFREAD(&header->TotalNumberElements, sizeof(int), 1, fimg, swap ); - xmippFREAD(&header->NUMBER_IMAGES, sizeof(int), 1, fimg, swap ); - xmippFREAD(&header->OFFSET_ARRAY_OFFSET, sizeof(int), 1, fimg, swap ); - xmippFREAD(&header->numberdimensions, sizeof(int), 1, fimg, swap ); - - // Check data type - if (header->DATA_TYPE_ID != 16674) - REPORT_ERROR(ERR_TYPE_INCORRECT, "ERROR: readTIA only processes images in real space"); - - fseek(fimg, header->OFFSET_ARRAY_OFFSET, SEEK_SET); - header->pDATA_OFFSET = (int *) askMemory(header->NUMBER_IMAGES * sizeof(int)); - xmippFREAD(header->pDATA_OFFSET, sizeof(int), header->NUMBER_IMAGES, fimg, swap); - - TIAdataHead* dataHeaders = new TIAdataHead [header->NUMBER_IMAGES]; - - // Read all the image headers - for (int i = 0; i < header->NUMBER_IMAGES; i++) - { - fseek(fimg, header->pDATA_OFFSET[i], SEEK_SET); - xmippFREAD(&(dataHeaders[i].CalibrationOffsetX), sizeof(double), 1, fimg, swap); - xmippFREAD(&dataHeaders[i].PIXEL_WIDTH, sizeof(double), 1, fimg, swap); - xmippFREAD(&dataHeaders[i].CalibrationElementX, sizeof(int), 1, fimg, swap); - xmippFREAD(&dataHeaders[i].CalibrationOffsetY, sizeof(double), 1, fimg, swap); - xmippFREAD(&dataHeaders[i].PIXEL_HEIGHT, sizeof(double), 1, fimg, swap); - xmippFREAD(&dataHeaders[i].CalibrationElementY, sizeof(int), 1, fimg, swap); - xmippFREAD(&dataHeaders[i].DATA_TYPE, sizeof(short int), 1, fimg, swap); - xmippFREAD(&dataHeaders[i].IMAGE_WIDTH, sizeof(int), 1, fimg, swap); - xmippFREAD(&dataHeaders[i].IMAGE_HEIGHT, sizeof(int), 1, fimg, swap); - } - - int _xDim,_yDim; - size_t _nDim; - - size_t imgStart = IMG_INDEX(select_img); - size_t imgEnd = (select_img != ALL_IMAGES) ? imgStart + 1 : header->NUMBER_IMAGES; - - if (select_img > header->NUMBER_IMAGES) - REPORT_ERROR(ERR_INDEX_OUTOFBOUNDS, formatString("readTIA: Image number %lu exceeds stack size %lu", select_img, header->NUMBER_IMAGES)); - else if (select_img == ALL_IMAGES) - { - for (int i = 1; i < header->NUMBER_IMAGES; i++) // Check images dimensions. Need to be the same - { - if (dataHeaders[0].IMAGE_HEIGHT != dataHeaders[i].IMAGE_HEIGHT || \ - dataHeaders[0].IMAGE_WIDTH != dataHeaders[i].IMAGE_WIDTH || \ - dataHeaders[0].DATA_TYPE != dataHeaders[i].DATA_TYPE) - REPORT_ERROR(ERR_IMG_NOREAD, "readTIA: images in TIA file with different dimensions and data types are not supported"); - } - _xDim = dataHeaders[0].IMAGE_WIDTH; - _yDim = dataHeaders[0].IMAGE_HEIGHT; - _nDim = (size_t) header->NUMBER_IMAGES; - } - else - { - _xDim = dataHeaders[imgStart].IMAGE_WIDTH; - _yDim = dataHeaders[imgStart].IMAGE_HEIGHT; - _nDim = 1; - } - - // Map the parameters - setDimensions(_xDim, _yDim, 1, _nDim); - - DataType datatype; - // dataHeaders[0].isSigned = false; - int tiaDT; - tiaDT = dataHeaders[imgStart].DATA_TYPE; - offset = header->pDATA_OFFSET[imgStart] + TIAdataSIZE; - - switch ( tiaDT ) - { - case 1: - datatype = DT_UChar; - break; - case 2: - datatype = DT_UShort; - // datatype = DT_Short; - break; - case 3: - datatype = DT_UInt; - break; - case 4: - datatype = DT_SChar; - break; - case 5: - datatype = DT_Short; - // dataHeaders[0].isSigned = true; - break; - case 6: - datatype = DT_Int; - break; - case 7: - datatype = DT_Float; - break; - case 8: - datatype = DT_Double; - break; - case 9: - datatype = DT_CFloat; - break; - case 10: - datatype = DT_CDouble; - break; - default: - datatype = DT_Unknown; - (void)datatype; // to suppress dead assignment warning - break; - } - - MDMainHeader.setValue(MDL_SAMPLINGRATE_X,(double)dataHeaders[0].PIXEL_WIDTH); - MDMainHeader.setValue(MDL_SAMPLINGRATE_Y,(double)dataHeaders[0].PIXEL_HEIGHT); - MDMainHeader.setValue(MDL_DATATYPE,(int)datatype); - - if (dataMode == HEADER || (dataMode == _HEADER_ALL && _nDim > 1)) // Stop reading if not necessary - { - delete header; - delete[] dataHeaders; - return 0; - } - - MD.clear(); - for (size_t i = 0; i < imgEnd-imgStart; i++) - MD.push_back(std::unique_ptr(new MDRowVec(MDL::emptyHeaderVec()))); - - double aux; - for ( size_t i = 0; i < imgEnd - imgStart; ++i ) - { - if (dataMode == _HEADER_ALL || dataMode == _DATA_ALL) - { - if(MDMainHeader.getValue(MDL_SAMPLINGRATE_X,aux)) - { - MD[i]->setValue(MDL_SHIFT_X, dataHeaders[i].CalibrationOffsetX/aux); - aux = ROUND(dataHeaders[i].CalibrationElementX - \ - dataHeaders[i].CalibrationOffsetX/aux - _xDim/2); - MD[i]->setValue(MDL_ORIGIN_X, aux); - } - if(MDMainHeader.getValue(MDL_SAMPLINGRATE_Y,aux)) - { - MD[i]->setValue(MDL_SHIFT_Y, dataHeaders[i].CalibrationOffsetY/aux); - aux = ROUND(dataHeaders[i].CalibrationElementY - \ - dataHeaders[i].CalibrationOffsetY/aux -_yDim/2); - MD[i]->setValue(MDL_ORIGIN_Y, aux); - } - } - } - - delete header; - delete[] dataHeaders; - - if( dataMode < DATA ) - return 0; - - size_t pad = TIAdataSIZE; - readData(fimg, select_img, datatype, pad); - - return(0); -} - -int ImageBase::writeTIA(int img_select, bool isStack, int mode) -{ - REPORT_ERROR(ERR_IMG_NOWRITE, "ERROR: writeTIA is not implemented."); -} - diff --git a/src/core/rwTIA.h b/src/core/rwTIA.h deleted file mode 100644 index cab2fc9..0000000 --- a/src/core/rwTIA.h +++ /dev/null @@ -1,44 +0,0 @@ -/*************************************************************************** - * Authors: Joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_RWTIA_H_ -#define CORE_RWTIA_H_ - - -///@defgroup TIA TIA File format -///@ingroup ImageFormats - -// I/O prototypes -/** TIA Reader - * @ingroup TIA -*/ -int readTIA(int img_select,bool isStack=false); - -/** TIA Writer - * @ingroup TIA -*/ -int writeTIA(int img_select, bool isStack=false, int mode=WRITE_OVERWRITE); - -#endif /* RWTIA_H_ */ diff --git a/src/core/rwTIFF.cpp b/src/core/rwTIFF.cpp deleted file mode 100644 index 2943c1d..0000000 --- a/src/core/rwTIFF.cpp +++ /dev/null @@ -1,539 +0,0 @@ -/*************************************************************************** - * Authors: Joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include -#include "xmipp_image_base.h" -#include "xmipp_error.h" -#include -#include "multidim_array_base.h" -#include "metadata_static.h" - -/** - * castTiffTile2T - * - * write the content of a tile from a TIFF file to an image array - */ -void ImageBase::castTiffTile2T( - size_t offset , - char* tif_buf, - unsigned int x, unsigned int y, - unsigned int imageWidth, unsigned int imageLength, - unsigned int tileWidth, unsigned int tileLength, - unsigned short samplesPerPixel, - DataType datatype) -{ - int typeSize = gettypesize(datatype); - unsigned int i, j; - unsigned int x_max = x + tileWidth, - y_max = y + tileLength; - - if (x_max > imageWidth) - x_max = imageWidth; - if (y_max > imageLength) - y_max = imageLength; - - - for (j = y; j < y_max; j++) - for (i = x; i < x_max; i++) - setPage2T(offset+(j*imageWidth + i), (char*) tif_buf+((j-y)*samplesPerPixel*typeSize*tileWidth+(i-x)*samplesPerPixel*typeSize), datatype, (size_t) 1); -} - -/** castTiffLine2T - * - * write the content of a line from a TIFF file to an image array -*/ -void ImageBase::castTiffLine2T( - size_t offset, - char* tif_buf, - unsigned int y, - unsigned int imageWidth, unsigned int imageLength, - unsigned short samplesPerPixel, - DataType datatype) -{ - unsigned int x; - int typeSize = gettypesize(datatype); - - for (x = 0; x < imageWidth; x++) - setPage2T(offset+(y*imageWidth + x), (char*) tif_buf+(samplesPerPixel*typeSize * x), datatype, (size_t) 1); -} - -/** Determine datatype of the TIFF format file. - * @ingroup TIFF -*/ -DataType ImageBase::datatypeTIFF(TIFFDirHead dHead) -{ - DataType datatype; - - switch (dHead.bitsPerSample) - { - case 8: - if (dHead.imageSampleFormat == SAMPLEFORMAT_INT) - datatype = DT_SChar; - else - datatype = DT_UChar; - break; - case 16: - if (dHead.imageSampleFormat == SAMPLEFORMAT_INT) - datatype = DT_Short; - else - datatype = DT_UShort; - - // else if (dHead.imageSampleFormat == SAMPLEFORMAT_UINT || - // dHead.imageSampleFormat == SAMPLEFORMAT_IEEEFP ) //Don't know why - // datatype = DT_UShort; - // // else if (dHead.imageSampleFormat == 0 || - // // dHead.imageSampleFormat == 32767 ) // Format 0 and 32767 are not declared in TIFF 6.0 specifications - // else - // datatype = DT_UShort; - break; - case 32: - if (dHead.imageSampleFormat == SAMPLEFORMAT_INT) - datatype = DT_Int; - else if (dHead.imageSampleFormat == SAMPLEFORMAT_UINT ) - datatype = DT_UInt; - else if (dHead.imageSampleFormat == SAMPLEFORMAT_IEEEFP ) - datatype = DT_Float; - else - //datatype = DT_Unknown; - datatype = DT_Float; // Eman2 does not write the datatype - break; - default: - datatype = DT_Unknown; - (void)datatype; // to suppress dead assignment warning - // REPORT_ERROR(ERR_TYPE_INCORRECT,"rwTIFF: Unsupported TIFF sample format."); - break; - } - return datatype; -} - -/** - * Read TIFF format files. -*/ -int ImageBase::readTIFF(size_t select_img, bool isStack) -{ -#undef DEBUG - //#define DEBUG -#ifdef DEBUG - printf("DEBUG readTIFF: Reading TIFF file\n"); -#endif - - // TIFFSetWarningHandler(NULL); // Switch off warning messages - - char* tif_buf = NULL; - std::vector dirHead; - TIFFDirHead dhRef; - - /* Get TIFF image properties */ - do - { - dhRef.imageSampleFormat = SAMPLEFORMAT_VOID; - if (TIFFGetField(tif, TIFFTAG_BITSPERSAMPLE, &dhRef.bitsPerSample) == 0) - REPORT_ERROR(ERR_IO_NOREAD,"rwTIFF: Error reading TIFFTAG_BITSPERSAMPLE"); - if (TIFFGetField(tif, TIFFTAG_SAMPLESPERPIXEL,&dhRef.samplesPerPixel) == 0) - dhRef.samplesPerPixel = 1; - - if (TIFFGetField(tif, TIFFTAG_IMAGEWIDTH, &dhRef.imageWidth) == 0) - REPORT_ERROR(ERR_IO_NOREAD,"rwTIFF: Error reading TIFFTAG_IMAGEWIDTH"); - if (TIFFGetField(tif, TIFFTAG_IMAGELENGTH, &dhRef.imageLength) == 0) - REPORT_ERROR(ERR_IO_NOREAD,"rwTIFF: Error reading TIFFTAG_IMAGELENGTH"); - if (TIFFGetField(tif, TIFFTAG_SUBFILETYPE, &dhRef.subFileType) == 0) - dhRef.subFileType = 0; // Some scanners does not provide this label. So, we set this to zero - // REPORT_ERROR(ERR_IO_NOREAD,"rwTIFF: Error reading TIFFTAG_SUBFILETYPE"); - TIFFGetField(tif, TIFFTAG_SAMPLEFORMAT, &dhRef.imageSampleFormat); - TIFFGetField(tif, TIFFTAG_RESOLUTIONUNIT, &dhRef.resUnit); - TIFFGetField(tif, TIFFTAG_XRESOLUTION, &dhRef.xTiffRes); - TIFFGetField(tif, TIFFTAG_YRESOLUTION, &dhRef.yTiffRes); - TIFFGetField(tif, TIFFTAG_PAGENUMBER, &dhRef.pNumber, &dhRef.pTotal); - - if ((dhRef.subFileType & 0x00000001) != 0x00000001) //add image if not a thumbnail - dirHead.push_back(dhRef); - } - while(TIFFReadDirectory(tif)); - - swap = TIFFIsByteSwapped(tif); - - //Check select_img is lower than stack size - if (select_img > dirHead.size()) - REPORT_ERROR(ERR_INDEX_OUTOFBOUNDS, formatString("readTIFF (%s): Image number %lu exceeds stack size %lu", filename.c_str(), select_img, dirHead.size())); - else if (select_img == ALL_IMAGES)// Check images dimensions. Need to be the same - { - for (size_t i = 1; i < dirHead.size(); i++) - { - if (dirHead[0].imageLength != dirHead[i].imageLength || \ - dirHead[0].imageWidth != dirHead[i].imageWidth) - dirHead.resize(i); - /*REPORT_ERROR(ERR_IMG_NOREAD, formatString("readTIFF: %s file contains %lu images with, at least,"\ - " two of them with different dimensions. Try to read them individually.",filename.c_str(), dirHead.size()));*/ - } - } - - // Calculate x,y space dimension resolution - double xRes=1.0, yRes=1.0; - - if (dirHead[0].xTiffRes>0 && dirHead[0].yTiffRes>0) - { - switch (dirHead[0].resUnit) - { - case RESUNIT_NONE: - { - xRes = yRes = -1; - break; - } - case RESUNIT_INCH: - { - xRes = 2.54e8/dirHead[0].xTiffRes; - yRes = 2.54e8/dirHead[0].yTiffRes; - break; - } - case RESUNIT_CENTIMETER: - { - xRes = 1e8/dirHead[0].xTiffRes; - yRes = 1e8/dirHead[0].yTiffRes; - break; - } - } - } - - // cast image data to image class datatypes - ArrayDim aDim; - - size_t imgStart = IMG_INDEX(select_img); - - aDim.xdim = (int) dirHead[imgStart].imageWidth; - aDim.ydim = (int) dirHead[imgStart].imageLength; - aDim.zdim = 1; - aDim.ndim = replaceNsize = (select_img == ALL_IMAGES)? dirHead.size() : 1; - setDimensions(aDim); - - size_t imgEnd = (select_img != ALL_IMAGES) ? imgStart + 1 : aDim.ndim; - - DataType datatype = datatypeTIFF(dirHead[0]); - - //Set main header - MDMainHeader.clear(); - MDMainHeader.setValue(MDL_SAMPLINGRATE_X, xRes); - MDMainHeader.setValue(MDL_SAMPLINGRATE_Y, yRes); - MDMainHeader.setValue(MDL_DATATYPE,(int) datatype); - - //Read header only - if( dataMode < DATA ||( dataMode == _HEADER_ALL && aDim.ndim > 1) ) - return 0; - - /* As we cannot mmap a TIFF File, when this option is passed we are going to mmap - * the multidimarray of Image - */ - if (mmapOnRead) - { - mmapOnRead = false; - if (aDim.nzyxdim*gettypesize(datatype) > tiff_map_min_size) - mdaBase->setMmap(true); - } - - // Allocate memory for image data (Assume xdim, ydim, zdim and ndim are already set - //if memory already allocated use it (no resize allowed) - mdaBase->coreAllocateReuse(); - - size_t pad = aDim.yxdim; - int imReaded = 0; - - MD.clear(); - for (size_t i = 0; i < aDim.ndim; i++) - MD.push_back(std::unique_ptr(new MDRowVec(MDL::emptyHeaderVec()))); - - uint32_t rowsperstrip; - tsize_t scanline; - - unsigned int x, y; - // Dimensions of tiles - unsigned int tileWidth, tileLength; - tileWidth = tileLength = 0; - - for (size_t i = imgStart; i < imgEnd; ++i) - { - TIFFSetDirectory(tif,(tdir_t) i); - - // If samplesPerPixel is higher than 3 it means there are extra samples, as associated alpha data - // Greyscale images are usually samplesPerPixel=1 - // RGB images are usually samplesPerPixel=3 (this is only implemented for untiled 8-bit tiffs) - if (dirHead[i].samplesPerPixel > 3) - dirHead[i].samplesPerPixel = 1; - - if (TIFFIsTiled(tif)) - { - TIFFGetField(tif, TIFFTAG_TILEWIDTH, &tileWidth); - TIFFGetField(tif, TIFFTAG_TILELENGTH,&tileLength); - tif_buf = (char*)_TIFFmalloc(TIFFTileSize(tif)); - } - else - { - TIFFGetFieldDefaulted(tif, TIFFTAG_ROWSPERSTRIP, &rowsperstrip); - scanline = TIFFScanlineSize(tif); - tif_buf = (char*)_TIFFmalloc(scanline); - } - if (tif_buf == 0) - { - TIFFError(TIFFFileName(tif), "No space for strip buffer"); - exit(-1); - } - - /* Start to convert the TIFF image to type T */ - - datatype = datatypeTIFF(dirHead[i]); - - if (TIFFIsTiled(tif)) - { - for (y = 0; y < dirHead[0].imageLength; y += tileLength) - for (x = 0; x < dirHead[0].imageWidth; x += tileWidth) - { - TIFFReadTile(tif, tif_buf, x, y, 0, 0); - if (swap) - swapPage((char*)tif_buf, TIFFTileSize(tif)*sizeof(unsigned char), datatype); - - castTiffTile2T((pad*imReaded), tif_buf, x, y, - dirHead[i].imageWidth, dirHead[i].imageLength, - tileWidth, tileLength, - dirHead[i].samplesPerPixel, - datatype); - } - } - else - { - for (y = 0; y < dirHead[i].imageLength; y++) - { - TIFFReadScanline(tif, tif_buf, y); - castTiffLine2T((pad*imReaded), tif_buf, y, - dirHead[i].imageWidth, dirHead[i].imageLength, - dirHead[i].samplesPerPixel, - datatype); - } - } - - ++imReaded; - _TIFFfree(tif_buf); - } - return 0; -} - -/** - * Write TIFF format files. -*/ -int ImageBase::writeTIFF(size_t select_img, bool isStack, int mode, String bitDepth, CastWriteMode castMode) -{ -#undef DEBUG - - if (isComplexT()) - { - REPORT_ERROR(ERR_TYPE_INCORRECT,"rwTIFF: Complex images are not supported by TIFF format."); - return 0; - } - - ArrayDim aDim; - mdaBase->getDimensions(aDim); - - // Volumes are not supported - if (aDim.zdim > 1) - REPORT_ERROR(ERR_MULTIDIM_DIM, "writeTIFF does not support volumes."); - // TIFF cannot open a file to read/write at the same time, so the file must be overwritten - // if (mode != WRITE_OVERWRITE) - // REPORT_ERROR(ERR_VALUE_INCORRECT, "writeTIFF: LIBTIFF cannot modify an existing file, only overwrite it."); - - TIFFDirHead dhMain; // Main header - - //Selection of output datatype - - DataType wDType,myTypeID = myT(); - - if (bitDepth == "") - { - castMode = CW_CAST; - switch(myTypeID) - { - case DT_Double: - case DT_Float: - wDType = DT_Float; - dhMain.imageSampleFormat = SAMPLEFORMAT_IEEEFP; - break; - case DT_Int: - castMode = CW_CONVERT; - case DT_UInt: - wDType = DT_UInt; - dhMain.imageSampleFormat = SAMPLEFORMAT_UINT; - break; - case DT_Short: - castMode = CW_CONVERT; - case DT_UShort: - wDType = DT_UShort; - dhMain.imageSampleFormat = SAMPLEFORMAT_UINT; - break; - case DT_SChar: - castMode = CW_CONVERT; - case DT_UChar: - wDType = DT_UChar; - dhMain.imageSampleFormat = SAMPLEFORMAT_UINT; - break; - default: - wDType = DT_Unknown; - (void)wDType; // to suppress dead assignment warning - REPORT_ERROR(ERR_TYPE_INCORRECT,formatString("rwTIFF: cannot write TIFF format from %s\ - datatype.",datatype2Str(myTypeID).c_str())); - } - } - else - { - // Default Value - wDType = (bitDepth == "default") ? DT_UChar : datatypeRAW(bitDepth); - - switch(wDType) - { - case DT_Float: - dhMain.imageSampleFormat = SAMPLEFORMAT_IEEEFP; - break; - case DT_UInt: - case DT_UShort: - case DT_UChar: - dhMain.imageSampleFormat = SAMPLEFORMAT_UINT; - break; - default: - wDType = DT_Unknown; - (void)wDType; // to suppress dead assignment warning - REPORT_ERROR(ERR_TYPE_INCORRECT,formatString("rwTIFF: TIFF format does not support %s " \ - "datatype.",datatype2Str(myTypeID).c_str())); - } - } - - if (mmapOnWrite) - { - /* As we cannot mmap a TIFF File, when this option is passed we are going to mmap - * the multidimarray of Image - */ - mmapOnWrite = false; - dataMode = DATA; - MDMainHeader.setValue(MDL_DATATYPE,(int) myTypeID); - - if (mdaBase->nzyxdim*gettypesize(myTypeID) > tiff_map_min_size) - mdaBase->setMmap(true); - - // Allocate memory for image data (Assume xdim, ydim, zdim and ndim are already set - //if memory already allocated use it (no resize allowed) - - mdaBase->coreAllocateReuse(); - - return 0; - } - - int nBytes = gettypesize(wDType); - - /* Set TIFF image properties */ - dhMain.bitsPerSample = (unsigned short int) nBytes*8; - dhMain.samplesPerPixel = 1; - dhMain.imageWidth = aDim.xdim; - dhMain.imageLength = aDim.ydim; - dhMain.resUnit = RESUNIT_CENTIMETER; - - double aux=1.0; - - if (!MDMainHeader.empty()) - { - dhMain.xTiffRes = (MDMainHeader.getValue(MDL_SAMPLINGRATE_X, aux)) ? (float) 1e8/aux : 0. ; - dhMain.yTiffRes = (MDMainHeader.getValue(MDL_SAMPLINGRATE_X, aux)) ? (float) 1e8/aux : 0. ; - } - else - { - dhMain.xTiffRes = 1.0; - dhMain.yTiffRes = 1.0; - } - - size_t imgStart = (mode == WRITE_APPEND)? replaceNsize : IMG_INDEX(select_img); - - size_t bufferSize, datasize_n; - bufferSize = aDim.xdim*nBytes; - datasize_n = aDim.zyxdim; - - char* tif_buf; - - if ((tif_buf = (char*)_TIFFmalloc(bufferSize)) == 0) - { - TIFFError(TIFFFileName(tif), "No space for strip buffer"); - exit(-1); - } - - //Write each image in a directory - for (size_t i = 0; i < aDim.ndim; i++ ) - { - TIFFSetDirectory(tif,(tdir_t) i + imgStart); - - // Image header - TIFFSetField(tif, TIFFTAG_BITSPERSAMPLE, dhMain.bitsPerSample); - TIFFSetField(tif, TIFFTAG_SAMPLESPERPIXEL,dhMain.samplesPerPixel); - TIFFSetField(tif, TIFFTAG_SAMPLEFORMAT, dhMain.imageSampleFormat); - TIFFSetField(tif, TIFFTAG_IMAGEWIDTH, dhMain.imageWidth); - TIFFSetField(tif, TIFFTAG_IMAGELENGTH, dhMain.imageLength); - TIFFSetField(tif, TIFFTAG_RESOLUTIONUNIT, dhMain.resUnit); - TIFFSetField(tif, TIFFTAG_XRESOLUTION, dhMain.xTiffRes); - TIFFSetField(tif, TIFFTAG_YRESOLUTION, dhMain.yTiffRes); - TIFFSetField(tif, TIFFTAG_PHOTOMETRIC, PHOTOMETRIC_MINISBLACK); - TIFFSetField(tif, TIFFTAG_COMPRESSION, COMPRESSION_NONE); - TIFFSetField(tif, TIFFTAG_ROWSPERSTRIP, dhMain.imageLength); - TIFFSetField(tif, TIFFTAG_PLANARCONFIG, PLANARCONFIG_CONTIG); - TIFFSetField(tif, TIFFTAG_SOFTWARE, "Xmipp 3.0"); - - if (aDim.ndim == 1 && isStack == false) - { - TIFFSetField(tif, TIFFTAG_SUBFILETYPE, (unsigned int) 0x0); - TIFFSetField(tif, TIFFTAG_PAGENUMBER, (uint16_t) 0, (uint16_t) 0); - } - else - { - TIFFSetField(tif, TIFFTAG_SUBFILETYPE, (unsigned int) 0x2); - TIFFSetField(tif, TIFFTAG_PAGENUMBER, (uint16_t) i, (uint16_t) aDim.ndim); - } - - // Only write images when needed - if (dataMode >= DATA) - { - double min0, max0; - - if (castMode != CW_CAST) - mdaBase->computeDoubleMinMaxRange(min0, max0, i*datasize_n, datasize_n); - - for (uint32_t y = 0; y < aDim.ydim; y++) - { - if (castMode == CW_CAST) - getPageFromT(i*datasize_n + y*aDim.xdim, (char *)tif_buf, wDType, (size_t) aDim.xdim); - else - getCastConvertPageFromT(i*datasize_n + y*aDim.xdim, - (char *)tif_buf, wDType, (size_t) aDim.xdim, min0, max0, castMode); - - TIFFWriteScanline(tif, tif_buf,y,0); - } - } - - TIFFWriteDirectory(tif); - } - - _TIFFfree(tif_buf); - return(0); -} -//@} diff --git a/src/core/rwTIFF.h b/src/core/rwTIFF.h deleted file mode 100644 index 65afc0c..0000000 --- a/src/core/rwTIFF.h +++ /dev/null @@ -1,91 +0,0 @@ -/*************************************************************************** - * Authors: Joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_RWTIFF_H_ -#define CORE_RWTIFF_H_ - -///@defgroup TIFF TIFF File format -///@ingroup ImageFormats -//@{ - -/** TIFF Data Header -*/ -struct TIFFDirHead -{ // Header for each Directory in TIFF - unsigned short bitsPerSample; - unsigned short samplesPerPixel; - unsigned int imageWidth; - unsigned int imageLength; - uint16_t imageSampleFormat; - unsigned short resUnit; - float xTiffRes,yTiffRes; - unsigned int subFileType; - uint16_t pNumber, pTotal; // pagenumber and total number of pages of current directory - TIFFDirHead() - { - bitsPerSample=samplesPerPixel=0; - imageWidth=imageLength=subFileType=0; - imageSampleFormat=0; - xTiffRes=yTiffRes=0; - } -}; - -/** castTiffTile2T - * write the content of a tile from a TIFF file to an image array - */ -void castTiffTile2T( - size_t offset , - char* tif_buf, - unsigned int x, unsigned int y, - unsigned int imageWidth, unsigned int imageLength, - unsigned int tileWidth, unsigned int tileLength, - unsigned short samplesPerPixel, - DataType datatype); - -/** castTiffLine2T - * write the content of a line from a TIFF file to an image array - */ -void castTiffLine2T( - size_t offset, - char* tif_buf, - unsigned int y, - unsigned int imageWidth, unsigned int imageLength, - unsigned short samplesPerPixel, - DataType datatype); - -/** Determine datatype of the TIFF format file. - * @ingroup TIFF - */ -DataType datatypeTIFF(TIFFDirHead dHead); - -/** Read TIFF format files. - */ -int readTIFF(size_t select_img, bool isStack=false); - -/** Write TIFF format files. - */ -int writeTIFF(size_t select_img, bool isStack=false, int mode=WRITE_OVERWRITE, String bitDepth="", CastWriteMode castMode = CW_CAST); -//@} -#endif /* RWTIFF_H_ */ diff --git a/src/core/sqlite3-extension-functions.c b/src/core/sqlite3-extension-functions.c deleted file mode 100644 index d7c1d32..0000000 --- a/src/core/sqlite3-extension-functions.c +++ /dev/null @@ -1,1945 +0,0 @@ -/* -This library will provide common mathematical and string functions in -SQL queries using the operating system libraries or provided -definitions. It includes the following functions: - -Math: acos, asin, atan, atn2, atan2, acosh, asinh, atanh, difference, -degrees, radians, cos, sin, tan, cot, cosh, sinh, tanh, coth, exp, -log, log10, power, sign, sqrt, square, ceil, floor, pi. - -String: replicate, charindex, leftstr, rightstr, ltrim, rtrim, trim, -replace, reverse, proper, padl, padr, padc, strfilter. - -Aggregate: stdev, variance, mode, median, lower_quartile, -upper_quartile. - -The string functions ltrim, rtrim, trim, replace are included in -recent versions of SQLite and so by default do not build. - -Compilation instructions: - Compile this C source file into a dynamic library as follows: - * Linux: - gcc -fPIC -lm -shared extension-functions.c -o libsqlitefunctions.so - * Mac OS X: - gcc -fno-common -dynamiclib extension-functions.c -o libsqlitefunctions.dylib - (You may need to add flags - -I /opt/local/include/ -L/opt/local/lib -lsqlite3 - if your sqlite3 is installed from Mac ports, or - -I /sw/include/ -L/sw/lib -lsqlite3 - if installed with Fink.) - * Windows: - 1. Install MinGW (http://www.mingw.org/) and you will get the gcc - (gnu compiler collection) - 2. add the path to your path variable (isn't done during the - installation!) - 3. compile: - gcc -shared -I "path" -o libsqlitefunctions.so extension-functions.c - (path = path of sqlite3ext.h; i.e. C:\programs\sqlite) - -Usage instructions for applications calling the sqlite3 API functions: - In your application, call sqlite3_enable_load_extension(db,1) to - allow loading external libraries. Then load the library libsqlitefunctions - using sqlite3_load_extension; the third argument should be 0. - See http://www.sqlite.org/cvstrac/wiki?p=LoadableExtensions. - Select statements may now use these functions, as in - SELECT cos(radians(inclination)) FROM satsum WHERE satnum = 25544; - -Usage instructions for the sqlite3 program: - If the program is built so that loading extensions is permitted, - the following will work: - sqlite> SELECT load_extension('./libsqlitefunctions.so'); - sqlite> select cos(radians(45)); - 0.707106781186548 - Note: Loading extensions is by default prohibited as a - security measure; see "Security Considerations" in - http://www.sqlite.org/cvstrac/wiki?p=LoadableExtensions. - If the sqlite3 program and library are built this - way, you cannot use these functions from the program, you - must write your own program using the sqlite3 API, and call - sqlite3_enable_load_extension as described above, or else - rebuilt the sqlite3 program to allow loadable extensions. - -Alterations: -The instructions are for Linux, Mac OS X, and Windows; users of other -OSes may need to modify this procedure. In particular, if your math -library lacks one or more of the needed trig or log functions, comment -out the appropriate HAVE_ #define at the top of file. If you do not -wish to make a loadable module, comment out the define for -COMPILE_SQLITE_EXTENSIONS_AS_LOADABLE_MODULE. If you are using a -version of SQLite without the trim functions and replace, comment out -the HAVE_TRIM #define. - -Liam Healy - -History: -2010-01-06 Correct check for argc in squareFunc, and add Windows -compilation instructions. -2009-06-24 Correct check for argc in properFunc. -2008-09-14 Add check that memory was actually allocated after -sqlite3_malloc or sqlite3StrDup, call sqlite3_result_error_nomem if -not. Thanks to Robert Simpson. -2008-06-13 Change to instructions to indicate use of the math library -and that program might work. -2007-10-01 Minor clarification to instructions. -2007-09-29 Compilation as loadable module is optional with -COMPILE_SQLITE_EXTENSIONS_AS_LOADABLE_MODULE. -2007-09-28 Use sqlite3_extension_init and macros -SQLITE_EXTENSION_INIT1, SQLITE_EXTENSION_INIT2, so that it works with -sqlite3_load_extension. Thanks to Eric Higashino and Joe Wilson. -New instructions for Mac compilation. -2007-09-17 With help from Joe Wilson and Nuno Luca, made use of -external interfaces so that compilation is no longer dependent on -SQLite source code. Merged source, header, and README into a single -file. Added casts so that Mac will compile without warnings (unsigned -and signed char). -2007-09-05 Included some definitions from sqlite 3.3.13 so that this -will continue to work in newer versions of sqlite. Completed -description of functions available. -2007-03-27 Revised description. -2007-03-23 Small cleanup and a bug fix on the code. This was mainly -letting errno flag errors encountered in the math library and checking -the result, rather than pre-checking. This fixes a bug in power that -would cause an error if any non-positive number was raised to any -power. -2007-02-07 posted by Mikey C to sqlite mailing list. -Original code 2006 June 05 by relicoder. - -*/ - -/* #include "config.h" */ - -#define COMPILE_SQLITE_EXTENSIONS_AS_LOADABLE_MODULE 1 -#define HAVE_ACOSH 1 -#define HAVE_ASINH 1 -#define HAVE_ATANH 1 -#define HAVE_SINH 1 -#define HAVE_COSH 1 -#define HAVE_TANH 1 -#define HAVE_LOG10 1 -#define HAVE_ISBLANK 1 -#define SQLITE_SOUNDEX 1 -#define HAVE_TRIM 1 /* LMH 2007-03-25 if sqlite has trim functions */ - -#ifdef COMPILE_SQLITE_EXTENSIONS_AS_LOADABLE_MODULE -#include "sqlite3ext.h" -SQLITE_EXTENSION_INIT1 -#else -#include "sqlite3.h" -#endif - -#include -/* relicoder */ -#include -#include -#include -#include /* LMH 2007-03-25 */ - -#include -#include - -#ifndef _MAP_H_ -#define _MAP_H_ - -#include - -/* -** Simple binary tree implementation to use in median, mode and quartile calculations -** Tree is not necessarily balanced. That would require something like red&black trees of AVL -*/ - -typedef int(*cmp_func)(const void *, const void *); -typedef void(*map_iterator)(void*, int64_t, void*); - -typedef struct node{ - struct node *l; - struct node *r; - void* data; - int64_t count; -} node; - -typedef struct map{ - node *base; - cmp_func cmp; - short free; -} map; - -/* -** creates a map given a comparison function -*/ -map map_make(cmp_func cmp); - -/* -** inserts the element e into map m -*/ -void map_insert(map *m, void *e); - -/* -** executes function iter over all elements in the map, in key increasing order -*/ -void map_iterate(map *m, map_iterator iter, void* p); - -/* -** frees all memory used by a map -*/ -void map_destroy(map *m); - -/* -** compares 2 integers -** to use with map_make -*/ -int int_cmp(const void *a, const void *b); - -/* -** compares 2 doubles -** to use with map_make -*/ -int double_cmp(const void *a, const void *b); - -#endif /* _MAP_H_ */ - -typedef uint8_t u8; -typedef uint16_t u16; -typedef int64_t i64; - -static char *sqlite3StrDup( const char *z ) { - char *res = sqlite3_malloc( strlen(z)+1 ); - return strcpy( res, z ); -} - -/* -** These are copied verbatim from fun.c so as to not have the names exported -*/ - -/* LMH from sqlite3 3.3.13 */ -/* -** This table maps from the first byte of a UTF-8 character to the number -** of trailing bytes expected. A value '4' indicates that the table key -** is not a legal first byte for a UTF-8 character. -*/ -static const u8 xtra_utf8_bytes[256] = { -/* 0xxxxxxx */ -0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - -/* 10wwwwww */ -4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, -4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, -4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, -4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, - -/* 110yyyyy */ -1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, -1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - -/* 1110zzzz */ -2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - -/* 11110yyy */ -3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, -}; - - -/* -** This table maps from the number of trailing bytes in a UTF-8 character -** to an integer constant that is effectively calculated for each character -** read by a naive implementation of a UTF-8 character reader. The code -** in the READ_UTF8 macro explains things best. -*/ -static const int xtra_utf8_bits[] = { - 0, - 12416, /* (0xC0 << 6) + (0x80) */ - 925824, /* (0xE0 << 12) + (0x80 << 6) + (0x80) */ - 63447168 /* (0xF0 << 18) + (0x80 << 12) + (0x80 << 6) + 0x80 */ -}; - -/* -** If a UTF-8 character contains N bytes extra bytes (N bytes follow -** the initial byte so that the total character length is N+1) then -** masking the character with utf8_mask[N] must produce a non-zero -** result. Otherwise, we have an (illegal) overlong encoding. -*/ -static const int utf_mask[] = { - 0x00000000, - 0xffffff80, - 0xfffff800, - 0xffff0000, -}; - -/* LMH salvaged from sqlite3 3.3.13 source code src/utf.c */ -#define READ_UTF8(zIn, c) { \ - int xtra; \ - c = *(zIn)++; \ - xtra = xtra_utf8_bytes[c]; \ - switch( xtra ){ \ - case 4: c = (int)0xFFFD; break; \ - case 3: c = (c<<6) + *(zIn)++; \ - case 2: c = (c<<6) + *(zIn)++; \ - case 1: c = (c<<6) + *(zIn)++; \ - c -= xtra_utf8_bits[xtra]; \ - if( (utf_mask[xtra]&c)==0 \ - || (c&0xFFFFF800)==0xD800 \ - || (c&0xFFFFFFFE)==0xFFFE ){ c = 0xFFFD; } \ - } \ -} - -static int sqlite3ReadUtf8(const unsigned char *z){ - int c; - READ_UTF8(z, c); - return c; -} - -#define SKIP_UTF8(zIn) { \ - zIn += (xtra_utf8_bytes[*(u8 *)zIn] + 1); \ -} - -/* -** pZ is a UTF-8 encoded unicode string. If nByte is less than zero, -** return the number of unicode characters in pZ up to (but not including) -** the first 0x00 byte. If nByte is not less than zero, return the -** number of unicode characters in the first nByte of pZ (or up to -** the first 0x00, whichever comes first). -*/ -static int sqlite3Utf8CharLen(const char *z, int nByte){ - int r = 0; - const char *zTerm; - if( nByte>=0 ){ - zTerm = &z[nByte]; - }else{ - zTerm = (const char *)(-1); - } - assert( z<=zTerm ); - while( *z!=0 && z 0) ? 1: ( iVal < 0 ) ? -1: 0; - sqlite3_result_int64(context, iVal); - break; - } - case SQLITE_NULL: { - sqlite3_result_null(context); - break; - } - default: { - /* 2nd change below. Line for abs was: if( rVal<0 ) rVal = rVal * -1.0; */ - - rVal = sqlite3_value_double(argv[0]); - rVal = ( rVal > 0) ? 1: ( rVal < 0 ) ? -1: 0; - sqlite3_result_double(context, rVal); - break; - } - } -} - - -/* -** smallest integer value not less than argument -*/ -static void ceilFunc(sqlite3_context *context, int argc, sqlite3_value **argv){ - double rVal=0.0; - assert( argc==1 ); - switch( sqlite3_value_type(argv[0]) ){ - case SQLITE_INTEGER: { - i64 iVal = sqlite3_value_int64(argv[0]); - sqlite3_result_int64(context, iVal); - break; - } - case SQLITE_NULL: { - sqlite3_result_null(context); - break; - } - default: { - rVal = sqlite3_value_double(argv[0]); - sqlite3_result_int64(context, (i64) ceil(rVal)); - break; - } - } -} - -/* -** largest integer value not greater than argument -*/ -static void floorFunc(sqlite3_context *context, int argc, sqlite3_value **argv){ - double rVal=0.0; - assert( argc==1 ); - switch( sqlite3_value_type(argv[0]) ){ - case SQLITE_INTEGER: { - i64 iVal = sqlite3_value_int64(argv[0]); - sqlite3_result_int64(context, iVal); - break; - } - case SQLITE_NULL: { - sqlite3_result_null(context); - break; - } - default: { - rVal = sqlite3_value_double(argv[0]); - sqlite3_result_int64(context, (i64) floor(rVal)); - break; - } - } -} - -/* -** Given a string (s) in the first argument and an integer (n) in the second returns the -** string that constains s contatenated n times -*/ -static void replicateFunc(sqlite3_context *context, int argc, sqlite3_value **argv){ - unsigned char *z; /* input string */ - unsigned char *zo; /* result string */ - i64 iCount; /* times to repeat */ - i64 nLen; /* length of the input string (no multibyte considerations) */ - i64 nTLen; /* length of the result string (no multibyte considerations) */ - i64 i=0; - - if( argc!=2 || SQLITE_NULL==sqlite3_value_type(argv[0]) ) - return; - - iCount = sqlite3_value_int64(argv[1]); - - if( iCount<0 ){ - sqlite3_result_error(context, "domain error", -1); - }else{ - - nLen = sqlite3_value_bytes(argv[0]); - nTLen = nLen*iCount; - z=sqlite3_malloc(nTLen+1); - zo=sqlite3_malloc(nLen+1); - if (!z || !zo){ - sqlite3_result_error_nomem(context); - if (z) sqlite3_free(z); - if (zo) sqlite3_free(zo); - return; - } - strcpy((char*)zo, (char*)sqlite3_value_text(argv[0])); - - for(i=0; i=n it's a NOP -** padl(NULL) = NULL -*/ -static void padlFunc(sqlite3_context *context, int argc, sqlite3_value **argv){ - i64 ilen; /* length to pad to */ - i64 zl; /* length of the input string (UTF-8 chars) */ - int i = 0; - const char *zi; /* input string */ - char *zo; /* output string */ - char *zt; - - assert( argc==2 ); - - if( sqlite3_value_type(argv[0]) == SQLITE_NULL ){ - sqlite3_result_null(context); - }else{ - zi = (char *)sqlite3_value_text(argv[0]); - ilen = sqlite3_value_int64(argv[1]); - /* check domain */ - if(ilen<0){ - sqlite3_result_error(context, "domain error", -1); - return; - } - zl = sqlite3Utf8CharLen(zi, -1); - if( zl>=ilen ){ - /* string is longer than the requested pad length, return the same string (dup it) */ - zo = sqlite3StrDup(zi); - if (!zo){ - sqlite3_result_error_nomem(context); - return; - } - sqlite3_result_text(context, zo, -1, SQLITE_TRANSIENT); - }else{ - zo = sqlite3_malloc(strlen(zi)+ilen-zl+1); - if (!zo){ - sqlite3_result_error_nomem(context); - return; - } - zt = zo; - for(i=1; i+zl<=ilen; ++i){ - *(zt++)=' '; - } - /* no need to take UTF-8 into consideration here */ - strcpy(zt,zi); - } - sqlite3_result_text(context, zo, -1, SQLITE_TRANSIENT); - sqlite3_free(zo); - } -} - -/* -** given an input string (s) and an integer (n) appends spaces at the end of s -** until it has a length of n characters. -** When s has a length >=n it's a NOP -** padl(NULL) = NULL -*/ -static void padrFunc(sqlite3_context *context, int argc, sqlite3_value **argv){ - i64 ilen; /* length to pad to */ - i64 zl; /* length of the input string (UTF-8 chars) */ - i64 zll; /* length of the input string (bytes) */ - int i = 0; - const char *zi; /* input string */ - char *zo; /* output string */ - char *zt; - - assert( argc==2 ); - - if( sqlite3_value_type(argv[0]) == SQLITE_NULL ){ - sqlite3_result_null(context); - }else{ - zi = (char *)sqlite3_value_text(argv[0]); - ilen = sqlite3_value_int64(argv[1]); - /* check domain */ - if(ilen<0){ - sqlite3_result_error(context, "domain error", -1); - return; - } - zl = sqlite3Utf8CharLen(zi, -1); - if( zl>=ilen ){ - /* string is longer than the requested pad length, return the same string (dup it) */ - zo = sqlite3StrDup(zi); - if (!zo){ - sqlite3_result_error_nomem(context); - return; - } - sqlite3_result_text(context, zo, -1, SQLITE_TRANSIENT); - }else{ - zll = strlen(zi); - zo = sqlite3_malloc(zll+ilen-zl+1); - if (!zo){ - sqlite3_result_error_nomem(context); - return; - } - zt = strcpy(zo,zi)+zll; - for(i=1; i+zl<=ilen; ++i){ - *(zt++) = ' '; - } - *zt = '\0'; - } - sqlite3_result_text(context, zo, -1, SQLITE_TRANSIENT); - sqlite3_free(zo); - } -} - -/* -** given an input string (s) and an integer (n) appends spaces at the end of s -** and adds spaces at the beginning of s until it has a length of n characters. -** Tries to add has many characters at the left as at the right. -** When s has a length >=n it's a NOP -** padl(NULL) = NULL -*/ -static void padcFunc(sqlite3_context *context, int argc, sqlite3_value **argv){ - i64 ilen; /* length to pad to */ - i64 zl; /* length of the input string (UTF-8 chars) */ - i64 zll; /* length of the input string (bytes) */ - int i = 0; - const char *zi; /* input string */ - char *zo; /* output string */ - char *zt; - - assert( argc==2 ); - - if( sqlite3_value_type(argv[0]) == SQLITE_NULL ){ - sqlite3_result_null(context); - }else{ - zi = (char *)sqlite3_value_text(argv[0]); - ilen = sqlite3_value_int64(argv[1]); - /* check domain */ - if(ilen<0){ - sqlite3_result_error(context, "domain error", -1); - return; - } - zl = sqlite3Utf8CharLen(zi, -1); - if( zl>=ilen ){ - /* string is longer than the requested pad length, return the same string (dup it) */ - zo = sqlite3StrDup(zi); - if (!zo){ - sqlite3_result_error_nomem(context); - return; - } - sqlite3_result_text(context, zo, -1, SQLITE_TRANSIENT); - }else{ - zll = strlen(zi); - zo = sqlite3_malloc(zll+ilen-zl+1); - if (!zo){ - sqlite3_result_error_nomem(context); - return; - } - zt = zo; - for(i=1; 2*i+zl<=ilen; ++i){ - *(zt++) = ' '; - } - strcpy(zt, zi); - zt+=zll; - for(; i+zl<=ilen; ++i){ - *(zt++) = ' '; - } - *zt = '\0'; - } - sqlite3_result_text(context, zo, -1, SQLITE_TRANSIENT); - sqlite3_free(zo); - } -} - -/* -** given 2 string (s1,s2) returns the string s1 with the characters NOT in s2 removed -** assumes strings are UTF-8 encoded -*/ -static void strfilterFunc(sqlite3_context *context, int argc, sqlite3_value **argv){ - const char *zi1; /* first parameter string (searched string) */ - const char *zi2; /* second parameter string (vcontains valid characters) */ - const char *z1; - const char *z21; - const char *z22; - char *zo; /* output string */ - char *zot; - int c1 = 0; - int c2 = 0; - - assert( argc==2 ); - - if( sqlite3_value_type(argv[0]) == SQLITE_NULL || sqlite3_value_type(argv[1]) == SQLITE_NULL ){ - sqlite3_result_null(context); - }else{ - zi1 = (char *)sqlite3_value_text(argv[0]); - zi2 = (char *)sqlite3_value_text(argv[1]); - /* - ** maybe I could allocate less, but that would imply 2 passes, rather waste - ** (possibly) some memory - */ - zo = sqlite3_malloc(strlen(zi1)+1); - if (!zo){ - sqlite3_result_error_nomem(context); - return; - } - zot = zo; - z1 = zi1; - while( (c1=sqliteCharVal((unsigned char *)z1))!=0 ){ - z21=zi2; - while( (c2=sqliteCharVal((unsigned char *)z21))!=0 && c2!=c1 ){ - sqliteNextChar(z21); - } - if( c2!=0){ - z22=z21; - sqliteNextChar(z22); - strncpy(zot, z21, z22-z21); - zot+=z22-z21; - } - sqliteNextChar(z1); - } - *zot = '\0'; - - sqlite3_result_text(context, zo, -1, SQLITE_TRANSIENT); - sqlite3_free(zo); - } -} - -/* -** Given a string z1, retutns the (0 based) index of it's first occurrence -** in z2 after the first s characters. -** Returns -1 when there isn't a match. -** updates p to point to the character where the match occurred. -** This is an auxiliary function. -*/ -static int _substr(const char* z1, const char* z2, int s, const char** p){ - int c = 0; - int rVal=-1; - const char* zt1; - const char* zt2; - int c1,c2; - - if( '\0'==*z1 ){ - return -1; - } - - while( (sqliteCharVal((unsigned char *)z2) != 0) && (c++)=0 ? rVal+s : rVal; -} - -/* -** given 2 input strings (s1,s2) and an integer (n) searches from the nth character -** for the string s1. Returns the position where the match occurred. -** Characters are counted from 1. -** 0 is returned when no match occurs. -*/ - -static void charindexFunc(sqlite3_context *context, int argc, sqlite3_value **argv){ - const u8 *z1; /* s1 string */ - u8 *z2; /* s2 string */ - int s=0; - int rVal=0; - - assert( argc==3 ||argc==2); - - if( SQLITE_NULL==sqlite3_value_type(argv[0]) || SQLITE_NULL==sqlite3_value_type(argv[1])){ - sqlite3_result_null(context); - return; - } - - z1 = sqlite3_value_text(argv[0]); - if( z1==0 ) return; - z2 = (u8*) sqlite3_value_text(argv[1]); - if(argc==3){ - s = sqlite3_value_int(argv[2])-1; - if(s<0){ - s=0; - } - }else{ - s = 0; - } - - rVal = _substr((char *)z1,(char *)z2,s,NULL); - sqlite3_result_int(context, rVal+1); -} - -/* -** given a string (s) and an integer (n) returns the n leftmost (UTF-8) characters -** if the string has a length<=n or is NULL this function is NOP -*/ -static void leftFunc(sqlite3_context *context, int argc, sqlite3_value **argv){ - int c=0; - int cc=0; - int l=0; - const unsigned char *z; /* input string */ - const unsigned char *zt; - unsigned char *rz; /* output string */ - - assert( argc==2); - - if( SQLITE_NULL==sqlite3_value_type(argv[0]) || SQLITE_NULL==sqlite3_value_type(argv[1])){ - sqlite3_result_null(context); - return; - } - - z = sqlite3_value_text(argv[0]); - l = sqlite3_value_int(argv[1]); - zt = z; - - while( sqliteCharVal(zt) && c++ 0 ){ - sqliteNextChar(zt); - } - - rz = sqlite3_malloc(ze-zt+1); - if (!rz){ - sqlite3_result_error_nomem(context); - return; - } - strcpy((char*) rz, (char*) (zt)); - sqlite3_result_text(context, (char*)rz, -1, SQLITE_TRANSIENT); - sqlite3_free(rz); -} - -#ifndef HAVE_TRIM -/* -** removes the whitespaces at the beginning of a string. -*/ -const char* ltrim(const char* s){ - while( *s==' ' ) - ++s; - return s; -} - -/* -** removes the whitespaces at the end of a string. -** !mutates the input string! -*/ -void rtrim(char* s){ - char* ss = s+strlen(s)-1; - while( ss>=s && *ss==' ' ) - --ss; - *(ss+1)='\0'; -} - -/* -** Removes the whitespace at the beginning of a string -*/ -static void ltrimFunc(sqlite3_context *context, int argc, sqlite3_value **argv){ - const char *z; - - assert( argc==1); - - if( SQLITE_NULL==sqlite3_value_type(argv[0]) ){ - sqlite3_result_null(context); - return; - } - z = sqlite3_value_text(argv[0]); - sqlite3_result_text(context, ltrim(z), -1, SQLITE_TRANSIENT); -} - -/* -** Removes the whitespace at the end of a string -*/ -static void rtrimFunc(sqlite3_context *context, int argc, sqlite3_value **argv){ - const char *z; - char *rz; - /* try not to change data in argv */ - - assert( argc==1); - - if( SQLITE_NULL==sqlite3_value_type(argv[0]) ){ - sqlite3_result_null(context); - return; - } - z = sqlite3_value_text(argv[0]); - rz = sqlite3StrDup(z); - rtrim(rz); - sqlite3_result_text(context, rz, -1, SQLITE_TRANSIENT); - sqlite3_free(rz); -} - -/* -** Removes the whitespace at the beginning and end of a string -*/ -static void trimFunc(sqlite3_context *context, int argc, sqlite3_value **argv){ - const char *z; - char *rz; - /* try not to change data in argv */ - - assert( argc==1); - - if( SQLITE_NULL==sqlite3_value_type(argv[0]) ){ - sqlite3_result_null(context); - return; - } - z = sqlite3_value_text(argv[0]); - rz = sqlite3StrDup(z); - rtrim(rz); - sqlite3_result_text(context, ltrim(rz), -1, SQLITE_TRANSIENT); - sqlite3_free(rz); -} -#endif - -/* -** given a pointer to a string s1, the length of that string (l1), a new string (s2) -** and it's length (l2) appends s2 to s1. -** All lengths in bytes. -** This is just an auxiliary function -*/ -// static void _append(char **s1, int l1, const char *s2, int l2){ -// *s1 = realloc(*s1, (l1+l2+1)*sizeof(char)); -// strncpy((*s1)+l1, s2, l2); -// *(*(s1)+l1+l2) = '\0'; -// } - -#ifndef HAVE_TRIM - -/* -** given strings s, s1 and s2 replaces occurrences of s1 in s by s2 -*/ -static void replaceFunc(sqlite3_context *context, int argc, sqlite3_value **argv){ - const char *z1; /* string s (first parameter) */ - const char *z2; /* string s1 (second parameter) string to look for */ - const char *z3; /* string s2 (third parameter) string to replace occurrences of s1 with */ - int lz1; - int lz2; - int lz3; - int lzo=0; - char *zo=0; - int ret=0; - const char *zt1; - const char *zt2; - - assert( 3==argc ); - - if( SQLITE_NULL==sqlite3_value_type(argv[0]) ){ - sqlite3_result_null(context); - return; - } - - z1 = sqlite3_value_text(argv[0]); - z2 = sqlite3_value_text(argv[1]); - z3 = sqlite3_value_text(argv[2]); - /* handle possible null values */ - if( 0==z2 ){ - z2=""; - } - if( 0==z3 ){ - z3=""; - } - - lz1 = strlen(z1); - lz2 = strlen(z2); - lz3 = strlen(z3); - -#if 0 - /* special case when z2 is empty (or null) nothing will be changed */ - if( 0==lz2 ){ - sqlite3_result_text(context, z1, -1, SQLITE_TRANSIENT); - return; - } -#endif - - zt1=z1; - zt2=z1; - - while(1){ - ret=_substr(z2,zt1 , 0, &zt2); - - if( ret<0 ) - break; - - _append(&zo, lzo, zt1, zt2-zt1); - lzo+=zt2-zt1; - _append(&zo, lzo, z3, lz3); - lzo+=lz3; - - zt1=zt2+lz2; - } - _append(&zo, lzo, zt1, lz1-(zt1-z1)); - sqlite3_result_text(context, zo, -1, SQLITE_TRANSIENT); - sqlite3_free(zo); -} -#endif - -/* -** given a string returns the same string but with the characters in reverse order -*/ -static void reverseFunc(sqlite3_context *context, int argc, sqlite3_value **argv){ - const char *z; - const char *zt; - char *rz; - char *rzt; - int l = 0; - int i = 0; - - assert( 1==argc ); - - if( SQLITE_NULL==sqlite3_value_type(argv[0]) ){ - sqlite3_result_null(context); - return; - } - z = (char *)sqlite3_value_text(argv[0]); - l = strlen(z); - rz = sqlite3_malloc(l+1); - if (!rz){ - sqlite3_result_error_nomem(context); - return; - } - rzt = rz+l; - *(rzt--) = '\0'; - - zt=z; - while( sqliteCharVal((unsigned char *)zt)!=0 ){ - z=zt; - sqliteNextChar(zt); - for(i=1; zt-i>=z; ++i){ - *(rzt--)=*(zt-i); - } - } - - sqlite3_result_text(context, rz, -1, SQLITE_TRANSIENT); - sqlite3_free(rz); -} - -/* -** An instance of the following structure holds the context of a -** stdev() or variance() aggregate computation. -** implementaion of http://en.wikipedia.org/wiki/Algorithms_for_calculating_variance#Algorithm_II -** less prone to rounding errors -*/ -typedef struct StdevCtx StdevCtx; -struct StdevCtx { - double rM; - double rS; - i64 cnt; /* number of elements */ -}; - -/* -** An instance of the following structure holds the context of a -** mode() or median() aggregate computation. -** Depends on structures defined in map.c (see map & map) -** These aggregate functions only work for integers and floats although -** they could be made to work for strings. This is usually considered meaningless. -** Only usuall order (for median), no use of collation functions (would this even make sense?) -*/ -typedef struct ModeCtx ModeCtx; -struct ModeCtx { - i64 riM; /* integer value found so far */ - double rdM; /* double value found so far */ - i64 cnt; /* number of elements so far */ - double pcnt; /* number of elements smaller than a percentile */ - i64 mcnt; /* maximum number of occurrences (for mode) */ - i64 mn; /* number of occurrences (for mode and percentiles) */ - i64 is_double; /* whether the computation is being done for doubles (>0) or integers (=0) */ - map* m; /* map structure used for the computation */ - int done; /* whether the answer has been found */ -}; - -/* -** called for each value received during a calculation of stdev or variance -*/ -static void varianceStep(sqlite3_context *context, int argc, sqlite3_value **argv){ - StdevCtx *p; - - double delta; - double x; - - assert( argc==1 ); - p = sqlite3_aggregate_context(context, sizeof(*p)); - /* only consider non-null values */ - if( SQLITE_NULL != sqlite3_value_numeric_type(argv[0]) ){ - p->cnt++; - x = sqlite3_value_double(argv[0]); - delta = (x-p->rM); - p->rM += delta/p->cnt; - p->rS += delta*(x-p->rM); - } -} - -/* -** called for each value received during a calculation of mode of median -*/ -static void modeStep(sqlite3_context *context, int argc, sqlite3_value **argv){ - ModeCtx *p; - i64 xi=0; - double xd=0.0; - i64 *iptr; - double *dptr; - int type; - - assert( argc==1 ); - type = sqlite3_value_numeric_type(argv[0]); - - if( type == SQLITE_NULL) - return; - - p = sqlite3_aggregate_context(context, sizeof(*p)); - - if( 0==(p->m) ){ - p->m = calloc(1, sizeof(map)); - if( type==SQLITE_INTEGER ){ - /* map will be used for integers */ - *(p->m) = map_make(int_cmp); - p->is_double = 0; - }else{ - p->is_double = 1; - /* map will be used for doubles */ - *(p->m) = map_make(double_cmp); - } - } - - ++(p->cnt); - - if( 0==p->is_double ){ - xi = sqlite3_value_int64(argv[0]); - iptr = (i64*)calloc(1,sizeof(i64)); - *iptr = xi; - map_insert(p->m, iptr); - }else{ - xd = sqlite3_value_double(argv[0]); - dptr = (double*)calloc(1,sizeof(double)); - *dptr = xd; - map_insert(p->m, dptr); - } -} - -/* -** Auxiliary function that iterates all elements in a map and finds the mode -** (most frequent value) -*/ -static void modeIterate(void* e, i64 c, void* pp){ - i64 ei; - double ed; - ModeCtx *p = (ModeCtx*)pp; - - if( 0==p->is_double ){ - ei = *(int*)(e); - - if( p->mcnt==c ){ - ++p->mn; - }else if( p->mcntriM = ei; - p->mcnt = c; - p->mn=1; - } - }else{ - ed = *(double*)(e); - - if( p->mcnt==c ){ - ++p->mn; - }else if(p->mcntrdM = ed; - p->mcnt = c; - p->mn=1; - } - } -} - -/* -** Auxiliary function that iterates all elements in a map and finds the median -** (the value such that the number of elements smaller is equal the the number of -** elements larger) -*/ -static void medianIterate(void* e, i64 c, void* pp){ - i64 ei; - double ed; - double iL; - double iR; - int il; - int ir; - ModeCtx *p = (ModeCtx*)pp; - - if(p->done>0) - return; - - iL = p->pcnt; - iR = p->cnt - p->pcnt; - il = p->mcnt + c; - ir = p->cnt - p->mcnt; - - if( il >= iL ){ - if( ir >= iR ){ - ++p->mn; - if( 0==p->is_double ){ - ei = *(int*)(e); - p->riM += ei; - }else{ - ed = *(double*)(e); - p->rdM += ed; - } - }else{ - p->done=1; - } - } - p->mcnt+=c; -} - -/* -** Returns the mode value -*/ -static void modeFinalize(sqlite3_context *context){ - ModeCtx *p; - p = sqlite3_aggregate_context(context, 0); - if( p && p->m ){ - map_iterate(p->m, modeIterate, p); - map_destroy(p->m); - free(p->m); - - if( 1==p->mn ){ - if( 0==p->is_double ) - sqlite3_result_int64(context, p->riM); - else - sqlite3_result_double(context, p->rdM); - } - } -} - -/* -** auxiliary function for percentiles -*/ -static void _medianFinalize(sqlite3_context *context){ - ModeCtx *p; - p = (ModeCtx*) sqlite3_aggregate_context(context, 0); - if( p && p->m ){ - p->done=0; - map_iterate(p->m, medianIterate, p); - map_destroy(p->m); - free(p->m); - - if( 0==p->is_double ) - if( 1==p->mn ) - sqlite3_result_int64(context, p->riM); - else - sqlite3_result_double(context, p->riM*1.0/p->mn); - else - sqlite3_result_double(context, p->rdM/p->mn); - } -} - -/* -** Returns the median value -*/ -static void medianFinalize(sqlite3_context *context){ - ModeCtx *p; - p = (ModeCtx*) sqlite3_aggregate_context(context, 0); - if( p!=0 ){ - p->pcnt = (p->cnt)/2.0; - _medianFinalize(context); - } -} - -/* -** Returns the lower_quartile value -*/ -static void lower_quartileFinalize(sqlite3_context *context){ - ModeCtx *p; - p = (ModeCtx*) sqlite3_aggregate_context(context, 0); - if( p!=0 ){ - p->pcnt = (p->cnt)/4.0; - _medianFinalize(context); - } -} - -/* -** Returns the upper_quartile value -*/ -static void upper_quartileFinalize(sqlite3_context *context){ - ModeCtx *p; - p = (ModeCtx*) sqlite3_aggregate_context(context, 0); - if( p!=0 ){ - p->pcnt = (p->cnt)*3/4.0; - _medianFinalize(context); - } -} - -/* -** Returns the stdev value -*/ -static void stdevFinalize(sqlite3_context *context){ - StdevCtx *p; - p = sqlite3_aggregate_context(context, 0); - if( p && p->cnt>1 ){ - sqlite3_result_double(context, sqrt(p->rS/(p->cnt-1))); - }else{ - sqlite3_result_double(context, 0.0); - } -} - -/* -** Returns the variance value -*/ -static void varianceFinalize(sqlite3_context *context){ - StdevCtx *p; - p = sqlite3_aggregate_context(context, 0); - if( p && p->cnt>1 ){ - sqlite3_result_double(context, p->rS/(p->cnt-1)); - }else{ - sqlite3_result_double(context, 0.0); - } -} - -#ifdef SQLITE_SOUNDEX - -/* relicoder factored code */ -/* -** Calculates the soundex value of a string -*/ - -static void soundex(const u8 *zIn, char *zResult){ - int i, j; - static const unsigned char iCode[] = { - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 1, 2, 3, 0, 1, 2, 0, 0, 2, 2, 4, 5, 5, 0, - 1, 2, 6, 2, 3, 0, 1, 0, 2, 0, 2, 0, 0, 0, 0, 0, - 0, 0, 1, 2, 3, 0, 1, 2, 0, 0, 2, 2, 4, 5, 5, 0, - 1, 2, 6, 2, 3, 0, 1, 0, 2, 0, 2, 0, 0, 0, 0, 0, - }; - - for(i=0; zIn[i] && !isalpha(zIn[i]); i++){} - if( zIn[i] ){ - zResult[0] = toupper(zIn[i]); - for(j=1; j<4 && zIn[i]; i++){ - int code = iCode[zIn[i]&0x7f]; - if( code>0 ){ - zResult[j++] = code + '0'; - } - } - while( j<4 ){ - zResult[j++] = '0'; - } - zResult[j] = 0; - }else{ - strcpy(zResult, "?000"); - } -} - -/* -** computes the number of different characters between the soundex value fo 2 strings -*/ -static void differenceFunc(sqlite3_context *context, int argc, sqlite3_value **argv){ - char zResult1[8]; - char zResult2[8]; - char *zR1 = zResult1; - char *zR2 = zResult2; - int rVal = 0; - int i = 0; - const u8 *zIn1; - const u8 *zIn2; - - assert( argc==2 ); - - if( sqlite3_value_type(argv[0])==SQLITE_NULL || sqlite3_value_type(argv[1])==SQLITE_NULL ){ - sqlite3_result_null(context); - return; - } - - zIn1 = (u8*)sqlite3_value_text(argv[0]); - zIn2 = (u8*)sqlite3_value_text(argv[1]); - - soundex(zIn1, zR1); - soundex(zIn2, zR2); - - for(i=0; i<4; ++i){ - if( sqliteCharVal((unsigned char *)zR1)==sqliteCharVal((unsigned char *)zR2) ) - ++rVal; - sqliteNextChar(zR1); - sqliteNextChar(zR2); - } - sqlite3_result_int(context, rVal); -} -#endif - -/* -** This function registered all of the above C functions as SQL -** functions. This should be the only routine in this file with -** external linkage. -*/ -int RegisterExtensionFunctions(sqlite3 *db){ - static const struct FuncDef { - char *zName; - signed char nArg; - u8 argType; /* 0: none. 1: db 2: (-1) */ - u8 eTextRep; /* 1: UTF-16. 0: UTF-8 */ - u8 needCollSeq; - void (*xFunc)(sqlite3_context*,int,sqlite3_value **); - } aFuncs[] = { - /* math.h */ - { "acos", 1, 0, SQLITE_UTF8, 0, acosFunc }, - { "asin", 1, 0, SQLITE_UTF8, 0, asinFunc }, - { "atan", 1, 0, SQLITE_UTF8, 0, atanFunc }, - { "atn2", 2, 0, SQLITE_UTF8, 0, atn2Func }, - /* XXX alias */ - { "atan2", 2, 0, SQLITE_UTF8, 0, atn2Func }, - { "acosh", 1, 0, SQLITE_UTF8, 0, acoshFunc }, - { "asinh", 1, 0, SQLITE_UTF8, 0, asinhFunc }, - { "atanh", 1, 0, SQLITE_UTF8, 0, atanhFunc }, - - { "difference", 2, 0, SQLITE_UTF8, 0, differenceFunc}, - { "degrees", 1, 0, SQLITE_UTF8, 0, rad2degFunc }, - { "radians", 1, 0, SQLITE_UTF8, 0, deg2radFunc }, - - { "cos", 1, 0, SQLITE_UTF8, 0, cosFunc }, - { "sin", 1, 0, SQLITE_UTF8, 0, sinFunc }, - { "tan", 1, 0, SQLITE_UTF8, 0, tanFunc }, - { "cot", 1, 0, SQLITE_UTF8, 0, cotFunc }, - { "cosh", 1, 0, SQLITE_UTF8, 0, coshFunc }, - { "sinh", 1, 0, SQLITE_UTF8, 0, sinhFunc }, - { "tanh", 1, 0, SQLITE_UTF8, 0, tanhFunc }, - { "coth", 1, 0, SQLITE_UTF8, 0, cothFunc }, - - { "exp", 1, 0, SQLITE_UTF8, 0, expFunc }, - { "log", 1, 0, SQLITE_UTF8, 0, logFunc }, - { "log10", 1, 0, SQLITE_UTF8, 0, log10Func }, - { "power", 2, 0, SQLITE_UTF8, 0, powerFunc }, - { "sign", 1, 0, SQLITE_UTF8, 0, signFunc }, - { "sqrt", 1, 0, SQLITE_UTF8, 0, sqrtFunc }, - { "square", 1, 0, SQLITE_UTF8, 0, squareFunc }, - - { "ceil", 1, 0, SQLITE_UTF8, 0, ceilFunc }, - { "floor", 1, 0, SQLITE_UTF8, 0, floorFunc }, - - { "pi", 0, 0, SQLITE_UTF8, 1, piFunc }, - - - /* string */ - { "replicate", 2, 0, SQLITE_UTF8, 0, replicateFunc }, - { "charindex", 2, 0, SQLITE_UTF8, 0, charindexFunc }, - { "charindex", 3, 0, SQLITE_UTF8, 0, charindexFunc }, - { "leftstr", 2, 0, SQLITE_UTF8, 0, leftFunc }, - { "rightstr", 2, 0, SQLITE_UTF8, 0, rightFunc }, -#ifndef HAVE_TRIM - { "ltrim", 1, 0, SQLITE_UTF8, 0, ltrimFunc }, - { "rtrim", 1, 0, SQLITE_UTF8, 0, rtrimFunc }, - { "trim", 1, 0, SQLITE_UTF8, 0, trimFunc }, - { "replace", 3, 0, SQLITE_UTF8, 0, replaceFunc }, -#endif - { "reverse", 1, 0, SQLITE_UTF8, 0, reverseFunc }, - { "proper", 1, 0, SQLITE_UTF8, 0, properFunc }, - { "padl", 2, 0, SQLITE_UTF8, 0, padlFunc }, - { "padr", 2, 0, SQLITE_UTF8, 0, padrFunc }, - { "padc", 2, 0, SQLITE_UTF8, 0, padcFunc }, - { "strfilter", 2, 0, SQLITE_UTF8, 0, strfilterFunc }, - - }; - /* Aggregate functions */ - static const struct FuncDefAgg { - char *zName; - signed char nArg; - u8 argType; - u8 needCollSeq; - void (*xStep)(sqlite3_context*,int,sqlite3_value**); - void (*xFinalize)(sqlite3_context*); - } aAggs[] = { - { "stdev", 1, 0, 0, varianceStep, stdevFinalize }, - { "variance", 1, 0, 0, varianceStep, varianceFinalize }, - { "mode", 1, 0, 0, modeStep, modeFinalize }, - { "median", 1, 0, 0, modeStep, medianFinalize }, - { "lower_quartile", 1, 0, 0, modeStep, lower_quartileFinalize }, - { "upper_quartile", 1, 0, 0, modeStep, upper_quartileFinalize }, - }; - int i; - - for(i=0; ineedCollSeq = 1; - } - } -#endif - } - - for(i=0; ineedCollSeq = 1; - } - } -#endif - } - return 0; -} - -#ifdef COMPILE_SQLITE_EXTENSIONS_AS_LOADABLE_MODULE -int sqlite3_extension_init( - sqlite3 *db, char **pzErrMsg, const sqlite3_api_routines *pApi){ - SQLITE_EXTENSION_INIT2(pApi); - RegisterExtensionFunctions(db); - return 0; -} -#endif /* COMPILE_SQLITE_EXTENSIONS_AS_LOADABLE_MODULE */ - -map map_make(cmp_func cmp){ - map r; - r.cmp=cmp; - r.base = 0; - - return r; -} - -void* xcalloc(size_t nmemb, size_t size, char* s){ - void* ret = calloc(nmemb, size); - return ret; -} - -void xfree(void* p){ - free(p); -} - -void node_insert(node** n, cmp_func cmp, void *e){ - int c; - node* nn; - if(*n==0){ - nn = (node*)xcalloc(1,sizeof(node), "for node"); - nn->data = e; - nn->count = 1; - *n=nn; - }else{ - c=cmp((*n)->data,e); - if(0==c){ - ++((*n)->count); - xfree(e); - }else if(c>0){ - /* put it right here */ - node_insert(&((*n)->l), cmp, e); - }else{ - node_insert(&((*n)->r), cmp, e); - } - } -} - -void map_insert(map *m, void *e){ - node_insert(&(m->base), m->cmp, e); -} - -void node_iterate(node *n, map_iterator iter, void* p){ - if(n){ - if(n->l) - node_iterate(n->l, iter, p); - iter(n->data, n->count, p); - if(n->r) - node_iterate(n->r, iter, p); - } -} - -void map_iterate(map *m, map_iterator iter, void* p){ - node_iterate(m->base, iter, p); -} - -void node_destroy(node *n){ - if(0!=n){ - xfree(n->data); - if(n->l) - node_destroy(n->l); - if(n->r) - node_destroy(n->r); - - xfree(n); - } -} - -void map_destroy(map *m){ - node_destroy(m->base); -} - -int int_cmp(const void *a, const void *b){ - int64_t aa = *(int64_t *)(a); - int64_t bb = *(int64_t *)(b); - /* printf("cmp %d <=> %d\n",aa,bb); */ - if(aa==bb) - return 0; - else if(aa %d\n",aa,bb); */ - if(aa==bb) - return 0; - else if(aa %lld\n", ee,(long long int)c); -} - diff --git a/src/core/symmetries.cpp b/src/core/symmetries.cpp deleted file mode 100644 index d1d7293..0000000 --- a/src/core/symmetries.cpp +++ /dev/null @@ -1,1285 +0,0 @@ -/*************************************************************************** - * - * Authors: Carlos Oscar S. Sorzano (coss@cnb.csic.es) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include - -#include "symmetries.h" -#include "geometry.h" - -// Read Symmetry file ====================================================== -// crystal symmetry matices from http://cci.lbl.gov/asu_gallery/ -int SymList::readSymmetryFile(FileName fn_sym, double accuracy) -{ - int i, j; - FILE *fpoii; - char line[80]; - char *auxstr; - double ang_incr, rot_ang; - int fold; - Matrix2D L(4, 4), R(4, 4); - Matrix1D axis(3), shift(3); - int pgGroup = sym_undefined; - int pgOrder; - std::vector fileContent; - - //check if reserved word - - // Open file --------------------------------------------------------- - if ((fpoii = fopen(fn_sym.c_str(), "r")) == NULL) - { - //check if reserved word and return group and order - if (isSymmetryGroup(fn_sym, pgGroup, pgOrder)) - { - fillSymmetryClass(fn_sym, pgGroup, pgOrder,fileContent); - } - else - REPORT_ERROR(ERR_IO_NOTOPEN, (std::string)"SymList::read_sym_file:Can't open file: " - + " or do not recognize symmetry group" + fn_sym); - } - else - { - while (fgets(line, 79, fpoii) != NULL) - { - if (line[0] == ';' || line[0] == '#' || line[0] == '\0') - continue; - fileContent.push_back(line); - } - fclose(fpoii); - } - - //reset space_group - space_group = 0; - // Count the number of symmetries ------------------------------------ - true_symNo = 0; - // count number of axis and mirror planes. It will help to identify - // the crystallographic symmetry - - int no_axis, no_mirror_planes, no_inversion_points; - no_axis = no_mirror_planes = no_inversion_points = 0; - - for (size_t n=0; n A; - alignWithZ(axis,A); - A = A.transpose(); - R = A * L * A.inv(); - setShift(i, shift); - L.initIdentity(); - setMatrices(i++, L, R); - __sym_elements++; - // P4212 ------------------------------------------------------------- - } - else if (strcmp(auxstr, "P4212") == 0) - { - space_group = sym_P42_12; - accuracy = -1; // Do not compute subgroup - L.initIdentity(); - - // With 0 shift - R.initZeros(); - R(3, 3) = 1; - R(0, 0) = R(1, 1) = -1; - R(2, 2) = 1; - setShift(i, shift); - setMatrices(i++, L, R); - R.initZeros(); - R(3, 3) = 1; - R(2, 2) = -1; - R(0, 1) = R(1, 0) = 1; - setShift(i, shift); - setMatrices(i++, L, R); - R.initZeros(); - R(3, 3) = 1; - R(2, 2) = R(0, 1) = R(1, 0) = -1; - setShift(i, shift); - setMatrices(i++, L, R); - - // With 1/2 shift - VECTOR_R3(shift, 0.5, 0.5, 0); - R.initZeros(); - R(3, 3) = 1; - R(0, 1) = -1; - R(1, 0) = R(2, 2) = 1; - setShift(i, shift); - setMatrices(i++, L, R); - R.initZeros(); - R(3, 3) = 1; - R(1, 0) = -1; - R(0, 1) = R(2, 2) = 1; - setShift(i, shift); - setMatrices(i++, L, R); - R.initZeros(); - R(3, 3) = 1; - R(0, 0) = R(2, 2) = -1; - R(1, 1) = 1; - setShift(i, shift); - setMatrices(i++, L, R); - R.initZeros(); - R(3, 3) = 1; - R(1, 1) = R(2, 2) = -1; - R(0, 0) = 1; - setShift(i, shift); - setMatrices(i++, L, R); - - __sym_elements++; - } - else if (strcmp(auxstr, "P2_122") == 0) - { - space_group = sym_P2_122; - accuracy = -1; // Do not compute subgroup - L.initIdentity(); - - // With 0 shift - R.initZeros(); - R(3, 3) = 1; - R(0, 0) = -1; - R(1, 1) = -1; - R(2, 2) = 1; - setShift(i, shift); - setMatrices(i++, L, R); - - // With 1/2 shift - VECTOR_R3(shift, 0.5, 0.0, 0.0); - R.initZeros(); - R(3, 3) = 1; - R(0, 0) = -1; - R(1, 1) = 1; - R(2, 2) = -1; - setShift(i, shift); - setMatrices(i++, L, R); - R.initZeros(); - R(3, 3) = 1; - R(0, 0) = 1; - R(1, 1) = -1; - R(2, 2) = -1; - setShift(i, shift); - setMatrices(i++, L, R); - __sym_elements++; - } - else if (strcmp(auxstr, "P22_12") == 0) - { - space_group = sym_P22_12; - accuracy = -1; // Do not compute subgroup - L.initIdentity(); - - // With 0 shift - R.initZeros(); - R(3, 3) = 1; - R(0, 0) = -1; - R(1, 1) = -1; - R(2, 2) = 1; - setShift(i, shift); - setMatrices(i++, L, R); - - // With 1/2 shift - VECTOR_R3(shift, 0.0, 0.5, 0.0); - R.initZeros(); - R(3, 3) = 1; - R(0, 0) = 1; - R(1, 1) = -1; - R(2, 2) = -1; - setShift(i, shift); - setMatrices(i++, L, R); - R.initZeros(); - R(3, 3) = 1; - R(0, 0) = -1; - R(1, 1) = 1; - R(2, 2) = -1; - setShift(i, shift); - setMatrices(i++, L, R); - __sym_elements++; - } - } - - if (accuracy > 0) - computeSubgroup(accuracy); - - //possible crystallographic symmetry - if (no_axis == 0 && no_mirror_planes == 0 && no_inversion_points == 0 && - true_symNo == 7 && space_group == sym_P42_12) - space_group = sym_P42_12; - else if (no_axis == 0 && no_mirror_planes == 0 && no_inversion_points == 0 && - true_symNo == 3 && space_group == sym_P2_122) - space_group = sym_P2_122; - else if (no_axis == 0 && no_mirror_planes == 0 && no_inversion_points == 0 && - true_symNo == 3 && space_group == sym_P22_12) - space_group = sym_P22_12; - // P4 and P6 - else if (no_axis == 1 && no_mirror_planes == 0 && no_inversion_points == 0 && - fabs(R(2, 2) - 1.) < XMIPP_EQUAL_ACCURACY && - fabs(R(0, 0) - R(1, 1)) < XMIPP_EQUAL_ACCURACY && - fabs(R(0, 1) + R(1, 0)) < XMIPP_EQUAL_ACCURACY) - { - switch (true_symNo) - { - case(5): - space_group = sym_P6; - break; - case(3): - space_group = sym_P4; - break; - default: - space_group = sym_undefined; - break; - }//switch end - }//end else if (no_axis==1 && no_mirror_planes== 0 - else if (no_axis == 0 && no_inversion_points == 0 && no_mirror_planes == 0) - space_group = sym_P1; - else - space_group = sym_undefined; - return pgGroup; -} - -// Get matrix ============================================================== -void SymList::getMatrices(int i, Matrix2D &L, Matrix2D &R, - bool homogeneous) -const -{ - int k, kp, l; - if (homogeneous) - { - L.initZeros(4, 4); - R.initZeros(4, 4); - for (k = 4 * i, kp=0; k < 4*i + 4; k++, kp++) - for (l = 0; l < 4; l++) - { - dMij(L,kp, l) = dMij(__L,k, l); - dMij(R,kp, l) = dMij(__R,k, l); - } - } - else - { - L.initZeros(3, 3); - R.initZeros(3, 3); - for (k = 4 * i, kp=0; k < 4*i + 3; k++, kp++) - for (l = 0; l < 3; l++) - { - dMij(L,kp, l) = dMij(__L,k, l); - dMij(R,kp, l) = dMij(__R,k, l); - } - } -} - -// Set matrix ============================================================== -void SymList::setMatrices(int i, const Matrix2D &L, - const Matrix2D &R) -{ - int k, l; - for (k = 4 * i; k < 4*i + 4; k++) - for (l = 0; l < 4; l++) - { - __L(k, l) = L(k - 4 * i, l); - __R(k, l) = R(k - 4 * i, l); - } -} - -// Get/Set shift =========================================================== -void SymList::getShift(int i, Matrix1D &shift) const -{ - shift.resize(3); - XX(shift) = __shift(i, 0); - YY(shift) = __shift(i, 1); - ZZ(shift) = __shift(i, 2); -} - -void SymList::setShift(int i, const Matrix1D &shift) -{ - if (shift.size() != 3) - REPORT_ERROR(ERR_MATRIX_SIZE, "SymList::add_shift: Shift vector is not 3x1"); - __shift(i, 0) = XX(shift); - __shift(i, 1) = YY(shift); - __shift(i, 2) = ZZ(shift); -} - -void SymList::addShift(const Matrix1D &shift) -{ - if (shift.size() != 3) - REPORT_ERROR(ERR_MATRIX_SIZE, "SymList::add_shift: Shift vector is not 3x1"); - int i = MAT_YSIZE(__shift); - __shift.resize(i + 1, 3); - setShift(i, shift); -} - -// Add matrix ============================================================== -void SymList::addMatrices(const Matrix2D &L, const Matrix2D &R, - int chain_length) -{ - if (MAT_XSIZE(L) != 4 || MAT_YSIZE(L) != 4 || MAT_XSIZE(R) != 4 || MAT_YSIZE(R) != 4) - REPORT_ERROR(ERR_MATRIX_SIZE, "SymList::add_matrix: Transformation matrix is not 4x4"); - if (trueSymsNo() == symsNo()) - { - __L.resize(MAT_YSIZE(__L) + 4, 4); - __R.resize(MAT_YSIZE(__R) + 4, 4); - __chain_length.resize(__chain_length.size() + 1); - } - - setMatrices(true_symNo, L, R); - __chain_length(__chain_length.size() - 1) = chain_length; - true_symNo++; -} - -// Compute subgroup ======================================================== -bool found_not_tried(const Matrix2D &tried, int &i, int &j, - int true_symNo) -{ - i = j = 0; - size_t n = 0; - while (n != MAT_YSIZE(tried)) - { - // if (tried(i, j) == 0 && !(i >= true_symNo && j >= true_symNo)) - if (dMij(tried,i, j) == 0 && !(i >= true_symNo && j >= true_symNo)) - return true; - if (i != (int)n) - { - // Move downwards - i++; - } - else - { - // Move leftwards - j--; - if (j == -1) - { - n++; - j = n; - i = 0; - } - } - } - return false; -} - -//#define DEBUG -void SymList::computeSubgroup(double accuracy) -{ - Matrix2D I(4, 4); - I.initIdentity(); - Matrix2D L1(4, 4), R1(4, 4), L2(4, 4), R2(4, 4), newL(4, 4), newR(4, 4),identity(4,4); - Matrix2D tried(true_symNo, true_symNo); - Matrix1D shift(3); - shift.initZeros(); - int i, j; - int new_chain_length; - identity.initIdentity(); - while (found_not_tried(tried, i, j, true_symNo)) - { - tried(i, j) = 1; - - // Form new symmetry matrices - // if (__chain_length(i)+__chain_length(j)>__sym_elements+2) continue; - - getMatrices(i, L1, R1); - getMatrices(j, L2, R2); - newL = L1 * L2; - newR = R1 * R2; - new_chain_length = __chain_length(i) + __chain_length(j); - - //if (newL.isIdentity() && newR.isIdentity()) continue; - //rounding error make newR different from identity - if (newL.equal(identity, accuracy) && - newR.equal(identity, accuracy)) - continue; - - // Try to find it in current ones - bool found; - found = false; - for (int l = 0; l < symsNo(); l++) - { - getMatrices(l, L1, R1); - if (newL.equal(L1, accuracy) && newR.equal(R1, accuracy)) - { - found = true; - break; - } - } - - if (!found) - { - //#define DEBUG -#ifdef DEBUG - static int kjhg=0; - /* std::cout << "Matrix size " << tried.Xdim() << " " - << "trying " << i << " " << j << " " - << "chain length=" << new_chain_length << std::endl; - std::cout << "Result R Sh\n" << newR << shift; - */ - //std::cerr << "shift" << __shift < XMIPP_EQUAL_ACCURACY || - fabs(ang_a2b_deg - 90) > XMIPP_EQUAL_ACCURACY) - std::cerr << "\nWARNING: P42 but mag_a != mag_b\n" - << " or ang_a2b !=90" << std::endl; - return(space_group); - break; - case sym_P2_122: - if (fabs((mag_a - mag_b)) > XMIPP_EQUAL_ACCURACY || - fabs(ang_a2b_deg - 90) > XMIPP_EQUAL_ACCURACY) - std::cerr << "\nWARNING: P2_122 but mag_a != mag_b\n" - << " or ang_a2b !=90" << std::endl; - return(space_group); - break; - case sym_P22_12: - if (fabs((mag_a - mag_b)) > XMIPP_EQUAL_ACCURACY || - fabs(ang_a2b_deg - 90) > XMIPP_EQUAL_ACCURACY) - std::cerr << "\nWARNING: P22_12 but mag_a != mag_b\n" - << " or ang_a2b !=90" << std::endl; - return(space_group); - break; - case sym_P42_12: - if (fabs((mag_a - mag_b)) > XMIPP_EQUAL_ACCURACY || - fabs(ang_a2b_deg - 90) > XMIPP_EQUAL_ACCURACY) - std::cerr << "\nWARNING: P42_12 but mag_a != mag_b\n" - << " or ang_a2b !=90" << std::endl; - return(space_group); - break; - case sym_P6: - if (fabs((mag_a - mag_b)) > XMIPP_EQUAL_ACCURACY || - fabs(ang_a2b_deg - 120.) > XMIPP_EQUAL_ACCURACY) - { - std::cerr << "\nWARNING: marked as P6 but mag_a != mag_b\n" - << "or ang_a2b !=120" << std::endl; - std::cerr << "\nWARNING: P1 is assumed\n"; - return(sym_P1); - } - else - return(space_group); - break; - default: - std::cerr << "\n Congratulations: you have found a bug in the\n" - << "routine crystallographic_space_group or\n" - << "You have called to this rotuine BEFORE reading\n" - << "the symmetry info" << std::endl; - exit(0); - break; - }//switch(space_group) end - -}//crystallographicSpaceGroup end - -bool SymList::isSymmetryGroup(FileName fn_sym, int &pgGroup, int &pgOrder) -{ - char G1,G2,G3='\0',G4; - char auxChar[3]; - //each case check length, check first letter, second, is number - //Non a point group - - //remove path - FileName fn_sym_tmp; - fn_sym_tmp=fn_sym.removeDirectories(); - int mySize=fn_sym_tmp.size(); - bool return_true; - return_true=false; - auxChar[2]='\0'; - //size maybe 4 because n maybe a 2 digit number - if(mySize>4 || mySize<1) - { - pgGroup=-1; - pgOrder=-1; - return false; - } - //get the group character by character - G1=toupper((fn_sym_tmp.c_str())[0]); - G2=toupper((fn_sym_tmp.c_str())[1]); - if (mySize > 2) - { - G3=toupper((fn_sym_tmp.c_str())[2]); - if(mySize > 3) - G4=toupper((fn_sym.c_str())[3]); - } - else - G4='\0'; - //CN - if (mySize==2 && G1=='C' && isdigit(G2)) - { - pgGroup=pg_CN; - pgOrder=int(G2)-48; - return_true=true; - } - if (mySize==3 && G1=='C' && isdigit(G2) && isdigit(G3)) - { - pgGroup=pg_CN; - auxChar[0]=G2; - auxChar[1]=G3; - pgOrder=atoi(auxChar); - return_true=true; - } - //CI - else if (mySize==2 && G1=='C' && G2=='I') - { - pgGroup=pg_CI; - pgOrder=-1; - return_true=true; - } - //CS - else if (mySize==2 && G1=='C' && G2=='S') - { - pgGroup=pg_CS; - pgOrder=-1; - return_true=true; - } - //CNH - else if (mySize==3 && G1=='C' && isdigit(G2) && G3=='H') - { - pgGroup=pg_CNH; - pgOrder=int(G2)-48; - return_true=true; - } - else if (mySize==4 && G1=='C' && isdigit(G2) && isdigit(G3) && G4=='H') - { - pgGroup=pg_CNH; - auxChar[0]=G2; - auxChar[1]=G3; - pgOrder=atoi(auxChar); - return_true=true; - } - //CNV - else if (mySize==3 && G1=='C' && isdigit(G2) && G3=='V') - { - pgGroup=pg_CNV; - pgOrder=int(G2)-48; - return_true=true; - } - else if (mySize==4 && G1=='C' && isdigit(G2) && isdigit(G3) && G4=='V') - { - pgGroup=pg_CNV; - auxChar[0]=G2; - auxChar[1]=G3; - pgOrder=atoi(auxChar); - return_true=true; - } - //SN - else if (mySize==2 && G1=='S' && isdigit(G2) ) - { - pgGroup=pg_SN; - pgOrder=int(G2)-48; - return_true=true; - } - else if (mySize==3 && G1=='S' && isdigit(G2) && isdigit(G3) ) - { - pgGroup=pg_SN; - auxChar[0]=G2; - auxChar[1]=G3; - pgOrder=atoi(auxChar); - return_true=true; - } - //DN - else if (mySize==2 && G1=='D' && isdigit(G2) ) - { - pgGroup=pg_DN; - pgOrder=int(G2)-48; - return_true=true; - } - if (mySize==3 && G1=='D' && isdigit(G2) && isdigit(G3)) - { - pgGroup=pg_DN; - auxChar[0]=G2; - auxChar[1]=G3; - pgOrder=atoi(auxChar); - return_true=true; - } - //DNV - else if (mySize==3 && G1=='D' && isdigit(G2) && G3=='V') - { - pgGroup=pg_DNV; - pgOrder=int(G2)-48; - return_true=true; - } - else if (mySize==4 && G1=='D' && isdigit(G2) && isdigit(G3) && G4=='V') - { - pgGroup=pg_DNV; - auxChar[0]=G2; - auxChar[1]=G3; - pgOrder=atoi(auxChar); - return_true=true; - } - //DNH - else if (mySize==3 && G1=='D' && isdigit(G2) && G3=='H') - { - pgGroup=pg_DNH; - pgOrder=int(G2)-48; - return_true=true; - } - else if (mySize==4 && G1=='D' && isdigit(G2) && isdigit(G3) && G4=='H') - { - pgGroup=pg_DNH; - auxChar[0]=G2; - auxChar[1]=G3; - pgOrder=atoi(auxChar); - return_true=true; - } - //T - else if (mySize==1 && G1=='T') - { - pgGroup=pg_T; - pgOrder=-1; - return_true=true; - } - //TD - else if (mySize==2 && G1=='T' && G2=='D') - { - pgGroup=pg_TD; - pgOrder=-1; - return_true=true; - } - //TH - else if (mySize==2 && G1=='T' && G2=='H') - { - pgGroup=pg_TH; - pgOrder=-1; - return_true=true; - } - //O - else if (mySize==1 && G1=='O') - { - pgGroup=pg_O; - pgOrder=-1; - return_true=true; - } - //OH - else if (mySize==2 && G1=='O'&& G2=='H') - { - pgGroup=pg_OH; - pgOrder=-1; - return_true=true; - } - //I - else if (mySize==1 && G1=='I') - { - pgGroup=pg_I; - pgOrder=-1; - return_true=true; - } - //I1 - else if (mySize==2 && G1=='I'&& G2=='1') - { - pgGroup=pg_I1; - pgOrder=-1; - return_true=true; - } - //I2 - else if (mySize==2 && G1=='I'&& G2=='2') - { - pgGroup=pg_I2; - pgOrder=-1; - return_true=true; - } - //I3 - else if (mySize==2 && G1=='I'&& G2=='3') - { - pgGroup=pg_I3; - pgOrder=-1; - return_true=true; - } - //I4 - else if (mySize==2 && G1=='I'&& G2=='4') - { - pgGroup=pg_I4; - pgOrder=-1; - return_true=true; - } - //I5 - else if (mySize==2 && G1=='I'&& G2=='5') - { - pgGroup=pg_I5; - pgOrder=-1; - return_true=true; - } - //IH - else if (mySize==2 && G1=='I'&& G2=='H') - { - pgGroup=pg_IH; - pgOrder=-1; - return_true=true; - } - //I1H - else if (mySize==3 && G1=='I'&& G2=='1'&& G3=='H') - { - pgGroup=pg_I1H; - pgOrder=-1; - return_true=true; - } - //I2H - else if (mySize==3 && G1=='I'&& G2=='2'&& G3=='H') - { - pgGroup=pg_I2H; - pgOrder=-1; - return_true=true; - } - //I3H - else if (mySize==3 && G1=='I'&& G2=='3'&& G3=='H') - { - pgGroup=pg_I3H; - pgOrder=-1; - return_true=true; - } - //I4H - else if (mySize==3 && G1=='I'&& G2=='4'&& G3=='H') - { - pgGroup=pg_I4H; - pgOrder=-1; - return_true=true; - } - //I5H - else if (mySize==3 && G1=='I'&& G2=='5'&& G3=='H') - { - pgGroup=pg_I5H; - pgOrder=-1; - return_true=true; - } - //#define DEBUG7 -#ifdef DEBUG7 - std::cerr << "pgGroup" << pgGroup << " pgOrder " << pgOrder << std::endl; -#endif -#undef DEBUG7 - - return return_true; -} -void SymList::fillSymmetryClass(const FileName &symmetry, int pgGroup, int pgOrder, - std::vector &fileContent) -{ - std::ostringstream line1; - std::ostringstream line2; - std::ostringstream line3; - std::ostringstream line4; - if (pgGroup == pg_CN) - { - line1 << "rot_axis " << pgOrder << " 0 0 1"; - } - else if (pgGroup == pg_CI) - { - line1 << "inversion "; - } - else if (pgGroup == pg_CS) - { - line1 << "mirror_plane 0 0 1"; - } - else if (pgGroup == pg_CNV) - { - line1 << "rot_axis " << pgOrder << " 0 0 1"; - line2 << "mirror_plane 0 1 0"; - } - else if (pgGroup == pg_CNH) - { - line1 << "rot_axis " << pgOrder << " 0 0 1"; - line2 << "mirror_plane 0 0 1"; - } - else if (pgGroup == pg_SN) - { - int order = pgOrder / 2; - if(2*order != pgOrder) - { - std::cerr << "ERROR: order for SN group must be even" << std::endl; - exit(0); - } - line1 << "rot_axis " << order << " 0 0 1"; - line2 << "inversion "; - } - else if (pgGroup == pg_DN) - { - line1 << "rot_axis " << pgOrder << " 0 0 1"; - line2 << "rot_axis " << "2" << " 1 0 0"; - } - else if (pgGroup == pg_DNV) - { - line1 << "rot_axis " << pgOrder << " 0 0 1"; - line2 << "rot_axis " << "2" << " 1 0 0"; - line3 << "mirror_plane 1 0 0"; - } - else if (pgGroup == pg_DNH) - { - line1 << "rot_axis " << pgOrder << " 0 0 1"; - line2 << "rot_axis " << "2" << " 1 0 0"; - line3 << "mirror_plane 0 0 1"; - } - else if (pgGroup == pg_T) - { - line1 << "rot_axis " << "3" << " 0. 0. 1."; - line2 << "rot_axis " << "2" << " 0. 0.816496 0.577350"; - } - else if (pgGroup == pg_TD) - { - line1 << "rot_axis " << "3" << " 0. 0. 1."; - line2 << "rot_axis " << "2" << " 0. 0.816496 0.577350"; - line3 << "mirror_plane 1.4142136 2.4494897 0.0000000"; - } - else if (pgGroup == pg_TH) - { - line1 << "rot_axis " << "3" << " 0. 0. 1."; - line2 << "rot_axis " << "2" << " 0. -0.816496 -0.577350"; - line3 << "inversion"; - } - else if (pgGroup == pg_O) - { - line1 << "rot_axis " << "3" << " .5773502 .5773502 .5773502"; - line2 << "rot_axis " << "4" << " 0 0 1"; - } - else if (pgGroup == pg_OH) - { - line1 << "rot_axis " << "3" << " .5773502 .5773502 .5773502"; - line2 << "rot_axis " << "4" << " 0 0 1"; - line3 << "mirror_plane 0 1 1"; - } - else if (pgGroup == pg_I || pgGroup == pg_I2) - { - line1 << "rot_axis 2 0 0 1"; - line2 << "rot_axis 5 0.525731114 0 0.850650807"; - line3 << "rot_axis 3 0 0.356822076 0.934172364"; - } - else if (pgGroup == pg_I1) - { - line1 << "rot_axis 2 1 0 0"; - line2 << "rot_axis 5 0.85065080702670 0 -0.5257311142635"; - line3 << "rot_axis 3 0.9341723640 0.3568220765 0"; - } - else if (pgGroup == pg_I3) - { - line1 << "rot_axis 2 -0.5257311143 0 0.8506508070"; - line3 << "rot_axis 5 0. 0. 1."; - line2 << "rot_axis 3 -0.4911234778630044, 0.3568220764705179, 0.7946544753759428"; - } - else if (pgGroup == pg_I4) - { - line1 << "rot_axis 2 0.5257311143 0 0.8506508070"; - line3 << "rot_axis 5 0.8944271932547096 0 0.4472135909903704"; - line2 << "rot_axis 3 0.4911234778630044 0.3568220764705179 0.7946544753759428"; - } - else if (pgGroup == pg_I5) - { - std::cerr << "ERROR: Symmetry pg_I5 not implemented" << std::endl; - exit(0); - } - else if (pgGroup == pg_IH || pgGroup == pg_I2H) - { - line1 << "rot_axis 2 0 0 1"; - line2 << "rot_axis 5 0.525731114 0 0.850650807"; - line3 << "rot_axis 3 0 0.356822076 0.934172364"; - line4 << "mirror_plane 1 0 0"; - } - else if (pgGroup == pg_I1H) - { - line1 << "rot_axis 2 1 0 0"; - line2 << "rot_axis 5 0.85065080702670 0 -0.5257311142635"; - line3 << "rot_axis 3 0.9341723640 0.3568220765 0"; - line4 << "mirror_plane 0 0 -1"; - } - else if (pgGroup == pg_I3H) - { - line1 << "rot_axis 2 -0.5257311143 0 0.8506508070"; - line3 << "rot_axis 5 0. 0. 1."; - line2 << "rot_axis 3 -0.4911234778630044, 0.3568220764705179, 0.7946544753759428"; - line4 << "mirror_plane 0.850650807 0 0.525731114"; - } - else if (pgGroup == pg_I4H) - { - line1 << "rot_axis 2 0.5257311143 0 0.8506508070"; - line3 << "rot_axis 5 0.8944271932547096 0 0.4472135909903704"; - line2 << "rot_axis 3 0.4911234778630044 0.3568220764705179 0.7946544753759428"; - line4 << "mirror_plane 0.850650807 0 -0.525731114"; - } - else if (pgGroup == pg_I5H) - { - std::cerr << "ERROR: Symmetry pg_I5H not implemented" << std::endl; - exit(0); - } - else - { - std::cerr << "ERROR: Symmetry " << symmetry << "is not known" << std::endl; - exit(0); - } - if (line1.str().size()>0) - fileContent.push_back(line1.str()); - if (line2.str().size()>0) - fileContent.push_back(line2.str()); - if (line3.str().size()>0) - fileContent.push_back(line3.str()); - if (line4.str().size()>0) - fileContent.push_back(line4.str()); - //#define DEBUG5 -#ifdef DEBUG5 - - for (int n=0; n E1, E2; - Euler_angles2matrix(rot1, tilt1, psi1, E1, false); - - int imax = symsNo() + 1; - Matrix2D L(3, 3), R(3, 3); // A matrix from the list - double best_ang_dist = 3600; - double best_rot2=0, best_tilt2=0, best_psi2=0; - - for (int i = 0; i < imax; i++) - { - double rot2p, tilt2p, psi2p; - if (i == 0) - { - rot2p = rot2; - tilt2p = tilt2; - psi2p = psi2; - } - else - { - getMatrices(i - 1, L, R, false); - if (object_rotation) - Euler_apply_transf(R, L, rot2, tilt2, psi2, rot2p, tilt2p, psi2p); - else - Euler_apply_transf(L, R, rot2, tilt2, psi2, rot2p, tilt2p, psi2p); - } - - double ang_dist = Euler_distanceBetweenAngleSets_fast(E1,rot2p, tilt2p, psi2p, - projdir_mode, E2); - - if (ang_dist < best_ang_dist) - { - best_rot2 = rot2p; - best_tilt2 = tilt2p; - best_psi2 = psi2p; - best_ang_dist = ang_dist; - } - - if (check_mirrors) - { - double rot2pm, tilt2pm, psi2pm; - Euler_mirrorY(rot2p, tilt2p, psi2p, rot2pm, tilt2pm, psi2pm); - double ang_dist_mirror = Euler_distanceBetweenAngleSets_fast(E1, - rot2pm, tilt2pm, psi2pm,projdir_mode, E2); - - if (ang_dist_mirror < best_ang_dist) - { - best_rot2 = write_mirrors ? rot2pm : rot2p; - best_tilt2 = write_mirrors ? tilt2pm : tilt2p; - best_psi2 = write_mirrors ? psi2pm : psi2p; - best_ang_dist = ang_dist_mirror; - } - - } - } - rot2 = best_rot2; - tilt2 = best_tilt2; - psi2 = best_psi2; - return best_ang_dist; -} - -void SymList::breakSymmetry(double rot1, double tilt1, double psi1, - double &rot2, double &tilt2, double &psi2 - ) -{ - Matrix2D E1; - Euler_angles2matrix(rot1, tilt1, psi1, E1, true); - static bool doRandomize=true; - Matrix2D L(3, 3), R(3, 3); // A matrix from the list - - int i; - if (doRandomize) - { - srand ( time(NULL) ); - doRandomize=false; - } - int symOrder = symsNo()+1; - //std::cerr << "DEBUG_ROB: symOrder: " << symOrder << std::endl; - i = rand() % symOrder;//59+1 - //std::cerr << "DEBUG_ROB: i: " << i << std::endl; - if (i < symOrder-1) - { - getMatrices(i, L, R); - //std::cerr << R << std::endl; - Euler_matrix2angles(E1 * R, rot2, tilt2, psi2); - } - else - { - //std::cerr << "else" < default in xmipp -#define pg_I3 218 //52 as used by spider -#define pg_I4 219 //another 52 -#define pg_I5 220 //another another 52 (used by EMBL-matfb) - -#define pg_I1H 221 //no crowther 222, + mirror plane -#define pg_I2H 222 //crowther 222-> default in xmipp+ mirror plane -#define pg_I3H 223 //52 as used by spider+ mirror plane -#define pg_I4H 224 //another 52+ mirror plane -#define pg_I5H 225 //another another 52 (used by EMBL-matfb)+ mirror plane - -/** Number of an image in the reconstruction list. - This macro returns the index of a symmetry image (after the symmetry matrix - number sym_no) within a list where the first images are true images and the - last ones, the symmetrized copies (all copies of a same image are - together). The total number of real images is numIMG, and i is the index - within this first numIMG images of the image we want to symmetrize The - first image in the list is the number 0 */ -#define SYMINDEX(SL, sym_no, i, numIMG) \ - numIMG+SL.__L.mdimy/4*i+sym_no - -/** Symmetry List class. - Internally the symmetry list class is implemented as a single 2D matrix, - where every 4 rows (remember that in 3D the geometrical transformation - matrices are 4x4) comprise a symmetry matrix. Access, and ways to modify - the symmetry list are supplied. Remind that any symmetry is expressed - in terms of two matrices L and R, so that any Euler matrix must be - transformed by L*Euler*R resulting into a new perspective of the volume - which is equivalent to the original one. - - The typical use of the symmetry lists is to read the symmetry file, and - do nothing else but reading matrices from it. - - The symmetry file format is - @code - #This is a comment - # The following line is a 6-fold rotational symmetry axis along Z-axis. - # The fold is the number of times that the volume can be rotated along - # the symmetry axis giving the same view from different view points. - # the structure for the rotational axis is - # rot_axis - # mirror_plane - rot_axis 6 0 0 1 - mirror_plane 0 0 1 - @endcode -*/ -class SymList -{ -private: - // Crystallographic space group. This is only a guess based on angles. - // No check on vectors magnitude is made - int space_group; -public: - // L and R matrices - Matrix2D __L, __R; - Matrix2D __shift; // It is used for crystallographic symmetries - Matrix1D __chain_length; - - // As the symmetry elements form a subgroup, this is the number of - // true symmetry elements belonging to the list, the rest of - // the list are simply the elements to fill the subgroup - int true_symNo; - - // Number of Axis, mirrors, ... - int __sym_elements; - -public: - /** Create an empty list. - The 2D matrices are 0x0. - \\ Ex: SymList SL; */ - SymList() - { - __sym_elements = true_symNo = space_group = 0; - } - - /** Create Symmetry List from a Symmetry file. - All the subgroup elements are computed automatically. - \\ Ex: SymList SL("sym.txt"); */ - SymList(const FileName& fn_sym, double accuracy = SYM_ACCURACY) - { - readSymmetryFile(fn_sym, accuracy); - } - - /** translate string fn_sym to symmetry group, return false - is translation is not possible. See - http://xmipp.cnb.csic.es/twiki/bin/view/Xmipp/Symmetry - for details. It also fill the symmetry information */ - bool isSymmetryGroup(FileName fn_sym, int &pgGroup, int &pgOrder); - - /** fill fileContect with symmetry information*/ - void fillSymmetryClass(const FileName &symmetry, int pgGroup, int pgOrder, - std::vector &fileContent); - - /** Get matrices from the symmetry list. - The number of matrices inside the list is given by symsNo. - This function return the 4x4 (homogeneous=true) or 3x3 (homogeneous=false) - transformation matrices associated to - the one in the list which occupies the position 'i'. The matrix - numbering within the list starts at 0. The output transformation - matrices is given as a pointer to gain speed. - \\ Ex: - @code - for (i=0; i &L, Matrix2D &R, - bool homogeneous=true) const; - - /** Set a couple of matrices in the symmetry list. - The number of matrices inside the list is given by symsNo. - This function sets the 4x4 transformation matrices associated to - the one in the list which occupies the position 'i'. The matrix - numbering within the list starts at 0. - \\ Ex: - @code - for (i=0; i &L, - const Matrix2D &R); - - /** Get shift. - Returns the shift associated to a certain symmetry. */ - void getShift(int i, Matrix1D &shift) const; - - /** Set shift. - Set the shift associated to a certain symmetry. */ - void setShift(int i, const Matrix1D &shift); - - /** Add shift. - Add a shift vector to the shift matrix. An exception is thrown if - the input vector is not a 3x1 vector.*/ - void addShift(const Matrix1D &shift); - - /** Read a symmetry file into a symmetry list. - The former symmetry list is overwritten with the new one. All the - subgroup members are added to the list. If the accuracy is negative - then the subgroup is not generated. return symmetry group - \\ Ex: SL.readSymmetryFile("sym.txt");*/ - int readSymmetryFile(FileName fn_sym, double accuracy = SYM_ACCURACY); - - /** Add symmetry matrices to the symmetry list. - The given matrix must specify a point of view equivalent to the - actual point of view. The matrices are added to the subgroup generator - but the subgroup is not updated, you must do it manually using - computeSubgroup. What is more, the subgroup after the insertion - is corrupted. - - The chain length is the number of single matrices multiplication of - which the inserted one is compound.*/ - void addMatrices(const Matrix2D &L, const Matrix2D &R, - int chain_length); - - /** Compute subgroup for this structure. - After adding or setting a matrix, the subgroup information - is lost, you must recalculate it using this function. The different - matrices are multiplied until no more different matrices are produced. - The accuracy is used in order to compare when two matrix elements are - the same. - - So far, all the shifts associated to generated matrices are set to 0*/ - void computeSubgroup(double accuracy = SYM_ACCURACY); - - /** Number of symmetry matrices inside the structure. - This is the number of all the matrices inside the subgroup. - \\ Ex: - @code - for (i=0; i -#include "metadata_row_base.h" -#include "utils/half.hpp" - -template -void produceSplineCoefficients(int SplineDegree, - MultidimArray< double > &coeffs, - const MultidimArray< T > &V1) -{ - - coeffs.initZeros(ZSIZE(V1), YSIZE(V1), XSIZE(V1)); - STARTINGX(coeffs) = STARTINGX(V1); - STARTINGY(coeffs) = STARTINGY(V1); - STARTINGZ(coeffs) = STARTINGZ(V1); - - int Status; - MultidimArray< double > aux; - typeCast(V1, aux); // This will create a single volume! - - ChangeBasisVolume(MULTIDIM_ARRAY(aux), MULTIDIM_ARRAY(coeffs), - XSIZE(V1), YSIZE(V1), ZSIZE(V1), - CardinalSpline, BasicSpline, SplineDegree, - MirrorOffBounds, DBL_EPSILON, &Status); - if (Status) - REPORT_ERROR(ERR_UNCLASSIFIED, "Error in produceSplineCoefficients..."); -} - -template -void produceImageFromSplineCoefficients(int SplineDegree, - MultidimArray< T >& img, - const MultidimArray< double > &coeffs) -{ - MultidimArray< double > imgD; - imgD.initZeros(ZSIZE(coeffs), YSIZE(coeffs), XSIZE(coeffs)); - STARTINGX(img) = STARTINGX(coeffs); - STARTINGY(img) = STARTINGY(coeffs); - STARTINGZ(img) = STARTINGZ(coeffs); - - int Status; - MultidimArray< double > aux(coeffs); - - ChangeBasisVolume(MULTIDIM_ARRAY(aux), MULTIDIM_ARRAY(imgD), - XSIZE(coeffs), YSIZE(coeffs), ZSIZE(coeffs), - BasicSpline, CardinalSpline, SplineDegree, - MirrorOnBounds, DBL_EPSILON, &Status); - if (Status) - REPORT_ERROR(ERR_UNCLASSIFIED, "Error in ImageFromSplineCoefficients..."); - typeCast(imgD, img); -} - -template -void reduceBSpline(int SplineDegree, - MultidimArray< double >& V2, - const MultidimArray &V1) -{ - double g[200]; // Coefficients of the reduce filter - long ng; // Number of coefficients of the reduce filter - double h[200]; // Coefficients of the expansion filter - long nh; // Number of coefficients of the expansion filter - short IsCentered; // Equal TRUE if the filter is a centered spline - - // Get the filter - const char *splineType="Centered Spline"; - if (GetPyramidFilter(splineType, SplineDegree, - g, &ng, h, &nh, &IsCentered)) - REPORT_ERROR(ERR_UNCLASSIFIED, "Unable to load the filter coefficients"); - - MultidimArray< double> aux; - typeCast(V1, aux); - if (V1.getDim() == 2) - { - if (XSIZE(aux) % 2 != 0 && YSIZE(aux) % 2 != 0) - aux.resize(YSIZE(aux) - 1, XSIZE(aux) - 1); - else if (YSIZE(aux) % 2 != 0) - aux.resize(YSIZE(aux) - 1, XSIZE(aux)); - else if (XSIZE(aux) % 2 != 0) - aux.resize(YSIZE(aux), XSIZE(aux) - 1); - - V2.initZeros(YSIZE(aux) / 2, XSIZE(aux) / 2); - Reduce_2D(MULTIDIM_ARRAY(aux), XSIZE(aux), YSIZE(aux), - MULTIDIM_ARRAY(V2), g, ng, IsCentered); - } - else if (V1.getDim() == 3) - { - if (XSIZE(aux) % 2 != 0 && YSIZE(aux) % 2 != 0 && ZSIZE(aux) % 2 != 0) - aux.resize(ZSIZE(aux - 1), YSIZE(aux) - 1, XSIZE(aux) - 1); - else if (XSIZE(aux) % 2 != 0 && YSIZE(aux) % 2 != 0 && ZSIZE(aux) % 2 == 0) - aux.resize(ZSIZE(aux), YSIZE(aux) - 1, XSIZE(aux) - 1); - else if (XSIZE(aux) % 2 != 0 && YSIZE(aux) % 2 == 0 && ZSIZE(aux) % 2 != 0) - aux.resize(ZSIZE(aux) - 1, YSIZE(aux), XSIZE(aux) - 1); - else if (XSIZE(aux) % 2 != 0 && YSIZE(aux) % 2 == 0 && ZSIZE(aux) % 2 == 0) - aux.resize(ZSIZE(aux), YSIZE(aux), XSIZE(aux) - 1); - else if (XSIZE(aux) % 2 == 0 && YSIZE(aux) % 2 != 0 && ZSIZE(aux) % 2 != 0) - aux.resize(ZSIZE(aux) - 1, YSIZE(aux) - 1, XSIZE(aux)); - else if (XSIZE(aux) % 2 == 0 && YSIZE(aux) % 2 != 0 && ZSIZE(aux) % 2 == 0) - aux.resize(ZSIZE(aux), YSIZE(aux) - 1, XSIZE(aux)); - else if (XSIZE(aux) % 2 == 0 && YSIZE(aux) % 2 == 0 && ZSIZE(aux) % 2 != 0) - aux.resize(ZSIZE(aux) - 1, YSIZE(aux), XSIZE(aux)); - - V2.initZeros(ZSIZE(aux) / 2, YSIZE(aux) / 2, XSIZE(aux) / 2); - Reduce_3D(MULTIDIM_ARRAY(aux), XSIZE(aux), YSIZE(aux), ZSIZE(aux), - MULTIDIM_ARRAY(V2), g, ng, IsCentered); - } - else - REPORT_ERROR(ERR_MULTIDIM_DIM,"reduceBSpline ERROR: only valid for 2D or 3D arrays"); -} - -template -void expandBSpline(int SplineDegree, - MultidimArray< double >& V2, - const MultidimArray &V1) -{ - double g[200]; // Coefficients of the reduce filter - long ng; // Number of coefficients of the reduce filter - double h[200]; // Coefficients of the expansion filter - long nh; // Number of coefficients of the expansion filter - short IsCentered; // Equal TRUE if the filter is a centered spline, FALSE otherwise */ - - // Get the filter - if (GetPyramidFilter("Centered Spline", SplineDegree, g, &ng, h, &nh, - &IsCentered)) - REPORT_ERROR(ERR_UNCLASSIFIED, "Unable to load the filter coefficients"); - - MultidimArray< double > aux; - typeCast(V1, aux); - - if (V1.getDim() == 2) - { - V2.initZeros(2 * YSIZE(aux), 2 * XSIZE(aux)); - Expand_2D(MULTIDIM_ARRAY(aux), XSIZE(aux), YSIZE(aux), - MULTIDIM_ARRAY(V2), h, nh, IsCentered); - } - else if (V1.getDim() == 3) - { - V2.initZeros(2 * ZSIZE(aux), 2 * YSIZE(aux), 2 * XSIZE(aux)); - Expand_3D(MULTIDIM_ARRAY(aux), XSIZE(aux), YSIZE(aux), ZSIZE(aux), - MULTIDIM_ARRAY(V2), h, nh, IsCentered); - } - else - REPORT_ERROR(ERR_MULTIDIM_DIM,"expandBSpline ERROR: only valid for 2D or 3D arrays"); -} - -void geo2TransformationMatrix(const MDRow &imageGeo, Matrix2D &A, - bool only_apply_shifts) -{ - // This has only been implemented for 2D images... - double psi = 0, shiftX = 0., shiftY = 0., scale = 1.; - bool flip = false; - - imageGeo.getValue(MDL_ANGLE_PSI, psi); - imageGeo.getValue(MDL_SHIFT_X, shiftX); - imageGeo.getValue(MDL_SHIFT_Y, shiftY); - imageGeo.getValue(MDL_SCALE, scale); - imageGeo.getValue(MDL_FLIP, flip); - - psi = realWRAP(psi, 0., 360.); - - int dim = A.Xdim() - 1; - //This check the case when matrix A is not initialized with correct size - if (dim < 2 || dim > 3) - { - dim = 3; - A.resizeNoCopy(dim + 1, dim + 1); - } - - if (only_apply_shifts) - A.initIdentity(); - else if (dim == 2) //2D geometry - rotation2DMatrix(psi, A, true); - else if (dim == 3)//3D geometry - { - double rot = 0., tilt = 0., shiftZ = 0.; - imageGeo.getValue(MDL_ANGLE_ROT, rot); - imageGeo.getValue(MDL_ANGLE_TILT, tilt); - imageGeo.getValue(MDL_SHIFT_Z, shiftZ); - Euler_angles2matrix(rot, tilt, psi, A, true); - dMij(A, 2, dim) = shiftZ; - } - dMij(A, 0, dim) = shiftX; - dMij(A, 1, dim) = shiftY; - - if (scale != 1.) - { - if (scale==0.) // Protection against badly formed metadatas - scale=1.0; - if (dim == 2) - { - M3x3_BY_CT(A, A, scale); - } - else if (dim == 3) - { - M4x4_BY_CT(A, A, scale); - } - dMij(A, dim, dim) = 1.; - } - - if (flip) - { - dMij(A, 0, 0) *= -1.; - dMij(A, 0, 1) *= -1.; - if (dim == 3) - dMij(A, 0, 2) *= -1.; - } -} - -void string2TransformationMatrix(const String &matrixStr, Matrix2D &matrix, size_t dim) -{ - matrix.resizeNoCopy(dim, dim); - - String matrixStrCopy(matrixStr); - char c; - - for (size_t i = 0; i < matrixStr.size(); i++) - { - c = matrixStr[i]; - if (c == '[' or c == ']' or c == ',') - matrixStrCopy[i] = ' '; - } - - size_t n = 4; // EMX matrix are always 4x4 - std::stringstream ss(matrixStrCopy); - size_t d_1 = dim - 1; - - for (size_t i = 0; i < n; ++i) - for (size_t j = 0; j < n; ++j) - { - //TODO validate that M(dim, dim) is 1 - //if (i == dim-1 && j == dim-1) - - ss >> dMij(matrix, i < dim ? i : i-1, j < dim ? j : j-1); - } - dMij(matrix, d_1, d_1) = 1.; - -} - -template -void transformationMatrix2Parameters2D(const Matrix2D &A, bool &flip, - T &scale, T &shiftX, - T &shiftY, T &psi) -{ - // FIXME DS this might not be true, but just to make sure - static_assert(std::is_floating_point::value, - "Only float and double are allowed as template parameters"); - //Calculate determinant for getting flip - flip = ((dMij(A, 0, 0) * dMij(A, 1, 1) - dMij(A, 0, 1) * dMij(A, 1, 0) ) < 0); - int sgn = flip ? -1 : 1; - T cosine = sgn * dMij(A, 0, 0); - T sine = sgn * dMij(A, 0, 1); - T scale2 = cosine * cosine + sine * sine; - scale = sqrt(scale2); - T invScale = 1 / scale; - shiftX = dMij(A, 0, 2) * invScale; - shiftY = dMij(A, 1, 2) * invScale; - psi = RAD2DEG(atan2(sine, cosine)); -} -template void transformationMatrix2Parameters2D(const Matrix2D &A, bool &flip, float &scale, float &shiftX, float &shiftY, float &psi); -template void transformationMatrix2Parameters2D(const Matrix2D &A, bool &flip, double &scale, double &shiftX, double &shiftY, double &psi); - - -void transformationMatrix2Parameters3D(const Matrix2D &A, bool &flip, - double &scale, double &shiftX, - double &shiftY, double &shiftZ, - double &rot, double &tilt, double &psi) -{ - scale = sqrt(dMij(A,2,0)*dMij(A,2,0) \ - + dMij(A,2,1)*dMij(A,2,1)\ - + dMij(A,2,2)*dMij(A,2,2) ); - double invScale = 1./ scale; - - Matrix2D tmpMatrix(4,4); - M4x4_BY_CT(tmpMatrix, A, invScale); - - Matrix2D eulerMatrix(3,3); - - FOR_ALL_ELEMENTS_IN_MATRIX2D(eulerMatrix) - dMij(eulerMatrix,i,j) = dMij(tmpMatrix, i, j); - //check determinant if -1 then flip = true - flip = tmpMatrix.det3x3() < 0; - if (flip) - { - dMij(eulerMatrix, 0, 0) *= -1.; - dMij(eulerMatrix, 0, 1) *= -1.; - dMij(eulerMatrix, 0, 2) *= -1.; - } - Euler_matrix2angles(eulerMatrix, rot, tilt, psi); - - shiftX = dMij(tmpMatrix,0,3); - shiftY = dMij(tmpMatrix,1,3); - shiftZ = dMij(tmpMatrix,2,3); -} - -#define ADD_IF_EXIST_NONZERO(label, value) if (imageGeo.containsLabel(label) || \ - !XMIPP_EQUAL_ZERO(value))\ - imageGeo.setValue(label, value); -void transformationMatrix2Geo(const Matrix2D &A, MDRow & imageGeo) -{ - bool flip = false; - double scale = 1, shiftX = 0, shiftY = 0, psi = 0, shiftZ = 0, rot = 0, tilt = 0; - - int dim = A.Xdim() - 1; - - if (dim == 2) - transformationMatrix2Parameters2D(A, flip, scale, shiftX, shiftY, psi); - else if (dim == 3) - { - transformationMatrix2Parameters3D(A, flip, scale, shiftX, shiftY, shiftZ, - rot, tilt, psi); - ADD_IF_EXIST_NONZERO(MDL_ANGLE_ROT, rot); - ADD_IF_EXIST_NONZERO(MDL_ANGLE_TILT, tilt); - ADD_IF_EXIST_NONZERO(MDL_SHIFT_Z, shiftZ); - } - - ADD_IF_EXIST_NONZERO(MDL_ANGLE_PSI, psi); - ADD_IF_EXIST_NONZERO(MDL_SHIFT_X, shiftX); - ADD_IF_EXIST_NONZERO(MDL_SHIFT_Y, shiftY); - - if (imageGeo.containsLabel(MDL_SCALE) || !XMIPP_EQUAL_REAL(scale, 1.)) - imageGeo.setValue(MDL_SCALE, scale); - - if (imageGeo.containsLabel(MDL_FLIP) || flip) - imageGeo.setValue(MDL_FLIP, flip); -} - -/* Rotation 2D ------------------------------------------------------------- */ -template -void rotation2DMatrix(T ang, Matrix2D &result, bool homogeneous) -{ - // FIXME DS this might not be true, but just to make sure - static_assert(std::is_floating_point::value, - "Only float and double are allowed as template parameters"); - - T rad = DEG2RAD(ang); - T cosine = cos(rad); - T sine = sin(rad); - - if (homogeneous) - { - result.resizeNoCopy(3,3); // sizes will be tested inside - // now we have 3x3 matrix row wise matrix - result.mdata[0] = cosine; - result.mdata[1] = sine; - result.mdata[2] = 0; - - result.mdata[3] = -sine; - result.mdata[4] = cosine; - result.mdata[5] = 0; - - result.mdata[6] = 0; - result.mdata[7] = 0; - result.mdata[8] = 1; - } else { - result.resizeNoCopy(2,2); // sizes will be tested inside - // now we have 2x2 matrix row wise matrix - result.mdata[0] = cosine; - result.mdata[1] = sine; - - result.mdata[2] = -sine; - result.mdata[3] = cosine; - } -} - -template void rotation2DMatrix(float ang, Matrix2D &result, bool homogeneous); -template void rotation2DMatrix(double ang, Matrix2D &result, bool homogeneous); - - -/* Translation 2D ---------------------------------------------------------- */ -template void translation2DMatrix(const Matrix1D&, Matrix2D&, bool inverse); -template void translation2DMatrix(const Matrix1D&, Matrix2D&, bool inverse); -template -void translation2DMatrix(const Matrix1D &translation, - Matrix2D &resMatrix, - bool inverse) -{ - if (VEC_XSIZE(translation) != 2) - REPORT_ERROR(ERR_MATRIX_SIZE, "Translation2D_matrix: vector is not in R2"); - - resMatrix.initIdentity(3); - if (inverse) - { - dMij(resMatrix,0, 2) = -XX(translation); - dMij(resMatrix,1, 2) = -YY(translation); - } - else - { - dMij(resMatrix,0, 2) = XX(translation); - dMij(resMatrix,1, 2) = YY(translation); - } -} - -/* Rotation 3D around the system axes -------------------------------------- */ -void rotation3DMatrix(double ang, char axis, Matrix2D< double > &result, - bool homogeneous) -{ - if (homogeneous) - { - result.initZeros(4,4); - dMij(result,3, 3) = 1; - } - else - result.initZeros(3,3); - - double cosine, sine; - ang = DEG2RAD(ang); - cosine = cos(ang); - sine = sin(ang); - - switch (axis) - { - case 'Z': - dMij(result,0, 0) = cosine; - dMij(result,0, 1) = sine; - dMij(result,1, 0) = -sine; - dMij(result,1, 1) = cosine; - dMij(result,2, 2) = 1; - break; - case 'Y': - dMij(result,0, 0) = cosine; - dMij(result,0, 2) = sine; - dMij(result,2, 0) = -sine; - dMij(result,2, 2) = cosine; - dMij(result,1, 1) = 1; - break; - case 'X': - dMij(result,1, 1) = cosine; - dMij(result,1, 2) = sine; - dMij(result,2, 1) = -sine; - dMij(result,2, 2) = cosine; - dMij(result,0, 0) = 1; - break; - default: - REPORT_ERROR(ERR_VALUE_INCORRECT, "rotation3DMatrix: Unknown axis"); - } -} - -/* Align a vector with Z axis */ -void alignWithZ(const Matrix1D &axis, Matrix2D& result, - bool homogeneous) -{ - if (axis.size() != 3) - REPORT_ERROR(ERR_MATRIX_SIZE, "alignWithZ: Axis is not in R3"); - if (homogeneous) - { - result.initZeros(4,4); - dMij(result,3, 3) = 1; - } - else - result.initZeros(3,3); - Matrix1D Axis(axis); - Axis.selfNormalize(); - - // Compute length of the projection on YZ plane - double proj_mod = sqrt(YY(Axis) * YY(Axis) + ZZ(Axis) * ZZ(Axis)); - if (proj_mod > XMIPP_EQUAL_ACCURACY) - { // proj_mod!=0 - // Build Matrix result, which makes the turning axis coincident with Z - dMij(result,0, 0) = proj_mod; - dMij(result,0, 1) = -XX(Axis) * YY(Axis) / proj_mod; - dMij(result,0, 2) = -XX(Axis) * ZZ(Axis) / proj_mod; - dMij(result,1, 0) = 0; - dMij(result,1, 1) = ZZ(Axis) / proj_mod; - dMij(result,1, 2) = -YY(Axis) / proj_mod; - dMij(result,2, 0) = XX(Axis); - dMij(result,2, 1) = YY(Axis); - dMij(result,2, 2) = ZZ(Axis); - } - else - { - // I know that the Axis is the X axis, EITHER POSITIVE OR NEGATIVE!! - dMij(result,0, 0) = 0; - dMij(result,0, 1) = 0; - dMij(result,0, 2) = (XX(Axis) > 0)? -1 : 1; - dMij(result,1, 0) = 0; - dMij(result,1, 1) = 1; - dMij(result,1, 2) = 0; - dMij(result,2, 0) = (XX(Axis) > 0)? 1 : -1; - dMij(result,2, 1) = 0; - dMij(result,2, 2) = 0; - } -} - -/* Rotation 3D around any axis -------------------------------------------- */ -void rotation3DMatrix(double ang, const Matrix1D &axis, - Matrix2D &result, bool homogeneous) -{ -#ifdef NEVERDEFINED - // Compute a matrix which makes the turning axis coincident with Z - // And turn around this axis - Matrix2D A, R; - alignWithZ(axis, A, homogeneous); - rotation3DMatrix(ang, 'Z', R, homogeneous); - result = A.transpose() * R * A; -#else - // http://en.wikipedia.org/wiki/Rotation_matrix#Rotation_matrix_from_axis_and_angle - if (homogeneous) - result.initIdentity(4); - else - result.initIdentity(3); - double s,c; - //sincos(-DEG2RAD(ang),&s,&c); - s = sin(-DEG2RAD(ang)); - c = cos(-DEG2RAD(ang)); - double c1=1-c; - double x=XX(axis); - double y=YY(axis); - double z=ZZ(axis); - double xy=x*y; - double xz=x*z; - double yz=y*z; - double x2=x*x; - double y2=y*y; - double z2=z*z; - dMij(result,0,0)=c+x2*c1; - dMij(result,0,1)=xy*c1-z*s; - dMij(result,0,2)=xz*c1+y*s; - dMij(result,1,0)=xy*c1+z*s; - dMij(result,1,1)=c+y2*c1; - dMij(result,1,2)=yz*c1-x*s; - dMij(result,2,0)=xz*c1-y*s; - dMij(result,2,1)=yz*c1+x*s; - dMij(result,2,2)=c+z2*c1; -#endif -} - -/* Translation 3D ---------------------------------------------------------- */ -template void translation3DMatrix(const Matrix1D &translation, Matrix2D &resMatrix, bool inverse); -template void translation3DMatrix(const Matrix1D &translation, Matrix2D &resMatrix, bool inverse); -template -void translation3DMatrix(const Matrix1D &translation, Matrix2D &resMatrix, bool inverse) -{ - if (VEC_XSIZE(translation) != 3) - REPORT_ERROR(ERR_MATRIX_SIZE, "Translation3D_matrix: vector is not in R3"); - - resMatrix.initIdentity(4); - if (inverse) - { - dMij(resMatrix,0, 3) = -XX(translation); - dMij(resMatrix,1, 3) = -YY(translation); - dMij(resMatrix,2, 3) = -ZZ(translation); - } - else - { - dMij(resMatrix,0, 3) = XX(translation); - dMij(resMatrix,1, 3) = YY(translation); - dMij(resMatrix,2, 3) = ZZ(translation); - } -} - -/* Scale 3D ---------------------------------------------------------------- */ -void scale3DMatrix(const Matrix1D &sc, Matrix2D& result, - bool homogeneous) -{ - if (VEC_XSIZE(sc) != 3) - REPORT_ERROR(ERR_MATRIX_SIZE, "Scale3D_matrix: vector is not in R3"); - - if (homogeneous) - { - result.initZeros(4,4); - dMij(result,3, 3) = 1; - } - else - result.initZeros(3,3); - dMij(result,0, 0) = XX(sc); - dMij(result,1, 1) = YY(sc); - dMij(result,2, 2) = ZZ(sc); -} - -#define DELTA_THRESHOLD 10e-7 -bool getLoopRange(double value, double min, double max, double delta, - int loopLimit, int &minIter, int &maxIter) -{ - bool validRange=true;// Return value. TRUE if input value is into range boundaries. - - // Value is under lower boundary. - if (value < min) - { - // If delta is negative -> moving to lower values and never into valid range. - if (delta <= DELTA_THRESHOLD) - { - validRange = false; - } - // Compute first and last iterations into valid values. - else - { - minIter = (int) (fabs(min - value) / delta); - minIter++; - maxIter = (int) (fabs(max - value) / delta); - } - } - // Value is over upper boundary. - else if (value >= max) - { - // If delta is negative -> moving to lower values and never into valid range. - if (delta >= -DELTA_THRESHOLD) - { - validRange = false; - } - // Compute first and last iterations into valid values. - else - { - minIter = (int) (fabs(value - max) / -delta); - minIter++; - maxIter = (int) (fabs(value - min) / -delta); - } - } - // First value into valid range. - else - { - // Compute first and last iterations into valid values. - if (delta > DELTA_THRESHOLD) - { - minIter = 0; - maxIter = (int) (fabs(max - value) / delta); - } - // Compute first and last iterations into valid values. - else if (delta < -DELTA_THRESHOLD) - { - minIter = 0; - maxIter = (int) (fabs(value - min) / -delta); - } - // If delta is zero then always in valid range. - else - { - minIter = 0; - maxIter = loopLimit; - } - } - - return(validRange); -} - -// Special case for complex numbers -template<> -void applyGeometry(int SplineDegree, - MultidimArray< std::complex >& V2, - const MultidimArray< std::complex >& V1, - const Matrix2D< double > &A, bool inv, - bool wrap, std::complex outside, - MultidimArray *BcoeffsPtr) -{ - - if (SplineDegree > 1) - { - MultidimArray re, im, rotre, rotim; - MultidimArray > oneImg; - double outre, outim; - re.resize(ZSIZE(V1), YSIZE(V1), XSIZE(V1)); - im.resize(ZSIZE(V1), YSIZE(V1), XSIZE(V1)); - outre = outside.real(); - outim = outside.imag(); - oneImg=V1; - Complex2RealImag(MULTIDIM_ARRAY(oneImg), - MULTIDIM_ARRAY(re), MULTIDIM_ARRAY(im), - MULTIDIM_SIZE(oneImg)); - applyGeometry(SplineDegree, rotre, re, A, inv, wrap, outre); - applyGeometry(SplineDegree, rotim, im, A, inv, wrap, outim); - V2.resize(oneImg); - RealImag2Complex(MULTIDIM_ARRAY(rotre), MULTIDIM_ARRAY(rotim), - MULTIDIM_ARRAY(V2), MULTIDIM_SIZE(re)); - } - else - { //FIXME I do not think you want to recall your self - REPORT_ERROR(ERR_NOT_IMPLEMENTED,"I do not think you want to recall your self"); - // applyGeometry(SplineDegree, V2, V1, A, inv, wrap, outside); // this was causing crash of the sonarcloud analyzer - } -} - -// Special case for complex numbers -template<> -void selfApplyGeometry(int Splinedegree, - MultidimArray< std::complex > &V1, - const Matrix2D &A, bool inv, - bool wrap, std::complex outside) -{ - MultidimArray > aux = V1; - applyGeometry(Splinedegree, V1, aux, A, inv, wrap, outside); -} - -void applyGeometry(int SplineDegree, - MultidimArrayGeneric &V2, - const MultidimArrayGeneric &V1, - const Matrix2D< double > &A, bool inv, - bool wrap, double outside) -{ -#define APPLYGEO(type) applyGeometry(SplineDegree,(*(MultidimArray*)(V2.im)), \ - (*(MultidimArray*)(V1.im)), A, inv, wrap, (type) outside); - SWITCHDATATYPE(V1.datatype, APPLYGEO) -#undef APPLYGEO - -} - -// Special case for complex arrays -void produceSplineCoefficients(int SplineDegree, - MultidimArray< double > &coeffs, - const MultidimArray< std::complex > &V1) -{ - // TODO Implement - REPORT_ERROR(ERR_NOT_IMPLEMENTED,"Spline coefficients of a complex matrix is not implemented."); -} - - -void selfScaleToSize(int SplineDegree, - MultidimArrayGeneric &V1, - int Xdim, int Ydim, int Zdim) -{ -#define SELFSCALETOSIZE(type) selfScaleToSize(SplineDegree,MULTIDIM_ARRAY_TYPE(V1,type), \ - Xdim,Ydim,Zdim); - SWITCHDATATYPE(V1.datatype,SELFSCALETOSIZE) -#undef SELFSCALETOSIZE -} - -void scaleToSize(int SplineDegree, - MultidimArrayGeneric &V2, const MultidimArrayGeneric &V1, - int Xdim, int Ydim, int Zdim) -{ - if (V1.datatype != V2.datatype) - REPORT_ERROR(ERR_PARAM_INCORRECT, "scaleToSize: MultidimArrayGeneric requires same datatype"); -#define SCALETOSIZE(type) scaleToSize(SplineDegree,MULTIDIM_ARRAY_TYPE(V2,type), \ - MULTIDIM_ARRAY_TYPE(V1,type),Xdim,Ydim,Zdim); - SWITCHDATATYPE(V1.datatype, SCALETOSIZE) -#undef SCALETOSIZE -} - -// Special case for complex arrays -void scaleToSize(int SplineDegree, - MultidimArray< std::complex > &V2, - const MultidimArray< std::complex > &V1, - int Xdim, int Ydim, int Zdim) -{ - if (SplineDegree > 1) - { - MultidimArray< double > re, im, aux; - MultidimArray > oneImg; - - re.resize(ZSIZE(V1), YSIZE(V1), XSIZE(V1)); - im.resize(ZSIZE(V1), YSIZE(V1), XSIZE(V1)); - - oneImg=V1; - Complex2RealImag(MULTIDIM_ARRAY(oneImg), - MULTIDIM_ARRAY(re), MULTIDIM_ARRAY(im), - MULTIDIM_SIZE(oneImg)); - aux = re; - scaleToSize(SplineDegree, re, aux, Ydim, Xdim, Zdim); - aux = im; - scaleToSize(SplineDegree, im, aux, Ydim, Xdim, Zdim); - RealImag2Complex(MULTIDIM_ARRAY(re), MULTIDIM_ARRAY(im), - MULTIDIM_ARRAY(V2), MULTIDIM_SIZE(re)); - } - else - scaleToSize(SplineDegree, V2, V1, Xdim, Ydim, Zdim); - -} - -// Special case for complex arrays -void selfScaleToSize(int SplineDegree, - MultidimArray< std::complex > &V1, - int Xdim, int Ydim, int Zdim) -{ - MultidimArray > aux; - scaleToSize(SplineDegree, V1, aux, Xdim, Ydim, Zdim); -} - -/** Same as template version but for MultidimArrayGeneric */ -void selfPyramidReduce(int SplineDegree, - MultidimArrayGeneric &V1, - int levels) -{ -#define SELFPYRAMIDREDUCE(type) selfPyramidReduce(SplineDegree, \ - *((MultidimArray*)(V1.im)), levels); - SWITCHDATATYPE(V1.datatype,SELFPYRAMIDREDUCE); -#undef SELFPYRAMIDREDUCE -} - -/** Same as previous but for MultidimArrayGeneric */ -void selfPyramidExpand(int SplineDegree, - MultidimArrayGeneric &V1, - int levels) -{ -#define SELFPYRAMIDEXPAND(type) selfPyramidExpand(SplineDegree, \ - *((MultidimArray*)(V1.im)), levels); - SWITCHDATATYPE(V1.datatype,SELFPYRAMIDEXPAND); -#undef SELFPYRAMIDEXPAND -} - -void pyramidExpand(int SplineDegree, - MultidimArrayGeneric &V2, - const MultidimArrayGeneric &V1, - int levels) -{ - if (V1.datatype != V2.datatype) - REPORT_ERROR(ERR_PARAM_INCORRECT, "pyramidExpand: MultidimArrayGeneric requires same datatype"); -#define PYRAMIDEXPAND(type) pyramidExpand(SplineDegree,MULTIDIM_ARRAY_TYPE(V2,type),\ - MULTIDIM_ARRAY_TYPE(V1,type), levels); - SWITCHDATATYPE(V1.datatype, PYRAMIDEXPAND) -#undef PYRAMIDEXPAND -} - -void pyramidReduce(int SplineDegree, - MultidimArrayGeneric &V2, - const MultidimArrayGeneric &V1, - int levels) -{ - if (V1.datatype != V2.datatype) - REPORT_ERROR(ERR_PARAM_INCORRECT, "pyramidReduce: MultidimArrayGeneric requires same datatype"); -#define PYRAMIDREDUCE(type) pyramidReduce(SplineDegree,MULTIDIM_ARRAY_TYPE(V2,type),\ - MULTIDIM_ARRAY_TYPE(V1,type), levels); - SWITCHDATATYPE(V1.datatype, PYRAMIDREDUCE) -#undef PYRAMIDREDUCE -} - -/** Interpolates the value of the 3D matrix M at the point (x,y,z) knowing -* that this image is a set of B-spline coefficients. And making the diff -* of x, such-> V=sum(Coef diff(Bx) By Bz) -* Only for BSplines of degree 3!! -* @ingroup VolumesMemory -* -* (x,y,z) are in logical coordinates. -*/ -double interpolatedElementBSplineDiffX(MultidimArray &vol, - double x, double y, double z, - int SplineDegree) -{ - int SplineDegree_1 = SplineDegree - 1; - double aux; - - // Logical to physical - z -= STARTINGZ(vol); - y -= STARTINGY(vol); - x -= STARTINGX(vol); - - int l1 = CEIL(x - SplineDegree_1); - int l2 = l1 + SplineDegree; - - int m1 = CEIL(y - SplineDegree_1); - int m2 = m1 + SplineDegree; - - int n1 = CEIL(z - SplineDegree_1); - int n2 = n1 + SplineDegree; - - double zyxsum = 0.0; - int Zdim=(int)ZSIZE(vol); - int Ydim=(int)YSIZE(vol); - int Xdim=(int)XSIZE(vol); - for (int n = n1; n <= n2; n++) - { - int equivalent_n=n; - if (n<0) - equivalent_n=-n-1; - else if (n>=Zdim) - equivalent_n=2*Zdim-n-1; - double yxsum = 0.0; - for (int m = m1; m <= m2; m++) - { - int equivalent_m=m; - if (m<0) - equivalent_m=-m-1; - else if (m>=Ydim) - equivalent_m=2*Ydim-m-1; - double xsum = 0.0; - for (int l = l1; l <= l2; l++) - { - double xminusl = x - (double) l; - int equivalent_l=l; - if (l<0) - equivalent_l=-l-1; - else if (l>=Xdim) - equivalent_l=2*Xdim-l-1; - double Coeff = (double) DIRECT_A3D_ELEM(vol, equivalent_n, - equivalent_m, - equivalent_l ); - switch (SplineDegree) - { - case 2: - xsum += Coeff * Bspline02(xminusl); - break; - case 3: - BSPLINE03DIFF1(aux,xminusl); - xsum += Coeff * aux; - break; - case 4: - xsum += Coeff * Bspline04(xminusl); - break; - case 5: - xsum += Coeff * Bspline05(xminusl); - break; - case 6: - xsum += Coeff * Bspline06(xminusl); - break; - case 7: - xsum += Coeff * Bspline07(xminusl); - break; - case 8: - xsum += Coeff * Bspline08(xminusl); - break; - case 9: - xsum += Coeff * Bspline09(xminusl); - break; - } - } - - double yminusm = y - (double) m; - switch (SplineDegree) - { - case 2: - yxsum += xsum * Bspline02(yminusm); - break; - case 3: - BSPLINE03(aux,yminusm); - yxsum += xsum * aux; - break; - case 4: - yxsum += xsum * Bspline04(yminusm); - break; - case 5: - yxsum += xsum * Bspline05(yminusm); - break; - case 6: - yxsum += xsum * Bspline06(yminusm); - break; - case 7: - yxsum += xsum * Bspline07(yminusm); - break; - case 8: - yxsum += xsum * Bspline08(yminusm); - break; - case 9: - yxsum += xsum * Bspline09(yminusm); - break; - } - } - - double zminusn = z - (double) n; - switch (SplineDegree) - { - case 2: - zyxsum += yxsum * Bspline02(zminusn); - break; - case 3: - BSPLINE03(aux,zminusn); - zyxsum += yxsum * aux; - break; - case 4: - zyxsum += yxsum * Bspline04(zminusn); - break; - case 5: - zyxsum += yxsum * Bspline05(zminusn); - break; - case 6: - zyxsum += yxsum * Bspline06(zminusn); - break; - case 7: - zyxsum += yxsum * Bspline07(zminusn); - break; - case 8: - zyxsum += yxsum * Bspline08(zminusn); - break; - case 9: - zyxsum += yxsum * Bspline09(zminusn); - break; - } - } - - return zyxsum; -} - -/** Interpolates the value of the 3D matrix M at the point (x,y,z) knowing - * that this image is a set of B-spline coefficients. And making the diff - * of y, such-> V=sum(Coef Bx diff(By) Bz) - * Only for BSplines of degree 3!! - * @ingroup VolumesMemory - * - * (x,y,z) are in logical coordinates. - */ -double interpolatedElementBSplineDiffY(MultidimArray &vol, - double x, double y, double z, - int SplineDegree) -{ - int SplineDegree_1 = SplineDegree - 1; - double aux; - - // Logical to physical - z -= STARTINGZ(vol); - y -= STARTINGY(vol); - x -= STARTINGX(vol); - - int l1 = CEIL(x - SplineDegree_1); - int l2 = l1 + SplineDegree; - - int m1 = CEIL(y - SplineDegree_1); - int m2 = m1 + SplineDegree; - - int n1 = CEIL(z - SplineDegree_1); - int n2 = n1 + SplineDegree; - - double zyxsum = 0.0; - int Zdim=(int)ZSIZE(vol); - int Ydim=(int)YSIZE(vol); - int Xdim=(int)XSIZE(vol); - for (int n = n1; n <= n2; n++) - { - int equivalent_n=n; - if (n<0) - equivalent_n=-n-1; - else if (n>=Zdim) - equivalent_n=2*Zdim-n-1; - double yxsum = 0.0; - for (int m = m1; m <= m2; m++) - { - int equivalent_m=m; - if (m<0) - equivalent_m=-m-1; - else if (m>=Ydim) - equivalent_m=2*Ydim-m-1; - double xsum = 0.0; - for (int l = l1; l <= l2; l++) - { - double xminusl = x - (double) l; - int equivalent_l=l; - if (l<0) - equivalent_l=-l-1; - else if (l>=Xdim) - equivalent_l=2*Xdim-l-1; - double Coeff = (double) DIRECT_A3D_ELEM(vol, equivalent_n, - equivalent_m, - equivalent_l ); - double aux; - switch (SplineDegree) - { - case 2: - xsum += Coeff * Bspline02(xminusl); - break; - case 3: - BSPLINE03(aux,xminusl); - xsum += Coeff * aux; - break; - case 4: - xsum += Coeff * Bspline04(xminusl); - break; - case 5: - xsum += Coeff * Bspline05(xminusl); - break; - case 6: - xsum += Coeff * Bspline06(xminusl); - break; - case 7: - xsum += Coeff * Bspline07(xminusl); - break; - case 8: - xsum += Coeff * Bspline08(xminusl); - break; - case 9: - xsum += Coeff * Bspline09(xminusl); - break; - } - } - - double yminusm = y - (double) m; - switch (SplineDegree) - { - case 2: - yxsum += xsum * Bspline02(yminusm); - break; - case 3: - BSPLINE03DIFF1(aux,yminusm); - yxsum += xsum * aux; - break; - case 4: - yxsum += xsum * Bspline04(yminusm); - break; - case 5: - yxsum += xsum * Bspline05(yminusm); - break; - case 6: - yxsum += xsum * Bspline06(yminusm); - break; - case 7: - yxsum += xsum * Bspline07(yminusm); - break; - case 8: - yxsum += xsum * Bspline08(yminusm); - break; - case 9: - yxsum += xsum * Bspline09(yminusm); - break; - } - } - - double zminusn = z - (double) n; - switch (SplineDegree) - { - case 2: - zyxsum += yxsum * Bspline02(zminusn); - break; - case 3: - BSPLINE03(aux,zminusn); - zyxsum += yxsum * aux; - break; - case 4: - zyxsum += yxsum * Bspline04(zminusn); - break; - case 5: - zyxsum += yxsum * Bspline05(zminusn); - break; - case 6: - zyxsum += yxsum * Bspline06(zminusn); - break; - case 7: - zyxsum += yxsum * Bspline07(zminusn); - break; - case 8: - zyxsum += yxsum * Bspline08(zminusn); - break; - case 9: - zyxsum += yxsum * Bspline09(zminusn); - break; - } - } - - return zyxsum; -} - -/** Interpolates the value of the 3D matrix M at the point (x,y,z) knowing - * that this image is a set of B-spline coefficients. And making the diff - * of z, such-> V=sum(Coef Bx By diff(Bz)) - * Only for BSplines of degree 3!! - * @ingroup VolumesMemory - * - * (x,y,z) are in logical coordinates. - */ -double interpolatedElementBSplineDiffZ(MultidimArray &vol, - double x, double y, double z, - int SplineDegree) -{ - int SplineDegree_1 = SplineDegree - 1; - double aux; - - // Logical to physical - z -= STARTINGZ(vol); - y -= STARTINGY(vol); - x -= STARTINGX(vol); - - int l1 = CEIL(x - SplineDegree_1); - int l2 = l1 + SplineDegree; - - int m1 = CEIL(y - SplineDegree_1); - int m2 = m1 + SplineDegree; - - int n1 = CEIL(z - SplineDegree_1); - int n2 = n1 + SplineDegree; - - double zyxsum = 0.0; - int Zdim=(int)ZSIZE(vol); - int Ydim=(int)YSIZE(vol); - int Xdim=(int)XSIZE(vol); - for (int n = n1; n <= n2; n++) - { - int equivalent_n=n; - if (n<0) - equivalent_n=-n-1; - else if (n>=Zdim) - equivalent_n=2*Zdim-n-1; - double yxsum = 0.0; - for (int m = m1; m <= m2; m++) - { - int equivalent_m=m; - if (m<0) - equivalent_m=-m-1; - else if (m>=Ydim) - equivalent_m=2*Ydim-m-1; - double xsum = 0.0; - for (int l = l1; l <= l2; l++) - { - double xminusl = x - (double) l; - int equivalent_l=l; - if (l<0) - equivalent_l=-l-1; - else if (l>=Xdim) - equivalent_l=2*Xdim-l-1; - double Coeff = (double) DIRECT_A3D_ELEM(vol, equivalent_n, - equivalent_m, - equivalent_l ); - double aux; - switch (SplineDegree) - { - case 2: - xsum += Coeff * Bspline02(xminusl); - break; - case 3: - BSPLINE03(aux,xminusl); - xsum += Coeff * aux; - break; - case 4: - xsum += Coeff * Bspline04(xminusl); - break; - case 5: - xsum += Coeff * Bspline05(xminusl); - break; - case 6: - xsum += Coeff * Bspline06(xminusl); - break; - case 7: - xsum += Coeff * Bspline07(xminusl); - break; - case 8: - xsum += Coeff * Bspline08(xminusl); - break; - case 9: - xsum += Coeff * Bspline09(xminusl); - break; - } - } - - double yminusm = y - (double) m; - switch (SplineDegree) - { - case 2: - yxsum += xsum * Bspline02(yminusm); - break; - case 3: - BSPLINE03(aux,yminusm); - yxsum += xsum * aux; - break; - case 4: - yxsum += xsum * Bspline04(yminusm); - break; - case 5: - yxsum += xsum * Bspline05(yminusm); - break; - case 6: - yxsum += xsum * Bspline06(yminusm); - break; - case 7: - yxsum += xsum * Bspline07(yminusm); - break; - case 8: - yxsum += xsum * Bspline08(yminusm); - break; - case 9: - yxsum += xsum * Bspline09(yminusm); - break; - } - } - - double zminusn = z - (double) n; - switch (SplineDegree) - { - case 2: - zyxsum += yxsum * Bspline02(zminusn); - break; - case 3: - BSPLINE03DIFF1(aux,zminusn); - zyxsum += yxsum * aux; - break; - case 4: - zyxsum += yxsum * Bspline04(zminusn); - break; - case 5: - zyxsum += yxsum * Bspline05(zminusn); - break; - case 6: - zyxsum += yxsum * Bspline06(zminusn); - break; - case 7: - zyxsum += yxsum * Bspline07(zminusn); - break; - case 8: - zyxsum += yxsum * Bspline08(zminusn); - break; - case 9: - zyxsum += yxsum * Bspline09(zminusn); - break; - } - } - - return zyxsum; -} - -void radiallySymmetrize(const MultidimArray& img, - MultidimArray &radialImg) -{ - Matrix1D center(2); - center.initZeros(); - MultidimArray distance, radial_count; - MultidimArray radial_mean; - int dim; - radialAveragePrecomputeDistance(img, center, distance, dim); - fastRadialAverage(img, distance, dim, radial_mean, radial_count); - - radialImg.initZeros(img); - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY(radialImg) - { - int d=DIRECT_MULTIDIM_ELEM(distance,n); - DIRECT_MULTIDIM_ELEM(radialImg,n)=A1D_ELEM(radial_mean,d); - } -} - - -void rotation3DMatrixFromIcoOrientations(const char* icoFrom, const char* icoTo, - Matrix2D &R) -{ - std::vector symLabel; - symLabel.push_back((int)icoFrom[1]); - symLabel.push_back((int)icoTo[1]); - Matrix1D xyz(3); - Matrix2D Rfrom, Rto; - - for(int i=0; i<2; i++) - { - switch (symLabel[i]) - { - case '1': - xyz = vectorR3(0.0, 90.0, 0.0); - break; - case '2': - xyz = vectorR3(0.0, 0.0, 0.0); - break; - case '3': - xyz = vectorR3(0.0, 31.7175, 0.0); - break; - case '4': - xyz = vectorR3(0.0, -31.7175, 0.0); - break; -/* case '5': - xyz = vectorR3(31.7175, 90.0, 0.0); // not aviable yet - break; - case '6': - xyz = vectorR3(-31.7175, 90.0, 0.0); // not aviable yet - break;*/ - default: - REPORT_ERROR(ERR_PARAM_INCORRECT, "Incorrect standard icosahedral orientation"); - } - if (i==0) - Euler_angles2matrix(XX(xyz), YY(xyz), ZZ(xyz), Rfrom, true); - else - Euler_angles2matrix(XX(xyz), YY(xyz), ZZ(xyz), Rto, true); - } - R = Rto * Rfrom.transpose(); -} - -template -void radialAverageNonCubic(const MultidimArray< T >& m, - Matrix1D< int >& center_of_rot, - MultidimArray< T >& radial_mean, - MultidimArray< int >& radial_count, - bool rounding) -{ - Matrix1D< double > idx(3); - - size_t sizemax = std::max({XSIZE(m), YSIZE(m), ZSIZE(m)}); - double scalex = double(XSIZE(m)/sizemax); - double scaley = double(YSIZE(m)/sizemax); - double scalez = double(ZSIZE(m)/sizemax); - - // If center_of_rot was written for 2D image - if (center_of_rot.size() < 3) - center_of_rot.resize(3); - - // First determine the maximum distance that one should expect, to set the - // dimension of the radial average vector - MultidimArray< int > distances(8); - - const double z0 = STARTINGZ(m) - ZZ(center_of_rot); - const double y0 = STARTINGY(m) - YY(center_of_rot); - const double x0 = STARTINGX(m) - XX(center_of_rot); - - const double xf = FINISHINGX(m) - XX(center_of_rot); - const double yf = FINISHINGY(m) - YY(center_of_rot); - const double zf = FINISHINGZ(m) - ZZ(center_of_rot); - - distances(0) = (int) floor(sqrt(x0 * x0 + y0 * y0 + z0 * z0)); - distances(1) = (int) floor(sqrt(xf * xf + y0 * y0 + z0 * z0)); - distances(2) = (int) floor(sqrt(xf * xf + yf * yf + z0 * z0)); - distances(3) = (int) floor(sqrt(x0 * x0 + yf * yf + z0 * z0)); - distances(4) = (int) floor(sqrt(x0 * x0 + yf * yf + zf * zf)); - distances(5) = (int) floor(sqrt(xf * xf + yf * yf + zf * zf)); - distances(6) = (int) floor(sqrt(xf * xf + y0 * y0 + zf * zf)); - distances(7) = (int) floor(sqrt(x0 * x0 + y0 * y0 + zf * zf)); - - int dim = CEIL(distances.computeMax()) + 1; - if (rounding) - dim++; - - // Define the vectors - radial_mean.initZeros(dim); - radial_count.initZeros(dim); - - // Perform the radial sum and count pixels that contribute to every - // distance - FOR_ALL_ELEMENTS_IN_ARRAY3D(m) - { - ZZ(idx) = scalez * (k - ZZ(center_of_rot)); - YY(idx) = scaley * (i - YY(center_of_rot)); - XX(idx) = scalex * (j - XX(center_of_rot)); - - // Determine distance to the center - double mod = sqrt(ZZ(idx)*ZZ(idx)+YY(idx)*YY(idx)+XX(idx)*XX(idx)); - int distance = rounding ? (int) round(mod) : (int) floor(mod); - - // Sum the value to the pixels with the same distance - DIRECT_MULTIDIM_ELEM(radial_mean,distance) += A3D_ELEM(m, k, i, j); - - // Count the pixel - DIRECT_MULTIDIM_ELEM(radial_count,distance)++; - } - - // Perform the mean - FOR_ALL_DIRECT_ELEMENTS_IN_ARRAY1D(radial_mean) - if (DIRECT_MULTIDIM_ELEM(radial_count,i) > 0) - DIRECT_MULTIDIM_ELEM(radial_mean,i) /= DIRECT_MULTIDIM_ELEM(radial_count,i); -} - - -template void reduceBSpline(int, MultidimArray&, MultidimArray const&); -template void expandBSpline(int, MultidimArray&, const MultidimArray &); - -template void produceImageFromSplineCoefficients(int, MultidimArray&, MultidimArray const&); -template void produceSplineCoefficients(int, MultidimArray&, MultidimArray const&); -template void produceSplineCoefficients(int, MultidimArray&, MultidimArray const&); -template void produceSplineCoefficients(int, MultidimArray&, MultidimArray const&); -template void produceSplineCoefficients(int, MultidimArray&, MultidimArray const&); -template void produceSplineCoefficients(int, MultidimArray&, MultidimArray const&); -template void produceSplineCoefficients(int, MultidimArray&, MultidimArray const&); -template void produceSplineCoefficients(int, MultidimArray&, MultidimArray const&); -template void produceSplineCoefficients(int, MultidimArray&, MultidimArray const&); -template void produceSplineCoefficients(int, MultidimArray&, MultidimArray const&); -template void produceSplineCoefficients(int, MultidimArray&, MultidimArray const&); -template void produceSplineCoefficients(int, MultidimArray&, MultidimArray const&); -template void produceSplineCoefficients(int, MultidimArray&, MultidimArray const&); - -template void radialAverageNonCubic(const MultidimArray& m, Matrix1D< int >& center_of_rot, MultidimArray& radial_mean, MultidimArray< int >& radial_count, bool rounding); - diff --git a/src/core/transformations.h b/src/core/transformations.h deleted file mode 100644 index 4ff4fcc..0000000 --- a/src/core/transformations.h +++ /dev/null @@ -1,1952 +0,0 @@ -/*************************************************************************** - * - * Authors: Carlos Oscar S. Sorzano (coss@cnb.csic.es) - * Sjors H.W. Scheres - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_TRANSFORMATIONS_H -#define CORE_TRANSFORMATIONS_H - -#include "matrix2d.h" -#include "multidim_array.h" -#include "multidim_array_generic.h" -#include "transformations_defines.h" - - -class MDRow; - -/// @defgroup GeometricalTransformations Geometrical transformations -/// @ingroup DataLibrary -//@{ -/** Get geometric transformation matrix from image geometry - * Now this info is stored in metadata - * The order is: first flip (if necessary), then rotate, then shift - * A=Translation*Rotation*(Mirror) - */ -void geo2TransformationMatrix(const MDRow &imageHeader, Matrix2D &A, - bool only_apply_shifts = false); - -bool getLoopRange( double value, double min, double max, double delta, int loopLimit, int &minIter, int &maxIter); - -/** Retrieve the matrix from an string representation - * Valid formats are: - * [[1, 0, 0, 0], [0, 1, 0, 0], [0, 0, 1, 0], [0, 0, 0, 1]] - * or - * 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1 - * or - * 1 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1 - */ -void string2TransformationMatrix(const String &matrixStr, Matrix2D &matrix, size_t dim=4); - -/** Retrieve the geometry transformations from matrix for 2D. */ -template -void transformationMatrix2Parameters2D(const Matrix2D &A, bool &flip, - T &scale, T &shiftX, T &shiftY, - T &psi); - -/** Retrieve the geometry transformations from matrix for D. */ -void transformationMatrix2Parameters3D(const Matrix2D &A, bool &flip, - double &scale, double &shiftX, double &shiftY, - double &shiftZ, double &rot, double &tilt, double &psi); - -/** Retrieve the geometry transfomations from matrix - */ -void transformationMatrix2Geo(const Matrix2D &A, MDRow & imageGeo); - -/** Creates a rotational matrix (3x3) for images - * @ingroup GeometricalTransformations - * - * The rotation angle is in degrees. - * m must have been already resized to 3x3 - * - * @code - * rotation2DMatrix(60,m); - * @endcode - */ -template -void rotation2DMatrix(T ang, Matrix2D &m, bool homogeneous=true); - -/** Creates a translational matrix (3x3) for images - * @ingroup GeometricalTransformations - * - * The shift is given as a R2 vector (shift_X, shift_Y). An exception is thrown - * if the displacement is not a R2 vector. - * - * @code - * // Displacement of 1 pixel to the right - * resMatrix = translation2DMatrix(vectorR2(1, 0)); - * @endcode - */ -template -void translation2DMatrix(const Matrix1D &translation, Matrix2D &resMatrix, bool inverse=false); - -/** Creates a rotational matrix (4x4) for volumes around system axis - * @ingroup GeometricalTransformations - * - * The rotation angle is in degrees, and the rotational axis is either 'X', 'Y' - * or 'Z'. An exception is thrown if the axis given is not one of these. - * - * The returned matrices are respectively alpha degrees around Z - * - * @code - * [ cos(A) -sin(A) 0 ] - * [ sin(A) cos(A) 0 ] - * [ 0 0 1 ] - * @endcode - * - * alpha degrees around Y - * @code - * [ cos(A) 0 -sin(A) ] - * [ 0 1 0 ] - * [ sin(A) 0 cos(A) ] - * @endcode - * - * alpha degrees around X - * @code - * [ 1 0 0 ] - * [ 0 cos(A) -sin(A) ] - * [ 0 sin(A) cos(A) ] - * @endcode - * - * @code - * m = rotation3DMatrix(60, 'X'); - * @endcode - */ -void rotation3DMatrix(double ang, char axis, Matrix2D< double > &m, - bool homogeneous=true); - -/** Creates a rotational matrix (4x4) for volumes around any axis - * @ingroup GeometricalTransformations - * - * The rotation angle is in degrees, and the rotational axis is given as a R3 - * vector. An exception is thrown if the axis is not a R3 vector. The axis needs - * not to be unitary. - * - * @code - * m = rotation3DMatrix(60, vectorR3(1, 1, 1)); - * @endcode - */ -void rotation3DMatrix(double ang, const Matrix1D< double >& axis, Matrix2D< double > &m, - bool homogeneous=true); - -/** Matrix which transforms the given axis into Z - * @ingroup GeometricalTransformations - * - * A geometrical transformation matrix (4x4) is returned such that the given - * axis is rotated until it is aligned with the Z axis. This is very useful in - * order to produce rotational matrices, for instance, around any axis. - * - * @code - * Matrix2D< double > A = alignWithZ(axis); - * return A.transpose() * rotation3DMatrix(ang, 'Z') * A; - * @endcode - * - * The returned matrix is such that A*axis=Z, where Z and axis are column - * vectors. - */ -void alignWithZ(const Matrix1D< double >& axis, Matrix2D< double > &m, bool homogeneous=true); - -/** Creates a translational matrix (4x4) for volumes - * @ingroup GeometricalTransformations - * - * The shift is given as a R3 vector (shift_X, shift_Y, shift_Z). An exception - * is thrown if the displacement is not a R3 vector. - * - * @code - * // Displacement of 2 pixels down - * resMatrix = translation3DMatrix(vectorR3(0, 0, 2)); - * @endcode - */ -template -void translation3DMatrix(const Matrix1D &translation, Matrix2D &resMatrix, bool inverse=false); - -/** Creates a scaling matrix (4x4) for volumes - * @ingroup GeometricalTransformations - * - * The scaling factors for the different axis must be given as a vector. So - * that, XX(sc)=scale for X axis, YY(sc)=... - */ -void scale3DMatrix(const Matrix1D< double >& sc, Matrix2D< double > &m, - bool homogeneous=true); - -/** Creates a rotation matrix (R) to change the orientation from - * one standard orientation (icoFrom) to another one (icoTo) - */ -void rotation3DMatrixFromIcoOrientations(const char* icoFrom, const char* icoTo, Matrix2D &R); - -namespace applyGeometryImpl { - -template -void applyGeometry2DDegree1( - MultidimArray& __restrict__ V2, - const MultidimArray& __restrict__ V1, - const Matrix2D &Aref) -{ - // 2D transformation - const double Aref00=MAT_ELEM(Aref,0,0); - const double Aref10=MAT_ELEM(Aref,1,0); - - // Find center and limits of image - const double cen_y = (int)(YSIZE(V2) / 2); - const double cen_x = (int)(XSIZE(V2) / 2); - const double cen_yp = (int)(YSIZE(V1) / 2); - const double cen_xp = (int)(XSIZE(V1) / 2); - const double minxp = -cen_xp; - const double minyp = -cen_yp; - const double minxpp = minxp-XMIPP_EQUAL_ACCURACY; - const double minypp = minyp-XMIPP_EQUAL_ACCURACY; - const double maxxp = XSIZE(V1) - cen_xp - 1; - const double maxyp = YSIZE(V1) - cen_yp - 1; - const double maxxpp = maxxp+XMIPP_EQUAL_ACCURACY; - const double maxypp = maxyp+XMIPP_EQUAL_ACCURACY; - const int Xdim = XSIZE(V1); - const int Ydim = YSIZE(V1); - - // Now we go from the output image to the input image, ie, for any pixel - // in the output image we calculate which are the corresponding ones in - // the original image, make an interpolation with them and put this value - // at the output pixel - -#ifdef DEBUG_APPLYGEO - std::cout << "A\n" << Aref << std::endl - << "(cen_x ,cen_y )=(" << cen_x << "," << cen_y << ")\n" - << "(cen_xp,cen_yp)=(" << cen_xp << "," << cen_yp << ")\n" - << "(min_xp,min_yp)=(" << minxp << "," << minyp << ")\n" - << "(max_xp,max_yp)=(" << maxxp << "," << maxyp << ")\n"; -#endif - // Calculate position of the beginning of the row in the output image - const double x = -cen_x; - double y = -cen_y; - for (size_t i = 0; i < YSIZE(V2); i++) - { - // Calculate this position in the input image according to the - // geometrical transformation - // they are related by - // coords_output(=x,y) = A * coords_input (=xp,yp) - double xp = x * MAT_ELEM(Aref, 0, 0) + y * MAT_ELEM(Aref, 0, 1) + MAT_ELEM(Aref, 0, 2); - double yp = x * MAT_ELEM(Aref, 1, 0) + y * MAT_ELEM(Aref, 1, 1) + MAT_ELEM(Aref, 1, 2); - - // Loop over j is splitted according to wrap (wrap==true is not - // vectorizable) and also according to SplineDegree value - // (I have not fully analyzed vector dependences for - // SplineDegree==3 and else branch) - if (wrap) - { - // This is original implementation - for (int j=0; j A(4,4); - * A.initIdentity; - * applyGeometry(V2, A, V1); - * @endcode - */ -template -void applyGeometry(int SplineDegree, - MultidimArray& __restrict__ V2, - const MultidimArray& __restrict__ V1, - const Matrix2D< T2 > &At, bool inv, - bool wrap, T outside = T(0), MultidimArray *BcoeffsPtr=NULL) -{ -#ifndef RELEASE_MODE - if (&V1 == (MultidimArray*)&V2) - REPORT_ERROR(ERR_VALUE_INCORRECT,"ApplyGeometry: Input array cannot be the same as output array"); - - if ( V1.getDim()==2 && ((MAT_XSIZE(At) != 3) || (MAT_YSIZE(At) != 3)) ) - REPORT_ERROR(ERR_MATRIX_SIZE,"ApplyGeometry: 2D transformation matrix is not 3x3"); - - if ( V1.getDim()==3 && ((MAT_XSIZE(At) != 4) || (MAT_YSIZE(At) != 4)) ) - REPORT_ERROR(ERR_MATRIX_SIZE,"ApplyGeometry: 3D transformation matrix is not 4x4"); -#endif - - if (At.isIdentity() && ( XSIZE(V2) == 0 || SAME_SHAPE3D(V1,V2) ) ) - { - typeCast(V1,V2); - return; - } - - if (XSIZE(V1) == 0) - { - V2.clear(); - return; - } - - MultidimArray Bcoeffs; - MultidimArray *BcoeffsToUse=NULL; - Matrix2D A, Ainv; - typeCast(At, A); - const Matrix2D * Aptr=&A; - if (!inv) - { - Ainv = A.inv(); - Aptr=&Ainv; - } - const Matrix2D &Aref=*Aptr; - - // For scalings the output matrix is resized outside to the final - // size instead of being resized inside the routine with the - // same size as the input matrix - if (XSIZE(V2) == 0) - V2.resizeNoCopy(V1); - - if (outside != 0.) - { - // Initialize output matrix with value=outside - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY(V2) - DIRECT_MULTIDIM_ELEM(V2, n) = outside; - } - else - V2.initZeros(); - - if (V1.getDim() == 2) - { - // this version should be slightly more optimized than the general one bellow - if (1 == SplineDegree) { - if (wrap) { - applyGeometryImpl::applyGeometry2DDegree1(V2, V1, Aref); - } else { - applyGeometryImpl::applyGeometry2DDegree1(V2, V1, Aref); - } - return; - } - - // 2D transformation - double Aref00=MAT_ELEM(Aref,0,0); - double Aref10=MAT_ELEM(Aref,1,0); - - // Find center and limits of image - double cen_y = (int)(YSIZE(V2) / 2); - double cen_x = (int)(XSIZE(V2) / 2); - double cen_yp = (int)(YSIZE(V1) / 2); - double cen_xp = (int)(XSIZE(V1) / 2); - double minxp = -cen_xp; - double minyp = -cen_yp; - double minxpp = minxp-XMIPP_EQUAL_ACCURACY; - double minypp = minyp-XMIPP_EQUAL_ACCURACY; - double maxxp = XSIZE(V1) - cen_xp - 1; - double maxyp = YSIZE(V1) - cen_yp - 1; - double maxxpp = maxxp+XMIPP_EQUAL_ACCURACY; - double maxypp = maxyp+XMIPP_EQUAL_ACCURACY; - size_t Xdim = XSIZE(V1); - size_t Ydim = YSIZE(V1); - - if (SplineDegree > 1) - { - // Build the B-spline coefficients - if (BcoeffsPtr!=NULL) - BcoeffsToUse=BcoeffsPtr; - else - { - produceSplineCoefficients(SplineDegree, Bcoeffs, V1); //Bcoeffs is a single image - BcoeffsToUse = &Bcoeffs; - } - STARTINGX(*BcoeffsToUse) = (int) minxp; - STARTINGY(*BcoeffsToUse) = (int) minyp; - } - - // Now we go from the output image to the input image, ie, for any pixel - // in the output image we calculate which are the corresponding ones in - // the original image, make an interpolation with them and put this value - // at the output pixel - -#ifdef DEBUG_APPLYGEO - std::cout << "A\n" << Aref << std::endl - << "(cen_x ,cen_y )=(" << cen_x << "," << cen_y << ")\n" - << "(cen_xp,cen_yp)=(" << cen_xp << "," << cen_yp << ")\n" - << "(min_xp,min_yp)=(" << minxp << "," << minyp << ")\n" - << "(max_xp,max_yp)=(" << maxxp << "," << maxyp << ")\n"; -#endif - // Calculate position of the beginning of the row in the output image - double x = -cen_x; - double y = -cen_y; - for (size_t i = 0; i < YSIZE(V2); i++) - { - // Calculate this position in the input image according to the - // geometrical transformation - // they are related by - // coords_output(=x,y) = A * coords_input (=xp,yp) - double xp = x * MAT_ELEM(Aref, 0, 0) + y * MAT_ELEM(Aref, 0, 1) + MAT_ELEM(Aref, 0, 2); - double yp = x * MAT_ELEM(Aref, 1, 0) + y * MAT_ELEM(Aref, 1, 1) + MAT_ELEM(Aref, 1, 2); - - // Inner loop boundaries. - int globalMin=0, globalMax=XSIZE(V2); - - if (!wrap) - { - // First and last iteration with valid values for x and y coordinates. - int minX, maxX, minY, maxY; - - // Compute valid iterations in x and y coordinates. If one of them is always out - // of boundaries then the inner loop is not executed this iteration. - if (!getLoopRange( xp, minxpp, maxxpp, Aref00, XSIZE(V2), minX, maxX) || - !getLoopRange( yp, minypp, maxypp, Aref10, XSIZE(V2), minY, maxY)) - { - y++; - continue; - } - else - { - // Compute initial iteration. - globalMin = minX; - if (minX < minY) - { - globalMin = minY; - } - - // Compute last iteration. - globalMax = maxX; - if (maxX > maxY) - { - globalMax = maxY; - } - globalMax++; - - // Check max iteration is not higher than image. - if ((globalMax >= 0) && ((size_t)globalMax > XSIZE(V2))) - { - globalMax = XSIZE(V2); - } - - xp += globalMin*Aref00; - yp += globalMin*Aref10; - } - } - - // Loop over j is splitted according to wrap (wrap==true is not - // vectorizable) and also according to SplineDegree value - // (I have not fully analyzed vector dependences for - // SplineDegree==3 and else branch) - if (wrap) - { - // This is original implementation - for (int j=globalMin; j 1) - { - // Build the B-spline coefficients - if (BcoeffsPtr!=NULL) - BcoeffsToUse=BcoeffsPtr; - else - { - produceSplineCoefficients(SplineDegree, Bcoeffs, V1); //Bcoeffs is a single image - BcoeffsToUse = &Bcoeffs; - } - STARTINGX(*BcoeffsToUse) = (int) minxp; - STARTINGY(*BcoeffsToUse) = (int) minyp; - STARTINGZ(*BcoeffsToUse) = (int) minzp; - } - - // Now we go from the output MultidimArray to the input MultidimArray, ie, for any - // voxel in the output MultidimArray we calculate which are the corresponding - // ones in the original MultidimArray, make an interpolation with them and put - // this value at the output voxel - - // V2 is not initialised to 0 because all its pixels are rewritten - for (size_t k = 0; k < V2.zdim; k++) - for (size_t i = 0; i < V2.ydim; i++) - { - // Calculate position of the beginning of the row in the output - // MultidimArray - x = -cen_x; - y = i - cen_y; - z = k - cen_z; - - // Calculate this position in the input image according to the - // geometrical transformation they are related by - // coords_output(=x,y) = A * coords_input (=xp,yp) - xp = x * MAT_ELEM(Aref, 0, 0) + y * MAT_ELEM(Aref, 0, 1) + z * MAT_ELEM(Aref, 0, 2) + MAT_ELEM(Aref, 0, 3); - yp = x * MAT_ELEM(Aref, 1, 0) + y * MAT_ELEM(Aref, 1, 1) + z * MAT_ELEM(Aref, 1, 2) + MAT_ELEM(Aref, 1, 3); - zp = x * MAT_ELEM(Aref, 2, 0) + y * MAT_ELEM(Aref, 2, 1) + z * MAT_ELEM(Aref, 2, 2) + MAT_ELEM(Aref, 2, 3); - - for (size_t j = 0; j < V2.xdim; j++) - { - bool interp; - double tmp; - -#ifdef DEBUG - - bool show_debug = false; - if ((i == 0 && j == 0 && k == 0) || - (i == V2.ydim - 1 && j == V2.xdim - 1 && k == V2.zdim - 1)) - show_debug = true; - - if (show_debug) - std::cout << "(x,y,z)-->(xp,yp,zp)= " - << "(" << x << "," << y << "," << z << ") " - << "(" << xp << "," << yp << "," << zp << ")\n"; -#endif - - // If the point is outside the volume, apply a periodic - // extension of the volume, what exits by one side enters by - // the other - interp = true; - bool x_isOut = XMIPP_RANGE_OUTSIDE(xp, minxp, maxxp); - bool y_isOut = XMIPP_RANGE_OUTSIDE(yp, minyp, maxyp); - bool z_isOut = XMIPP_RANGE_OUTSIDE(zp, minzp, maxzp); - - if (wrap) - { - if (x_isOut) - xp = realWRAP(xp, minxp - 0.5, maxxp + 0.5); - - if (y_isOut) - yp = realWRAP(yp, minyp - 0.5, maxyp + 0.5); - - if (z_isOut) - zp = realWRAP(zp, minzp - 0.5, maxzp + 0.5); - } - else if (x_isOut || y_isOut || z_isOut) - interp = false; - - if (interp) - { - if (SplineDegree == 1) - { - // Linear interpolation - - // Calculate the integer position in input volume, be - // careful that it is not the nearest but the one at the - // top left corner of the interpolation square. Ie, - // (0.7,0.7) would give (0,0) - // Calculate also weights for point m1+1,n1+1 - wx = xp + cen_xp; - m1 = (int) wx; - wx = wx - m1; - m2 = m1 + 1; - wy = yp + cen_yp; - n1 = (int) wy; - wy = wy - n1; - n2 = n1 + 1; - wz = zp + cen_zp; - o1 = (int) wz; - wz = wz - o1; - o2 = o1 + 1; - -#ifdef DEBUG - - if (show_debug) - { - std::cout << "After wrapping(xp,yp,zp)= " - << "(" << xp << "," << yp << "," << zp << ")\n"; - std::cout << "(m1,n1,o1)-->(m2,n2,o2)=" - << "(" << m1 << "," << n1 << "," << o1 << ") " - << "(" << m2 << "," << n2 << "," << o2 << ")\n"; - std::cout << "(wx,wy,wz)=" - << "(" << wx << "," << wy << "," << wz << ")\n"; - } -#endif - - // Perform interpolation - // if wx == 0 means that the rightest point is useless for - // this interpolation, and even it might not be defined if - // m1=xdim-1 - // The same can be said for wy. - double wx_1=1-wx; - double wy_1=1-wy; - double wz_1=1-wz; - - double aux1=wz_1 * wy_1; - double aux2=aux1*wx_1; - tmp = aux2 * DIRECT_A3D_ELEM(V1, o1, n1, m1); - - if (wx != 0 && m2 < V1.xdim) - tmp += (aux1-aux2)* DIRECT_A3D_ELEM(V1, o1, n1, m2); - - if (wy != 0 && n2 < V1.ydim) - { - aux1=wz_1 * wy; - aux2=aux1*wx_1; - tmp += aux2 * DIRECT_A3D_ELEM(V1, o1, n2, m1); - if (wx != 0 && m2 < V1.xdim) - tmp += (aux1-aux2) * DIRECT_A3D_ELEM(V1, o1, n2, m2); - } - - if (wz != 0 && o2 < V1.zdim) - { - aux1=wz * wy_1; - aux2=aux1*wx_1; - tmp += aux2 * DIRECT_A3D_ELEM(V1, o2, n1, m1); - if (wx != 0 && m2 < V1.xdim) - tmp += (aux1-aux2) * DIRECT_A3D_ELEM(V1, o2, n1, m2); - if (wy != 0 && n2 < V1.ydim) - { - aux1=wz * wy; - aux2=aux1*wx_1; - tmp += aux2 * DIRECT_A3D_ELEM(V1, o2, n2, m1); - if (wx != 0 && m2 < V1.xdim) - tmp += (aux1-aux2) * DIRECT_A3D_ELEM(V1, o2, n2, m2); - } - } - -#ifdef DEBUG - if (show_debug) - std::cout << - "tmp1=" << DIRECT_A3D_ELEM(V1, o1, n1, m1) << " " - << (T)(wz_1 *wy_1 *wx_1 * DIRECT_A3D_ELEM(V1, o1, n1, m1)) - << std::endl << - "tmp2=" << DIRECT_A3D_ELEM(V1, o1, n1, m2) << " " - << (T)(wz_1 *wy_1 * wx * DIRECT_A3D_ELEM(V1, o1, n1, m2)) - << std::endl << - "tmp3=" << DIRECT_A3D_ELEM(V1, o1, n2, m1) << " " - << (T)(wz_1 * wy *wx_1 * DIRECT_A3D_ELEM(V1, o1, n2, m1)) - << std::endl << - "tmp4=" << DIRECT_A3D_ELEM(V1, o1, n2, m2) << " " - << (T)(wz_1 * wy * wx * DIRECT_A3D_ELEM(V1, o2, n1, m1)) - << std::endl << - "tmp6=" << DIRECT_A3D_ELEM(V1, o2, n1, m2) << " " - << (T)(wz * wy_1 * wx * DIRECT_A3D_ELEM(V1, o2, n1, m2)) - << std::endl << - "tmp7=" << DIRECT_A3D_ELEM(V1, o2, n2, m1) << " " - << (T)(wz * wy *wx_1 * DIRECT_A3D_ELEM(V1, o2, n2, m1)) - << std::endl << - "tmp8=" << DIRECT_A3D_ELEM(V1, o2, n2, m2) << " " - << (T)(wz * wy * wx * DIRECT_A3D_ELEM(V1, o2, n2, m2)) - << std::endl << - "tmp= " << tmp << std::endl; -#endif - - dAkij(V2 , k, i, j) = (T)tmp; - } - else if (SplineDegree==0) - { - dAkij(V2, k, i, j)=(T)A3D_ELEM(V1,(int)trunc(zp),(int)trunc(yp),(int)trunc(xp)); - } - else - { - // B-spline interpolation - dAkij(V2, k, i, j) = - (T) BcoeffsToUse->interpolatedElementBSpline3D(xp, yp, zp, SplineDegree); - } - } - else - dAkij(V2, k, i, j) = outside; - - // Compute new point inside input image - xp += Aref00; - yp += Aref10; - zp += Aref20; - } - } - } -} - -// Special case for input MultidimArrayGeneric -template -void applyGeometry(int SplineDegree, - MultidimArray& V2, - const MultidimArrayGeneric& V1, - const Matrix2D< double > &A, bool inv, - bool wrap, T outside = 0) -{ -#define APPLYGEO(type) applyGeometry(SplineDegree,V2, (*(MultidimArray*)(V1.im)), A, inv, wrap, outside); - SWITCHDATATYPE(V1.datatype, APPLYGEO) -#undef APPLYGEO -} - - - -/** Applies a geometrical transformation and overwrites the input matrix. - * @ingroup GeometricalTransformations - * - * The same as the previous function, but input array is overwritten - */ -template -void selfApplyGeometry(int SplineDegree, - MultidimArray& V1, - const Matrix2D< double > &A, bool inv, - bool wrap, T outside = 0) -{ - MultidimArray aux = V1; - V1.initZeros(); - applyGeometry(SplineDegree, V1, aux, A, inv, wrap, outside); -} - -//Special cases for complex arrays -template<> -void applyGeometry(int SplineDegree, - MultidimArray< std::complex >& V2, - const MultidimArray< std::complex >& V1, - const Matrix2D< double > &A, bool inv, - bool wrap, std::complex outside, MultidimArray *BcoeffsPtr); - -//Special cases for complex arrays -template<> -void selfApplyGeometry(int SplineDegree, - MultidimArray< std::complex >& V1, - const Matrix2D< double > &A, bool inv, - bool wrap, std::complex outside); - -// Special cases for MultidimArrayGeneric -void applyGeometry(int SplineDegree, - MultidimArrayGeneric &V2, - const MultidimArrayGeneric &V1, - const Matrix2D< double > &A, bool inv, - bool wrap, double outside); - - -/** Produce spline coefficients. - * @ingroup GeometricalTransformations - * - * Create a single image with spline coefficients for the nth image - * - */ -template -void produceSplineCoefficients(int SplineDegree, - MultidimArray< double > &coeffs, - const MultidimArray< T > &V1); - -// Special case for complex arrays -void produceSplineCoefficients(int SplineDegree, - MultidimArray< double > &coeffs, - const MultidimArray< std::complex > &V1); - -/** Produce image from B-spline coefficients. - * @ingroup GeometricalTransformations - * Note that the coeffs and img are only single images! - */ -template -void produceImageFromSplineCoefficients(int SplineDegree, - MultidimArray< T >& img, - const MultidimArray< double > &coeffs); - -/** Rotate an array around a given system axis. - * @ingroup GeometricalTransformations - * - * The rotation angle is in degrees, and the rotational axis is either - * 'X', 'Y' or 'Z' for 3D arrays and only 'Z' for 2D arrays. An - * exception is thrown if the axis given is not one of these. - * - * @code - * V2 = V1.rotate(60); - * @endcode - */ -template -void rotate(int SplineDegree, - MultidimArray& V2, - const MultidimArray& V1, - double ang, char axis = 'Z', - bool wrap = xmipp_transformation::DONT_WRAP, T outside = 0) -{ - Matrix2D< double > tmp; - if (V1.getDim()==2) - { - rotation2DMatrix(ang,tmp); - } - else if (V1.getDim()==3) - { - rotation3DMatrix(ang, axis, tmp); - } - else - REPORT_ERROR(ERR_MULTIDIM_DIM,"rotate ERROR: rotate only valid for 2D or 3D arrays"); - - applyGeometry(SplineDegree, V2, V1, tmp, xmipp_transformation::IS_NOT_INV, wrap, outside); -} - -/** Rotate an array around a given system axis. - * @ingroup GeometricalTransformations - * - * The same as the previous function, but input array is overwritten - */ -template -void selfRotate(int SplineDegree, - MultidimArray& V1, - double ang, char axis = 'Z', - bool wrap = xmipp_transformation::DONT_WRAP, T outside = 0) -{ - MultidimArray aux = V1; - V1.initZeros(); - rotate(SplineDegree, V1, aux, ang, axis, wrap, outside); -} - -/** Translate a array. - * @ingroup GeometricalTransformations - * - * The shift is given as a R2 or R3 vector (shift_X, shift_Y, shift_Z) for 2D and 3D arrays, respectively. - * An exception is thrown if the displacement is not a R3 vector. - * - * @code - * // Displacement of 2 pixels down - * V2 = V1.translate(vectorR3(0, 0, 2)); - * @endcode - */ -template -void translate(int SplineDegree, - MultidimArray &V2, - const MultidimArray &V1, - const Matrix1D< double >& v, - bool wrap = xmipp_transformation::WRAP, T outside = 0) -{ - Matrix2D< double > tmp; - if (V1.getDim()==2) - translation2DMatrix(v, tmp,true); - else if (V1.getDim()==3) - translation3DMatrix(v, tmp,true); - else - REPORT_ERROR(ERR_MULTIDIM_DIM,"translate ERROR: translate only valid for 2D or 3D arrays"); - applyGeometry(SplineDegree, V2, V1, tmp, xmipp_transformation::IS_INV, wrap, outside); -} - -/** Translate an array. - * @ingroup GeometricalTransformations - * - * The same as the previous function, but input array is overwritten - */ -template -void selfTranslate(int SplineDegree, - MultidimArray& V1, - const Matrix1D< double >& v, - bool wrap = xmipp_transformation::WRAP, T outside = 0) -{ - MultidimArray aux = V1; - V1.initZeros(); - translate(SplineDegree, V1, aux, v, wrap, outside); -} - -/** Translate center of mass to center - * @ingroup GeometricalTransformations - * - * If the input has very high values, it is better to rescale it to be - * between 0 and 1. - */ -template -void translateCenterOfMassToCenter(int SplineDegree, - MultidimArray &V2, - const MultidimArray &V1, - bool wrap = xmipp_transformation::WRAP) -{ - V2 = V1; - V2.setXmippOrigin(); - Matrix1D< double > center; - V2.centerOfMass(center); - center *= -1; - translate(SplineDegree, V2, V1, center, wrap, 0); -} - -/** Translate center of mass to center - * @ingroup GeometricalTransformations - * - * The same as the previous function, but input array is overwritten - */ -template -void selfTranslateCenterOfMassToCenter(int SplineDegree, - MultidimArray &V1, - bool wrap = xmipp_transformation::WRAP) -{ - MultidimArray aux = V1; - V1.initZeros(); - translateCenterOfMassToCenter(SplineDegree, V1, aux, wrap); -} - -/** Scales to a new size. - * @ingroup GeometricalTransformations - * - * The volume is scaled (resampled) to fill a new size. It is not the - * same as "selfWindow" in this same class. The size can be larger or smaller - * than the actual one. - * - * @code - * V2 = V1.scaleToSize(128, 128, 128); - * @endcode - */ -template -void scaleToSize(int SplineDegree, - MultidimArray &V2, - const MultidimArray &V1, - size_t Xdim, size_t Ydim, size_t Zdim = 1) -{ - if (Xdim == XSIZE(V1) && Ydim == YSIZE(V1) && \ - (!(V1.getDim()==3) || (Zdim == ZSIZE(V1))) ) - { - typeCast(V1,V2); - return; - } - - Matrix2D< double > tmp; - if (V1.getDim()==2) - { - tmp.initIdentity(3); - tmp(0, 0) = (double) Xdim / (double) XSIZE(V1); - tmp(1, 1) = (double) Ydim / (double) YSIZE(V1); - V2.initZeros(1, 1, Ydim, Xdim); - } - else if (V1.getDim()==3) - { - tmp.initIdentity(4); - tmp(0, 0) = (double) Xdim / (double) XSIZE(V1); - tmp(1, 1) = (double) Ydim / (double) YSIZE(V1); - tmp(2, 2) = (double) Zdim / (double) ZSIZE(V1); - V2.initZeros(1, Zdim, Ydim, Xdim); - } - else - REPORT_ERROR(ERR_MULTIDIM_DIM,"scaleToSize ERROR: scaleToSize only valid for 2D or 3D arrays"); - - V2.setXmippOrigin(); - applyGeometry(SplineDegree, V2, V1, tmp, xmipp_transformation::IS_NOT_INV, xmipp_transformation::WRAP, (T)0); -} - -/** Scales to a new size. - * @ingroup GeometricalTransformations - * - * The volume is scaled (resampled) to fill a new size. - * Same as previous, but in this case the input is a MultidimArrayGeneric. - * - * @code - * scaleToSize(VolumeOut, VolumeGenericInput, 128, 128, 128); - * @endcode - */ -template -inline void scaleToSize(int SplineDegree, - MultidimArray &V2, - const MultidimArrayGeneric &V1,int Xdim, int Ydim, int Zdim = 1) -{ -#define SCALETOSIZE(type) scaleToSize(SplineDegree,V2,*((MultidimArray*)(V1.im)),Xdim,Ydim,Zdim); - SWITCHDATATYPE(V1.datatype,SCALETOSIZE) -#undef SCALETOSIZE -} - -/** Scales to a new size. - * @ingroup GeometricalTransformations - * - * The volume is scaled (resampled) to fill a new size. - * Same as previous, but in this case the input is a MultidimArrayGeneric. - * - * @code - * scaleToSize(VolumeOut, VolumeGenericInput, 128, 128, 128); - * @endcode - */ -template -inline void scaleToSize(int SplineDegree, - MultidimArrayGeneric &V2, - const MultidimArray &V1,int Xdim, int Ydim, int Zdim = 1) -{ -#define SCALETOSIZE(type) scaleToSize(SplineDegree,MULTIDIM_ARRAY_TYPE(V2,type),V1,Xdim,Ydim,Zdim); - SWITCHDATATYPE(V1.datatype,SCALETOSIZE) -#undef SCALETOSIZE -} - -/** Scales to a new size. - * @ingroup GeometricalTransformations - * - * The volume is scaled (resampled) to fill a new size. - * Same as previous, but in this case the input is a MultidimArrayGeneric. - * - * @code - * scaleToSize(VolumeOut, VolumeGenericInput, 128, 128, 128); - * @endcode - */ -void scaleToSize(int SplineDegree, - MultidimArrayGeneric &V2, - const MultidimArrayGeneric &V1,int Xdim, int Ydim, int Zdim = 1); - -/** Scales to a new size. - * @ingroup GeometricalTransformations - * - * The same as the previous function, but input array is overwritten - */ -template -void selfScaleToSize(int SplineDegree, - MultidimArray &V1, - int Xdim, int Ydim, int Zdim = 1) -{ - MultidimArray aux = V1; - scaleToSize(SplineDegree, V1, aux, Xdim, Ydim, Zdim); -} - -void selfScaleToSize(int SplineDegree, - MultidimArrayGeneric &V1, - int Xdim, int Ydim, int Zdim = 1); - - -// Special case for complex arrays -void scaleToSize(int SplineDegree, - MultidimArray< std::complex > &V2, - const MultidimArray< std::complex > &V1, - int Xdim, int Ydim, int Zdim = 1); - -// Special case for complex arrays -void selfScaleToSize(int SplineDegree, - MultidimArray< std::complex > &V1, - int Xdim, int Ydim, int Zdim = 1); - - -/** Reduce a set of B-spline coefficients. - * @ingroup GeometricalTransformations - * - * Knowing that V1 is a (single image of) B-spline coefficients, produce the - * reduced set of B-spline coefficients using the two-scale relationship. - */ -template -void reduceBSpline(int SplineDegree, - MultidimArray< double >& V2, - const MultidimArray &V1); - -/** Expand a set of B-spline coefficients. - * @ingroup GeometricalTransformations - * - * Knowing that V1 is a (single image of) B-spline coefficients, produce the - * expanded set of B-spline coefficients using the two-scale relationship. - */ -template -void expandBSpline(int SplineDegree, - MultidimArray< double >& V2, - const MultidimArray &V1); - -/** Reduce the nth volume by 2 using a BSpline pyramid. - * @ingroup GeometricalTransformations - */ -template -void pyramidReduce(int SplineDegree, - MultidimArray &V2, - const MultidimArray &V1, - int levels = 1) -{ - MultidimArray< double > coeffs, coeffs2; - - produceSplineCoefficients(SplineDegree, coeffs, V1); - - for (int i = 0; i < levels; i++) - { - reduceBSpline(SplineDegree, coeffs2, coeffs); - coeffs = coeffs2; - } - - produceImageFromSplineCoefficients(SplineDegree, V2, coeffs); -} - -/** Reduce the nth volume by 2 using a BSpline pyramid. - * @ingroup GeometricalTransformations - * - * The same as the previous function, but input array is overwritten - */ -template -void selfPyramidReduce(int SplineDegree, - MultidimArray &V1, - int levels = 1) -{ - MultidimArray aux = V1; - V1.initZeros(); - pyramidReduce(SplineDegree, V1, aux, levels); -} - -/** Same as previous but for MultidimArrayGeneric */ -void selfPyramidReduce(int SplineDegree, - MultidimArrayGeneric &V1, - int levels = 1); - - -/** Expand the nth volume by 2 using a BSpline pyramid. - * @ingroup GeometricalTransformations - */ -template -void pyramidExpand(int SplineDegree, - MultidimArray &V2, - const MultidimArray &V1, - int levels = 1) -{ - MultidimArray< double > coeffs, coeffs2; - - produceSplineCoefficients(SplineDegree, coeffs, V1); - - for (int i = 0; i < levels; i++) - { - expandBSpline(SplineDegree, coeffs2, coeffs); - coeffs = coeffs2; - } - - produceImageFromSplineCoefficients(SplineDegree, V2, coeffs); - -} - -void pyramidExpand(int SplineDegree, - MultidimArrayGeneric &V2, - const MultidimArrayGeneric &V1, - int levels = 1); - -void pyramidReduce(int SplineDegree, - MultidimArrayGeneric &V2, - const MultidimArrayGeneric &V1, - int levels = 1); - -/** Expand the nth volume by 2 using a BSpline pyramid. - * @ingroup GeometricalTransformations - * - * The same as the previous function, but input array is overwritten - */ -template -void selfPyramidExpand(int SplineDegree, - MultidimArray &V1, - int levels = 1) -{ - MultidimArray aux = V1; - V1.initZeros(); - pyramidExpand(SplineDegree, V1, aux, levels); -} - -/** Same as previous but for MultidimArrayGeneric */ -void selfPyramidExpand(int SplineDegree, - MultidimArrayGeneric &V1, - int levels = 1); - - -/** Does a radial average of a 2D/3D image, around the voxel where is the origin. - * @ingroup GeometricalTransformations - * - * A vector radial_mean is returned where: - * - the first element is the mean of the voxels whose - * distance to the origin is (0-1), - * - the second element is the mean of the voxels - * whose distance to the origin is (1-2) - * - and so on. - * - * A second vector radial_count is returned containing the number of voxels - * over which each radial average was calculated. - * - * Sjors nov2003: if rounding=true, element=round(distance); - * - so the first element is the mean of the voxels whose distance to the - * origin is (0.5-1.5), - * - the second element is the mean of the voxels whose distance to the origin - * is (1.5-2.5) - * - and so on. - */ -template -void radialAverage(const MultidimArray< T >& m, - Matrix1D< int >& center_of_rot, - MultidimArray< T >& radial_mean, - MultidimArray< int >& radial_count, - const bool& rounding = false) -{ - Matrix1D< double > idx(3); - - // If center_of_rot was written for 2D image - if (center_of_rot.size() < 3) - center_of_rot.resize(3); - - // First determine the maximum distance that one should expect, to set the - // dimension of the radial average vector - MultidimArray< int > distances(8); - - double z = STARTINGZ(m) - ZZ(center_of_rot); - double y = STARTINGY(m) - YY(center_of_rot); - double x = STARTINGX(m) - XX(center_of_rot); - - distances(0) = (int) floor(sqrt(x * x + y * y + z * z)); - x = FINISHINGX(m) - XX(center_of_rot); - - distances(1) = (int) floor(sqrt(x * x + y * y + z * z)); - y = FINISHINGY(m) - YY(center_of_rot); - - distances(2) = (int) floor(sqrt(x * x + y * y + z * z)); - x = STARTINGX(m) - XX(center_of_rot); - - distances(3) = (int) floor(sqrt(x * x + y * y + z * z)); - z = FINISHINGZ(m) - ZZ(center_of_rot); - - distances(4) = (int) floor(sqrt(x * x + y * y + z * z)); - x = FINISHINGX(m) - XX(center_of_rot); - - distances(5) = (int) floor(sqrt(x * x + y * y + z * z)); - y = STARTINGY(m) - YY(center_of_rot); - - distances(6) = (int) floor(sqrt(x * x + y * y + z * z)); - x = STARTINGX(m) - XX(center_of_rot); - - distances(7) = (int) floor(sqrt(x * x + y * y + z * z)); - - int dim = (int) CEIL(distances.computeMax()) + 1; - if (rounding) - dim++; - - // Define the vectors - radial_mean.initZeros(dim); - radial_count.initZeros(dim); - - // Perform the radial sum and count pixels that contribute to every - // distance - FOR_ALL_ELEMENTS_IN_ARRAY3D(m) - { - ZZ(idx) = k - ZZ(center_of_rot); - YY(idx) = i - YY(center_of_rot); - XX(idx) = j - XX(center_of_rot); - - // Determine distance to the center - ; - double module = sqrt(ZZ(idx)*ZZ(idx)+YY(idx)*YY(idx)+XX(idx)*XX(idx)); - int distance = (rounding) ? (int) round(module) : (int) floor(module); - - // Sum the value to the pixels with the same distance - DIRECT_MULTIDIM_ELEM(radial_mean,distance) += A3D_ELEM(m, k, i, j); - - // Count the pixel - DIRECT_MULTIDIM_ELEM(radial_count,distance)++; - } - - // Perform the mean - FOR_ALL_DIRECT_ELEMENTS_IN_ARRAY1D(radial_mean) - if (DIRECT_MULTIDIM_ELEM(radial_count,i) > 0) - DIRECT_MULTIDIM_ELEM(radial_mean,i) /= DIRECT_MULTIDIM_ELEM(radial_count,i); -} - -template -void radialAveragePrecomputeDistance(const MultidimArray< T >& m, - Matrix1D< int >& center_of_rot, - MultidimArray< int >& distance, - int &dim, - const bool& rounding = false) -{ - Matrix1D< double > idx(3); - - // If center_of_rot was written for 2D image - if (center_of_rot.size() < 3) - center_of_rot.resize(3); - - // First determine the maximum distance that one should expect, to set the - // dimension of the radial average vector - MultidimArray< int > distances(8); - - double z = STARTINGZ(m) - ZZ(center_of_rot); - double y = STARTINGY(m) - YY(center_of_rot); - double x = STARTINGX(m) - XX(center_of_rot); - - distances(0) = (int) floor(sqrt(x * x + y * y + z * z)); - x = FINISHINGX(m) - XX(center_of_rot); - - distances(1) = (int) floor(sqrt(x * x + y * y + z * z)); - y = FINISHINGY(m) - YY(center_of_rot); - - distances(2) = (int) floor(sqrt(x * x + y * y + z * z)); - x = STARTINGX(m) - XX(center_of_rot); - - distances(3) = (int) floor(sqrt(x * x + y * y + z * z)); - z = FINISHINGZ(m) - ZZ(center_of_rot); - - distances(4) = (int) floor(sqrt(x * x + y * y + z * z)); - x = FINISHINGX(m) - XX(center_of_rot); - - distances(5) = (int) floor(sqrt(x * x + y * y + z * z)); - y = STARTINGY(m) - YY(center_of_rot); - - distances(6) = (int) floor(sqrt(x * x + y * y + z * z)); - x = STARTINGX(m) - XX(center_of_rot); - - distances(7) = (int) floor(sqrt(x * x + y * y + z * z)); - - dim = (int) CEIL(distances.computeMax()) + 1; - if (rounding) - dim++; - - // Perform the radial sum and count pixels that contribute to every - // distance - distance.initZeros(m); - FOR_ALL_ELEMENTS_IN_ARRAY3D(m) - { - ZZ(idx) = k - ZZ(center_of_rot); - YY(idx) = i - YY(center_of_rot); - XX(idx) = j - XX(center_of_rot); - - // Determine distance to the center - if (rounding) - A3D_ELEM(distance,k,i,j) = (int) round(idx.module()); - else - A3D_ELEM(distance,k,i,j) = (int) floor(idx.module()); - } -} - -template -void fastRadialAverage(const MultidimArray< T >& m, - const MultidimArray< int >& distance, - int dim, - MultidimArray< T >& radial_mean, - MultidimArray< int >& radial_count) -{ - // Define the vectors - radial_mean.initZeros(dim); - radial_count.initZeros(dim); - - // Perform the radial sum and count pixels that contribute to every - // distance - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY(m) - { - int d=DIRECT_MULTIDIM_ELEM(distance,n); - A1D_ELEM(radial_mean,d) += DIRECT_MULTIDIM_ELEM(m,n); - ++A1D_ELEM(radial_count,d); - } - - // Perform the mean - FOR_ALL_DIRECT_ELEMENTS_IN_ARRAY1D(radial_mean) - if (DIRECT_MULTIDIM_ELEM(radial_count,i) > 0) - DIRECT_MULTIDIM_ELEM(radial_mean,i) /= DIRECT_MULTIDIM_ELEM(radial_count,i); -} - -template -void radialAverageAxis(const MultidimArray< T >& in, char axis, MultidimArray< double >& out) -{ - MultidimArray inCentered; - inCentered.alias(in); - inCentered.setXmippOrigin(); - if (axis=='z') - { - out.initZeros(ZSIZE(in),XSIZE(in)); - out.setXmippOrigin(); - for (int i=STARTINGY(inCentered); i<=FINISHINGY(inCentered); ++i) - { - double z=i; - for (int j=0; j -void radialAverageNonCubic(const MultidimArray< T >& m, - Matrix1D< int >& center_of_rot, - MultidimArray< T >& radial_mean, - MultidimArray< int >& radial_count, - bool rounding = false); - -void radiallySymmetrize(const MultidimArray< double >& img, MultidimArray &radialImg); - -/** Interpolates the value of the 3D matrix M at the point (x,y,z) knowing -* that this image is a set of B-spline coefficients. And making the diff -* of x, such-> V=sum(Coef diff(Bx) By Bz) -* Only for BSplines of degree 3!! -* @ingroup GeometricalTransformations -* -* (x,y,z) are in logical coordinates. -*/ -double interpolatedElementBSplineDiffX(MultidimArray &vol, double x, double y, double z, - int SplineDegree = 3); - -/** Interpolates the value of the 3D matrix M at the point (x,y,z) knowing - * that this image is a set of B-spline coefficients. And making the diff - * of y, such-> V=sum(Coef Bx diff(By) Bz) - * Only for BSplines of degree 3!! - * @ingroup GeometricalTransformations - * - * (x,y,z) are in logical coordinates. - */ -double interpolatedElementBSplineDiffY(MultidimArray &vol, double x, double y, double z, - int SplineDegree = 3); -/** Interpolates the value of the 3D matrix M at the point (x,y,z) knowing - * that this image is a set of B-spline coefficients. And making the diff - * of z, such-> V=sum(Coef Bx By diff(Bz)) - * Only for BSplines of degree 3!! - * @ingroup GeometricalTransformations - * - * (x,y,z) are in logical coordinates. - */ -double interpolatedElementBSplineDiffZ(MultidimArray &vol, double x, double y, double z, - int SplineDegree = 3); -//@} -#endif diff --git a/src/core/transformations_defines.h b/src/core/transformations_defines.h deleted file mode 100644 index 6e9c280..0000000 --- a/src/core/transformations_defines.h +++ /dev/null @@ -1,43 +0,0 @@ -/*************************************************************************** - * - * Authors: David Strelak (davidstrelak@gmail.com) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef XMIPPCORE_CORE_TRANSFORMATIONS_DEFINES_H_ -#define XMIPPCORE_CORE_TRANSFORMATIONS_DEFINES_H_ - - -namespace xmipp_transformation -{ - enum XmippInterpolation {NEAREST=0, LINEAR=1, BSPLINE2=2, BSPLINE3=3, BSPLINE4=4}; // Interpolation type - static const bool IS_INV=true; - static const bool IS_NOT_INV=false; - static const bool DONT_WRAP=false; - static const bool WRAP=true; -} - -#ifndef DBL_EPSILON -#define DBL_EPSILON 1e-50 -#endif - -#endif /* XMIPPCORE_CORE_TRANSFORMATIONS_DEFINES_H_ */ diff --git a/src/core/userSettings.cpp b/src/core/userSettings.cpp deleted file mode 100644 index da12332..0000000 --- a/src/core/userSettings.cpp +++ /dev/null @@ -1,64 +0,0 @@ -/*************************************************************************** - * - * Authors: David Strelak (davidstrelak@gmail.com) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include "userSettings.h" -#include - -std::list UserSettings::storages; - -bool UserSettings::store() { - std::ofstream output(path); - if (output) { - for (const auto& rec : data) { - output << rec.first << delim << rec.second << "\n"; - } - output.close(); - return true; - } - - std::cerr<<"Error opening output file "<< path << std::endl; - return false; -} - -bool UserSettings::reload() { - std::ifstream file(path); - std::string line; - - if (!file) { - std::cerr<<"File "<< path << " does NOT exist yet or cannot be read." - << std::endl; - return false; - } - while (std::getline(file, line)) - { - std::stringstream ss(line); - std::string key, value; - std::getline(ss, key, delim); - std::getline(ss, value); - data[key] = value; - } - file.close(); - return true; -} diff --git a/src/core/userSettings.h b/src/core/userSettings.h deleted file mode 100644 index 9c959ec..0000000 --- a/src/core/userSettings.h +++ /dev/null @@ -1,178 +0,0 @@ -/*************************************************************************** - * - * Authors: David Strelak (davidstrelak@gmail.com) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -/** - * This class is able to store/read user settings. - * Use it to permanently store some data/setting. - */ - -#ifndef USERSETTINGS_H_ -#define USERSETTINGS_H_ - -#include -#include -#include -#include -#include -#include -#include -#include -#include - -class UserSettings { -public: - /** - * Returns the only instance of this class - */ - static UserSettings& get(const std::string &path = std::string()) { - static std::mutex mtx; - auto res = find_if(storages.begin(), storages.end(), - [&path](const UserSettings& obj) - {return obj.identifier.compare(path) == 0;}); - if (storages.end() == res) { - // it seems that we don't have such a storage yet - mtx.lock(); - // make sure that nobody did it meanwhile - res = find_if(storages.begin(), storages.end(), - [&path](const UserSettings& obj) - {return obj.identifier.compare(path) == 0;}); - if (storages.end() == res) { - storages.emplace_front(UserSettings(path)); - res = storages.begin(); - } - mtx.unlock(); - } - // now we have to have it - return *res; - } - - /** - * Save data to HDD - */ - bool store(); - - /** - * Reload data from HDD. All changes will be discarded - */ - bool reload(); - - /** - * Insert new / update existing key-value pair. - * Value will be converted to std::string using std::stringstream and - * operator <<. - * @param obj storing the key - * @param key to use - * @param value to store - * @returns false if identical key-value pair already existed, true otherwise - */ - template - bool insert(const T &obj, const std::string &key, const U &value) { - auto fullKey = getFullName(obj, key); - auto result = data.find(fullKey); - std::stringstream ss; - ss << value; - std::string valStr = ss.str(); - bool newRec = result == data.end(); - bool update = !newRec && (valStr.compare(result->second) != 0); - - if (newRec || update) { - data[fullKey] = valStr; - wasChanged = true; - return true; - } - return false; - } - - /** - * Finds value using key. - * @param obj making query - * @param key to search up - * @param value to be set (if the record exists) - * @returns true if record with the key exists, false otherwise - */ - template - bool find(const T &obj, const std::string &key, U &value) { - auto result = data.find(getFullName(obj, key)); - if (result != data.end()) { - std::stringstream ss (result->second); - ss >> value; - return true; - } else { - return false; - } - } - - UserSettings(UserSettings&&) = default; // Move construct - - /** Destructor, stores the data on change */ - ~UserSettings() { if (wasChanged) store(); }; - -protected: - /** Constructor, loads the data from HDD */ - UserSettings(const std::string &path = std::string()) : wasChanged(false), - identifier(path), path(path) { - if (path.empty()) { - this->path = std::string(getenv("HOME")) + "/.xmipp.settings"; - } - reload(); - }; - - /** - * Generate full key name using the caller - * @param obj of the caller - * @param key to use - */ - template - const std::string getFullName(const T &obj, const std::string &key) { - std::stringstream ss; - ss << typeid(obj).name() << key; - return ss.str(); - } - -private: - // delete copy and move constructors and assign operators - UserSettings(UserSettings const&) = delete; // Copy construct - UserSettings& operator=(UserSettings const&) = delete; // Copy assign - UserSettings& operator=(UserSettings &&) = delete; // Move assign - - /** Actual records */ - std::map data; - - /** If true, content of the records changed since last load */ - bool wasChanged; - - /** Delimiter used while storing data on HDD */ - char delim = '\t'; - - /** Path to the file where data are stored */ - std::string path; - - /** Unique identifier of the instance */ - std::string identifier; - - static std::list storages; -}; - -#endif /* USERSETTINGS_H_ */ diff --git a/src/core/utils/half.hpp b/src/core/utils/half.hpp deleted file mode 100644 index 8fedb44..0000000 --- a/src/core/utils/half.hpp +++ /dev/null @@ -1,3261 +0,0 @@ -// half - IEEE 754-based half-precision floating-point library. -// -// Copyright (c) 2012-2021 Christian Rau -// -// Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation -// files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, -// modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the -// Software is furnished to do so, subject to the following conditions: -// -// The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. -// -// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE -// WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR -// COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, -// ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. - -// Version 2.2.0 - - -#ifndef HALF_HALF_HPP -#define HALF_HALF_HPP - -#define HALF_GCC_VERSION (__GNUC__*100+__GNUC_MINOR__) - -#if defined(__INTEL_COMPILER) - #define HALF_ICC_VERSION __INTEL_COMPILER -#elif defined(__ICC) - #define HALF_ICC_VERSION __ICC -#elif defined(__ICL) - #define HALF_ICC_VERSION __ICL -#else - #define HALF_ICC_VERSION 0 -#endif - -// check C++11 language features -#if defined(__clang__) // clang - #if __has_feature(cxx_static_assert) && !defined(HALF_ENABLE_CPP11_STATIC_ASSERT) - #define HALF_ENABLE_CPP11_STATIC_ASSERT 1 - #endif - #if __has_feature(cxx_constexpr) && !defined(HALF_ENABLE_CPP11_CONSTEXPR) - #define HALF_ENABLE_CPP11_CONSTEXPR 1 - #endif - #if __has_feature(cxx_noexcept) && !defined(HALF_ENABLE_CPP11_NOEXCEPT) - #define HALF_ENABLE_CPP11_NOEXCEPT 1 - #endif - #if __has_feature(cxx_user_literals) && !defined(HALF_ENABLE_CPP11_USER_LITERALS) - #define HALF_ENABLE_CPP11_USER_LITERALS 1 - #endif - #if __has_feature(cxx_thread_local) && !defined(HALF_ENABLE_CPP11_THREAD_LOCAL) - #define HALF_ENABLE_CPP11_THREAD_LOCAL 1 - #endif - #if (defined(__GXX_EXPERIMENTAL_CXX0X__) || __cplusplus >= 201103L) && !defined(HALF_ENABLE_CPP11_LONG_LONG) - #define HALF_ENABLE_CPP11_LONG_LONG 1 - #endif -#elif HALF_ICC_VERSION && defined(__INTEL_CXX11_MODE__) // Intel C++ - #if HALF_ICC_VERSION >= 1500 && !defined(HALF_ENABLE_CPP11_THREAD_LOCAL) - #define HALF_ENABLE_CPP11_THREAD_LOCAL 1 - #endif - #if HALF_ICC_VERSION >= 1500 && !defined(HALF_ENABLE_CPP11_USER_LITERALS) - #define HALF_ENABLE_CPP11_USER_LITERALS 1 - #endif - #if HALF_ICC_VERSION >= 1400 && !defined(HALF_ENABLE_CPP11_CONSTEXPR) - #define HALF_ENABLE_CPP11_CONSTEXPR 1 - #endif - #if HALF_ICC_VERSION >= 1400 && !defined(HALF_ENABLE_CPP11_NOEXCEPT) - #define HALF_ENABLE_CPP11_NOEXCEPT 1 - #endif - #if HALF_ICC_VERSION >= 1110 && !defined(HALF_ENABLE_CPP11_STATIC_ASSERT) - #define HALF_ENABLE_CPP11_STATIC_ASSERT 1 - #endif - #if HALF_ICC_VERSION >= 1110 && !defined(HALF_ENABLE_CPP11_LONG_LONG) - #define HALF_ENABLE_CPP11_LONG_LONG 1 - #endif -#elif defined(__GNUC__) // gcc - #if defined(__GXX_EXPERIMENTAL_CXX0X__) || __cplusplus >= 201103L - #if HALF_GCC_VERSION >= 408 && !defined(HALF_ENABLE_CPP11_THREAD_LOCAL) - #define HALF_ENABLE_CPP11_THREAD_LOCAL 1 - #endif - #if HALF_GCC_VERSION >= 407 && !defined(HALF_ENABLE_CPP11_USER_LITERALS) - #define HALF_ENABLE_CPP11_USER_LITERALS 1 - #endif - #if HALF_GCC_VERSION >= 406 && !defined(HALF_ENABLE_CPP11_CONSTEXPR) - #define HALF_ENABLE_CPP11_CONSTEXPR 1 - #endif - #if HALF_GCC_VERSION >= 406 && !defined(HALF_ENABLE_CPP11_NOEXCEPT) - #define HALF_ENABLE_CPP11_NOEXCEPT 1 - #endif - #if HALF_GCC_VERSION >= 403 && !defined(HALF_ENABLE_CPP11_STATIC_ASSERT) - #define HALF_ENABLE_CPP11_STATIC_ASSERT 1 - #endif - #if !defined(HALF_ENABLE_CPP11_LONG_LONG) - #define HALF_ENABLE_CPP11_LONG_LONG 1 - #endif - #endif - #define HALF_TWOS_COMPLEMENT_INT 1 -#elif defined(_MSC_VER) // Visual C++ - #if _MSC_VER >= 1900 && !defined(HALF_ENABLE_CPP11_THREAD_LOCAL) - #define HALF_ENABLE_CPP11_THREAD_LOCAL 1 - #endif - #if _MSC_VER >= 1900 && !defined(HALF_ENABLE_CPP11_USER_LITERALS) - #define HALF_ENABLE_CPP11_USER_LITERALS 1 - #endif - #if _MSC_VER >= 1900 && !defined(HALF_ENABLE_CPP11_CONSTEXPR) - #define HALF_ENABLE_CPP11_CONSTEXPR 1 - #endif - #if _MSC_VER >= 1900 && !defined(HALF_ENABLE_CPP11_NOEXCEPT) - #define HALF_ENABLE_CPP11_NOEXCEPT 1 - #endif - #if _MSC_VER >= 1600 && !defined(HALF_ENABLE_CPP11_STATIC_ASSERT) - #define HALF_ENABLE_CPP11_STATIC_ASSERT 1 - #endif - #if _MSC_VER >= 1310 && !defined(HALF_ENABLE_CPP11_LONG_LONG) - #define HALF_ENABLE_CPP11_LONG_LONG 1 - #endif - #define HALF_TWOS_COMPLEMENT_INT 1 - #define HALF_POP_WARNINGS 1 - #pragma warning(push) - #pragma warning(disable : 4099 4127 4146) //struct vs class, constant in if, negative unsigned -#endif - -// check C++11 library features -#include -#if defined(_LIBCPP_VERSION) // libc++ - #if defined(__GXX_EXPERIMENTAL_CXX0X__) || __cplusplus >= 201103 - #ifndef HALF_ENABLE_CPP11_TYPE_TRAITS - #define HALF_ENABLE_CPP11_TYPE_TRAITS 1 - #endif - #ifndef HALF_ENABLE_CPP11_CSTDINT - #define HALF_ENABLE_CPP11_CSTDINT 1 - #endif - #ifndef HALF_ENABLE_CPP11_CMATH - #define HALF_ENABLE_CPP11_CMATH 1 - #endif - #ifndef HALF_ENABLE_CPP11_HASH - #define HALF_ENABLE_CPP11_HASH 1 - #endif - #ifndef HALF_ENABLE_CPP11_CFENV - #define HALF_ENABLE_CPP11_CFENV 1 - #endif - #endif -#elif defined(__GLIBCXX__) // libstdc++ - #if defined(__GXX_EXPERIMENTAL_CXX0X__) || __cplusplus >= 201103 - #ifdef __clang__ - #if __GLIBCXX__ >= 20080606 && !defined(HALF_ENABLE_CPP11_TYPE_TRAITS) - #define HALF_ENABLE_CPP11_TYPE_TRAITS 1 - #endif - #if __GLIBCXX__ >= 20080606 && !defined(HALF_ENABLE_CPP11_CSTDINT) - #define HALF_ENABLE_CPP11_CSTDINT 1 - #endif - #if __GLIBCXX__ >= 20080606 && !defined(HALF_ENABLE_CPP11_CMATH) - #define HALF_ENABLE_CPP11_CMATH 1 - #endif - #if __GLIBCXX__ >= 20080606 && !defined(HALF_ENABLE_CPP11_HASH) - #define HALF_ENABLE_CPP11_HASH 1 - #endif - #if __GLIBCXX__ >= 20080606 && !defined(HALF_ENABLE_CPP11_CFENV) - #define HALF_ENABLE_CPP11_CFENV 1 - #endif - #else - #if HALF_GCC_VERSION >= 403 && !defined(HALF_ENABLE_CPP11_TYPE_TRAITS) - #define HALF_ENABLE_CPP11_TYPE_TRAITS 1 - #endif - #if HALF_GCC_VERSION >= 403 && !defined(HALF_ENABLE_CPP11_CSTDINT) - #define HALF_ENABLE_CPP11_CSTDINT 1 - #endif - #if HALF_GCC_VERSION >= 403 && !defined(HALF_ENABLE_CPP11_CMATH) - #define HALF_ENABLE_CPP11_CMATH 1 - #endif - #if HALF_GCC_VERSION >= 403 && !defined(HALF_ENABLE_CPP11_HASH) - #define HALF_ENABLE_CPP11_HASH 1 - #endif - #if HALF_GCC_VERSION >= 403 && !defined(HALF_ENABLE_CPP11_CFENV) - #define HALF_ENABLE_CPP11_CFENV 1 - #endif - #endif - #endif -#elif defined(_CPPLIB_VER) // Dinkumware/Visual C++ - #if _CPPLIB_VER >= 520 && !defined(HALF_ENABLE_CPP11_TYPE_TRAITS) - #define HALF_ENABLE_CPP11_TYPE_TRAITS 1 - #endif - #if _CPPLIB_VER >= 520 && !defined(HALF_ENABLE_CPP11_CSTDINT) - #define HALF_ENABLE_CPP11_CSTDINT 1 - #endif - #if _CPPLIB_VER >= 520 && !defined(HALF_ENABLE_CPP11_HASH) - #define HALF_ENABLE_CPP11_HASH 1 - #endif - #if _CPPLIB_VER >= 610 && !defined(HALF_ENABLE_CPP11_CMATH) - #define HALF_ENABLE_CPP11_CMATH 1 - #endif - #if _CPPLIB_VER >= 610 && !defined(HALF_ENABLE_CPP11_CFENV) - #define HALF_ENABLE_CPP11_CFENV 1 - #endif -#endif -#undef HALF_GCC_VERSION -#undef HALF_ICC_VERSION - -// any error throwing C++ exceptions? -#if defined(HALF_ERRHANDLING_THROW_INVALID) || defined(HALF_ERRHANDLING_THROW_DIVBYZERO) || defined(HALF_ERRHANDLING_THROW_OVERFLOW) || defined(HALF_ERRHANDLING_THROW_UNDERFLOW) || defined(HALF_ERRHANDLING_THROW_INEXACT) -#define HALF_ERRHANDLING_THROWS 1 -#endif - -// any error handling enabled? -#define HALF_ERRHANDLING (HALF_ERRHANDLING_FLAGS||HALF_ERRHANDLING_ERRNO||HALF_ERRHANDLING_FENV||HALF_ERRHANDLING_THROWS) - -#if HALF_ERRHANDLING - #define HALF_UNUSED_NOERR(name) name -#else - #define HALF_UNUSED_NOERR(name) -#endif - -// support constexpr -#if HALF_ENABLE_CPP11_CONSTEXPR - #define HALF_CONSTEXPR constexpr - #define HALF_CONSTEXPR_CONST constexpr - #if HALF_ERRHANDLING - #define HALF_CONSTEXPR_NOERR - #else - #define HALF_CONSTEXPR_NOERR constexpr - #endif -#else - #define HALF_CONSTEXPR - #define HALF_CONSTEXPR_CONST const - #define HALF_CONSTEXPR_NOERR -#endif - -// support noexcept -#if HALF_ENABLE_CPP11_NOEXCEPT - #define HALF_NOEXCEPT noexcept - #define HALF_NOTHROW noexcept -#else - #define HALF_NOEXCEPT - #define HALF_NOTHROW throw() -#endif - -// support thread storage -#if HALF_ENABLE_CPP11_THREAD_LOCAL - #define HALF_THREAD_LOCAL thread_local -#else - #define HALF_THREAD_LOCAL static -#endif - -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#if HALF_ENABLE_CPP11_TYPE_TRAITS - #include -#endif -#if HALF_ENABLE_CPP11_CSTDINT - #include -#endif -#if HALF_ERRHANDLING_ERRNO - #include -#endif -#if HALF_ENABLE_CPP11_CFENV - #include -#endif -#if HALF_ENABLE_CPP11_HASH - #include -#endif - - -#ifndef HALF_ENABLE_F16C_INTRINSICS - #define HALF_ENABLE_F16C_INTRINSICS __F16C__ -#endif -#if HALF_ENABLE_F16C_INTRINSICS - #include -#endif - -#ifdef HALF_DOXYGEN_ONLY -#define HALF_ARITHMETIC_TYPE (undefined) - -#define HALF_ERRHANDLING_FLAGS 0 - -#define HALF_ERRHANDLING_ERRNO 0 - -#define HALF_ERRHANDLING_FENV 0 - -#define HALF_ERRHANDLING_THROW_INVALID (undefined) - -#define HALF_ERRHANDLING_THROW_DIVBYZERO (undefined) - -#define HALF_ERRHANDLING_THROW_OVERFLOW (undefined) - -#define HALF_ERRHANDLING_THROW_UNDERFLOW (undefined) - -#define HALF_ERRHANDLING_THROW_INEXACT (undefined) -#endif - -#ifndef HALF_ERRHANDLING_OVERFLOW_TO_INEXACT -#define HALF_ERRHANDLING_OVERFLOW_TO_INEXACT 1 -#endif - -#ifndef HALF_ERRHANDLING_UNDERFLOW_TO_INEXACT -#define HALF_ERRHANDLING_UNDERFLOW_TO_INEXACT 1 -#endif - -#ifndef HALF_ROUND_STYLE - #define HALF_ROUND_STYLE 1 // = std::round_to_nearest -#endif - -#define HUGE_VALH std::numeric_limits::infinity() - -#define FP_FAST_FMAH 1 - -#define HLF_ROUNDS HALF_ROUND_STYLE - -#ifndef FP_ILOGB0 - #define FP_ILOGB0 INT_MIN -#endif -#ifndef FP_ILOGBNAN - #define FP_ILOGBNAN INT_MAX -#endif -#ifndef FP_SUBNORMAL - #define FP_SUBNORMAL 0 -#endif -#ifndef FP_ZERO - #define FP_ZERO 1 -#endif -#ifndef FP_NAN - #define FP_NAN 2 -#endif -#ifndef FP_INFINITE - #define FP_INFINITE 3 -#endif -#ifndef FP_NORMAL - #define FP_NORMAL 4 -#endif - -#if !HALF_ENABLE_CPP11_CFENV && !defined(FE_ALL_EXCEPT) - #define FE_INVALID 0x10 - #define FE_DIVBYZERO 0x08 - #define FE_OVERFLOW 0x04 - #define FE_UNDERFLOW 0x02 - #define FE_INEXACT 0x01 - #define FE_ALL_EXCEPT (FE_INVALID|FE_DIVBYZERO|FE_OVERFLOW|FE_UNDERFLOW|FE_INEXACT) -#endif - - -namespace half_float -{ - class half; - -#if HALF_ENABLE_CPP11_USER_LITERALS - namespace literal - { - half operator "" _h(long double); - } -#endif - - namespace detail - { - #if HALF_ENABLE_CPP11_TYPE_TRAITS - template struct conditional : std::conditional {}; - - template struct bool_type : std::integral_constant {}; - using std::true_type; - using std::false_type; - - template struct is_float : std::is_floating_point {}; - #else - template struct conditional { typedef T type; }; - template struct conditional { typedef F type; }; - - template struct bool_type {}; - typedef bool_type true_type; - typedef bool_type false_type; - - template struct is_float : false_type {}; - template struct is_float : is_float {}; - template struct is_float : is_float {}; - template struct is_float : is_float {}; - template<> struct is_float : true_type {}; - template<> struct is_float : true_type {}; - template<> struct is_float : true_type {}; - #endif - - template struct bits { typedef unsigned char type; }; - template struct bits : bits {}; - template struct bits : bits {}; - template struct bits : bits {}; - - #if HALF_ENABLE_CPP11_CSTDINT - typedef std::uint_least16_t uint16; - - typedef std::uint_fast32_t uint32; - - typedef std::int_fast32_t int32; - - template<> struct bits { typedef std::uint_least32_t type; }; - - template<> struct bits { typedef std::uint_least64_t type; }; - #else - typedef unsigned short uint16; - - typedef unsigned long uint32; - - typedef long int32; - - template<> struct bits : conditional::digits>=32,unsigned int,unsigned long> {}; - - #if HALF_ENABLE_CPP11_LONG_LONG - template<> struct bits : conditional::digits>=64,unsigned long,unsigned long long> {}; - #else - template<> struct bits { typedef unsigned long type; }; - #endif - #endif - - #ifdef HALF_ARITHMETIC_TYPE - typedef HALF_ARITHMETIC_TYPE internal_t; - #endif - - struct binary_t {}; - - HALF_CONSTEXPR_CONST binary_t binary = binary_t(); - - - template bool builtin_isinf(T arg) - { - #if HALF_ENABLE_CPP11_CMATH - return std::isinf(arg); - #elif defined(_MSC_VER) - return !::_finite(static_cast(arg)) && !::_isnan(static_cast(arg)); - #else - return arg == std::numeric_limits::infinity() || arg == -std::numeric_limits::infinity(); - #endif - } - - template bool builtin_isnan(T arg) - { - #if HALF_ENABLE_CPP11_CMATH - return std::isnan(arg); - #elif defined(_MSC_VER) - return ::_isnan(static_cast(arg)) != 0; - #else - return arg != arg; - #endif - } - - template bool builtin_signbit(T arg) - { - #if HALF_ENABLE_CPP11_CMATH - return std::signbit(arg); - #else - return arg < T() || (arg == T() && T(1)/arg < T()); - #endif - } - - inline uint32 sign_mask(uint32 arg) - { - static const int N = std::numeric_limits::digits - 1; - #if HALF_TWOS_COMPLEMENT_INT - return static_cast(arg) >> N; - #else - return -((arg>>N)&1); - #endif - } - - inline uint32 arithmetic_shift(uint32 arg, int i) - { - #if HALF_TWOS_COMPLEMENT_INT - return static_cast(arg) >> i; - #else - return static_cast(arg)/(static_cast(1)<>(std::numeric_limits::digits-1))&1); - #endif - } - - - inline int& errflags() { HALF_THREAD_LOCAL int flags = 0; return flags; } - - inline void raise(int HALF_UNUSED_NOERR(flags), bool HALF_UNUSED_NOERR(cond) = true) - { - #if HALF_ERRHANDLING - if(!cond) - return; - #if HALF_ERRHANDLING_FLAGS - errflags() |= flags; - #endif - #if HALF_ERRHANDLING_ERRNO - if(flags & FE_INVALID) - errno = EDOM; - else if(flags & (FE_DIVBYZERO|FE_OVERFLOW|FE_UNDERFLOW)) - errno = ERANGE; - #endif - #if HALF_ERRHANDLING_FENV && HALF_ENABLE_CPP11_CFENV - std::feraiseexcept(flags); - #endif - #ifdef HALF_ERRHANDLING_THROW_INVALID - if(flags & FE_INVALID) - throw std::domain_error(HALF_ERRHANDLING_THROW_INVALID); - #endif - #ifdef HALF_ERRHANDLING_THROW_DIVBYZERO - if(flags & FE_DIVBYZERO) - throw std::domain_error(HALF_ERRHANDLING_THROW_DIVBYZERO); - #endif - #ifdef HALF_ERRHANDLING_THROW_OVERFLOW - if(flags & FE_OVERFLOW) - throw std::overflow_error(HALF_ERRHANDLING_THROW_OVERFLOW); - #endif - #ifdef HALF_ERRHANDLING_THROW_UNDERFLOW - if(flags & FE_UNDERFLOW) - throw std::underflow_error(HALF_ERRHANDLING_THROW_UNDERFLOW); - #endif - #ifdef HALF_ERRHANDLING_THROW_INEXACT - if(flags & FE_INEXACT) - throw std::range_error(HALF_ERRHANDLING_THROW_INEXACT); - #endif - #if HALF_ERRHANDLING_UNDERFLOW_TO_INEXACT - if((flags & FE_UNDERFLOW) && !(flags & FE_INEXACT)) - raise(FE_INEXACT); - #endif - #if HALF_ERRHANDLING_OVERFLOW_TO_INEXACT - if((flags & FE_OVERFLOW) && !(flags & FE_INEXACT)) - raise(FE_INEXACT); - #endif - #endif - } - - inline HALF_CONSTEXPR_NOERR bool compsignal(unsigned int x, unsigned int y) - { - #if HALF_ERRHANDLING - raise(FE_INVALID, (x&0x7FFF)>0x7C00 || (y&0x7FFF)>0x7C00); - #endif - return (x&0x7FFF) > 0x7C00 || (y&0x7FFF) > 0x7C00; - } - - inline HALF_CONSTEXPR_NOERR unsigned int signal(unsigned int nan) - { - #if HALF_ERRHANDLING - raise(FE_INVALID, !(nan&0x200)); - #endif - return nan | 0x200; - } - - inline HALF_CONSTEXPR_NOERR unsigned int signal(unsigned int x, unsigned int y) - { - #if HALF_ERRHANDLING - raise(FE_INVALID, ((x&0x7FFF)>0x7C00 && !(x&0x200)) || ((y&0x7FFF)>0x7C00 && !(y&0x200))); - #endif - return ((x&0x7FFF)>0x7C00) ? (x|0x200) : (y|0x200); - } - - inline HALF_CONSTEXPR_NOERR unsigned int signal(unsigned int x, unsigned int y, unsigned int z) - { - #if HALF_ERRHANDLING - raise(FE_INVALID, ((x&0x7FFF)>0x7C00 && !(x&0x200)) || ((y&0x7FFF)>0x7C00 && !(y&0x200)) || ((z&0x7FFF)>0x7C00 && !(z&0x200))); - #endif - return ((x&0x7FFF)>0x7C00) ? (x|0x200) : ((y&0x7FFF)>0x7C00) ? (y|0x200) : (z|0x200); - } - - inline HALF_CONSTEXPR_NOERR unsigned int select(unsigned int x, unsigned int HALF_UNUSED_NOERR(y)) - { - #if HALF_ERRHANDLING - return (((y&0x7FFF)>0x7C00) && !(y&0x200)) ? signal(y) : x; - #else - return x; - #endif - } - - inline HALF_CONSTEXPR_NOERR unsigned int invalid() - { - #if HALF_ERRHANDLING - raise(FE_INVALID); - #endif - return 0x7FFF; - } - - inline HALF_CONSTEXPR_NOERR unsigned int pole(unsigned int sign = 0) - { - #if HALF_ERRHANDLING - raise(FE_DIVBYZERO); - #endif - return sign | 0x7C00; - } - - inline HALF_CONSTEXPR_NOERR unsigned int check_underflow(unsigned int arg) - { - #if HALF_ERRHANDLING && !HALF_ERRHANDLING_UNDERFLOW_TO_INEXACT - raise(FE_UNDERFLOW, !(arg&0x7C00)); - #endif - return arg; - } - - - template HALF_CONSTEXPR_NOERR unsigned int overflow(unsigned int sign = 0) - { - #if HALF_ERRHANDLING - raise(FE_OVERFLOW); - #endif - return (R==std::round_toward_infinity) ? (sign+0x7C00-(sign>>15)) : - (R==std::round_toward_neg_infinity) ? (sign+0x7BFF+(sign>>15)) : - (R==std::round_toward_zero) ? (sign|0x7BFF) : - (sign|0x7C00); - } - - template HALF_CONSTEXPR_NOERR unsigned int underflow(unsigned int sign = 0) - { - #if HALF_ERRHANDLING - raise(FE_UNDERFLOW); - #endif - return (R==std::round_toward_infinity) ? (sign+1-(sign>>15)) : - (R==std::round_toward_neg_infinity) ? (sign+(sign>>15)) : - sign; - } - - template HALF_CONSTEXPR_NOERR unsigned int rounded(unsigned int value, int g, int s) - { - #if HALF_ERRHANDLING - value += (R==std::round_to_nearest) ? (g&(s|value)) : - (R==std::round_toward_infinity) ? (~(value>>15)&(g|s)) : - (R==std::round_toward_neg_infinity) ? ((value>>15)&(g|s)) : 0; - if((value&0x7C00) == 0x7C00) - raise(FE_OVERFLOW); - else if(value & 0x7C00) - raise(FE_INEXACT, I || (g|s)!=0); - else - raise(FE_UNDERFLOW, !(HALF_ERRHANDLING_UNDERFLOW_TO_INEXACT) || I || (g|s)!=0); - return value; - #else - return (R==std::round_to_nearest) ? (value+(g&(s|value))) : - (R==std::round_toward_infinity) ? (value+(~(value>>15)&(g|s))) : - (R==std::round_toward_neg_infinity) ? (value+((value>>15)&(g|s))) : - value; - #endif - } - - template unsigned int integral(unsigned int value) - { - unsigned int abs = value & 0x7FFF; - if(abs < 0x3C00) - { - raise(FE_INEXACT, I); - return ((R==std::round_to_nearest) ? (0x3C00&-static_cast(abs>=(0x3800+E))) : - (R==std::round_toward_infinity) ? (0x3C00&-(~(value>>15)&(abs!=0))) : - (R==std::round_toward_neg_infinity) ? (0x3C00&-static_cast(value>0x8000)) : - 0) | (value&0x8000); - } - if(abs >= 0x6400) - return (abs>0x7C00) ? signal(value) : value; - unsigned int exp = 25 - (abs>>10), mask = (1<>exp)&E)) : - (R==std::round_toward_infinity) ? (mask&((value>>15)-1)) : - (R==std::round_toward_neg_infinity) ? (mask&-(value>>15)) : - 0) + value) & ~mask; - } - - template unsigned int fixed2half(uint32 m, int exp = 14, unsigned int sign = 0, int s = 0) - { - if(S) - { - uint32 msign = sign_mask(m); - m = (m^msign) - msign; - sign = msign & 0x8000; - } - if(N) - for(; m<(static_cast(1)<(sign+(m>>(F-10-exp)), (m>>(F-11-exp))&1, s|((m&((static_cast(1)<<(F-11-exp))-1))!=0)); - return rounded(sign+(exp<<10)+(m>>(F-10)), (m>>(F-11))&1, s|((m&((static_cast(1)<<(F-11))-1))!=0)); - } - - template unsigned int float2half_impl(float value, true_type) - { - #if HALF_ENABLE_F16C_INTRINSICS - return _mm_cvtsi128_si32(_mm_cvtps_ph(_mm_set_ss(value), - (R==std::round_to_nearest) ? _MM_FROUND_TO_NEAREST_INT : - (R==std::round_toward_zero) ? _MM_FROUND_TO_ZERO : - (R==std::round_toward_infinity) ? _MM_FROUND_TO_POS_INF : - (R==std::round_toward_neg_infinity) ? _MM_FROUND_TO_NEG_INF : - _MM_FROUND_CUR_DIRECTION)); - #else - bits::type fbits; - std::memcpy(&fbits, &value, sizeof(float)); - #if 1 - unsigned int sign = (fbits>>16) & 0x8000; - fbits &= 0x7FFFFFFF; - if(fbits >= 0x7F800000) - return sign | 0x7C00 | ((fbits>0x7F800000) ? (0x200|((fbits>>13)&0x3FF)) : 0); - if(fbits >= 0x47800000) - return overflow(sign); - if(fbits >= 0x38800000) - return rounded(sign|(((fbits>>23)-112)<<10)|((fbits>>13)&0x3FF), (fbits>>12)&1, (fbits&0xFFF)!=0); - if(fbits >= 0x33000000) - { - int i = 125 - (fbits>>23); - fbits = (fbits&0x7FFFFF) | 0x800000; - return rounded(sign|(fbits>>(i+1)), (fbits>>i)&1, (fbits&((static_cast(1)<(sign); - return sign; - #else - static const uint16 base_table[512] = { - 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, - 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, - 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, - 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, - 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, - 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, - 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0001, 0x0002, 0x0004, 0x0008, 0x0010, 0x0020, 0x0040, 0x0080, 0x0100, - 0x0200, 0x0400, 0x0800, 0x0C00, 0x1000, 0x1400, 0x1800, 0x1C00, 0x2000, 0x2400, 0x2800, 0x2C00, 0x3000, 0x3400, 0x3800, 0x3C00, - 0x4000, 0x4400, 0x4800, 0x4C00, 0x5000, 0x5400, 0x5800, 0x5C00, 0x6000, 0x6400, 0x6800, 0x6C00, 0x7000, 0x7400, 0x7800, 0x7BFF, - 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, - 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, - 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, - 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, - 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, - 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, - 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7BFF, 0x7C00, - 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, - 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, - 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, - 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, - 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, - 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, - 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8000, 0x8001, 0x8002, 0x8004, 0x8008, 0x8010, 0x8020, 0x8040, 0x8080, 0x8100, - 0x8200, 0x8400, 0x8800, 0x8C00, 0x9000, 0x9400, 0x9800, 0x9C00, 0xA000, 0xA400, 0xA800, 0xAC00, 0xB000, 0xB400, 0xB800, 0xBC00, - 0xC000, 0xC400, 0xC800, 0xCC00, 0xD000, 0xD400, 0xD800, 0xDC00, 0xE000, 0xE400, 0xE800, 0xEC00, 0xF000, 0xF400, 0xF800, 0xFBFF, - 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, - 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, - 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, - 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, - 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, - 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, - 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFBFF, 0xFC00 }; - static const unsigned char shift_table[256] = { - 24, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, - 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, - 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, - 25, 25, 25, 25, 25, 25, 24, 23, 22, 21, 20, 19, 18, 17, 16, 15, 14, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, - 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, - 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, - 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, - 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 13 }; - int sexp = fbits >> 23, exp = sexp & 0xFF, i = shift_table[exp]; - fbits &= 0x7FFFFF; - uint32 m = (fbits|((exp!=0)<<23)) & -static_cast(exp!=0xFF); - return rounded(base_table[sexp]+(fbits>>i), (m>>(i-1))&1, (((static_cast(1)<<(i-1))-1)&m)!=0); - #endif - #endif - } - - template unsigned int float2half_impl(double value, true_type) - { - #if HALF_ENABLE_F16C_INTRINSICS - if(R == std::round_indeterminate) - return _mm_cvtsi128_si32(_mm_cvtps_ph(_mm_cvtpd_ps(_mm_set_sd(value)), _MM_FROUND_CUR_DIRECTION)); - #endif - bits::type dbits; - std::memcpy(&dbits, &value, sizeof(double)); - uint32 hi = dbits >> 32, lo = dbits & 0xFFFFFFFF; - unsigned int sign = (hi>>16) & 0x8000; - hi &= 0x7FFFFFFF; - if(hi >= 0x7FF00000) - return sign | 0x7C00 | ((dbits&0xFFFFFFFFFFFFF) ? (0x200|((hi>>10)&0x3FF)) : 0); - if(hi >= 0x40F00000) - return overflow(sign); - if(hi >= 0x3F100000) - return rounded(sign|(((hi>>20)-1008)<<10)|((hi>>10)&0x3FF), (hi>>9)&1, ((hi&0x1FF)|lo)!=0); - if(hi >= 0x3E600000) - { - int i = 1018 - (hi>>20); - hi = (hi&0xFFFFF) | 0x100000; - return rounded(sign|(hi>>(i+1)), (hi>>i)&1, ((hi&((static_cast(1)<(sign); - return sign; - } - - template unsigned int float2half_impl(T value, ...) - { - unsigned int hbits = static_cast(builtin_signbit(value)) << 15; - if(value == T()) - return hbits; - if(builtin_isnan(value)) - return hbits | 0x7FFF; - if(builtin_isinf(value)) - return hbits | 0x7C00; - int exp; - std::frexp(value, &exp); - if(exp > 16) - return overflow(hbits); - if(exp < -13) - value = std::ldexp(value, 25); - else - { - value = std::ldexp(value, 12-exp); - hbits |= ((exp+13)<<10); - } - T ival, frac = std::modf(value, &ival); - int m = std::abs(static_cast(ival)); - return rounded(hbits+(m>>1), m&1, frac!=T()); - } - - template unsigned int float2half(T value) - { - return float2half_impl(value, bool_type::is_iec559&&sizeof(typename bits::type)==sizeof(T)>()); - } - - template unsigned int int2half(T value) - { - unsigned int bits = static_cast(value<0) << 15; - if(!value) - return bits; - if(bits) - value = -value; - if(value > 0xFFFF) - return overflow(bits); - unsigned int m = static_cast(value), exp = 24; - for(; m<0x400; m<<=1,--exp) ; - for(; m>0x7FF; m>>=1,++exp) ; - bits |= (exp<<10) + m; - return (exp>24) ? rounded(bits, (value>>(exp-25))&1, (((1<<(exp-25))-1)&value)!=0) : bits; - } - - inline float half2float_impl(unsigned int value, float, true_type) - { - #if HALF_ENABLE_F16C_INTRINSICS - return _mm_cvtss_f32(_mm_cvtph_ps(_mm_cvtsi32_si128(value))); - #else - #if 0 - bits::type fbits = static_cast::type>(value&0x8000) << 16; - int abs = value & 0x7FFF; - if(abs) - { - fbits |= 0x38000000 << static_cast(abs>=0x7C00); - for(; abs<0x400; abs<<=1,fbits-=0x800000) ; - fbits += static_cast::type>(abs) << 13; - } - #else - static const bits::type mantissa_table[2048] = { - 0x00000000, 0x33800000, 0x34000000, 0x34400000, 0x34800000, 0x34A00000, 0x34C00000, 0x34E00000, 0x35000000, 0x35100000, 0x35200000, 0x35300000, 0x35400000, 0x35500000, 0x35600000, 0x35700000, - 0x35800000, 0x35880000, 0x35900000, 0x35980000, 0x35A00000, 0x35A80000, 0x35B00000, 0x35B80000, 0x35C00000, 0x35C80000, 0x35D00000, 0x35D80000, 0x35E00000, 0x35E80000, 0x35F00000, 0x35F80000, - 0x36000000, 0x36040000, 0x36080000, 0x360C0000, 0x36100000, 0x36140000, 0x36180000, 0x361C0000, 0x36200000, 0x36240000, 0x36280000, 0x362C0000, 0x36300000, 0x36340000, 0x36380000, 0x363C0000, - 0x36400000, 0x36440000, 0x36480000, 0x364C0000, 0x36500000, 0x36540000, 0x36580000, 0x365C0000, 0x36600000, 0x36640000, 0x36680000, 0x366C0000, 0x36700000, 0x36740000, 0x36780000, 0x367C0000, - 0x36800000, 0x36820000, 0x36840000, 0x36860000, 0x36880000, 0x368A0000, 0x368C0000, 0x368E0000, 0x36900000, 0x36920000, 0x36940000, 0x36960000, 0x36980000, 0x369A0000, 0x369C0000, 0x369E0000, - 0x36A00000, 0x36A20000, 0x36A40000, 0x36A60000, 0x36A80000, 0x36AA0000, 0x36AC0000, 0x36AE0000, 0x36B00000, 0x36B20000, 0x36B40000, 0x36B60000, 0x36B80000, 0x36BA0000, 0x36BC0000, 0x36BE0000, - 0x36C00000, 0x36C20000, 0x36C40000, 0x36C60000, 0x36C80000, 0x36CA0000, 0x36CC0000, 0x36CE0000, 0x36D00000, 0x36D20000, 0x36D40000, 0x36D60000, 0x36D80000, 0x36DA0000, 0x36DC0000, 0x36DE0000, - 0x36E00000, 0x36E20000, 0x36E40000, 0x36E60000, 0x36E80000, 0x36EA0000, 0x36EC0000, 0x36EE0000, 0x36F00000, 0x36F20000, 0x36F40000, 0x36F60000, 0x36F80000, 0x36FA0000, 0x36FC0000, 0x36FE0000, - 0x37000000, 0x37010000, 0x37020000, 0x37030000, 0x37040000, 0x37050000, 0x37060000, 0x37070000, 0x37080000, 0x37090000, 0x370A0000, 0x370B0000, 0x370C0000, 0x370D0000, 0x370E0000, 0x370F0000, - 0x37100000, 0x37110000, 0x37120000, 0x37130000, 0x37140000, 0x37150000, 0x37160000, 0x37170000, 0x37180000, 0x37190000, 0x371A0000, 0x371B0000, 0x371C0000, 0x371D0000, 0x371E0000, 0x371F0000, - 0x37200000, 0x37210000, 0x37220000, 0x37230000, 0x37240000, 0x37250000, 0x37260000, 0x37270000, 0x37280000, 0x37290000, 0x372A0000, 0x372B0000, 0x372C0000, 0x372D0000, 0x372E0000, 0x372F0000, - 0x37300000, 0x37310000, 0x37320000, 0x37330000, 0x37340000, 0x37350000, 0x37360000, 0x37370000, 0x37380000, 0x37390000, 0x373A0000, 0x373B0000, 0x373C0000, 0x373D0000, 0x373E0000, 0x373F0000, - 0x37400000, 0x37410000, 0x37420000, 0x37430000, 0x37440000, 0x37450000, 0x37460000, 0x37470000, 0x37480000, 0x37490000, 0x374A0000, 0x374B0000, 0x374C0000, 0x374D0000, 0x374E0000, 0x374F0000, - 0x37500000, 0x37510000, 0x37520000, 0x37530000, 0x37540000, 0x37550000, 0x37560000, 0x37570000, 0x37580000, 0x37590000, 0x375A0000, 0x375B0000, 0x375C0000, 0x375D0000, 0x375E0000, 0x375F0000, - 0x37600000, 0x37610000, 0x37620000, 0x37630000, 0x37640000, 0x37650000, 0x37660000, 0x37670000, 0x37680000, 0x37690000, 0x376A0000, 0x376B0000, 0x376C0000, 0x376D0000, 0x376E0000, 0x376F0000, - 0x37700000, 0x37710000, 0x37720000, 0x37730000, 0x37740000, 0x37750000, 0x37760000, 0x37770000, 0x37780000, 0x37790000, 0x377A0000, 0x377B0000, 0x377C0000, 0x377D0000, 0x377E0000, 0x377F0000, - 0x37800000, 0x37808000, 0x37810000, 0x37818000, 0x37820000, 0x37828000, 0x37830000, 0x37838000, 0x37840000, 0x37848000, 0x37850000, 0x37858000, 0x37860000, 0x37868000, 0x37870000, 0x37878000, - 0x37880000, 0x37888000, 0x37890000, 0x37898000, 0x378A0000, 0x378A8000, 0x378B0000, 0x378B8000, 0x378C0000, 0x378C8000, 0x378D0000, 0x378D8000, 0x378E0000, 0x378E8000, 0x378F0000, 0x378F8000, - 0x37900000, 0x37908000, 0x37910000, 0x37918000, 0x37920000, 0x37928000, 0x37930000, 0x37938000, 0x37940000, 0x37948000, 0x37950000, 0x37958000, 0x37960000, 0x37968000, 0x37970000, 0x37978000, - 0x37980000, 0x37988000, 0x37990000, 0x37998000, 0x379A0000, 0x379A8000, 0x379B0000, 0x379B8000, 0x379C0000, 0x379C8000, 0x379D0000, 0x379D8000, 0x379E0000, 0x379E8000, 0x379F0000, 0x379F8000, - 0x37A00000, 0x37A08000, 0x37A10000, 0x37A18000, 0x37A20000, 0x37A28000, 0x37A30000, 0x37A38000, 0x37A40000, 0x37A48000, 0x37A50000, 0x37A58000, 0x37A60000, 0x37A68000, 0x37A70000, 0x37A78000, - 0x37A80000, 0x37A88000, 0x37A90000, 0x37A98000, 0x37AA0000, 0x37AA8000, 0x37AB0000, 0x37AB8000, 0x37AC0000, 0x37AC8000, 0x37AD0000, 0x37AD8000, 0x37AE0000, 0x37AE8000, 0x37AF0000, 0x37AF8000, - 0x37B00000, 0x37B08000, 0x37B10000, 0x37B18000, 0x37B20000, 0x37B28000, 0x37B30000, 0x37B38000, 0x37B40000, 0x37B48000, 0x37B50000, 0x37B58000, 0x37B60000, 0x37B68000, 0x37B70000, 0x37B78000, - 0x37B80000, 0x37B88000, 0x37B90000, 0x37B98000, 0x37BA0000, 0x37BA8000, 0x37BB0000, 0x37BB8000, 0x37BC0000, 0x37BC8000, 0x37BD0000, 0x37BD8000, 0x37BE0000, 0x37BE8000, 0x37BF0000, 0x37BF8000, - 0x37C00000, 0x37C08000, 0x37C10000, 0x37C18000, 0x37C20000, 0x37C28000, 0x37C30000, 0x37C38000, 0x37C40000, 0x37C48000, 0x37C50000, 0x37C58000, 0x37C60000, 0x37C68000, 0x37C70000, 0x37C78000, - 0x37C80000, 0x37C88000, 0x37C90000, 0x37C98000, 0x37CA0000, 0x37CA8000, 0x37CB0000, 0x37CB8000, 0x37CC0000, 0x37CC8000, 0x37CD0000, 0x37CD8000, 0x37CE0000, 0x37CE8000, 0x37CF0000, 0x37CF8000, - 0x37D00000, 0x37D08000, 0x37D10000, 0x37D18000, 0x37D20000, 0x37D28000, 0x37D30000, 0x37D38000, 0x37D40000, 0x37D48000, 0x37D50000, 0x37D58000, 0x37D60000, 0x37D68000, 0x37D70000, 0x37D78000, - 0x37D80000, 0x37D88000, 0x37D90000, 0x37D98000, 0x37DA0000, 0x37DA8000, 0x37DB0000, 0x37DB8000, 0x37DC0000, 0x37DC8000, 0x37DD0000, 0x37DD8000, 0x37DE0000, 0x37DE8000, 0x37DF0000, 0x37DF8000, - 0x37E00000, 0x37E08000, 0x37E10000, 0x37E18000, 0x37E20000, 0x37E28000, 0x37E30000, 0x37E38000, 0x37E40000, 0x37E48000, 0x37E50000, 0x37E58000, 0x37E60000, 0x37E68000, 0x37E70000, 0x37E78000, - 0x37E80000, 0x37E88000, 0x37E90000, 0x37E98000, 0x37EA0000, 0x37EA8000, 0x37EB0000, 0x37EB8000, 0x37EC0000, 0x37EC8000, 0x37ED0000, 0x37ED8000, 0x37EE0000, 0x37EE8000, 0x37EF0000, 0x37EF8000, - 0x37F00000, 0x37F08000, 0x37F10000, 0x37F18000, 0x37F20000, 0x37F28000, 0x37F30000, 0x37F38000, 0x37F40000, 0x37F48000, 0x37F50000, 0x37F58000, 0x37F60000, 0x37F68000, 0x37F70000, 0x37F78000, - 0x37F80000, 0x37F88000, 0x37F90000, 0x37F98000, 0x37FA0000, 0x37FA8000, 0x37FB0000, 0x37FB8000, 0x37FC0000, 0x37FC8000, 0x37FD0000, 0x37FD8000, 0x37FE0000, 0x37FE8000, 0x37FF0000, 0x37FF8000, - 0x38000000, 0x38004000, 0x38008000, 0x3800C000, 0x38010000, 0x38014000, 0x38018000, 0x3801C000, 0x38020000, 0x38024000, 0x38028000, 0x3802C000, 0x38030000, 0x38034000, 0x38038000, 0x3803C000, - 0x38040000, 0x38044000, 0x38048000, 0x3804C000, 0x38050000, 0x38054000, 0x38058000, 0x3805C000, 0x38060000, 0x38064000, 0x38068000, 0x3806C000, 0x38070000, 0x38074000, 0x38078000, 0x3807C000, - 0x38080000, 0x38084000, 0x38088000, 0x3808C000, 0x38090000, 0x38094000, 0x38098000, 0x3809C000, 0x380A0000, 0x380A4000, 0x380A8000, 0x380AC000, 0x380B0000, 0x380B4000, 0x380B8000, 0x380BC000, - 0x380C0000, 0x380C4000, 0x380C8000, 0x380CC000, 0x380D0000, 0x380D4000, 0x380D8000, 0x380DC000, 0x380E0000, 0x380E4000, 0x380E8000, 0x380EC000, 0x380F0000, 0x380F4000, 0x380F8000, 0x380FC000, - 0x38100000, 0x38104000, 0x38108000, 0x3810C000, 0x38110000, 0x38114000, 0x38118000, 0x3811C000, 0x38120000, 0x38124000, 0x38128000, 0x3812C000, 0x38130000, 0x38134000, 0x38138000, 0x3813C000, - 0x38140000, 0x38144000, 0x38148000, 0x3814C000, 0x38150000, 0x38154000, 0x38158000, 0x3815C000, 0x38160000, 0x38164000, 0x38168000, 0x3816C000, 0x38170000, 0x38174000, 0x38178000, 0x3817C000, - 0x38180000, 0x38184000, 0x38188000, 0x3818C000, 0x38190000, 0x38194000, 0x38198000, 0x3819C000, 0x381A0000, 0x381A4000, 0x381A8000, 0x381AC000, 0x381B0000, 0x381B4000, 0x381B8000, 0x381BC000, - 0x381C0000, 0x381C4000, 0x381C8000, 0x381CC000, 0x381D0000, 0x381D4000, 0x381D8000, 0x381DC000, 0x381E0000, 0x381E4000, 0x381E8000, 0x381EC000, 0x381F0000, 0x381F4000, 0x381F8000, 0x381FC000, - 0x38200000, 0x38204000, 0x38208000, 0x3820C000, 0x38210000, 0x38214000, 0x38218000, 0x3821C000, 0x38220000, 0x38224000, 0x38228000, 0x3822C000, 0x38230000, 0x38234000, 0x38238000, 0x3823C000, - 0x38240000, 0x38244000, 0x38248000, 0x3824C000, 0x38250000, 0x38254000, 0x38258000, 0x3825C000, 0x38260000, 0x38264000, 0x38268000, 0x3826C000, 0x38270000, 0x38274000, 0x38278000, 0x3827C000, - 0x38280000, 0x38284000, 0x38288000, 0x3828C000, 0x38290000, 0x38294000, 0x38298000, 0x3829C000, 0x382A0000, 0x382A4000, 0x382A8000, 0x382AC000, 0x382B0000, 0x382B4000, 0x382B8000, 0x382BC000, - 0x382C0000, 0x382C4000, 0x382C8000, 0x382CC000, 0x382D0000, 0x382D4000, 0x382D8000, 0x382DC000, 0x382E0000, 0x382E4000, 0x382E8000, 0x382EC000, 0x382F0000, 0x382F4000, 0x382F8000, 0x382FC000, - 0x38300000, 0x38304000, 0x38308000, 0x3830C000, 0x38310000, 0x38314000, 0x38318000, 0x3831C000, 0x38320000, 0x38324000, 0x38328000, 0x3832C000, 0x38330000, 0x38334000, 0x38338000, 0x3833C000, - 0x38340000, 0x38344000, 0x38348000, 0x3834C000, 0x38350000, 0x38354000, 0x38358000, 0x3835C000, 0x38360000, 0x38364000, 0x38368000, 0x3836C000, 0x38370000, 0x38374000, 0x38378000, 0x3837C000, - 0x38380000, 0x38384000, 0x38388000, 0x3838C000, 0x38390000, 0x38394000, 0x38398000, 0x3839C000, 0x383A0000, 0x383A4000, 0x383A8000, 0x383AC000, 0x383B0000, 0x383B4000, 0x383B8000, 0x383BC000, - 0x383C0000, 0x383C4000, 0x383C8000, 0x383CC000, 0x383D0000, 0x383D4000, 0x383D8000, 0x383DC000, 0x383E0000, 0x383E4000, 0x383E8000, 0x383EC000, 0x383F0000, 0x383F4000, 0x383F8000, 0x383FC000, - 0x38400000, 0x38404000, 0x38408000, 0x3840C000, 0x38410000, 0x38414000, 0x38418000, 0x3841C000, 0x38420000, 0x38424000, 0x38428000, 0x3842C000, 0x38430000, 0x38434000, 0x38438000, 0x3843C000, - 0x38440000, 0x38444000, 0x38448000, 0x3844C000, 0x38450000, 0x38454000, 0x38458000, 0x3845C000, 0x38460000, 0x38464000, 0x38468000, 0x3846C000, 0x38470000, 0x38474000, 0x38478000, 0x3847C000, - 0x38480000, 0x38484000, 0x38488000, 0x3848C000, 0x38490000, 0x38494000, 0x38498000, 0x3849C000, 0x384A0000, 0x384A4000, 0x384A8000, 0x384AC000, 0x384B0000, 0x384B4000, 0x384B8000, 0x384BC000, - 0x384C0000, 0x384C4000, 0x384C8000, 0x384CC000, 0x384D0000, 0x384D4000, 0x384D8000, 0x384DC000, 0x384E0000, 0x384E4000, 0x384E8000, 0x384EC000, 0x384F0000, 0x384F4000, 0x384F8000, 0x384FC000, - 0x38500000, 0x38504000, 0x38508000, 0x3850C000, 0x38510000, 0x38514000, 0x38518000, 0x3851C000, 0x38520000, 0x38524000, 0x38528000, 0x3852C000, 0x38530000, 0x38534000, 0x38538000, 0x3853C000, - 0x38540000, 0x38544000, 0x38548000, 0x3854C000, 0x38550000, 0x38554000, 0x38558000, 0x3855C000, 0x38560000, 0x38564000, 0x38568000, 0x3856C000, 0x38570000, 0x38574000, 0x38578000, 0x3857C000, - 0x38580000, 0x38584000, 0x38588000, 0x3858C000, 0x38590000, 0x38594000, 0x38598000, 0x3859C000, 0x385A0000, 0x385A4000, 0x385A8000, 0x385AC000, 0x385B0000, 0x385B4000, 0x385B8000, 0x385BC000, - 0x385C0000, 0x385C4000, 0x385C8000, 0x385CC000, 0x385D0000, 0x385D4000, 0x385D8000, 0x385DC000, 0x385E0000, 0x385E4000, 0x385E8000, 0x385EC000, 0x385F0000, 0x385F4000, 0x385F8000, 0x385FC000, - 0x38600000, 0x38604000, 0x38608000, 0x3860C000, 0x38610000, 0x38614000, 0x38618000, 0x3861C000, 0x38620000, 0x38624000, 0x38628000, 0x3862C000, 0x38630000, 0x38634000, 0x38638000, 0x3863C000, - 0x38640000, 0x38644000, 0x38648000, 0x3864C000, 0x38650000, 0x38654000, 0x38658000, 0x3865C000, 0x38660000, 0x38664000, 0x38668000, 0x3866C000, 0x38670000, 0x38674000, 0x38678000, 0x3867C000, - 0x38680000, 0x38684000, 0x38688000, 0x3868C000, 0x38690000, 0x38694000, 0x38698000, 0x3869C000, 0x386A0000, 0x386A4000, 0x386A8000, 0x386AC000, 0x386B0000, 0x386B4000, 0x386B8000, 0x386BC000, - 0x386C0000, 0x386C4000, 0x386C8000, 0x386CC000, 0x386D0000, 0x386D4000, 0x386D8000, 0x386DC000, 0x386E0000, 0x386E4000, 0x386E8000, 0x386EC000, 0x386F0000, 0x386F4000, 0x386F8000, 0x386FC000, - 0x38700000, 0x38704000, 0x38708000, 0x3870C000, 0x38710000, 0x38714000, 0x38718000, 0x3871C000, 0x38720000, 0x38724000, 0x38728000, 0x3872C000, 0x38730000, 0x38734000, 0x38738000, 0x3873C000, - 0x38740000, 0x38744000, 0x38748000, 0x3874C000, 0x38750000, 0x38754000, 0x38758000, 0x3875C000, 0x38760000, 0x38764000, 0x38768000, 0x3876C000, 0x38770000, 0x38774000, 0x38778000, 0x3877C000, - 0x38780000, 0x38784000, 0x38788000, 0x3878C000, 0x38790000, 0x38794000, 0x38798000, 0x3879C000, 0x387A0000, 0x387A4000, 0x387A8000, 0x387AC000, 0x387B0000, 0x387B4000, 0x387B8000, 0x387BC000, - 0x387C0000, 0x387C4000, 0x387C8000, 0x387CC000, 0x387D0000, 0x387D4000, 0x387D8000, 0x387DC000, 0x387E0000, 0x387E4000, 0x387E8000, 0x387EC000, 0x387F0000, 0x387F4000, 0x387F8000, 0x387FC000, - 0x38000000, 0x38002000, 0x38004000, 0x38006000, 0x38008000, 0x3800A000, 0x3800C000, 0x3800E000, 0x38010000, 0x38012000, 0x38014000, 0x38016000, 0x38018000, 0x3801A000, 0x3801C000, 0x3801E000, - 0x38020000, 0x38022000, 0x38024000, 0x38026000, 0x38028000, 0x3802A000, 0x3802C000, 0x3802E000, 0x38030000, 0x38032000, 0x38034000, 0x38036000, 0x38038000, 0x3803A000, 0x3803C000, 0x3803E000, - 0x38040000, 0x38042000, 0x38044000, 0x38046000, 0x38048000, 0x3804A000, 0x3804C000, 0x3804E000, 0x38050000, 0x38052000, 0x38054000, 0x38056000, 0x38058000, 0x3805A000, 0x3805C000, 0x3805E000, - 0x38060000, 0x38062000, 0x38064000, 0x38066000, 0x38068000, 0x3806A000, 0x3806C000, 0x3806E000, 0x38070000, 0x38072000, 0x38074000, 0x38076000, 0x38078000, 0x3807A000, 0x3807C000, 0x3807E000, - 0x38080000, 0x38082000, 0x38084000, 0x38086000, 0x38088000, 0x3808A000, 0x3808C000, 0x3808E000, 0x38090000, 0x38092000, 0x38094000, 0x38096000, 0x38098000, 0x3809A000, 0x3809C000, 0x3809E000, - 0x380A0000, 0x380A2000, 0x380A4000, 0x380A6000, 0x380A8000, 0x380AA000, 0x380AC000, 0x380AE000, 0x380B0000, 0x380B2000, 0x380B4000, 0x380B6000, 0x380B8000, 0x380BA000, 0x380BC000, 0x380BE000, - 0x380C0000, 0x380C2000, 0x380C4000, 0x380C6000, 0x380C8000, 0x380CA000, 0x380CC000, 0x380CE000, 0x380D0000, 0x380D2000, 0x380D4000, 0x380D6000, 0x380D8000, 0x380DA000, 0x380DC000, 0x380DE000, - 0x380E0000, 0x380E2000, 0x380E4000, 0x380E6000, 0x380E8000, 0x380EA000, 0x380EC000, 0x380EE000, 0x380F0000, 0x380F2000, 0x380F4000, 0x380F6000, 0x380F8000, 0x380FA000, 0x380FC000, 0x380FE000, - 0x38100000, 0x38102000, 0x38104000, 0x38106000, 0x38108000, 0x3810A000, 0x3810C000, 0x3810E000, 0x38110000, 0x38112000, 0x38114000, 0x38116000, 0x38118000, 0x3811A000, 0x3811C000, 0x3811E000, - 0x38120000, 0x38122000, 0x38124000, 0x38126000, 0x38128000, 0x3812A000, 0x3812C000, 0x3812E000, 0x38130000, 0x38132000, 0x38134000, 0x38136000, 0x38138000, 0x3813A000, 0x3813C000, 0x3813E000, - 0x38140000, 0x38142000, 0x38144000, 0x38146000, 0x38148000, 0x3814A000, 0x3814C000, 0x3814E000, 0x38150000, 0x38152000, 0x38154000, 0x38156000, 0x38158000, 0x3815A000, 0x3815C000, 0x3815E000, - 0x38160000, 0x38162000, 0x38164000, 0x38166000, 0x38168000, 0x3816A000, 0x3816C000, 0x3816E000, 0x38170000, 0x38172000, 0x38174000, 0x38176000, 0x38178000, 0x3817A000, 0x3817C000, 0x3817E000, - 0x38180000, 0x38182000, 0x38184000, 0x38186000, 0x38188000, 0x3818A000, 0x3818C000, 0x3818E000, 0x38190000, 0x38192000, 0x38194000, 0x38196000, 0x38198000, 0x3819A000, 0x3819C000, 0x3819E000, - 0x381A0000, 0x381A2000, 0x381A4000, 0x381A6000, 0x381A8000, 0x381AA000, 0x381AC000, 0x381AE000, 0x381B0000, 0x381B2000, 0x381B4000, 0x381B6000, 0x381B8000, 0x381BA000, 0x381BC000, 0x381BE000, - 0x381C0000, 0x381C2000, 0x381C4000, 0x381C6000, 0x381C8000, 0x381CA000, 0x381CC000, 0x381CE000, 0x381D0000, 0x381D2000, 0x381D4000, 0x381D6000, 0x381D8000, 0x381DA000, 0x381DC000, 0x381DE000, - 0x381E0000, 0x381E2000, 0x381E4000, 0x381E6000, 0x381E8000, 0x381EA000, 0x381EC000, 0x381EE000, 0x381F0000, 0x381F2000, 0x381F4000, 0x381F6000, 0x381F8000, 0x381FA000, 0x381FC000, 0x381FE000, - 0x38200000, 0x38202000, 0x38204000, 0x38206000, 0x38208000, 0x3820A000, 0x3820C000, 0x3820E000, 0x38210000, 0x38212000, 0x38214000, 0x38216000, 0x38218000, 0x3821A000, 0x3821C000, 0x3821E000, - 0x38220000, 0x38222000, 0x38224000, 0x38226000, 0x38228000, 0x3822A000, 0x3822C000, 0x3822E000, 0x38230000, 0x38232000, 0x38234000, 0x38236000, 0x38238000, 0x3823A000, 0x3823C000, 0x3823E000, - 0x38240000, 0x38242000, 0x38244000, 0x38246000, 0x38248000, 0x3824A000, 0x3824C000, 0x3824E000, 0x38250000, 0x38252000, 0x38254000, 0x38256000, 0x38258000, 0x3825A000, 0x3825C000, 0x3825E000, - 0x38260000, 0x38262000, 0x38264000, 0x38266000, 0x38268000, 0x3826A000, 0x3826C000, 0x3826E000, 0x38270000, 0x38272000, 0x38274000, 0x38276000, 0x38278000, 0x3827A000, 0x3827C000, 0x3827E000, - 0x38280000, 0x38282000, 0x38284000, 0x38286000, 0x38288000, 0x3828A000, 0x3828C000, 0x3828E000, 0x38290000, 0x38292000, 0x38294000, 0x38296000, 0x38298000, 0x3829A000, 0x3829C000, 0x3829E000, - 0x382A0000, 0x382A2000, 0x382A4000, 0x382A6000, 0x382A8000, 0x382AA000, 0x382AC000, 0x382AE000, 0x382B0000, 0x382B2000, 0x382B4000, 0x382B6000, 0x382B8000, 0x382BA000, 0x382BC000, 0x382BE000, - 0x382C0000, 0x382C2000, 0x382C4000, 0x382C6000, 0x382C8000, 0x382CA000, 0x382CC000, 0x382CE000, 0x382D0000, 0x382D2000, 0x382D4000, 0x382D6000, 0x382D8000, 0x382DA000, 0x382DC000, 0x382DE000, - 0x382E0000, 0x382E2000, 0x382E4000, 0x382E6000, 0x382E8000, 0x382EA000, 0x382EC000, 0x382EE000, 0x382F0000, 0x382F2000, 0x382F4000, 0x382F6000, 0x382F8000, 0x382FA000, 0x382FC000, 0x382FE000, - 0x38300000, 0x38302000, 0x38304000, 0x38306000, 0x38308000, 0x3830A000, 0x3830C000, 0x3830E000, 0x38310000, 0x38312000, 0x38314000, 0x38316000, 0x38318000, 0x3831A000, 0x3831C000, 0x3831E000, - 0x38320000, 0x38322000, 0x38324000, 0x38326000, 0x38328000, 0x3832A000, 0x3832C000, 0x3832E000, 0x38330000, 0x38332000, 0x38334000, 0x38336000, 0x38338000, 0x3833A000, 0x3833C000, 0x3833E000, - 0x38340000, 0x38342000, 0x38344000, 0x38346000, 0x38348000, 0x3834A000, 0x3834C000, 0x3834E000, 0x38350000, 0x38352000, 0x38354000, 0x38356000, 0x38358000, 0x3835A000, 0x3835C000, 0x3835E000, - 0x38360000, 0x38362000, 0x38364000, 0x38366000, 0x38368000, 0x3836A000, 0x3836C000, 0x3836E000, 0x38370000, 0x38372000, 0x38374000, 0x38376000, 0x38378000, 0x3837A000, 0x3837C000, 0x3837E000, - 0x38380000, 0x38382000, 0x38384000, 0x38386000, 0x38388000, 0x3838A000, 0x3838C000, 0x3838E000, 0x38390000, 0x38392000, 0x38394000, 0x38396000, 0x38398000, 0x3839A000, 0x3839C000, 0x3839E000, - 0x383A0000, 0x383A2000, 0x383A4000, 0x383A6000, 0x383A8000, 0x383AA000, 0x383AC000, 0x383AE000, 0x383B0000, 0x383B2000, 0x383B4000, 0x383B6000, 0x383B8000, 0x383BA000, 0x383BC000, 0x383BE000, - 0x383C0000, 0x383C2000, 0x383C4000, 0x383C6000, 0x383C8000, 0x383CA000, 0x383CC000, 0x383CE000, 0x383D0000, 0x383D2000, 0x383D4000, 0x383D6000, 0x383D8000, 0x383DA000, 0x383DC000, 0x383DE000, - 0x383E0000, 0x383E2000, 0x383E4000, 0x383E6000, 0x383E8000, 0x383EA000, 0x383EC000, 0x383EE000, 0x383F0000, 0x383F2000, 0x383F4000, 0x383F6000, 0x383F8000, 0x383FA000, 0x383FC000, 0x383FE000, - 0x38400000, 0x38402000, 0x38404000, 0x38406000, 0x38408000, 0x3840A000, 0x3840C000, 0x3840E000, 0x38410000, 0x38412000, 0x38414000, 0x38416000, 0x38418000, 0x3841A000, 0x3841C000, 0x3841E000, - 0x38420000, 0x38422000, 0x38424000, 0x38426000, 0x38428000, 0x3842A000, 0x3842C000, 0x3842E000, 0x38430000, 0x38432000, 0x38434000, 0x38436000, 0x38438000, 0x3843A000, 0x3843C000, 0x3843E000, - 0x38440000, 0x38442000, 0x38444000, 0x38446000, 0x38448000, 0x3844A000, 0x3844C000, 0x3844E000, 0x38450000, 0x38452000, 0x38454000, 0x38456000, 0x38458000, 0x3845A000, 0x3845C000, 0x3845E000, - 0x38460000, 0x38462000, 0x38464000, 0x38466000, 0x38468000, 0x3846A000, 0x3846C000, 0x3846E000, 0x38470000, 0x38472000, 0x38474000, 0x38476000, 0x38478000, 0x3847A000, 0x3847C000, 0x3847E000, - 0x38480000, 0x38482000, 0x38484000, 0x38486000, 0x38488000, 0x3848A000, 0x3848C000, 0x3848E000, 0x38490000, 0x38492000, 0x38494000, 0x38496000, 0x38498000, 0x3849A000, 0x3849C000, 0x3849E000, - 0x384A0000, 0x384A2000, 0x384A4000, 0x384A6000, 0x384A8000, 0x384AA000, 0x384AC000, 0x384AE000, 0x384B0000, 0x384B2000, 0x384B4000, 0x384B6000, 0x384B8000, 0x384BA000, 0x384BC000, 0x384BE000, - 0x384C0000, 0x384C2000, 0x384C4000, 0x384C6000, 0x384C8000, 0x384CA000, 0x384CC000, 0x384CE000, 0x384D0000, 0x384D2000, 0x384D4000, 0x384D6000, 0x384D8000, 0x384DA000, 0x384DC000, 0x384DE000, - 0x384E0000, 0x384E2000, 0x384E4000, 0x384E6000, 0x384E8000, 0x384EA000, 0x384EC000, 0x384EE000, 0x384F0000, 0x384F2000, 0x384F4000, 0x384F6000, 0x384F8000, 0x384FA000, 0x384FC000, 0x384FE000, - 0x38500000, 0x38502000, 0x38504000, 0x38506000, 0x38508000, 0x3850A000, 0x3850C000, 0x3850E000, 0x38510000, 0x38512000, 0x38514000, 0x38516000, 0x38518000, 0x3851A000, 0x3851C000, 0x3851E000, - 0x38520000, 0x38522000, 0x38524000, 0x38526000, 0x38528000, 0x3852A000, 0x3852C000, 0x3852E000, 0x38530000, 0x38532000, 0x38534000, 0x38536000, 0x38538000, 0x3853A000, 0x3853C000, 0x3853E000, - 0x38540000, 0x38542000, 0x38544000, 0x38546000, 0x38548000, 0x3854A000, 0x3854C000, 0x3854E000, 0x38550000, 0x38552000, 0x38554000, 0x38556000, 0x38558000, 0x3855A000, 0x3855C000, 0x3855E000, - 0x38560000, 0x38562000, 0x38564000, 0x38566000, 0x38568000, 0x3856A000, 0x3856C000, 0x3856E000, 0x38570000, 0x38572000, 0x38574000, 0x38576000, 0x38578000, 0x3857A000, 0x3857C000, 0x3857E000, - 0x38580000, 0x38582000, 0x38584000, 0x38586000, 0x38588000, 0x3858A000, 0x3858C000, 0x3858E000, 0x38590000, 0x38592000, 0x38594000, 0x38596000, 0x38598000, 0x3859A000, 0x3859C000, 0x3859E000, - 0x385A0000, 0x385A2000, 0x385A4000, 0x385A6000, 0x385A8000, 0x385AA000, 0x385AC000, 0x385AE000, 0x385B0000, 0x385B2000, 0x385B4000, 0x385B6000, 0x385B8000, 0x385BA000, 0x385BC000, 0x385BE000, - 0x385C0000, 0x385C2000, 0x385C4000, 0x385C6000, 0x385C8000, 0x385CA000, 0x385CC000, 0x385CE000, 0x385D0000, 0x385D2000, 0x385D4000, 0x385D6000, 0x385D8000, 0x385DA000, 0x385DC000, 0x385DE000, - 0x385E0000, 0x385E2000, 0x385E4000, 0x385E6000, 0x385E8000, 0x385EA000, 0x385EC000, 0x385EE000, 0x385F0000, 0x385F2000, 0x385F4000, 0x385F6000, 0x385F8000, 0x385FA000, 0x385FC000, 0x385FE000, - 0x38600000, 0x38602000, 0x38604000, 0x38606000, 0x38608000, 0x3860A000, 0x3860C000, 0x3860E000, 0x38610000, 0x38612000, 0x38614000, 0x38616000, 0x38618000, 0x3861A000, 0x3861C000, 0x3861E000, - 0x38620000, 0x38622000, 0x38624000, 0x38626000, 0x38628000, 0x3862A000, 0x3862C000, 0x3862E000, 0x38630000, 0x38632000, 0x38634000, 0x38636000, 0x38638000, 0x3863A000, 0x3863C000, 0x3863E000, - 0x38640000, 0x38642000, 0x38644000, 0x38646000, 0x38648000, 0x3864A000, 0x3864C000, 0x3864E000, 0x38650000, 0x38652000, 0x38654000, 0x38656000, 0x38658000, 0x3865A000, 0x3865C000, 0x3865E000, - 0x38660000, 0x38662000, 0x38664000, 0x38666000, 0x38668000, 0x3866A000, 0x3866C000, 0x3866E000, 0x38670000, 0x38672000, 0x38674000, 0x38676000, 0x38678000, 0x3867A000, 0x3867C000, 0x3867E000, - 0x38680000, 0x38682000, 0x38684000, 0x38686000, 0x38688000, 0x3868A000, 0x3868C000, 0x3868E000, 0x38690000, 0x38692000, 0x38694000, 0x38696000, 0x38698000, 0x3869A000, 0x3869C000, 0x3869E000, - 0x386A0000, 0x386A2000, 0x386A4000, 0x386A6000, 0x386A8000, 0x386AA000, 0x386AC000, 0x386AE000, 0x386B0000, 0x386B2000, 0x386B4000, 0x386B6000, 0x386B8000, 0x386BA000, 0x386BC000, 0x386BE000, - 0x386C0000, 0x386C2000, 0x386C4000, 0x386C6000, 0x386C8000, 0x386CA000, 0x386CC000, 0x386CE000, 0x386D0000, 0x386D2000, 0x386D4000, 0x386D6000, 0x386D8000, 0x386DA000, 0x386DC000, 0x386DE000, - 0x386E0000, 0x386E2000, 0x386E4000, 0x386E6000, 0x386E8000, 0x386EA000, 0x386EC000, 0x386EE000, 0x386F0000, 0x386F2000, 0x386F4000, 0x386F6000, 0x386F8000, 0x386FA000, 0x386FC000, 0x386FE000, - 0x38700000, 0x38702000, 0x38704000, 0x38706000, 0x38708000, 0x3870A000, 0x3870C000, 0x3870E000, 0x38710000, 0x38712000, 0x38714000, 0x38716000, 0x38718000, 0x3871A000, 0x3871C000, 0x3871E000, - 0x38720000, 0x38722000, 0x38724000, 0x38726000, 0x38728000, 0x3872A000, 0x3872C000, 0x3872E000, 0x38730000, 0x38732000, 0x38734000, 0x38736000, 0x38738000, 0x3873A000, 0x3873C000, 0x3873E000, - 0x38740000, 0x38742000, 0x38744000, 0x38746000, 0x38748000, 0x3874A000, 0x3874C000, 0x3874E000, 0x38750000, 0x38752000, 0x38754000, 0x38756000, 0x38758000, 0x3875A000, 0x3875C000, 0x3875E000, - 0x38760000, 0x38762000, 0x38764000, 0x38766000, 0x38768000, 0x3876A000, 0x3876C000, 0x3876E000, 0x38770000, 0x38772000, 0x38774000, 0x38776000, 0x38778000, 0x3877A000, 0x3877C000, 0x3877E000, - 0x38780000, 0x38782000, 0x38784000, 0x38786000, 0x38788000, 0x3878A000, 0x3878C000, 0x3878E000, 0x38790000, 0x38792000, 0x38794000, 0x38796000, 0x38798000, 0x3879A000, 0x3879C000, 0x3879E000, - 0x387A0000, 0x387A2000, 0x387A4000, 0x387A6000, 0x387A8000, 0x387AA000, 0x387AC000, 0x387AE000, 0x387B0000, 0x387B2000, 0x387B4000, 0x387B6000, 0x387B8000, 0x387BA000, 0x387BC000, 0x387BE000, - 0x387C0000, 0x387C2000, 0x387C4000, 0x387C6000, 0x387C8000, 0x387CA000, 0x387CC000, 0x387CE000, 0x387D0000, 0x387D2000, 0x387D4000, 0x387D6000, 0x387D8000, 0x387DA000, 0x387DC000, 0x387DE000, - 0x387E0000, 0x387E2000, 0x387E4000, 0x387E6000, 0x387E8000, 0x387EA000, 0x387EC000, 0x387EE000, 0x387F0000, 0x387F2000, 0x387F4000, 0x387F6000, 0x387F8000, 0x387FA000, 0x387FC000, 0x387FE000 }; - static const bits::type exponent_table[64] = { - 0x00000000, 0x00800000, 0x01000000, 0x01800000, 0x02000000, 0x02800000, 0x03000000, 0x03800000, 0x04000000, 0x04800000, 0x05000000, 0x05800000, 0x06000000, 0x06800000, 0x07000000, 0x07800000, - 0x08000000, 0x08800000, 0x09000000, 0x09800000, 0x0A000000, 0x0A800000, 0x0B000000, 0x0B800000, 0x0C000000, 0x0C800000, 0x0D000000, 0x0D800000, 0x0E000000, 0x0E800000, 0x0F000000, 0x47800000, - 0x80000000, 0x80800000, 0x81000000, 0x81800000, 0x82000000, 0x82800000, 0x83000000, 0x83800000, 0x84000000, 0x84800000, 0x85000000, 0x85800000, 0x86000000, 0x86800000, 0x87000000, 0x87800000, - 0x88000000, 0x88800000, 0x89000000, 0x89800000, 0x8A000000, 0x8A800000, 0x8B000000, 0x8B800000, 0x8C000000, 0x8C800000, 0x8D000000, 0x8D800000, 0x8E000000, 0x8E800000, 0x8F000000, 0xC7800000 }; - static const unsigned short offset_table[64] = { - 0, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, - 0, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024, 1024 }; - bits::type fbits = mantissa_table[offset_table[value>>10]+(value&0x3FF)] + exponent_table[value>>10]; - #endif - float out; - std::memcpy(&out, &fbits, sizeof(float)); - return out; - #endif - } - - inline double half2float_impl(unsigned int value, double, true_type) - { - #if HALF_ENABLE_F16C_INTRINSICS - return _mm_cvtsd_f64(_mm_cvtps_pd(_mm_cvtph_ps(_mm_cvtsi32_si128(value)))); - #else - uint32 hi = static_cast(value&0x8000) << 16; - unsigned int abs = value & 0x7FFF; - if(abs) - { - hi |= 0x3F000000 << static_cast(abs>=0x7C00); - for(; abs<0x400; abs<<=1,hi-=0x100000) ; - hi += static_cast(abs) << 10; - } - bits::type dbits = static_cast::type>(hi) << 32; - double out; - std::memcpy(&out, &dbits, sizeof(double)); - return out; - #endif - } - - template T half2float_impl(unsigned int value, T, ...) - { - T out; - unsigned int abs = value & 0x7FFF; - if(abs > 0x7C00) - out = (std::numeric_limits::has_signaling_NaN && !(abs&0x200)) ? std::numeric_limits::signaling_NaN() : - std::numeric_limits::has_quiet_NaN ? std::numeric_limits::quiet_NaN() : T(); - else if(abs == 0x7C00) - out = std::numeric_limits::has_infinity ? std::numeric_limits::infinity() : std::numeric_limits::max(); - else if(abs > 0x3FF) - out = std::ldexp(static_cast((abs&0x3FF)|0x400), (abs>>10)-25); - else - out = std::ldexp(static_cast(abs), -24); - return (value&0x8000) ? -out : out; - } - - template T half2float(unsigned int value) - { - return half2float_impl(value, T(), bool_type::is_iec559&&sizeof(typename bits::type)==sizeof(T)>()); - } - - template T half2int(unsigned int value) - { - unsigned int abs = value & 0x7FFF; - if(abs >= 0x7C00) - { - raise(FE_INVALID); - return (value&0x8000) ? std::numeric_limits::min() : std::numeric_limits::max(); - } - if(abs < 0x3800) - { - raise(FE_INEXACT, I); - return (R==std::round_toward_infinity) ? T(~(value>>15)&(abs!=0)) : - (R==std::round_toward_neg_infinity) ? -T(value>0x8000) : - T(); - } - int exp = 25 - (abs>>10); - unsigned int m = (value&0x3FF) | 0x400; - int32 i = static_cast((exp<=0) ? (m<<-exp) : ((m+( - (R==std::round_to_nearest) ? ((1<<(exp-1))-(~(m>>exp)&E)) : - (R==std::round_toward_infinity) ? (((1<>15)-1)) : - (R==std::round_toward_neg_infinity) ? (((1<>15)) : 0))>>exp)); - if((!std::numeric_limits::is_signed && (value&0x8000)) || (std::numeric_limits::digits<16 && - ((value&0x8000) ? (-i::min()) : (i>std::numeric_limits::max())))) - raise(FE_INVALID); - else if(I && exp > 0 && (m&((1<((value&0x8000) ? -i : i); - } - - - template uint32 mulhi(uint32 x, uint32 y) - { - uint32 xy = (x>>16) * (y&0xFFFF), yx = (x&0xFFFF) * (y>>16), c = (xy&0xFFFF) + (yx&0xFFFF) + (((x&0xFFFF)*(y&0xFFFF))>>16); - return (x>>16)*(y>>16) + (xy>>16) + (yx>>16) + (c>>16) + - ((R==std::round_to_nearest) ? ((c>>15)&1) : (R==std::round_toward_infinity) ? ((c&0xFFFF)!=0) : 0); - } - - inline uint32 multiply64(uint32 x, uint32 y) - { - #if HALF_ENABLE_CPP11_LONG_LONG - return static_cast((static_cast(x)*static_cast(y)+0x80000000)>>32); - #else - return mulhi(x, y); - #endif - } - - inline uint32 divide64(uint32 x, uint32 y, int &s) - { - #if HALF_ENABLE_CPP11_LONG_LONG - unsigned long long xx = static_cast(x) << 32; - return s = (xx%y!=0), static_cast(xx/y); - #else - y >>= 1; - uint32 rem = x, div = 0; - for(unsigned int i=0; i<32; ++i) - { - div <<= 1; - if(rem >= y) - { - rem -= y; - div |= 1; - } - rem <<= 1; - } - return s = rem > 1, div; - #endif - } - - template unsigned int mod(unsigned int x, unsigned int y, int *quo = NULL) - { - unsigned int q = 0; - if(x > y) - { - int absx = x, absy = y, expx = 0, expy = 0; - for(; absx<0x400; absx<<=1,--expx) ; - for(; absy<0x400; absy<<=1,--expy) ; - expx += absx >> 10; - expy += absy >> 10; - int mx = (absx&0x3FF) | 0x400, my = (absy&0x3FF) | 0x400; - for(int d=expx-expy; d; --d) - { - if(!Q && mx == my) - return 0; - if(mx >= my) - { - mx -= my; - q += Q; - } - mx <<= 1; - q <<= static_cast(Q); - } - if(!Q && mx == my) - return 0; - if(mx >= my) - { - mx -= my; - ++q; - } - if(Q) - { - q &= (1<<(std::numeric_limits::digits-1)) - 1; - if(!mx) - return *quo = q, 0; - } - for(; mx<0x400; mx<<=1,--expy) ; - x = (expy>0) ? ((expy<<10)|(mx&0x3FF)) : (mx>>(1-expy)); - } - if(R) - { - unsigned int a, b; - if(y < 0x800) - { - a = (x<0x400) ? (x<<1) : (x+0x400); - b = y; - } - else - { - a = x; - b = y - 0x400; - } - if(a > b || (a == b && (q&1))) - { - int exp = (y>>10) + (y<=0x3FF), d = exp - (x>>10) - (x<=0x3FF); - int m = (((y&0x3FF)|((y>0x3FF)<<10))<<1) - (((x&0x3FF)|((x>0x3FF)<<10))<<(1-d)); - for(; m<0x800 && exp>1; m<<=1,--exp) ; - x = 0x8000 + ((exp-1)<<10) + (m>>1); - q += Q; - } - } - if(Q) - *quo = q; - return x; - } - - template uint32 sqrt(uint32 &r, int &exp) - { - int i = exp & 1; - r <<= i; - exp = (exp-i) / 2; - uint32 m = 0; - for(uint32 bit=static_cast(1)<>=2) - { - if(r < m+bit) - m >>= 1; - else - { - r -= m + bit; - m = (m>>1) + bit; - } - } - return m; - } - - inline uint32 exp2(uint32 m, unsigned int n = 32) - { - static const uint32 logs[] = { - 0x80000000, 0x4AE00D1D, 0x2934F098, 0x15C01A3A, 0x0B31FB7D, 0x05AEB4DD, 0x02DCF2D1, 0x016FE50B, - 0x00B84E23, 0x005C3E10, 0x002E24CA, 0x001713D6, 0x000B8A47, 0x0005C53B, 0x0002E2A3, 0x00017153, - 0x0000B8AA, 0x00005C55, 0x00002E2B, 0x00001715, 0x00000B8B, 0x000005C5, 0x000002E3, 0x00000171, - 0x000000B9, 0x0000005C, 0x0000002E, 0x00000017, 0x0000000C, 0x00000006, 0x00000003, 0x00000001 }; - if(!m) - return 0x80000000; - uint32 mx = 0x80000000, my = 0; - for(unsigned int i=1; i> i; - } - } - return mx; - } - - inline uint32 log2(uint32 m, unsigned int n = 32) - { - static const uint32 logs[] = { - 0x80000000, 0x4AE00D1D, 0x2934F098, 0x15C01A3A, 0x0B31FB7D, 0x05AEB4DD, 0x02DCF2D1, 0x016FE50B, - 0x00B84E23, 0x005C3E10, 0x002E24CA, 0x001713D6, 0x000B8A47, 0x0005C53B, 0x0002E2A3, 0x00017153, - 0x0000B8AA, 0x00005C55, 0x00002E2B, 0x00001715, 0x00000B8B, 0x000005C5, 0x000002E3, 0x00000171, - 0x000000B9, 0x0000005C, 0x0000002E, 0x00000017, 0x0000000C, 0x00000006, 0x00000003, 0x00000001 }; - if(m == 0x40000000) - return 0; - uint32 mx = 0x40000000, my = 0; - for(unsigned int i=1; i>i); - if(mz <= m) - { - mx = mz; - my += logs[i]; - } - } - return my; - } - - inline std::pair sincos(uint32 mz, unsigned int n = 31) - { - static const uint32 angles[] = { - 0x3243F6A9, 0x1DAC6705, 0x0FADBAFD, 0x07F56EA7, 0x03FEAB77, 0x01FFD55C, 0x00FFFAAB, 0x007FFF55, - 0x003FFFEB, 0x001FFFFD, 0x00100000, 0x00080000, 0x00040000, 0x00020000, 0x00010000, 0x00008000, - 0x00004000, 0x00002000, 0x00001000, 0x00000800, 0x00000400, 0x00000200, 0x00000100, 0x00000080, - 0x00000040, 0x00000020, 0x00000010, 0x00000008, 0x00000004, 0x00000002, 0x00000001 }; - uint32 mx = 0x26DD3B6A, my = 0; - for(unsigned int i=0; i0x3FF)<<10); - int exp = (abs>>10) + (abs<=0x3FF) - 15; - if(abs < 0x3A48) - return k = 0, m << (exp+20); - #if HALF_ENABLE_CPP11_LONG_LONG - unsigned long long y = m * 0xA2F9836E4E442, mask = (1ULL<<(62-exp)) - 1, yi = (y+(mask>>1)) & ~mask, f = y - yi; - uint32 sign = -static_cast(f>>63); - k = static_cast(yi>>(62-exp)); - return (multiply64(static_cast((sign ? -f : f)>>(31-exp)), 0xC90FDAA2)^sign) - sign; - #else - uint32 yh = m*0xA2F98 + mulhi(m, 0x36E4E442), yl = (m*0x36E4E442) & 0xFFFFFFFF; - uint32 mask = (static_cast(1)<<(30-exp)) - 1, yi = (yh+(mask>>1)) & ~mask, sign = -static_cast(yi>yh); - k = static_cast(yi>>(30-exp)); - uint32 fh = (yh^sign) + (yi^~sign) - ~sign, fl = (yl^sign) - sign; - return (multiply64((exp>-1) ? (((fh<<(1+exp))&0xFFFFFFFF)|((fl&0xFFFFFFFF)>>(31-exp))) : fh, 0xC90FDAA2)^sign) - sign; - #endif - } - - inline std::pair atan2_args(unsigned int abs) - { - int exp = -15; - for(; abs<0x400; abs<<=1,--exp) ; - exp += abs >> 10; - uint32 my = ((abs&0x3FF)|0x400) << 5, r = my * my; - int rexp = 2 * exp; - r = 0x40000000 - ((rexp>-31) ? ((r>>-rexp)|((r&((static_cast(1)<<-rexp)-1))!=0)) : 1); - for(rexp=0; r<0x40000000; r<<=1,--rexp) ; - uint32 mx = sqrt<30>(r, rexp); - int d = exp - rexp; - if(d < 0) - return std::make_pair((d<-14) ? ((my>>(-d-14))+((my>>(-d-15))&1)) : (my<<(14+d)), (mx<<14)+(r<<13)/mx); - if(d > 0) - return std::make_pair(my<<14, (d>14) ? ((mx>>(d-14))+((mx>>(d-15))&1)) : ((d==14) ? mx : ((mx<<(14-d))+(r<<(13-d))/mx))); - return std::make_pair(my<<13, (mx<<13)+(r<<12)/mx); - } - - inline std::pair hyperbolic_args(unsigned int abs, int &exp, unsigned int n = 32) - { - uint32 mx = detail::multiply64(static_cast((abs&0x3FF)+((abs>0x3FF)<<10))<<21, 0xB8AA3B29), my; - int e = (abs>>10) + (abs<=0x3FF); - if(e < 14) - { - exp = 0; - mx >>= 14 - e; - } - else - { - exp = mx >> (45-e); - mx = (mx<<(e-14)) & 0x7FFFFFFF; - } - mx = exp2(mx, n); - int d = exp << 1, s; - if(mx > 0x80000000) - { - my = divide64(0x80000000, mx, s); - my |= s; - ++d; - } - else - my = mx; - return std::make_pair(mx, (d<31) ? ((my>>d)|((my&((static_cast(1)< unsigned int exp2_post(uint32 m, int exp, bool esign, unsigned int sign = 0, unsigned int n = 32) - { - if(esign) - { - exp = -exp - (m!=0); - if(exp < -25) - return underflow(sign); - else if(exp == -25) - return rounded(sign, 1, m!=0); - } - else if(exp > 15) - return overflow(sign); - if(!m) - return sign | (((exp+=15)>0) ? (exp<<10) : check_underflow(0x200>>-exp)); - m = exp2(m, n); - int s = 0; - if(esign) - m = divide64(0x80000000, m, s); - return fixed2half(m, exp+14, sign, s); - } - - template unsigned int log2_post(uint32 m, int ilog, int exp, unsigned int sign = 0) - { - uint32 msign = sign_mask(ilog); - m = (((static_cast(ilog)<<27)+(m>>4))^msign) - msign; - if(!m) - return 0; - for(; m<0x80000000; m<<=1,--exp) ; - int i = m >= L, s; - exp += i; - m >>= 1 + i; - sign ^= msign & 0x8000; - if(exp < -11) - return underflow(sign); - m = divide64(m, L, s); - return fixed2half(m, exp, sign, 1); - } - - template unsigned int hypot_post(uint32 r, int exp) - { - int i = r >> 31; - if((exp+=i) > 46) - return overflow(); - if(exp < -34) - return underflow(); - r = (r>>i) | (r&i); - uint32 m = sqrt<30>(r, exp+=15); - return fixed2half(m, exp-1, 0, r!=0); - } - - template unsigned int tangent_post(uint32 my, uint32 mx, int exp, unsigned int sign = 0) - { - int i = my >= mx, s; - exp += i; - if(exp > 29) - return overflow(sign); - if(exp < -11) - return underflow(sign); - uint32 m = divide64(my>>(i+1), mx, s); - return fixed2half(m, exp, sign, s); - } - - template unsigned int area(unsigned int arg) - { - int abs = arg & 0x7FFF, expx = (abs>>10) + (abs<=0x3FF) - 15, expy = -15, ilog, i; - uint32 mx = static_cast((abs&0x3FF)|((abs>0x3FF)<<10)) << 20, my, r; - for(; abs<0x400; abs<<=1,--expy) ; - expy += abs >> 10; - r = ((abs&0x3FF)|0x400) << 5; - r *= r; - i = r >> 31; - expy = 2*expy + i; - r >>= i; - if(S) - { - if(expy < 0) - { - r = 0x40000000 + ((expy>-30) ? ((r>>-expy)|((r&((static_cast(1)<<-expy)-1))!=0)) : 1); - expy = 0; - } - else - { - r += 0x40000000 >> expy; - i = r >> 31; - r = (r>>i) | (r&i); - expy += i; - } - } - else - { - r -= 0x40000000 >> expy; - for(; r<0x40000000; r<<=1,--expy) ; - } - my = sqrt<30>(r, expy); - my = (my<<15) + (r<<14)/my; - if(S) - { - mx >>= expy - expx; - ilog = expy; - } - else - { - my >>= expx - expy; - ilog = expx; - } - my += mx; - i = my >> 31; - static const int G = S && (R==std::round_to_nearest); - return log2_post(log2(my>>i, 26+S+G)+(G<<3), ilog+i, 17, arg&(static_cast(S)<<15)); - } - - struct f31 - { - HALF_CONSTEXPR f31(uint32 mant, int e) : m(mant), exp(e) {} - - f31(unsigned int abs) : exp(-15) - { - for(; abs<0x400; abs<<=1,--exp) ; - m = static_cast((abs&0x3FF)|0x400) << 21; - exp += (abs>>10); - } - - friend f31 operator+(f31 a, f31 b) - { - if(b.exp > a.exp) - std::swap(a, b); - int d = a.exp - b.exp; - uint32 m = a.m + ((d<32) ? (b.m>>d) : 0); - int i = (m&0xFFFFFFFF) < a.m; - return f31(((m+i)>>i)|0x80000000, a.exp+i); - } - - friend f31 operator-(f31 a, f31 b) - { - int d = a.exp - b.exp, exp = a.exp; - uint32 m = a.m - ((d<32) ? (b.m>>d) : 0); - if(!m) - return f31(0, -32); - for(; m<0x80000000; m<<=1,--exp) ; - return f31(m, exp); - } - - friend f31 operator*(f31 a, f31 b) - { - uint32 m = multiply64(a.m, b.m); - int i = m >> 31; - return f31(m<<(1-i), a.exp + b.exp + i); - } - - friend f31 operator/(f31 a, f31 b) - { - int i = a.m >= b.m, s; - uint32 m = divide64((a.m+i)>>i, b.m, s); - return f31(m, a.exp - b.exp + i - 1); - } - - uint32 m; - int exp; - }; - - template unsigned int erf(unsigned int arg) - { - unsigned int abs = arg & 0x7FFF, sign = arg & 0x8000; - f31 x(abs), x2 = x * x * f31(0xB8AA3B29, 0), t = f31(0x80000000, 0) / (f31(0x80000000, 0)+f31(0xA7BA054A, -2)*x), t2 = t * t; - f31 e = ((f31(0x87DC2213, 0)*t2+f31(0xB5F0E2AE, 0))*t2+f31(0x82790637, -2)-(f31(0xBA00E2B8, 0)*t2+f31(0x91A98E62, -2))*t) * t / - ((x2.exp<0) ? f31(exp2((x2.exp>-32) ? (x2.m>>-x2.exp) : 0, 30), 0) : f31(exp2((x2.m<>(31-x2.exp))); - return (!C || sign) ? fixed2half(0x80000000-(e.m>>(C-e.exp)), 14+C, sign&(C-1U)) : - (e.exp<-25) ? underflow() : fixed2half(e.m>>1, e.exp+14, 0, e.m&1); - } - - template unsigned int gamma(unsigned int arg) - { -/* static const double p[] ={ 2.50662827563479526904, 225.525584619175212544, -268.295973841304927459, 80.9030806934622512966, -5.00757863970517583837, 0.0114684895434781459556 }; - double t = arg + 4.65, s = p[0]; - for(unsigned int i=0; i<5; ++i) - s += p[i+1] / (arg+i); - return std::log(s) + (arg-0.5)*std::log(t) - t; -*/ static const f31 pi(0xC90FDAA2, 1), lbe(0xB8AA3B29, 0); - unsigned int abs = arg & 0x7FFF, sign = arg & 0x8000; - bool bsign = sign != 0; - f31 z(abs), x = sign ? (z+f31(0x80000000, 0)) : z, t = x + f31(0x94CCCCCD, 2), s = - f31(0xA06C9901, 1) + f31(0xBBE654E2, -7)/(x+f31(0x80000000, 2)) + f31(0xA1CE6098, 6)/(x+f31(0x80000000, 1)) - + f31(0xE1868CB7, 7)/x - f31(0x8625E279, 8)/(x+f31(0x80000000, 0)) - f31(0xA03E158F, 2)/(x+f31(0xC0000000, 1)); - int i = (s.exp>=2) + (s.exp>=4) + (s.exp>=8) + (s.exp>=16); - s = f31((static_cast(s.exp)<<(31-i))+(log2(s.m>>1, 28)>>i), i) / lbe; - if(x.exp != -1 || x.m != 0x80000000) - { - i = (t.exp>=2) + (t.exp>=4) + (t.exp>=8); - f31 l = f31((static_cast(t.exp)<<(31-i))+(log2(t.m>>1, 30)>>i), i) / lbe; - s = (x.exp<-1) ? (s-(f31(0x80000000, -1)-x)*l) : (s+(x-f31(0x80000000, -1))*l); - } - s = x.exp ? (s-t) : (t-s); - if(bsign) - { - if(z.exp >= 0) - { - sign &= (L|((z.m>>(31-z.exp))&1)) - 1; - for(z=f31((z.m<<(1+z.exp))&0xFFFFFFFF, -1); z.m<0x80000000; z.m<<=1,--z.exp) ; - } - if(z.exp == -1) - z = f31(0x80000000, 0) - z; - if(z.exp < -1) - { - z = z * pi; - z.m = sincos(z.m>>(1-z.exp), 30).first; - for(z.exp=1; z.m<0x80000000; z.m<<=1,--z.exp) ; - } - else - z = f31(0x80000000, 0); - } - if(L) - { - if(bsign) - { - f31 l(0x92868247, 0); - if(z.exp < 0) - { - uint32 m = log2((z.m+1)>>1, 27); - z = f31(-((static_cast(z.exp)<<26)+(m>>5)), 5); - for(; z.m<0x80000000; z.m<<=1,--z.exp) ; - l = l + z / lbe; - } - sign = static_cast(x.exp&&(l.exp(x.exp==0) << 15; - if(s.exp < -24) - return underflow(sign); - if(s.exp > 15) - return overflow(sign); - } - } - else - { - s = s * lbe; - uint32 m; - if(s.exp < 0) - { - m = s.m >> -s.exp; - s.exp = 0; - } - else - { - m = (s.m<>(31-s.exp)); - } - s.m = exp2(m, 27); - if(!x.exp) - s = f31(0x80000000, 0) / s; - if(bsign) - { - if(z.exp < 0) - s = s * z; - s = pi / s; - if(s.exp < -24) - return underflow(sign); - } - else if(z.exp > 0 && !(z.m&((1<<(31-z.exp))-1))) - return ((s.exp+14)<<10) + (s.m>>21); - if(s.exp > 15) - return overflow(sign); - } - return fixed2half(s.m, s.exp+14, sign); - } - - template struct half_caster; - } - - class half - { - public: - - HALF_CONSTEXPR half() HALF_NOEXCEPT : data_() {} - - explicit half(float rhs) : data_(static_cast(detail::float2half(rhs))) {} - - operator float() const { return detail::half2float(data_); } - - half& operator=(float rhs) { data_ = static_cast(detail::float2half(rhs)); return *this; } - - - half& operator+=(half rhs) { return *this = *this + rhs; } - - half& operator-=(half rhs) { return *this = *this - rhs; } - - half& operator*=(half rhs) { return *this = *this * rhs; } - - half& operator/=(half rhs) { return *this = *this / rhs; } - - half& operator+=(float rhs) { return *this = *this + rhs; } - - half& operator-=(float rhs) { return *this = *this - rhs; } - - half& operator*=(float rhs) { return *this = *this * rhs; } - - half& operator/=(float rhs) { return *this = *this / rhs; } - - - half& operator++() { return *this = *this + half(detail::binary, 0x3C00); } - - half& operator--() { return *this = *this + half(detail::binary, 0xBC00); } - - half operator++(int) { half out(*this); ++*this; return out; } - - half operator--(int) { half out(*this); --*this; return out; } - - private: - static const std::float_round_style round_style = (std::float_round_style)(HALF_ROUND_STYLE); - - HALF_CONSTEXPR half(detail::binary_t, unsigned int bits) HALF_NOEXCEPT : data_(static_cast(bits)) {} - - detail::uint16 data_; - - #ifndef HALF_DOXYGEN_ONLY - friend HALF_CONSTEXPR_NOERR bool operator==(half, half); - friend HALF_CONSTEXPR_NOERR bool operator!=(half, half); - friend HALF_CONSTEXPR_NOERR bool operator<(half, half); - friend HALF_CONSTEXPR_NOERR bool operator>(half, half); - friend HALF_CONSTEXPR_NOERR bool operator<=(half, half); - friend HALF_CONSTEXPR_NOERR bool operator>=(half, half); - friend HALF_CONSTEXPR half operator-(half); - friend half operator+(half, half); - friend half operator-(half, half); - friend half operator*(half, half); - friend half operator/(half, half); - template friend std::basic_ostream& operator<<(std::basic_ostream&, half); - template friend std::basic_istream& operator>>(std::basic_istream&, half&); - friend HALF_CONSTEXPR half fabs(half); - friend half fmod(half, half); - friend half remainder(half, half); - friend half remquo(half, half, int*); - friend half fma(half, half, half); - friend HALF_CONSTEXPR_NOERR half fmax(half, half); - friend HALF_CONSTEXPR_NOERR half fmin(half, half); - friend half fdim(half, half); - friend half nanh(const char*); - friend half exp(half); - friend half exp2(half); - friend half expm1(half); - friend half log(half); - friend half log10(half); - friend half log2(half); - friend half log1p(half); - friend half sqrt(half); - friend half rsqrt(half); - friend half cbrt(half); - friend half hypot(half, half); - friend half hypot(half, half, half); - friend half pow(half, half); - friend void sincos(half, half*, half*); - friend half sin(half); - friend half cos(half); - friend half tan(half); - friend half asin(half); - friend half acos(half); - friend half atan(half); - friend half atan2(half, half); - friend half sinh(half); - friend half cosh(half); - friend half tanh(half); - friend half asinh(half); - friend half acosh(half); - friend half atanh(half); - friend half erf(half); - friend half erfc(half); - friend half lgamma(half); - friend half tgamma(half); - friend half ceil(half); - friend half floor(half); - friend half trunc(half); - friend half round(half); - friend long lround(half); - friend half rint(half); - friend long lrint(half); - friend half nearbyint(half); - #ifdef HALF_ENABLE_CPP11_LONG_LONG - friend long long llround(half); - friend long long llrint(half); - #endif - friend half frexp(half, int*); - friend half scalbln(half, long); - friend half modf(half, half*); - friend int ilogb(half); - friend half logb(half); - friend half nextafter(half, half); - friend half nexttoward(half, long double); - friend HALF_CONSTEXPR half copysign(half, half); - friend HALF_CONSTEXPR int fpclassify(half); - friend HALF_CONSTEXPR bool isfinite(half); - friend HALF_CONSTEXPR bool isinf(half); - friend HALF_CONSTEXPR bool isnan(half); - friend HALF_CONSTEXPR bool isnormal(half); - friend HALF_CONSTEXPR bool signbit(half); - friend HALF_CONSTEXPR bool isgreater(half, half); - friend HALF_CONSTEXPR bool isgreaterequal(half, half); - friend HALF_CONSTEXPR bool isless(half, half); - friend HALF_CONSTEXPR bool islessequal(half, half); - friend HALF_CONSTEXPR bool islessgreater(half, half); - template friend struct detail::half_caster; - friend class std::numeric_limits; - #if HALF_ENABLE_CPP11_HASH - friend struct std::hash; - #endif - #if HALF_ENABLE_CPP11_USER_LITERALS - friend half literal::operator "" _h(long double); - #endif - #endif - }; - -#if HALF_ENABLE_CPP11_USER_LITERALS - namespace literal - { - inline half operator "" _h(long double value) { return half(detail::binary, detail::float2half(value)); } - } -#endif - - namespace detail - { - template struct half_caster {}; - template struct half_caster - { - #if HALF_ENABLE_CPP11_STATIC_ASSERT && HALF_ENABLE_CPP11_TYPE_TRAITS - static_assert(std::is_arithmetic::value, "half_cast from non-arithmetic type unsupported"); - #endif - - static half cast(U arg) { return cast_impl(arg, is_float()); }; - - private: - static half cast_impl(U arg, true_type) { return half(binary, float2half(arg)); } - static half cast_impl(U arg, false_type) { return half(binary, int2half(arg)); } - }; - template struct half_caster - { - #if HALF_ENABLE_CPP11_STATIC_ASSERT && HALF_ENABLE_CPP11_TYPE_TRAITS - static_assert(std::is_arithmetic::value, "half_cast to non-arithmetic type unsupported"); - #endif - - static T cast(half arg) { return cast_impl(arg, is_float()); } - - private: - static T cast_impl(half arg, true_type) { return half2float(arg.data_); } - static T cast_impl(half arg, false_type) { return half2int(arg.data_); } - }; - template struct half_caster - { - static half cast(half arg) { return arg; } - }; - } -} - -namespace std -{ - template<> class numeric_limits - { - public: - static HALF_CONSTEXPR_CONST bool is_specialized = true; - - static HALF_CONSTEXPR_CONST bool is_signed = true; - - static HALF_CONSTEXPR_CONST bool is_integer = false; - - static HALF_CONSTEXPR_CONST bool is_exact = false; - - static HALF_CONSTEXPR_CONST bool is_modulo = false; - - static HALF_CONSTEXPR_CONST bool is_bounded = true; - - static HALF_CONSTEXPR_CONST bool is_iec559 = true; - - static HALF_CONSTEXPR_CONST bool has_infinity = true; - - static HALF_CONSTEXPR_CONST bool has_quiet_NaN = true; - - static HALF_CONSTEXPR_CONST bool has_signaling_NaN = true; - - static HALF_CONSTEXPR_CONST float_denorm_style has_denorm = denorm_present; - - static HALF_CONSTEXPR_CONST bool has_denorm_loss = false; - - #if HALF_ERRHANDLING_THROWS - static HALF_CONSTEXPR_CONST bool traps = true; - #else - static HALF_CONSTEXPR_CONST bool traps = false; - #endif - - static HALF_CONSTEXPR_CONST bool tinyness_before = false; - - static HALF_CONSTEXPR_CONST float_round_style round_style = half_float::half::round_style; - - static HALF_CONSTEXPR_CONST int digits = 11; - - static HALF_CONSTEXPR_CONST int digits10 = 3; - - static HALF_CONSTEXPR_CONST int max_digits10 = 5; - - static HALF_CONSTEXPR_CONST int radix = 2; - - static HALF_CONSTEXPR_CONST int min_exponent = -13; - - static HALF_CONSTEXPR_CONST int min_exponent10 = -4; - - static HALF_CONSTEXPR_CONST int max_exponent = 16; - - static HALF_CONSTEXPR_CONST int max_exponent10 = 4; - - static HALF_CONSTEXPR half_float::half min() HALF_NOTHROW { return half_float::half(half_float::detail::binary, 0x0400); } - - static HALF_CONSTEXPR half_float::half lowest() HALF_NOTHROW { return half_float::half(half_float::detail::binary, 0xFBFF); } - - static HALF_CONSTEXPR half_float::half max() HALF_NOTHROW { return half_float::half(half_float::detail::binary, 0x7BFF); } - - static HALF_CONSTEXPR half_float::half epsilon() HALF_NOTHROW { return half_float::half(half_float::detail::binary, 0x1400); } - - static HALF_CONSTEXPR half_float::half round_error() HALF_NOTHROW - { return half_float::half(half_float::detail::binary, (round_style==std::round_to_nearest) ? 0x3800 : 0x3C00); } - - static HALF_CONSTEXPR half_float::half infinity() HALF_NOTHROW { return half_float::half(half_float::detail::binary, 0x7C00); } - - static HALF_CONSTEXPR half_float::half quiet_NaN() HALF_NOTHROW { return half_float::half(half_float::detail::binary, 0x7FFF); } - - static HALF_CONSTEXPR half_float::half signaling_NaN() HALF_NOTHROW { return half_float::half(half_float::detail::binary, 0x7DFF); } - - static HALF_CONSTEXPR half_float::half denorm_min() HALF_NOTHROW { return half_float::half(half_float::detail::binary, 0x0001); } - }; - -#if HALF_ENABLE_CPP11_HASH - template<> struct hash - { - typedef half_float::half argument_type; - - typedef size_t result_type; - - result_type operator()(argument_type arg) const { return hash()(arg.data_&-static_cast(arg.data_!=0x8000)); } - }; -#endif -} - -namespace half_float -{ - - inline HALF_CONSTEXPR_NOERR bool operator==(half x, half y) - { - return !detail::compsignal(x.data_, y.data_) && (x.data_==y.data_ || !((x.data_|y.data_)&0x7FFF)); - } - - inline HALF_CONSTEXPR_NOERR bool operator!=(half x, half y) - { - return detail::compsignal(x.data_, y.data_) || (x.data_!=y.data_ && ((x.data_|y.data_)&0x7FFF)); - } - - inline HALF_CONSTEXPR_NOERR bool operator<(half x, half y) - { - return !detail::compsignal(x.data_, y.data_) && - ((x.data_^(0x8000|(0x8000-(x.data_>>15))))+(x.data_>>15)) < ((y.data_^(0x8000|(0x8000-(y.data_>>15))))+(y.data_>>15)); - } - - inline HALF_CONSTEXPR_NOERR bool operator>(half x, half y) - { - return !detail::compsignal(x.data_, y.data_) && - ((x.data_^(0x8000|(0x8000-(x.data_>>15))))+(x.data_>>15)) > ((y.data_^(0x8000|(0x8000-(y.data_>>15))))+(y.data_>>15)); - } - - inline HALF_CONSTEXPR_NOERR bool operator<=(half x, half y) - { - return !detail::compsignal(x.data_, y.data_) && - ((x.data_^(0x8000|(0x8000-(x.data_>>15))))+(x.data_>>15)) <= ((y.data_^(0x8000|(0x8000-(y.data_>>15))))+(y.data_>>15)); - } - - inline HALF_CONSTEXPR_NOERR bool operator>=(half x, half y) - { - return !detail::compsignal(x.data_, y.data_) && - ((x.data_^(0x8000|(0x8000-(x.data_>>15))))+(x.data_>>15)) >= ((y.data_^(0x8000|(0x8000-(y.data_>>15))))+(y.data_>>15)); - } - - - inline HALF_CONSTEXPR half operator+(half arg) { return arg; } - - inline HALF_CONSTEXPR half operator-(half arg) { return half(detail::binary, arg.data_^0x8000); } - - inline half operator+(half x, half y) - { - #ifdef HALF_ARITHMETIC_TYPE - return half(detail::binary, detail::float2half(detail::half2float(x.data_)+detail::half2float(y.data_))); - #else - int absx = x.data_ & 0x7FFF, absy = y.data_ & 0x7FFF; - bool sub = ((x.data_^y.data_)&0x8000) != 0; - if(absx >= 0x7C00 || absy >= 0x7C00) - return half(detail::binary, (absx>0x7C00 || absy>0x7C00) ? detail::signal(x.data_, y.data_) : (absy!=0x7C00) ? x.data_ : - (sub && absx==0x7C00) ? detail::invalid() : y.data_); - if(!absx) - return absy ? y : half(detail::binary, (half::round_style==std::round_toward_neg_infinity) ? (x.data_|y.data_) : (x.data_&y.data_)); - if(!absy) - return x; - unsigned int sign = ((sub && absy>absx) ? y.data_ : x.data_) & 0x8000; - if(absy > absx) - std::swap(absx, absy); - int exp = (absx>>10) + (absx<=0x3FF), d = exp - (absy>>10) - (absy<=0x3FF), mx = ((absx&0x3FF)|((absx>0x3FF)<<10)) << 3, my; - if(d < 13) - { - my = ((absy&0x3FF)|((absy>0x3FF)<<10)) << 3; - my = (my>>d) | ((my&((1<(half::round_style==std::round_toward_neg_infinity)<<15); - for(; mx<0x2000 && exp>1; mx<<=1,--exp) ; - } - else - { - mx += my; - int i = mx >> 14; - if((exp+=i) > 30) - return half(detail::binary, detail::overflow(sign)); - mx = (mx>>i) | (mx&i); - } - return half(detail::binary, detail::rounded(sign+((exp-1)<<10)+(mx>>3), (mx>>2)&1, (mx&0x3)!=0)); - #endif - } - - inline half operator-(half x, half y) - { - #ifdef HALF_ARITHMETIC_TYPE - return half(detail::binary, detail::float2half(detail::half2float(x.data_)-detail::half2float(y.data_))); - #else - return x + -y; - #endif - } - - inline half operator*(half x, half y) - { - #ifdef HALF_ARITHMETIC_TYPE - return half(detail::binary, detail::float2half(detail::half2float(x.data_)*detail::half2float(y.data_))); - #else - int absx = x.data_ & 0x7FFF, absy = y.data_ & 0x7FFF, exp = -16; - unsigned int sign = (x.data_^y.data_) & 0x8000; - if(absx >= 0x7C00 || absy >= 0x7C00) - return half(detail::binary, (absx>0x7C00 || absy>0x7C00) ? detail::signal(x.data_, y.data_) : - ((absx==0x7C00 && !absy)||(absy==0x7C00 && !absx)) ? detail::invalid() : (sign|0x7C00)); - if(!absx || !absy) - return half(detail::binary, sign); - for(; absx<0x400; absx<<=1,--exp) ; - for(; absy<0x400; absy<<=1,--exp) ; - detail::uint32 m = static_cast((absx&0x3FF)|0x400) * static_cast((absy&0x3FF)|0x400); - int i = m >> 21, s = m & i; - exp += (absx>>10) + (absy>>10) + i; - if(exp > 29) - return half(detail::binary, detail::overflow(sign)); - else if(exp < -11) - return half(detail::binary, detail::underflow(sign)); - return half(detail::binary, detail::fixed2half(m>>i, exp, sign, s)); - #endif - } - - inline half operator/(half x, half y) - { - #ifdef HALF_ARITHMETIC_TYPE - return half(detail::binary, detail::float2half(detail::half2float(x.data_)/detail::half2float(y.data_))); - #else - int absx = x.data_ & 0x7FFF, absy = y.data_ & 0x7FFF, exp = 14; - unsigned int sign = (x.data_^y.data_) & 0x8000; - if(absx >= 0x7C00 || absy >= 0x7C00) - return half(detail::binary, (absx>0x7C00 || absy>0x7C00) ? detail::signal(x.data_, y.data_) : - (absx==absy) ? detail::invalid() : (sign|((absx==0x7C00) ? 0x7C00 : 0))); - if(!absx) - return half(detail::binary, absy ? sign : detail::invalid()); - if(!absy) - return half(detail::binary, detail::pole(sign)); - for(; absx<0x400; absx<<=1,--exp) ; - for(; absy<0x400; absy<<=1,++exp) ; - detail::uint32 mx = (absx&0x3FF) | 0x400, my = (absy&0x3FF) | 0x400; - int i = mx < my; - exp += (absx>>10) - (absy>>10) - i; - if(exp > 29) - return half(detail::binary, detail::overflow(sign)); - else if(exp < -11) - return half(detail::binary, detail::underflow(sign)); - mx <<= 12 + i; - my <<= 1; - return half(detail::binary, detail::fixed2half(mx/my, exp, sign, mx%my!=0)); - #endif - } - - - template std::basic_ostream& operator<<(std::basic_ostream &out, half arg) - { - #ifdef HALF_ARITHMETIC_TYPE - return out << detail::half2float(arg.data_); - #else - return out << detail::half2float(arg.data_); - #endif - } - - template std::basic_istream& operator>>(std::basic_istream &in, half &arg) - { - #ifdef HALF_ARITHMETIC_TYPE - detail::internal_t f; - #else - double f; - #endif - if(in >> f) - arg.data_ = detail::float2half(f); - return in; - } - - - inline HALF_CONSTEXPR half fabs(half arg) { return half(detail::binary, arg.data_&0x7FFF); } - - inline HALF_CONSTEXPR half abs(half arg) { return fabs(arg); } - - inline half fmod(half x, half y) - { - unsigned int absx = x.data_ & 0x7FFF, absy = y.data_ & 0x7FFF, sign = x.data_ & 0x8000; - if(absx >= 0x7C00 || absy >= 0x7C00) - return half(detail::binary, (absx>0x7C00 || absy>0x7C00) ? detail::signal(x.data_, y.data_) : - (absx==0x7C00) ? detail::invalid() : x.data_); - if(!absy) - return half(detail::binary, detail::invalid()); - if(!absx) - return x; - if(absx == absy) - return half(detail::binary, sign); - return half(detail::binary, sign|detail::mod(absx, absy)); - } - - inline half remainder(half x, half y) - { - unsigned int absx = x.data_ & 0x7FFF, absy = y.data_ & 0x7FFF, sign = x.data_ & 0x8000; - if(absx >= 0x7C00 || absy >= 0x7C00) - return half(detail::binary, (absx>0x7C00 || absy>0x7C00) ? detail::signal(x.data_, y.data_) : - (absx==0x7C00) ? detail::invalid() : x.data_); - if(!absy) - return half(detail::binary, detail::invalid()); - if(absx == absy) - return half(detail::binary, sign); - return half(detail::binary, sign^detail::mod(absx, absy)); - } - - inline half remquo(half x, half y, int *quo) - { - unsigned int absx = x.data_ & 0x7FFF, absy = y.data_ & 0x7FFF, value = x.data_ & 0x8000; - if(absx >= 0x7C00 || absy >= 0x7C00) - return half(detail::binary, (absx>0x7C00 || absy>0x7C00) ? detail::signal(x.data_, y.data_) : - (absx==0x7C00) ? detail::invalid() : (*quo = 0, x.data_)); - if(!absy) - return half(detail::binary, detail::invalid()); - bool qsign = ((value^y.data_)&0x8000) != 0; - int q = 1; - if(absx != absy) - value ^= detail::mod(absx, absy, &q); - return *quo = qsign ? -q : q, half(detail::binary, value); - } - - inline half fma(half x, half y, half z) - { - #ifdef HALF_ARITHMETIC_TYPE - detail::internal_t fx = detail::half2float(x.data_), fy = detail::half2float(y.data_), fz = detail::half2float(z.data_); - #if HALF_ENABLE_CPP11_CMATH && FP_FAST_FMA - return half(detail::binary, detail::float2half(std::fma(fx, fy, fz))); - #else - return half(detail::binary, detail::float2half(fx*fy+fz)); - #endif - #else - int absx = x.data_ & 0x7FFF, absy = y.data_ & 0x7FFF, absz = z.data_ & 0x7FFF, exp = -15; - unsigned int sign = (x.data_^y.data_) & 0x8000; - bool sub = ((sign^z.data_)&0x8000) != 0; - if(absx >= 0x7C00 || absy >= 0x7C00 || absz >= 0x7C00) - return (absx>0x7C00 || absy>0x7C00 || absz>0x7C00) ? half(detail::binary, detail::signal(x.data_, y.data_, z.data_)) : - (absx==0x7C00) ? half(detail::binary, (!absy || (sub && absz==0x7C00)) ? detail::invalid() : (sign|0x7C00)) : - (absy==0x7C00) ? half(detail::binary, (!absx || (sub && absz==0x7C00)) ? detail::invalid() : (sign|0x7C00)) : z; - if(!absx || !absy) - return absz ? z : half(detail::binary, (half::round_style==std::round_toward_neg_infinity) ? (z.data_|sign) : (z.data_&sign)); - for(; absx<0x400; absx<<=1,--exp) ; - for(; absy<0x400; absy<<=1,--exp) ; - detail::uint32 m = static_cast((absx&0x3FF)|0x400) * static_cast((absy&0x3FF)|0x400); - int i = m >> 21; - exp += (absx>>10) + (absy>>10) + i; - m <<= 3 - i; - if(absz) - { - int expz = 0; - for(; absz<0x400; absz<<=1,--expz) ; - expz += absz >> 10; - detail::uint32 mz = static_cast((absz&0x3FF)|0x400) << 13; - if(expz > exp || (expz == exp && mz > m)) - { - std::swap(m, mz); - std::swap(exp, expz); - if(sub) - sign = z.data_ & 0x8000; - } - int d = exp - expz; - mz = (d<23) ? ((mz>>d)|((mz&((static_cast(1)<(half::round_style==std::round_toward_neg_infinity)<<15); - for(; m<0x800000; m<<=1,--exp) ; - } - else - { - m += mz; - i = m >> 24; - m = (m>>i) | (m&i); - exp += i; - } - } - if(exp > 30) - return half(detail::binary, detail::overflow(sign)); - else if(exp < -10) - return half(detail::binary, detail::underflow(sign)); - return half(detail::binary, detail::fixed2half(m, exp-1, sign)); - #endif - } - - inline HALF_CONSTEXPR_NOERR half fmax(half x, half y) - { - return half(detail::binary, (!isnan(y) && (isnan(x) || (x.data_^(0x8000|(0x8000-(x.data_>>15)))) < - (y.data_^(0x8000|(0x8000-(y.data_>>15)))))) ? detail::select(y.data_, x.data_) : detail::select(x.data_, y.data_)); - } - - inline HALF_CONSTEXPR_NOERR half fmin(half x, half y) - { - return half(detail::binary, (!isnan(y) && (isnan(x) || (x.data_^(0x8000|(0x8000-(x.data_>>15)))) > - (y.data_^(0x8000|(0x8000-(y.data_>>15)))))) ? detail::select(y.data_, x.data_) : detail::select(x.data_, y.data_)); - } - - inline half fdim(half x, half y) - { - if(isnan(x) || isnan(y)) - return half(detail::binary, detail::signal(x.data_, y.data_)); - return (x.data_^(0x8000|(0x8000-(x.data_>>15)))) <= (y.data_^(0x8000|(0x8000-(y.data_>>15)))) ? half(detail::binary, 0) : (x-y); - } - - inline half nanh(const char *arg) - { - unsigned int value = 0x7FFF; - while(*arg) - value ^= static_cast(*arg++) & 0xFF; - return half(detail::binary, value); - } - - - inline half exp(half arg) - { - #ifdef HALF_ARITHMETIC_TYPE - return half(detail::binary, detail::float2half(std::exp(detail::half2float(arg.data_)))); - #else - int abs = arg.data_ & 0x7FFF, e = (abs>>10) + (abs<=0x3FF), exp; - if(!abs) - return half(detail::binary, 0x3C00); - if(abs >= 0x7C00) - return half(detail::binary, (abs==0x7C00) ? (0x7C00&((arg.data_>>15)-1U)) : detail::signal(arg.data_)); - if(abs >= 0x4C80) - return half(detail::binary, (arg.data_&0x8000) ? detail::underflow() : detail::overflow()); - detail::uint32 m = detail::multiply64(static_cast((abs&0x3FF)+((abs>0x3FF)<<10))<<21, 0xB8AA3B29); - if(e < 14) - { - exp = 0; - m >>= 14 - e; - } - else - { - exp = m >> (45-e); - m = (m<<(e-14)) & 0x7FFFFFFF; - } - return half(detail::binary, detail::exp2_post(m, exp, (arg.data_&0x8000)!=0, 0, 26)); - #endif - } - - inline half exp2(half arg) - { - #if defined(HALF_ARITHMETIC_TYPE) && HALF_ENABLE_CPP11_CMATH - return half(detail::binary, detail::float2half(std::exp2(detail::half2float(arg.data_)))); - #else - int abs = arg.data_ & 0x7FFF, e = (abs>>10) + (abs<=0x3FF), exp = (abs&0x3FF) + ((abs>0x3FF)<<10); - if(!abs) - return half(detail::binary, 0x3C00); - if(abs >= 0x7C00) - return half(detail::binary, (abs==0x7C00) ? (0x7C00&((arg.data_>>15)-1U)) : detail::signal(arg.data_)); - if(abs >= 0x4E40) - return half(detail::binary, (arg.data_&0x8000) ? detail::underflow() : detail::overflow()); - return half(detail::binary, detail::exp2_post( - (static_cast(exp)<<(6+e))&0x7FFFFFFF, exp>>(25-e), (arg.data_&0x8000)!=0, 0, 28)); - #endif - } - - inline half expm1(half arg) - { - #if defined(HALF_ARITHMETIC_TYPE) && HALF_ENABLE_CPP11_CMATH - return half(detail::binary, detail::float2half(std::expm1(detail::half2float(arg.data_)))); - #else - unsigned int abs = arg.data_ & 0x7FFF, sign = arg.data_ & 0x8000, e = (abs>>10) + (abs<=0x3FF), exp; - if(!abs) - return arg; - if(abs >= 0x7C00) - return half(detail::binary, (abs==0x7C00) ? (0x7C00+(sign>>1)) : detail::signal(arg.data_)); - if(abs >= 0x4A00) - return half(detail::binary, (arg.data_&0x8000) ? detail::rounded(0xBBFF, 1, 1) : detail::overflow()); - detail::uint32 m = detail::multiply64(static_cast((abs&0x3FF)+((abs>0x3FF)<<10))<<21, 0xB8AA3B29); - if(e < 14) - { - exp = 0; - m >>= 14 - e; - } - else - { - exp = m >> (45-e); - m = (m<<(e-14)) & 0x7FFFFFFF; - } - m = detail::exp2(m); - if(sign) - { - int s = 0; - if(m > 0x80000000) - { - ++exp; - m = detail::divide64(0x80000000, m, s); - } - m = 0x80000000 - ((m>>exp)|((m&((static_cast(1)<>exp) : 1; - for(exp+=14; m<0x80000000 && exp; m<<=1,--exp) ; - if(exp > 29) - return half(detail::binary, detail::overflow()); - return half(detail::binary, detail::rounded(sign+(exp<<10)+(m>>21), (m>>20)&1, (m&0xFFFFF)!=0)); - #endif - } - - inline half log(half arg) - { - #ifdef HALF_ARITHMETIC_TYPE - return half(detail::binary, detail::float2half(std::log(detail::half2float(arg.data_)))); - #else - int abs = arg.data_ & 0x7FFF, exp = -15; - if(!abs) - return half(detail::binary, detail::pole(0x8000)); - if(arg.data_ & 0x8000) - return half(detail::binary, (arg.data_<=0xFC00) ? detail::invalid() : detail::signal(arg.data_)); - if(abs >= 0x7C00) - return (abs==0x7C00) ? arg : half(detail::binary, detail::signal(arg.data_)); - for(; abs<0x400; abs<<=1,--exp) ; - exp += abs >> 10; - return half(detail::binary, detail::log2_post( - detail::log2(static_cast((abs&0x3FF)|0x400)<<20, 27)+8, exp, 17)); - #endif - } - - inline half log10(half arg) - { - #ifdef HALF_ARITHMETIC_TYPE - return half(detail::binary, detail::float2half(std::log10(detail::half2float(arg.data_)))); - #else - int abs = arg.data_ & 0x7FFF, exp = -15; - if(!abs) - return half(detail::binary, detail::pole(0x8000)); - if(arg.data_ & 0x8000) - return half(detail::binary, (arg.data_<=0xFC00) ? detail::invalid() : detail::signal(arg.data_)); - if(abs >= 0x7C00) - return (abs==0x7C00) ? arg : half(detail::binary, detail::signal(arg.data_)); - switch(abs) - { - case 0x4900: return half(detail::binary, 0x3C00); - case 0x5640: return half(detail::binary, 0x4000); - case 0x63D0: return half(detail::binary, 0x4200); - case 0x70E2: return half(detail::binary, 0x4400); - } - for(; abs<0x400; abs<<=1,--exp) ; - exp += abs >> 10; - return half(detail::binary, detail::log2_post( - detail::log2(static_cast((abs&0x3FF)|0x400)<<20, 27)+8, exp, 16)); - #endif - } - - inline half log2(half arg) - { - #if defined(HALF_ARITHMETIC_TYPE) && HALF_ENABLE_CPP11_CMATH - return half(detail::binary, detail::float2half(std::log2(detail::half2float(arg.data_)))); - #else - int abs = arg.data_ & 0x7FFF, exp = -15, s = 0; - if(!abs) - return half(detail::binary, detail::pole(0x8000)); - if(arg.data_ & 0x8000) - return half(detail::binary, (arg.data_<=0xFC00) ? detail::invalid() : detail::signal(arg.data_)); - if(abs >= 0x7C00) - return (abs==0x7C00) ? arg : half(detail::binary, detail::signal(arg.data_)); - if(abs == 0x3C00) - return half(detail::binary, 0); - for(; abs<0x400; abs<<=1,--exp) ; - exp += (abs>>10); - if(!(abs&0x3FF)) - { - unsigned int value = static_cast(exp<0) << 15, m = std::abs(exp) << 6; - for(exp=18; m<0x400; m<<=1,--exp) ; - return half(detail::binary, value+(exp<<10)+m); - } - detail::uint32 ilog = exp, sign = detail::sign_mask(ilog), m = - (((ilog<<27)+(detail::log2(static_cast((abs&0x3FF)|0x400)<<20, 28)>>4))^sign) - sign; - if(!m) - return half(detail::binary, 0); - for(exp=14; m<0x8000000 && exp; m<<=1,--exp) ; - for(; m>0xFFFFFFF; m>>=1,++exp) - s |= m & 1; - return half(detail::binary, detail::fixed2half(m, exp, sign&0x8000, s)); - #endif - } - - inline half log1p(half arg) - { - #if defined(HALF_ARITHMETIC_TYPE) && HALF_ENABLE_CPP11_CMATH - return half(detail::binary, detail::float2half(std::log1p(detail::half2float(arg.data_)))); - #else - if(arg.data_ >= 0xBC00) - return half(detail::binary, (arg.data_==0xBC00) ? detail::pole(0x8000) : (arg.data_<=0xFC00) ? detail::invalid() : detail::signal(arg.data_)); - int abs = arg.data_ & 0x7FFF, exp = -15; - if(!abs || abs >= 0x7C00) - return (abs>0x7C00) ? half(detail::binary, detail::signal(arg.data_)) : arg; - for(; abs<0x400; abs<<=1,--exp) ; - exp += abs >> 10; - detail::uint32 m = static_cast((abs&0x3FF)|0x400) << 20; - if(arg.data_ & 0x8000) - { - m = 0x40000000 - (m>>-exp); - for(exp=0; m<0x40000000; m<<=1,--exp) ; - } - else - { - if(exp < 0) - { - m = 0x40000000 + (m>>-exp); - exp = 0; - } - else - { - m += 0x40000000 >> exp; - int i = m >> 31; - m >>= i; - exp += i; - } - } - return half(detail::binary, detail::log2_post(detail::log2(m), exp, 17)); - #endif - } - - - inline half sqrt(half arg) - { - #ifdef HALF_ARITHMETIC_TYPE - return half(detail::binary, detail::float2half(std::sqrt(detail::half2float(arg.data_)))); - #else - int abs = arg.data_ & 0x7FFF, exp = 15; - if(!abs || arg.data_ >= 0x7C00) - return half(detail::binary, (abs>0x7C00) ? detail::signal(arg.data_) : (arg.data_>0x8000) ? detail::invalid() : arg.data_); - for(; abs<0x400; abs<<=1,--exp) ; - detail::uint32 r = static_cast((abs&0x3FF)|0x400) << 10, m = detail::sqrt<20>(r, exp+=abs>>10); - return half(detail::binary, detail::rounded((exp<<10)+(m&0x3FF), r>m, r!=0)); - #endif - } - - inline half rsqrt(half arg) - { - #ifdef HALF_ARITHMETIC_TYPE - return half(detail::binary, detail::float2half(detail::internal_t(1)/std::sqrt(detail::half2float(arg.data_)))); - #else - unsigned int abs = arg.data_ & 0x7FFF, bias = 0x4000; - if(!abs || arg.data_ >= 0x7C00) - return half(detail::binary, (abs>0x7C00) ? detail::signal(arg.data_) : (arg.data_>0x8000) ? - detail::invalid() : !abs ? detail::pole(arg.data_&0x8000) : 0); - for(; abs<0x400; abs<<=1,bias-=0x400) ; - unsigned int frac = (abs+=bias) & 0x7FF; - if(frac == 0x400) - return half(detail::binary, 0x7A00-(abs>>1)); - if((half::round_style == std::round_to_nearest && (frac == 0x3FE || frac == 0x76C)) || - (half::round_style != std::round_to_nearest && (frac == 0x15A || frac == 0x3FC || frac == 0x401 || frac == 0x402 || frac == 0x67B))) - return pow(arg, half(detail::binary, 0xB800)); - detail::uint32 f = 0x17376 - abs, mx = (abs&0x3FF) | 0x400, my = ((f>>1)&0x3FF) | 0x400, mz = my * my; - int expy = (f>>11) - 31, expx = 32 - (abs>>10), i = mz >> 21; - for(mz=0x60000000-(((mz>>i)*mx)>>(expx-2*expy-i)); mz<0x40000000; mz<<=1,--expy) ; - i = (my*=mz>>10) >> 31; - expy += i; - my = (my>>(20+i)) + 1; - i = (mz=my*my) >> 21; - for(mz=0x60000000-(((mz>>i)*mx)>>(expx-2*expy-i)); mz<0x40000000; mz<<=1,--expy) ; - i = (my*=(mz>>10)+1) >> 31; - return half(detail::binary, detail::fixed2half(my>>i, expy+i+14)); - #endif - } - - inline half cbrt(half arg) - { - #if defined(HALF_ARITHMETIC_TYPE) && HALF_ENABLE_CPP11_CMATH - return half(detail::binary, detail::float2half(std::cbrt(detail::half2float(arg.data_)))); - #else - int abs = arg.data_ & 0x7FFF, exp = -15; - if(!abs || abs == 0x3C00 || abs >= 0x7C00) - return (abs>0x7C00) ? half(detail::binary, detail::signal(arg.data_)) : arg; - for(; abs<0x400; abs<<=1, --exp); - detail::uint32 ilog = exp + (abs>>10), sign = detail::sign_mask(ilog), f, m = - (((ilog<<27)+(detail::log2(static_cast((abs&0x3FF)|0x400)<<20, 24)>>4))^sign) - sign; - for(exp=2; m<0x80000000; m<<=1,--exp) ; - m = detail::multiply64(m, 0xAAAAAAAB); - int i = m >> 31, s; - exp += i; - m <<= 1 - i; - if(exp < 0) - { - f = m >> -exp; - exp = 0; - } - else - { - f = (m<> (31-exp); - } - m = detail::exp2(f, (half::round_style==std::round_to_nearest) ? 29 : 26); - if(sign) - { - if(m > 0x80000000) - { - m = detail::divide64(0x80000000, m, s); - ++exp; - } - exp = -exp; - } - return half(detail::binary, (half::round_style==std::round_to_nearest) ? - detail::fixed2half(m, exp+14, arg.data_&0x8000) : - detail::fixed2half((m+0x80)>>8, exp+14, arg.data_&0x8000)); - #endif - } - - inline half hypot(half x, half y) - { - #ifdef HALF_ARITHMETIC_TYPE - detail::internal_t fx = detail::half2float(x.data_), fy = detail::half2float(y.data_); - #if HALF_ENABLE_CPP11_CMATH - return half(detail::binary, detail::float2half(std::hypot(fx, fy))); - #else - return half(detail::binary, detail::float2half(std::sqrt(fx*fx+fy*fy))); - #endif - #else - int absx = x.data_ & 0x7FFF, absy = y.data_ & 0x7FFF, expx = 0, expy = 0; - if(absx >= 0x7C00 || absy >= 0x7C00) - return half(detail::binary, (absx==0x7C00) ? detail::select(0x7C00, y.data_) : - (absy==0x7C00) ? detail::select(0x7C00, x.data_) : detail::signal(x.data_, y.data_)); - if(!absx) - return half(detail::binary, absy ? detail::check_underflow(absy) : 0); - if(!absy) - return half(detail::binary, detail::check_underflow(absx)); - if(absy > absx) - std::swap(absx, absy); - for(; absx<0x400; absx<<=1,--expx) ; - for(; absy<0x400; absy<<=1,--expy) ; - detail::uint32 mx = (absx&0x3FF) | 0x400, my = (absy&0x3FF) | 0x400; - mx *= mx; - my *= my; - int ix = mx >> 21, iy = my >> 21; - expx = 2*(expx+(absx>>10)) - 15 + ix; - expy = 2*(expy+(absy>>10)) - 15 + iy; - mx <<= 10 - ix; - my <<= 10 - iy; - int d = expx - expy; - my = (d<30) ? ((my>>d)|((my&((static_cast(1)<(mx+my, expx)); - #endif - } - - inline half hypot(half x, half y, half z) - { - #ifdef HALF_ARITHMETIC_TYPE - detail::internal_t fx = detail::half2float(x.data_), fy = detail::half2float(y.data_), fz = detail::half2float(z.data_); - return half(detail::binary, detail::float2half(std::sqrt(fx*fx+fy*fy+fz*fz))); - #else - int absx = x.data_ & 0x7FFF, absy = y.data_ & 0x7FFF, absz = z.data_ & 0x7FFF, expx = 0, expy = 0, expz = 0; - if(!absx) - return hypot(y, z); - if(!absy) - return hypot(x, z); - if(!absz) - return hypot(x, y); - if(absx >= 0x7C00 || absy >= 0x7C00 || absz >= 0x7C00) - return half(detail::binary, (absx==0x7C00) ? detail::select(0x7C00, detail::select(y.data_, z.data_)) : - (absy==0x7C00) ? detail::select(0x7C00, detail::select(x.data_, z.data_)) : - (absz==0x7C00) ? detail::select(0x7C00, detail::select(x.data_, y.data_)) : - detail::signal(x.data_, y.data_, z.data_)); - if(absz > absy) - std::swap(absy, absz); - if(absy > absx) - std::swap(absx, absy); - if(absz > absy) - std::swap(absy, absz); - for(; absx<0x400; absx<<=1,--expx) ; - for(; absy<0x400; absy<<=1,--expy) ; - for(; absz<0x400; absz<<=1,--expz) ; - detail::uint32 mx = (absx&0x3FF) | 0x400, my = (absy&0x3FF) | 0x400, mz = (absz&0x3FF) | 0x400; - mx *= mx; - my *= my; - mz *= mz; - int ix = mx >> 21, iy = my >> 21, iz = mz >> 21; - expx = 2*(expx+(absx>>10)) - 15 + ix; - expy = 2*(expy+(absy>>10)) - 15 + iy; - expz = 2*(expz+(absz>>10)) - 15 + iz; - mx <<= 10 - ix; - my <<= 10 - iy; - mz <<= 10 - iz; - int d = expy - expz; - mz = (d<30) ? ((mz>>d)|((mz&((static_cast(1)<>1) | (my&1); - if(++expy > expx) - { - std::swap(mx, my); - std::swap(expx, expy); - } - } - d = expx - expy; - my = (d<30) ? ((my>>d)|((my&((static_cast(1)<(mx+my, expx)); - #endif - } - - inline half pow(half x, half y) - { - #ifdef HALF_ARITHMETIC_TYPE - return half(detail::binary, detail::float2half(std::pow(detail::half2float(x.data_), detail::half2float(y.data_)))); - #else - int absx = x.data_ & 0x7FFF, absy = y.data_ & 0x7FFF, exp = -15; - if(!absy || x.data_ == 0x3C00) - return half(detail::binary, detail::select(0x3C00, (x.data_==0x3C00) ? y.data_ : x.data_)); - bool is_int = absy >= 0x6400 || (absy>=0x3C00 && !(absy&((1<<(25-(absy>>10)))-1))); - unsigned int sign = x.data_ & (static_cast((absy<0x6800)&&is_int&&((absy>>(25-(absy>>10)))&1))<<15); - if(absx >= 0x7C00 || absy >= 0x7C00) - return half(detail::binary, (absx>0x7C00 || absy>0x7C00) ? detail::signal(x.data_, y.data_) : - (absy==0x7C00) ? ((absx==0x3C00) ? 0x3C00 : (!absx && y.data_==0xFC00) ? detail::pole() : - (0x7C00&-((y.data_>>15)^(absx>0x3C00)))) : (sign|(0x7C00&((y.data_>>15)-1U)))); - if(!absx) - return half(detail::binary, (y.data_&0x8000) ? detail::pole(sign) : sign); - if((x.data_&0x8000) && !is_int) - return half(detail::binary, detail::invalid()); - if(x.data_ == 0xBC00) - return half(detail::binary, sign|0x3C00); - switch(y.data_) - { - case 0x3800: return sqrt(x); - case 0x3C00: return half(detail::binary, detail::check_underflow(x.data_)); - case 0x4000: return x * x; - case 0xBC00: return half(detail::binary, 0x3C00) / x; - } - for(; absx<0x400; absx<<=1,--exp) ; - detail::uint32 ilog = exp + (absx>>10), msign = detail::sign_mask(ilog), f, m = - (((ilog<<27)+((detail::log2(static_cast((absx&0x3FF)|0x400)<<20)+8)>>4))^msign) - msign; - for(exp=-11; m<0x80000000; m<<=1,--exp) ; - for(; absy<0x400; absy<<=1,--exp) ; - m = detail::multiply64(m, static_cast((absy&0x3FF)|0x400)<<21); - int i = m >> 31; - exp += (absy>>10) + i; - m <<= 1 - i; - if(exp < 0) - { - f = m >> -exp; - exp = 0; - } - else - { - f = (m<> (31-exp); - } - return half(detail::binary, detail::exp2_post(f, exp, ((msign&1)^(y.data_>>15))!=0, sign)); - #endif - } - - - inline void sincos(half arg, half *sin, half *cos) - { - #ifdef HALF_ARITHMETIC_TYPE - detail::internal_t f = detail::half2float(arg.data_); - *sin = half(detail::binary, detail::float2half(std::sin(f))); - *cos = half(detail::binary, detail::float2half(std::cos(f))); - #else - int abs = arg.data_ & 0x7FFF, sign = arg.data_ >> 15, k; - if(abs >= 0x7C00) - *sin = *cos = half(detail::binary, (abs==0x7C00) ? detail::invalid() : detail::signal(arg.data_)); - else if(!abs) - { - *sin = arg; - *cos = half(detail::binary, 0x3C00); - } - else if(abs < 0x2500) - { - *sin = half(detail::binary, detail::rounded(arg.data_-1, 1, 1)); - *cos = half(detail::binary, detail::rounded(0x3BFF, 1, 1)); - } - else - { - if(half::round_style != std::round_to_nearest) - { - switch(abs) - { - case 0x48B7: - *sin = half(detail::binary, detail::rounded((~arg.data_&0x8000)|0x1D07, 1, 1)); - *cos = half(detail::binary, detail::rounded(0xBBFF, 1, 1)); - return; - case 0x598C: - *sin = half(detail::binary, detail::rounded((arg.data_&0x8000)|0x3BFF, 1, 1)); - *cos = half(detail::binary, detail::rounded(0x80FC, 1, 1)); - return; - case 0x6A64: - *sin = half(detail::binary, detail::rounded((~arg.data_&0x8000)|0x3BFE, 1, 1)); - *cos = half(detail::binary, detail::rounded(0x27FF, 1, 1)); - return; - case 0x6D8C: - *sin = half(detail::binary, detail::rounded((arg.data_&0x8000)|0x0FE6, 1, 1)); - *cos = half(detail::binary, detail::rounded(0x3BFF, 1, 1)); - return; - } - } - std::pair sc = detail::sincos(detail::angle_arg(abs, k), 28); - switch(k & 3) - { - case 1: sc = std::make_pair(sc.second, -sc.first); break; - case 2: sc = std::make_pair(-sc.first, -sc.second); break; - case 3: sc = std::make_pair(-sc.second, sc.first); break; - } - *sin = half(detail::binary, detail::fixed2half((sc.first^-static_cast(sign))+sign)); - *cos = half(detail::binary, detail::fixed2half(sc.second)); - } - #endif - } - - inline half sin(half arg) - { - #ifdef HALF_ARITHMETIC_TYPE - return half(detail::binary, detail::float2half(std::sin(detail::half2float(arg.data_)))); - #else - int abs = arg.data_ & 0x7FFF, k; - if(!abs) - return arg; - if(abs >= 0x7C00) - return half(detail::binary, (abs==0x7C00) ? detail::invalid() : detail::signal(arg.data_)); - if(abs < 0x2900) - return half(detail::binary, detail::rounded(arg.data_-1, 1, 1)); - if(half::round_style != std::round_to_nearest) - switch(abs) - { - case 0x48B7: return half(detail::binary, detail::rounded((~arg.data_&0x8000)|0x1D07, 1, 1)); - case 0x6A64: return half(detail::binary, detail::rounded((~arg.data_&0x8000)|0x3BFE, 1, 1)); - case 0x6D8C: return half(detail::binary, detail::rounded((arg.data_&0x8000)|0x0FE6, 1, 1)); - } - std::pair sc = detail::sincos(detail::angle_arg(abs, k), 28); - detail::uint32 sign = -static_cast(((k>>1)&1)^(arg.data_>>15)); - return half(detail::binary, detail::fixed2half((((k&1) ? sc.second : sc.first)^sign) - sign)); - #endif - } - - inline half cos(half arg) - { - #ifdef HALF_ARITHMETIC_TYPE - return half(detail::binary, detail::float2half(std::cos(detail::half2float(arg.data_)))); - #else - int abs = arg.data_ & 0x7FFF, k; - if(!abs) - return half(detail::binary, 0x3C00); - if(abs >= 0x7C00) - return half(detail::binary, (abs==0x7C00) ? detail::invalid() : detail::signal(arg.data_)); - if(abs < 0x2500) - return half(detail::binary, detail::rounded(0x3BFF, 1, 1)); - if(half::round_style != std::round_to_nearest && abs == 0x598C) - return half(detail::binary, detail::rounded(0x80FC, 1, 1)); - std::pair sc = detail::sincos(detail::angle_arg(abs, k), 28); - detail::uint32 sign = -static_cast(((k>>1)^k)&1); - return half(detail::binary, detail::fixed2half((((k&1) ? sc.first : sc.second)^sign) - sign)); - #endif - } - - inline half tan(half arg) - { - #ifdef HALF_ARITHMETIC_TYPE - return half(detail::binary, detail::float2half(std::tan(detail::half2float(arg.data_)))); - #else - int abs = arg.data_ & 0x7FFF, exp = 13, k; - if(!abs) - return arg; - if(abs >= 0x7C00) - return half(detail::binary, (abs==0x7C00) ? detail::invalid() : detail::signal(arg.data_)); - if(abs < 0x2700) - return half(detail::binary, detail::rounded(arg.data_, 0, 1)); - if(half::round_style != std::round_to_nearest) - switch(abs) - { - case 0x658C: return half(detail::binary, detail::rounded((arg.data_&0x8000)|0x07E6, 1, 1)); - case 0x7330: return half(detail::binary, detail::rounded((~arg.data_&0x8000)|0x4B62, 1, 1)); - } - std::pair sc = detail::sincos(detail::angle_arg(abs, k), 30); - if(k & 1) - sc = std::make_pair(-sc.second, sc.first); - detail::uint32 signy = detail::sign_mask(sc.first), signx = detail::sign_mask(sc.second); - detail::uint32 my = (sc.first^signy) - signy, mx = (sc.second^signx) - signx; - for(; my<0x80000000; my<<=1,--exp) ; - for(; mx<0x80000000; mx<<=1,++exp) ; - return half(detail::binary, detail::tangent_post(my, mx, exp, (signy^signx^arg.data_)&0x8000)); - #endif - } - - inline half asin(half arg) - { - #ifdef HALF_ARITHMETIC_TYPE - return half(detail::binary, detail::float2half(std::asin(detail::half2float(arg.data_)))); - #else - unsigned int abs = arg.data_ & 0x7FFF, sign = arg.data_ & 0x8000; - if(!abs) - return arg; - if(abs >= 0x3C00) - return half(detail::binary, (abs>0x7C00) ? detail::signal(arg.data_) : (abs>0x3C00) ? detail::invalid() : - detail::rounded(sign|0x3E48, 0, 1)); - if(abs < 0x2900) - return half(detail::binary, detail::rounded(arg.data_, 0, 1)); - if(half::round_style != std::round_to_nearest && (abs == 0x2B44 || abs == 0x2DC3)) - return half(detail::binary, detail::rounded(arg.data_+1, 1, 1)); - std::pair sc = detail::atan2_args(abs); - detail::uint32 m = detail::atan2(sc.first, sc.second, (half::round_style==std::round_to_nearest) ? 27 : 26); - return half(detail::binary, detail::fixed2half(m, 14, sign)); - #endif - } - - inline half acos(half arg) - { - #ifdef HALF_ARITHMETIC_TYPE - return half(detail::binary, detail::float2half(std::acos(detail::half2float(arg.data_)))); - #else - unsigned int abs = arg.data_ & 0x7FFF, sign = arg.data_ >> 15; - if(!abs) - return half(detail::binary, detail::rounded(0x3E48, 0, 1)); - if(abs >= 0x3C00) - return half(detail::binary, (abs>0x7C00) ? detail::signal(arg.data_) : (abs>0x3C00) ? detail::invalid() : - sign ? detail::rounded(0x4248, 0, 1) : 0); - std::pair cs = detail::atan2_args(abs); - detail::uint32 m = detail::atan2(cs.second, cs.first, 28); - return half(detail::binary, detail::fixed2half(sign ? (0xC90FDAA2-m) : m, 15, 0, sign)); - #endif - } - - inline half atan(half arg) - { - #ifdef HALF_ARITHMETIC_TYPE - return half(detail::binary, detail::float2half(std::atan(detail::half2float(arg.data_)))); - #else - unsigned int abs = arg.data_ & 0x7FFF, sign = arg.data_ & 0x8000; - if(!abs) - return arg; - if(abs >= 0x7C00) - return half(detail::binary, (abs==0x7C00) ? detail::rounded(sign|0x3E48, 0, 1) : detail::signal(arg.data_)); - if(abs <= 0x2700) - return half(detail::binary, detail::rounded(arg.data_-1, 1, 1)); - int exp = (abs>>10) + (abs<=0x3FF); - detail::uint32 my = (abs&0x3FF) | ((abs>0x3FF)<<10); - detail::uint32 m = (exp>15) ? detail::atan2(my<<19, 0x20000000>>(exp-15), (half::round_style==std::round_to_nearest) ? 26 : 24) : - detail::atan2(my<<(exp+4), 0x20000000, (half::round_style==std::round_to_nearest) ? 30 : 28); - return half(detail::binary, detail::fixed2half(m, 14, sign)); - #endif - } - - inline half atan2(half y, half x) - { - #ifdef HALF_ARITHMETIC_TYPE - return half(detail::binary, detail::float2half(std::atan2(detail::half2float(y.data_), detail::half2float(x.data_)))); - #else - unsigned int absx = x.data_ & 0x7FFF, absy = y.data_ & 0x7FFF, signx = x.data_ >> 15, signy = y.data_ & 0x8000; - if(absx >= 0x7C00 || absy >= 0x7C00) - { - if(absx > 0x7C00 || absy > 0x7C00) - return half(detail::binary, detail::signal(x.data_, y.data_)); - if(absy == 0x7C00) - return half(detail::binary, (absx<0x7C00) ? detail::rounded(signy|0x3E48, 0, 1) : - signx ? detail::rounded(signy|0x40B6, 0, 1) : - detail::rounded(signy|0x3A48, 0, 1)); - return (x.data_==0x7C00) ? half(detail::binary, signy) : half(detail::binary, detail::rounded(signy|0x4248, 0, 1)); - } - if(!absy) - return signx ? half(detail::binary, detail::rounded(signy|0x4248, 0, 1)) : y; - if(!absx) - return half(detail::binary, detail::rounded(signy|0x3E48, 0, 1)); - int d = (absy>>10) + (absy<=0x3FF) - (absx>>10) - (absx<=0x3FF); - if(d > (signx ? 18 : 12)) - return half(detail::binary, detail::rounded(signy|0x3E48, 0, 1)); - if(signx && d < -11) - return half(detail::binary, detail::rounded(signy|0x4248, 0, 1)); - if(!signx && d < ((half::round_style==std::round_toward_zero) ? -15 : -9)) - { - for(; absy<0x400; absy<<=1,--d) ; - detail::uint32 mx = ((absx<<1)&0x7FF) | 0x800, my = ((absy<<1)&0x7FF) | 0x800; - int i = my < mx; - d -= i; - if(d < -25) - return half(detail::binary, detail::underflow(signy)); - my <<= 11 + i; - return half(detail::binary, detail::fixed2half(my/mx, d+14, signy, my%mx!=0)); - } - detail::uint32 m = detail::atan2( ((absy&0x3FF)|((absy>0x3FF)<<10))<<(19+((d<0) ? d : (d>0) ? 0 : -1)), - ((absx&0x3FF)|((absx>0x3FF)<<10))<<(19-((d>0) ? d : (d<0) ? 0 : 1))); - return half(detail::binary, detail::fixed2half(signx ? (0xC90FDAA2-m) : m, 15, signy, signx)); - #endif - } - - - inline half sinh(half arg) - { - #ifdef HALF_ARITHMETIC_TYPE - return half(detail::binary, detail::float2half(std::sinh(detail::half2float(arg.data_)))); - #else - int abs = arg.data_ & 0x7FFF, exp; - if(!abs || abs >= 0x7C00) - return (abs>0x7C00) ? half(detail::binary, detail::signal(arg.data_)) : arg; - if(abs <= 0x2900) - return half(detail::binary, detail::rounded(arg.data_, 0, 1)); - std::pair mm = detail::hyperbolic_args(abs, exp, (half::round_style==std::round_to_nearest) ? 29 : 27); - detail::uint32 m = mm.first - mm.second; - for(exp+=13; m<0x80000000 && exp; m<<=1,--exp) ; - unsigned int sign = arg.data_ & 0x8000; - if(exp > 29) - return half(detail::binary, detail::overflow(sign)); - return half(detail::binary, detail::fixed2half(m, exp, sign)); - #endif - } - - inline half cosh(half arg) - { - #ifdef HALF_ARITHMETIC_TYPE - return half(detail::binary, detail::float2half(std::cosh(detail::half2float(arg.data_)))); - #else - int abs = arg.data_ & 0x7FFF, exp; - if(!abs) - return half(detail::binary, 0x3C00); - if(abs >= 0x7C00) - return half(detail::binary, (abs>0x7C00) ? detail::signal(arg.data_) : 0x7C00); - std::pair mm = detail::hyperbolic_args(abs, exp, (half::round_style==std::round_to_nearest) ? 23 : 26); - detail::uint32 m = mm.first + mm.second, i = (~m&0xFFFFFFFF) >> 31; - m = (m>>i) | (m&i) | 0x80000000; - if((exp+=13+i) > 29) - return half(detail::binary, detail::overflow()); - return half(detail::binary, detail::fixed2half(m, exp)); - #endif - } - - inline half tanh(half arg) - { - #ifdef HALF_ARITHMETIC_TYPE - return half(detail::binary, detail::float2half(std::tanh(detail::half2float(arg.data_)))); - #else - int abs = arg.data_ & 0x7FFF, exp; - if(!abs) - return arg; - if(abs >= 0x7C00) - return half(detail::binary, (abs>0x7C00) ? detail::signal(arg.data_) : (arg.data_-0x4000)); - if(abs >= 0x4500) - return half(detail::binary, detail::rounded((arg.data_&0x8000)|0x3BFF, 1, 1)); - if(abs < 0x2700) - return half(detail::binary, detail::rounded(arg.data_-1, 1, 1)); - if(half::round_style != std::round_to_nearest && abs == 0x2D3F) - return half(detail::binary, detail::rounded(arg.data_-3, 0, 1)); - std::pair mm = detail::hyperbolic_args(abs, exp, 27); - detail::uint32 my = mm.first - mm.second - (half::round_style!=std::round_to_nearest), mx = mm.first + mm.second, i = (~mx&0xFFFFFFFF) >> 31; - for(exp=13; my<0x80000000; my<<=1,--exp) ; - mx = (mx>>i) | 0x80000000; - return half(detail::binary, detail::tangent_post(my, mx, exp-i, arg.data_&0x8000)); - #endif - } - - inline half asinh(half arg) - { - #if defined(HALF_ARITHMETIC_TYPE) && HALF_ENABLE_CPP11_CMATH - return half(detail::binary, detail::float2half(std::asinh(detail::half2float(arg.data_)))); - #else - int abs = arg.data_ & 0x7FFF; - if(!abs || abs >= 0x7C00) - return (abs>0x7C00) ? half(detail::binary, detail::signal(arg.data_)) : arg; - if(abs <= 0x2900) - return half(detail::binary, detail::rounded(arg.data_-1, 1, 1)); - if(half::round_style != std::round_to_nearest) - switch(abs) - { - case 0x32D4: return half(detail::binary, detail::rounded(arg.data_-13, 1, 1)); - case 0x3B5B: return half(detail::binary, detail::rounded(arg.data_-197, 1, 1)); - } - return half(detail::binary, detail::area(arg.data_)); - #endif - } - - inline half acosh(half arg) - { - #if defined(HALF_ARITHMETIC_TYPE) && HALF_ENABLE_CPP11_CMATH - return half(detail::binary, detail::float2half(std::acosh(detail::half2float(arg.data_)))); - #else - int abs = arg.data_ & 0x7FFF; - if((arg.data_&0x8000) || abs < 0x3C00) - return half(detail::binary, (abs<=0x7C00) ? detail::invalid() : detail::signal(arg.data_)); - if(abs == 0x3C00) - return half(detail::binary, 0); - if(arg.data_ >= 0x7C00) - return (abs>0x7C00) ? half(detail::binary, detail::signal(arg.data_)) : arg; - return half(detail::binary, detail::area(arg.data_)); - #endif - } - - inline half atanh(half arg) - { - #if defined(HALF_ARITHMETIC_TYPE) && HALF_ENABLE_CPP11_CMATH - return half(detail::binary, detail::float2half(std::atanh(detail::half2float(arg.data_)))); - #else - int abs = arg.data_ & 0x7FFF, exp = 0; - if(!abs) - return arg; - if(abs >= 0x3C00) - return half(detail::binary, (abs==0x3C00) ? detail::pole(arg.data_&0x8000) : (abs<=0x7C00) ? detail::invalid() : detail::signal(arg.data_)); - if(abs < 0x2700) - return half(detail::binary, detail::rounded(arg.data_, 0, 1)); - detail::uint32 m = static_cast((abs&0x3FF)|((abs>0x3FF)<<10)) << ((abs>>10)+(abs<=0x3FF)+6), my = 0x80000000 + m, mx = 0x80000000 - m; - for(; mx<0x80000000; mx<<=1,++exp) ; - int i = my >= mx, s; - return half(detail::binary, detail::log2_post(detail::log2( - (detail::divide64(my>>i, mx, s)+1)>>1, 27)+0x10, exp+i-1, 16, arg.data_&0x8000)); - #endif - } - - - inline half erf(half arg) - { - #if defined(HALF_ARITHMETIC_TYPE) && HALF_ENABLE_CPP11_CMATH - return half(detail::binary, detail::float2half(std::erf(detail::half2float(arg.data_)))); - #else - unsigned int abs = arg.data_ & 0x7FFF; - if(!abs || abs >= 0x7C00) - return (abs>=0x7C00) ? half(detail::binary, (abs==0x7C00) ? (arg.data_-0x4000) : detail::signal(arg.data_)) : arg; - if(abs >= 0x4200) - return half(detail::binary, detail::rounded((arg.data_&0x8000)|0x3BFF, 1, 1)); - return half(detail::binary, detail::erf(arg.data_)); - #endif - } - - inline half erfc(half arg) - { - #if defined(HALF_ARITHMETIC_TYPE) && HALF_ENABLE_CPP11_CMATH - return half(detail::binary, detail::float2half(std::erfc(detail::half2float(arg.data_)))); - #else - unsigned int abs = arg.data_ & 0x7FFF, sign = arg.data_ & 0x8000; - if(abs >= 0x7C00) - return (abs>=0x7C00) ? half(detail::binary, (abs==0x7C00) ? (sign>>1) : detail::signal(arg.data_)) : arg; - if(!abs) - return half(detail::binary, 0x3C00); - if(abs >= 0x4400) - return half(detail::binary, detail::rounded((sign>>1)-(sign>>15), sign>>15, 1)); - return half(detail::binary, detail::erf(arg.data_)); - #endif - } - - inline half lgamma(half arg) - { - #if defined(HALF_ARITHMETIC_TYPE) && HALF_ENABLE_CPP11_CMATH - return half(detail::binary, detail::float2half(std::lgamma(detail::half2float(arg.data_)))); - #else - int abs = arg.data_ & 0x7FFF; - if(abs >= 0x7C00) - return half(detail::binary, (abs==0x7C00) ? 0x7C00 : detail::signal(arg.data_)); - if(!abs || arg.data_ >= 0xE400 || (arg.data_ >= 0xBC00 && !(abs&((1<<(25-(abs>>10)))-1)))) - return half(detail::binary, detail::pole()); - if(arg.data_ == 0x3C00 || arg.data_ == 0x4000) - return half(detail::binary, 0); - return half(detail::binary, detail::gamma(arg.data_)); - #endif - } - - inline half tgamma(half arg) - { - #if defined(HALF_ARITHMETIC_TYPE) && HALF_ENABLE_CPP11_CMATH - return half(detail::binary, detail::float2half(std::tgamma(detail::half2float(arg.data_)))); - #else - unsigned int abs = arg.data_ & 0x7FFF; - if(!abs) - return half(detail::binary, detail::pole(arg.data_)); - if(abs >= 0x7C00) - return (arg.data_==0x7C00) ? arg : half(detail::binary, detail::signal(arg.data_)); - if(arg.data_ >= 0xE400 || (arg.data_ >= 0xBC00 && !(abs&((1<<(25-(abs>>10)))-1)))) - return half(detail::binary, detail::invalid()); - if(arg.data_ >= 0xCA80) - return half(detail::binary, detail::underflow((1-((abs>>(25-(abs>>10)))&1))<<15)); - if(arg.data_ <= 0x100 || (arg.data_ >= 0x4900 && arg.data_ < 0x8000)) - return half(detail::binary, detail::overflow()); - if(arg.data_ == 0x3C00) - return arg; - return half(detail::binary, detail::gamma(arg.data_)); - #endif - } - - - inline half ceil(half arg) { return half(detail::binary, detail::integral(arg.data_)); } - - inline half floor(half arg) { return half(detail::binary, detail::integral(arg.data_)); } - - inline half trunc(half arg) { return half(detail::binary, detail::integral(arg.data_)); } - - inline half round(half arg) { return half(detail::binary, detail::integral(arg.data_)); } - - inline long lround(half arg) { return detail::half2int(arg.data_); } - - inline half rint(half arg) { return half(detail::binary, detail::integral(arg.data_)); } - - inline long lrint(half arg) { return detail::half2int(arg.data_); } - - inline half nearbyint(half arg) { return half(detail::binary, detail::integral(arg.data_)); } -#if HALF_ENABLE_CPP11_LONG_LONG - inline long long llround(half arg) { return detail::half2int(arg.data_); } - - inline long long llrint(half arg) { return detail::half2int(arg.data_); } -#endif - - - inline half frexp(half arg, int *exp) - { - *exp = 0; - unsigned int abs = arg.data_ & 0x7FFF; - if(abs >= 0x7C00 || !abs) - return (abs>0x7C00) ? half(detail::binary, detail::signal(arg.data_)) : arg; - for(; abs<0x400; abs<<=1,--*exp) ; - *exp += (abs>>10) - 14; - return half(detail::binary, (arg.data_&0x8000)|0x3800|(abs&0x3FF)); - } - - inline half scalbln(half arg, long exp) - { - unsigned int abs = arg.data_ & 0x7FFF, sign = arg.data_ & 0x8000; - if(abs >= 0x7C00 || !abs) - return (abs>0x7C00) ? half(detail::binary, detail::signal(arg.data_)) : arg; - for(; abs<0x400; abs<<=1,--exp) ; - exp += abs >> 10; - if(exp > 30) - return half(detail::binary, detail::overflow(sign)); - else if(exp < -10) - return half(detail::binary, detail::underflow(sign)); - else if(exp > 0) - return half(detail::binary, sign|(exp<<10)|(abs&0x3FF)); - unsigned int m = (abs&0x3FF) | 0x400; - return half(detail::binary, detail::rounded(sign|(m>>(1-exp)), (m>>-exp)&1, (m&((1<<-exp)-1))!=0)); - } - - inline half scalbn(half arg, int exp) { return scalbln(arg, exp); } - - inline half ldexp(half arg, int exp) { return scalbln(arg, exp); } - - inline half modf(half arg, half *iptr) - { - unsigned int abs = arg.data_ & 0x7FFF; - if(abs > 0x7C00) - { - arg = half(detail::binary, detail::signal(arg.data_)); - return *iptr = arg, arg; - } - if(abs >= 0x6400) - return *iptr = arg, half(detail::binary, arg.data_&0x8000); - if(abs < 0x3C00) - return iptr->data_ = arg.data_ & 0x8000, arg; - unsigned int exp = abs >> 10, mask = (1<<(25-exp)) - 1, m = arg.data_ & mask; - iptr->data_ = arg.data_ & ~mask; - if(!m) - return half(detail::binary, arg.data_&0x8000); - for(; m<0x400; m<<=1,--exp) ; - return half(detail::binary, (arg.data_&0x8000)|(exp<<10)|(m&0x3FF)); - } - - inline int ilogb(half arg) - { - int abs = arg.data_ & 0x7FFF, exp; - if(!abs || abs >= 0x7C00) - { - detail::raise(FE_INVALID); - return !abs ? FP_ILOGB0 : (abs==0x7C00) ? INT_MAX : FP_ILOGBNAN; - } - for(exp=(abs>>10)-15; abs<0x200; abs<<=1,--exp) ; - return exp; - } - - inline half logb(half arg) - { - int abs = arg.data_ & 0x7FFF, exp; - if(!abs) - return half(detail::binary, detail::pole(0x8000)); - if(abs >= 0x7C00) - return half(detail::binary, (abs==0x7C00) ? 0x7C00 : detail::signal(arg.data_)); - for(exp=(abs>>10)-15; abs<0x200; abs<<=1,--exp) ; - unsigned int value = static_cast(exp<0) << 15; - if(exp) - { - unsigned int m = std::abs(exp) << 6; - for(exp=18; m<0x400; m<<=1,--exp) ; - value |= (exp<<10) + m; - } - return half(detail::binary, value); - } - - inline half nextafter(half from, half to) - { - int fabs = from.data_ & 0x7FFF, tabs = to.data_ & 0x7FFF; - if(fabs > 0x7C00 || tabs > 0x7C00) - return half(detail::binary, detail::signal(from.data_, to.data_)); - if(from.data_ == to.data_ || !(fabs|tabs)) - return to; - if(!fabs) - { - detail::raise(FE_UNDERFLOW, !HALF_ERRHANDLING_UNDERFLOW_TO_INEXACT); - return half(detail::binary, (to.data_&0x8000)+1); - } - unsigned int out = from.data_ + (((from.data_>>15)^static_cast( - (from.data_^(0x8000|(0x8000-(from.data_>>15))))<(to.data_^(0x8000|(0x8000-(to.data_>>15))))))<<1) - 1; - detail::raise(FE_OVERFLOW, fabs<0x7C00 && (out&0x7C00)==0x7C00); - detail::raise(FE_UNDERFLOW, !HALF_ERRHANDLING_UNDERFLOW_TO_INEXACT && (out&0x7C00)<0x400); - return half(detail::binary, out); - } - - inline half nexttoward(half from, long double to) - { - int fabs = from.data_ & 0x7FFF; - if(fabs > 0x7C00) - return half(detail::binary, detail::signal(from.data_)); - long double lfrom = static_cast(from); - if(detail::builtin_isnan(to) || lfrom == to) - return half(static_cast(to)); - if(!fabs) - { - detail::raise(FE_UNDERFLOW, !HALF_ERRHANDLING_UNDERFLOW_TO_INEXACT); - return half(detail::binary, (static_cast(detail::builtin_signbit(to))<<15)+1); - } - unsigned int out = from.data_ + (((from.data_>>15)^static_cast(lfrom 0x7C00; } - - inline HALF_CONSTEXPR bool isnormal(half arg) { return ((arg.data_&0x7C00)!=0) & ((arg.data_&0x7C00)!=0x7C00); } - - inline HALF_CONSTEXPR bool signbit(half arg) { return (arg.data_&0x8000) != 0; } - - - inline HALF_CONSTEXPR bool isgreater(half x, half y) - { - return ((x.data_^(0x8000|(0x8000-(x.data_>>15))))+(x.data_>>15)) > ((y.data_^(0x8000|(0x8000-(y.data_>>15))))+(y.data_>>15)) && !isnan(x) && !isnan(y); - } - - inline HALF_CONSTEXPR bool isgreaterequal(half x, half y) - { - return ((x.data_^(0x8000|(0x8000-(x.data_>>15))))+(x.data_>>15)) >= ((y.data_^(0x8000|(0x8000-(y.data_>>15))))+(y.data_>>15)) && !isnan(x) && !isnan(y); - } - - inline HALF_CONSTEXPR bool isless(half x, half y) - { - return ((x.data_^(0x8000|(0x8000-(x.data_>>15))))+(x.data_>>15)) < ((y.data_^(0x8000|(0x8000-(y.data_>>15))))+(y.data_>>15)) && !isnan(x) && !isnan(y); - } - - inline HALF_CONSTEXPR bool islessequal(half x, half y) - { - return ((x.data_^(0x8000|(0x8000-(x.data_>>15))))+(x.data_>>15)) <= ((y.data_^(0x8000|(0x8000-(y.data_>>15))))+(y.data_>>15)) && !isnan(x) && !isnan(y); - } - - inline HALF_CONSTEXPR bool islessgreater(half x, half y) - { - return x.data_!=y.data_ && ((x.data_|y.data_)&0x7FFF) && !isnan(x) && !isnan(y); - } - - inline HALF_CONSTEXPR bool isunordered(half x, half y) { return isnan(x) || isnan(y); } - - - template T half_cast(U arg) { return detail::half_caster::cast(arg); } - - template T half_cast(U arg) { return detail::half_caster::cast(arg); } - - - inline int feclearexcept(int excepts) { detail::errflags() &= ~excepts; return 0; } - - inline int fetestexcept(int excepts) { return detail::errflags() & excepts; } - - inline int feraiseexcept(int excepts) { detail::errflags() |= excepts; detail::raise(excepts); return 0; } - - inline int fegetexceptflag(int *flagp, int excepts) { *flagp = detail::errflags() & excepts; return 0; } - - inline int fesetexceptflag(const int *flagp, int excepts) { detail::errflags() = (detail::errflags()|(*flagp&excepts)) & (*flagp|~excepts); return 0; } - - inline void fethrowexcept(int excepts, const char *msg = "") - { - excepts &= detail::errflags(); - if(excepts & (FE_INVALID|FE_DIVBYZERO)) - throw std::domain_error(msg); - if(excepts & FE_OVERFLOW) - throw std::overflow_error(msg); - if(excepts & FE_UNDERFLOW) - throw std::underflow_error(msg); - if(excepts & FE_INEXACT) - throw std::range_error(msg); - } -} - - -#undef HALF_UNUSED_NOERR -#undef HALF_CONSTEXPR -#undef HALF_CONSTEXPR_CONST -#undef HALF_CONSTEXPR_NOERR -#undef HALF_NOEXCEPT -#undef HALF_NOTHROW -#undef HALF_THREAD_LOCAL -#undef HALF_TWOS_COMPLEMENT_INT -#ifdef HALF_POP_WARNINGS - #pragma warning(pop) - #undef HALF_POP_WARNINGS -#endif - -#endif - \ No newline at end of file diff --git a/src/core/utils/memory_utils.h b/src/core/utils/memory_utils.h deleted file mode 100644 index 5dfd097..0000000 --- a/src/core/utils/memory_utils.h +++ /dev/null @@ -1,136 +0,0 @@ -/*************************************************************************** - * - * Authors: David Strelak (davidstrelak@gmail.com) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_UTILS_MEMORY_UTILS_H_ -#define CORE_UTILS_MEMORY_UTILS_H_ - -#include -#include -#include -#include -#include // MADVICE -#include // sysconf - -namespace memoryUtils -{ - - const static long PAGE_SIZE = sysconf(_SC_PAGESIZE); - - inline constexpr size_t operator"" _kB(unsigned long long int bytes) { - return 1024 * bytes; - } - - inline constexpr size_t operator"" _MB(unsigned long long int bytes) { - return 1024 * 1024 * bytes; - } - - inline constexpr size_t operator"" _GB(unsigned long long int bytes) { - return 1024 * 1024 * 1024 * bytes; - } - - inline constexpr double operator"" _kB(long double bytes) { - return 1024. * bytes; - } - - inline constexpr double operator"" _MB(long double bytes) { - return 1024. * 1024. * bytes; - } - - inline constexpr double operator"" _GB(long double bytes) { - return 1024. * 1024. * 1024. * bytes; - } - - - inline void* page_aligned_alloc(size_t bytes) { - return aligned_alloc(PAGE_SIZE, bytes); - } - - template - inline T* page_aligned_alloc(size_t elems, bool initToZero) { - size_t bytes = elems * sizeof(T); - auto p = (T*)page_aligned_alloc(bytes); - #ifdef MADV_HUGEPAGE - madvise(p, bytes, MADV_HUGEPAGE); // Not available in all platforms - #endif - if (initToZero) { - memset(p, 0, bytes); - } - return p; - } - - template - inline constexpr T kB(T bytes) { - return bytes / (T)1024; - } - - template - inline constexpr T MB(T bytes) { - return bytes / ((T)1024 * T(1024)); - } - - template - inline constexpr T GB(T bytes) { - return bytes / ((T)1024 * (T)1024 * (T)1024); - } - - /** Returns the current alignment of the ptr. - * Essentially just counts the amount of LSB zeros. - * Returns 2^31 for ptr == 0. */ - inline uint32_t alignmentOf(uintptr_t ptr) { - for (uint32_t alignPower = 0; alignPower < 32; alignPower++) { - const uint32_t alignment = 1u << alignPower; - if ((ptr & alignment) != 0) { - return alignment; - } - } - return 1u << 31u; - } - - /** Convenience shortcut for alignmentOf(uintptr_t). */ - inline uint32_t alignmentOf(void * ptr) { - return alignmentOf((size_t) ptr); - } - - /** Return number + N, where N is the smallest non-negative number required to make number have given alignment. - * Example: align(13, 8) = 16 */ - template - inline T align(T number, uint32_t alignment) { - T off = number % alignment; - if (off == 0) { - return number; - } else { - return number + alignment - off; - } - } - - template - std::unique_ptr make_unique(Args&&... args) - { - return std::unique_ptr(new T(std::forward(args)...)); - } - -} // memoryUtils - -#endif /* CORE_UTILS_MEMORY_UTILS_H_ */ diff --git a/src/core/utils/sql_utils.cpp b/src/core/utils/sql_utils.cpp deleted file mode 100644 index 29d3a9d..0000000 --- a/src/core/utils/sql_utils.cpp +++ /dev/null @@ -1,343 +0,0 @@ -/*************************************************************************** - * - * Authors: David Strelak (davidstrelak@gmail.com) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include -#include -#include "sql_utils.h" -#include "../xmipp_error.h" - -bool sqlUtils::addColumns(const std::vector &columns, - sqlite3 *db, const std::string &table) { - // it seems that with columns, one cannot use data binding - auto query = "ALTER TABLE " + table + " ADD COLUMN "; - // FIXME currently, whole db is in one huge transaction. Finish whatever might be pending, - // do our business in a clean transaction and start a new transaction after (not to break the original code) - commitTrans(db); - beginTrans(db); - - for (auto c : columns) { - auto stmt = query + MDL::label2SqlColumn(c) + ";"; - sqlite3_exec(db, stmt.c_str(), nullptr, nullptr, nullptr); - } - - endTrans(db); - beginTrans(db); - return checkError(db); -} - -void sqlUtils::extractValue(sqlite3_stmt *stmt, const int position, MDObject &valueOut) -{ - switch (valueOut.type) - { - case LABEL_BOOL: //bools are int in sqlite3 - valueOut.data.boolValue = sqlite3_column_int(stmt, position) == 1; - break; - case LABEL_INT: - valueOut.data.intValue = sqlite3_column_int(stmt, position); - break; - case LABEL_SIZET: - valueOut.data.longintValue = sqlite3_column_int(stmt, position); - break; - case LABEL_DOUBLE: - valueOut.data.doubleValue = sqlite3_column_double(stmt, position); - break; - case LABEL_STRING: - { - std::stringstream ss; - ss << sqlite3_column_text(stmt, position); - valueOut.data.stringValue->assign(ss.str()); - - break; - } - case LABEL_VECTOR_DOUBLE: - case LABEL_VECTOR_SIZET: - { - std::stringstream ss; - ss << sqlite3_column_text(stmt, position); - valueOut.fromStream(ss); - break; - } - default: - REPORT_ERROR(ERR_ARG_INCORRECT,"Do not know how to extract a value of type " + valueOut.type); - } -} - -bool sqlUtils::select(size_t rowId, - sqlite3 *db, const std::string &table, - std::vector &values) { - // assuming all records are the same - auto query = createSelectQuery(rowId, values, table); - - // FIXME currently, whole db is in one huge transaction. Finish whatever might be pending, - // do our business in a clean transaction and start a new transaction after (not to break the original code) - sqlite3_mutex_enter(sqlite3_db_mutex(db)); // FIXME this should be only done on demand or not at all ... - commitTrans(db); - beginTrans(db); - - sqlite3_stmt *stmt = nullptr; - sqlite3_prepare_v2(db, query.c_str(), -1, &stmt, nullptr); - - // execute - sqlite3_step(stmt); - for (size_t i = 0; i < values.size(); ++i) { - extractValue(stmt, i, values.at(i)); - } - - sqlite3_reset(stmt); - - sqlite3_finalize(stmt); - endTrans(db); - beginTrans(db); - sqlite3_mutex_leave(sqlite3_db_mutex(db)); // FIXME this should be only done on demand or not at all ... - - return checkError(db); -} - -bool sqlUtils::select( - sqlite3 *db, const std::string &table, - const std::vector &columns, - std::vector> &rows) { - // assuming all records are the same - auto query = createSelectQuery(columns, table); - sqlite3_stmt *stmt = nullptr; - // FIXME currently, whole db is in one huge transaction. Finish whatever might be pending, - // do our business in a clean transaction and start a new transaction after (not to break the original code) - commitTrans(db); - beginTrans(db); - sqlite3_prepare_v2(db, query.c_str(), -1, &stmt, nullptr); - - // execute, extract value from each row - while (sqlite3_step(stmt) == SQLITE_ROW) { - rows.emplace_back(columns); - auto &r = rows.back(); - for (size_t i = 0; i < columns.size(); ++i) { - extractValue(stmt, i, r.at(i)); - } - } - sqlite3_reset(stmt); - - sqlite3_finalize(stmt); - endTrans(db); - beginTrans(db); - - return checkError(db); -} - - -std::string sqlUtils::createSelectQuery(size_t id, - const std::vector &values, - const std::string &table) { - std::stringstream cols; - const auto len = values.size(); - for (size_t i = 0; i < len; ++i) { - cols << MDL::label2StrSql(values.at(i).label); - if (len != (i + 1)) { - cols << ", "; - } - } - std::stringstream ss; - ss << "SELECT " - << cols.str() - << " FROM " << table - << " WHERE objID=" << id << ";"; - return ss.str(); -} - -std::string sqlUtils::createSelectQuery( - const std::vector &values, - const std::string &table) { - std::stringstream cols; - const auto len = values.size(); - for (size_t i = 0; i < len; ++i) { - cols << MDL::label2StrSql(values.at(i).label); - if (len != (i + 1)) { - cols << ", "; - } - } - std::stringstream ss; - ss << "SELECT " - << cols.str() - << " FROM " << table << ";"; - return ss.str(); -} - -std::string sqlUtils::createUpdateQuery( - const std::vector &values, - const std::string &table, - size_t id) { - std::stringstream cols; - const auto len = values.size(); - for (size_t i = 0; i < len; ++i) { - cols << MDL::label2StrSql(values.at(i)->label); - cols << "=?"; - if (len != (i + 1)) { - cols << ", "; - } - } - std::stringstream ss; - ss << "UPDATE " << table << " SET " - << cols.str() - << " WHERE objID=" << id << ";"; - return ss.str(); -} - -bool sqlUtils::update(const std::vector &values, - sqlite3 *db, const std::string &table, size_t id) { - if (values.empty()) { - return true; - } - // assuming all records are the same - auto query = createUpdateQuery(values, table, id); - sqlite3_stmt *stmt = nullptr; - sqlite3_prepare_v2(db, query.c_str(), -1, &stmt, nullptr); - // FIXME currently, whole db is in one huge transaction. Finish whatever might be pending, - // do our business in a clean transaction and start a new transaction after (not to break the original code) - commitTrans(db); - beginTrans(db); - - // bind proper values - for (auto i = 0; i < values.size(); ++i) { - bindValue(stmt, i + 1, *values.at(i)); - } - // execute - sqlite3_step(stmt); - sqlite3_clear_bindings(stmt); - sqlite3_reset(stmt); - - sqlite3_finalize(stmt); - endTrans(db); - beginTrans(db); - - return checkError(db); -} - -std::string sqlUtils::createInsertQuery( - const std::vector &values, - const std::string &table) { - std::stringstream cols; - std::stringstream vals; - const auto len = values.size(); - for (size_t i = 0; i < len; ++i) { - cols << MDL::label2StrSql(values.at(i)->label); - vals << "?"; - if (len != (i + 1)) { - cols << ", "; - vals << ", "; - } - } - std::stringstream ss; - ss << "INSERT INTO " << table - << " (" << cols.str() << ")" - << " VALUES " - << " (" << vals.str() << ");"; - return ss.str(); -} - -bool sqlUtils::insert(const std::vector> &records, - sqlite3 *db, const std::string &table) { - if (0 == records.size()) { - return true; - } - // assuming all records are the same - const auto &rec = records.at(0); - auto query = createInsertQuery(rec, table); - sqlite3_stmt *stmt = nullptr; - sqlite3_prepare_v2(db, query.c_str(), -1, &stmt, nullptr); - // FIXME currently, whole db is in one huge transaction. Finish whatever might be pending, - // do our business in a clean transaction and start a new transaction after (not to break the original code) - commitTrans(db); - beginTrans(db); - - const auto len = rec.size(); - for (const auto &r : records) { - // bind proper values - for (size_t i = 0; i < len; ++i) { - bindValue(stmt, i + 1, *r.at(i)); - } - // execute - sqlite3_step(stmt); - sqlite3_clear_bindings(stmt); - sqlite3_reset(stmt); - } - sqlite3_finalize(stmt); - endTrans(db); - beginTrans(db); - - return checkError(db); -} - -bool sqlUtils::insert(const std::vector &values, - sqlite3 *db, const std::string &table) { - return insert(std::vector>{values}, db, table); -} - -int sqlUtils::bindValue(sqlite3_stmt *stmt, const int position, const MDObject &valueIn) -{ - //First reset the statement - //rc = sqlite3_reset(stmt); - //std::cerr << "rc after reset: " << rc <c_str(), -1, SQLITE_TRANSIENT); - case LABEL_VECTOR_DOUBLE: - case LABEL_VECTOR_SIZET: - return sqlite3_bind_text(stmt, position, valueIn.toString(false, true).c_str(), -1, SQLITE_TRANSIENT); - default: - REPORT_ERROR(ERR_ARG_INCORRECT,"Do not know how to handle this type"); - } - } -} - -bool sqlUtils::checkError(sqlite3 *db) { - auto err = sqlite3_errcode(db); - if (0 != err - && 100 != err && 101 != err) { // probably not an error in case of the sqlite3_step (fingers crossed) - auto msg = sqlite3_errmsg(db); - std::cerr << "SQLite3 error: " << err - << "\n" - << msg << std::endl; - return false; - } - - return true; - } diff --git a/src/core/utils/sql_utils.h b/src/core/utils/sql_utils.h deleted file mode 100644 index b96a830..0000000 --- a/src/core/utils/sql_utils.h +++ /dev/null @@ -1,190 +0,0 @@ -/*************************************************************************** - * - * Authors: David Strelak (davidstrelak@gmail.com) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_UTILS_SQL_UTILS_H_ -#define CORE_UTILS_SQL_UTILS_H_ - -#include -#include "../metadata_label.h" -#include "../metadata_object.h" -#include "../metadata_static.h" - -class sqlUtils { -public: - /** - * Add a new column to a DB table. - * WARNING: this operation is typically 'very slow'. - * If you can, define all columns of the table at the construction time. - * @param columns to be added - * @param db to be altered - * @param table to be altered - * @returns true on success - */ - static bool addColumns(const std::vector &columns, - sqlite3 *db, const std::string &table); - - /** - * Report last error registered by the db to std::cerr - * @param db where the error occured - */ - static void reportLastError(sqlite3 *db) { - - } - - /** - * Retrieve all values within a specific row - * @param rowId of the row - * @param db to be read - * @param table to be read - * @param values will be stored here - * @return true on success - */ - static bool select(size_t rowId, - sqlite3 *db, const std::string &table, - std::vector &values); - - /** - * Retrieve all rows from a table - * All MDObjects are expected to be in the same order - * @param db to be read - * @param table to be read - * @columns to be read - * @param rows will be stored here - * @return true on success - */ - static bool select(sqlite3 *db, const std::string &table, - const std::vector &columns, - std::vector> &rows); - - /** - * Retrieve all values within a single column - * @param label of the column - * @param db to be read - * @param table to be read - * @param values will be stored here (appended to the end) - * @return true on success - */ - template - static bool select(const MDLabel &label, - sqlite3 *db, const std::string &table, - std::vector &values) { - // assuming all records are the same - auto query = createSelectQuery({label}, table); - - sqlite3_stmt *stmt = nullptr; - // FIXME currently, whole db is in one huge transaction. Finish whatever might be pending, - // do our business in a clean transaction and start a new transaction after (not to break the original code) - commitTrans(db); - beginTrans(db); - sqlite3_prepare_v2(db, query.c_str(), -1, &stmt, nullptr); - - MDObject obj(label); - // execute, extract value from each row - while (sqlite3_step(stmt) == SQLITE_ROW) { - extractValue(stmt, 0, obj); - values.emplace_back(obj.getValue2(T())); - } - - sqlite3_reset(stmt); - sqlite3_finalize(stmt); - endTrans(db); - beginTrans(db); - - return checkError(db); - } - - /** - * Add multiple new rows into the table - * @param records to be added (respective columns are expected to exists in the table) - * @param db to be altered - * @param table to be altered - * @return true on success - */ - static bool insert(const std::vector> &records, - sqlite3 *db, const std::string &table); - - /** - * Add a single new row into the table - * @param values in the row to be added (respective columns are expected to exists in the table) - * @param db to be altered - * @param table to be altered - * @return true on success - */ - static bool insert(const std::vector &values, - sqlite3 *db, const std::string &table); - - /** - * Update a single row in the table - * @param values in the row to be updated (respective columns are expected to exists in the table) - * @param db to be altered - * @param table to be altered - * @param id of the row - * @return true on success - */ - static bool update(const std::vector &values, - sqlite3 *db, const std::string &table, size_t id); - -protected: - static inline void beginTrans(sqlite3 *db) { - sqlite3_exec(db, "BEGIN TRANSACTION", nullptr, nullptr, nullptr); - } - - static inline void endTrans(sqlite3 *db) { - sqlite3_exec(db, "END TRANSACTION", nullptr, nullptr, nullptr); - } - - static inline void commitTrans(sqlite3 *db) { - sqlite3_exec(db, "COMMIT TRANSACTION", nullptr, nullptr, nullptr); - } - - static bool checkError(sqlite3 *db); - - /** Create a query for selecting multiple values from a table */ - static std::string createSelectQuery( - const std::vector &values, - const std::string &table); - - /** Create a query for selecting multiple values from a specific row */ - static std::string createSelectQuery(size_t rowId, - const std::vector &values, - const std::string &table); - - static std::string createInsertQuery( - const std::vector &values, - const std::string &table); - - /** Create an update query for setting multiple values from a specific row */ - static std::string createUpdateQuery( - const std::vector &values, - const std::string &table, - size_t id); - -private: - /** FIXME this is copied directly from metadata_sql.h */ - static void extractValue(sqlite3_stmt *stmt, const int position, MDObject &valueOut); - static int bindValue(sqlite3_stmt *stmt, const int position, const MDObject &valueIn); -}; - -#endif /* CORE_UTILS_SQL_UTILS_H_ */ diff --git a/src/core/utils/time_utils.cpp b/src/core/utils/time_utils.cpp deleted file mode 100644 index 45d8aa0..0000000 --- a/src/core/utils/time_utils.cpp +++ /dev/null @@ -1,30 +0,0 @@ -/*************************************************************************** - * - * Authors: David Strelak (davidstrelak@gmail.com) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include "time_utils.h" - -int timeUtils::indent_counter = -1; -bool timeUtils::isReportEnabled = true; -std::string timeUtils::separator = " | "; diff --git a/src/core/utils/time_utils.h b/src/core/utils/time_utils.h deleted file mode 100644 index e20d897..0000000 --- a/src/core/utils/time_utils.h +++ /dev/null @@ -1,187 +0,0 @@ -/*************************************************************************** - * - * Authors: David Strelak (davidstrelak@gmail.com) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_UTILS_TIME_UTILS_H_ -#define CORE_UTILS_TIME_UTILS_H_ - -#include -#include -#include - -/** - * This is a utility class able to measure duration of a block of code. - * It can be used for benchmarking parts of the code by wrapping it using lambda - * expressions. - * - * Unless explicitly stated, its method can be used similarly to the following text: - * timeUtils::measureTimeMs([&]{ - * code_to_measure - * }); - * - * Typical usage would be to wrap several parts of the code with the 'report' - * methods, disable reporting, and re-enable it once the code reaches the proper - * location: - * - * void foo() { - * timeUtils::reportTimeMs("foo", [&]{ - * // original code - * }); - * } - * - * int main() { - * timeUtils::disableReport(); - * // some code, including e.g. foo() - * timeUtils::enableReport(); - * // more code, including e.g. foo() - * } - * - * Reporting methods are not thread-safe. - */ -class timeUtils -{ -public: - - /** - * Function to measure execution time of some code - * @param ToDuration 'resolution' of the time, e.g. std::chrono::seconds - * @param F function to run - * @param Args arguments of the function - */ - template - static typename ToDuration::rep measureTime(F &&func, Args &&...args) { - using namespace std::chrono; - auto start = high_resolution_clock::now(); - std::forward(func)(std::forward(args)...); - return duration_cast(high_resolution_clock::now() - start).count(); - } - - /** - * Function to measure and report execution time of some code - * @param ToDuration 'resolution' of the time, e.g. std::chrono::seconds - * @param unit to show in the report (e.g. 's' for std::chrono::seconds) - * @param funName identification of the block - * @param F function to run - * @param Args arguments of the function - */ - template - static void reportTime(const std::string &unit, - const std::string &funName, F &&func, Args &&...args) { - ++indent_counter; - auto duration = measureTime(func, args...); - if (isReportEnabled) { - reportIndent(indent_counter); - std::cout << funName << separator << duration << separator << unit << "\n"; - } - --indent_counter; - } - - /** - * Helper function, measuring time of some code in seconds - * @param F function to run - * @param Args arguments of the function - */ - template - static std::chrono::seconds::rep measureTimeS(F &&func, Args &&...args) { - return measureTime(func, args...); - } - - /** - * Helper function, measuring time of some code in milliseconds - * @param F function to run - * @param Args arguments of the function - */ - template - static std::chrono::milliseconds::rep measureTimeMs(F &&func, Args &&...args) { - return measureTime(func, args...); - } - - /** - * Helper function, measuring time of some code in seconds and reporting - * it to std::cout. - * @param funName some name the block (for identification purposes) - * @param F funcion to run - * @param Args arguments of the function - */ - template - static void reportTimeS(const std::string &funName, F &&func, Args &&...args) { - reportTime("s", funName, func, args...); - } - - /** - * Helper function, measuring time of some code in milliseconds and reporting - * it to std::cout. - * @param funName some name the block (for identification purposes) - * @param F funcion to run - * @param Args arguments of the function - */ - template - static void reportTimeMs(const std::string &funName, F &&func, Args &&...args) { - reportTime("ms", funName, func, args...); - } - - /** - * Helper function, measuring time of some code in microseconds and reporting - * it to std::cout. - * @param funName some name the block (for identification purposes) - * @param F funcion to run - * @param Args arguments of the function - */ - template - static void reportTimeUs(const std::string &funName, F &&func, Args &&...args) { - reportTime("us", funName, func, args...); - } - - static void enableReport() { - isReportEnabled = true; - } - - static void disableReport() { - isReportEnabled = false; - } - - static void setSeparator(const std::string &s) { - separator = s; - } - -private: - /** - * This method is responsible for indenting the current block of code - * in the report fucntions - */ - static void reportIndent(int level) { - if (0 == level) { - return; - } - std::cout << std::string((level - 1) * 2, ' '); - std::cout << " » "; - } - - static int indent_counter; - static bool isReportEnabled; - static std::string separator; - -}; // timeUtils - -#endif /* CORE_UTILS_TIME_UTILS_H_ */ diff --git a/src/core/xmipp_array_coord.h b/src/core/xmipp_array_coord.h deleted file mode 100644 index 13ea8be..0000000 --- a/src/core/xmipp_array_coord.h +++ /dev/null @@ -1,47 +0,0 @@ -/*************************************************************************** - * - * Authors: David Strelak (davidstrelak@gmail.com) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef XMIPPCORE_CORE_XMIPP_ARRAY_COORD_H_ -#define XMIPPCORE_CORE_XMIPP_ARRAY_COORD_H_ - -#include - -/** - * Structure with a set of coordinates in an image - */ -struct ArrayCoord -{ - // Number of images - size_t n; - // Number of elements in Z - int z; - // Number of elements in Y - int y; - // Number of elements in X - int x; -} ; - - -#endif /* XMIPPCORE_CORE_XMIPP_ARRAY_COORD_H_ */ diff --git a/src/core/xmipp_array_dim.h b/src/core/xmipp_array_dim.h deleted file mode 100644 index 7adfc70..0000000 --- a/src/core/xmipp_array_dim.h +++ /dev/null @@ -1,74 +0,0 @@ -/*************************************************************************** - * - * Authors: David Strelak (davidstrelak@gmail.com) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef XMIPPCORE_CORE_XMIPP_ARRAY_DIM_H_ -#define XMIPPCORE_CORE_XMIPP_ARRAY_DIM_H_ - -#include - -/** - * Structure with the dimensions information of an image - */ -struct ArrayDim -{ - // Number of images - size_t ndim; - // Number of elements in Z - size_t zdim; - // Number of elements in Y - size_t ydim; - // Number of elements in X - size_t xdim; - // Number of elements in YX - size_t yxdim; - // Number of elements in ZYX - size_t zyxdim; - // Number of elements in NZYX - size_t nzyxdim; - - ArrayDim() - { - ndim = 0; - zdim = 0; - ydim = 0; - xdim = 0; - yxdim = 0; - zyxdim = 0; - nzyxdim = 0; - } - - bool operator==(ArrayDim &adim) - { - return (this->ndim == adim.ndim && - this->zdim == adim.zdim && - this->ydim == adim.ydim && - this->xdim == adim.xdim ); - } -} -; - - - -#endif /* XMIPPCORE_CORE_XMIPP_ARRAY_DIM_H_ */ diff --git a/src/core/xmipp_color.cpp b/src/core/xmipp_color.cpp deleted file mode 100644 index 4af6c2f..0000000 --- a/src/core/xmipp_color.cpp +++ /dev/null @@ -1,36 +0,0 @@ -/*************************************************************************** - * - * Authors: J.M. De la Rosa Trevin (jmdelarosa@cnb.csic.es) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include "xmipp_color.h" - -String colorString(const char * msg, int color, int attribute, int bgcolor) -{ - size_t n = strlen(msg); - char *formatBuffer = new char[n+20]; // Extra space for color characters - sprintf(formatBuffer, "%c[%d;%dm%s%c[0m", 0x1B, attribute, color + 30, msg, 0x1B); - String s = formatBuffer; - delete[] formatBuffer; - return s; -} diff --git a/src/core/xmipp_color.h b/src/core/xmipp_color.h deleted file mode 100644 index 1dd3fc8..0000000 --- a/src/core/xmipp_color.h +++ /dev/null @@ -1,57 +0,0 @@ -/*************************************************************************** - * - * Authors: J.M. De la Rosa Trevin (jmdelarosa@cnb.csic.es) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_COLOR_H_ -#define CORE_COLOR_H_ - -#include -#include "xmipp_strings.h" -enum colorAttribute -{ - RESET = 0, - BRIGHT = 1, - DIM = 2, - UNDERLINE = 3, - BLINK = 4, - REVERSE = 7, - HIDDEN = 8 -}; - -enum colorCode -{ - BLACK = 0, - RED = 1, - GREEN = 2, - YELLOW = 3, - BLUE = 4, - MAGENTA = 5, - CYAN = 6, - WHITE = 7 -}; - -String colorString(const char * msg, int color, int attribute = BRIGHT, int bgcolor=BLACK); - - -#endif /* COLOR_H_ */ diff --git a/src/core/xmipp_datatype.cpp b/src/core/xmipp_datatype.cpp deleted file mode 100644 index 1895ac1..0000000 --- a/src/core/xmipp_datatype.cpp +++ /dev/null @@ -1,214 +0,0 @@ -/*************************************************************************** - * Authors: Joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include -#include "xmipp_datatype.h" -#include "xmipp_error.h" -#include "utils/half.hpp" - - -// Get size of datatype -size_t gettypesize(DataType type) -{ - size_t size; - - switch ( type ) - { - case DT_UHalfByte: - case DT_UChar: - case DT_SChar: - size = sizeof(char); - break; - case DT_UShort: - case DT_Short: - size = sizeof(short); - break; - case DT_UInt: - case DT_Int: - size = sizeof(int); - break; - case DT_ULong: - case DT_Long: - size = sizeof(long); - break; - case DT_Float: - size = sizeof(float); - break; - case DT_Double: - size = sizeof(double); - break; - case DT_CShort: - size = sizeof(std::complex); - break; - case DT_CInt: - size = sizeof(std::complex); - break; - case DT_CFloat: - size = sizeof(std::complex); - break; - case DT_CDouble: - size = sizeof(std::complex); - break; - case DT_Bool: - size = sizeof(bool); - break; - case DT_HalfFloat: - size = sizeof(half_float::half); - break; - default: - size = 0; - } - - return(size); -} - -/** Convert datatype string to datatypr enun */ -DataType str2Datatype(const std::string & str) -{ - DataType datatype; - - if(str=="uint8") - datatype = DT_UChar; - else if (str == "uhalfint8") - datatype = DT_UHalfByte; - else if (str=="int8") - datatype = DT_SChar; - else if (str=="uint16") - datatype = DT_UShort; - else if (str=="int16") - datatype = DT_Short; - else if (str=="uint32") - datatype = DT_UInt; - else if (str=="int32") - datatype = DT_Int; - else if (str=="long") - datatype = DT_Long; - else if (str=="float") - datatype = DT_Float; - else if (str=="double") - datatype = DT_Double; - else if (str=="cint16") - datatype = DT_CShort; - else if (str=="cint32") - datatype = DT_CInt; - else if (str=="cfloat") - datatype = DT_CFloat; - else if (str=="cdouble") - datatype = DT_CDouble; - else if (str=="bool") - datatype = DT_Bool; - else if (str=="half") - datatype = DT_HalfFloat; - else - REPORT_ERROR(ERR_TYPE_INCORRECT, "datatypeString2int; unknown datatype"); - - return datatype; -} - -/** Convert datatype to string */ -std::string datatype2Str(DataType datatype) -{ - switch ( datatype ) - { - case DT_UHalfByte: - return "uhalfint8"; - case DT_UChar: - return "uint8"; - case DT_SChar: - return "int8"; - case DT_UShort: - return "uint16"; - case DT_Short: - return "int16"; - case DT_UInt: - return "uint32"; - case DT_Int: - return "int32"; - case DT_Long: - return "int64"; - case DT_Float: - return "float"; - case DT_Double: - return "double"; - case DT_CShort: - return "cint16"; - case DT_CInt: - return "cint32"; - case DT_CFloat: - return "cfloat"; - case DT_CDouble: - return "cdouble"; - case DT_Bool: - return "bool"; - case DT_HalfFloat: - return "half"; - default: - return "unknown type"; - } -} - -std::string datatype2StrLong(DataType datatype) -{ - switch (datatype) - { - case DT_UHalfByte: - return "Unsigned 4 bit type (UHalfInt8)"; - case DT_UChar: - return "Unsigned character or byte type (UInt8)"; - case DT_SChar: - return "Signed character (Int8)"; - case DT_UShort: - return "Unsigned short integer (UInt16)"; - case DT_Short: - return "Signed short integer (Int16)"; - case DT_UInt: - return "Unsigned integer (UInt32)"; - case DT_Int: - return "Signed integer (Int32)"; - case DT_Long: - return "Signed integer (4 or 8 byte, depending on system)"; - case DT_Float: - return "Floating point (4-byte)"; - case DT_Double: - return "Double precision floating point (8-byte)"; - case DT_CShort: - return "Complex two-byte integer (4-byte)"; - case DT_CInt: - return "Complex integer (8-byte)"; - case DT_CFloat: - return "Complex floating point (8-byte)"; - case DT_CDouble: - return "Complex floating point (16-byte)"; - case DT_Bool: - return "Boolean (1-byte?)"; - case DT_HalfFloat: - return "Half precision floating point (2-byte)"; - case DT_Unknown: - return "Unknown data type"; - default: - return "Undefined data type"; - } -} - diff --git a/src/core/xmipp_datatype.h b/src/core/xmipp_datatype.h deleted file mode 100644 index fd3332c..0000000 --- a/src/core/xmipp_datatype.h +++ /dev/null @@ -1,76 +0,0 @@ -/*************************************************************************** - * Authors: Joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_DATATYPE_H_ -#define CORE_DATATYPE_H_ - -#include - -/** @defgroup Datatypes Datatypes for MultidimArrays - * @ingroup DataLibrary -*/ -//@{ -/** Data type. - * This class defines the datatype of the data inside this image. - */ -typedef enum -{ - DT_Default = -1, // For writing purposes - DT_Unknown = 0, // Undefined data type - DT_UChar = 1, // Unsigned character or byte type - DT_SChar = 2, // Signed character (for CCP4) - DT_UShort = 3, // Unsigned integer (2-byte) - DT_Short = 4, // Signed integer (2-byte) - DT_UInt = 5, // Unsigned integer (4-byte) - DT_Int = 6, // Signed integer (4-byte) - DT_ULong = 7, // Unsigned integer (4 or 8 byte, depending on system) - DT_Long = 8, // Signed integer (4 or 8 byte, depending on system) - DT_Float = 9, // Floating point (4-byte) - DT_Double = 10, // DT_Double precision floating point (8-byte) - DT_CShort = 11, // Complex two-byte integer (4-byte) - DT_CInt = 12, // Complex integer (8-byte) - DT_CFloat = 13, // Complex floating point (8-byte) - DT_CDouble = 14, // Complex floating point (16-byte) - DT_Bool = 15, // Boolean (1-byte?) - DT_UHalfByte = 16, // For 4-bit format (e.g. mrc 4bit file) - DT_HalfFloat = 17, // Half precision floating point (2-byte) - DT_LastEntry = 18 // This must be the last entry -} DataType; - - -/// Returns memory size of datatype -size_t gettypesize(DataType type); - -/** Convert datatype string to datatype enum */ -DataType str2Datatype(const std::string & str); - -/** Convert datatype to string */ -std::string datatype2Str(DataType datatype); - -/** Convert datatype to string in long format */ -std::string datatype2StrLong(DataType datatype); - -//@} -#endif /* DATATYPE_H_ */ diff --git a/src/core/xmipp_error.cpp b/src/core/xmipp_error.cpp deleted file mode 100644 index 3266495..0000000 --- a/src/core/xmipp_error.cpp +++ /dev/null @@ -1,200 +0,0 @@ -/*************************************************************************** - * - * Authors: Carlos Oscar S. Sorzano (coss@cnb.csic.es) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include -#include -#include "xmipp_error.h" -#include "xmipp_color.h" - -// Object Constructor -XmippError::XmippError(const ErrorType nerr, const String &what, - const String &fileArg, const long lineArg) - :std::runtime_error(XmippError::getMessage(nerr, what, fileArg, lineArg)), __errno(nerr) -{} - -String XmippError::getMessage(const ErrorType nerr, const String& what, - const String &fileArg, const long lineArg) { - String error = formatString("XMIPP_ERROR %d: %s\n ", nerr, getDefaultMessage(nerr).c_str()); - error += what; - error += formatString("\n File: %s line: %ld\n", fileArg.c_str(), lineArg); - return error; -} - -String XmippError::getDefaultMessage(ErrorType e) -{ - switch (e) - { - case ERR_ARG_BADCMDLINE: - return "Errors on command line parameters"; - case ERR_ARG_INCORRECT: - return " Incorrect argument received"; - case ERR_ARG_MISSING: - return " Argument missing"; - case ERR_ARG_DEPENDENCE: - return "Error with some arguments dependecies"; - - case ERR_PROG_NOTDEF: - return "Requiered function not implemented in derived class"; - case ERR_DEBUG_TEST: - return " Just an error for debugging purpose"; - case ERR_DEBUG_IMPOSIBLE: - return " Just for debugging: situation that can't happens"; - - case ERR_DOCFILE: - return " Error in docfile format."; - - case ERR_GRID: - return " Grid general error."; - case ERR_GRID_SIZE: - return " Incorrect number of GRID volumes or shapes."; - - case ERR_IMG_NOREAD: - return " Image cannot be read from file."; - case ERR_IMG_NOWRITE: - return " Image cannot be written to file."; - case ERR_IMG_UNKNOWN: - return " Unknown image type."; - - case ERR_INDEX_OUTOFBOUNDS: - return " Index out of bounds."; - - case ERR_IO: - return " Input/output general error."; - case ERR_IO_NOCLOSED: - return " File cannot be closed."; - case ERR_IO_NOPATH: - return " Environment PATH cannot be read."; - case ERR_IO_NOPERM: - return " Insufficient permissions to perform operation."; - case ERR_IO_NOREAD: - return " Couldn't read from file."; - case ERR_IO_NOTDIR: - return " It is not a directory."; - case ERR_IO_NOTEXIST: - return " File or directory does not exist."; - case ERR_IO_NOTFILE: - return " It is not a file"; - case ERR_IO_NOTOPEN: - return "File cannot be open."; - case ERR_IO_NOWRITE: - return " Couldn't write to file."; - case ERR_IO_SIZE: - return " Incorrect file size."; - - case ERR_MATRIX: - return " Matrix error."; - case ERR_MATRIX_DIM: - return " Incorrect matrix dimensions."; - case ERR_MATRIX_EMPTY: - return " The matrix is empty."; - case ERR_MATRIX_SIZE: - return " Incorrect matrix size."; - - case ERR_MD: - return " MetaData error."; - case ERR_MD_BADLABEL: - return " Unexpected label."; - case ERR_MD_MISSINGLABEL: - return " Missing expected label."; - case ERR_MD_BADTYPE: - return " Bad label type."; - case ERR_MD_NOACTIVE: - return " No active object in MetaData."; - case ERR_MD_NOOBJ: - return " No exist requested object."; - case ERR_MD_SQL: - return " Error in SQL of MetaData operations"; - case ERR_MD_OBJECTNUMBER: - return " Bad number of objects in MetaData"; - case ERR_MD_UNDEFINED: - return " Undefined label."; - case ERR_MD_BADBLOCK: - return " Block not existing."; - - case ERR_MEM_BADREQUEST: - return " Bad amount of memory requested."; - case ERR_MEM_NOTENOUGH: - return " There is not enough memory for allocation."; - case ERR_MEM_NOTDEALLOC: - return " Memory has not been deallocated."; - case ERR_MEM_NULLPOINTER: - return " Null pointer passed as parameter."; - - case ERR_MMAP: - return " Global mmap error."; - case ERR_MMAP_NOTADDR: - return " Map addressing of file has failed."; - - case ERR_MULTIDIM_DIM: - return " Incorrect MultidimArray dimensions."; - case ERR_MULTIDIM_EMPTY: - return " MultidimArray is empty."; - case ERR_MULTIDIM_SIZE: - return " Incorrect MultidimArray size."; - - case ERR_NOT_IMPLEMENTED: - return " Algorithm not implemented yet."; - - case ERR_NUMERICAL: - return " Error related to numerical calculation."; - - case ERR_PARAM_INCORRECT: - return " Parameter incorrect."; - case ERR_PARAM_MISSING: - return " Parameter missing."; - - case ERR_PLANS_NOCREATE: - return " FFT plan cannot be created."; - - case ERR_SELFILE: - return " Error in selfile format"; - - case ERR_THREADS_NOTINIT: - return " Threads cannot be initiated."; - - case ERR_TYPE_INCORRECT: - return " Incorrect type received"; - - case ERR_UNCLASSIFIED: - return " Not classified error."; - - case ERR_VALUE_EMPTY: - return " Empty value."; - case ERR_VALUE_INCORRECT: - return " Incorrect received value."; - case ERR_VALUE_NOTSET: - return " Value has not been set."; - - default: - return "Unrecognized error code"; - } -} - -void reportWarning(const String& what) -{ - String error = formatString("=== XMIPP_WARNING ===\n%s", what.c_str()); - std::cerr << colorString(error.c_str(), MAGENTA) << std::endl; -} - diff --git a/src/core/xmipp_error.h b/src/core/xmipp_error.h deleted file mode 100644 index 5893b61..0000000 --- a/src/core/xmipp_error.h +++ /dev/null @@ -1,242 +0,0 @@ -/*************************************************************************** -* -* Authors: Carlos Oscar S. Sorzano (coss@cnb.csic.es) -* -* Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC -* -* This program is free software; you can redistribute it and/or modify -* it under the terms of the GNU General Public License as published by -* the Free Software Foundation; either version 2 of the License, or -* (at your option) any later version. -* -* This program is distributed in the hope that it will be useful, -* but WITHOUT ANY WARRANTY; without even the implied warranty of -* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -* GNU General Public License for more details. -* -* You should have received a copy of the GNU General Public License -* along with this program; if not, write to the Free Software -* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA -* 02111-1307 USA -* -* All comments concerning this program package may be sent to the -* e-mail address 'xmipp@cnb.csic.es' -***************************************************************************/ - -#pragma once - -#include -#include "xmipp_strings.h" - -/** @defgroup ErrorHandling Error handling - * @ingroup DataLibrary - * - * The error handling is performed in two different ways depending on the - * configuration selected for Xmipp in the file xmippConfiguration: a simple - * error management and a second method based on C++ exceptions. - * - * The first method aborts the program with an error code (different for each - * error) while the second throws an exception which might be caught by an - * external routine or program. - * - * The prototype definitions in both cases are the same as they are based on - * some macros which change with the configuration. Here goes a programming - * example considering both implementations. - * - * @code - * // Class definition - * class ReconstructingVolume : - * { - * ... - * void write(const FileName& fn) const; - * ... - * }; - * - * // Class implementation - * void ReconstructingVolume::write(const FileName& fn) const - * { - * ... - * if (...) - * REPORT_ERROR(ERR_MULTIDIM_SIZE, "Volume too small to be stored"); - * ... - * } - * - * // Use of this class in an external program - * using std::cout; - * using std::endl; - * ... - * #ifndef _NO_EXCEPTION - * try - * { - * vol_blobs.write(fn_blobs); - * } - * catch (XmippError XE) - * { - * std::cout << XE; - * std::cout << "The reconstructed volume is too small to be saved in blobs"; - * std::cout << "So, there is no blob version of it at this iteration"; - * std::cout << "I go on processing" << std::endl; - * } - * #else - * vol_blobs.write(fn_blobs); - * #endif - * ... - * @endcode - * - * You see that the routine implementation is the same in both cases but the - * external program varies from one to the other as in the exception case we can - * catch the exception and go on processing, while in the exit mode, the program - * always is aborted. If you don't put the routine in a try-catch structure and - * an exception is thrown then a core is generated and the program is - * automatically aborted. - * - */ -/** @{ */ -/* Enum with errors types. - * This enum represent the code of all possible - * Xmipp erros that will be used to reporting errors - * with REPORT_ERROR and EXIT_ERROR. - * The convention for the codes is the following: - * - All starts with prefix ERR_ - * - Follows some kind of section. Like IO for input/output errors. - * ERR_IO_ - * ERR_MEM_ - * ERR_IMG_ - * - Finally an abbreviation for the error msg. - * All error codes have a default string message - * that can be obtained with XmippError::getDefaultMessage(ErrorType) - */ -enum ErrorType -{ - ERR_FIRST_LABEL, - ERR_ARG_BADCMDLINE, ///< Errors on command line parameters. - ERR_ARG_INCORRECT, ///< Incorrect argument received. - ERR_ARG_MISSING, ///< Argument missing. - ERR_ARG_DEPENDENCE, ///< Error with some arguments dependencies - - ERR_PROG_NOTDEF, ///< Required function not implemented - - ERR_DEBUG_TEST, ///< Just an error for debugging purpose. - ERR_DEBUG_IMPOSIBLE, ///< Just for debugging, situation that can't happens - - ERR_DOCFILE, ///< Error in docfile format - - ERR_GPU_MEMORY, ///< GPU memory related issues - ERR_GRID, ///< Grid general error. - ERR_GRID_SIZE, ///< Incorrect number of GRID volumes or shapes - - ERR_IMG_NOREAD, ///< Cannot read image from file. - ERR_IMG_NOWRITE, ///< Cannot write image to file. - ERR_IMG_UNKNOWN, ///< Unknown image type - - ERR_INDEX_OUTOFBOUNDS, ///< Index out of bounds. - - ERR_IO, ///< Input/Output general error. - ERR_IO_NOCLOSED, ///< File cannot be closed. - ERR_IO_NOTEXIST, ///< File or directory does not exist. - ERR_IO_NOTOPEN, ///< File cannot be open. - ERR_IO_NOPERM, ///< Insufficient permissions to perform operation. - ERR_IO_NOREAD, ///< Couldn't read from file. - ERR_IO_NOWRITE, ///< Couldn't write to file. - ERR_IO_NOTFILE, ///< It is not a file. - ERR_IO_NOTDIR, ///< It is not a directory. - ERR_IO_NOPATH, ///< Environment PATH cannot be read. - ERR_IO_LOCKED, ///< Error when locking/unloking a file. - ERR_IO_SIZE, ///< Incorrect file size. - - ERR_LOGIC_ERROR, ///< Some logical error in the pipeline - - ERR_MATRIX, ///< Matrix error. - ERR_MATRIX_DIM, ///< Problem with matrix dimensions. - ERR_MATRIX_EMPTY, ///< The matrix is empty. - ERR_MATRIX_SIZE, ///< Problem with matrix size. - - ERR_MD, ///< MetaData error. - ERR_MD_NOACTIVE, ///< No active object in MetaData. - ERR_MD_NOOBJ, ///< No exist requested object. - ERR_MD_BADLABEL, ///< Unexpected label. - ERR_MD_MISSINGLABEL, ///< Missing expected label - ERR_MD_SQL, ///< Error in SQL of MetaData operations. - ERR_MD_OBJECTNUMBER, ///< Incorrect number of objects in Metadata - ERR_MD_BADTYPE, ///< Bad label type. - ERR_MD_UNDEFINED, ///< Undefined label. - ERR_MD_BADBLOCK , ///< This block does not exist. - - ERR_MEM_BADREQUEST, ///< Bad amount of memory requested. - ERR_MEM_NOTENOUGH, ///< There is not enough memory for allocation. - ERR_MEM_NOTDEALLOC, ///< Memory has not been deallocated. - ERR_MEM_NULLPOINTER, ///< Null pointer passed as parameter - - ERR_MMAP, ///< Global mmap error. - ERR_MMAP_NOTADDR, ///< Map addressing of file has failed. - - ERR_MULTIDIM_DIM, ///< Incorrect MultidimArray dimensions - ERR_MULTIDIM_SIZE, ///< Incorrect MultidimArray size - ERR_MULTIDIM_EMPTY, ///< MultidimArray is empty. - - ERR_NOT_IMPLEMENTED, ///< Case or algorithm not implemented yet. - - ERR_NUMERICAL, ///< Error related to numerical calculation. - - ERR_PARAM_INCORRECT, ///< Parameter incorrect. - ERR_PARAM_MISSING, ///< Parameter missing. - - ERR_PLANS_NOCREATE, ///< FFT Plan cannot be created. - - ERR_SELFILE, ///< Error in docfile format - - ERR_THREADS_NOTINIT, ///< Threads cannot be initiated. - - ERR_TYPE_INCORRECT, ///< Incorrect type received. - - ERR_UNCLASSIFIED, ///< Just to locate unclassified errors. - - ERR_VALUE_EMPTY, ///< Empty value. - ERR_VALUE_INCORRECT, ///< Incorrect value received. - ERR_VALUE_NOTSET, ///< Value has not been set. - - ERR_LAST_LABEL -}; - - -/** Show message and throw exception - * - * This macro shows the given message and exits with the error code. - * - * @code - * if (...) - * REPORT_ERROR(ERR_DEBUG_TEST, "Error 1"); - * @endcode - */ -#define REPORT_ERROR(nerr, ErrormMsg) throw XmippError(nerr, ErrormMsg, __FILE__, __LINE__) -/** Report error without any extra message */ -//#define REPORT_ERROR(nerr) throw XmippError((ErrorType)nerr, "", __FILE__, __LINE__) - -/** Exception class - * - * This is the class type for the errors thrown by the routines when the - * exception handling mode is active (see Xmipp Configuration for details about - * enabling the exception handling). - */ -class XmippError : public std::runtime_error -{ -public: - XmippError(const ErrorType nerr, const String& what, - const String &fileArg, const long lineArg); - - XmippError(const std::string &what):XmippError(ERR_UNCLASSIFIED,what,"Unknown file",0) {}; - - ErrorType __errno; -private: - static String getMessage(const ErrorType nerr, const String& what, - const String &fileArg, const long lineArg); - - /** Get default message */ - static String getDefaultMessage(ErrorType e); -}; - -/** Print a report warning and continue the execution. - */ -void reportWarning(const String& what); - -/* @} */ \ No newline at end of file diff --git a/src/core/xmipp_fft.cpp b/src/core/xmipp_fft.cpp deleted file mode 100644 index f33431e..0000000 --- a/src/core/xmipp_fft.cpp +++ /dev/null @@ -1,518 +0,0 @@ -/*************************************************************************** - * - * Authors: Carlos Oscar S. Sorzano (coss@cnb.csic.es) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include "bilib/dft.h" - -#include "xmipp_fft.h" -#include "args.h" -#include "histogram.h" - -/* Format conversions ------------------------------------------------------ */ -/** Convert whole -> half of (centro-symmetric) Fourier transforms 1D. -- */ -void Whole2Half(const MultidimArray > &in, - MultidimArray > &out) -{ - if (in.getDim() == 1) - { - // 1D - int ldim = (int)(XSIZE(in) / 2) + 1; - out.resize(ldim); - for (int j = 0; j < ldim; j++) - out(j) = in(j); - } - else if (in.getDim() == 2) - { - // 2D - // This assumes squared images... - int ldim = (int)(YSIZE(in) / 2) + 1; - - out.initZeros(ldim, XSIZE(in)); - // Fill first column only half - for (int j = 0; j < ldim; j++) - dAij(out, 0, j) = dAij(in, 0, j); - // Fill rest - for (int i = 1; i < ldim; i++) - for (size_t j = 0; j < XSIZE(in); j++) - dAij(out, i, j) = dAij(in, i, j); - } - else - REPORT_ERROR(ERR_MULTIDIM_DIM,"ERROR: Whole2Half only implemented for 1D and 2D multidimArrays"); - -} - -/** Convert half -> whole of (centro-symmetric) Fourier transforms 2D. -- */ -void Half2Whole(const MultidimArray > &in, - MultidimArray > &out, size_t oridim) -{ - if (in.getDim() == 1) - { - // 1D - out.resizeNoCopy(oridim); - for (size_t j = 0; j < XSIZE(in); j++) - DIRECT_A1D_ELEM(out,j) = DIRECT_A1D_ELEM(in,j); - for (size_t j = XSIZE(in); j < oridim; j++) - DIRECT_A1D_ELEM(out,j) = conj(DIRECT_A1D_ELEM(in,oridim - j)); - } - else if (in.getDim() == 2) - { - // 2D - out.resizeNoCopy(oridim, XSIZE(in)); - - // Old part - for (size_t i = 0; i < YSIZE(in); i++) - for (size_t j = 0; j < XSIZE(in); j++) - dAij(out, i, j) = dAij(in, i, j); - - // Complete first column of old part - for (size_t j = YSIZE(in); j < XSIZE(in); j++) - dAij(out, 0, j) = conj(dAij(in, 0, XSIZE(in) - j)); - - // New part - for (size_t i = YSIZE(in); i < oridim; i++) - { - dAij(out, i, 0) = conj(dAij(in, oridim - i, 0)); - for (size_t j = 1; j < XSIZE(in); j++) - dAij(out, i, j) = conj(dAij(in, oridim - i, XSIZE(in) - j)); - } - } -} - -/** Convert complex -> real,imag Fourier transforms 2D. -- */ -void Complex2RealImag(const MultidimArray< std::complex< double > > & in, - MultidimArray< double > & real, - MultidimArray< double > & imag) -{ - real.resizeNoCopy(in); - imag.resizeNoCopy(in); - Complex2RealImag(MULTIDIM_ARRAY(in), MULTIDIM_ARRAY(real), - MULTIDIM_ARRAY(imag), MULTIDIM_SIZE(in)); -} - -/** Convert real,imag -> complex Fourier transforms 3D. -- */ -void RealImag2Complex(const MultidimArray< double > & real, - const MultidimArray< double > & imag, - MultidimArray< std::complex< double > > & out) -{ - out.resizeNoCopy(real); - RealImag2Complex(MULTIDIM_ARRAY(real), MULTIDIM_ARRAY(imag), - MULTIDIM_ARRAY(out), MULTIDIM_SIZE(real)); -} - -/** Direct Fourier Transform nD ------------------------------------------- */ -void FourierTransform(const MultidimArray &in, - MultidimArray< std::complex > &out) -{ - if ( in.getDim() == 1 ) - { - // 1D - int N = XSIZE(in); - MultidimArray re(in), tmp(N), im(N), cas(N); - out.resizeNoCopy(N); - - GetCaS(MULTIDIM_ARRAY(cas), N); - DftRealToRealImaginary(MULTIDIM_ARRAY(re), MULTIDIM_ARRAY(im), - MULTIDIM_ARRAY(tmp), MULTIDIM_ARRAY(cas), N); - RealImag2Complex(MULTIDIM_ARRAY(re), MULTIDIM_ARRAY(im), - MULTIDIM_ARRAY(out), N); - } - else - { - // 2D and 3D - int Status; - MultidimArray re(in), im; - im.resizeNoCopy(in); - out.resizeNoCopy(in); - VolumeDftRealToRealImaginary(MULTIDIM_ARRAY(re), - MULTIDIM_ARRAY(im), XSIZE(in), YSIZE(in), ZSIZE(in), &Status); - RealImag2Complex(re,im,out); - } - -} - -/** Inverse Fourier Transform nD. ----------------------------------------- */ -void InverseFourierTransform(const MultidimArray< std::complex > &in, - MultidimArray &out) -{ - if ( in.getDim() == 1 ) - { - // 1D - int N = XSIZE(in); - MultidimArray tmp(N), im(N), cas(N); - out.resizeNoCopy(N); - - GetCaS(MULTIDIM_ARRAY(cas), N); - Complex2RealImag(MULTIDIM_ARRAY(in), MULTIDIM_ARRAY(out), - MULTIDIM_ARRAY(im), N); - InvDftRealImaginaryToReal(MULTIDIM_ARRAY(out), MULTIDIM_ARRAY(im), - MULTIDIM_ARRAY(tmp), MULTIDIM_ARRAY(cas), N); - } - else - { - // 2D and 3D - int Status; - MultidimArray im; - out.resizeNoCopy(in); - im.resizeNoCopy(in); - Complex2RealImag(in, out, im); - VolumeInvDftRealImaginaryToReal(MULTIDIM_ARRAY(out), - MULTIDIM_ARRAY(im), - XSIZE(in), YSIZE(in), ZSIZE(in), &Status); - } -} - - -/** Direct Fourier Transform 1D / 2D, output half of (centro-symmetric) transform ---- */ -void FourierTransformHalf(const MultidimArray &in, - MultidimArray< std::complex > &out) -{ - - MultidimArray > aux; - FourierTransform(in, aux); - Whole2Half(aux, out); -} - -/** Inverse Fourier Transform 1D / 2D, input half of (centro-symmetric) transform ---- */ -void InverseFourierTransformHalf(const MultidimArray< std::complex > &in, - MultidimArray &out, int oridim) -{ - - MultidimArray< std::complex > aux; - Half2Whole(in, aux, oridim); - InverseFourierTransform(aux, out); - out.setXmippOrigin(); -} - -/* Complex Fourier Transform ------------------------------------------------------ */ - -/** Complex Direct Fourier Transform 1D ------------------------------------------- */ -void FourierTransform(const MultidimArray > &in, - MultidimArray< std::complex > &out) -{ - // Only implemented for 1D transforms - in.checkDimension(1); - - int N = XSIZE(in); - MultidimArray re(N), tmpre(N), tmpim(N), im(N), cas(N); - out.resizeNoCopy(N); - - GetCaS(MULTIDIM_ARRAY(cas), N); - Complex2RealImag(MULTIDIM_ARRAY(in), MULTIDIM_ARRAY(re), - MULTIDIM_ARRAY(im), N); - DftRealImaginaryToRealImaginary(MULTIDIM_ARRAY(re), MULTIDIM_ARRAY(im), - MULTIDIM_ARRAY(tmpre), MULTIDIM_ARRAY(tmpim), - MULTIDIM_ARRAY(cas), N); - RealImag2Complex(MULTIDIM_ARRAY(re), MULTIDIM_ARRAY(im), - MULTIDIM_ARRAY(out), N); -} - -/** Complex Inverse Fourier Transform 1D. ----------------------------------------- */ -void InverseFourierTransform(const MultidimArray< std::complex > &in, - MultidimArray > &out) -{ - // Only implemented for 1D transforms - in.checkDimension(1); - - int N = XSIZE(in); - MultidimArray tmpre(N), tmpim(N), re(N), im(N), cas(N); - out.resizeNoCopy(N); - - GetCaS(MULTIDIM_ARRAY(cas), N); - Complex2RealImag(MULTIDIM_ARRAY(in), MULTIDIM_ARRAY(re), - MULTIDIM_ARRAY(im), N); - InvDftRealImaginaryToRealImaginary(MULTIDIM_ARRAY(re), MULTIDIM_ARRAY(im), - MULTIDIM_ARRAY(tmpre), MULTIDIM_ARRAY(tmpim), - MULTIDIM_ARRAY(cas), N); - RealImag2Complex(MULTIDIM_ARRAY(re), MULTIDIM_ARRAY(im), - MULTIDIM_ARRAY(out), N); -} - -/** Complex Fourier Transform 1D, output half of (centro-symmetric) transform ---- */ -void FourierTransformHalf(const MultidimArray > &in, - MultidimArray< std::complex > &out) -{ - // Only implemented for 1D transforms - in.checkDimension(1); - - MultidimArray > aux; - FourierTransform(in, aux); - Whole2Half(aux, out); -} - -/** Complex Inverse Fourier Transform 1D, input half of (centro-symmetric) transform ---- */ -void InverseFourierTransformHalf(const MultidimArray< std::complex > &in, - MultidimArray > &out, int orixdim) -{ - // Only implemented for 1D transforms - in.checkDimension(1); - - MultidimArray< std::complex > aux; - Half2Whole(in, aux, orixdim); - InverseFourierTransform(aux, out); - out.setXmippOrigin(); -} - -void centerFFT2(MultidimArray &v) -{ - if (v.getDim() == 2) - { - //Just separe the even and odd dimensions case - if (XSIZE(v) % 2 == 0 && YSIZE(v) % 2 == 0) - { - int xsize = XSIZE(v); - int xhalf = xsize / 2; - int yhalf = YSIZE(v) / 2; - double * posA = MULTIDIM_ARRAY(v); - double * posB = posA + xhalf; - double * posC = posA + xsize * yhalf; - double * posD = posC + xhalf; - double * buffer=new double[xhalf]; - size_t bytes = xhalf * sizeof(double); - - for (int i = 0; i < yhalf; ++i, - posA += xsize, posB += xsize, posC += xsize, posD += xsize) - { - SWAP_ARRAY(posA, posD, bytes); - SWAP_ARRAY(posB, posC, bytes); - } - delete []buffer; - } - else - { - //todo: implementation for the odd case needed - CenterFFT(v, true); - } - } - else - std::cerr <<"bad dim: " << v.getDim() << std::endl; -} -/* FFT shifts ------------------------------------------------------------ */ -void ShiftFFT(MultidimArray< std::complex< double > > & v, - double xshift) -{ - v.checkDimension(1); - double dotp, a, b, c, d, ac, bd, ab_cd; - double xxshift = xshift / (double)XSIZE(v); - FOR_ALL_DIRECT_ELEMENTS_IN_ARRAY1D(v) - { - dotp = -2 * PI * ((double)(i) * xxshift); - a = cos(dotp); - b = sin(dotp); - c = DIRECT_A1D_ELEM(v,i).real(); - d = DIRECT_A1D_ELEM(v,i).imag(); - ac = a * c; - bd = b * d; - ab_cd = (a + b) * (c + d); // (ab_cd-ac-bd = ad+bc : but needs 4 multiplications) - DIRECT_A1D_ELEM(v,i) = std::complex(ac - bd, ab_cd - ac - bd); - } -} - -void ShiftFFT(MultidimArray< std::complex< double > > & v, - double xshift, double yshift) -{ - v.checkDimension(2); - double dotp, a, b, c, d, ac, bd, ab_cd; - double xxshift = xshift / (double)XSIZE(v); - double yyshift = yshift / (double)YSIZE(v); - FOR_ALL_DIRECT_ELEMENTS_IN_ARRAY2D(v) - { - dotp = -2 * PI * ((double)(j) * xxshift + (double)(i) * yyshift); - a = cos(dotp); - b = sin(dotp); - c = DIRECT_A2D_ELEM(v,i,j).real(); - d = DIRECT_A2D_ELEM(v,i,j).imag(); - ac = a * c; - bd = b * d; - ab_cd = (a + b) * (c + d); - DIRECT_A2D_ELEM(v,i,j) = std::complex(ac - bd, ab_cd - ac - bd); - } -} - -void ShiftFFT(MultidimArray< std::complex< double > > & v, - double xshift, double yshift, double zshift) -{ - v.checkDimension(3); - double dotp, a, b, c, d, ac, bd, ab_cd; - double xxshift = -2 * PI * xshift / (double)XSIZE(v); - double yyshift = -2 * PI * yshift / (double)YSIZE(v); - double zzshift = -2 * PI * zshift / (double)ZSIZE(v); - for (size_t k=0; k > & v, bool forward) -{ - if ( v.getDim() == 1 ) - { - // 1D - double xshift = -(double)(int)(XSIZE(v) / 2); - if (forward) - { - ShiftFFT(v, xshift); - CenterFFT(v, forward); - } - else - { - CenterFFT(v, forward); - ShiftFFT(v, -xshift); - } - } - else if ( v.getDim() == 2) - { - // 2D - - double xshift = -(double)(int)(XSIZE(v) / 2); - double yshift = -(double)(int)(YSIZE(v) / 2); - if (forward) - { - ShiftFFT(v, xshift, yshift); - CenterFFT(v, forward); - } - else - { - CenterFFT(v, forward); - ShiftFFT(v, -xshift, -yshift); - } - } - else if ( v.getDim() == 3) - { - // 3D - double xshift = -(double)(int)(XSIZE(v) / 2); - double yshift = -(double)(int)(YSIZE(v) / 2); - double zshift = -(double)(int)(ZSIZE(v) / 2); - if (forward) - { - ShiftFFT(v, xshift, yshift, zshift); - CenterFFT(v, forward); - } - else - { - CenterFFT(v, forward); - ShiftFFT(v, -xshift, -yshift, -zshift); - } - } - else - REPORT_ERROR(ERR_MULTIDIM_DIM,"CenterOriginFFT ERROR: only valis for 1D or 2D or 3D"); -} - -/* Xmipp image -> Xmipp PSD ------------------------------------------------ */ -template -void xmipp2PSD(const MultidimArray &input, MultidimArray &output, - bool takeLog) -{ - output = input; - CenterFFT(output, true); - if (takeLog) { - auto min_val = std::numeric_limits::max(); - FOR_ALL_ELEMENTS_IN_ARRAY2D(output) - { - auto pixval=A2D_ELEM(output,i,j); - if (pixval > 0 && pixval < min_val) - min_val = pixval; - } - min_val = 10 * log10(min_val); - FOR_ALL_ELEMENTS_IN_ARRAY2D(output) - { - auto pixval=A2D_ELEM(output,i,j); - if (pixval > 0) - A2D_ELEM(output,i,j) = 10 * log10(pixval); - else - A2D_ELEM(output,i,j) = min_val; - } - } - reject_outliers(output); -} -template void xmipp2PSD(const MultidimArray &, MultidimArray&, bool); -template void xmipp2PSD(const MultidimArray &, MultidimArray&, bool); - -/* Xmipp image -> Xmipp CTF ------------------------------------------------ */ -void xmipp2CTF(const MultidimArray &input, MultidimArray &output) -{ - output = input; - CenterFFT(output, true); - - // Prepare PSD part - double min_val = output(0, XSIZE(output) - 1); - double max_val = min_val; - bool first = true; - int Xdim = XSIZE(output); - int Ydim = YSIZE(output); - FOR_ALL_ELEMENTS_IN_ARRAY2D(output) - { - if ((i < Ydim / 2 && j >= Xdim / 2) || (i >= Ydim / 2 && j < Xdim / 2)) - { - if (output(i, j) > XMIPP_EQUAL_ACCURACY && - (output(i, j) < min_val || first)) - min_val = output(i, j); - if (output(i, j) > XMIPP_EQUAL_ACCURACY && - (output(i, j) > max_val || first)) - { - max_val = output(i, j); - first = false; - } - } - } - MultidimArray left(YSIZE(output), XSIZE(output)); - min_val = 10 * log10(min_val); - FOR_ALL_ELEMENTS_IN_ARRAY2D(output) - { - if ((i < Ydim / 2 && j >= Xdim / 2) || (i >= Ydim / 2 && j < Xdim / 2)) - { - if (output(i, j) > XMIPP_EQUAL_ACCURACY) - left(i, j) = 10 * log10(output(i, j)); - else - left(i, j) = min_val; - } - } - reject_outliers(left); - - // Join both parts - FOR_ALL_ELEMENTS_IN_ARRAY2D(output) - if ((i < Ydim / 2 && j >= Xdim / 2) || (i >= Ydim / 2 && j < Xdim / 2)) - output(i, j) = left(i, j); - else - output(i, j) = ABS(output(i, j)); -} diff --git a/src/core/xmipp_fft.h b/src/core/xmipp_fft.h deleted file mode 100644 index 7ea6cc4..0000000 --- a/src/core/xmipp_fft.h +++ /dev/null @@ -1,596 +0,0 @@ -/*************************************************************************** -* -* Authors: Carlos Oscar S. Sorzano (coss@cnb.csic.es) -* -* Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC -* -* This program is free software; you can redistribute it and/or modify -* it under the terms of the GNU General Public License as published by -* the Free Software Foundation; either version 2 of the License, or -* (at your option) any later version. -* -* This program is distributed in the hope that it will be useful, -* but WITHOUT ANY WARRANTY; without even the implied warranty of -* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -* GNU General Public License for more details. -* -* You should have received a copy of the GNU General Public License -* along with this program; if not, write to the Free Software -* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA -* 02111-1307 USA -* -* All comments concerning this program package may be sent to the -* e-mail address 'xmipp@cnb.csic.es' -***************************************************************************/ - -#ifndef CORE_FFT_H -#define CORE_FFT_H - -#include - -#include "multidim_array.h" -#include "xmipp_funcs.h" - -/** @defgroup Fourier Fourier transforms - * @ingroup DataLibrary - */ -//@{ -/** @name Index <--> Frequency, Continuous <--> Discrete - */ -//@{ -/** Index to frequency - * - * Given an index and a size of the FFT, this function returns the corresponding - * digital frequency (-1/2 to 1/2) - */ -#define FFT_IDX2DIGFREQ(idx, size, freq) \ - freq = (size<=1)? 0:(( (((int)idx) <= (((int)(size)) >> 1)) ? ((int)(idx)) : -((int)(size)) + ((int)(idx))) / \ - (double)(size)); - -#define FFT_IDX2DIGFREQ_DOUBLE(idx, size, freq) \ - freq = (size<=1)? 0:(( (((double)idx) <= (((double)(size)) / 2.0)) ? ((double)(idx)) : -((double)(size)) + ((double)(idx))) / \ - (double)(size)); - -#define FFT_IDX2DIGFREQ_FAST(idx, size, size_2, isize, freq) \ - freq = ( ((idx) <= (size_2)) ? (idx) : -(size) + (idx) ) * (isize); -/** Frequency to index (int) - * - * Given a frequency and a size of the FFT, this macro returns the corresponding - * integer index - */ -#define DIGFREQ2FFT_IDX(freq, size, idx) { \ - (idx) = (int) (round((size) * (freq))); if ((idx) < 0) (idx) += (int) \ - (size); } - -/** Frequency to index (double) - * - * Given a frequency and a size of the FFT, this macro returns the corresponding - * double index - */ -#define DIGFREQ2FFT_IDX_DOUBLE(freq, size, idx) { \ - (idx) = ((size) * (freq)); if ((idx) < 0) (idx) += (size); } - -/** Index to frequency - * - * This function can be used with vectors of any size (1,2,3). The Digital - * spectrum is limited between -1/2 and 1/2. If the vector has got more than 3 - * coordinates, then an exception is thrown - */ -template -void FFT_idx2digfreq(T& v, const Matrix1D< int >& idx, Matrix1D< double >& freq) -{ - if (VEC_XSIZE(idx) < 1 || VEC_XSIZE(idx) > 3) - REPORT_ERROR(ERR_MATRIX_SIZE, "FFT_idx2digfreq: Index is not of the correct size"); - - freq.resizeNoCopy(VEC_XSIZE(idx)); - - switch (VEC_XSIZE(idx)) - { - case 3: - FFT_IDX2DIGFREQ(VEC_ELEM(idx,2), ZSIZE(v), VEC_ELEM(freq,2)); - case 2: - FFT_IDX2DIGFREQ(VEC_ELEM(idx,1), YSIZE(v), VEC_ELEM(freq,1)); - case 1: - FFT_IDX2DIGFREQ(VEC_ELEM(idx,0), XSIZE(v), VEC_ELEM(freq,0)); - } -} - -/** Frequency to index - * - * This function can be used with vectors of any size (1,2,3). The Digital - * spectrum is lim:confirm bd - * ited between -1/2 and 1/2. If the vector has got more than 3 - * coordinates, then an exception is thrown - */ -template -void digfreq2FFT_idx(T& v, const Matrix1D< double >& freq, Matrix1D< int >& idx) -{ - if (VEC_XSIZE(freq) < 1 || VEC_XSIZE(freq) > 3) - REPORT_ERROR(ERR_MATRIX_SIZE, "digfreq2FFT_idx: freq is not of the correct size"); - - idx.resizeNoCopy(VEC_XSIZE(freq)); - - int size[3]; - v.getSize(size); - - FOR_ALL_ELEMENTS_IN_MATRIX1D(idx) - DIGFREQ2FFT_IDX(VEC_ELEM(freq,i), size[i], VEC_ELEM(idx,i)); -} - -/** Digital to Continuous frequency - * - * The pixel size must be given in Amstrongs. The digital frequency is between - * [-1/2,1/2] - */ -inline void digfreq2contfreq(const Matrix1D< double >& digfreq, - Matrix1D< double >& contfreq, - double pixel_size) -{ - contfreq.resizeNoCopy(digfreq); - FOR_ALL_ELEMENTS_IN_MATRIX1D(digfreq) - VEC_ELEM(contfreq,i) = VEC_ELEM(digfreq,i) / pixel_size; -} - -/** Continuous to Digital frequency - * - * The pixel size must be given in Amstrongs. The digital frequency is between - * [-1/2,1/2] - */ -inline void contfreq2digfreq(const Matrix1D< double >& contfreq, - Matrix1D< double >& digfreq, - double pixel_size) -{ - digfreq.resizeNoCopy(contfreq); - FOR_ALL_ELEMENTS_IN_MATRIX1D(contfreq) - VEC_ELEM(digfreq,i) = VEC_ELEM(contfreq,i) * pixel_size; -} -//@} - -/** @name Format conversions - */ -//@{ -/** Conversion from whole -> half - */ -void Whole2Half(const MultidimArray< std::complex < double > > & in, - MultidimArray< std::complex < double > > & out); - -/** Conversion from half -> whole - */ -void Half2Whole(const MultidimArray< std::complex < double > > & in, - MultidimArray< std::complex< double > > & out, - size_t oridim); - -/** Conversion from complex -> real,imag - */ -void Complex2RealImag(const MultidimArray< std::complex < double > > & in, - MultidimArray< double > & real, - MultidimArray< double > & imag); - -/** Conversion from real,imag -> complex - */ -void RealImag2Complex(const MultidimArray< double > & real, - const MultidimArray< double > & imag, - MultidimArray< std::complex < double > > & out); -//@} - -/** @name Fourier Transforms - * - * The theoretical relationship between the Fourier transform of a discrete - * signal and the Fourier transform of the continuous signal is - * - * X(e^jw)=1/T*X_c(jw/T) - * - * Xmipp is not computing X(e^jw) but samples from it so that - * - * X(e^jw)=N*X_XMIPP[k] - * - * where N is the length of the signal being transformed and X_XMIPP[k] - * is the k-th sample. - * - * The following program illustrates how the continuous, discrete and - * Xmipp Fourier transform relate - * - * @code - * #include - * #include - * - * double discreteTransform(double w, int N1) { - * if (w==0) return 2*N1+1; - * else return sin(w*(N1+0.5))/sin(0.5*w); - * } - * - * double continuousTransform(double W, double T1) { - * if (W==0) return 2*T1; - * else return 2*sin(W*T1)/W; - * } - * - * int main() { - * try { - * MultidimArray x(65); - * x.setXmippOrigin(); - * double T=0.5; - * double T1=6; - * int N1=(int)CEIL(T1/T); - * - * // Fill x with a pulse from -N1 to N1 (-T1 to T1 in continuous) - * FOR_ALL_ELEMENTS_IN_ARRAY1D(x) - * if (ABS(i)<=N1) x(i)=1; - * - * // Compute the Fourier transform - * MultidimArray< std::complex > X; - * MultidimArray Xmag; - * FourierTransform(x,X); - * FFT_magnitude(X,Xmag); - * - * // Compute the frequency axes - * MultidimArray contfreq(XSIZE(X)), digfreq(XSIZE(X)); - * FOR_ALL_ELEMENTS_IN_ARRAY1D(X) - * FFT_IDX2DIGFREQ(i,XSIZE(X),digfreq(i)); - * digfreq*=2*PI; - * contfreq=digfreq/T; - * - * // Show all Fourier transforms - * FOR_ALL_ELEMENTS_IN_ARRAY1D(X) { - * if (digfreq(i)>=0) - * std::cout << digfreq(i) << " " << contfreq(i) << " " - * << XSIZE(X)*Xmag(i) << " " - * << ABS(discreteTransform(digfreq(i),N1)) << " " - * << ABS(continuousTransform(contfreq(i),T1)/T) - * << std::endl; - * } - * } catch (XmippError XE) { - * std::cout << XE << std::endl; - * } - * return 0; - * } - * @endcode - */ -//@{ -/** Direct Fourier Transform - */ -void FourierTransform(const MultidimArray< double >& in, - MultidimArray< std::complex< double > > & out); - -/** Inverse Fourier Transform - */ -void InverseFourierTransform(const MultidimArray< std::complex< double > > & in, - MultidimArray< double >& out); - -/** Direct Fourier Transform, output half of (centro-symmetric) transform - */ -void FourierTransformHalf(const MultidimArray< double >& in, - MultidimArray< std::complex< double > > & out); - -/** Inverse Fourier Transform 1D, input half of (centro-symmetric) transform - */ -void InverseFourierTransformHalf(const MultidimArray< std::complex< double > > & in, - MultidimArray< double >& out, - int oridim); -//@} - -/** @name Operations with the Fourier Transforms - */ -//@{ - -/** Faster version of CenterFFT (now just for even images) - */ - -#define SWAP_ARRAY(a, b, n) memcpy(buffer, a, n); memcpy(a, b, n); memcpy(b, buffer, n); - -/** Center FFT for 2D arrays. - * The function is optimized for the particular case of 2D. - */ -void centerFFT2(MultidimArray &v); - - -/** CenterFFT - * Relation with Matlab fftshift: forward true is equals to fftshift and forward false - * equals to ifftshift - */ -template -void CenterFFT(MultidimArray< T >& v, bool forward) -{ - bool firstTime=true; // First time executing inner loops. - - // Check dimension is between 1 and 3 inclusive. - if ( v.getDim() > 0 && v.getDim() <= 3) - { - // Shift in the X direction - size_t l=0; - - // Shift in the X direction - if (((l = XSIZE(v)) > 1) && (YSIZE(v) == 1) && (ZSIZE(v) == 1)) - { - size_t firstHalfSize=0; - size_t secondHalfSize=0; - MultidimArray< T > aux; - - if (forward) - { - firstHalfSize = (l + 1) / 2; - secondHalfSize = l - firstHalfSize; - aux.resizeNoCopy( firstHalfSize); - - for (size_t k = 0; k < ZSIZE(v); k++) - { - for (size_t i = 0; i < YSIZE(v); i++) - { - memcpy( &dAi(aux, 0), &dAkij(v, k, i, 0), sizeof(T)*firstHalfSize); - memcpy( &dAkij(v, k, i, 0), &dAkij(v, k, i, firstHalfSize), sizeof(T)*secondHalfSize); - memcpy( &dAkij(v, k, i, secondHalfSize), &dAi(aux, 0), sizeof(T)*firstHalfSize); - } - } - } - else - { - secondHalfSize = (l + 1) / 2; - firstHalfSize = l - secondHalfSize; - aux.resizeNoCopy( secondHalfSize); - - for (size_t k = 0; k < ZSIZE(v); k++) - { - for (size_t i = 0; i < YSIZE(v); i++) - { - memcpy( &dAi(aux, 0), &dAkij(v, k, i, firstHalfSize), sizeof(T)*secondHalfSize); - memcpy( &dAkij(v, k, i, secondHalfSize), &dAkij(v, k, i, 0), sizeof(T)*firstHalfSize); - memcpy( &dAkij(v, k, i, 0), &dAi(aux, 0), sizeof(T)*secondHalfSize); - } - } - } - } - else - { - // 3D - MultidimArray< T > aux; - size_t l=0; - long int shift; - - int i=0; // Loop counter. - int halfRows=0; // Half rows of the matrix. - int rowSize=0; // Size in bytes of the row. - - // Size in bytes of first and second half row. - int firstHalfRowSize=0, secondHalfRowSize=0; - - // # elements in first and second half row. - int nElemsFirstHalf_X=0, nElemsSecondHalf_X=0; - - MultidimArray< T > tempVector; // Temporary vector. - - bool isOdd=false; // Odd # rows in matrix. - MultidimArray< T > savedRow; // Temporary vector in odd matrix. - - // Execute FFT in 2 dimensions before 3D. - if (forward) - { - for (size_t k=0; k 1) - { - aux.resizeNoCopy(l); - shift = (long int)(l / 2); - - if (!forward) - shift = -shift; - size_t lmax=(l/4)*4; - for (size_t i = 0; i < YSIZE(v); i++) - { - for (size_t j = 0; j < XSIZE(v); j++) - { - // Shift the input in an auxiliary vector - for (size_t k = 0; k < l; k++) - { - size_t kp = k + shift; - if (-shift > (long int)k) - kp += l; - else if (kp >= l) - kp -= l; - - dAi(aux,kp) = dAkij(v, k, i, j); - } - - // Copy the vector - const T* ptrAux=&dAi(aux,0); - for (size_t k = 0; k < lmax; k+=4,ptrAux+=4) - { - dAkij(v, k, i, j) = *ptrAux; - dAkij(v, k+1, i, j) = *(ptrAux+1); - dAkij(v, k+2, i, j) = *(ptrAux+2); - dAkij(v, k+3, i, j) = *(ptrAux+3); - } - for (size_t k = lmax; k < l; ++k, ++ptrAux) - { - dAkij(v, k, i, j) = *ptrAux; - } - } - } - } - } - } - else - { - REPORT_ERROR(ERR_MULTIDIM_DIM,"CenterFFT ERROR: Dimension should be 1, 2 or 3"); - } -} - -/** FFT shift 1D - * - * Calculates the Fourier Transform of the shifted real-space vector - * by phase shifts in Fourier space - */ -void ShiftFFT(MultidimArray< std::complex< double > > & v, double xshift); - -/** FFT shift 2D - * - * Calculates the Fourier Transform of the shifted real-space vector - * by phase shifts in Fourier space - */ -void ShiftFFT(MultidimArray< std::complex< double > > & v, double xshift, double yshift); - -/** FFT shift 3D - * - * Calculates the Fourier Transform of the shifted real-space vector - * by phase shifts in Fourier space - */ -void ShiftFFT(MultidimArray< std::complex< double > > & v, - double xshift, - double yshift, - double zshift); - -/** Place the origin of the FFT at the center of the vector and back - * - * Changes the real and the fourier space origin - */ -void CenterOriginFFT(MultidimArray< std::complex< double > > & v, bool forward); - - -/** Xmipp image -> Xmipp PSD. - The log10 is taken, outliers rejected and the image is reorganized. */ -template -void xmipp2PSD(const MultidimArray &input, MultidimArray &output, - bool takeLog=true); - -/** Xmipp image -> Xmipp CTF. - The log10 is taken, outliers rejected and the image is reorganized. */ -void xmipp2CTF(const MultidimArray &input, MultidimArray &output); -//@} -//@} -#endif diff --git a/src/core/xmipp_fftw.cpp b/src/core/xmipp_fftw.cpp deleted file mode 100644 index 22f32f5..0000000 --- a/src/core/xmipp_fftw.cpp +++ /dev/null @@ -1,1006 +0,0 @@ -/*************************************************************************** - * - * Authors: Roberto Marabini (roberto@cnb.csic.es) - * Carlos Oscar S. Sorzano (coss@cnb.csic.es) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include "xmipp_fftw.h" -#include "args.h" -#include "transformations.h" -#include -#include - -static pthread_mutex_t fftw_plan_mutex = PTHREAD_MUTEX_INITIALIZER; -bool planCreated=false; -int nInstances=0; - -// Constructors and destructors -------------------------------------------- -FourierTransformer::FourierTransformer() -{ - init(); - nthreads=1; - pthread_mutex_lock(&fftw_plan_mutex); - nInstances++; - pthread_mutex_unlock(&fftw_plan_mutex); - threadsSetOn=false; - normSign = FFTW_FORWARD; -} - -FourierTransformer::FourierTransformer(int _normSign) -{ - init(); - pthread_mutex_lock(&fftw_plan_mutex); - nInstances++; - pthread_mutex_unlock(&fftw_plan_mutex); - nthreads=1; - threadsSetOn=false; - normSign = _normSign; -} - -FourierTransformer::FourierTransformer(const FourierTransformer& fTransform) -{ - REPORT_ERROR(ERR_UNCLASSIFIED,"Fourier transformers should not be copied"); -} - -FourierTransformer & FourierTransformer::operator= (const FourierTransformer & other) -{ - REPORT_ERROR(ERR_UNCLASSIFIED,"Fourier transformers should not be copied"); -} -void FourierTransformer::init() -{ - fReal=NULL; - fComplex=NULL; - fPlanForward = NULL; - fPlanBackward = NULL; - dataPtr = NULL; - complexDataPtr = NULL; -} - -void FourierTransformer::clear() -{ - fFourier.clear(); - // Anything to do with plans has to be protected for threads! - pthread_mutex_lock(&fftw_plan_mutex); - if (fPlanForward !=NULL) - fftw_destroy_plan(fPlanForward); - if (fPlanBackward!=NULL) - fftw_destroy_plan(fPlanBackward); - pthread_mutex_unlock(&fftw_plan_mutex); - - init(); -} - -FourierTransformer::~FourierTransformer() -{ - clear(); - - pthread_mutex_lock(&fftw_plan_mutex); - nInstances--; - - // Check if a plan was already created. - if (planCreated) - { - // Check if this is last instance of a FFT. - if (nInstances == 0) - { - destroyThreads(); - planCreated = false; - // Don't call cleanup. - // There might be other transformers, and this call would - // invalidate it's plans -// cleanup(); - } - } - pthread_mutex_unlock(&fftw_plan_mutex); -} - -// Initialization ---------------------------------------------------------- -const MultidimArray &FourierTransformer::getReal() const -{ - return (*fReal); -} - -const MultidimArray > &FourierTransformer::getComplex() const -{ - return (*fComplex); -} - - -void FourierTransformer::setReal(MultidimArray &input) -{ - bool updatePlan=false; - if (fReal==NULL) - updatePlan=true; - else if (dataPtr!=MULTIDIM_ARRAY(input)) - updatePlan=true; - else - updatePlan=!(fReal->sameShape(input)); - fFourier.resizeNoCopy(ZSIZE(input),YSIZE(input),XSIZE(input)/2+1); - fReal=&input; - - if (updatePlan) - { - recomputePlanR2C(); - } -} - -void FourierTransformer::recomputePlanR2C() -{ - int ndim=3; - if (ZSIZE(*fReal)==1) - { - ndim=2; - if (YSIZE(*fReal)==1) - ndim=1; - } - int N[3]; - switch (ndim) - { - case 1: - N[0]=XSIZE(*fReal); - break; - case 2: - N[0]=YSIZE(*fReal); - N[1]=XSIZE(*fReal); - break; - case 3: - N[0]=ZSIZE(*fReal); - N[1]=YSIZE(*fReal); - N[2]=XSIZE(*fReal); - break; - } - - pthread_mutex_lock(&fftw_plan_mutex); - if (fPlanForward!=NULL) - fftw_destroy_plan(fPlanForward); - fPlanForward=NULL; - fPlanForward = fftw_plan_dft_r2c(ndim, N, MULTIDIM_ARRAY(*fReal), - (fftw_complex*) MULTIDIM_ARRAY(fFourier), FFTW_ESTIMATE); - if (fPlanBackward!=NULL) - fftw_destroy_plan(fPlanBackward); - fPlanBackward=NULL; - fPlanBackward = fftw_plan_dft_c2r(ndim, N, - (fftw_complex*) MULTIDIM_ARRAY(fFourier), MULTIDIM_ARRAY(*fReal), - FFTW_ESTIMATE); - if (fPlanForward == NULL || fPlanBackward == NULL) - REPORT_ERROR(ERR_PLANS_NOCREATE, "FFTW plans cannot be created"); - dataPtr=MULTIDIM_ARRAY(*fReal); - planCreated = true; - pthread_mutex_unlock(&fftw_plan_mutex); -} - -void FourierTransformer::setReal(MultidimArray > &input) -{ - bool recomputePlan=false; - if (fComplex==NULL) - recomputePlan=true; - else if (complexDataPtr!=MULTIDIM_ARRAY(input)) - recomputePlan=true; - else - recomputePlan=!(fComplex->sameShape(input)); - fFourier.resizeNoCopy(input); - fComplex=&input; - - if (recomputePlan) - { - int ndim=3; - if (ZSIZE(input)==1) - { - ndim=2; - if (YSIZE(input)==1) - ndim=1; - } - int *N = new int[ndim]; - switch (ndim) - { - case 1: - N[0]=XSIZE(input); - break; - case 2: - N[0]=YSIZE(input); - N[1]=XSIZE(input); - break; - case 3: - N[0]=ZSIZE(input); - N[1]=YSIZE(input); - N[2]=XSIZE(input); - break; - } - - pthread_mutex_lock(&fftw_plan_mutex); - if (fPlanForward!=NULL) - fftw_destroy_plan(fPlanForward); - fPlanForward=NULL; - fPlanForward = fftw_plan_dft(ndim, N, (fftw_complex*) MULTIDIM_ARRAY(*fComplex), - (fftw_complex*) MULTIDIM_ARRAY(fFourier), FFTW_FORWARD, FFTW_ESTIMATE); - if (fPlanBackward!=NULL) - fftw_destroy_plan(fPlanBackward); - fPlanBackward=NULL; - fPlanBackward = fftw_plan_dft(ndim, N, (fftw_complex*) MULTIDIM_ARRAY(fFourier), - (fftw_complex*) MULTIDIM_ARRAY(*fComplex), FFTW_BACKWARD, FFTW_ESTIMATE); - if (fPlanForward == NULL || fPlanBackward == NULL) - REPORT_ERROR(ERR_PLANS_NOCREATE, "FFTW plans cannot be created"); - delete [] N; - complexDataPtr=MULTIDIM_ARRAY(*fComplex); - pthread_mutex_unlock(&fftw_plan_mutex); - } -} - -void FourierTransformer::setFourier(const MultidimArray > &inputFourier) -{ - memcpy(MULTIDIM_ARRAY(fFourier),MULTIDIM_ARRAY(inputFourier), - MULTIDIM_SIZE(inputFourier)*2*sizeof(double)); -} - -// Transform --------------------------------------------------------------- -void FourierTransformer::Transform(int sign) -{ - if (sign == FFTW_FORWARD) - { - fftw_execute(fPlanForward); - - if (sign == normSign) - { - unsigned long int size=0; - if(fReal!=NULL) - size = MULTIDIM_SIZE(*fReal); - else if (fComplex!= NULL) - size = MULTIDIM_SIZE(*fComplex); - else - REPORT_ERROR(ERR_UNCLASSIFIED,"No complex nor real data defined"); - - double isize=1.0/size; - double *ptr=(double*)MULTIDIM_ARRAY(fFourier); - size_t nmax=(fFourier.nzyxdim/4)*4; - for (size_t n=0; n mean=0.5*( - DIRECT_A2D_ELEM(fFourier,i,0)+ - conj(DIRECT_A2D_ELEM(fFourier,isym,0))); - DIRECT_A2D_ELEM(fFourier,i,0)=mean; - DIRECT_A2D_ELEM(fFourier,isym,0)=conj(mean); - } - break; - case 3: - for (int k=0; k mean=0.5*( - DIRECT_A3D_ELEM(fFourier,k,i,0)+ - conj(DIRECT_A3D_ELEM(fFourier,ksym,isym,0))); - DIRECT_A3D_ELEM(fFourier,k,i,0)=mean; - DIRECT_A3D_ELEM(fFourier,ksym,isym,0)=conj(mean); - } - } - for (int k=1; k<=zHalf; k++) - { - int ksym=intWRAP(-k,0,Zdim-1); - std::complex mean=0.5*( - DIRECT_A3D_ELEM(fFourier,k,0,0)+ - conj(DIRECT_A3D_ELEM(fFourier,ksym,0,0))); - DIRECT_A3D_ELEM(fFourier,k,0,0)=mean; - DIRECT_A3D_ELEM(fFourier,ksym,0,0)=conj(mean); - } - break; - } -} - -/* FFT Magnitude ------------------------------------------------------- */ -void FFT_magnitude(const MultidimArray< std::complex > &v, - MultidimArray &mag) -{ - mag.resizeNoCopy(v); - double * ptrv=(double *)MULTIDIM_ARRAY(v); - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY(v) - { - double re=*ptrv; - double im=*(ptrv+1); - DIRECT_MULTIDIM_ELEM(mag, n) = sqrt(re*re+im*im); - ptrv+=2; - } -} - -/* FFT Phase ------------------------------------------------------- */ -void FFT_phase(const MultidimArray< std::complex > &v, - MultidimArray &phase) -{ - phase.resizeNoCopy(v); - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY(v) - DIRECT_MULTIDIM_ELEM(phase, n) = atan2(DIRECT_MULTIDIM_ELEM(v,n).imag(), DIRECT_MULTIDIM_ELEM(v, n).real()); -} - -void radial_magnitude(const MultidimArray & v, MultidimArray< std::complex< double > > &V, - MultidimArray< double >& radialMagnitude) -{ - FourierTransform(v,V); - MultidimArray Vmag; - FFT_magnitude(V,Vmag); - CenterFFT(Vmag,true); - Vmag.setXmippOrigin(); - MultidimArray radialCount; - Matrix1D center(3); - radialAverage(Vmag,center,radialMagnitude,radialCount); -} - -void convolutionFFTStack(const MultidimArray &img, - const MultidimArray &kernel, - MultidimArray &result) -{ - if (&result != &img) - result = img; - - MultidimArray imgTemp; - MultidimArray< std::complex< double> > FFTIm, FFTK; - FourierTransformer transformer1(FFTW_BACKWARD), transformer2(FFTW_BACKWARD); - - transformer2.FourierTransform((MultidimArray &)kernel, FFTK, false); - - for (size_t n = 0; n < ZSIZE(result); n++) - { - imgTemp.aliasSlice(result, n); - transformer1.FourierTransform(imgTemp, FFTIm, false); - - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY(FFTIm) - DIRECT_MULTIDIM_ELEM(FFTIm,n) *= DIRECT_MULTIDIM_ELEM(FFTK,n); - - transformer1.inverseFourierTransform(); - - CenterFFT(imgTemp, false); - } - -} - -void convolutionFFT(MultidimArray &img, - MultidimArray &kernel, - MultidimArray &result) -{ - FourierTransformer transformer1, transformer2; - MultidimArray< std::complex > FFT1, FFT2; - transformer1.FourierTransform(img, FFT1, false); - result=kernel; - transformer2.FourierTransform(result, FFT2, false); - - // Multiply FFT1 * FFT2' - double dSize=MULTIDIM_SIZE(img); - double a, b, c, d; // a+bi, c+di - double *ptrFFT2=(double*)MULTIDIM_ARRAY(FFT2); - double *ptrFFT1=(double*)MULTIDIM_ARRAY(FFT1); - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY(FFT1) - { - a=*ptrFFT1++; - b=*ptrFFT1++; - c=(*ptrFFT2)*dSize; - d=(*(ptrFFT2+1))*dSize; - *ptrFFT2++ = a*c-b*d; - *ptrFFT2++ = b*c+a*d; - } - - // Invert the product, in order to obtain the correlation image - transformer2.inverseFourierTransform(); - - // Center the resulting image to compensate for phase shift - CenterFFT(result, false); -} - -// Fourier ring correlation ----------------------------------------------- -//#define SAVE_REAL_PART -void frc_dpr(MultidimArray< double > & m1, - MultidimArray< double > & m2, - double sampling_rate, - MultidimArray< double >& freq, - MultidimArray< double >& frc, - MultidimArray< double >& frc_noise, - MultidimArray< double >& dpr, - MultidimArray< double >& error_l2, - bool dodpr, - bool doRfactor, - double minFreq, - double maxFreq, - double * rFactor) -{ - if (!m1.sameShape(m2)) - REPORT_ERROR(ERR_MULTIDIM_SIZE,"MultidimArrays have different shapes!"); - - int m1sizeX = XSIZE(m1), m1sizeY = YSIZE(m1), m1sizeZ = ZSIZE(m1); - - MultidimArray< std::complex< double > > FT1; - FourierTransformer transformer1(FFTW_BACKWARD); - transformer1.FourierTransform(m1, FT1, false); - -//#define DEBUG -#ifdef DEBUG - std::cerr << "FT1" << FT1 << std::endl; -#endif -#undef DEBUG - - - m1.clear(); // Free memory - - MultidimArray< std::complex< double > > FT2; - FourierTransformer transformer2(FFTW_BACKWARD); - transformer2.FourierTransform(m2, FT2, false); - m2.clear(); // Free memory - - MultidimArray< int > radial_count(m1sizeX/2+1); - MultidimArray num, den1, den2, den_dpr; - Matrix1D f(3); - //to calculate r-factor - double rFactorNumerator=0; - double rFactorDenominator=0; - - - num.initZeros(radial_count); - den1.initZeros(radial_count); - den2.initZeros(radial_count); - - //dpr calculation takes for ever in large volumes - //since atan2 is called many times - //until atan2 is changed by a table let us make dpr an option - if (dodpr) - { - dpr.initZeros(radial_count); - den_dpr.initZeros(radial_count); - } - freq.initZeros(radial_count); - frc.initZeros(radial_count); - frc_noise.initZeros(radial_count); - error_l2.initZeros(radial_count); -#ifdef SAVE_REAL_PART - - std::vector *realPart= - new std::vector[XSIZE(radial_count)]; -#endif - - int sizeZ_2 = m1sizeZ/2; - if (sizeZ_2==0) - sizeZ_2=1; - double isizeZ = 1.0/m1sizeZ; - int sizeY_2 = m1sizeY/2; - double iysize = 1.0/m1sizeY; - int sizeX_2 = m1sizeX/2; - double ixsize = 1.0/m1sizeX; - double R; - - int ZdimFT1=(int)ZSIZE(FT1); - int YdimFT1=(int)YSIZE(FT1); - int XdimFT1=(int)XSIZE(FT1); - - double maxFreq_2 =0.; - maxFreq_2 = maxFreq * maxFreq; - for (int k=0; kmaxFreq_2) - continue; - - R = sqrt(R2); - int idx = (int)round(R * m1sizeX); - std::complex &z1 = dAkij(FT1, k, i, j); - std::complex &z2 = dAkij(FT2, k, i, j); - double absz1 = abs(z1); - double absz2 = abs(z2); - dAi(num,idx) += real(conj(z1) * z2); - dAi(den1,idx) += absz1*absz1; - dAi(den2,idx) += absz2*absz2; - dAi(error_l2,idx) += abs(z1-z2); - //for calculating r-factor - if ( R > minFreq && R < maxFreq) - { - rFactorNumerator += fabs(absz1 - absz2); - rFactorDenominator += absz1; - } - - if (dodpr) //this takes to long for a huge volume - { - double phaseDiff=atan2(z1.imag(),z1.real()) - atan2(z2.imag(),z2.real()); - phaseDiff = RAD2DEG(phaseDiff); - phaseDiff = realWRAP(phaseDiff,-180, 180); - dAi(dpr,idx) += ((absz1+absz2)*phaseDiff*phaseDiff); - dAi(den_dpr,idx) += (absz1+absz2); -#ifdef SAVE_REAL_PART - - realPart[idx].push_back(z1.real()); -#endif - - } - dAi(radial_count,idx)++; - } - } - } - //to calculate r-factor - if (doRfactor) - { - //std::cout << "rFactorNumerator = " << rFactorNumerator << std::endl; - //std::cout << "rFactorDenominator = " << rFactorDenominator << std::endl; - *rFactor = rFactorNumerator / rFactorDenominator; - - //std::cout << "R-factor = " << rFactorValue << std::endl; - //*rFactor = rFactorValue; - //std::cout << "R-rFactor = " << *rFactor << std::endl; - } - - FOR_ALL_ELEMENTS_IN_ARRAY1D(freq) - { - dAi(freq,i) = (double) i / (m1sizeX * sampling_rate); - dAi(frc,i) = dAi(num,i)/sqrt(dAi(den1,i)*dAi(den2,i)); - dAi(frc_noise,i) = 2 / sqrt((double) dAi(radial_count,i)); - dAi(error_l2,i) /= dAi(radial_count,i); - - if (dodpr) - dAi(dpr,i) = sqrt(dAi(dpr,i) / dAi(den_dpr,i)); -#ifdef SAVE_REAL_PART - - std::ofstream fhOut; - fhOut.open(((std::string)"PPP_RealPart_"+integerToString(i)+".txt"). - c_str()); - for (int j=0; j &mdaIn, MultidimArray &mdaOut, int nThreads) -{ - //Mmem = *this - //memory for fourier transform output - MultidimArray > MmemFourier; - // Perform the Fourier transform - FourierTransformer transformerM; - transformerM.setThreadsNumber(nThreads); - transformerM.FourierTransform(mdaIn, MmemFourier, false); - - // Create space for the downsampled image and its Fourier transform - mdaOut.resizeNoCopy(Zdim, Ydim, Xdim); - MultidimArray > MpmemFourier; - FourierTransformer transformerMp; - transformerMp.setReal(mdaOut); - transformerMp.getFourierAlias(MpmemFourier); - - scaleToSizeFourier(mdaIn, mdaOut, MmemFourier, MpmemFourier); - - // Transform data - transformerMp.inverseFourierTransform(); -} - -template void scaleToSizeFourier(MultidimArray &mdaIn, MultidimArray &mdaOut, - MultidimArray > &inFourier, MultidimArray > &outFourier); - -template -void scaleToSizeFourier(MultidimArray &mdaIn, MultidimArray &mdaOut, - MultidimArray > &inFourier, MultidimArray > &outFourier) { - size_t xsize = std::min(XSIZE(inFourier),XSIZE(outFourier))*sizeof(std::complex); - size_t yhalf = std::min(std::min(YSIZE(mdaIn)/2,YSIZE(mdaOut)/2),YSIZE(mdaIn)-1); - size_t zhalf = std::min(std::min(ZSIZE(mdaIn)/2,ZSIZE(mdaOut)/2),ZSIZE(mdaIn)-1); - - size_t kp0=0; - size_t kpF=zhalf; - size_t ip0=0; - size_t ipF=yhalf; - size_t km0=ZSIZE(inFourier)>=ZSIZE(outFourier)?(kpF+1):(ZSIZE(outFourier)-(ZSIZE(inFourier)-(zhalf+1))); - size_t kmF=ZSIZE(outFourier)-1; - size_t im0=YSIZE(inFourier)>=YSIZE(outFourier)?(ipF+1):(YSIZE(outFourier)-(YSIZE(inFourier)-(yhalf+1))); - size_t imF=YSIZE(outFourier)-1; - - //Init with zero - outFourier.initZeros(); - - for (size_t k = kp0; k<=kpF; ++k) - { - for (size_t i=ip0; i<=ipF; ++i) - memcpy(&dAkij(outFourier,k,i,0),&dAkij(inFourier,k,i,0),xsize); - for (size_t i=im0; i<=imF; ++i) { - size_t ip = i + YSIZE(inFourier)-YSIZE(outFourier) ; - memcpy(&dAkij(outFourier,k,i,0),&dAkij(inFourier,k,ip,0),xsize); - } - } - for (size_t k = km0; k<=kmF; ++k) { - size_t kp = k + ZSIZE(inFourier)-ZSIZE(outFourier) ; - for (size_t i=ip0; i<=ipF; ++i) - memcpy(&dAkij(outFourier,k,i,0),&dAkij(inFourier,kp,i,0),xsize); - for (size_t i=im0; i<=imF; ++i) { - size_t ip = i + YSIZE(inFourier)-YSIZE(outFourier) ; - memcpy(&dAkij(outFourier,k,i,0),&dAkij(inFourier,kp,ip,0),xsize); - } - } -} - -void selfScaleToSizeFourier(int Zdim, int Ydim, int Xdim, MultidimArray &mda, int nThreads) -{ - MultidimArray aux; - scaleToSizeFourier(Zdim, Ydim, Xdim, mda, aux, nThreads); - mda=aux; -} - - -void selfScaleToSizeFourier(int Ydim, int Xdim, MultidimArray& Mpmem,int nThreads) -{ - selfScaleToSizeFourier(1, Ydim, Xdim, Mpmem, nThreads); -} - -void selfScaleToSizeFourier(int Zdim, int Ydim, int Xdim, MultidimArrayGeneric &Mpmem, int nThreads) -{ - MultidimArray aux; - Mpmem.getImage(aux); - selfScaleToSizeFourier(Zdim, Ydim, Xdim, aux, nThreads); - Mpmem.setImage(aux); -} - -void selfScaleToSizeFourier(int Ydim, int Xdim, MultidimArrayGeneric &Mpmem, int nThreads) -{ - MultidimArray aux; - Mpmem.getImage(aux); - selfScaleToSizeFourier(1, Ydim, Xdim, aux, nThreads); - Mpmem.setImage(aux); -} - -void getSpectrum(MultidimArray &Min, - MultidimArray &spectrum, - int spectrum_type) -{ - MultidimArray > Faux; - int xsize = XSIZE(Min); - Matrix1D f(3); - MultidimArray count(xsize); - FourierTransformer transformer; - - spectrum.initZeros(xsize); - count.initZeros(); - transformer.FourierTransform(Min, Faux, false); - if (ZSIZE(Faux)==1) - ZZ(f)=0; - FOR_ALL_DIRECT_ELEMENTS_IN_ARRAY3D(Faux) - { - FFT_IDX2DIGFREQ(j,xsize,XX(f)); - FFT_IDX2DIGFREQ(i,YSIZE(Faux),YY(f)); - if (ZSIZE(Faux)>1) - FFT_IDX2DIGFREQ(k,ZSIZE(Faux),ZZ(f)); - double R=f.module(); - //if (R>0.5) continue; - int idx = round(R*xsize); - double F=abs(dAkij(Faux, k, i, j)); - if (spectrum_type == AMPLITUDE_SPECTRUM) - A1D_ELEM(spectrum,idx) += F; - else - A1D_ELEM(spectrum,idx) += F*F; - A1D_ELEM(count,idx) += 1.; - } - for (int i = 0; i < xsize; i++) - if (A1D_ELEM(count,i) > 0.) - A1D_ELEM(spectrum,i) /= A1D_ELEM(count,i); -} - -void divideBySpectrum(MultidimArray &Min, - MultidimArray &spectrum, - bool leave_origin_intact) -{ - - Min.checkDimension(3); - - MultidimArray div_spec(spectrum); - FOR_ALL_DIRECT_ELEMENTS_IN_ARRAY1D(spectrum) - { - if (ABS(dAi(spectrum,i)) > 0.) - dAi(div_spec,i) = 1./dAi(spectrum,i); - else - dAi(div_spec,i) = 1.; - } - multiplyBySpectrum(Min,div_spec,leave_origin_intact); -} - -void multiplyBySpectrum(MultidimArray &Min, - MultidimArray &spectrum, - bool leave_origin_intact) -{ - Min.checkDimension(3); - - MultidimArray > Faux; - Matrix1D f(3); - MultidimArray lspectrum; - FourierTransformer transformer; - double dim3 = XSIZE(Min)*YSIZE(Min)*ZSIZE(Min); - - transformer.FourierTransform(Min, Faux, false); - lspectrum=spectrum; - if (leave_origin_intact) - lspectrum(0)=1.; - FOR_ALL_DIRECT_ELEMENTS_IN_ARRAY3D(Faux) - { - FFT_IDX2DIGFREQ(j,XSIZE(Min), XX(f)); - FFT_IDX2DIGFREQ(i,YSIZE(Faux),YY(f)); - FFT_IDX2DIGFREQ(k,ZSIZE(Faux),ZZ(f)); - double R=f.module(); - //if (R > 0.5) continue; - int idx=ROUND(R*XSIZE(Min)); - dAkij(Faux, k, i, j) *= lspectrum(idx) * dim3; - } - transformer.inverseFourierTransform(); -} - -void whitenSpectrum(MultidimArray &Min, - MultidimArray &Mout, - int spectrum_type, - bool leave_origin_intact) -{ - Min.checkDimension(3); - - MultidimArray spectrum; - getSpectrum(Min,spectrum,spectrum_type); - Mout=Min; - divideBySpectrum(Mout,spectrum,leave_origin_intact); - -} - -void adaptSpectrum(MultidimArray &Min, - MultidimArray &Mout, - const MultidimArray &spectrum_ref, - int spectrum_type, - bool leave_origin_intact) -{ - - Min.checkDimension(3); - - MultidimArray spectrum; - getSpectrum(Min,spectrum,spectrum_type); - FOR_ALL_DIRECT_ELEMENTS_IN_ARRAY1D(spectrum) - { - dAi(spectrum, i) = (dAi(spectrum, i) > 0.) ? dAi(spectrum_ref,i)/ dAi(spectrum, i) : 1.; - } - Mout=Min; - multiplyBySpectrum(Mout,spectrum,leave_origin_intact); - -} - -void correlation_matrix(const MultidimArray & m1, - const MultidimArray & m2, - MultidimArray< double >& R, - CorrelationAux &aux, - bool center) -{ - aux.transformer1.FourierTransform((MultidimArray &)m1, aux.FFT1, false); - correlation_matrix(aux.FFT1,m2,R,aux,center); -} - -void correlationInFourier(const MultidimArray< std::complex< double > > & FF1, MultidimArray< std::complex< double > > & FF2, double dSize) -{ - // Multiply FFT1 * FFT2' - double mdSize=-dSize; - double a, b, c, d; // a+bi, c+di - double *ptrFFT2=(double*)MULTIDIM_ARRAY(FF2); - double *ptrFFT1=(double*)MULTIDIM_ARRAY(FF1); - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY(FF1) - { - a=*ptrFFT1++; - b=*ptrFFT1++; - c=(*ptrFFT2)*dSize; - d=(*(ptrFFT2+1))*mdSize; - *ptrFFT2++ = a*c-b*d; - *ptrFFT2++ = b*c+a*d; - } -} - - -void correlation_matrix(const MultidimArray< std::complex< double > > & FF1, - const MultidimArray & m2, - MultidimArray& R, - CorrelationAux &aux, - bool center) -{ - R=m2; - aux.transformer2.FourierTransform(R, aux.FFT2, false); - correlationInFourier(FF1,aux.FFT2,MULTIDIM_SIZE(R)); - aux.transformer2.inverseFourierTransform(); - if (center) - CenterFFT(R, true); -} - -void correlation_matrix(const MultidimArray< std::complex< double > > & FFT1, - const MultidimArray< std::complex< double > > & FFT2, - MultidimArray& R, - CorrelationAux &aux, - bool center) -{ - aux.transformer2.setReal(R); - aux.transformer2.setFourier(FFT2); - correlationInFourier(FFT1,aux.transformer2.fFourier,MULTIDIM_SIZE(R)); - aux.transformer2.inverseFourierTransform(); - if (center) - CenterFFT(R, true); -} - -void fast_correlation_vector(const MultidimArray< std::complex > & FFT1, - const MultidimArray< std::complex > & FFT2, - MultidimArray< double >& R, - FourierTransformer &transformer) -{ - transformer.setFourier(FFT1); - - // Multiply FFT1 * FFT2' - double a, b, c, d; // a+bi, c+di - double *ptrFFT2=(double*)MULTIDIM_ARRAY(FFT2); - double *ptrFFT1=(double*)&(A1D_ELEM(transformer.fFourier,0)); - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY(FFT1) - { - a=*ptrFFT1; - b=*(ptrFFT1+1); - c=(*ptrFFT2++); - d=(*ptrFFT2++)*(-1); - *ptrFFT1++ = a*c-b*d; - *ptrFFT1++ = b*c+a*d; - } - - // Invert the product, in order to obtain the correlation image - transformer.inverseFourierTransform(); - - // Center the resulting image to obtain a centered autocorrelation - R=*transformer.fReal; - CenterFFT(R, true); - R.setXmippOrigin(); -} - -/** Fast autocorrelation matrix */ -void auto_correlation_matrix(const MultidimArray & Img, MultidimArray< double >& R, CorrelationAux &aux) -{ - // Compute the Fourier Transform - R=Img; - aux.transformer1.FourierTransform(R, aux.FFT1, false); - - // Multiply FFT1 * FFT1' - double dSize=MULTIDIM_SIZE(Img); - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY(aux.FFT1) - { - double *ptr=(double*)&DIRECT_MULTIDIM_ELEM(aux.FFT1,n); - double &realPart=*ptr; - double &imagPart=*(ptr+1); - realPart=dSize*(realPart*realPart+imagPart*imagPart); - imagPart=0; - } - - // Invert the product, in order to obtain the correlation image - aux.transformer1.inverseFourierTransform(); - - // Center the resulting image to obtain a centered autocorrelation - CenterFFT(R, true); -} - -void randomizePhases(MultidimArray &Min, double wRandom) -{ - FourierTransformer transformer; - MultidimArray< std::complex > F; - transformer.FourierTransform(Min,F,false); - - Matrix1D f(3); - FOR_ALL_DIRECT_ELEMENTS_IN_ARRAY3D(F) - { - FFT_IDX2DIGFREQ(j,XSIZE(Min), XX(f)); - FFT_IDX2DIGFREQ(i,YSIZE(F),YY(f)); - FFT_IDX2DIGFREQ(k,ZSIZE(F),ZZ(f)); - double w=f.module(); - if (w > wRandom) - { - double alpha=rnd_unif(0,2*PI); - double c,s; - //sincos(alpha,&s,&c); - s = sin(alpha); - c = cos(alpha); - - DIRECT_A3D_ELEM(F,k,i,j)*=std::complex(s,c); - } - } - transformer.inverseFourierTransform(); -} diff --git a/src/core/xmipp_fftw.h b/src/core/xmipp_fftw.h deleted file mode 100644 index dc1462d..0000000 --- a/src/core/xmipp_fftw.h +++ /dev/null @@ -1,719 +0,0 @@ -/*************************************************************************** - * - * Authors: Roberto Marabini (roberto@cnb.csic.es) - * Carlos Oscar S. Sorzano (coss@cnb.csic.es) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef _CORE__XmippFFTW_H -#define _CORE__XmippFFTW_H - -#include -#include "fftw3.h" -#include "multidim_array.h" -#include "multidim_array_generic.h" -#include "xmipp_fft.h" - - -/** @defgroup FourierW FFTW Fourier transforms - * @ingroup DataLibrary - *@{ - */ - -/** Fourier Transformer class. - * @ingroup FourierW - * - * The memory for the Fourier transform is handled by this object. - * However, the memory for the real space image is handled externally - * and this object only has a pointer to it. - * - * Here you have an example of use - * @code - * FourierTransformer transformer; - * MultidimArray< std::complex > Vfft; - * transformer.FourierTransform(V(),Vfft,false); - * MultidimArray Vmag; - * Vmag.resize(Vfft); - * FOR_ALL_ELEMENTS_IN_ARRAY3D(Vmag) - * Vmag(k,i,j)=20*log10(abs(Vfft(k,i,j))); - * @endcode - */ -class FourierTransformer -{ -public: - /** Real array, in fact a pointer to the user array is stored. */ - MultidimArray *fReal; - - /** Complex array, in fact a pointer to the user array is stored. */ - MultidimArray > *fComplex; - - /** Fourier array */ - MultidimArray< std::complex > fFourier; - - /* fftw Forawrd plan */ - fftw_plan fPlanForward; - - /* fftw Backward plan */ - fftw_plan fPlanBackward; - - /* number of threads*/ - int nthreads; - - /* Threads has been used in this program*/ - bool threadsSetOn; - - /* Sign where the normalization is applied */ - int normSign; - - // Public methods -public: - /** Default constructor */ - FourierTransformer(); - - /** Copy constructor */ - FourierTransformer(const FourierTransformer& fTransform); - - /** Constructor setting the sign of normalization application*/ - FourierTransformer(int _normSign); - - /** Assignment operator */ - FourierTransformer & operator= (const FourierTransformer & other); - - /** Destructor */ - ~FourierTransformer(); - - /** Set Number of threads - * This function, which should be called once, performs any - * one-time initialization required to use threads on your - * system. - * - * The nthreads argument indicates the number of threads you - * want FFTW to use (or actually, the maximum number). All - * plans subsequently created with any planner routine will use - * that many threads. You can call fftw_plan_with_nthreads, - * create some plans, call fftw_plan_with_nthreads again with a - * different argument, and create some more plans for a new - * number of threads. Plans already created before a call to - * fftw_plan_with_nthreads are unaffected. If you pass an - * nthreads argument of 1 (the default), threads are - * disabled for subsequent plans. */ - void setThreadsNumber(int tNumber) - { - if (tNumber!=1) - { - threadsSetOn=true; - nthreads = tNumber; - if(fftw_init_threads()==0) - REPORT_ERROR(ERR_THREADS_NOTINIT, (std::string)"FFTW cannot init threads (setThreadsNumber)"); - fftw_plan_with_nthreads(nthreads); - } - } - /** Change Number of threads. - * - * The nthreads argument indicates the number of threads you want FFTW to use - * (or actually, the maximum number). All plans subsequently - * created with any planner routine will use that many - * threads. You can call fftw_plan_with_nthreads, create - * some plans, call fftw_plan_with_nthreads again with a - * different argument, and create some more plans for a new - * number of threads. Plans already created before a call to - * fftw_plan_with_nthreads are unaffected. If you pass an - * nthreads argument of 1 (the default), threads are - * disabled for subsequent plans. */ - void changeThreadsNumber(int tNumber) - { - nthreads = tNumber; - fftw_plan_with_nthreads(nthreads); - } - - /** Destroy Threads. Do not execute any previously created - * plans after calling this function */ - void destroyThreads(void ) - { - nthreads = 1; - if(threadsSetOn) - fftw_cleanup_threads(); - - threadsSetOn=false; - } - - /** Compute the Fourier transform of a MultidimArray, 2D and 3D. - If getCopy is false, an alias to the transformed data is returned. - This is a faster option since a copy of all the data is avoided, - but you need to be careful that an inverse Fourier transform may - change the data. - */ - template - void FourierTransform(T& v, T1& V, bool getCopy=true) - { - setReal(v); - Transform(FFTW_FORWARD); - if (getCopy) - getFourierCopy(V); - else - getFourierAlias(V); - } - - /** Compute the Fourier transform. - The data is taken from the matrix with which the object was - created. */ - void FourierTransform(); - - /** Inforce Hermitian symmetry. - If the Fourier transform risks of losing Hermitian symmetry, - use this function to renforce it. */ - void enforceHermitianSymmetry(); - - /** Compute the inverse Fourier transform. - The result is stored in the same real data that was passed for - the forward transform. The Fourier coefficients are taken from - the internal Fourier coefficients */ - void inverseFourierTransform(); - - /** Compute the inverse Fourier transform. - New data is provided for the Fourier coefficients and the output - can be any matrix1D, 2D or 3D. It is important that the output - matrix is already resized to the right size before entering - in this function. */ - template - void inverseFourierTransform(T& V, T1& v) - { - setReal(v); - setFourier(V); - Transform(FFTW_BACKWARD); - } - - /** Get Fourier coefficients. */ - template - void getFourierAlias(T& V) - { - V.alias(fFourier); - return; - } - - /** Use input as a reference to Fourier data. */ - template - void setFourierAlias(T& V) - { - fFourier.alias(V); - return; - } - - /** Get Fourier coefficients. */ - template - void getFourierCopy(T& V) - { - V.resizeNoCopy(fFourier); - memcpy(MULTIDIM_ARRAY(V),MULTIDIM_ARRAY(fFourier), - MULTIDIM_SIZE(fFourier)*2*sizeof(double)); - } - - - /** Return a complete Fourier transform (two halves). - */ - template - void getCompleteFourier(T& V) - { - V.resizeNoCopy(*fReal); - int ndim=3; - if (ZSIZE(*fReal)==1) - { - ndim=2; - if (YSIZE(*fReal)==1) - ndim=1; - } - double *ptrSource=NULL; - double *ptrDest=NULL; - switch (ndim) - { - case 1: - FOR_ALL_DIRECT_ELEMENTS_IN_ARRAY1D(V) - { - ptrDest=(double*)&DIRECT_A1D_ELEM(V,i); - if (i - void completeFourierTransform(T& v, T1& V) - { - setReal(v); - Transform(FFTW_FORWARD); - getCompleteFourier(V); - } - - /** Set one half of the FT in fFourier from the input complete Fourier transform (two halves). - The fReal and fFourier already should have the right sizes - */ - template - void setFromCompleteFourier(T& V) - { - int ndim=3; - if (ZSIZE(*fReal)==1) - { - ndim=2; - if (YSIZE(*fReal)==1) - ndim=1; - } - switch (ndim) - { - case 1: - FOR_ALL_DIRECT_ELEMENTS_IN_ARRAY1D(fFourier) - DIRECT_A1D_ELEM(fFourier,i)=DIRECT_A1D_ELEM(V,i); - break; - case 2: - FOR_ALL_DIRECT_ELEMENTS_IN_ARRAY2D(fFourier) - DIRECT_A2D_ELEM(fFourier,i,j) = DIRECT_A2D_ELEM(V,i,j); - break; - case 3: - FOR_ALL_DIRECT_ELEMENTS_IN_ARRAY3D(fFourier) - DIRECT_A3D_ELEM(fFourier,k,i,j) = DIRECT_A3D_ELEM(V,k,i,j); - break; - } - } - - // Internal methods -public: - /* Pointer to the array of doubles with which the plan was computed */ - double * dataPtr; - - /* Pointer to the array of complex with which the plan was computed */ - std::complex * complexDataPtr; - - /* Init object*/ - void init(); - /** Clear object */ - void clear(); - /** FFTW's planner saves some other persistent data, - * such as the accumulated wisdom and a list of algorithms available - * in the current configuration. If you want to deallocate all of that - * and reset FFTW to the pristine state it was in when - * you started your program, you can call: - */ - void cleanup(void) - { - fftw_cleanup(); - } - - /** Recompute transformation plan. Call this method after setting real/fourier alias - and before calling Transform() to correctly update this object. - */ - void recomputePlanR2C(); - - /** Computes the transform, specified in Init() function - If normalization=true the forward transform is normalized - (no normalization is made in the inverse transform) - If normalize=false no normalization is performed and therefore - the image is scaled by the number of pixels. - */ - void Transform(int sign); - - /** Get the Multidimarray that is being used as input. */ - const MultidimArray &getReal() const; - const MultidimArray > &getComplex() const; - - /** Set a Multidimarray for input. - The data of img will be the one of fReal. In forward - transforms it is not modified, but in backward transforms, - the result will be stored in img. This means that the size - of img cannot change between calls. */ - void setReal(MultidimArray &img); - - /** Set a Multidimarray for input. - The data of img will be the one of fComplex. In forward - transforms it is not modified, but in backward transforms, - the result will be stored in img. This means that the size - of img cannot change between calls. */ - void setReal(MultidimArray > &img); - - /** Set a Multidimarray for the Fourier transform. - The values of the input array are copied in the internal array. - It is assumed that the container for the real image as well as - the one for the Fourier array are already resized. - No plan is updated. */ - void setFourier(const MultidimArray > &imgFourier); - - /* Set normalization sign. - * It defines when the normalization must be applied, when doing - * FFTW_FORWARD OR FFTW_BACKWARD. By default, FFTW_FORWARD.*/ - void setNormalizationSign(int _normSign) - { - normSign = _normSign; - } - -}; - -/** FFT Magnitude 1D - * @ingroup FourierOperations - */ -void FFT_magnitude(const MultidimArray< std::complex< double > > & v, - MultidimArray< double >& mag); - -/** FFT Phase 1D - * @ingroup FourierOperations - */ -void FFT_phase(const MultidimArray< std::complex< double > > & v, - MultidimArray< double >& phase); - -/** FFT Radial average. - * This function computes the Fourier transform (in a relatively inefficient way), - * the amplitude and radial average of the input image. This is primarily meant for - * debugging. It also returns the Fourier transform just in case it might be useful - * outside. - * @ingroup FourierOperations - */ -void radial_magnitude(const MultidimArray & v, MultidimArray< std::complex< double > > &V, - MultidimArray< double >& radialMagnitude); - -/** Autocorrelation function of a Xmipp vector - * @ingroup FourierOperations - * - * Fast calculation of the autocorrelation vector of a given one using Fast - * Fourier Transform. (Using the correlation theorem) - */ -template -void auto_correlation_vector(const MultidimArray< T > & Img, MultidimArray< double >& R) -{ - Img.checkDimension(1); - - // Compute the Fourier Transform - MultidimArray< std::complex< double > > FFT1; - FourierTransformer transformer1; - R=Img; - transformer1.FourierTransform(R, FFT1, false); - - // Multiply FFT1 * FFT1' - double dSize=XSIZE(Img); - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY(FFT1) - { - double *ptr=(double*)&DIRECT_MULTIDIM_ELEM(FFT1,n); - double &realPart=*ptr; - double &imagPart=*(ptr+1); - realPart=dSize*(realPart*realPart+imagPart*imagPart); - imagPart=0; - } - - // Invert the product, in order to obtain the correlation image - transformer1.inverseFourierTransform(); - - // Center the resulting image to obtain a centered autocorrelation - CenterFFT(R, true); -} - -/** Autocorrelation function of a Xmipp vector - * @ingroup FourierOperations - * - * Fast calcuation of the correlation matrix on two matrices using Fast Fourier - * Transform. (Using the correlation theorem). The output matrix must be already - * resized - */ -template -void correlation_vector(const MultidimArray< T > & m1, - const MultidimArray< T > & m2, - MultidimArray< double >& R) -{ - m1.checkDimension(2); - m2.checkDimension(2); - - // Compute the Fourier Transforms - MultidimArray< std::complex< double > > FFT1, FFT2; - FourierTransformer transformer1, transformer2; - R=m1; - transformer1.FourierTransform(R, FFT1, false); - transformer2.FourierTransform((MultidimArray &)m2, FFT2, false); - - // Multiply FFT1 * FFT2' - double dSize=XSIZE(m1); - FOR_ALL_ELEMENTS_IN_ARRAY1D(FFT1) - FFT1(i) *= dSize * conj(FFT2(i)); - - // Invert the product, in order to obtain the correlation image - transformer1.inverseFourierTransform(); - - // Center the resulting image to obtain a centered autocorrelation - CenterFFT(R, true); -} - -/** Autocorrelation function of a Xmipp vector - * @ingroup FourierOperations - * - * Same as correlation_vector, but the Fourier transforms have already been computed - * and the transformer is reused. The transformer internal variables must have already - * been resized. - */ -void fast_correlation_vector(const MultidimArray< std::complex > & FFT1, - const MultidimArray< std::complex > & FFT2, - MultidimArray< double >& R, - FourierTransformer &transformer); - -/** Compute the correlation vector without using Fourier. - * @ingroup FourierOperations - * - * The results are the same as the previous ones but this function - * is threadsafe while the previous one is not. - * - * It is assumed that the two vectors v1, and v2 are of the same size. */ -template -void correlation_vector_no_Fourier(const MultidimArray &v1, const MultidimArray &v2, - MultidimArray &result) -{ - v1.checkDimension(1); - v2.checkDimension(1); - - result.initZeros(v1); - result.setXmippOrigin(); - int N=XSIZE(v1)-1; - FOR_ALL_ELEMENTS_IN_ARRAY1D(result) - for (int k=0; k > FFT1, FFT2; - FourierTransformer transformer1, transformer2; -}; - -/** Correlation of two nD images - * @ingroup FourierOperations - * - * Fast calcuation of the correlation matrix on two matrices using Fast Fourier - * Transform. (Using the correlation theorem). The output matrix must be already - * resized - */ - -void correlation_matrix(const MultidimArray & m1, - const MultidimArray & m2, - MultidimArray< double >& R, - CorrelationAux &aux, - bool center=true); - -void correlation_matrix(const MultidimArray< std::complex< double > > & FFT1, - const MultidimArray & m2, - MultidimArray& R, - CorrelationAux &aux, - bool center=true); - -/** Correlation matrix. - * R must already be with the right size. - */ -void correlation_matrix(const MultidimArray< std::complex< double > > & FFT1, - const MultidimArray< std::complex< double > > & FFT2, - MultidimArray& R, - CorrelationAux &aux, - bool center=true); - -/** Autocorrelation function of an image - * @ingroup FourierOperations - * - * Fast calcuation of the autocorrelation matrix of a given one using Fast - * Fourier Transform. (Using the correlation theorem) - */ -template -void auto_correlation_matrix(const MultidimArray< T > & Img, MultidimArray< double >& R) -{ - // Compute the Fourier Transform - MultidimArray< std::complex< double > > FFT1; - FourierTransformer transformer1; - R=Img; - transformer1.FourierTransform(R, FFT1, false); - - // Multiply FFT1 * FFT1' - double dSize=MULTIDIM_SIZE(Img); - FOR_ALL_DIRECT_ELEMENTS_IN_MULTIDIMARRAY(FFT1) - { - double *ptr=(double*)&DIRECT_MULTIDIM_ELEM(FFT1,n); - double &realPart=*ptr; - double &imagPart=*(ptr+1); - realPart=dSize*(realPart*realPart+imagPart*imagPart); - imagPart=0; - } - - // Invert the product, in order to obtain the correlation image - transformer1.inverseFourierTransform(); - - // Center the resulting image to obtain a centered autocorrelation - CenterFFT(R, true); -} - -/** Fast autocorrelation matrix */ -void auto_correlation_matrix(const MultidimArray & Img, MultidimArray< double >& R, CorrelationAux &aux); - -void convolutionFFTStack(const MultidimArray &img, - const MultidimArray &kernel, - MultidimArray &result); - -void convolutionFFT(MultidimArray &img, - MultidimArray &kernel, - MultidimArray &result); - -/** Fourier-Ring-Correlation between two multidimArrays using FFT - * @ingroup FourierOperations - */ -void frc_dpr(MultidimArray< double > & m1, - MultidimArray< double > & m2, - double sampling_rate, - MultidimArray< double >& freq, - MultidimArray< double >& frc, - MultidimArray< double >& frc_noise, - MultidimArray< double >& dpr, - MultidimArray< double >& error_l2, - bool skipdpr=false, - bool doRfactor = false, - double minFreq = -1, - double maxFreq = 0.5, - double * rFactor= NULL); - -/** Scale matrix using Fourier transform - * @ingroup FourierOperations - * Ydim and Xdim define the output size, mda is the MultidimArray to scale - */ -void scaleToSizeFourier(int Zdim, int Ydim, int Xdim, MultidimArray &mdaIn, MultidimArray &mdaOut, int nThreads=1); - -/** Scale Fourier transform - * mdaIn and mdaOut define the sizes of the respective image, inFourier is transform to be scaled - */ -template -void scaleToSizeFourier(MultidimArray &mdaIn, MultidimArray &mdaOut, - MultidimArray > &inFourier, MultidimArray > &outFourier); - -void selfScaleToSizeFourier(int Zdim, int Ydim, int Xdim, MultidimArray &mda, int nthreads=1); - -void selfScaleToSizeFourier(int Ydim, int Xdim, MultidimArray &mda, int nthreads=1); -/** MultidimArrayGeneric version */ -void selfScaleToSizeFourier(int Zdim, int Ydim, int Xdim, MultidimArrayGeneric &mda, int nthreads=1); -void selfScaleToSizeFourier(int Ydim, int Xdim, MultidimArrayGeneric &mda, int nthreads=1); - -#define POWER_SPECTRUM 0 -#define AMPLITUDE_SPECTRUM 1 - -/** Get the amplitude or power spectrum of the map in Fourier space. - * @ingroup FourierOperations - i.e. the radial average of the (squared) amplitudes of all Fourier components -*/ -void getSpectrum(MultidimArray &Min, - MultidimArray &spectrum, - int spectrum_type=AMPLITUDE_SPECTRUM); - -/** Divide the input map in Fourier-space by the spectrum provided. - * @ingroup FourierOperations - If leave_origin_intact==true, the origin pixel will remain untouched -*/ -void divideBySpectrum(MultidimArray &Min, - MultidimArray &spectrum, - bool leave_origin_intact=false); - -/** Multiply the input map in Fourier-space by the spectrum provided. - * @ingroup FourierOperations - If leave_origin_intact==true, the origin pixel will remain untouched -*/ -void multiplyBySpectrum(MultidimArray &Min, - MultidimArray &spectrum, - bool leave_origin_intact=false); - -/** Perform a whitening of the amplitude/power spectrum of a 3D map - * @ingroup FourierOperations - If leave_origin_intact==true, the origin pixel will remain untouched -*/ -void whitenSpectrum(MultidimArray &Min, - MultidimArray &Mout, - int spectrum_type=AMPLITUDE_SPECTRUM, - bool leave_origin_intact=false); - -/** Adapts Min to have the same spectrum as spectrum_ref - * @ingroup FourierOperations - If only_amplitudes==true, the amplitude rather than the power spectrum will be equalized -*/ -void adaptSpectrum(MultidimArray &Min, - MultidimArray &Mout, - const MultidimArray &spectrum_ref, - int spectrum_type=AMPLITUDE_SPECTRUM, - bool leave_origin_intact=false); - -/** Randomize phases beyond a certain frequency - * @ingroup FourierOperations -*/ -void randomizePhases(MultidimArray &Min, double wRandom); -#endif -/** @} */ diff --git a/src/core/xmipp_filename.cpp b/src/core/xmipp_filename.cpp deleted file mode 100644 index 7bc06eb..0000000 --- a/src/core/xmipp_filename.cpp +++ /dev/null @@ -1,941 +0,0 @@ -/*************************************************************************** - * Authors: Carlos Oscar S. Sorzano (coss@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include -#include -#include -#include -#include -#include "xmipp_filename.h" -#include "xmipp_funcs.h" -#include "xmipp_image_macros.h" -#include "xmipp_image_generic.h" - -#include - - -String FileNameVersion=METADATA_XMIPP_STAR; - -void setMetadataVersion(String version) -{ - FileNameVersion=version; -} - -String getMetadataVersion(void) -{ - return FileNameVersion; -} - -// Constructor with root, number and extension ............................. -void FileName::compose(const String &str, size_t no, const String &ext) -{ - - if (no == ALL_IMAGES || no == (size_t) -1) - REPORT_ERROR(ERR_DEBUG_TEST, "Don't compose with 0 or -1 index, now images index start at 1"); - - *this = (FileName) str; - - if (no != ALL_IMAGES) - this->append(formatString("%06lu", no)); - - if (!ext.empty()) - *this += (String) "." + ext; -} - -// Constructor: prefix number and filename, mainly for selfiles.. -void FileName::compose(size_t no, const String &str) -{ - if (no == ALL_IMAGES || no == (size_t) -1) - REPORT_ERROR(ERR_DEBUG_TEST, "Don't compose with 0 or -1 index, now images index start at 1"); - - if (no != ALL_IMAGES) - { - size_t first = str.rfind(AT); - if (first != npos) - { - std::vector prefixes; - int nPref = splitString(str.substr(0, first),",",prefixes, false); - - if (isalpha(prefixes[nPref-1].at(0))) - formatStringFast(*this, "%06lu,%s", no, str.c_str()); - } - else - formatStringFast(*this, "%06lu@%s", no, str.c_str()); - } - else - *this = str; -} - -// Constructor: prefix number, filename root and extension, mainly for selfiles.. -void FileName::compose(size_t no, const String &str, const String &ext) -{ - if (no == ALL_IMAGES || no == (size_t) -1) - REPORT_ERROR(ERR_DEBUG_TEST, "Don't compose with 0 or -1 index, now images index start at 1"); - - if (no != ALL_IMAGES) - formatStringFast(*this, "%06lu@%s.%s", no, - str.c_str(), ext.c_str()); - else - *this = str; -} - -// Constructor: string and filename, mainly for metadata blocks.. -void FileName::compose(const String &blockName, const String &str) -{ - if (blockName.empty()) - *this = str; - else - formatStringFast(*this, "%s@%s", blockName.c_str(), str.c_str()); -} - -// Constructor: string, number and filename, mainly for numered metadata blocks.. -void FileName::composeBlock(const String &blockName, size_t no, const String &root, const String &ext) -{ - formatStringFast(*this, "%s%06lu@%s", blockName.c_str(), no, root.c_str()); - if (ext != "") - *this += (String) "." + ext; -} - -// Is in stack ............................................................ -bool FileName::isInStack() const -{ - return find(AT) != String::npos; -} - -// Decompose .............................................................. -void FileName::decompose(size_t &no, String &str) const -{ - char buffer[1024]; - unsigned long int auxNo; - int ok = sscanf(c_str(), "%lu@%s", &auxNo, buffer); - no=auxNo; - if (ok != 2) - { - no = ALL_IMAGES; - str = *this; - return; - } - else if (no == 0) - REPORT_ERROR(ERR_INDEX_OUTOFBOUNDS, formatString("FileName::decompose: Incorrect index number at filename %s; It must start at %lu",c_str(),FIRST_IMAGE)); - - str = buffer; -} - -// Get decomposed filename ....................................... -FileName FileName::getDecomposedFileName() const -{ - String str; - size_t no; - decompose(no, str); - return str; -} - -// Get the root name of a filename ......................................... -// TODO: Check if it is really needed -FileName FileName::getRoot() const -{ - size_t skip_directories = find_last_of("/") + 1; - size_t point = find_first_of(".", skip_directories); - if (point == npos) - point = length(); - size_t root_end = find_last_not_of("0123456789", point - 1); - if (root_end + 1 != point) - if (point - root_end > FILENAMENUMBERLENGTH) - root_end = point - FILENAMENUMBERLENGTH - 1; - return substr(0, root_end + 1); -} - -// Convert to lower case characters ......................................... -FileName FileName::toLowercase() const -{ - FileName result = *this; - for (size_t i = 0; i < result.length(); i++) - result[i] = tolower(result[i]); - return result; -} - -// Convert to upper case characters ......................................... -FileName FileName::toUppercase() const -{ - FileName result = *this; - for (size_t i = 0; i < result.length(); i++) - result[i] = toupper(result[i]); - return result; -} - -// Is substring present? -bool FileName::contains(const String& str) const -{ - return find(str) != npos; -} - -// Get substring before first instance of str -//TODO: Check behaviour -FileName FileName::beforeFirstOf(const String& str) const -{ - size_t point = find_first_of(str); - return (point != npos ? (FileName)substr(0, point) : *this); -} - -// Get substring before last instance of str -//TODO: Check behaviour -FileName FileName::beforeLastOf(const String& str) const -{ - size_t point = find_last_of(str); - return point != npos ? (FileName)substr(0, point) : *this; -} - -// Get substring after first instance of str -//TODO: Check behaviour -FileName FileName::afterFirstOf(const String& str) const -{ - size_t point = find_first_of(str); - return point != npos ? (FileName)substr(point + 1) : *this; -} - -// Get substring after last instance of str -//TODO: Check behaviour -FileName FileName::afterLastOf(const String& str) const -{ - size_t point = find_last_of(str); - return point != npos ? (FileName)substr(point + 1) : *this; -} - -// Get the base name of a filename ......................................... -FileName FileName::getBaseName() const -{ - FileName baseName = removeLastExtension(); - return baseName.afterLastOf("/"); -} - - -// Get the dir of a filename ......................................... -FileName FileName::getDir() const -{ - size_t pos = find_last_of("/"); - return (FileName)( pos != npos ? substr(0, pos+1) : ""); -} - -// Get the extension of a filename ......................................... -String FileName::getExtension() const -{ - size_t posA = find_last_of("/"); - size_t posB = find_last_of("."); - if (posB==npos) - return ""; - if (posA==npos) - return substr(posB+1); - if (posB>posA) - return substr(posB+1); - return ""; -} - -// Has image extension ..................................................... -bool FileName::hasImageExtension() const -{ - String ext = getFileFormat(); - return (ext=="img" || ext=="hed" || ext=="inf" || ext=="raw" || ext=="mrc" || - ext=="map" || ext=="spi" || ext=="xmp" || ext=="tif" || ext=="gain" || - ext=="dm3" || ext=="spe" || ext=="em" || ext=="pif" || ext=="ser" || - ext=="stk" || ext=="mrcs"|| ext=="jpg" || ext=="dm4"); -} - -// Has image extension ..................................................... -bool FileName::hasStackExtension() const -{ - String ext = getFileFormat(); - return (ext=="stk" || ext=="spi" || ext=="xmp" || ext=="mrcs" || ext=="mrc" || - ext=="img" || ext=="hed" || ext=="pif" || ext=="tif" || ext=="dm3" || - ext=="ser" || ext=="st" || ext=="dm4"); -} - -// Has image extension ..................................................... -bool FileName::hasVolumeExtension() const -{ - String ext = getFileFormat(); - return (ext=="vol" || ext=="spi" || ext=="xmp" || ext=="mrc" || ext=="map" || - ext=="em" || ext=="pif" || ext=="inf" || ext=="raw"); -} - -// Has image extension ..................................................... -bool FileName::hasMetadataExtension() const -{ - String ext = getFileFormat(); - return (ext == "sel" || ext == "xmd" || ext == "doc" || - ext == "ctfdat" || ext == "ctfparam" || ext == "pos" || - ext == "sqlite" || ext == "xml" || ext == "star"); -} - -// Init random ............................................................. -void FileName::initRandom(int length) -{ - randomize_random_generator(); - *this = ""; - for (int i = 0; i < length; i++) - *this += 'a' + FLOOR(rnd_unif(0, 26)); -} - -// Init Unique ............................................................. -void FileName::initUniqueName(const char *templateStr, const String &fnDir) -{ -#ifndef __MINGW32__ - int fd; - const int len=512; - char filename[len]; - if (fnDir!="") - strcpy(filename,(fnDir+"/").c_str()); - else - filename[0]=0; - strcat(filename, templateStr); - filename[len - 1] = 0; - if ((fd = mkstemp(filename)) == -1) - { - perror("FileName::Error generating tmp lock file"); - exit(1); - } - close(fd); - *this = filename; -#endif -} - -// Add at beginning ........................................................ -FileName FileName::addPrefix(const String &prefix) const -{ - FileName retval = *this; - int skip_directories = find_last_of("/") + 1; - return retval.insert(skip_directories, prefix); -} - -// Add at the end .......................................................... -FileName FileName::addExtension(const String &ext) const -{ - if (ext == "") - return *this; - else - { - FileName retval = *this; - retval = retval.append((String) "." + ext); - return retval; - } -} - -// Remove last extension ................................................... -FileName FileName::withoutExtension() const -{ - FileName retval = *this; - return retval.substr(0, rfind(".")); -} - -// Remove root ............................................................. -FileName FileName::withoutRoot() const -{ - return removeSubstring(getRoot()); -} - -// Insert before extension ................................................. -FileName FileName::insertBeforeExtension(const String &str) const -{ - FileName retval = *this; - size_t pos = find_last_of('.'); - return pos != npos ? retval.insert(pos, str) : retval.append(str); -} - -// Remove an extension wherever it is ...................................... -FileName FileName::removeExtension(const String &ext) const -{ - FileName retval = *this; - size_t first = find((String) "." + ext); - return (first == npos) ? retval: retval.erase(first, 1 + ext.length()); -} - -// Remove the last extension ................................................ -FileName FileName::removeLastExtension() const -{ - FileName retval = *this; - size_t first = find_last_of('.'); - return (first == npos) ? retval : retval.substr(0, first); -} - -// Remove all extensions.................................................... -FileName FileName::removeAllExtensions() const -{ - FileName retval = *this; - size_t first = find_last_of('/'); - first = find_first_of('.', first + 1); - return (first == npos) ? retval: retval.substr(0, first); -} - -FileName FileName::removeFilename() const -{ - size_t first = find_last_of('/'); - return (first == npos) ? "" : substr(0, first); -} - -String FileName::getFileFormat() const -{ - size_t first; - FileName result; - if ((first = rfind(COLON)) != npos) - result = substr(first + 1); - else if ((first = rfind(".")) != npos) - { - // Get everything from the '.' to the end of the filename - // If there is a '#', only keep whatever is between the '.' and the '#' - result = substr(first + 1); - result = result.substr(0, result.find(NUM)); - } - else if (find(NUM) != npos) - return "raw"; - return result.toLowercase(); -} - -size_t FileName::getFileSize() const -{ - Stat info; - if (stat(c_str(), &info)) - { - char cCurrentPath[FILENAME_MAX]; - char *success=getcwd(cCurrentPath, sizeof(cCurrentPath)); - if (success==NULL) - cCurrentPath[0]='\0'; - REPORT_ERROR(ERR_UNCLASSIFIED,formatString("FileName::getFileSize: Cannot get size of file %s/%s",cCurrentPath,this->c_str())); - } - return info.st_size; - -// int fd = open(c_str(), O_RDONLY); -// size_t size = lseek(fd, 0, SEEK_END); // seek to end of file -// close(fd); -// -// return size; - -} - -FileName FileName::removeFileFormat() const -{ - size_t found = rfind(NUM); - if (found != String::npos) - return substr(0, found); - found = rfind(COLON); - if (found != String::npos) - return substr(0, found); - return *this; -} - -// Get number from file base name .................................................... -int FileName::getNumber() const -{ - size_t skip_directories = find_last_of("/") + 1; - size_t point = find_first_of(".", skip_directories); - if (point == npos) - point = length(); - size_t root_end = find_last_not_of("0123456789", point - 1); - if (root_end + 1 != point) - { - if (point - root_end > FILENAMENUMBERLENGTH) - root_end = point - FILENAMENUMBERLENGTH - 1; - String aux = substr(root_end + 1, point - root_end + 1); - return atoi(aux.c_str()); - } - else - return -1; -} - -// Get number from file .................................................... -size_t FileName::getPrefixNumber(size_t pos) const -{ - size_t first = rfind(AT); - size_t result = ALL_IMAGES; - if (first != npos) - { - std::vector prefixes; - size_t nPref = splitString(substr(0, first),",",prefixes, false); - - if (pos > nPref-1) - REPORT_ERROR(ERR_ARG_INCORRECT, formatString("getPrefixNumber: Selected %lu position greater than %lu positions \n" - " detected in %s filename.",pos+1, nPref, this->c_str())); - - if (isdigit(prefixes[pos].at(0))) - result = textToSizeT(prefixes[pos].c_str()); - } - return result; -} - -String FileName::getBlockName() const -{ - size_t first = rfind(AT); - String result = ""; - if (first != npos) - { - result = substr(0, first); - if ((first = result.find(COMMA)) != npos) // Assign and compare at the same time - result = result.substr(first+1); - - /* using isdigit instead of isalpha allows to - * detect as blockname rootnames starting by "/" - */ - if (result.empty() || isdigit(result[0])) - result = ""; - } - return result; - -} - -FileName FileName::removeBlockName() const -{ - size_t first = rfind(AT); - - if (first != npos) - { - String block = substr(0, first); - size_t second = block.find(COMMA); - - if (second == npos) - { - if (!isdigit(block[0])){ - return substr(first + 1); - } - } - else - { - String prefix = block.substr(0, second); - block = block.substr(second + 1); - if (!isdigit(block[0])) - return prefix + substr(first); - } - } - return *this; -} - -FileName FileName::removePrefixNumber() const -{ - size_t first = rfind(AT); - - if (first != npos) - { - std::vector prefixes; - int nPref = splitString(substr(0, first),",",prefixes, false); - - if (isdigit(prefixes[nPref-1].at(0))) - return substr(first + 1); - else if (nPref > 1) // isalpha and we remove the "," - return substr(first - prefixes[nPref-1].size()); - } - return *this; -} - -FileName FileName::removeAllPrefixes() const -{ - size_t first = rfind(AT); - if (first != npos) - return substr(first + 1); - return *this; -} - -bool FileName::isMetaData(bool failIfNotExists) const -{ - //check empty string - if (empty()) - REPORT_ERROR(ERR_ARG_INCORRECT, "FileName::isMetaData: Empty string is not a MetaData"); - //file names containing : or % are not metadatas - //size_t found = this->find('@'); - if (find_first_of(":#") != npos) - return false; - - //check if file exists - if (failIfNotExists && !existsTrim()) - REPORT_ERROR(ERR_IO_NOTFILE, formatString("FileName::isMetaData: File: '%s' does not exist", c_str())); - //This is dangerous and should be removed - //in next version. only star1 files should be OK - //ROB - //FIXME - return (hasMetadataExtension() || isStar1(failIfNotExists)); -} - -bool FileName::isStar1(bool failIfNotExists) const -{ - std::ifstream infile( this->removeAllPrefixes().c_str(), std::ios_base::in); - String line; - - if (infile.fail()) - { - if (failIfNotExists) - REPORT_ERROR( ERR_IO_NOTEXIST, formatString("File '%s' does not exist.", this->removeAllPrefixes().c_str())); - else - return false; - } - - // Search for xmipp_3, - char cline[128]; - infile.getline(cline, 128); - infile.close(); - line = cline; - size_t pos = line.find(METADATA_XMIPP_STAR); - return (pos != npos); // xmipp_star_1 token found -} - -// Replace one substring by other ....................................... -FileName FileName::replaceSubstring(const String &subOld, const String &subNew) const -{ - size_t pos = find(subOld); - if (pos == npos) - return *this; - - FileName result = *this; - result.replace(pos, subOld.length(), subNew); - return result; -} - -// Replace all appearances of one substring by other ....................................... -FileName FileName::replaceCharacter(char oldChar, char newChar) const -{ - FileName result = *this; - std::replace(result.begin(), result.end(), oldChar, newChar); - return result; -} - -// Substitute one extension by other ....................................... -FileName FileName::replaceExtension(const String &newExt) const -{ - return removeLastExtension() + "." + newExt; -} - -// Remove a substring ...................................................... -FileName FileName::removeSubstring(const String &sub) const -{ - return replaceSubstring(sub, ""); -} - -// Remove until prefix ..................................................... -FileName FileName::removeUntilPrefix(const String &prefix) const -{ - size_t pos = find(prefix); - if (pos == npos) - return *this; - FileName result = *this; - return result.erase(0, pos + prefix.length()); -} - -// Remove directories ...................................................... -FileName FileName::removeDirectories(int keep) const -{ - size_t last_slash = rfind("/"); - int tokeep = keep; - while (tokeep > 0) - { - last_slash = rfind("/", last_slash - 1); - tokeep--; - } - if (last_slash == npos) - return *this; - else - return substr(last_slash + 1, length() - last_slash); -} - -void FileName::copyFile(const FileName & target) const -{ - std::ifstream f1(this->c_str(), std::fstream::binary); - std::ofstream - f2(target.c_str(), std::fstream::trunc | std::fstream::binary); - f2 << f1.rdbuf(); -} - -/* Check if a file exists -------------------------------------------------- */ -bool FileName::exists() const -{ - return fileExists(getDecomposedFileName().removeFileFormat()); -} -/* Delete file exists -------------------------------------------------- */ -void FileName::deleteFile() const -{ - FileName temp = this->removeFileFormat().removeAllPrefixes(); - if (temp.exists()) - unlink(temp.c_str()); -} -/* Check if a file exists remove leading @ and tailing : */ -bool FileName::existsTrim() const -{ - FileName auxF(*this); - size_t found = find_first_of(AT); - - if (found != String::npos) - auxF = substr(found+1); - - found = auxF.find_first_of(NUM); - - if ( found != String::npos) - auxF = auxF.substr(0, found); - found = auxF.find_first_of(COLON); - - if (found != String::npos) - auxF = auxF.substr(0, found); - return fileExists(auxF.c_str()); -} - -/* List of files within a directory ---------------------------------------- */ -void FileName::getFiles(std::vector &files) const -{ - files.clear(); - - DIR *dp; - struct dirent *dirp; - if ((dp = opendir(c_str())) == NULL) - REPORT_ERROR(ERR_IO_NOTEXIST,*this); - - while ((dirp = readdir(dp)) != NULL) - if (strcmp(dirp->d_name,".")!=0 && strcmp(dirp->d_name,"..")!=0) - files.push_back(FileName(dirp->d_name)); - closedir(dp); - std::sort(files.begin(),files.end()); -} - -/* Is directory ------------------------------------------------------------ */ -bool FileName::isDir() const -{ - Stat st_buf; - if (stat (c_str(), &st_buf) != 0) - REPORT_ERROR(ERR_UNCLASSIFIED,(String)"Cannot determine status of filename "+ *this); - return (S_ISDIR (st_buf.st_mode)); -} - -/* Wait until file has a stable size --------------------------------------- */ -void FileName::waitUntilStableSize(size_t time_step) -{ - size_t idx; - FileName basicName; - decompose(idx, basicName); - - if (!exists()) - return; - Stat info1, info2; - if (stat(basicName.c_str(), &info1)) - REPORT_ERROR(ERR_UNCLASSIFIED, - (String)"FileName::waitUntilStableSize: Cannot get size of file " + *this); - off_t size1 = info1.st_size; - do - { - usleep(time_step); - if (stat(basicName.c_str(), &info2)) - REPORT_ERROR(ERR_UNCLASSIFIED, - (String)"FileName::waitUntilStableSize: Cannot get size of file " + *this); - off_t size2 = info2.st_size; - if (size1 == size2) - break; - size1 = size2; - } - while (true); - return; -} - -/* Create empty file ------------------------------------------------------- */ -void FileName::createEmptyFile(size_t size, size_t block_size) -{ - unsigned char * buffer = (unsigned char*) calloc(sizeof(unsigned char), - block_size); - if (buffer == NULL) - REPORT_ERROR(ERR_MEM_NOTENOUGH, "create_empty_file: No memory left"); - FILE * fd = fopen(c_str(), "w"); - if (fd == NULL) - REPORT_ERROR(ERR_IO_NOTOPEN, (String)"FileName::createEmptyFile: Cannot open file" + *this); - for (size_t i = 0; i < size / block_size; i++) - fwrite(buffer, sizeof(unsigned char), block_size, fd); - fwrite(buffer, sizeof(unsigned char), size % block_size, fd); - fclose(fd); - free(buffer); -} - -void FileName::createEmptyFileWithGivenLength(size_t length) const -{ - FILE* fMap = fopen(c_str(),"wb"); - if (!fMap) - REPORT_ERROR(ERR_IO_NOWRITE, *this); - if (length>0) - { - char c=0; - if ((fseek(fMap, length-1, SEEK_SET) == -1) || (fwrite(&c,1,1,fMap) != 1)) - REPORT_ERROR(ERR_IO_NOWRITE,"FileName::createEmptyFileWithGivenLength: Cannot create empty file"); - } - fclose(fMap); -} - -/** Auxiliary function used to create a tree of directories - * return 0 on success - */ -int do_mkdir(const char *path, mode_t mode) -{ - Stat st; - int status = 0; - - if (stat(path, &st) != 0) - { - /* Directory does not exist */ -#ifndef __MINGW32__ - if (mkdir(path, mode) != 0) -#else - - if (mkdir(path) != 0) -#endif - - status = -1; - } - else if (!S_ISDIR(st.st_mode)) - { - errno = ENOTDIR; - status = -1; - } - - return (status); -} - -int FileName::makePath(mode_t mode) const -{ - char *pp; - char *sp; - int status; - char *copypath = strdup(c_str()); - if (copypath == NULL) - REPORT_ERROR(ERR_MEM_BADREQUEST,"FileName::makePath: Canot alloc memory"); - - status = 0; - pp = copypath; - while (status == 0 && (sp = strchr(pp, '/')) != 0) - { - if (sp != pp) - { - /* Neither root nor double slash in path */ - *sp = '\0'; - status = do_mkdir(copypath, mode); - *sp = '/'; - } - pp = sp + 1; - } - if (status == 0) - status = do_mkdir(c_str(), mode); - free(copypath); - return status; -} - -/* Exit program if filename is not empry and file does not exist ----------- */ -void FileName::assertExists() -{ - if (!empty() && !exists()) - { - std::cerr << "FileName::assertExists: control file" << *this - << " doesn't exist, exiting..." << std::endl; - exit(ERR_IO_NOTEXIST); - } - //TODO: Maybe change to report error??? - //REPORT_ERROR(ERR_IO_NOTEXIST, (String)"FileName::assertExists: control file" + *this " doesn't exist, exiting..."); -} - -/* Get the Xmipp Base directory -------------------------------------------- */ -char * getXmippPath() -{ - char* path = getenv("XMIPP_HOME"); - if (path == NULL) - REPORT_ERROR(ERR_VALUE_EMPTY, "getXmippPath::Variable XMIPP_HOME is not defined"); - return path; - -} - -/* Get the Xmipp source directory -------------------------------------------- */ -char * getXmippSrcPath() -{ - char* path = getenv("XMIPP_SRC"); - if (path == NULL) - REPORT_ERROR(ERR_VALUE_EMPTY, "getXmippSrcPath::Variable XMIPP_HOME is not defined"); - return path; - -} - -void copyImage(const FileName & source, const FileName & target) -{ - ImageGeneric img(source); - img.write(target); -} - -void deleteFile(const FileName &fn) -{ - fn.deleteFile(); -} - -void FileLock::lock(int _fileno) -{ -#ifndef __MINGW32__ - if (islocked) - unlock(); - - if (_fileno != 0) - filenum = _fileno; - - fl.l_type = F_WRLCK; - fcntl(filenum, F_SETLKW, &fl); - islocked = true; -#endif - -} - -void FileLock::lock(FILE * hdlFile) -{ - if (islocked) - unlock(); - - if (hdlFile != NULL) - this->filenum = fileno(hdlFile); - -#ifdef __MINGW32__ - - HANDLE hFile = (HANDLE)_get_osfhandle(filenum); - DWORD dwLastPos = SetFilePointer(hFile, 0, NULL, FILE_END); - if (LockFile(hFile, 0, 0, dwLastPos, 0) != NULL) - REPORT_ERROR(ERR_IO_LOCKED,"File cannot be locked."); -#else - - fl.l_type = F_WRLCK; - fcntl(filenum, F_SETLKW, &fl); -#endif - - islocked = true; -} - - -void FileLock::unlock() -{ - if (islocked) - { -#ifdef __MINGW32__ - HANDLE hFile = (HANDLE)_get_osfhandle(filenum); - DWORD dwLastPos = SetFilePointer(hFile, 0, NULL, FILE_END); - if (UnlockFile(hFile, 0, 0, dwLastPos, 0) != NULL) - REPORT_ERROR(ERR_IO_LOCKED,"File cannot be unlocked."); -#else - - fl.l_type = F_UNLCK; - fcntl(filenum, F_SETLK, &fl); -#endif - - islocked = false; - } -} - diff --git a/src/core/xmipp_filename.h b/src/core/xmipp_filename.h deleted file mode 100644 index 4422e5f..0000000 --- a/src/core/xmipp_filename.h +++ /dev/null @@ -1,795 +0,0 @@ -/*************************************************************************** - * Authors: Carlos Oscar S. Sorzano (coss@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_XMIPP_FILENAME_H_ -#define CORE_XMIPP_FILENAME_H_ - -//#ifdef HAVE_UNISTD_H -#include -//#endif /* HAVE_UNISTD_H */ - -#include "xmipp_strings.h" - -#ifndef __MINGW32__ -#include -#endif - -#define FILENAMENUMBERLENGTH 6 - -typedef struct stat Stat; - -//extern variable with magic Word used to define metadata version -// xmipp XMIPP_STAR_1 -// sqlite SQLite format 3 - -#define METADATA_XMIPP_STAR "# XMIPP_STAR_1" -#define METADATA_XMIPP_SQLITE "SQLite format 3" - - -/** Some filename macros */ -#define AT '@' -#define COMMA ',' -#define COLON ':' -#define NUM '#' - -//@{ -/** Filenames. - * - * This class allows you a lot of usual and common manipulations with filenames. - * See filename conventions for a detailed explanation of the Filenames dealed - * here, although most of the functions work with the more general model - * "name.extension" - */ -class FileName: public String -{ -public: - /// @name Filename constructors - /// @{ - - /** Empty constructor - * - * The empty constructor is inherited from the string class, so an empty - * FileName is equal to "". - * - * @code - * FileName fn_blobs; - * @endcode - */ - inline FileName(): String("") - {} - - /** Constructor from string - * - * The constructor from a string allows building complex expressions based - * on the string class. Notice that in the following example the type - * casting to string is very important, if not, the operation is just a - * pointer movement instead of a string concatenation. - * - * @code - * FileName fn_blobs((String) "art00001" + ".blobs"); - * @endcode - */ - FileName(const String& str): String(str) - {} - - /** Constructor from char* - */ - FileName(const char* str) : String(str) - {} - - /** Assignment constructor - */ - FileName& operator=(const FileName& op) - { - return (FileName&) std::string::operator=(op); - } - - /** Copy constructor - */ - FileName(const FileName& fn) : String(fn) - {} - - /** Constructor from root, number and extension - * - * The number and extension are optional. - * - * @code - * FileName fn_proj("g1ta000001.xmp"); // fn_proj = "g1ta000001.xmp" - * FileName fn_proj("g1ta",1,"xmp"); // fn_proj = "g1ta000001.xmp" - * FileName fn_proj("g1ta",1); // fn_proj = "g1ta000001" - * @endcode - */ - FileName(const char* str, int no, const String& ext = "") - { - compose(str, no, ext); - } - - /** Constructor from root and extension - * - * None of the parameters is optional - * - * @code - * FileName fn_proj("g1ta00001", "xmp"); // fn_proj = "g1ta00001.xmp" - * @endcode - */ - FileName(const char* str, const String& ext): String(str + ext) - {} - - /** Constructor from root and extension - * - * None of the parameters is optional - * - * @code - * FileName fn_proj("g1ta00001", "xmp"); // fn_proj = "g1ta00001.xmp" - * @endcode - */ - FileName(const String& str, const String& ext): String(str + "." + ext) - {} - //@} - - /// @name Composing/Decomposing the filename - /// @{ - - /** - * Convert to String - */ - inline String getString() const - { - return (String)(*this); - } - - /** True if the FileName has an empty value "" - */ - inline bool isEmpty() const - { - return *this == ""; - } - - /** Compose from root, number and extension - * - * @code - * fn_proj.compose("g1ta", 1, "xmp"); // fn_proj = "g1ta000001.xmp" - * @endcode - */ - void compose(const String& str, const size_t no, const String& ext = ""); - - /** Prefix with number @. Mainly for selfiles - * - * @code - * fn_proj.compose(1,"g1ta.xmp"); // fn_proj = "000001@g1ta000001.xmp" - * @endcode - */ - void compose(const size_t no, const String& str); - - - // Constructor: prefix number, filename root and extension, mainly for selfiles.. - /** Prefix with number and extension @. - * - * @code - * fn_proj.compose(1, "g1ta", "xmp"); // fn_proj = "000001@g1ta000001.xmp" - * @endcode - */ - void compose(size_t no , const String &str , const String &ext); - - // Constructor: string and filename, mainly for metadata blocks.. - /** Prefix with string (blockname) . - * - * @code - * fn_proj.compose(b00001, "g1ta.xmp"); // fn_proj = "b000001@g1ta.xmp" - * @endcode - */ - void compose(const String &blockName , const String &str); - - /** Constructor: string, number, rootfilename and extension: - * mainly for numered metadata blocks.. - * - * @code - * fn_proj.composeBlock("bb",5, "g1ta","xmp"); // fn_proj = "bb000005@g1ta.xmp" - * fn_proj.composeBlock("bb",5, "g1ta.xmp"); // fn_proj = "bb000005@g1ta.xmp" - * @endcode - */ - void composeBlock(const String &blockName, size_t no, const String &str, const String &ext=""); - - - /** True if this filename belongs to a stack - */ - bool isInStack() const; - - /** Decompose filenames with @. Mainly from selfiles - * - * @code - * fn_proj.decompose(no,filename); // fn_proj = "000001@g1ta000001.xmp" - * // no=1 - * // filename = "g1ta000001.xmp" - * @endcode - */ - void decompose(size_t &no, String& str) const; - - /** Get decomposed filename from filenames with @. Mainly from selfiles - * - * @code - * filename = fn_proj.decomposedFileName(); // fn_proj = "000001@g1ta000001.xmp" - * // no=1 - * // filename = "g1ta000001.xmp" - * @endcode - */ - FileName getDecomposedFileName() const; - - /** Get the root from a filename - * - * @code - * FileName fn_root, fn_proj("g1ta00001"); - * fn_root = fn_proj.get_root(); - * @endcode - */ - FileName getRoot() const; - - /** Get the base name from a filename - */ - FileName getBaseName() const; - - /** Get the number from a filename - * - * If there is no number a -1 is returned. - * - * @code - * FileName proj("g1ta00001"); - * int num = proj.getNumber(); - * @endcode - */ - int getNumber() const; - - /** Get the number from a stack filename - * - * If there is no number a 0 is returned. - * - * @code - * FileName proj("24@images.stk"); - * size_t num = proj.getStackNumber(); - * @endcode - */ - size_t getPrefixNumber(size_t pos = 0) const; - - FileName getDir() const; - - /** Get the last extension from filename - * - * The extension is returned without the dot. If there is no extension "" is - * returned. - * - * @code - * String ext = fn_proj.get_extension(); - * @endcode - */ - String getExtension() const; - - /** Get image format identifier - * - * @code - * fn_proj = "g1ta00001.xmp"; - * fn_proj = fn_proj.get_file_format(); // fn_proj == "xmp" - * fn_proj = "g1ta00001.nor:spi"; - * fn_proj = fn_proj.get_file_format(); // fn_proj == "spi" - * fn_proj = "input.file#120,120,55,1024,float"; - * fn_proj = fn_proj.get_file_format(); // fn_proj == "raw" - * @endcode - */ - String getFileFormat() const; - - /** True if the extension of this filename is of an image type - */ - bool hasImageExtension() const; - - /** True if the extension of this filename is of a stack type - */ - bool hasStackExtension() const; - - /** True if the extension of this filename is of a stack type - */ - bool hasVolumeExtension() const; - - /** True if the extension of this filename is of a metadata file - */ - bool hasMetadataExtension() const; - - /** Get the size of the file. - */ - size_t getFileSize() const; - - - /** Get blockName from filename - * @code - * fn_meta="block1@md1.doc" - * String blockName; - * blockName=fn_meta.getblockName();//blockName="block1" - * @endcode - */ - - String getBlockName() const; - - /** Remove leading number from filename - * @code - * fn_meta="1@md1.doc" - * String blockName; - * filename=fn_meta.removeSliceNumber();//filename="md1.doc" - * @endcode - */ - - FileName removePrefixNumber() const; - - /** Remove blockName from filename - * @code - * fn_meta="block1@md1.doc" - * String blockName; - * filename=fn_meta.getblockName();//filename="md1.doc" - * @endcode - */ - - FileName removeBlockName() const; - - /** Remove blockName or slice number from filename - * @code - * fn_meta="block1@md1.doc" - * String blockName; - * filename=removeBlockNameOrSliceNumber();//filename="md1.doc" - * @endcode - */ - FileName removeAllPrefixes() const; - - /** Random name - * - * Generate a random name of the desired length. - */ - void initRandom(int length); - - /** Unique name - * - * Generate a unique name replacing each 'X' with a character from - * the portable filename character set. The characters are chosen such - * that the resulting name does not duplicate the name of an existing file. - */ - void initUniqueName(const char * templateStr = "xmippTemp_XXXXXX", const String &fnDir=""); - //@} - - ///@name Filename utilities - //@{ - /** Change all characters for lowercases - * - * @code - * FileName fn_proj("g1tA00001"); - * fn_proj = fn_proj.to_lowercase(); // fn_proj = "g1ta00001" - * @endcode - */ - FileName toLowercase() const; - - /** Change all characters for uppercases - * - * @code - * FileName fn_proj("g1tA00001"); - * fn_proj = fn_proj.to_uppercase(); // fn_proj = "G1Ta00001" - * @endcode - */ - FileName toUppercase() const; - - /** Check whether the filename contains the argument substring - * - * @code - * FileName fn_proj("g1ta00001.raw#d=f"); - * if (fn_proj.contains("raw) ) // true - * @endcode - */ - bool contains(const String& str) const; - - /** Return substring before first instance of argument (as in Bsoft) - * - * @code - * FileName fn_proj("g1ta00001.raw#d=f"); - * fn_proj = fn_proj.before_first_of("#"); // fn_proj = "g1ta00001.raw" - * @endcode - */ - FileName beforeFirstOf(const String& str) const; - - /** Return substring before last instance of argument (as in Bsoft) - * - * @code - * FileName fn_proj("g1ta00001.raw#d=f"); - * fn_proj = fn_proj.before_last_of("#"); // fn_proj = "g1ta00001.raw" - * @endcode - */ - FileName beforeLastOf(const String& str) const; - - /** Return substring after first instance of argument (as in Bsoft) - * - * @code - * FileName fn_proj("g1ta00001.raw#d=f"); - * fn_proj = fn_proj.after_first_of("#"); // fn_proj = "d=f" - * @endcode - */ - FileName afterFirstOf(const String& str) const; - - /** Return substring after last instance of argument (as in Bsoft) - * - * @code - * FileName fn_proj("g1ta00001.raw#d=f"); - * fn_proj = fn_proj.after_last_of("#"); // fn_proj = "d=f" - * @endcode - */ - FileName afterLastOf(const String& str) const; - - /** Add string at the beginning - * - * If there is a path then the prefix is added after the path. - * - * @code - * fn_proj = "imgs/g1ta00001"; - * fn_proj.add_prefix("h"); // fn_proj == "imgs/hg1ta00001" - * - * fn_proj = "g1ta00001"; - * fn_proj.add_prefix("h"); // fn_proj == "hg1ta00001" - * @endcode - */ - FileName addPrefix(const String& prefix) const; - - /** Add extension at the end. - * - * The "." is added. If the input extension is "" then the same name is - * returned, with nothing added. - * - * @code - * fn_proj = "g1ta00001"; - * fn_proj.add_extension("xmp"); // fn_proj == "g1ta00001.xmp" - * @endcode - */ - FileName addExtension(const String& ext) const; - - /** Remove last extension, if any - * - * @code - * fn_proj = "g1ta00001.xmp"; - * fn_proj = fn_proj.without_extension(); // fn_proj == "g1ta00001" - * - * fn_proj = "g1ta00001"; - * fn_proj = fn_proj.without_extension(); // fn_proj == "g1ta00001" - * @endcode - */ - FileName withoutExtension() const; - - /** Remove the root - * - * @code - * fn_proj = "g1ta00001.xmp"; - * fn_proj = fn_proj.without_root(); // fn_proj == "00001.xmp" - * - * fn_proj = "g1ta00001"; - * fn_proj = fn_proj.without_root(); // fn_proj == "00001" - * @endcode - */ - FileName withoutRoot() const; - - /** Insert before first extension - * - * If there is no extension, the insertion is performed at the end. - * - * @code - * fn_proj = "g1ta00001.xmp"; - * fn_proj = fn_proj.insert_before_extension("pp"); - * // fn_proj == "g1ta00001pp.xmp" - * - * fn_proj = "g1ta00001"; - * fn_proj = fn_proj.insert_before_extension("pp"); - * // fn_proj=="g1ta00001pp" - * @endcode - */ - FileName insertBeforeExtension(const String& str) const; - - /** Remove a certain extension - * - * It doesn't matter if there are several extensions and the one to be - * removed is in the middle. If the given extension is not present in the - * filename nothing is done. - * - * @code - * fn_proj = "g1ta00001.xmp.bak"; - * fn_proj = fn_proj.remove_extension("xmp"); - * // fn_proj == "g1ta00001.bak" - * @endcode - */ - FileName removeExtension(const String& ext) const; - - FileName removeLastExtension() const; - - - /**Extract the directory portion from a filename string - * (e.g. /foo/bar.txt -> /foo). - * - */ - FileName removeFilename() const; - - /** Remove all extensions - */ - FileName removeAllExtensions() const; - - /** Remove file format - * @code - * fn_proj = "g1ta00001.xmp"; - * fn_proj = fn_proj.get_file_format(); // fn_proj == "xmp" - * fn_proj = "g1ta00001.nor:spi"; - * fn_proj = fn_proj.get_file_format(); // fn_proj == "spi" - * fn_proj = "input.file#d=f#x=120,120,55#h=1024"; - * fn_proj = fn_proj.get_file_format(); // fn_proj == "raw" - * @endcode - */ - FileName removeFileFormat() const; - - /** Is this file a MetaData file? - * Returns true if the get_file_format extension == "sel", "doc" or "xmd" - * Otherwise, the file is opened and checked for the occurrence of "XMIPP_3 *" in its first line - */ - bool isMetaData(bool failIfNotExists=true) const; - - /** True if it is a Star 1 file. */ - bool isStar1(bool failIfNotExists) const; - - /** Replace a the first occurrence of substring 'subOld' by 'subNew' - * If 'subOld' not present, not changes are done. - * The search is done from left to right - * - * @code - * fn_proj = "g1ta00001.xmp.bak"; - * fn_proj = fn_proj.replace(".xmp", ".bor"); - * // fn_proj == "g1ta00001.bor.bak" - * - * fn_proj = "g1ta00001.xmp.bak"; - * fn_proj = fn_proj.replace(".bor", ""); - * // fn_proj == "g1ta00001.bak" - * @endcode - * */ - FileName replaceSubstring(const String& subOld, const String& subNew) const; - - /** Replace all occurrences of a character by another character */ - FileName replaceCharacter(char oldChar, char newChar) const; - - /** Substitute last extension by a new one - * - * @code - * fn_proj = "g1ta00001.xmp.bak"; - * fn_proj = fn_proj.replaceExtension("bor"); - * // fn_proj == "g1ta00001.xmp.bor" - * @endcode - */ - FileName replaceExtension(const String& newExt) const; - - /** Remove a substring from the filename - * - * If the substring is not present the same FileName is returned, if it is - * there the substring is removed. - * It is equivalent to replaceSubstring(sub, ""); - */ - FileName removeSubstring(const String& sub) const; - - /** Remove until prefix - * - * Remove the starting string until the given prefix, inclusively. For - * instance /usr/local/data/ctf-image00001.fft with ctf- yields - * image00001.fft. If the prefix is not found nothing is done. - */ - FileName removeUntilPrefix(const String& prefix) const; - - /** Remove all directories - * - * Or if keep>0, then keep the lowest keep directories - */ - FileName removeDirectories(int keep = 0) const; - /**copy one file - */ - void copyFile(const FileName & target) const; - - // This function is in funcs, cannot be here because need metadata_generic and metadata_generic - // need filename - // /* Copy one image - // * - // */ - // void copyImage(const FileName & target) const; - - /** True if the filename exists, check from current directory if is relative - * - * @code - * FileName fn("g1ta0001"); - * if (fn.exists()) - * std::cout << "The file exists" << std::endl; - * @endcode - */ - bool exists() const; - - /** Delete the file if exists */ - void deleteFile() const; - - /** True if the file exists in the current directory - * Remove leading xx@ and tailing :xx - * - * @code - * if (exists("g1ta00001")) - * std::cout << "The file exists" << std::endl; - * @endcode - */ - bool existsTrim() const; - - /** True if the path is a directory */ - bool isDir() const; - - /** Return the list of files if this filename is a directory*/ - void getFiles(std::vector &files) const; - - /** Waits until the given filename has a stable size - * - * The stable size is defined as having the same size within two samples - * separated by time_step (microsecs). - * - * An exception is throw if the file exists but its size cannot be stated. - */ - void waitUntilStableSize(size_t time_step = 250000); - - /** Write a zero filled file with the desired size. - * - * The file is written by blocks to speed up, you can modify the block size. - * An exception is thrown if any error happens - */ - void createEmptyFile(size_t size, size_t block_size = 102400); - - /** Create empty file with a given length. */ - void createEmptyFileWithGivenLength(size_t length = 0) const; - - /** - * makePath - ensure all directories in path exist - * Algorithm takes the pessimistic view and works top-down to ensure - * each directory in path exists, rather than optimistically creating - * the last element and working backwards. Return null if fails - */ - int makePath(mode_t mode = 0755) const; - - /** This function raised an ERROR if the filename if not empty and if - * the corresponding file does not exist. - * This may be useful to have a better (killing) control on (mpi-regulated) jobs - * - * @code - * exit_if_not_exists("control_file.txt"); - * @endcode - * - * This function is not ported to Python. - */ - void assertExists(); - //@} -}; - -/** Returns the base directory of the Xmipp installation - */ -char* getXmippPath(); - -/** Returns the source directory of Xmipp - */ -char* getXmippSrcPath(); - -/** Check if the file exists using the stat function - */ -inline bool fileExists( const char *filename ) -{ - // do not use stat since updates the atime flag. This may be dangerous - // for mpi processes in which the same file is accessed many times - // from different computers even if not writting is made - //return ( stat(filename, &buffer) == 0 ? true : false ); - return ( access (filename, F_OK) == 0 ? true : false); - -} - -/** Check if the file exists using the stat function - */ -inline bool fileExists( const FileName &filename ) -{ - return fileExists(filename.c_str()); -} - -/** Copy one image - */ -void copyImage(const FileName & source,const FileName & target); - -/** Delete file - */ -void deleteFile(const FileName &fn); - -//Functions to make easy to change the magicWord used to identify the -//file format of metadata -extern String FileNameVersion; -void setMetadataVersion(String version); -String getMetadataVersion(void); - -/** This class is used for comparing filenames. - * - * Example: "g0ta00001.xmp" is less than "g0ta00002.xmp" - * - * This class is needed to define a std::map as - * map myMap; - * - * This function is not ported to Python. - */ -class FileNameComparison -{ -public: - inline bool operator ()(const FileName &fn1, const FileName &fn2) - { - return fn1filenum = fileno; - } - - /// Lock file - void lock(int fileno = 0); - void lock(FILE* file); - - ///Unlock - void unlock(); - -}; - -//@} - -#endif /* FILENAME_H_ */ diff --git a/src/core/xmipp_funcs.cpp b/src/core/xmipp_funcs.cpp deleted file mode 100644 index de7a5d6..0000000 --- a/src/core/xmipp_funcs.cpp +++ /dev/null @@ -1,1194 +0,0 @@ -/*************************************************************************** - * - * Authors: Carlos Oscar S. Sorzano (coss@cnb.csic.es) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -//#include -//#include -#include -#include -#include -#include -#include -//#include -#include "xmipp_funcs.h" -#include "numerical_recipes.h" -#include "xmipp_filename.h" - -//#include -//#include "xmipp_error.h" -//#include - -#ifndef __MINGW32__ - #include - #ifdef __MACH__ - #include - #include - #endif -#endif - - -/* Numerical functions ----------------------------------------------------- */ -// Kaiser-Bessel constructor -KaiserBessel::KaiserBessel(double alpha_, int K_, double r_, double v_, - int N_, double vtable_, int ntable_) - : alpha(alpha_), v(v_), r(r_), N(N_), K(K_), vtable(vtable_), - ntable(ntable_) -{ - // Default values are alpha=1.25, K=6, r=0.5, v = K/2 - if (0.f == v) - v = double(K)/2; - if (0.f == vtable) - vtable = v; - alphar = alpha*r; - fac = static_cast(2.*PI)*alphar*v; - vadjust = 1.0f*v; - facadj = static_cast(2.*PI)*alphar*vadjust; - build_I0table(); -} - -// Kaiser-Bessel I0 selfWindow function -double KaiserBessel::i0win(double x) const -{ - double val0 = double(bessi0(facadj)); - double absx = fabs(x); - if (absx > vadjust) - return 0.f; - double rt = sqrt(1.f - pow(absx/vadjust, 2)); - double res = bessi0(facadj*rt)/val0; - return res; -} - -// Tabulate I0 selfWindow for speed -void KaiserBessel::build_I0table() -{ - i0table.resize(ntable+1); // i0table[0:ntable] - int ltab = int(ROUND(double(ntable)/1.25f)); - fltb = double(ltab)/(K/2); - //double val0 = gsl_sf_bessel_I0(facadj); - double val0 = bessi0(facadj); - for (int i=ltab+1; i <= ntable; i++) - i0table[i] = 0.f; - for (int i=0; i <= ltab; i++) - { - double s = double(i)/fltb/N; - if (s < vadjust) - { - double rt = sqrt(1.f - pow(s/vadjust, 2)); - //i0table[i] = gsl_sf_bessel_I0(facadj*rt)/val0; - i0table[i] = bessi0(facadj*rt)/val0; - } - else - { - i0table[i] = 0.f; - } - } -} - -// Compute the maximum error in the table -double KaiserBessel::I0table_maxerror() -{ - double maxdiff = 0.f; - for (int i = 1; i <= ntable; i++) - { - double diff = fabs(i0table[i] - i0table[i-1]); - if (diff > maxdiff) - maxdiff = diff; - } - return maxdiff; -} - -// Kaiser-Bessel Sinh selfWindow function -double KaiserBessel::sinhwin(double x) const -{ - double val0 = sinh(fac)/fac; - double absx = fabs(x); - if (0.0 == x) - { - double res = 1.0f; - return res; - } - else if (absx == alphar) - { - return 1.0f/val0; - } - else if (absx < alphar) - { - double rt = sqrt(1.0f - pow((x/alphar), 2)); - double facrt = fac*rt; - double res = (sinh(facrt)/facrt)/val0; - return res; - } - else - { - double rt = sqrt(pow((x/alphar),2) - 1.f); - double facrt = fac*rt; - double res = (sin(facrt)/facrt)/val0; - return res; - } -} - - -// Solve second degree equation. ax^2+bx+c=0 ------------------------------- -int solve_2nd_degree_eq(double a, double b, double c, double &x1, double &x2, - double prec) -{ - // Degenerate case? - if (fabs(a) < prec) - { - if (fabs(b) < prec) - return -1; - else - { - x1 = -c / b; - return 1; - } - } - - // Normal case - double d = b * b - 4 * a * c; - if (d < 0) - return 0; - else - { - x1 = (-b + sqrt(d)) / (2 * a); - x2 = (-b - sqrt(d)) / (2 * a); - return 2; - } -} - -/* Gaussian value ---------------------------------------------------------- */ -double gaussian1D(double x, double sigma, double mu) -{ - x -= mu; - return 1 / sqrt(2*PI*sigma*sigma)*exp(-0.5*((x / sigma)*(x / sigma))); -} - -/* t-student value -------------------------------------------------------- */ -double tstudent1D(double x, double df, double sigma, double mu) -{ - x -= mu; - double norm = exp(gammln((df+1.)/2.)) / exp(gammln(df/2.)); - norm /= sqrt(df*PI*sigma*sigma); - return norm * pow((1 + (x/sigma)*(x/sigma)/df),-((df+1.)/2.)); - -} - -double gaussian2D(double x, double y, double sigmaX, double sigmaY, - double ang, double muX, double muY) -{ - // Express x,y in the gaussian internal coordinates - x -= muX; - y -= muY; - double xp = cos(ang) * x + sin(ang) * y; - double yp = -sin(ang) * x + cos(ang) * y; - - // Now evaluate - return 1 / sqrt(2*PI*sigmaX*sigmaY)*exp(-0.5*((xp / sigmaX)*(xp / sigmaX) + - (yp / sigmaY)*(yp / sigmaY))); -} - -/* ICDF Gaussian ----------------------------------------------------------- */ -double icdf_gauss(double p) -{ - const double c[] = - { - 2.515517, 0.802853, 0.010328 - }; - const double d[] = - { - 1.432788, 0.189269, 0.001308 - }; - if (p < 0.5) - { - // F^-1(p) = - G^-1(p) - double t=sqrt(-2.0*log(p)); - double z=t - ((c[2]*t + c[1])*t + c[0]) / - (((d[2]*t + d[1])*t + d[0])*t + 1.0); - return -z; - } - else - { - // F^-1(p) = G^-1(1-p) - double t=sqrt(-2.0*log(1-p)); - double z=t - ((c[2]*t + c[1])*t + c[0]) / - (((d[2]*t + d[1])*t + d[0])*t + 1.0); - return z; - } -} - -/* CDF Gaussian ------------------------------------------------------------ */ -double cdf_gauss(double x) -{ - return 0.5 * (1. + erf(x/sqrt(2.))); -} - -/************************************************************************* -Student's t distribution - -Computes the integral from minus infinity to t of the Student -t distribution with integer k > 0 degrees of freedom: - - t - - - | | - - | 2 -(k+1)/2 - | ( (k+1)/2 ) | ( x ) - ---------------------- | ( 1 + --- ) dx - - | ( k ) - sqrt( k pi ) | ( k/2 ) | - | | - - - -inf. - -Relation to incomplete beta integral: - - 1 - stdtr(k,t) = 0.5 * incbet( k/2, 1/2, z ) -where - z = k/(k + t**2). - -For t < -2, this is the method of computation. For higher t, -a direct method is derived from integration by parts. -Since the function is symmetric about t=0, the area under the -right tail of the density is found by calling the function -with -t instead of t. - -ACCURACY: - -Tested at random 1 <= k <= 25. The "domain" refers to t. - Relative error: -arithmetic domain # trials peak rms - IEEE -100,-2 50000 5.9e-15 1.4e-15 - IEEE -2,100 500000 2.7e-15 4.9e-17 - -Cephes Math Library Release 2.8: June, 2000 -Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier -*************************************************************************/ -double cdf_tstudent(int k, double t) -{ - double EPS=5E-16; - double result; - double x; - double rk; - double z; - double f; - double tz; - double p; - double xsqk; - int j; - - if ( t==0 ) - { - result = 0.5; - return result; - } - if ( t<-2.0 ) - { - rk = k; - z = rk/(rk+t*t); - result = 0.5*betai(0.5*rk, 0.5, z); - return result; - } - if ( t<0 ) - { - x = -t; - } - else - { - x = t; - } - rk = k; - z = 1.0+x*x/rk; - if ( k%2 != 0 ) - { - xsqk = x/sqrt(rk); - p = atan(xsqk); - if ( k > 1 ) - { - f = 1.0; - tz = 1.0; - j = 3; - while ( j <= k-2 && tz/f > EPS ) - { - tz = tz*((j-1)/(z*j)); - f = f+tz; - j = j+2; - } - p = p+f*xsqk/z; - } - p = p*2.0/PI; - } - else - { - f = 1.0; - tz = 1.0; - j = 2; - while ( j<= k-2 && tz/f > EPS) - { - tz = tz*((j-1)/(z*j)); - f = f+tz; - j = j+2; - } - p = f*x/sqrt(z*rk); - } - if ( t<0 ) - { - p = -p; - } - result = 0.5+0.5*p; - return result; -} - -/* Snedecor's F ------------------------------------------------------------ */ -// http://en.wikipedia.org/wiki/F-distribution -double cdf_FSnedecor(int d1, int d2, double x) -{ - return betai(0.5*d1,0.5*d2,(d1*x)/(d1*x+d2)); -} - -double icdf_FSnedecor(int d1, int d2, double p) -{ - double xl=0, xr=1e6; - double xm, pm; - do - { - xm=(xl+xr)*0.5; - pm=cdf_FSnedecor(d1,d2,xm); - if (pm>p) - { - xr=xm; - } - else - { - xl=xm; - } - } - while (fabs(pm-p)/p>0.001); - return xm; -} - -/* Random functions -------------------------------------------------------- */ -int idum; - -// Uniform distribution .................................................... -void init_random_generator(int seed) -{ - idum = -1; - ran1(&idum); - if (seed != -1) - { - // Prevent seeds larger than 65000 - seed %=0xffff; - for (int i = 0; i < seed; i++) - ran1(&idum); - } -} - -unsigned int randomize_random_generator() -{ - static unsigned int seed; - int rand_return; - struct timespec highresTime; - -#ifdef __MACH__ // OS X does not have clock_gettime, use clock_get_time - - clock_serv_t cclock; - mach_timespec_t mts; - host_get_clock_service(mach_host_self(), CALENDAR_CLOCK, &cclock); - clock_get_time(cclock, &mts); - mach_port_deallocate(mach_task_self(), cclock); - highresTime.tv_sec = mts.tv_sec; - highresTime.tv_nsec = mts.tv_nsec; -#else - - clock_gettime(CLOCK_REALTIME, &highresTime); -#endif - - srand(rand()+clock()+time(NULL)+highresTime.tv_nsec); - rand_return = rand(); - - time_t t; - time(&t); - //rand_return = abs(rand_return); - idum = (-(int)(t % 10000) - - (int)(rand_return % 10000)); - ran1(&idum); - seed = (unsigned int)rand_return; - return seed; -} - -double rnd_unif() -{ - return ran1(&idum); -} -double rnd_unif(double a, double b) -{ - if (a == b) - return a; - else - return a + (b - a)*ran1(&idum); -} - -// t-distribution -double rnd_student_t(double nu) -{ - return tdev(nu, &idum); -} -double rnd_student_t(double nu, double a, double b) -{ - if (b == 0) - return a; - else - return b*tdev(nu, &idum) + a; -} - -// Gaussian distribution ................................................... -double rnd_gaus() -{ - return gasdev(&idum); -} -double rnd_gaus(double a, double b) -{ - if (b == 0) - return a; - else - return b*gasdev(&idum) + a; -} -double gaus_within_x0(double x0, double mean, double stddev) -{ - double z0 = (x0 - mean) / stddev; - return erf(ABS(z0) / sqrt(2.0)); -} - -double gaus_outside_x0(double x0, double mean, double stddev) -{ - double z0 = (x0 - mean) / stddev; - return erfc(ABS(z0) / sqrt(2.0)); -} - -double gaus_up_to_x0(double x0, double mean, double stddev) -{ - if (x0 > mean) - return 1.0 -gaus_outside_x0(x0, mean, stddev) / 2; - else if (x0 == mean) - return 0.5; - else - return gaus_outside_x0(x0, mean, stddev) / 2; -} - -double gaus_from_x0(double x0, double mean, double stddev) -{ - if (x0 > mean) - return gaus_outside_x0(x0, mean, stddev) / 2; - else if (x0 == mean) - return 0.5; - else - return 1.0 -gaus_outside_x0(x0, mean, stddev) / 2; -} - -double gaus_outside_probb(double p, double mean, double stddev) -{ - // Make a Bolzano search for the right value - double pm, x1, x2, xm; - x1 = mean; - x2 = mean + 5 * stddev; - do - { - xm = (x1 + x2) / 2; - pm = gaus_outside_x0(xm, mean, stddev); - if (pm > p) - x1 = xm; - else - x2 = xm; - } - while (ABS(pm - p) / p > 0.005); - return xm; -} - -// See Numerical Recipes, Chap. 6.3 -double student_within_t0(double t0, double degrees_of_freedom) -{ - return 1 -betai(degrees_of_freedom / 2, 0.5, - degrees_of_freedom / (degrees_of_freedom + t0*t0)); -} - -double student_outside_t0(double t0, double degrees_of_freedom) -{ - return 1 -student_within_t0(t0, degrees_of_freedom); -} - -double student_up_to_t0(double t0, double degrees_of_freedom) -{ - if (t0 >= 0) - return 1.0 -student_outside_t0(t0, degrees_of_freedom) / 2; - else - return student_outside_t0(t0, degrees_of_freedom) / 2; -} - -double student_from_t0(double t0, double degrees_of_freedom) -{ - return 1 -student_up_to_t0(t0, degrees_of_freedom); -} - -double student_outside_probb(double p, double degrees_of_freedom) -{ - // Make a Bolzano search for the right value - double pm, t1, t2, tm; - t1 = 0; - t2 = 100; - do - { - tm = (t1 + t2) / 2; - pm = student_outside_t0(tm, degrees_of_freedom); - if (pm > p) - t1 = tm; - else - t2 = tm; - } - while (fabs(pm - p) / p > 0.005); - return tm; -} - -double chi2_up_to_t0(double t0, double degrees_of_freedom) -{ - return gammp(degrees_of_freedom / 2, t0 / 2); -} - -double chi2_from_t0(double t0, double degrees_of_freedom) -{ - return 1 -chi2_up_to_t0(t0, degrees_of_freedom); -} - -// Log uniform distribution ................................................ -double rnd_log(double a, double b) -{ - if (a == b) - return a; - else - return exp(rnd_unif(log(a), log(b))); -} - -/* Time managing ----------------------------------------------------------- */ -#ifdef _NO_TIME -void time_config() -{} -void annotate_time(ProcessorTimeStamp *time) -{} -void print_elapsed_time(ProcessorTimeStamp &time) -{} -double elapsed_time(ProcessorTimeStamp &time) -{} -double time_to_go(ProcessorTimeStamp &time, double fraction_done) -{} -void TimeMessage(const std::string &message) -{} -void progress_bar(long rlen) -{} -#else -#if defined __MINGW32__ || defined __APPLE__ -struct tm* localtime_r (const time_t *clock, struct tm *result) -{ - if (!clock || !result) - return NULL; - memcpy(result,localtime(clock),sizeof(*result)); - return result; -} -void sin_cos(double angle, double * sine, double * cosine) -{ - *sine = sin(angle); - *cosine = cos(angle); -} -#endif - -// A global ................................................................ -int XmippTICKS; - -// Time configuration ...................................................... -// The clock frequency for each machine must be known -void time_config() -{ -#ifndef __MINGW32__ - XmippTICKS = sysconf(_SC_CLK_TCK); -#else - - XmippTICKS = CLK_TCK; -#endif -} - -#if !defined _NO_TIME && !defined __MINGW32__ -// Annotate actual time .................................................... -void annotate_processor_time(ProcessorTimeStamp *time) -{ - times(time); -} -#endif - -void annotate_time(TimeStamp *time) -{ - struct timeval tv; - gettimeofday(&tv, NULL); - struct tm tm; - localtime_r(&tv.tv_sec,&tm); - *time = tm.tm_hour * 3600 * 1000 + tm.tm_min * 60 * 1000 + tm.tm_sec * 1000 + - tv.tv_usec / 1000; -} - -#if !defined _NO_TIME && !defined __MINGW32__ -// Acumulative time -void acum_time(ProcessorTimeStamp *orig, ProcessorTimeStamp *dest) -{ - ProcessorTimeStamp now; - times(&now); - (*dest).tms_utime += (*dest).tms_utime + (now.tms_utime - (*orig).tms_utime); - (*dest).tms_stime += (*dest).tms_stime + (now.tms_utime - (*orig).tms_utime); -} -#endif - -#if !defined _NO_TIME && !defined __MINGW32__ -// Show elapsed time since last annotation ................................. -void print_elapsed_time(ProcessorTimeStamp &time, bool _IN_SECS) -{ - ProcessorTimeStamp now; - times(&now); - double userTime = now.tms_utime - time.tms_utime; - double sysTime = now.tms_stime - time.tms_stime; - if (_IN_SECS) - { - userTime /= XmippTICKS; - sysTime /= XmippTICKS; - } - std::cout << "Elapsed time: User(" << userTime << ") System(" << sysTime - << ")\n"; -} -#endif - -void print_elapsed_time(TimeStamp& time, bool _IN_SECS) -{ - struct timeval tv; - gettimeofday(&tv, NULL); - struct tm tm; - localtime_r(&tv.tv_sec,&tm); - TimeStamp now = tm.tm_hour * 3600 * 1000 + tm.tm_min * 60 * 1000 + tm.tm_sec * 1000 + - tv.tv_usec / 1000; - TimeStamp diff=now-time; - - std::cout << "Elapsed time: "; - if (_IN_SECS) - std::cout << diff/1000.0 << " secs." << std::endl; - else - std::cout << diff << " msecs." << std::endl; -} - -size_t Timer::now() -{ - gettimeofday(&tv, NULL); - localtime_r(&tv.tv_sec,&tm); - return tm.tm_hour * 3600 * 1000 + tm.tm_min * 60 * 1000 + tm.tm_sec * 1000 + - tv.tv_usec / 1000; -} - -size_t Timer::tic() -{ - tic_time = now(); - return tic_time; -} - -size_t Timer::toc(const char * msg, bool inSecs) -{ - size_t diff = elapsed(); - - if (msg != NULL) - std::cout << msg; - std::cout << "Elapsed time: "; - - if (inSecs) - std::cout << diff/1000.0 << " secs." << std::endl; - else - std::cout << diff << " msecs." << std::endl; - - return diff; -} - -size_t Timer::elapsed() -{ - return now() - tic_time; -} - - -// Calculate elapsed time since last annotation ............................. -double elapsed_time(ProcessorTimeStamp &time, bool _IN_SECS) -{ -#if !defined _NO_TIME && !defined __MINGW32__ - ProcessorTimeStamp now; - times(&now); - double userTime = now.tms_utime - time.tms_utime; - double sysTime = now.tms_stime - time.tms_stime; - if (_IN_SECS) - { - userTime /= XmippTICKS; - sysTime /= XmippTICKS; - } - return userTime + sysTime; -#endif -} - -#if !defined _NO_TIME && !defined __MINGW32__ -// Compute the predicted time left ......................................... -double time_to_go(ProcessorTimeStamp &time, double fraction_done) -{ - ProcessorTimeStamp now; - times(&now); - double totalTime = (now.tms_utime - time.tms_utime + - now.tms_stime - time.tms_stime) / XmippTICKS; - return totalTime*(1 - fraction_done) / fraction_done; -} -#endif - -// Show a message with the time it is produced ............................. -void TimeMessage(const std::string & message) -{ - struct tm *T; - time_t seconds; - - if (time(&seconds) < 0) - seconds = 0; - T = localtime(&seconds); - - printf("%2d:%2d:%2d (day=%2d) =>%s ", T->tm_hour, - T->tm_min, T->tm_sec, T->tm_mday, message.c_str()); -} - -// Init progress bar -void init_progress_bar(long total) -{ - progress_bar(-(total)); -} - -// Show a bar with the progress in time .................................... -// When the input is negative then we are setting the progress bar, this -// will be the total of elements to process. Afterwards the call to this -// routine must be in ascending order, ie, 0, 1, 2, ... No. elements -void progress_bar(long rlen) -{ - static time_t startt; - time_t currt; - static long totlen; - long t1, t2; - int min, i, hour; - double h1, h2, m1, m2; - bool queue = (getenv("XMIPP_IN_QUEUE") != NULL); - - if (rlen == 0) - return; - currt = time(NULL); - - if (rlen < 0) - { - totlen = -rlen; - startt = currt; - fprintf(stdout, "0000/???? sec. "); - if (!queue) - for (i = 0; i < 10; i++) - fprintf(stdout, "------"); - fflush(stdout); - } - else if (totlen > 0) - { - t1 = currt - startt; // Elapsed time - t2 = (long)(t1 * (double)totlen / rlen); // Total time - - hour = 0; - min = 0; - if (t2 > 60) - { - m1 = (double)t1 / 60.0; - m2 = (double)t2 / 60.0; - min = 1; - if (m2 > 60) - { - h1 = (double)m1 / 60.0; - h2 = (double)m2 / 60.0; - hour = 1; - min = 0; - } - else - hour = 0; - } - - if (hour) - fprintf(stdout, "\r%3.2f/%3.2f %s ", h1, h2, "hours"); - else if (min) - fprintf(stdout, "\r%3.2f/%3.2f %s ", m1, m2, "min"); - else - fprintf(stdout, "\r%4u/%4u %4s ", (int)t1, (int)t2, "sec."); - - if (!queue) - { - i = (int)(60 * (1 - (double)(totlen - rlen) / totlen)); - while (i--) - fprintf(stdout, "."); - } - - if (rlen == totlen) - { - fprintf(stdout, "\n"); - totlen = 0; - } - fflush(stdout); - } -} - -char * getCurrentTimeString() -{ - time_t rawtime; - time ( &rawtime ); - char * str = ctime (&rawtime); - char * pos = strrchr(str, '\n'); - pos[0] = '\0'; //Remove \n end character - return str; - -} - -// Initialize progress bar. - -void TextualListener::OnInitOperation(unsigned long _est_it) -{ - progress_bar(-static_cast(_est_it)); -} - -// Show a bar with the progress in time .................................... -// When the input is negative then we are setting the progress bar, this -// will be the total of elements to process. Afterwards the call to this -// routine must be in ascending order, ie, 0, 1, 2, ... No. elements -// Almost identical to previous progress bar function, in fact, we call -// those functions inside. - -void TextualListener::OnProgress(unsigned long _it) -{ - progress_bar(_it); -} - -// Shows a message indicating the operation in progress. -void TextualListener::OnReportOperation(const std::string& _rsOp) -{ - fprintf(stderr, "%s", _rsOp.c_str());// std::cout << _rsOp; -} - - -#endif - -/* Little/big endian ------------------------------------------------------- */ -// Read in reverse/normal order -------------------------------------------- -size_t xmippFREAD(void *dest, size_t size, size_t nitems, FILE * &fp, bool reverse) -{ - size_t retval; - if (!reverse) - retval = fread(dest, size, nitems, fp); - else - { - char *ptr = (char *)dest; - bool end = false; - retval = 0; - for (size_t n = 0; n < nitems; n++) - { - char * ptrp = ptr + size - 1; - for (size_t i = 0; i < size; ++i, --ptrp) - { - if (fread(ptrp, 1, 1, fp) != 1) - { - end = true; - break; - } - } - if (end) - break; - else - retval++; - ptr += size; - } - } - if (retval != nitems) - REPORT_ERROR(ERR_IO_NOREAD,"XmippFREAD: An error occurred or End of File was reached."); - - return retval; -} - -// Read in reverse/normal order -------------------------------------------- -size_t xmippFWRITE(const void *src, size_t size, size_t nitems, FILE * &fp, - bool reverse) -{ - size_t retval; - if (!reverse) - retval = fwrite(src, size, nitems, fp); - else - { - char *ptr = (char *)src; - bool end = false; - retval = 0; - for (size_t n = 0; n < nitems; n++) - { - char * ptrp = ptr + size - 1; - for (size_t i = 0; i < size; ++i, --ptrp) - { - if (fwrite(ptrp, 1, 1, fp) != 1) - { - end = true; - break; - } - } - if (end) - break; - else - retval++; - ptr += size; - } - } - return retval; -} - -/* Map file */ -void mapFile(const FileName &filename, char*&map, size_t &size, int &fileDescriptor, bool readOnly) -{ - if (size<0) - { - struct stat file_status; - if(stat(filename.c_str(), &file_status) != 0) - REPORT_ERROR(ERR_IO_NOPATH,"Cannot get filesize for file "+filename); - size = file_status.st_size; - } -#ifdef XMIPP_MMAP - struct stat file_status; - if(stat(filename.c_str(), &file_status) != 0) - REPORT_ERROR(ERR_IO_NOPATH,(String)"Cannot get filesize for file "+filename); - size = file_status.st_size; - if(size==0) - REPORT_ERROR(ERR_IO_NOPATH,(String)"File size=0, cannot read it ("+filename+")"); - - if (readOnly) - fileDescriptor = open(filename.c_str(), O_RDONLY, S_IREAD); - else - fileDescriptor = open(filename.c_str(), O_RDWR, S_IREAD | S_IWRITE); - if (fileDescriptor == -1) - REPORT_ERROR(ERR_IO_NOPATH,(String)"Cannot open file named "+filename); - - if (readOnly) - map = (char *) mmap(0, size, PROT_READ, MAP_SHARED, fileDescriptor, 0); - else - map = (char *) mmap(0, size, PROT_READ | PROT_WRITE, MAP_SHARED, fileDescriptor, 0); - if (map == MAP_FAILED) - REPORT_ERROR(ERR_MEM_BADREQUEST,"Write can not map memory "); -#else - - map = new char[size]; - fileDescriptor = open(filename.data(), O_RDONLY); - if (fileDescriptor == -1) - REPORT_ERROR(ERR_IO_NOPATH,(String)"Cannot open file named "+filename); - int ok=read(fileDescriptor,map,size); - if (ok==-1) - REPORT_ERROR(ERR_IO_NOREAD,(String)"Cannot read from file named"+filename); -#endif -} - -/* Unmap file*/ -void unmapFile(char *&map, size_t &size, int& fileDescriptor) -{ -#ifdef XMIPP_MMAP - if (munmap(map, size) == -1) - REPORT_ERROR(ERR_MEM_NOTDEALLOC,"Cannot unmap memory"); -#else - - delete []map; - map=NULL; -#endif - - close(fileDescriptor); -} - -/* Conversion little-big endian any size */ -void ByteSwap(unsigned char * b, int n) -{ - int i = 0; - int j = n - 1; - while (i < j) - { - std::swap(b[i], b[j]); - i++, j--; - } -} - -// Bsoft function -void swapbytes(char* v, unsigned long n) -{ - char t, t0, t1, t2, t3; - switch (n) - { - case 4: - t0 = v[0]; - t1 = v[1]; - v[0]=v[3]; - v[1]=v[2]; - v[2]=t1; - v[3]=t0; - break; - case 2: - t = v[0]; - v[0] = v[1]; - v[1] = t; - break; - case 1: - break; - case 8: - t0 = v[0]; - t1 = v[1]; - t2 = v[2]; - t3 = v[4]; - v[0]=v[7]; - v[1]=v[6]; - v[2]=v[5]; - v[3]=v[4]; - v[4]=t3; - v[5]=t2; - v[6]=t1; - v[7]=t0; - break; - default: - for (size_t i=0; i> pid >> comm >> state >> ppid >> pgrp >> session >> tty_nr - >> tpgid >> flags >> minflt >> cminflt >> majflt >> cmajflt - >> utime >> stime >> cutime >> cstime >> priority >> nice - >> O >> itrealvalue >> starttime >> vsize >> rss; // don't care about the rest - - stat_stream.close(); - - long page_size_kb = sysconf(_SC_PAGE_SIZE) / 1024; // in case x86-64 is configured to use 2MB pages - vm_usage = vsize / 1024.0; - resident_set = rss * page_size_kb; -} - -void printMemoryUsed() -{ - double virtualMemory, residentMemory; - processMemUsage(virtualMemory, residentMemory); - std::cout << "VM: " << virtualMemory << "kB ; RSS: " << residentMemory << " kB" << std::endl; -} - -/** Divides a number into most equally groups */ -size_t divide_equally(size_t N, size_t size, size_t rank, size_t &first, size_t &last) -{ - size_t jobs_per_worker = N / size; - size_t jobs_resting = N % size; - - if (rank < jobs_resting) - { - first = rank * (jobs_per_worker + 1); - last = first + jobs_per_worker; - } - else - { - first = rank * jobs_per_worker + jobs_resting; - last = first + jobs_per_worker - 1; - } - - return last - first + 1; -} -/** In which group from divide_equally is myself? */ -size_t divide_equally_group(size_t N, size_t size, size_t myself) -{ - size_t first, last; - for (size_t rank = 0; rank < size; rank++) - { - divide_equally(N, size, rank, first, last); - if (myself >= first && myself <= last) - return rank; - } - return -1; - -} - -/**Compare two files **/ -bool compareTwoFiles(const FileName &fn1, const FileName &fn2, size_t offset) -{ - char *map1,*map2; - int fd1, fd2; - size_t size1=-1, size2=-1; - mapFile(fn1,map1,size1,fd1,true); - mapFile(fn2,map2,size2,fd2,true); - int result=memcmp(map1+offset,map2+offset,size1-offset); - unmapFile(map1,size1,fd1); - unmapFile(map2,size2,fd2); - return (result==0); -} diff --git a/src/core/xmipp_funcs.h b/src/core/xmipp_funcs.h deleted file mode 100644 index c09ef6e..0000000 --- a/src/core/xmipp_funcs.h +++ /dev/null @@ -1,1240 +0,0 @@ -/*************************************************************************** -* -* Authors: Carlos Oscar S. Sorzano (coss@cnb.csic.es) -* -* Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC -* -* This program is free software; you can redistribute it and/or modify -* it under the terms of the GNU General Public License as published by -* the Free Software Foundation; either version 2 of the License, or -* (at your option) any later version. -* -* This program is distributed in the hope that it will be useful, -* but WITHOUT ANY WARRANTY; without even the implied warranty of -* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -* GNU General Public License for more details. -* -* You should have received a copy of the GNU General Public License -* along with this program; if not, write to the Free Software -* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA -* 02111-1307 USA -* -* All comments concerning this program package may be sent to the -* e-mail address 'xmipp@cnb.csic.es' -***************************************************************************/ - -#ifndef CORE_XMIPP_FUNCS_H -#define CORE_XMIPP_FUNCS_H - -#include -#include "xmipp_macros.h" -#include - -class FileName; - -// For timing functions -// Uncomment next line timing functions are giving problems in your system -//#define _NO_TIME -#ifndef _NO_TIME -#include -#ifndef __MINGW32__ -#include -#endif -#ifdef _IRIX65 -#include -#include -#endif -#endif - - - -/// @defgroup GeneralFunctions General functions -/// @ingroup DataLibrary -//@{ -/// @name Numerical functions -//@{ -/** Tabulated Sinc = SIN(PI*X)/(PI*X) - * - * A lookup-table with the given sampling rate and range is created. - * - * @code - * tabsinc TSINC(0.0001,64); - * if (TSINC(1)==0) - * std::cout << "This is true!\n"; - * @endcode - * - * This class is not ported to Python. - */ -class Tabsinc -{ -public: - - double sampl; - double isampl; - int xmax; - int no_elem; - double* tabulatedsinc; - -public: - /** Constructor with sampling rate and range */ - Tabsinc(const double dd, const int xx) - { - sampl = dd; - isampl = 1.0/sampl; - xmax = xx; - filltable(); - } - - // Destructor - virtual ~Tabsinc() - { - delete tabulatedsinc; - } - -#define TSINCVALUE(Tsinc, x,y) \ - { \ - int TSINCVALUEaux=(int)(x * Tsinc.isampl); \ - y=Tsinc.tabulatedsinc[ABS(TSINCVALUEaux)]; \ - } - - - /** Value access. Tabulated sine in radians */ - double operator()(double val) const - { - int aux=(int)(val * isampl); - return tabulatedsinc[ABS(aux)]; - } - - /** Actually fill the table */ - void filltable() - { - no_elem = (int)(xmax / sampl); - tabulatedsinc = new double[no_elem]; - tabulatedsinc[0] = 1; - for (int i = 1; i < no_elem; i++) - { - double xx = (double) i * sampl * PI; - tabulatedsinc[i] = sin(xx) / xx; - } - } -}; - -/** Kaiser-Bessel function - * - * This code was modified from SPARX and originally written by Pawel - * Penczek at the University of Texas - Houston Medical School - * - * see P. A. Penczek, R. Renka, and H. Schomberg, - * J. Opt. Soc. Am. _21_, 449 (2004) - * - * The I0 version can be tabulated and interpolated upon - * demand, but the max error needs to be checked. The - * "vtable" parameter corresponds to the maximum value of x - * for which the I0 selfWindow is non-zero. Setting "vtable" - * different from "v" corresponds to a change in units of x. - * In practice, it is often handy to replace x in some sort - * of absolute units with x described in terms of grid - * intervals. - * - * The get_kbsinh_win and get_kbi0_win functions return - * single-argument function objects, which is what a - * generic routine is likely to want. - * - * @code - * kb = KaiserBessel(alpha, K, r, v , N); - * double wx = kb.sinhwin(32); - * double tablex1 = kb.i0win_tab(delx-inxold+3); - * @endcode - */ -class KaiserBessel -{ -protected: - double alpha, v, r; /** Kaiser-Bessel parameters */ - int N; /** size in Ix-space */ - int K; /** I0 selfWindow size */ - double vtable; /** table I0 non-zero domain maximum */ - int ntable; - std::vector i0table; - double dtable; /** table spastd::cing */ - double alphar; /** alpha*r */ - double fac; /** 2*pi*alpha*r*v */ - double vadjust; - double facadj; /** 2*pi*alpha*r*vadjust */ - void build_I0table(); /** Tabulate I0 selfWindow for speed */ - double fltb; - -public: - /** Constructor with parameters */ - KaiserBessel(double alpha_, int K, double r_, - double v_, int N_, double vtable_=0., - int ntable_ = 5999); - - /** Compute the maximum error in the table */ - double I0table_maxerror(); - std::vector dump_table() const - { - return i0table; - } - - /** Kaiser-Bessel Sinh selfWindow function */ - double sinhwin(double x) const; - - /** Kaiser-Bessel I0 selfWindow function */ - double i0win(double x) const; - - /** Kaiser-Bessel I0 selfWindow function (uses table lookup) */ - inline double i0win_tab(double x) const - { - double xt; - if(x<0.) - xt = -x*fltb+0.5; - else - xt = x*fltb+0.5; - return i0table[ (int) xt]; - } - - /** Return the size of the I0 selfWindow */ - int get_window_size() const - { - return K; - } -}; - -#if defined(__APPLE__) || defined(__MINGW32__) -/** Calculate sin and cos at the same time - * - */ -void sin_cos(double angle, double * sine, double * cosine); -#endif - -/** Solve second degree equation - * - * ax^2+bx+c=0 - * - * It returns the number of real solutions, 0 if the two roots are complex - * and -1 if the equation is impossible to satisfy (Ex: 7=0). A number is said - * to be 0 if its absolute magnitude is smaller than precision. This is used to - * avoid dividing by 0 - */ -int solve_2nd_degree_eq(double a, - double b, - double c, - double& x1, - double& x2, - double prec = XMIPP_EQUAL_ACCURACY); - -/** 1D gaussian value - * - * This function returns the value of a univariate gaussian function at the - * point x. - */ -double gaussian1D(double x, double sigma, double mu = 0); - -/** 1D t-student value - * - * This function returns the value of a univariate t-student function at the - * point x, and with df degrees of freedom - */ -double tstudent1D(double x, double df, double sigma, double mu = 0); - -/** Inverse Cumulative distribution function for a Gaussian - * - * This function returns the z of a N(0,1) such that the probability below z is p - * - * The function employs an fast approximation to z which is valid up to 1e-4. - * See http://www.johndcook.com/normal_cdf_inverse.html - */ -double icdf_gauss(double p); - -/** Cumulative distribution function for a Gaussian - * - * This function returns the value of the CDF of a univariate gaussian function at the - * point x. - */ -double cdf_gauss(double x); - -/** Cumulative distribution function for a t-distribution - * - * This function returns the value of the CDF of a univariate t-distribution - * with k degrees of freedom at the point t. - * Adapted by Sjors from: http://www.alglib.net/specialfunctions/distributions/student.php - */ -double cdf_tstudent(int k, double t); - -/** Cumulative distribution function for a Snedecor's F-distribution. - * - * This function returns the value of the CDF of a univariate Snedecor's - * F-distribution - * with d1, d2 degrees of freedom at the point x. - */ -double cdf_FSnedecor(int d1, int d2, double x); - -/** Inverse Cumulative distribution function for a Snedecor's F-distribution. - * - * This function returns the value of the ICDF of a univariate Snedecor's - * F-distribution - * with d1, d2 degrees of freedom with probability p, i.e., it returns - * x such that CDF(d1,d2,x)=p - */ -double icdf_FSnedecor(int d1, int d2, double p); - -/** 2D gaussian value - * - * This function returns the value of a multivariate (2D) gaussian function at - * the point (x,y) when the X axis of the gaussian is rotated ang - * (counter-clockwise) radians (the angle is positive when measured from the - * universal X to the gaussian X). X and Y are supposed to be independent. - */ -double gaussian2D(double x, - double y, - double sigmaX, - double sigmaY, - double ang, - double muX = 0, - double muY = 0); -//@} - -/// @name Miscellaneous functions -//@{ -/** Divides a number into most equally groups - * - * For example you want to distribute N jobs between M workers - * so each worker will have N/M jobs and some of them(N % M first) - * will have N/M + 1 jobs - * So for the worker 'rank' will be computed the first and last job to do - * Return the number of jobs assigned, that could be N/M + 1 or N/M - * - */ -size_t divide_equally(size_t N, size_t size, size_t rank, size_t &first, size_t &last); - -/** In which group (of divide_equally) is myself situated? - */ -size_t divide_equally_group(size_t N, size_t size, size_t myself); - -/** Compute statistics of a std::vector - */ -template -void computeStats(const std::vector &V, double& avg, double& stddev, - T& minval, T& maxval) -{ - if (V.size()<= 0) - return; - - avg = 0; - stddev = 0; - - minval = maxval = V[0]; - - size_t nmax=V.size(); - const T* ptr=&V[0]; - for(size_t n=0; n maxval) - maxval = val; - else if (val < minval) - minval = val; - } - avg /= nmax; - - if (nmax > 1) - { - stddev = stddev / nmax - avg * avg; - stddev *= nmax / (nmax - 1); - - // Foreseeing numerical instabilities - stddev = sqrt(static_cast< double >(ABS(stddev))); - } - else - stddev = 0; -} - -/** Compute statistics of a std::vector - */ -template -void computeAvgStddev(const std::vector &V, double& avg, double& stddev) -{ - if (V.size()<= 0) - return; - - avg = 0; - stddev = 0; - - size_t nmax=V.size(); - const T* ptr=&V[0]; - for(size_t n=0; n 1) - { - stddev = stddev / nmax - avg * avg; - stddev *= nmax / (nmax - 1); - - // Foreseeing numerical instabilities - stddev = sqrt(static_cast< double >(ABS(stddev))); - } - else - stddev = 0; -} - -/** Initialize std::vector with constant value */ -template -void initConstant(std::vector &V, T &value) -{ - const T* ptr=&V[0]; - size_t nmax=V.size(); - for(size_t n=0; n Complex - * - * The output array(s) must be already resized. - * - * This function is not ported to Python. - */ -template -void RealImag2Complex(const T* _real, - const T* _imag, - std::complex< double >* _complex, - int length) -{ - T* aux_real = (T*) _real; - T* aux_imag = (T*) _imag; - double* aux_complex = (double*) _complex; - - for (int i = 0; i < length; i++) - { - *aux_complex++ = (double)(*aux_real++); - *aux_complex++ = (double)(*aux_imag++); - } -} - -/** Amplitude/Phase --> Complex - * - * The output array(s) must be already resized. - * - * This function is not ported to Python. - */ -template -void AmplPhase2Complex(const T* _ampl, - const T* _phase, - std::complex< double >* _complex, - int length) -{ - T* aux_ampl = (T*) _ampl; - T* aux_phase = (T*) _phase; - double* aux_complex = (double*) _complex; - - for (int i = 0; i < length; i++) - { - double ampl = (double)(*aux_ampl++); - double phase = (double)(*aux_phase++); - *aux_complex++ = ampl * cos(phase); - *aux_complex++ = ampl * sin(phase); - } -} - -/** Complex --> Real/Imag - * - * The output array(s) must be already resized. - * - * This function is not ported to Python. - */ -template -void Complex2RealImag(const std::complex< double >* _complex, - T* _real, - T* _imag, - int length) -{ - T* aux_real = (T*) _real; - T* aux_imag = (T*) _imag; - double* aux_complex = (double*) _complex; - - for (int i = 0; i < length; i++) - { - *aux_real++ = (T)(*aux_complex++); - *aux_imag++ = (T)(*aux_complex++); - } -} - -/** Complex --> Amplitude/Phase - * - * The output array(s) must be already resized. - * - * This function is not ported to Python. - */ -template -void Complex2AmplPhase(const std::complex< double >* _complex, - T* _ampl, - T* _phase, - int length) -{ - T* aux_ampl = (T*) _ampl; - T* aux_phase = (T*) _phase; - double* aux_complex = (double*) _complex; - - for (int i = 0; i < length; i++) - { - double re = *aux_complex++; - double im = *aux_complex++; - *aux_ampl++ = sqrt(re * re + im * im); - *aux_phase++ = atan2(im, re); - } -} -//@} - -/** @name Random functions - * - * These functions allow you to work in an easier way with the random functions - * of the Numerical Recipes. Only an uniform and a gaussian random number - * generators have been implemented. In fact only a uniform generator exists and - * the gaussian one is based on a call to it. For this reason, if you initialize - * the gaussian random generator, you are also initialising the uniform one. - * - * Here goes an example for uniform random numbers to show how to use this set - * of functions. - * - * @code - * // Initialise according to the clock - * randomize_random_generator(); - * - * // Show 10 random numbers between -1 and 1 - * for (int i=0; i<10; i++) - * std::cout << rnd_unif(-1,1) << std::endl; - * @endcode - */ -//@{ -/** Reset uniform random generator to a known point - * - * If you initialize the random generator with this function each time, then the - * same random sequence will be generated - * - * @code - * init_rnd_unif(); - * init_rnd_unif(17891) - * @endcode - */ -void init_random_generator(int seed = -1); - -/** Reset random generator according to the clock. - * - * This time the initialisation itself assures a random sequence different each - * time the program is run. Be careful not to run the program twice within the - * same second as the initialisation will be the same for both runs. - * Returns seed. - */ -unsigned int randomize_random_generator(); - -/** Produce a uniform random number between 0 and 1 - * - * @code - * std::cout << "This random number should be between 0 and 1: " << rnd_unif() - * << std::endl; - * @endcode - */ -double rnd_unif(); - -/** Produce a uniform random number between a and b - * - * @code - * std::cout << "This random number should be between 0 and 10: " << rnd_unif(0,10) - * << std::endl; - * @endcode - */ -double rnd_unif(double a, double b); - -/** Produce a t-distributed random number with mean 0 and standard deviation 1 and nu degrees of freedom - * - * @code - * std::cout << "This random number should follow t(0,1) with 3 degrees of freedon: " << rnd_student_t(3.) - * << std::endl; - * @endcode - */ -double rnd_student_t(double nu); - -/** Produce a gaussian random number with mean a and standard deviation b and nu degrees of freedom - * - * @code - * std::cout << "This random number should follow t(1,4) with 3 d.o.f.: " << rnd_gaus(3,1,2) - * << std::endl; - * @endcode - */ -double rnd_student_t(double nu, double a, double b); - -/** Produce a gaussian random number with mean 0 and standard deviation 1 - * - * @code - * std::cout << "This random number should follow N(0,1): " << rnd_gaus() - * << std::endl; - * @endcode - */ -double rnd_gaus(); - -/** Produce a gaussian random number with mean a and standard deviation b - * - * @code - * std::cout << "This random number should follow N(1,4): " << rnd_gaus(1,2) - * << std::endl; - * @endcode - */ -double rnd_gaus(double a, double b); - -/** Gaussian area from -x0 to x0 - * - * By default the gaussian mean is 0 and the gaussian standard deviation is 1. - * x0 must be positive - */ -double gaus_within_x0(double x0, double mean = 0, double stddev = 1); - -/** Gaussian area outisde -x0 to x0 - * - * By default the gaussian mean is 0 and the gaussian standard deviation is 1. - * x0 must be positive - */ -double gaus_outside_x0(double x0, double mean = 0, double stddev = 1); - -/** Gaussian area from -inf to x0 - * - * By default the gaussian mean is 0 and the gaussian standard deviation is 1. - * There is no restriction over the sign of x0 - */ -double gaus_up_to_x0(double x0, double mean = 0, double stddev = 1); - -/** Gaussian area from x0 to inf - * - * By default the gaussian mean is 0 and the gaussian standard deviation is 1. - * There is no restriction over the sign of x0 - */ -double gaus_from_x0(double x0, double mean = 0, double stddev = 1); - -/** t0 for a given two-sided probability - * - * This function returns t0 such that the student probability outside t0 is - * equal to p - */ -double student_outside_probb(double p, double degrees_of_freedom); - -/** student area from -t0 to t0 - * - * By default the student mean is 0 and the student standard deviation is 1. - * t0 must be positive - */ -double student_within_t0(double t0, double degrees_of_freedom); - -/** student area outisde -t0 to t0 - * - * By default the student mean is 0 and the student standard deviation is 1. - * t0 must be positive - */ -double student_outside_t0(double t0, double degrees_of_freedom); - -/** student area from -inf to t0 - * - * By default the student mean is 0 and the student standard deviation is 1. - * There is no restriction over the sign of t0 - */ -double student_up_to_t0(double t0, double degrees_of_freedom); - -/** student area from t0 to inf - * - * By default the student mean is 0 and the student standard deviation is 1. - * There is no restriction over the sign of t0 - */ -double student_from_t0(double t0, double degrees_of_freedom); - -/** chi2 area from -inf to t0 - * - * By default the chi2 mean is 0 and the chi2 standard deviation is 1. - * There is no restriction over the sign of t0 - */ -double chi2_up_to_t0(double t0, double degrees_of_freedom); - -/** chi2 area from t0 to inf - * - * By default the chi2 mean is 0 and the chi2 standard deviation is 1. - * There is no restriction over the sign of t0 - */ -double chi2_from_t0(double t0, double degrees_of_freedom); - -/** Produce a log uniform random number between a and b - * - * Watch out that the following inequation must hold 0 Hello, world", ie, The - * message "Hello, world" was produced at 14:11:32 o'clock of the day 12. This - * function needs not to read the time configuration (see time_config). - * - * @code - * TimeMessage("Hello, world"); - * @endcode - * - * This function is not ported to Python. - */ -void TimeMessage(const std::string &message); -//@} - -/** @name Little/Big endian - * - * These set of functions helps you to deal with the little/big endian - * problems. - */ -//@{ -/** Read from file - * - * This function is the same as fread from C, but at the end there is a flag - * saying if data should be read in reverse order or not. - * - * @code - * double f; - * xmippFREAD(&f, sizeof(double), 1, fp, TRUE); // Reverse order - * - * double f; - * xmippFREAD(&f, sizeof(double), 1, fp); // Normal order - * @endcode - * - * This function is not ported to Python. - */ -size_t xmippFREAD(void* dest, size_t size, size_t nitems, FILE*& fp, - bool reverse = false); - -/** Write to file - * - * This function is the same as fread from C, but at the end there is a flag - * saying if data should be read in reverse order or not. - * - * This function is not ported to Python. - */ -size_t xmippFWRITE(const void* src, - size_t size, - size_t nitems, - FILE*& fp, - bool reverse = false); - -/** Map file to memory. - * - * If size is less than 0, then the whole file is mapped, and the size - * is correctly set to the file size. - * */ -void mapFile(const FileName &filename, char*&map,size_t &size, int &fileDescriptor, bool readOnly=true); - -/** Unmap file*/ -void unmapFile(char *&map, size_t &size, int& fileDescriptor); - -/** Conversion little-big endian - * - * This function is not ported to Python. - */ -#define little22bigendian(x) swapbytes((unsigned char*)& x,sizeof(x)) - -/** Conversion little-big endian - * - * This function is not ported to Python. - */ -void swapbytes(char* v, unsigned long n); - -/** Returns 1 if machine is big endian else 0 - */ -bool IsBigEndian(void); - -////////////////////////////////////////////////////////////////////////////// -// -// process_mem_usage(double &, double &) - takes two doubles by reference, -// attempts to read the system-dependent data for a process' virtual memory -// size and resident set size, and return the results in KB. -// -// On failure, returns 0.0, 0.0 -void processMemUsage(double& vm_usage, double& resident_set); - -/** Returns 1 if machine is little endian else 0 - * little-endian format (sometimes called the Intel format - */ -bool IsLittleEndian(void); - -/** Print the memory used by this process. - */ -void printMemoryUsed(); -//@} - -/// binary comparison of two files skipping first "offset" bytes -bool compareTwoFiles(const FileName &fn1, const FileName &fn2, size_t offset = 0); - - - -//@} -#endif diff --git a/src/core/xmipp_hdf5.cpp b/src/core/xmipp_hdf5.cpp deleted file mode 100644 index b983b2d..0000000 --- a/src/core/xmipp_hdf5.cpp +++ /dev/null @@ -1,236 +0,0 @@ -/*************************************************************************** - * Authors: joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include "xmipp_hdf5.h" -#include "xmipp_strings.h" -#include "xmipp_error.h" - -struct H5TreeInfo -{ - std::string rootname; - std::ostream * out; -}; - -herr_t showObjectInfo(hid_t objId, const char *name, void *op_data) -{ - H5TreeInfo &h5Info = *((H5TreeInfo*)op_data); - std::ostream &out = *(h5Info.out); - - hsize_t nobj; - herr_t err=0; - hid_t grpid, dsid; - - H5G_stat_t statbuf; - - // Print the object name - out << formatString("%s%s - ", h5Info.rootname.c_str(), name); - - H5Gget_objinfo(objId, name, 0, &statbuf); - /* - * process each object according to its type - */ - switch(statbuf.type) - { - case H5G_LINK: - out << " SYM_LINK:\n"; - // do_link(gid,memb_name); - break; - case H5G_GROUP: - { - String rootname = h5Info.rootname; - h5Info.rootname += (String)name + "/"; - - grpid = H5Gopen(objId,name, H5P_DEFAULT); - err = H5Gget_num_objs(grpid, &nobj); - out << formatString("Group {%d elements}\n", nobj); - - H5Giterate(objId, name, NULL, showObjectInfo, &h5Info); - h5Info.rootname = rootname; - break; - } - case H5G_DATASET: - out << "Dataset {"; - dsid = H5Dopen(objId, name, H5P_DEFAULT); - hsize_t dims[4]; - hid_t filespace; - int rank; - filespace = H5Dget_space(dsid); /* Get filespace handle first. */ - rank = H5Sget_simple_extent_dims(filespace, dims, NULL); - - for (int k = 0; k < rank-1; ++k) - out << dims[k] << ", "; - - out << dims[rank-1] << "}\n"; - H5Dclose(dsid); - break; - case H5G_TYPE: - out << " Data type:\n"; - // idType = H5Topen(objId,memb_name, H5P_DEFAULT); - // H5Tclose(idType); - break; - default: - out << " unknown?\n"; - break; - } - return err; -} - - - -std::map createProviderMap() -{ - std::map m; - m["NXtomo"] = std::make_pair(MISTRAL, "/NXtomo/instrument/sample/data"); - m["TomoNormalized"] = std::make_pair(MISTRAL, "/TomoNormalized/TomoNormalized"); - m["MDF"] = std::make_pair(EMAN, "/MDF/images/%i/image"); - return m; -} - - -void XmippH5File::openFile(const H5std_string& name, unsigned int flags, - const H5::FileAccPropList& access_plist) -{ - if ( isHdf5(name.c_str()) ) - H5::H5File::openFile(name.c_str(), flags, access_plist); - else - REPORT_ERROR(ERR_IMG_UNKNOWN, formatString("XmippH5File: Format of %s is not HDF5.",name.c_str())); -} - -bool XmippH5File::checkDataset(const char* dsname) const -{ - H5::DataSet dataset; - // Open the dataset - try - { - dataset = openDataSet(dsname); - } - catch (H5::Exception &h5e) - { - return false; - } - dataset.close(); - return true; -} - -int XmippH5File::getDataset(const char* dsname, Matrix1D &data, bool reportError) const -{ - H5::DataSet dataset; - // Open the dataset - try - { - dataset = openDataSet(dsname); - } - catch (H5::Exception &h5e) - { - if ( reportError ) - REPORT_ERROR(ERR_ARG_MISSING,formatString("getDataset: %s dataset " \ - "does not exist in file %s.", dsname, this->getFileName().c_str())); - // std::cerr << "getDataset Error: " << h5e.getCDetailMsg() << std::endl; - return -1; - } - - //Get dataspace of the dataset. - H5::DataSpace filespace = dataset.getSpace(); - - // Check the number of dimensions in the dataspace is one. - if (filespace.getSimpleExtentNdims()!= 1 ) - REPORT_ERROR(ERR_ARG_INCORRECT, formatString("getDataset: Dataset %s has "\ - "more than 1 dimension", dsname)); - - // Get the size of the dimension in the dataspace - hsize_t dim[1]; - filespace.getSimpleExtentDims(dim); - - - hsize_t offset[1]; // Hyperslab offset in the file - // hsize_t count[1]; // Size of the hyperslab in the file - - // Define the offset and count of the hyperslab to be read. - offset[0] = 0; - // count[0] = dim[0]; - - filespace.selectHyperslab( H5S_SELECT_SET, dim, offset ); - - // Allocate space for data and define the memspace - data.resizeNoCopy((int)*dim); - - H5::DataSpace memspace(1, dim); - - // Read data from hyperslab in the file into the hyperslab in memory - dataset.read(MATRIX1D_ARRAY(data), H5::PredType::NATIVE_DOUBLE, memspace, filespace); - - filespace.close(); - memspace.close(); - dataset.close(); - - return 0; -} - -void XmippH5File::showTree(std::ostream &out) -{ - H5TreeInfo h5Info; - - h5Info.out = &out; - h5Info.rootname = ""; - - this->iterateElems("/", NULL, showObjectInfo, &h5Info); -} - - -H5infoProvider getProvider(hid_t fhdf5) -{ - H5infoProvider provider; - - size_t maxSize = 1024; - char groupName[1024]; - char memName[1024]; - - hid_t gid; - ssize_t len; - - gid = H5Gopen(fhdf5,"/", H5P_DEFAULT); - - len = H5Iget_name(gid, groupName, maxSize); - - if (len == 0) - REPORT_ERROR(ERR_VALUE_EMPTY, "rwHDF5: Empty structure in file."); - - len = H5Gget_objname_by_idx(gid, 0, memName, maxSize); - - H5Gclose(gid); - - typedef std::map::const_iterator it_type; - - for ( it_type it = H5ProviderMap.begin(); it != H5ProviderMap.end(); it++) - { - if ( strcmp(memName,it->first.c_str() ) == 0 ) - return it->second; - } - - return std::make_pair(NONE , ""); - -// REPORT_ERROR(ERR_IO, "rwHDF5: Unknown file provider. Default dataset unknown."); - -} diff --git a/src/core/xmipp_hdf5.h b/src/core/xmipp_hdf5.h deleted file mode 100644 index 2b03782..0000000 --- a/src/core/xmipp_hdf5.h +++ /dev/null @@ -1,111 +0,0 @@ -/*************************************************************************** - * Authors: Joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_XMIPP_HDF5_H_ -#define CORE_XMIPP_HDF5_H_ - -#include -#include -#include "hdf5.h" -#include "H5Cpp.h" -#include "matrix1d.h" - - - -/** @defgroup Tools for General Purpose handling of hdf5 files - * @ingroup DataLibrary - * - * @{ - */ - -enum H5FileProvider -{ - NONE, - MISTRAL, - EMAN -} ; - - -typedef std::pair H5infoProvider; -std::map createProviderMap(); - -/** Global declaration of a map to distinguish the h5file provider - */ -const std::map H5ProviderMap = createProviderMap(); - -/** - * Return the default dataset name according to the typical group - * name of the root - * @param fhdf5 hdf5 file hander - * @return Default dataset name for a file provider - */ -H5infoProvider getProvider(hid_t fhdf5); - - - - -class XmippH5File: public H5::H5File -{ - -public: - - /** - * Show the groups and dataset and print them in the output stream out. - * @param out Output stream - */ - void showTree(std::ostream &out = std::cout); - - /** - * Open HDF5 file - * @param name File name - * @param flags tandard hdf5 flags - * @param access_plist Standard hdf5 plist - */ - void openFile(const H5std_string& name, unsigned int flags, - const H5::FileAccPropList& access_plist = H5::FileAccPropList::DEFAULT); - - /** Return the values in the dataset dsname and return them in a Matrix1D double data - * - * @param dsname Dataset name - * @param data Vector data - * @param reportError If true throw an exception in case of failure, otherwise it returns - * a negative number - */ - int getDataset(const char* dsname, Matrix1D &data, bool reportError = true) const; - - /** Return true if the dataset dsname exists in the file - * - * @param dsname Dataset name to check - * @return true if dataset exists, false otherwise. - */ - bool checkDataset(const char* dsname) const; -}; - -herr_t showObjectInfo(hid_t group, const char *name, void *op_data); - - -/** @} - */ -#endif /* XMIPP_HDF5_H_ */ diff --git a/src/core/xmipp_image.cpp b/src/core/xmipp_image.cpp deleted file mode 100644 index 3702aaa..0000000 --- a/src/core/xmipp_image.cpp +++ /dev/null @@ -1,420 +0,0 @@ -/*************************************************************************** - * - * Authors: Sjors H.W. Scheres (scheres@cnb.csic.es) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * Part of this module has been developed by Lorenzo Zampighi and Nelson Tang - * Dept. Physiology of the David Geffen School of Medicine - * Univ. of California, Los Angeles. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include "xmipp_image.h" -#include "xmipp_image_generic.h" -#include "matrix2d.h" -#include "transformations.h" -#include -#include "metadata_static.h" - -template -int Image::readPreview(const FileName &name, size_t Xdim, size_t Ydim, - int select_slice, size_t select_img) // FIXME this should be moved to image_generic.* -{ - // Zdim is used to choose the slices: -1 = CENTRAL_SLICE, 0 = ALL_SLICES, else This Slice - - ImageGeneric im; - size_t imXdim, imYdim, imZdim, Zdim; - int err; - err = im.readMapped(name, select_img); - im.getDimensions(imXdim, imYdim, imZdim); - ImageInfo imgInfo; - im.getInfo(imgInfo); - - //Set information from image file - setName(name); - setDatatype(imgInfo.datatype); - aDimFile = imgInfo.adim; - - im().setXmippOrigin(); - - double scale; - - // If only Xdim is passed, it is the higher allowable size, for any dimension - if (Ydim == 0 && imXdim < imYdim) - { - Ydim = Xdim; - scale = ((double) Ydim) / ((double) imYdim); - Xdim = (int) (scale * imXdim); - } - else - { - scale = ((double) Xdim) / ((double) imXdim); - if (Ydim == 0) - Ydim = (int) (scale * imYdim); - } - - int mode = (scale <= 1) ? xmipp_transformation::NEAREST : xmipp_transformation::LINEAR; // If scale factor is higher than 1, LINEAR mode is used to avoid artifacts - - if (select_slice > ALL_SLICES) // In this case a specific slice number has been chosen (Not central slice) - { - MultidimArrayGeneric array(im(), select_slice - 1); - array.setXmippOrigin(); - - scaleToSize(mode, IMGMATRIX(*this), array, Xdim, Ydim); - } - else // Otherwise, All slices or Central slice is selected - { - Zdim = (select_slice == ALL_SLICES) ? imZdim : 1; - scaleToSize(mode, IMGMATRIX(*this), im(), Xdim, Ydim, Zdim); - } - - IMGMATRIX(*this).resetOrigin(); - return err; -} - -template -void Image::mmapFile() - { -#ifdef XMIPP_MMAP - if (this->hFile->mode == WRITE_READONLY) - mFd = open(dataFName.c_str(), O_RDONLY, S_IREAD); - else - mFd = open(dataFName.c_str(), O_RDWR, S_IREAD | S_IWRITE); - - if (mFd == -1) - { - if (errno == EACCES) - REPORT_ERROR(ERR_IO_NOPERM, - formatString( - "Image Class::mmapFile: permission denied when opening %s", - dataFName.c_str())); - else - REPORT_ERROR(ERR_IO_NOTOPEN, - "Image Class::mmapFile: Error opening the image file to be mapped."); - } - char * map; - const size_t pagesize = sysconf(_SC_PAGESIZE); - size_t offsetPages = (mappedOffset / pagesize) * pagesize; - mappedOffset -= offsetPages; - mappedSize -= offsetPages; - - if (this->hFile->mode == WRITE_READONLY) - map = (char*) mmap(0, mappedSize, PROT_READ, MAP_SHARED, mFd, - offsetPages); - else - map = (char*) mmap(0, mappedSize, PROT_READ | PROT_WRITE, MAP_SHARED, - mFd, offsetPages); - - if (map == MAP_FAILED) - REPORT_ERROR(ERR_MMAP_NOTADDR, - formatString("Image Class::mmapFile: mmap of image file failed. Error: %s", strerror(errno))); - data.data = reinterpret_cast(map + mappedOffset); - data.nzyxdimAlloc = XSIZE(data) * YSIZE(data) * ZSIZE(data) * NSIZE(data); -#else - - REPORT_ERROR(ERR_MMAP,"Mapping not supported in Windows"); -#endif - - } - - -// Special cases for complex numbers -template<> -void Image< std::complex< double > >::castPage2T(char * page, - std::complex * ptrDest, - DataType datatype, - size_t pageSize) -{ - - switch (datatype) - { - case DT_CShort: - { - std::complex * ptr = (std::complex *) page; - for(size_t i=0; i (real(ptr[i]),imag(ptr[i])); - } - break; - case DT_CInt: - { - std::complex * ptr = (std::complex *) page; - for(size_t i=0; i (real(ptr[i]),imag(ptr[i])); - } - break; - case DT_CFloat: - { - std::complex * ptr = (std::complex *) page; - for(size_t i=0; i (real(ptr[i]),imag(ptr[i])); - } - break; - case DT_CDouble: - memcpy(ptrDest, page, pageSize*sizeof(std::complex)); - break; - default: - std::cerr<<"Datatype= "<"); - break; - } -} - -template<> -void Image< std::complex< double > >::castPage2Datatype(std::complex * srcPtr, - char * page, - DataType datatype, - size_t pageSize) const -{ - switch (datatype) - { - case DT_CShort: - { - short * ptr = (short *) page; - double * srcPtrd = (double *)srcPtr; - for(size_t i=0; i * ptr = (std::complex *) page; - for(size_t i=0; i)srcPtr[i]; - } - break; - case DT_CDouble: - memcpy(page, srcPtr, pageSize*sizeof(std::complex)); - break; - default: - REPORT_ERROR(ERR_TYPE_INCORRECT,formatString("ERROR: cannot cast type number %d to complex",datatype)); - break; - } -} - -template<> -void Image< std::complex< double > >::castConvertPage2Datatype(std::complex< double > * srcPtr, - char * page, DataType datatype, size_t pageSize,double min0,double max0,CastWriteMode castMode) const -{ - - switch (datatype) - { - case DT_CFloat: - { - std::complex * ptr = (std::complex *) page; - for(size_t i=0; i)srcPtr[i]; - } - break; - default: - REPORT_ERROR(ERR_TYPE_INCORRECT,formatString("ERROR: cannot cast&convert type number %d to complex",datatype)); - break; - } -} - -template -void Image::selfApplyGeometry(int SplineDegree, bool wrap, - bool only_apply_shifts) -{ - //apply geo has not been defined for volumes - //and only make sense when reading data - if (data.getDim() < 3 && dataMode >= DATA) - { - Matrix2D A; - getTransformationMatrix(A, only_apply_shifts); - if (!A.isIdentity()) - { - MultidimArray tmp = MULTIDIM_ARRAY(*this); - applyGeometry(SplineDegree, MULTIDIM_ARRAY(*this), tmp, A, xmipp_transformation::IS_NOT_INV, - wrap); - } - } -} - -template -void Image::getTransformationMatrix(Matrix2D &A, bool only_apply_shifts, - const size_t n) -{ - // This has only been implemented for 2D images... - MULTIDIM_ARRAY(*this).checkDimension(2); - A.resizeNoCopy(3, 3); - geo2TransformationMatrix(*MD[n], A, only_apply_shifts); -} - -template -void Image::getPreview(ImageBase *imgBOut, size_t Xdim, size_t Ydim, - int select_slice, size_t select_img) -{ - // Zdim is used to choose the slices: -1 = CENTRAL_SLICE, 0 = ALL_SLICES, else This Slice - - size_t Zdim; - ArrayDim imAdim; - MULTIDIM_ARRAY(*this).getDimensions(imAdim); - MULTIDIM_ARRAY(*this).setXmippOrigin(); - - double scale; - - // If only Xdim is passed, it is the higher allowable size, for any dimension - if (Ydim == 0 && imAdim.xdim < imAdim.ydim) - { - Ydim = Xdim; - scale = ((double) Ydim) / ((double) imAdim.ydim); - Xdim = (int) (scale * imAdim.xdim); - } - else - { - scale = ((double) Xdim) / ((double) imAdim.xdim); - if (Ydim == 0) - Ydim = (int) (scale * imAdim.ydim); - } - - Image &imgOut = *((Image*) imgBOut); - - int mode = (scale <= 1) ? xmipp_transformation::NEAREST : xmipp_transformation::LINEAR; // If scale factor is higher than 1, LINEAR mode is used to avoid artifacts - - if (select_slice > ALL_SLICES) // In this case a specific slice number has been chosen (Not central slice) - { - movePointerTo(select_slice, select_img); - scaleToSize(mode, IMGMATRIX(imgOut), IMGMATRIX(*this), Xdim, Ydim); - } - else // Otherwise, All slices or Central slice is selected - { - movePointerTo(ALL_SLICES, select_img); - Zdim = (select_slice == ALL_SLICES) ? imAdim.zdim : 1; - scaleToSize(mode, IMGMATRIX(imgOut), IMGMATRIX(*this), Xdim, Ydim, - Zdim); - } - - movePointerTo(); - IMGMATRIX(*this).resetOrigin(); - - // We set the actual dimesions of th MDA to the imageOut as if it were read from file. - imgOut.setADimFile(IMGMATRIX(imgOut).getDimensions()); -} - -template -void Image::applyGeo(const MDRow &row, bool only_apply_shifts, bool wrap) { - //This implementation does not handle stacks, - //read in a block - if (data.ndim != 1) - REPORT_ERROR(ERR_MULTIDIM_SIZE, - "Geometric transformation cannot be applied to stacks!!!"); - - if (MD.size() == 0) - MD.push_back(std::unique_ptr(new MDRowVec(MDL::emptyHeaderVec()))); - MDRow &rowAux = *MD[0]; - - if (!row.containsLabel(MDL_TRANSFORM_MATRIX)) - { - double aux; - //origins - if (row.getValue(MDL_ORIGIN_X, aux)) - rowAux.setValue(MDL_ORIGIN_X, aux); - if (row.getValue(MDL_ORIGIN_Y, aux)) - rowAux.setValue(MDL_ORIGIN_Y, aux); - if (row.getValue(MDL_ORIGIN_Z, aux)) - rowAux.setValue(MDL_ORIGIN_Z, aux); - //shifts - if (row.getValue(MDL_SHIFT_X, aux)) - rowAux.setValue(MDL_SHIFT_X, aux); - if (row.getValue(MDL_SHIFT_Y, aux)) - rowAux.setValue(MDL_SHIFT_Y, aux); - if (row.getValue(MDL_SHIFT_Z, aux)) - rowAux.setValue(MDL_SHIFT_Z, aux); - //rotations - if (row.getValue(MDL_ANGLE_ROT, aux)) - rowAux.setValue(MDL_ANGLE_ROT, aux); - if (row.getValue(MDL_ANGLE_TILT, aux)) - rowAux.setValue(MDL_ANGLE_TILT, aux); - if (row.getValue(MDL_ANGLE_PSI, aux)) - rowAux.setValue(MDL_ANGLE_PSI, aux); - //scale - if (row.getValue(MDL_SCALE, aux)) - rowAux.setValue(MDL_SCALE, aux); - //weight - if (row.getValue(MDL_WEIGHT, aux)) - rowAux.setValue(MDL_WEIGHT, aux); - bool auxBool; - if (row.getValue(MDL_FLIP, auxBool)) - rowAux.setValue(MDL_FLIP, auxBool); - } - - //apply geo has not been defined for volumes - //and only make sense when reading data - if (data.getDim() < 3 && dataMode >= DATA) - { - Matrix2D A; - if (!row.containsLabel(MDL_TRANSFORM_MATRIX)) - getTransformationMatrix(A, only_apply_shifts); - else - { - String matrixStr; - row.getValue(MDL_TRANSFORM_MATRIX, matrixStr); - string2TransformationMatrix(matrixStr, A, 3); - } - - if (!A.isIdentity()) - { - MultidimArray tmp = MULTIDIM_ARRAY(*this); - applyGeometry(xmipp_transformation::BSPLINE3, MULTIDIM_ARRAY(*this), tmp, A, xmipp_transformation::IS_NOT_INV, - wrap); - } - } -} - -//template int Image >::readPreview(FileName const&, unsigned long, unsigned long, int, unsigned long); -//template int Image::readPreview(FileName const&, unsigned long, unsigned long, int, unsigned long); -//template int Image::readPreview(FileName const&, unsigned long, unsigned long, int, unsigned long); -//template int Image::readPreview(FileName const&, unsigned long, unsigned long, int, unsigned long); -//template int Image::readPreview(FileName const&, unsigned long, unsigned long, int, unsigned long); -//template int Image::readPreview(FileName const&, unsigned long, unsigned long, int, unsigned long); -//template int Image::readPreview(FileName const&, unsigned long, unsigned long, int, unsigned long); -//template int Image::readPreview(FileName const&, unsigned long, unsigned long, int, unsigned long); -//template int Image::readPreview(FileName const&, unsigned long, unsigned long, int, unsigned long); -//template int Image::readPreview(FileName const&, unsigned long, unsigned long, int, unsigned long); -//template int Image::readPreview(FileName const&, unsigned long, unsigned long, int, unsigned long); -//template int Image::readPreview(FileName const&, unsigned long, unsigned long, int, unsigned long); -template class Image >; -template class Image; -template class Image; -template class Image; -template class Image; -template class Image; -template class Image; -template class Image; -template class Image; -template class Image; -template class Image; -template class Image; -template class Image; diff --git a/src/core/xmipp_image.h b/src/core/xmipp_image.h deleted file mode 100644 index f9f61b9..0000000 --- a/src/core/xmipp_image.h +++ /dev/null @@ -1,1571 +0,0 @@ -/*************************************************************************** - * - * Authors: Sjors H.W. Scheres (scheres@cnb.csic.es) - * Joaquin Oton (joton@cnb.csic.es) - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * Part of this module has been developed by Lorenzo Zampighi and Nelson Tang - * Dept. Physiology of the David Geffen School of Medicine - * Univ. of California, Los Angeles. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#ifndef CORE_IMAGE_H -#define CORE_IMAGE_H - -#include -#include -#include "multidim_array.h" -#include "xmipp_image_base.h" -#include "xmipp_memory.h" -#include "utils/half.hpp" - -/// @addtogroup Images -//@{ - -/** Size of the page used to read and write images from/to file */ -const size_t rw_max_page_size = 4194304; // 4Mb - -/** Template class for images. - * The image class is the general image handling class. - */ -template -class Image : public ImageBase -{ - -public: - MultidimArray data; // The image data array - -public: - /** Empty constructor - * - * An empty image is created. - * - * @code - * Image I; - * @endcode - */ - Image() - { - mdaBase = (MultidimArrayBase*) &data; - init(); - } - - /** Constructor with size and filename - * - * An image file, which name and format are given by filename, - * is created with the given size. Then the image is mapped to this file. - * - * @code - * Image I(64,64,1,1,"image.spi"); - * @endcode - */ - Image(int Xdim, int Ydim, int Zdim, int Ndim, const FileName &_filename) - { - mdaBase = (MultidimArrayBase*) &data; - init(); - mmapOnWrite = true; - data.setDimensions(Xdim, Ydim, Zdim, Ndim); - MD.resize(Ndim); - filename = _filename; - ImageFHandler *hFile = openFile(_filename, WRITE_OVERWRITE); - _write(_filename, hFile, ALL_IMAGES, false, WRITE_OVERWRITE); - closeFile(hFile); - } - - /** Constructor with size - * - * A blank image (0.0 filled) is created with the given size. Pay attention - * to the dimension order: Y and then X. If _mmapOn is True then image is allocated - * in a temporary file. - * - * @code - * Image I(64,64); - * @endcode - */ - Image(int Xdim, int Ydim, int Zdim = 1, int Ndim = 1, bool _mmapOn = false) - { - mdaBase = (MultidimArrayBase*) &data; - init(); - data.setMmap(_mmapOn); - data.coreAllocate(Ndim, Zdim, Ydim, Xdim); - MD.resize(Ndim); - } - - Image(const Image &im) - { - mdaBase = (MultidimArrayBase*) &data; - init(); - *this = im; - } - - /** Constructor with MultidimArray alias - * - * An image is created directly with its multidimarray aliased to im. - * This function is useful when debugging and you want to save multidimarrays. - */ - Image(const MultidimArray &im) - { - mdaBase = (MultidimArrayBase*) &data; - init(); - data.alias(im); - } - - /** Destructor. - */ - virtual - ~Image() - { - clearData(); - } - - /** Clear. - * Initialize everything to 0 - */ - void - clear() - { - clearData(); - init(); - } - - /** Clear the data pointer either mapped or not. - * Initially fix the pointer position in case of - * tricking a lower number of slices and starting - * in a slice different from zero. - */ - void - clearData() - { - // If MultidimArray pointer has been moved to a slice different from zero, then reset it. - // This check must be done prior to mappedSize check, since mappedSlice is a trick over data pointer - if (virtualOffset != 0) - movePointerTo(ALL_SLICES); - if (mmapOnRead || mmapOnWrite) - munmapFile(); - - else - data.clear(); - - } - - /** Check whether image is complex based on T - */ - bool - isComplexT() const - { - return (typeid(T) == typeid(std::complex) - || typeid(T) == typeid(std::complex)); - } - - - /** - * Obtain the inverse axis mapping - */ - void - getInverseAxisOrder(const std::array &order, - std::array &result ) - { - for (size_t i = 0; i < result.size(); ++i) - { - size_t j = 0; - while(j < order.size() && order[j] != i) ++j; // Find inverse mapping - if (j >= order.size()) - REPORT_ERROR(ERR_LOGIC_ERROR, "Invalid axis mapping"); - - result[i] = j; - } - } - - /** - * Trasposes the given size array according to inverseOrder - */ - void - transposeAxisSizes(const std::array &sizes, - const std::array &order, - std::array &result ) - { - std::array inverseOrder; - getInverseAxisOrder(order, inverseOrder); - - result = { - sizes[inverseOrder[0]], - sizes[inverseOrder[1]], - sizes[inverseOrder[2]], - sizes[inverseOrder[3]] - }; - } - - /** - * Trasposes the given MultidimArray with the given order - */ - void - transposeInPlace(MultidimArray &multidimArray, const std::array &order) - { - std::array inverseOrder; - getInverseAxisOrder(order, inverseOrder); - - // Creating new multidim array of the same size than the original - const std::array sizes = { - NSIZE(multidimArray), - ZSIZE(multidimArray), - YSIZE(multidimArray), - XSIZE(multidimArray) - }; - - MultidimArray result( - sizes[inverseOrder[0]], - sizes[inverseOrder[1]], - sizes[inverseOrder[2]], - sizes[inverseOrder[3]] - ); - - // Performing transposition in a loop for every dimension - for (size_t n = 0; n < NSIZE(multidimArray); n++) { - for (size_t z = 0; z < ZSIZE(multidimArray); z++) { - for (size_t y = 0; y < YSIZE(multidimArray); y++) { - for (size_t x = 0; x < XSIZE(multidimArray); x++) { - // Defining array to access with the axis orders - const std::array indices = {n, z, y, x}; - const auto l = indices[inverseOrder[0]]; - const auto k = indices[inverseOrder[1]]; - const auto i = indices[inverseOrder[2]]; - const auto j = indices[inverseOrder[3]]; - - // Transposing element - DIRECT_NZYX_ELEM(result, l, k, i, j) = DIRECT_NZYX_ELEM(multidimArray, n, z, y, x); - } - } - } - } - - // Remapping pointers from original multidim array to transposed one - multidimArray = std::move(result); - } - - /** Cast a page of data from type dataType to type Tdest - * input pointer char * - */ - void - castPage2T(char * page, T * ptrDest, DataType datatype, size_t pageSize) - { - switch (datatype) - { - case DT_Unknown: - REPORT_ERROR(ERR_TYPE_INCORRECT, "ERROR: datatype is Unknown_Type"); - case DT_UHalfByte: - case DT_UChar: - { - if (typeid(T) == typeid(unsigned char)) - memcpy(ptrDest, page, pageSize * sizeof(T)); - else - { - const auto* ptr = (unsigned char *) page; - for (size_t i = 0; i < pageSize; ++i, ++ptr) - ptrDest[i] = (T) *ptr; - } - break; - } - case DT_SChar: - { - if (typeid(T) == typeid(signed char)) - { - memcpy(ptrDest, page, pageSize * sizeof(T)); - } - else - { - const auto* ptr = (signed char *) page; - for (size_t i = 0; i < pageSize; ++i, ++ptr) - ptrDest[i] = (T) *ptr; - } - break; - } - case DT_UShort: - { - if (typeid(T) == typeid(unsigned short)) - { - memcpy(ptrDest, page, pageSize * sizeof(T)); - } - else - { - const auto* ptr = (unsigned short *) page; - for (size_t i = 0; i < pageSize; ++i, ++ptr) - ptrDest[i] = (T) *ptr; - } - break; - } - case DT_Short: - { - if (typeid(T) == typeid(short)) - { - memcpy(ptrDest, page, pageSize * sizeof(T)); - } - else - { - const auto* ptr = (short *) page; - for (size_t i = 0; i < pageSize; ++i, ++ptr) - ptrDest[i] = (T) *ptr; - } - break; - } - case DT_UInt: - { - if (typeid(T) == typeid(unsigned int)) - { - memcpy(ptrDest, page, pageSize * sizeof(T)); - } - else - { - const auto* ptr = (unsigned int *) page; - for (size_t i = 0; i < pageSize; ++i, ++ptr) - ptrDest[i] = (T) *ptr; - } - break; - } - case DT_Int: - { - if (typeid(T) == typeid(int)) - { - memcpy(ptrDest, page, pageSize * sizeof(T)); - } - else - { - const auto* ptr = (int *) page; - for (size_t i = 0; i < pageSize; ++i, ++ptr) - ptrDest[i] = (T) *ptr; - } - break; - } - case DT_Long: - { - if (typeid(T) == typeid(long)) - { - memcpy(ptrDest, page, pageSize * sizeof(T)); - } - else - { - const auto* ptr = (long *) page; - for (size_t i = 0; i < pageSize; ++i, ++ptr) - ptrDest[i] = (T) *ptr; - } - break; - } - case DT_Float: - { - if (typeid(T) == typeid(float)) - { - memcpy(ptrDest, page, pageSize * sizeof(T)); - } - else - { - const auto* ptr = (float *) page; - for (size_t i = 0; i < pageSize; ++i, ++ptr) - ptrDest[i] = (T) *ptr; - } - break; - } - case DT_Double: - { - if (typeid(T) == typeid(double)) - { - memcpy(ptrDest, page, pageSize * sizeof(T)); - } - else - { - const auto* ptr = (double *) page; - for (size_t i = 0; i < pageSize; ++i, ++ptr) - ptrDest[i] = (T) *ptr; - } - break; - } - case DT_HalfFloat: - { - if (typeid(T) == typeid(half_float::half)) - { - memcpy(ptrDest, page, pageSize * sizeof(T)); - } - else - { - const auto* ptr = (half_float::half *) page; - for (size_t i = 0; i < pageSize; ++i, ++ptr) - ptrDest[i] = (T) *ptr; - } - break; - } - default: - { - std::cerr << "Datatype= " << datatype << std::endl; - REPORT_ERROR(ERR_TYPE_INCORRECT, " ERROR: cannot cast datatype to T"); - } - } - - } - - /** Cast page from T to datatype - * input pointer char * - */ - void - castPage2Datatype(T * srcPtr, char * page, DataType datatype, - size_t pageSize) const - { - switch (datatype) - { - case DT_Float: - { - if (typeid(T) == typeid(float)) - { - memcpy(page, srcPtr, pageSize * sizeof(T)); - } - else - { - auto* ptr = (float *) page; - for (size_t i = 0; i < pageSize; ++i, ++ptr) - *ptr = (float) srcPtr[i]; - } - break; - } - case DT_Double: - { - if (typeid(T) == typeid(double)) - { - memcpy(page, srcPtr, pageSize * sizeof(T)); - } - else - { - auto* ptr = (double *) page; - for (size_t i = 0; i < pageSize; ++i, ++ptr) - *ptr = (double) srcPtr[i]; - } - break; - } - case DT_UShort: - { - if (typeid(T) == typeid(unsigned short)) - { - memcpy(page, srcPtr, pageSize * sizeof(T)); - } - else - { - auto* ptr = (unsigned short *) page; - for (size_t i = 0; i < pageSize; ++i, ++ptr) - *ptr = (unsigned short) srcPtr[i]; - } - break; - } - case DT_Short: - { - if (typeid(T) == typeid(short)) - { - memcpy(page, srcPtr, pageSize * sizeof(T)); - } - else - { - auto* ptr = (short *) page; - for (size_t i = 0; i < pageSize; ++i, ++ptr) - *ptr = (short) srcPtr[i]; - } - break; - } - case DT_UHalfByte: - case DT_UChar: - { - if (typeid(T) == typeid(unsigned char)) - { - memcpy(page, srcPtr, pageSize * sizeof(T)); - } - else - { - auto* ptr = (unsigned char *) page; - for (size_t i = 0; i < pageSize; ++i, ++ptr) - *ptr = (unsigned char) srcPtr[i]; - } - break; - } - case DT_SChar: - { - if (typeid(T) == typeid(char)) - { - memcpy(page, srcPtr, pageSize * sizeof(T)); - } - else - { - auto* ptr = (char *) page; - for (size_t i = 0; i < pageSize; ++i, ++ptr) - *ptr = (char) srcPtr[i]; - } - break; - } - case DT_HalfFloat: - { - if (typeid(T) == typeid(half_float::half)) - { - memcpy(page, srcPtr, pageSize * sizeof(T)); - } - else - { - auto* ptr = (half_float::half *) page; - for (size_t i = 0; i < pageSize; ++i, ++ptr) - *ptr = (half_float::half) srcPtr[i]; - } - break; - } - default: - { - std::cerr << "outputDatatype = " << datatype << std::endl; - REPORT_ERROR(ERR_TYPE_INCORRECT, - " ERROR: cannot cast T to outputDatatype"); - } - } - } - - /* Convert the pixels values from one datatype to another, taking into account for datatypes - * of same bitdepth the shift of the minimum values. In other cases, the conversion is done - * adjusting the input values in the range of output datatype. - */ - void - castConvertPage2Datatype(T * srcPtr, char * page, DataType datatype, - size_t pageSize, double min0, double max0, CastWriteMode castMode = - CW_CONVERT) const - { - - double minF, maxF; - double slope; - size_t n; - DataType myTypeId = myT(); - - switch (datatype) - { - case DT_UHalfByte: - case DT_UChar: - { - if (castMode == CW_CONVERT && myTypeId == DT_SChar) - { - slope = 1; - min0 -= CHAR_MIN; - } - else if (castMode == CW_CAST) - { - minF = 0; - min0 = 0; - slope = 1; - } - else - { - minF = 0; - maxF = UCHAR_MAX; - if (max0 != min0) - slope = static_cast(maxF - minF) - / static_cast(max0 - min0); - else - slope = 0; - } - unsigned char * ptr = (unsigned char *) page; - - for (n = 0; n < pageSize; n++) - ptr[n] = static_cast(minF - + (slope * static_cast(srcPtr[n] - min0))); - - break; - } - case DT_SChar: - { - if (castMode == CW_CONVERT && myTypeId == DT_UChar) - { - slope = 1; - min0 += CHAR_MIN; - } - else if (castMode == CW_CAST) - { - minF = 0; - min0 = 0; - slope = 1; - } - else - { - minF = CHAR_MIN; - maxF = CHAR_MAX; - if (max0 != min0) - slope = static_cast(maxF - minF) - / static_cast(max0 - min0); - else - slope = 0; - } - char * ptr = (char *) page; - - for (n = 0; n < pageSize; n++) - ptr[n] = static_cast(minF - + (slope * static_cast(srcPtr[n] - min0))); - - break; - } - case DT_UShort: - { - if (castMode == CW_CONVERT - && (myTypeId == DT_SChar || myTypeId == DT_Short)) - { - slope = 1; - min0 -= SHRT_MIN; - } - else if (castMode == CW_CONVERT && (myTypeId == DT_UChar)) - { - slope = 1; - } - else if (castMode == CW_CAST) - { - minF = 0; - min0 = 0; - slope = 1; - } - else - { - minF = 0; - maxF = USHRT_MAX; - if (max0 != min0) - slope = static_cast(maxF - minF) - / static_cast(max0 - min0); - else - slope = 0; - } - - unsigned short * ptr = (unsigned short *) page; - - for (n = 0; n < pageSize; n++) - ptr[n] = static_cast(minF - + (slope * static_cast(srcPtr[n] - min0))); - - break; - } - case DT_Short: - { - if (castMode == CW_CONVERT - && (myTypeId == DT_UChar || myTypeId == DT_UShort)) - { - slope = 1; - min0 += SHRT_MIN; - } - else if (castMode == CW_CONVERT && (myTypeId == DT_SChar)) - { - slope = 1; - } - else if (castMode == CW_CAST) - { - minF = 0; - min0 = 0; - slope = 1; - } - else - { - minF = SHRT_MIN; - maxF = SHRT_MAX; - if (max0 != min0) - slope = static_cast(maxF - minF) - / static_cast(max0 - min0); - else - slope = 0; - } - short * ptr = (short *) page; - - for (n = 0; n < pageSize; n++) - ptr[n] = static_cast(minF - + (slope * static_cast(srcPtr[n] - min0))); - - break; - } - case DT_UInt: - { - if (castMode == CW_CONVERT - && (myTypeId == DT_SChar || myTypeId == DT_Short - || myTypeId == DT_Int)) - { - slope = 1; - min0 -= INT_MIN; - } - else if (castMode == CW_CONVERT - && (myTypeId == DT_UShort || myTypeId == DT_UChar)) - { - slope = 1; - } - else if (castMode == CW_CAST) - { - minF = 0; - min0 = 0; - slope = 1; - } - else - { - minF = 0; - maxF = UINT_MAX; - if (max0 != min0) - slope = static_cast(maxF - minF) - / static_cast(max0 - min0); - else - slope = 0; - } - unsigned int * ptr = (unsigned int *) page; - - for (n = 0; n < pageSize; n++) - ptr[n] = static_cast(minF - + (slope * static_cast(srcPtr[n] - min0))); - break; - } - case DT_Int: - { - if (castMode == CW_CONVERT - && (myTypeId == DT_UChar || myTypeId == DT_UShort - || myTypeId == DT_UInt)) - { - slope = 1; - min0 += INT_MIN; - } - else if (castMode == CW_CONVERT - && (myTypeId == DT_Short || myTypeId == DT_SChar)) - { - slope = 1; - } - else if (castMode == CW_CAST) - { - minF = 0; - min0 = 0; - slope = 1; - } - else - { - minF = INT_MIN; - maxF = INT_MAX; - if (max0 != min0) - slope = static_cast(maxF - minF) - / static_cast(max0 - min0); - else - slope = 0; - } - int * ptr = (int *) page; - - for (n = 0; n < pageSize; n++) - ptr[n] = static_cast(minF - + (slope * static_cast(srcPtr[n] - min0))); - break; - } - default: - castPage2Datatype(srcPtr, page, datatype, pageSize); - } - - } - - void - setPage2T(size_t offset, char * page, DataType datatype, size_t pageSize) - { - castPage2T(page, MULTIDIM_ARRAY(data) + offset, datatype, pageSize); - } - - void - getPageFromT(size_t offset, char * page, DataType datatype, size_t pageSize) - { - castPage2Datatype(MULTIDIM_ARRAY(data) + offset, page, datatype, - pageSize); - } - - void - getCastConvertPageFromT(size_t offset, char * page, DataType datatype, - size_t pageSize, double min0, double max0, CastWriteMode castMode = - CW_CONVERT) const - { - castConvertPage2Datatype(MULTIDIM_ARRAY(data) + offset, page, datatype, - pageSize, min0, max0, castMode); - } - - /** Check if file Datatype is the same as the declared image object (T type) to use mmap. - */ - bool - checkMmapT(DataType datatype) override - { - - switch (datatype) - { - case DT_Unknown: - REPORT_ERROR(ERR_TYPE_INCORRECT, "ERROR: datatype is Unknown_Type"); - case DT_UHalfByte: - return 0; - case DT_UChar: - return typeid(T) == typeid(unsigned char); - case DT_SChar: - return typeid(T) == typeid(char); - case DT_UShort: - return typeid(T) == typeid(unsigned short); - case DT_Short: - return typeid(T) == typeid(short); - case DT_UInt: - return typeid(T) == typeid(unsigned int); - case DT_Int: - return typeid(T) == typeid(int); - case DT_Long: - return typeid(T) == typeid(long); - case DT_Float: - return typeid(T) == typeid(float); - case DT_Double: - return typeid(T) == typeid(double); - case DT_HalfFloat: - return typeid(T) == typeid(half_float::half); - default: - { - std::cerr << "Datatype= " << datatype << std::endl; - REPORT_ERROR(ERR_TYPE_INCORRECT, " ERROR: cannot cast datatype to T"); - } - } - } - - /** flip image around X axis - * - */ - void - mirrorY(void) - { - T aux(0); - size_t Z, Y, X, N, Y2; - - X = XSIZE(data); - Y = YSIZE(data); - Z = ZSIZE(data); - N = NSIZE(data); - Y2 = Y / 2; - Y--; - for (size_t l = 0; l < N; ++l) - for (size_t k = 0; k < Z; ++k) - for (size_t i = 0; i < Y2; ++i) - for (size_t j = 0; j < X; ++j) - { - aux = DIRECT_NZYX_ELEM(data, l, k, i, j); - DIRECT_NZYX_ELEM(data, l, k, i, j) = DIRECT_NZYX_ELEM(data, l, k, - Y - i, j); - DIRECT_NZYX_ELEM(data, l, k, Y-i, j) = aux; - } - } - - /** flip image around Y axis - * - */ - void - mirrorX(void) - { - T aux(0); - size_t Z, Y, X, N, X2; - - X = XSIZE(data); - Y = YSIZE(data); - Z = ZSIZE(data); - N = NSIZE(data); - X2 = X / 2; - X--; - for (size_t l = 0; l < N; ++l) - for (size_t k = 0; k < Z; ++k) - for (size_t i = 0; i < Y; ++i) - for (size_t j = 0; j < X2; ++j) - { - aux = DIRECT_NZYX_ELEM(data, l, k, i, j); - DIRECT_NZYX_ELEM(data, l, k, i, j) = DIRECT_NZYX_ELEM(data, l, k, - i, X - j); - DIRECT_NZYX_ELEM(data, l, k, i, X - j) = aux; - } - } - - void - selfApplyGeometry(int SplineDegree, bool wrap = xmipp_transformation::WRAP, - bool only_apply_shifts = false); - - /* Read an image with a lower resolution as a preview image. - * If Zdim parameter is not passed, then all slices are rescaled. - * If Ydim is not passed, then Ydim is rescaled same factor as Xdim. - */ - int - readPreview(const FileName &name, size_t Xdim, size_t Ydim = 0, - int select_slice = CENTRAL_SLICE, size_t select_img = FIRST_IMAGE); - - /** Returns an image with a lower resolution as a preview image. - * If Zdim parameter is not passed, then all slices are rescaled. - * If Ydim is not passed, then Ydim is rescaled same factor as Xdim. - */ - void - getPreview(ImageBase *imgBOut, size_t Xdim, size_t Ydim = 0, - int select_slice = CENTRAL_SLICE, size_t select_img = FIRST_IMAGE); - - /** It changes the behavior of the internal multidimarray so it points to a specific slice/image - * from a stack, volume or stack of volumes. No information is deallocated from memory, so it is - * also possible to repoint to the whole stack,volume... (passing select_slice = ALL_SLICES and - * selec_img = ALL_IMAGES). - * - * The options for select_slice are: - * - * - a slice number, - * - CENTRAL_SLICE, to automatically select the central slice of the volume, - * - ALL_SLICES, to recover the whole volume. - * - * The options for selec_img are: - * - * - a image number of the stack, - * - ALL_IMAGES, to recover the whole stack. - * - * If a specific slice number is selected, then a specific image from the stack must be - * also selected. Otherwise, FIRST_IMAGE is proposed. - * - * If Image Object is read using readPreview method, movePointerTo only works when rescaling - * the image in X-Y plane only, but all slices must be read. - */ - void - movePointerTo(int select_slice = ALL_SLICES, size_t select_img = ALL_IMAGES) - { - if (MULTIDIM_ARRAY(VOLMATRIX(*this)) == NULL) - REPORT_ERROR(ERR_MULTIDIM_EMPTY, - "Image::movePointerTo: Image is empty"); - if (select_slice > (int) aDimFile.zdim) - REPORT_ERROR(ERR_MULTIDIM_SIZE, - formatString( - "movePointerTo: Selected slice %4d cannot be higher than Z size %4d.", - select_slice, aDimFile.zdim)); - else if (select_img > aDimFile.ndim) - REPORT_ERROR(ERR_MULTIDIM_SIZE, - formatString( - "movePointerTo: Selected image %4d cannot be higher than N size %4d.", - select_img, aDimFile.ndim)); - - ArrayDim newDim; - VOLMATRIX(*this).getDimensions(newDim); - - /* Restore the real dimensions from the MDA, as it may be - * X-Y dimensioned different from file (readPreview). */ - newDim.zdim = aDimFile.zdim; - newDim.ndim = aDimFile.ndim; - - int phys_slice; - - switch (select_slice) - { - case CENTRAL_SLICE: - phys_slice = aDimFile.zdim / 2; - newDim.zdim = 1; - break; - case ALL_SLICES: - phys_slice = 0; - break; - default: - phys_slice = select_slice - 1; - newDim.zdim = 1; - break; - } - - /* If we select a single slice, we are forced to chose also an image. - * as at this moment we cannot select the same slice from different images at a time. - */ - if (select_slice > 0 && select_img == ALL_IMAGES) - select_img = FIRST_IMAGE; - if (select_img > ALL_IMAGES) - newDim.ndim = 1; - - VOLMATRIX(*this).setDimensions(newDim); - - size_t newVirtualOffset = YXSIZE(VOLMATRIX(*this)) - * (aDimFile.zdim * IMG_INDEX(select_img) + phys_slice); - MULTIDIM_ARRAY(VOLMATRIX(*this)) += (newVirtualOffset - virtualOffset); - virtualOffset = newVirtualOffset; - } - - /** Write an entire page as datatype - * - * A page of datasize_n elements T is cast to datatype and written to fimg - * The memory for the casted page is allocated and freed internally. - */ - void - writePageAsDatatype(FILE * fimg, DataType datatype, size_t datasize_n) - { - size_t datasize = datasize_n * gettypesize(datatype); - char * fdata = (char *) askMemory(datasize); - castPage2Datatype(MULTIDIM_ARRAY(data), fdata, datatype, datasize_n); - fwrite(fdata, datasize, 1, fimg); - freeMemory(fdata, datasize); - } - - /** Copy the MDA and the fields related to the (possible) original file - */ - Image& - operator=(const Image &op1) - { - this->copy(op1); - data = op1.data; - return *this; - } - - /** Data access - * - * This operator can be used to access the data multidimarray. - * In this way we could resize an image just by - * resizing its associated matrix or we could add two images by adding their - * matrices. - * @code - * I().resize(128, 128); - * I2() = I1() + I2(); - * @endcode - */ - MultidimArray& - operator()() - { - return data; - } - const MultidimArray& - operator()() const - { - return data; - } - - /** Pixel access - * - * This operator is used to access a pixel within a 2D image. This is a - * logical access, so you could access to negative positions if the image - * has been defined so (see the general explanation for the class). - * - * @code - * std::cout << "Grey level of pixel (-3,-3) of the image = " << I(-3, -3) - * << std::endl; - * - * I(-3, -3) = I(-3, -2); - * @endcode - */ - T& - operator()(int i, int j) const - { - return A2D_ELEM(data, i, j); - } - /** - * equal operator - */ - bool - operator==(const Image &i1) const - { - return (this->data == i1.data); - } - - /** Voxel access - * - * This operator is used to access a voxel within a 3D image. This is a - * logical access, so you could access to negative positions if the image - * has been defined so (see the general explanation for the class). - * - * @code - * std::cout << "Grey level of pixel (-3,-3, 1) of the volume = " << I(-3, -3, 1) - * << std::endl; - * - * I(-3, -3, 1) = I(-3, -2, 0); - * @endcode - */ - T& - operator()(int k, int i, int j) const - { - return A3D_ELEM(data, k, i, j); - } - - /** Get Image dimensions - */ - // void getDimensions(int &Xdim, int &Ydim, int &Zdim, size_t &Ndim) const - // { - // Xdim = XSIZE(data); - // Ydim = YSIZE(data); - // Zdim = ZSIZE(data); - // Ndim = NSIZE(data); - // } - size_t - getSize() const - { - return NZYXSIZE(data); - } - - /** Get geometric transformation matrix from 2D-image header - */ - void - getTransformationMatrix(Matrix2D &A, bool only_apply_shifts = false, - const size_t n = 0); - - /** Sum this object with other file and keep in this object - */ - void - sumWithFile(const FileName &fn) - { - Image aux; - aux.read(fn, DATA, ALL_IMAGES, true); - (*this)() += aux(); - } - - /** - * Specific read functions for different file formats - */ - //#include "rwTIFF.h" -protected: - - /** Apply geometry in referring metadata to the image */ - void applyGeo(const MDRow &row, bool only_apply_shifts = false, bool wrap = xmipp_transformation::WRAP) override; - - //apply geo has not been defined for volumes - //and only make sense when reading data - - /** Set the image dimensions - */ - void - setDimensions(int Xdim, int Ydim, int Zdim, size_t Ndim) - { - data.setDimensions(Xdim, Ydim, Zdim, Ndim); - data.getDimensions(aDimFile); - } - -private: - - void setDimensions(ArrayDim &aDim) override - { - ImageBase::setDimensions(aDim); - } - - static bool isValidAxisOrder(const std::array& order) - { - std::set uniqueValues; - - for (int value : order) { - // Check if the value is not in the range [0, 3] or is not unique. - if (value < 0 || value > 3 || !uniqueValues.insert(value).second) - return false; - } - - return true; - } - - /** Read the raw data - */ - void - readData(FILE* fimg, size_t select_img, DataType datatype, size_t pad) override - { - //#define DEBUG -#ifdef DEBUG - std::cerr<<"entering readdata"< sizes; - getDimensions(sizes[3], sizes[2], sizes[1], sizes[0]); - transposeAxisSizes(sizes, axisOrder, sizes); - setDimensions(sizes[3], sizes[2], sizes[1], sizes[0]); - } - return; - } - - if (datatype == DT_UHalfByte){ - //REPORT_ERROR(ERR_MMAP, "Image Class::readData not supported for " - // "data type " + datatype2Str(DT_UHalfByte)); - std::cout<<"redirecting from readData to readData4bits!"< 0 || axisOrder != defaultAxisOrder)) - { - String warnMessage; - if (swap > 0) - reportWarning("Image::readData: File endianness is swapped and not " - "compatible with mmap. Loading into memory."); - else if (axisOrder != defaultAxisOrder) - reportWarning("Image::readData: Axis order is not standard 0,1,2,3, which makes it " - "incompatible with memory mapping. Loading into memory."); - else - reportWarning( - "Image::readData: File datatype and image declaration not " - "compatible with mmap. Loading into memory."); - - mmapOnRead = false; - mFd = -1; - } - - if (mmapOnRead) - { - // Image mmapOn is not compatible with Multidimarray mmapOn - if (data.mmapOn) - REPORT_ERROR(ERR_MULTIDIM_DIM, - "Image Class::ReadData: mmap option can not be selected simultaneously\ - for both Image class and its Multidimarray."); - if ( NSIZE(data) > 1) - { - REPORT_ERROR(ERR_MMAP, "Image Class::ReadData: mmap with multiple " - "images file not compatible. Try selecting a unique image."); - } - mappedOffset = selectImgOffset; - mappedSize = mappedOffset + pagesize; - mmapFile(); - } - else - { - // Allocate memory for image data (Assume xdim, ydim, zdim and ndim are already set - //if memory already allocated use it (no resize allowed) - data.coreAllocateReuse(); - //ROB -// #define DEBUG -#ifdef DEBUG - - data.printShape(); - printf("DEBUG: Page size: %ld offset= %ld \n", pagesize, offset); - printf("DEBUG: Swap = %d Pad = %ld Offset = %ld\n", swap, pad, offset); - printf("DEBUG: myoffset = %ld select_img= %ld \n", selectImgOffset, select_img); - printf("DEBUG: NSIZE = %lu \n", NSIZE(data)); -#endif -#undef DEBUG - - if (checkMmapT(datatype) && !swap && axisOrder == defaultAxisOrder) { - // printf( "type is same, reading without cast\n" ); - - size_t slice_elements = ZYXSIZE(data); - - if (fseek(fimg, selectImgOffset, SEEK_SET) == -1) - REPORT_ERROR(ERR_IO_SIZE, "readData: can not seek the file pointer"); - - if (pad == 0) { - // printf( "pad == 0, reading with one fread \n" ); - if (fread(MULTIDIM_ARRAY(data), pagesize * NSIZE(data), 1, fimg) != 1) { - REPORT_ERROR(ERR_IO_NOREAD, "readData: cannot read the whole image slice"); - } - } else { - for (size_t n = 0; n < NSIZE(data); ++n) { - if (fread(MULTIDIM_ARRAY(data) + slice_elements * n, pagesize, 1, fimg) != 1) { - REPORT_ERROR(ERR_IO_NOREAD, "readData: cannot read the whole image slice"); - } - - if (fseek(fimg, pad, SEEK_CUR) == -1) { - REPORT_ERROR(ERR_IO_SIZE, "readData: cannot seek the file pointer"); - } - } - } - - - } else { - // std::cout << "original read" << std::endl; - char* page = NULL; - - if (pagesize > pagemax) - page = (char *) askMemory(pagemax * sizeof(char)); - else - page = (char *) askMemory(pagesize * sizeof(char)); - - if (fseek(fimg, selectImgOffset, SEEK_SET) == -1) - REPORT_ERROR(ERR_IO_SIZE, "readData: can not seek the file pointer"); - for (size_t myn = 0; myn < NSIZE(data); myn++) - { - for (size_t myj = 0; myj < pagesize; myj += pagemax) //pagesize size of object - { - // Read next page. Divide pages larger than pagemax - readsize = pagesize - myj; - if (readsize > pagemax) - readsize = pagemax; - readsize_n = readsize / datatypesize; - - //Read page from disc - if (fread(page, readsize, 1, fimg) != 1) - REPORT_ERROR(ERR_IO_NOREAD, "Cannot read the whole page"); - //swap per page - if (swap) - swapPage(page, readsize, datatype, swap); - // cast to T per page - castPage2T(page, MULTIDIM_ARRAY(data) + haveread_n, datatype, - readsize_n); - haveread_n += readsize_n; - } - if (pad > 0) - //fread( padpage, pad, 1, fimg); - if (fseek(fimg, pad, SEEK_CUR) == -1) - REPORT_ERROR(ERR_IO_SIZE, - "readData: can not seek the file pointer"); - } - // Transposing multidim array - if (axisOrder != defaultAxisOrder) { - transposeInPlace(data, axisOrder); - data.getDimensions(aDimFile); - } - //if ( pad > 0 ) - // freeMemory(padpage, pad*sizeof(char)); - if (page) - freeMemory(page, pagesize * sizeof(char)); - - } - -#ifdef DEBUG - - printf("DEBUG img_read_data: Finished reading and converting data\n"); -#endif - - } - return; - } - - - - /** Read the raw data from compressed 4bit images - * We are assuming the values are stored in 4bits (2 values in 1 byte) - */ - void - readData4bit(FILE* fimg, size_t select_img, DataType datatype, size_t pad) - { - - if (dataMode < DATA) - return; - - if (datatype != DT_UHalfByte){ - REPORT_ERROR(ERR_MMAP, "Image Class::readData4bit not supported for " - "data type different than " + datatype2Str(DT_UHalfByte)); - } - - size_t selectImgOffset; //4Mb - size_t itemSize = ZYXSIZE(data); - size_t pagesizeF = itemSize /2; - size_t pagesizeM = itemSize; - //size_t pagesizeHalf = pagesize/2; - size_t haveread_n = 0; - - char* page = NULL; // Compressed - - // Allocate memory for image data (Assume xdim, ydim, zdim and ndim are already set - //if memory already allocated use it (no resize allowed) - data.coreAllocateReuse(); - - page = (char *) askMemory(pagesizeM); - - // Calculate the staring reading pointer. - selectImgOffset = offset + IMG_INDEX(select_img) * (pagesizeF + pad); - - if (fseek(fimg, selectImgOffset, SEEK_SET) == -1) - REPORT_ERROR(ERR_IO_SIZE, "readData4bit: can not seek the file pointer"); - for (size_t myn = 0; myn < NSIZE(data); myn++) - { - - //Read page from disc - if (fread(page+pagesizeF, pagesizeF, 1, fimg) != 1) - REPORT_ERROR(ERR_IO_NOREAD, "Cannot read the whole page"); - - // cast to T per page - - size_t start = pagesizeF; - uint8_t mask = 15; // 00001111 - - for (size_t i = 0, j = start; i < pagesizeM - 1; i += 2, ++j) - { - char& value = *(page+j); - page[i] = value & mask; // take the lower 4 bits - page[i+1] = (value >> 4) & mask; // take the upper 4 bits - } - - castPage2T(page, MULTIDIM_ARRAY(data) + haveread_n, datatype, - pagesizeM); - haveread_n += pagesizeM; - - if (pad > 0) - //fread( padpage, pad, 1, fimg); - if (fseek(fimg, pad, SEEK_CUR) == -1) - REPORT_ERROR(ERR_IO_SIZE, - "readData4bit: can not seek the file pointer"); - - //if ( pad > 0 ) - // freeMemory(padpage, pad*sizeof(char)); - -#ifdef DEBUG - - printf("DEBUG readData4bit: Finished reading and converting data\n"); -#endif - } - if (page) - freeMemory(page, pagesizeM * sizeof(char)); - - return; - } - - - - - - - - - /* Write the raw date after a data type casting. - */ - void - writeData(FILE* fimg, size_t offset, DataType wDType, size_t datasize_n, - CastWriteMode castMode = CW_CAST) - { - size_t dTypeSize = gettypesize(wDType); - size_t datasize = datasize_n * dTypeSize; - size_t ds2Write = rw_max_page_size; - size_t dsN2Write = rw_max_page_size / dTypeSize; - size_t rw_max_n = dsN2Write; - - char* fdata; - double min0 = 0, max0 = 0; - - if (wDType == myT() && castMode == CW_CONVERT) - castMode = CW_CAST; - - if (castMode != CW_CAST) - data.computeDoubleMinMaxRange(min0, max0, offset, datasize_n); - - if ( checkMmapT(wDType) ) { - fwrite( MULTIDIM_ARRAY(data) + offset, datasize, 1, fimg ); - return; - } - - if (datasize > rw_max_page_size) - fdata = (char *) askMemory(rw_max_page_size * sizeof(char)); - else - fdata = (char *) askMemory(datasize * sizeof(char)); - - for (size_t writtenDataN = 0; writtenDataN < datasize_n; writtenDataN += - rw_max_n) - { - - if (writtenDataN + rw_max_n > datasize_n) - { - dsN2Write = datasize_n - writtenDataN; - ds2Write = dsN2Write * dTypeSize; - } - - if (castMode == CW_CAST) - castPage2Datatype(MULTIDIM_ARRAY(data) + offset + writtenDataN, fdata, - wDType, dsN2Write); - else - castConvertPage2Datatype(MULTIDIM_ARRAY(data) + offset + writtenDataN, - fdata, wDType, dsN2Write, min0, max0, castMode); - - //swap per page - if (swapWrite) - swapPage(fdata, ds2Write, wDType); - - fwrite(fdata, ds2Write, 1, fimg); - } - freeMemory(fdata, rw_max_page_size); - } - - /* Mmap the Image class to an image file. - */ - void - mmapFile(); - - /* Munmap the image file. - */ - void - munmapFile() - { -#ifdef XMIPP_MMAP - munmap((char*) (data.data) - mappedOffset, mappedSize); - close(mFd); - data.data = NULL; - mappedSize = mappedOffset = 0; -#else - - REPORT_ERROR(ERR_MMAP,"Mapping not supported in Windows"); -#endif - - } - - /* Return the datatype of the current image object - */ - DataType - myT() const - { - if (typeid(T) == typeid(unsigned char)) - return DT_UChar; - else if (typeid(T) == typeid(char)) - return DT_SChar; - else if (typeid(T) == typeid(unsigned short)) - return DT_UShort; - else if (typeid(T) == typeid(short)) - return DT_Short; - else if (typeid(T) == typeid(unsigned int)) - return DT_UInt; - else if (typeid(T) == typeid(int)) - return DT_Int; - else if (typeid(T) == typeid(unsigned int)) - return DT_UInt; - else if (typeid(T) == typeid(int)) - return DT_Int; - else if (typeid(T) == typeid(long)) - return DT_Long; - else if (typeid(T) == typeid(float)) - return DT_Float; - else if (typeid(T) == typeid(double)) - return DT_Double; - else if (typeid(T) == typeid(std::complex)) - return DT_CShort; - else if (typeid(T) == typeid(std::complex)) - return DT_CInt; - else if (typeid(T) == typeid(std::complex)) - return DT_CFloat; - else if (typeid(T) == typeid(std::complex)) - return DT_CDouble; - else if (typeid(T) == typeid(bool)) - return DT_HalfFloat; - else if (typeid(T) == typeid(half_float::half)) - return DT_Bool; - else - return DT_Unknown; - } - - /* friend declaration for stacks handling purposes - */ - friend class ImageCollection; - template - friend class Image; - -} -; - -// Special cases for complex numbers -template<> -void -Image >::castPage2T(char * page, - std::complex * ptrDest, DataType datatype, size_t pageSize); -template<> -void -Image >::castPage2Datatype(std::complex * srcPtr, - char * page, DataType datatype, size_t pageSize) const; -template<> -void -Image >::castConvertPage2Datatype( - std::complex * srcPtr, char * page, DataType datatype, - size_t pageSize, double min0, double max0, CastWriteMode castMode) const; - -//@} -#endif diff --git a/src/core/xmipp_image_base.cpp b/src/core/xmipp_image_base.cpp deleted file mode 100644 index 790cf23..0000000 --- a/src/core/xmipp_image_base.cpp +++ /dev/null @@ -1,1208 +0,0 @@ -/*************************************************************************** - * Authors: Joaquin Oton (joton@cnb.csic.es) - * - * - * Unidad de Bioinformatica of Centro Nacional de Biotecnologia , CSIC - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - * 02111-1307 USA - * - * All comments concerning this program package may be sent to the - * e-mail address 'xmipp@cnb.csic.es' - ***************************************************************************/ - -#include "xmipp_image_base.h" -#include "xmipp_image.h" -#include "xmipp_error.h" - -#include -#include "metadata_static.h" -#include "metadata_base.h" -#include "xmipp_funcs.h" -#include -#include - -//This is needed for static memory allocation - -void ImageBase::initGeometry(const size_t n) -{ - MDL::emptifyHeader(*MD[n]); -} - -void ImageBase::setDimensions(ArrayDim &aDim) -{ - mdaBase->setDimensions(aDim); - aDimFile = aDim; -} - -void ImageBase::init() -{ - clearHeader(); - - filename = tempFilename = dataFName = ""; - fimg = fhed = NULL; - hFile = NULL; - tif = NULL; - dataMode = DATA; - transform = isComplexT() ? Standard : NoTransform; - filename.clear(); - offset = 0; - swap = swapWrite = 0; - replaceNsize = 0; - _exists = mmapOnRead = mmapOnWrite = false; - mFd = 0; - mappedSize = mappedOffset = virtualOffset = 0; - m_auxI = nullptr; -} - -void ImageBase::copy(const ImageBase& other) { - MDMainHeader = other.MDMainHeader; - MD.clear(); - MD.reserve(other.MD.size()); - if ((other.MD.size() > 0) && (dynamic_cast(other.MD[0].get()) != nullptr)) { - for (const std::unique_ptr& rowPtr : other.MD) { - const MDRow& row = *rowPtr; - MD.emplace_back(std::unique_ptr(new MDRowVec(dynamic_cast(row)))); - } - } - if ((other.MD.size() > 0) && (dynamic_cast(other.MD[0].get()) != nullptr)) { - for (const std::unique_ptr& rowPtr : other.MD) { - const MDRow& row = *rowPtr; - MD.emplace_back(std::unique_ptr(new MDRowSql(dynamic_cast(row)))); - } - } - - filename = other.filename; - tempFilename = other.tempFilename; - dataFName = other.dataFName; - fimg = other.fimg; - fhed = other.fhed; - tif = other.tif; - hFile = other.hFile; - aDimFile = other.aDimFile; - offset = other.offset; - swap = other.swap; - swapWrite = other.swapWrite; - transform = other.transform; - replaceNsize = other.replaceNsize; - _exists = other._exists; - mmapOnRead = other.mmapOnRead; - mmapOnWrite = other.mmapOnWrite; - mFd = other.mFd; - mappedSize = other.mappedSize; - mappedOffset = other.mappedOffset; - virtualOffset = other.virtualOffset; -} - -void ImageBase::clearHeader() -{ - MDMainHeader.clear(); - MD.clear(); - //Just to ensure there is an empty MDRow - MD.push_back(std::unique_ptr(new MDRowVec(MDMainHeader))); -} - -/** General read function - */ -int ImageBase::read(const FileName &name, DataMode datamode, size_t select_img, - bool mapData, int mode) -{ - if (!mapData) - mode = WRITE_READONLY; //TODO: Check if openfile other than readonly is necessary - - hFile = openFile(name, mode); - int err = _read(name, hFile, datamode, select_img, mapData); - closeFile(hFile); - return err; -} - -int ImageBase::readBatch(const FileName &name, size_t start_img, size_t batch_size, - DataMode datamode /*= DATA*/, bool mapData /*= false*/, int mode /*= WRITE_READONLY*/) -{ - if (!mapData) { - mode = WRITE_READONLY; - } - - hFile = openFile(name, mode); - int err = _readBatch(name, hFile, start_img, batch_size, datamode, mapData); - closeFile(hFile); - return err; -} - -int ImageBase::readRange(const FileName &name, size_t start_img, size_t end_img, - DataMode datamode /*= DATA*/, bool mapData /*= false*/, int mode /*= WRITE_READONLY*/) -{ - if (end_img < start_img) { - REPORT_ERROR(ERR_ARG_DEPENDENCE, formatString("readRange: end_img %lu is smaller than start_img %lu\n", end_img, start_img)); - } - - readBatch(name, start_img, end_img - start_img + 1, datamode, mapData, mode); - return true; -} - - -int ImageBase::readMapped(const FileName &name, size_t select_img, int mode) -{ - read(name, HEADER); - bool swap = this->swap > 0; - return read(name, DATA, select_img, !swap, mode); -} - -int ImageBase::readOrReadMapped(const FileName &name, size_t select_img, int mode) -{ - try - { - return read(name, DATA, select_img, false, mode); - } - catch (XmippError &xe) - { - if (xe.__errno == ERR_MEM_NOTENOUGH) - { - reportWarning("ImageBase::readOrReadMapped: Not enough memory to allocate. \n" - " Proceeding to map image from file."); - return readMapped(name, select_img, mode); - } - else - throw xe; - } -} - -int ImageBase::readOrReadPreview(const FileName &name, size_t Xdim, size_t Ydim, int select_slice, size_t select_img, - bool mapData) -{ - read(name, HEADER); - size_t imXdim, imYdim, imZdim, imNdim; - getDimensions(imXdim, imYdim, imZdim, imNdim); - - if (imXdim != Xdim || imYdim != Ydim) - return readPreview(name, Xdim, Ydim, select_slice, select_img); - else - { - int ret = read(name, DATA, select_img, mapData); - if (select_slice != ALL_SLICES) - movePointerTo(select_slice); - return ret; - } - -} - -/** New mapped file */ -void ImageBase::mapFile2Write(size_t Xdim, size_t Ydim, size_t Zdim, const FileName &_filename, - bool createTempFile, size_t select_img, bool isStack, int mode) -{ - /** If XMIPP_MMAP is not defined this function is supposed to create - * the empty file only */ -#ifdef XMIPP_MMAP - mmapOnWrite = true; -#endif - - setDimensions(Xdim, Ydim, Zdim, 1); // Images with Ndim >1 cannot be mapped to image file - MD.resize(1); - filename = _filename; - FileName fnToOpen; - if (createTempFile) - { - tempFilename.initUniqueName("temp_XXXXXX"); - fnToOpen = tempFilename + ":" + _filename.getExtension(); - } - else - fnToOpen=_filename; - - /* If the filename is in stack or an image is selected, we will suppose - * you want to write this, even if you have not set the flags to. - */ - if ( (filename.isInStack() || select_img > ALL_IMAGES) && mode == WRITE_OVERWRITE) - { - isStack = true; - mode = WRITE_REPLACE; - } - - hFile = openFile(fnToOpen, mode); - _write(filename, hFile, select_img, isStack, mode); - closeFile(hFile); -} - -/** General read function - */ -/** Macros for don't type */ -#define READ_AND_RETURN() ImageFHandler* hFile = openFile(name); \ - int err = _read(name, hFile, params.datamode, params.select_img); \ - applyGeo(*row, params.only_apply_shifts, params.wrap); \ - closeFile(hFile); \ - return err - -void ImageBase::applyGeo(const MetaData &md, size_t objId, const ApplyGeoParams ¶ms) -{ - std::unique_ptr row(md.getRow(objId)); - applyGeo(*row, params.only_apply_shifts, params.wrap); -} - -void ImageBase::setGeo(const MDRow &row, size_t n) -{ - if (n < MD.size()) { - if (dynamic_cast(&row) != nullptr) - MD[n] = std::unique_ptr(new MDRowVec(dynamic_cast(row))); - if (dynamic_cast(&row) != nullptr) - MD[n] = std::unique_ptr(new MDRowSql(dynamic_cast(row))); - } else { - REPORT_ERROR(ERR_MD_OBJECTNUMBER, "Trying to set a value outside the current metadata size"); - } -} - -int ImageBase::readApplyGeo(const FileName &name, const MDRow &row, const ApplyGeoParams ¶ms) -{ - ImageFHandler* hFile = openFile(name); - int err = _read(name, hFile, params.datamode, params.select_img); - applyGeo(row, params.only_apply_shifts, params.wrap); - closeFile(hFile); - return err; -} - -/** Read an image from metadata, filename is provided -*/ -int ImageBase::readApplyGeo(const FileName &name, const MetaData &md, size_t objId, const ApplyGeoParams ¶ms) -{ - std::unique_ptr row(md.getRow(objId)); - READ_AND_RETURN(); -} - -/** Read an image from metadata, filename is taken from MDL_IMAGE - */ -int ImageBase::readApplyGeo(const MetaData &md, size_t objId, const ApplyGeoParams ¶ms) -{ - std::unique_ptr row(md.getRow(objId)); - FileName name; - row->getValue(MDL_IMAGE, name); - READ_AND_RETURN(); -} - - -void ImageBase::write(const FileName &name, size_t select_img, bool isStack, - int mode, CastWriteMode castMode, int _swapWrite) -{ - const FileName &fname = (name.empty()) ? filename : name; - - if (mmapOnWrite && mappedSize > 0) - { - bool hasTempFile = !tempFilename.empty(); - if (hasTempFile && fname.isInStack()) - mmapOnWrite = !(mmapOnRead = true); // We change mmap mode from write to read to allow writing the image into a stack. - else - { - if (_swapWrite > 0) - REPORT_ERROR(ERR_ARG_INCORRECT, "Cannot swap endianness on writing if file is already mapped."); - munmapFile(); - if (hasTempFile && std::rename(tempFilename.c_str(), fname.c_str()) != 0) - REPORT_ERROR(ERR_IO, formatString("Error renaming file '%s' to '%s'.", tempFilename.c_str(), fname.c_str())); - return; - } - } - // Swap the endianness of the image file when writing - swapWrite = _swapWrite; - - /* If the filename is in stack we will suppose you want to write this, - * even if you have not set the flags to. - */ - if ( fname.isInStack() && mode == WRITE_OVERWRITE) - { - isStack = true; - mode = WRITE_REPLACE; - } - // else if (!isStack && mode != WRITE_OVERWRITE) - // mode = WRITE_OVERWRITE; - - hFile = openFile(fname, mode); - _write(fname, hFile, select_img, isStack, mode, castMode); - closeFile(hFile); -} - -void ImageBase::swapPage(char * page, size_t pageNrElements, DataType datatype, int swap) -{ - size_t datatypesize = gettypesize(datatype); -#ifdef DEBUG - - std::cerr<<"DEBUG swapPage: Swapping image data with swap= " - << swap<<" datatypesize= "<= DT_CShort ) - datatypesize /= 2; - for ( size_t i = 0; i < pageNrElements; i += datatypesize ) - swapbytes(page+i, datatypesize); - } - else if ( swap > 1 ) - { - for (size_t i=0; igetValue(MDL_ANGLE_ROT, dummy); - return dummy; -} - -/** Get Tilt angle - * - * @code - * std::cout << "Second Euler angle " << I.tilt() << std::endl; - * @endcode - */ -double ImageBase::tilt(const size_t n) const -{ - double dummy = 0; - MD[n]->getValue(MDL_ANGLE_TILT, dummy); - return dummy; -} - -/** Get Psi angle - * - * @code - * std::cout << "Third Euler angle " << I.psi() << std::endl; - * @endcode - */ -double ImageBase::psi(const size_t n) const -{ - double dummy = 0; - MD[n]->getValue(MDL_ANGLE_PSI, dummy); - return dummy; -} - -/** Get Xoff - * - * @code - * std::cout << "Origin offset in X " << I.Xoff() << std::endl; - * @endcode - */ -double ImageBase::Xoff(const size_t n) const -{ - double dummy = 0; - MD[n]->getValue(MDL_SHIFT_X, dummy); - return dummy; -} - -/** Get Yoff - * - * @code - * std::cout << "Origin offset in Y " << I.Yoff() << std::endl; - * @endcode - */ -double ImageBase::Yoff(const size_t n) const -{ - double dummy = 0; - MD[n]->getValue(MDL_SHIFT_Y, dummy); - return dummy; -} - -/** Get Zoff - * - * @code - * std::cout << "Origin offset in Z " << I.Zoff() << std::endl; - * @endcode - */ -double ImageBase::Zoff(const size_t n) const -{ - double dummy = 0; - MD[n]->getValue(MDL_SHIFT_Z, dummy); - return dummy; -} - -/** Get Weight -* -* @code -* std::cout << "weight= " << I.weight() << std::endl; -* @endcode -*/ -double ImageBase::weight(const size_t n) const -{ - double dummy = 1; - MD[n]->getValue(MDL_WEIGHT, dummy); - return dummy; -} - -/** Get Scale factor -* -* @code -* std::cout << "scale= " << I.scale() << std::endl; -* @endcode -*/ -double ImageBase::scale(const size_t n) const -{ - double dummy = 1; - MD[n]->getValue(MDL_SCALE, dummy); - return dummy; -} - - -/** Get Flip -* -* @code -* std::cout << "flip= " << flip() << std::endl; -* @endcode -*/ -bool ImageBase::flip(const size_t n) const -{ - bool dummy = false; - MD[n]->getValue(MDL_FLIP, dummy); - return dummy; -} - -/** Data type - * - * @code - * std::cout << "datatype= " << dataType() << std::endl; - * @endcode - */ -DataType ImageBase::datatype() const -{ - int dummy; - MDMainHeader.getValue(MDL_DATATYPE, dummy); - return (DataType)dummy; -} - -void ImageBase::setDatatype(DataType datatype) -{ - MDMainHeader.setValue(MDL_DATATYPE, (int) datatype); -} -/** Sampling RateX -* -* @code -* std::cout << "sampling= " << samplingRateX() << std::endl; -* @endcode -*/ -double ImageBase::samplingRateX() const -{ - double dummy = 1.; - MDMainHeader.getValue(MDL_SAMPLINGRATE_X, dummy); - return dummy; -} - -/** Set Euler angles in image header - */ -void ImageBase::setEulerAngles(double rot, double tilt, double psi, - const size_t n) -{ - MD[n]->setValue(MDL_ANGLE_ROT, rot); - MD[n]->setValue(MDL_ANGLE_TILT, tilt); - MD[n]->setValue(MDL_ANGLE_PSI, psi); -} - -/** Get Euler angles from image header - */ -void ImageBase::getEulerAngles(double &rot, double &tilt, double &psi, - const size_t n) const -{ - MD[n]->getValue(MDL_ANGLE_ROT, rot); - MD[n]->getValue(MDL_ANGLE_TILT, tilt); - MD[n]->getValue(MDL_ANGLE_PSI, psi); -} - -/** Set origin offsets in image header - */ -void ImageBase::setShifts(double xoff, double yoff, double zoff, const size_t n) -{ - MD[n]->setValue(MDL_SHIFT_X, xoff); - MD[n]->setValue(MDL_SHIFT_Y, yoff); - MD[n]->setValue(MDL_SHIFT_Z, zoff); -} -/** Get origin offsets from image header - */ -void ImageBase::getShifts(double &xoff, double &yoff, double &zoff, const size_t n) const -{ - MD[n]->getValue(MDL_SHIFT_X, xoff); - MD[n]->getValue(MDL_SHIFT_Y, yoff); - MD[n]->getValue(MDL_SHIFT_Z, zoff); -} - -void ImageBase::getDimensions(size_t &Xdim, size_t &Ydim, size_t &Zdim, size_t &Ndim) const -{ - Xdim = XSIZE(*mdaBase); - Ydim = YSIZE(*mdaBase); - Zdim = ZSIZE(*mdaBase); - Ndim = NSIZE(*mdaBase); -} - -/** Get Image dimensions - */ -void ImageBase::getInfo(ImageInfo &imgInfo) const -{ - imgInfo.filename = filename; - imgInfo.offset = offset; - imgInfo.datatype = datatype(); - imgInfo.swap = getSwap() > 0; - imgInfo.adim = aDimFile ; -} - -void ImageBase::getInfo(const FileName &name, ImageInfo &imgInfo) -{ - read(name, HEADER); - getInfo(imgInfo); -} - -/** Open file function - * Open the image file and returns its file hander. - */ -ImageFHandler* ImageBase::openFile(const FileName &name, int mode) const -{ - if (name.empty()) - REPORT_ERROR(ERR_PARAM_INCORRECT, "ImageBase::openFile Cannot open an empty Filename."); - - ImageFHandler* hFile = new ImageFHandler; - FileName fileName, headName = ""; - FileName ext_name = name.getFileFormat(); - - // Remove image number and block name - fileName = name.removeAllPrefixes(); - - fileName = fileName.removeFileFormat(); - - size_t found = fileName.find_first_of("%"); - if (found!=String::npos) - fileName = fileName.substr(0, found) ; - - bool exist = fileName.exists(); - bool sizeZero = true; - - if (exist) - sizeZero = fileName.getFileSize() <= 0; - hFile->exist = exist && !sizeZero; - hFile->mode = mode; - - String wmChar; - - switch (mode) - { - case WRITE_READONLY: - if (!exist) - REPORT_ERROR(ERR_IO_NOTEXIST, formatString("Cannot access file '%s'. It doesn't exist", name.c_str())); - else if (sizeZero) - REPORT_ERROR(ERR_IO_SIZE, formatString("Cannot read zero size file '%s'.", name.c_str())); - - wmChar = "r"; - break; - case WRITE_OVERWRITE: - wmChar = "w"; - break; - case WRITE_APPEND: - case WRITE_REPLACE: - wmChar = (hFile->exist) ? "r+" : "w+"; - break; - - } - - if (ext_name.contains("tif") || ext_name.contains("gain")) - { - TIFFSetWarningHandler(NULL); // Switch off warning messages - if ((hFile->tif = TIFFOpen(fileName.c_str(), wmChar.c_str())) == NULL) - REPORT_ERROR(ERR_IO_NOTOPEN,"rwTIFF: There is a problem opening the TIFF file."); - hFile->fimg = NULL; - hFile->fhed = NULL; - } - else if (ext_name.contains("hdf") || ext_name.contains("h5")) - { - if ((hFile->fhdf5 = H5Fopen(fileName.c_str(), H5F_ACC_RDONLY, H5P_DEFAULT)) == -1 ) - REPORT_ERROR(ERR_IO_NOTOPEN,"ImageBase::openFile: There is a problem opening the HDF5 file."); - // hFile->fimg = NULL; - - if ( (hFile->fimg = fopen(fileName.c_str(), wmChar.c_str())) == NULL ) - { - if (errno == EACCES) - REPORT_ERROR(ERR_IO_NOPERM,formatString("Image::openFile: permission denied when opening %s",fileName.c_str())); - else - REPORT_ERROR(ERR_IO_NOTOPEN,formatString("Image::openFile cannot open: %s", fileName.c_str())); - } - - hFile->fhed = NULL; - hFile->tif = NULL; - } - else - { - hFile->tif = NULL; - - if (ext_name.contains("img") || ext_name.contains("hed")) - { - fileName = fileName.withoutExtension(); - headName = fileName.addExtension("hed"); - fileName = fileName.addExtension("img"); - } - else if (ext_name.contains("raw")) - { - if (mode != WRITE_READONLY || fileName.addExtension("inf").exists() ) - { - headName = fileName.addExtension("inf"); - ext_name = "inf"; - } - else - ext_name = "raw"; - } - else if (ext_name.contains("inf")) - { - headName = fileName; - fileName = fileName.withoutExtension(); - ext_name = "inf"; - } - - // Open image file - if ( (hFile->fimg = fopen(fileName.c_str(), wmChar.c_str())) == NULL ) - { - if (errno == EACCES) - REPORT_ERROR(ERR_IO_NOPERM,formatString("Image::openFile: permission denied when opening %s",fileName.c_str())); - else - REPORT_ERROR(ERR_IO_NOTOPEN,formatString("Image::openFile cannot open: %s", fileName.c_str())); - } - - - if (headName != "") - { - if ((hFile->fhed = fopen(headName.c_str(), wmChar.c_str())) == NULL ) - { - if (errno == EACCES) - REPORT_ERROR(ERR_IO_NOPERM,formatString("Image::openFile: permission denied when opening %s",headName.c_str())); - else - REPORT_ERROR(ERR_IO_NOTOPEN,formatString("Image::openFile cannot open: %s",headName.c_str())); - } - - } - else - hFile->fhed = NULL; - - } - hFile->fileName = fileName; - hFile->headName = headName; - hFile->ext_name = ext_name; - - return hFile; -} - -/** Close file function. - * Close the image file according to its name and file handler. - */ -void ImageBase::closeFile(ImageFHandler* hFile) const -{ - FileName ext_name, fileName; - FILE* fimg, *fhed; - TIFF* tif; - hid_t fhdf5; - - if (hFile != NULL) - { - fileName = hFile->fileName; - ext_name = hFile->ext_name; - fimg = hFile->fimg; - fhed = hFile->fhed; - tif = hFile->tif; - fhdf5 = hFile->fhdf5; - } - else - { - fileName = filename; - ext_name = filename.getFileFormat(); - fimg = this->fimg; - fhed = this->fhed; - tif = this->tif; - fhdf5 = this->fhdf5; - - } - - if (ext_name.contains("tif") || ext_name.contains("gain")) - { - TIFFClose(tif); - /* Since when creating a TIFF file without adding an image the file is 8 bytes - * and this same file returns an error when trying to open again, we are going - * to suppose that under 8 bytes this is empty. - */ - if (fileName.getFileSize() < 9) - filename.deleteFile(); - } - else if (ext_name.contains("hdf") || ext_name.contains("h5")) - { - H5Fclose(fhdf5); - if (fclose(fimg) != 0 ) - REPORT_ERROR(ERR_IO_NOCLOSED,(String)"Can not close image file "+ filename); - } - else - { - if (fclose(fimg) != 0 ) - REPORT_ERROR(ERR_IO_NOCLOSED,(String)"Can not close image file "+ filename); - - if (fhed != NULL && fclose(fhed) != 0 ) - REPORT_ERROR(ERR_IO_NOCLOSED,(String)"Can not close header file of " - + filename); - } - delete hFile; -} - -bool isDynamicMRC(const char * envvar, const String &ext) -{ - FileName mrcExtensions; - if (getenv(envvar)) - mrcExtensions=getenv(envvar); - String plainExt = ext; - size_t found = ext.find_first_of("%"); - if (found!=String::npos) - plainExt = ext.substr(0, found); - else - return false; - return mrcExtensions.contains(plainExt); -} - -bool isMRCStack(const FileName &ext_name) -{ - return ext_name.contains("mrcs") || ext_name.contains("st") || - ext_name.contains("preali") || ext_name.contains("ali") || - ext_name.contains("fixed") || - isDynamicMRC("XMIPP_MRC_STACK_EXTENSIONS",ext_name); -} - -bool isMRCImageOrVolume(const FileName &ext_name) -{ - return ext_name.contains("mrc") || ext_name.contains("map") || - ext_name.contains("rec") || isDynamicMRC("XMIPP_MRC_EXTENSIONS",ext_name); -} - -/* Internal read image file method. - */ -int ImageBase::_read(const FileName &name, ImageFHandler* hFile, DataMode datamode, size_t select_img, - bool mapData) -{ - // Temporary Error to find old select_img == -1 - if (select_img == (size_t) -1) - REPORT_ERROR(ERR_DEBUG_TEST, "To select all images use ALL_IMAGES macro, or FIRST_IMAGE macro."); - - int err = 0; - dataMode = datamode; - - // If MultidimArray pointer has been moved to a slice/image different from zero, then reset it. - // This check must be done prior to mappedSize check, since mappedSlice is a trick over data pointer - if ( virtualOffset != 0) - movePointerTo(ALL_SLICES); - // If Image has been previously used with mmap, then close the previous file - if (mappedSize != 0) - munmapFile(); - - // Check whether to map the data or not -#ifdef XMIPP_MMAP - - mmapOnRead = mapData; -#endif - - const auto &ext_name = hFile->ext_name; - fimg = hFile->fimg; - fhed = hFile->fhed; - tif = hFile->tif; - fhdf5 = hFile->fhdf5; - - size_t image_num = name.getPrefixNumber(); - filename = name; - dataFName = hFile->fileName; - - if (image_num != ALL_IMAGES) - select_img = image_num; - -#undef DEBUG - // #define DEBUG -#ifdef DEBUG - - std::cerr << "READ\n" << - "name="<ext_name; - fimg = hFile->fimg; - fhed = hFile->fhed; - tif = hFile->tif; - fhdf5 = hFile->fhdf5; - - filename = name; - dataFName = hFile->fileName; - - - //Just clear the header before reading - MDMainHeader.clear(); - //Set the file pointer at beginning - if (fimg != NULL) - fseek(fimg, 0, SEEK_SET); - if (fhed != NULL) - fseek(fhed, 0, SEEK_SET); - - if (ext_name.contains("spi") || ext_name.contains("xmp") || - ext_name.contains("stk") || ext_name.contains("vol")) { - err = readSPIDER(start_img, batch_size); - } else if (isMRCStack(ext_name)) { //mrc stack MUST go BEFORE plain MRC - err = readMRC(start_img, batch_size, true); - } else if (isMRCImageOrVolume(ext_name)) {//mrc - err = readMRC(start_img, batch_size, false); - } else { - REPORT_ERROR(ERR_NOT_IMPLEMENTED, "Reading of a range of files is implemented only for SPIDER and MRC stack."); - } - - // Negative errors are bad. - return err; -} - -/* Internal write image file method. - */ -void ImageBase::_write(const FileName &name, ImageFHandler* hFile, size_t select_img, - bool isStack, int mode, CastWriteMode castMode) -{ - // Temporary Error to find old select_img == -1 - if (select_img == (size_t) -1) - REPORT_ERROR(ERR_DEBUG_TEST, "To select all images use ALL_IMAGES macro, or FIRST_IMAGE macro."); - - int err = 0; - - // if image is mapped to file then close the file and clear - if (mmapOnWrite && mappedSize > 0) - { - munmapFile(); - return; - } - - filename = name; - dataFName = hFile->fileName; - _exists = hFile->exist; - fimg = hFile->fimg; - fhed = hFile->fhed; - tif = hFile->tif; - - FileName ext_name = hFile->ext_name; - - size_t aux; - FileName filNamePlusExt; - name.decompose(aux, filNamePlusExt); - - if (select_img == ALL_IMAGES) - select_img = aux; - - /// Datatype info must be from filename after "%" symbol - size_t found = filNamePlusExt.find_first_of("%"); - String imParam = ""; - if (found!=String::npos) - { - imParam = filNamePlusExt.substr(found+1).c_str(); - filNamePlusExt = filNamePlusExt.substr(0, found) ; - } - - // #define DEBUG -#ifdef DEBUG - - std::cerr << "write" <(); - } - m_auxI->_read(filNamePlusExt, hFile, HEADER, ALL_IMAGES); - - this->getDimensions(Xdim, Ydim, Zdim, Ndim); - m_auxI->getDimensions(_Xdim, _Ydim, _Zdim, _Ndim); - - if(m_auxI->getSize()>1) - { - replaceNsize = _Ndim; - - /** If we are going to changes all images, then swap of the file may be changed, - * otherwise, original swap remains. */ - if (select_img > ALL_IMAGES || Ndim < replaceNsize) - swapWrite = m_auxI->swap; - - if(Xdim != _Xdim || - Ydim != _Ydim || - Zdim != _Zdim) - { - REPORT_ERROR(ERR_MULTIDIM_SIZE,formatString( - "ImageBase::Write: images source and target have different sizes:\n" - "Image source to be written (x,y,z,n) = %d %d %d %lu\n" - "Image file target %s (x,y,z,n) = %d %d %d %lu", - Xdim,Ydim,Zdim,Ndim,dataFName.c_str(),_Xdim,_Ydim,_Zdim,_Ndim)); - } - } - } - else if(!_exists && mode == WRITE_APPEND) - { - ; - } - else if (mode == WRITE_READONLY)//If new file we are in the WRITE_OVERWRITE mode - { - REPORT_ERROR(ERR_ARG_INCORRECT, formatString("File %s opened in read-only mode. Cannot write.", name.c_str())); - } - - /* - * SELECT FORMAT - */ - //Set the file pointer at beginning - if (fimg != NULL) - fseek(fimg, 0, SEEK_SET); - if (fhed != NULL) - fseek(fhed, 0, SEEK_SET); - - if(ext_name.contains("spi") || ext_name.contains("xmp") || - ext_name.contains("vol")) - err = writeSPIDER(select_img,isStack,mode); - else if (ext_name.contains("stk")) - err = writeSPIDER(select_img,true,mode); - else if (isMRCStack(ext_name) || isMRCImageOrVolume(ext_name)) - writeMRC(select_img,isStack,mode,imParam,castMode); - else if (ext_name.contains("img") || ext_name.contains("hed")) - writeIMAGIC(select_img,mode,imParam,castMode); - else if (ext_name.contains("dm3")) - writeDM3(select_img,false,mode); - else if (ext_name.contains("dm4")) - writeDM4(select_img,false,mode); - else if (ext_name.contains("em")) - writeEM(select_img,false,mode); - else if (ext_name.contains("pif")) - writePIF(select_img,false,mode); - else if (ext_name.contains("ser")) - writeTIA(select_img,false,mode); - else if (ext_name.contains("raw") || ext_name.contains("inf")) - writeINF(select_img,false,mode,imParam,castMode); - else if (ext_name.contains("tif") || ext_name.contains("gain")) - writeTIFF(select_img,isStack,mode,imParam,castMode); - else if (ext_name.contains("spe")) - writeSPE(select_img,isStack,mode); - else if (ext_name.contains("jpg")) - writeJPEG(select_img, false, WRITE_OVERWRITE, "", CW_ADJUST); - else if (ext_name.contains("hdf5") || ext_name.contains("h5")) - writeHDF5(select_img); - else - err = writeSPIDER(select_img,isStack,mode); - - if ( err < 0 ) - { - std::cerr << " Filename = " << filename << " Extension= " << ext_name << std::endl; - REPORT_ERROR(ERR_IO_NOWRITE, "Error writing file"); - } - - /* If initially the file did not existed, once the first image is written, - * then the file exists - */ - if (!_exists) - hFile->exist = _exists = true; -} - -bool ImageBase::isImage(const FileName &name) -{ - try - { - return !read(name, HEADER); - } - catch (XmippError &xe) - { - return false; - } -} - -/** Show image properties - */ -std::ostream& operator<<(std::ostream& o, const ImageBase& I) -{ - o << std::endl; - DataType * fileDT = NULL; - if (!I.filename.empty()) - { - o << "--- File information ---" << std::endl; - o << "Filename : " << I.filename << std::endl; - o << "Endianess : "; - if (I.swap^IsLittleEndian()) - o << "Little" << std::endl; - else - o << "Big" << std::endl; - - o << "Reversed : "; - if (I.swap) - o << "True" << std::endl; - else - o << "False" << std::endl; - fileDT = new DataType; - *fileDT = I.datatype(); - o << "Data type : " << datatype2StrLong(*fileDT) << std::endl; - o << "Data offset : " << I.offset << std::endl; - } - - o << "--- Image information ---" << std::endl; - - DataType myDT = I.myT(); - if ((fileDT == NULL || myDT != *fileDT) && I.dataMode >= DATA ) - o << "Memory datatype: " << datatype2StrLong(I.myT()) << std::endl; - o << "Image type : "; - if (I.isComplex()) - o << "Fourier-space image" << std::endl; - else - o << "Real-space image" << std::endl; - - delete fileDT; - - size_t xdim, ydim, zdim, ndim; - I.getDimensions(xdim, ydim, zdim, ndim); - o << "Dimensions : " << ndim << " x " << zdim << " x " << ydim << " x " << xdim; - o << " ((N)Objects x (Z)Slices x (Y)Rows x (X)Columns)" << std::endl; - - double sampling; - I.MDMainHeader.getValueOrDefault(MDL_SAMPLINGRATE_X, sampling, 0); - if (sampling > 0) - { - o << "Sampling rate : " << std::endl; - o << " X-rate (Angstrom/pixel) = " << sampling << std::endl; - I.MDMainHeader.getValue(MDL_SAMPLINGRATE_Y, sampling); - o << " Y-rate (Angstrom/pixel) = " << sampling << std::endl; - I.MDMainHeader.getValue(MDL_SAMPLINGRATE_Z, sampling); - o << " Z-rate (Angstrom/pixel) = " << sampling << std::endl; - } - - std::stringstream oGeo; - - if (I.individualContainsLabel(MDL_ANGLE_ROT)) - { - oGeo << "Euler angles : " << std::endl; - oGeo << " Phi (rotation around Z axis) = " << I.rot() << std::endl; - oGeo << " Theta (tilt, second rotation around new Y axis) = " << I.tilt() << std::endl; - oGeo << " Psi (third rotation around new Z axis) = " << I.psi() << std::endl; - } - if (I.individualContainsLabel(MDL_SHIFT_X)) - { - oGeo << "Origin Offsets : " << std::endl; - oGeo << " Xoff (origin offset in X-direction) = " << I.Xoff() << std::endl; - oGeo << " Yoff (origin offset in Y-direction) = " << I.Yoff() << std::endl; - oGeo << " Zoff (origin offset in Z-direction) = " << I.Zoff() << std::endl; - } - if (I.individualContainsLabel(MDL_SCALE)) - oGeo << "Scale : " < -#include - -#include "xmipp_image_macros.h" -#include "xmipp_datatype.h" -#include "metadata_row_vec.h" -#include "xmipp_array_dim.h" -#include "xmipp_filename.h" -#include "transformations_defines.h" - -#include - -template -class Matrix2D; -template -class Image; -struct tiff; -typedef struct tiff TIFF; -class MultidimArrayBase; -class MetaData; - -/* Minimum size of a TIFF file to be mapped to a tempfile in case of mapping from - * image file is required - */ -const size_t tiff_map_min_size = 0x12000000; - -/// @defgroup Images Images -/// @ingroup DataLibrary - -//@{ -/** Transform type. - * This type defines the kind of image. - */ -typedef enum -{ - NoTransform = 0, // No transform - Standard = 1, // Standard transform: origin = (0,0,0) - Centered = 2, // Centered transform: origin = (nx/2,ny/2,nz/2) - Hermitian = 3, // Hermitian half: origin = (0,0,0) - CentHerm = 4 // Centered hermitian: origin = (0,ny/2,nz/2) -} TransformType; - -/** Write mode - * This class defines the writing behavior. - */ -typedef enum -{ - WRITE_READONLY, //only can read the file - WRITE_OVERWRITE, //forget about the old file and overwrite it - WRITE_REPLACE, //replace a particular object by another - WRITE_APPEND, //append and object at the end of a stack, so far can not append stacks - WRITE_LAST_LABEL // **** NOTE ****: Do keep this label always at the end - // it is here for looping purposes -} WriteMode; - -/** Data mode - * This enumerate which data will be read/write from image files - * We can read/write complete image or only its headers(w/o geometrical information) - */ -typedef enum -{ - _NONE = -2, // Nothing to do. Used by ImageGeneric to check the right datatype to be used - HEADER = -1, //Don't read image data, only info from main header(datatype and dimensions) - _HEADER_ALL = 0, //Read complete header(main and geo), useful for header_extract and header_assign - DATA = 1, //Read image data and main header, geometrical transformations will be ignored - _DATA_ALL = 2 //Read data with complete header(the use of this option is not recommended, all Xmipp - // programs should read and write geo info through metadatas -}DataMode; - -/* Cast Write mode - * This enum defines the cast writing behavior - */ -typedef enum -{ - // prefix needed so extract_image_enums.py script can create the equivalent class for Java - CW_CAST, //Only cast the data type - CW_CONVERT, //Convert the data from one type to another - CW_ADJUST, //Adjust the histogram to fill the gray level range - CW_LAST_LABEL // **** NOTE ****: Do keep this label always at the end - // it is here for looping purposes -} CastWriteMode; - -/** Open File struct - * This struct is used to share the File handlers with Image Collection class - */ -struct ImageFHandler -{ - FILE* fimg; // Image File handler - FILE* fhed; // Image File header handler - TIFF* tif; // TIFF Image file handler - hid_t fhdf5; // HDF5 File handler - FileName fileName; // Image file name - FileName headName; // Header file name - FileName ext_name; // Filename extension - bool exist; // Shows if the file exists. Equal 0 means file does not exist or not stack. - int mode; // Opening mode behavior -}; - -struct ImageInfo -{ - FileName filename; - size_t offset; - DataType datatype; - bool swap; - ArrayDim adim; -}; - -struct ApplyGeoParams -{ - bool only_apply_shifts; - DataMode datamode; - size_t select_img; - bool wrap; - - ApplyGeoParams() - { - only_apply_shifts = false; - datamode = DATA; - select_img = ALL_IMAGES; - wrap = xmipp_transformation::WRAP; - } -}; - -const ApplyGeoParams DefaultApplyGeoParams; - -/// @name Images Speed-up -/// @{ - -/** Volume Matrix access. - * - * This macro does the same as the normal 3D matrix access but in a faster way - * as no function call is generated. - * - * @code - * VOLMATRIX(V).resize(128, 128, 128); - * - * VOLMATRIX(V2) = VOLMATRIX(V1) + VOLMATRIX(V2); - * @endcode - */ -#define VOLMATRIX(V) ((V).data) - -/** Image Matrix access. - * - * This macro does the same as the normal 2D matrix access but in a faster way - * as no function call is generated. - * - * @code - * IMGMATRIX(V).resize(128, 128); - * - * IMGMATRIX(V2) = IMGMATRIX(V1) + IMGMATRIX(V2); - * @endcode - */ -#define IMGMATRIX(I) ((I).data) - -/** Pixel access. - * For fast access to pixel values (and for backwards compatibility of the code) - */ -#define IMGPIXEL(I, i, j) A2D_ELEM(((I).data), (i), (j)) - -/** Physical pixel access. - * - * The physical pixel access gives you access to a pixel by its physical - * position and not by its logical one. This access shouldn't be used as a - * custom, use instead the logical access, but there might be cases in which - * this access might be interesting. Physical positions start at index 0 in C. - * - * @code - * std::cout << "This is the first pixel stored in the Image " << - * DIRECT_IMGPIXEL(V, 0, 0) << std::endl; - * @endcode - */ -#define DIRECT_IMGPIXEL(I, i, j) DIRECT_A2D_ELEM(((I).data), (i), (j)) - -/** Voxel access. - * - * This macro does the same as the normal voxel access (remember, logical - * access) but in a faster way as no function call is generated. - * - * @code - * std::cout << "Grey level of voxel (2,-3,-3) of the Volume = " << - * VOLVOXEL(V, 2, -3, -3) << std::endl; - * - * VOLVOXEL(I, 2, -3, -3) = VOLVOXEL(I, 2, -3, -2); - * @endcode - */ -#define VOLVOXEL(V, k, i, j) A3D_ELEM(((V).data), (k), (i), (j)) - -/** Physical voxel access. - * - * The physical voxel access gives you access to a voxel by its physical - * position and not by its logical one. This access shouldn't be used as a - * custom, use instead the logical access, but there might be cases in which - * this access might be interesting. Physical positions start at index 0 in C. - * - * @code - * std::cout << "This is the first voxel stored in the Volume " << - * DIRECT_VOLVOXEL(V, 0, 0, 0) << std::endl; - * @endcode - */ -#define DIRECT_VOLVOXEL(I, k, i, j) DIRECT_A3D_ELEM(((I).data), (k), (i), (j)) -///@} - -/** Swapping trigger. - * Threshold file z size above which bytes are swapped. - */ -#define SWAPTRIG 16776960 - - -/// Image base class -class ImageBase -{ -public: - MultidimArrayBase * mdaBase; // Pointer to data from Image